mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

* Change a couple of functions to accept either symbols or strings only.

Browse source 
* Get rid of remainig uses of SCM_LENGTH etc.
This commit is contained in:
Dirk Herrmann 2000-10-30 11:42:26 +00:00
parent e9bfab50e4
commit a6d9e5abe5
24 changed files with 418 additions and 320 deletions
Download patch file Download diff file Expand all files Collapse all files

27
NEWS
View file

@ -202,17 +202,42 @@ collector has set this variable. But, this is an implementation detail that
may change. Further, scm_gc_heap_lock is not set throughout gc, thus the use may change. Further, scm_gc_heap_lock is not set throughout gc, thus the use
of this variable is (and has been) not fully safe anyway. of this variable is (and has been) not fully safe anyway.
** New macros: SCM_CONTINUATION_LENGTH, SCM_CCLO_LENGTH, SCM_STACK_LENGTH,
SCM_STRING_LENGTH, SCM_SYMBOL_LENGTH, SCM_UVECTOR_LENGTH,
SCM_BITVECTOR_LENGTH, SCM_VECTOR_LENGTH.
Use these instead of SCM_LENGTH.
** New macros: SCM_STRING_CHARS, SCM_SYMBOL_CHARS, SCM_CCLO_BASE,
SCM_VECTOR_BASE, SCM_UVECTOR_BASE, SCM_BITVECTOR_BASE, SCM_COMPLEX_MEM,
SCM_ARRAY_MEM
Use these instead of SCM_CHARS or SCM_VELTS.
** New macro: SCM_BITVECTOR_P
** New macro: SCM_STRING_COERCE_0TERMINATION_X
Use instead of SCM_COERCE_SUBSTR.
** Deprecated macros: SCM_OUTOFRANGE, SCM_NALLOC, SCM_HUP_SIGNAL, ** Deprecated macros: SCM_OUTOFRANGE, SCM_NALLOC, SCM_HUP_SIGNAL,
SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL, SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL,
SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD, SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD,
SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SYMBOL_SLOTS, SCM_SLOTS, SCM_SLOPPY_STRINGP, SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SYMBOL_SLOTS, SCM_SLOTS, SCM_SLOPPY_STRINGP,
SCM_VALIDATE_STRINGORSUBSTR, SCM_FREEP, SCM_NFREEP SCM_VALIDATE_STRINGORSUBSTR, SCM_FREEP, SCM_NFREEP, SCM_CHARS, SCM_UCHARS,
SCM_VALIDATE_ROSTRING, SCM_VALIDATE_ROSTRING_COPY,
SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH, SCM_LENGTH, SCM_HUGE_LENGTH,
SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR
Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE. Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
Use scm_memory_error instead of SCM_NALLOC. Use scm_memory_error instead of SCM_NALLOC.
Use SCM_STRINGP instead of SCM_SLOPPY_STRINGP. Use SCM_STRINGP instead of SCM_SLOPPY_STRINGP.
Use SCM_VALIDATE_STRING instead of SCM_VALIDATE_STRINGORSUBSTR. Use SCM_VALIDATE_STRING instead of SCM_VALIDATE_STRINGORSUBSTR.
Use SCM_FREE_CELL_P instead of SCM_FREEP/SCM_NFREEP Use SCM_FREE_CELL_P instead of SCM_FREEP/SCM_NFREEP
Use a type specific accessor macro instead of SCM_CHARS/SCM_UCHARS.
Use a type specific accessor instead of SCM(_|_RO|_HUGE_)LENGTH.
Use SCM_VALIDATE_(SYMBOL|STRING) instead of SCM_VALIDATE_ROSTRING.
Use SCM_STRING_COERCE_0TERMINATION_X instead of SCM_COERCE_SUBSTR.
** Removed function: scm_struct_init ** Removed function: scm_struct_init

5
RELEASE
View file

@ -46,7 +46,10 @@ In release 1.6:
SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL, SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL,
SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD, SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD,
SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SLOPPY_STRINGP, SCM_VALIDATE_STRINGORSUBSTR, SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SLOPPY_STRINGP, SCM_VALIDATE_STRINGORSUBSTR,
SCM_FREEP, SCM_NFREEP SCM_FREEP, SCM_NFREEP, SCM_CHARS, SCM_UCHARS, SCM_VALIDATE_ROSTRING,
SCM_VALIDATE_ROSTRING_COPY, SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH,
SCM_LENGTH, SCM_HUGE_LENGTH, SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET,
SCM_COERCE_SUBSTR
- remove scm_vector_set_length_x - remove scm_vector_set_length_x
- remove function scm_call_catching_errors - remove function scm_call_catching_errors
(replaced by catch functions from throw.[ch]) (replaced by catch functions from throw.[ch])

66
libguile/ChangeLog
View file

@ -1,3 +1,68 @@
2000-10-27 Dirk Herrmann <D.Herrmann@tu-bs.de>
* dynl.c (scm_dynamic_link, scm_dynamic_func, scm_dynamic_call,
scm_dynamic_args_call), filesys.c (scm_chown, scm_chmod,
scm_open_fdes, scm_stat, scm_link, scm_rename, scm_delete_file,
scm_mkdir, scm_rmdir, scm_opendir, scm_chdir, scm_symlink,
scm_readlink, scm_lstat, scm_copy_file), fports.c (scm_open_file),
ioext.c (scm_read_delimited_x, scm_fdopen), load.c
(scm_primitive_load, scm_parse_path, scm_search_path,
scm_sys_search_load_path, scm_primitive_load_path), net_db.c
(scm_inet_aton, scm_gethost, scm_getnet, scm_getproto,
scm_getserv), numbers.c (scm_string_to_number), ports.c
(scm_truncate_file, scm_sys_make_void_port), posix.c
(scm_getpwuid, scm_getgrgid, scm_execl, scm_execlp,
environ_list_to_c, scm_execle, scm_utime, scm_access,
scm_setlocale, scm_mknod), regex-posix.c (scm_make_regexp),
simpos.c (scm_system, scm_getenv), socket.c (scm_fill_sockaddr,
scm_send, scm_sendto), stime.c (scm_strftime, scm_strptime),
strop.c (scm_i_index, scm_string_null_p, scm_string_to_list),
strports.c (scm_mkstrport), symbols.c
(scm_string_to_obarray_symbol), vports.c (scm_make_soft_port):
Don't accept symbols as input parameters. Use SCM_STRING_LENGTH
instead of SCM_ROLENGTH.
* dynl.c (scm_dynamic_link, scm_dynamic_func), error.c
(scm_error_scm), filesys.c (scm_chown, scm_chmod, scm_open_fdes,
scm_stat, scm_link, scm_rename, scm_delete_file, scm_mkdir,
scm_rmdir, scm_opendir, scm_chdir, scm_symlink, scm_readlink,
scm_lstat, scm_copy_file), fports.c (scm_open_file), ioext.c
(scm_fdopen), net_db.c (scm_inet_aton, scm_gethost, scm_getnet,
scm_getproto, scm_getserv), ports.c (scm_truncate_file,
scm_sys_make_void_port), posix.c (scm_getpwuid, scm_getgrgid,
scm_execl, scm_execlp, scm_execle, scm_utime, scm_access,
scm_setlocale, scm_mknod), regex-posix.c (scm_make_regexp,
scm_regexp_exec), simpos.c (scm_system, scm_getenv), stime.c
(setzone, scm_strftime, scm_strptime), vports.c
(scm_make_soft_port): Use SCM_STRING_COERCE_0TERMINATION_X to
make sure the characters of a string are followed by a \0.
Further, use SCM_STRING_CHARS instead of SCM_ROCHARS on the
resulting string.
* dynl.c (scm_make_argv_from_stringlist), posix.c
(scm_convert_exec_args): Aligned to match each other.
* dynl.c (scm_coerce_rostring): Removed.
(scm_dynamic_func): Changed the comment to reflect that the
function name has to be a string. Further, hide implementation
details from the scheme comment.
* error (scm_error_scm): Don't accept a symbol as message
parameter. Fix substring handling.
* posix.c (environ_list_to_c): Use memcpy to copy environment
strings. Handle substrings which don't have a trailing \0.
* symbols.h (SCM_LENGTH, SCM_ROLENGTH, SCM_SUBSTRP,
SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR):
Deprecated.
* unif.h (SCM_HUGE_LENGTH): Deprecated.
* validate.h (SCM_VALIDATE_ROSTRING, SCM_VALIDATE_ROSTRING_COPY,
SCM_VALIDATE_NULLORROSTRING_COPY): Deprecated.
2000-10-26 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-10-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* random.c: Include unif.h. * random.c: Include unif.h.
@ -110,7 +175,6 @@
* validated.h (SCM_VALIDATE_STRINGORSUBSTR): Deprecated. * validated.h (SCM_VALIDATE_STRINGORSUBSTR): Deprecated.
>>>>>>> 1.1152
2000-10-20 Marius Vollmer <mvo@zagadka.ping.de> 2000-10-20 Marius Vollmer <mvo@zagadka.ping.de>
* init.c (scm_init_guile_1, invoke_main_func): Call * init.c (scm_init_guile_1, invoke_main_func): Call

80
libguile/dynl.c
View file

@ -74,33 +74,41 @@ maybe_drag_in_eprintf ()
#include "libguile/validate.h" #include "libguile/validate.h"
/* Create a new C argv array from a scheme list of strings. */
/* Dirk:FIXME:: A quite similar function is implemented in posix.c */
/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */
/* Converting a list of SCM strings into a argv-style array. You must /* Converting a list of SCM strings into a argv-style array. You must
have ints disabled for the whole lifetime of the created argv (from have ints disabled for the whole lifetime of the created argv (from
before MAKE_ARGV_FROM_STRINGLIST until after before MAKE_ARGV_FROM_STRINGLIST until after
MUST_FREE_ARGV). Atleast this is was the documentation for MUST_FREE_ARGV). Atleast this is was the documentation for
MAKARGVFROMSTRS says, it isn't really used that way. MAKARGVFROMSTRS says, it isn't really used that way.
This code probably belongs into strings.c */ This code probably belongs into strings.c
(Dirk: IMO strings.c is not the right place.) */
static char ** static char **
scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
{ {
char **argv; char **argv;
int argc, i; int argc;
int i;
argc = scm_ilength (args); argc = scm_ilength (args);
argv = (char **) scm_must_malloc ((1L + argc) * sizeof (char *), subr); SCM_ASSERT (argc >= 0, args, argn, subr);
for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) { argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr);
size_t len; for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) {
char *dst, *src; SCM arg = SCM_CAR (args);
SCM str = SCM_CAR (args); scm_sizet len;
char *dst;
char *src;
SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr); SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
len = 1 + SCM_ROLENGTH (str); len = SCM_STRING_LENGTH (arg);
dst = (char *) scm_must_malloc ((long) len, subr); src = SCM_ROCHARS (arg);
src = SCM_ROCHARS (str); dst = (char *) scm_must_malloc (len + 1, subr);
while (len--) memcpy (dst, src, len);
dst[len] = src[len]; dst[len] = 0;
argv[i] = dst; argv[i] = dst;
} }
@ -119,18 +127,6 @@ scm_must_free_argv(char **argv)
free (argv); free (argv);
} }
/* Coerce an arbitrary readonly-string into a zero-terminated string.
*/
static SCM
scm_coerce_rostring (SCM rostr,const char *subr,int argn)
{
SCM_ASSERT (SCM_ROSTRINGP (rostr), rostr, argn, subr);
if (SCM_SUBSTRP (rostr))
rostr = scm_makfromstr (SCM_ROCHARS (rostr), SCM_STRING_LENGTH (rostr), 0);
return rostr;
}
/* Module registry /* Module registry
*/ */
@ -353,11 +349,10 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
#define FUNC_NAME s_scm_dynamic_link #define FUNC_NAME s_scm_dynamic_link
{ {
void *handle; void *handle;
char *chars;
fname = scm_coerce_rostring (fname, FUNC_NAME, 1); SCM_VALIDATE_STRING (1, fname);
chars = SCM_STRINGP (fname) ? SCM_STRING_CHARS (fname) : SCM_SYMBOL_CHARS (fname); SCM_STRING_COERCE_0TERMINATION_X (fname);
handle = sysdep_dynl_link (chars, FUNC_NAME); handle = sysdep_dynl_link (SCM_STRING_CHARS (fname), FUNC_NAME);
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (fname), handle); SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (fname), handle);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -401,24 +396,24 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
(SCM symb, SCM dobj), (SCM name, SCM dobj),
"Import the symbol @var{func} from @var{lib} (a dynamic library handle).\n" "Search the dynamic object @var{dobj} for the C function\n"
"A @dfn{function handle} representing the imported function is returned.\n" "indicated by the string @var{name} and return some Scheme\n"
"GJB:FIXME:DOC: 2nd version below\n" "handle that can later be used with @code{dynamic-call} to\n"
"Search the C function indicated by @var{function} (a string or symbol)\n" "actually call the function.\n\n"
"in @var{dynobj} and return some Scheme object that can later be used\n"
"with @code{dynamic-call} to actually call this function. Right now,\n"
"these Scheme objects are formed by casting the address of the function\n"
"to @code{long} and converting this number to its Scheme representation.\n\n"
"Regardless whether your C compiler prepends an underscore @samp{_} to\n" "Regardless whether your C compiler prepends an underscore @samp{_} to\n"
"the global names in a program, you should @strong{not} include this\n" "the global names in a program, you should @strong{not} include this\n"
"underscore in @var{function}. Guile knows whether the underscore is\n" "underscore in @var{function}. Guile knows whether the underscore is\n"
"needed or not and will add it when necessary.") "needed or not and will add it when necessary.")
#define FUNC_NAME s_scm_dynamic_func #define FUNC_NAME s_scm_dynamic_func
{ {
/* The returned handle is formed by casting the address of the function to a
* long value and converting this to a scheme number
*/
void (*func) (); void (*func) ();
symb = scm_coerce_rostring (symb, FUNC_NAME, 1); SCM_VALIDATE_STRING (1, name);
/*fixme* GC-problem */ /*fixme* GC-problem */
SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj); SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
if (DYNL_HANDLE (dobj) == NULL) { if (DYNL_HANDLE (dobj) == NULL) {
@ -427,7 +422,8 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
char *chars; char *chars;
SCM_DEFER_INTS; SCM_DEFER_INTS;
chars = SCM_STRINGP (symb) ? SCM_STRING_CHARS (symb) : SCM_SYMBOL_CHARS (symb); SCM_STRING_COERCE_0TERMINATION_X (name);
chars = SCM_STRING_CHARS (name);
func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return scm_ulong2num ((unsigned long) func); return scm_ulong2num ((unsigned long) func);
@ -458,7 +454,7 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
{ {
void (*fptr) (); void (*fptr) ();
if (SCM_ROSTRINGP (func)) if (SCM_STRINGP (func))
func = scm_dynamic_func (func, dobj); func = scm_dynamic_func (func, dobj);
fptr = (void (*) ()) SCM_NUM2ULONG (1, func); fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -494,7 +490,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
int result, argc; int result, argc;
char **argv; char **argv;
if (SCM_ROSTRINGP (func)) if (SCM_STRINGP (func))
func = scm_dynamic_func (func, dobj); func = scm_dynamic_func (func, dobj);
fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);

32
libguile/error.c
View file

@ -116,10 +116,34 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
{ {
char *szSubr; char *szSubr;
char *szMessage; char *szMessage;
SCM_VALIDATE_SYMBOL (1,key);
SCM_VALIDATE_NULLORROSTRING_COPY (2,subr,szSubr); SCM_VALIDATE_SYMBOL (1, key);
SCM_VALIDATE_NULLORROSTRING_COPY (3,message,szMessage);
SCM_COERCE_SUBSTR (message); if (SCM_FALSEP (subr))
{
szSubr = NULL;
}
else if (SCM_SYMBOLP (subr))
{
szSubr = SCM_SYMBOL_CHARS (subr);
}
else
{
SCM_VALIDATE_STRING (2, subr);
SCM_STRING_COERCE_0TERMINATION_X (subr);
szSubr = SCM_STRING_CHARS (subr);
}
if (SCM_FALSEP (message))
{
szMessage = NULL;
}
else
{
SCM_VALIDATE_STRING (2, message);
SCM_STRING_COERCE_0TERMINATION_X (message);
szMessage = SCM_STRING_CHARS (message);
}
scm_error (key, szSubr, szMessage, args, rest); scm_error (key, szSubr, szMessage, args, rest);
/* not reached. */ /* not reached. */

124
libguile/filesys.c
View file

@ -155,9 +155,9 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
else else
#endif #endif
{ {
SCM_VALIDATE_ROSTRING(1,object); SCM_VALIDATE_STRING (1, object);
SCM_COERCE_SUBSTR (object); SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = chown (SCM_ROCHARS (object), SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object),
SCM_INUM (owner), SCM_INUM (group))); SCM_INUM (owner), SCM_INUM (group)));
} }
if (rv == -1) if (rv == -1)
@ -194,9 +194,9 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
} }
else else
{ {
SCM_VALIDATE_ROSTRING (1,object); SCM_VALIDATE_STRING (1, object);
SCM_COERCE_SUBSTR (object); SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode))); SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode)));
} }
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -239,11 +239,11 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
int iflags; int iflags;
int imode; int imode;
SCM_VALIDATE_ROSTRING (1,path); SCM_VALIDATE_STRING (1, path);
SCM_COERCE_SUBSTR (path); SCM_STRING_COERCE_0TERMINATION_X (path);
iflags = SCM_NUM2LONG(2,flags); iflags = SCM_NUM2LONG(2,flags);
imode = SCM_NUM2LONG_DEF(3,mode,0666); imode = SCM_NUM2LONG_DEF(3,mode,0666);
SCM_SYSCALL (fd = open (SCM_ROCHARS (path), iflags, imode)); SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1) if (fd == -1)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_MAKINUM (fd); return SCM_MAKINUM (fd);
@ -505,10 +505,10 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
else else
{ {
SCM_VALIDATE_NIM (1,object); SCM_VALIDATE_NIM (1,object);
if (SCM_ROSTRINGP (object)) if (SCM_STRINGP (object))
{ {
SCM_COERCE_SUBSTR (object); SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp)); SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp));
} }
else else
{ {
@ -544,15 +544,11 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
{ {
int val; int val;
SCM_VALIDATE_ROSTRING (1,oldpath); SCM_VALIDATE_STRING (1, oldpath);
if (SCM_SUBSTRP (oldpath)) SCM_STRING_COERCE_0TERMINATION_X (oldpath);
oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_VALIDATE_STRING (2, newpath);
SCM_STRING_LENGTH (oldpath), 0); SCM_STRING_COERCE_0TERMINATION_X (newpath);
SCM_VALIDATE_ROSTRING (2,newpath); SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath)));
if (SCM_SUBSTRP (newpath))
newpath = scm_makfromstr (SCM_ROCHARS (newpath),
SCM_STRING_LENGTH (newpath), 0);
SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0) if (val != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -568,20 +564,20 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
#define FUNC_NAME s_scm_rename #define FUNC_NAME s_scm_rename
{ {
int rv; int rv;
SCM_VALIDATE_ROSTRING (1,oldname); SCM_VALIDATE_STRING (1, oldname);
SCM_VALIDATE_ROSTRING (2,newname); SCM_VALIDATE_STRING (2, newname);
SCM_COERCE_SUBSTR (oldname); SCM_STRING_COERCE_0TERMINATION_X (oldname);
SCM_COERCE_SUBSTR (newname); SCM_STRING_COERCE_0TERMINATION_X (newname);
#ifdef HAVE_RENAME #ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname))); SCM_SYSCALL (rv = rename (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
#else #else
SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname))); SCM_SYSCALL (rv = link (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
if (rv == 0) if (rv == 0)
{ {
SCM_SYSCALL (rv = unlink (SCM_ROCHARS (oldname)));; SCM_SYSCALL (rv = unlink (SCM_STRING_CHARS (oldname)));;
if (rv != 0) if (rv != 0)
/* unlink failed. remove new name */ /* unlink failed. remove new name */
SCM_SYSCALL (unlink (SCM_ROCHARS (newname))); SCM_SYSCALL (unlink (SCM_STRING_CHARS (newname)));
} }
#endif #endif
if (rv != 0) if (rv != 0)
@ -597,9 +593,9 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
#define FUNC_NAME s_scm_delete_file #define FUNC_NAME s_scm_delete_file
{ {
int ans; int ans;
SCM_VALIDATE_ROSTRING (1,str); SCM_VALIDATE_STRING (1, str);
SCM_COERCE_SUBSTR (str); SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str))); SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str)));
if (ans != 0) if (ans != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -617,18 +613,18 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
{ {
int rv; int rv;
mode_t mask; mode_t mask;
SCM_VALIDATE_ROSTRING (1,path); SCM_VALIDATE_STRING (1, path);
SCM_COERCE_SUBSTR (path); SCM_STRING_COERCE_0TERMINATION_X (path);
if (SCM_UNBNDP (mode)) if (SCM_UNBNDP (mode))
{ {
mask = umask (0); mask = umask (0);
umask (mask); umask (mask);
SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), 0777 ^ mask)); SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), 0777 ^ mask));
} }
else else
{ {
SCM_VALIDATE_INUM (2,mode); SCM_VALIDATE_INUM (2,mode);
SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), SCM_INUM (mode))); SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode)));
} }
if (rv != 0) if (rv != 0)
SCM_SYSERROR; SCM_SYSERROR;
@ -646,9 +642,9 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
{ {
int val; int val;
SCM_VALIDATE_ROSTRING (1,path); SCM_VALIDATE_STRING (1, path);
SCM_COERCE_SUBSTR (path); SCM_STRING_COERCE_0TERMINATION_X (path);
SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path))); SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path)));
if (val != 0) if (val != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -679,9 +675,9 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
#define FUNC_NAME s_scm_opendir #define FUNC_NAME s_scm_opendir
{ {
DIR *ds; DIR *ds;
SCM_VALIDATE_ROSTRING (1,dirname); SCM_VALIDATE_STRING (1, dirname);
SCM_COERCE_SUBSTR (dirname); SCM_STRING_COERCE_0TERMINATION_X (dirname);
SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname))); SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
if (ds == NULL) if (ds == NULL)
SCM_SYSERROR; SCM_SYSERROR;
SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds); SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds);
@ -781,9 +777,9 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
{ {
int ans; int ans;
SCM_VALIDATE_ROSTRING (1,str); SCM_VALIDATE_STRING (1, str);
SCM_COERCE_SUBSTR (str); SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str))); SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str)));
if (ans != 0) if (ans != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1206,11 +1202,11 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
{ {
int val; int val;
SCM_VALIDATE_ROSTRING (1,oldpath); SCM_VALIDATE_STRING (1, oldpath);
SCM_VALIDATE_ROSTRING (2,newpath); SCM_VALIDATE_STRING (2, newpath);
SCM_COERCE_SUBSTR (oldpath); SCM_STRING_COERCE_0TERMINATION_X (oldpath);
SCM_COERCE_SUBSTR (newpath); SCM_STRING_COERCE_0TERMINATION_X (newpath);
SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath))); SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath)));
if (val != 0) if (val != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1230,10 +1226,10 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
int size = 100; int size = 100;
char *buf; char *buf;
SCM result; SCM result;
SCM_VALIDATE_ROSTRING (1,path); SCM_VALIDATE_STRING (1, path);
SCM_COERCE_SUBSTR (path); SCM_STRING_COERCE_0TERMINATION_X (path);
buf = scm_must_malloc (size, FUNC_NAME); buf = scm_must_malloc (size, FUNC_NAME);
while ((rv = readlink (SCM_ROCHARS (path), buf, size)) == size) while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size)
{ {
scm_must_free (buf); scm_must_free (buf);
size *= 2; size *= 2;
@ -1259,9 +1255,9 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
int rv; int rv;
struct stat stat_temp; struct stat stat_temp;
SCM_VALIDATE_ROSTRING (1,str); SCM_VALIDATE_STRING (1, str);
SCM_COERCE_SUBSTR (str); SCM_STRING_COERCE_0TERMINATION_X (str);
SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp)); SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp));
if (rv != 0) if (rv != 0)
{ {
int en = errno; int en = errno;
@ -1287,20 +1283,18 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
char buf[BUFSIZ]; char buf[BUFSIZ];
struct stat oldstat; struct stat oldstat;
SCM_VALIDATE_ROSTRING (1,oldfile); SCM_VALIDATE_STRING (1, oldfile);
if (SCM_SUBSTRP (oldfile)) SCM_STRING_COERCE_0TERMINATION_X (oldfile);
oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_STRING_LENGTH (oldfile), 0); SCM_VALIDATE_STRING (2, newfile);
SCM_VALIDATE_ROSTRING (2,newfile); SCM_STRING_COERCE_0TERMINATION_X (newfile);
if (SCM_SUBSTRP (newfile)) if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1)
newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_STRING_LENGTH (newfile), 0);
if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
SCM_SYSERROR; SCM_SYSERROR;
oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY); oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY);
if (oldfd == -1) if (oldfd == -1)
SCM_SYSERROR; SCM_SYSERROR;
/* use POSIX flags instead of 07777?. */ /* use POSIX flags instead of 07777?. */
newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC, newfd = open (SCM_STRING_CHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
oldstat.st_mode & 07777); oldstat.st_mode & 07777);
if (newfd == -1) if (newfd == -1)
SCM_SYSERROR; SCM_SYSERROR;

14
libguile/fports.c
View file

@ -276,15 +276,13 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
char *mode; char *mode;
char *ptr; char *ptr;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_VALIDATE_ROSTRING (2,modes); SCM_VALIDATE_STRING (2, modes);
if (SCM_SUBSTRP (filename)) SCM_STRING_COERCE_0TERMINATION_X (filename);
filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_STRING_LENGTH (filename), 0); SCM_STRING_COERCE_0TERMINATION_X (modes);
if (SCM_SUBSTRP (modes))
modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_STRING_LENGTH (modes), 0);
file = SCM_ROCHARS (filename); file = SCM_STRING_CHARS (filename);
mode = SCM_ROCHARS (modes); mode = SCM_STRING_CHARS (modes);
switch (*mode) switch (*mode)
{ {

10
libguile/ioext.c
View file

@ -93,8 +93,8 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
char *cdelims; char *cdelims;
int num_delims; int num_delims;
SCM_VALIDATE_ROSTRING_COPY (1,delims,cdelims); SCM_VALIDATE_STRING_COPY (1, delims, cdelims);
num_delims = SCM_ROLENGTH (delims); num_delims = SCM_STRING_LENGTH (delims);
SCM_VALIDATE_STRING_COPY (2,buf,cbuf); SCM_VALIDATE_STRING_COPY (2,buf,cbuf);
cend = SCM_STRING_LENGTH (buf); cend = SCM_STRING_LENGTH (buf);
if (SCM_UNBNDP (port)) if (SCM_UNBNDP (port))
@ -457,10 +457,10 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
#define FUNC_NAME s_scm_fdopen #define FUNC_NAME s_scm_fdopen
{ {
SCM_VALIDATE_INUM (1,fdes); SCM_VALIDATE_INUM (1,fdes);
SCM_VALIDATE_ROSTRING (2,modes); SCM_VALIDATE_STRING (2, modes);
SCM_COERCE_SUBSTR (modes); SCM_STRING_COERCE_0TERMINATION_X (modes);
return scm_fdes_to_port (SCM_INUM (fdes), SCM_ROCHARS (modes), SCM_BOOL_F); return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F);
} }
#undef FUNC_NAME #undef FUNC_NAME

38
libguile/load.c
View file

@ -118,7 +118,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
#define FUNC_NAME s_scm_primitive_load #define FUNC_NAME s_scm_primitive_load
{ {
SCM hook = *scm_loc_load_hook; SCM hook = *scm_loc_load_hook;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)), SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)),
hook, "value of %load-hook is neither a procedure nor #f", hook, "value of %load-hook is neither a procedure nor #f",
FUNC_NAME); FUNC_NAME);
@ -225,7 +225,7 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0,
"") "")
#define FUNC_NAME s_scm_parse_path #define FUNC_NAME s_scm_parse_path
{ {
SCM_ASSERT (SCM_FALSEP (path) || (SCM_ROSTRINGP (path)), SCM_ASSERT (SCM_FALSEP (path) || (SCM_STRINGP (path)),
path, path,
SCM_ARG1, FUNC_NAME); SCM_ARG1, FUNC_NAME);
if (SCM_UNBNDP (tail)) if (SCM_UNBNDP (tail))
@ -276,14 +276,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
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_ROSTRING (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_ROCHARS (filename); filename_chars = SCM_ROCHARS (filename);
filename_len = SCM_ROLENGTH (filename); filename_len = SCM_STRING_LENGTH (filename);
/* If FILENAME is absolute, return it unchanged. */ /* If FILENAME is absolute, return it unchanged. */
if (filename_len >= 1 && filename_chars[0] == '/') if (filename_len >= 1 && filename_chars[0] == '/')
@ -294,14 +294,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
SCM walk; SCM walk;
max_path_len = 0; max_path_len = 0;
for (walk = path; SCM_NNULLP (walk); walk = SCM_CDR (walk)) for (walk = path; !SCM_NULLP (walk); walk = SCM_CDR (walk))
{ {
SCM elt = SCM_CAR (walk); SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_STRINGP (elt), elt,
"path is not a list of strings", "path is not a list of strings",
FUNC_NAME); FUNC_NAME);
if (SCM_ROLENGTH (elt) > max_path_len) if (SCM_STRING_LENGTH (elt) > max_path_len)
max_path_len = SCM_ROLENGTH (elt); max_path_len = SCM_STRING_LENGTH (elt);
} }
} }
@ -333,14 +333,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
SCM walk; SCM walk;
max_ext_len = 0; max_ext_len = 0;
for (walk = extensions; SCM_NNULLP (walk); walk = SCM_CDR (walk)) for (walk = extensions; !SCM_NULLP (walk); walk = SCM_CDR (walk))
{ {
SCM elt = SCM_CAR (walk); SCM elt = SCM_CAR (walk);
SCM_ASSERT (SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_STRINGP (elt), elt,
"extension list is not a list of strings", "extension list is not a list of strings",
FUNC_NAME); FUNC_NAME);
if (SCM_ROLENGTH (elt) > max_ext_len) if (SCM_STRING_LENGTH (elt) > max_ext_len)
max_ext_len = SCM_ROLENGTH (elt); max_ext_len = SCM_STRING_LENGTH (elt);
} }
} }
@ -357,14 +357,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
/* Try every path element. At this point, we know the path is a /* Try every path element. At this point, we know the path is a
proper list of strings. */ proper list of strings. */
for (; SCM_NNULLP (path); path = SCM_CDR (path)) for (; !SCM_NULLP (path); path = SCM_CDR (path))
{ {
int len; int len;
SCM dir = SCM_CAR (path); SCM dir = SCM_CAR (path);
SCM exts; SCM exts;
/* Concatenate the path name and the filename. */ /* Concatenate the path name and the filename. */
len = SCM_ROLENGTH (dir); len = SCM_STRING_LENGTH (dir);
memcpy (buf, SCM_ROCHARS (dir), len); memcpy (buf, SCM_ROCHARS (dir), len);
if (len >= 1 && buf[len - 1] != '/') if (len >= 1 && buf[len - 1] != '/')
buf[len++] = '/'; buf[len++] = '/';
@ -373,10 +373,10 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
/* Try every extension. At this point, we know the extension /* Try every extension. At this point, we know the extension
list is a proper, nonempty list of strings. */ list is a proper, nonempty list of strings. */
for (exts = extensions; SCM_NNULLP (exts); exts = SCM_CDR (exts)) for (exts = extensions; !SCM_NULLP (exts); exts = SCM_CDR (exts))
{ {
SCM ext = SCM_CAR (exts); SCM ext = SCM_CAR (exts);
int ext_len = SCM_ROLENGTH (ext); int ext_len = SCM_STRING_LENGTH (ext);
struct stat mode; struct stat mode;
/* Concatenate the extension. */ /* Concatenate the extension. */
@ -420,7 +420,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
{ {
SCM path = *scm_loc_load_path; SCM path = *scm_loc_load_path;
SCM exts = *scm_loc_load_extensions; SCM exts = *scm_loc_load_extensions;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_ASSERT (scm_ilength (path) >= 0, path, "load path is not a proper list", SCM_ASSERT (scm_ilength (path) >= 0, path, "load path is not a proper list",
FUNC_NAME); FUNC_NAME);
@ -441,13 +441,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
{ {
SCM full_filename; SCM full_filename;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
full_filename = scm_sys_search_load_path (filename); full_filename = scm_sys_search_load_path (filename);
if (SCM_FALSEP (full_filename)) if (SCM_FALSEP (full_filename))
{ {
int absolute = (SCM_ROLENGTH (filename) >= 1 int absolute = (SCM_STRING_LENGTH (filename) >= 1
&& SCM_ROCHARS (filename)[0] == '/'); && SCM_ROCHARS (filename)[0] == '/');
SCM_MISC_ERROR ((absolute SCM_MISC_ERROR ((absolute
? "Unable to load file ~S" ? "Unable to load file ~S"

37
libguile/net_db.c
View file

@ -95,10 +95,9 @@ SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0,
{ {
struct in_addr soka; struct in_addr soka;
SCM_VALIDATE_ROSTRING (1,address); SCM_VALIDATE_STRING (1, address);
if (SCM_SUBSTRP (address)) SCM_STRING_COERCE_0TERMINATION_X (address);
address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); if (inet_aton (SCM_STRING_CHARS (address), &soka) == 0)
if (inet_aton (SCM_ROCHARS (address), &soka) == 0)
SCM_MISC_ERROR ("bad address", SCM_EOL); SCM_MISC_ERROR ("bad address", SCM_EOL);
return scm_ulong2num (ntohl (soka.s_addr)); return scm_ulong2num (ntohl (soka.s_addr));
} }
@ -277,10 +276,10 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_ROSTRINGP (host)) else if (SCM_STRINGP (host))
{ {
SCM_COERCE_SUBSTR (host); SCM_STRING_COERCE_0TERMINATION_X (host);
entry = gethostbyname (SCM_ROCHARS (host)); entry = gethostbyname (SCM_STRING_CHARS (host));
} }
else else
{ {
@ -351,10 +350,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_ROSTRINGP (net)) else if (SCM_STRINGP (net))
{ {
SCM_COERCE_SUBSTR (net); SCM_STRING_COERCE_0TERMINATION_X (net);
entry = getnetbyname (SCM_ROCHARS (net)); entry = getnetbyname (SCM_STRING_CHARS (net));
} }
else else
{ {
@ -403,10 +402,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
else if (SCM_ROSTRINGP (protocol)) else if (SCM_STRINGP (protocol))
{ {
SCM_COERCE_SUBSTR (protocol); SCM_STRING_COERCE_0TERMINATION_X (protocol);
entry = getprotobyname (SCM_ROCHARS (protocol)); entry = getprotobyname (SCM_STRING_CHARS (protocol));
} }
else else
{ {
@ -468,17 +467,17 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
} }
return scm_return_entry (entry); return scm_return_entry (entry);
} }
SCM_VALIDATE_ROSTRING (2,protocol); SCM_VALIDATE_STRING (2, protocol);
SCM_COERCE_SUBSTR (protocol); SCM_STRING_COERCE_0TERMINATION_X (protocol);
if (SCM_ROSTRINGP (name)) if (SCM_STRINGP (name))
{ {
SCM_COERCE_SUBSTR (name); SCM_STRING_COERCE_0TERMINATION_X (name);
entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (protocol)); entry = getservbyname (SCM_STRING_CHARS (name), SCM_STRING_CHARS (protocol));
} }
else else
{ {
SCM_VALIDATE_INUM (1,name); SCM_VALIDATE_INUM (1,name);
entry = getservbyport (htons (SCM_INUM (name)), SCM_ROCHARS (protocol)); entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol));
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG("no such service ~A", SCM_SYSERROR_MSG("no such service ~A",

4
libguile/numbers.c
View file

@ -2806,10 +2806,10 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
{ {
SCM answer; SCM answer;
int base; int base;
SCM_VALIDATE_ROSTRING (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_istring2number (SCM_ROCHARS (string), answer = scm_istring2number (SCM_ROCHARS (string),
SCM_ROLENGTH (string), SCM_STRING_LENGTH (string),
base); base);
return scm_return_first (answer, string); return scm_return_first (answer, string);
} }

14
libguile/ports.c
View file

@ -1163,7 +1163,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
if (SCM_UNBNDP (length)) if (SCM_UNBNDP (length))
{ {
/* must supply length if object is a filename. */ /* must supply length if object is a filename. */
if (SCM_ROSTRINGP (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));
@ -1194,9 +1194,9 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
} }
else else
{ {
SCM_VALIDATE_ROSTRING (1,object); SCM_VALIDATE_STRING (1, object);
SCM_COERCE_SUBSTR (object); SCM_STRING_COERCE_0TERMINATION_X (object);
SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length)); SCM_SYSCALL (rv = truncate (SCM_STRING_CHARS (object), c_length));
} }
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1386,9 +1386,9 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
"documentation for @code{open-file} in @ref{File Ports}.") "documentation for @code{open-file} in @ref{File Ports}.")
#define FUNC_NAME s_scm_sys_make_void_port #define FUNC_NAME s_scm_sys_make_void_port
{ {
SCM_VALIDATE_ROSTRING (1,mode); SCM_VALIDATE_STRING (1, mode);
SCM_COERCE_SUBSTR (mode); SCM_STRING_COERCE_0TERMINATION_X (mode);
return scm_void_port (SCM_ROCHARS (mode)); return scm_void_port (SCM_STRING_CHARS (mode));
} }
#undef FUNC_NAME #undef FUNC_NAME

119
libguile/posix.c
View file

@ -264,10 +264,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
} }
else else
{ {
SCM_VALIDATE_ROSTRING (1,user); SCM_VALIDATE_STRING (1, user);
if (SCM_SUBSTRP (user)) SCM_STRING_COERCE_0TERMINATION_X (user);
user = scm_makfromstr (SCM_ROCHARS (user), SCM_STRING_LENGTH (user), 0); entry = getpwnam (SCM_STRING_CHARS (user));
entry = getpwnam (SCM_ROCHARS (user));
} }
if (!entry) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
@ -334,9 +333,9 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
SCM_SYSCALL (entry = getgrgid (SCM_INUM (name))); SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
else else
{ {
SCM_VALIDATE_ROSTRING (1,name); SCM_VALIDATE_STRING (1, name);
SCM_COERCE_SUBSTR (name); SCM_STRING_COERCE_0TERMINATION_X (name);
SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name))); SCM_SYSCALL (entry = getgrnam (SCM_STRING_CHARS (name)));
} }
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
@ -802,35 +801,37 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_TCSETPGRP */ #endif /* HAVE_TCSETPGRP */
/* Copy exec args from an SCM vector into a new C array. */ /* Create a new C argv array from a scheme list of strings. */
/* Dirk:FIXME:: A quite similar function is implemented in dynl.c */
/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */
static char ** static char **
scm_convert_exec_args (SCM args, int pos, const char *subr) scm_convert_exec_args (SCM args, int argn, const char *subr)
{ {
char **execargv; char **argv;
int num_args; int argc;
int i; int i;
num_args = scm_ilength (args); argc = scm_ilength (args);
SCM_ASSERT (num_args >= 0, args, pos, subr); SCM_ASSERT (argc >= 0, args, argn, subr);
execargv = (char **) argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr);
scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i)
{ {
SCM arg = SCM_CAR (args);
scm_sizet len; scm_sizet len;
char *dst; char *dst;
char *src; char *src;
SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)),
SCM_CAR (args), SCM_ARGn, subr); SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
len = 1 + SCM_ROLENGTH (SCM_CAR (args)); len = SCM_STRING_LENGTH (arg);
dst = (char *) scm_must_malloc ((long) len, subr); src = SCM_ROCHARS (arg);
src = SCM_ROCHARS (SCM_CAR (args)); dst = (char *) scm_must_malloc (len + 1, subr);
while (len--) memcpy (dst, src, len);
dst[len] = src[len]; dst[len] = 0;
execargv[i] = dst; argv[i] = dst;
} }
execargv[i] = 0; argv[i] = 0;
return execargv; return argv;
} }
SCM_DEFINE (scm_execl, "execl", 1, 0, 1, SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
@ -847,10 +848,10 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
#define FUNC_NAME s_scm_execl #define FUNC_NAME s_scm_execl
{ {
char **execargv; char **execargv;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_COERCE_SUBSTR (filename); SCM_STRING_COERCE_0TERMINATION_X (filename);
execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
execv (SCM_ROCHARS (filename), execargv); execv (SCM_STRING_CHARS (filename), execargv);
SCM_SYSERROR; SCM_SYSERROR;
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
@ -868,10 +869,10 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
#define FUNC_NAME s_scm_execlp #define FUNC_NAME s_scm_execlp
{ {
char **execargv; char **execargv;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_COERCE_SUBSTR (filename); SCM_STRING_COERCE_0TERMINATION_X (filename);
execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
execvp (SCM_ROCHARS (filename), execargv); execvp (SCM_STRING_CHARS (filename), execargv);
SCM_SYSERROR; SCM_SYSERROR;
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
@ -883,30 +884,27 @@ environ_list_to_c (SCM envlist, int arg, const char *proc)
{ {
int num_strings; int num_strings;
char **result; char **result;
int i = 0; int i;
SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist),
envlist, arg, proc);
num_strings = scm_ilength (envlist); num_strings = scm_ilength (envlist);
SCM_ASSERT (num_strings >= 0, envlist, arg, proc);
result = (char **) malloc ((num_strings + 1) * sizeof (char *)); result = (char **) malloc ((num_strings + 1) * sizeof (char *));
if (result == NULL) if (result == NULL)
scm_memory_error (proc); scm_memory_error (proc);
while (SCM_NNULLP (envlist)) for (i = 0; !SCM_NULLP (envlist); ++i, envlist = SCM_CDR (envlist))
{ {
SCM str = SCM_CAR (envlist);
int len; int len;
char *src; char *src;
SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (envlist)), SCM_ASSERT (SCM_STRINGP (str), envlist, arg, proc);
envlist, arg, proc); len = SCM_STRING_LENGTH (str);
len = 1 + SCM_ROLENGTH (SCM_CAR (envlist)); src = SCM_ROCHARS (str);
result[i] = malloc ((long) len); result[i] = malloc (len + 1);
if (result[i] == NULL) if (result[i] == NULL)
scm_memory_error (proc); scm_memory_error (proc);
src = SCM_ROCHARS (SCM_CAR (envlist)); memcpy (result[i], src, len);
while (len--) result[i][len] = 0;
result[i][len] = src[len];
envlist = SCM_CDR (envlist);
i++;
} }
result[i] = 0; result[i] = 0;
return result; return result;
@ -924,12 +922,12 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
char **execargv; char **execargv;
char **exec_env; char **exec_env;
SCM_VALIDATE_ROSTRING (1,filename); SCM_VALIDATE_STRING (1, filename);
SCM_COERCE_SUBSTR (filename); SCM_STRING_COERCE_0TERMINATION_X (filename);
execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME); execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME); exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
execve (SCM_ROCHARS (filename), execargv, exec_env); execve (SCM_STRING_CHARS (filename), execargv, exec_env);
SCM_SYSERROR; SCM_SYSERROR;
/* not reached. */ /* not reached. */
return SCM_BOOL_F; return SCM_BOOL_F;
@ -1052,8 +1050,8 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
int rv; int rv;
struct utimbuf utm_tmp; struct utimbuf utm_tmp;
SCM_VALIDATE_ROSTRING (1,pathname); SCM_VALIDATE_STRING (1, pathname);
SCM_COERCE_SUBSTR (pathname); SCM_STRING_COERCE_0TERMINATION_X (pathname);
if (SCM_UNBNDP (actime)) if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime)); SCM_SYSCALL (time (&utm_tmp.actime));
else else
@ -1064,7 +1062,7 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
else else
utm_tmp.modtime = SCM_NUM2ULONG (3,modtime); utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp)); SCM_SYSCALL (rv = utime (SCM_STRING_CHARS (pathname), &utm_tmp));
if (rv != 0) if (rv != 0)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1100,11 +1098,10 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0,
{ {
int rv; int rv;
SCM_VALIDATE_ROSTRING (1,path); SCM_VALIDATE_STRING (1, path);
if (SCM_SUBSTRP (path)) SCM_STRING_COERCE_0TERMINATION_X (path);
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0); SCM_VALIDATE_INUM (2, how);
SCM_VALIDATE_INUM (2,how); rv = access (SCM_STRING_CHARS (path), SCM_INUM (how));
rv = access (SCM_ROCHARS (path), SCM_INUM (how));
return SCM_NEGATE_BOOL(rv); return SCM_NEGATE_BOOL(rv);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1172,9 +1169,9 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
} }
else else
{ {
SCM_VALIDATE_ROSTRING (2,locale); SCM_VALIDATE_STRING (2, locale);
SCM_COERCE_SUBSTR (locale); SCM_STRING_COERCE_0TERMINATION_X (locale);
clocale = SCM_ROCHARS (locale); clocale = SCM_STRING_CHARS (locale);
} }
rv = setlocale (SCM_INUM (category), clocale); rv = setlocale (SCM_INUM (category), clocale);
@ -1207,11 +1204,11 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
char *p; char *p;
int ctype = 0; int ctype = 0;
SCM_VALIDATE_ROSTRING (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);
SCM_COERCE_SUBSTR (path); SCM_STRING_COERCE_0TERMINATION_X (path);
p = SCM_SYMBOL_CHARS (type); p = SCM_SYMBOL_CHARS (type);
if (strcmp (p, "regular") == 0) if (strcmp (p, "regular") == 0)
@ -1233,7 +1230,7 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
else else
SCM_OUT_OF_RANGE (2,type); SCM_OUT_OF_RANGE (2,type);
SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms), SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms),
SCM_INUM (dev))); SCM_INUM (dev)));
if (val != 0) if (val != 0)
SCM_SYSERROR; SCM_SYSERROR;

12
libguile/regex-posix.c
View file

@ -184,9 +184,9 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
regex_t *rx; regex_t *rx;
int status, cflags; int status, cflags;
SCM_VALIDATE_ROSTRING (1,pat); SCM_VALIDATE_STRING (1, pat);
SCM_VALIDATE_REST_ARGUMENT (flags); SCM_VALIDATE_REST_ARGUMENT (flags);
SCM_COERCE_SUBSTR (pat); SCM_STRING_COERCE_0TERMINATION_X (pat);
/* Examine list of regexp flags. If REG_BASIC is supplied, then /* Examine list of regexp flags. If REG_BASIC is supplied, then
turn off REG_EXTENDED flag (on by default). */ turn off REG_EXTENDED flag (on by default). */
@ -202,7 +202,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
} }
rx = SCM_MUST_MALLOC_TYPE (regex_t); rx = SCM_MUST_MALLOC_TYPE (regex_t);
status = regcomp (rx, SCM_ROCHARS (pat), status = regcomp (rx, SCM_STRING_CHARS (pat),
/* Make sure they're not passing REG_NOSUB; /* Make sure they're not passing REG_NOSUB;
regexp-exec assumes we're getting match data. */ regexp-exec assumes we're getting match data. */
cflags & ~REG_NOSUB); cflags & ~REG_NOSUB);
@ -232,13 +232,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
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);
SCM_COERCE_SUBSTR (str); SCM_STRING_COERCE_0TERMINATION_X (str);
/* 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. */
@ -246,7 +246,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
nmatches = SCM_RGX(rx)->re_nsub + 1; nmatches = SCM_RGX(rx)->re_nsub + 1;
SCM_DEFER_INTS; SCM_DEFER_INTS;
matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches); matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches);
status = regexec (SCM_RGX (rx), SCM_ROCHARS (str) + offset, status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset,
nmatches, matches, nmatches, matches,
SCM_INUM (flags)); SCM_INUM (flags));
if (!status) if (!status)

11
libguile/simpos.c
View file

@ -82,12 +82,11 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
rv = system (NULL); rv = system (NULL);
return SCM_BOOL(rv); return SCM_BOOL(rv);
} }
SCM_VALIDATE_ROSTRING (1,cmd); SCM_VALIDATE_STRING (1, cmd);
SCM_DEFER_INTS; SCM_DEFER_INTS;
errno = 0; errno = 0;
if (SCM_SUBSTRP (cmd)) SCM_STRING_COERCE_0TERMINATION_X (cmd);
cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_STRING_LENGTH (cmd), 0); rv = system (SCM_STRING_CHARS (cmd));
rv = system(SCM_ROCHARS(cmd));
if (rv == -1 || (rv == 127 && errno != 0)) if (rv == -1 || (rv == 127 && errno != 0))
SCM_SYSERROR; SCM_SYSERROR;
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -105,8 +104,8 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
#define FUNC_NAME s_scm_getenv #define FUNC_NAME s_scm_getenv
{ {
char *val; char *val;
SCM_VALIDATE_ROSTRING (1,nam); SCM_VALIDATE_STRING (1, nam);
nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0); SCM_STRING_COERCE_0TERMINATION_X (nam);
val = getenv (SCM_STRING_CHARS (nam)); val = getenv (SCM_STRING_CHARS (nam));
return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val), 0) : SCM_BOOL_F; return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val), 0) : SCM_BOOL_F;
} }

13
libguile/socket.c
View file

@ -430,10 +430,9 @@ scm_fill_sockaddr (int fam,SCM address,SCM *args,int which_arg,const char *proc,
scm_must_malloc (sizeof (struct sockaddr_un), proc); scm_must_malloc (sizeof (struct sockaddr_un), proc);
memset (soka, 0, sizeof (struct sockaddr_un)); memset (soka, 0, sizeof (struct sockaddr_un));
soka->sun_family = AF_UNIX; soka->sun_family = AF_UNIX;
SCM_ASSERT (SCM_ROSTRINGP (address), address, SCM_ASSERT (SCM_STRINGP (address), address, which_arg, proc);
which_arg, proc);
memcpy (soka->sun_path, SCM_ROCHARS (address), memcpy (soka->sun_path, SCM_ROCHARS (address),
1 + SCM_ROLENGTH (address)); 1 + SCM_STRING_LENGTH (address));
*size = sizeof (struct sockaddr_un); *size = sizeof (struct sockaddr_un);
return (struct sockaddr *) soka; return (struct sockaddr *) soka;
} }
@ -735,11 +734,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1,sock); SCM_VALIDATE_OPFPORT (1,sock);
SCM_VALIDATE_ROSTRING (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_ROCHARS (message), SCM_ROLENGTH (message), flg)); SCM_SYSCALL (rv = send (fd, SCM_ROCHARS (message), SCM_STRING_LENGTH (message), flg));
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
return SCM_MAKINUM (rv); return SCM_MAKINUM (rv);
@ -845,7 +844,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_FPORT (1,sock); SCM_VALIDATE_FPORT (1,sock);
SCM_VALIDATE_ROSTRING (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,
@ -857,7 +856,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
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_ROCHARS (message), SCM_ROLENGTH (message), SCM_SYSCALL (rv = sendto (fd, SCM_ROCHARS (message), SCM_STRING_LENGTH (message),
flg, soka, size)); flg, soka, size));
save_err = errno; save_err = errno;
scm_must_free ((char *) soka); scm_must_free ((char *) soka);

24
libguile/stime.c
View file

@ -307,9 +307,9 @@ setzone (SCM zone, int pos, const char *subr)
char *buf; char *buf;
SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr); SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr);
SCM_COERCE_SUBSTR (zone); SCM_STRING_COERCE_0TERMINATION_X (zone);
buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr); buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr);
sprintf (buf, "%s=%s", tzvar, SCM_ROCHARS (zone)); sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone));
oldenv = environ; oldenv = environ;
tmpenv[0] = buf; tmpenv[0] = buf;
tmpenv[1] = 0; tmpenv[1] = 0;
@ -573,12 +573,12 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
int len; int len;
SCM result; SCM result;
SCM_VALIDATE_ROSTRING (1,format); SCM_VALIDATE_STRING (1, format);
bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME); bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
SCM_COERCE_SUBSTR (format); SCM_STRING_COERCE_0TERMINATION_X (format);
fmt = SCM_ROCHARS (format); fmt = SCM_STRING_CHARS (format);
len = SCM_ROLENGTH (format); len = SCM_STRING_LENGTH (format);
/* Ugly hack: strftime can return 0 if its buffer is too small, /* Ugly hack: strftime can return 0 if its buffer is too small,
but some valid time strings (e.g. "%p") can sometimes produce but some valid time strings (e.g. "%p") can sometimes produce
@ -666,13 +666,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
struct tm t; struct tm t;
char *fmt, *str, *rest; char *fmt, *str, *rest;
SCM_VALIDATE_ROSTRING (1,format); SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_ROSTRING (2,string); SCM_VALIDATE_STRING (2, string);
SCM_COERCE_SUBSTR (format); SCM_STRING_COERCE_0TERMINATION_X (format);
SCM_COERCE_SUBSTR (string); SCM_STRING_COERCE_0TERMINATION_X (string);
fmt = SCM_ROCHARS (format); fmt = SCM_STRING_CHARS (format);
str = SCM_ROCHARS (string); str = SCM_STRING_CHARS (string);
/* initialize the struct tm */ /* initialize the struct tm */
#define tm_init(field) t.field = 0 #define tm_init(field) t.field = 0

18
libguile/strop.c
View file

@ -61,7 +61,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
int upper; int upper;
int ch; int ch;
SCM_ASSERT (SCM_ROSTRINGP (*str), *str, SCM_ARG1, why); SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why);
SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
if (SCM_FALSEP (sub_start)) if (SCM_FALSEP (sub_start))
@ -69,17 +69,15 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why);
lower = SCM_INUM (sub_start); lower = SCM_INUM (sub_start);
if (lower < 0 if (lower < 0 || lower > SCM_STRING_LENGTH (*str))
|| lower > SCM_ROLENGTH (*str))
scm_out_of_range (why, sub_start); scm_out_of_range (why, sub_start);
if (SCM_FALSEP (sub_end)) if (SCM_FALSEP (sub_end))
sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str)); sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str));
SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why);
upper = SCM_INUM (sub_end); upper = SCM_INUM (sub_end);
if (upper < SCM_INUM (sub_start) if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str))
|| upper > SCM_ROLENGTH (*str))
scm_out_of_range (why, sub_end); scm_out_of_range (why, sub_end);
if (direction > 0) if (direction > 0)
@ -309,8 +307,8 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
"@end example") "@end example")
#define FUNC_NAME s_scm_string_null_p #define FUNC_NAME s_scm_string_null_p
{ {
SCM_VALIDATE_ROSTRING (1,str); SCM_VALIDATE_STRING (1,str);
return SCM_NEGATE_BOOL(SCM_ROLENGTH (str)); return SCM_NEGATE_BOOL (SCM_STRING_LENGTH (str));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -328,9 +326,9 @@ 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_ROSTRING (1,str); SCM_VALIDATE_STRING (1,str);
src = SCM_ROUCHARS (str); src = SCM_ROUCHARS (str);
for (i = SCM_ROLENGTH (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;
} }
#undef FUNC_NAME #undef FUNC_NAME

4
libguile/strports.c
View file

@ -270,8 +270,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
int str_len; int str_len;
SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller); SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller);
SCM_ASSERT (SCM_ROSTRINGP(str), str, SCM_ARG1, caller); SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG1, caller);
str_len = SCM_ROLENGTH (str); str_len = SCM_STRING_LENGTH (str);
if (SCM_INUM (pos) > str_len) if (SCM_INUM (pos) > str_len)
scm_out_of_range (caller, pos); scm_out_of_range (caller, pos);
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))

4
libguile/symbols.c
View file

@ -524,7 +524,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
SCM answer; SCM answer;
int softness; int softness;
SCM_VALIDATE_ROSTRING (2,s); SCM_VALIDATE_STRING (2, s);
SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME);
softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp)); softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp));
@ -535,7 +535,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
o = SCM_BOOL_F; o = SCM_BOOL_F;
vcell = scm_intern_obarray_soft (SCM_ROCHARS(s), vcell = scm_intern_obarray_soft (SCM_ROCHARS(s),
(scm_sizet)SCM_ROLENGTH(s), SCM_STRING_LENGTH (s),
o, o,
softness); softness);
if (SCM_FALSEP (vcell)) if (SCM_FALSEP (vcell))

15
libguile/symbols.h
View file

@ -62,7 +62,6 @@ extern int scm_symhash_dim;
#define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_LENGTH_MAX (0xffffffL) #define SCM_LENGTH_MAX (0xffffffL)
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t))) #define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t)))
#define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v))) #define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v)))
@ -88,14 +87,6 @@ extern int scm_symhash_dim;
: ((SCM_TYP7 (x) == scm_tc7_string) \ : ((SCM_TYP7 (x) == scm_tc7_string) \
? SCM_STRING_UCHARS (x) \ ? SCM_STRING_UCHARS (x) \
: SCM_SYMBOL_UCHARS (x))) : SCM_SYMBOL_UCHARS (x)))
#define SCM_ROLENGTH(x) SCM_LENGTH (x)
#define SCM_SUBSTRP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring))
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_COERCE_SUBSTR(x) { if (SCM_SUBSTRP (x)) \
x = scm_makfromstr (SCM_ROCHARS (x), \
SCM_STRING_LENGTH (x), 0); }
@ -139,6 +130,12 @@ extern void scm_init_symbols (void);
#define SCM_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x))) #define SCM_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x))) #define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SLOPPY_SUBSTRP(x) (SCM_SUBSTRP (x)) #define SCM_SLOPPY_SUBSTRP(x) (SCM_SUBSTRP (x))
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_ROLENGTH(x) SCM_LENGTH (x)
#define SCM_SUBSTRP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring))
#define SCM_COERCE_SUBSTR(x) SCM_STRING_COERCE_0TERMINATION_X (x)
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n)) #define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))
#endif /* SCM_DEBUG_DEPRECATED == 0 */ #endif /* SCM_DEBUG_DEPRECATED == 0 */

21
libguile/unif.h
View file

@ -93,14 +93,6 @@ extern long scm_tc16_array;
#define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x)))
#define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
/* apparently it's possible to have more than SCM_LENGTH_MAX elements
in an array: if the length is SCM_LENGTH_MAX then the SCM_VELTS
block begins with the true length (a long int). I wonder if it
works. */
#define SCM_HUGE_LENGTH(x)\
(SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
extern scm_sizet scm_uniform_element_size (SCM obj); extern scm_sizet scm_uniform_element_size (SCM obj);
@ -140,6 +132,19 @@ extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
extern SCM scm_array_prototype (SCM ra); extern SCM scm_array_prototype (SCM ra);
extern void scm_init_unif (void); extern void scm_init_unif (void);
#if (SCM_DEBUG_DEPRECATED == 0)
/* apparently it's possible to have more than SCM_LENGTH_MAX elements
in an array: if the length is SCM_LENGTH_MAX then the SCM_VELTS
block begins with the true length (a long int). I wonder if it
works. */
#define SCM_HUGE_LENGTH(x)\
(SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* UNIFH */ #endif /* UNIFH */
/* /*

38
libguile/validate.h
View file

@ -1,4 +1,4 @@
/* $Id: validate.h,v 1.18 2000-10-25 11:01:03 dirk Exp $ */ /* $Id: validate.h,v 1.19 2000-10-30 11:42:26 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc. /* Copyright (C) 1999, 2000 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
@ -124,24 +124,6 @@
cvar = SCM_CHAR (scm); \ cvar = SCM_CHAR (scm); \
} while (0) } while (0)
#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
#define SCM_VALIDATE_ROSTRING_COPY(pos, str, cvar) \
do { \
SCM_ASSERT (SCM_ROSTRINGP (str), str, pos, FUNC_NAME); \
cvar = SCM_ROCHARS (str); \
} while (0)
#define SCM_VALIDATE_NULLORROSTRING_COPY(pos, str, cvar) \
do { \
SCM_ASSERT (SCM_FALSEP (str) || SCM_ROSTRINGP (str), \
str, pos, FUNC_NAME); \
if (SCM_FALSEP(str)) \
cvar = NULL; \
else \
cvar = SCM_ROCHARS(str); \
} while (0)
#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE (pos, str, STRINGP) #define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE (pos, str, STRINGP)
#define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \ #define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \
@ -416,6 +398,24 @@
#define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING #define SCM_VALIDATE_STRINGORSUBSTR SCM_VALIDATE_STRING
#define SCM_VALIDATE_ROSTRING(pos, str) SCM_MAKE_VALIDATE (pos, str, ROSTRINGP)
#define SCM_VALIDATE_ROSTRING_COPY(pos, str, cvar) \
do { \
SCM_ASSERT (SCM_ROSTRINGP (str), str, pos, FUNC_NAME); \
cvar = SCM_ROCHARS (str); \
} while (0)
#define SCM_VALIDATE_NULLORROSTRING_COPY(pos, str, cvar) \
do { \
SCM_ASSERT (SCM_FALSEP (str) || SCM_ROSTRINGP (str), \
str, pos, FUNC_NAME); \
if (SCM_FALSEP(str)) \
cvar = NULL; \
else \
cvar = SCM_ROCHARS(str); \
} while (0)
#endif /* SCM_DEBUG_DEPRECATED == 0 */ #endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif #endif

6
libguile/vports.c
View file

@ -182,13 +182,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
scm_port *pt; scm_port *pt;
SCM z; SCM z;
SCM_VALIDATE_VECTOR_LEN (1,pv,5); SCM_VALIDATE_VECTOR_LEN (1,pv,5);
SCM_VALIDATE_ROSTRING (2,modes); SCM_VALIDATE_STRING (2, modes);
SCM_COERCE_SUBSTR (modes); SCM_STRING_COERCE_0TERMINATION_X (modes);
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_DEFER_INTS; SCM_DEFER_INTS;
pt = scm_add_to_port_table (z); pt = scm_add_to_port_table (z);
scm_port_non_buffer (pt); scm_port_non_buffer (pt);
SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS (modes))); SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes)));
SCM_SETPTAB_ENTRY (z, pt); SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, SCM_UNPACK (pv)); SCM_SETSTREAM (z, SCM_UNPACK (pv));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;