* *.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.
+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
######################################################################
-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
+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,
\f
#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 */
/* 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)))
}
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);
}
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;
}
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))
"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. */
}
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;
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
"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
#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[] =
#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)
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;
}
#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,
"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)
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
#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))
"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
"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
"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);
"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:
{
"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);
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;
}
}
slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]);
- SCM_VELTS (obarray)[hash] = slot;
+ SCM_VECTOR_SET (obarray, hash, slot);
return SCM_BOOL_F;
}
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
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;
}
for (i = 0; i < size; i++)
{
- SCM_VELTS (obarray)[i] = SCM_EOL;
+ SCM_VECTOR_SET (obarray, i, SCM_EOL);
}
}
#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)))
\f
"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
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);
}
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);
}
-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);
}
-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
#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
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--)
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,
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);
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),
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);
}
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))
{
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 (),
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)))
{
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))
}
else
{
- SCM_VALIDATE_INUM (1,mode);
+ SCM_VALIDATE_INUM (1, mode);
mask = umask (SCM_INUM (mode));
}
return SCM_MAKINUM (mask);
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));
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,
tmp <<= 1;
if (S_IXOTH & mode) tmp += 1;
- ve[14] = SCM_MAKINUM (tmp);
+ SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp));
*/
}
}
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)
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)
{
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)
{
timeout.tv_usec = 0;
else
{
- SCM_VALIDATE_INUM (5,usecs);
+ SCM_VALIDATE_INUM (5, usecs);
timeout.tv_usec = SCM_INUM (usecs);
}
}
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);
}
}
else
{
- SCM_VALIDATE_INUM (1,object);
+ SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
if (fsync (fdes) == -1)
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);
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);
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++;
}
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
# 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)
#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))
#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)
{
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;
}
{
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;
}
#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 */
(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:
}
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;
* 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)) {
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;
{
/* 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
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) {
/* 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))
{
/* 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));
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;
}
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;
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;
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;
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);
}
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))
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;
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;
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;
}
"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
{
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);
"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;
}
"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))));
static void
-fixconfig (char *s1,char *s2,int s)
+fixconfig (char *s1, char *s2, int s)
{
fputs (s1, stderr);
fputs (s2, stderr);
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;
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);
}
#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
"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);
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);
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++)
{
{
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
{
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
\f
/* 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)
#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
{
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);
{
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);
#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;
{
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);
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);
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);
"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
" 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
"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
"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
"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);
}
#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
#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;
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++);
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
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 ();
}
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
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 ();
}
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
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;
}
}
else
{
- SCM_VALIDATE_INUM (1,name);
+ SCM_VALIDATE_INUM (1, name);
entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol));
}
if (!entry)
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
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;
#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));
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);
#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);
#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));
((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) \
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
- SCM_VALIDATE_OPINPORT (1,port);
+ SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
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)
#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;
}
{
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;
}
{
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;
}
#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
#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
#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;
}
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+");
"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
else
{
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPOUTPORT (1,port);
+ SCM_VALIDATE_OPOUTPORT (1, port);
}
scm_flush (port);
return SCM_UNSPECIFIED;
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;
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;
{
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);
"@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);
}
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;
{
/* 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);
#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
#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;
}
#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
#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;
}
#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
#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;
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;}
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;
}
"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 ());
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 */
"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 ());
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
"@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)
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);
}
{
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. */
{
int lstatus;
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
if (WIFSIGNALED (lstatus))
{
int lstatus;
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
if (WIFSTOPPED (lstatus))
"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;
"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;
{
int rv;
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = seteuid (SCM_INUM (id));
#else
{
int rv;
- SCM_VALIDATE_INUM (1,id);
+ SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = setegid (SCM_INUM (id));
#else
"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;
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);
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;
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;
{
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;
}
char *clocale;
char *rv;
- SCM_VALIDATE_INUM (1,category);
+ SCM_VALIDATE_INUM (1, category);
if (SCM_UNBNDP (locale))
{
clocale = NULL;
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)
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)));
"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;
= 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;
}
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;
/* 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;
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;
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
#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;
"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
{
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;
}
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
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));
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);
/* 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);
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;
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);
ras = scm_vector (ras);
ve = SCM_VELTS (ras);
}
+
for (; i <= n; i++, i1 += inc1)
{
args = SCM_EOL;
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;
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;
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;
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;
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;
"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))
{
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);
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);
"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;
#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:
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:
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;
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;
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"
{
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)));
{
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
{
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)));
}
{
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
{
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
"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)),
"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;
#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));
{
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
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)
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;
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. */
#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
#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))
#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);
{
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)
{
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)
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'
#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
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)
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
}
#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);
}
#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
"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. */
"@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;
int cstatus = 0;
if (!SCM_UNBNDP (status))
{
- SCM_VALIDATE_INUM (1,status);
+ SCM_VALIDATE_INUM (1, status);
cstatus = SCM_INUM (status);
}
exit (cstatus);
#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
#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[];
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);
{
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;
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);
{
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;
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)
{
{
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
{
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;
{
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
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
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;
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;
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));
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));
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);
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);
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),
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; */
}
{
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;
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;
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);
{
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),
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))
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);
}
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))
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),
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);
}
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),
#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
#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);
}
#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))
#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))
#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))
{
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))
}
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
}
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
#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)))
* 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;
/* 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))
*/
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;
*/
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;
"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
"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
"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
"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);
"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
"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
"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
"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
"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
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
{
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;
}
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)
#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;
}
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);
{
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])),
{
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;
}
"@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
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;
{
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;
}
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]);
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);
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))
{
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);
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))
{
"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
"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
"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
"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;
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;
}
"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
"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
"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;
}
"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;
#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))
\f
(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
"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
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))
{
"@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;
}
else
{
- SCM_VALIDATE_INUM (2,args);
+ SCM_VALIDATE_INUM (2, args);
pos = SCM_INUM (args);
}
length = SCM_INUM (scm_uniform_vector_length (v));
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;
}
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);
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;
break;
case scm_tc7_vector:
case scm_tc7_wvect:
- SCM_VELTS (v)[pos] = obj;
+ SCM_VECTOR_SET (v, pos, obj);
break;
}
return SCM_UNSPECIFIED;
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))
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;)
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);
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))
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
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;
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);
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
#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)))
} \
} 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)
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 { \
#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); \
#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)), \
*/
#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))
\f
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);
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
{
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;
#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
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
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
#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))
\f
/*
{
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;
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);
{
if (SCM_IS_WHVEC_ANY (w))
{
- SCM *ptr;
+ SCM const *ptr;
SCM obj;
long j;
long n;
{
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]))
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)
{
HCoop / bpt / guile.git / commitdiff