mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

2002-07-20 Han-Wen <hanwen@cs.uu.nl>

Browse source 
* *.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.

* autogen.sh (mscripts): find and check version number of
autoconf. Complain if 2.53 is not found.
This commit is contained in:
Han-Wen Nienhuys 2002-07-20 14:08:34 +00:00
parent dd897aafbd
commit 34d19ef643
67 changed files with 739 additions and 615 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ChangeLog
View file

@ -1,3 +1,8 @@
2002-07-20 Han-Wen <hanwen@cs.uu.nl>
* autogen.sh (mscripts): find and check version number of
autoconf. Complain if 2.53 is not found.
2002-07-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* benchmark-guile.in: Copied from check-guile.in and adapted for

22
autogen.sh
View file

@ -85,8 +85,26 @@ fi
######################################################################
autoheader
autoconf
# configure.in reqs autoconf-2.53; try to find it
for suf in "-2.53" "2.53" "" false; do
version=`autoconf$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 100 + $2}'`
if test "0$version" -eq 253; then
autoconf=autoconf$suf
autoheader=autoheader$suf
break
fi
done
if test -z "$autoconf"; then
echo "ERROR: Please install autoconf 2.53"
exit 1
fi
################################################################
$autoheader
$autoconf
# Automake has a bug that will let it only add one copy of a missing
# file. We need two mdate-sh, tho, one in doc/ref/ and one in

11
libguile/ChangeLog
View file

@ -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,

4
libguile/_scm.h
View file

@ -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 */

2
libguile/async.c
View file

@ -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)))

14
libguile/backtrace.c
View file

@ -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;

70
libguile/chars.c
View file

@ -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[] =

2
libguile/continuations.h
View file

@ -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)

10
libguile/convert.i.c
View file

@ -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;
}

20
libguile/debug.c
View file

@ -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);

72
libguile/environments.c
View file

@ -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)))

4
libguile/error.c
View file

@ -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);
}

22
libguile/eval.c
View file

@ -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))

2
libguile/evalext.c
View file

@ -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 (),

81
libguile/filesys.c
View file

@ -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);

6
libguile/fluids.c
View file

@ -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

19
libguile/gc.h
View file

@ -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))

2
libguile/gh.h
View file

@ -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)

7
libguile/gh_data.c
View file

@ -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;
}

46
libguile/goops.c
View file

@ -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;
}

2
libguile/hash.c
View file

@ -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;

26
libguile/hashtab.c
View file

@ -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

6
libguile/hooks.c
View file

@ -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))));

2
libguile/init.c
View file

@ -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);

16
libguile/ioext.c
View file

@ -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++)
{

4
libguile/lang.c
View file

@ -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

18
libguile/list.c
View file

@ -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);

4
libguile/load.c
View file

@ -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);

10
libguile/macros.c
View file

@ -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);
}

2
libguile/modules.h
View file

@ -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

45
libguile/net_db.c
View file

@ -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)

8
libguile/numbers.c
View file

@ -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);

8
libguile/objects.c
View file

@ -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));

2
libguile/objects.h
View file

@ -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) \

58
libguile/ports.c
View file

@ -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;

6
libguile/ports.h
View file

@ -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;}

108
libguile/posix.c
View file

@ -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;

23
libguile/print.c
View file

@ -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;

8
libguile/procprop.c
View file

@ -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));

40
libguile/ramap.c
View file

@ -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;

32
libguile/random.c
View file

@ -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

4
libguile/read.c
View file

@ -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;

8
libguile/regex-posix.c
View file

@ -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. */

33
libguile/scmsigs.c
View file

@ -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;

2
libguile/simpos.c
View file

@ -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);

6
libguile/smob.c
View file

@ -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

6
libguile/smob.h
View file

@ -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[];

81
libguile/socket.c
View file

@ -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),

70
libguile/sort.c
View file

@ -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);
}

12
libguile/srcprop.c
View file

@ -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

8
libguile/srcprop.h
View file

@ -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)))

26
libguile/stacks.c
View file

@ -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

34
libguile/stime.c
View file

@ -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)

6
libguile/strings.c
View file

@ -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);

40
libguile/strop.c
View file

@ -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;
}

26
libguile/struct.c
View file

@ -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;

10
libguile/symbols.c
View file

@ -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;

2
libguile/tags.h
View file

@ -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))

6
libguile/throw.c
View file

@ -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

35
libguile/unif.c
View file

@ -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

4
libguile/unif.h
View file

@ -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)))

12
libguile/validate.h
View file

@ -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)), \

2
libguile/variable.h
View file

@ -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))

44
libguile/vectors.c
View file

@ -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

15
libguile/vectors.h
View file

@ -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))
/*

2
libguile/vports.c
View file

@ -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;

11
libguile/weaks.c
View file

@ -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)
{