mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-15 08:10:17 +02:00
* *.c: Finish replacing K&R style prototypes with ANSI C
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
parent
1006486ec2
commit
6e8d25a695
36 changed files with 273 additions and 523 deletions
|
|
@ -21,6 +21,9 @@
|
|||
allocating any. It is a good idea to use alloca(0) in
|
||||
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
|
||||
#include <scmconfig.h>
|
||||
#endif
|
||||
|
|
@ -153,8 +156,7 @@ static header *last_alloca_header = NULL; /* -> last alloca header. */
|
|||
implementations of C, for example under Gould's UTX/32. */
|
||||
|
||||
pointer
|
||||
alloca (size)
|
||||
unsigned size;
|
||||
alloca (unsigned size)
|
||||
{
|
||||
auto char probe; /* Probes stack depth: */
|
||||
register char *depth = ADDRESS_FUNCTION (probe);
|
||||
|
|
|
|||
|
|
@ -106,10 +106,7 @@ display_header (SCM source, SCM port)
|
|||
|
||||
|
||||
void
|
||||
scm_display_error_message (message, args, port)
|
||||
SCM message;
|
||||
SCM args;
|
||||
SCM port;
|
||||
scm_display_error_message (SCM message, SCM args, SCM port)
|
||||
{
|
||||
int writingp;
|
||||
char *start;
|
||||
|
|
|
|||
|
|
@ -317,8 +317,7 @@ scm_tables_prehistory ()
|
|||
|
||||
|
||||
int
|
||||
scm_upcase (c)
|
||||
unsigned int c;
|
||||
scm_upcase (unsigned int c)
|
||||
{
|
||||
if (c < sizeof (scm_upcase_table))
|
||||
return scm_upcase_table[c];
|
||||
|
|
@ -328,8 +327,7 @@ scm_upcase (c)
|
|||
|
||||
|
||||
int
|
||||
scm_downcase (c)
|
||||
unsigned int c;
|
||||
scm_downcase (unsigned int c)
|
||||
{
|
||||
if (c < sizeof (scm_downcase_table))
|
||||
return scm_downcase_table[c];
|
||||
|
|
|
|||
|
|
@ -62,8 +62,7 @@ static char s_cont[] = "continuation";
|
|||
|
||||
|
||||
SCM
|
||||
scm_make_cont (answer)
|
||||
SCM * answer;
|
||||
scm_make_cont (SCM *answer)
|
||||
{
|
||||
long j;
|
||||
SCM cont;
|
||||
|
|
@ -141,8 +140,7 @@ grow_throw (SCM *a)
|
|||
|
||||
|
||||
void
|
||||
scm_dynthrow (a)
|
||||
SCM *a;
|
||||
scm_dynthrow (SCM *a)
|
||||
{
|
||||
SCM cont = a[0], val = a[1];
|
||||
#ifndef CHEAP_CONTINUATIONS
|
||||
|
|
@ -184,9 +182,7 @@ scm_dynthrow (a)
|
|||
|
||||
|
||||
SCM
|
||||
scm_call_continuation (cont, val)
|
||||
SCM cont;
|
||||
SCM val;
|
||||
scm_call_continuation (SCM cont, SCM val)
|
||||
{
|
||||
SCM a[3];
|
||||
a[0] = cont;
|
||||
|
|
|
|||
|
|
@ -522,10 +522,7 @@ scm_reverse_lookup (SCM env, SCM data)
|
|||
}
|
||||
|
||||
SCM
|
||||
scm_start_stack (id, exp, env)
|
||||
SCM id;
|
||||
SCM exp;
|
||||
SCM env;
|
||||
scm_start_stack (SCM id, SCM exp, SCM env)
|
||||
{
|
||||
SCM answer;
|
||||
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);
|
||||
|
||||
static SCM
|
||||
scm_m_start_stack (exp, env)
|
||||
SCM exp;
|
||||
SCM env;
|
||||
scm_m_start_stack (SCM exp, SCM env)
|
||||
{
|
||||
exp = SCM_CDR (exp);
|
||||
SCM_ASSERT (SCM_NIMP (exp)
|
||||
|
|
|
|||
|
|
@ -45,6 +45,9 @@
|
|||
Author: Aubrey Jaffer
|
||||
(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,
|
||||
too. */
|
||||
|
||||
|
|
@ -74,8 +77,7 @@ struct dsc$descriptor *descriptorize(x, buff)
|
|||
return(x);}
|
||||
|
||||
static char s_dynl[] = "vms:dynamic-link-call";
|
||||
SCM dynl(dir, symbol, fname)
|
||||
SCM dir, symbol, fname;
|
||||
SCM dynl(SCM dir, SCM symbol, SCM fname)
|
||||
{
|
||||
struct dsc$descriptor fnamed, symbold, dird;
|
||||
void (*fcn)();
|
||||
|
|
|
|||
|
|
@ -145,9 +145,7 @@ struct moddata {
|
|||
static struct moddata *registered_mods = NULL;
|
||||
|
||||
void
|
||||
scm_register_module_xxx (module_name, init_func)
|
||||
char *module_name;
|
||||
void *init_func;
|
||||
scm_register_module_xxx (char *module_name, void *init_func)
|
||||
{
|
||||
struct moddata *md;
|
||||
|
||||
|
|
|
|||
|
|
@ -171,9 +171,7 @@ scm_swap_bindings (SCM glocs, SCM vals)
|
|||
}
|
||||
|
||||
void
|
||||
scm_dowinds (to, delta)
|
||||
SCM to;
|
||||
long delta;
|
||||
scm_dowinds (SCM to, long delta)
|
||||
{
|
||||
tail:
|
||||
if (scm_dynwinds == to);
|
||||
|
|
|
|||
148
libguile/eval.c
148
libguile/eval.c
|
|
@ -157,9 +157,7 @@ SCM (*scm_memoize_method) (SCM, SCM);
|
|||
#ifdef MEMOIZE_LOCALS
|
||||
|
||||
SCM *
|
||||
scm_ilookup (iloc, env)
|
||||
SCM iloc;
|
||||
SCM env;
|
||||
scm_ilookup (SCM iloc, SCM env)
|
||||
{
|
||||
register int ir = SCM_IFRAME (iloc);
|
||||
register SCM er = env;
|
||||
|
|
@ -384,10 +382,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
|
||||
#ifdef USE_THREADS
|
||||
SCM *
|
||||
scm_lookupcar (vloc, genv, check)
|
||||
SCM vloc;
|
||||
SCM genv;
|
||||
int check;
|
||||
scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||
{
|
||||
SCM *loc = scm_lookupcar1 (vloc, genv, check);
|
||||
if (loc == NULL)
|
||||
|
|
@ -399,9 +394,7 @@ scm_lookupcar (vloc, genv, check)
|
|||
#define unmemocar scm_unmemocar
|
||||
|
||||
SCM
|
||||
scm_unmemocar (form, env)
|
||||
SCM form;
|
||||
SCM env;
|
||||
scm_unmemocar (SCM form, SCM env)
|
||||
{
|
||||
#ifdef DEBUG_EXTENSIONS
|
||||
register int ir;
|
||||
|
|
@ -431,9 +424,7 @@ scm_unmemocar (form, env)
|
|||
|
||||
|
||||
SCM
|
||||
scm_eval_car (pair, env)
|
||||
SCM pair;
|
||||
SCM env;
|
||||
scm_eval_car (SCM pair, SCM 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 (xorig, bodyloc, what)
|
||||
SCM xorig;
|
||||
SCM *bodyloc;
|
||||
const char *what;
|
||||
bodycheck (SCM xorig, SCM *bodyloc, const char *what)
|
||||
{
|
||||
ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, scm_s_expression);
|
||||
}
|
||||
|
|
@ -491,10 +479,7 @@ bodycheck (xorig, bodyloc, what)
|
|||
This is not done yet. */
|
||||
|
||||
static SCM
|
||||
scm_m_body (op, xorig, what)
|
||||
SCM op;
|
||||
SCM xorig;
|
||||
char *what;
|
||||
scm_m_body (SCM op, SCM xorig, const char *what)
|
||||
{
|
||||
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
|
||||
scm_m_quote (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_quote (SCM xorig, SCM env)
|
||||
{
|
||||
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
|
||||
scm_m_begin (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_begin (SCM xorig, SCM env)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1,
|
||||
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
|
||||
scm_m_if (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_if (SCM xorig, SCM env)
|
||||
{
|
||||
int len = scm_ilength (SCM_CDR (xorig));
|
||||
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
|
||||
scm_m_set_x (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_set_x (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
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
|
||||
|
||||
SCM
|
||||
scm_m_vref (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_vref (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
SCM_ASSYNT (1 == scm_ilength (x), xorig, scm_s_expression, s_vref);
|
||||
|
|
@ -600,9 +575,7 @@ scm_m_vref (xorig, env)
|
|||
|
||||
|
||||
SCM
|
||||
scm_m_vset (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_vset (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
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
|
||||
scm_m_and (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_and (SCM xorig, SCM env)
|
||||
{
|
||||
int len = scm_ilength (SCM_CDR (xorig));
|
||||
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
|
||||
scm_m_or (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_or (SCM xorig, SCM env)
|
||||
{
|
||||
int len = scm_ilength (SCM_CDR (xorig));
|
||||
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
|
||||
scm_m_case (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_case (SCM xorig, SCM env)
|
||||
{
|
||||
SCM proc, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
|
||||
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_m_cond (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_cond (SCM xorig, SCM env)
|
||||
{
|
||||
SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
|
||||
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
|
||||
scm_m_lambda (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_lambda (SCM xorig, SCM env)
|
||||
{
|
||||
SCM proc, x = SCM_CDR (xorig);
|
||||
if (scm_ilength (x) < 2)
|
||||
|
|
@ -751,9 +714,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_letstar,s_letstar);
|
|||
|
||||
|
||||
SCM
|
||||
scm_m_letstar (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_letstar (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
|
||||
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
|
||||
scm_m_do (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_do (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig), arg1, proc;
|
||||
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
|
||||
scm_m_quasiquote (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_quasiquote (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
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
|
||||
scm_m_delay (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_delay (SCM xorig, SCM env)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (xorig) == 2, xorig, scm_s_expression, s_delay);
|
||||
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
|
||||
scm_m_define (x, env)
|
||||
SCM x;
|
||||
SCM env;
|
||||
scm_m_define (SCM x, SCM env)
|
||||
{
|
||||
SCM proc, arg1 = x;
|
||||
x = SCM_CDR (x);
|
||||
|
|
@ -977,11 +930,7 @@ scm_m_define (x, env)
|
|||
/* end of acros */
|
||||
|
||||
static SCM
|
||||
scm_m_letrec1 (op, imm, xorig, env)
|
||||
SCM op;
|
||||
SCM imm;
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_letrec1 (SCM op, SCM imm, SCM xorig, SCM env)
|
||||
{
|
||||
SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */
|
||||
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
|
||||
scm_m_letrec (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_letrec (SCM xorig, SCM env)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
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
|
||||
scm_m_let (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_let (SCM xorig, SCM env)
|
||||
{
|
||||
SCM cdrx = SCM_CDR (xorig); /* locally mutable version of form */
|
||||
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
|
||||
scm_m_apply (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_apply (SCM xorig, SCM env)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2,
|
||||
xorig, scm_s_expression, s_atapply);
|
||||
|
|
@ -1111,9 +1054,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc);
|
|||
|
||||
|
||||
SCM
|
||||
scm_m_cont (xorig, env)
|
||||
SCM xorig;
|
||||
SCM env;
|
||||
scm_m_cont (SCM xorig, SCM env)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
|
||||
xorig, scm_s_expression, s_atcall_cc);
|
||||
|
|
@ -1545,9 +1486,7 @@ loop:
|
|||
|
||||
|
||||
SCM
|
||||
scm_unmemocopy (x, env)
|
||||
SCM x;
|
||||
SCM env;
|
||||
scm_unmemocopy (SCM x, SCM env)
|
||||
{
|
||||
if (SCM_NNULLP (env))
|
||||
/* Make a copy of the lowest frame to protect it from
|
||||
|
|
@ -1560,9 +1499,7 @@ scm_unmemocopy (x, env)
|
|||
#ifndef SCM_RECKLESS
|
||||
|
||||
int
|
||||
scm_badargsp (formals, args)
|
||||
SCM formals;
|
||||
SCM args;
|
||||
scm_badargsp (SCM formals, SCM args)
|
||||
{
|
||||
while (SCM_NIMP (formals))
|
||||
{
|
||||
|
|
@ -1580,10 +1517,7 @@ scm_badargsp (formals, args)
|
|||
|
||||
|
||||
SCM
|
||||
scm_eval_args (l, env, proc)
|
||||
SCM l;
|
||||
SCM env;
|
||||
SCM proc;
|
||||
scm_eval_args (SCM l, SCM env, SCM proc)
|
||||
{
|
||||
SCM results = SCM_EOL, *lloc = &results, res;
|
||||
while (SCM_NIMP (l))
|
||||
|
|
@ -1802,8 +1736,7 @@ GUILE_PROC (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
SCM
|
||||
scm_deval_args (l, env, proc, lloc)
|
||||
SCM l, env, proc, *lloc;
|
||||
scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
|
||||
{
|
||||
SCM *results = lloc, res;
|
||||
while (SCM_NIMP (l))
|
||||
|
|
@ -3275,21 +3208,15 @@ GUILE_PROC(scm_nconc2last, "apply:nconc2last", 1, 0, 0,
|
|||
#if 0
|
||||
|
||||
SCM
|
||||
scm_apply (proc, arg1, args)
|
||||
SCM proc;
|
||||
SCM arg1;
|
||||
SCM args;
|
||||
scm_apply (SCM proc, SCM arg1, SCM args)
|
||||
{}
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
|
||||
SCM
|
||||
scm_dapply (proc, arg1, args)
|
||||
SCM proc;
|
||||
SCM arg1;
|
||||
SCM args;
|
||||
{}
|
||||
scm_dapply (SCM proc, SCM arg1, SCM args)
|
||||
{ /* empty */ }
|
||||
#endif
|
||||
|
||||
|
||||
|
|
@ -3742,9 +3669,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
|
|||
|
||||
|
||||
SCM
|
||||
scm_closure (code, env)
|
||||
SCM code;
|
||||
SCM env;
|
||||
scm_closure (SCM code, SCM env)
|
||||
{
|
||||
register SCM z;
|
||||
SCM_NEWCELL (z);
|
||||
|
|
@ -3757,8 +3682,7 @@ scm_closure (code, env)
|
|||
long scm_tc16_promise;
|
||||
|
||||
SCM
|
||||
scm_makprom (code)
|
||||
SCM code;
|
||||
scm_makprom (SCM code)
|
||||
{
|
||||
SCM_RETURN_NEWSMOB (scm_tc16_promise, code);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -120,8 +120,7 @@ GUILE_PROC (scm_definedp, "defined?", 1, 1, 0,
|
|||
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
|
||||
|
||||
SCM
|
||||
scm_m_undefine (x, env)
|
||||
SCM x, env;
|
||||
scm_m_undefine (SCM x, SCM env)
|
||||
{
|
||||
SCM arg1 = x;
|
||||
x = SCM_CDR (x);
|
||||
|
|
|
|||
|
|
@ -62,8 +62,7 @@
|
|||
static SCM *scm_loc_features;
|
||||
|
||||
void
|
||||
scm_add_feature (str)
|
||||
const char* str;
|
||||
scm_add_feature (const char *str)
|
||||
{
|
||||
*scm_loc_features = scm_cons (SCM_CAR (scm_intern (str, strlen (str))),
|
||||
*scm_loc_features);
|
||||
|
|
|
|||
|
|
@ -90,8 +90,7 @@ grow_fluids (scm_root_state *root_state,int new_length)
|
|||
}
|
||||
|
||||
void
|
||||
scm_copy_fluids (root_state)
|
||||
scm_root_state *root_state;
|
||||
scm_copy_fluids (scm_root_state *root_state)
|
||||
{
|
||||
grow_fluids (root_state, SCM_LENGTH(root_state->fluids));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -186,8 +186,7 @@ GUILE_PROC (scm_setvbuf, "setvbuf", 2, 1, 0,
|
|||
*/
|
||||
|
||||
void
|
||||
scm_evict_ports (fd)
|
||||
int fd;
|
||||
scm_evict_ports (int fd)
|
||||
{
|
||||
int i;
|
||||
|
||||
|
|
|
|||
|
|
@ -389,8 +389,7 @@ GUILE_PROC (scm_gc_stats, "gc-stats", 0, 0, 0,
|
|||
|
||||
|
||||
void
|
||||
scm_gc_start (what)
|
||||
const char *what;
|
||||
scm_gc_start (const char *what)
|
||||
{
|
||||
scm_gc_rt = SCM_INUM (scm_get_internal_run_time ());
|
||||
scm_gc_cells_collected = 0;
|
||||
|
|
@ -912,9 +911,7 @@ gc_mark_nimp:
|
|||
*/
|
||||
|
||||
void
|
||||
scm_mark_locations (x, n)
|
||||
SCM_STACKITEM x[];
|
||||
scm_sizet n;
|
||||
scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
|
||||
{
|
||||
register long m = n;
|
||||
register int i, j;
|
||||
|
|
@ -981,8 +978,7 @@ scm_mark_locations (x, n)
|
|||
|
||||
|
||||
int
|
||||
scm_cellp (value)
|
||||
SCM value;
|
||||
scm_cellp (SCM value)
|
||||
{
|
||||
register int i, j;
|
||||
register SCM_CELLPTR ptr;
|
||||
|
|
@ -1553,8 +1549,7 @@ scm_must_free (void *obj)
|
|||
* value. */
|
||||
|
||||
void
|
||||
scm_done_malloc (size)
|
||||
long size;
|
||||
scm_done_malloc (long size)
|
||||
{
|
||||
scm_mallocated += size;
|
||||
|
||||
|
|
@ -1615,11 +1610,7 @@ unsigned long scm_heap_size = 0;
|
|||
|
||||
|
||||
static scm_sizet
|
||||
init_heap_seg (seg_org, size, ncells, freelistp)
|
||||
SCM_CELLPTR seg_org;
|
||||
scm_sizet size;
|
||||
int ncells;
|
||||
SCM *freelistp;
|
||||
init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, int ncells, SCM *freelistp)
|
||||
{
|
||||
register SCM_CELLPTR ptr;
|
||||
#ifdef SCM_POINTERS_MUNGED
|
||||
|
|
@ -1701,9 +1692,7 @@ init_heap_seg (seg_org, size, ncells, freelistp)
|
|||
|
||||
|
||||
static void
|
||||
alloc_some_heap (ncells, freelistp)
|
||||
int ncells;
|
||||
SCM * freelistp;
|
||||
alloc_some_heap (int ncells, SCM *freelistp)
|
||||
{
|
||||
struct scm_heap_seg_data * tmptable;
|
||||
SCM_CELLPTR ptr;
|
||||
|
|
@ -1813,9 +1802,8 @@ GUILE_PROC (scm_unhash_name, "unhash-name", 1, 0, 0,
|
|||
|
||||
|
||||
void
|
||||
scm_remember (ptr)
|
||||
SCM * ptr;
|
||||
{}
|
||||
scm_remember (SCM *ptr)
|
||||
{ /* empty */ }
|
||||
|
||||
|
||||
SCM
|
||||
|
|
@ -1826,8 +1814,7 @@ scm_return_first (SCM elt, ...)
|
|||
|
||||
|
||||
SCM
|
||||
scm_permanent_object (obj)
|
||||
SCM obj;
|
||||
scm_permanent_object (SCM obj)
|
||||
{
|
||||
SCM_REDEFER_INTS;
|
||||
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
|
||||
to the list. */
|
||||
SCM
|
||||
scm_protect_object (obj)
|
||||
SCM obj;
|
||||
scm_protect_object (SCM obj)
|
||||
{
|
||||
scm_protects = scm_cons (obj, scm_protects);
|
||||
|
||||
|
|
@ -1867,8 +1853,7 @@ scm_protect_object (obj)
|
|||
|
||||
See scm_protect_object for more information. */
|
||||
SCM
|
||||
scm_unprotect_object (obj)
|
||||
SCM obj;
|
||||
scm_unprotect_object (SCM obj)
|
||||
{
|
||||
SCM *tail_ptr = &scm_protects;
|
||||
|
||||
|
|
|
|||
|
|
@ -163,8 +163,7 @@ remark_port (SCM port)
|
|||
|
||||
|
||||
int
|
||||
gdb_maybe_valid_type_p (value)
|
||||
SCM value;
|
||||
gdb_maybe_valid_type_p (SCM value)
|
||||
{
|
||||
if (SCM_IMP (value) || scm_cellp (value))
|
||||
return scm_tag (value) != SCM_MAKINUM (-1);
|
||||
|
|
@ -173,8 +172,7 @@ gdb_maybe_valid_type_p (value)
|
|||
|
||||
|
||||
int
|
||||
gdb_read (str)
|
||||
char *str;
|
||||
gdb_read (char *str)
|
||||
{
|
||||
SCM ans;
|
||||
int status = 0;
|
||||
|
|
@ -239,8 +237,7 @@ exit:
|
|||
|
||||
|
||||
int
|
||||
gdb_eval (exp)
|
||||
SCM exp;
|
||||
gdb_eval (SCM exp)
|
||||
{
|
||||
RESET_STRING;
|
||||
if (SCM_IMP (exp))
|
||||
|
|
@ -264,8 +261,7 @@ gdb_eval (exp)
|
|||
|
||||
|
||||
int
|
||||
gdb_print (obj)
|
||||
SCM obj;
|
||||
gdb_print (SCM obj)
|
||||
{
|
||||
RESET_STRING;
|
||||
SCM_BEGIN_FOREIGN_BLOCK;
|
||||
|
|
@ -286,9 +282,7 @@ gdb_print (obj)
|
|||
|
||||
|
||||
int
|
||||
gdb_binding (name, value)
|
||||
SCM name;
|
||||
SCM value;
|
||||
gdb_binding (SCM name, SCM value)
|
||||
{
|
||||
RESET_STRING;
|
||||
if (SCM_GC_P)
|
||||
|
|
|
|||
|
|
@ -31,6 +31,9 @@
|
|||
* 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)
|
||||
static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93";
|
||||
#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.
|
||||
*/
|
||||
u_long
|
||||
inet_addr(cp)
|
||||
register const char *cp;
|
||||
inet_addr(const char *cp)
|
||||
{
|
||||
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
|
||||
* cannot distinguish between failure and a local broadcast address. */
|
||||
int
|
||||
inet_aton(cp_arg, addr)
|
||||
const char *cp_arg;
|
||||
struct in_addr *addr;
|
||||
inet_aton(const char *cp_arg, struct in_addr *addr)
|
||||
{
|
||||
register unsigned long val;
|
||||
register int base, n;
|
||||
|
|
|
|||
|
|
@ -376,11 +376,7 @@ static SCM invoke_main_func(void *body_data);
|
|||
|
||||
|
||||
void
|
||||
scm_boot_guile (argc, argv, main_func, closure)
|
||||
int argc;
|
||||
char ** argv;
|
||||
void (*main_func) ();
|
||||
void *closure;
|
||||
scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
|
||||
{
|
||||
/* The garbage collector uses the address of this variable as one
|
||||
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;
|
||||
|
||||
static void
|
||||
scm_boot_guile_1 (base, closure)
|
||||
SCM_STACKITEM *base;
|
||||
struct main_func_closure *closure;
|
||||
scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
|
||||
{
|
||||
static int initialized = 0;
|
||||
/* static int live = 0; */
|
||||
|
|
@ -558,8 +552,7 @@ scm_boot_guile_1 (base, closure)
|
|||
|
||||
|
||||
static SCM
|
||||
invoke_main_func (body_data)
|
||||
void *body_data;
|
||||
invoke_main_func (void *body_data)
|
||||
{
|
||||
struct main_func_closure *closure = (struct main_func_closure *) body_data;
|
||||
|
||||
|
|
|
|||
|
|
@ -65,8 +65,7 @@ int scm_tc16_malloc;
|
|||
|
||||
|
||||
SCM
|
||||
scm_malloc_obj (n)
|
||||
scm_sizet n;
|
||||
scm_malloc_obj (scm_sizet n)
|
||||
{
|
||||
SCM mem;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
/* Wrapper to implement ANSI C's memmove using BSD's bcopy. */
|
||||
/* 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>
|
||||
|
||||
#ifdef __STDC__
|
||||
|
|
@ -14,10 +17,7 @@ PTR memmove ();
|
|||
#endif
|
||||
|
||||
PTR
|
||||
memmove (s1, s2, n)
|
||||
PTR s1;
|
||||
CPTR s2;
|
||||
size_t n;
|
||||
memmove (PTR s1, CPTR s2, size_t n)
|
||||
{
|
||||
bcopy (s2, s1, n);
|
||||
return s1;
|
||||
|
|
|
|||
|
|
@ -38,6 +38,10 @@
|
|||
* If you write modifications of your own for GUILE, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* 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"
|
||||
|
|
@ -136,8 +140,7 @@ scm_load_scheme_module (SCM name)
|
|||
*/
|
||||
|
||||
SCM
|
||||
scm_top_level_env (thunk)
|
||||
SCM thunk;
|
||||
scm_top_level_env (SCM thunk)
|
||||
{
|
||||
if (SCM_IMP (thunk))
|
||||
return SCM_EOL;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
scm_abs (x)
|
||||
SCM x;
|
||||
scm_abs (SCM x)
|
||||
{
|
||||
#ifdef SCM_BIGDIG
|
||||
if (SCM_NINUMP (x))
|
||||
|
|
@ -178,9 +177,7 @@ scm_abs (x)
|
|||
SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient);
|
||||
|
||||
SCM
|
||||
scm_quotient (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_quotient (SCM x, SCM y)
|
||||
{
|
||||
register long z;
|
||||
#ifdef SCM_BIGDIG
|
||||
|
|
@ -270,9 +267,7 @@ scm_quotient (x, y)
|
|||
SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder);
|
||||
|
||||
SCM
|
||||
scm_remainder (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_remainder (SCM x, SCM y)
|
||||
{
|
||||
register long z;
|
||||
#ifdef SCM_BIGDIG
|
||||
|
|
@ -329,9 +324,7 @@ scm_remainder (x, y)
|
|||
SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo);
|
||||
|
||||
SCM
|
||||
scm_modulo (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_modulo (SCM x, SCM y)
|
||||
{
|
||||
register long yy, z;
|
||||
#ifdef SCM_BIGDIG
|
||||
|
|
@ -382,9 +375,7 @@ scm_modulo (x, y)
|
|||
SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
|
||||
|
||||
SCM
|
||||
scm_gcd (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_gcd (SCM x, SCM y)
|
||||
{
|
||||
register long u, v, k, t;
|
||||
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
|
||||
scm_lcm (n1, n2)
|
||||
SCM n1;
|
||||
SCM n2;
|
||||
scm_lcm (SCM n1, SCM n2)
|
||||
{
|
||||
SCM d;
|
||||
#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
|
||||
scm_num_eq_p (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_num_eq_p (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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
|
||||
scm_less_p (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_less_p (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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
|
||||
scm_zero_p (z)
|
||||
SCM z;
|
||||
scm_zero_p (SCM z)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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
|
||||
scm_positive_p (x)
|
||||
SCM x;
|
||||
scm_positive_p (SCM x)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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
|
||||
scm_negative_p (x)
|
||||
SCM x;
|
||||
scm_negative_p (SCM x)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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
|
||||
scm_max (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_max (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
double z;
|
||||
|
|
@ -3036,9 +3016,7 @@ scm_max (x, y)
|
|||
SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
|
||||
|
||||
SCM
|
||||
scm_min (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_min (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
double z;
|
||||
|
|
@ -3147,9 +3125,7 @@ scm_min (x, y)
|
|||
SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum);
|
||||
|
||||
SCM
|
||||
scm_sum (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_sum (SCM x, SCM 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
|
||||
scm_difference (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_difference (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
if (SCM_NINUMP (x))
|
||||
|
|
@ -3538,9 +3512,7 @@ scm_difference (x, y)
|
|||
SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product);
|
||||
|
||||
SCM
|
||||
scm_product (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_product (SCM x, SCM y)
|
||||
{
|
||||
if (SCM_UNBNDP (y))
|
||||
{
|
||||
|
|
@ -3753,9 +3725,7 @@ scm_product (x, y)
|
|||
|
||||
|
||||
double
|
||||
scm_num2dbl (a, why)
|
||||
SCM a;
|
||||
const char *why;
|
||||
scm_num2dbl (SCM a, const char *why)
|
||||
{
|
||||
if (SCM_INUMP (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
|
||||
scm_divide (x, y)
|
||||
SCM x;
|
||||
SCM y;
|
||||
scm_divide (SCM x, SCM y)
|
||||
{
|
||||
#ifdef SCM_FLOATS
|
||||
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);
|
||||
|
||||
double
|
||||
scm_asinh (x)
|
||||
double x;
|
||||
scm_asinh (double x)
|
||||
{
|
||||
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);
|
||||
|
||||
double
|
||||
scm_acosh (x)
|
||||
double x;
|
||||
scm_acosh (double x)
|
||||
{
|
||||
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);
|
||||
|
||||
double
|
||||
scm_atanh (x)
|
||||
double x;
|
||||
scm_atanh (double 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);
|
||||
|
||||
double
|
||||
scm_truncate (x)
|
||||
double x;
|
||||
scm_truncate (double x)
|
||||
{
|
||||
if (x < 0.0)
|
||||
return -floor (-x);
|
||||
|
|
@ -4088,8 +4052,7 @@ scm_truncate (x)
|
|||
SCM_GPROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round, g_round);
|
||||
|
||||
double
|
||||
scm_round (x)
|
||||
double x;
|
||||
scm_round (double x)
|
||||
{
|
||||
double plus_half = x + 0.5;
|
||||
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);
|
||||
|
||||
double
|
||||
scm_exact_to_inexact (z)
|
||||
double z;
|
||||
scm_exact_to_inexact (double z)
|
||||
{
|
||||
return z;
|
||||
}
|
||||
|
|
@ -4137,10 +4099,7 @@ static void scm_two_doubles (SCM z1,
|
|||
struct dpair * xy);
|
||||
|
||||
static void
|
||||
scm_two_doubles (z1, z2, sstring, xy)
|
||||
SCM z1, z2;
|
||||
const char *sstring;
|
||||
struct dpair *xy;
|
||||
scm_two_doubles (SCM z1, SCM z2, const char *sstring, struct dpair *xy)
|
||||
{
|
||||
if (SCM_INUMP (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
|
||||
scm_real_part (z)
|
||||
SCM z;
|
||||
scm_real_part (SCM 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
|
||||
scm_imag_part (z)
|
||||
SCM z;
|
||||
scm_imag_part (SCM z)
|
||||
{
|
||||
if (SCM_INUMP (z))
|
||||
return SCM_INUM0;
|
||||
|
|
@ -4306,8 +4263,7 @@ scm_imag_part (z)
|
|||
SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude);
|
||||
|
||||
SCM
|
||||
scm_magnitude (z)
|
||||
SCM z;
|
||||
scm_magnitude (SCM z)
|
||||
{
|
||||
if (SCM_INUMP (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
|
||||
scm_angle (z)
|
||||
SCM z;
|
||||
scm_angle (SCM z)
|
||||
{
|
||||
double x, y = 0.0;
|
||||
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
|
||||
scm_trunc (x)
|
||||
SCM x;
|
||||
scm_trunc (SCM x)
|
||||
{
|
||||
SCM_GASSERT2 (SCM_INUMP (x), g_trunc, x, y, SCM_ARG1, s_truncate);
|
||||
return x;
|
||||
|
|
@ -4436,8 +4390,7 @@ scm_trunc (x)
|
|||
/* d must be integer */
|
||||
|
||||
SCM
|
||||
scm_dbl2big (d)
|
||||
double d;
|
||||
scm_dbl2big (double d)
|
||||
{
|
||||
scm_sizet i = 0;
|
||||
long c;
|
||||
|
|
@ -4468,8 +4421,7 @@ scm_dbl2big (d)
|
|||
|
||||
|
||||
double
|
||||
scm_big2dbl (b)
|
||||
SCM b;
|
||||
scm_big2dbl (SCM b)
|
||||
{
|
||||
double ans = 0.0;
|
||||
scm_sizet i = SCM_NUMDIGS (b);
|
||||
|
|
@ -4485,8 +4437,7 @@ scm_big2dbl (b)
|
|||
|
||||
|
||||
SCM
|
||||
scm_long2num (sl)
|
||||
long sl;
|
||||
scm_long2num (long sl)
|
||||
{
|
||||
if (!SCM_FIXABLE (sl))
|
||||
{
|
||||
|
|
@ -4507,8 +4458,7 @@ scm_long2num (sl)
|
|||
#ifdef HAVE_LONG_LONGS
|
||||
|
||||
SCM
|
||||
scm_long_long2num (sl)
|
||||
long_long sl;
|
||||
scm_long_long2num (long_long sl)
|
||||
{
|
||||
if (!SCM_FIXABLE (sl))
|
||||
{
|
||||
|
|
@ -4529,8 +4479,7 @@ scm_long_long2num (sl)
|
|||
|
||||
|
||||
SCM
|
||||
scm_ulong2num (sl)
|
||||
unsigned long sl;
|
||||
scm_ulong2num (unsigned long sl)
|
||||
{
|
||||
if (!SCM_POSFIXABLE (sl))
|
||||
{
|
||||
|
|
@ -4549,10 +4498,7 @@ scm_ulong2num (sl)
|
|||
|
||||
|
||||
long
|
||||
scm_num2long (num, pos, s_caller)
|
||||
SCM num;
|
||||
char *pos;
|
||||
const char *s_caller;
|
||||
scm_num2long (SCM num, char *pos, const char *s_caller)
|
||||
{
|
||||
long res;
|
||||
|
||||
|
|
@ -4615,10 +4561,7 @@ scm_num2long (num, pos, s_caller)
|
|||
#ifdef HAVE_LONG_LONGS
|
||||
|
||||
long_long
|
||||
scm_num2long_long (num, pos, s_caller)
|
||||
SCM num;
|
||||
char *pos;
|
||||
const char *s_caller;
|
||||
scm_num2long_long (SCM num, char *pos, const char *s_caller)
|
||||
{
|
||||
long_long res;
|
||||
|
||||
|
|
@ -4681,10 +4624,7 @@ scm_num2long_long (num, pos, s_caller)
|
|||
|
||||
|
||||
unsigned long
|
||||
scm_num2ulong (num, pos, s_caller)
|
||||
SCM num;
|
||||
char *pos;
|
||||
const char *s_caller;
|
||||
scm_num2ulong (SCM num, char *pos, const char *s_caller)
|
||||
{
|
||||
unsigned long res;
|
||||
|
||||
|
|
@ -4734,8 +4674,7 @@ scm_num2ulong (num, pos, s_caller)
|
|||
#ifdef SCM_FLOATS
|
||||
#ifndef DBL_DIG
|
||||
static void
|
||||
add1 (f, fsum)
|
||||
double f, *fsum;
|
||||
add1 (double f, double *fsum)
|
||||
{
|
||||
*fsum = f + 1.0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -41,6 +41,10 @@
|
|||
*
|
||||
* The author can be reached at djurfeldt@nada.kth.se
|
||||
* 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>
|
||||
|
|
@ -117,11 +121,7 @@ SCM_SYMBOL (scm_no_sym, "no");
|
|||
static SCM protected_objects;
|
||||
|
||||
SCM
|
||||
scm_options (arg, options, n, s)
|
||||
SCM arg;
|
||||
scm_option options[];
|
||||
int n;
|
||||
const char *s;
|
||||
scm_options (SCM arg, scm_option options[], int n, const char *s)
|
||||
{
|
||||
int i, docp = (!SCM_UNBNDP (arg)
|
||||
&& !SCM_NULLP (arg)
|
||||
|
|
@ -213,10 +213,7 @@ scm_options (arg, options, n, s)
|
|||
|
||||
|
||||
void
|
||||
scm_init_opts (func, options, n)
|
||||
SCM (*func) (SCM);
|
||||
scm_option options[];
|
||||
int n;
|
||||
scm_init_opts (SCM (*func) (SCM), scm_option options[], int n)
|
||||
{
|
||||
int i;
|
||||
|
||||
|
|
|
|||
|
|
@ -227,8 +227,7 @@ scm_make_print_state ()
|
|||
}
|
||||
|
||||
void
|
||||
scm_free_print_state (print_state)
|
||||
SCM print_state;
|
||||
scm_free_print_state (SCM print_state)
|
||||
{
|
||||
SCM handle;
|
||||
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
|
||||
|
|
|
|||
|
|
@ -15,6 +15,9 @@
|
|||
Foundation, Inc., 59 Temple Place, Suite 330, 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 */
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
#include "libguile/scmconfig.h"
|
||||
#endif
|
||||
|
|
@ -59,8 +62,7 @@ extern char **environ;
|
|||
|
||||
/* Put STRING, which is of the form "NAME=VALUE", in the environment. */
|
||||
int
|
||||
putenv (string)
|
||||
const char *string;
|
||||
putenv (const char *string)
|
||||
{
|
||||
char *name_end = strchr (string, '=');
|
||||
register size_t size;
|
||||
|
|
|
|||
|
|
@ -142,9 +142,7 @@ cind (SCM ra, SCM inds)
|
|||
*/
|
||||
|
||||
int
|
||||
scm_ra_matchp (ra0, ras)
|
||||
SCM ra0;
|
||||
SCM ras;
|
||||
scm_ra_matchp (SCM ra0, SCM ras)
|
||||
{
|
||||
SCM ra1;
|
||||
scm_array_dim dims;
|
||||
|
|
|
|||
|
|
@ -117,8 +117,7 @@ GUILE_PROC (scm_read, "read", 0, 1, 0,
|
|||
|
||||
|
||||
char *
|
||||
scm_grow_tok_buf (tok_buf)
|
||||
SCM * tok_buf;
|
||||
scm_grow_tok_buf (SCM *tok_buf)
|
||||
{
|
||||
scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf)));
|
||||
return SCM_CHARS (*tok_buf);
|
||||
|
|
@ -127,9 +126,7 @@ scm_grow_tok_buf (tok_buf)
|
|||
|
||||
|
||||
int
|
||||
scm_flush_ws (port, eoferr)
|
||||
SCM port;
|
||||
const char *eoferr;
|
||||
scm_flush_ws (SCM port, const char *eoferr)
|
||||
{
|
||||
register int c;
|
||||
while (1)
|
||||
|
|
@ -164,9 +161,7 @@ scm_flush_ws (port, eoferr)
|
|||
|
||||
|
||||
int
|
||||
scm_casei_streq (s1, s2)
|
||||
char * s1;
|
||||
char * s2;
|
||||
scm_casei_streq (char *s1, char *s2)
|
||||
{
|
||||
while (*s1 && *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. */
|
||||
|
||||
static void
|
||||
skip_scsh_block_comment (port)
|
||||
SCM port;
|
||||
skip_scsh_block_comment (SCM port)
|
||||
{
|
||||
/* Is this portable? Dear God, spare me from the non-eight-bit
|
||||
characters. But is it tasteful? */
|
||||
|
|
@ -517,11 +511,7 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */
|
|||
#endif
|
||||
|
||||
scm_sizet
|
||||
scm_read_token (ic, tok_buf, port, weird)
|
||||
int ic;
|
||||
SCM *tok_buf;
|
||||
SCM port;
|
||||
int weird;
|
||||
scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
|
||||
{
|
||||
register scm_sizet j;
|
||||
register int c;
|
||||
|
|
@ -607,11 +597,7 @@ _Pragma ("opt"); /* # pragma _CRI opt */
|
|||
#endif
|
||||
|
||||
SCM
|
||||
scm_lreadparen (tok_buf, port, name, copy)
|
||||
SCM *tok_buf;
|
||||
SCM port;
|
||||
char *name;
|
||||
SCM *copy;
|
||||
scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
|
||||
{
|
||||
SCM tmp;
|
||||
SCM tl;
|
||||
|
|
@ -647,11 +633,7 @@ scm_lreadparen (tok_buf, port, name, copy)
|
|||
|
||||
|
||||
SCM
|
||||
scm_lreadrecparen (tok_buf, port, name, copy)
|
||||
SCM *tok_buf;
|
||||
SCM port;
|
||||
char *name;
|
||||
SCM *copy;
|
||||
scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
|
||||
{
|
||||
register int c;
|
||||
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. */
|
||||
static SCM
|
||||
scm_get_hash_procedure (c)
|
||||
int c;
|
||||
scm_get_hash_procedure (int c)
|
||||
{
|
||||
SCM rest = *scm_read_hash_procedures;
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
*
|
||||
* 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_VALIDATE_NIM(pos,scm) \
|
||||
do { SCM_ASSERT(SCM_NIMP(scm), scm, pos, FUNC_NAME); } while (0)
|
||||
|
||||
#define SCM_MAKE_NIM_VALIDATE(pos,var,pred) \
|
||||
do { SCM_ASSERT (SCM_NIMP(var) && SCM ## pred(var), var, pos, FUNC_NAME); } while (0)
|
||||
|
||||
#define SCM_MAKE_VALIDATE(pos,var,pred) \
|
||||
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) \
|
||||
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) \
|
||||
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)
|
||||
|
||||
#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)
|
||||
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -41,6 +41,9 @@
|
|||
/* "script.c" argv tricks for `#!' scripts.
|
||||
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 <ctype.h>
|
||||
#include "_scm.h"
|
||||
|
|
@ -58,10 +61,7 @@
|
|||
string if file exists; 0 otherwise. */
|
||||
|
||||
static char *
|
||||
scm_cat_path (str1, str2, n)
|
||||
char *str1;
|
||||
const char *str2;
|
||||
long n;
|
||||
scm_cat_path (char *str1, const char *str2, long n)
|
||||
{
|
||||
if (!n)
|
||||
n = strlen (str2);
|
||||
|
|
@ -84,8 +84,7 @@ scm_cat_path (str1, str2, n)
|
|||
|
||||
#if 0
|
||||
static char *
|
||||
scm_try_path (path)
|
||||
char *path;
|
||||
scm_try_path (char *path)
|
||||
{
|
||||
FILE *f;
|
||||
/* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
|
||||
|
|
@ -103,9 +102,7 @@ scm_try_path (path)
|
|||
}
|
||||
|
||||
static char *
|
||||
scm_sep_init_try (path, sep, initname)
|
||||
char *path;
|
||||
const char *sep, *initname;
|
||||
scm_sep_init_try (char *path, const char *sep, const char *initname)
|
||||
{
|
||||
if (path)
|
||||
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. */
|
||||
static int
|
||||
script_get_octal (f)
|
||||
FILE *f;
|
||||
script_get_octal (FILE *f)
|
||||
{
|
||||
int i;
|
||||
int value = 0;
|
||||
|
|
@ -187,8 +183,7 @@ script_get_octal (f)
|
|||
|
||||
|
||||
static int
|
||||
script_get_backslash (f)
|
||||
FILE *f;
|
||||
script_get_backslash (FILE *f)
|
||||
{
|
||||
int c = getc (f);
|
||||
|
||||
|
|
@ -229,8 +224,7 @@ script_get_backslash (f)
|
|||
|
||||
|
||||
static char *
|
||||
script_read_arg (f)
|
||||
FILE *f;
|
||||
script_read_arg (FILE *f)
|
||||
{
|
||||
int size = 7;
|
||||
char *buf = malloc (size + 1);
|
||||
|
|
@ -287,8 +281,7 @@ script_read_arg (f)
|
|||
|
||||
|
||||
static int
|
||||
script_meta_arg_P (arg)
|
||||
char *arg;
|
||||
script_meta_arg_P (char *arg)
|
||||
{
|
||||
if ('\\' != arg[0])
|
||||
return 0L;
|
||||
|
|
@ -308,9 +301,7 @@ script_meta_arg_P (arg)
|
|||
}
|
||||
|
||||
char **
|
||||
scm_get_meta_args (argc, argv)
|
||||
int argc;
|
||||
char **argv;
|
||||
scm_get_meta_args (int argc, char **argv)
|
||||
{
|
||||
int nargc = argc, argi = 1, nargi = 1;
|
||||
char *narg, **nargv;
|
||||
|
|
@ -352,8 +343,7 @@ scm_get_meta_args (argc, argv)
|
|||
}
|
||||
|
||||
int
|
||||
scm_count_argv (argv)
|
||||
char **argv;
|
||||
scm_count_argv (char **argv)
|
||||
{
|
||||
int argc = 0;
|
||||
while (argv[argc])
|
||||
|
|
@ -626,9 +616,7 @@ scm_compile_shell_switches (int argc, char **argv)
|
|||
|
||||
|
||||
void
|
||||
scm_shell (argc, argv)
|
||||
int argc;
|
||||
char **argv;
|
||||
scm_shell (int argc, char **argv)
|
||||
{
|
||||
/* If present, add SCSH-style meta-arguments from the top of the
|
||||
script file to the argument vector. See the SCSH manual: "The
|
||||
|
|
|
|||
|
|
@ -79,15 +79,13 @@ scm_smob_descriptor *scm_smobs;
|
|||
to make their links fail. */
|
||||
|
||||
SCM
|
||||
scm_mark0 (ptr)
|
||||
SCM ptr;
|
||||
scm_mark0 (SCM ptr)
|
||||
{
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_markcdr (ptr)
|
||||
SCM ptr;
|
||||
scm_markcdr (SCM ptr)
|
||||
{
|
||||
return SCM_CDR (ptr);
|
||||
}
|
||||
|
|
@ -96,8 +94,7 @@ scm_markcdr (ptr)
|
|||
*/
|
||||
|
||||
scm_sizet
|
||||
scm_free0 (ptr)
|
||||
SCM ptr;
|
||||
scm_free0 (SCM ptr)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -60,8 +60,6 @@ SCM FNAME ARGLIST
|
|||
static const char s_ ## FNAME [] = PRIMNAME; \
|
||||
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) \
|
||||
static const char RANAME[]=STR
|
||||
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
|
||||
|
|
@ -76,14 +74,17 @@ SCM FNAME ARGLIST
|
|||
#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
|
||||
|
||||
#define GUILE_PROC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
%%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM (*)(...)) FNAME);
|
||||
#define GUILE_PROC1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
|
||||
%%% scm_make_subr (s_ ## FNAME, TYPE, FNAME);
|
||||
%%% scm_make_gsubr (s_ ## FNAME, REQ, OPT, VAR, (SCM (*)(...)) FNAME); \
|
||||
$$$ primname #ARGLIST req opt var @@@ docstring @!!!
|
||||
|
||||
#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) \
|
||||
%%% 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) \
|
||||
%%% scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM (*)(...))CFN, &GF)
|
||||
#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
|
||||
|
|
|
|||
|
|
@ -38,6 +38,10 @@
|
|||
* If you write modifications of your own for GUILE, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* 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>
|
||||
|
|
@ -69,8 +73,7 @@ scm_report_stack_overflow ()
|
|||
#endif
|
||||
|
||||
long
|
||||
scm_stack_size (start)
|
||||
SCM_STACKITEM *start;
|
||||
scm_stack_size (SCM_STACKITEM *start)
|
||||
{
|
||||
SCM_STACKITEM stack;
|
||||
#ifdef SCM_STACK_GROWS_UP
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
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 *
|
||||
strerror (errnum)
|
||||
int errnum;
|
||||
strerror (int errnum)
|
||||
{
|
||||
extern char *sys_errlist[];
|
||||
extern int sys_nerr;
|
||||
|
|
|
|||
|
|
@ -38,26 +38,28 @@
|
|||
* If you write modifications of your own for GUILE, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* 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 "_scm.h"
|
||||
#include "chars.h"
|
||||
|
||||
#include "scm_validate.h"
|
||||
#include "strorder.h"
|
||||
|
||||
|
||||
SCM_PROC1 (s_string_equal_p, "string=?", scm_tc7_rpsubr, scm_string_equal_p);
|
||||
|
||||
SCM
|
||||
scm_string_equal_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_equal_p
|
||||
{
|
||||
register scm_sizet i;
|
||||
register unsigned char *c1, *c2;
|
||||
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_equal_p);
|
||||
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_equal_p);
|
||||
SCM_VALIDATE_ROSTRING(1,s1);
|
||||
SCM_VALIDATE_ROSTRING(2,s2);
|
||||
|
||||
i = SCM_ROLENGTH (s2);
|
||||
if (SCM_ROLENGTH (s1) != i)
|
||||
|
|
@ -71,18 +73,18 @@ scm_string_equal_p (s1, s2)
|
|||
return SCM_BOOL_F;
|
||||
return SCM_BOOL_T;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_PROC1 (s_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, scm_string_ci_equal_p);
|
||||
|
||||
SCM
|
||||
scm_string_ci_equal_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_ci_equal_p
|
||||
{
|
||||
register scm_sizet i;
|
||||
register unsigned char *c1, *c2;
|
||||
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_equal_p);
|
||||
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_equal_p);
|
||||
SCM_VALIDATE_ROSTRING(1,s1);
|
||||
SCM_VALIDATE_ROSTRING(2,s2);
|
||||
|
||||
i = SCM_ROLENGTH (s2);
|
||||
if (SCM_ROLENGTH (s1) != i)
|
||||
{
|
||||
|
|
@ -95,20 +97,19 @@ scm_string_ci_equal_p (s1, s2)
|
|||
return SCM_BOOL_F;
|
||||
return SCM_BOOL_T;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_PROC1 (s_string_less_p, "string<?", scm_tc7_rpsubr, scm_string_less_p);
|
||||
|
||||
SCM
|
||||
scm_string_less_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_less_p
|
||||
{
|
||||
register scm_sizet i, len, s2len;
|
||||
register unsigned char *c1, *c2;
|
||||
register int c;
|
||||
|
||||
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_less_p);
|
||||
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_less_p);
|
||||
SCM_VALIDATE_ROSTRING(1,s1);
|
||||
SCM_VALIDATE_ROSTRING(2,s2);
|
||||
len = SCM_ROLENGTH (s1);
|
||||
s2len = SCM_ROLENGTH (s2);
|
||||
if (len>s2len) len = s2len;
|
||||
|
|
@ -128,49 +129,45 @@ scm_string_less_p (s1, s2)
|
|||
return answer;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_PROC1 (s_string_leq_p, "string<=?", scm_tc7_rpsubr, scm_string_leq_p);
|
||||
|
||||
SCM
|
||||
scm_string_leq_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_leq_p
|
||||
{
|
||||
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);
|
||||
|
||||
SCM
|
||||
scm_string_gr_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_gr_p
|
||||
{
|
||||
return scm_string_less_p (s2, s1);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_PROC1 (s_string_geq_p, "string>=?", scm_tc7_rpsubr, scm_string_geq_p);
|
||||
|
||||
SCM
|
||||
scm_string_geq_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_geq_p
|
||||
{
|
||||
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);
|
||||
|
||||
SCM
|
||||
scm_string_ci_less_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_ci_less_p
|
||||
{
|
||||
register scm_sizet i, len, s2len;
|
||||
register unsigned char *c1, *c2;
|
||||
register int c;
|
||||
SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_less_p);
|
||||
SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_less_p);
|
||||
SCM_VALIDATE_ROSTRING(1,s1);
|
||||
SCM_VALIDATE_ROSTRING(2,s2);
|
||||
len = SCM_ROLENGTH (s1);
|
||||
s2len = SCM_ROLENGTH (s2);
|
||||
if (len>s2len) len = s2len;
|
||||
|
|
@ -183,36 +180,34 @@ scm_string_ci_less_p (s1, s2)
|
|||
}
|
||||
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);
|
||||
|
||||
SCM
|
||||
scm_string_ci_leq_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_ci_leq_p
|
||||
{
|
||||
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);
|
||||
|
||||
SCM
|
||||
scm_string_ci_gr_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_ci_gr_p
|
||||
{
|
||||
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);
|
||||
|
||||
SCM
|
||||
scm_string_ci_geq_p (s1, s2)
|
||||
SCM s1;
|
||||
SCM s2;
|
||||
GUILE_PROC1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
|
||||
(SCM s1, SCM s2),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_string_ci_geq_p
|
||||
{
|
||||
return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -183,12 +183,7 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
|
|||
will be found. */
|
||||
|
||||
SCM
|
||||
scm_internal_catch (tag, body, body_data, handler, handler_data)
|
||||
SCM tag;
|
||||
scm_catch_body_t body;
|
||||
void *body_data;
|
||||
scm_catch_handler_t handler;
|
||||
void *handler_data;
|
||||
scm_internal_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_catch_handler_t handler, void *handler_data)
|
||||
{
|
||||
struct jmp_buf_and_retval jbr;
|
||||
SCM jmpbuf;
|
||||
|
|
@ -286,12 +281,7 @@ make_lazy_catch (struct lazy_catch *c)
|
|||
- It does not unwind the stack (this is the major difference).
|
||||
- If handler returns, its value is returned from the throw. */
|
||||
SCM
|
||||
scm_internal_lazy_catch (tag, body, body_data, handler, handler_data)
|
||||
SCM tag;
|
||||
scm_catch_body_t body;
|
||||
void *body_data;
|
||||
scm_catch_handler_t handler;
|
||||
void *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 lazy_catch, answer;
|
||||
struct lazy_catch c;
|
||||
|
|
@ -368,8 +358,7 @@ scm_internal_stack_catch (SCM tag,
|
|||
we're catching. */
|
||||
|
||||
SCM
|
||||
scm_body_thunk (body_data)
|
||||
void *body_data;
|
||||
scm_body_thunk (void *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
|
||||
from GC. */
|
||||
SCM
|
||||
scm_handle_by_proc (handler_data, tag, throw_args)
|
||||
void *handler_data;
|
||||
SCM tag;
|
||||
SCM throw_args;
|
||||
scm_handle_by_proc (void *handler_data, SCM tag, SCM throw_args)
|
||||
{
|
||||
SCM *handler_proc_p = (SCM *) handler_data;
|
||||
|
||||
|
|
@ -408,18 +394,14 @@ struct hbpca_data {
|
|||
};
|
||||
|
||||
static SCM
|
||||
hbpca_body (body_data)
|
||||
void *body_data;
|
||||
hbpca_body (void *body_data)
|
||||
{
|
||||
struct hbpca_data *data = (struct hbpca_data *)body_data;
|
||||
return scm_apply (data->proc, data->args, SCM_EOL);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_handle_by_proc_catching_all (handler_data, tag, throw_args)
|
||||
void *handler_data;
|
||||
SCM tag;
|
||||
SCM throw_args;
|
||||
scm_handle_by_proc_catching_all (void *handler_data, SCM tag, SCM throw_args)
|
||||
{
|
||||
SCM *handler_proc_p = (SCM *) handler_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 ...). */
|
||||
int
|
||||
scm_exit_status (args)
|
||||
SCM args;
|
||||
scm_exit_status (SCM 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. */
|
||||
|
||||
SCM
|
||||
scm_handle_by_message (handler_data, tag, args)
|
||||
void *handler_data;
|
||||
SCM tag;
|
||||
SCM args;
|
||||
scm_handle_by_message (void *handler_data, SCM tag, SCM args)
|
||||
{
|
||||
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
|
||||
want to let throws fall off the bottom of the wind list. */
|
||||
SCM
|
||||
scm_handle_by_message_noexit (handler_data, tag, args)
|
||||
void *handler_data;
|
||||
SCM tag;
|
||||
SCM args;
|
||||
scm_handle_by_message_noexit (void *handler_data, SCM tag, SCM args)
|
||||
{
|
||||
handler_message (handler_data, tag, args);
|
||||
|
||||
|
|
@ -541,10 +516,7 @@ scm_handle_by_message_noexit (handler_data, tag, args)
|
|||
|
||||
|
||||
SCM
|
||||
scm_handle_by_throw (handler_data, tag, args)
|
||||
void *handler_data;
|
||||
SCM tag;
|
||||
SCM args;
|
||||
scm_handle_by_throw (void *handler_data, SCM tag, SCM args)
|
||||
{
|
||||
scm_ithrow (tag, args, 1);
|
||||
return SCM_UNSPECIFIED; /* never returns */
|
||||
|
|
|
|||
|
|
@ -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.) */
|
||||
|
||||
SCM
|
||||
scm_cvref (v, pos, last)
|
||||
SCM v;
|
||||
scm_sizet pos;
|
||||
SCM last;
|
||||
scm_cvref (SCM v, scm_sizet pos, SCM last)
|
||||
{
|
||||
switch SCM_TYP7 (v)
|
||||
{
|
||||
|
|
@ -1345,9 +1342,7 @@ GUILE_PROC(scm_array_contents, "array-contents", 1, 1, 0,
|
|||
|
||||
|
||||
SCM
|
||||
scm_ra2contig (ra, copy)
|
||||
SCM ra;
|
||||
int copy;
|
||||
scm_ra2contig (SCM ra, int copy)
|
||||
{
|
||||
SCM ret;
|
||||
long inc = 1;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
scm_vector_length(v)
|
||||
SCM v;
|
||||
scm_vector_length(SCM v)
|
||||
{
|
||||
SCM_GASSERT1(SCM_NIMP(v) && SCM_VECTORP(v),
|
||||
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
|
||||
scm_vector_set_x(v, k, obj)
|
||||
SCM v;
|
||||
SCM k;
|
||||
SCM obj;
|
||||
scm_vector_set_x(SCM v, SCM k, SCM obj)
|
||||
{
|
||||
SCM_GASSERTn (SCM_NIMP(v) && SCM_VECTORP(v),
|
||||
g_vector_set_x, SCM_LIST3 (v, k, obj),
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue