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:
parent
2e18892a89
commit
8b13c6b392
6 changed files with 64 additions and 53 deletions
|
@ -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.
|
||||||
|
|
|
@ -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}
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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__
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue