mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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
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

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_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])

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

80
libguile/dynl.c
View file

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

32
libguile/error.c
View file

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

124
libguile/filesys.c
View file

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

14
libguile/fports.c
View file

@ -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);
SCM_VALIDATE_STRING (1, filename);
SCM_VALIDATE_STRING (2, modes);
SCM_STRING_COERCE_0TERMINATION_X (filename);
SCM_STRING_COERCE_0TERMINATION_X (modes);
file = SCM_ROCHARS (filename);
mode = SCM_ROCHARS (modes);
file = SCM_STRING_CHARS (filename);
mode = SCM_STRING_CHARS (modes);
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;
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

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
{
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"

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;
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",

4
libguile/numbers.c
View file

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

14
libguile/ports.c
View file

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

121
libguile/posix.c
View file

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

12
libguile/regex-posix.c
View file

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

11
libguile/simpos.c
View file

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

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

24
libguile/stime.c
View file

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

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

4
libguile/strports.c
View file

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

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

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_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 */

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_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 */
/*

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

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