mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

* ports.c: add SCM_PROC declarations for pt-size and pt-member.

Browse source 
* 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"
This commit is contained in:
Gary Houston 1997-01-25 18:23:49 +00:00
parent ea00ecbade
commit 1146b6cda2
15 changed files with 275 additions and 301 deletions
Download patch file Download diff file Expand all files Collapse all files

44
libguile/ChangeLog
View file

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

7
libguile/Makefile.am
View file

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

11
libguile/Makefile.in
View file

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

4
libguile/__scm.h
View file

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

12
libguile/configure vendored
View file

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

10
libguile/configure.in
View file

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

96
libguile/ioext.c
View file

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

7
libguile/ioext.h
View file

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

5
libguile/ports.c
View file

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

114
libguile/posix.c
View file

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

5
libguile/posix.h
View file

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

140
libguile/socket.c
View file

@ -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;
}
else
{
SCM_ASSERT (SCM_NIMP (buff_or_size), buff_or_size, SCM_ARG2, s_recvfrom);
if (SCM_CONSP (buff_or_size))
{
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;
}
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));
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
flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom);
{
flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom);
if (!SCM_UNBNDP (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;
}
}
}
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);

4
libguile/socket.h
View file

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

111
libguile/unif.c
View file

@ -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 (llen < 0 || llen > len_to_read)
scm_out_of_range (s_uniform_array_read_x, length);
len_to_read = llen;
if (!SCM_UNBNDP (end))
{
long tend =
scm_num2long (end, (char *) SCM_ARG4, s_uniform_array_read_x);
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 (llen < 0 || llen > len_to_write)
scm_out_of_range (s_uniform_array_read_x, length);
len_to_write = llen;
if (!SCM_UNBNDP (end))
{
long tend =
scm_num2long (end, (char *) SCM_ARG4, s_uniform_array_write);
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);
}

4
libguile/unif.h
View file

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