diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-10-30 11:42:26 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-10-30 11:42:26 +0000 |
commit | a6d9e5abe5b110dc30e8cf914bcb4de4d28baf43 (patch) | |
tree | d5a3679c885a17f8469801bc97897a80ae48f1d6 | |
parent | e9bfab50e4ec7787db05605727a06f98fe30f5b6 (diff) | |
download | guile-a6d9e5abe5b110dc30e8cf914bcb4de4d28baf43.tar.gz |
* Change a couple of functions to accept either symbols or strings only.
* Get rid of remainig uses of SCM_LENGTH etc.
-rw-r--r-- | NEWS | 27 | ||||
-rw-r--r-- | RELEASE | 5 | ||||
-rw-r--r-- | libguile/ChangeLog | 66 | ||||
-rw-r--r-- | libguile/dynl.c | 82 | ||||
-rw-r--r-- | libguile/error.c | 32 | ||||
-rw-r--r-- | libguile/filesys.c | 124 | ||||
-rw-r--r-- | libguile/fports.c | 16 | ||||
-rw-r--r-- | libguile/ioext.c | 10 | ||||
-rw-r--r-- | libguile/load.c | 38 | ||||
-rw-r--r-- | libguile/net_db.c | 37 | ||||
-rw-r--r-- | libguile/numbers.c | 4 | ||||
-rw-r--r-- | libguile/ports.c | 14 | ||||
-rw-r--r-- | libguile/posix.c | 121 | ||||
-rw-r--r-- | libguile/regex-posix.c | 12 | ||||
-rw-r--r-- | libguile/simpos.c | 11 | ||||
-rw-r--r-- | libguile/socket.c | 13 | ||||
-rw-r--r-- | libguile/stime.c | 24 | ||||
-rw-r--r-- | libguile/strop.c | 18 | ||||
-rw-r--r-- | libguile/strports.c | 4 | ||||
-rw-r--r-- | libguile/symbols.c | 4 | ||||
-rw-r--r-- | libguile/symbols.h | 15 | ||||
-rw-r--r-- | libguile/unif.h | 21 | ||||
-rw-r--r-- | libguile/validate.h | 38 | ||||
-rw-r--r-- | libguile/vports.c | 6 |
24 files changed, 420 insertions, 322 deletions
@@ -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 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, 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_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_memory_error instead of SCM_NALLOC. Use SCM_STRINGP instead of SCM_SLOPPY_STRINGP. Use SCM_VALIDATE_STRING instead of SCM_VALIDATE_STRINGORSUBSTR. 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 @@ -46,7 +46,10 @@ In release 1.6: 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_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 function scm_call_catching_errors (replaced by catch functions from throw.[ch]) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index cff3cdf6a..d2b0d79b1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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> * random.c: Include unif.h. @@ -110,7 +175,6 @@ * validated.h (SCM_VALIDATE_STRINGORSUBSTR): Deprecated. ->>>>>>> 1.1152 2000-10-20 Marius Vollmer <mvo@zagadka.ping.de> * init.c (scm_init_guile_1, invoke_main_func): Call diff --git a/libguile/dynl.c b/libguile/dynl.c index 595517045..9d3346f1f 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -74,33 +74,41 @@ maybe_drag_in_eprintf () #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 have ints disabled for the whole lifetime of the created argv (from before MAKE_ARGV_FROM_STRINGLIST until after MUST_FREE_ARGV). Atleast this is was the documentation for 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 ** scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) { char **argv; - int argc, i; + int argc; + int i; argc = scm_ilength (args); - argv = (char **) scm_must_malloc ((1L + argc) * sizeof (char *), subr); - for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) { - size_t len; - char *dst, *src; - SCM str = SCM_CAR (args); - - SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr); - len = 1 + SCM_ROLENGTH (str); - dst = (char *) scm_must_malloc ((long) len, subr); - src = SCM_ROCHARS (str); - while (len--) - dst[len] = src[len]; + SCM_ASSERT (argc >= 0, args, argn, subr); + argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr); + for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) { + SCM arg = SCM_CAR (args); + scm_sizet len; + char *dst; + char *src; + + SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); + len = SCM_STRING_LENGTH (arg); + src = SCM_ROCHARS (arg); + dst = (char *) scm_must_malloc (len + 1, subr); + memcpy (dst, src, len); + dst[len] = 0; argv[i] = dst; } @@ -119,18 +127,6 @@ scm_must_free_argv(char **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 */ @@ -353,11 +349,10 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, #define FUNC_NAME s_scm_dynamic_link { void *handle; - char *chars; - fname = scm_coerce_rostring (fname, FUNC_NAME, 1); - chars = SCM_STRINGP (fname) ? SCM_STRING_CHARS (fname) : SCM_SYMBOL_CHARS (fname); - handle = sysdep_dynl_link (chars, FUNC_NAME); + SCM_VALIDATE_STRING (1, fname); + SCM_STRING_COERCE_0TERMINATION_X (fname); + handle = sysdep_dynl_link (SCM_STRING_CHARS (fname), FUNC_NAME); SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (fname), handle); } #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 symb, SCM dobj), - "Import the symbol @var{func} from @var{lib} (a dynamic library handle).\n" - "A @dfn{function handle} representing the imported function is returned.\n" - "GJB:FIXME:DOC: 2nd version below\n" - "Search the C function indicated by @var{function} (a string or symbol)\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" + (SCM name, SCM dobj), + "Search the dynamic object @var{dobj} for the C function\n" + "indicated by the string @var{name} and return some Scheme\n" + "handle that can later be used with @code{dynamic-call} to\n" + "actually call the function.\n\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" "underscore in @var{function}. Guile knows whether the underscore is\n" "needed or not and will add it when necessary.") #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) (); - symb = scm_coerce_rostring (symb, FUNC_NAME, 1); + SCM_VALIDATE_STRING (1, name); /*fixme* GC-problem */ SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj); if (DYNL_HANDLE (dobj) == NULL) { @@ -427,7 +422,8 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, char *chars; 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); SCM_ALLOW_INTS; return scm_ulong2num ((unsigned long) func); @@ -458,7 +454,7 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, { void (*fptr) (); - if (SCM_ROSTRINGP (func)) + if (SCM_STRINGP (func)) func = scm_dynamic_func (func, dobj); fptr = (void (*) ()) SCM_NUM2ULONG (1, func); SCM_DEFER_INTS; @@ -494,7 +490,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, int result, argc; char **argv; - if (SCM_ROSTRINGP (func)) + if (SCM_STRINGP (func)) func = scm_dynamic_func (func, dobj); fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); diff --git a/libguile/error.c b/libguile/error.c index 4790df734..69f680ee5 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -116,10 +116,34 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, { char *szSubr; char *szMessage; - SCM_VALIDATE_SYMBOL (1,key); - SCM_VALIDATE_NULLORROSTRING_COPY (2,subr,szSubr); - SCM_VALIDATE_NULLORROSTRING_COPY (3,message,szMessage); - SCM_COERCE_SUBSTR (message); + + SCM_VALIDATE_SYMBOL (1, key); + + 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); /* not reached. */ diff --git a/libguile/filesys.c b/libguile/filesys.c index c7de1c615..7e280652e 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -155,9 +155,9 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0, else #endif { - SCM_VALIDATE_ROSTRING(1,object); - SCM_COERCE_SUBSTR (object); - SCM_SYSCALL (rv = chown (SCM_ROCHARS (object), + SCM_VALIDATE_STRING (1, object); + SCM_STRING_COERCE_0TERMINATION_X (object); + SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object), SCM_INUM (owner), SCM_INUM (group))); } if (rv == -1) @@ -194,9 +194,9 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0, } else { - SCM_VALIDATE_ROSTRING (1,object); - SCM_COERCE_SUBSTR (object); - SCM_SYSCALL (rv = chmod (SCM_ROCHARS (object), SCM_INUM (mode))); + SCM_VALIDATE_STRING (1, object); + SCM_STRING_COERCE_0TERMINATION_X (object); + SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode))); } if (rv == -1) SCM_SYSERROR; @@ -239,11 +239,11 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, int iflags; int imode; - SCM_VALIDATE_ROSTRING (1,path); - SCM_COERCE_SUBSTR (path); + SCM_VALIDATE_STRING (1, path); + SCM_STRING_COERCE_0TERMINATION_X (path); iflags = SCM_NUM2LONG(2,flags); 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) SCM_SYSERROR; return SCM_MAKINUM (fd); @@ -505,10 +505,10 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0, else { SCM_VALIDATE_NIM (1,object); - if (SCM_ROSTRINGP (object)) + if (SCM_STRINGP (object)) { - SCM_COERCE_SUBSTR (object); - SCM_SYSCALL (rv = stat (SCM_ROCHARS (object), &stat_temp)); + SCM_STRING_COERCE_0TERMINATION_X (object); + SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp)); } else { @@ -544,15 +544,11 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, { int val; - SCM_VALIDATE_ROSTRING (1,oldpath); - if (SCM_SUBSTRP (oldpath)) - oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), - SCM_STRING_LENGTH (oldpath), 0); - SCM_VALIDATE_ROSTRING (2,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))); + SCM_VALIDATE_STRING (1, oldpath); + SCM_STRING_COERCE_0TERMINATION_X (oldpath); + SCM_VALIDATE_STRING (2, newpath); + SCM_STRING_COERCE_0TERMINATION_X (newpath); + SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath))); if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -568,20 +564,20 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0, #define FUNC_NAME s_scm_rename { int rv; - SCM_VALIDATE_ROSTRING (1,oldname); - SCM_VALIDATE_ROSTRING (2,newname); - SCM_COERCE_SUBSTR (oldname); - SCM_COERCE_SUBSTR (newname); + SCM_VALIDATE_STRING (1, oldname); + SCM_VALIDATE_STRING (2, newname); + SCM_STRING_COERCE_0TERMINATION_X (oldname); + SCM_STRING_COERCE_0TERMINATION_X (newname); #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 - 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) { - SCM_SYSCALL (rv = unlink (SCM_ROCHARS (oldname)));; + SCM_SYSCALL (rv = unlink (SCM_STRING_CHARS (oldname)));; if (rv != 0) /* unlink failed. remove new name */ - SCM_SYSCALL (unlink (SCM_ROCHARS (newname))); + SCM_SYSCALL (unlink (SCM_STRING_CHARS (newname))); } #endif if (rv != 0) @@ -597,9 +593,9 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, #define FUNC_NAME s_scm_delete_file { int ans; - SCM_VALIDATE_ROSTRING (1,str); - SCM_COERCE_SUBSTR (str); - SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str))); + SCM_VALIDATE_STRING (1, str); + SCM_STRING_COERCE_0TERMINATION_X (str); + SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str))); if (ans != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -617,18 +613,18 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, { int rv; mode_t mask; - SCM_VALIDATE_ROSTRING (1,path); - SCM_COERCE_SUBSTR (path); + SCM_VALIDATE_STRING (1, path); + SCM_STRING_COERCE_0TERMINATION_X (path); if (SCM_UNBNDP (mode)) { mask = umask (0); umask (mask); - SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), 0777 ^ mask)); + SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), 0777 ^ mask)); } else { 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) SCM_SYSERROR; @@ -646,9 +642,9 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, { int val; - SCM_VALIDATE_ROSTRING (1,path); - SCM_COERCE_SUBSTR (path); - SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path))); + SCM_VALIDATE_STRING (1, path); + SCM_STRING_COERCE_0TERMINATION_X (path); + SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path))); if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -679,9 +675,9 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0, #define FUNC_NAME s_scm_opendir { DIR *ds; - SCM_VALIDATE_ROSTRING (1,dirname); - SCM_COERCE_SUBSTR (dirname); - SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname))); + SCM_VALIDATE_STRING (1, dirname); + SCM_STRING_COERCE_0TERMINATION_X (dirname); + SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname))); if (ds == NULL) SCM_SYSERROR; SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds); @@ -781,9 +777,9 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, { int ans; - SCM_VALIDATE_ROSTRING (1,str); - SCM_COERCE_SUBSTR (str); - SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str))); + SCM_VALIDATE_STRING (1, str); + SCM_STRING_COERCE_0TERMINATION_X (str); + SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str))); if (ans != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -1206,11 +1202,11 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, { int val; - SCM_VALIDATE_ROSTRING (1,oldpath); - SCM_VALIDATE_ROSTRING (2,newpath); - SCM_COERCE_SUBSTR (oldpath); - SCM_COERCE_SUBSTR (newpath); - SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath))); + SCM_VALIDATE_STRING (1, oldpath); + SCM_VALIDATE_STRING (2, newpath); + SCM_STRING_COERCE_0TERMINATION_X (oldpath); + SCM_STRING_COERCE_0TERMINATION_X (newpath); + SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath))); if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -1230,10 +1226,10 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, int size = 100; char *buf; SCM result; - SCM_VALIDATE_ROSTRING (1,path); - SCM_COERCE_SUBSTR (path); + SCM_VALIDATE_STRING (1, path); + SCM_STRING_COERCE_0TERMINATION_X (path); 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); size *= 2; @@ -1259,9 +1255,9 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, int rv; struct stat stat_temp; - SCM_VALIDATE_ROSTRING (1,str); - SCM_COERCE_SUBSTR (str); - SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp)); + SCM_VALIDATE_STRING (1, str); + SCM_STRING_COERCE_0TERMINATION_X (str); + SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp)); if (rv != 0) { int en = errno; @@ -1287,20 +1283,18 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0, char buf[BUFSIZ]; struct stat oldstat; - SCM_VALIDATE_ROSTRING (1,oldfile); - if (SCM_SUBSTRP (oldfile)) - oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_STRING_LENGTH (oldfile), 0); - SCM_VALIDATE_ROSTRING (2,newfile); - if (SCM_SUBSTRP (newfile)) - newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_STRING_LENGTH (newfile), 0); - if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1) + SCM_VALIDATE_STRING (1, oldfile); + SCM_STRING_COERCE_0TERMINATION_X (oldfile); + SCM_VALIDATE_STRING (2, newfile); + SCM_STRING_COERCE_0TERMINATION_X (newfile); + if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1) SCM_SYSERROR; - oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY); + oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY); if (oldfd == -1) SCM_SYSERROR; /* 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); if (newfd == -1) SCM_SYSERROR; diff --git a/libguile/fports.c b/libguile/fports.c index bd955e314..658ab2675 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -276,15 +276,13 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, char *mode; char *ptr; - SCM_VALIDATE_ROSTRING (1,filename); - SCM_VALIDATE_ROSTRING (2,modes); - if (SCM_SUBSTRP (filename)) - filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_STRING_LENGTH (filename), 0); - if (SCM_SUBSTRP (modes)) - modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_STRING_LENGTH (modes), 0); - - file = SCM_ROCHARS (filename); - mode = SCM_ROCHARS (modes); + SCM_VALIDATE_STRING (1, filename); + SCM_VALIDATE_STRING (2, modes); + SCM_STRING_COERCE_0TERMINATION_X (filename); + SCM_STRING_COERCE_0TERMINATION_X (modes); + + file = SCM_STRING_CHARS (filename); + mode = SCM_STRING_CHARS (modes); switch (*mode) { diff --git a/libguile/ioext.c b/libguile/ioext.c index c6d49d7f1..9cb84560e 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -93,8 +93,8 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0, char *cdelims; int num_delims; - SCM_VALIDATE_ROSTRING_COPY (1,delims,cdelims); - num_delims = SCM_ROLENGTH (delims); + SCM_VALIDATE_STRING_COPY (1, delims, cdelims); + num_delims = SCM_STRING_LENGTH (delims); SCM_VALIDATE_STRING_COPY (2,buf,cbuf); cend = SCM_STRING_LENGTH (buf); if (SCM_UNBNDP (port)) @@ -457,10 +457,10 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0, #define FUNC_NAME s_scm_fdopen { SCM_VALIDATE_INUM (1,fdes); - SCM_VALIDATE_ROSTRING (2,modes); - SCM_COERCE_SUBSTR (modes); + SCM_VALIDATE_STRING (2, 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 diff --git a/libguile/load.c b/libguile/load.c index 06eacbd8f..ca84cc454 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -118,7 +118,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, #define FUNC_NAME s_scm_primitive_load { 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)), hook, "value of %load-hook is neither a procedure nor #f", FUNC_NAME); @@ -225,7 +225,7 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, "") #define FUNC_NAME s_scm_parse_path { - SCM_ASSERT (SCM_FALSEP (path) || (SCM_ROSTRINGP (path)), + SCM_ASSERT (SCM_FALSEP (path) || (SCM_STRINGP (path)), path, SCM_ARG1, FUNC_NAME); 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 */ SCM_VALIDATE_LIST (1,path); - SCM_VALIDATE_ROSTRING (2,filename); + SCM_VALIDATE_STRING (2, filename); if (SCM_UNBNDP (extensions)) extensions = SCM_EOL; else SCM_VALIDATE_LIST (3,extensions); 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_len >= 1 && filename_chars[0] == '/') @@ -294,14 +294,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, SCM walk; 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_ASSERT (SCM_ROSTRINGP (elt), elt, + SCM_ASSERT (SCM_STRINGP (elt), elt, "path is not a list of strings", FUNC_NAME); - if (SCM_ROLENGTH (elt) > max_path_len) - max_path_len = SCM_ROLENGTH (elt); + if (SCM_STRING_LENGTH (elt) > max_path_len) + max_path_len = SCM_STRING_LENGTH (elt); } } @@ -333,14 +333,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, SCM walk; 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_ASSERT (SCM_ROSTRINGP (elt), elt, + SCM_ASSERT (SCM_STRINGP (elt), elt, "extension list is not a list of strings", FUNC_NAME); - if (SCM_ROLENGTH (elt) > max_ext_len) - max_ext_len = SCM_ROLENGTH (elt); + if (SCM_STRING_LENGTH (elt) > max_ext_len) + 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 proper list of strings. */ - for (; SCM_NNULLP (path); path = SCM_CDR (path)) + for (; !SCM_NULLP (path); path = SCM_CDR (path)) { int len; SCM dir = SCM_CAR (path); SCM exts; /* Concatenate the path name and the filename. */ - len = SCM_ROLENGTH (dir); + len = SCM_STRING_LENGTH (dir); memcpy (buf, SCM_ROCHARS (dir), len); if (len >= 1 && buf[len - 1] != '/') 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 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); - int ext_len = SCM_ROLENGTH (ext); + int ext_len = SCM_STRING_LENGTH (ext); struct stat mode; /* 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 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", FUNC_NAME); @@ -441,13 +441,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, { SCM full_filename; - SCM_VALIDATE_ROSTRING (1,filename); + SCM_VALIDATE_STRING (1, filename); full_filename = scm_sys_search_load_path (filename); if (SCM_FALSEP (full_filename)) { - int absolute = (SCM_ROLENGTH (filename) >= 1 + int absolute = (SCM_STRING_LENGTH (filename) >= 1 && SCM_ROCHARS (filename)[0] == '/'); SCM_MISC_ERROR ((absolute ? "Unable to load file ~S" diff --git a/libguile/net_db.c b/libguile/net_db.c index 1df26f4f1..c29597979 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -95,10 +95,9 @@ SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0, { struct in_addr soka; - SCM_VALIDATE_ROSTRING (1,address); - if (SCM_SUBSTRP (address)) - address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); - if (inet_aton (SCM_ROCHARS (address), &soka) == 0) + SCM_VALIDATE_STRING (1, address); + SCM_STRING_COERCE_0TERMINATION_X (address); + if (inet_aton (SCM_STRING_CHARS (address), &soka) == 0) SCM_MISC_ERROR ("bad address", SCM_EOL); return scm_ulong2num (ntohl (soka.s_addr)); } @@ -277,10 +276,10 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (host)) + else if (SCM_STRINGP (host)) { - SCM_COERCE_SUBSTR (host); - entry = gethostbyname (SCM_ROCHARS (host)); + SCM_STRING_COERCE_0TERMINATION_X (host); + entry = gethostbyname (SCM_STRING_CHARS (host)); } else { @@ -351,10 +350,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (net)) + else if (SCM_STRINGP (net)) { - SCM_COERCE_SUBSTR (net); - entry = getnetbyname (SCM_ROCHARS (net)); + SCM_STRING_COERCE_0TERMINATION_X (net); + entry = getnetbyname (SCM_STRING_CHARS (net)); } else { @@ -403,10 +402,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (protocol)) + else if (SCM_STRINGP (protocol)) { - SCM_COERCE_SUBSTR (protocol); - entry = getprotobyname (SCM_ROCHARS (protocol)); + SCM_STRING_COERCE_0TERMINATION_X (protocol); + entry = getprotobyname (SCM_STRING_CHARS (protocol)); } else { @@ -468,17 +467,17 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, } return scm_return_entry (entry); } - SCM_VALIDATE_ROSTRING (2,protocol); - SCM_COERCE_SUBSTR (protocol); - if (SCM_ROSTRINGP (name)) + SCM_VALIDATE_STRING (2, protocol); + SCM_STRING_COERCE_0TERMINATION_X (protocol); + if (SCM_STRINGP (name)) { - SCM_COERCE_SUBSTR (name); - entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (protocol)); + SCM_STRING_COERCE_0TERMINATION_X (name); + entry = getservbyname (SCM_STRING_CHARS (name), SCM_STRING_CHARS (protocol)); } else { 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) SCM_SYSERROR_MSG("no such service ~A", diff --git a/libguile/numbers.c b/libguile/numbers.c index 7e6a79281..a1491b8b7 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2806,10 +2806,10 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, { SCM answer; int base; - SCM_VALIDATE_ROSTRING (1,string); + SCM_VALIDATE_STRING (1, string); SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base); answer = scm_istring2number (SCM_ROCHARS (string), - SCM_ROLENGTH (string), + SCM_STRING_LENGTH (string), base); return scm_return_first (answer, string); } diff --git a/libguile/ports.c b/libguile/ports.c index 84df7e5d6..fe7ea9003 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1163,7 +1163,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, if (SCM_UNBNDP (length)) { /* 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); 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 { - SCM_VALIDATE_ROSTRING (1,object); - SCM_COERCE_SUBSTR (object); - SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length)); + SCM_VALIDATE_STRING (1, object); + SCM_STRING_COERCE_0TERMINATION_X (object); + SCM_SYSCALL (rv = truncate (SCM_STRING_CHARS (object), c_length)); } if (rv == -1) 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}.") #define FUNC_NAME s_scm_sys_make_void_port { - SCM_VALIDATE_ROSTRING (1,mode); - SCM_COERCE_SUBSTR (mode); - return scm_void_port (SCM_ROCHARS (mode)); + SCM_VALIDATE_STRING (1, mode); + SCM_STRING_COERCE_0TERMINATION_X (mode); + return scm_void_port (SCM_STRING_CHARS (mode)); } #undef FUNC_NAME diff --git a/libguile/posix.c b/libguile/posix.c index 1782928a6..623ca2012 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -264,10 +264,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, } else { - SCM_VALIDATE_ROSTRING (1,user); - if (SCM_SUBSTRP (user)) - user = scm_makfromstr (SCM_ROCHARS (user), SCM_STRING_LENGTH (user), 0); - entry = getpwnam (SCM_ROCHARS (user)); + SCM_VALIDATE_STRING (1, user); + SCM_STRING_COERCE_0TERMINATION_X (user); + entry = getpwnam (SCM_STRING_CHARS (user)); } if (!entry) 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))); else { - SCM_VALIDATE_ROSTRING (1,name); - SCM_COERCE_SUBSTR (name); - SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name))); + SCM_VALIDATE_STRING (1, name); + SCM_STRING_COERCE_0TERMINATION_X (name); + SCM_SYSCALL (entry = getgrnam (SCM_STRING_CHARS (name))); } if (!entry) SCM_SYSERROR; @@ -802,35 +801,37 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0, #undef FUNC_NAME #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 ** -scm_convert_exec_args (SCM args, int pos, const char *subr) +scm_convert_exec_args (SCM args, int argn, const char *subr) { - char **execargv; - int num_args; + char **argv; + int argc; int i; - num_args = scm_ilength (args); - SCM_ASSERT (num_args >= 0, args, pos, subr); - execargv = (char **) - scm_must_malloc ((num_args + 1) * sizeof (char *), subr); + argc = scm_ilength (args); + SCM_ASSERT (argc >= 0, args, argn, subr); + argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr); for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) { + SCM arg = SCM_CAR (args); scm_sizet len; char *dst; char *src; - SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)), - SCM_CAR (args), SCM_ARGn, subr); - len = 1 + SCM_ROLENGTH (SCM_CAR (args)); - dst = (char *) scm_must_malloc ((long) len, subr); - src = SCM_ROCHARS (SCM_CAR (args)); - while (len--) - dst[len] = src[len]; - execargv[i] = dst; + + SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); + len = SCM_STRING_LENGTH (arg); + src = SCM_ROCHARS (arg); + dst = (char *) scm_must_malloc (len + 1, subr); + memcpy (dst, src, len); + dst[len] = 0; + argv[i] = dst; } - execargv[i] = 0; - return execargv; + argv[i] = 0; + return argv; } 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 { char **execargv; - SCM_VALIDATE_ROSTRING (1,filename); - SCM_COERCE_SUBSTR (filename); + SCM_VALIDATE_STRING (1, filename); + SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); - execv (SCM_ROCHARS (filename), execargv); + execv (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; @@ -868,10 +869,10 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1, #define FUNC_NAME s_scm_execlp { char **execargv; - SCM_VALIDATE_ROSTRING (1,filename); - SCM_COERCE_SUBSTR (filename); + SCM_VALIDATE_STRING (1, filename); + SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); - execvp (SCM_ROCHARS (filename), execargv); + execvp (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; @@ -883,30 +884,27 @@ environ_list_to_c (SCM envlist, int arg, const char *proc) { int num_strings; char **result; - int i = 0; + int i; - SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist), - envlist, arg, proc); num_strings = scm_ilength (envlist); + SCM_ASSERT (num_strings >= 0, envlist, arg, proc); result = (char **) malloc ((num_strings + 1) * sizeof (char *)); if (result == NULL) 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; char *src; - SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (envlist)), - envlist, arg, proc); - len = 1 + SCM_ROLENGTH (SCM_CAR (envlist)); - result[i] = malloc ((long) len); + SCM_ASSERT (SCM_STRINGP (str), envlist, arg, proc); + len = SCM_STRING_LENGTH (str); + src = SCM_ROCHARS (str); + result[i] = malloc (len + 1); if (result[i] == NULL) scm_memory_error (proc); - src = SCM_ROCHARS (SCM_CAR (envlist)); - while (len--) - result[i][len] = src[len]; - envlist = SCM_CDR (envlist); - i++; + memcpy (result[i], src, len); + result[i][len] = 0; } result[i] = 0; return result; @@ -924,12 +922,12 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1, char **execargv; char **exec_env; - SCM_VALIDATE_ROSTRING (1,filename); - SCM_COERCE_SUBSTR (filename); + SCM_VALIDATE_STRING (1, filename); + SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG1, 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; /* not reached. */ return SCM_BOOL_F; @@ -1052,8 +1050,8 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0, int rv; struct utimbuf utm_tmp; - SCM_VALIDATE_ROSTRING (1,pathname); - SCM_COERCE_SUBSTR (pathname); + SCM_VALIDATE_STRING (1, pathname); + SCM_STRING_COERCE_0TERMINATION_X (pathname); if (SCM_UNBNDP (actime)) SCM_SYSCALL (time (&utm_tmp.actime)); else @@ -1064,7 +1062,7 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0, else 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) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -1100,11 +1098,10 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0, { int rv; - SCM_VALIDATE_ROSTRING (1,path); - if (SCM_SUBSTRP (path)) - path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0); - SCM_VALIDATE_INUM (2,how); - rv = access (SCM_ROCHARS (path), SCM_INUM (how)); + SCM_VALIDATE_STRING (1, path); + SCM_STRING_COERCE_0TERMINATION_X (path); + SCM_VALIDATE_INUM (2, how); + rv = access (SCM_STRING_CHARS (path), SCM_INUM (how)); return SCM_NEGATE_BOOL(rv); } #undef FUNC_NAME @@ -1172,9 +1169,9 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, } else { - SCM_VALIDATE_ROSTRING (2,locale); - SCM_COERCE_SUBSTR (locale); - clocale = SCM_ROCHARS (locale); + SCM_VALIDATE_STRING (2, locale); + SCM_STRING_COERCE_0TERMINATION_X (locale); + clocale = SCM_STRING_CHARS (locale); } rv = setlocale (SCM_INUM (category), clocale); @@ -1207,11 +1204,11 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, char *p; int ctype = 0; - SCM_VALIDATE_ROSTRING (1,path); + SCM_VALIDATE_STRING (1, path); SCM_VALIDATE_SYMBOL (2,type); SCM_VALIDATE_INUM (3,perms); SCM_VALIDATE_INUM (4,dev); - SCM_COERCE_SUBSTR (path); + SCM_STRING_COERCE_0TERMINATION_X (path); p = SCM_SYMBOL_CHARS (type); if (strcmp (p, "regular") == 0) @@ -1233,8 +1230,8 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, else SCM_OUT_OF_RANGE (2,type); - SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms), - SCM_INUM (dev))); + SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms), + SCM_INUM (dev))); if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index d706bd6ba..9c79e23c5 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -184,9 +184,9 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, regex_t *rx; int status, cflags; - SCM_VALIDATE_ROSTRING (1,pat); + SCM_VALIDATE_STRING (1, pat); 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 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); - status = regcomp (rx, SCM_ROCHARS (pat), + status = regcomp (rx, SCM_STRING_CHARS (pat), /* Make sure they're not passing REG_NOSUB; regexp-exec assumes we're getting match data. */ cflags & ~REG_NOSUB); @@ -232,13 +232,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, SCM mvec = SCM_BOOL_F; 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_ASSERT_RANGE (3,start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); if (SCM_UNBNDP (flags)) flags = SCM_INUM0; 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 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; SCM_DEFER_INTS; 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, SCM_INUM (flags)); if (!status) diff --git a/libguile/simpos.c b/libguile/simpos.c index f8f1ab940..d21c81d7e 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -82,12 +82,11 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, rv = system (NULL); return SCM_BOOL(rv); } - SCM_VALIDATE_ROSTRING (1,cmd); + SCM_VALIDATE_STRING (1, cmd); SCM_DEFER_INTS; errno = 0; - if (SCM_SUBSTRP (cmd)) - cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_STRING_LENGTH (cmd), 0); - rv = system(SCM_ROCHARS(cmd)); + SCM_STRING_COERCE_0TERMINATION_X (cmd); + rv = system (SCM_STRING_CHARS (cmd)); if (rv == -1 || (rv == 127 && errno != 0)) SCM_SYSERROR; SCM_ALLOW_INTS; @@ -105,8 +104,8 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, #define FUNC_NAME s_scm_getenv { char *val; - SCM_VALIDATE_ROSTRING (1,nam); - nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0); + SCM_VALIDATE_STRING (1, nam); + SCM_STRING_COERCE_0TERMINATION_X (nam); val = getenv (SCM_STRING_CHARS (nam)); return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val), 0) : SCM_BOOL_F; } diff --git a/libguile/socket.c b/libguile/socket.c index 0a7f2937f..ae799d963 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -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); memset (soka, 0, sizeof (struct sockaddr_un)); soka->sun_family = AF_UNIX; - SCM_ASSERT (SCM_ROSTRINGP (address), address, - which_arg, proc); + SCM_ASSERT (SCM_STRINGP (address), address, which_arg, proc); memcpy (soka->sun_path, SCM_ROCHARS (address), - 1 + SCM_ROLENGTH (address)); + 1 + SCM_STRING_LENGTH (address)); *size = sizeof (struct sockaddr_un); return (struct sockaddr *) soka; } @@ -735,11 +734,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0, sock = SCM_COERCE_OUTPORT (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); 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) SCM_SYSERROR; return SCM_MAKINUM (rv); @@ -845,7 +844,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, sock = SCM_COERCE_OUTPORT (sock); SCM_VALIDATE_FPORT (1,sock); - SCM_VALIDATE_ROSTRING (2,message); + SCM_VALIDATE_STRING (2, message); SCM_VALIDATE_INUM (3,fam); fd = SCM_FPORT_FDES (sock); 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); 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)); save_err = errno; scm_must_free ((char *) soka); diff --git a/libguile/stime.c b/libguile/stime.c index 6e99a008c..19c428dec 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -307,9 +307,9 @@ setzone (SCM zone, int pos, const char *subr) char *buf; 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); - sprintf (buf, "%s=%s", tzvar, SCM_ROCHARS (zone)); + sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone)); oldenv = environ; tmpenv[0] = buf; tmpenv[1] = 0; @@ -573,12 +573,12 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, int len; SCM result; - SCM_VALIDATE_ROSTRING (1,format); + SCM_VALIDATE_STRING (1, format); bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME); - SCM_COERCE_SUBSTR (format); - fmt = SCM_ROCHARS (format); - len = SCM_ROLENGTH (format); + SCM_STRING_COERCE_0TERMINATION_X (format); + fmt = SCM_STRING_CHARS (format); + len = SCM_STRING_LENGTH (format); /* Ugly hack: strftime can return 0 if its buffer is too small, 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; char *fmt, *str, *rest; - SCM_VALIDATE_ROSTRING (1,format); - SCM_VALIDATE_ROSTRING (2,string); + SCM_VALIDATE_STRING (1, format); + SCM_VALIDATE_STRING (2, string); - SCM_COERCE_SUBSTR (format); - SCM_COERCE_SUBSTR (string); - fmt = SCM_ROCHARS (format); - str = SCM_ROCHARS (string); + SCM_STRING_COERCE_0TERMINATION_X (format); + SCM_STRING_COERCE_0TERMINATION_X (string); + fmt = SCM_STRING_CHARS (format); + str = SCM_STRING_CHARS (string); /* initialize the struct tm */ #define tm_init(field) t.field = 0 diff --git a/libguile/strop.c b/libguile/strop.c index cc8b53933..1ecf4258c 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -61,7 +61,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, int upper; 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); 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); lower = SCM_INUM (sub_start); - if (lower < 0 - || lower > SCM_ROLENGTH (*str)) + if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) scm_out_of_range (why, sub_start); 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); upper = SCM_INUM (sub_end); - if (upper < SCM_INUM (sub_start) - || upper > SCM_ROLENGTH (*str)) + if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str)) scm_out_of_range (why, sub_end); if (direction > 0) @@ -309,8 +307,8 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, "@end example") #define FUNC_NAME s_scm_string_null_p { - SCM_VALIDATE_ROSTRING (1,str); - return SCM_NEGATE_BOOL(SCM_ROLENGTH (str)); + SCM_VALIDATE_STRING (1,str); + return SCM_NEGATE_BOOL (SCM_STRING_LENGTH (str)); } #undef FUNC_NAME @@ -328,9 +326,9 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, long i; SCM res = SCM_EOL; unsigned char *src; - SCM_VALIDATE_ROSTRING (1,str); + SCM_VALIDATE_STRING (1,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; } #undef FUNC_NAME diff --git a/libguile/strports.c b/libguile/strports.c index 274008684..8717e9843 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -270,8 +270,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) int str_len; SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller); - SCM_ASSERT (SCM_ROSTRINGP(str), str, SCM_ARG1, caller); - str_len = SCM_ROLENGTH (str); + SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG1, caller); + str_len = SCM_STRING_LENGTH (str); if (SCM_INUM (pos) > str_len) scm_out_of_range (caller, pos); if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) diff --git a/libguile/symbols.c b/libguile/symbols.c index 65679fe8a..56a4cd9ca 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -524,7 +524,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, SCM answer; 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); 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; vcell = scm_intern_obarray_soft (SCM_ROCHARS(s), - (scm_sizet)SCM_ROLENGTH(s), + SCM_STRING_LENGTH (s), o, softness); if (SCM_FALSEP (vcell)) diff --git a/libguile/symbols.h b/libguile/symbols.h index 3331bd63c..e742f18b5 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -62,7 +62,6 @@ extern int scm_symhash_dim; #define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #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_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_STRING_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_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (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)) #endif /* SCM_DEBUG_DEPRECATED == 0 */ diff --git a/libguile/unif.h b/libguile/unif.h index 5fce7b467..932ceec82 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -93,14 +93,6 @@ extern long scm_tc16_array; #define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #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); @@ -140,6 +132,19 @@ extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate); extern SCM scm_array_prototype (SCM ra); 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 */ /* diff --git a/libguile/validate.h b/libguile/validate.h index 4115c8200..e80f5708a 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -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. * * This program is free software; you can redistribute it and/or modify @@ -124,24 +124,6 @@ cvar = SCM_CHAR (scm); \ } 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_COPY(pos, str, cvar) \ @@ -416,6 +398,24 @@ #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 diff --git a/libguile/vports.c b/libguile/vports.c index d36888606..877da5c40 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -182,13 +182,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, scm_port *pt; SCM z; SCM_VALIDATE_VECTOR_LEN (1,pv,5); - SCM_VALIDATE_ROSTRING (2,modes); - SCM_COERCE_SUBSTR (modes); + SCM_VALIDATE_STRING (2, modes); + SCM_STRING_COERCE_0TERMINATION_X (modes); SCM_NEWCELL (z); SCM_DEFER_INTS; pt = scm_add_to_port_table (z); 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_SETSTREAM (z, SCM_UNPACK (pv)); SCM_ALLOW_INTS; |