1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

a few fixups to primitive functions

This commit is contained in:
Gary Houston 1996-08-04 22:32:07 +00:00
parent 2e18892a89
commit 8b13c6b392
6 changed files with 64 additions and 53 deletions

View file

@ -1,3 +1,13 @@
Sat Aug 3 06:16:35 1996 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (*null-device*): global constant from goonix.
(move->fdes): adjusted for boolean primitive-move->fdes. return
the modified port, always set revealed count to 1 (SCSH compatible).
(release-port-handle port): from goonix (SCSH compatible).
(%open-file): removed.
(open-input-file, open-output-file, file-exists?, file-is-directory?):
modified for open-file change (does not return #f).
Thu Aug 1 02:52:42 1996 Jim Blandy <jimb@totoro.cyclic.com> Thu Aug 1 02:52:42 1996 Jim Blandy <jimb@totoro.cyclic.com>
* Makefile.in (dist-dir): New target for new dist system. * Makefile.in (dist-dir): New target for new dist system.

View file

@ -90,7 +90,6 @@
;;; {Silly Naming Cleanups and Trivial Functions} ;;; {Silly Naming Cleanups and Trivial Functions}
;;; ;;;
(define %open-file open-file)
(define (id x) x) (define (id x) x)
(define < <?) (define < <?)
(define <= <=?) (define <= <=?)
@ -156,13 +155,13 @@
((MS-DOS WINDOWS ATARIST) "r+b") ((MS-DOS WINDOWS ATARIST) "r+b")
(else "r+"))) (else "r+")))
(define *null-device* "/dev/null")
(define (open-input-file str) (define (open-input-file str)
(or (open-file str OPEN_READ) (open-file str OPEN_READ))
(error "OPEN-INPUT-FILE couldn't find file " str)))
(define (open-output-file str) (define (open-output-file str)
(or (open-file str OPEN_WRITE) (open-file str OPEN_WRITE))
(error "OPEN-OUTPUT-FILE couldn't find file " str)))
(define (open-io-file str) (open-file str OPEN_BOTH)) (define (open-io-file str) (open-file str OPEN_BOTH))
(define close-input-port close-port) (define close-input-port close-port)
@ -553,12 +552,16 @@
;;; ;;;
(define (file-exists? str) (define (file-exists? str)
(let ((port (open-file str OPEN_READ))) ;; we don't have false-if-exception (or defmacro) yet.
(let ((port (catch #t (lambda () (open-file str OPEN_READ))
(lambda args #f))))
(if port (begin (close-port port) #t) (if port (begin (close-port port) #t)
#f))) #f)))
(define (file-is-directory? str) (define (file-is-directory? str)
(let ((port (open-file (string-append str "/.") OPEN_READ))) (let ((port (catch #t (lambda () (open-file (string-append str "/.")
OPEN_READ))
(lambda args #f))))
(if port (begin (close-port port) #t) (if port (begin (close-port port) #t)
#f))) #f)))
@ -742,9 +745,16 @@
(define (setprotoent arg) (setproto arg)) (define (setprotoent arg) (setproto arg))
(define (setpwent arg) (setpw arg)) (define (setpwent arg) (setpw arg))
(define (setservent arg) (setserv arg)) (define (setservent arg) (setserv arg))
(define (move->fdes port fd) (define (move->fdes port fd)
(if (= 1 (primitive-move->fdes port fd)) (primitive-move->fdes port fd)
(set-port-revealed! port 1))) (set-port-revealed! port 1)
port)
(define (release-port-handle port)
(let ((revealed (port-revealed port)))
(if (> revealed 0)
(set-port-revealed! port (- revealed 1)))))
;;; {Load Paths} ;;; {Load Paths}

View file

@ -1,5 +1,18 @@
Sat Aug 3 01:27:14 1996 Gary Houston <ghouston@actrix.gen.nz> Sat Aug 3 01:27:14 1996 Gary Houston <ghouston@actrix.gen.nz>
* ioext.c (scm_sys_fdopen): fix the port-table assignment.
* fports.c (scm_open_file): don't return #f, throw error.
* ioext.c (fileno): renamed from %fileno.
(soft-fileno): deleted.
* ports.c (scm_port_revealed): don't need to check for -1 from
scm_revealed_count.
(scm_set_port_revealed_x): return unspecified, not #f.
* ioext.c (primitive-move->fdes): return #t or #f, not 1 or 0.
* fdsocket.c: getsockopt, setsockopt: use HAVE_STRUCT_LINGER. * fdsocket.c: getsockopt, setsockopt: use HAVE_STRUCT_LINGER.
* scmconfig.h.in: add HAVE_STRUCT_LINGER. * scmconfig.h.in: add HAVE_STRUCT_LINGER.

View file

@ -193,10 +193,12 @@ scm_open_file (filename, modes)
if (SCM_SUBSTRP (modes)) if (SCM_SUBSTRP (modes))
modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0); modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes)); port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
/* Force the compiler to keep filename and modes alive:
*/ if (port == SCM_BOOL_F) {
if (port == SCM_BOOL_F) SCM_SYSERROR (s_open_file);
/* Force the compiler to keep filename and modes alive. */
scm_cons (filename, modes); scm_cons (filename, modes);
}
return port; return port;
} }

View file

@ -210,7 +210,7 @@ scm_sys_redirect_port (into_pt, from_pt)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
SCM_PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno); SCM_PROC (s_sys_fileno, "fileno", 1, 0, 0, scm_sys_fileno);
#ifdef __STDC__ #ifdef __STDC__
SCM SCM
scm_sys_fileno (SCM port) scm_sys_fileno (SCM port)
@ -228,27 +228,6 @@ scm_sys_fileno (port)
return SCM_MAKINUM (fd); return SCM_MAKINUM (fd);
} }
SCM_PROC (s_sys_soft_fileno, "soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
#ifdef __STDC__
SCM
scm_sys_soft_fileno (SCM port)
#else
SCM
scm_sys_soft_fileno (port)
SCM port;
#endif
{
int fd;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1)
SCM_SYSERROR (s_sys_soft_fileno);
return SCM_MAKINUM (fd);
}
SCM_PROC (s_sys_isatty, "isatty?", 1, 0, 0, scm_sys_isatty_p); SCM_PROC (s_sys_isatty, "isatty?", 1, 0, 0, scm_sys_isatty_p);
#ifdef __STDC__ #ifdef __STDC__
SCM SCM
@ -283,17 +262,21 @@ scm_sys_fdopen (fdes, modes)
{ {
FILE *f; FILE *f;
SCM port; SCM port;
struct scm_port_table * pt;
SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_sys_fdopen); SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_sys_fdopen);
SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_fdopen); SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_fdopen);
SCM_NEWCELL (port);
SCM_DEFER_INTS; SCM_DEFER_INTS;
f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes)); f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
if (f == NULL) if (f == NULL)
SCM_SYSERROR (s_sys_fdopen); SCM_SYSERROR (s_sys_fdopen);
SCM_NEWCELL (port); pt = scm_add_to_port_table (port);
SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes)); SCM_SETPTAB_ENTRY (port, pt);
SCM_SETSTREAM (port,(SCM)f); if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport
scm_add_to_port_table (port); | scm_mode_bits (SCM_CHARS (modes))))
scm_setbuf0 (port);
SCM_SETSTREAM (port, (SCM)f);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return port; return port;
} }
@ -301,8 +284,8 @@ scm_sys_fdopen (fdes, modes)
/* Move a port's underlying file descriptor to a given value. /* Move a port's underlying file descriptor to a given value.
* Returns 0 if fdes is already the given value. * Returns #f if fdes is already the given value.
* 1 if fdes moved. * #t if fdes moved.
* MOVE->FDES is implemented in Scheme and calls this primitive. * MOVE->FDES is implemented in Scheme and calls this primitive.
*/ */
SCM_PROC (s_sys_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes); SCM_PROC (s_sys_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
@ -330,7 +313,7 @@ scm_sys_primitive_move_to_fdes (port, fd)
if (old_fd == new_fd) if (old_fd == new_fd)
{ {
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_MAKINUM (0); return SCM_BOOL_F;
} }
scm_evict_ports (new_fd); scm_evict_ports (new_fd);
rv = dup2 (old_fd, new_fd); rv = dup2 (old_fd, new_fd);
@ -339,7 +322,7 @@ scm_sys_primitive_move_to_fdes (port, fd)
scm_setfileno (stream, new_fd); scm_setfileno (stream, new_fd);
SCM_SYSCALL (close (old_fd)); SCM_SYSCALL (close (old_fd));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_MAKINUM (1); return SCM_BOOL_T;
} }
#ifdef __STDC__ #ifdef __STDC__

View file

@ -438,9 +438,8 @@ scm_pt_member (member)
#endif #endif
/* Find a port in the table and return its revealed count. Return -1 /* Find a port in the table and return its revealed count.
* if the port isn't in the table (should not happen). Also used by Also used by the garbage collector.
* the garbage collector.
*/ */
#ifdef __STDC__ #ifdef __STDC__
int int
@ -468,14 +467,8 @@ scm_port_revealed (port)
SCM port; SCM port;
#endif #endif
{ {
int result;
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed); SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
return SCM_MAKINUM (scm_revealed_count (port));
if ((result = scm_revealed_count (port)) == -1)
return SCM_BOOL_F;
else
return SCM_MAKINUM (result);
} }
/* Set the revealed count for a port. */ /* Set the revealed count for a port. */
@ -495,7 +488,7 @@ scm_set_port_revealed_x (port, rcount)
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_REVEALED (port) = SCM_INUM (rcount); SCM_REVEALED (port) = SCM_INUM (rcount);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_BOOL_F; return SCM_UNSPECIFIED;
} }
/* scm_close_port /* scm_close_port