summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog44
-rw-r--r--libguile/Makefile.am7
-rw-r--r--libguile/Makefile.in11
-rw-r--r--libguile/__scm.h4
-rwxr-xr-xlibguile/configure12
-rw-r--r--libguile/configure.in10
-rw-r--r--libguile/ioext.c96
-rw-r--r--libguile/ioext.h7
-rw-r--r--libguile/ports.c5
-rw-r--r--libguile/posix.c114
-rw-r--r--libguile/posix.h5
-rw-r--r--libguile/socket.c136
-rw-r--r--libguile/socket.h4
-rw-r--r--libguile/unif.c111
-rw-r--r--libguile/unif.h4
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));