mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

* ioext.h: fix up prototypes.

Browse source 
* ioext.c (scm_dup_to_fdes): renamed from scm_primitive_dup2.
Scheme name is now dup->fdes.
(scm_dup_to_fdes): make the second argument optional and
fold in the functionality of scm_primitive_dup.
(scm_primitive_dup): deleted.
* fports.h (SCM_P): prototypes for scm_setvbuf, scm_setfileno.
* fports.c (scm_setbuf0): don't disable the setbuf if MSDOS or
ultrix are defined.  Use setvbuf instead of setbuf.
(scm_setvbuf): new procedure.
(scm_init_fports): intern _IOFBF, _IOLBF, _IONBF.
(scm_setfileno): moved from ioext.c.
(scm_fgets): cast SCM_STREAM to (FILE *), remove unused lp variable.
(top of file): Delete 25 lines of probably obsolete CPP hair for MSDOS.

* boot-9.scm (move->fdes, dup->port): use dup->fdes, not primitive-dup.
(dup->fdes): deleted, now done in C.
This commit is contained in:
Gary Houston 1997-07-29 02:21:08 +00:00
parent a0cb6cb0ec
commit 7a6f1ffa10
8 changed files with 131 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

34
NEWS
View file

@ -100,18 +100,6 @@ supplied port, otherwise returns an integer file descriptor.
Returns a new port using the new file descriptor. MODE supplies a
mode string for the port (as for `open-file').
** primitive-dup PORT/FD
Performs a dup system call on the file descriptor FD, or the file
descriptor underlying PORT and returns a new integer file descriptor.
** primitive-dup2 PORT/FD NEWFD
Performs a dup2 system call on the file descriptor FD, or the file
descriptor underlying PORT, using NEWFD (an integer) as the target
file descriptor. Any ports using NEWFD are moved to a different file
descriptor and have their revealed counts set to zero. The value
returned is NEWFD.
** port->fdes PORT
Returns the integer file descriptor underlying PORT. As a
side effect the revealed count of PORT is incremented.
@ -126,11 +114,31 @@ Returns an existing output port which has FDES as its underlying file
descriptor, if one exists, and increments its revealed count.
Otherwise, returns a new output port with a revealed count of 1.
** setenv [NAME] [VALUE]
** setenv NAME VALUE
If VALUE is `#f', removes NAME from the environment. Otherwise
adds the string NAME=VALUE to the environment, replacing any previous
value for NAME.
** setvbuf PORT MODE [SIZE]
Set the buffering mode for PORT. MODE can be:
`_IONBF'
non-buffered
`_IOLBF'
line buffered
`_IOFBF'
block buffered, using a newly allocated buffer of SIZE bytes.
However if SIZE is zero or unspecified, the port will be made
non-buffered.
This procedure should not be used after I/O has been performed with
the port.
Ports are usually block buffered by default, with a default buffer
size. Procedures e.g., *Note open-file: File Ports, which accept a
mode string allow `0' to be added to request an unbuffered port.
** primitive-exit [STATUS]
Terminates the current process without unwinding the Scheme stack.
This would usually be used after a fork.

5
ice-9/ChangeLog
View file

@ -1,3 +1,8 @@
Tue Jul 29 01:18:08 1997 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (move->fdes, dup->port): use dup->fdes, not primitive-dup.
(dup->fdes): deleted, now done in C.
Sat Jul 26 08:00:42 1997 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (setenv): new procedure, scsh compatible.

11
ice-9/boot-9.scm
View file

@ -768,7 +768,7 @@
(define (move->fdes fd/port fd)
(cond ((integer? fd/port)
(primitive-dup2 fd/port fd)
(dup->fdes fd/port fd)
(close fd/port)
fd)
(else
@ -782,9 +782,7 @@
(set-port-revealed! port (- revealed 1)))))
(define (dup->port port/fd mode . maybe-fd)
(let ((port (fdopen (if (pair? maybe-fd)
(primitive-dup2 port/fd (car maybe-fd))
(primitive-dup port/fd))
(let ((port (fdopen (apply dup->fdes port/fd maybe-fd)
mode)))
(if (pair? maybe-fd)
(set-port-revealed! port 1))
@ -796,11 +794,6 @@
(define (dup->outport port/fd . maybe-fd)
(apply dup->port port/fd "w" maybe-fd))
(define (dup->fdes port/fd . maybe-fd)
(if (pair? maybe-fd)
(primitive-dup2 port/fd (car maybe-fd))
(primitive-dup port/fd)))
(define (dup port/fd . maybe-fd)
(if (integer? port/fd)
(apply dup->fdes port/fd maybe-fd)

20
libguile/ChangeLog
View file

@ -1,3 +1,23 @@
Tue Jul 29 01:03:08 1997 Gary Houston <ghouston@actrix.gen.nz>
* ioext.h: fix up prototypes.
* ioext.c (scm_dup_to_fdes): renamed from scm_primitive_dup2.
Scheme name is now dup->fdes.
(scm_dup_to_fdes): make the second argument optional and
fold in the functionality of scm_primitive_dup.
(scm_primitive_dup): deleted.
Mon Jul 28 05:24:42 1997 Gary Houston <ghouston@actrix.gen.nz>
* fports.h (SCM_P): prototypes for scm_setvbuf, scm_setfileno.
* fports.c (scm_setbuf0): don't disable the setbuf if MSDOS or
ultrix are defined. Use setvbuf instead of setbuf.
(scm_setvbuf): new procedure.
(scm_init_fports): intern _IOFBF, _IOLBF, _IONBF.
(scm_setfileno): moved from ioext.c.
(scm_fgets): cast SCM_STREAM to (FILE *), remove unused lp variable.
(top of file): Delete 25 lines of probably obsolete CPP hair for MSDOS.
Sun Jul 27 10:54:01 1997 Marius Vollmer <mvo@zagadka.ping.de>
* fluids.c (scm_fluid_p): New function.

93
libguile/fports.c
View file

@ -55,34 +55,6 @@
scm_sizet fwrite ();
#endif
#ifdef __IBMC__
#include <io.h>
#include <direct.h>
#else
#ifndef MSDOS
#ifndef ultrix
#ifndef vms
#ifdef _DCC
#include <ioctl.h>
#define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0)
#else
#ifdef MWC
#include <sys/io.h>
#else
#ifndef THINK_C
#ifndef ARM_ULIB
#include <sys/ioctl.h>
#endif
#endif
#endif
#endif
#endif
#endif
#endif
#endif
/* {Ports - file ports}
*
*/
@ -93,16 +65,65 @@ SCM
scm_setbuf0 (port)
SCM port;
{
/* NOSETBUF was provided by scm to allow unbuffered ports to be
avoided on systems where ungetc didn't work correctly. See
comment in unif.c, which seems to be the only place where it
could still be a problem. */
#ifndef NOSETBUF
#ifndef MSDOS
#ifndef ultrix
SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
#endif
#endif
/* SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0);); */
SCM_SYSCALL (setvbuf ((FILE *)SCM_STREAM (port), 0, _IONBF, 0););
#endif
return SCM_UNSPECIFIED;
}
SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf);
SCM
scm_setvbuf (SCM port, SCM mode, SCM size)
{
int rv;
int cmode, csize;
SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG1, s_setvbuf);
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf);
if (SCM_UNBNDP (size))
csize = 0;
else
{
SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
csize = SCM_INUM (size);
}
cmode = SCM_INUM (mode);
if (csize == 0 && cmode == _IOFBF)
cmode = _IONBF;
SCM_DEFER_INTS;
SCM_SYSCALL (rv = setvbuf ((FILE *)SCM_STREAM (port), 0, cmode, csize));
if (rv < 0)
scm_syserror (s_setvbuf);
if (cmode == _IONBF)
SCM_SETCAR (port, SCM_CAR (port) | SCM_BUF0);
else
SCM_SETCAR (port, (SCM_CAR (port) & ~SCM_BUF0));
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
#ifdef FD_SETTER
#define SET_FILE_FD_FIELD(F,D) ((F)->FD_SETTER = (D))
#endif
void
scm_setfileno (fs, fd)
FILE *fs;
int fd;
{
#ifdef SET_FILE_FD_FIELD
SET_FILE_FD_FIELD(fs, fd);
#else
scm_misc_error ("scm_setfileno", "Not fully implemented on this platform",
SCM_EOL);
#endif
}
/* Move ports with the specified file descriptor to new descriptors,
* reseting the revealed count to 0.
* Should be called with SCM_DEFER_INTS active.
@ -283,9 +304,8 @@ scm_fgets (port)
char *p; /* pointer to current buffer position */
int i = 0; /* index into current buffer position */
int limit = 80; /* current size of buffer */
int lp;
f = SCM_STREAM (port);
f = (FILE *) SCM_STREAM (port);
if (feof (f))
return NULL;
@ -447,4 +467,7 @@ void
scm_init_fports ()
{
#include "fports.x"
scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
}

2
libguile/fports.h
View file

@ -56,6 +56,8 @@ extern scm_ptobfuns scm_pipob;
extern SCM scm_setbuf0 SCM_P ((SCM port));
extern SCM scm_setvbuf (SCM port, SCM mode, SCM size);
extern void scm_setfileno SCM_P ((FILE *fs, int fd));
extern void scm_evict_ports SCM_P ((int fd));
extern SCM scm_open_file SCM_P ((SCM filename, SCM modes));
extern SCM scm_stdio_to_port SCM_P ((FILE *file, char *name, char *modes));

53
libguile/ioext.c
View file

@ -302,9 +302,9 @@ scm_primitive_dup (SCM fd_or_port)
return SCM_MAKINUM (newfd);
}
SCM_PROC (s_primitive_dup2, "primitive-dup2", 2, 0, 0, scm_primitive_dup2);
SCM_PROC (s_dup_to_fdes, "dup->fdes", 1, 1, 0, scm_dup_to_fdes);
SCM
scm_primitive_dup2 (SCM fd_or_port, SCM fd)
scm_dup_to_fdes (SCM fd_or_port, SCM fd)
{
int oldfd, newfd, rv;
@ -314,23 +314,31 @@ scm_primitive_dup2 (SCM fd_or_port, SCM fd)
else
{
SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port),
fd_or_port, SCM_ARG1, s_primitive_dup2);
fd_or_port, SCM_ARG1, s_dup_to_fdes);
oldfd = fileno ((FILE *)SCM_STREAM (fd_or_port));
if (oldfd == -1)
scm_syserror (s_primitive_dup2);
scm_syserror (s_dup_to_fdes);
}
SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_dup2);
newfd = SCM_INUM (fd);
if (oldfd == newfd)
if (SCM_UNBNDP (fd))
{
SCM_ALLOW_INTS;
return fd;
SCM_SYSCALL (newfd = dup (oldfd));
if (newfd == -1)
scm_syserror (s_primitive_dup);
fd = SCM_MAKINUM (newfd);
}
else
{
SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_dup_to_fdes);
newfd = SCM_INUM (fd);
if (oldfd != newfd)
{
scm_evict_ports (newfd); /* see scsh manual. */
SCM_SYSCALL (rv = dup2 (oldfd, newfd));
if (rv == -1)
scm_syserror (s_dup_to_fdes);
}
}
scm_evict_ports (newfd); /* see scsh manual. */
SCM_SYSCALL (rv = dup2 (oldfd, newfd));
if (rv == -1)
scm_syserror (s_primitive_dup2);
SCM_ALLOW_INTS;
return fd;
}
@ -436,23 +444,6 @@ scm_primitive_move_to_fdes (port, fd)
return SCM_BOOL_T;
}
#ifdef FD_SETTER
#define SET_FILE_FD_FIELD(F,D) ((F)->FD_SETTER = (D))
#endif
void
scm_setfileno (fs, fd)
FILE *fs;
int fd;
{
#ifdef SET_FILE_FD_FIELD
SET_FILE_FD_FIELD(fs, fd);
#else
scm_misc_error ("scm_setfileno", "Not fully implemented on this platform",
SCM_EOL);
#endif
}
/* Return a list of ports using a given file descriptor. */
SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);

4
libguile/ioext.h
View file

@ -54,13 +54,11 @@ extern SCM scm_ftell SCM_P ((SCM port));
extern SCM scm_fseek SCM_P ((SCM port, SCM offset, SCM whence));
extern SCM scm_freopen SCM_P ((SCM filename, SCM modes, SCM port));
extern SCM scm_redirect_port SCM_P ((SCM into_pt, SCM from_pt));
extern SCM scm_primitive_dup (SCM fd_or_port);
extern SCM scm_primitive_dup2 (SCM fd_or_port, SCM newfd);
extern SCM scm_dup_to_fdes (SCM fd_or_port, SCM newfd);
extern SCM scm_fileno SCM_P ((SCM port));
extern SCM scm_isatty_p SCM_P ((SCM port));
extern SCM scm_fdopen SCM_P ((SCM fdes, SCM modes));
extern SCM scm_primitive_move_to_fdes SCM_P ((SCM port, SCM fd));
extern void scm_setfileno SCM_P ((FILE *fs, int fd));
extern SCM scm_fdes_to_ports SCM_P ((SCM fd));
extern void scm_init_ioext SCM_P ((void));