diff options
Diffstat (limited to 'libguile')
65 files changed, 714 insertions, 613 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5d3375721..3f95b31ed 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2002-07-20 Han-Wen <hanwen@cs.uu.nl> + + * *.c: add space after commas everywhere. + + * *.c: use SCM_VECTOR_SET everywhere, where a vector is written. + Document cases where SCM_WRITABLE_VELTS() is used. + + * vectors.h (SCM_VELTS): prepare for write barrier, and let + SCM_VELTS() return a const pointer + (SCM_VECTOR_SET): add macro. + 2002-07-15 Dirk Herrmann <D.Herrmann@tu-bs.de> * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, diff --git a/libguile/_scm.h b/libguile/_scm.h index 0a1c3f4fe..7fedd5c00 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -125,10 +125,10 @@ #ifndef min -#define min(A,B) ((A) <= (B) ? (A) : (B)) +#define min(A, B) ((A) <= (B) ? (A) : (B)) #endif #ifndef max -#define max(A,B) ((A) >= (B) ? (A) : (B)) +#define max(A, B) ((A) >= (B) ? (A) : (B)) #endif #endif /* SCM__SCM_H */ diff --git a/libguile/async.c b/libguile/async.c index 118a0d0e6..f0a2b2eae 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -115,7 +115,7 @@ static scm_t_bits tc16_async; /* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. this is ugly. */ #define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) -#define VALIDATE_ASYNC(pos,a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) +#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) #define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 16) #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 6c707ac90..b75031cf5 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -132,7 +132,7 @@ scm_display_error_message (SCM message, SCM args, SCM port) } static void -display_expression (SCM frame,SCM pname,SCM source,SCM port) +display_expression (SCM frame, SCM pname, SCM source, SCM port) { SCM print_state = scm_make_print_state (); scm_print_state *pstate = SCM_PRINT_STATE (print_state); @@ -335,7 +335,7 @@ indent (int n, SCM port) } static void -display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM string; int i = 0, n; @@ -377,7 +377,7 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po } static void -display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM proc = SCM_FRAME_PROC (frame); SCM name = (!SCM_FALSEP (scm_procedure_p (proc)) @@ -400,15 +400,15 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0, "output.") #define FUNC_NAME s_scm_display_application { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); if (SCM_UNBNDP (port)) port = scm_cur_outp; else - SCM_VALIDATE_OPOUTPORT (2,port); + SCM_VALIDATE_OPOUTPORT (2, port); if (SCM_UNBNDP (indent)) indent = SCM_INUM0; else - SCM_VALIDATE_INUM (3,indent); + SCM_VALIDATE_INUM (3, indent); if (SCM_FRAME_PROC_P (frame)) /* Display an application. */ @@ -524,7 +524,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) } static void -display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_print_state *pstate) { int n, i, j; diff --git a/libguile/chars.c b/libguile/chars.c index cbc2cb5e8..f9800dfed 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -76,8 +76,8 @@ SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr, "else @code{#f}.") #define FUNC_NAME s_scm_char_less_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) < SCM_CHAR(y)); } #undef FUNC_NAME @@ -88,8 +88,8 @@ SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr, "ASCII sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_leq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) <= SCM_CHAR(y)); } #undef FUNC_NAME @@ -100,8 +100,8 @@ SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr, "sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_gr_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y)); } #undef FUNC_NAME @@ -112,8 +112,8 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, "ASCII sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_geq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y)); } #undef FUNC_NAME @@ -124,8 +124,8 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, "case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_eq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x))==scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -136,8 +136,8 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr, "ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_less_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL((scm_upcase(SCM_CHAR(x))) < scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -148,8 +148,8 @@ SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr, "ASCII sequence ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_leq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) <= scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -160,8 +160,8 @@ SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr, "sequence ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_gr_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) > scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -172,8 +172,8 @@ SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, "ASCII sequence ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_geq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) >= scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -185,7 +185,7 @@ SCM_DEFINE (scm_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, "Alphabetic means the same thing as the isalpha C library function.") #define FUNC_NAME s_scm_char_alphabetic_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isalpha(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -196,7 +196,7 @@ SCM_DEFINE (scm_char_numeric_p, "char-numeric?", 1, 0, 0, "Numeric means the same thing as the isdigit C library function.") #define FUNC_NAME s_scm_char_numeric_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isdigit(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -207,7 +207,7 @@ SCM_DEFINE (scm_char_whitespace_p, "char-whitespace?", 1, 0, 0, "Whitespace means the same thing as the isspace C library function.") #define FUNC_NAME s_scm_char_whitespace_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isspace(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -220,7 +220,7 @@ SCM_DEFINE (scm_char_upper_case_p, "char-upper-case?", 1, 0, 0, "Uppercase means the same thing as the isupper C library function.") #define FUNC_NAME s_scm_char_upper_case_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isupper(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -232,7 +232,7 @@ SCM_DEFINE (scm_char_lower_case_p, "char-lower-case?", 1, 0, 0, "Lowercase means the same thing as the islower C library function.") #define FUNC_NAME s_scm_char_lower_case_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(islower(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -246,7 +246,7 @@ SCM_DEFINE (scm_char_is_both_p, "char-is-both?", 1, 0, 0, "C library functions.") #define FUNC_NAME s_scm_char_is_both_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); } #undef FUNC_NAME @@ -260,7 +260,7 @@ SCM_DEFINE (scm_char_to_integer, "char->integer", 1, 0, 0, "ASCII sequence.") #define FUNC_NAME s_scm_char_to_integer { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return scm_ulong2num((unsigned long)SCM_CHAR(chr)); } #undef FUNC_NAME @@ -283,7 +283,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0, "Return the uppercase character version of @var{chr}.") #define FUNC_NAME s_scm_char_upcase { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -294,7 +294,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0, "Return the lowercase character version of @var{chr}.") #define FUNC_NAME s_scm_char_downcase { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -358,14 +358,14 @@ scm_downcase (unsigned int c) #ifdef EBCDIC char *const scm_charnames[] = { - "nul","soh","stx","etx", "pf", "ht", "lc","del", - 0 , 0 ,"smm", "vt", "ff", "cr", "so", "si", - "dle","dc1","dc2","dc3","res", "nl", "bs", "il", - "can", "em", "cc", 0 ,"ifs","igs","irs","ius", - "ds","sos", "fs", 0 ,"byp", "lf","eob","pre", - 0 , 0 , "sm", 0 , 0 ,"enq","ack","bel", - 0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot", - 0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub", + "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del", + 0 , 0 , "smm", "vt", "ff", "cr", "so", "si", + "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il", + "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius", + "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre", + 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel", + 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot", + 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub", "space", scm_s_newline, "tab", "backspace", "return", "page", "null"}; const char scm_charnums[] = diff --git a/libguile/continuations.h b/libguile/continuations.h index d8db12ff0..96d02fb77 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -91,7 +91,7 @@ typedef struct #define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_CELL_WORD_1 (x)) #define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items) -#define SCM_SET_CONTINUATION_LENGTH(x,n)\ +#define SCM_SET_CONTINUATION_LENGTH(x, n)\ (SCM_CONTREGS (x)->num_stack_items = (n)) #define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf) #define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv) diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 45a3ea443..258062232 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -245,17 +245,17 @@ SCM CTYPES2SCM (const CTYPE *data, long n) { long i; - SCM v, *velts; - + SCM v; + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), n > 0 && n <= SCM_VECTOR_MAX_LENGTH); v = scm_c_make_vector (n, SCM_UNSPECIFIED); - velts = SCM_VELTS (v); + for (i = 0; i < n; i++) #ifdef FLOATTYPE - velts[i] = scm_make_real ((double) data[i]); + SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i])); #else - velts[i] = SCM_MAKINUM (data[i]); + SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i])); #endif return v; } diff --git a/libguile/debug.c b/libguile/debug.c index 05c0cf3bd..dc947cc39 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -123,7 +123,7 @@ SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0, #define FUNC_NAME s_scm_with_traps { int trap_flag; - SCM_VALIDATE_THUNK (1,thunk); + SCM_VALIDATE_THUNK (1, thunk); return scm_internal_dynamic_wind (with_traps_before, with_traps_inner, with_traps_after, @@ -243,8 +243,8 @@ SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0, "offset @var{binding} and the cdr flag @var{cdrp}.") #define FUNC_NAME s_scm_make_iloc { - SCM_VALIDATE_INUM (1,frame); - SCM_VALIDATE_INUM (2,binding); + SCM_VALIDATE_INUM (1, frame); + SCM_VALIDATE_INUM (2, binding); return SCM_PACK (SCM_UNPACK (SCM_ILOC00) + SCM_IFRINC * SCM_INUM (frame) + (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0) @@ -289,7 +289,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0, if (SCM_UNBNDP (env)) env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE); else - SCM_VALIDATE_NULLORCONS (3,env); + SCM_VALIDATE_NULLORCONS (3, env); return scm_make_memoized (scm_cons (car, cdr), env); } #undef FUNC_NAME @@ -301,7 +301,7 @@ SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0, #define FUNC_NAME s_scm_mem_to_proc { SCM env; - SCM_VALIDATE_MEMOIZED (1,obj); + SCM_VALIDATE_MEMOIZED (1, obj); env = SCM_MEMOIZED_ENV (obj); obj = SCM_MEMOIZED_EXP (obj); if (!SCM_CONSP (obj) || !SCM_EQ_P (SCM_CAR (obj), SCM_IM_LAMBDA)) @@ -328,7 +328,7 @@ SCM_DEFINE (scm_unmemoize, "unmemoize", 1, 0, 0, "Unmemoize the memoized expression @var{m},") #define FUNC_NAME s_scm_unmemoize { - SCM_VALIDATE_MEMOIZED (1,m); + SCM_VALIDATE_MEMOIZED (1, m); return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m)); } #undef FUNC_NAME @@ -338,7 +338,7 @@ SCM_DEFINE (scm_memoized_environment, "memoized-environment", 1, 0, 0, "Return the environment of the memoized expression @var{m}.") #define FUNC_NAME s_scm_memoized_environment { - SCM_VALIDATE_MEMOIZED (1,m); + SCM_VALIDATE_MEMOIZED (1, m); return SCM_MEMOIZED_ENV (m); } #undef FUNC_NAME @@ -348,7 +348,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, "Return the name of the procedure @var{proc}") #define FUNC_NAME s_scm_procedure_name { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_subrs: return SCM_SNAME (proc); @@ -374,7 +374,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, "Return the source of the procedure @var{proc}.") #define FUNC_NAME s_scm_procedure_source { - SCM_VALIDATE_NIM (1,proc); + SCM_VALIDATE_NIM (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_closures: { @@ -407,7 +407,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0, "Return the environment of the procedure @var{proc}.") #define FUNC_NAME s_scm_procedure_environment { - SCM_VALIDATE_NIM (1,proc); + SCM_VALIDATE_NIM (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_closures: return SCM_ENV (proc); diff --git a/libguile/environments.c b/libguile/environments.c index f083b9399..a5cc3c244 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -533,7 +533,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data) size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray); SCM entry = scm_cons (symbol, data); SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET (obarray, hash, slot); return entry; } @@ -562,7 +562,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data) } slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET (obarray, hash, slot); return SCM_BOOL_F; } @@ -587,6 +587,46 @@ obarray_retrieve (SCM obarray, SCM sym) return SCM_UNDEFINED; } +/* + Remove first occurance of KEY from (cdr ALIST), + return (KEY . VAL) if found, otherwise return #f + + PRECONDITION: + + length (ALIST) >= 1 + */ +static +SCM +remove_key_from_alist (SCM alist, SCM key) +{ + SCM cell_cdr = alist; + alist =SCM_CDR (alist); + + /* + inv: cdr(cell_cdr) == alist + */ + while (!SCM_NULLP (alist)) + { + if (SCM_EQ_P(SCM_CAAR (alist), key)) + { + SCM entry = SCM_CAR(alist); + SCM_SETCDR(cell_cdr, SCM_CDR (alist)); + + return entry; + } + else + { + cell_cdr = SCM_CDR (cell_cdr); + } + + if (!SCM_NULLP(alist)) + alist = SCM_CDR (alist); + } + + return SCM_BOOL_F; +} + + /* * Remove entry from obarray. If the symbol was found and removed, the old @@ -596,22 +636,20 @@ static SCM obarray_remove (SCM obarray, SCM sym) { size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); - SCM lsym; - SCM *lsymp; + SCM table_entry = SCM_VELTS (obarray)[hash]; - /* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */ - for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]); - !SCM_NULLP (lsym); - lsym = *(lsymp = SCM_CDRLOC (lsym))) + if (SCM_NULLP(table_entry)) + return SCM_BOOL_F; + + if (SCM_EQ_P (SCM_CAAR (table_entry), sym)) { - SCM entry = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (entry), sym)) - { - *lsymp = SCM_CDR (lsym); - return entry; - } + SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry)); + return SCM_CAR(table_entry); + } + else + { + return remove_key_from_alist (table_entry, sym); } - return SCM_BOOL_F; } @@ -623,7 +661,7 @@ obarray_remove_all (SCM obarray) for (i = 0; i < size; i++) { - SCM_VELTS (obarray)[i] = SCM_EOL; + SCM_VECTOR_SET (obarray, i, SCM_EOL); } } @@ -655,7 +693,7 @@ struct core_environments_base { #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0]) #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \ - (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v)) + (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v))) diff --git a/libguile/error.c b/libguile/error.c index 9308205a6..2042b12fb 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -168,7 +168,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0, "must be an integer value.") #define FUNC_NAME s_scm_strerror { - SCM_VALIDATE_INUM (1,err); + SCM_VALIDATE_INUM (1, err); return scm_makfrom0str (SCM_I_STRERROR (SCM_INUM (err))); } #undef FUNC_NAME @@ -224,7 +224,7 @@ scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos) scm_error (scm_out_of_range_key, subr, "Argument ~S out of range: ~S", - scm_list_2 (pos,bad_value), + scm_list_2 (pos, bad_value), SCM_BOOL_F); } diff --git a/libguile/eval.c b/libguile/eval.c index 8a07bfeb1..699f9fc4a 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -798,7 +798,7 @@ iqq (SCM form, SCM env, unsigned long int depth) else if (SCM_VECTORP (form)) { size_t i = SCM_VECTOR_LENGTH (form); - SCM *data = SCM_VELTS (form); + SCM const *data = SCM_VELTS (form); SCM tmp = SCM_EOL; while (i != 0) tmp = scm_cons (data[--i], tmp); @@ -1020,7 +1020,7 @@ scm_m_let (SCM xorig, SCM env) } -SCM_SYNTAX (s_atapply,"@apply", scm_makmmacro, scm_m_apply); +SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply); SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); @@ -1032,8 +1032,8 @@ scm_m_apply (SCM xorig, SCM env SCM_UNUSED) } -SCM_SYNTAX(s_atcall_cc,"@call-with-current-continuation", scm_makmmacro, scm_m_cont); -SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc); +SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_makmmacro, scm_m_cont); +SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc); SCM @@ -3413,7 +3413,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, #define FUNC_NAME s_scm_nconc2last { SCM *lloc; - SCM_VALIDATE_NONEMPTYLIST (1,lst); + SCM_VALIDATE_NONEMPTYLIST (1, lst); lloc = &lst; while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be SCM_NULL_OR_NIL_P, but not @@ -3792,7 +3792,7 @@ check_map_args (SCM argv, SCM args, const char *who) { - SCM *ve = SCM_VELTS (argv); + SCM const *ve = SCM_VELTS (argv); long i; for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) @@ -3831,7 +3831,7 @@ scm_map (SCM proc, SCM arg1, SCM args) long i, len; SCM res = SCM_EOL; SCM *pres = &res; - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, @@ -3858,7 +3858,7 @@ scm_map (SCM proc, SCM arg1, SCM args) if (SCM_IMP (ve[i])) return res; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); } *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL)); pres = SCM_CDRLOC (*pres); @@ -3873,7 +3873,7 @@ SCM scm_for_each (SCM proc, SCM arg1, SCM args) #define FUNC_NAME s_for_each { - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ long i, len; len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), @@ -3899,7 +3899,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args) if (SCM_IMP (ve[i])) return SCM_UNSPECIFIED; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); } scm_apply (proc, arg1, SCM_EOL); } @@ -4011,7 +4011,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, unsigned long i = SCM_VECTOR_LENGTH (obj); ans = scm_c_make_vector (i, SCM_UNSPECIFIED); while (i--) - SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); + SCM_VECTOR_SET (ans, i, scm_copy_tree (SCM_VELTS (obj)[i])); return ans; } if (!SCM_CONSP (obj)) diff --git a/libguile/evalext.c b/libguile/evalext.c index 4b64eaa0f..16b3ed567 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -77,7 +77,7 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0, { SCM var; - SCM_VALIDATE_SYMBOL (1,sym); + SCM_VALIDATE_SYMBOL (1, sym); if (SCM_UNBNDP (env)) var = scm_sym2var (sym, scm_current_module_lookup_closure (), diff --git a/libguile/filesys.c b/libguile/filesys.c index fa7e75427..b1c757725 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -218,8 +218,8 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,owner); - SCM_VALIDATE_INUM (3,group); + SCM_VALIDATE_INUM (2, owner); + SCM_VALIDATE_INUM (3, group); #ifdef HAVE_FCHOWN if (SCM_INUMP (object) || (SCM_OPFPORTP (object))) { @@ -259,7 +259,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,mode); + SCM_VALIDATE_INUM (2, mode); if (SCM_INUMP (object) || SCM_OPFPORTP (object)) { if (SCM_INUMP (object)) @@ -295,7 +295,7 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0, } else { - SCM_VALIDATE_INUM (1,mode); + SCM_VALIDATE_INUM (1, mode); mask = umask (SCM_INUM (mode)); } return SCM_MAKINUM (mask); @@ -397,7 +397,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0, if (SCM_PORTP (fd_or_port)) return scm_close_port (fd_or_port); - SCM_VALIDATE_INUM (1,fd_or_port); + SCM_VALIDATE_INUM (1, fd_or_port); fd = SCM_INUM (fd_or_port); scm_evict_ports (fd); /* see scsh manual. */ SCM_SYSCALL (rv = close (fd)); @@ -448,58 +448,57 @@ static SCM scm_stat2scm (struct stat *stat_temp) { SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); - ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); - ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino); - ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode); - ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink); - ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid); - ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid); + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) stat_temp->st_dev)); + SCM_VECTOR_SET(ans, 1, scm_ulong2num ((unsigned long) stat_temp->st_ino)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) stat_temp->st_mode)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) stat_temp->st_nlink)); + SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) stat_temp->st_uid)); + SCM_VECTOR_SET(ans, 5, scm_ulong2num ((unsigned long) stat_temp->st_gid)); #ifdef HAVE_STRUCT_STAT_ST_RDEV - ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev); + SCM_VECTOR_SET(ans, 6, scm_ulong2num ((unsigned long) stat_temp->st_rdev)); #else - ve[6] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 6, SCM_BOOL_F); #endif - ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size); - ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime); - ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime); - ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime); + SCM_VECTOR_SET(ans, 7, scm_ulong2num ((unsigned long) stat_temp->st_size)); + SCM_VECTOR_SET(ans, 8, scm_ulong2num ((unsigned long) stat_temp->st_atime)); + SCM_VECTOR_SET(ans, 9, scm_ulong2num ((unsigned long) stat_temp->st_mtime)); + SCM_VECTOR_SET(ans, 10, scm_ulong2num ((unsigned long) stat_temp->st_ctime)); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE - ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize); + SCM_VECTOR_SET(ans, 11, scm_ulong2num ((unsigned long) stat_temp->st_blksize)); #else - ve[11] = scm_ulong2num (4096L); + SCM_VECTOR_SET(ans, 11, scm_ulong2num (4096L)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLOCKS - ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks); + SCM_VECTOR_SET(ans, 12, scm_ulong2num ((unsigned long) stat_temp->st_blocks)); #else - ve[12] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 12, SCM_BOOL_F); #endif { int mode = stat_temp->st_mode; if (S_ISREG (mode)) - ve[13] = scm_sym_regular; + SCM_VECTOR_SET(ans, 13, scm_sym_regular); else if (S_ISDIR (mode)) - ve[13] = scm_sym_directory; + SCM_VECTOR_SET(ans, 13, scm_sym_directory); #ifdef HAVE_S_ISLNK else if (S_ISLNK (mode)) - ve[13] = scm_sym_symlink; + SCM_VECTOR_SET(ans, 13, scm_sym_symlink); #endif else if (S_ISBLK (mode)) - ve[13] = scm_sym_block_special; + SCM_VECTOR_SET(ans, 13, scm_sym_block_special); else if (S_ISCHR (mode)) - ve[13] = scm_sym_char_special; + SCM_VECTOR_SET(ans, 13, scm_sym_char_special); else if (S_ISFIFO (mode)) - ve[13] = scm_sym_fifo; + SCM_VECTOR_SET(ans, 13, scm_sym_fifo); #ifdef S_ISSOCK else if (S_ISSOCK (mode)) - ve[13] = scm_sym_sock; + SCM_VECTOR_SET(ans, 13, scm_sym_sock); #endif else - ve[13] = scm_sym_unknown; + SCM_VECTOR_SET(ans, 13, scm_sym_unknown); - ve[14] = SCM_MAKINUM ((~S_IFMT) & mode); + SCM_VECTOR_SET(ans, 14, SCM_MAKINUM ((~S_IFMT) & mode)); /* the layout of the bits in ve[14] is intended to be portable. If there are systems that don't follow the usual convention, @@ -528,7 +527,7 @@ scm_stat2scm (struct stat *stat_temp) tmp <<= 1; if (S_IXOTH & mode) tmp += 1; - ve[14] = SCM_MAKINUM (tmp); + SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp)); */ } @@ -761,7 +760,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, } else { - SCM_VALIDATE_INUM (2,mode); + SCM_VALIDATE_INUM (2, mode); SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode))); } if (rv != 0) @@ -1021,7 +1020,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { @@ -1082,7 +1081,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec) if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { @@ -1212,7 +1211,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, timeout.tv_usec = 0; else { - SCM_VALIDATE_INUM (5,usecs); + SCM_VALIDATE_INUM (5, usecs); timeout.tv_usec = SCM_INUM (usecs); } } @@ -1285,12 +1284,12 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,cmd); + SCM_VALIDATE_INUM (2, cmd); if (SCM_OPFPORTP (object)) fdes = SCM_FPORT_FDES (object); else { - SCM_VALIDATE_INUM (1,object); + SCM_VALIDATE_INUM (1, object); fdes = SCM_INUM (object); } @@ -1327,7 +1326,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0, } else { - SCM_VALIDATE_INUM (1,object); + SCM_VALIDATE_INUM (1, object); fdes = SCM_INUM (object); } if (fsync (fdes) == -1) @@ -1464,7 +1463,7 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0, long int i; unsigned long int len; - SCM_VALIDATE_STRING (1,filename); + SCM_VALIDATE_STRING (1, filename); s = SCM_STRING_CHARS (filename); len = SCM_STRING_LENGTH (filename); @@ -1506,7 +1505,7 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, char *f, *s = 0; int i, j, len, end; - SCM_VALIDATE_STRING (1,filename); + SCM_VALIDATE_STRING (1, filename); f = SCM_STRING_CHARS (filename); len = SCM_STRING_LENGTH (filename); diff --git a/libguile/fluids.c b/libguile/fluids.c index 267918249..c975be49b 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -76,12 +76,12 @@ grow_fluids (scm_root_state *root_state, int new_length) i = 0; while (i < old_length) { - SCM_VELTS(new_fluids)[i] = SCM_VELTS(old_fluids)[i]; + SCM_VECTOR_SET (new_fluids, i, SCM_VELTS(old_fluids)[i]); i++; } while (i < new_length) { - SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; + SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F); i++; } @@ -171,7 +171,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n) grow_fluids (scm_root, n+1); - SCM_VELTS (scm_root->fluids)[n] = value; + SCM_VECTOR_SET (scm_root->fluids, n, value); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/gc.h b/libguile/gc.h index fce0add19..72ac83074 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -80,9 +80,24 @@ typedef scm_t_cell * SCM_CELLPTR; # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) #endif /* def _UNICOS */ +#ifdef GENGC +/* + TODO + */ +#else /* ! genGC */ + #define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_CELLS 256 +#define SCM_GC_CARD_GENERATION(card) +#define SCM_GC_FLAG_OBJECT_WRITE(x) + +#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) +#define SCM_GC_SET_CARD_BVEC(card, bvec) \ + ((card)->word_0 = (scm_t_bits) (bvec)) +#endif + + #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) #define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) @@ -92,10 +107,6 @@ typedef scm_t_cell * SCM_CELLPTR; #define SCM_GC_IN_CARD_HEADERP(x) \ SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS) -#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) -#define SCM_GC_SET_CARD_BVEC(card, bvec) \ - ((card)->word_0 = (scm_t_bits) (bvec)) - #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1)) #define SCM_GC_SET_CARD_FLAGS(card, flags) \ ((card)->word_1 = (scm_t_bits) (flags)) diff --git a/libguile/gh.h b/libguile/gh.h index 90b229dd9..e180c0d7c 100644 --- a/libguile/gh.h +++ b/libguile/gh.h @@ -167,7 +167,7 @@ SCM_API SCM gh_define(const char *name, SCM val); #define gh_string_length(str) scm_string_length(str) #define gh_string_ref(str, k) scm_string_ref(str, k) #define gh_string_set_x(str, k, chr) scm_string_set_x(str, k, chr) -#define gh_substring(str, start,end) scm_substring(str, start, end) +#define gh_substring(str, start, end) scm_substring(str, start, end) #define gh_string_append(args) scm_string_append(args) diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 31c9ea730..edcc290d3 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -122,10 +122,8 @@ gh_ints2scm (const int *d, long n) { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); - for (i = 0; i < n; ++i) - velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i])); + SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]))); return v; } @@ -135,10 +133,9 @@ gh_doubles2scm (const double *d, long n) { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); for(i = 0; i < n; i++) - velts[i] = scm_make_real (d[i]); + SCM_VECTOR_SET (v, i, scm_make_real (d[i])); return v; } diff --git a/libguile/goops.c b/libguile/goops.c index fcb8ee3ed..7ff530d1d 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -75,7 +75,7 @@ #define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers) -#define DEFVAR(v,val) \ +#define DEFVAR(v, val) \ { scm_eval (scm_list_3 (scm_sym_define_public, (v), (val)), \ scm_module_goops); } /* Temporary hack until we get the new module system */ @@ -84,13 +84,13 @@ (v), SCM_BOOL_F))) /* Fixme: Should use already interned symbols */ -#define CALL_GF1(name,a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \ a)) -#define CALL_GF2(name,a,b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \ a, b)) -#define CALL_GF3(name,a,b,c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \ a, b, c)) -#define CALL_GF4(name,a,b,c,d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \ a, b, c, d)) /* Class redefinition protocol: @@ -1684,7 +1684,7 @@ applicablep (SCM actual, SCM formal) } static int -more_specificp (SCM m1, SCM m2, SCM *targs) +more_specificp (SCM m1, SCM m2, SCM const *targs) { register SCM s1, s2; register long i; @@ -1704,7 +1704,7 @@ more_specificp (SCM m1, SCM m2, SCM *targs) * the end of this array). * */ - for (i=0,s1=SPEC_OF(m1),s2=SPEC_OF(m2); ; i++,s1=SCM_CDR(s1),s2=SCM_CDR(s2)) { + for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { if (SCM_NULLP(s1)) return 1; if (SCM_NULLP(s2)) return 0; if (SCM_CAR(s1) != SCM_CAR(s2)) { @@ -1731,13 +1731,13 @@ scm_i_vector2list (SCM l, long len) SCM z = scm_c_make_vector (len, SCM_UNDEFINED); for (j = 0; j < len; j++, l = SCM_CDR (l)) { - SCM_VELTS (z)[j] = SCM_CAR (l); + SCM_VECTOR_SET (z, j, SCM_CAR (l)); } return z; } static SCM -sort_applicable_methods (SCM method_list, long size, SCM *targs) +sort_applicable_methods (SCM method_list, long size, SCM const *targs) { long i, j, incr; SCM *v, vector = SCM_EOL; @@ -1761,7 +1761,13 @@ sort_applicable_methods (SCM method_list, long size, SCM *targs) { /* Too many elements in method_list to keep everything locally */ vector = scm_i_vector2list (save, size); - v = SCM_VELTS (vector); + + /* + This is a new vector. Don't worry about the write barrier. + We're not allocating elements in this routine, so this should + pose no problem. + */ + v = SCM_WRITABLE_VELTS (vector); } /* Use a simple shell sort since it is generally faster than qsort on @@ -1807,8 +1813,10 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) long count = 0; SCM l, fl, applicable = SCM_EOL; SCM save = args; - SCM buffer[BUFFSIZE], *types, *p; - SCM tmp; + SCM buffer[BUFFSIZE]; + SCM const *types; + SCM *p; + SCM tmp = SCM_EOL; /* Build the list of arguments types */ if (len >= BUFFSIZE) { @@ -1816,14 +1824,20 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) /* NOTE: Using pointers to malloced memory won't work if we 1. have preemtive threading, and, 2. have a GC which moves objects. */ - types = p = SCM_VELTS(tmp); + types = p = SCM_WRITABLE_VELTS(tmp); + + /* + note that we don't have to work to reset the generation + count. TMP is a new vector anyway, and it is found + conservatively. + */ } else types = p = buffer; for ( ; !SCM_NULLP (args); args = SCM_CDR (args)) *p++ = scm_class_of (SCM_CAR (args)); - + /* Build a list of all applicable methods */ for (l = SCM_SLOT (gf, scm_si_methods); !SCM_NULLP (l); l = SCM_CDR (l)) { @@ -1857,6 +1871,8 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) /* if we are here, it's because no-applicable-method hasn't signaled an error */ return SCM_BOOL_F; } + + scm_remember_upto_here (tmp); return (count == 1 ? applicable : sort_applicable_methods (applicable, count, types)); @@ -2135,7 +2151,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0, for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); - SCM_VELTS(v)[i] = SCM_CAR(l); + SCM_VECTOR_SET (v, i, SCM_CAR(l)); } return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F; } diff --git a/libguile/hash.c b/libguile/hash.c index f3fba4e3b..b89415086 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -145,7 +145,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d) case scm_tc7_vector: { size_t len = SCM_VECTOR_LENGTH(obj); - SCM *data = SCM_VELTS(obj); + SCM const *data = SCM_VELTS(obj); if (len > 5) { size_t i = d/2; diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 5cf8c7e6b..b347dd3d9 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -61,7 +61,7 @@ scm_c_make_hash_table (unsigned long k) SCM -scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),void * closure) +scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), void * closure) #define FUNC_NAME "scm_hash_fn_get_handle" { unsigned long k; @@ -80,8 +80,8 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc SCM -scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) #define FUNC_NAME "scm_hash_fn_create_handle_x" { unsigned long k; @@ -107,7 +107,7 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn) SCM old_bucket; old_bucket = SCM_VELTS (table)[k]; new_bucket = scm_acons (obj, init, old_bucket); - SCM_VELTS(table)[k] = new_bucket; + SCM_VECTOR_SET (table, k, new_bucket); SCM_REALLOW_INTS; return SCM_CAR (new_bucket); } @@ -116,8 +116,8 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn) SCM -scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) { SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); if (SCM_CONSP (it)) @@ -130,8 +130,8 @@ scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(), SCM -scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) { SCM it; @@ -145,8 +145,8 @@ scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(), SCM -scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(), - SCM (*delete_fn)(),void * closure) +scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), + SCM (*delete_fn)(), void * closure) { unsigned long k; SCM h; @@ -158,7 +158,7 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_f if (k >= SCM_VECTOR_LENGTH (table)) scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); h = assoc_fn (obj, SCM_VELTS (table)[k], closure); - SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]); + SCM_VECTOR_SET (table, k, delete_fn (h, SCM_VELTS(table)[k])); return h; } @@ -528,8 +528,8 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, "table into an a-list of key-value pairs.") #define FUNC_NAME s_scm_hash_fold { - SCM_VALIDATE_PROC (1,proc); - SCM_VALIDATE_VECTOR (3,table); + SCM_VALIDATE_PROC (1, proc); + SCM_VALIDATE_VECTOR (3, table); return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table); } #undef FUNC_NAME diff --git a/libguile/hooks.c b/libguile/hooks.c index ade502e54..3d01de1c8 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -228,7 +228,7 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0, { SCM arity, rest; int n_args; - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)), proc, SCM_ARG2, FUNC_NAME); n_args = SCM_HOOK_ARITY (hook); @@ -267,7 +267,7 @@ SCM_DEFINE (scm_reset_hook_x, "reset-hook!", 1, 0, 0, "value of this procedure is not specified.") #define FUNC_NAME s_scm_reset_hook_x { - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); SCM_SET_HOOK_PROCEDURES (hook, SCM_EOL); return SCM_UNSPECIFIED; } @@ -281,7 +281,7 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1, "last. The return value of this procedure is not specified.") #define FUNC_NAME s_scm_run_hook { - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); if (scm_ilength (args) != SCM_HOOK_ARITY (hook)) SCM_MISC_ERROR ("Hook ~S requires ~A arguments", scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook)))); diff --git a/libguile/init.c b/libguile/init.c index 0e8b6ff73..432983ea3 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -199,7 +199,7 @@ static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define "; static void -fixconfig (char *s1,char *s2,int s) +fixconfig (char *s1, char *s2, int s) { fputs (s1, stderr); fputs (s2, stderr); diff --git a/libguile/ioext.c b/libguile/ioext.c index 124332366..931a157f7 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -97,8 +97,8 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0, old = SCM_COERCE_OUTPORT (old); new = SCM_COERCE_OUTPORT (new); - SCM_VALIDATE_OPFPORT (1,old); - SCM_VALIDATE_OPFPORT (2,new); + SCM_VALIDATE_OPFPORT (1, old); + SCM_VALIDATE_OPFPORT (2, new); oldfd = SCM_FPORT_FDES (old); fp = SCM_FSTREAM (new); newfd = fp->fdes; @@ -138,7 +138,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, oldfd = SCM_INUM (fd_or_port); else { - SCM_VALIDATE_OPFPORT (1,fd_or_port); + SCM_VALIDATE_OPFPORT (1, fd_or_port); oldfd = SCM_FPORT_FDES (fd_or_port); } @@ -197,7 +197,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0, #define FUNC_NAME s_scm_fileno { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPFPORT (1, port); return SCM_MAKINUM (SCM_FPORT_FDES (port)); } #undef FUNC_NAME @@ -238,7 +238,7 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0, "same as that accepted by @ref{File Ports, open-file}.") #define FUNC_NAME s_scm_fdopen { - SCM_VALIDATE_INUM (1,fdes); + SCM_VALIDATE_INUM (1, fdes); SCM_VALIDATE_STRING (2, modes); return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F); @@ -269,8 +269,8 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); - SCM_VALIDATE_INUM (2,fd); + SCM_VALIDATE_OPFPORT (1, port); + SCM_VALIDATE_INUM (2, fd); stream = SCM_FSTREAM (port); old_fd = stream->fdes; new_fd = SCM_INUM (fd); @@ -300,7 +300,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0, int int_fd; long i; - SCM_VALIDATE_INUM_COPY (1,fd,int_fd); + SCM_VALIDATE_INUM_COPY (1, fd, int_fd); for (i = 0; i < scm_port_table_size; i++) { diff --git a/libguile/lang.c b/libguile/lang.c index 4fbcbf47f..6d6077935 100644 --- a/libguile/lang.c +++ b/libguile/lang.c @@ -85,7 +85,7 @@ SCM_DEFINE (scm_nil_car, "nil-car", 1, 0, 0, { if (SCM_NILP (x)) return scm_lisp_nil; - SCM_VALIDATE_CONS (1,x); + SCM_VALIDATE_CONS (1, x); return SCM_CAR (x); } #undef FUNC_NAME @@ -98,7 +98,7 @@ SCM_DEFINE (scm_nil_cdr, "nil-cdr", 1, 0, 0, { if (SCM_NILP (x)) return scm_lisp_nil; - SCM_VALIDATE_CONS (1,x); + SCM_VALIDATE_CONS (1, x); return SCM_EOL2NIL (SCM_CDR (x), x); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index fd815c7a6..e62ad5b37 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -59,7 +59,7 @@ /* creating lists */ -#define SCM_I_CONS(cell,x,y) \ +#define SCM_I_CONS(cell, x, y) \ do { \ cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \ } while (0) @@ -218,7 +218,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0, #define FUNC_NAME s_scm_length { long i; - SCM_VALIDATE_LIST_COPYLEN (1,lst,i); + SCM_VALIDATE_LIST_COPYLEN (1, lst, i); return SCM_MAKINUM (i); } #undef FUNC_NAME @@ -398,7 +398,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) return SCM_CAR (lst); @@ -422,7 +422,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) { SCM_SETCAR (lst, val); @@ -453,9 +453,9 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0, #define FUNC_NAME s_scm_list_tail { register long i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (i-- > 0) { - SCM_VALIDATE_CONS (1,lst); + SCM_VALIDATE_CONS (1, lst); lst = SCM_CDR(lst); } return lst; @@ -470,7 +470,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) { SCM_SETCDR (lst, val); @@ -501,12 +501,12 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0, SCM * pos; register long i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); answer = SCM_EOL; pos = &answer; while (i-- > 0) { - SCM_VALIDATE_CONS (1,lst); + SCM_VALIDATE_CONS (1, lst); *pos = scm_cons (SCM_CAR (lst), SCM_EOL); pos = SCM_CDRLOC (*pos); lst = SCM_CDR(lst); diff --git a/libguile/load.c b/libguile/load.c index f3511231f..300480bdf 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -282,12 +282,12 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, size_t max_path_len; /* maximum length of any PATH element */ size_t max_ext_len; /* maximum length of any EXTENSIONS element */ - SCM_VALIDATE_LIST (1,path); + SCM_VALIDATE_LIST (1, path); SCM_VALIDATE_STRING (2, filename); if (SCM_UNBNDP (extensions)) extensions = SCM_EOL; else - SCM_VALIDATE_LIST (3,extensions); + SCM_VALIDATE_LIST (3, extensions); filename_chars = SCM_STRING_CHARS (filename); filename_len = SCM_STRING_LENGTH (filename); diff --git a/libguile/macros.c b/libguile/macros.c index 467de2c02..77c068519 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -106,7 +106,7 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, "environment.") #define FUNC_NAME s_scm_makacro { - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro, SCM_UNPACK (code)); } #undef FUNC_NAME @@ -134,7 +134,7 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0, " non-memoizing macros in general. Use memoizing macros" " or r5rs macros instead."); - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code)); } #undef FUNC_NAME @@ -154,7 +154,7 @@ SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0, "form of the containing code.") #define FUNC_NAME s_scm_makmmacro { - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code)); } #undef FUNC_NAME @@ -206,7 +206,7 @@ SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0, "Return the name of the macro @var{m}.") #define FUNC_NAME s_scm_macro_name { - SCM_VALIDATE_SMOB (1,m,macro); + SCM_VALIDATE_SMOB (1, m, macro); return scm_procedure_name (SCM_PACK (SCM_SMOB_DATA (m))); } #undef FUNC_NAME @@ -217,7 +217,7 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0, "Return the transformer of the macro @var{m}.") #define FUNC_NAME s_scm_macro_transformer { - SCM_VALIDATE_SMOB (1,m,macro); + SCM_VALIDATE_SMOB (1, m, macro); return ((SCM_CLOSUREP (SCM_PACK (SCM_SMOB_DATA (m)))) ? SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F); } diff --git a/libguile/modules.h b/libguile/modules.h index f5e8e4f55..32d74efeb 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/libguile/net_db.c b/libguile/net_db.c index ecb075c8b..12885642e 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -154,7 +154,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, #define FUNC_NAME s_scm_gethost { SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM *ve = SCM_WRITABLE_VELTS (ans); SCM lst = SCM_EOL; struct hostent *entry; struct in_addr inad; @@ -190,13 +190,13 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, if (!entry) scm_resolv_error (FUNC_NAME, host); - ve[0] = scm_mem2string (entry->h_name, strlen (entry->h_name)); - ve[1] = scm_makfromstrs (-1, entry->h_aliases); - ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); - ve[3] = SCM_MAKINUM (entry->h_length + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); + SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L)); if (sizeof (struct in_addr) != entry->h_length) { - ve[4] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 4, SCM_BOOL_F); return ans; } for (argv = entry->h_addr_list; argv[i]; i++); @@ -205,7 +205,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, inad = *(struct in_addr *) argv[i]; lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); } - ve[4] = lst; + SCM_VECTOR_SET(ans, 4, lst); return ans; } #undef FUNC_NAME @@ -237,7 +237,8 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, struct netent *entry; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); + if (SCM_UNBNDP (net)) { entry = getnetent (); @@ -261,10 +262,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); - ve[0] = scm_mem2string (entry->n_name, strlen (entry->n_name)); - ve[1] = scm_makfromstrs (-1, entry->n_aliases); - ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); - ve[3] = scm_ulong2num (entry->n_net + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L)); return ans; } #undef FUNC_NAME @@ -286,7 +287,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, struct protoent *entry; ans = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); if (SCM_UNBNDP (protocol)) { entry = getprotoent (); @@ -310,9 +311,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); - ve[0] = scm_mem2string (entry->p_name, strlen (entry->p_name)); - ve[1] = scm_makfromstrs (-1, entry->p_aliases); - ve[2] = SCM_MAKINUM (entry->p_proto + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L)); return ans; } #undef FUNC_NAME @@ -326,11 +327,11 @@ scm_return_entry (struct servent *entry) SCM *ve; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); - ve[0] = scm_mem2string (entry->s_name, strlen (entry->s_name)); - ve[1] = scm_makfromstrs (-1, entry->s_aliases); - ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); - ve[3] = scm_mem2string (entry->s_proto, strlen (entry->s_proto)); + ve = SCM_WRITABLE_VELTS (ans); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); + SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); return ans; } @@ -367,7 +368,7 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, } else { - SCM_VALIDATE_INUM (1,name); + SCM_VALIDATE_INUM (1, name); entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol)); } if (!entry) diff --git a/libguile/numbers.c b/libguile/numbers.c index d3d8eca2e..09b81c7da 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -65,7 +65,7 @@ static SCM scm_divbigbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, in static SCM scm_divbigint (SCM x, long z, int sgn, int mode); -#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0) +#define SCM_SWAP(x, y) do { SCM __t = x; x = y; y = __t; } while (0) /* FLOBUFLEN is the maximum number of characters neccessary for the @@ -1257,7 +1257,7 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, SCM_WRONG_TYPE_ARG (2, k); } else - SCM_VALIDATE_ULONG_COPY (2,k,i2); + SCM_VALIDATE_ULONG_COPY (2, k, i2); if (i2 < 0) { i2 = -i2; @@ -1350,7 +1350,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, #define FUNC_NAME s_scm_bit_extract { unsigned long int istart, iend; - SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart); + SCM_VALIDATE_INUM_MIN_COPY (2, start,0, istart); SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend); SCM_ASSERT_RANGE (3, end, (iend >= istart)); @@ -2992,7 +2992,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, SCM answer; int base; SCM_VALIDATE_STRING (1, string); - SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base); + SCM_VALIDATE_INUM_MIN_DEF_COPY (2, radix,2,10, base); answer = scm_i_mem2number (SCM_STRING_CHARS (string), SCM_STRING_LENGTH (string), base); diff --git a/libguile/objects.c b/libguile/objects.c index 22fa968cb..4c22626c6 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -468,8 +468,8 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0, #define FUNC_NAME s_scm_make_class_object { unsigned long flags = 0; - SCM_VALIDATE_STRUCT (1,metaclass); - SCM_VALIDATE_STRING (2,layout); + SCM_VALIDATE_STRUCT (1, metaclass); + SCM_VALIDATE_STRING (2, layout); if (SCM_EQ_P (metaclass, scm_metaclass_operator)) flags = SCM_CLASSF_OPERATOR; return scm_i_make_class_object (metaclass, layout, flags); @@ -483,8 +483,8 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, #define FUNC_NAME s_scm_make_subclass_object { SCM pl; - SCM_VALIDATE_STRUCT (1,class); - SCM_VALIDATE_STRING (2,layout); + SCM_VALIDATE_STRUCT (1, class); + SCM_VALIDATE_STRING (2, layout); pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]); /* Convert symbol->string */ pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl)); diff --git a/libguile/objects.h b/libguile/objects.h index afeeb181a..5bf79fc9b 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -92,7 +92,7 @@ ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0) #define SCM_ENTITY_PROCEDURE(obj) \ (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure])) -#define SCM_SET_ENTITY_PROCEDURE(obj,v) \ +#define SCM_SET_ENTITY_PROCEDURE(obj, v) \ (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v)) #define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter])) #define SCM_SET_ENTITY_SETTER(obj, v) \ diff --git a/libguile/ports.c b/libguile/ports.c index fe9fcc6d6..057327460 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -264,7 +264,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); pt = SCM_PTAB_ENTRY (port); @@ -340,7 +340,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0, scm_t_port *pt = SCM_PTAB_ENTRY (port); long count; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); count = pt->read_end - pt->read_pos; if (pt->read_buf == pt->putback_buf) @@ -409,7 +409,7 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0, #define FUNC_NAME s_scm_set_current_input_port { SCM oinp = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); scm_cur_inp = port; return oinp; } @@ -423,7 +423,7 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0, { SCM ooutp = scm_cur_outp; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); scm_cur_outp = port; return ooutp; } @@ -437,7 +437,7 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, { SCM oerrp = scm_cur_errp; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); scm_cur_errp = port; return oerrp; } @@ -538,7 +538,7 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0, #define FUNC_NAME s_scm_pt_member { long i; - SCM_VALIDATE_INUM_COPY (1,index,i); + SCM_VALIDATE_INUM_COPY (1, index, i); if (i < 0 || i >= scm_port_table_size) return SCM_BOOL_F; else @@ -579,7 +579,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0, #define FUNC_NAME s_scm_port_revealed { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (scm_revealed_count (port)); } #undef FUNC_NAME @@ -592,8 +592,8 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_revealed_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,rcount); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, rcount); SCM_REVEALED (port) = SCM_INUM (rcount); return SCM_UNSPECIFIED; } @@ -638,7 +638,7 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0, modes[0] = '\0'; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPPORT (1,port); + SCM_VALIDATE_OPPORT (1, port); if (SCM_CELL_WORD_0 (port) & SCM_RDNG) { if (SCM_CELL_WORD_0 (port) & SCM_WRTNG) strcpy (modes, "r+"); @@ -805,7 +805,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0, "open.") #define FUNC_NAME s_scm_port_closed_p { - SCM_VALIDATE_PORT (1,port); + SCM_VALIDATE_PORT (1, port); return SCM_BOOL (!SCM_OPPORTP (port)); } #undef FUNC_NAME @@ -835,7 +835,7 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0, else { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); } scm_flush (port); return SCM_UNSPECIFIED; @@ -869,7 +869,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0, int c; if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_getc (port); if (EOF == c) return SCM_EOF_VAL; @@ -1196,7 +1196,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_getc (port); if (EOF == c) return SCM_EOF_VAL; @@ -1215,11 +1215,11 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0, { int c; - SCM_VALIDATE_CHAR (1,cobj); + SCM_VALIDATE_CHAR (1, cobj); if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (2,port); + SCM_VALIDATE_OPINPORT (2, port); c = SCM_CHAR (cobj); @@ -1236,11 +1236,11 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0, "@var{port} is not supplied, the current-input-port is used.") #define FUNC_NAME s_scm_unread_string { - SCM_VALIDATE_STRING (1,str); + SCM_VALIDATE_STRING (1, str); if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (2,port); + SCM_VALIDATE_OPINPORT (2, port); scm_ungets (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port); @@ -1297,7 +1297,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, } else /* file descriptor?. */ { - SCM_VALIDATE_INUM (1,fd_port); + SCM_VALIDATE_INUM (1, fd_port); rv = lseek (SCM_INUM (fd_port), off, how); if (rv == -1) SCM_SYSERROR; @@ -1339,11 +1339,11 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, { /* must supply length if object is a filename. */ if (SCM_STRINGP (object)) - SCM_MISC_ERROR("must supply length if OBJECT is a filename",SCM_EOL); + SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL); length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); } - c_length = SCM_NUM2LONG (2,length); + c_length = SCM_NUM2LONG (2, length); if (c_length < 0) SCM_MISC_ERROR ("negative offset", SCM_EOL); @@ -1384,7 +1384,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, #define FUNC_NAME s_scm_port_line { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (SCM_LINUM (port)); } #undef FUNC_NAME @@ -1395,8 +1395,8 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_line_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,line); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, line); SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line); return SCM_UNSPECIFIED; } @@ -1416,7 +1416,7 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, #define FUNC_NAME s_scm_port_column { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (SCM_COL (port)); } #undef FUNC_NAME @@ -1429,8 +1429,8 @@ SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_column_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,column); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, column); SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column); return SCM_UNSPECIFIED; } @@ -1444,7 +1444,7 @@ SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0, #define FUNC_NAME s_scm_port_filename { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_FILENAME (port); } #undef FUNC_NAME @@ -1458,7 +1458,7 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_filename_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); /* We allow the user to set the filename to whatever he likes. */ SCM_SET_FILENAME (port, filename); return SCM_UNSPECIFIED; diff --git a/libguile/ports.h b/libguile/ports.h index e9a1af950..500a3802a 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -168,15 +168,15 @@ SCM_API long scm_port_table_size; /* Number of ports in scm_port_table. */ SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN) #define SCM_PTAB_ENTRY(x) ((scm_t_port *) SCM_CELL_WORD_1 (x)) -#define SCM_SETPTAB_ENTRY(x,ent) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (ent))) +#define SCM_SETPTAB_ENTRY(x, ent) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (ent))) #define SCM_STREAM(x) (SCM_PTAB_ENTRY(x)->stream) -#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = (scm_t_bits) (s)) +#define SCM_SETSTREAM(x, s) (SCM_PTAB_ENTRY(x)->stream = (scm_t_bits) (s)) #define SCM_FILENAME(x) (SCM_PTAB_ENTRY(x)->file_name) #define SCM_SET_FILENAME(x, n) (SCM_PTAB_ENTRY(x)->file_name = (n)) #define SCM_LINUM(x) (SCM_PTAB_ENTRY(x)->line_number) #define SCM_COL(x) (SCM_PTAB_ENTRY(x)->column_number) #define SCM_REVEALED(x) (SCM_PTAB_ENTRY(x)->revealed) -#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = (s)) +#define SCM_SETREVEALED(x, s) (SCM_PTAB_ENTRY(x)->revealed = (s)) #define SCM_INCLINE(port) {SCM_LINUM (port) += 1; SCM_COL (port) = 0;} #define SCM_INCCOL(port) {SCM_COL (port) += 1;} diff --git a/libguile/posix.c b/libguile/posix.c index 066e0f90b..f9d8a22e0 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -236,9 +236,13 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, getgroups (ngroups, groups); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); - while (--ngroups >= 0) - SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]); + { + SCM * ve = SCM_WRITABLE_VELTS(ans); + + while (--ngroups >= 0) + ve[ngroups] = SCM_MAKINUM (groups [ngroups]); + } free (groups); return ans; } @@ -253,12 +257,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, "or getpwent respectively.") #define FUNC_NAME s_scm_getpwuid { - SCM result; struct passwd *entry; - SCM *ve; - result = scm_c_make_vector (7, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED); if (SCM_UNBNDP (user) || SCM_FALSEP (user)) { SCM_SYSCALL (entry = getpwent ()); @@ -279,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, if (!entry) SCM_MISC_ERROR ("entry not found", SCM_EOL); - ve[0] = scm_makfrom0str (entry->pw_name); - ve[1] = scm_makfrom0str (entry->pw_passwd); - ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid); - ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid); - ve[4] = scm_makfrom0str (entry->pw_gecos); + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid)); + SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos)); if (!entry->pw_dir) - ve[5] = scm_makfrom0str (""); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str ("")); else - ve[5] = scm_makfrom0str (entry->pw_dir); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir)); if (!entry->pw_shell) - ve[6] = scm_makfrom0str (""); + SCM_VECTOR_SET(ans, 6, scm_makfrom0str ("")); else - ve[6] = scm_makfrom0str (entry->pw_shell); - return result; + SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell)); + return ans; } #undef FUNC_NAME #endif /* HAVE_GETPWENT */ @@ -325,11 +326,9 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, "or getgrent respectively.") #define FUNC_NAME s_scm_getgrgid { - SCM result; struct group *entry; - SCM *ve; - result = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED); + if (SCM_UNBNDP (name) || SCM_FALSEP (name)) { SCM_SYSCALL (entry = getgrent ()); @@ -348,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, if (!entry) SCM_SYSERROR; - ve[0] = scm_makfrom0str (entry->gr_name); - ve[1] = scm_makfrom0str (entry->gr_passwd); - ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid); - ve[3] = scm_makfromstrs (-1, entry->gr_mem); - return result; + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid)); + SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem)); + return ans; } #undef FUNC_NAME @@ -401,8 +400,8 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0, "@end defvar") #define FUNC_NAME s_scm_kill { - SCM_VALIDATE_INUM (1,pid); - SCM_VALIDATE_INUM (2,sig); + SCM_VALIDATE_INUM (1, pid); + SCM_VALIDATE_INUM (2, sig); /* Signal values are interned in scm_init_posix(). */ #ifdef HAVE_KILL if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) @@ -457,12 +456,12 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0, int i; int status; int ioptions; - SCM_VALIDATE_INUM (1,pid); + SCM_VALIDATE_INUM (1, pid); if (SCM_UNBNDP (options)) ioptions = 0; else { - SCM_VALIDATE_INUM (2,options); + SCM_VALIDATE_INUM (2, options); /* Flags are interned in scm_init_posix. */ ioptions = SCM_INUM (options); } @@ -484,7 +483,7 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); /* On Ultrix, the WIF... macros assume their argument is an lvalue; go figure. SCM_INUM does not yield an lvalue. */ @@ -504,7 +503,7 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); lstatus = SCM_INUM (status); if (WIFSIGNALED (lstatus)) @@ -522,7 +521,7 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); lstatus = SCM_INUM (status); if (WIFSTOPPED (lstatus)) @@ -610,7 +609,7 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setuid { - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); if (setuid (SCM_INUM (id)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -624,7 +623,7 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setgid { - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); if (setgid (SCM_INUM (id)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -642,7 +641,7 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0, { int rv; - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); #ifdef HAVE_SETEUID rv = seteuid (SCM_INUM (id)); #else @@ -668,7 +667,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0, { int rv; - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); #ifdef HAVE_SETEUID rv = setegid (SCM_INUM (id)); #else @@ -708,8 +707,8 @@ SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setpgid { - SCM_VALIDATE_INUM (1,pid); - SCM_VALIDATE_INUM (2,pgid); + SCM_VALIDATE_INUM (1, pid); + SCM_VALIDATE_INUM (2, pgid); /* FIXME(?): may be known as setpgrp. */ if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) SCM_SYSERROR; @@ -746,7 +745,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, int fd; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPPORT (1,port); + SCM_VALIDATE_OPPORT (1, port); if (!SCM_FPORTP (port)) return SCM_BOOL_F; fd = SCM_FPORT_FDES (port); @@ -794,7 +793,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPFPORT (1, port); fd = SCM_FPORT_FDES (port); if ((pgid = tcgetpgrp (fd)) == -1) SCM_SYSERROR; @@ -817,8 +816,8 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); - SCM_VALIDATE_INUM (2,pgid); + SCM_VALIDATE_OPFPORT (1, port); + SCM_VALIDATE_INUM (2, pgid); fd = SCM_FPORT_FDES (port); if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1) SCM_SYSERROR; @@ -984,17 +983,16 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0, { struct utsname buf; SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); if (uname (&buf) < 0) SCM_SYSERROR; - ve[0] = scm_makfrom0str (buf.sysname); - ve[1] = scm_makfrom0str (buf.nodename); - ve[2] = scm_makfrom0str (buf.release); - ve[3] = scm_makfrom0str (buf.version); - ve[4] = scm_makfrom0str (buf.machine); + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename)); + SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release)); + SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version)); + SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine)); /* a linux special? - ve[5] = scm_makfrom0str (buf.domainname); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname)); */ return ans; } @@ -1225,7 +1223,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, char *clocale; char *rv; - SCM_VALIDATE_INUM (1,category); + SCM_VALIDATE_INUM (1, category); if (SCM_UNBNDP (locale)) { clocale = NULL; @@ -1267,9 +1265,9 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, int ctype = 0; SCM_VALIDATE_STRING (1, path); - SCM_VALIDATE_SYMBOL (2,type); - SCM_VALIDATE_INUM (3,perms); - SCM_VALIDATE_INUM (4,dev); + SCM_VALIDATE_SYMBOL (2, type); + SCM_VALIDATE_INUM (3, perms); + SCM_VALIDATE_INUM (4, dev); p = SCM_SYMBOL_CHARS (type); if (strcmp (p, "regular") == 0) @@ -1289,7 +1287,7 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, ctype = S_IFSOCK; #endif else - SCM_OUT_OF_RANGE (2,type); + SCM_OUT_OF_RANGE (2, type); SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms), SCM_INUM (dev))); @@ -1308,7 +1306,7 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_nice { - SCM_VALIDATE_INUM (1,incr); + SCM_VALIDATE_INUM (1, incr); if (nice(SCM_INUM(incr)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; diff --git a/libguile/print.c b/libguile/print.c index fd869402a..63389f1f5 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -216,7 +216,7 @@ make_print_state (void) = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); scm_print_state *pstate = SCM_PRINT_STATE (print_state); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); - pstate->ref_stack = SCM_VELTS (pstate->ref_vect); + pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); return print_state; } @@ -260,23 +260,22 @@ static void grow_ref_stack (scm_print_state *pstate) { unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); - SCM *old_elts = SCM_VELTS (pstate->ref_vect); + SCM const *old_elts = SCM_VELTS (pstate->ref_vect); unsigned long int new_size = 2 * pstate->ceiling; SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); - SCM *new_elts = SCM_VELTS (new_vect); unsigned long int i; for (i = 0; i != old_size; ++i) - new_elts [i] = old_elts [i]; + SCM_VECTOR_SET (new_vect, i, old_elts [i]); pstate->ref_vect = new_vect; - pstate->ref_stack = new_elts; + pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect); pstate->ceiling = new_size; } static void -print_circref (SCM port,scm_print_state *pstate,SCM ref) +print_circref (SCM port, scm_print_state *pstate, SCM ref) { register long i; long self = pstate->top - 1; @@ -757,7 +756,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port) /* Print a list. */ void -scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate) +scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) { register SCM hare, tortoise; long floor = pstate->top - 2; @@ -1012,7 +1011,7 @@ SCM_DEFINE (scm_newline, "newline", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_outp; - SCM_VALIDATE_OPORT_VALUE (1,port); + SCM_VALIDATE_OPORT_VALUE (1, port); scm_putc ('\n', SCM_COERCE_OUTPORT (port)); return SCM_UNSPECIFIED; @@ -1027,8 +1026,8 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_outp; - SCM_VALIDATE_CHAR (1,chr); - SCM_VALIDATE_OPORT_VALUE (2,port); + SCM_VALIDATE_CHAR (1, chr); + SCM_VALIDATE_OPORT_VALUE (2, port); scm_putc ((int) SCM_CHAR (chr), SCM_COERCE_OUTPORT (port)); #ifdef HAVE_PIPE @@ -1079,8 +1078,8 @@ SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0, #define FUNC_NAME s_scm_port_with_print_state { SCM pwps; - SCM_VALIDATE_OPORT_VALUE (1,port); - SCM_VALIDATE_PRINTSTATE (2,pstate); + SCM_VALIDATE_OPORT_VALUE (1, port); + SCM_VALIDATE_PRINTSTATE (2, pstate); port = SCM_COERCE_OUTPORT (port); SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate))); return pwps; diff --git a/libguile/procprop.c b/libguile/procprop.c index 099691ca4..f7887ed55 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, "Return @var{obj}'s property list.") #define FUNC_NAME s_scm_procedure_properties { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc), SCM_PROCPROPS (SCM_CLOSUREP (proc) ? proc @@ -191,7 +191,7 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0 { if (!SCM_CLOSUREP (proc)) proc = scm_stand_in_scm_proc(proc); - SCM_VALIDATE_CLOSURE (1,proc); + SCM_VALIDATE_CLOSURE (1, proc); SCM_SETPROCPROPS (proc, new_val); return SCM_UNSPECIFIED; } @@ -210,7 +210,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, p, SCM_ARG1, FUNC_NAME); return arity; } - SCM_VALIDATE_PROC (1,p); + SCM_VALIDATE_PROC (1, p); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (SCM_CLOSUREP (p) ? p @@ -228,7 +228,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM assoc; if (!SCM_CLOSUREP (p)) p = scm_stand_in_scm_proc(p); - SCM_VALIDATE_CLOSURE (1,p); + SCM_VALIDATE_CLOSURE (1, p); if (SCM_EQ_P (k, scm_sym_arity)) SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p)); diff --git a/libguile/ramap.c b/libguile/ramap.c index e2389451f..24c1474d9 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -488,7 +488,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_vector: case scm_tc7_wvect: for (i = base; n--; i += inc) - SCM_VELTS (ra)[i] = fill; + SCM_VECTOR_SET (ra, i, fill); break; case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (fill), badarg2); @@ -905,7 +905,7 @@ scm_ra_eqp (SCM ra0, SCM ras) /* opt 0 means <, nonzero means >= */ static int -ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt) +ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) { long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2); @@ -1230,7 +1230,7 @@ scm_array_identity (SCM dst, SCM src) static int -ramap (SCM ra0,SCM proc,SCM ras) +ramap (SCM ra0, SCM proc, SCM ras) { long i = SCM_ARRAY_DIMS (ra0)->lbnd; long inc = SCM_ARRAY_DIMS (ra0)->inc; @@ -1243,7 +1243,8 @@ ramap (SCM ra0,SCM proc,SCM ras) else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const *ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1255,6 +1256,7 @@ ramap (SCM ra0,SCM proc,SCM ras) ras = scm_vector (ras); ve = SCM_VELTS (ras); } + for (; i <= n; i++, i1 += inc1) { args = SCM_EOL; @@ -1269,7 +1271,7 @@ ramap (SCM ra0,SCM proc,SCM ras) static int -ramap_cxr (SCM ra0,SCM proc,SCM ras) +ramap_cxr (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1330,7 +1332,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras) static int -ramap_rp (SCM ra0,SCM proc,SCM ras) +ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED; @@ -1415,7 +1417,7 @@ ramap_rp (SCM ra0,SCM proc,SCM ras) static int -ramap_1 (SCM ra0,SCM proc,SCM ras) +ramap_1 (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1436,7 +1438,7 @@ ramap_1 (SCM ra0,SCM proc,SCM ras) static int -ramap_2o (SCM ra0,SCM proc,SCM ras) +ramap_2o (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1483,7 +1485,7 @@ ramap_2o (SCM ra0,SCM proc,SCM ras) static int -ramap_a (SCM ra0,SCM proc,SCM ras) +ramap_a (SCM ra0, SCM proc, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; @@ -1521,7 +1523,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, "unspecified. The order of application is unspecified.") #define FUNC_NAME s_scm_array_map_x { - SCM_VALIDATE_PROC (2,proc); + SCM_VALIDATE_PROC (2, proc); SCM_VALIDATE_REST_ARGUMENT (lra); switch (SCM_TYP7 (proc)) { @@ -1624,7 +1626,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, static int -rafe (SCM ra0,SCM proc,SCM ras) +rafe (SCM ra0, SCM proc, SCM ras) { long i = SCM_ARRAY_DIMS (ra0)->lbnd; unsigned long i0 = SCM_ARRAY_BASE (ra0); @@ -1637,7 +1639,8 @@ rafe (SCM ra0,SCM proc,SCM ras) else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const*ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1668,7 +1671,7 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, "in row-major order. The value returned is unspecified.") #define FUNC_NAME s_scm_array_for_each { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_REST_ARGUMENT (lra); scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME); return SCM_UNSPECIFIED; @@ -1697,8 +1700,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, #define FUNC_NAME s_scm_array_index_map_x { unsigned long i; - SCM_VALIDATE_NIM (1,ra); - SCM_VALIDATE_PROC (2,proc); + SCM_VALIDATE_NIM (1, ra); + SCM_VALIDATE_PROC (2, proc); switch (SCM_TYP7(ra)) { default: @@ -1706,9 +1709,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, case scm_tc7_vector: case scm_tc7_wvect: { - SCM *ve = SCM_VELTS (ra); for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) - ve[i] = scm_call_1 (proc, SCM_MAKINUM (i)); + SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_MAKINUM (i))); return SCM_UNSPECIFIED; } case scm_tc7_string: @@ -1778,7 +1780,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, static int -raeql_1 (SCM ra0,SCM as_equal,SCM ra1) +raeql_1 (SCM ra0, SCM as_equal, SCM ra1) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; unsigned long i0 = 0, i1 = 0; @@ -1906,7 +1908,7 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1) static int -raeql (SCM ra0,SCM as_equal,SCM ra1) +raeql (SCM ra0, SCM as_equal, SCM ra1) { SCM v0 = ra0, v1 = ra1; scm_t_array_dim dim0, dim1; diff --git a/libguile/random.c b/libguile/random.c index 319d2a0c6..ea1d3a755 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -362,7 +362,7 @@ SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_ra SCM_DEFINE (scm_random, "random", 1, 1, 0, (SCM n, SCM state), - "Return a number in [0,N).\n" + "Return a number in [0, N).\n" "\n" "Accepts a positive integer or real n and returns a\n" "number of the same type between zero (inclusive) and\n" @@ -378,14 +378,14 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); if (SCM_INUMP (n)) { unsigned long m = SCM_INUM (n); - SCM_ASSERT_RANGE (1,n,m > 0); + SCM_ASSERT_RANGE (1, n, m > 0); return SCM_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); } - SCM_VALIDATE_NIM (1,n); + SCM_VALIDATE_NIM (1, n); if (SCM_REALP (n)) return scm_make_real (SCM_REAL_VALUE (n) * scm_c_uniform01 (SCM_RSTATE (state))); @@ -401,7 +401,7 @@ SCM_DEFINE (scm_copy_random_state, "copy-random-state", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -413,7 +413,7 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0, { if (SCM_NUMBERP (seed)) seed = scm_number_to_string (seed, SCM_UNDEFINED); - SCM_VALIDATE_STRING (1,seed); + SCM_VALIDATE_STRING (1, seed); return make_rstate (scm_c_make_rstate (SCM_STRING_CHARS (seed), SCM_STRING_LENGTH (seed))); } @@ -427,7 +427,7 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_uniform01 (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -442,7 +442,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -496,10 +496,10 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, "The sum of the squares of the numbers is returned.") #define FUNC_NAME s_scm_random_solid_sphere_x { - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); scm_random_normal_vector_x (v, state); vector_scale (v, pow (scm_c_uniform01 (SCM_RSTATE (state)), @@ -519,10 +519,10 @@ SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0, "unit n-sphere.") #define FUNC_NAME s_scm_random_hollow_sphere_x { - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); scm_random_normal_vector_x (v, state); vector_scale (v, 1 / sqrt (vector_sum_squares (v))); return SCM_UNSPECIFIED; @@ -538,14 +538,14 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, #define FUNC_NAME s_scm_random_normal_vector_x { int n; - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); n = SCM_INUM (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) - SCM_VELTS (v)[n] = scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); + SCM_VECTOR_SET (v, n, scm_make_real (scm_c_normal01 (SCM_RSTATE (state)))); else while (--n >= 0) ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); @@ -564,7 +564,7 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_exp1 (SCM_RSTATE (state))); } #undef FUNC_NAME diff --git a/libguile/read.c b/libguile/read.c index 36a9fff2d..f829cd535 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -107,7 +107,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_flush_ws (port, (char *) NULL); if (EOF == c) @@ -280,7 +280,7 @@ static SCM scm_get_hash_procedure(int c); static char s_list[]="list"; SCM -scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) +scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) #define FUNC_NAME "scm_lreadr" { int c; diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index eb28ebe4b..ddb73ea03 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -247,13 +247,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, regmatch_t *matches; SCM mvec = SCM_BOOL_F; - SCM_VALIDATE_RGXP (1,rx); + SCM_VALIDATE_RGXP (1, rx); SCM_VALIDATE_STRING (2, str); - SCM_VALIDATE_INUM_DEF_COPY (3,start,0,offset); - SCM_ASSERT_RANGE (3,start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); + SCM_VALIDATE_INUM_DEF_COPY (3, start,0, offset); + SCM_ASSERT_RANGE (3, start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); if (SCM_UNBNDP (flags)) flags = SCM_INUM0; - SCM_VALIDATE_INUM (4,flags); + SCM_VALIDATE_INUM (4, flags); /* re_nsub doesn't account for the `subexpression' representing the whole regexp, so add 1 to nmatches. */ diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index cdb44e049..95e15ec4d 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -192,10 +192,10 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #endif int query_only = 0; int save_handler = 0; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); + SCM old_handler; - SCM_VALIDATE_INUM_COPY (1,signum,csig); + SCM_VALIDATE_INUM_COPY (1, signum, csig); #if defined(HAVE_SIGACTION) #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS) /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS @@ -207,13 +207,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #endif if (!SCM_UNBNDP (flags)) { - SCM_VALIDATE_INUM (3,flags); + SCM_VALIDATE_INUM (3, flags); action.sa_flags |= SCM_INUM (flags); } sigemptyset (&action.sa_mask); #endif SCM_DEFER_INTS; - old_handler = scheme_handlers[csig]; + old_handler = SCM_VELTS(*signal_handlers)[csig]; if (SCM_UNBNDP (handler)) query_only = 1; else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) @@ -226,7 +226,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #else chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); #endif - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); } else SCM_OUT_OF_RANGE (2, handler); @@ -241,7 +241,8 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, { action = orig_handlers[csig]; orig_handlers[csig].sa_handler = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); + } #else if (orig_handlers[csig] == SIG_ERR) @@ -250,13 +251,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, { chandler = orig_handlers[csig]; orig_handlers[csig] = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); } #endif } else { - SCM_VALIDATE_NIM (2,handler); + SCM_VALIDATE_NIM (2, handler); #ifdef HAVE_SIGACTION action.sa_handler = take_signal; if (orig_handlers[csig].sa_handler == SIG_ERR) @@ -266,7 +267,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, if (orig_handlers[csig] == SIG_ERR) save_handler = 1; #endif - scheme_handlers[csig] = handler; + SCM_VECTOR_SET (*signal_handlers, csig, handler); } /* XXX - Silently ignore setting handlers for `program error signals' @@ -346,8 +347,6 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, #define FUNC_NAME s_scm_restore_signals { int i; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); - for (i = 0; i < NSIG; i++) { #ifdef HAVE_SIGACTION @@ -356,7 +355,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, if (sigaction (i, &orig_handlers[i], NULL) == -1) SCM_SYSERROR; orig_handlers[i].sa_handler = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); } #else if (orig_handlers[i] != SIG_ERR) @@ -364,7 +363,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, if (signal (i, orig_handlers[i]) == SIG_ERR) SCM_SYSERROR; orig_handlers[i] = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); } #endif } @@ -385,7 +384,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0, #define FUNC_NAME s_scm_alarm { unsigned int j; - SCM_VALIDATE_INUM (1,i); + SCM_VALIDATE_INUM (1, i); j = alarm (SCM_INUM (i)); return SCM_MAKINUM (j); } @@ -496,7 +495,7 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0, #define FUNC_NAME s_scm_sleep { unsigned long j; - SCM_VALIDATE_INUM_MIN (1,i,0); + SCM_VALIDATE_INUM_MIN (1, i,0); #ifdef USE_THREADS j = scm_thread_sleep (SCM_INUM(i)); #else @@ -513,7 +512,7 @@ SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0, "all platforms.") #define FUNC_NAME s_scm_usleep { - SCM_VALIDATE_INUM_MIN (1,i,0); + SCM_VALIDATE_INUM_MIN (1, i,0); #ifdef USE_THREADS /* If we have threads, we use the thread system's sleep function. */ @@ -542,7 +541,7 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0, "@var{sig} is as described for the kill procedure.") #define FUNC_NAME s_scm_raise { - SCM_VALIDATE_INUM (1,sig); + SCM_VALIDATE_INUM (1, sig); SCM_DEFER_INTS; if (kill (getpid (), (int) SCM_INUM (sig)) != 0) SCM_SYSERROR; diff --git a/libguile/simpos.c b/libguile/simpos.c index 5dc7fff13..f3269000f 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, int cstatus = 0; if (!SCM_UNBNDP (status)) { - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); cstatus = SCM_INUM (status); } exit (cstatus); diff --git a/libguile/smob.c b/libguile/smob.c index e907fb107..847748d33 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -137,11 +137,11 @@ scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) #define SCM_SMOB_APPLY0(SMOB) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB) -#define SCM_SMOB_APPLY1(SMOB,A1) \ +#define SCM_SMOB_APPLY1(SMOB, A1) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1) -#define SCM_SMOB_APPLY2(SMOB,A1,A2) \ +#define SCM_SMOB_APPLY2(SMOB, A1, A2) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2) -#define SCM_SMOB_APPLY3(SMOB,A1,A2,A3) \ +#define SCM_SMOB_APPLY3(SMOB, A1, A2, A3) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2, A3) static SCM diff --git a/libguile/smob.h b/libguile/smob.h index 50de243ce..c1893a433 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -115,9 +115,9 @@ do { \ #define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)]) #define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply) #define SCM_SMOB_APPLY_0(x) (SCM_SMOB_DESCRIPTOR (x).apply_0 (x)) -#define SCM_SMOB_APPLY_1(x,a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1))) -#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) -#define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst))) +#define SCM_SMOB_APPLY_1(x, a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1))) +#define SCM_SMOB_APPLY_2(x, a1, a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) +#define SCM_SMOB_APPLY_3(x, a1, a2, rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst))) SCM_API long scm_numsmob; SCM_API scm_smob_descriptor scm_smobs[]; diff --git a/libguile/socket.c b/libguile/socket.c index 86b61aca1..5ea34d78a 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -473,9 +473,9 @@ SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0, int fam; int fd[2]; - SCM_VALIDATE_INUM (1,family); - SCM_VALIDATE_INUM (2,style); - SCM_VALIDATE_INUM (3,proto); + SCM_VALIDATE_INUM (1, family); + SCM_VALIDATE_INUM (2, style); + SCM_VALIDATE_INUM (3, proto); fam = SCM_INUM (family); @@ -673,9 +673,9 @@ SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0, { int fd; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,how); - SCM_ASSERT_RANGE(2,how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how)); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, how); + SCM_ASSERT_RANGE(2, how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how)); fd = SCM_FPORT_FDES (sock); if (shutdown (fd, SCM_INUM (how)) == -1) SCM_SYSERROR; @@ -820,8 +820,8 @@ SCM_DEFINE (scm_connect, "connect", 3, 0, 1, int size; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,fam); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, fam); fd = SCM_FPORT_FDES (sock); soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME, &size); @@ -911,8 +911,8 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0, { int fd; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,backlog); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, backlog); fd = SCM_FPORT_FDES (sock); if (listen (fd, SCM_INUM (backlog)) == -1) SCM_SYSERROR; @@ -925,8 +925,8 @@ static SCM scm_addr_vector (const struct sockaddr *address, const char *proc) { short int fam = address->sa_family; - SCM result; - SCM *ve; + SCM ans =SCM_EOL; + switch (fam) { @@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in *nad = (struct sockaddr_in *) address; - result = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); - ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); + ans = scm_c_make_vector (3, SCM_UNSPECIFIED); + + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr))); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port))); } break; #ifdef HAVE_IPV6 @@ -946,16 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; - result = scm_c_make_vector (5, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = ipv6_net_to_num (nad->sin6_addr.s6_addr); - ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)); - ve[3] = scm_ulong2num ((unsigned long) nad->sin6_flowinfo); + ans = scm_c_make_vector (5, SCM_UNSPECIFIED); + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port))); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo)); #ifdef HAVE_SIN6_SCOPE_ID - ve[4] = scm_ulong2num ((unsigned long) nad->sin6_scope_id); + SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id)); #else - ve[4] = SCM_INUM0; + SCM_VECTOR_SET(ans, 4, SCM_INUM0); #endif } break; @@ -965,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_un *nad = (struct sockaddr_un *) address; - result = scm_c_make_vector (2, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = scm_mem2string (nad->sun_path, strlen (nad->sun_path)); + ans = scm_c_make_vector (2, SCM_UNSPECIFIED); + + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); } break; #endif @@ -976,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) scm_misc_error (proc, "Unrecognised address family: ~A", scm_list_1 (SCM_MAKINUM (fam))); } - return result; + return ans; } /* calculate the size of a buffer large enough to hold any supported @@ -1047,7 +1046,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0, struct sockaddr *addr = (struct sockaddr *) max_addr; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); if (getsockname (fd, addr, &addr_size) == -1) SCM_SYSERROR; @@ -1069,7 +1068,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0, struct sockaddr *addr = (struct sockaddr *) max_addr; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); if (getpeername (fd, addr, &addr_size) == -1) SCM_SYSERROR; @@ -1102,9 +1101,9 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0, int fd; int flg; - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_STRING (2,buf); - SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_STRING (2, buf); + SCM_VALIDATE_INUM_DEF_COPY (3, flags,0, flg); fd = SCM_FPORT_FDES (sock); SCM_SYSCALL (rv = recv (fd, SCM_STRING_CHARS (buf), SCM_STRING_LENGTH (buf), flg)); @@ -1136,9 +1135,9 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0, int flg; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_STRING (2, message); - SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg); + SCM_VALIDATE_INUM_DEF_COPY (3, flags,0, flg); fd = SCM_FPORT_FDES (sock); SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg)); @@ -1182,7 +1181,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0, char max_addr[MAX_ADDR_SIZE]; struct sockaddr *addr = (struct sockaddr *) max_addr; - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 4, start, offset, 5, end, cend); @@ -1236,9 +1235,9 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, int size; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_FPORT (1,sock); + SCM_VALIDATE_FPORT (1, sock); SCM_VALIDATE_STRING (2, message); - SCM_VALIDATE_INUM (3,fam); + SCM_VALIDATE_INUM (3, fam); fd = SCM_FPORT_FDES (sock); soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, FUNC_NAME, &size); @@ -1246,7 +1245,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, flg = 0; else { - SCM_VALIDATE_CONS (5,args_and_flags); + SCM_VALIDATE_CONS (5, args_and_flags); flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags)); } SCM_SYSCALL (rv = sendto (fd, SCM_STRING_CHARS (message), diff --git a/libguile/sort.c b/libguile/sort.c index ac0eaf5a2..8bca27c41 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -425,18 +425,20 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, size_t vlen, spos, len, size = sizeof (SCM); SCM *vp; - SCM_VALIDATE_VECTOR (1,vec); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_VECTOR (1, vec); + SCM_VALIDATE_NIM (2, less); - vp = SCM_VELTS (vec); /* vector pointer */ + vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */ vlen = SCM_VECTOR_LENGTH (vec); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); - SCM_ASSERT_RANGE (3,startpos, spos <= vlen); - SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1); + SCM_ASSERT_RANGE (3, startpos, spos <= vlen); + SCM_VALIDATE_INUM_RANGE (4, endpos,0, vlen+1); len = SCM_INUM (endpos) - spos; quicksort (&vp[spos], len, size, scm_cmp_function (less), less); + SCM_GC_FLAG_OBJECT_WRITE(vec); + return SCM_UNSPECIFIED; /* return vec; */ } @@ -455,18 +457,18 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, { long len, j; /* list/vector length, temp j */ SCM item, rest; /* rest of items loop variable */ - SCM *vp; + SCM const *vp; cmp_fun_t cmp = scm_cmp_function (less); if (SCM_NULL_OR_NIL_P (items)) return SCM_BOOL_T; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { len = scm_ilength (items); /* also checks that it's a pure list */ - SCM_ASSERT_RANGE (1,items,len >= 0); + SCM_ASSERT_RANGE (1, items, len >= 0); if (len <= 1) return SCM_BOOL_T; @@ -529,7 +531,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, long alen, blen; /* list lengths */ SCM build, last; cmp_fun_t cmp = scm_cmp_function (less); - SCM_VALIDATE_NIM (3,less); + SCM_VALIDATE_NIM (3, less); if (SCM_NULL_OR_NIL_P (alist)) return blist; @@ -537,8 +539,8 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, return alist; else { - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); if ((*cmp) (less, SCM_CARLOC (blist), SCM_CARLOC (alist))) { build = scm_cons (SCM_CAR (blist), SCM_EOL); @@ -641,15 +643,15 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, { long alen, blen; /* list lengths */ - SCM_VALIDATE_NIM (3,less); + SCM_VALIDATE_NIM (3, less); if (SCM_NULL_OR_NIL_P (alist)) return blist; else if (SCM_NULL_OR_NIL_P (blist)) return alist; else { - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); return scm_merge_list_x (alist, blist, alen, blen, scm_cmp_function (less), @@ -719,11 +721,11 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } else if (SCM_VECTORP (items)) @@ -752,12 +754,12 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } @@ -850,10 +852,10 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } else if (SCM_VECTORP (items)) @@ -861,7 +863,14 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, SCM *temp, *vp; len = SCM_VECTOR_LENGTH (items); temp = malloc (len * sizeof(SCM)); - vp = SCM_VELTS (items); + + + vp = SCM_WRITABLE_VELTS (items); + /* + This routine modifies VP + */ + + SCM_GC_FLAG_OBJECT_WRITE(items); scm_merge_vector_step (vp, temp, scm_cmp_function (less), @@ -889,10 +898,10 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } @@ -906,7 +915,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, retvec = scm_make_uve (len, scm_array_prototype (items)); scm_array_copy_x (items, retvec); temp = malloc (len * sizeof (SCM)); - vp = SCM_VELTS (retvec); + + /* + don't worry about write barrier: retvec is new anyway. + */ + vp = SCM_WRITABLE_VELTS (retvec); + scm_merge_vector_step (vp, temp, scm_cmp_function (less), @@ -932,8 +946,8 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0, #define FUNC_NAME s_scm_sort_list_x { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); + SCM_VALIDATE_NIM (2, less); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } #undef FUNC_NAME @@ -946,8 +960,8 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, #define FUNC_NAME s_scm_sort_list { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); + SCM_VALIDATE_NIM (2, less); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 3c679d3bd..a47dfc0ea 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -179,7 +179,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, #define FUNC_NAME s_scm_source_properties { SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -200,7 +200,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, #define FUNC_NAME s_scm_set_source_properties_x { SCM handle; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -218,7 +218,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, #define FUNC_NAME s_scm_source_property { SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -250,7 +250,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { scm_whash_handle h; SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -284,7 +284,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, } else if (SCM_EQ_P (scm_sym_line, key)) { - SCM_VALIDATE_INUM (3,datum); + SCM_VALIDATE_INUM (3, datum); if (SRCPROPSP (p)) SETSRCPROPLINE (p, SCM_INUM (datum)); else @@ -294,7 +294,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, } else if (SCM_EQ_P (scm_sym_column, key)) { - SCM_VALIDATE_INUM (3,datum); + SCM_VALIDATE_INUM (3, datum); if (SRCPROPSP (p)) SETSRCPROPCOL (p, SCM_INUM (datum)); else diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 117dc39ed..37b452be9 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -110,10 +110,10 @@ typedef struct scm_t_srcprops_chunk #define CLEARSRCPROPBRK(p) \ (SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) \ & ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) -#define SRCPROPMAKPOS(l,c) (((l) << 12) + (c)) -#define SETSRCPROPPOS(p,l,c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) -#define SETSRCPROPLINE(p,l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) -#define SETSRCPROPCOL(p,c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) +#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) +#define SETSRCPROPPOS(p, l, c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) +#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) +#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) #define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) diff --git a/libguile/stacks.c b/libguile/stacks.c index a2a397985..5765a2286 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -151,7 +151,7 @@ * is read from a continuation. */ static scm_t_bits -stack_depth (scm_t_debug_frame *dframe,long offset,SCM *id,int *maxp) +stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp) { long n; long max_depth = SCM_BACKTRACE_MAXDEPTH; @@ -183,7 +183,7 @@ stack_depth (scm_t_debug_frame *dframe,long offset,SCM *id,int *maxp) /* Read debug info from DFRAME into IFRAME. */ static void -read_frame (scm_t_debug_frame *dframe,long offset,scm_t_info_frame *iframe) +read_frame (scm_t_debug_frame *dframe, long offset, scm_t_info_frame *iframe) { scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */ if (SCM_EVALFRAMEP (*dframe)) @@ -250,7 +250,7 @@ do { \ */ static scm_t_bits -read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *iframes) +read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *iframes) { scm_t_info_frame *iframe = iframes; scm_t_debug_info *info; @@ -344,7 +344,7 @@ read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *ifra */ static void -narrow_stack (SCM stack,long inner,SCM inner_key,long outer,SCM outer_key) +narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) { scm_t_stack *s = SCM_STACK (stack); unsigned long int i; @@ -591,7 +591,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0, "Return the length of @var{stack}.") #define FUNC_NAME s_scm_stack_length { - SCM_VALIDATE_STACK (1,stack); + SCM_VALIDATE_STACK (1, stack); return SCM_MAKINUM (SCM_STACK_LENGTH (stack)); } #undef FUNC_NAME @@ -657,7 +657,7 @@ SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0, "Return the frame number of @var{frame}.") #define FUNC_NAME s_scm_frame_number { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_MAKINUM (SCM_FRAME_NUMBER (frame)); } #undef FUNC_NAME @@ -667,7 +667,7 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0, "Return the source of @var{frame}.") #define FUNC_NAME s_scm_frame_source { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_FRAME_SOURCE (frame); } #undef FUNC_NAME @@ -678,7 +678,7 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0, "procedure is associated with @var{frame}.") #define FUNC_NAME s_scm_frame_procedure { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return (SCM_FRAME_PROC_P (frame) ? SCM_FRAME_PROC (frame) : SCM_BOOL_F); @@ -690,7 +690,7 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0, "Return the arguments of @var{frame}.") #define FUNC_NAME s_scm_frame_arguments { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_FRAME_ARGS (frame); } #undef FUNC_NAME @@ -732,7 +732,7 @@ SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0, "Return @code{#t} if @var{frame} is a real frame.") #define FUNC_NAME s_scm_frame_real_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_REAL_P (frame)); } #undef FUNC_NAME @@ -742,7 +742,7 @@ SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0, "Return @code{#t} if a procedure is associated with @var{frame}.") #define FUNC_NAME s_scm_frame_procedure_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_PROC_P (frame)); } #undef FUNC_NAME @@ -752,7 +752,7 @@ SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, "Return @code{#t} if @var{frame} contains evaluated arguments.") #define FUNC_NAME s_scm_frame_evaluating_args_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame)); } #undef FUNC_NAME @@ -762,7 +762,7 @@ SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0, "Return @code{#t} if @var{frame} is an overflow frame.") #define FUNC_NAME s_scm_frame_overflow_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame)); } #undef FUNC_NAME diff --git a/libguile/stime.c b/libguile/stime.c index 6b04e7e88..0db4ab26d 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -195,11 +195,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0, rv = times (&t); if (rv == -1) SCM_SYSERROR; - SCM_VELTS (result)[0] = scm_long2num (rv); - SCM_VELTS (result)[1] = scm_long2num (t.tms_utime); - SCM_VELTS (result)[2] = scm_long2num (t.tms_stime); - SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); - SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); + SCM_VECTOR_SET (result, 0, scm_long2num (rv)); + SCM_VECTOR_SET (result, 1, scm_long2num (t.tms_utime)); + SCM_VECTOR_SET (result, 2, scm_long2num (t.tms_stime)); + SCM_VECTOR_SET (result ,3, scm_long2num (t.tms_cutime)); + SCM_VECTOR_SET (result, 4, scm_long2num (t.tms_cstime)); return result; } #undef FUNC_NAME @@ -282,17 +282,17 @@ filltime (struct tm *bd_time, int zoff, char *zname) { SCM result = scm_c_make_vector (11, SCM_UNDEFINED); - SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec); - SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); - SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour); - SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday); - SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon); - SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year); - SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday); - SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday); - SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst); - SCM_VELTS (result)[9] = SCM_MAKINUM (zoff); - SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F; + SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec)); + SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min)); + SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour)); + SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday)); + SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon)); + SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year)); + SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday)); + SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday)); + SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst)); + SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff)); + SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F); return result; } @@ -439,7 +439,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, static void bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) { - SCM *velts; + SCM const *velts; int i; SCM_ASSERT (SCM_VECTORP (sbd_time) diff --git a/libguile/strings.c b/libguile/strings.c index 4f5b48b18..cbfab7b99 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -271,8 +271,8 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, #define FUNC_NAME s_scm_string_set_x { SCM_VALIDATE_STRING (1, str); - SCM_VALIDATE_INUM_RANGE (2,k,0,SCM_STRING_LENGTH(str)); - SCM_VALIDATE_CHAR (3,chr); + SCM_VALIDATE_INUM_RANGE (2, k,0, SCM_STRING_LENGTH(str)); + SCM_VALIDATE_CHAR (3, chr); SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr); return SCM_UNSPECIFIED; } @@ -323,7 +323,7 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (args); for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) { s = SCM_CAR (l); - SCM_VALIDATE_STRING (SCM_ARGn,s); + SCM_VALIDATE_STRING (SCM_ARGn, s); i += SCM_STRING_LENGTH (s); } res = scm_allocate_string (i); diff --git a/libguile/strop.c b/libguile/strop.c index bf2ede036..f42046ba1 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -190,17 +190,17 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, { long s1, s2, e, len; - SCM_VALIDATE_STRING (1,str1); - SCM_VALIDATE_INUM_COPY (2,start1,s1); - SCM_VALIDATE_INUM_COPY (3,end1,e); - SCM_VALIDATE_STRING (4,str2); - SCM_VALIDATE_INUM_COPY (5,start2,s2); + SCM_VALIDATE_STRING (1, str1); + SCM_VALIDATE_INUM_COPY (2, start1, s1); + SCM_VALIDATE_INUM_COPY (3, end1, e); + SCM_VALIDATE_STRING (4, str2); + SCM_VALIDATE_INUM_COPY (5, start2, s2); len = e - s1; - SCM_ASSERT_RANGE (3,end1,len >= 0); - SCM_ASSERT_RANGE (2,start1,s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); - SCM_ASSERT_RANGE (5,start2,s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); - SCM_ASSERT_RANGE (3,end1,e <= SCM_STRING_LENGTH (str1) && e >= 0); - SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_STRING_LENGTH (str2)); + SCM_ASSERT_RANGE (3, end1, len >= 0); + SCM_ASSERT_RANGE (2, start1, s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); + SCM_ASSERT_RANGE (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); + SCM_ASSERT_RANGE (3, end1, e <= SCM_STRING_LENGTH (str1) && e >= 0); + SCM_ASSERT_RANGE (5, start2, len+s2 <= SCM_STRING_LENGTH (str2)); SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), (void *)(&(SCM_STRING_CHARS(str1)[s1])), @@ -226,12 +226,12 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, { long i, e; char c; - SCM_VALIDATE_STRING (1,str); - SCM_VALIDATE_INUM_COPY (2,start,i); - SCM_VALIDATE_INUM_COPY (3,end,e); - SCM_VALIDATE_CHAR_COPY (4,fill,c); - SCM_ASSERT_RANGE (2,start,i <= SCM_STRING_LENGTH (str) && i >= 0); - SCM_ASSERT_RANGE (3,end,e <= SCM_STRING_LENGTH (str) && e >= 0); + SCM_VALIDATE_STRING (1, str); + SCM_VALIDATE_INUM_COPY (2, start, i); + SCM_VALIDATE_INUM_COPY (3, end, e); + SCM_VALIDATE_CHAR_COPY (4, fill, c); + SCM_ASSERT_RANGE (2, start, i <= SCM_STRING_LENGTH (str) && i >= 0); + SCM_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0); while (i<e) SCM_STRING_CHARS (str)[i++] = c; return SCM_UNSPECIFIED; } @@ -249,7 +249,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_string_null_p { - SCM_VALIDATE_STRING (1,str); + SCM_VALIDATE_STRING (1, str); return SCM_BOOL (SCM_STRING_LENGTH (str) == 0); } #undef FUNC_NAME @@ -266,7 +266,7 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, long i; SCM res = SCM_EOL; unsigned char *src; - SCM_VALIDATE_STRING (1,str); + SCM_VALIDATE_STRING (1, str); src = SCM_STRING_UCHARS (str); for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); return res; @@ -307,8 +307,8 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, { register char *dst, c; register long k; - SCM_VALIDATE_STRING_COPY (1,str,dst); - SCM_VALIDATE_CHAR_COPY (2,chr,c); + SCM_VALIDATE_STRING_COPY (1, str, dst); + SCM_VALIDATE_CHAR_COPY (2, chr, c); for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; return SCM_UNSPECIFIED; } diff --git a/libguile/struct.c b/libguile/struct.c index c92beabb9..e8585896e 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -440,8 +440,8 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, scm_t_bits * data; SCM handle; - SCM_VALIDATE_VTABLE (1,vtable); - SCM_VALIDATE_INUM (2,tail_array_size); + SCM_VALIDATE_VTABLE (1, vtable); + SCM_VALIDATE_INUM (2, tail_array_size); SCM_VALIDATE_REST_ARGUMENT (init); layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); @@ -569,8 +569,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, char field_type = 0; - SCM_VALIDATE_STRUCT (1,handle); - SCM_VALIDATE_INUM (2,pos); + SCM_VALIDATE_STRUCT (1, handle); + SCM_VALIDATE_INUM (2, pos); layout = SCM_STRUCT_LAYOUT (handle); data = SCM_STRUCT_DATA (handle); @@ -579,7 +579,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, fields_desc = SCM_SYMBOL_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT_RANGE(1,pos, p < n_fields); + SCM_ASSERT_RANGE(1, pos, p < n_fields); if (p * 2 < SCM_SYMBOL_LENGTH (layout)) { @@ -645,8 +645,8 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, char * fields_desc; char field_type = 0; - SCM_VALIDATE_STRUCT (1,handle); - SCM_VALIDATE_INUM (2,pos); + SCM_VALIDATE_STRUCT (1, handle); + SCM_VALIDATE_INUM (2, pos); layout = SCM_STRUCT_LAYOUT (handle); data = SCM_STRUCT_DATA (handle); @@ -655,7 +655,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, fields_desc = SCM_SYMBOL_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT_RANGE (1,pos, p < n_fields); + SCM_ASSERT_RANGE (1, pos, p < n_fields); if (p * 2 < SCM_SYMBOL_LENGTH (layout)) { @@ -708,7 +708,7 @@ SCM_DEFINE (scm_struct_vtable, "struct-vtable", 1, 0, 0, "Return the vtable structure that describes the type of @var{struct}.") #define FUNC_NAME s_scm_struct_vtable { - SCM_VALIDATE_STRUCT (1,handle); + SCM_VALIDATE_STRUCT (1, handle); return SCM_STRUCT_VTABLE (handle); } #undef FUNC_NAME @@ -719,7 +719,7 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0, "Return the vtable tag of the structure @var{handle}.") #define FUNC_NAME s_scm_struct_vtable_tag { - SCM_VALIDATE_VTABLE (1,handle); + SCM_VALIDATE_VTABLE (1, handle); return scm_long2num ((long) SCM_STRUCT_DATA (handle) >> 3); } #undef FUNC_NAME @@ -758,7 +758,7 @@ SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0, "Return the name of the vtable @var{vtable}.") #define FUNC_NAME s_scm_struct_vtable_name { - SCM_VALIDATE_VTABLE (1,vtable); + SCM_VALIDATE_VTABLE (1, vtable); return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable))); } #undef FUNC_NAME @@ -768,8 +768,8 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0, "Set the name of the vtable @var{vtable} to @var{name}.") #define FUNC_NAME s_scm_set_struct_vtable_name_x { - SCM_VALIDATE_VTABLE (1,vtable); - SCM_VALIDATE_SYMBOL (2,name); + SCM_VALIDATE_VTABLE (1, vtable); + SCM_VALIDATE_SYMBOL (2, name); SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)), name); return SCM_UNSPECIFIED; diff --git a/libguile/symbols.c b/libguile/symbols.c index 780575228..73635dea4 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -133,7 +133,7 @@ scm_mem2symbol (const char *name, size_t len) slot = SCM_VELTS (symbols) [hash]; cell = scm_cons (symbol, SCM_UNDEFINED); - SCM_VELTS (symbols) [hash] = scm_cons (cell, slot); + SCM_VECTOR_SET (symbols, hash, scm_cons (cell, slot)); return symbol; } @@ -319,7 +319,7 @@ SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, "Return the contents of @var{symbol}'s @dfn{function slot}.") #define FUNC_NAME s_scm_symbol_fref { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); return SCM_SYMBOL_FUNC (s); } #undef FUNC_NAME @@ -330,7 +330,7 @@ SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, "Return the @dfn{property list} currently associated with @var{symbol}.") #define FUNC_NAME s_scm_symbol_pref { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); return SCM_SYMBOL_PROPS (s); } #undef FUNC_NAME @@ -341,7 +341,7 @@ SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, "Change the binding of @var{symbol}'s function slot.") #define FUNC_NAME s_scm_symbol_fset_x { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); SCM_SET_SYMBOL_FUNC (s, val); return SCM_UNSPECIFIED; } @@ -353,7 +353,7 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, "Change the binding of @var{symbol}'s property slot.") #define FUNC_NAME s_scm_symbol_pset_x { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); SCM_DEFER_INTS; SCM_SET_SYMBOL_PROPS (s, val); SCM_ALLOW_INTS; diff --git a/libguile/tags.h b/libguile/tags.h index 37d4a0f60..26d4e890e 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -315,7 +315,7 @@ typedef signed long scm_t_signed_bits; #define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) -#define SCM_TYP16_PREDICATE(tag,x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) +#define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) diff --git a/libguile/throw.c b/libguile/throw.c index 68c18726e..ce0a403c2 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -76,10 +76,10 @@ static scm_t_bits tc16_jmpbuffer; (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L)))) #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) -#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) #ifdef DEBUG_EXTENSIONS #define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x)) -#define SCM_SETJBDFRAME(x,v) (SCM_SET_CELL_WORD_2 ((x), (v))) +#define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (v))) #endif static int @@ -595,7 +595,7 @@ SCM_DEFINE (scm_throw, "throw", 1, 0, 1, "If there is no handler at all, Guile prints an error and then exits.") #define FUNC_NAME s_scm_throw { - SCM_VALIDATE_SYMBOL (1,key); + SCM_VALIDATE_SYMBOL (1, key); return scm_ithrow (key, args, 1); } #undef FUNC_NAME diff --git a/libguile/unif.c b/libguile/unif.c index 761fbc101..dedd1e559 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -678,8 +678,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, scm_t_array_dim *s; SCM_VALIDATE_REST_ARGUMENT (dims); - SCM_VALIDATE_ARRAY (1,oldra); - SCM_VALIDATE_PROC (2,mapfunc); + SCM_VALIDATE_ARRAY (1, oldra); + SCM_VALIDATE_PROC (2, mapfunc); ra = scm_shap2ra (dims, FUNC_NAME); if (SCM_ARRAYP (oldra)) { @@ -802,7 +802,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, "@end lisp") #define FUNC_NAME s_scm_transpose_array { - SCM res, vargs, *ve = &vargs; + SCM res, vargs; + SCM const *ve = &vargs; scm_t_array_dim *s, *r; int ndim, i, k; @@ -1104,7 +1105,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, } else { - SCM_VALIDATE_INUM (2,args); + SCM_VALIDATE_INUM (2, args); pos = SCM_INUM (args); } length = SCM_INUM (scm_uniform_vector_length (v)); @@ -1184,7 +1185,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last) default: SCM_WRONG_TYPE_ARG (SCM_ARG1, v); case scm_tc7_bvect: - if (SCM_BITVEC_REF(v,pos)) + if (SCM_BITVEC_REF(v, pos)) return SCM_BOOL_T; else return SCM_BOOL_F; @@ -1278,7 +1279,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, } else { - SCM_VALIDATE_INUM_COPY (3,args,pos); + SCM_VALIDATE_INUM_COPY (3, args, pos); } length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (pos >= 0 && pos < length, outrng); @@ -1296,9 +1297,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, goto badarg1; case scm_tc7_bvect: if (SCM_FALSEP (obj)) - SCM_BITVEC_CLR(v,pos); + SCM_BITVEC_CLR(v, pos); else if (SCM_EQ_P (obj, SCM_BOOL_T)) - SCM_BITVEC_SET(v,pos); + SCM_BITVEC_SET(v, pos); else badobj:SCM_WRONG_TYPE_ARG (2, obj); break; @@ -1350,7 +1351,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; case scm_tc7_vector: case scm_tc7_wvect: - SCM_VELTS (v)[pos] = obj; + SCM_VECTOR_SET (v, pos, obj); break; } return SCM_UNSPECIFIED; @@ -1824,7 +1825,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, SCM_VALIDATE_BOOL (1, item); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); - SCM_VALIDATE_INUM_COPY (3,k,pos); + SCM_VALIDATE_INUM_COPY (3, k, pos); SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0)); if (pos == SCM_BITVECTOR_LENGTH (v)) @@ -1902,7 +1903,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - SCM_BITVEC_CLR(v,k); + SCM_BITVEC_CLR(v, k); } else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) @@ -1910,7 +1911,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - SCM_BITVEC_SET(v,k); + SCM_BITVEC_SET(v, k); } else badarg3:SCM_WRONG_TYPE_ARG (3, obj); @@ -1960,7 +1961,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - if (!SCM_BITVEC_REF(v,k)) + if (!SCM_BITVEC_REF(v, k)) count++; } else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1969,7 +1970,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - if (SCM_BITVEC_REF (v,k)) + if (SCM_BITVEC_REF (v, k)) count++; } else @@ -2050,7 +2051,7 @@ scm_istr2bve (char *str, long len) static SCM -ra2l (SCM ra,unsigned long base,unsigned long k) +ra2l (SCM ra, unsigned long base, unsigned long k) { register SCM res = SCM_EOL; register long inc = SCM_ARRAY_DIMS (ra)[k].inc; @@ -2190,7 +2191,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, SCM ra; unsigned long k; long n; - SCM_VALIDATE_INUM_COPY (1,ndim,k); + SCM_VALIDATE_INUM_COPY (1, ndim, k); while (k--) { n = scm_ilength (row); @@ -2261,7 +2262,7 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) static void -rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate) +rapr1 (SCM ra, unsigned long j, unsigned long k, SCM port, scm_print_state *pstate) { long inc = 1; long n = (SCM_TYP7 (ra) == scm_tc7_smob diff --git a/libguile/unif.h b/libguile/unif.h index e467033df..028446eff 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -96,8 +96,8 @@ SCM_API scm_t_bits scm_tc16_array; #define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) -#define SCM_MAKE_UVECTOR_TAG(l,t) (((l) << 8) + (t)) -#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_UVECTOR_TAG(l,t))) +#define SCM_MAKE_UVECTOR_TAG(l, t) (((l) << 8) + (t)) +#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_UVECTOR_TAG(l, t))) #define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect)) #define SCM_BITVECTOR_BASE(x) ((unsigned long *) (SCM_CELL_WORD_1 (x))) diff --git a/libguile/validate.h b/libguile/validate.h index 9068b8278..2a2c83b52 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -306,10 +306,10 @@ } \ } while (0) -/* [low,high) */ -#define SCM_VALIDATE_INUM_RANGE(pos,k,low,high) \ +/* [low, high) */ +#define SCM_VALIDATE_INUM_RANGE(pos, k, low, high) \ do { SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); \ - SCM_ASSERT_RANGE(pos,k, \ + SCM_ASSERT_RANGE(pos, k, \ (SCM_INUM (k) >= low && \ SCM_INUM (k) < high)); \ } while (0) @@ -367,7 +367,7 @@ SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE(pos,a,PRINT_STATE_P) +#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE(pos, a, PRINT_STATE_P) #define SCM_VALIDATE_SMOB(pos, obj, type) \ do { \ @@ -421,7 +421,7 @@ #define SCM_VALIDATE_OPINPORT(pos, port) \ SCM_MAKE_VALIDATE (pos, port, OPINPORTP) -#define SCM_VALIDATE_OPENPORT(pos,port) \ +#define SCM_VALIDATE_OPENPORT(pos, port) \ do { \ SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \ port, pos, FUNC_NAME); \ @@ -445,7 +445,7 @@ #define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE (pos, v, RSTATEP) -#define SCM_VALIDATE_ARRAY(pos,v) \ +#define SCM_VALIDATE_ARRAY(pos, v) \ do { \ SCM_ASSERT (!SCM_IMP (v) \ && !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \ diff --git a/libguile/variable.h b/libguile/variable.h index 5be7d067d..7d0350938 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -55,7 +55,7 @@ */ #define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable) #define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1 (V) -#define SCM_VARIABLE_SET(V,X) SCM_SET_CELL_OBJECT_1 (V, X) +#define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X) #define SCM_VARIABLE_LOC(V) ((SCM *) SCM_CELL_WORD_LOC ((V), 1)) diff --git a/libguile/vectors.c b/libguile/vectors.c index 7a6e64a17..86dc0b121 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -101,7 +101,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, while the vector is being created. */ SCM_VALIDATE_LIST_COPYLEN (1, l, i); res = scm_c_make_vector (i, SCM_UNSPECIFIED); - data = SCM_VELTS (res); + + /* + this code doesn't alloc. -- accessing RES is safe. + */ + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); @@ -165,7 +169,7 @@ scm_vector_set_x (SCM v, SCM k, SCM obj) g_vector_set_x, scm_list_3 (v, k, obj), SCM_ARG2, s_vector_set_x); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - SCM_VELTS(v)[(long) SCM_INUM(k)] = obj; + SCM_VECTOR_SET (v, (long) SCM_INUM(k), obj); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -235,8 +239,8 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, { SCM res = SCM_EOL; long i; - SCM *data; - SCM_VALIDATE_VECTOR (1,v); + SCM const *data; + SCM_VALIDATE_VECTOR (1, v); data = SCM_VELTS(v); for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res); return res; @@ -251,11 +255,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, #define FUNC_NAME s_scm_vector_fill_x { register long i; - register SCM *data; SCM_VALIDATE_VECTOR (1, v); - data = SCM_VELTS (v); + for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) - data[i] = fill; + SCM_VECTOR_SET(v, i, fill); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -287,16 +290,19 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, long j; long e; - SCM_VALIDATE_VECTOR (1,vec1); - SCM_VALIDATE_INUM_COPY (2,start1,i); - SCM_VALIDATE_INUM_COPY (3,end1,e); - SCM_VALIDATE_VECTOR (4,vec2); - SCM_VALIDATE_INUM_COPY (5,start2,j); + SCM_VALIDATE_VECTOR (1, vec1); + SCM_VALIDATE_INUM_COPY (2, start1, i); + SCM_VALIDATE_INUM_COPY (3, end1, e); + SCM_VALIDATE_VECTOR (4, vec2); + SCM_VALIDATE_INUM_COPY (5, start2, j); SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); - while (i<e) SCM_VELTS (vec2)[j++] = SCM_VELTS (vec1)[i++]; + + while (i<e) + SCM_VECTOR_SET (vec2, j++, SCM_VELTS (vec1)[i++]); + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -316,18 +322,18 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, long j; long e; - SCM_VALIDATE_VECTOR (1,vec1); - SCM_VALIDATE_INUM_COPY (2,start1,i); - SCM_VALIDATE_INUM_COPY (3,end1,e); - SCM_VALIDATE_VECTOR (4,vec2); - SCM_VALIDATE_INUM_COPY (5,start2,j); + SCM_VALIDATE_VECTOR (1, vec1); + SCM_VALIDATE_INUM_COPY (2, start1, i); + SCM_VALIDATE_INUM_COPY (3, end1, e); + SCM_VALIDATE_VECTOR (4, vec2); + SCM_VALIDATE_INUM_COPY (5, start2, j); SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); j = e - i + j; SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2)); while (i < e) - SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e]; + SCM_VECTOR_SET (vec2, --j, SCM_VELTS (vec1)[--e]); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/vectors.h b/libguile/vectors.h index 4d37b37a2..dda0c7612 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -55,13 +55,20 @@ #define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) #define SCM_VECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) -#define SCM_MAKE_VECTOR_TAG(l,t) (((l) << 8) + (t)) -#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l,t))) +#define SCM_MAKE_VECTOR_TAG(l, t) (((l) << 8) + (t)) +#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l, t))) -#define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) +#define SCM_VELTS(x) ((const SCM *) SCM_CELL_WORD_1 (x)) #define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x)) -#define SCM_SETVELTS(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val)) +#define SCM_GC_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x)) + +/* + no WB yet. + */ +#define SCM_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x)) /* diff --git a/libguile/vports.c b/libguile/vports.c index 69855331e..ce5ea7925 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -187,7 +187,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, { scm_t_port *pt; SCM z; - SCM_VALIDATE_VECTOR_LEN (1,pv,5); + SCM_VALIDATE_VECTOR_LEN (1, pv,5); SCM_VALIDATE_STRING (2, modes); z = scm_cell (scm_tc16_sfport, 0); SCM_DEFER_INTS; diff --git a/libguile/weaks.c b/libguile/weaks.c index 535b4482e..90b573185 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -141,8 +141,11 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, i = scm_ilength (l); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); - data = SCM_VELTS (res); + /* + no alloc, so this loop is safe. + */ + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); @@ -261,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, { if (SCM_IS_WHVEC_ANY (w)) { - SCM *ptr; + SCM const *ptr; SCM obj; long j; long n; @@ -302,7 +305,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, { register long j, n; - ptr = SCM_VELTS (w); + ptr = SCM_GC_WRITABLE_VELTS (w); n = SCM_VECTOR_LENGTH (w); for (j = 0; j < n; ++j) if (SCM_FREE_CELL_P (ptr[j])) @@ -316,7 +319,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj); - ptr = SCM_VELTS (w); + ptr = SCM_GC_WRITABLE_VELTS (w); for (j = 0; j < n; ++j) { |