diff --git a/libguile/deprecation.c b/libguile/deprecation.c index 2c7d2a413..3d4852a2f 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -105,6 +105,7 @@ SCM_DEFINE(scm_issue_deprecation_warning, { SCM nl = scm_str2string ("\n"); SCM msgs_nl = SCM_EOL; + char *c_msgs; while (SCM_CONSP (msgs)) { if (msgs_nl != SCM_EOL) @@ -113,8 +114,9 @@ SCM_DEFINE(scm_issue_deprecation_warning, msgs = SCM_CDR (msgs); } msgs_nl = scm_string_append (scm_reverse_x (msgs_nl, SCM_EOL)); - scm_c_issue_deprecation_warning (SCM_STRING_CHARS (msgs_nl)); - scm_remember_upto_here_1 (msgs_nl); + c_msgs = scm_to_locale_string (msgs_nl); + scm_c_issue_deprecation_warning (c_msgs); + free (c_msgs); } return SCM_UNSPECIFIED; } diff --git a/libguile/dynl.c b/libguile/dynl.c index 76380de4d..99c6dc837 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -51,6 +51,7 @@ maybe_drag_in_eprintf () #include "libguile/deprecation.h" #include "libguile/lang.h" #include "libguile/validate.h" +#include "libguile/dynwind.h" #include "guile-ltdl.h" @@ -149,9 +150,13 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, #define FUNC_NAME s_scm_dynamic_link { void *handle; + char *file; - SCM_VALIDATE_STRING (1, filename); - handle = sysdep_dynl_link (SCM_STRING_CHARS (filename), FUNC_NAME); + scm_frame_begin (0); + file = scm_to_locale_string (filename); + scm_frame_free (file); + handle = sysdep_dynl_link (file, FUNC_NAME); + scm_frame_end (); SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle); } #undef FUNC_NAME @@ -216,9 +221,12 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, } else { char *chars; - chars = SCM_STRING_CHARS (name); + scm_frame_begin (0); + chars = scm_to_locale_string (name); + scm_frame_free (chars); func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); + scm_frame_end (); return scm_from_ulong ((unsigned long) func); } } @@ -247,41 +255,18 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, { void (*fptr) (); - if (SCM_STRINGP (func)) + if (scm_is_string (func)) func = scm_dynamic_func (func, dobj); - fptr = (void (*) ()) SCM_NUM2ULONG (1, func); + fptr = (void (*) ()) scm_to_ulong (func); fptr (); return SCM_UNSPECIFIED; } #undef FUNC_NAME -/* return a newly allocated array of char pointers to each of the strings - in args, with a terminating NULL pointer. */ -/* Note: a similar function is defined in posix.c, but we don't necessarily - want to export it. */ -static char **allocate_string_pointers (SCM args, int *num_args_return) +static void +free_string_pointers (void *data) { - char **result; - int n_args = scm_ilength (args); - int i; - - SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); - result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); - result[n_args] = NULL; - for (i = 0; i < n_args; i++) - { - SCM car = SCM_CAR (args); - - if (!SCM_STRINGP (car)) - { - free (result); - scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); - } - result[i] = SCM_STRING_CHARS (SCM_CAR (args)); - args = SCM_CDR (args); - } - *num_args_return = n_args; - return result; + scm_i_free_string_pointers ((char **)data); } SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, @@ -304,17 +289,21 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, int result, argc; char **argv; - if (SCM_STRINGP (func)) + scm_frame_begin (0); + + if (scm_is_string (func)) func = scm_dynamic_func (func, dobj); - fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); - argv = allocate_string_pointers (args, &argc); - /* if the procedure mutates its arguments, the original strings will be - changed -- in Guile 1.6 and earlier, this wasn't the case since a - new copy of each string was allocated. */ - result = (*fptr) (argc, argv); - free (argv); + fptr = (int (*) (int, char **)) scm_to_ulong (func); + argv = scm_i_allocate_string_pointers (args); + scm_frame_unwind_handler (free_string_pointers, argv, + SCM_F_WIND_EXPLICITLY); + for (argc = 0; argv[argc]; argc++) + ; + result = (*fptr) (argc, argv); + + scm_frame_end (); return scm_from_int (result); } #undef FUNC_NAME diff --git a/libguile/eval.c b/libguile/eval.c index 18db8906c..d8dfc9e70 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1480,7 +1480,7 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED) * the documentation string will have to be skipped with every execution * of the closure. */ cddr_expr = SCM_CDR (cdr_expr); - documentation = (length >= 3 && SCM_STRINGP (SCM_CAR (cddr_expr))); + documentation = (length >= 3 && scm_is_string (SCM_CAR (cddr_expr))); body = documentation ? SCM_CDR (cddr_expr) : cddr_expr; new_body = m_body (SCM_IM_LAMBDA, body); diff --git a/libguile/filesys.c b/libguile/filesys.c index 29c86883e..459f5530c 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -610,18 +610,17 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0, SCM_SYSCALL (rv = fstat (scm_to_int (object), &stat_temp)); #endif } - else if (SCM_STRINGP (object)) + else if (scm_is_string (object)) { + char *file = scm_to_locale_string (object); #ifdef __MINGW32__ - char *p, *file = strdup (SCM_STRING_CHARS (object)); + char *p; p = file + strlen (file) - 1; while (p > file && (*p == '/' || *p == '\\')) *p-- = '\0'; +#endif SCM_SYSCALL (rv = stat (file, &stat_temp)); free (file); -#else - SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp)); -#endif } else { diff --git a/libguile/fports.c b/libguile/fports.c index cb824db17..6b462e03e 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -27,6 +27,7 @@ #include "libguile/strings.h" #include "libguile/validate.h" #include "libguile/gc.h" +#include "libguile/dynwind.h" #include "libguile/fports.h" @@ -289,11 +290,13 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, char *md; char *ptr; - SCM_VALIDATE_STRING (1, filename); - SCM_VALIDATE_STRING (2, mode); + scm_frame_begin (0); - file = SCM_STRING_CHARS (filename); - md = SCM_STRING_CHARS (mode); + file = scm_to_locale_string (filename); + scm_frame_free (file); + + md = scm_to_locale_string (mode); + scm_frame_free (md); switch (*md) { @@ -340,6 +343,9 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, scm_cons (filename, SCM_EOL)), en); } port = scm_fdes_to_port (fdes, md, filename); + + scm_frame_end (); + return port; } #undef FUNC_NAME @@ -489,7 +495,7 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { int fdes; SCM name = SCM_FILENAME (exp); - if (SCM_STRINGP (name) || SCM_SYMBOLP (name)) + if (scm_is_string (name) || SCM_SYMBOLP (name)) scm_display (name, port); else scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); diff --git a/libguile/net_db.c b/libguile/net_db.c index 539599189..41f05a9d7 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -35,6 +35,7 @@ #include "libguile/feature.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/dynwind.h" #include "libguile/validate.h" #include "libguile/net_db.h" @@ -139,6 +140,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, struct in_addr inad; char **argv; int i = 0; + if (SCM_UNBNDP (host)) { #ifdef HAVE_GETHOSTENT @@ -157,15 +159,18 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_STRINGP (host)) + else if (scm_is_string (host)) { - entry = gethostbyname (SCM_STRING_CHARS (host)); + char *str = scm_to_locale_string (host); + entry = gethostbyname (str); + free (str); } else { - inad.s_addr = htonl (SCM_NUM2ULONG (1, host)); + inad.s_addr = htonl (scm_to_ulong (host)); entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET); } + if (!entry) scm_resolv_error (FUNC_NAME, host); @@ -211,8 +216,9 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, "given.") #define FUNC_NAME s_scm_getnet { - SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); struct netent *entry; + int eno; if (SCM_UNBNDP (net)) { @@ -225,18 +231,23 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_STRINGP (net)) + else if (scm_is_string (net)) { - entry = getnetbyname (SCM_STRING_CHARS (net)); + char *str = scm_to_locale_string (net); + entry = getnetbyname (str); + eno = errno; + free (str); } else { - unsigned long netnum; - netnum = SCM_NUM2ULONG (1, net); + unsigned long netnum = scm_to_ulong (net); entry = getnetbyaddr (netnum, AF_INET); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); + SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno); + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype)); @@ -257,9 +268,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, "@code{getprotoent} (see below) if no arguments are supplied.") #define FUNC_NAME s_scm_getproto { - SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED); - + SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED); struct protoent *entry; + int eno; + if (SCM_UNBNDP (protocol)) { entry = getprotoent (); @@ -271,18 +283,23 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_STRINGP (protocol)) + else if (scm_is_string (protocol)) { - entry = getprotobyname (SCM_STRING_CHARS (protocol)); + char *str = scm_to_locale_string (protocol); + entry = getprotobyname (str); + eno = errno; + free (str); } else { - unsigned long protonum; - protonum = SCM_NUM2ULONG (1, protocol); + unsigned long protonum = scm_to_ulong (protocol); entry = getprotobynumber (protonum); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); + SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno); + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto)); @@ -318,6 +335,9 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, #define FUNC_NAME s_scm_getserv { struct servent *entry; + char *protoname; + int eno; + if (SCM_UNBNDP (name)) { entry = getservent (); @@ -330,19 +350,29 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, } return scm_return_entry (entry); } - SCM_VALIDATE_STRING (2, protocol); - if (SCM_STRINGP (name)) + + scm_frame_begin (0); + + protoname = scm_to_locale_string (protocol); + scm_frame_free (protoname); + + if (scm_is_string (name)) { - entry = getservbyname (SCM_STRING_CHARS (name), - SCM_STRING_CHARS (protocol)); + char *str = scm_to_locale_string (name); + entry = getservbyname (str, protoname); + eno = errno; + free (str); } else { - entry = getservbyport (htons (scm_to_int (name)), - SCM_STRING_CHARS (protocol)); + entry = getservbyport (htons (scm_to_int (name)), protoname); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), errno); + SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), eno); + + scm_frame_end (); return scm_return_entry (entry); } #undef FUNC_NAME diff --git a/libguile/ports.c b/libguile/ports.c index 101244d84..02d72b448 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1397,7 +1397,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, "@var{length} bytes. @var{object} can be a string containing a\n" "file name or an integer file descriptor or a port.\n" "@var{length} may be omitted if @var{object} is not a file name,\n" - "in which case the truncation occurs at the current port.\n" + "in which case the truncation occurs at the current port\n" "position. The return value is unspecified.") #define FUNC_NAME s_scm_truncate_file { @@ -1409,14 +1409,12 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, if (SCM_UNBNDP (length)) { /* must supply length if object is a filename. */ - if (SCM_STRINGP (object)) + if (scm_is_string (object)) SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL); length = scm_seek (object, SCM_INUM0, scm_from_int (SEEK_CUR)); } - c_length = SCM_NUM2LONG (2, length); - if (c_length < 0) - SCM_MISC_ERROR ("negative offset", SCM_EOL); + c_length = scm_to_size_t (length); object = SCM_COERCE_OUTPORT (object); if (scm_is_integer (object)) @@ -1440,8 +1438,12 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, } else { - SCM_VALIDATE_STRING (1, object); - SCM_SYSCALL (rv = truncate (SCM_STRING_CHARS (object), c_length)); + char *str = scm_to_locale_string (object); + int eno; + SCM_SYSCALL (rv = truncate (str, c_length)); + eno = errno; + free (str); + errno = eno; } if (rv == -1) SCM_SYSERROR; diff --git a/libguile/procs.c b/libguile/procs.c index a03ef8bb3..a625b6e30 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -258,7 +258,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, if (SCM_NULLP (SCM_CDR (code))) return SCM_BOOL_F; code = SCM_CAR (code); - if (SCM_STRINGP (code)) + if (scm_is_string (code)) return code; else return SCM_BOOL_F; diff --git a/libguile/simpos.c b/libguile/simpos.c index a35de86dc..ff4637d61 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -33,6 +33,7 @@ #include "libguile/validate.h" #include "libguile/simpos.h" +#include "libguile/dynwind.h" #ifdef HAVE_STRING_H #include @@ -84,33 +85,10 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, #ifdef HAVE_SYSTEM #ifdef HAVE_WAITPID -/* return a newly allocated array of char pointers to each of the strings - in args, with a terminating NULL pointer. */ -/* Note: a similar function is defined in dynl.c, but we don't necessarily - want to export it. */ -static char ** -allocate_string_pointers (SCM args) +static void +free_string_pointers (void *data) { - char **result; - int n_args = scm_ilength (args); - int i; - - SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); - result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); - result[n_args] = NULL; - for (i = 0; i < n_args; i++) - { - SCM car = SCM_CAR (args); - - if (!SCM_STRINGP (car)) - { - free (result); - scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); - } - result[i] = SCM_STRING_CHARS (SCM_CAR (args)); - args = SCM_CDR (args); - } - return result; + scm_i_free_string_pointers ((char **)data); } SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, @@ -146,9 +124,12 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, int pid; char **execargv; - SCM_VALIDATE_STRING (1, SCM_CAR (args)); + scm_frame_begin (0); + /* allocate before fork */ - execargv = allocate_string_pointers (args); + execargv = scm_i_allocate_string_pointers (args); + scm_frame_unwind_handler (free_string_pointers, execargv, + SCM_F_WIND_EXPLICITLY); /* make sure the child can't kill us (as per normal system call) */ sig_ign = scm_from_long ((unsigned long) SIG_IGN); @@ -161,33 +142,32 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, if (pid == 0) { /* child */ - execvp (SCM_STRING_CHARS (SCM_CAR (args)), execargv); - scm_remember_upto_here_1 (args); + execvp (execargv[0], execargv); SCM_SYSERROR; /* not reached. */ + scm_frame_end (); return SCM_BOOL_F; } else { /* parent */ - int wait_result, status, save_errno; + int wait_result, status; - save_errno = errno; - free (execargv); - errno = save_errno; if (pid == -1) SCM_SYSERROR; SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); - if (wait_result == -1) SCM_SYSERROR; + if (wait_result == -1) + SCM_SYSERROR; scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); - scm_remember_upto_here_2 (oldint, oldquit); + + scm_frame_end (); return scm_from_int (status); } } else - SCM_WRONG_TYPE_ARG (1, SCM_CAR (args)); + SCM_WRONG_TYPE_ARG (1, args); } #undef FUNC_NAME #endif /* HAVE_WAITPID */ @@ -202,9 +182,10 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, #define FUNC_NAME s_scm_getenv { char *val; - SCM_VALIDATE_STRING (1, nam); - val = getenv (SCM_STRING_CHARS (nam)); - return val ? scm_mem2string (val, strlen (val)) : SCM_BOOL_F; + char *var = scm_to_locale_string (nam); + val = getenv (var); + free (var); + return val ? scm_from_locale_string (val) : SCM_BOOL_F; } #undef FUNC_NAME diff --git a/libguile/socket.c b/libguile/socket.c index 2761964ea..7135be618 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -31,6 +31,7 @@ #include "libguile/fports.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/dynwind.h" #include "libguile/validate.h" #include "libguile/socket.h" @@ -782,8 +783,13 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, { struct sockaddr_un *soka; int addr_size; + char *c_address; + + scm_frame_begin (0); + + c_address = scm_to_locale_string (address); + scm_frame_free (c_address); - SCM_ASSERT (SCM_STRINGP (address), address, which_arg, proc); /* the static buffer size in sockaddr_un seems to be arbitrary and not necessarily a hard limit. e.g., the glibc manual suggests it may be possible to declare it size 0. let's @@ -791,15 +797,14 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, connect/bind etc., to fail. sun_path is always the last member of the structure. */ addr_size = sizeof (struct sockaddr_un) - + max (0, SCM_STRING_LENGTH (address) + 1 - (sizeof soka->sun_path)); + + max (0, strlen (c_address) + 1 - (sizeof soka->sun_path)); soka = (struct sockaddr_un *) scm_malloc (addr_size); - if (!soka) - scm_memory_error (proc); memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */ soka->sun_family = AF_UNIX; - memcpy (soka->sun_path, SCM_STRING_CHARS (address), - SCM_STRING_LENGTH (address)); + strcpy (soka->sun_path, c_address); *size = SUN_LEN (soka); + + scm_frame_end (); return (struct sockaddr *) soka; } #endif diff --git a/libguile/stime.c b/libguile/stime.c index c237ae7fb..f08ae28b5 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -293,10 +293,14 @@ setzone (SCM zone, int pos, const char *subr) { static char *tmpenv[2]; char *buf; - - SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr); - buf = scm_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1); - sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone)); + size_t zone_len; + + zone_len = scm_to_locale_stringbuf (zone, NULL, 0); + buf = scm_malloc (zone_len + sizeof (tzvar) + 1); + strcpy (buf, tzvar); + buf[sizeof(tzvar)-1] = '='; + scm_to_locale_stringbuf (zone, buf+sizeof(tzvar), zone_len); + buf[sizeof(tzvar)+zone_len] = '\0'; oldenv = environ; tmpenv[0] = buf; tmpenv[1] = 0; @@ -459,7 +463,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) { SCM_ASSERT (scm_is_integer (velts[i]), sbd_time, pos, subr); } - SCM_ASSERT (scm_is_false (velts[10]) || SCM_STRINGP (velts[10]), + SCM_ASSERT (scm_is_false (velts[10]) || scm_is_string (velts[10]), sbd_time, pos, subr); lt->tm_sec = scm_to_int (velts[0]);