scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Hacked I/O system so that ports set/clear their 

fd's CLOEXEC bit when they become unrevealed/revealed.
This commit is contained in:
shivers 1996-09-12 01:43:53 +00:00
parent aed6c163b8
commit 70a1342cef
47 changed files with 336 additions and 557 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
scsh/aix/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o100) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/aix/errno.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1993 by Olin Shivers.
;;; AIX version by Chipsy Sperber
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

42
scsh/aix/fdflags.scm
View File

@ -2,12 +2,7 @@
;;; Copyright (c) 1993 by Olin Shivers.
;;; AIX version by Chipsy Sperber
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
@ -26,19 +21,28 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;; These are internal; they are not part of the supported scsh interface.
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
(define fcntl/close-on-exec 1)
;;; fcntl fdes-flags (F_GETFD)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-record-lock 5) ; F_GETLK
(define fcntl/set-record-lock-noblock 6) ; F_SETLK
(define fcntl/set-record-lock 7) ; F_SETLKW
(define fdflags/close-on-exec 1)
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ' F_UNLCK
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/aix/signals.scm
View File

@ -3,14 +3,9 @@
;;; Copyright (c) 1994 by Brian D. Carlstrom.
;;; AIX version by Chipsy Sperber
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here.
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

7
scsh/cxux/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/cxux/errno.scm
View File

@ -3,14 +3,9 @@
;;; These are the correct values for a Harris NightHawk running CX/UX
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
(perm 1)
(noent 2)
(srch 3)

7
scsh/cxux/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)

7
scsh/cxux/signals.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here.
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

22
scsh/fdports.scm
View File

@ -25,7 +25,7 @@
target)
((fdport? fd/port)
(call/fdes fd/port doit)
(sleazy-call/fdes fd/port doit)
(if (%move-fdport target fd/port 1)
(error "fdport shift failed."))
fd/port)
@ -37,7 +37,7 @@
(check-arg fd/port? fd/port input-source?)
(or (input-port? fd/port)
(and (integer? fd/port)
(let ((access (bitwise-and open/access-mask (i/o-flags fd/port))))
(let ((access (bitwise-and open/access-mask (fdes-status fd/port))))
(or (= access open/read)
(= access open/read+write))))))
@ -45,7 +45,7 @@
(check-arg fd/port? fd/port output-source?)
(or (output-port? fd/port)
(and (integer? fd/port)
(let ((access (bitwise-and open/access-mask (i/o-flags fd/port))))
(let ((access (bitwise-and open/access-mask (fdes-status fd/port))))
(or (= access open/write)
(= access open/read+write))))))
@ -61,24 +61,22 @@
fd/port maybe-target))
(define (dup->fdes fd/port . maybe-target)
(check-arg fd/port? fd/port dup)
(check-arg fd/port? fd/port dup->fdes)
(if (pair? maybe-target)
(let ((target (car maybe-target)))
(close-fdes target) ; Thus evicting any port there.
(call/fdes fd/port (lambda (fd) (%dup2 fd target))))
(call/fdes fd/port %dup)))
(sleazy-call/fdes fd/port (lambda (fd) (%dup2 fd target))))
(sleazy-call/fdes fd/port %dup)))
(define (dup->inport fd/port . maybe-target)
(apply really-dup->port fdes->inport fd/port maybe-target))
(apply really-dup->port make-input-fdport fd/port maybe-target))
(define (dup->outport fd/port . maybe-target)
(apply really-dup->port fdes->outport fd/port maybe-target))
(apply really-dup->port make-output-fdport fd/port maybe-target))
(define (really-dup->port port-maker fd/port . maybe-target)
(let ((new-port (port-maker (apply dup->fdes fd/port maybe-target))))
(if (null? maybe-target) (release-port-handle new-port))
new-port))
(let ((fd (apply dup->fdes fd/port maybe-target)))
(port-maker fd (if (null? maybe-target) 0 1))))
;;; Not exported.

6
scsh/fdports1.c
View File

@ -224,7 +224,7 @@ scheme_value cloexec_unrevealed(void)
}
int install_port(int fd, scheme_value port)
int install_port(int fd, scheme_value port, int revealed)
{
FILE *stream;
const char *modestr;
@ -236,6 +236,9 @@ int install_port(int fd, scheme_value port)
fdports[fd] = port;
if( !revealed )
if( set_cloexec(fd, 1) ) return errno;
if( fstar_cache[fd] ) return 0; /* A hack mainly for stdio. */
fstar_cache[fd] = stream = fdopen(fd, modestr);
@ -296,6 +299,7 @@ int move_fdport(int fd, scheme_value port, int new_revealed)
*PortData_OldRev(port_data) = ENTER_FIXNUM(EXTRACT_FIXNUM(*PortData_OldRev(port_data))+
EXTRACT_FIXNUM(*PortData_Rev(port_data)));
*PortData_Rev(port_data) = ENTER_FIXNUM(new_revealed);
if( !new_revealed ) return set_cloexec(fd, 1);
return 0;
}

4
scsh/fdports1.h
View File

@ -22,9 +22,7 @@ int set_fdbuf( scheme_value data, int policy, int bufsize );
int close_fdport(scheme_value port_data);
scheme_value cloexec_unrevealed(void);
int install_port(int fd, scheme_value port);
int install_port(int fd, scheme_value port, int revealed);
FILE *fdes2fstar(int fd);

7
scsh/generic/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/generic/errno.scm
View File

@ -3,14 +3,9 @@
;;; These are the correct values for my SparcStation.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

33
scsh/generic/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
@ -24,3 +19,29 @@
(define open/access-mask
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
;;; fcntl fdes-flags (F_GETFD)
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/generic/signals.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here.
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

7
scsh/hpux/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/hpux/errno.scm
View File

@ -4,14 +4,9 @@
;;; NOTE: When the hp9000s500 symbol is set, errno.h defines ENOMSG to be 250
;;; instead of 35. What to do? We go with 35 in this file.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
(perm 1) ; Not super-user
(noent 2) ; No such file or directory
(srch 3) ; No such process

44
scsh/hpux/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-opens form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
;; POSIX
(read 0)
(write 1)
@ -19,25 +14,34 @@
(exclusive #o2000)
;; NextStep
(sync #o100000)) ; Synchronous writes
(sync #o100000)) ; Synchronous writes
(define open/access-mask
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;; These are internal; they are not part of the supported scsh interface.
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
(define fcntl/close-on-exec 1)
;;; fcntl fdes-flags (F_GETFD)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-record-lock 5) ; F_GETLK
(define fcntl/set-record-lock-noblock 6) ; F_SETLK
(define fcntl/set-record-lock 7) ; F_SETLKW
(define fdflags/close-on-exec 1)
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ' F_UNLCK
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/hpux/signals.scm
View File

@ -2,12 +2,7 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
(define-signals
(define-enum-constants signal
(hup 1) ; floating point exception
(int 2) ; Interrupt
(quit 3) ; quit

7
scsh/irix/bufpol.scm
View File

@ -7,12 +7,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o100) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/irix/errno.scm
View File

@ -3,14 +3,9 @@
;;; These are the correct values for my SparcStation.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

43
scsh/irix/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
@ -25,16 +20,28 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
(define fcntl/close-on-exec 1)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-record-lock 5)
(define fcntl/set-record-lock-noblock 6)
(define fcntl/set-record-lock 7)
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
(define lock/read 1)
(define lock/write 2)
(define lock/release 3)
;;; fcntl fdes-flags (F_GETFD)
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/irix/signals.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here.
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

7
scsh/linux/bufpol.scm
View File

@ -7,12 +7,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line 1) ; _IOLBF
(none 2)) ; _IONBF

7
scsh/linux/errno.scm
View File

@ -4,14 +4,9 @@
;;; These are the correct values for Linux systems.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1 ); Operation Not Permitted

84
scsh/linux/fdflags.scm
View File

@ -2,12 +2,7 @@
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom
(define-syntax define-open-flags
(syntax-rules ()
((define-opens form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
;; POSIX
(read #x0000)
(write #x0001)
@ -16,8 +11,8 @@
(append #x0400) ; set append mode
;; Linux
(shlock #x0004) ; open with shared file lock
(exlock #x0008) ; open with exclusive file lock
(shared-lock #x0004) ; open with shared file lock
(exclusive-lock #x0008) ; open with exclusive file lock
(async #x2000) ; signal pgrep when data ready
(fsync #x1000) ; synchronus writes
@ -33,55 +28,30 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;;; fcntl
;;;; Rough sketch only. Will define a separate proc for each fcntl command.
;
;;;; fcntl commands
;dup
;
;get-flags ; Only gives close-on-exec bit.
;set-flags
;
;get-status ; Returns open flags + get-status flags (below)
;set-status ; Can set: append, sync, async, nbio, nonblocking, no-delay
;
;get-lock
;set-lock
;nonblocking-set-lock
;
;get-record-lock
;set-record-lock
;set-record-lock-noblock
;
;get-owner ; Not POSIX
;set-owner ; Not POSIX
;remote-set-lock ; Not POSIX
;nonblocking-remote-set-lock ; Not POSIX
;remote-get-lock ; Not POSIX
;
;;;; Flags
;
;close-on-exec ; get-flags
;
;async ; get-status
;no-delay ; get-status
;nbio ; get-status
;
;;; These are internal; they are not part of the supported scsh interface.
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 9) ; F_GETOWN (Not POSIX)
(set-owner 8) ; F_SETOWN (Not POSIX)
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
(define fcntl/close-on-exec 1)
;;; fcntl fdes-flags (F_GETFD)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-owner 9) ; Not POSIX
(define fcntl/set-owner 8) ; Not POSIX
(define fcntl/get-record-lock 5) ; F_GETLK
(define fcntl/set-record-lock-noblock 6) ; F_SETLK
(define fcntl/set-record-lock 7) ; F_SETLKW
(define fdflags/close-on-exec 1)
(define lock/read 0) ; F_RDLCK
(define lock/release 2) ; F_UNLCK
(define lock/write 1) ; F_WRLCK
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 0) ; F_RDLCK
(release 2) ; F_UNLCK
(write 1)) ; F_WRLCK

7
scsh/linux/signals.scm
View File

@ -2,12 +2,7 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1)
(int 2)

12
scsh/network.scm
View File

@ -150,9 +150,8 @@
(error "create-socket: integer arguments expected ~s ~s ~s"
pf type protocol)
(let* ((fd (%socket pf type protocol))
(in (make-input-fdport fd))
(in (make-input-fdport fd 0))
(out (dup->outport in)))
(%install-port fd in)
(make-socket pf in out)))))
(define-foreign %socket/errno
@ -252,9 +251,8 @@
(let* ((family (socket:family sock))
(name (make-addr family))
(fd (%accept (socket->fdes sock) family name))
(in (make-input-fdport fd))
(in (make-input-fdport fd 0))
(out (dup->outport in)))
(%install-port fd in)
(values (make-socket family in out)
(make-socket-address family name)))))
@ -340,12 +338,10 @@
(error "create-socket-pair: integer argument expected ~s" type)
(receive (s1 s2)
(%socket-pair type)
(let* ((in1 (make-input-fdport s1))
(let* ((in1 (make-input-fdport s1 0))
(out1 (dup->outport in1))
(in2 (make-input-fdport s2))
(in2 (make-input-fdport s2 0))
(out2 (dup->outport in2)))
(%install-port s1 in1)
(%install-port s2 in2)
(values (make-socket protocol-family/unix in1 out1)
(make-socket protocol-family/unix in2 out2))))))

68
scsh/newports.scm
View File

@ -6,20 +6,31 @@
fd ; Unix file descriptor - integer.
(closed? #f) ; Is port closed.
(peek-char #f)
(revealed 0) ; REVEALED & OLD-REVEALED are for keeping
revealed ; REVEALED & OLD-REVEALED are for keeping
(old-revealed 0)) ; track of whether the FD value has escaped.
;;; We could flush the PEEK-CHAR field and use stdio ungetc(), but it
;;; is only guaranteed for buffered streams. Too bad...
(define (make-input-fdport fd)
(make-extensible-input-port (make-fdport-data fd)
(define (alloc-input-fdport fd revealed)
(make-extensible-input-port (make-fdport-data fd revealed)
input-fdport-methods))
(define (make-output-fdport fd)
(make-extensible-output-port (make-fdport-data fd)
(define (alloc-output-fdport fd revealed)
(make-extensible-output-port (make-fdport-data fd revealed)
output-fdport-methods))
(define (make-input-fdport fd revealed)
(let ((p (alloc-input-fdport fd revealed)))
(%install-port fd p revealed)
p))
(define (make-output-fdport fd revealed)
(let ((p (alloc-output-fdport fd revealed)))
(%install-port fd p revealed)
p))
(define (fdport? x)
(cond ((or (and (extensible-input-port? x)
(extensible-input-port-local-data x))
@ -128,14 +139,12 @@
;;; ------------
(define (open-file fname flags . maybe-mode)
(let* ((fd (apply open-fdes fname flags maybe-mode))
(access (bitwise-and flags open/access-mask))
(port ((if (or (= access open/read) (= access open/read+write))
make-input-fdport
make-output-fdport)
fd)))
(%install-port fd port)
port))
(let ((fd (apply open-fdes fname flags maybe-mode))
(access (bitwise-and flags open/access-mask)))
((if (or (= access open/read) (= access open/read+write))
make-input-fdport
make-output-fdport)
fd 0)))
(define (open-input-file fname . maybe-flags)
(let ((flags (:optional maybe-flags 0)))
@ -154,8 +163,11 @@
(define (increment-revealed-count port delta)
(let* ((data (extensible-port-local-data port))
(count (fdport-data:revealed data)))
(set-fdport-data:revealed data (+ count delta))))
(count (fdport-data:revealed data))
(newcount (+ count delta)))
(set-fdport-data:revealed data newcount)
(if (and (zero? count) (> newcount 0)) ; We just became revealed,
(%set-cloexec (fdport-data:fd data) #f)))) ; so don't close on exec().
(define (release-port-handle port)
(check-arg fdport? port port->fdes)
@ -164,7 +176,10 @@
(if (zero? rev)
(set-fdport-data:old-revealed data
(- (fdport-data:old-revealed data) 1))
(set-fdport-data:revealed data (- rev 1)))))
(let ((new-rev (- rev 1)))
(set-fdport-data:revealed data new-rev)
(if (zero? new-rev) ; We just became unrevealed, so
(%set-cloexec (fdport-data:fd data) #t)))))); the fd can be closed on exec.
(define (port-revealed port)
(let ((count (fdport-data:revealed
@ -173,12 +188,11 @@
(and (not (zero? count)) count)))
(define (fdes->port fd port-maker) ; local proc.
(let ((port (or (%maybe-fdes->port fd)
(let ((port (port-maker fd)))
(%install-port fd port)
port))))
(increment-revealed-count port 1)
port))
(cond ((%maybe-fdes->port fd) =>
(lambda (p)
(increment-revealed-count p 1)
p))
(else (port-maker fd 1))))
(define (fdes->inport fd) (fdes->port fd make-input-fdport))
(define (fdes->outport fd) (fdes->port fd make-output-fdport))
@ -205,6 +219,14 @@
(else (error "Not a file descriptor or fdport." fd/port))))
;;; Don't mess with the revealed count in the port case
;;; -- just sneakily grab the fdes and run.
(define (sleazy-call/fdes fd/port proc)
(proc (cond ((integer? fd/port) fd/port)
((fdport? fd/port) (fdport-data:fd (fdport-data fd/port)))
(else (error "Not a file descriptor or fdport." fd/port)))))
;;; Random predicates and arg checkers
;;; ----------------------------------
@ -274,7 +296,7 @@
;;; If this fd has an associated input or output port,
;;; move it to a new fd, freeing this one up.
;;; Unitialized fdport in table is set to 0, does this mean
(define (evict-ports fd)
(cond ((%maybe-fdes->port fd) => ; Shouldn't bump the revealed count.
(lambda (port)

7
scsh/next/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/next/errno.scm
View File

@ -3,14 +3,9 @@
;;; These are the correct values for NextStep systems.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

81
scsh/next/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-opens form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
;; POSIX
(read 0)
(write 1)
@ -26,55 +21,31 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;;; fcntl
;;;; Rough sketch only. Will define a separate proc for each fcntl command.
;
;;;; fcntl commands
;dup
;
;get-flags ; Only gives close-on-exec bit.
;set-flags
;
;get-status ; Returns open flags + get-status flags (below)
;set-status ; Can set: append, sync, async, nbio, nonblocking, no-delay
;
;get-lock
;set-lock
;nonblocking-set-lock
;
;get-record-lock
;set-record-lock
;set-record-lock-noblock
;
;get-owner ; Not POSIX
;set-owner ; Not POSIX
;remote-set-lock ; Not POSIX
;nonblocking-remote-set-lock ; Not POSIX
;remote-get-lock ; Not POSIX
;
;;;; Flags
;
;close-on-exec ; get-flags
;
;async ; get-status
;no-delay ; get-status
;nbio ; get-status
;
;;; These are internal; they are not part of the supported scsh interface.
(define fcntl/close-on-exec 1)
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 5) ; F_GETOWN (Not POSIX)
(set-owner 6) ; F_SETOWN (Not POSIX)
(get-record-lock 7) ; F_GETLK
(set-record-lock-noblock 8) ; F_SETLK
(set-record-lock 9)) ; F_SETLKW
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-owner 5) ; Not POSIX
(define fcntl/set-owner 6) ; Not POSIX
(define fcntl/get-record-lock 7) ; F_GETLK
(define fcntl/set-record-lock-noblock 8) ; F_SETLK
(define fcntl/set-record-lock 9) ; F_SETLKW
;;; fcntl fdes-flags (F_GETFD)
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ' F_UNLCK
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/next/signals.scm
View File

@ -1,12 +1,7 @@
;;; Signal constant definitions for NextStep
;;; Copyright (c) 1994 by Olin Shivers.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

1
scsh/scsh.scm
View File

@ -657,7 +657,6 @@
;; Try each directory in PATH-LIST.
(let ((argv (list->vector (cons prog (map stringify arglist)))))
(cloexec-unrevealed-ports)
(for-each (lambda (dir)
(let ((binary (string-append dir "/" prog)))
(%%exec/errno binary argv env)))

7
scsh/solaris/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o100) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/solaris/errno.scm
View File

@ -4,14 +4,9 @@
;;; These are the correct values for my SparcStation.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Not Super-User
(noent 2) ; No Such File Or Directory

80
scsh/solaris/fdflags.scm
View File

@ -1,12 +1,8 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
;;; Modified for Solaris by tvb@math.ufl.edu
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
@ -25,58 +21,30 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;;; fcntl
;;;; Rough sketch only. Will define a separate proc for each fcntl command.
;
;;;; fcntl commands
;dup
;
;get-flags ; Only gives close-on-exec bit.
;set-flags
;
;get-status ; Returns open flags + get-status flags (below)
;set-status ; Can set: append, sync, async, nbio, nonblocking, no-delay
;
;get-lock
;set-lock
;nonblocking-set-lock
;
;get-record-lock
;set-record-lock
;
;get-owner ; Not POSIX
;set-owner ; Not POSIX
;remote-set-lock ; Not POSIX
;nonblocking-remote-set-lock ; Not POSIX
;remote-get-lock ; Not POSIX
;
;;;; Flags
;
;close-on-exec ; get-flags
;
;async ; get-status
;no-delay ; get-status
;nbio ; get-status
;
;lock/read ; set-lock
;lock/write ; set-lock
;lock/release ; set-lock
;;; These are internal; they are not part of the supported scsh interface.
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 23) ; F_GETOWN (Not Posix)
(set-owner 24) ; F_SETOWN (Not Posix)
(get-record-lock 5) ; F_GETLK
(set-record-lock-noblock 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
(define fcntl/close-on-exec 1)
;;; fcntl fdes-flags (F_GETFD)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-owner 23) ; F_GETOWN
(define fcntl/set-owner 24) ; F_SETOWN
(define fcntl/get-record-lock 5) ; F_GETLK
(define fcntl/set-record-lock-noblock 6) ; F_SETLK
(define fcntl/set-record-lock 7) ; F_SETLKW
(define fdflags/close-on-exec 1)
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ; F_UNLCK
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/solaris/signals.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Modified for Solaris by tvb@math.ufl.edu
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;; Adapted from signal.h - tvb
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; Hangup
(int 2) ; Interrupt (Rubout)

7
scsh/sunos/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/sunos/errno.scm
View File

@ -3,14 +3,9 @@
;;; These are the correct values for my SparcStation.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

82
scsh/sunos/fdflags.scm
View File

@ -1,12 +1,7 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
@ -25,59 +20,30 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;;; fcntl
;;;; Rough sketch only. Will define a separate proc for each fcntl command.
;
;;;; fcntl commands
;dup
;
;get-flags ; Only gives close-on-exec bit.
;set-flags
;
;get-status ; Returns open flags + get-status flags (below)
;set-status ; Can set: append, sync, async, nbio, nonblocking, no-delay
;
;get-lock
;set-lock
;nonblocking-set-lock
;
;get-record-lock
;set-record-lock
;set-record-lock-noblock
;
;get-owner ; Not POSIX
;set-owner ; Not POSIX
;remote-set-lock ; Not POSIX
;nonblocking-remote-set-lock ; Not POSIX
;remote-get-lock ; Not POSIX
;
;;;; Flags
;
;close-on-exec ; get-flags
;
;async ; get-status
;no-delay ; get-status
;nbio ; get-status
;
;lock/read ; set-lock
;lock/write ; set-lock
;lock/release ; set-lock
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 5) ; F_GETOWN (Not Posix)
(set-owner 6) ; F_SETOWN (Not Posix)
(get-record-lock 7) ; F_GETLK
(set-record-lock-noblock 8) ; F_SETLK
(set-record-lock 9)) ; F_SETLKW
;;; These are internal; they are not part of the supported scsh interface.
;;; fcntl fdes-flags (F_GETFD)
(define fcntl/close-on-exec 1)
(define fdflags/close-on-exec 1)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-owner 5) ; F_GETOWN
(define fcntl/set-owner 6) ; F_SETOWN
(define fcntl/get-record-lock 7) ; F_GETLK
(define fcntl/set-record-lock-noblock 8) ; F_SETLK
(define fcntl/set-record-lock 9) ; F_SETLKW
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ' F_UNLCK
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/sunos/signals.scm
View File

@ -1,14 +1,9 @@
;;; Signal constant definitions for Sun4
;;; Copyright (c) 1994 by Olin Shivers.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here, couldn't find signal.h for Sun4 -dalbertz
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt

30
scsh/tty.scm
View File

@ -109,7 +109,7 @@
(receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24
cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24
ispeed-code ospeed-code)
(call/fdes fdport (lambda (fd) (%tty-info fd control-chars)))
(sleazy-call/fdes fdport (lambda (fd) (%tty-info fd control-chars)))
(make-%tty-info control-chars
(bitwise-ior (arithmetic-shift iflag-hi8 24) iflag-lo24)
(bitwise-ior (arithmetic-shift oflag-hi8 24) oflag-lo24)
@ -161,7 +161,7 @@
(cflag-lo24 (bitwise-and cf #xffffff))
(lflag-hi8 (arithmetic-shift lf -24))
(lflag-lo24 (bitwise-and lf #xffffff)))
(call/fdes fdport
(sleazy-call/fdes fdport
(lambda (fd)
(%set-tty-info fd option
cc
@ -221,7 +221,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (send-tty-break fdport . maybe-duration)
(call/fdes fdport
(sleazy-call/fdes fdport
(lambda (fdes)
(%send-tty-break-fdes fdes (:optional maybe-duration 0)))))
@ -240,7 +240,7 @@
(cond ((integer? fdport) (%tcdrain fdport)) ; File descriptor.
((fdport? fdport) ; Scheme port -- flush first.
(force-output fdport)
(call/fdes fdport %tcdrain))
(sleazy-call/fdes fdport %tcdrain))
(else (error "Illegal argument to DRAIN-TTY" fdport))))
(define-errno-syscall (%tcdrain fdes) %tcdrain/errno)
@ -255,7 +255,7 @@
(define (make-tty-flusher flag)
(lambda (fdport)
(call/fdes fdport (lambda (fdes) (%tcflush fdes flag)))))
(sleazy-call/fdes fdport (lambda (fdes) (%tcflush fdes flag)))))
(define flush-tty/input (make-tty-flusher %flush-tty/input))
(define flush-tty/output (make-tty-flusher %flush-tty/output))
@ -274,7 +274,7 @@
(define (make-flow-controller action)
(lambda (fdport)
(call/fdes fdport (lambda (fdes) (%tcflow fdes action)))))
(sleazy-call/fdes fdport (lambda (fdes) (%tcflow fdes action)))))
(define start-tty-output (make-flow-controller %tcflow/start-out))
(define stop-tty-output (make-flow-controller %tcflow/stop-out))
@ -310,7 +310,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (set-tty-process-group port/fd proc-group)
(call/fdes port/fd
(sleazy-call/fdes port/fd
(lambda (fd)
(%set-tty-process-group fd (if (integer? proc-group)
proc-group
@ -325,7 +325,7 @@
(to-scheme integer errno_or_false))
(define (tty-process-group port/fd)
(call/fdes port/fd %tty-process-group))
(sleazy-call/fdes port/fd %tty-process-group))
(define-errno-syscall (%tty-process-group fd) %tty-process-group/errno
pid)
@ -348,14 +348,12 @@
(let lp ()
(receive (errno fd) (open-control-tty/errno ttyname flags)
(cond ((not errno)
(let* ((access (bitwise-and flags open/access-mask))
(port ((if (or (= access open/read)
(= access open/read+write))
make-input-fdport
make-output-fdport)
fd)))
(%install-port fd port)
port))
(let ((access (bitwise-and flags open/access-mask)))
((if (or (= access open/read)
(= access open/read+write))
make-input-fdport
make-output-fdport)
fd 1)))
((= errno/intr errno) (lp))
(else (errno-error errno open-control-tty ttyname flags)))))))

7
scsh/ultrix/bufpol.scm
View File

@ -6,12 +6,7 @@
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-syntax define-bufpols
(syntax-rules ()
((define-bufpols form ...)
(begin (define-enum-constant "bufpol" . form) ...))))
(define-bufpols
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line #o200) ; _IOLBF
(none 4)) ; _IONBF

7
scsh/ultrix/errno.scm
View File

@ -4,14 +4,9 @@
;;; These are the correct values for Ultrix.
(define-syntax define-errnos
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "errno" . form) ...))))
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-errnos
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory

44
scsh/ultrix/fdflags.scm
View File

@ -2,12 +2,7 @@
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-open-flags
(syntax-rules ()
((define-errnos form ...)
(begin (define-enum-constant "open" . form) ...))))
(define-open-flags
(define-enum-constants open
(read #o000)
(write #o001)
(read+write #o002)
@ -29,16 +24,29 @@
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
(define fcntl/close-on-exec 1)
(define fcntl/dupfd 0)
(define fcntl/get-fd-flags 1)
(define fcntl/set-fd-flags 2)
(define fcntl/get-file-flags 3)
(define fcntl/set-file-flags 4)
(define fcntl/get-record-lock 7) ; F_GETLK
(define fcntl/set-record-lock-noblock 8) ; F_SETLK
(define fcntl/set-record-lock 9) ; F_SETLKW
;;; fcntl() commands
(define lock/read 1) ; F_RDLCK
(define lock/write 2) ; F_WRLCK
(define lock/release 3) ; F_UNLCK
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-record-lock 7) ; F_GETLK
(set-record-lock-noblock 8) ; F_SETLK
(set-record-lock 9)) ; F_SETLKW
;;; fcntl fdes-flags (F_GETFD)
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

7
scsh/ultrix/signals.scm
View File

@ -2,14 +2,9 @@
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-syntax define-signals
(syntax-rules ()
((define-signals form ...)
(begin (define-enum-constant "signal" . form) ...))))
;;POSIX only defined here.
(define-signals
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt