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

* stime.c, socket.c, simpos.c, procs.c, posix.c, ports.c,

Browse source 
net_db.c, fports.c, filesys.c, eval.c, deprecation.c, dynl.c:
Replaced uses of SCM_STRING_CHARS with proper uses of
scm_to_locale_string.  Replaced SCM_STRINGP with scm_is_string.
Replaced scm_mem2string with scm_from_locale_string.

* simpos.c, posix.c (allocate_string_pointers, environ_list_to_c):
Removed, replaced all uses with scm_i_allocate_string_pointers.
This commit is contained in:
Marius Vollmer 2004-08-10 14:08:02 +00:00
parent 02573e4c7a
commit 7f9994d904
11 changed files with 152 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/deprecation.c
View file

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

67
libguile/dynl.c
View file

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

2
libguile/eval.c
View file

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

9
libguile/filesys.c
View file

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

16
libguile/fports.c
View file

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

76
libguile/net_db.c
View file

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

16
libguile/ports.c
View file

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

2
libguile/procs.c
View file

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

61
libguile/simpos.c
View file

@ -33,6 +33,7 @@
#include "libguile/validate.h"
#include "libguile/simpos.h"
#include "libguile/dynwind.h"
#ifdef HAVE_STRING_H
#include <string.h>
@ -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

17
libguile/socket.c
View file

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

14
libguile/stime.c
View file

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