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

* validate.h, deprecated.h (SCM_VALIDATE_INUM, SCM_VALIDATE_INUM_COPY,

Browse source 
SCM_VALIDATE_BIGINT, SCM_VALIDATE_INUM_MIN,
SCM_VALIDATE_INUM_MIN_COPY,
SCM_VALIDATE_INUM_MIN_DEF_COPY,SCM_VALIDATE_INUM_DEF,
SCM_VALIDATE_INUM_DEF_COPY, SCM_VALIDATE_INUM_RANGE,
SCM_VALIDATE_INUM_RANGE_COPY): Deprecated because they make the
fixnum/bignum distinction visible.  Changed all uses to scm_to_size_t
or similar.
This commit is contained in:
Marius Vollmer 2004-07-10 14:35:36 +00:00
parent 7cee5b315a
commit a55c2b6809
28 changed files with 221 additions and 312 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/ChangeLog
View file

@ -1,3 +1,30 @@
2004-07-10 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* socket.c (ipv6_net_to_num, scm_from_ipv6): Renamed
ipv6_net_to_num to scm_from_ipv6, for converting from an IPv&
byte-wise address to a SCM integer. Changed all uses.
(ipv6_num_to_net, scm_to_ipv6): Renamed ipv6_num_to_net to
scm_to_ipv6 and added type and range checking, for converting from
an IPv& byte-wise address to a SCM integer. Changed all uses.
(bignum_in_ipv6_range_p, VALIDATE_INET6): Removed, their function
is now done by scm_to_ipv6.
* numbers.c (scm_to_signed_integer, scm_to_unsigned_integer): dot
not accept inexact integers.
* validate.h, deprecated.h (SCM_VALIDATE_INUM,
SCM_VALIDATE_INUM_COPY, SCM_VALIDATE_BIGINT,
SCM_VALIDATE_INUM_MIN, SCM_VALIDATE_INUM_MIN_COPY,
SCM_VALIDATE_INUM_MIN_DEF_COPY,SCM_VALIDATE_INUM_DEF,
SCM_VALIDATE_INUM_DEF_COPY, SCM_VALIDATE_INUM_RANGE,
SCM_VALIDATE_INUM_RANGE_COPY): Deprecated because they make the
fixnum/bignum distinction visible. Changed all uses to
scm_to_size_t or similar.
2004-07-09 Marius Vollmer <marius.vollmer@uni-dortmund.de>
* cpp_cnvt.awk: Use scm_from_int instead of SCM_MAKINUM.
2004-07-10 Kevin Ryde <user42@zip.com.au>
* hash.c (scm_hashq, scm_hashv, scm_hash): Restrict to size>=1 rather

4
libguile/backtrace.c
View file

@ -443,8 +443,6 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0,
SCM_VALIDATE_OPOUTPORT (2, port);
if (SCM_UNBNDP (indent))
indent = SCM_INUM0;
else
SCM_VALIDATE_INUM (3, indent);
if (SCM_FRAME_PROC_P (frame))
/* Display an application. */
@ -465,7 +463,7 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0,
pstate->writingp = 1;
pstate->fancyp = 1;
display_application (frame, SCM_INUM (indent), sport, port, pstate);
display_application (frame, scm_to_int (indent), sport, port, pstate);
return SCM_BOOL_T;
}
else

3
libguile/chars.c
View file

@ -249,8 +249,7 @@ SCM_DEFINE (scm_integer_to_char, "integer->char", 1, 0, 0,
"Return the character at position @var{n} in the ASCII sequence.")
#define FUNC_NAME s_scm_integer_to_char
{
SCM_VALIDATE_INUM_RANGE (1, n, 0, 256);
return SCM_MAKE_CHAR (SCM_INUM (n));
return SCM_MAKE_CHAR (scm_to_uchar (n));
}
#undef FUNC_NAME

3
libguile/error.c
View file

@ -148,8 +148,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
"must be an integer value.")
#define FUNC_NAME s_scm_strerror
{
SCM_VALIDATE_INUM (1, err);
return scm_makfrom0str (SCM_I_STRERROR (SCM_INUM (err)));
return scm_makfrom0str (SCM_I_STRERROR (scm_to_int (err)));
}
#undef FUNC_NAME

10
libguile/eval.c
View file

@ -328,6 +328,8 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
* environment frame, the number of the binding within that frame, and a
* boolean value indicating whether the binding is the last binding in the
* frame.
*
* Frame numbers have 11 bits, relative offsets have 12 bits.
*/
#define SCM_ILOC00 SCM_MAKE_ITAG8(0L, scm_tc8_iloc)
@ -339,6 +341,8 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
#define SCM_IDSTMSK (-SCM_IDINC)
#define SCM_IFRAMEMAX ((1<<11)-1)
#define SCM_IDISTMAX ((1<<12)-1)
#define SCM_MAKE_ILOC(frame_nr, binding_nr, last_p) \
SCM_PACK ( \
((frame_nr) << 8) \
@ -365,10 +369,8 @@ SCM_DEFINE (scm_dbg_make_iloc, "dbg-make-iloc", 3, 0, 0,
"offset @var{binding} and the cdr flag @var{cdrp}.")
#define FUNC_NAME s_scm_dbg_make_iloc
{
SCM_VALIDATE_INUM (1, frame);
SCM_VALIDATE_INUM (2, binding);
return SCM_MAKE_ILOC (SCM_INUM (frame),
SCM_INUM (binding),
return SCM_MAKE_ILOC (scm_to_unsigned_integer (frame, 0, SCM_IFRAME_MAX),
scm_to_unsigned_integer (binding, 0, SCM_IDIST_MAX),
scm_is_true (cdrp));
}
#undef FUNC_NAME

68
libguile/filesys.c
View file

@ -201,22 +201,20 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INUM (2, owner);
SCM_VALIDATE_INUM (3, group);
#ifdef HAVE_FCHOWN
if (SCM_INUMP (object) || (SCM_OPFPORTP (object)))
if (scm_is_integer (object) || (SCM_OPFPORTP (object)))
{
int fdes = SCM_INUMP (object) ? SCM_INUM (object)
: SCM_FPORT_FDES (object);
int fdes = (SCM_OPFPORTP (object)?
SCM_FPORT_FDES (object) : scm_to_int (object));
SCM_SYSCALL (rv = fchown (fdes, SCM_INUM (owner), SCM_INUM (group)));
SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
}
else
#endif
{
SCM_VALIDATE_STRING (1, object);
SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object),
SCM_INUM (owner), SCM_INUM (group)));
scm_to_int (owner), scm_to_int (group)));
}
if (rv == -1)
SCM_SYSERROR;
@ -242,19 +240,18 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INUM (2, mode);
if (SCM_INUMP (object) || SCM_OPFPORTP (object))
if (scm_is_integer (object) || SCM_OPFPORTP (object))
{
if (SCM_INUMP (object))
fdes = SCM_INUM (object);
if (scm_is_integer (object))
fdes = scm_to_int (object);
else
fdes = SCM_FPORT_FDES (object);
SCM_SYSCALL (rv = fchmod (fdes, SCM_INUM (mode)));
SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
}
else
{
SCM_VALIDATE_STRING (1, object);
SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode)));
SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), scm_to_int (mode)));
}
if (rv == -1)
SCM_SYSERROR;
@ -278,10 +275,9 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
}
else
{
SCM_VALIDATE_INUM (1, mode);
mask = umask (SCM_INUM (mode));
mask = umask (scm_to_uint (mode));
}
return SCM_I_MAKINUM (mask);
return scm_from_uint (mask);
}
#undef FUNC_NAME
@ -380,8 +376,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0,
if (SCM_PORTP (fd_or_port))
return scm_close_port (fd_or_port);
SCM_VALIDATE_INUM (1, fd_or_port);
fd = SCM_INUM (fd_or_port);
fd = scm_to_int (fd_or_port);
scm_evict_ports (fd); /* see scsh manual. */
SCM_SYSCALL (rv = close (fd));
/* following scsh, closing an already closed file descriptor is
@ -404,7 +399,7 @@ SCM_DEFINE (scm_close_fdes, "close-fdes", 1, 0, 0,
int c_fd;
int rv;
SCM_VALIDATE_INUM_COPY (1, fd, c_fd);
c_fd = scm_to_int (fd);
SCM_SYSCALL (rv = close (c_fd));
if (rv < 0)
SCM_SYSERROR;
@ -743,8 +738,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
}
else
{
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_to_uint (mode)));
}
if (rv != 0)
SCM_SYSERROR;
@ -1213,16 +1207,13 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
time_ptr = 0;
else
{
if (SCM_INUMP (secs))
if (scm_is_unsigned_integer (secs, 0, ULONG_MAX))
{
timeout.tv_sec = SCM_INUM (secs);
timeout.tv_sec = scm_to_ulong (secs);
if (SCM_UNBNDP (usecs))
timeout.tv_usec = 0;
else
{
SCM_VALIDATE_INUM (5, usecs);
timeout.tv_usec = SCM_INUM (usecs);
}
timeout.tv_usec = scm_to_long (usecs);
}
else
{
@ -1288,25 +1279,20 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
object = SCM_COERCE_OUTPORT (object);
SCM_VALIDATE_INUM (2, cmd);
if (SCM_OPFPORTP (object))
fdes = SCM_FPORT_FDES (object);
else
{
SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
fdes = scm_to_int (object);
if (SCM_UNBNDP (value)) {
if (SCM_UNBNDP (value))
ivalue = 0;
} else {
SCM_VALIDATE_INUM_COPY (SCM_ARG3, value, ivalue);
}
else
ivalue = scm_to_int (value);
SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
if (rv == -1)
SCM_SYSERROR;
return SCM_I_MAKINUM (rv);
return scm_from_int (rv);
}
#undef FUNC_NAME
#endif /* HAVE_FCNTL */
@ -1329,10 +1315,8 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
fdes = SCM_FPORT_FDES (object);
}
else
{
SCM_VALIDATE_INUM (1, object);
fdes = SCM_INUM (object);
}
fdes = scm_to_int (object);
if (fsync (fdes) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;

4
libguile/fports.c
View file

@ -142,7 +142,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port);
SCM_VALIDATE_INUM_COPY (2,mode,cmode);
cmode = scm_to_int (mode);
if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
scm_out_of_range (FUNC_NAME, mode);
@ -165,7 +165,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
}
else
{
SCM_VALIDATE_INUM_COPY (3,size,csize);
csize = scm_to_int (size);
if (csize < 0 || (cmode == _IONBF && csize > 0))
scm_out_of_range (FUNC_NAME, size);
}

11
libguile/goops.c
View file

@ -1077,11 +1077,7 @@ SCM_DEFINE (scm_sys_fast_slot_ref, "%fast-slot-ref", 2, 0, 0,
unsigned long int i;
SCM_VALIDATE_INSTANCE (1, obj);
SCM_VALIDATE_INUM (2, index);
SCM_ASSERT_RANGE (2, index, SCM_INUM (index) >= 0);
i = SCM_INUM (index);
SCM_ASSERT_RANGE (2, index, i < SCM_NUMBER_OF_SLOTS (obj));
i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
return SCM_SLOT (obj, i);
}
#undef FUNC_NAME
@ -1095,10 +1091,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
unsigned long int i;
SCM_VALIDATE_INSTANCE (1, obj);
SCM_VALIDATE_INUM (2, index);
SCM_ASSERT_RANGE (2, index, SCM_INUM (index) >= 0);
i = SCM_INUM (index);
SCM_ASSERT_RANGE (2, index, i < SCM_NUMBER_OF_SLOTS (obj));
i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
SCM_SET_SLOT (obj, i, value);

12
libguile/hash.c
View file

@ -171,8 +171,8 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
"different values, since @code{foo} will be garbage collected.")
#define FUNC_NAME s_scm_hashq
{
SCM_VALIDATE_INUM_MIN (2, size, 1);
return SCM_I_MAKINUM (scm_ihashq (key, SCM_INUM (size)));
unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
return scm_from_ulong (scm_ihashq (key, sz));
}
#undef FUNC_NAME
@ -207,8 +207,8 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
"different values, since @code{foo} will be garbage collected.")
#define FUNC_NAME s_scm_hashv
{
SCM_VALIDATE_INUM_MIN (2, size, 1);
return SCM_I_MAKINUM (scm_ihashv (key, SCM_INUM (size)));
unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
return scm_from_ulong (scm_ihashv (key, sz));
}
#undef FUNC_NAME
@ -230,8 +230,8 @@ SCM_DEFINE (scm_hash, "hash", 2, 0, 0,
"integer in the range 0 to @var{size} - 1.")
#define FUNC_NAME s_scm_hash
{
SCM_VALIDATE_INUM_MIN (2, size, 1);
return SCM_I_MAKINUM (scm_ihash (key, SCM_INUM (size)));
unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
return scm_from_ulong (scm_ihash (key, sz));
}
#undef FUNC_NAME

24
libguile/hashtab.c
View file

@ -312,11 +312,7 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
if (SCM_UNBNDP (n))
return make_hash_table (0, 0, FUNC_NAME);
else
{
int k;
SCM_VALIDATE_INUM_COPY (1, n, k);
return make_hash_table (0, k, FUNC_NAME);
}
return make_hash_table (0, scm_to_ulong (n), FUNC_NAME);
}
#undef FUNC_NAME
@ -335,11 +331,8 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0,
if (SCM_UNBNDP (n))
return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, 0, FUNC_NAME);
else
{
int k;
SCM_VALIDATE_INUM_COPY (1, n, k);
return make_hash_table (SCM_HASHTABLEF_WEAK_CAR, k, FUNC_NAME);
}
return make_hash_table (SCM_HASHTABLEF_WEAK_CAR,
scm_to_ulong (n), FUNC_NAME);
}
#undef FUNC_NAME
@ -354,9 +347,8 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 0, 1,
return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME);
else
{
int k;
SCM_VALIDATE_INUM_COPY (1, n, k);
return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, k, FUNC_NAME);
return make_hash_table (SCM_HASHTABLEF_WEAK_CDR,
scm_to_ulong (n), FUNC_NAME);
}
}
#undef FUNC_NAME
@ -374,10 +366,8 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0
FUNC_NAME);
else
{
int k;
SCM_VALIDATE_INUM_COPY (1, n, k);
return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
k,
scm_to_ulong (n),
FUNC_NAME);
}
}
@ -785,7 +775,7 @@ scm_ihashx (SCM obj, unsigned long n, scm_t_ihashx_closure *closure)
SCM answer = scm_call_2 (closure->hash,
obj,
scm_ulong2num ((unsigned long) n));
return SCM_INUM (answer);
return scm_to_ulong (answer);
}

10
libguile/hooks.c
View file

@ -154,18 +154,12 @@ SCM_DEFINE (scm_make_hook, "make-hook", 0, 1, 0,
"object to be used with the other hook procedures.")
#define FUNC_NAME s_scm_make_hook
{
int n;
unsigned int n;
if (SCM_UNBNDP (n_args))
{
n = 0;
}
else
{
SCM_VALIDATE_INUM_COPY (SCM_ARG1, n_args, n);
if (n < 0 || n > 16)
SCM_OUT_OF_RANGE (SCM_ARG1, n_args);
}
n = scm_to_unsigned_integer (n_args, 0, 16);
SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_UNPACK (SCM_EOL));
}

18
libguile/ioext.c
View file

@ -127,11 +127,11 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
newfd = dup (oldfd);
if (newfd == -1)
SCM_SYSERROR;
fd = SCM_I_MAKINUM (newfd);
fd = scm_from_int (newfd);
}
else
{
SCM_VALIDATE_INUM_COPY (2, fd, newfd);
newfd = scm_to_int (fd);
if (oldfd != newfd)
{
scm_evict_ports (newfd); /* see scsh manual. */
@ -161,8 +161,8 @@ SCM_DEFINE (scm_dup2, "dup2", 2, 0, 0,
int c_newfd;
int rv;
SCM_VALIDATE_INUM_COPY (1, oldfd, c_oldfd);
SCM_VALIDATE_INUM_COPY (2, newfd, c_newfd);
c_oldfd = scm_to_int (oldfd);
c_newfd = scm_to_int (newfd);
rv = dup2 (c_oldfd, c_newfd);
if (rv == -1)
SCM_SYSERROR;
@ -218,10 +218,9 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
"same as that accepted by @ref{File Ports, open-file}.")
#define FUNC_NAME s_scm_fdopen
{
SCM_VALIDATE_INUM (1, fdes);
SCM_VALIDATE_STRING (2, modes);
return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F);
return scm_fdes_to_port (scm_to_int (fdes),
SCM_STRING_CHARS (modes), SCM_BOOL_F);
}
#undef FUNC_NAME
@ -250,10 +249,9 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1, port);
SCM_VALIDATE_INUM (2, fd);
stream = SCM_FSTREAM (port);
old_fd = stream->fdes;
new_fd = SCM_INUM (fd);
new_fd = scm_to_int (fd);
if (old_fd == new_fd)
{
return SCM_BOOL_F;
@ -280,7 +278,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
int int_fd;
long i;
SCM_VALIDATE_INUM_COPY (1, fd, int_fd);
int_fd = scm_to_int (fd);
scm_mutex_lock (&scm_i_port_table_mutex);
for (i = 0; i < scm_i_port_table_size; i++)

14
libguile/list.c
View file

@ -383,7 +383,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
{
SCM lst = list;
unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
i = scm_to_ulong (k);
while (SCM_CONSP (lst)) {
if (i == 0)
return SCM_CAR (lst);
@ -406,8 +406,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
#define FUNC_NAME s_scm_list_set_x
{
SCM lst = list;
unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
unsigned long int i = scm_to_ulong (k);
while (SCM_CONSP (lst)) {
if (i == 0) {
SCM_SETCAR (lst, val);
@ -437,8 +436,7 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0,
"or returning the results of cdring @var{k} times down @var{lst}.")
#define FUNC_NAME s_scm_list_tail
{
register long i;
SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
size_t i = scm_to_size_t (k);
while (i-- > 0) {
SCM_VALIDATE_CONS (1, lst);
lst = SCM_CDR(lst);
@ -454,8 +452,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
#define FUNC_NAME s_scm_list_cdr_set_x
{
SCM lst = list;
unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
size_t i = scm_to_size_t (k);
while (SCM_CONSP (lst)) {
if (i == 0) {
SCM_SETCDR (lst, val);
@ -484,9 +481,8 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
{
SCM answer;
SCM * pos;
register long i;
size_t i = scm_to_size_t (k);
SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
answer = SCM_EOL;
pos = &answer;
while (i-- > 0)

7
libguile/net_db.c
View file

@ -333,12 +333,13 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
SCM_VALIDATE_STRING (2, protocol);
if (SCM_STRINGP (name))
{
entry = getservbyname (SCM_STRING_CHARS (name), SCM_STRING_CHARS (protocol));
entry = getservbyname (SCM_STRING_CHARS (name),
SCM_STRING_CHARS (protocol));
}
else
{
SCM_VALIDATE_INUM (1, name);
entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol));
entry = getservbyport (htons (scm_to_int (name)),
SCM_STRING_CHARS (protocol));
}
if (!entry)
SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), errno);

27
libguile/ports.c
View file

@ -598,9 +598,8 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
"@code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_pt_member
{
long i;
SCM_VALIDATE_INUM_COPY (1, index, i);
if (i < 0 || i >= scm_i_port_table_size)
size_t i = scm_to_size_t (index);
if (i >= scm_i_port_table_size)
return SCM_BOOL_F;
else
return scm_i_port_table[i]->port;
@ -654,8 +653,7 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
{
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2, rcount);
SCM_REVEALED (port) = SCM_INUM (rcount);
SCM_REVEALED (port) = scm_to_int (rcount);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -1351,8 +1349,12 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
fd_port = SCM_COERCE_OUTPORT (fd_port);
off = SCM_NUM2LONG (2, offset);
SCM_VALIDATE_INUM_COPY (3, whence, how);
if (sizeof (off_t) == sizeof (scm_t_intmax))
off = scm_to_intmax (offset);
else
off = scm_to_long (offset);
how = scm_to_int (whence);
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
SCM_OUT_OF_RANGE (3, whence);
if (SCM_OPPORTP (fd_port))
@ -1367,12 +1369,11 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
}
else /* file descriptor?. */
{
SCM_VALIDATE_INUM (1, fd_port);
rv = lseek (SCM_INUM (fd_port), off, how);
rv = lseek (scm_to_int (fd_port), off, how);
if (rv == -1)
SCM_SYSERROR;
}
return scm_long2num (rv);
return scm_from_intmax (rv);
}
#undef FUNC_NAME
@ -1472,8 +1473,7 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0,
{
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2, line);
SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
SCM_PTAB_ENTRY (port)->line_number = scm_to_int (line);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -1504,8 +1504,7 @@ SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0,
{
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
SCM_VALIDATE_INUM (2, column);
SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
SCM_PTAB_ENTRY (port)->column_number = scm_to_int (column);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

94
libguile/posix.c
View file

@ -450,14 +450,12 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
"@end defvar")
#define FUNC_NAME s_scm_kill
{
SCM_VALIDATE_INUM (1, pid);
SCM_VALIDATE_INUM (2, sig);
/* Signal values are interned in scm_init_posix(). */
#ifdef HAVE_KILL
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
if (kill (scm_to_int (pid), scm_to_int (sig)) != 0)
#else
if ((int) SCM_INUM (pid) == getpid ())
if (raise ((int) SCM_INUM (sig)) != 0)
if (scm_to_int (pid) == getpid ())
if (raise (scm_to_int (sig)) != 0)
#endif
SCM_SYSERROR;
return SCM_UNSPECIFIED;
@ -506,19 +504,17 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
int i;
int status;
int ioptions;
SCM_VALIDATE_INUM (1, pid);
if (SCM_UNBNDP (options))
ioptions = 0;
else
{
SCM_VALIDATE_INUM (2, options);
/* Flags are interned in scm_init_posix. */
ioptions = SCM_INUM (options);
ioptions = scm_to_int (options);
}
SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
SCM_SYSCALL (i = waitpid (scm_to_int (pid), &status, ioptions));
if (i == -1)
SCM_SYSERROR;
return scm_cons (SCM_I_MAKINUM (0L + i), SCM_I_MAKINUM (0L + status));
return scm_cons (scm_from_int (i), scm_from_int (status));
}
#undef FUNC_NAME
#endif /* HAVE_WAITPID */
@ -533,13 +529,11 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0,
{
int lstatus;
SCM_VALIDATE_INUM (1, status);
/* On Ultrix, the WIF... macros assume their argument is an lvalue;
go figure. SCM_INUM does not yield an lvalue. */
lstatus = SCM_INUM (status);
lstatus = scm_to_int (status);
if (WIFEXITED (lstatus))
return (SCM_I_MAKINUM (WEXITSTATUS (lstatus)));
return (scm_from_int (WEXITSTATUS (lstatus)));
else
return SCM_BOOL_F;
}
@ -553,11 +547,9 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0,
{
int lstatus;
SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
lstatus = scm_to_int (status);
if (WIFSIGNALED (lstatus))
return SCM_I_MAKINUM (WTERMSIG (lstatus));
return scm_from_int (WTERMSIG (lstatus));
else
return SCM_BOOL_F;
}
@ -571,11 +563,9 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
{
int lstatus;
SCM_VALIDATE_INUM (1, status);
lstatus = SCM_INUM (status);
lstatus = scm_to_int (status);
if (WIFSTOPPED (lstatus))
return SCM_I_MAKINUM (WSTOPSIG (lstatus));
return scm_from_int (WSTOPSIG (lstatus));
else
return SCM_BOOL_F;
}
@ -659,8 +649,7 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0,
"The return value is unspecified.")
#define FUNC_NAME s_scm_setuid
{
SCM_VALIDATE_INUM (1, id);
if (setuid (SCM_INUM (id)) != 0)
if (setuid (scm_to_int (id)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
@ -673,8 +662,7 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0,
"The return value is unspecified.")
#define FUNC_NAME s_scm_setgid
{
SCM_VALIDATE_INUM (1, id);
if (setgid (SCM_INUM (id)) != 0)
if (setgid (scm_to_int (id)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
@ -691,11 +679,10 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
{
int rv;
SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = seteuid (SCM_INUM (id));
rv = seteuid (scm_to_int (id));
#else
rv = setuid (SCM_INUM (id));
rv = setuid (scm_to_int (id));
#endif
if (rv != 0)
SCM_SYSERROR;
@ -717,11 +704,10 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
{
int rv;
SCM_VALIDATE_INUM (1, id);
#ifdef HAVE_SETEUID
rv = setegid (SCM_INUM (id));
rv = setegid (scm_to_int (id));
#else
rv = setgid (SCM_INUM (id));
rv = setgid (scm_to_int (id));
#endif
if (rv != 0)
SCM_SYSERROR;
@ -757,10 +743,8 @@ SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0,
"The return value is unspecified.")
#define FUNC_NAME s_scm_setpgid
{
SCM_VALIDATE_INUM (1, pid);
SCM_VALIDATE_INUM (2, pgid);
/* FIXME(?): may be known as setpgrp. */
if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
if (setpgid (scm_to_int (pid), scm_to_int (pgid)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
@ -867,9 +851,8 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1, port);
SCM_VALIDATE_INUM (2, pgid);
fd = SCM_FPORT_FDES (port);
if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
if (tcsetpgrp (fd, scm_to_int (pgid)) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
@ -1218,8 +1201,7 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0,
int rv;
SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_INUM (2, how);
rv = access (SCM_STRING_CHARS (path), SCM_INUM (how));
rv = access (SCM_STRING_CHARS (path), scm_to_int (how));
return scm_from_bool (!rv);
}
#undef FUNC_NAME
@ -1343,7 +1325,6 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
char *clocale;
char *rv;
SCM_VALIDATE_INUM (1, category);
if (SCM_UNBNDP (locale))
{
clocale = NULL;
@ -1354,7 +1335,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
clocale = SCM_STRING_CHARS (locale);
}
rv = setlocale (SCM_INUM (category), clocale);
rv = setlocale (scm_to_int (category), clocale);
if (rv == NULL)
SCM_SYSERROR;
return scm_makfrom0str (rv);
@ -1386,8 +1367,6 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_SYMBOL (2, type);
SCM_VALIDATE_INUM (3, perms);
SCM_VALIDATE_INUM (4, dev);
p = SCM_SYMBOL_CHARS (type);
if (strcmp (p, "regular") == 0)
@ -1409,8 +1388,9 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
else
SCM_OUT_OF_RANGE (2, type);
SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms),
SCM_INUM (dev)));
SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path),
ctype | scm_to_int (perms),
scm_to_int (dev)));
if (val != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
@ -1426,8 +1406,7 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0,
"The return value is unspecified.")
#define FUNC_NAME s_scm_nice
{
SCM_VALIDATE_INUM (1, incr);
if (nice(SCM_INUM(incr)) != 0)
if (nice (scm_to_int (incr)) != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
@ -1553,8 +1532,8 @@ SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
{
int cwhich, cwho, ret;
SCM_VALIDATE_INUM_COPY (1, which, cwhich);
SCM_VALIDATE_INUM_COPY (2, who, cwho);
cwhich = scm_to_int (which);
cwho = scm_to_int (who);
/* We have to clear errno and examine it later, because -1 is a
legal return value for getpriority(). */
@ -1562,7 +1541,7 @@ SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
ret = getpriority (cwhich, cwho);
if (errno != 0)
SCM_SYSERROR;
return SCM_I_MAKINUM (ret);
return scm_from_int (ret);
}
#undef FUNC_NAME
#endif /* HAVE_GETPRIORITY */
@ -1587,9 +1566,9 @@ SCM_DEFINE (scm_setpriority, "setpriority", 3, 0, 0,
{
int cwhich, cwho, cprio;
SCM_VALIDATE_INUM_COPY (1, which, cwhich);
SCM_VALIDATE_INUM_COPY (2, who, cwho);
SCM_VALIDATE_INUM_COPY (3, prio, cprio);
cwhich = scm_to_int (which);
cwho = scm_to_int (who);
cprio = scm_to_int (prio);
if (setpriority (cwhich, cwho, cprio) == -1)
SCM_SYSERROR;
@ -1714,18 +1693,17 @@ SCM_DEFINE (scm_flock, "flock", 2, 0, 0,
"file descriptor or an open file descriptor port.")
#define FUNC_NAME s_scm_flock
{
int coperation, fdes;
int fdes;
if (SCM_INUMP (file))
fdes = SCM_INUM (file);
if (scm_is_integer (file))
fdes = scm_to_int (file);
else
{
SCM_VALIDATE_OPFPORT (2, file);
fdes = SCM_FPORT_FDES (file);
}
SCM_VALIDATE_INUM_COPY (2, operation, coperation);
if (flock (fdes, coperation) == -1)
if (flock (fdes, scm_to_int (operation)) == -1)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}

3
libguile/random.c
View file

@ -360,7 +360,8 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
return scm_make_real (SCM_REAL_VALUE (n)
* scm_c_uniform01 (SCM_RSTATE (state)));
SCM_VALIDATE_BIGINT (1, n);
if (!SCM_BIGP (n))
SCM_WRONG_TYPE_ARG (1, n);
return scm_c_random_bignum (SCM_RSTATE (state), n);
}
#undef FUNC_NAME

11
libguile/regex-posix.c
View file

@ -230,11 +230,14 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
SCM_VALIDATE_RGXP (1, rx);
SCM_VALIDATE_STRING (2, str);
SCM_VALIDATE_INUM_DEF_COPY (3, start,0, offset);
SCM_ASSERT_RANGE (3, start, offset >= 0 && offset <= SCM_STRING_LENGTH (str));
if (SCM_UNBNDP (start))
offset = 0;
else
offset = scm_to_signed_integer (start, 0, SCM_STRING_LENGTH (str));
if (SCM_UNBNDP (flags))
flags = SCM_INUM0;
SCM_VALIDATE_INUM (4, flags);
/* re_nsub doesn't account for the `subexpression' representing the
whole regexp, so add 1 to nmatches. */
@ -244,7 +247,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
matches = scm_malloc (sizeof (regmatch_t) * nmatches);
status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset,
nmatches, matches,
SCM_INUM (flags));
scm_to_int (flags));
if (!status)
{
int i;

33
libguile/scmsigs.c
View file

@ -298,9 +298,8 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
SCM old_handler;
SCM_VALIDATE_INUM_COPY (1, signum, csig);
if (csig < 0 || csig >= NSIG)
SCM_OUT_OF_RANGE (1, signum);
csig = scm_to_signed_integer (signum, 0, NSIG-1);
#if defined(HAVE_SIGACTION)
#if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
/* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
@ -311,10 +310,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
action.sa_flags = 0;
#endif
if (!SCM_UNBNDP (flags))
{
SCM_VALIDATE_INUM (3, flags);
action.sa_flags |= SCM_INUM (flags);
}
action.sa_flags |= scm_to_int (flags);
sigemptyset (&action.sa_mask);
#endif
@ -497,10 +493,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0,
"no previous alarm, the return value is zero.")
#define FUNC_NAME s_scm_alarm
{
unsigned int j;
SCM_VALIDATE_INUM (1, i);
j = alarm (SCM_INUM (i));
return SCM_I_MAKINUM (j);
return scm_from_uint (alarm (scm_to_uint (i)));
}
#undef FUNC_NAME
@ -608,23 +601,16 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
"of seconds remaining otherwise.")
#define FUNC_NAME s_scm_sleep
{
unsigned long j;
SCM_VALIDATE_INUM_MIN (1, i,0);
j = scm_thread_sleep (SCM_INUM(i));
return scm_ulong2num (j);
return scm_from_ulong (scm_thread_sleep (scm_to_int (i)));
}
#undef FUNC_NAME
SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
(SCM i),
"Sleep for I microseconds. @code{usleep} is not available on\n"
"all platforms.")
"Sleep for @var{i} microseconds.")
#define FUNC_NAME s_scm_usleep
{
unsigned long j;
SCM_VALIDATE_INUM_MIN (1, i,0);
j = scm_thread_usleep (SCM_INUM (i));
return scm_ulong2num (j);
return scm_from_ulong (scm_thread_usleep (scm_to_ulong (i)));
}
#undef FUNC_NAME
@ -634,11 +620,8 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
"@var{sig} is as described for the kill procedure.")
#define FUNC_NAME s_scm_raise
{
SCM_VALIDATE_INUM (1, sig);
SCM_DEFER_INTS;
if (kill (getpid (), (int) SCM_INUM (sig)) != 0)
if (kill (getpid (), scm_to_int (sig)) != 0)
SCM_SYSERROR;
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

5
libguile/simpos.c
View file

@ -218,10 +218,7 @@ SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
{
int cstatus = 0;
if (!SCM_UNBNDP (status))
{
SCM_VALIDATE_INUM (1, status);
cstatus = SCM_INUM (status);
}
cstatus = scm_to_int (status);
exit (cstatus);
}
#undef FUNC_NAME

6
libguile/sort.c
View file

@ -299,10 +299,8 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */
vlen = SCM_VECTOR_LENGTH (vec);
SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos);
SCM_ASSERT_RANGE (3, startpos, spos <= vlen);
SCM_VALIDATE_INUM_RANGE (4, endpos,0, vlen+1);
len = SCM_INUM (endpos) - spos;
spos = scm_to_unsigned_integer (startpos, 0, vlen);
len = scm_to_unsigned_integer (endpos, 0, vlen) - spos;
quicksort (&vp[spos], len, cmp, less);
scm_remember_upto_here_1 (vec);

10
libguile/srcprop.c
View file

@ -260,22 +260,20 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
}
else if (SCM_EQ_P (scm_sym_line, key))
{
SCM_VALIDATE_INUM (3, datum);
if (SRCPROPSP (p))
SETSRCPROPLINE (p, SCM_INUM (datum));
SETSRCPROPLINE (p, scm_to_int (datum));
else
SCM_WHASHSET (scm_source_whash, h,
scm_make_srcprops (SCM_INUM (datum), 0,
scm_make_srcprops (scm_to_int (datum), 0,
SCM_UNDEFINED, SCM_UNDEFINED, p));
}
else if (SCM_EQ_P (scm_sym_column, key))
{
SCM_VALIDATE_INUM (3, datum);
if (SRCPROPSP (p))
SETSRCPROPCOL (p, SCM_INUM (datum));
SETSRCPROPCOL (p, scm_to_int (datum));
else
SCM_WHASHSET (scm_source_whash, h,
scm_make_srcprops (0, SCM_INUM (datum),
scm_make_srcprops (0, scm_to_int (datum),
SCM_UNDEFINED, SCM_UNDEFINED, p));
}
else if (SCM_EQ_P (scm_sym_filename, key))

5
libguile/stacks.c
View file

@ -551,10 +551,7 @@ SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
unsigned long int c_index;
SCM_VALIDATE_STACK (1, stack);
SCM_VALIDATE_INUM (2, index);
SCM_ASSERT_RANGE (1, index, SCM_INUM (index) >= 0);
c_index = SCM_INUM (index);
SCM_ASSERT_RANGE (1, index, c_index < SCM_STACK_LENGTH (stack));
c_index = scm_to_unsigned_integer (index, 0, SCM_STACK_LENGTH(stack)-1);
return scm_cons (stack, index);
}
#undef FUNC_NAME

28
libguile/strings.c
View file

@ -227,11 +227,10 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
"indexing. @var{k} must be a valid index of @var{str}.")
#define FUNC_NAME s_scm_string_ref
{
long idx;
unsigned long idx;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2, k, idx);
SCM_ASSERT_RANGE (2, k, idx >= 0 && idx < SCM_STRING_LENGTH (str));
idx = scm_to_unsigned_integer (k, 0, SCM_STRING_LENGTH(str)-1);
return SCM_MAKE_CHAR (SCM_STRING_UCHARS (str)[idx]);
}
#undef FUNC_NAME
@ -244,10 +243,12 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
"@var{str}.")
#define FUNC_NAME s_scm_string_set_x
{
unsigned long idx;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_RANGE (2, k,0, SCM_STRING_LENGTH(str));
idx = scm_to_unsigned_integer (k, 0, SCM_STRING_LENGTH(str)-1);
SCM_VALIDATE_CHAR (3, chr);
SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr);
SCM_STRING_UCHARS (str)[idx] = SCM_CHAR (chr);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -263,19 +264,16 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
"0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
#define FUNC_NAME s_scm_substring
{
long int from;
long int to;
unsigned long int from;
unsigned long int to;
SCM substr;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM (2, start);
SCM_VALIDATE_INUM_DEF (3, end, SCM_STRING_LENGTH (str));
from = SCM_INUM (start);
SCM_ASSERT_RANGE (2, start, 0 <= from && from <= SCM_STRING_LENGTH (str));
to = SCM_INUM (end);
SCM_ASSERT_RANGE (3, end, from <= to && to <= SCM_STRING_LENGTH (str));
from = scm_to_unsigned_integer (start, 0, SCM_STRING_LENGTH(str));
if (SCM_UNBNDP (end))
to = SCM_STRING_LENGTH(str);
else
to = scm_to_unsigned_integer (end, from, SCM_STRING_LENGTH(str));
substr = scm_mem2string (&SCM_STRING_CHARS (str)[from], to - from);
scm_remember_upto_here_1 (str);
return substr;

21
libguile/strop.c
View file

@ -165,19 +165,14 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
"@var{str1} and @var{str2} can be the same string.")
#define FUNC_NAME s_scm_substring_move_x
{
long s1, s2, e, len;
unsigned long s1, s2, e, len;
SCM_VALIDATE_STRING (1, str1);
SCM_VALIDATE_INUM_COPY (2, start1, s1);
SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_STRING (4, str2);
SCM_VALIDATE_INUM_COPY (5, start2, s2);
s1 = scm_to_unsigned_integer (start1, 0, SCM_STRING_LENGTH(str1));
e = scm_to_unsigned_integer (end1, s1, SCM_STRING_LENGTH(str1));
len = e - s1;
SCM_ASSERT_RANGE (3, end1, len >= 0);
SCM_ASSERT_RANGE (2, start1, s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0);
SCM_ASSERT_RANGE (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_STRING_LENGTH (str1) && e >= 0);
SCM_ASSERT_RANGE (5, start2, len+s2 <= SCM_STRING_LENGTH (str2));
s2 = scm_to_unsigned_integer (start2, 0, SCM_STRING_LENGTH(str2)-len);
SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])),
(void *)(&(SCM_STRING_CHARS(str1)[s1])),
@ -201,14 +196,12 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_substring_fill_x
{
long i, e;
size_t i, e;
char c;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2, start, i);
SCM_VALIDATE_INUM_COPY (3, end, e);
i = scm_to_unsigned_integer (start, 0, SCM_STRING_LENGTH (str));
e = scm_to_unsigned_integer (end, i, SCM_STRING_LENGTH (str));
SCM_VALIDATE_CHAR_COPY (4, fill, c);
SCM_ASSERT_RANGE (2, start, i <= SCM_STRING_LENGTH (str) && i >= 0);
SCM_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0);
while (i<e) SCM_STRING_CHARS (str)[i++] = c;
return SCM_UNSPECIFIED;
}

26
libguile/struct.c
View file

@ -413,18 +413,17 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
#define FUNC_NAME s_scm_make_struct
{
SCM layout;
int basic_size;
int tail_elts;
size_t basic_size;
size_t tail_elts;
scm_t_bits * data;
SCM handle;
SCM_VALIDATE_VTABLE (1, vtable);
SCM_VALIDATE_INUM (2, tail_array_size);
SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
tail_elts = SCM_INUM (tail_array_size);
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
{
@ -499,20 +498,19 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
{
SCM fields;
SCM layout;
int basic_size;
int tail_elts;
scm_t_bits * data;
size_t basic_size;
size_t tail_elts;
scm_t_bits *data;
SCM handle;
SCM_VALIDATE_STRING (1, user_fields);
SCM_VALIDATE_INUM (2, tail_array_size);
SCM_VALIDATE_REST_ARGUMENT (init);
fields = scm_string_append (scm_list_2 (required_vtable_fields,
user_fields));
layout = scm_make_struct_layout (fields);
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
tail_elts = SCM_INUM (tail_array_size);
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_n_extra_words,
@ -541,18 +539,17 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM answer = SCM_UNDEFINED;
scm_t_bits * data;
SCM layout;
int p;
size_t p;
scm_t_bits n_fields;
char * fields_desc;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
SCM_VALIDATE_INUM (2, pos);
layout = SCM_STRUCT_LAYOUT (handle);
data = SCM_STRUCT_DATA (handle);
p = SCM_INUM (pos);
p = scm_to_size_t (pos);
fields_desc = SCM_SYMBOL_CHARS (layout);
n_fields = data[scm_struct_i_n_words];
@ -618,17 +615,16 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
{
scm_t_bits * data;
SCM layout;
int p;
size_t p;
int n_fields;
char * fields_desc;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
SCM_VALIDATE_INUM (2, pos);
layout = SCM_STRUCT_LAYOUT (handle);
data = SCM_STRUCT_DATA (handle);
p = SCM_INUM (pos);
p = scm_to_size_t (pos);
fields_desc = SCM_SYMBOL_CHARS (layout);
n_fields = data[scm_struct_i_n_words];

14
libguile/unif.c
View file

@ -800,9 +800,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
#endif
if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CAR (args));
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args),
SCM_EQ_P (SCM_INUM0, SCM_CAR (args)));
SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
return ra;
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
@ -1078,8 +1077,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
}
else
{
SCM_VALIDATE_INUM (2, args);
pos = SCM_INUM (args);
pos = scm_to_long (args);
}
length = SCM_INUM (scm_uniform_vector_length (v));
SCM_ASRTGO (pos >= 0 && pos < length, outrng);
@ -1252,7 +1250,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
}
else
{
SCM_VALIDATE_INUM_COPY (3, args, pos);
pos = scm_to_long (args);
}
length = SCM_INUM (scm_uniform_vector_length (v));
SCM_ASRTGO (pos >= 0 && pos < length, outrng);
@ -1804,7 +1802,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
SCM_VALIDATE_BOOL (1, item);
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME);
SCM_VALIDATE_INUM_COPY (3, k, pos);
pos = scm_to_long (k);
SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0));
if (pos == SCM_BITVECTOR_LENGTH (v))
@ -2201,7 +2199,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
SCM ra;
unsigned long k;
long n;
SCM_VALIDATE_INUM_COPY (1, ndim, k);
k = scm_to_ulong (ndim);
while (k--)
{
n = scm_ilength (row);

31
libguile/vectors.c
View file

@ -262,19 +262,13 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
"@var{start1} is greater than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_left_x
{
long i;
long j;
long e;
size_t i, j, e;
SCM_VALIDATE_VECTOR (1, vec1);
SCM_VALIDATE_INUM_COPY (2, start1, i);
SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_VECTOR (4, vec2);
SCM_VALIDATE_INUM_COPY (5, start2, j);
SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0);
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0);
SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2));
i = scm_to_unsigned_integer (start1, 0, SCM_VECTOR_LENGTH(vec1));
e = scm_to_unsigned_integer (end1, i, SCM_VECTOR_LENGTH(vec1));
j = scm_to_unsigned_integer (start2, 0, SCM_VECTOR_LENGTH(vec2)-(i-e));
while (i<e)
{
@ -298,20 +292,15 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
"@var{start1} is less than @var{start2}.")
#define FUNC_NAME s_scm_vector_move_right_x
{
long i;
long j;
long e;
size_t i, j, e;
SCM_VALIDATE_VECTOR (1, vec1);
SCM_VALIDATE_INUM_COPY (2, start1, i);
SCM_VALIDATE_INUM_COPY (3, end1, e);
SCM_VALIDATE_VECTOR (4, vec2);
SCM_VALIDATE_INUM_COPY (5, start2, j);
SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0);
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0);
j = e - i + j;
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2));
i = scm_to_unsigned_integer (start1, 0, SCM_VECTOR_LENGTH(vec1));
e = scm_to_unsigned_integer (end1, i, SCM_VECTOR_LENGTH(vec1));
j = scm_to_unsigned_integer (start2, 0, SCM_VECTOR_LENGTH(vec2)-(i-e));
j += e - i;
while (i < e)
{
j--;