mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* scm_validate.h: Added SCM_NUM2LONG_DEF macro. Make

Browse source 
SCM_OUT_OF_RANGE use SCM_MAKINUM, not scm_long2num.  Added
SCM_COERCE_ROSTRING macro.  Added SCM_VALIDATE_NONEMPTYLIST
macro.  Fix SCM_VALIDATE_STRINGORSUBSTR macro to not use SLOPPY
variants.

* ports.c (scm_port_closed_p): Validate that the arg is a PORT,
then return whether it's an open port (was validating that it was
an open port -- this was a bug I introduced back in December, but
my careful reading of diffs caught it).

* numbers.c: Recombine the two conditional-compilation paths for
all the log* primitives -- they were split based on #ifndef
scm_long2num;  factored out a SCM_LOGOP_RETURN macro, and fixed
some bugs and inconsistencies in the two sets of implementations.
(scm_lognot) Fixed *atrocious* re-use of a SCM as an integer!

* ioext.c: Use SCM_ASSERT_RANGE in a couple places, and
SCM_VALIDATE_INUM_COPY once where it should've been used.

* fluids.c (scm_internal_with_fluids): Use
SCM_VALIDATE_LIST_COPYLEN.

* filesys.c: Use SCM_NUM2LONG instead of SCM_VALIDATE_INUM_COPY;
this is questionable as it relaxes type safety, but other changes
were useful and all SCM_NUM2LONG's should probably be
revisited. Use SCM_OUT_OF_RANGE, SCM_WRONG_TYPE_ARG.

* evalext.c: line-break change on 1 line.

* eval.c (nconc2last): Takes a non-empty list as its first
argument, not just a list.

* dynl.c: Use new SCM_COERCE_ROSTRING macro.
This commit is contained in:
Greg J. Badros 2000-01-12 01:51:18 +00:00
parent d61f6b0288
commit c1bfcf602b
10 changed files with 51 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

2
guile-readline/readline.c
View file

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

4
libguile/dynl.c
View file

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

2
libguile/eval.c
View file

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

3
libguile/evalext.c
View file

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

15
libguile/filesys.c
View file

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

9
libguile/fluids.c
View file

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

10
libguile/ioext.c
View file

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

109
libguile/numbers.c
View file

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

4
libguile/ports.c
View file

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

16
libguile/scm_validate.h
View file

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