mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

* *.c: Finish replacing K&R style prototypes with ANSI C

Browse source 
prototypes.

* eval.c: Make scm_m_mody's 3rd argument be a const char *, not a
char *.  ANSI prototypes caught this.

* strorder.c: Use GUILE_PROC1 for the couple SCM_PROC1 expansions
that I missed.

* scm_validate.h: Use SCM_BOOLP for validating bools.  Do not
expand macros if SCM_DOCSTRING_SNARF.
This commit is contained in:
Greg J. Badros 1999-12-12 20:35:02 +00:00
parent 1006486ec2
commit 6e8d25a695
36 changed files with 273 additions and 523 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/alloca.c
View file

@ -21,6 +21,9 @@
allocating any. It is a good idea to use alloca(0) in allocating any. It is a good idea to use alloca(0) in
your main control loop, etc. to force garbage collection. */ your main control loop, etc. to force garbage collection. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#ifdef HAVE_CONFIG_H #ifdef HAVE_CONFIG_H
#include <scmconfig.h> #include <scmconfig.h>
#endif #endif
@ -153,8 +156,7 @@ static header *last_alloca_header = NULL; /* -> last alloca header. */
implementations of C, for example under Gould's UTX/32. */ implementations of C, for example under Gould's UTX/32. */
pointer pointer
alloca (size) alloca (unsigned size)
unsigned size;
{ {
auto char probe; /* Probes stack depth: */ auto char probe; /* Probes stack depth: */
register char *depth = ADDRESS_FUNCTION (probe); register char *depth = ADDRESS_FUNCTION (probe);

5
libguile/backtrace.c
View file

@ -106,10 +106,7 @@ display_header (SCM source, SCM port)
void void
scm_display_error_message (message, args, port) scm_display_error_message (SCM message, SCM args, SCM port)
SCM message;
SCM args;
SCM port;
{ {
int writingp; int writingp;
char *start; char *start;

6
libguile/chars.c
View file

@ -317,8 +317,7 @@ scm_tables_prehistory ()
int int
scm_upcase (c) scm_upcase (unsigned int c)
unsigned int c;
{ {
if (c < sizeof (scm_upcase_table)) if (c < sizeof (scm_upcase_table))
return scm_upcase_table[c]; return scm_upcase_table[c];
@ -328,8 +327,7 @@ scm_upcase (c)
int int
scm_downcase (c) scm_downcase (unsigned int c)
unsigned int c;
{ {
if (c < sizeof (scm_downcase_table)) if (c < sizeof (scm_downcase_table))
return scm_downcase_table[c]; return scm_downcase_table[c];

10
libguile/continuations.c
View file

@ -62,8 +62,7 @@ static char s_cont[] = "continuation";
SCM SCM
scm_make_cont (answer) scm_make_cont (SCM *answer)
SCM * answer;
{ {
long j; long j;
SCM cont; SCM cont;
@ -141,8 +140,7 @@ grow_throw (SCM *a)
void void
scm_dynthrow (a) scm_dynthrow (SCM *a)
SCM *a;
{ {
SCM cont = a[0], val = a[1]; SCM cont = a[0], val = a[1];
#ifndef CHEAP_CONTINUATIONS #ifndef CHEAP_CONTINUATIONS
@ -184,9 +182,7 @@ scm_dynthrow (a)
SCM SCM
scm_call_continuation (cont, val) scm_call_continuation (SCM cont, SCM val)
SCM cont;
SCM val;
{ {
SCM a[3]; SCM a[3];
a[0] = cont; a[0] = cont;

9
libguile/debug.c
View file

@ -522,10 +522,7 @@ scm_reverse_lookup (SCM env, SCM data)
} }
SCM SCM
scm_start_stack (id, exp, env) scm_start_stack (SCM id, SCM exp, SCM env)
SCM id;
SCM exp;
SCM env;
{ {
SCM answer; SCM answer;
scm_debug_frame vframe; scm_debug_frame vframe;
@ -543,9 +540,7 @@ scm_start_stack (id, exp, env)
SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack); SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
static SCM static SCM
scm_m_start_stack (exp, env) scm_m_start_stack (SCM exp, SCM env)
SCM exp;
SCM env;
{ {
exp = SCM_CDR (exp); exp = SCM_CDR (exp);
SCM_ASSERT (SCM_NIMP (exp) SCM_ASSERT (SCM_NIMP (exp)

6
libguile/dynl-vms.c
View file

@ -45,6 +45,9 @@
Author: Aubrey Jaffer Author: Aubrey Jaffer
(Not yet) modified for libguile by Marius Vollmer */ (Not yet) modified for libguile by Marius Vollmer */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
/* We should try to implement dynamic-link/dynamic-call for VMS, /* We should try to implement dynamic-link/dynamic-call for VMS,
too. */ too. */
@ -74,8 +77,7 @@ struct dsc$descriptor *descriptorize(x, buff)
return(x);} return(x);}
static char s_dynl[] = "vms:dynamic-link-call"; static char s_dynl[] = "vms:dynamic-link-call";
SCM dynl(dir, symbol, fname) SCM dynl(SCM dir, SCM symbol, SCM fname)
SCM dir, symbol, fname;
{ {
struct dsc$descriptor fnamed, symbold, dird; struct dsc$descriptor fnamed, symbold, dird;
void (*fcn)(); void (*fcn)();

4
libguile/dynl.c
View file

@ -145,9 +145,7 @@ struct moddata {
static struct moddata *registered_mods = NULL; static struct moddata *registered_mods = NULL;
void void
scm_register_module_xxx (module_name, init_func) scm_register_module_xxx (char *module_name, void *init_func)
char *module_name;
void *init_func;
{ {
struct moddata *md; struct moddata *md;

4
libguile/dynwind.c
View file

@ -171,9 +171,7 @@ scm_swap_bindings (SCM glocs, SCM vals)
} }
void void
scm_dowinds (to, delta) scm_dowinds (SCM to, long delta)
SCM to;
long delta;
{ {
tail: tail:
if (scm_dynwinds == to); if (scm_dynwinds == to);

148
libguile/eval.c
View file

@ -157,9 +157,7 @@ SCM (*scm_memoize_method) (SCM, SCM);
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
SCM * SCM *
scm_ilookup (iloc, env) scm_ilookup (SCM iloc, SCM env)
SCM iloc;
SCM env;
{ {
register int ir = SCM_IFRAME (iloc); register int ir = SCM_IFRAME (iloc);
register SCM er = env; register SCM er = env;
@ -384,10 +382,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
#ifdef USE_THREADS #ifdef USE_THREADS
SCM * SCM *
scm_lookupcar (vloc, genv, check) scm_lookupcar (SCM vloc, SCM genv, int check)
SCM vloc;
SCM genv;
int check;
{ {
SCM *loc = scm_lookupcar1 (vloc, genv, check); SCM *loc = scm_lookupcar1 (vloc, genv, check);
if (loc == NULL) if (loc == NULL)
@ -399,9 +394,7 @@ scm_lookupcar (vloc, genv, check)
#define unmemocar scm_unmemocar #define unmemocar scm_unmemocar
SCM SCM
scm_unmemocar (form, env) scm_unmemocar (SCM form, SCM env)
SCM form;
SCM env;
{ {
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
register int ir; register int ir;
@ -431,9 +424,7 @@ scm_unmemocar (form, env)
SCM SCM
scm_eval_car (pair, env) scm_eval_car (SCM pair, SCM env)
SCM pair;
SCM env;
{ {
return SCM_XEVALCAR (pair, env); return SCM_XEVALCAR (pair, env);
} }
@ -469,10 +460,7 @@ SCM scm_sym_trace;
static void bodycheck SCM_P ((SCM xorig, SCM *bodyloc, const char *what)); static void bodycheck SCM_P ((SCM xorig, SCM *bodyloc, const char *what));
static void static void
bodycheck (xorig, bodyloc, what) bodycheck (SCM xorig, SCM *bodyloc, const char *what)
SCM xorig;
SCM *bodyloc;
const char *what;
{ {
ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, scm_s_expression); ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, scm_s_expression);
} }
@ -491,10 +479,7 @@ bodycheck (xorig, bodyloc, what)
This is not done yet. */ This is not done yet. */
static SCM static SCM
scm_m_body (op, xorig, what) scm_m_body (SCM op, SCM xorig, const char *what)
SCM op;
SCM xorig;
char *what;
{ {
ASRTSYNTAX (scm_ilength (xorig) >= 1, scm_s_expression); ASRTSYNTAX (scm_ilength (xorig) >= 1, scm_s_expression);
@ -518,9 +503,7 @@ SCM_SYNTAX(s_quote,"quote", scm_makmmacro, scm_m_quote);
SCM_GLOBAL_SYMBOL(scm_sym_quote, s_quote); SCM_GLOBAL_SYMBOL(scm_sym_quote, s_quote);
SCM SCM
scm_m_quote (xorig, env) scm_m_quote (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = scm_copy_tree (SCM_CDR (xorig)); SCM x = scm_copy_tree (SCM_CDR (xorig));
@ -535,9 +518,7 @@ SCM_SYNTAX(s_begin, "begin", scm_makmmacro, scm_m_begin);
SCM_GLOBAL_SYMBOL(scm_sym_begin, s_begin); SCM_GLOBAL_SYMBOL(scm_sym_begin, s_begin);
SCM SCM
scm_m_begin (xorig, env) scm_m_begin (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1,
xorig, scm_s_expression, s_begin); xorig, scm_s_expression, s_begin);
@ -548,9 +529,7 @@ SCM_SYNTAX(s_if, "if", scm_makmmacro, scm_m_if);
SCM_GLOBAL_SYMBOL(scm_sym_if, s_if); SCM_GLOBAL_SYMBOL(scm_sym_if, s_if);
SCM SCM
scm_m_if (xorig, env) scm_m_if (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 2 && len <= 3, xorig, scm_s_expression, "if"); SCM_ASSYNT (len >= 2 && len <= 3, xorig, scm_s_expression, "if");
@ -564,9 +543,7 @@ const char scm_s_set_x[] = "set!";
SCM_GLOBAL_SYMBOL(scm_sym_set_x, scm_s_set_x); SCM_GLOBAL_SYMBOL(scm_sym_set_x, scm_s_set_x);
SCM SCM
scm_m_set_x (xorig, env) scm_m_set_x (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x); SCM_ASSYNT (2 == scm_ilength (x), xorig, scm_s_expression, scm_s_set_x);
@ -579,9 +556,7 @@ scm_m_set_x (xorig, env)
#if 0 #if 0
SCM SCM
scm_m_vref (xorig, env) scm_m_vref (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (1 == scm_ilength (x), xorig, scm_s_expression, s_vref); SCM_ASSYNT (1 == scm_ilength (x), xorig, scm_s_expression, s_vref);
@ -600,9 +575,7 @@ scm_m_vref (xorig, env)
SCM SCM
scm_m_vset (xorig, env) scm_m_vset (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (3 == scm_ilength (x), xorig, scm_s_expression, s_vset); SCM_ASSYNT (3 == scm_ilength (x), xorig, scm_s_expression, s_vset);
@ -618,9 +591,7 @@ SCM_SYNTAX(s_and, "and", scm_makmmacro, scm_m_and);
SCM_GLOBAL_SYMBOL(scm_sym_and, s_and); SCM_GLOBAL_SYMBOL(scm_sym_and, s_and);
SCM SCM
scm_m_and (xorig, env) scm_m_and (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_and); SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_and);
@ -634,9 +605,7 @@ SCM_SYNTAX(s_or,"or", scm_makmmacro, scm_m_or);
SCM_GLOBAL_SYMBOL(scm_sym_or,s_or); SCM_GLOBAL_SYMBOL(scm_sym_or,s_or);
SCM SCM
scm_m_or (xorig, env) scm_m_or (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
int len = scm_ilength (SCM_CDR (xorig)); int len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_or); SCM_ASSYNT (len >= 0, xorig, scm_s_test, s_or);
@ -651,9 +620,7 @@ SCM_SYNTAX(s_case, "case", scm_makmmacro, scm_m_case);
SCM_GLOBAL_SYMBOL(scm_sym_case, s_case); SCM_GLOBAL_SYMBOL(scm_sym_case, s_case);
SCM SCM
scm_m_case (xorig, env) scm_m_case (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_clauses, s_case); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_clauses, s_case);
@ -674,9 +641,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_cond, s_cond);
SCM SCM
scm_m_cond (xorig, env) scm_m_cond (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
int len = scm_ilength (x); int len = scm_ilength (x);
@ -704,9 +669,7 @@ SCM_SYNTAX(s_lambda, "lambda", scm_makmmacro, scm_m_lambda);
SCM_GLOBAL_SYMBOL(scm_sym_lambda, s_lambda); SCM_GLOBAL_SYMBOL(scm_sym_lambda, s_lambda);
SCM SCM
scm_m_lambda (xorig, env) scm_m_lambda (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM proc, x = SCM_CDR (xorig); SCM proc, x = SCM_CDR (xorig);
if (scm_ilength (x) < 2) if (scm_ilength (x) < 2)
@ -751,9 +714,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_letstar,s_letstar);
SCM SCM
scm_m_letstar (xorig, env) scm_m_letstar (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars; SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
int len = scm_ilength (x); int len = scm_ilength (x);
@ -794,9 +755,7 @@ SCM_SYNTAX(s_do, "do", scm_makmmacro, scm_m_do);
SCM_GLOBAL_SYMBOL(scm_sym_do, s_do); SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
SCM SCM
scm_m_do (xorig, env) scm_m_do (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig), arg1, proc; SCM x = SCM_CDR (xorig), arg1, proc;
SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL; SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
@ -842,9 +801,7 @@ SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote); SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote);
SCM SCM
scm_m_quasiquote (xorig, env) scm_m_quasiquote (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 1, xorig, scm_s_expression, s_quasiquote); SCM_ASSYNT (scm_ilength (x) == 1, xorig, scm_s_expression, s_quasiquote);
@ -902,9 +859,7 @@ SCM_SYNTAX (s_delay, "delay", scm_makmmacro, scm_m_delay);
SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay); SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
SCM SCM
scm_m_delay (xorig, env) scm_m_delay (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM_ASSYNT (scm_ilength (xorig) == 2, xorig, scm_s_expression, s_delay); SCM_ASSYNT (scm_ilength (xorig) == 2, xorig, scm_s_expression, s_delay);
return scm_cons2 (SCM_IM_DELAY, SCM_EOL, SCM_CDR (xorig)); return scm_cons2 (SCM_IM_DELAY, SCM_EOL, SCM_CDR (xorig));
@ -915,9 +870,7 @@ SCM_SYNTAX(s_define, "define", scm_makmmacro, scm_m_define);
SCM_GLOBAL_SYMBOL(scm_sym_define, s_define); SCM_GLOBAL_SYMBOL(scm_sym_define, s_define);
SCM SCM
scm_m_define (x, env) scm_m_define (SCM x, SCM env)
SCM x;
SCM env;
{ {
SCM proc, arg1 = x; SCM proc, arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);
@ -977,11 +930,7 @@ scm_m_define (x, env)
/* end of acros */ /* end of acros */
static SCM static SCM
scm_m_letrec1 (op, imm, xorig, env) scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env)
SCM op;
SCM imm;
SCM xorig;
SCM env;
{ {
SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */ SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */
char *what = SCM_CHARS (SCM_CAR (xorig)); char *what = SCM_CHARS (SCM_CAR (xorig));
@ -1011,9 +960,7 @@ SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec);
SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec); SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
SCM SCM
scm_m_letrec (xorig, env) scm_m_letrec (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM x = SCM_CDR (xorig); SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_letrec); SCM_ASSYNT (scm_ilength (x) >= 2, xorig, scm_s_body, s_letrec);
@ -1032,9 +979,7 @@ SCM_SYNTAX(s_let, "let", scm_makmmacro, scm_m_let);
SCM_GLOBAL_SYMBOL(scm_sym_let, s_let); SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
SCM SCM
scm_m_let (xorig, env) scm_m_let (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */ SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */
SCM x = cdrx, proc, arg1, name; /* structure traversers */ SCM x = cdrx, proc, arg1, name; /* structure traversers */
@ -1096,9 +1041,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
SCM SCM
scm_m_apply (xorig, env) scm_m_apply (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2,
xorig, scm_s_expression, s_atapply); xorig, scm_s_expression, s_atapply);
@ -1111,9 +1054,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc);
SCM SCM
scm_m_cont (xorig, env) scm_m_cont (SCM xorig, SCM env)
SCM xorig;
SCM env;
{ {
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
xorig, scm_s_expression, s_atcall_cc); xorig, scm_s_expression, s_atcall_cc);
@ -1545,9 +1486,7 @@ loop:
SCM SCM
scm_unmemocopy (x, env) scm_unmemocopy (SCM x, SCM env)
SCM x;
SCM env;
{ {
if (SCM_NNULLP (env)) if (SCM_NNULLP (env))
/* Make a copy of the lowest frame to protect it from /* Make a copy of the lowest frame to protect it from
@ -1560,9 +1499,7 @@ scm_unmemocopy (x, env)
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
int int
scm_badargsp (formals, args) scm_badargsp (SCM formals, SCM args)
SCM formals;
SCM args;
{ {
while (SCM_NIMP (formals)) while (SCM_NIMP (formals))
{ {
@ -1580,10 +1517,7 @@ scm_badargsp (formals, args)
SCM SCM
scm_eval_args (l, env, proc) scm_eval_args (SCM l, SCM env, SCM proc)
SCM l;
SCM env;
SCM proc;
{ {
SCM results = SCM_EOL, *lloc = &results, res; SCM results = SCM_EOL, *lloc = &results, res;
while (SCM_NIMP (l)) while (SCM_NIMP (l))
@ -1802,8 +1736,7 @@ GUILE_PROC (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM SCM
scm_deval_args (l, env, proc, lloc) scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
SCM l, env, proc, *lloc;
{ {
SCM *results = lloc, res; SCM *results = lloc, res;
while (SCM_NIMP (l)) while (SCM_NIMP (l))
@ -3275,21 +3208,15 @@ GUILE_PROC(scm_nconc2last, "apply:nconc2last", 1, 0, 0,
#if 0 #if 0
SCM SCM
scm_apply (proc, arg1, args) scm_apply (SCM proc, SCM arg1, SCM args)
SCM proc;
SCM arg1;
SCM args;
{} {}
#endif #endif
#if 0 #if 0
SCM SCM
scm_dapply (proc, arg1, args) scm_dapply (SCM proc, SCM arg1, SCM args)
SCM proc; { /* empty */ }
SCM arg1;
SCM args;
{}
#endif #endif
@ -3742,9 +3669,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
SCM SCM
scm_closure (code, env) scm_closure (SCM code, SCM env)
SCM code;
SCM env;
{ {
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
@ -3757,8 +3682,7 @@ scm_closure (code, env)
long scm_tc16_promise; long scm_tc16_promise;
SCM SCM
scm_makprom (code) scm_makprom (SCM code)
SCM code;
{ {
SCM_RETURN_NEWSMOB (scm_tc16_promise, code); SCM_RETURN_NEWSMOB (scm_tc16_promise, code);
} }

3
libguile/evalext.c
View file

@ -120,8 +120,7 @@ GUILE_PROC (scm_definedp, "defined?", 1, 1, 0,
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine); SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
SCM SCM
scm_m_undefine (x, env) scm_m_undefine (SCM x, SCM env)
SCM x, env;
{ {
SCM arg1 = x; SCM arg1 = x;
x = SCM_CDR (x); x = SCM_CDR (x);

3
libguile/feature.c
View file

@ -62,8 +62,7 @@
static SCM *scm_loc_features; static SCM *scm_loc_features;
void void
scm_add_feature (str) scm_add_feature (const char *str)
const char* str;
{ {
*scm_loc_features = scm_cons (SCM_CAR (scm_intern (str, strlen (str))), *scm_loc_features = scm_cons (SCM_CAR (scm_intern (str, strlen (str))),
*scm_loc_features); *scm_loc_features);

3
libguile/fluids.c
View file

@ -90,8 +90,7 @@ grow_fluids (scm_root_state *root_state,int new_length)
} }
void void
scm_copy_fluids (root_state) scm_copy_fluids (scm_root_state *root_state)
scm_root_state *root_state;
{ {
grow_fluids (root_state, SCM_LENGTH(root_state->fluids)); grow_fluids (root_state, SCM_LENGTH(root_state->fluids));
} }

3
libguile/fports.c
View file

@ -186,8 +186,7 @@ GUILE_PROC (scm_setvbuf, "setvbuf", 2, 1, 0,
*/ */
void void
scm_evict_ports (fd) scm_evict_ports (int fd)
int fd;
{ {
int i; int i;

37
libguile/gc.c
View file

@ -389,8 +389,7 @@ GUILE_PROC (scm_gc_stats, "gc-stats", 0, 0, 0,
void void
scm_gc_start (what) scm_gc_start (const char *what)
const char *what;
{ {
scm_gc_rt = SCM_INUM (scm_get_internal_run_time ()); scm_gc_rt = SCM_INUM (scm_get_internal_run_time ());
scm_gc_cells_collected = 0; scm_gc_cells_collected = 0;
@ -912,9 +911,7 @@ gc_mark_nimp:
*/ */
void void
scm_mark_locations (x, n) scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
SCM_STACKITEM x[];
scm_sizet n;
{ {
register long m = n; register long m = n;
register int i, j; register int i, j;
@ -981,8 +978,7 @@ scm_mark_locations (x, n)
int int
scm_cellp (value) scm_cellp (SCM value)
SCM value;
{ {
register int i, j; register int i, j;
register SCM_CELLPTR ptr; register SCM_CELLPTR ptr;
@ -1553,8 +1549,7 @@ scm_must_free (void *obj)
* value. */ * value. */
void void
scm_done_malloc (size) scm_done_malloc (long size)
long size;
{ {
scm_mallocated += size; scm_mallocated += size;
@ -1615,11 +1610,7 @@ unsigned long scm_heap_size = 0;
static scm_sizet static scm_sizet
init_heap_seg (seg_org, size, ncells, freelistp) init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, int ncells, SCM *freelistp)
SCM_CELLPTR seg_org;
scm_sizet size;
int ncells;
SCM *freelistp;
{ {
register SCM_CELLPTR ptr; register SCM_CELLPTR ptr;
#ifdef SCM_POINTERS_MUNGED #ifdef SCM_POINTERS_MUNGED
@ -1701,9 +1692,7 @@ init_heap_seg (seg_org, size, ncells, freelistp)
static void static void
alloc_some_heap (ncells, freelistp) alloc_some_heap (int ncells, SCM *freelistp)
int ncells;
SCM * freelistp;
{ {
struct scm_heap_seg_data * tmptable; struct scm_heap_seg_data * tmptable;
SCM_CELLPTR ptr; SCM_CELLPTR ptr;
@ -1813,9 +1802,8 @@ GUILE_PROC (scm_unhash_name, "unhash-name", 1, 0, 0,
void void
scm_remember (ptr) scm_remember (SCM *ptr)
SCM * ptr; { /* empty */ }
{}
SCM SCM
@ -1826,8 +1814,7 @@ scm_return_first (SCM elt, ...)
SCM SCM
scm_permanent_object (obj) scm_permanent_object (SCM obj)
SCM obj;
{ {
SCM_REDEFER_INTS; SCM_REDEFER_INTS;
scm_permobjs = scm_cons (obj, scm_permobjs); scm_permobjs = scm_cons (obj, scm_permobjs);
@ -1853,8 +1840,7 @@ scm_permanent_object (obj)
scm_unprotect_object removes the first occurrence of its argument scm_unprotect_object removes the first occurrence of its argument
to the list. */ to the list. */
SCM SCM
scm_protect_object (obj) scm_protect_object (SCM obj)
SCM obj;
{ {
scm_protects = scm_cons (obj, scm_protects); scm_protects = scm_cons (obj, scm_protects);
@ -1867,8 +1853,7 @@ scm_protect_object (obj)
See scm_protect_object for more information. */ See scm_protect_object for more information. */
SCM SCM
scm_unprotect_object (obj) scm_unprotect_object (SCM obj)
SCM obj;
{ {
SCM *tail_ptr = &scm_protects; SCM *tail_ptr = &scm_protects;

16
libguile/gdbint.c
View file

@ -163,8 +163,7 @@ remark_port (SCM port)
int int
gdb_maybe_valid_type_p (value) gdb_maybe_valid_type_p (SCM value)
SCM value;
{ {
if (SCM_IMP (value) || scm_cellp (value)) if (SCM_IMP (value) || scm_cellp (value))
return scm_tag (value) != SCM_MAKINUM (-1); return scm_tag (value) != SCM_MAKINUM (-1);
@ -173,8 +172,7 @@ gdb_maybe_valid_type_p (value)
int int
gdb_read (str) gdb_read (char *str)
char *str;
{ {
SCM ans; SCM ans;
int status = 0; int status = 0;
@ -239,8 +237,7 @@ exit:
int int
gdb_eval (exp) gdb_eval (SCM exp)
SCM exp;
{ {
RESET_STRING; RESET_STRING;
if (SCM_IMP (exp)) if (SCM_IMP (exp))
@ -264,8 +261,7 @@ gdb_eval (exp)
int int
gdb_print (obj) gdb_print (SCM obj)
SCM obj;
{ {
RESET_STRING; RESET_STRING;
SCM_BEGIN_FOREIGN_BLOCK; SCM_BEGIN_FOREIGN_BLOCK;
@ -286,9 +282,7 @@ gdb_print (obj)
int int
gdb_binding (name, value) gdb_binding (SCM name, SCM value)
SCM name;
SCM value;
{ {
RESET_STRING; RESET_STRING;
if (SCM_GC_P) if (SCM_GC_P)

10
libguile/inet_aton.c
View file

@ -31,6 +31,9 @@
* SUCH DAMAGE. * SUCH DAMAGE.
*/ */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#if defined(LIBC_SCCS) && !defined(lint) #if defined(LIBC_SCCS) && !defined(lint)
static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93"; static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93";
#endif /* LIBC_SCCS and not lint */ #endif /* LIBC_SCCS and not lint */
@ -48,8 +51,7 @@ static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93";
* The value returned is in network order. * The value returned is in network order.
*/ */
u_long u_long
inet_addr(cp) inet_addr(const char *cp)
register const char *cp;
{ {
struct in_addr val; struct in_addr val;
@ -72,9 +74,7 @@ int inet_aton (const char *cp, struct in_addr *addr);
* This replaces inet_addr, the return value from which * This replaces inet_addr, the return value from which
* cannot distinguish between failure and a local broadcast address. */ * cannot distinguish between failure and a local broadcast address. */
int int
inet_aton(cp_arg, addr) inet_aton(const char *cp_arg, struct in_addr *addr)
const char *cp_arg;
struct in_addr *addr;
{ {
register unsigned long val; register unsigned long val;
register int base, n; register int base, n;

13
libguile/init.c
View file

@ -376,11 +376,7 @@ static SCM invoke_main_func(void *body_data);
void void
scm_boot_guile (argc, argv, main_func, closure) scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
int argc;
char ** argv;
void (*main_func) ();
void *closure;
{ {
/* The garbage collector uses the address of this variable as one /* The garbage collector uses the address of this variable as one
end of the stack, and the address of one of its own local end of the stack, and the address of one of its own local
@ -405,9 +401,7 @@ scm_boot_guile (argc, argv, main_func, closure)
int scm_boot_guile_1_live = 0; int scm_boot_guile_1_live = 0;
static void static void
scm_boot_guile_1 (base, closure) scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
SCM_STACKITEM *base;
struct main_func_closure *closure;
{ {
static int initialized = 0; static int initialized = 0;
/* static int live = 0; */ /* static int live = 0; */
@ -558,8 +552,7 @@ scm_boot_guile_1 (base, closure)
static SCM static SCM
invoke_main_func (body_data) invoke_main_func (void *body_data)
void *body_data;
{ {
struct main_func_closure *closure = (struct main_func_closure *) body_data; struct main_func_closure *closure = (struct main_func_closure *) body_data;

3
libguile/mallocs.c
View file

@ -65,8 +65,7 @@ int scm_tc16_malloc;
SCM SCM
scm_malloc_obj (n) scm_malloc_obj (scm_sizet n)
scm_sizet n;
{ {
SCM mem; SCM mem;

8
libguile/memmove.c
View file

@ -1,6 +1,9 @@
/* Wrapper to implement ANSI C's memmove using BSD's bcopy. */ /* Wrapper to implement ANSI C's memmove using BSD's bcopy. */
/* This function is in the public domain. --Per Bothner. */ /* This function is in the public domain. --Per Bothner. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <sys/types.h> #include <sys/types.h>
#ifdef __STDC__ #ifdef __STDC__
@ -14,10 +17,7 @@ PTR memmove ();
#endif #endif
PTR PTR
memmove (s1, s2, n) memmove (PTR s1, CPTR s2, size_t n)
PTR s1;
CPTR s2;
size_t n;
{ {
bcopy (s2, s1, n); bcopy (s2, s1, n);
return s1; return s1;

7
libguile/modules.c
View file

@ -38,6 +38,10 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */ * If you do not wish that, delete this exception notice. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include "_scm.h" #include "_scm.h"
@ -136,8 +140,7 @@ scm_load_scheme_module (SCM name)
*/ */
SCM SCM
scm_top_level_env (thunk) scm_top_level_env (SCM thunk)
SCM thunk;
{ {
if (SCM_IMP (thunk)) if (SCM_IMP (thunk))
return SCM_EOL; return SCM_EOL;

139
libguile/numbers.c
View file

@ -149,8 +149,7 @@ GUILE_PROC (scm_even_p, "even?", 1, 0, 0,
SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs); SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs);
SCM SCM
scm_abs (x) scm_abs (SCM x)
SCM x;
{ {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
@ -178,9 +177,7 @@ scm_abs (x)
SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient); SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient);
SCM SCM
scm_quotient (x, y) scm_quotient (SCM x, SCM y)
SCM x;
SCM y;
{ {
register long z; register long z;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
@ -270,9 +267,7 @@ scm_quotient (x, y)
SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder); SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder);
SCM SCM
scm_remainder (x, y) scm_remainder (SCM x, SCM y)
SCM x;
SCM y;
{ {
register long z; register long z;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
@ -329,9 +324,7 @@ scm_remainder (x, y)
SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo); SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo);
SCM SCM
scm_modulo (x, y) scm_modulo (SCM x, SCM y)
SCM x;
SCM y;
{ {
register long yy, z; register long yy, z;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
@ -382,9 +375,7 @@ scm_modulo (x, y)
SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd); SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
SCM SCM
scm_gcd (x, y) scm_gcd (SCM x, SCM y)
SCM x;
SCM y;
{ {
register long u, v, k, t; register long u, v, k, t;
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
@ -481,9 +472,7 @@ scm_gcd (x, y)
SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm); SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm);
SCM SCM
scm_lcm (n1, n2) scm_lcm (SCM n1, SCM n2)
SCM n1;
SCM n2;
{ {
SCM d; SCM d;
#ifndef SCM_BIGDIG #ifndef SCM_BIGDIG
@ -2556,9 +2545,7 @@ GUILE_PROC (scm_inexact_p, "inexact?", 1, 0, 0,
SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p); SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p);
SCM SCM
scm_num_eq_p (x, y) scm_num_eq_p (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
SCM t; SCM t;
@ -2672,9 +2659,7 @@ scm_num_eq_p (x, y)
SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p); SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p);
SCM SCM
scm_less_p (x, y) scm_less_p (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
@ -2803,8 +2788,7 @@ GUILE_PROC1 (scm_geq_p, ">=", scm_tc7_rpsubr,
SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p); SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p);
SCM SCM
scm_zero_p (z) scm_zero_p (SCM z)
SCM z;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NINUMP (z)) if (SCM_NINUMP (z))
@ -2844,8 +2828,7 @@ scm_zero_p (z)
SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p); SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p);
SCM SCM
scm_positive_p (x) scm_positive_p (SCM x)
SCM x;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
@ -2885,8 +2868,7 @@ scm_positive_p (x)
SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p); SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p);
SCM SCM
scm_negative_p (x) scm_negative_p (SCM x)
SCM x;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
@ -2925,9 +2907,7 @@ scm_negative_p (x)
SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max); SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max);
SCM SCM
scm_max (x, y) scm_max (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
double z; double z;
@ -3036,9 +3016,7 @@ scm_max (x, y)
SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min); SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
SCM SCM
scm_min (x, y) scm_min (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
double z; double z;
@ -3147,9 +3125,7 @@ scm_min (x, y)
SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum); SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum);
SCM SCM
scm_sum (x, y) scm_sum (SCM x, SCM y)
SCM x;
SCM y;
{ {
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
{ {
@ -3334,9 +3310,7 @@ scm_sum (x, y)
SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference); SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference);
SCM SCM
scm_difference (x, y) scm_difference (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
if (SCM_NINUMP (x)) if (SCM_NINUMP (x))
@ -3538,9 +3512,7 @@ scm_difference (x, y)
SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product); SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product);
SCM SCM
scm_product (x, y) scm_product (SCM x, SCM y)
SCM x;
SCM y;
{ {
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
{ {
@ -3753,9 +3725,7 @@ scm_product (x, y)
double double
scm_num2dbl (a, why) scm_num2dbl (SCM a, const char *why)
SCM a;
const char *why;
{ {
if (SCM_INUMP (a)) if (SCM_INUMP (a))
return (double) SCM_INUM (a); return (double) SCM_INUM (a);
@ -3775,9 +3745,7 @@ scm_num2dbl (a, why)
SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide); SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide);
SCM SCM
scm_divide (x, y) scm_divide (SCM x, SCM y)
SCM x;
SCM y;
{ {
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
double d, r, i, a; double d, r, i, a;
@ -4039,8 +4007,7 @@ scm_divide (x, y)
SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh); SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh);
double double
scm_asinh (x) scm_asinh (double x)
double x;
{ {
return log (x + sqrt (x * x + 1)); return log (x + sqrt (x * x + 1));
} }
@ -4051,8 +4018,7 @@ scm_asinh (x)
SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh, g_acosh); SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh, g_acosh);
double double
scm_acosh (x) scm_acosh (double x)
double x;
{ {
return log (x + sqrt (x * x - 1)); return log (x + sqrt (x * x - 1));
} }
@ -4063,8 +4029,7 @@ scm_acosh (x)
SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh, g_atanh); SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh, g_atanh);
double double
scm_atanh (x) scm_atanh (double x)
double x;
{ {
return 0.5 * log ((1 + x) / (1 - x)); return 0.5 * log ((1 + x) / (1 - x));
} }
@ -4075,8 +4040,7 @@ scm_atanh (x)
SCM_GPROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate, g_truncate); SCM_GPROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate, g_truncate);
double double
scm_truncate (x) scm_truncate (double x)
double x;
{ {
if (x < 0.0) if (x < 0.0)
return -floor (-x); return -floor (-x);
@ -4088,8 +4052,7 @@ scm_truncate (x)
SCM_GPROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round, g_round); SCM_GPROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round, g_round);
double double
scm_round (x) scm_round (double x)
double x;
{ {
double plus_half = x + 0.5; double plus_half = x + 0.5;
double result = floor (plus_half); double result = floor (plus_half);
@ -4103,8 +4066,7 @@ scm_round (x)
SCM_GPROC1 (s_exact_to_inexact, "exact->inexact", scm_tc7_cxr, (SCM (*)()) scm_exact_to_inexact, g_exact_to_inexact); SCM_GPROC1 (s_exact_to_inexact, "exact->inexact", scm_tc7_cxr, (SCM (*)()) scm_exact_to_inexact, g_exact_to_inexact);
double double
scm_exact_to_inexact (z) scm_exact_to_inexact (double z)
double z;
{ {
return z; return z;
} }
@ -4137,10 +4099,7 @@ static void scm_two_doubles (SCM z1,
struct dpair * xy); struct dpair * xy);
static void static void
scm_two_doubles (z1, z2, sstring, xy) scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
SCM z1, z2;
const char *sstring;
struct dpair *xy;
{ {
if (SCM_INUMP (z1)) if (SCM_INUMP (z1))
xy->x = SCM_INUM (z1); xy->x = SCM_INUM (z1);
@ -4249,8 +4208,7 @@ GUILE_PROC (scm_make_polar, "make-polar", 2, 0, 0,
SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part); SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part);
SCM SCM
scm_real_part (z) scm_real_part (SCM z)
SCM z;
{ {
if (SCM_NINUMP (z)) if (SCM_NINUMP (z))
{ {
@ -4278,8 +4236,7 @@ scm_real_part (z)
SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part); SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part);
SCM SCM
scm_imag_part (z) scm_imag_part (SCM z)
SCM z;
{ {
if (SCM_INUMP (z)) if (SCM_INUMP (z))
return SCM_INUM0; return SCM_INUM0;
@ -4306,8 +4263,7 @@ scm_imag_part (z)
SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude); SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude);
SCM SCM
scm_magnitude (z) scm_magnitude (SCM z)
SCM z;
{ {
if (SCM_INUMP (z)) if (SCM_INUMP (z))
return scm_abs (z); return scm_abs (z);
@ -4338,8 +4294,7 @@ scm_magnitude (z)
SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle); SCM_GPROC (s_angle, "angle", 1, 0, 0, scm_angle, g_angle);
SCM SCM
scm_angle (z) scm_angle (SCM z)
SCM z;
{ {
double x, y = 0.0; double x, y = 0.0;
if (SCM_INUMP (z)) if (SCM_INUMP (z))
@ -4420,8 +4375,7 @@ GUILE_PROC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
SCM_GPROC (s_trunc, "truncate", 1, 0, 0, scm_trunc, g_trunc); SCM_GPROC (s_trunc, "truncate", 1, 0, 0, scm_trunc, g_trunc);
SCM SCM
scm_trunc (x) scm_trunc (SCM x)
SCM x;
{ {
SCM_GASSERT2 (SCM_INUMP (x), g_trunc, x, y, SCM_ARG1, s_truncate); SCM_GASSERT2 (SCM_INUMP (x), g_trunc, x, y, SCM_ARG1, s_truncate);
return x; return x;
@ -4436,8 +4390,7 @@ scm_trunc (x)
/* d must be integer */ /* d must be integer */
SCM SCM
scm_dbl2big (d) scm_dbl2big (double d)
double d;
{ {
scm_sizet i = 0; scm_sizet i = 0;
long c; long c;
@ -4468,8 +4421,7 @@ scm_dbl2big (d)
double double
scm_big2dbl (b) scm_big2dbl (SCM b)
SCM b;
{ {
double ans = 0.0; double ans = 0.0;
scm_sizet i = SCM_NUMDIGS (b); scm_sizet i = SCM_NUMDIGS (b);
@ -4485,8 +4437,7 @@ scm_big2dbl (b)
SCM SCM
scm_long2num (sl) scm_long2num (long sl)
long sl;
{ {
if (!SCM_FIXABLE (sl)) if (!SCM_FIXABLE (sl))
{ {
@ -4507,8 +4458,7 @@ scm_long2num (sl)
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
SCM SCM
scm_long_long2num (sl) scm_long_long2num (long_long sl)
long_long sl;
{ {
if (!SCM_FIXABLE (sl)) if (!SCM_FIXABLE (sl))
{ {
@ -4529,8 +4479,7 @@ scm_long_long2num (sl)
SCM SCM
scm_ulong2num (sl) scm_ulong2num (unsigned long sl)
unsigned long sl;
{ {
if (!SCM_POSFIXABLE (sl)) if (!SCM_POSFIXABLE (sl))
{ {
@ -4549,10 +4498,7 @@ scm_ulong2num (sl)
long long
scm_num2long (num, pos, s_caller) scm_num2long (SCM num, char *pos, const char *s_caller)
SCM num;
char *pos;
const char *s_caller;
{ {
long res; long res;
@ -4615,10 +4561,7 @@ scm_num2long (num, pos, s_caller)
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
long_long long_long
scm_num2long_long (num, pos, s_caller) scm_num2long_long (SCM num, char *pos, const char *s_caller)
SCM num;
char *pos;
const char *s_caller;
{ {
long_long res; long_long res;
@ -4681,10 +4624,7 @@ scm_num2long_long (num, pos, s_caller)
unsigned long unsigned long
scm_num2ulong (num, pos, s_caller) scm_num2ulong (SCM num, char *pos, const char *s_caller)
SCM num;
char *pos;
const char *s_caller;
{ {
unsigned long res; unsigned long res;
@ -4734,8 +4674,7 @@ scm_num2ulong (num, pos, s_caller)
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
#ifndef DBL_DIG #ifndef DBL_DIG
static void static void
add1 (f, fsum) add1 (double f, double *fsum)
double f, *fsum;
{ {
*fsum = f + 1.0; *fsum = f + 1.0;
} }

15
libguile/options.c
View file

@ -41,6 +41,10 @@
* *
* The author can be reached at djurfeldt@nada.kth.se * The author can be reached at djurfeldt@nada.kth.se
* Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */ * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h> #include <stdio.h>
@ -117,11 +121,7 @@ SCM_SYMBOL (scm_no_sym, "no");
static SCM protected_objects; static SCM protected_objects;
SCM SCM
scm_options (arg, options, n, s) scm_options (SCM arg, scm_option options[], int n, const char *s)
SCM arg;
scm_option options[];
int n;
const char *s;
{ {
int i, docp = (!SCM_UNBNDP (arg) int i, docp = (!SCM_UNBNDP (arg)
&& !SCM_NULLP (arg) && !SCM_NULLP (arg)
@ -213,10 +213,7 @@ scm_options (arg, options, n, s)
void void
scm_init_opts (func, options, n) scm_init_opts (SCM (*func) (SCM), scm_option options[], int n)
SCM (*func) (SCM);
scm_option options[];
int n;
{ {
int i; int i;

3
libguile/print.c
View file

@ -227,8 +227,7 @@ scm_make_print_state ()
} }
void void
scm_free_print_state (print_state) scm_free_print_state (SCM print_state)
SCM print_state;
{ {
SCM handle; SCM handle;
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);

6
libguile/putenv.c
View file

@ -15,6 +15,9 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA */ USA */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#ifdef HAVE_CONFIG_H #ifdef HAVE_CONFIG_H
#include "libguile/scmconfig.h" #include "libguile/scmconfig.h"
#endif #endif
@ -59,8 +62,7 @@ extern char **environ;
/* Put STRING, which is of the form "NAME=VALUE", in the environment. */ /* Put STRING, which is of the form "NAME=VALUE", in the environment. */
int int
putenv (string) putenv (const char *string)
const char *string;
{ {
char *name_end = strchr (string, '='); char *name_end = strchr (string, '=');
register size_t size; register size_t size;

4
libguile/ramap.c
View file

@ -142,9 +142,7 @@ cind (SCM ra, SCM inds)
*/ */
int int
scm_ra_matchp (ra0, ras) scm_ra_matchp (SCM ra0, SCM ras)
SCM ra0;
SCM ras;
{ {
SCM ra1; SCM ra1;
scm_array_dim dims; scm_array_dim dims;

35
libguile/read.c
View file

@ -117,8 +117,7 @@ GUILE_PROC (scm_read, "read", 0, 1, 0,
char * char *
scm_grow_tok_buf (tok_buf) scm_grow_tok_buf (SCM *tok_buf)
SCM * tok_buf;
{ {
scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf))); scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf)));
return SCM_CHARS (*tok_buf); return SCM_CHARS (*tok_buf);
@ -127,9 +126,7 @@ scm_grow_tok_buf (tok_buf)
int int
scm_flush_ws (port, eoferr) scm_flush_ws (SCM port, const char *eoferr)
SCM port;
const char *eoferr;
{ {
register int c; register int c;
while (1) while (1)
@ -164,9 +161,7 @@ scm_flush_ws (port, eoferr)
int int
scm_casei_streq (s1, s2) scm_casei_streq (char *s1, char *s2)
char * s1;
char * s2;
{ {
while (*s1 && *s2) while (*s1 && *s2)
if (scm_downcase((int)*s1) != scm_downcase((int)*s2)) if (scm_downcase((int)*s1) != scm_downcase((int)*s2))
@ -238,8 +233,7 @@ recsexpr (SCM obj,int line,int column,SCM filename)
newline/exclamation-point/sharp-sign/newline sequence. */ newline/exclamation-point/sharp-sign/newline sequence. */
static void static void
skip_scsh_block_comment (port) skip_scsh_block_comment (SCM port)
SCM port;
{ {
/* Is this portable? Dear God, spare me from the non-eight-bit /* Is this portable? Dear God, spare me from the non-eight-bit
characters. But is it tasteful? */ characters. But is it tasteful? */
@ -517,11 +511,7 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */
#endif #endif
scm_sizet scm_sizet
scm_read_token (ic, tok_buf, port, weird) scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
int ic;
SCM *tok_buf;
SCM port;
int weird;
{ {
register scm_sizet j; register scm_sizet j;
register int c; register int c;
@ -607,11 +597,7 @@ _Pragma ("opt"); /* # pragma _CRI opt */
#endif #endif
SCM SCM
scm_lreadparen (tok_buf, port, name, copy) scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
SCM *tok_buf;
SCM port;
char *name;
SCM *copy;
{ {
SCM tmp; SCM tmp;
SCM tl; SCM tl;
@ -647,11 +633,7 @@ scm_lreadparen (tok_buf, port, name, copy)
SCM SCM
scm_lreadrecparen (tok_buf, port, name, copy) scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
SCM *tok_buf;
SCM port;
char *name;
SCM *copy;
{ {
register int c; register int c;
register SCM tmp; register SCM tmp;
@ -777,8 +759,7 @@ GUILE_PROC (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
/* Recover the read-hash procedure corresponding to char c. */ /* Recover the read-hash procedure corresponding to char c. */
static SCM static SCM
scm_get_hash_procedure (c) scm_get_hash_procedure (int c)
int c;
{ {
SCM rest = *scm_read_hash_procedures; SCM rest = *scm_read_hash_procedures;

18
libguile/scm_validate.h
View file

@ -1,4 +1,4 @@
/* $Id: scm_validate.h,v 1.4 1999-12-12 19:09:46 gjb Exp $ */ /* $Id: scm_validate.h,v 1.5 1999-12-12 20:35:02 gjb Exp $ */
/* Copyright (C) 1999 Free Software Foundation, Inc. /* Copyright (C) 1999 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
@ -85,20 +85,24 @@
#define SCM_MUST_MALLOC(size) (scm_must_malloc((size), FUNC_NAME)) #define SCM_MUST_MALLOC(size) (scm_must_malloc((size), FUNC_NAME))
#define SCM_VALIDATE_NIM(pos,scm) \
do { SCM_ASSERT(SCM_NIMP(scm), scm, pos, FUNC_NAME); } while (0)
#define SCM_MAKE_NIM_VALIDATE(pos,var,pred) \ #define SCM_MAKE_NIM_VALIDATE(pos,var,pred) \
do { SCM_ASSERT (SCM_NIMP(var) && SCM ## pred(var), var, pos, FUNC_NAME); } while (0) do { SCM_ASSERT (SCM_NIMP(var) && SCM ## pred(var), var, pos, FUNC_NAME); } while (0)
#define SCM_MAKE_VALIDATE(pos,var,pred) \ #define SCM_MAKE_VALIDATE(pos,var,pred) \
do { SCM_ASSERT (SCM ## pred(var), var, pos, FUNC_NAME); } while (0) do { SCM_ASSERT (SCM ## pred(var), var, pos, FUNC_NAME); } while (0)
#ifndef SCM_DOCSTRING_SNARF
#define SCM_VALIDATE_NIM(pos,scm) \
do { SCM_ASSERT(SCM_NIMP(scm), scm, pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_BOOL(pos,flag) \ #define SCM_VALIDATE_BOOL(pos,flag) \
do { SCM_ASSERT(SCM_BOOL_T == flag || SCM_BOOL_F == flag, flag, pos, FUNC_NAME); } while (0) do { SCM_ASSERT(SCM_BOOLP(flag), pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_BOOL_COPY(pos,flag,cvar) \ #define SCM_VALIDATE_BOOL_COPY(pos,flag,cvar) \
do { SCM_ASSERT(SCM_BOOL_T == flag || SCM_BOOL_F == flag, flag, pos, FUNC_NAME); \ do { SCM_ASSERT(SCM_BOOLP(flags), flag, pos, FUNC_NAME); \
cvar = (SCM_BOOL_T == flag)? 1: 0; } while (0) cvar = (SCM_BOOL_T == flag)? 1: 0; } while (0)
#define SCM_VALIDATE_CHAR(pos,scm) \ #define SCM_VALIDATE_CHAR(pos,scm) \
@ -306,3 +310,5 @@
do { SCM_ASSERT (SCM_NIMP (v) && SCM_VECTORP (v) && len == SCM_LENGTH(v), v, pos, FUNC_NAME); } while (0) do { SCM_ASSERT (SCM_NIMP (v) && SCM_VECTORP (v) && len == SCM_LENGTH(v), v, pos, FUNC_NAME); } while (0)
#endif #endif
#endif

38
libguile/script.c
View file

@ -41,6 +41,9 @@
/* "script.c" argv tricks for `#!' scripts. /* "script.c" argv tricks for `#!' scripts.
Authors: Aubrey Jaffer and Jim Blandy */ Authors: Aubrey Jaffer and Jim Blandy */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h> #include <stdio.h>
#include <ctype.h> #include <ctype.h>
#include "_scm.h" #include "_scm.h"
@ -58,10 +61,7 @@
string if file exists; 0 otherwise. */ string if file exists; 0 otherwise. */
static char * static char *
scm_cat_path (str1, str2, n) scm_cat_path (char *str1, const char *str2, long n)
char *str1;
const char *str2;
long n;
{ {
if (!n) if (!n)
n = strlen (str2); n = strlen (str2);
@ -84,8 +84,7 @@ scm_cat_path (str1, str2, n)
#if 0 #if 0
static char * static char *
scm_try_path (path) scm_try_path (char *path)
char *path;
{ {
FILE *f; FILE *f;
/* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */ /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
@ -103,9 +102,7 @@ scm_try_path (path)
} }
static char * static char *
scm_sep_init_try (path, sep, initname) scm_sep_init_try (char *path, const char *sep, const char *initname)
char *path;
const char *sep, *initname;
{ {
if (path) if (path)
path = scm_cat_path (path, sep, 0L); path = scm_cat_path (path, sep, 0L);
@ -166,8 +163,7 @@ scm_find_executable (const char *name)
/* Read a \nnn-style escape. We've just read the backslash. */ /* Read a \nnn-style escape. We've just read the backslash. */
static int static int
script_get_octal (f) script_get_octal (FILE *f)
FILE *f;
{ {
int i; int i;
int value = 0; int value = 0;
@ -187,8 +183,7 @@ script_get_octal (f)
static int static int
script_get_backslash (f) script_get_backslash (FILE *f)
FILE *f;
{ {
int c = getc (f); int c = getc (f);
@ -229,8 +224,7 @@ script_get_backslash (f)
static char * static char *
script_read_arg (f) script_read_arg (FILE *f)
FILE *f;
{ {
int size = 7; int size = 7;
char *buf = malloc (size + 1); char *buf = malloc (size + 1);
@ -287,8 +281,7 @@ script_read_arg (f)
static int static int
script_meta_arg_P (arg) script_meta_arg_P (char *arg)
char *arg;
{ {
if ('\\' != arg[0]) if ('\\' != arg[0])
return 0L; return 0L;
@ -308,9 +301,7 @@ script_meta_arg_P (arg)
} }
char ** char **
scm_get_meta_args (argc, argv) scm_get_meta_args (int argc, char **argv)
int argc;
char **argv;
{ {
int nargc = argc, argi = 1, nargi = 1; int nargc = argc, argi = 1, nargi = 1;
char *narg, **nargv; char *narg, **nargv;
@ -352,8 +343,7 @@ scm_get_meta_args (argc, argv)
} }
int int
scm_count_argv (argv) scm_count_argv (char **argv)
char **argv;
{ {
int argc = 0; int argc = 0;
while (argv[argc]) while (argv[argc])
@ -626,9 +616,7 @@ scm_compile_shell_switches (int argc, char **argv)
void void
scm_shell (argc, argv) scm_shell (int argc, char **argv)
int argc;
char **argv;
{ {
/* If present, add SCSH-style meta-arguments from the top of the /* If present, add SCSH-style meta-arguments from the top of the
script file to the argument vector. See the SCSH manual: "The script file to the argument vector. See the SCSH manual: "The

9
libguile/smob.c
View file

@ -79,15 +79,13 @@ scm_smob_descriptor *scm_smobs;
to make their links fail. */ to make their links fail. */
SCM SCM
scm_mark0 (ptr) scm_mark0 (SCM ptr)
SCM ptr;
{ {
return SCM_BOOL_F; return SCM_BOOL_F;
} }
SCM SCM
scm_markcdr (ptr) scm_markcdr (SCM ptr)
SCM ptr;
{ {
return SCM_CDR (ptr); return SCM_CDR (ptr);
} }
@ -96,8 +94,7 @@ scm_markcdr (ptr)
*/ */
scm_sizet scm_sizet
scm_free0 (ptr) scm_free0 (SCM ptr)
SCM ptr;
{ {
return 0; return 0;
} }

17
libguile/snarf.h
View file

@ -60,8 +60,6 @@ SCM FNAME ARGLIST
static const char s_ ## FNAME [] = PRIMNAME; \ static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST SCM FNAME ARGLIST
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
static const char RANAME[]=STR
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
static const char RANAME[]=STR static const char RANAME[]=STR
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
@ -76,14 +74,17 @@ SCM FNAME ARGLIST
#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF) #if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
#define GUILE_PROC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ #define GUILE_PROC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
%%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM (*)(...)) FNAME); %%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM (*)(...)) FNAME); \
#define GUILE_PROC1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \ $$$ primname #ARGLIST req opt var @@@ docstring @!!!
%%% scm_make_subr (s_ ## FNAME, TYPE, FNAME);
#define GUILE_PROC1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
%%% scm_make_subr (s_ ## FNAME, TYPE, FNAME); \
$$1 primname #ARGLIST type @@@ docstring @!!!
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM (*)(...)) CFN)
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM (*)(...)) CFN) %%% scm_make_gsubr (RANAME, REQ, OPT, VAR, (SCM (*)(...)) CFN) \
$$R RANAMEprimname #ARGLIST type @@@ docstring @!!!
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
%%% scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM (*)(...))CFN, &GF) %%% scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM (*)(...))CFN, &GF)
#define SCM_PROC1(RANAME, STR, TYPE, CFN) \ #define SCM_PROC1(RANAME, STR, TYPE, CFN) \

7
libguile/stackchk.c
View file

@ -38,6 +38,10 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */ * If you do not wish that, delete this exception notice. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h> #include <stdio.h>
@ -69,8 +73,7 @@ scm_report_stack_overflow ()
#endif #endif
long long
scm_stack_size (start) scm_stack_size (SCM_STACKITEM *start)
SCM_STACKITEM *start;
{ {
SCM_STACKITEM stack; SCM_STACKITEM stack;
#ifdef SCM_STACK_GROWS_UP #ifdef SCM_STACK_GROWS_UP

5
libguile/strerror.c
View file

@ -18,10 +18,11 @@ along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */ Boston, MA 02111-1307, USA. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
char * char *
strerror (errnum) strerror (int errnum)
int errnum;
{ {
extern char *sys_errlist[]; extern char *sys_errlist[];
extern int sys_nerr; extern int sys_nerr;

131
libguile/strorder.c
View file

@ -38,26 +38,28 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */ * If you do not wish that, delete this exception notice. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h> #include <stdio.h>
#include "_scm.h" #include "_scm.h"
#include "chars.h" #include "chars.h"
#include "scm_validate.h"
#include "strorder.h" #include "strorder.h"
SCM_PROC1 (s_string_equal_p, "string=?", scm_tc7_rpsubr, scm_string_equal_p); GUILE_PROC1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_equal_p (s1, s2) #define FUNC_NAME s_scm_string_equal_p
SCM s1;
SCM s2;
{ {
register scm_sizet i; register scm_sizet i;
register unsigned char *c1, *c2; register unsigned char *c1, *c2;
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_equal_p); SCM_VALIDATE_ROSTRING(1,s1);
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_equal_p); SCM_VALIDATE_ROSTRING(2,s2);
i = SCM_ROLENGTH (s2); i = SCM_ROLENGTH (s2);
if (SCM_ROLENGTH (s1) != i) if (SCM_ROLENGTH (s1) != i)
@ -71,18 +73,18 @@ scm_string_equal_p (s1, s2)
return SCM_BOOL_F; return SCM_BOOL_F;
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, scm_string_ci_equal_p); GUILE_PROC1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_ci_equal_p (s1, s2) #define FUNC_NAME s_scm_string_ci_equal_p
SCM s1;
SCM s2;
{ {
register scm_sizet i; register scm_sizet i;
register unsigned char *c1, *c2; register unsigned char *c1, *c2;
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_equal_p); SCM_VALIDATE_ROSTRING(1,s1);
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_equal_p); SCM_VALIDATE_ROSTRING(2,s2);
i = SCM_ROLENGTH (s2); i = SCM_ROLENGTH (s2);
if (SCM_ROLENGTH (s1) != i) if (SCM_ROLENGTH (s1) != i)
{ {
@ -95,20 +97,19 @@ scm_string_ci_equal_p (s1, s2)
return SCM_BOOL_F; return SCM_BOOL_F;
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_less_p, "string<?", scm_tc7_rpsubr, scm_string_less_p); GUILE_PROC1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_less_p (s1, s2) #define FUNC_NAME s_scm_string_less_p
SCM s1;
SCM s2;
{ {
register scm_sizet i, len, s2len; register scm_sizet i, len, s2len;
register unsigned char *c1, *c2; register unsigned char *c1, *c2;
register int c; register int c;
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_less_p); SCM_VALIDATE_ROSTRING(1,s1);
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_less_p); SCM_VALIDATE_ROSTRING(2,s2);
len = SCM_ROLENGTH (s1); len = SCM_ROLENGTH (s1);
s2len = SCM_ROLENGTH (s2); s2len = SCM_ROLENGTH (s2);
if (len>s2len) len = s2len; if (len>s2len) len = s2len;
@ -128,49 +129,45 @@ scm_string_less_p (s1, s2)
return answer; return answer;
} }
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_leq_p, "string<=?", scm_tc7_rpsubr, scm_string_leq_p); GUILE_PROC1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_leq_p (s1, s2) #define FUNC_NAME s_scm_string_leq_p
SCM s1;
SCM s2;
{ {
return SCM_BOOL_NOT (scm_string_less_p (s2, s1)); return SCM_BOOL_NOT (scm_string_less_p (s2, s1));
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_gr_p, "string>?", scm_tc7_rpsubr, scm_string_gr_p); GUILE_PROC1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_gr_p (s1, s2) #define FUNC_NAME s_scm_string_gr_p
SCM s1;
SCM s2;
{ {
return scm_string_less_p (s2, s1); return scm_string_less_p (s2, s1);
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_geq_p, "string>=?", scm_tc7_rpsubr, scm_string_geq_p); GUILE_PROC1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_geq_p (s1, s2) #define FUNC_NAME s_scm_string_geq_p
SCM s1;
SCM s2;
{ {
return SCM_BOOL_NOT (scm_string_less_p (s1, s2)); return SCM_BOOL_NOT (scm_string_less_p (s1, s2));
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, scm_string_ci_less_p); GUILE_PROC1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_ci_less_p (s1, s2) #define FUNC_NAME s_scm_string_ci_less_p
SCM s1;
SCM s2;
{ {
register scm_sizet i, len, s2len; register scm_sizet i, len, s2len;
register unsigned char *c1, *c2; register unsigned char *c1, *c2;
register int c; register int c;
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_less_p); SCM_VALIDATE_ROSTRING(1,s1);
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_less_p); SCM_VALIDATE_ROSTRING(2,s2);
len = SCM_ROLENGTH (s1); len = SCM_ROLENGTH (s1);
s2len = SCM_ROLENGTH (s2); s2len = SCM_ROLENGTH (s2);
if (len>s2len) len = s2len; if (len>s2len) len = s2len;
@ -183,36 +180,34 @@ scm_string_ci_less_p (s1, s2)
} }
return SCM_BOOL(s2len != len); return SCM_BOOL(s2len != len);
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, scm_string_ci_leq_p); GUILE_PROC1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_ci_leq_p (s1, s2) #define FUNC_NAME s_scm_string_ci_leq_p
SCM s1;
SCM s2;
{ {
return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1)); return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1));
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr, scm_string_ci_gr_p); GUILE_PROC1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_ci_gr_p (s1, s2) #define FUNC_NAME s_scm_string_ci_gr_p
SCM s1;
SCM s2;
{ {
return scm_string_ci_less_p (s2, s1); return scm_string_ci_less_p (s2, s1);
} }
#undef FUNC_NAME
SCM_PROC1 (s_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, scm_string_ci_geq_p); GUILE_PROC1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
(SCM s1, SCM s2),
SCM "")
scm_string_ci_geq_p (s1, s2) #define FUNC_NAME s_scm_string_ci_geq_p
SCM s1;
SCM s2;
{ {
return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2)); return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2));
} }
#undef FUNC_NAME

48
libguile/throw.c
View file

@ -183,12 +183,7 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
will be found. */ will be found. */
SCM SCM
scm_internal_catch (tag, body, body_data, handler, handler_data) scm_internal_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_catch_handler_t handler, void *handler_data)
SCM tag;
scm_catch_body_t body;
void *body_data;
scm_catch_handler_t handler;
void *handler_data;
{ {
struct jmp_buf_and_retval jbr; struct jmp_buf_and_retval jbr;
SCM jmpbuf; SCM jmpbuf;
@ -286,12 +281,7 @@ make_lazy_catch (struct lazy_catch *c)
- It does not unwind the stack (this is the major difference). - It does not unwind the stack (this is the major difference).
- If handler returns, its value is returned from the throw. */ - If handler returns, its value is returned from the throw. */
SCM SCM
scm_internal_lazy_catch (tag, body, body_data, handler, handler_data) scm_internal_lazy_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_catch_handler_t handler, void *handler_data)
SCM tag;
scm_catch_body_t body;
void *body_data;
scm_catch_handler_t handler;
void *handler_data;
{ {
SCM lazy_catch, answer; SCM lazy_catch, answer;
struct lazy_catch c; struct lazy_catch c;
@ -368,8 +358,7 @@ scm_internal_stack_catch (SCM tag,
we're catching. */ we're catching. */
SCM SCM
scm_body_thunk (body_data) scm_body_thunk (void *body_data)
void *body_data;
{ {
struct scm_body_thunk_data *c = (struct scm_body_thunk_data *) body_data; struct scm_body_thunk_data *c = (struct scm_body_thunk_data *) body_data;
@ -388,10 +377,7 @@ scm_body_thunk (body_data)
the stack), or the procedure object should be otherwise protected the stack), or the procedure object should be otherwise protected
from GC. */ from GC. */
SCM SCM
scm_handle_by_proc (handler_data, tag, throw_args) scm_handle_by_proc (void *handler_data, SCM tag, SCM throw_args)
void *handler_data;
SCM tag;
SCM throw_args;
{ {
SCM *handler_proc_p = (SCM *) handler_data; SCM *handler_proc_p = (SCM *) handler_data;
@ -408,18 +394,14 @@ struct hbpca_data {
}; };
static SCM static SCM
hbpca_body (body_data) hbpca_body (void *body_data)
void *body_data;
{ {
struct hbpca_data *data = (struct hbpca_data *)body_data; struct hbpca_data *data = (struct hbpca_data *)body_data;
return scm_apply (data->proc, data->args, SCM_EOL); return scm_apply (data->proc, data->args, SCM_EOL);
} }
SCM SCM
scm_handle_by_proc_catching_all (handler_data, tag, throw_args) scm_handle_by_proc_catching_all (void *handler_data, SCM tag, SCM throw_args)
void *handler_data;
SCM tag;
SCM throw_args;
{ {
SCM *handler_proc_p = (SCM *) handler_data; SCM *handler_proc_p = (SCM *) handler_data;
struct hbpca_data data; struct hbpca_data data;
@ -433,8 +415,7 @@ scm_handle_by_proc_catching_all (handler_data, tag, throw_args)
/* Derive the an exit status from the arguments to (quit ...). */ /* Derive the an exit status from the arguments to (quit ...). */
int int
scm_exit_status (args) scm_exit_status (SCM args)
SCM args;
{ {
if (SCM_NNULLP (args)) if (SCM_NNULLP (args))
{ {
@ -506,10 +487,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
text is followed by a colon, then the message described by ARGS. */ text is followed by a colon, then the message described by ARGS. */
SCM SCM
scm_handle_by_message (handler_data, tag, args) scm_handle_by_message (void *handler_data, SCM tag, SCM args)
void *handler_data;
SCM tag;
SCM args;
{ {
if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit"))))) if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit")))))
{ {
@ -529,10 +507,7 @@ scm_handle_by_message (handler_data, tag, args)
enough about the body to handle things in a better way, but don't enough about the body to handle things in a better way, but don't
want to let throws fall off the bottom of the wind list. */ want to let throws fall off the bottom of the wind list. */
SCM SCM
scm_handle_by_message_noexit (handler_data, tag, args) scm_handle_by_message_noexit (void *handler_data, SCM tag, SCM args)
void *handler_data;
SCM tag;
SCM args;
{ {
handler_message (handler_data, tag, args); handler_message (handler_data, tag, args);
@ -541,10 +516,7 @@ scm_handle_by_message_noexit (handler_data, tag, args)
SCM SCM
scm_handle_by_throw (handler_data, tag, args) scm_handle_by_throw (void *handler_data, SCM tag, SCM args)
void *handler_data;
SCM tag;
SCM args;
{ {
scm_ithrow (tag, args, 1); scm_ithrow (tag, args, 1);
return SCM_UNSPECIFIED; /* never returns */ return SCM_UNSPECIFIED; /* never returns */

9
libguile/unif.c
View file

@ -1088,10 +1088,7 @@ GUILE_PROC(scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
tries to recycle conses. (Make *sure* you want them recycled.) */ tries to recycle conses. (Make *sure* you want them recycled.) */
SCM SCM
scm_cvref (v, pos, last) scm_cvref (SCM v, scm_sizet pos, SCM last)
SCM v;
scm_sizet pos;
SCM last;
{ {
switch SCM_TYP7 (v) switch SCM_TYP7 (v)
{ {
@ -1345,9 +1342,7 @@ GUILE_PROC(scm_array_contents, "array-contents", 1, 1, 0,
SCM SCM
scm_ra2contig (ra, copy) scm_ra2contig (SCM ra, int copy)
SCM ra;
int copy;
{ {
SCM ret; SCM ret;
long inc = 1; long inc = 1;

8
libguile/vectors.c
View file

@ -135,8 +135,7 @@ GUILE_PROC(scm_vector_p, "vector?", 1, 0, 0,
SCM_GPROC(s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length); SCM_GPROC(s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length);
SCM SCM
scm_vector_length(v) scm_vector_length(SCM v)
SCM v;
{ {
SCM_GASSERT1(SCM_NIMP(v) && SCM_VECTORP(v), SCM_GASSERT1(SCM_NIMP(v) && SCM_VECTORP(v),
g_vector_length, v, SCM_ARG1, s_vector_length); g_vector_length, v, SCM_ARG1, s_vector_length);
@ -179,10 +178,7 @@ scm_vector_ref (SCM v, SCM k)
SCM_GPROC(s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x); SCM_GPROC(s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x);
SCM SCM
scm_vector_set_x(v, k, obj) scm_vector_set_x(SCM v, SCM k, SCM obj)
SCM v;
SCM k;
SCM obj;
{ {
SCM_GASSERTn (SCM_NIMP(v) && SCM_VECTORP(v), SCM_GASSERTn (SCM_NIMP(v) && SCM_VECTORP(v),
g_vector_set_x, SCM_LIST3 (v, k, obj), g_vector_set_x, SCM_LIST3 (v, k, obj),