diff options
-rw-r--r-- | libguile/ChangeLog | 44 | ||||
-rw-r--r-- | libguile/Makefile.am | 7 | ||||
-rw-r--r-- | libguile/Makefile.in | 11 | ||||
-rw-r--r-- | libguile/__scm.h | 4 | ||||
-rwxr-xr-x | libguile/configure | 12 | ||||
-rw-r--r-- | libguile/configure.in | 10 | ||||
-rw-r--r-- | libguile/ioext.c | 96 | ||||
-rw-r--r-- | libguile/ioext.h | 7 | ||||
-rw-r--r-- | libguile/ports.c | 5 | ||||
-rw-r--r-- | libguile/posix.c | 114 | ||||
-rw-r--r-- | libguile/posix.h | 5 | ||||
-rw-r--r-- | libguile/socket.c | 136 | ||||
-rw-r--r-- | libguile/socket.h | 4 | ||||
-rw-r--r-- | libguile/unif.c | 111 | ||||
-rw-r--r-- | libguile/unif.h | 4 |
15 files changed, 272 insertions, 298 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9d45b216e..3ae17c4b6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,47 @@ +Fri Jan 24 06:16:32 1997 Gary Houston <ghouston@actrix.gen.nz> + + * ports.c: add SCM_PROC declarations for pt-size and pt-member. + + * Makefile.am: remove AWK=@AWK@. + Add a rule for generating errnos.list. + (CLEANFILES): put errnos.list here instead of in DISTCLEANFILES. + + * configure.in: add AC_SUBST(AWK) and AC_SUBST(ERRNO_EXTRACT). + don't extract errnos, just set a variable (avoids the + need to recompile error.c just because configure is run.) + + * unif.h: update prototypes. + * unif.c (scm_uniform_array_read,write): change the offset and + length arguments to start and end, for consistency. + + * __scm.h: uncomment SCM_ARG6 and SCM_ARG7, I needed SCM_ARG6. + + * ioext.h: update prototypes. +* * ioext.c (scm_read_delimited_x): replaces scm_read_line and + scm_read_line_x, it's a more general procedure using an + interface from scsh. read-line and read-line! are now defined + in boot-9.scm. +* Note that the new read-line trims the terminator + by default, previously it was appended to the returned string. An + optional argument specifies how to process the terminator (scsh + compatible). For the old behaviour: (read-line port 'concat). + scm_read_line, scm_read_line_x: deleted. (read-line port 'split) + returns a pair, but is converted to multiple values if the scsh + module is loaded. + + socket.h: update prototypes. + * socket.c (scm_recvfrom): for consistency with other procedures, + take start and end as separate optional arguments. +* (scm_recv, scm_recvfrom): don't allow the second argument + to be a size, only a buffer. Change the scheme names to + recv! and recvfrom!. Don't return the buffer. + + * ioext.h, posix.h: move prototypes too. + * ioext.c, posix.c (scm_read_line, scm_read_line_x, scm_write_line: + moved back from posix.c to ioext.c. Also move #includes of "genio.h" + "read.h" and "unif.h". + * ioext.c: include "chars.h" + Mon Jan 20 19:54:49 1997 Marius Vollmer <mvo@zagadka.ping.de> * dynl.c: The dynamic linking and module registration functions diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 7459322a0..d28436780 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -2,7 +2,6 @@ AUTOMAKE_OPTIONS = foreign -AWK=@AWK@ ## Check for headers in $(srcdir)/.., so that #include ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're ## building. @@ -69,8 +68,10 @@ dynl.o dynl.lo: dynl.x ## Add -MG to make the .x magic work with auto-dep code. MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +errnos.list: $(srcdir)/errnos.default + $(ERRNO_EXTRACT) + errnos.c: errnos.list $(AWK) -f $(srcdir)/errnos_cnvt.awk < errnos.list > errnos.c -CLEANFILES=errnos.c -DISTCLEANFILES=errnos.list +CLEANFILES=errnos.c errnos.list diff --git a/libguile/Makefile.in b/libguile/Makefile.in index 91de7acff..fd91de489 100644 --- a/libguile/Makefile.in +++ b/libguile/Makefile.in @@ -39,19 +39,20 @@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ transform = @program_transform_name@ host_triplet = @host@ host_alias = @host_alias@ +ERRNO_EXTRACT = @ERRNO_EXTRACT@ FD_SETTER = @FD_SETTER@ +AWK = @AWK@ LIBTOOL = @LIBTOOL@ VERSION = @VERSION@ module = @module@ CC = @CC@ RANLIB = @RANLIB@ -xtra_PLUGIN_guile_libs = @xtra_PLUGIN_guile_libs@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ +xtra_PLUGIN_guile_libs = @xtra_PLUGIN_guile_libs@ PACKAGE = @PACKAGE@ AUTOMAKE_OPTIONS = foreign -AWK=@AWK@ INCLUDES = -I.. -I$(srcdir)/.. lib_PROGRAMS = libguile.la @@ -96,8 +97,7 @@ SUFFIXES = .x MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) -CLEANFILES=errnos.c -DISTCLEANFILES=errnos.list +CLEANFILES=errnos.c errnos.list ACLOCAL = $(top_srcdir)/aclocal.m4 CONFIG_HEADER_IN = scmconfig.h.in mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs @@ -494,6 +494,9 @@ libpath.h: Makefile dynl.o dynl.lo: dynl.x +errnos.list: $(srcdir)/errnos.default + $(ERRNO_EXTRACT) + errnos.c: errnos.list $(AWK) -f $(srcdir)/errnos_cnvt.awk < errnos.list > errnos.c diff --git a/libguile/__scm.h b/libguile/__scm.h index 22c2eaa38..52d175ead 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -353,8 +353,8 @@ extern unsigned int scm_async_clock; #define SCM_ARG3 3 #define SCM_ARG4 4 #define SCM_ARG5 5 - /* #define SCM_ARG6 6 - #define SCM_ARG7 7 */ +#define SCM_ARG6 6 +#define SCM_ARG7 7 /* #define SCM_ARGERR(X) ((X) < SCM_WNA \ ? (char *)(X) \ : "wrong type argument") diff --git a/libguile/configure b/libguile/configure index 3661f74c6..a1cb605df 100755 --- a/libguile/configure +++ b/libguile/configure @@ -2790,15 +2790,11 @@ done echo $ac_n "checking whether errno codes can be extracted from errno.h""... $ac_c" 1>&6 echo "configure:2793: checking whether errno codes can be extracted from errno.h" >&5 -goterrnos=0 if test "$GCC" = yes ; then - ${CC-cc} -undef -dM -E $srcdir/errnos_get.c | egrep ' E.+' | cut -f2 -d' ' > errnos.list - egrep '^E.+' errnos.list > /dev/null 2>&1 && goterrnos=1 -fi -if test $goterrnos = 1 ; then echo "$ac_t""yes" 1>&6 + ERRNO_EXTRACT="${CC-cc} -undef -dM -E $srcdir/errnos_get.c | egrep ' E.+' | cut -f2 -d' ' > errnos.list" else - cp $srcdir/errnos.default errnos.list + ERRNO_EXTRACT="cp $srcdir/errnos.default errnos.list" echo "$ac_t""no, using default" 1>&6 fi @@ -2816,6 +2812,8 @@ EOF + + trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure @@ -2967,6 +2965,7 @@ s%@LIBOBJS@%$LIBOBJS%g s%@xtra_PLUGIN_guile_libs@%$xtra_PLUGIN_guile_libs%g s%@AWK@%$AWK%g s%@FD_SETTER@%$FD_SETTER%g +s%@ERRNO_EXTRACT@%$ERRNO_EXTRACT%g CEOF EOF @@ -3177,7 +3176,6 @@ fi; done EOF cat >> $CONFIG_STATUS <<EOF - EOF cat >> $CONFIG_STATUS <<\EOF test -z "$CONFIG_HEADER" || echo timestamp > stamp-h diff --git a/libguile/configure.in b/libguile/configure.in index c8c3189d6..f85a5ef4a 100644 --- a/libguile/configure.in +++ b/libguile/configure.in @@ -224,15 +224,11 @@ esac AC_PROG_AWK AC_MSG_CHECKING(whether errno codes can be extracted from errno.h) -goterrnos=0 if test "$GCC" = yes ; then - ${CC-cc} -undef -dM -E $srcdir/errnos_get.c | egrep ' E.+' | cut -f2 -d' ' > errnos.list - egrep '^E.+' errnos.list > /dev/null 2>&1 && goterrnos=1 -fi -if test $goterrnos = 1 ; then AC_MSG_RESULT(yes) + ERRNO_EXTRACT="${CC-cc} -undef -dM -E $srcdir/errnos_get.c | egrep ' E.+' | cut -f2 -d' ' > errnos.list" else - cp $srcdir/errnos.default errnos.list + ERRNO_EXTRACT="cp $srcdir/errnos.default errnos.list" AC_MSG_RESULT([no, using default]) fi @@ -240,7 +236,9 @@ AC_DEFINE_UNQUOTED(GUILE_MAJOR_VERSION, "$GUILE_MAJOR_VERSION") AC_DEFINE_UNQUOTED(GUILE_MINOR_VERSION, "$GUILE_MINOR_VERSION") AC_DEFINE_UNQUOTED(GUILE_VERSION, "$GUILE_VERSION") +AC_SUBST(AWK) AC_SUBST(FD_SETTER) +AC_SUBST(ERRNO_EXTRACT) AC_OUTPUT([Makefile fd.h guile-snarf PLUGIN/guile.libs], [chmod +x guile-snarf]) dnl Local Variables: diff --git a/libguile/ioext.c b/libguile/ioext.c index 37b8bdc34..a179ffb56 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -44,7 +44,11 @@ #include <stdio.h> #include "fd.h" #include "_scm.h" +#include "genio.h" +#include "read.h" #include "fports.h" +#include "unif.h" +#include "chars.h" #include "ioext.h" @@ -56,6 +60,96 @@ #endif +SCM_PROC (s_read_delimited_x, "%read-delimited!", 3, 3, 0, scm_read_delimited_x); + +SCM +scm_read_delimited_x (delims, buf, gobble, port, start, end) + SCM delims; + SCM buf; + SCM gobble; + SCM port; + SCM start; + SCM end; +{ + long j; + char *cbuf; + long cstart; + long cend; + int c; + char *cdelims; + int num_delims; + + SCM_ASSERT (SCM_NIMP (delims) && SCM_STRINGP (delims), + delims, SCM_ARG1, s_read_delimited_x); + cdelims = SCM_CHARS (delims); + num_delims = SCM_LENGTH (delims); + SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), + buf, SCM_ARG2, s_read_delimited_x); + cbuf = SCM_CHARS (buf); + cend = SCM_LENGTH (buf); + if (SCM_UNBNDP (port)) + port = scm_cur_inp; + else + { + SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), + port, SCM_ARG1, s_read_delimited_x); + } + + if (SCM_UNBNDP (start)) + cstart = 0; + else + { + cstart = scm_num2long (start, + (char *) SCM_ARG5, s_read_delimited_x); + if (cstart < 0 || cstart >= cend) + scm_out_of_range (s_read_delimited_x, start); + + if (!SCM_UNBNDP (end)) + { + long tend = scm_num2long (end, (char *) SCM_ARG6, + s_read_delimited_x); + if (tend <= cstart || tend > cend) + scm_out_of_range (s_read_delimited_x, end); + cend = tend; + } + } + + for (j = cstart; j < cend; j++) + { + int k; + + c = scm_gen_getc (port); + for (k = 0; k < num_delims; k++) + { + if (cdelims[k] == c) + { + if (SCM_FALSEP (gobble)) + scm_gen_ungetc (c, port); + + return scm_cons (SCM_MAKICHR (c), + scm_long2num (j - cstart)); + } + } + if (c == EOF) + return scm_cons (SCM_EOF_VAL, + scm_long2num (j - cstart)); + + cbuf[j] = c; + } + return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart)); +} + +SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line); + +SCM +scm_write_line (obj, port) + SCM obj; + SCM port; +{ + scm_display (obj, port); + return scm_newline (port); +} + SCM_PROC (s_sys_ftell, "ftell", 1, 0, 0, scm_sys_ftell); SCM diff --git a/libguile/ioext.h b/libguile/ioext.h index e026a1f23..3e994a568 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -2,7 +2,7 @@ #ifndef IOEXTH #define IOEXTH -/* Copyright (C) 1995 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -48,9 +48,8 @@ - - - +extern SCM scm_read_delimited_x SCM_P ((SCM delims, SCM buf, SCM gobble, SCM port, SCM offset, SCM length)); +extern SCM scm_write_line SCM_P ((SCM obj, SCM port)); extern SCM scm_sys_ftell SCM_P ((SCM port)); extern SCM scm_sys_fseek SCM_P ((SCM port, SCM offset, SCM whence)); extern SCM scm_sys_freopen SCM_P ((SCM filename, SCM modes, SCM port)); diff --git a/libguile/ports.c b/libguile/ports.c index c2a9406e6..01324bda7 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -302,8 +302,8 @@ scm_remove_from_port_table (port) #ifdef DEBUG /* Undocumented functions for debugging. */ /* Return the number of ports in the table. */ -static char s_pt_size[] = "pt-size"; +SCM_PROC(s_pt_size, "pt-size", 0, 0, 0, scm_pt_size); SCM scm_pt_size () { @@ -311,8 +311,7 @@ scm_pt_size () } /* Return the ith member of the port table. */ -static char s_pt_member[] = "pt-member"; - +SCM_PROC(s_pt_member, "pt-member", 1, 0, 0, scm_pt_member); SCM scm_pt_member (member) SCM member; diff --git a/libguile/posix.c b/libguile/posix.c index ebdbf202c..2d52690d0 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -43,10 +43,7 @@ #include <stdio.h> #include "_scm.h" #include "fports.h" -#include "genio.h" #include "scmsigs.h" -#include "read.h" -#include "unif.h" #include "feature.h" #include "sequences.h" @@ -988,115 +985,6 @@ scm_putenv (str) #endif } -SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line); - -SCM -scm_read_line (port, include_terminator) - SCM port; - SCM include_terminator; -{ - register int c; - register int j = 0; - scm_sizet len = 30; - SCM tok_buf; - register char *p; - int include; - - tok_buf = scm_makstr ((long) len, 0); - p = SCM_CHARS (tok_buf); - if (SCM_UNBNDP (port)) - port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line); - - if (SCM_UNBNDP (include_terminator)) - include = 0; - else - include = SCM_NFALSEP (include_terminator); - - if (EOF == (c = scm_gen_getc (port))) - return SCM_EOF_VAL; - while (1) - { - switch (c) - { - case SCM_LINE_INCREMENTORS: - if (j >= len) - { - p = scm_grow_tok_buf (&tok_buf); - len = SCM_LENGTH (tok_buf); - } - p[j++] = c; - /* fallthrough */ - case EOF: - if (len == j) - return tok_buf; - return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j)); - - default: - if (j >= len) - { - p = scm_grow_tok_buf (&tok_buf); - len = SCM_LENGTH (tok_buf); - } - p[j++] = c; - c = scm_gen_getc (port); - break; - } - } -} - -SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x); - -SCM -scm_read_line_x (str, port) - SCM str; - SCM port; -{ - register int c; - register int j = 0; - register char *p; - scm_sizet len; - SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x); - p = SCM_CHARS (str); - len = SCM_LENGTH (str); - if SCM_UNBNDP - (port) port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x); - c = scm_gen_getc (port); - if (EOF == c) - return SCM_EOF_VAL; - while (1) - { - switch (c) - { - case SCM_LINE_INCREMENTORS: - case EOF: - return SCM_MAKINUM (j); - default: - if (j >= len) - { - scm_gen_ungetc (c, port); - return SCM_BOOL_F; - } - p[j++] = c; - c = scm_gen_getc (port); - } - } -} - -SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line); - -SCM -scm_write_line (obj, port) - SCM obj; - SCM port; -{ - scm_display (obj, port); - return scm_newline (port); -} - SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale); SCM diff --git a/libguile/posix.h b/libguile/posix.h index 1dd9eb52d..5f5a943bc 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -2,7 +2,7 @@ #ifndef POSIXH #define POSIXH -/* Copyright (C) 1995 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -87,9 +87,6 @@ extern SCM scm_utime SCM_P ((SCM pathname, SCM actime, SCM modtime)); extern SCM scm_access SCM_P ((SCM path, SCM how)); extern SCM scm_getpid SCM_P ((void)); extern SCM scm_putenv SCM_P ((SCM str)); -extern SCM scm_read_line SCM_P ((SCM port, SCM include_terminator)); -extern SCM scm_read_line_x SCM_P ((SCM str, SCM port)); -extern SCM scm_write_line SCM_P ((SCM obj, SCM port)); extern SCM scm_setlocale SCM_P ((SCM category, SCM locale)); extern SCM scm_strftime SCM_P ((SCM format, SCM stime)); extern SCM scm_strptime SCM_P ((SCM format, SCM string)); diff --git a/libguile/socket.c b/libguile/socket.c index b8795a2f7..e4a817796 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -558,37 +558,20 @@ scm_getpeername (sock) return result; } -SCM_PROC (s_recv, "recv", 2, 1, 0, scm_recv); +SCM_PROC (s_recv, "recv!", 2, 1, 0, scm_recv); SCM -scm_recv (sock, buff_or_size, flags) +scm_recv (sock, buf, flags) SCM sock; - SCM buff_or_size; + SCM buf; SCM flags; { int rv; int fd; int flg; - SCM tok_buf; - char *p; - int size; - int allocated = 0; SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recv); - if (SCM_INUMP (buff_or_size)) - { - size = SCM_INUM (buff_or_size); - tok_buf = scm_makstr (size, 0); - allocated = 1; - } - else - { - SCM_ASSERT (SCM_NIMP (buff_or_size) && SCM_STRINGP (buff_or_size), - buff_or_size, SCM_ARG2, s_recv); - tok_buf = buff_or_size; - size = SCM_LENGTH (tok_buf); - } - p = SCM_CHARS (tok_buf); + SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recv); fd = fileno ((FILE *)SCM_STREAM (sock)); if (SCM_UNBNDP (flags)) @@ -596,14 +579,11 @@ scm_recv (sock, buff_or_size, flags) else flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recv); - SCM_SYSCALL (rv = recv (fd, p, size, flg)); + SCM_SYSCALL (rv = recv (fd, SCM_CHARS (buf), SCM_LENGTH (buf), flg)); if (rv == -1) scm_syserror (s_recv); - return scm_cons (allocated - ? scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (rv)) - : tok_buf, - SCM_MAKINUM (rv)); + return SCM_MAKINUM (rv); } SCM_PROC (s_send, "send", 2, 1, 0, scm_send); @@ -633,83 +613,63 @@ scm_send (sock, message, flags) return SCM_MAKINUM (rv); } -/* buff_or_size can be: - 1/ size of buffer to allocate initially - 2/ string buffer - 3/ list with string buffer, start position and end positions. - (for SCSH networking). - */ -SCM_PROC (s_recvfrom, "recvfrom", 2, 1, 0, scm_recvfrom); +SCM_PROC (s_recvfrom, "recvfrom!", 2, 3, 0, scm_recvfrom); SCM -scm_recvfrom (sock, buff_or_size, flags) +scm_recvfrom (sock, buf, flags, start, end) SCM sock; - SCM buff_or_size; + SCM buf; SCM flags; + SCM start; + SCM end; { int rv; int fd; int flg; - SCM tok_buf; - int size; - int allocated = 0; + int offset = 0; + int cend; int tmp_size; SCM address; - char *c_buf; - SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recvfrom); - if (SCM_INUMP (buff_or_size)) - { - size = SCM_INUM (buff_or_size); - tok_buf = scm_makstr (size, 0); - c_buf = SCM_CHARS (tok_buf); - allocated = 1; - } + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, + s_recvfrom); + SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2, s_recvfrom); + cend = SCM_LENGTH (buf); + + if (SCM_UNBNDP (flags)) + flg = 0; else { - SCM_ASSERT (SCM_NIMP (buff_or_size), buff_or_size, SCM_ARG2, s_recvfrom); - if (SCM_CONSP (buff_or_size)) + flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); + + if (!SCM_UNBNDP (start)) { - SCM s_start, s_end; - int start, end; - - SCM_ASSERT (scm_ilength (buff_or_size) == 3, buff_or_size, - SCM_ARG2, s_recvfrom); - tok_buf = SCM_CAR (buff_or_size); - SCM_ASSERT (SCM_NIMP (tok_buf) && SCM_STRINGP (tok_buf), - buff_or_size, SCM_ARG2, s_recvfrom); - s_start = SCM_CADR (buff_or_size); - start = (int)scm_num2long (s_start, (char *)SCM_ARG2, s_recvfrom); - if (start < 0) - scm_out_of_range (s_recvfrom, s_start); - s_end = SCM_CADDR (buff_or_size); - end = (int)scm_num2long (s_end, (char *) SCM_ARG2, s_recvfrom); - if (end < 0 || end > SCM_LENGTH (tok_buf)) - scm_out_of_range (s_recvfrom, s_end); - if (start > end) - scm_out_of_range (s_recvfrom, s_start); - c_buf = SCM_CHARS (tok_buf) + start; - size = end - start; + offset = (int) scm_num2long (start, + (char *) SCM_ARG4, s_recvfrom); + + if (offset < 0 || offset >= cend) + scm_out_of_range (s_recvfrom, start); + + if (!SCM_UNBNDP (end)) + { + int tend = (int) scm_num2long (end, + (char *) SCM_ARG5, s_recvfrom); + + if (tend <= offset || tend > cend) + scm_out_of_range (s_recvfrom, end); + + cend = tend; + } } - else { - SCM_ASSERT (SCM_STRINGP (buff_or_size), buff_or_size, SCM_ARG2, - s_recvfrom); - tok_buf = buff_or_size; - c_buf = SCM_CHARS (tok_buf); - size = SCM_LENGTH (tok_buf); - } } - fd = fileno ((FILE *)SCM_STREAM (sock)); - if (SCM_UNBNDP (flags)) - flg = 0; - else - flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); + fd = fileno ((FILE *)SCM_STREAM (sock)); tmp_size = scm_addr_buffer_size; - SCM_SYSCALL (rv = recvfrom (fd, c_buf, size, flg, - (struct sockaddr *) scm_addr_buffer, - &tmp_size)); + SCM_SYSCALL (rv = recvfrom (fd, SCM_CHARS (buf) + offset, + cend - offset, flg, + (struct sockaddr *) scm_addr_buffer, + &tmp_size)); if (rv == -1) scm_syserror (s_recvfrom); if (tmp_size > 0) @@ -717,13 +677,7 @@ scm_recvfrom (sock, buff_or_size, flags) else address = SCM_BOOL_F; - return scm_listify (allocated - ? scm_vector_set_length_x (tok_buf, - (SCM) SCM_MAKINUM (rv)) - : tok_buf, - SCM_MAKINUM (rv), - address, - SCM_UNDEFINED); + return scm_cons (SCM_MAKINUM (rv), address); } SCM_PROC (s_sendto, "sendto", 4, 0, 1, scm_sendto); diff --git a/libguile/socket.h b/libguile/socket.h index 16df43ba6..1d28b8171 100644 --- a/libguile/socket.h +++ b/libguile/socket.h @@ -2,7 +2,7 @@ #ifndef SOCKETH #define SOCKETH -/* Copyright (C) 1995 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -65,7 +65,7 @@ extern SCM scm_getsockname SCM_P ((SCM sockfd)); extern SCM scm_getpeername SCM_P ((SCM sockfd)); extern SCM scm_recv SCM_P ((SCM sockfd, SCM buff_or_size, SCM flags)); extern SCM scm_send SCM_P ((SCM sockfd, SCM message, SCM flags)); -extern SCM scm_recvfrom SCM_P ((SCM sockfd, SCM buff_or_size, SCM flags)); +extern SCM scm_recvfrom SCM_P ((SCM sockfd, SCM buff_or_size, SCM flags, SCM offset, SCM length)); extern SCM scm_sendto SCM_P ((SCM sockfd, SCM message, SCM fam, SCM address, SCM args_and_flags)); extern void scm_init_socket SCM_P ((void)); diff --git a/libguile/unif.c b/libguile/unif.c index 8e181f1a4..c35230d47 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1437,16 +1437,17 @@ scm_ra2contig (ra, copy) SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, scm_uniform_array_read_x); SCM -scm_uniform_array_read_x (ra, port_or_fd, offset, length) +scm_uniform_array_read_x (ra, port_or_fd, start, end) SCM ra; SCM port_or_fd; - SCM offset; - SCM length; + SCM start; + SCM end; { SCM cra = SCM_UNDEFINED, v = ra; long sz, vlen, ans; - long start = 0; - long len_to_read; + long cstart = 0; + long cend; + long offset = 0; SCM_ASRTGO (SCM_NIMP (v), badarg1); if (SCM_UNBNDP (port_or_fd)) @@ -1465,7 +1466,7 @@ loop: case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); cra = scm_ra2contig (ra, 0); - start += SCM_ARRAY_BASE (cra); + cstart += SCM_ARRAY_BASE (cra); vlen = SCM_ARRAY_DIMS (cra)->inc * (SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1); v = SCM_ARRAY_V (cra); @@ -1476,7 +1477,7 @@ loop: break; case scm_tc7_bvect: vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; - start /= SCM_LONG_BIT; + cstart /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: sz = sizeof (long); @@ -1504,25 +1505,24 @@ loop: #endif } - len_to_read = vlen; - if (!SCM_UNBNDP (offset)) + cend = vlen; + if (!SCM_UNBNDP (start)) { - long loff = - scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_read_x); + offset = + scm_num2long (start, (char *) SCM_ARG3, s_uniform_array_read_x); - if (loff < 0 || loff >= vlen) - scm_out_of_range (s_uniform_array_read_x, offset); - start += loff; - len_to_read -= loff; - } - if (!SCM_UNBNDP (length)) - { - long llen = - scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + if (offset < 0 || offset >= cend) + scm_out_of_range (s_uniform_array_read_x, start); + + if (!SCM_UNBNDP (end)) + { + long tend = + scm_num2long (end, (char *) SCM_ARG4, s_uniform_array_read_x); - if (llen < 0 || llen > len_to_read) - scm_out_of_range (s_uniform_array_read_x, length); - len_to_read = llen; + if (tend <= offset || tend > cend) + scm_out_of_range (s_uniform_array_read_x, end); + cend = tend; + } } if (SCM_NIMP (port_or_fd)) @@ -1536,16 +1536,15 @@ loop: ungetc (SCM_CGETUN (port_or_fd), (FILE *)SCM_STREAM (port_or_fd)); SCM_CLRDY (port_or_fd); /* Clear ungetted char */ } - SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, - (scm_sizet) sz, (scm_sizet) len_to_read, - (FILE *)SCM_STREAM (port_or_fd))); - + SCM_SYSCALL (ans = fread (SCM_CHARS (v) + (cstart + offset) * sz, + (scm_sizet) sz, (scm_sizet) (cend - offset), + (FILE *)SCM_STREAM (port_or_fd))); } else /* file descriptor. */ { SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd), - SCM_CHARS (v) + start * sz, - (scm_sizet) (sz * len_to_read))); + SCM_CHARS (v) + (cstart + offset) * sz, + (scm_sizet) (sz * (cend - offset)))); if (ans == -1) scm_syserror (s_uniform_array_read_x); } @@ -1561,15 +1560,16 @@ loop: SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 3, 0, scm_uniform_array_write); SCM -scm_uniform_array_write (v, port_or_fd, offset, length) +scm_uniform_array_write (v, port_or_fd, start, end) SCM v; SCM port_or_fd; - SCM offset; - SCM length; + SCM start; + SCM end; { long sz, vlen, ans; - long start = 0; - long len_to_write; + long offset = 0; + long cstart = 0; + long cend; SCM_ASRTGO (SCM_NIMP (v), badarg1); if (SCM_UNBNDP (port_or_fd)) @@ -1588,7 +1588,7 @@ loop: case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); v = scm_ra2contig (v, 1); - start = SCM_ARRAY_BASE (v); + cstart = SCM_ARRAY_BASE (v); vlen = SCM_ARRAY_DIMS (v)->inc * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1); v = SCM_ARRAY_V (v); @@ -1599,7 +1599,7 @@ loop: break; case scm_tc7_bvect: vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; - start /= SCM_LONG_BIT; + cstart /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: sz = sizeof (long); @@ -1627,38 +1627,37 @@ loop: #endif } - len_to_write = vlen; - if (!SCM_UNBNDP (offset)) + cend = vlen; + if (!SCM_UNBNDP (start)) { - long loff = - scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_write); + offset = + scm_num2long (start, (char *) SCM_ARG3, s_uniform_array_write); - if (loff < 0 || loff >= vlen) - scm_out_of_range (s_uniform_array_write, offset); - start += loff; - len_to_write -= loff; - } - if (!SCM_UNBNDP (length)) - { - long llen = - scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + if (offset < 0 || offset >= cend) + scm_out_of_range (s_uniform_array_write, start); + + if (!SCM_UNBNDP (end)) + { + long tend = + scm_num2long (end, (char *) SCM_ARG4, s_uniform_array_write); - if (llen < 0 || llen > len_to_write) - scm_out_of_range (s_uniform_array_read_x, length); - len_to_write = llen; + if (tend <= offset || tend > cend) + scm_out_of_range (s_uniform_array_write, end); + cend = tend; + } } if (SCM_NIMP (port_or_fd)) { - SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, - (scm_sizet) sz, (scm_sizet) len_to_write, + SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + (cstart + offset) * sz, + (scm_sizet) sz, (scm_sizet) (cend - offset), (FILE *)SCM_STREAM (port_or_fd))); } else /* file descriptor. */ { SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd), - SCM_CHARS (v) + start * sz, - (scm_sizet) (sz * len_to_write))); + SCM_CHARS (v) + (cstart + offset) * sz, + (scm_sizet) (sz * (cend - offset)))); if (ans == -1) scm_syserror (s_uniform_array_write); } diff --git a/libguile/unif.h b/libguile/unif.h index 82a6088fe..bf44d8b72 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -95,8 +95,8 @@ extern SCM scm_cvref SCM_P ((SCM v, scm_sizet pos, SCM last)); extern SCM scm_array_set_x SCM_P ((SCM v, SCM obj, SCM args)); extern SCM scm_array_contents SCM_P ((SCM ra, SCM strict)); extern SCM scm_ra2contig SCM_P ((SCM ra, int copy)); -extern SCM scm_uniform_array_read_x SCM_P ((SCM ra, SCM port_or_fd, SCM offset, SCM length)); -extern SCM scm_uniform_array_write SCM_P ((SCM v, SCM port_or_fd, SCM offset, SCM length)); +extern SCM scm_uniform_array_read_x SCM_P ((SCM ra, SCM port_or_fd, SCM start, SCM end)); +extern SCM scm_uniform_array_write SCM_P ((SCM v, SCM port_or_fd, SCM start, SCM end)); extern SCM scm_bit_count SCM_P ((SCM item, SCM seq)); extern SCM scm_bit_position SCM_P ((SCM item, SCM v, SCM k)); extern SCM scm_bit_set_star_x SCM_P ((SCM v, SCM kv, SCM obj)); |