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

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

Browse source 
* *.c: add space after commas everywhere.

* *.c: use SCM_VECTOR_SET everywhere, where a vector is written.
Document cases where SCM_WRITABLE_VELTS() is used.

* vectors.h (SCM_VELTS): prepare for write barrier, and let
SCM_VELTS() return a const pointer
(SCM_VECTOR_SET): add macro.

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

5
ChangeLog
View file

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

22
autogen.sh
View file

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

11
libguile/ChangeLog
View file

@ -1,3 +1,14 @@
2002-07-20 Han-Wen <hanwen@cs.uu.nl>
* *.c: add space after commas everywhere.
* *.c: use SCM_VECTOR_SET everywhere, where a vector is written.
Document cases where SCM_WRITABLE_VELTS() is used.
* vectors.h (SCM_VELTS): prepare for write barrier, and let
SCM_VELTS() return a const pointer
(SCM_VECTOR_SET): add macro.
2002-07-15 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-07-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro,

4
libguile/_scm.h
View file

@ -125,10 +125,10 @@
#ifndef min #ifndef min
#define min(A,B) ((A) <= (B) ? (A) : (B)) #define min(A, B) ((A) <= (B) ? (A) : (B))
#endif #endif
#ifndef max #ifndef max
#define max(A,B) ((A) >= (B) ? (A) : (B)) #define max(A, B) ((A) >= (B) ? (A) : (B))
#endif #endif
#endif /* SCM__SCM_H */ #endif /* SCM__SCM_H */

2
libguile/async.c
View file

@ -115,7 +115,7 @@ static scm_t_bits tc16_async;
/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. /* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it.
this is ugly. */ this is ugly. */
#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) #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 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))) #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16)))

14
libguile/backtrace.c
View file

@ -132,7 +132,7 @@ scm_display_error_message (SCM message, SCM args, SCM port)
} }
static void 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 = scm_make_print_state ();
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);
@ -335,7 +335,7 @@ indent (int n, SCM port)
} }
static void 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; SCM string;
int i = 0, n; int i = 0, n;
@ -377,7 +377,7 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po
} }
static void 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 proc = SCM_FRAME_PROC (frame);
SCM name = (!SCM_FALSEP (scm_procedure_p (proc)) SCM name = (!SCM_FALSEP (scm_procedure_p (proc))
@ -400,15 +400,15 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0,
"output.") "output.")
#define FUNC_NAME s_scm_display_application #define FUNC_NAME s_scm_display_application
{ {
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1, frame);
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_outp; port = scm_cur_outp;
else else
SCM_VALIDATE_OPOUTPORT (2,port); SCM_VALIDATE_OPOUTPORT (2, port);
if (SCM_UNBNDP (indent)) if (SCM_UNBNDP (indent))
indent = SCM_INUM0; indent = SCM_INUM0;
else else
SCM_VALIDATE_INUM (3,indent); SCM_VALIDATE_INUM (3, indent);
if (SCM_FRAME_PROC_P (frame)) if (SCM_FRAME_PROC_P (frame))
/* Display an application. */ /* Display an application. */
@ -524,7 +524,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
} }
static void 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; int n, i, j;

70
libguile/chars.c
View file

@ -76,8 +76,8 @@ SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr,
"else @code{#f}.") "else @code{#f}.")
#define FUNC_NAME s_scm_char_less_p #define FUNC_NAME s_scm_char_less_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(SCM_CHAR(x) < SCM_CHAR(y)); return SCM_BOOL(SCM_CHAR(x) < SCM_CHAR(y));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -88,8 +88,8 @@ SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr,
"ASCII sequence, else @code{#f}.") "ASCII sequence, else @code{#f}.")
#define FUNC_NAME s_scm_char_leq_p #define FUNC_NAME s_scm_char_leq_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(SCM_CHAR(x) <= SCM_CHAR(y)); return SCM_BOOL(SCM_CHAR(x) <= SCM_CHAR(y));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -100,8 +100,8 @@ SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr,
"sequence, else @code{#f}.") "sequence, else @code{#f}.")
#define FUNC_NAME s_scm_char_gr_p #define FUNC_NAME s_scm_char_gr_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y)); return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -112,8 +112,8 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr,
"ASCII sequence, else @code{#f}.") "ASCII sequence, else @code{#f}.")
#define FUNC_NAME s_scm_char_geq_p #define FUNC_NAME s_scm_char_geq_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y)); return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -124,8 +124,8 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr,
"case, else @code{#f}.") "case, else @code{#f}.")
#define FUNC_NAME s_scm_char_ci_eq_p #define FUNC_NAME s_scm_char_ci_eq_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(scm_upcase(SCM_CHAR(x))==scm_upcase(SCM_CHAR(y))); return SCM_BOOL(scm_upcase(SCM_CHAR(x))==scm_upcase(SCM_CHAR(y)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -136,8 +136,8 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr,
"ignoring case, else @code{#f}.") "ignoring case, else @code{#f}.")
#define FUNC_NAME s_scm_char_ci_less_p #define FUNC_NAME s_scm_char_ci_less_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL((scm_upcase(SCM_CHAR(x))) < scm_upcase(SCM_CHAR(y))); return SCM_BOOL((scm_upcase(SCM_CHAR(x))) < scm_upcase(SCM_CHAR(y)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -148,8 +148,8 @@ SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr,
"ASCII sequence ignoring case, else @code{#f}.") "ASCII sequence ignoring case, else @code{#f}.")
#define FUNC_NAME s_scm_char_ci_leq_p #define FUNC_NAME s_scm_char_ci_leq_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(scm_upcase(SCM_CHAR(x)) <= scm_upcase(SCM_CHAR(y))); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) <= scm_upcase(SCM_CHAR(y)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -160,8 +160,8 @@ SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr,
"sequence ignoring case, else @code{#f}.") "sequence ignoring case, else @code{#f}.")
#define FUNC_NAME s_scm_char_ci_gr_p #define FUNC_NAME s_scm_char_ci_gr_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(scm_upcase(SCM_CHAR(x)) > scm_upcase(SCM_CHAR(y))); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) > scm_upcase(SCM_CHAR(y)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -172,8 +172,8 @@ SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr,
"ASCII sequence ignoring case, else @code{#f}.") "ASCII sequence ignoring case, else @code{#f}.")
#define FUNC_NAME s_scm_char_ci_geq_p #define FUNC_NAME s_scm_char_ci_geq_p
{ {
SCM_VALIDATE_CHAR (1,x); SCM_VALIDATE_CHAR (1, x);
SCM_VALIDATE_CHAR (2,y); SCM_VALIDATE_CHAR (2, y);
return SCM_BOOL(scm_upcase(SCM_CHAR(x)) >= scm_upcase(SCM_CHAR(y))); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) >= scm_upcase(SCM_CHAR(y)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -185,7 +185,7 @@ SCM_DEFINE (scm_char_alphabetic_p, "char-alphabetic?", 1, 0, 0,
"Alphabetic means the same thing as the isalpha C library function.") "Alphabetic means the same thing as the isalpha C library function.")
#define FUNC_NAME s_scm_char_alphabetic_p #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))); return SCM_BOOL(isalpha(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -196,7 +196,7 @@ SCM_DEFINE (scm_char_numeric_p, "char-numeric?", 1, 0, 0,
"Numeric means the same thing as the isdigit C library function.") "Numeric means the same thing as the isdigit C library function.")
#define FUNC_NAME s_scm_char_numeric_p #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))); return SCM_BOOL(isdigit(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -207,7 +207,7 @@ SCM_DEFINE (scm_char_whitespace_p, "char-whitespace?", 1, 0, 0,
"Whitespace means the same thing as the isspace C library function.") "Whitespace means the same thing as the isspace C library function.")
#define FUNC_NAME s_scm_char_whitespace_p #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))); return SCM_BOOL(isspace(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -220,7 +220,7 @@ SCM_DEFINE (scm_char_upper_case_p, "char-upper-case?", 1, 0, 0,
"Uppercase means the same thing as the isupper C library function.") "Uppercase means the same thing as the isupper C library function.")
#define FUNC_NAME s_scm_char_upper_case_p #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))); return SCM_BOOL(isupper(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -232,7 +232,7 @@ SCM_DEFINE (scm_char_lower_case_p, "char-lower-case?", 1, 0, 0,
"Lowercase means the same thing as the islower C library function.") "Lowercase means the same thing as the islower C library function.")
#define FUNC_NAME s_scm_char_lower_case_p #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))); return SCM_BOOL(islower(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -246,7 +246,7 @@ SCM_DEFINE (scm_char_is_both_p, "char-is-both?", 1, 0, 0,
"C library functions.") "C library functions.")
#define FUNC_NAME s_scm_char_is_both_p #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)))); return SCM_BOOL((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr))));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -260,7 +260,7 @@ SCM_DEFINE (scm_char_to_integer, "char->integer", 1, 0, 0,
"ASCII sequence.") "ASCII sequence.")
#define FUNC_NAME s_scm_char_to_integer #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)); return scm_ulong2num((unsigned long)SCM_CHAR(chr));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -283,7 +283,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0,
"Return the uppercase character version of @var{chr}.") "Return the uppercase character version of @var{chr}.")
#define FUNC_NAME s_scm_char_upcase #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))); return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -294,7 +294,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0,
"Return the lowercase character version of @var{chr}.") "Return the lowercase character version of @var{chr}.")
#define FUNC_NAME s_scm_char_downcase #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))); return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -358,14 +358,14 @@ scm_downcase (unsigned int c)
#ifdef EBCDIC #ifdef EBCDIC
char *const scm_charnames[] = char *const scm_charnames[] =
{ {
"nul","soh","stx","etx", "pf", "ht", "lc","del", "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del",
0 , 0 ,"smm", "vt", "ff", "cr", "so", "si", 0 , 0 , "smm", "vt", "ff", "cr", "so", "si",
"dle","dc1","dc2","dc3","res", "nl", "bs", "il", "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il",
"can", "em", "cc", 0 ,"ifs","igs","irs","ius", "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius",
"ds","sos", "fs", 0 ,"byp", "lf","eob","pre", "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre",
0 , 0 , "sm", 0 , 0 ,"enq","ack","bel", 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel",
0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot", 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot",
0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub", 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub",
"space", scm_s_newline, "tab", "backspace", "return", "page", "null"}; "space", scm_s_newline, "tab", "backspace", "return", "page", "null"};
const char scm_charnums[] = const char scm_charnums[] =

2
libguile/continuations.h
View file

@ -91,7 +91,7 @@ typedef struct
#define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_CELL_WORD_1 (x)) #define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_CELL_WORD_1 (x))
#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items) #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)) (SCM_CONTREGS (x)->num_stack_items = (n))
#define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf) #define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
#define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv) #define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv)

10
libguile/convert.i.c
View file

@ -245,17 +245,17 @@ SCM
CTYPES2SCM (const CTYPE *data, long n) CTYPES2SCM (const CTYPE *data, long n)
{ {
long i; long i;
SCM v, *velts; SCM v;
SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n),
n > 0 && n <= SCM_VECTOR_MAX_LENGTH); n > 0 && n <= SCM_VECTOR_MAX_LENGTH);
v = scm_c_make_vector (n, SCM_UNSPECIFIED); v = scm_c_make_vector (n, SCM_UNSPECIFIED);
velts = SCM_VELTS (v);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
#ifdef FLOATTYPE #ifdef FLOATTYPE
velts[i] = scm_make_real ((double) data[i]); SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i]));
#else #else
velts[i] = SCM_MAKINUM (data[i]); SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i]));
#endif #endif
return v; return v;
} }

20
libguile/debug.c
View file

@ -123,7 +123,7 @@ SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0,
#define FUNC_NAME s_scm_with_traps #define FUNC_NAME s_scm_with_traps
{ {
int trap_flag; int trap_flag;
SCM_VALIDATE_THUNK (1,thunk); SCM_VALIDATE_THUNK (1, thunk);
return scm_internal_dynamic_wind (with_traps_before, return scm_internal_dynamic_wind (with_traps_before,
with_traps_inner, with_traps_inner,
with_traps_after, with_traps_after,
@ -243,8 +243,8 @@ SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0,
"offset @var{binding} and the cdr flag @var{cdrp}.") "offset @var{binding} and the cdr flag @var{cdrp}.")
#define FUNC_NAME s_scm_make_iloc #define FUNC_NAME s_scm_make_iloc
{ {
SCM_VALIDATE_INUM (1,frame); SCM_VALIDATE_INUM (1, frame);
SCM_VALIDATE_INUM (2,binding); SCM_VALIDATE_INUM (2, binding);
return SCM_PACK (SCM_UNPACK (SCM_ILOC00) return SCM_PACK (SCM_UNPACK (SCM_ILOC00)
+ SCM_IFRINC * SCM_INUM (frame) + SCM_IFRINC * SCM_INUM (frame)
+ (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0) + (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0)
@ -289,7 +289,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
if (SCM_UNBNDP (env)) if (SCM_UNBNDP (env))
env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE); env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
else else
SCM_VALIDATE_NULLORCONS (3,env); SCM_VALIDATE_NULLORCONS (3, env);
return scm_make_memoized (scm_cons (car, cdr), env); return scm_make_memoized (scm_cons (car, cdr), env);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -301,7 +301,7 @@ SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0,
#define FUNC_NAME s_scm_mem_to_proc #define FUNC_NAME s_scm_mem_to_proc
{ {
SCM env; SCM env;
SCM_VALIDATE_MEMOIZED (1,obj); SCM_VALIDATE_MEMOIZED (1, obj);
env = SCM_MEMOIZED_ENV (obj); env = SCM_MEMOIZED_ENV (obj);
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
if (!SCM_CONSP (obj) || !SCM_EQ_P (SCM_CAR (obj), SCM_IM_LAMBDA)) if (!SCM_CONSP (obj) || !SCM_EQ_P (SCM_CAR (obj), SCM_IM_LAMBDA))
@ -328,7 +328,7 @@ SCM_DEFINE (scm_unmemoize, "unmemoize", 1, 0, 0,
"Unmemoize the memoized expression @var{m},") "Unmemoize the memoized expression @var{m},")
#define FUNC_NAME s_scm_unmemoize #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)); return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -338,7 +338,7 @@ SCM_DEFINE (scm_memoized_environment, "memoized-environment", 1, 0, 0,
"Return the environment of the memoized expression @var{m}.") "Return the environment of the memoized expression @var{m}.")
#define FUNC_NAME s_scm_memoized_environment #define FUNC_NAME s_scm_memoized_environment
{ {
SCM_VALIDATE_MEMOIZED (1,m); SCM_VALIDATE_MEMOIZED (1, m);
return SCM_MEMOIZED_ENV (m); return SCM_MEMOIZED_ENV (m);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -348,7 +348,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
"Return the name of the procedure @var{proc}") "Return the name of the procedure @var{proc}")
#define FUNC_NAME s_scm_procedure_name #define FUNC_NAME s_scm_procedure_name
{ {
SCM_VALIDATE_PROC (1,proc); SCM_VALIDATE_PROC (1, proc);
switch (SCM_TYP7 (proc)) { switch (SCM_TYP7 (proc)) {
case scm_tcs_subrs: case scm_tcs_subrs:
return SCM_SNAME (proc); return SCM_SNAME (proc);
@ -374,7 +374,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
"Return the source of the procedure @var{proc}.") "Return the source of the procedure @var{proc}.")
#define FUNC_NAME s_scm_procedure_source #define FUNC_NAME s_scm_procedure_source
{ {
SCM_VALIDATE_NIM (1,proc); SCM_VALIDATE_NIM (1, proc);
switch (SCM_TYP7 (proc)) { switch (SCM_TYP7 (proc)) {
case scm_tcs_closures: case scm_tcs_closures:
{ {
@ -407,7 +407,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
"Return the environment of the procedure @var{proc}.") "Return the environment of the procedure @var{proc}.")
#define FUNC_NAME s_scm_procedure_environment #define FUNC_NAME s_scm_procedure_environment
{ {
SCM_VALIDATE_NIM (1,proc); SCM_VALIDATE_NIM (1, proc);
switch (SCM_TYP7 (proc)) { switch (SCM_TYP7 (proc)) {
case scm_tcs_closures: case scm_tcs_closures:
return SCM_ENV (proc); return SCM_ENV (proc);

72
libguile/environments.c
View file

@ -533,7 +533,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray); size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
SCM entry = scm_cons (symbol, data); SCM entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]); SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]);
SCM_VELTS (obarray)[hash] = slot; SCM_VECTOR_SET (obarray, hash, slot);
return entry; return entry;
} }
@ -562,7 +562,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
} }
slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]); 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_BOOL_F;
} }
@ -587,6 +587,46 @@ obarray_retrieve (SCM obarray, SCM sym)
return SCM_UNDEFINED; 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 * Remove entry from obarray. If the symbol was found and removed, the old
@ -596,22 +636,20 @@ static SCM
obarray_remove (SCM obarray, SCM sym) obarray_remove (SCM obarray, SCM sym)
{ {
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
SCM lsym; SCM table_entry = SCM_VELTS (obarray)[hash];
SCM *lsymp;
/* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */ if (SCM_NULLP(table_entry))
for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]); return SCM_BOOL_F;
!SCM_NULLP (lsym);
lsym = *(lsymp = SCM_CDRLOC (lsym))) if (SCM_EQ_P (SCM_CAAR (table_entry), sym))
{ {
SCM entry = SCM_CAR (lsym); SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry));
if (SCM_EQ_P (SCM_CAR (entry), sym)) return SCM_CAR(table_entry);
{ }
*lsymp = SCM_CDR (lsym); else
return entry; {
} return remove_key_from_alist (table_entry, sym);
} }
return SCM_BOOL_F;
} }
@ -623,7 +661,7 @@ obarray_remove_all (SCM obarray)
for (i = 0; i < size; i++) for (i = 0; i < size; i++)
{ {
SCM_VELTS (obarray)[i] = SCM_EOL; SCM_VECTOR_SET (obarray, i, SCM_EOL);
} }
} }
@ -655,7 +693,7 @@ struct core_environments_base {
#define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \
(SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0]) (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0])
#define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \ #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \
(SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v)) (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v)))

4
libguile/error.c
View file

@ -168,7 +168,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
"must be an integer value.") "must be an integer value.")
#define FUNC_NAME s_scm_strerror #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))); return scm_makfrom0str (SCM_I_STRERROR (SCM_INUM (err)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -224,7 +224,7 @@ scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos)
scm_error (scm_out_of_range_key, scm_error (scm_out_of_range_key,
subr, subr,
"Argument ~S out of range: ~S", "Argument ~S out of range: ~S",
scm_list_2 (pos,bad_value), scm_list_2 (pos, bad_value),
SCM_BOOL_F); SCM_BOOL_F);
} }

22
libguile/eval.c
View file

@ -798,7 +798,7 @@ iqq (SCM form, SCM env, unsigned long int depth)
else if (SCM_VECTORP (form)) else if (SCM_VECTORP (form))
{ {
size_t i = SCM_VECTOR_LENGTH (form); size_t i = SCM_VECTOR_LENGTH (form);
SCM *data = SCM_VELTS (form); SCM const *data = SCM_VELTS (form);
SCM tmp = SCM_EOL; SCM tmp = SCM_EOL;
while (i != 0) while (i != 0)
tmp = scm_cons (data[--i], tmp); tmp = scm_cons (data[--i], tmp);
@ -1020,7 +1020,7 @@ scm_m_let (SCM xorig, SCM env)
} }
SCM_SYNTAX (s_atapply,"@apply", scm_makmmacro, scm_m_apply); SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply);
SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply); SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
@ -1032,8 +1032,8 @@ scm_m_apply (SCM xorig, SCM env SCM_UNUSED)
} }
SCM_SYNTAX(s_atcall_cc,"@call-with-current-continuation", scm_makmmacro, scm_m_cont); SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_makmmacro, scm_m_cont);
SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc); SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
SCM SCM
@ -3413,7 +3413,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
#define FUNC_NAME s_scm_nconc2last #define FUNC_NAME s_scm_nconc2last
{ {
SCM *lloc; SCM *lloc;
SCM_VALIDATE_NONEMPTYLIST (1,lst); SCM_VALIDATE_NONEMPTYLIST (1, lst);
lloc = &lst; lloc = &lst;
while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be
SCM_NULL_OR_NIL_P, but not SCM_NULL_OR_NIL_P, but not
@ -3792,7 +3792,7 @@ check_map_args (SCM argv,
SCM args, SCM args,
const char *who) const char *who)
{ {
SCM *ve = SCM_VELTS (argv); SCM const *ve = SCM_VELTS (argv);
long i; long i;
for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
@ -3831,7 +3831,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
long i, len; long i, len;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM *pres = &res; 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); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, SCM_GASSERTn (len >= 0,
@ -3858,7 +3858,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
if (SCM_IMP (ve[i])) if (SCM_IMP (ve[i]))
return res; return res;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); 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_list_1 (scm_apply (proc, arg1, SCM_EOL));
pres = SCM_CDRLOC (*pres); pres = SCM_CDRLOC (*pres);
@ -3873,7 +3873,7 @@ SCM
scm_for_each (SCM proc, SCM arg1, SCM args) scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each #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; long i, len;
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
@ -3899,7 +3899,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
if (SCM_IMP (ve[i])) if (SCM_IMP (ve[i]))
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); 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); scm_apply (proc, arg1, SCM_EOL);
} }
@ -4011,7 +4011,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
unsigned long i = SCM_VECTOR_LENGTH (obj); unsigned long i = SCM_VECTOR_LENGTH (obj);
ans = scm_c_make_vector (i, SCM_UNSPECIFIED); ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
while (i--) 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; return ans;
} }
if (!SCM_CONSP (obj)) if (!SCM_CONSP (obj))

2
libguile/evalext.c
View file

@ -77,7 +77,7 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
{ {
SCM var; SCM var;
SCM_VALIDATE_SYMBOL (1,sym); SCM_VALIDATE_SYMBOL (1, sym);
if (SCM_UNBNDP (env)) if (SCM_UNBNDP (env))
var = scm_sym2var (sym, scm_current_module_lookup_closure (), var = scm_sym2var (sym, scm_current_module_lookup_closure (),

81
libguile/filesys.c
View file

@ -218,8 +218,8 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
object = SCM_COERCE_OUTPORT (object); object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INUM (2,owner); SCM_VALIDATE_INUM (2, owner);
SCM_VALIDATE_INUM (3,group); SCM_VALIDATE_INUM (3, group);
#ifdef HAVE_FCHOWN #ifdef HAVE_FCHOWN
if (SCM_INUMP (object) || (SCM_OPFPORTP (object))) if (SCM_INUMP (object) || (SCM_OPFPORTP (object)))
{ {
@ -259,7 +259,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
object = SCM_COERCE_OUTPORT (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) || SCM_OPFPORTP (object))
{ {
if (SCM_INUMP (object)) if (SCM_INUMP (object))
@ -295,7 +295,7 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
} }
else else
{ {
SCM_VALIDATE_INUM (1,mode); SCM_VALIDATE_INUM (1, mode);
mask = umask (SCM_INUM (mode)); mask = umask (SCM_INUM (mode));
} }
return SCM_MAKINUM (mask); return SCM_MAKINUM (mask);
@ -397,7 +397,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0,
if (SCM_PORTP (fd_or_port)) if (SCM_PORTP (fd_or_port))
return scm_close_port (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); fd = SCM_INUM (fd_or_port);
scm_evict_ports (fd); /* see scsh manual. */ scm_evict_ports (fd); /* see scsh manual. */
SCM_SYSCALL (rv = close (fd)); SCM_SYSCALL (rv = close (fd));
@ -448,58 +448,57 @@ static SCM
scm_stat2scm (struct stat *stat_temp) scm_stat2scm (struct stat *stat_temp)
{ {
SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) stat_temp->st_dev));
ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino); SCM_VECTOR_SET(ans, 1, scm_ulong2num ((unsigned long) stat_temp->st_ino));
ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) stat_temp->st_mode));
ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) stat_temp->st_nlink));
ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid); SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) stat_temp->st_uid));
ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid); SCM_VECTOR_SET(ans, 5, scm_ulong2num ((unsigned long) stat_temp->st_gid));
#ifdef HAVE_STRUCT_STAT_ST_RDEV #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 #else
ve[6] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif #endif
ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size); SCM_VECTOR_SET(ans, 7, scm_ulong2num ((unsigned long) stat_temp->st_size));
ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime); SCM_VECTOR_SET(ans, 8, scm_ulong2num ((unsigned long) stat_temp->st_atime));
ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime); SCM_VECTOR_SET(ans, 9, scm_ulong2num ((unsigned long) stat_temp->st_mtime));
ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime); SCM_VECTOR_SET(ans, 10, scm_ulong2num ((unsigned long) stat_temp->st_ctime));
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE #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 #else
ve[11] = scm_ulong2num (4096L); SCM_VECTOR_SET(ans, 11, scm_ulong2num (4096L));
#endif #endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS #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 #else
ve[12] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif #endif
{ {
int mode = stat_temp->st_mode; int mode = stat_temp->st_mode;
if (S_ISREG (mode)) if (S_ISREG (mode))
ve[13] = scm_sym_regular; SCM_VECTOR_SET(ans, 13, scm_sym_regular);
else if (S_ISDIR (mode)) else if (S_ISDIR (mode))
ve[13] = scm_sym_directory; SCM_VECTOR_SET(ans, 13, scm_sym_directory);
#ifdef HAVE_S_ISLNK #ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode)) else if (S_ISLNK (mode))
ve[13] = scm_sym_symlink; SCM_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif #endif
else if (S_ISBLK (mode)) 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)) 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)) else if (S_ISFIFO (mode))
ve[13] = scm_sym_fifo; SCM_VECTOR_SET(ans, 13, scm_sym_fifo);
#ifdef S_ISSOCK #ifdef S_ISSOCK
else if (S_ISSOCK (mode)) else if (S_ISSOCK (mode))
ve[13] = scm_sym_sock; SCM_VECTOR_SET(ans, 13, scm_sym_sock);
#endif #endif
else 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. /* the layout of the bits in ve[14] is intended to be portable.
If there are systems that don't follow the usual convention, If there are systems that don't follow the usual convention,
@ -528,7 +527,7 @@ scm_stat2scm (struct stat *stat_temp)
tmp <<= 1; tmp <<= 1;
if (S_IXOTH & mode) tmp += 1; if (S_IXOTH & mode) tmp += 1;
ve[14] = SCM_MAKINUM (tmp); SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp));
*/ */
} }
@ -761,7 +760,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
} }
else else
{ {
SCM_VALIDATE_INUM (2,mode); SCM_VALIDATE_INUM (2, mode);
SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode))); SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode)));
} }
if (rv != 0) if (rv != 0)
@ -1021,7 +1020,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
if (SCM_VECTORP (list_or_vec)) if (SCM_VECTORP (list_or_vec))
{ {
int i = SCM_VECTOR_LENGTH (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) while (--i >= 0)
{ {
@ -1082,7 +1081,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
if (SCM_VECTORP (list_or_vec)) if (SCM_VECTORP (list_or_vec))
{ {
int i = SCM_VECTOR_LENGTH (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) while (--i >= 0)
{ {
@ -1212,7 +1211,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
timeout.tv_usec = 0; timeout.tv_usec = 0;
else else
{ {
SCM_VALIDATE_INUM (5,usecs); SCM_VALIDATE_INUM (5, usecs);
timeout.tv_usec = SCM_INUM (usecs); timeout.tv_usec = SCM_INUM (usecs);
} }
} }
@ -1285,12 +1284,12 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
object = SCM_COERCE_OUTPORT (object); object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INUM (2,cmd); SCM_VALIDATE_INUM (2, cmd);
if (SCM_OPFPORTP (object)) if (SCM_OPFPORTP (object))
fdes = SCM_FPORT_FDES (object); fdes = SCM_FPORT_FDES (object);
else else
{ {
SCM_VALIDATE_INUM (1,object); SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object); fdes = SCM_INUM (object);
} }
@ -1327,7 +1326,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
} }
else else
{ {
SCM_VALIDATE_INUM (1,object); SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object); fdes = SCM_INUM (object);
} }
if (fsync (fdes) == -1) if (fsync (fdes) == -1)
@ -1464,7 +1463,7 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
long int i; long int i;
unsigned long int len; unsigned long int len;
SCM_VALIDATE_STRING (1,filename); SCM_VALIDATE_STRING (1, filename);
s = SCM_STRING_CHARS (filename); s = SCM_STRING_CHARS (filename);
len = SCM_STRING_LENGTH (filename); len = SCM_STRING_LENGTH (filename);
@ -1506,7 +1505,7 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
char *f, *s = 0; char *f, *s = 0;
int i, j, len, end; int i, j, len, end;
SCM_VALIDATE_STRING (1,filename); SCM_VALIDATE_STRING (1, filename);
f = SCM_STRING_CHARS (filename); f = SCM_STRING_CHARS (filename);
len = SCM_STRING_LENGTH (filename); len = SCM_STRING_LENGTH (filename);

6
libguile/fluids.c
View file

@ -76,12 +76,12 @@ grow_fluids (scm_root_state *root_state, int new_length)
i = 0; i = 0;
while (i < old_length) 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++; i++;
} }
while (i < new_length) while (i < new_length)
{ {
SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F);
i++; i++;
} }
@ -171,7 +171,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n) if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1); grow_fluids (scm_root, n+1);
SCM_VELTS (scm_root->fluids)[n] = value; SCM_VECTOR_SET (scm_root->fluids, n, value);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

19
libguile/gc.h
View file

@ -80,9 +80,24 @@ typedef scm_t_cell * SCM_CELLPTR;
# define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x)))
#endif /* def _UNICOS */ #endif /* def _UNICOS */
#ifdef GENGC
/*
TODO
*/
#else /* ! genGC */
#define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_HEADER_CELLS 1
#define SCM_GC_CARD_N_CELLS 256 #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_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_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
@ -92,10 +107,6 @@ typedef scm_t_cell * SCM_CELLPTR;
#define SCM_GC_IN_CARD_HEADERP(x) \ #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) 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_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
#define SCM_GC_SET_CARD_FLAGS(card, flags) \ #define SCM_GC_SET_CARD_FLAGS(card, flags) \
((card)->word_1 = (scm_t_bits) (flags)) ((card)->word_1 = (scm_t_bits) (flags))

2
libguile/gh.h
View file

@ -167,7 +167,7 @@ SCM_API SCM gh_define(const char *name, SCM val);
#define gh_string_length(str) scm_string_length(str) #define gh_string_length(str) scm_string_length(str)
#define gh_string_ref(str, k) scm_string_ref(str, k) #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_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) #define gh_string_append(args) scm_string_append(args)

7
libguile/gh_data.c
View file

@ -122,10 +122,8 @@ gh_ints2scm (const int *d, long n)
{ {
long i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for (i = 0; i < n; ++i) 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; return v;
} }
@ -135,10 +133,9 @@ gh_doubles2scm (const double *d, long n)
{ {
long i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for(i = 0; i < n; i++) 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; return v;
} }

46
libguile/goops.c
View file

@ -75,7 +75,7 @@
#define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers) #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_eval (scm_list_3 (scm_sym_define_public, (v), (val)), \
scm_module_goops); } scm_module_goops); }
/* Temporary hack until we get the new module system */ /* Temporary hack until we get the new module system */
@ -84,13 +84,13 @@
(v), SCM_BOOL_F))) (v), SCM_BOOL_F)))
/* Fixme: Should use already interned symbols */ /* 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)) 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)) 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)) 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)) a, b, c, d))
/* Class redefinition protocol: /* Class redefinition protocol:
@ -1684,7 +1684,7 @@ applicablep (SCM actual, SCM formal)
} }
static int static int
more_specificp (SCM m1, SCM m2, SCM *targs) more_specificp (SCM m1, SCM m2, SCM const *targs)
{ {
register SCM s1, s2; register SCM s1, s2;
register long i; register long i;
@ -1704,7 +1704,7 @@ more_specificp (SCM m1, SCM m2, SCM *targs)
* the end of this array). * 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(s1)) return 1;
if (SCM_NULLP(s2)) return 0; if (SCM_NULLP(s2)) return 0;
if (SCM_CAR(s1) != SCM_CAR(s2)) { if (SCM_CAR(s1) != SCM_CAR(s2)) {
@ -1731,13 +1731,13 @@ scm_i_vector2list (SCM l, long len)
SCM z = scm_c_make_vector (len, SCM_UNDEFINED); SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) { 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; return z;
} }
static SCM 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; long i, j, incr;
SCM *v, vector = SCM_EOL; SCM *v, vector = SCM_EOL;
@ -1761,7 +1761,13 @@ sort_applicable_methods (SCM method_list, long size, SCM *targs)
{ {
/* Too many elements in method_list to keep everything locally */ /* Too many elements in method_list to keep everything locally */
vector = scm_i_vector2list (save, size); 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 /* Use a simple shell sort since it is generally faster than qsort on
@ -1807,8 +1813,10 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
long count = 0; long count = 0;
SCM l, fl, applicable = SCM_EOL; SCM l, fl, applicable = SCM_EOL;
SCM save = args; SCM save = args;
SCM buffer[BUFFSIZE], *types, *p; SCM buffer[BUFFSIZE];
SCM tmp; SCM const *types;
SCM *p;
SCM tmp = SCM_EOL;
/* Build the list of arguments types */ /* Build the list of arguments types */
if (len >= BUFFSIZE) { if (len >= BUFFSIZE) {
@ -1816,14 +1824,20 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
/* NOTE: Using pointers to malloced memory won't work if we /* NOTE: Using pointers to malloced memory won't work if we
1. have preemtive threading, and, 1. have preemtive threading, and,
2. have a GC which moves objects. */ 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 else
types = p = buffer; types = p = buffer;
for ( ; !SCM_NULLP (args); args = SCM_CDR (args)) for ( ; !SCM_NULLP (args); args = SCM_CDR (args))
*p++ = scm_class_of (SCM_CAR (args)); *p++ = scm_class_of (SCM_CAR (args));
/* Build a list of all applicable methods */ /* Build a list of all applicable methods */
for (l = SCM_SLOT (gf, scm_si_methods); !SCM_NULLP (l); l = SCM_CDR (l)) for (l = SCM_SLOT (gf, scm_si_methods); !SCM_NULLP (l); l = SCM_CDR (l))
{ {
@ -1857,6 +1871,8 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
/* if we are here, it's because no-applicable-method hasn't signaled an error */ /* if we are here, it's because no-applicable-method hasn't signaled an error */
return SCM_BOOL_F; return SCM_BOOL_F;
} }
scm_remember_upto_here (tmp);
return (count == 1 return (count == 1
? applicable ? applicable
: sort_applicable_methods (applicable, count, types)); : sort_applicable_methods (applicable, count, types));
@ -2135,7 +2151,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { 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_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; return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F;
} }

2
libguile/hash.c
View file

@ -145,7 +145,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
case scm_tc7_vector: case scm_tc7_vector:
{ {
size_t len = SCM_VECTOR_LENGTH(obj); size_t len = SCM_VECTOR_LENGTH(obj);
SCM *data = SCM_VELTS(obj); SCM const *data = SCM_VELTS(obj);
if (len > 5) if (len > 5)
{ {
size_t i = d/2; size_t i = d/2;

26
libguile/hashtab.c
View file

@ -61,7 +61,7 @@ scm_c_make_hash_table (unsigned long k)
SCM SCM
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" #define FUNC_NAME "scm_hash_fn_get_handle"
{ {
unsigned long k; unsigned long k;
@ -80,8 +80,8 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc
SCM SCM
scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(), scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure) SCM (*assoc_fn)(), void * closure)
#define FUNC_NAME "scm_hash_fn_create_handle_x" #define FUNC_NAME "scm_hash_fn_create_handle_x"
{ {
unsigned long k; unsigned long k;
@ -107,7 +107,7 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)
SCM old_bucket; SCM old_bucket;
old_bucket = SCM_VELTS (table)[k]; old_bucket = SCM_VELTS (table)[k];
new_bucket = scm_acons (obj, init, old_bucket); new_bucket = scm_acons (obj, init, old_bucket);
SCM_VELTS(table)[k] = new_bucket; SCM_VECTOR_SET (table, k, new_bucket);
SCM_REALLOW_INTS; SCM_REALLOW_INTS;
return SCM_CAR (new_bucket); return SCM_CAR (new_bucket);
} }
@ -116,8 +116,8 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)
SCM SCM
scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(), scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure) SCM (*assoc_fn)(), void * closure)
{ {
SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_CONSP (it)) if (SCM_CONSP (it))
@ -130,8 +130,8 @@ scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(),
SCM SCM
scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(), scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure) SCM (*assoc_fn)(), void * closure)
{ {
SCM it; SCM it;
@ -145,8 +145,8 @@ scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(),
SCM SCM
scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(), scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(),
SCM (*delete_fn)(),void * closure) SCM (*delete_fn)(), void * closure)
{ {
unsigned long k; unsigned long k;
SCM h; SCM h;
@ -158,7 +158,7 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_f
if (k >= SCM_VECTOR_LENGTH (table)) if (k >= SCM_VECTOR_LENGTH (table))
scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
h = assoc_fn (obj, SCM_VELTS (table)[k], closure); 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; return h;
} }
@ -528,8 +528,8 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
"table into an a-list of key-value pairs.") "table into an a-list of key-value pairs.")
#define FUNC_NAME s_scm_hash_fold #define FUNC_NAME s_scm_hash_fold
{ {
SCM_VALIDATE_PROC (1,proc); SCM_VALIDATE_PROC (1, proc);
SCM_VALIDATE_VECTOR (3,table); SCM_VALIDATE_VECTOR (3, table);
return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table); return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table);
} }
#undef FUNC_NAME #undef FUNC_NAME

6
libguile/hooks.c
View file

@ -228,7 +228,7 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0,
{ {
SCM arity, rest; SCM arity, rest;
int n_args; int n_args;
SCM_VALIDATE_HOOK (1,hook); SCM_VALIDATE_HOOK (1, hook);
SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)), SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)),
proc, SCM_ARG2, FUNC_NAME); proc, SCM_ARG2, FUNC_NAME);
n_args = SCM_HOOK_ARITY (hook); n_args = SCM_HOOK_ARITY (hook);
@ -267,7 +267,7 @@ SCM_DEFINE (scm_reset_hook_x, "reset-hook!", 1, 0, 0,
"value of this procedure is not specified.") "value of this procedure is not specified.")
#define FUNC_NAME s_scm_reset_hook_x #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); SCM_SET_HOOK_PROCEDURES (hook, SCM_EOL);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -281,7 +281,7 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1,
"last. The return value of this procedure is not specified.") "last. The return value of this procedure is not specified.")
#define FUNC_NAME s_scm_run_hook #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)) if (scm_ilength (args) != SCM_HOOK_ARITY (hook))
SCM_MISC_ERROR ("Hook ~S requires ~A arguments", SCM_MISC_ERROR ("Hook ~S requires ~A arguments",
scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook)))); scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook))));

2
libguile/init.c
View file

@ -199,7 +199,7 @@ static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define ";
static void static void
fixconfig (char *s1,char *s2,int s) fixconfig (char *s1, char *s2, int s)
{ {
fputs (s1, stderr); fputs (s1, stderr);
fputs (s2, stderr); fputs (s2, stderr);

16
libguile/ioext.c
View file

@ -97,8 +97,8 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
old = SCM_COERCE_OUTPORT (old); old = SCM_COERCE_OUTPORT (old);
new = SCM_COERCE_OUTPORT (new); new = SCM_COERCE_OUTPORT (new);
SCM_VALIDATE_OPFPORT (1,old); SCM_VALIDATE_OPFPORT (1, old);
SCM_VALIDATE_OPFPORT (2,new); SCM_VALIDATE_OPFPORT (2, new);
oldfd = SCM_FPORT_FDES (old); oldfd = SCM_FPORT_FDES (old);
fp = SCM_FSTREAM (new); fp = SCM_FSTREAM (new);
newfd = fp->fdes; newfd = fp->fdes;
@ -138,7 +138,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
oldfd = SCM_INUM (fd_or_port); oldfd = SCM_INUM (fd_or_port);
else else
{ {
SCM_VALIDATE_OPFPORT (1,fd_or_port); SCM_VALIDATE_OPFPORT (1, fd_or_port);
oldfd = SCM_FPORT_FDES (fd_or_port); oldfd = SCM_FPORT_FDES (fd_or_port);
} }
@ -197,7 +197,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0,
#define FUNC_NAME s_scm_fileno #define FUNC_NAME s_scm_fileno
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port); SCM_VALIDATE_OPFPORT (1, port);
return SCM_MAKINUM (SCM_FPORT_FDES (port)); return SCM_MAKINUM (SCM_FPORT_FDES (port));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -238,7 +238,7 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
"same as that accepted by @ref{File Ports, open-file}.") "same as that accepted by @ref{File Ports, open-file}.")
#define FUNC_NAME s_scm_fdopen #define FUNC_NAME s_scm_fdopen
{ {
SCM_VALIDATE_INUM (1,fdes); SCM_VALIDATE_INUM (1, fdes);
SCM_VALIDATE_STRING (2, modes); SCM_VALIDATE_STRING (2, modes);
return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F); return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F);
@ -269,8 +269,8 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port); SCM_VALIDATE_OPFPORT (1, port);
SCM_VALIDATE_INUM (2,fd); SCM_VALIDATE_INUM (2, fd);
stream = SCM_FSTREAM (port); stream = SCM_FSTREAM (port);
old_fd = stream->fdes; old_fd = stream->fdes;
new_fd = SCM_INUM (fd); new_fd = SCM_INUM (fd);
@ -300,7 +300,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
int int_fd; int int_fd;
long i; 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++) for (i = 0; i < scm_port_table_size; i++)
{ {

4
libguile/lang.c
View file

@ -85,7 +85,7 @@ SCM_DEFINE (scm_nil_car, "nil-car", 1, 0, 0,
{ {
if (SCM_NILP (x)) if (SCM_NILP (x))
return scm_lisp_nil; return scm_lisp_nil;
SCM_VALIDATE_CONS (1,x); SCM_VALIDATE_CONS (1, x);
return SCM_CAR (x); return SCM_CAR (x);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -98,7 +98,7 @@ SCM_DEFINE (scm_nil_cdr, "nil-cdr", 1, 0, 0,
{ {
if (SCM_NILP (x)) if (SCM_NILP (x))
return scm_lisp_nil; return scm_lisp_nil;
SCM_VALIDATE_CONS (1,x); SCM_VALIDATE_CONS (1, x);
return SCM_EOL2NIL (SCM_CDR (x), x); return SCM_EOL2NIL (SCM_CDR (x), x);
} }
#undef FUNC_NAME #undef FUNC_NAME

18
libguile/list.c
View file

@ -59,7 +59,7 @@
/* creating lists */ /* creating lists */
#define SCM_I_CONS(cell,x,y) \ #define SCM_I_CONS(cell, x, y) \
do { \ do { \
cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \ cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \
} while (0) } while (0)
@ -218,7 +218,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0,
#define FUNC_NAME s_scm_length #define FUNC_NAME s_scm_length
{ {
long i; long i;
SCM_VALIDATE_LIST_COPYLEN (1,lst,i); SCM_VALIDATE_LIST_COPYLEN (1, lst, i);
return SCM_MAKINUM (i); return SCM_MAKINUM (i);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -398,7 +398,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
{ {
SCM lst = list; SCM lst = list;
unsigned long int i; 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)) { while (SCM_CONSP (lst)) {
if (i == 0) if (i == 0)
return SCM_CAR (lst); return SCM_CAR (lst);
@ -422,7 +422,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
{ {
SCM lst = list; SCM lst = list;
unsigned long int i; 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)) { while (SCM_CONSP (lst)) {
if (i == 0) { if (i == 0) {
SCM_SETCAR (lst, val); SCM_SETCAR (lst, val);
@ -453,9 +453,9 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0,
#define FUNC_NAME s_scm_list_tail #define FUNC_NAME s_scm_list_tail
{ {
register long i; register long i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
while (i-- > 0) { while (i-- > 0) {
SCM_VALIDATE_CONS (1,lst); SCM_VALIDATE_CONS (1, lst);
lst = SCM_CDR(lst); lst = SCM_CDR(lst);
} }
return lst; return lst;
@ -470,7 +470,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
{ {
SCM lst = list; SCM lst = list;
unsigned long int i; 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)) { while (SCM_CONSP (lst)) {
if (i == 0) { if (i == 0) {
SCM_SETCDR (lst, val); SCM_SETCDR (lst, val);
@ -501,12 +501,12 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
SCM * pos; SCM * pos;
register long i; register long i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
answer = SCM_EOL; answer = SCM_EOL;
pos = &answer; pos = &answer;
while (i-- > 0) while (i-- > 0)
{ {
SCM_VALIDATE_CONS (1,lst); SCM_VALIDATE_CONS (1, lst);
*pos = scm_cons (SCM_CAR (lst), SCM_EOL); *pos = scm_cons (SCM_CAR (lst), SCM_EOL);
pos = SCM_CDRLOC (*pos); pos = SCM_CDRLOC (*pos);
lst = SCM_CDR(lst); lst = SCM_CDR(lst);

4
libguile/load.c
View file

@ -282,12 +282,12 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
size_t max_path_len; /* maximum length of any PATH element */ size_t max_path_len; /* maximum length of any PATH element */
size_t max_ext_len; /* maximum length of any EXTENSIONS 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); SCM_VALIDATE_STRING (2, filename);
if (SCM_UNBNDP (extensions)) if (SCM_UNBNDP (extensions))
extensions = SCM_EOL; extensions = SCM_EOL;
else else
SCM_VALIDATE_LIST (3,extensions); SCM_VALIDATE_LIST (3, extensions);
filename_chars = SCM_STRING_CHARS (filename); filename_chars = SCM_STRING_CHARS (filename);
filename_len = SCM_STRING_LENGTH (filename); filename_len = SCM_STRING_LENGTH (filename);

10
libguile/macros.c
View file

@ -106,7 +106,7 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
"environment.") "environment.")
#define FUNC_NAME s_scm_makacro #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)); SCM_RETURN_NEWSMOB (scm_tc16_macro, SCM_UNPACK (code));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -134,7 +134,7 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0,
" non-memoizing macros in general. Use memoizing macros" " non-memoizing macros in general. Use memoizing macros"
" or r5rs macros instead."); " 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)); SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -154,7 +154,7 @@ SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0,
"form of the containing code.") "form of the containing code.")
#define FUNC_NAME s_scm_makmmacro #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)); SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -206,7 +206,7 @@ SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0,
"Return the name of the macro @var{m}.") "Return the name of the macro @var{m}.")
#define FUNC_NAME s_scm_macro_name #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))); return scm_procedure_name (SCM_PACK (SCM_SMOB_DATA (m)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -217,7 +217,7 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0,
"Return the transformer of the macro @var{m}.") "Return the transformer of the macro @var{m}.")
#define FUNC_NAME s_scm_macro_transformer #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)))) ? return ((SCM_CLOSUREP (SCM_PACK (SCM_SMOB_DATA (m)))) ?
SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F); SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F);
} }

2
libguile/modules.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_MODULES_H #ifndef SCM_MODULES_H
#define 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 * 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 * it under the terms of the GNU General Public License as published by

45
libguile/net_db.c
View file

@ -154,7 +154,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
#define FUNC_NAME s_scm_gethost #define FUNC_NAME s_scm_gethost
{ {
SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans); SCM *ve = SCM_WRITABLE_VELTS (ans);
SCM lst = SCM_EOL; SCM lst = SCM_EOL;
struct hostent *entry; struct hostent *entry;
struct in_addr inad; struct in_addr inad;
@ -190,13 +190,13 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry) if (!entry)
scm_resolv_error (FUNC_NAME, host); scm_resolv_error (FUNC_NAME, host);
ve[0] = scm_mem2string (entry->h_name, strlen (entry->h_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
ve[1] = scm_makfromstrs (-1, entry->h_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases));
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L));
ve[3] = SCM_MAKINUM (entry->h_length + 0L); SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L));
if (sizeof (struct in_addr) != entry->h_length) if (sizeof (struct in_addr) != entry->h_length)
{ {
ve[4] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 4, SCM_BOOL_F);
return ans; return ans;
} }
for (argv = entry->h_addr_list; argv[i]; i++); for (argv = entry->h_addr_list; argv[i]; i++);
@ -205,7 +205,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
inad = *(struct in_addr *) argv[i]; inad = *(struct in_addr *) argv[i];
lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
} }
ve[4] = lst; SCM_VECTOR_SET(ans, 4, lst);
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -237,7 +237,8 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
struct netent *entry; struct netent *entry;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (net)) if (SCM_UNBNDP (net))
{ {
entry = getnetent (); entry = getnetent ();
@ -261,10 +262,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno);
ve[0] = scm_mem2string (entry->n_name, strlen (entry->n_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
ve[1] = scm_makfromstrs (-1, entry->n_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases));
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L));
ve[3] = scm_ulong2num (entry->n_net + 0L); SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L));
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -286,7 +287,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
struct protoent *entry; struct protoent *entry;
ans = scm_c_make_vector (3, SCM_UNSPECIFIED); ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (protocol)) if (SCM_UNBNDP (protocol))
{ {
entry = getprotoent (); entry = getprotoent ();
@ -310,9 +311,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno);
ve[0] = scm_mem2string (entry->p_name, strlen (entry->p_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
ve[1] = scm_makfromstrs (-1, entry->p_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases));
ve[2] = SCM_MAKINUM (entry->p_proto + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L));
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -326,11 +327,11 @@ scm_return_entry (struct servent *entry)
SCM *ve; SCM *ve;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
ve[0] = scm_mem2string (entry->s_name, strlen (entry->s_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
ve[1] = scm_makfromstrs (-1, entry->s_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases));
ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L));
ve[3] = scm_mem2string (entry->s_proto, strlen (entry->s_proto)); SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
return ans; return ans;
} }
@ -367,7 +368,7 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
} }
else else
{ {
SCM_VALIDATE_INUM (1,name); SCM_VALIDATE_INUM (1, name);
entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol)); entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol));
} }
if (!entry) if (!entry)

8
libguile/numbers.c
View file

@ -65,7 +65,7 @@ static SCM scm_divbigbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, in
static SCM scm_divbigint (SCM x, long z, int sgn, int mode); 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 /* FLOBUFLEN is the maximum number of characters neccessary for the
@ -1257,7 +1257,7 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
SCM_WRONG_TYPE_ARG (2, k); SCM_WRONG_TYPE_ARG (2, k);
} }
else else
SCM_VALIDATE_ULONG_COPY (2,k,i2); SCM_VALIDATE_ULONG_COPY (2, k, i2);
if (i2 < 0) if (i2 < 0)
{ {
i2 = -i2; i2 = -i2;
@ -1350,7 +1350,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
#define FUNC_NAME s_scm_bit_extract #define FUNC_NAME s_scm_bit_extract
{ {
unsigned long int istart, iend; 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_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
SCM_ASSERT_RANGE (3, end, (iend >= istart)); SCM_ASSERT_RANGE (3, end, (iend >= istart));
@ -2992,7 +2992,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
SCM answer; SCM answer;
int base; int base;
SCM_VALIDATE_STRING (1, string); 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), answer = scm_i_mem2number (SCM_STRING_CHARS (string),
SCM_STRING_LENGTH (string), SCM_STRING_LENGTH (string),
base); base);

8
libguile/objects.c
View file

@ -468,8 +468,8 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
#define FUNC_NAME s_scm_make_class_object #define FUNC_NAME s_scm_make_class_object
{ {
unsigned long flags = 0; unsigned long flags = 0;
SCM_VALIDATE_STRUCT (1,metaclass); SCM_VALIDATE_STRUCT (1, metaclass);
SCM_VALIDATE_STRING (2,layout); SCM_VALIDATE_STRING (2, layout);
if (SCM_EQ_P (metaclass, scm_metaclass_operator)) if (SCM_EQ_P (metaclass, scm_metaclass_operator))
flags = SCM_CLASSF_OPERATOR; flags = SCM_CLASSF_OPERATOR;
return scm_i_make_class_object (metaclass, layout, flags); return scm_i_make_class_object (metaclass, layout, flags);
@ -483,8 +483,8 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
#define FUNC_NAME s_scm_make_subclass_object #define FUNC_NAME s_scm_make_subclass_object
{ {
SCM pl; SCM pl;
SCM_VALIDATE_STRUCT (1,class); SCM_VALIDATE_STRUCT (1, class);
SCM_VALIDATE_STRING (2,layout); SCM_VALIDATE_STRING (2, layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]); pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */ /* Convert symbol->string */
pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl)); pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));

2
libguile/objects.h
View file

@ -92,7 +92,7 @@
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0) ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
#define SCM_ENTITY_PROCEDURE(obj) \ #define SCM_ENTITY_PROCEDURE(obj) \
(SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure])) (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)) (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_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter]))
#define SCM_SET_ENTITY_SETTER(obj, v) \ #define SCM_SET_ENTITY_SETTER(obj, v) \

58
libguile/ports.c
View file

@ -264,7 +264,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
else else
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port); pt = SCM_PTAB_ENTRY (port);
@ -340,7 +340,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
long count; long count;
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
count = pt->read_end - pt->read_pos; count = pt->read_end - pt->read_pos;
if (pt->read_buf == pt->putback_buf) if (pt->read_buf == pt->putback_buf)
@ -409,7 +409,7 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
#define FUNC_NAME s_scm_set_current_input_port #define FUNC_NAME s_scm_set_current_input_port
{ {
SCM oinp = scm_cur_inp; SCM oinp = scm_cur_inp;
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
scm_cur_inp = port; scm_cur_inp = port;
return oinp; return oinp;
} }
@ -423,7 +423,7 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
{ {
SCM ooutp = scm_cur_outp; SCM ooutp = scm_cur_outp;
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1,port); SCM_VALIDATE_OPOUTPORT (1, port);
scm_cur_outp = port; scm_cur_outp = port;
return ooutp; return ooutp;
} }
@ -437,7 +437,7 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
{ {
SCM oerrp = scm_cur_errp; SCM oerrp = scm_cur_errp;
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1,port); SCM_VALIDATE_OPOUTPORT (1, port);
scm_cur_errp = port; scm_cur_errp = port;
return oerrp; return oerrp;
} }
@ -538,7 +538,7 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
#define FUNC_NAME s_scm_pt_member #define FUNC_NAME s_scm_pt_member
{ {
long i; long i;
SCM_VALIDATE_INUM_COPY (1,index,i); SCM_VALIDATE_INUM_COPY (1, index, i);
if (i < 0 || i >= scm_port_table_size) if (i < 0 || i >= scm_port_table_size)
return SCM_BOOL_F; return SCM_BOOL_F;
else else
@ -579,7 +579,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
#define FUNC_NAME s_scm_port_revealed #define FUNC_NAME s_scm_port_revealed
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
return SCM_MAKINUM (scm_revealed_count (port)); return SCM_MAKINUM (scm_revealed_count (port));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -592,8 +592,8 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
#define FUNC_NAME s_scm_set_port_revealed_x #define FUNC_NAME s_scm_set_port_revealed_x
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2,rcount); SCM_VALIDATE_INUM (2, rcount);
SCM_REVEALED (port) = SCM_INUM (rcount); SCM_REVEALED (port) = SCM_INUM (rcount);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -638,7 +638,7 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
modes[0] = '\0'; modes[0] = '\0';
port = SCM_COERCE_OUTPORT (port); 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_RDNG) {
if (SCM_CELL_WORD_0 (port) & SCM_WRTNG) if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
strcpy (modes, "r+"); strcpy (modes, "r+");
@ -805,7 +805,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0,
"open.") "open.")
#define FUNC_NAME s_scm_port_closed_p #define FUNC_NAME s_scm_port_closed_p
{ {
SCM_VALIDATE_PORT (1,port); SCM_VALIDATE_PORT (1, port);
return SCM_BOOL (!SCM_OPPORTP (port)); return SCM_BOOL (!SCM_OPPORTP (port));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -835,7 +835,7 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
else else
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1,port); SCM_VALIDATE_OPOUTPORT (1, port);
} }
scm_flush (port); scm_flush (port);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -869,7 +869,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
int c; int c;
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
c = scm_getc (port); c = scm_getc (port);
if (EOF == c) if (EOF == c)
return SCM_EOF_VAL; return SCM_EOF_VAL;
@ -1196,7 +1196,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
else else
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
c = scm_getc (port); c = scm_getc (port);
if (EOF == c) if (EOF == c)
return SCM_EOF_VAL; return SCM_EOF_VAL;
@ -1215,11 +1215,11 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
{ {
int c; int c;
SCM_VALIDATE_CHAR (1,cobj); SCM_VALIDATE_CHAR (1, cobj);
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
else else
SCM_VALIDATE_OPINPORT (2,port); SCM_VALIDATE_OPINPORT (2, port);
c = SCM_CHAR (cobj); c = SCM_CHAR (cobj);
@ -1236,11 +1236,11 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
"@var{port} is not supplied, the current-input-port is used.") "@var{port} is not supplied, the current-input-port is used.")
#define FUNC_NAME s_scm_unread_string #define FUNC_NAME s_scm_unread_string
{ {
SCM_VALIDATE_STRING (1,str); SCM_VALIDATE_STRING (1, str);
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
else else
SCM_VALIDATE_OPINPORT (2,port); SCM_VALIDATE_OPINPORT (2, port);
scm_ungets (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port); scm_ungets (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port);
@ -1297,7 +1297,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
} }
else /* file descriptor?. */ else /* file descriptor?. */
{ {
SCM_VALIDATE_INUM (1,fd_port); SCM_VALIDATE_INUM (1, fd_port);
rv = lseek (SCM_INUM (fd_port), off, how); rv = lseek (SCM_INUM (fd_port), off, how);
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1339,11 +1339,11 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
{ {
/* must supply length if object is a filename. */ /* must supply length if object is a filename. */
if (SCM_STRINGP (object)) 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)); 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) if (c_length < 0)
SCM_MISC_ERROR ("negative offset", SCM_EOL); SCM_MISC_ERROR ("negative offset", SCM_EOL);
@ -1384,7 +1384,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0,
#define FUNC_NAME s_scm_port_line #define FUNC_NAME s_scm_port_line
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
return SCM_MAKINUM (SCM_LINUM (port)); return SCM_MAKINUM (SCM_LINUM (port));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1395,8 +1395,8 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0,
#define FUNC_NAME s_scm_set_port_line_x #define FUNC_NAME s_scm_set_port_line_x
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2,line); SCM_VALIDATE_INUM (2, line);
SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line); SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1416,7 +1416,7 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0,
#define FUNC_NAME s_scm_port_column #define FUNC_NAME s_scm_port_column
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
return SCM_MAKINUM (SCM_COL (port)); return SCM_MAKINUM (SCM_COL (port));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1429,8 +1429,8 @@ SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0,
#define FUNC_NAME s_scm_set_port_column_x #define FUNC_NAME s_scm_set_port_column_x
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2,column); SCM_VALIDATE_INUM (2, column);
SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column); SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1444,7 +1444,7 @@ SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0,
#define FUNC_NAME s_scm_port_filename #define FUNC_NAME s_scm_port_filename
{ {
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port); SCM_VALIDATE_OPENPORT (1, port);
return SCM_FILENAME (port); return SCM_FILENAME (port);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1458,7 +1458,7 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
#define FUNC_NAME s_scm_set_port_filename_x #define FUNC_NAME s_scm_set_port_filename_x
{ {
port = SCM_COERCE_OUTPORT (port); 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. */ /* We allow the user to set the filename to whatever he likes. */
SCM_SET_FILENAME (port, filename); SCM_SET_FILENAME (port, filename);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;

6
libguile/ports.h
View file

@ -168,15 +168,15 @@ SCM_API long scm_port_table_size; /* Number of ports in scm_port_table. */
SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN) 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_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_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_FILENAME(x) (SCM_PTAB_ENTRY(x)->file_name)
#define SCM_SET_FILENAME(x, n) (SCM_PTAB_ENTRY(x)->file_name = (n)) #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_LINUM(x) (SCM_PTAB_ENTRY(x)->line_number)
#define SCM_COL(x) (SCM_PTAB_ENTRY(x)->column_number) #define SCM_COL(x) (SCM_PTAB_ENTRY(x)->column_number)
#define SCM_REVEALED(x) (SCM_PTAB_ENTRY(x)->revealed) #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_INCLINE(port) {SCM_LINUM (port) += 1; SCM_COL (port) = 0;}
#define SCM_INCCOL(port) {SCM_COL (port) += 1;} #define SCM_INCCOL(port) {SCM_COL (port) += 1;}

108
libguile/posix.c
View file

@ -236,9 +236,13 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
getgroups (ngroups, groups); getgroups (ngroups, groups);
ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); 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); free (groups);
return ans; return ans;
} }
@ -253,12 +257,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
"or getpwent respectively.") "or getpwent respectively.")
#define FUNC_NAME s_scm_getpwuid #define FUNC_NAME s_scm_getpwuid
{ {
SCM result;
struct passwd *entry; struct passwd *entry;
SCM *ve;
result = scm_c_make_vector (7, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (user) || SCM_FALSEP (user)) if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{ {
SCM_SYSCALL (entry = getpwent ()); SCM_SYSCALL (entry = getpwent ());
@ -279,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
ve[0] = scm_makfrom0str (entry->pw_name); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name));
ve[1] = scm_makfrom0str (entry->pw_passwd); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd));
ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
ve[4] = scm_makfrom0str (entry->pw_gecos); SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos));
if (!entry->pw_dir) if (!entry->pw_dir)
ve[5] = scm_makfrom0str (""); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (""));
else else
ve[5] = scm_makfrom0str (entry->pw_dir); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir));
if (!entry->pw_shell) if (!entry->pw_shell)
ve[6] = scm_makfrom0str (""); SCM_VECTOR_SET(ans, 6, scm_makfrom0str (""));
else else
ve[6] = scm_makfrom0str (entry->pw_shell); SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell));
return result; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_GETPWENT */ #endif /* HAVE_GETPWENT */
@ -325,11 +326,9 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
"or getgrent respectively.") "or getgrent respectively.")
#define FUNC_NAME s_scm_getgrgid #define FUNC_NAME s_scm_getgrgid
{ {
SCM result;
struct group *entry; struct group *entry;
SCM *ve; SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
result = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (name) || SCM_FALSEP (name)) if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{ {
SCM_SYSCALL (entry = getgrent ()); SCM_SYSCALL (entry = getgrent ());
@ -348,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
ve[0] = scm_makfrom0str (entry->gr_name); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name));
ve[1] = scm_makfrom0str (entry->gr_passwd); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd));
ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
ve[3] = scm_makfromstrs (-1, entry->gr_mem); SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem));
return result; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -401,8 +400,8 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
"@end defvar") "@end defvar")
#define FUNC_NAME s_scm_kill #define FUNC_NAME s_scm_kill
{ {
SCM_VALIDATE_INUM (1,pid); SCM_VALIDATE_INUM (1, pid);
SCM_VALIDATE_INUM (2,sig); SCM_VALIDATE_INUM (2, sig);
/* Signal values are interned in scm_init_posix(). */ /* Signal values are interned in scm_init_posix(). */
#ifdef HAVE_KILL #ifdef HAVE_KILL
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
@ -457,12 +456,12 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
int i; int i;
int status; int status;
int ioptions; int ioptions;
SCM_VALIDATE_INUM (1,pid); SCM_VALIDATE_INUM (1, pid);
if (SCM_UNBNDP (options)) if (SCM_UNBNDP (options))
ioptions = 0; ioptions = 0;
else else
{ {
SCM_VALIDATE_INUM (2,options); SCM_VALIDATE_INUM (2, options);
/* Flags are interned in scm_init_posix. */ /* Flags are interned in scm_init_posix. */
ioptions = SCM_INUM (options); ioptions = SCM_INUM (options);
} }
@ -484,7 +483,7 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0,
{ {
int lstatus; int lstatus;
SCM_VALIDATE_INUM (1,status); SCM_VALIDATE_INUM (1, status);
/* On Ultrix, the WIF... macros assume their argument is an lvalue; /* On Ultrix, the WIF... macros assume their argument is an lvalue;
go figure. SCM_INUM does not yield an lvalue. */ go figure. SCM_INUM does not yield an lvalue. */
@ -504,7 +503,7 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0,
{ {
int lstatus; int lstatus;
SCM_VALIDATE_INUM (1,status); SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status); lstatus = SCM_INUM (status);
if (WIFSIGNALED (lstatus)) if (WIFSIGNALED (lstatus))
@ -522,7 +521,7 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
{ {
int lstatus; int lstatus;
SCM_VALIDATE_INUM (1,status); SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status); lstatus = SCM_INUM (status);
if (WIFSTOPPED (lstatus)) if (WIFSTOPPED (lstatus))
@ -610,7 +609,7 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0,
"The return value is unspecified.") "The return value is unspecified.")
#define FUNC_NAME s_scm_setuid #define FUNC_NAME s_scm_setuid
{ {
SCM_VALIDATE_INUM (1,id); SCM_VALIDATE_INUM (1, id);
if (setuid (SCM_INUM (id)) != 0) if (setuid (SCM_INUM (id)) != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -624,7 +623,7 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0,
"The return value is unspecified.") "The return value is unspecified.")
#define FUNC_NAME s_scm_setgid #define FUNC_NAME s_scm_setgid
{ {
SCM_VALIDATE_INUM (1,id); SCM_VALIDATE_INUM (1, id);
if (setgid (SCM_INUM (id)) != 0) if (setgid (SCM_INUM (id)) != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -642,7 +641,7 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
{ {
int rv; int rv;
SCM_VALIDATE_INUM (1,id); SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID #ifdef HAVE_SETEUID
rv = seteuid (SCM_INUM (id)); rv = seteuid (SCM_INUM (id));
#else #else
@ -668,7 +667,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
{ {
int rv; int rv;
SCM_VALIDATE_INUM (1,id); SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID #ifdef HAVE_SETEUID
rv = setegid (SCM_INUM (id)); rv = setegid (SCM_INUM (id));
#else #else
@ -708,8 +707,8 @@ SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0,
"The return value is unspecified.") "The return value is unspecified.")
#define FUNC_NAME s_scm_setpgid #define FUNC_NAME s_scm_setpgid
{ {
SCM_VALIDATE_INUM (1,pid); SCM_VALIDATE_INUM (1, pid);
SCM_VALIDATE_INUM (2,pgid); SCM_VALIDATE_INUM (2, pgid);
/* FIXME(?): may be known as setpgrp. */ /* FIXME(?): may be known as setpgrp. */
if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
SCM_SYSERROR; SCM_SYSERROR;
@ -746,7 +745,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
int fd; int fd;
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPPORT (1,port); SCM_VALIDATE_OPPORT (1, port);
if (!SCM_FPORTP (port)) if (!SCM_FPORTP (port))
return SCM_BOOL_F; return SCM_BOOL_F;
fd = SCM_FPORT_FDES (port); fd = SCM_FPORT_FDES (port);
@ -794,7 +793,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port); SCM_VALIDATE_OPFPORT (1, port);
fd = SCM_FPORT_FDES (port); fd = SCM_FPORT_FDES (port);
if ((pgid = tcgetpgrp (fd)) == -1) if ((pgid = tcgetpgrp (fd)) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -817,8 +816,8 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port); SCM_VALIDATE_OPFPORT (1, port);
SCM_VALIDATE_INUM (2,pgid); SCM_VALIDATE_INUM (2, pgid);
fd = SCM_FPORT_FDES (port); fd = SCM_FPORT_FDES (port);
if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1) if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -984,17 +983,16 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
{ {
struct utsname buf; struct utsname buf;
SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;
ve[0] = scm_makfrom0str (buf.sysname); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname));
ve[1] = scm_makfrom0str (buf.nodename); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename));
ve[2] = scm_makfrom0str (buf.release); SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release));
ve[3] = scm_makfrom0str (buf.version); SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version));
ve[4] = scm_makfrom0str (buf.machine); SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine));
/* /*
a linux special? a linux special?
ve[5] = scm_makfrom0str (buf.domainname); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname));
*/ */
return ans; return ans;
} }
@ -1225,7 +1223,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
char *clocale; char *clocale;
char *rv; char *rv;
SCM_VALIDATE_INUM (1,category); SCM_VALIDATE_INUM (1, category);
if (SCM_UNBNDP (locale)) if (SCM_UNBNDP (locale))
{ {
clocale = NULL; clocale = NULL;
@ -1267,9 +1265,9 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
int ctype = 0; int ctype = 0;
SCM_VALIDATE_STRING (1, path); SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_SYMBOL (2,type); SCM_VALIDATE_SYMBOL (2, type);
SCM_VALIDATE_INUM (3,perms); SCM_VALIDATE_INUM (3, perms);
SCM_VALIDATE_INUM (4,dev); SCM_VALIDATE_INUM (4, dev);
p = SCM_SYMBOL_CHARS (type); p = SCM_SYMBOL_CHARS (type);
if (strcmp (p, "regular") == 0) if (strcmp (p, "regular") == 0)
@ -1289,7 +1287,7 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
ctype = S_IFSOCK; ctype = S_IFSOCK;
#endif #endif
else 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_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms),
SCM_INUM (dev))); SCM_INUM (dev)));
@ -1308,7 +1306,7 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0,
"The return value is unspecified.") "The return value is unspecified.")
#define FUNC_NAME s_scm_nice #define FUNC_NAME s_scm_nice
{ {
SCM_VALIDATE_INUM (1,incr); SCM_VALIDATE_INUM (1, incr);
if (nice(SCM_INUM(incr)) != 0) if (nice(SCM_INUM(incr)) != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;

23
libguile/print.c
View file

@ -216,7 +216,7 @@ make_print_state (void)
= scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); 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); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
return print_state; return print_state;
} }
@ -260,23 +260,22 @@ static void
grow_ref_stack (scm_print_state *pstate) grow_ref_stack (scm_print_state *pstate)
{ {
unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); 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; unsigned long int new_size = 2 * pstate->ceiling;
SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
SCM *new_elts = SCM_VELTS (new_vect);
unsigned long int i; unsigned long int i;
for (i = 0; i != old_size; ++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_vect = new_vect;
pstate->ref_stack = new_elts; pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect);
pstate->ceiling = new_size; pstate->ceiling = new_size;
} }
static void 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; register long i;
long self = pstate->top - 1; long self = pstate->top - 1;
@ -757,7 +756,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
/* Print a list. /* Print a list.
*/ */
void 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; register SCM hare, tortoise;
long floor = pstate->top - 2; long floor = pstate->top - 2;
@ -1012,7 +1011,7 @@ SCM_DEFINE (scm_newline, "newline", 0, 1, 0,
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_outp; port = scm_cur_outp;
SCM_VALIDATE_OPORT_VALUE (1,port); SCM_VALIDATE_OPORT_VALUE (1, port);
scm_putc ('\n', SCM_COERCE_OUTPORT (port)); scm_putc ('\n', SCM_COERCE_OUTPORT (port));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1027,8 +1026,8 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_outp; port = scm_cur_outp;
SCM_VALIDATE_CHAR (1,chr); SCM_VALIDATE_CHAR (1, chr);
SCM_VALIDATE_OPORT_VALUE (2,port); SCM_VALIDATE_OPORT_VALUE (2, port);
scm_putc ((int) SCM_CHAR (chr), SCM_COERCE_OUTPORT (port)); scm_putc ((int) SCM_CHAR (chr), SCM_COERCE_OUTPORT (port));
#ifdef HAVE_PIPE #ifdef HAVE_PIPE
@ -1079,8 +1078,8 @@ SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,
#define FUNC_NAME s_scm_port_with_print_state #define FUNC_NAME s_scm_port_with_print_state
{ {
SCM pwps; SCM pwps;
SCM_VALIDATE_OPORT_VALUE (1,port); SCM_VALIDATE_OPORT_VALUE (1, port);
SCM_VALIDATE_PRINTSTATE (2,pstate); SCM_VALIDATE_PRINTSTATE (2, pstate);
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate))); SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate)));
return pwps; return pwps;

8
libguile/procprop.c
View file

@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
"Return @var{obj}'s property list.") "Return @var{obj}'s property list.")
#define FUNC_NAME s_scm_procedure_properties #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), return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc),
SCM_PROCPROPS (SCM_CLOSUREP (proc) SCM_PROCPROPS (SCM_CLOSUREP (proc)
? proc ? proc
@ -191,7 +191,7 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0
{ {
if (!SCM_CLOSUREP (proc)) if (!SCM_CLOSUREP (proc))
proc = scm_stand_in_scm_proc(proc); proc = scm_stand_in_scm_proc(proc);
SCM_VALIDATE_CLOSURE (1,proc); SCM_VALIDATE_CLOSURE (1, proc);
SCM_SETPROCPROPS (proc, new_val); SCM_SETPROCPROPS (proc, new_val);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -210,7 +210,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
p, SCM_ARG1, FUNC_NAME); p, SCM_ARG1, FUNC_NAME);
return arity; return arity;
} }
SCM_VALIDATE_PROC (1,p); SCM_VALIDATE_PROC (1, p);
assoc = scm_sloppy_assq (k, assoc = scm_sloppy_assq (k,
SCM_PROCPROPS (SCM_CLOSUREP (p) SCM_PROCPROPS (SCM_CLOSUREP (p)
? p ? p
@ -228,7 +228,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
SCM assoc; SCM assoc;
if (!SCM_CLOSUREP (p)) if (!SCM_CLOSUREP (p))
p = scm_stand_in_scm_proc(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)) if (SCM_EQ_P (k, scm_sym_arity))
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p)); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p));

40
libguile/ramap.c
View file

@ -488,7 +488,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
SCM_VELTS (ra)[i] = fill; SCM_VECTOR_SET (ra, i, fill);
break; break;
case scm_tc7_string: case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2); SCM_ASRTGO (SCM_CHARP (fill), badarg2);
@ -905,7 +905,7 @@ scm_ra_eqp (SCM ra0, SCM ras)
/* opt 0 means <, nonzero means >= */ /* opt 0 means <, nonzero means >= */
static int 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; 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); unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
@ -1230,7 +1230,7 @@ scm_array_identity (SCM dst, SCM src)
static int static int
ramap (SCM ra0,SCM proc,SCM ras) ramap (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_ARRAY_DIMS (ra0)->lbnd; long i = SCM_ARRAY_DIMS (ra0)->lbnd;
long inc = SCM_ARRAY_DIMS (ra0)->inc; long inc = SCM_ARRAY_DIMS (ra0)->inc;
@ -1243,7 +1243,8 @@ ramap (SCM ra0,SCM proc,SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras; SCM args;
SCM const *ve = &ras;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_ARRAY_V (ra1);
@ -1255,6 +1256,7 @@ ramap (SCM ra0,SCM proc,SCM ras)
ras = scm_vector (ras); ras = scm_vector (ras);
ve = SCM_VELTS (ras); ve = SCM_VELTS (ras);
} }
for (; i <= n; i++, i1 += inc1) for (; i <= n; i++, i1 += inc1)
{ {
args = SCM_EOL; args = SCM_EOL;
@ -1269,7 +1271,7 @@ ramap (SCM ra0,SCM proc,SCM ras)
static int static int
ramap_cxr (SCM ra0,SCM proc,SCM ras) ramap_cxr (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED; SCM e1 = SCM_UNDEFINED;
@ -1330,7 +1332,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras)
static int 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 ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED; SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
@ -1415,7 +1417,7 @@ ramap_rp (SCM ra0,SCM proc,SCM ras)
static int static int
ramap_1 (SCM ra0,SCM proc,SCM ras) ramap_1 (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED; SCM e1 = SCM_UNDEFINED;
@ -1436,7 +1438,7 @@ ramap_1 (SCM ra0,SCM proc,SCM ras)
static int static int
ramap_2o (SCM ra0,SCM proc,SCM ras) ramap_2o (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED; SCM e1 = SCM_UNDEFINED;
@ -1483,7 +1485,7 @@ ramap_2o (SCM ra0,SCM proc,SCM ras)
static int 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; SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
@ -1521,7 +1523,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
"unspecified. The order of application is unspecified.") "unspecified. The order of application is unspecified.")
#define FUNC_NAME s_scm_array_map_x #define FUNC_NAME s_scm_array_map_x
{ {
SCM_VALIDATE_PROC (2,proc); SCM_VALIDATE_PROC (2, proc);
SCM_VALIDATE_REST_ARGUMENT (lra); SCM_VALIDATE_REST_ARGUMENT (lra);
switch (SCM_TYP7 (proc)) switch (SCM_TYP7 (proc))
{ {
@ -1624,7 +1626,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int static int
rafe (SCM ra0,SCM proc,SCM ras) rafe (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_ARRAY_DIMS (ra0)->lbnd; long i = SCM_ARRAY_DIMS (ra0)->lbnd;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_ARRAY_BASE (ra0);
@ -1637,7 +1639,8 @@ rafe (SCM ra0,SCM proc,SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras; SCM args;
SCM const*ve = &ras;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_ARRAY_V (ra1);
@ -1668,7 +1671,7 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
"in row-major order. The value returned is unspecified.") "in row-major order. The value returned is unspecified.")
#define FUNC_NAME s_scm_array_for_each #define FUNC_NAME s_scm_array_for_each
{ {
SCM_VALIDATE_PROC (1,proc); SCM_VALIDATE_PROC (1, proc);
SCM_VALIDATE_REST_ARGUMENT (lra); SCM_VALIDATE_REST_ARGUMENT (lra);
scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME); scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1697,8 +1700,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
#define FUNC_NAME s_scm_array_index_map_x #define FUNC_NAME s_scm_array_index_map_x
{ {
unsigned long i; unsigned long i;
SCM_VALIDATE_NIM (1,ra); SCM_VALIDATE_NIM (1, ra);
SCM_VALIDATE_PROC (2,proc); SCM_VALIDATE_PROC (2, proc);
switch (SCM_TYP7(ra)) switch (SCM_TYP7(ra))
{ {
default: default:
@ -1706,9 +1709,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
{ {
SCM *ve = SCM_VELTS (ra);
for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) 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; return SCM_UNSPECIFIED;
} }
case scm_tc7_string: case scm_tc7_string:
@ -1778,7 +1780,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
static int 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; SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
unsigned long i0 = 0, i1 = 0; unsigned long i0 = 0, i1 = 0;
@ -1906,7 +1908,7 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
static int static int
raeql (SCM ra0,SCM as_equal,SCM ra1) raeql (SCM ra0, SCM as_equal, SCM ra1)
{ {
SCM v0 = ra0, v1 = ra1; SCM v0 = ra0, v1 = ra1;
scm_t_array_dim dim0, dim1; scm_t_array_dim dim0, dim1;

32
libguile/random.c
View file

@ -362,7 +362,7 @@ SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_ra
SCM_DEFINE (scm_random, "random", 1, 1, 0, SCM_DEFINE (scm_random, "random", 1, 1, 0,
(SCM n, SCM state), (SCM n, SCM state),
"Return a number in [0,N).\n" "Return a number in [0, N).\n"
"\n" "\n"
"Accepts a positive integer or real n and returns a\n" "Accepts a positive integer or real n and returns a\n"
"number of the same type between zero (inclusive) and\n" "number of the same type between zero (inclusive) and\n"
@ -378,14 +378,14 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
{ {
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2,state); SCM_VALIDATE_RSTATE (2, state);
if (SCM_INUMP (n)) if (SCM_INUMP (n))
{ {
unsigned long m = SCM_INUM (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)); return SCM_MAKINUM (scm_c_random (SCM_RSTATE (state), m));
} }
SCM_VALIDATE_NIM (1,n); SCM_VALIDATE_NIM (1, n);
if (SCM_REALP (n)) if (SCM_REALP (n))
return scm_make_real (SCM_REAL_VALUE (n) return scm_make_real (SCM_REAL_VALUE (n)
* scm_c_uniform01 (SCM_RSTATE (state))); * scm_c_uniform01 (SCM_RSTATE (state)));
@ -401,7 +401,7 @@ SCM_DEFINE (scm_copy_random_state, "copy-random-state", 0, 1, 0,
{ {
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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))); return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -413,7 +413,7 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0,
{ {
if (SCM_NUMBERP (seed)) if (SCM_NUMBERP (seed))
seed = scm_number_to_string (seed, SCM_UNDEFINED); 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), return make_rstate (scm_c_make_rstate (SCM_STRING_CHARS (seed),
SCM_STRING_LENGTH (seed))); SCM_STRING_LENGTH (seed)));
} }
@ -427,7 +427,7 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0,
{ {
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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))); return scm_make_real (scm_c_uniform01 (SCM_RSTATE (state)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -442,7 +442,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
{ {
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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))); return scm_make_real (scm_c_normal01 (SCM_RSTATE (state)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -496,10 +496,10 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0,
"The sum of the squares of the numbers is returned.") "The sum of the squares of the numbers is returned.")
#define FUNC_NAME s_scm_random_solid_sphere_x #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)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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); scm_random_normal_vector_x (v, state);
vector_scale (v, vector_scale (v,
pow (scm_c_uniform01 (SCM_RSTATE (state)), pow (scm_c_uniform01 (SCM_RSTATE (state)),
@ -519,10 +519,10 @@ SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
"unit n-sphere.") "unit n-sphere.")
#define FUNC_NAME s_scm_random_hollow_sphere_x #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)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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); scm_random_normal_vector_x (v, state);
vector_scale (v, 1 / sqrt (vector_sum_squares (v))); vector_scale (v, 1 / sqrt (vector_sum_squares (v)));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -538,14 +538,14 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
#define FUNC_NAME s_scm_random_normal_vector_x #define FUNC_NAME s_scm_random_normal_vector_x
{ {
int n; int n;
SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v);
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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)); n = SCM_INUM (scm_uniform_vector_length (v));
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) 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 else
while (--n >= 0) while (--n >= 0)
((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state));
@ -564,7 +564,7 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
{ {
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_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))); return scm_make_real (scm_c_exp1 (SCM_RSTATE (state)));
} }
#undef FUNC_NAME #undef FUNC_NAME

4
libguile/read.c
View file

@ -107,7 +107,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
port = scm_cur_inp; port = scm_cur_inp;
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1, port);
c = scm_flush_ws (port, (char *) NULL); c = scm_flush_ws (port, (char *) NULL);
if (EOF == c) if (EOF == c)
@ -280,7 +280,7 @@ static SCM scm_get_hash_procedure(int c);
static char s_list[]="list"; static char s_list[]="list";
SCM SCM
scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
#define FUNC_NAME "scm_lreadr" #define FUNC_NAME "scm_lreadr"
{ {
int c; int c;

8
libguile/regex-posix.c
View file

@ -247,13 +247,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
regmatch_t *matches; regmatch_t *matches;
SCM mvec = SCM_BOOL_F; SCM mvec = SCM_BOOL_F;
SCM_VALIDATE_RGXP (1,rx); SCM_VALIDATE_RGXP (1, rx);
SCM_VALIDATE_STRING (2, str); SCM_VALIDATE_STRING (2, str);
SCM_VALIDATE_INUM_DEF_COPY (3,start,0,offset); SCM_VALIDATE_INUM_DEF_COPY (3, start,0, offset);
SCM_ASSERT_RANGE (3,start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); SCM_ASSERT_RANGE (3, start, offset >= 0 && offset <= SCM_STRING_LENGTH (str));
if (SCM_UNBNDP (flags)) if (SCM_UNBNDP (flags))
flags = SCM_INUM0; flags = SCM_INUM0;
SCM_VALIDATE_INUM (4,flags); SCM_VALIDATE_INUM (4, flags);
/* re_nsub doesn't account for the `subexpression' representing the /* re_nsub doesn't account for the `subexpression' representing the
whole regexp, so add 1 to nmatches. */ whole regexp, so add 1 to nmatches. */

33
libguile/scmsigs.c
View file

@ -192,10 +192,10 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
#endif #endif
int query_only = 0; int query_only = 0;
int save_handler = 0; int save_handler = 0;
SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
SCM old_handler; SCM old_handler;
SCM_VALIDATE_INUM_COPY (1,signum,csig); SCM_VALIDATE_INUM_COPY (1, signum, csig);
#if defined(HAVE_SIGACTION) #if defined(HAVE_SIGACTION)
#if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS) #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
/* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
@ -207,13 +207,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
#endif #endif
if (!SCM_UNBNDP (flags)) if (!SCM_UNBNDP (flags))
{ {
SCM_VALIDATE_INUM (3,flags); SCM_VALIDATE_INUM (3, flags);
action.sa_flags |= SCM_INUM (flags); action.sa_flags |= SCM_INUM (flags);
} }
sigemptyset (&action.sa_mask); sigemptyset (&action.sa_mask);
#endif #endif
SCM_DEFER_INTS; SCM_DEFER_INTS;
old_handler = scheme_handlers[csig]; old_handler = SCM_VELTS(*signal_handlers)[csig];
if (SCM_UNBNDP (handler)) if (SCM_UNBNDP (handler))
query_only = 1; query_only = 1;
else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
@ -226,7 +226,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
#else #else
chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
#endif #endif
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
else else
SCM_OUT_OF_RANGE (2, handler); SCM_OUT_OF_RANGE (2, handler);
@ -241,7 +241,8 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
{ {
action = orig_handlers[csig]; action = orig_handlers[csig];
orig_handlers[csig].sa_handler = SIG_ERR; orig_handlers[csig].sa_handler = SIG_ERR;
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
#else #else
if (orig_handlers[csig] == SIG_ERR) if (orig_handlers[csig] == SIG_ERR)
@ -250,13 +251,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
{ {
chandler = orig_handlers[csig]; chandler = orig_handlers[csig];
orig_handlers[csig] = SIG_ERR; orig_handlers[csig] = SIG_ERR;
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
#endif #endif
} }
else else
{ {
SCM_VALIDATE_NIM (2,handler); SCM_VALIDATE_NIM (2, handler);
#ifdef HAVE_SIGACTION #ifdef HAVE_SIGACTION
action.sa_handler = take_signal; action.sa_handler = take_signal;
if (orig_handlers[csig].sa_handler == SIG_ERR) if (orig_handlers[csig].sa_handler == SIG_ERR)
@ -266,7 +267,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
if (orig_handlers[csig] == SIG_ERR) if (orig_handlers[csig] == SIG_ERR)
save_handler = 1; save_handler = 1;
#endif #endif
scheme_handlers[csig] = handler; SCM_VECTOR_SET (*signal_handlers, csig, handler);
} }
/* XXX - Silently ignore setting handlers for `program error signals' /* XXX - Silently ignore setting handlers for `program error signals'
@ -346,8 +347,6 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
#define FUNC_NAME s_scm_restore_signals #define FUNC_NAME s_scm_restore_signals
{ {
int i; int i;
SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
for (i = 0; i < NSIG; i++) for (i = 0; i < NSIG; i++)
{ {
#ifdef HAVE_SIGACTION #ifdef HAVE_SIGACTION
@ -356,7 +355,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (sigaction (i, &orig_handlers[i], NULL) == -1) if (sigaction (i, &orig_handlers[i], NULL) == -1)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i].sa_handler = SIG_ERR; orig_handlers[i].sa_handler = SIG_ERR;
scheme_handlers[i] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
} }
#else #else
if (orig_handlers[i] != SIG_ERR) if (orig_handlers[i] != SIG_ERR)
@ -364,7 +363,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (signal (i, orig_handlers[i]) == SIG_ERR) if (signal (i, orig_handlers[i]) == SIG_ERR)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i] = SIG_ERR; orig_handlers[i] = SIG_ERR;
scheme_handlers[i] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
} }
#endif #endif
} }
@ -385,7 +384,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
#define FUNC_NAME s_scm_alarm #define FUNC_NAME s_scm_alarm
{ {
unsigned int j; unsigned int j;
SCM_VALIDATE_INUM (1,i); SCM_VALIDATE_INUM (1, i);
j = alarm (SCM_INUM (i)); j = alarm (SCM_INUM (i));
return SCM_MAKINUM (j); return SCM_MAKINUM (j);
} }
@ -496,7 +495,7 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
#define FUNC_NAME s_scm_sleep #define FUNC_NAME s_scm_sleep
{ {
unsigned long j; unsigned long j;
SCM_VALIDATE_INUM_MIN (1,i,0); SCM_VALIDATE_INUM_MIN (1, i,0);
#ifdef USE_THREADS #ifdef USE_THREADS
j = scm_thread_sleep (SCM_INUM(i)); j = scm_thread_sleep (SCM_INUM(i));
#else #else
@ -513,7 +512,7 @@ SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
"all platforms.") "all platforms.")
#define FUNC_NAME s_scm_usleep #define FUNC_NAME s_scm_usleep
{ {
SCM_VALIDATE_INUM_MIN (1,i,0); SCM_VALIDATE_INUM_MIN (1, i,0);
#ifdef USE_THREADS #ifdef USE_THREADS
/* If we have threads, we use the thread system's sleep function. */ /* If we have threads, we use the thread system's sleep function. */
@ -542,7 +541,7 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
"@var{sig} is as described for the kill procedure.") "@var{sig} is as described for the kill procedure.")
#define FUNC_NAME s_scm_raise #define FUNC_NAME s_scm_raise
{ {
SCM_VALIDATE_INUM (1,sig); SCM_VALIDATE_INUM (1, sig);
SCM_DEFER_INTS; SCM_DEFER_INTS;
if (kill (getpid (), (int) SCM_INUM (sig)) != 0) if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
SCM_SYSERROR; SCM_SYSERROR;

2
libguile/simpos.c
View file

@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
int cstatus = 0; int cstatus = 0;
if (!SCM_UNBNDP (status)) if (!SCM_UNBNDP (status))
{ {
SCM_VALIDATE_INUM (1,status); SCM_VALIDATE_INUM (1, status);
cstatus = SCM_INUM (status); cstatus = SCM_INUM (status);
} }
exit (cstatus); exit (cstatus);

6
libguile/smob.c
View file

@ -137,11 +137,11 @@ scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
#define SCM_SMOB_APPLY0(SMOB) \ #define SCM_SMOB_APPLY0(SMOB) \
SCM_SMOB_DESCRIPTOR (SMOB).apply (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) 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) 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) SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2, A3)
static SCM static SCM

6
libguile/smob.h
View file

@ -115,9 +115,9 @@ do { \
#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)]) #define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
#define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply) #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_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_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_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_3(x, a1, a2, rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
SCM_API long scm_numsmob; SCM_API long scm_numsmob;
SCM_API scm_smob_descriptor scm_smobs[]; SCM_API scm_smob_descriptor scm_smobs[];

81
libguile/socket.c
View file

@ -473,9 +473,9 @@ SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
int fam; int fam;
int fd[2]; int fd[2];
SCM_VALIDATE_INUM (1,family); SCM_VALIDATE_INUM (1, family);
SCM_VALIDATE_INUM (2,style); SCM_VALIDATE_INUM (2, style);
SCM_VALIDATE_INUM (3,proto); SCM_VALIDATE_INUM (3, proto);
fam = SCM_INUM (family); fam = SCM_INUM (family);
@ -673,9 +673,9 @@ SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
{ {
int fd; int fd;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_INUM (2,how); SCM_VALIDATE_INUM (2, how);
SCM_ASSERT_RANGE(2,how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how)); SCM_ASSERT_RANGE(2, how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how));
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (shutdown (fd, SCM_INUM (how)) == -1) if (shutdown (fd, SCM_INUM (how)) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -820,8 +820,8 @@ SCM_DEFINE (scm_connect, "connect", 3, 0, 1,
int size; int size;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_INUM (2,fam); SCM_VALIDATE_INUM (2, fam);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME, soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME,
&size); &size);
@ -911,8 +911,8 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
{ {
int fd; int fd;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_INUM (2,backlog); SCM_VALIDATE_INUM (2, backlog);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (listen (fd, SCM_INUM (backlog)) == -1) if (listen (fd, SCM_INUM (backlog)) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -925,8 +925,8 @@ static SCM
scm_addr_vector (const struct sockaddr *address, const char *proc) scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
short int fam = address->sa_family; short int fam = address->sa_family;
SCM result; SCM ans =SCM_EOL;
SCM *ve;
switch (fam) switch (fam)
{ {
@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in *nad = (struct sockaddr_in *) address; const struct sockaddr_in *nad = (struct sockaddr_in *) address;
result = scm_c_make_vector (3, SCM_UNSPECIFIED); ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr)));
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port)));
} }
break; break;
#ifdef HAVE_IPV6 #ifdef HAVE_IPV6
@ -946,16 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
result = scm_c_make_vector (5, SCM_UNSPECIFIED); ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
ve = SCM_VELTS (result); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr));
ve[1] = ipv6_net_to_num (nad->sin6_addr.s6_addr); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)));
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo));
ve[3] = scm_ulong2num ((unsigned long) nad->sin6_flowinfo);
#ifdef HAVE_SIN6_SCOPE_ID #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 #else
ve[4] = SCM_INUM0; SCM_VECTOR_SET(ans, 4, SCM_INUM0);
#endif #endif
} }
break; break;
@ -965,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_un *nad = (struct sockaddr_un *) address; const struct sockaddr_un *nad = (struct sockaddr_un *) address;
result = scm_c_make_vector (2, SCM_UNSPECIFIED); ans = scm_c_make_vector (2, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[1] = scm_mem2string (nad->sun_path, strlen (nad->sun_path)); SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
} }
break; break;
#endif #endif
@ -976,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
scm_misc_error (proc, "Unrecognised address family: ~A", scm_misc_error (proc, "Unrecognised address family: ~A",
scm_list_1 (SCM_MAKINUM (fam))); scm_list_1 (SCM_MAKINUM (fam)));
} }
return result; return ans;
} }
/* calculate the size of a buffer large enough to hold any supported /* calculate the size of a buffer large enough to hold any supported
@ -1047,7 +1046,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
struct sockaddr *addr = (struct sockaddr *) max_addr; struct sockaddr *addr = (struct sockaddr *) max_addr;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (getsockname (fd, addr, &addr_size) == -1) if (getsockname (fd, addr, &addr_size) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1069,7 +1068,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
struct sockaddr *addr = (struct sockaddr *) max_addr; struct sockaddr *addr = (struct sockaddr *) max_addr;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (getpeername (fd, addr, &addr_size) == -1) if (getpeername (fd, addr, &addr_size) == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1102,9 +1101,9 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
int fd; int fd;
int flg; int flg;
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_STRING (2,buf); SCM_VALIDATE_STRING (2, buf);
SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg); SCM_VALIDATE_INUM_DEF_COPY (3, flags,0, flg);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = recv (fd, SCM_STRING_CHARS (buf), SCM_STRING_LENGTH (buf), flg)); SCM_SYSCALL (rv = recv (fd, SCM_STRING_CHARS (buf), SCM_STRING_LENGTH (buf), flg));
@ -1136,9 +1135,9 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
int flg; int flg;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_STRING (2, message); 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); fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg)); SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg));
@ -1182,7 +1181,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
char max_addr[MAX_ADDR_SIZE]; char max_addr[MAX_ADDR_SIZE];
struct sockaddr *addr = (struct sockaddr *) max_addr; struct sockaddr *addr = (struct sockaddr *) max_addr;
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 4, start, offset, SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 4, start, offset,
5, end, cend); 5, end, cend);
@ -1236,9 +1235,9 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
int size; int size;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_FPORT (1,sock); SCM_VALIDATE_FPORT (1, sock);
SCM_VALIDATE_STRING (2, message); SCM_VALIDATE_STRING (2, message);
SCM_VALIDATE_INUM (3,fam); SCM_VALIDATE_INUM (3, fam);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4,
FUNC_NAME, &size); FUNC_NAME, &size);
@ -1246,7 +1245,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
flg = 0; flg = 0;
else else
{ {
SCM_VALIDATE_CONS (5,args_and_flags); SCM_VALIDATE_CONS (5, args_and_flags);
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags)); flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
} }
SCM_SYSCALL (rv = sendto (fd, SCM_STRING_CHARS (message), SCM_SYSCALL (rv = sendto (fd, SCM_STRING_CHARS (message),

70
libguile/sort.c
View file

@ -425,18 +425,20 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
size_t vlen, spos, len, size = sizeof (SCM); size_t vlen, spos, len, size = sizeof (SCM);
SCM *vp; SCM *vp;
SCM_VALIDATE_VECTOR (1,vec); SCM_VALIDATE_VECTOR (1, vec);
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
vp = SCM_VELTS (vec); /* vector pointer */ vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */
vlen = SCM_VECTOR_LENGTH (vec); vlen = SCM_VECTOR_LENGTH (vec);
SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos);
SCM_ASSERT_RANGE (3,startpos, spos <= vlen); SCM_ASSERT_RANGE (3, startpos, spos <= vlen);
SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1); SCM_VALIDATE_INUM_RANGE (4, endpos,0, vlen+1);
len = SCM_INUM (endpos) - spos; len = SCM_INUM (endpos) - spos;
quicksort (&vp[spos], len, size, scm_cmp_function (less), less); quicksort (&vp[spos], len, size, scm_cmp_function (less), less);
SCM_GC_FLAG_OBJECT_WRITE(vec);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
/* return vec; */ /* return vec; */
} }
@ -455,18 +457,18 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
{ {
long len, j; /* list/vector length, temp j */ long len, j; /* list/vector length, temp j */
SCM item, rest; /* rest of items loop variable */ SCM item, rest; /* rest of items loop variable */
SCM *vp; SCM const *vp;
cmp_fun_t cmp = scm_cmp_function (less); cmp_fun_t cmp = scm_cmp_function (less);
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return SCM_BOOL_T; return SCM_BOOL_T;
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) if (SCM_CONSP (items))
{ {
len = scm_ilength (items); /* also checks that it's a pure list */ 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) if (len <= 1)
return SCM_BOOL_T; return SCM_BOOL_T;
@ -529,7 +531,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
long alen, blen; /* list lengths */ long alen, blen; /* list lengths */
SCM build, last; SCM build, last;
cmp_fun_t cmp = scm_cmp_function (less); 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)) if (SCM_NULL_OR_NIL_P (alist))
return blist; return blist;
@ -537,8 +539,8 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
return alist; return alist;
else else
{ {
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
if ((*cmp) (less, SCM_CARLOC (blist), SCM_CARLOC (alist))) if ((*cmp) (less, SCM_CARLOC (blist), SCM_CARLOC (alist)))
{ {
build = scm_cons (SCM_CAR (blist), SCM_EOL); build = scm_cons (SCM_CAR (blist), SCM_EOL);
@ -641,15 +643,15 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0,
{ {
long alen, blen; /* list lengths */ long alen, blen; /* list lengths */
SCM_VALIDATE_NIM (3,less); SCM_VALIDATE_NIM (3, less);
if (SCM_NULL_OR_NIL_P (alist)) if (SCM_NULL_OR_NIL_P (alist))
return blist; return blist;
else if (SCM_NULL_OR_NIL_P (blist)) else if (SCM_NULL_OR_NIL_P (blist))
return alist; return alist;
else else
{ {
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
return scm_merge_list_x (alist, blist, return scm_merge_list_x (alist, blist,
alen, blen, alen, blen,
scm_cmp_function (less), scm_cmp_function (less),
@ -719,11 +721,11 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return items; return items;
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) 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); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }
else if (SCM_VECTORP (items)) else if (SCM_VECTORP (items))
@ -752,12 +754,12 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return items; return items;
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) if (SCM_CONSP (items))
{ {
long len; long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len); SCM_VALIDATE_LIST_COPYLEN (1, items, len);
items = scm_list_copy (items); items = scm_list_copy (items);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }
@ -850,10 +852,10 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return items; return items;
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) 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); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }
else if (SCM_VECTORP (items)) else if (SCM_VECTORP (items))
@ -861,7 +863,14 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
SCM *temp, *vp; SCM *temp, *vp;
len = SCM_VECTOR_LENGTH (items); len = SCM_VECTOR_LENGTH (items);
temp = malloc (len * sizeof(SCM)); 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, scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),
@ -889,10 +898,10 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
return items; return items;
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
if (SCM_CONSP (items)) if (SCM_CONSP (items))
{ {
SCM_VALIDATE_LIST_COPYLEN (1,items,len); SCM_VALIDATE_LIST_COPYLEN (1, items, len);
items = scm_list_copy (items); items = scm_list_copy (items);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }
@ -906,7 +915,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
retvec = scm_make_uve (len, scm_array_prototype (items)); retvec = scm_make_uve (len, scm_array_prototype (items));
scm_array_copy_x (items, retvec); scm_array_copy_x (items, retvec);
temp = malloc (len * sizeof (SCM)); 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, scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),
@ -932,8 +946,8 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
#define FUNC_NAME s_scm_sort_list_x #define FUNC_NAME s_scm_sort_list_x
{ {
long len; long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len); SCM_VALIDATE_LIST_COPYLEN (1, items, len);
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -946,8 +960,8 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0,
#define FUNC_NAME s_scm_sort_list #define FUNC_NAME s_scm_sort_list
{ {
long len; long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len); SCM_VALIDATE_LIST_COPYLEN (1, items, len);
SCM_VALIDATE_NIM (2,less); SCM_VALIDATE_NIM (2, less);
items = scm_list_copy (items); items = scm_list_copy (items);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
} }

12
libguile/srcprop.c
View file

@ -179,7 +179,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
#define FUNC_NAME s_scm_source_properties #define FUNC_NAME s_scm_source_properties
{ {
SCM p; SCM p;
SCM_VALIDATE_NIM (1,obj); SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj)) if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj)) else if (!SCM_CONSP (obj))
@ -200,7 +200,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
#define FUNC_NAME s_scm_set_source_properties_x #define FUNC_NAME s_scm_set_source_properties_x
{ {
SCM handle; SCM handle;
SCM_VALIDATE_NIM (1,obj); SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj)) if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj)) else if (!SCM_CONSP (obj))
@ -218,7 +218,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
#define FUNC_NAME s_scm_source_property #define FUNC_NAME s_scm_source_property
{ {
SCM p; SCM p;
SCM_VALIDATE_NIM (1,obj); SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj)) if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj)) else if (!SCM_CONSP (obj))
@ -250,7 +250,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
{ {
scm_whash_handle h; scm_whash_handle h;
SCM p; SCM p;
SCM_VALIDATE_NIM (1,obj); SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj)) if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj)) else if (!SCM_CONSP (obj))
@ -284,7 +284,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
} }
else if (SCM_EQ_P (scm_sym_line, key)) else if (SCM_EQ_P (scm_sym_line, key))
{ {
SCM_VALIDATE_INUM (3,datum); SCM_VALIDATE_INUM (3, datum);
if (SRCPROPSP (p)) if (SRCPROPSP (p))
SETSRCPROPLINE (p, SCM_INUM (datum)); SETSRCPROPLINE (p, SCM_INUM (datum));
else else
@ -294,7 +294,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
} }
else if (SCM_EQ_P (scm_sym_column, key)) else if (SCM_EQ_P (scm_sym_column, key))
{ {
SCM_VALIDATE_INUM (3,datum); SCM_VALIDATE_INUM (3, datum);
if (SRCPROPSP (p)) if (SRCPROPSP (p))
SETSRCPROPCOL (p, SCM_INUM (datum)); SETSRCPROPCOL (p, SCM_INUM (datum));
else else

8
libguile/srcprop.h
View file

@ -110,10 +110,10 @@ typedef struct scm_t_srcprops_chunk
#define CLEARSRCPROPBRK(p) \ #define CLEARSRCPROPBRK(p) \
(SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) \ (SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) \
& ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK))
#define SRCPROPMAKPOS(l,c) (((l) << 12) + (c)) #define SRCPROPMAKPOS(l, c) (((l) << 12) + (c))
#define SETSRCPROPPOS(p,l,c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) #define SETSRCPROPPOS(p, l, c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c))
#define SETSRCPROPLINE(p,l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
#define SETSRCPROPCOL(p,c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
#define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) #define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace)))

26
libguile/stacks.c
View file

@ -151,7 +151,7 @@
* is read from a continuation. * is read from a continuation.
*/ */
static scm_t_bits 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 n;
long max_depth = SCM_BACKTRACE_MAXDEPTH; long max_depth = SCM_BACKTRACE_MAXDEPTH;
@ -183,7 +183,7 @@ stack_depth (scm_t_debug_frame *dframe,long offset,SCM *id,int *maxp)
/* Read debug info from DFRAME into IFRAME. /* Read debug info from DFRAME into IFRAME.
*/ */
static void 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. */ scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe)) if (SCM_EVALFRAMEP (*dframe))
@ -250,7 +250,7 @@ do { \
*/ */
static scm_t_bits 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_info_frame *iframe = iframes;
scm_t_debug_info *info; scm_t_debug_info *info;
@ -344,7 +344,7 @@ read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *ifra
*/ */
static void 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); scm_t_stack *s = SCM_STACK (stack);
unsigned long int i; unsigned long int i;
@ -591,7 +591,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0,
"Return the length of @var{stack}.") "Return the length of @var{stack}.")
#define FUNC_NAME s_scm_stack_length #define FUNC_NAME s_scm_stack_length
{ {
SCM_VALIDATE_STACK (1,stack); SCM_VALIDATE_STACK (1, stack);
return SCM_MAKINUM (SCM_STACK_LENGTH (stack)); return SCM_MAKINUM (SCM_STACK_LENGTH (stack));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -657,7 +657,7 @@ SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
"Return the frame number of @var{frame}.") "Return the frame number of @var{frame}.")
#define FUNC_NAME s_scm_frame_number #define FUNC_NAME s_scm_frame_number
{ {
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1, frame);
return SCM_MAKINUM (SCM_FRAME_NUMBER (frame)); return SCM_MAKINUM (SCM_FRAME_NUMBER (frame));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -667,7 +667,7 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
"Return the source of @var{frame}.") "Return the source of @var{frame}.")
#define FUNC_NAME s_scm_frame_source #define FUNC_NAME s_scm_frame_source
{ {
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_SOURCE (frame); return SCM_FRAME_SOURCE (frame);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -678,7 +678,7 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
"procedure is associated with @var{frame}.") "procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure #define FUNC_NAME s_scm_frame_procedure
{ {
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1, frame);
return (SCM_FRAME_PROC_P (frame) return (SCM_FRAME_PROC_P (frame)
? SCM_FRAME_PROC (frame) ? SCM_FRAME_PROC (frame)
: SCM_BOOL_F); : SCM_BOOL_F);
@ -690,7 +690,7 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
"Return the arguments of @var{frame}.") "Return the arguments of @var{frame}.")
#define FUNC_NAME s_scm_frame_arguments #define FUNC_NAME s_scm_frame_arguments
{ {
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_ARGS (frame); return SCM_FRAME_ARGS (frame);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -732,7 +732,7 @@ SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0,
"Return @code{#t} if @var{frame} is a real frame.") "Return @code{#t} if @var{frame} is a real frame.")
#define FUNC_NAME s_scm_frame_real_p #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)); return SCM_BOOL(SCM_FRAME_REAL_P (frame));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -742,7 +742,7 @@ SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0,
"Return @code{#t} if a procedure is associated with @var{frame}.") "Return @code{#t} if a procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure_p #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)); return SCM_BOOL(SCM_FRAME_PROC_P (frame));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -752,7 +752,7 @@ SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0,
"Return @code{#t} if @var{frame} contains evaluated arguments.") "Return @code{#t} if @var{frame} contains evaluated arguments.")
#define FUNC_NAME s_scm_frame_evaluating_args_p #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)); return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -762,7 +762,7 @@ SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0,
"Return @code{#t} if @var{frame} is an overflow frame.") "Return @code{#t} if @var{frame} is an overflow frame.")
#define FUNC_NAME s_scm_frame_overflow_p #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)); return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame));
} }
#undef FUNC_NAME #undef FUNC_NAME

34
libguile/stime.c
View file

@ -195,11 +195,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
rv = times (&t); rv = times (&t);
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VELTS (result)[0] = scm_long2num (rv); SCM_VECTOR_SET (result, 0, scm_long2num (rv));
SCM_VELTS (result)[1] = scm_long2num (t.tms_utime); SCM_VECTOR_SET (result, 1, scm_long2num (t.tms_utime));
SCM_VELTS (result)[2] = scm_long2num (t.tms_stime); SCM_VECTOR_SET (result, 2, scm_long2num (t.tms_stime));
SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); SCM_VECTOR_SET (result ,3, scm_long2num (t.tms_cutime));
SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); SCM_VECTOR_SET (result, 4, scm_long2num (t.tms_cstime));
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -282,17 +282,17 @@ filltime (struct tm *bd_time, int zoff, char *zname)
{ {
SCM result = scm_c_make_vector (11, SCM_UNDEFINED); SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec); SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec));
SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min));
SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour); SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour));
SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday); SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday));
SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon); SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon));
SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year); SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year));
SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday); SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday));
SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday); SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday));
SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst); SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst));
SCM_VELTS (result)[9] = SCM_MAKINUM (zoff); SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff));
SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F; SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F);
return result; return result;
} }
@ -439,7 +439,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
static void static void
bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{ {
SCM *velts; SCM const *velts;
int i; int i;
SCM_ASSERT (SCM_VECTORP (sbd_time) SCM_ASSERT (SCM_VECTORP (sbd_time)

6
libguile/strings.c
View file

@ -271,8 +271,8 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
#define FUNC_NAME s_scm_string_set_x #define FUNC_NAME s_scm_string_set_x
{ {
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_RANGE (2,k,0,SCM_STRING_LENGTH(str)); SCM_VALIDATE_INUM_RANGE (2, k,0, SCM_STRING_LENGTH(str));
SCM_VALIDATE_CHAR (3,chr); SCM_VALIDATE_CHAR (3, chr);
SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr); SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -323,7 +323,7 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) { for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) {
s = SCM_CAR (l); s = SCM_CAR (l);
SCM_VALIDATE_STRING (SCM_ARGn,s); SCM_VALIDATE_STRING (SCM_ARGn, s);
i += SCM_STRING_LENGTH (s); i += SCM_STRING_LENGTH (s);
} }
res = scm_allocate_string (i); res = scm_allocate_string (i);

40
libguile/strop.c
View file

@ -190,17 +190,17 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
{ {
long s1, s2, e, len; long s1, s2, e, len;
SCM_VALIDATE_STRING (1,str1); SCM_VALIDATE_STRING (1, str1);
SCM_VALIDATE_INUM_COPY (2,start1,s1); SCM_VALIDATE_INUM_COPY (2, start1, s1);
SCM_VALIDATE_INUM_COPY (3,end1,e); SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_STRING (4,str2); SCM_VALIDATE_STRING (4, str2);
SCM_VALIDATE_INUM_COPY (5,start2,s2); SCM_VALIDATE_INUM_COPY (5, start2, s2);
len = e - s1; len = e - s1;
SCM_ASSERT_RANGE (3,end1,len >= 0); SCM_ASSERT_RANGE (3, end1, len >= 0);
SCM_ASSERT_RANGE (2,start1,s1 <= SCM_STRING_LENGTH (str1) && s1 >= 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 (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0);
SCM_ASSERT_RANGE (3,end1,e <= SCM_STRING_LENGTH (str1) && e >= 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 (5, start2, len+s2 <= SCM_STRING_LENGTH (str2));
SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])),
(void *)(&(SCM_STRING_CHARS(str1)[s1])), (void *)(&(SCM_STRING_CHARS(str1)[s1])),
@ -226,12 +226,12 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
{ {
long i, e; long i, e;
char c; char c;
SCM_VALIDATE_STRING (1,str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2,start,i); SCM_VALIDATE_INUM_COPY (2, start, i);
SCM_VALIDATE_INUM_COPY (3,end,e); SCM_VALIDATE_INUM_COPY (3, end, e);
SCM_VALIDATE_CHAR_COPY (4,fill,c); SCM_VALIDATE_CHAR_COPY (4, fill, c);
SCM_ASSERT_RANGE (2,start,i <= SCM_STRING_LENGTH (str) && i >= 0); 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_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0);
while (i<e) SCM_STRING_CHARS (str)[i++] = c; while (i<e) SCM_STRING_CHARS (str)[i++] = c;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -249,7 +249,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_string_null_p #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); return SCM_BOOL (SCM_STRING_LENGTH (str) == 0);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -266,7 +266,7 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
long i; long i;
SCM res = SCM_EOL; SCM res = SCM_EOL;
unsigned char *src; unsigned char *src;
SCM_VALIDATE_STRING (1,str); SCM_VALIDATE_STRING (1, str);
src = SCM_STRING_UCHARS (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); for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
return res; return res;
@ -307,8 +307,8 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
{ {
register char *dst, c; register char *dst, c;
register long k; register long k;
SCM_VALIDATE_STRING_COPY (1,str,dst); SCM_VALIDATE_STRING_COPY (1, str, dst);
SCM_VALIDATE_CHAR_COPY (2,chr,c); SCM_VALIDATE_CHAR_COPY (2, chr, c);
for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }

26
libguile/struct.c
View file

@ -440,8 +440,8 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
scm_t_bits * data; scm_t_bits * data;
SCM handle; SCM handle;
SCM_VALIDATE_VTABLE (1,vtable); SCM_VALIDATE_VTABLE (1, vtable);
SCM_VALIDATE_INUM (2,tail_array_size); SCM_VALIDATE_INUM (2, tail_array_size);
SCM_VALIDATE_REST_ARGUMENT (init); SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
@ -569,8 +569,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
char field_type = 0; char field_type = 0;
SCM_VALIDATE_STRUCT (1,handle); SCM_VALIDATE_STRUCT (1, handle);
SCM_VALIDATE_INUM (2,pos); SCM_VALIDATE_INUM (2, pos);
layout = SCM_STRUCT_LAYOUT (handle); layout = SCM_STRUCT_LAYOUT (handle);
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
@ -579,7 +579,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
fields_desc = SCM_SYMBOL_CHARS (layout); fields_desc = SCM_SYMBOL_CHARS (layout);
n_fields = data[scm_struct_i_n_words]; 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)) if (p * 2 < SCM_SYMBOL_LENGTH (layout))
{ {
@ -645,8 +645,8 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
char * fields_desc; char * fields_desc;
char field_type = 0; char field_type = 0;
SCM_VALIDATE_STRUCT (1,handle); SCM_VALIDATE_STRUCT (1, handle);
SCM_VALIDATE_INUM (2,pos); SCM_VALIDATE_INUM (2, pos);
layout = SCM_STRUCT_LAYOUT (handle); layout = SCM_STRUCT_LAYOUT (handle);
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
@ -655,7 +655,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
fields_desc = SCM_SYMBOL_CHARS (layout); fields_desc = SCM_SYMBOL_CHARS (layout);
n_fields = data[scm_struct_i_n_words]; 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)) if (p * 2 < SCM_SYMBOL_LENGTH (layout))
{ {
@ -708,7 +708,7 @@ SCM_DEFINE (scm_struct_vtable, "struct-vtable", 1, 0, 0,
"Return the vtable structure that describes the type of @var{struct}.") "Return the vtable structure that describes the type of @var{struct}.")
#define FUNC_NAME s_scm_struct_vtable #define FUNC_NAME s_scm_struct_vtable
{ {
SCM_VALIDATE_STRUCT (1,handle); SCM_VALIDATE_STRUCT (1, handle);
return SCM_STRUCT_VTABLE (handle); return SCM_STRUCT_VTABLE (handle);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -719,7 +719,7 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0,
"Return the vtable tag of the structure @var{handle}.") "Return the vtable tag of the structure @var{handle}.")
#define FUNC_NAME s_scm_struct_vtable_tag #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); return scm_long2num ((long) SCM_STRUCT_DATA (handle) >> 3);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -758,7 +758,7 @@ SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0,
"Return the name of the vtable @var{vtable}.") "Return the name of the vtable @var{vtable}.")
#define FUNC_NAME s_scm_struct_vtable_name #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))); return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -768,8 +768,8 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0,
"Set the name of the vtable @var{vtable} to @var{name}.") "Set the name of the vtable @var{vtable} to @var{name}.")
#define FUNC_NAME s_scm_set_struct_vtable_name_x #define FUNC_NAME s_scm_set_struct_vtable_name_x
{ {
SCM_VALIDATE_VTABLE (1,vtable); SCM_VALIDATE_VTABLE (1, vtable);
SCM_VALIDATE_SYMBOL (2,name); SCM_VALIDATE_SYMBOL (2, name);
SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)), SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)),
name); name);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;

10
libguile/symbols.c
View file

@ -133,7 +133,7 @@ scm_mem2symbol (const char *name, size_t len)
slot = SCM_VELTS (symbols) [hash]; slot = SCM_VELTS (symbols) [hash];
cell = scm_cons (symbol, SCM_UNDEFINED); 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 symbol;
} }
@ -319,7 +319,7 @@ SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
"Return the contents of @var{symbol}'s @dfn{function slot}.") "Return the contents of @var{symbol}'s @dfn{function slot}.")
#define FUNC_NAME s_scm_symbol_fref #define FUNC_NAME s_scm_symbol_fref
{ {
SCM_VALIDATE_SYMBOL (1,s); SCM_VALIDATE_SYMBOL (1, s);
return SCM_SYMBOL_FUNC (s); return SCM_SYMBOL_FUNC (s);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -330,7 +330,7 @@ SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0,
"Return the @dfn{property list} currently associated with @var{symbol}.") "Return the @dfn{property list} currently associated with @var{symbol}.")
#define FUNC_NAME s_scm_symbol_pref #define FUNC_NAME s_scm_symbol_pref
{ {
SCM_VALIDATE_SYMBOL (1,s); SCM_VALIDATE_SYMBOL (1, s);
return SCM_SYMBOL_PROPS (s); return SCM_SYMBOL_PROPS (s);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -341,7 +341,7 @@ SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
"Change the binding of @var{symbol}'s function slot.") "Change the binding of @var{symbol}'s function slot.")
#define FUNC_NAME s_scm_symbol_fset_x #define FUNC_NAME s_scm_symbol_fset_x
{ {
SCM_VALIDATE_SYMBOL (1,s); SCM_VALIDATE_SYMBOL (1, s);
SCM_SET_SYMBOL_FUNC (s, val); SCM_SET_SYMBOL_FUNC (s, val);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -353,7 +353,7 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
"Change the binding of @var{symbol}'s property slot.") "Change the binding of @var{symbol}'s property slot.")
#define FUNC_NAME s_scm_symbol_pset_x #define FUNC_NAME s_scm_symbol_pset_x
{ {
SCM_VALIDATE_SYMBOL (1,s); SCM_VALIDATE_SYMBOL (1, s);
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SET_SYMBOL_PROPS (s, val); SCM_SET_SYMBOL_PROPS (s, val);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;

2
libguile/tags.h
View file

@ -315,7 +315,7 @@ typedef signed long scm_t_signed_bits;
#define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x)) #define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x))
#define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x))
#define SCM_TYP16_PREDICATE(tag,x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) #define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))

6
libguile/throw.c
View file

@ -76,10 +76,10 @@ static scm_t_bits tc16_jmpbuffer;
(SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L)))) (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) #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 #ifdef DEBUG_EXTENSIONS
#define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x)) #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 #endif
static int static int
@ -595,7 +595,7 @@ SCM_DEFINE (scm_throw, "throw", 1, 0, 1,
"If there is no handler at all, Guile prints an error and then exits.") "If there is no handler at all, Guile prints an error and then exits.")
#define FUNC_NAME s_scm_throw #define FUNC_NAME s_scm_throw
{ {
SCM_VALIDATE_SYMBOL (1,key); SCM_VALIDATE_SYMBOL (1, key);
return scm_ithrow (key, args, 1); return scm_ithrow (key, args, 1);
} }
#undef FUNC_NAME #undef FUNC_NAME

35
libguile/unif.c
View file

@ -678,8 +678,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
scm_t_array_dim *s; scm_t_array_dim *s;
SCM_VALIDATE_REST_ARGUMENT (dims); SCM_VALIDATE_REST_ARGUMENT (dims);
SCM_VALIDATE_ARRAY (1,oldra); SCM_VALIDATE_ARRAY (1, oldra);
SCM_VALIDATE_PROC (2,mapfunc); SCM_VALIDATE_PROC (2, mapfunc);
ra = scm_shap2ra (dims, FUNC_NAME); ra = scm_shap2ra (dims, FUNC_NAME);
if (SCM_ARRAYP (oldra)) if (SCM_ARRAYP (oldra))
{ {
@ -802,7 +802,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_transpose_array #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; scm_t_array_dim *s, *r;
int ndim, i, k; int ndim, i, k;
@ -1104,7 +1105,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
} }
else else
{ {
SCM_VALIDATE_INUM (2,args); SCM_VALIDATE_INUM (2, args);
pos = SCM_INUM (args); pos = SCM_INUM (args);
} }
length = SCM_INUM (scm_uniform_vector_length (v)); length = SCM_INUM (scm_uniform_vector_length (v));
@ -1184,7 +1185,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
default: default:
SCM_WRONG_TYPE_ARG (SCM_ARG1, v); SCM_WRONG_TYPE_ARG (SCM_ARG1, v);
case scm_tc7_bvect: case scm_tc7_bvect:
if (SCM_BITVEC_REF(v,pos)) if (SCM_BITVEC_REF(v, pos))
return SCM_BOOL_T; return SCM_BOOL_T;
else else
return SCM_BOOL_F; return SCM_BOOL_F;
@ -1278,7 +1279,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
} }
else else
{ {
SCM_VALIDATE_INUM_COPY (3,args,pos); SCM_VALIDATE_INUM_COPY (3, args, pos);
} }
length = SCM_INUM (scm_uniform_vector_length (v)); length = SCM_INUM (scm_uniform_vector_length (v));
SCM_ASRTGO (pos >= 0 && pos < length, outrng); SCM_ASRTGO (pos >= 0 && pos < length, outrng);
@ -1296,9 +1297,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
goto badarg1; goto badarg1;
case scm_tc7_bvect: case scm_tc7_bvect:
if (SCM_FALSEP (obj)) if (SCM_FALSEP (obj))
SCM_BITVEC_CLR(v,pos); SCM_BITVEC_CLR(v, pos);
else if (SCM_EQ_P (obj, SCM_BOOL_T)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
SCM_BITVEC_SET(v,pos); SCM_BITVEC_SET(v, pos);
else else
badobj:SCM_WRONG_TYPE_ARG (2, obj); badobj:SCM_WRONG_TYPE_ARG (2, obj);
break; break;
@ -1350,7 +1351,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
SCM_VELTS (v)[pos] = obj; SCM_VECTOR_SET (v, pos, obj);
break; break;
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1824,7 +1825,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
SCM_VALIDATE_BOOL (1, item); SCM_VALIDATE_BOOL (1, item);
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); 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)); SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0));
if (pos == SCM_BITVECTOR_LENGTH (v)) if (pos == SCM_BITVECTOR_LENGTH (v))
@ -1902,7 +1903,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); 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)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_UVECTOR_LENGTH (kv); i;) for (i = SCM_UVECTOR_LENGTH (kv); i;)
@ -1910,7 +1911,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
SCM_BITVEC_SET(v,k); SCM_BITVEC_SET(v, k);
} }
else else
badarg3:SCM_WRONG_TYPE_ARG (3, obj); badarg3:SCM_WRONG_TYPE_ARG (3, obj);
@ -1960,7 +1961,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (!SCM_BITVEC_REF(v,k)) if (!SCM_BITVEC_REF(v, k))
count++; count++;
} }
else if (SCM_EQ_P (obj, SCM_BOOL_T)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
@ -1969,7 +1970,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (SCM_BITVEC_REF (v,k)) if (SCM_BITVEC_REF (v, k))
count++; count++;
} }
else else
@ -2050,7 +2051,7 @@ scm_istr2bve (char *str, long len)
static SCM 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 SCM res = SCM_EOL;
register long inc = SCM_ARRAY_DIMS (ra)[k].inc; register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
@ -2190,7 +2191,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
SCM ra; SCM ra;
unsigned long k; unsigned long k;
long n; long n;
SCM_VALIDATE_INUM_COPY (1,ndim,k); SCM_VALIDATE_INUM_COPY (1, ndim, k);
while (k--) while (k--)
{ {
n = scm_ilength (row); n = scm_ilength (row);
@ -2261,7 +2262,7 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k)
static void 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 inc = 1;
long n = (SCM_TYP7 (ra) == scm_tc7_smob long n = (SCM_TYP7 (ra) == scm_tc7_smob

4
libguile/unif.h
View file

@ -96,8 +96,8 @@ SCM_API scm_t_bits scm_tc16_array;
#define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH
#define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #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_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_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_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect))
#define SCM_BITVECTOR_BASE(x) ((unsigned long *) (SCM_CELL_WORD_1 (x))) #define SCM_BITVECTOR_BASE(x) ((unsigned long *) (SCM_CELL_WORD_1 (x)))

12
libguile/validate.h
View file

@ -306,10 +306,10 @@
} \ } \
} while (0) } while (0)
/* [low,high) */ /* [low, high) */
#define SCM_VALIDATE_INUM_RANGE(pos,k,low,high) \ #define SCM_VALIDATE_INUM_RANGE(pos, k, low, high) \
do { SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); \ 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) >= low && \
SCM_INUM (k) < high)); \ SCM_INUM (k) < high)); \
} while (0) } while (0)
@ -367,7 +367,7 @@
SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \ SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \
} while (0) } 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) \ #define SCM_VALIDATE_SMOB(pos, obj, type) \
do { \ do { \
@ -421,7 +421,7 @@
#define SCM_VALIDATE_OPINPORT(pos, port) \ #define SCM_VALIDATE_OPINPORT(pos, port) \
SCM_MAKE_VALIDATE (pos, port, OPINPORTP) SCM_MAKE_VALIDATE (pos, port, OPINPORTP)
#define SCM_VALIDATE_OPENPORT(pos,port) \ #define SCM_VALIDATE_OPENPORT(pos, port) \
do { \ do { \
SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \ SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \
port, pos, FUNC_NAME); \ port, pos, FUNC_NAME); \
@ -445,7 +445,7 @@
#define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE (pos, v, RSTATEP) #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 { \ do { \
SCM_ASSERT (!SCM_IMP (v) \ SCM_ASSERT (!SCM_IMP (v) \
&& !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \ && !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \

2
libguile/variable.h
View file

@ -55,7 +55,7 @@
*/ */
#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable) #define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable)
#define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1 (V) #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)) #define SCM_VARIABLE_LOC(V) ((SCM *) SCM_CELL_WORD_LOC ((V), 1))

44
libguile/vectors.c
View file

@ -101,7 +101,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
while the vector is being created. */ while the vector is being created. */
SCM_VALIDATE_LIST_COPYLEN (1, l, i); SCM_VALIDATE_LIST_COPYLEN (1, l, i);
res = scm_c_make_vector (i, SCM_UNSPECIFIED); 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)) while (!SCM_NULL_OR_NIL_P (l))
{ {
*data++ = SCM_CAR (l); *data++ = SCM_CAR (l);
@ -165,7 +169,7 @@ scm_vector_set_x (SCM v, SCM k, SCM obj)
g_vector_set_x, scm_list_3 (v, k, obj), g_vector_set_x, scm_list_3 (v, k, obj),
SCM_ARG2, s_vector_set_x); SCM_ARG2, s_vector_set_x);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); 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; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -235,8 +239,8 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
{ {
SCM res = SCM_EOL; SCM res = SCM_EOL;
long i; long i;
SCM *data; SCM const *data;
SCM_VALIDATE_VECTOR (1,v); SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS(v); data = SCM_VELTS(v);
for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res); for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res);
return res; return res;
@ -251,11 +255,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
#define FUNC_NAME s_scm_vector_fill_x #define FUNC_NAME s_scm_vector_fill_x
{ {
register long i; register long i;
register SCM *data;
SCM_VALIDATE_VECTOR (1, v); SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS (v);
for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--)
data[i] = fill; SCM_VECTOR_SET(v, i, fill);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -287,16 +290,19 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
long j; long j;
long e; long e;
SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_VECTOR (1, vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i); SCM_VALIDATE_INUM_COPY (2, start1, i);
SCM_VALIDATE_INUM_COPY (3,end1,e); SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_VECTOR (4,vec2); SCM_VALIDATE_VECTOR (4, vec2);
SCM_VALIDATE_INUM_COPY (5,start2,j); SCM_VALIDATE_INUM_COPY (5, start2, j);
SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0); 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 (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 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)); 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; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -316,18 +322,18 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
long j; long j;
long e; long e;
SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_VECTOR (1, vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i); SCM_VALIDATE_INUM_COPY (2, start1, i);
SCM_VALIDATE_INUM_COPY (3,end1,e); SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_VECTOR (4,vec2); SCM_VALIDATE_VECTOR (4, vec2);
SCM_VALIDATE_INUM_COPY (5,start2,j); SCM_VALIDATE_INUM_COPY (5, start2, j);
SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0); 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 (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0);
j = e - i + j; j = e - i + j;
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2)); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2));
while (i < e) while (i < e)
SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e]; SCM_VECTOR_SET (vec2, --j, SCM_VELTS (vec1)[--e]);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

15
libguile/vectors.h
View file

@ -55,13 +55,20 @@
#define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
#define SCM_VECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #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_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_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_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x))
#define SCM_SETVELTS(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) #define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val))
#define SCM_GC_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x))
/*
no WB yet.
*/
#define SCM_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x))
/* /*

2
libguile/vports.c
View file

@ -187,7 +187,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
{ {
scm_t_port *pt; scm_t_port *pt;
SCM z; SCM z;
SCM_VALIDATE_VECTOR_LEN (1,pv,5); SCM_VALIDATE_VECTOR_LEN (1, pv,5);
SCM_VALIDATE_STRING (2, modes); SCM_VALIDATE_STRING (2, modes);
z = scm_cell (scm_tc16_sfport, 0); z = scm_cell (scm_tc16_sfport, 0);
SCM_DEFER_INTS; SCM_DEFER_INTS;

11
libguile/weaks.c
View file

@ -141,8 +141,11 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
i = scm_ilength (l); i = scm_ilength (l);
SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); 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)) while (!SCM_NULL_OR_NIL_P (l))
{ {
*data++ = SCM_CAR (l); *data++ = SCM_CAR (l);
@ -261,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
{ {
if (SCM_IS_WHVEC_ANY (w)) if (SCM_IS_WHVEC_ANY (w))
{ {
SCM *ptr; SCM const *ptr;
SCM obj; SCM obj;
long j; long j;
long n; long n;
@ -302,7 +305,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
{ {
register long j, n; register long j, n;
ptr = SCM_VELTS (w); ptr = SCM_GC_WRITABLE_VELTS (w);
n = SCM_VECTOR_LENGTH (w); n = SCM_VECTOR_LENGTH (w);
for (j = 0; j < n; ++j) for (j = 0; j < n; ++j)
if (SCM_FREE_CELL_P (ptr[j])) if (SCM_FREE_CELL_P (ptr[j]))
@ -316,7 +319,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj);
int weak_values = SCM_IS_WHVEC_V (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) for (j = 0; j < n; ++j)
{ {