diff options
-rw-r--r-- | guile-readline/readline.c | 2 | ||||
-rw-r--r-- | libguile/dynl.c | 4 | ||||
-rw-r--r-- | libguile/eval.c | 2 | ||||
-rw-r--r-- | libguile/evalext.c | 3 | ||||
-rw-r--r-- | libguile/filesys.c | 15 | ||||
-rw-r--r-- | libguile/fluids.c | 9 | ||||
-rw-r--r-- | libguile/ioext.c | 10 | ||||
-rw-r--r-- | libguile/numbers.c | 109 | ||||
-rw-r--r-- | libguile/ports.c | 4 | ||||
-rw-r--r-- | libguile/scm_validate.h | 16 |
10 files changed, 51 insertions, 123 deletions
diff --git a/guile-readline/readline.c b/guile-readline/readline.c index 49dab1b75..188ad8f73 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -514,7 +514,7 @@ scm_init_readline () rl_readline_name = "Guile"; #ifdef USE_THREADS - scm_mutex_init (&reentry_barrier_mutex, NULL); + scm_mutex_init (&reentry_barrier_mutex); #endif scm_init_opts (scm_readline_options, scm_readline_opts, diff --git a/libguile/dynl.c b/libguile/dynl.c index d648d36ad..057ae450d 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -367,7 +367,7 @@ as the @var{lib} argument to the following functions.") struct dynl_obj *d; int flags = DYNL_GLOBAL; - fname = scm_coerce_rostring (fname, FUNC_NAME, SCM_ARG1); + SCM_COERCE_ROSTRING (1, fname); /* collect flags */ while (SCM_CONSP (rest)) @@ -475,7 +475,7 @@ needed or not and will add it when necessary. struct dynl_obj *d; void (*func) (); - symb = scm_coerce_rostring (symb, FUNC_NAME, SCM_ARG1); + SCM_COERCE_ROSTRING (1, symb); d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG2); SCM_DEFER_INTS; diff --git a/libguile/eval.c b/libguile/eval.c index dc9d80853..77cffe9bb 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -3190,7 +3190,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, #define FUNC_NAME s_scm_nconc2last { SCM *lloc; - SCM_VALIDATE_LIST (1,lst); + SCM_VALIDATE_NONEMPTYLIST (1,lst); lloc = &lst; while (SCM_NNULLP (SCM_CDR (*lloc))) lloc = SCM_CDRLOC (*lloc); diff --git a/libguile/evalext.c b/libguile/evalext.c index 9fe0b6811..0e9ab9b05 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -90,8 +90,7 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0, b = SCM_CAR (frames); if (SCM_NFALSEP (scm_procedure_p (b))) break; - SCM_ASSERT (SCM_CONSP (b), - env, SCM_ARG2, FUNC_NAME); + SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME); for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b)) { if (SCM_NCONSP (b)) diff --git a/libguile/filesys.c b/libguile/filesys.c index 3ffbd76d2..848138ec7 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -155,8 +155,7 @@ as @code{-1}, then that ID is not changed.") } else { - SCM_ASSERT (SCM_ROSTRINGP (object), - object, SCM_ARG1, FUNC_NAME); + SCM_VALIDATE_ROSTRING(1,object); SCM_COERCE_SUBSTR (object); SCM_SYSCALL (rv = chown (SCM_ROCHARS (object), SCM_INUM (owner), SCM_INUM (group))); @@ -243,8 +242,8 @@ port.") SCM_VALIDATE_ROSTRING (1,path); SCM_COERCE_SUBSTR (path); - SCM_VALIDATE_INUM_COPY (2,flags,iflags); - SCM_VALIDATE_INUM_DEF_COPY (3,mode,0666,imode); + iflags = SCM_NUM2LONG(2,flags); + imode = SCM_NUM2LONG_DEF(3,mode,0666); SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode)); if (fd == -1) SCM_SYSERROR; @@ -289,7 +288,7 @@ for additional flags.") int iflags; fd = SCM_INUM (scm_open_fdes (path, flags, mode)); - SCM_VALIDATE_INUM_COPY (2,flags,iflags); + iflags = SCM_NUM2LONG (2,flags); if (iflags & O_RDWR) { if (iflags & O_APPEND) @@ -520,7 +519,7 @@ An integer representing the access permission bits. else { object = SCM_COERCE_OUTPORT (object); - SCM_ASSERT (SCM_OPFPORTP (object), object, SCM_ARG1, FUNC_NAME); + SCM_VALIDATE_OPFPORT(1,object); fdes = SCM_FPORT_FDES (object); SCM_SYSCALL (rv = fstat (fdes, &stat_temp)); } @@ -996,9 +995,9 @@ values instead of a list and has an additional select! interface. double fl = scm_num2dbl (secs, FUNC_NAME); if (!SCM_UNBNDP (usecs)) - scm_wrong_type_arg (FUNC_NAME, 4, secs); + SCM_WRONG_TYPE_ARG (4, secs); if (fl > LONG_MAX) - scm_out_of_range (FUNC_NAME, secs); + SCM_OUT_OF_RANGE (4, secs); timeout.tv_sec = (long) fl; timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000); } diff --git a/libguile/fluids.c b/libguile/fluids.c index 37eecf939..cc02f8a1a 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -224,13 +224,13 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, SCM scm_internal_with_fluids (SCM fluids, SCM vals, SCM (*cproc) (), void *cdata) +#define FUNC_NAME "scm_internal_with_fluids" { SCM ans; + int flen, vlen; - int flen = scm_ilength (fluids); - int vlen = scm_ilength (vals); - SCM_ASSERT (flen >= 0, fluids, SCM_ARG1, s_scm_with_fluids); - SCM_ASSERT (vlen >= 0, vals, SCM_ARG2, s_scm_with_fluids); + SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen); + SCM_VALIDATE_LIST_COPYLEN (2, vals, vlen); if (flen != vlen) scm_out_of_range (s_scm_with_fluids, vals); @@ -241,6 +241,7 @@ scm_internal_with_fluids (SCM fluids, SCM vals, SCM (*cproc) (), void *cdata) scm_swap_fluids_reverse (fluids, vals); return ans; } +#undef FUNC_NAME diff --git a/libguile/ioext.c b/libguile/ioext.c index a65407f49..cdfed984a 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -102,12 +102,11 @@ without encountering a delimiter, this value is @var{#f}.") SCM_VALIDATE_OPINPORT (4,port); SCM_VALIDATE_INUM_DEF_COPY (5,start,0,cstart); - if (cstart < 0 || cstart >= cend) - scm_out_of_range (FUNC_NAME, start); + SCM_ASSERT_RANGE(5, start, cstart >= 0 && cstart < cend); SCM_VALIDATE_INUM_DEF_COPY (6,end,cend,tend); - if (tend <= cstart || tend > cend) - scm_out_of_range (FUNC_NAME, end); + SCM_ASSERT_RANGE(6, end, tend > cstart && tend <= cend); + cend = tend; for (j = cstart; j < cend; j++) @@ -397,8 +396,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, } else { - SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, FUNC_NAME); - newfd = SCM_INUM (fd); + SCM_VALIDATE_INUM_COPY (2, fd, newfd); if (oldfd != newfd) { scm_evict_ports (newfd); /* see scsh manual. */ diff --git a/libguile/numbers.c b/libguile/numbers.c index 96712b14c..5854d692b 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -510,6 +510,11 @@ scm_lcm (SCM n1, SCM n2) #endif #ifndef scm_long2num +#define SCM_LOGOP_RETURN(x) scm_ulong2num(x) +#else +#define SCM_LOGOP_RETURN(x) SCM_MAKINUM(x) +#endif + SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, (SCM n1, SCM n2), "Returns the integer which is the bit-wise AND of the two integer @@ -530,7 +535,7 @@ Example: } SCM_VALIDATE_INUM_COPY (1,n1,i1); SCM_VALIDATE_INUM_COPY (2,n2,i2); - return scm_ulong2num (i1 & i2); + return SCM_LOGOP_RETURN (i1 & i2); } #undef FUNC_NAME @@ -555,7 +560,7 @@ Example: } SCM_VALIDATE_INUM_COPY (1,n1,i1); SCM_VALIDATE_INUM_COPY (2,n2,i2); - return scm_ulong2num (i1 | i2); + return SCM_LOGOP_RETURN (i1 | i2); } #undef FUNC_NAME @@ -580,88 +585,7 @@ Example: } SCM_VALIDATE_INUM_COPY (1,n1,i1); SCM_VALIDATE_INUM_COPY (2,n2,i2); - return scm_ulong2num (i1 ^ i2); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, - (SCM n1, SCM n2), -"") -#define FUNC_NAME s_scm_logtest -{ - int i1, i2; - SCM_VALIDATE_INUM_COPY (1,n1,i1); - SCM_VALIDATE_INUM_COPY (2,n2,i2); - return SCM_BOOL(i1 & i2); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, - (SCM n1, SCM n2), -"") -#define FUNC_NAME s_scm_logbit_p -{ - int i1, i2; - SCM_VALIDATE_INUM_COPY (1,n1,i1); - SCM_VALIDATE_INUM_COPY (2,n2,i2); - return SCM_BOOL((1 << i1) & i2); -} -#undef FUNC_NAME - -#else - -SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, - (SCM n1, SCM n2), -"") -#define FUNC_NAME s_scm_logand -{ - int i1, i2; - if (SCM_UNBNDP (n2)) - { - if (SCM_UNBNDP (n1)) - return SCM_MAKINUM (-1); - return n1; - } - SCM_VALIDATE_INUM_COPY (1,n1,i1); - SCM_VALIDATE_INUM_COPY (2,n2,i2); - return SCM_MAKINUM (i1 & i2); -} -#undef FUNC_NAME - -SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, - (SCM n1, SCM n2), -"") -#define FUNC_NAME s_scm_logior -{ - int i1, i2; - if (SCM_UNBNDP (n2)) - { - if (SCM_UNBNDP (n1)) - return SCM_INUM0; - return n1; - } - SCM_VALIDATE_INUM_COPY (1,n1,i1); - SCM_VALIDATE_INUM_COPY (2,n2,i2); - return SCM_MAKINUM (i1 | i2); -} -#undef FUNC_NAME - -SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, - (SCM n1, SCM n2), -"") -#define FUNC_NAME s_scm_logxor -{ - int i1, i2; - if (SCM_UNBNDP (n2)) - { - if (SCM_UNBNDP (n1)) - return SCM_INUM0; - return n1; - } - SCM_VALIDATE_INUM_COPY (1,n1,i1); - SCM_VALIDATE_INUM_COPY (2,n2,i2); - return SCM_MAKINUM (i1 ^ i2); + return SCM_LOGOP_RETURN (i1 ^ i2); } #undef FUNC_NAME @@ -682,6 +606,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, } #undef FUNC_NAME + SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, (SCM n1, SCM n2), "@example @@ -701,7 +626,6 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, return SCM_BOOL((1 << i1) & i2); } #undef FUNC_NAME -#endif SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0, (SCM n), @@ -821,23 +745,22 @@ Example: @end lisp") #define FUNC_NAME s_scm_bit_extract { + int istart, iend; SCM_VALIDATE_INUM (1,n); - SCM_VALIDATE_INUM_MIN (2,start,0); - SCM_VALIDATE_INUM_MIN (3,end,0); - start = SCM_INUM (start); - end = SCM_INUM (end); - SCM_ASSERT (end >= start, SCM_MAKINUM (end), SCM_OUTOFRANGE, FUNC_NAME); + SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart); + SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend); + SCM_ASSERT_RANGE (3, end, (iend >= istart)); #ifdef SCM_BIGDIG if (SCM_NINUMP (n)) return scm_logand (scm_difference (scm_integer_expt (SCM_MAKINUM (2), - SCM_MAKINUM (end - start)), + SCM_MAKINUM (iend - istart)), SCM_MAKINUM (1L)), - scm_ash (n, SCM_MAKINUM (-start))); + scm_ash (n, SCM_MAKINUM (-istart))); #else SCM_VALIDATE_INUM (1,n); #endif - return SCM_MAKINUM ((SCM_INUM (n) >> start) & ((1L << (end - start)) - 1)); + return SCM_MAKINUM ((SCM_INUM (n) >> istart) & ((1L << (iend - istart)) - 1)); } #undef FUNC_NAME diff --git a/libguile/ports.c b/libguile/ports.c index 8dbf8f1b4..62edccc26 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -669,7 +669,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0, "Returns @code{#t} if @var{port} is closed or @code{#f} if it is open.") #define FUNC_NAME s_scm_port_closed_p { - SCM_VALIDATE_OPPORT (1,port); + SCM_VALIDATE_PORT (1,port); return SCM_NEGATE_BOOL(SCM_OPPORTP (port)); } #undef FUNC_NAME @@ -1084,7 +1084,7 @@ The return value is unspecified.") { /* must supply length if object is a filename. */ if (SCM_ROSTRINGP (object)) - scm_wrong_num_args (SCM_FUNC_NAME); + SCM_MISC_ERROR("must supply length if OBJECT is a filename",SCM_EOL); length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); } diff --git a/libguile/scm_validate.h b/libguile/scm_validate.h index 5a883cc7c..6b41f158b 100644 --- a/libguile/scm_validate.h +++ b/libguile/scm_validate.h @@ -1,4 +1,4 @@ -/* $Id: scm_validate.h,v 1.16 2000-01-11 19:19:59 gjb Exp $ */ +/* $Id: scm_validate.h,v 1.17 2000-01-12 01:51:18 gjb Exp $ */ /* Copyright (C) 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -54,6 +54,9 @@ #define SCM_SYSERROR_MSG(str,args,val) \ do { scm_syserror_msg(FUNC_NAME,(str),(args),(val)); } while (0) +#define SCM_COERCE_ROSTRING(pos,scm) \ + do { scm = scm_coerce_rostring (scm, FUNC_NAME, pos); } while (0) + #define SCM_WTA(pos,scm) \ do { scm_wta(scm,(char *)pos,FUNC_NAME); } while (0) @@ -70,9 +73,11 @@ #define SCM_NUM2LONG(pos,arg) (scm_num2long(arg, (char *) pos, FUNC_NAME)) +#define SCM_NUM2LONG_DEF(pos,arg,def) (SCM_UNBNDP(arg)?SCM_MAKINUM(def):(scm_num2long(arg, (char *) pos, FUNC_NAME))) + #define SCM_NUM2LONG_LONG(pos,arg) (scm_num2long_long(arg, (char *) pos, FUNC_NAME)) -#define SCM_OUT_OF_RANGE(pos,arg) do { scm_out_of_range_pos(FUNC_NAME,arg,scm_long2num(pos)); } while (0) +#define SCM_OUT_OF_RANGE(pos,arg) do { scm_out_of_range_pos(FUNC_NAME,arg, SCM_MAKINUM(pos)); } while (0) #define SCM_ASSERT_RANGE(pos,arg,f) do { SCM_ASSERT(f,arg,SCM_OUTOFRANGE,FUNC_NAME); } while (0) @@ -114,8 +119,8 @@ #define SCM_VALIDATE_STRING(pos,str) SCM_MAKE_VALIDATE(pos,str,STRINGP) #define SCM_VALIDATE_STRINGORSUBSTR(pos,str) \ - do { SCM_ASSERT(SCM_SLOPPY_STRINGP (str) || \ - SCM_SLOPPY_SUBSTRP(str), str, pos, FUNC_NAME); } while (0) + do { SCM_ASSERT(SCM_STRINGP (str) || \ + SCM_SUBSTRP(str), str, pos, FUNC_NAME); } while (0) #define SCM_VALIDATE_STRING_COPY(pos,str,cvar) \ do { SCM_ASSERT(SCM_STRINGP (str), str, pos, FUNC_NAME); \ @@ -171,6 +176,9 @@ #define SCM_VALIDATE_LIST(pos,lst) \ do { SCM_ASSERT (scm_ilength (lst) >= 0, lst, pos, FUNC_NAME); } while (0) +#define SCM_VALIDATE_NONEMPTYLIST(pos,lst) \ + do { SCM_ASSERT (scm_ilength (lst) > 0, lst, pos, FUNC_NAME); } while (0) + #define SCM_VALIDATE_LIST_COPYLEN(pos,lst,cvar) \ do { cvar = scm_ilength(lst); SCM_ASSERT(cvar >= 0,lst,pos,FUNC_NAME); } while (0) |