From 7a6f1ffa105d5c02829a85d865df0e35b38e9b2b Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Tue, 29 Jul 1997 02:21:08 +0000 Subject: [PATCH] * 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. * 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. --- NEWS | 34 ++++++++++------- ice-9/ChangeLog | 5 +++ ice-9/boot-9.scm | 11 +----- libguile/ChangeLog | 20 ++++++++++ libguile/fports.c | 91 +++++++++++++++++++++++++++++----------------- libguile/fports.h | 2 + libguile/ioext.c | 53 +++++++++++---------------- libguile/ioext.h | 4 +- 8 files changed, 130 insertions(+), 90 deletions(-) diff --git a/NEWS b/NEWS index 54299ab9a..b68e77b9a 100644 --- a/NEWS +++ b/NEWS @@ -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. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index dbe68bebd..124ae049e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +Tue Jul 29 01:18:08 1997 Gary Houston + + * 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 * boot-9.scm (setenv): new procedure, scsh compatible. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index ff3b3a550..80f1190cc 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -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) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 67066ad1a..29d42686d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,23 @@ +Tue Jul 29 01:03:08 1997 Gary Houston + + * 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 + + * 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 * fluids.c (scm_fluid_p): New function. diff --git a/libguile/fports.c b/libguile/fports.c index fd8d3d78a..0a70fb196 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -55,34 +55,6 @@ scm_sizet fwrite (); #endif - -#ifdef __IBMC__ -#include -#include -#else -#ifndef MSDOS -#ifndef ultrix -#ifndef vms -#ifdef _DCC -#include -#define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0) -#else -#ifdef MWC -#include -#else -#ifndef THINK_C -#ifndef ARM_ULIB -#include -#endif -#endif -#endif -#endif -#endif -#endif -#endif -#endif - - /* {Ports - file ports} * */ @@ -93,14 +65,63 @@ 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);); + /* 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 - return SCM_UNSPECIFIED; } /* Move ports with the specified file descriptor to new descriptors, @@ -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)); } diff --git a/libguile/fports.h b/libguile/fports.h index 1323759b5..d4db3e20c 100644 --- a/libguile/fports.h +++ b/libguile/fports.h @@ -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)); diff --git a/libguile/ioext.c b/libguile/ioext.c index 5e1f79a50..81e58a42f 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -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); diff --git a/libguile/ioext.h b/libguile/ioext.h index ee5ed86cf..ef9f8d1da 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -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)); -- 2.20.1