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

fd's CLOEXEC bit when they become unrevealed/revealed.

scsh/aix/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o100)	; _IOLBF
   (none		4))	; _IONBF

scsh/aix/errno.scm

@@ -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

scsh/aix/fdflags.scm

@@ -2,12 +2,7 @@
 ;;; Copyright (c) 1993 by Olin Shivers.
 ;;; AIX version by Chipsy Sperber
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-errnos form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   (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 fdflags/close-on-exec 		1)
-(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 lock/read	1)	; F_RDLCK
+;;; fcntl status-flags (F_GETFL)
-(define lock/write	2)	; F_WRLCK
+;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
-(define lock/release	3)	' F_UNLCK
+;;; (define fdstatus/... ...)
+
+;;; fcntl lock values.
+
+(define-enum-constants lock
+  (read	1)		; F_RDLCK
+  (write	2)	; F_WRLCK
+  (release	3))	; F_UNLCK

scsh/aix/signals.scm

@@ -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 

scsh/cxux/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/cxux/errno.scm

@@ -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)

scsh/cxux/fdflags.scm

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

scsh/cxux/signals.scm

@@ -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 

scsh/fdports.scm

@@ -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))))
+	(sleazy-call/fdes fd/port (lambda (fd) (%dup2 fd target))))
-      (call/fdes fd/port %dup)))
+      (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))))
+  (let ((fd (apply dup->fdes fd/port maybe-target)))
-    (if (null? maybe-target) (release-port-handle new-port))
+    (port-maker fd (if (null? maybe-target) 0 1))))
-    new-port))
-
 
 
 ;;; Not exported.

scsh/fdports1.c

@@ -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;
     }
 

scsh/fdports1.h

@@ -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 revealed);
-
-int install_port(int fd, scheme_value port);
 
 FILE *fdes2fstar(int fd);
 

scsh/generic/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/generic/errno.scm

@@ -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

scsh/generic/fdflags.scm

@@ -1,12 +1,7 @@
 ;;; Flags for open(2) and fcntl(2).
 ;;; Copyright (c) 1993 by Olin Shivers.
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-errnos form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   (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

scsh/generic/signals.scm

@@ -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 

scsh/hpux/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/hpux/errno.scm

@@ -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

scsh/hpux/fdflags.scm

@@ -1,12 +1,7 @@
 ;;; Flags for open(2) and fcntl(2).
 ;;; Copyright (c) 1993 by Olin Shivers.
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-opens form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   ;; 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 fdflags/close-on-exec 		1)
-(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 lock/read	1)	; F_RDLCK
+;;; fcntl status-flags (F_GETFL)
-(define lock/write	2)	; F_WRLCK
+;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
-(define lock/release	3)	' F_UNLCK
+;;; (define fdstatus/... ...)
+
+;;; fcntl lock values.
+
+(define-enum-constants lock
+  (read		1)	; F_RDLCK
+  (write	2)	; F_WRLCK
+  (release	3))	; F_UNLCK

scsh/hpux/signals.scm

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

scsh/irix/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o100)	; _IOLBF
   (none		4))	; _IONBF

scsh/irix/errno.scm

@@ -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

scsh/irix/fdflags.scm

@@ -1,12 +1,7 @@
 ;;; Flags for open(2) and fcntl(2).
 ;;; Copyright (c) 1993 by Olin Shivers.
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-errnos form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   (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)
+;;; fcntl() commands
-(define fcntl/dupfd			0)
+(define-enum-constants fcntl
-(define fcntl/get-fd-flags		1)
+  (dup-fdes			0)      ; F_DUPFD
-(define fcntl/set-fd-flags		2)
+  (get-fdes-flags		1)      ; F_GETFD
-(define fcntl/get-file-flags		3)
+  (set-fdes-flags		2)      ; F_SETFD
-(define fcntl/set-file-flags		4)
+  (get-status-flags		3)      ; F_GETFL
-(define fcntl/get-record-lock		5)
+  (set-status-flags		4)      ; F_SETFL
-(define fcntl/set-record-lock-noblock	6)
+  (get-record-lock		5)	; F_GETLK
-(define fcntl/set-record-lock		7)
+  (set-record-lock-noblock	6)	; F_SETLK
+  (set-record-lock		7))	; F_SETLKW
 
-(define lock/read	1)
+;;; fcntl fdes-flags (F_GETFD)
-(define lock/write	2)
+
-(define lock/release	3)
+(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

scsh/irix/signals.scm

@@ -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 

scsh/linux/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		1)	; _IOLBF
   (none		2))	; _IONBF

scsh/linux/errno.scm

@@ -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 

scsh/linux/fdflags.scm

@@ -2,12 +2,7 @@
 ;;; Copyright (c) 1993 by Olin Shivers.
 ;;; Copyright (c) 1994 by Brian D. Carlstrom
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-opens form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   ;; POSIX
   (read			#x0000)
   (write		#x0001)
@@ -16,8 +11,8 @@
   (append		#x0400)		; set append mode
   
   ;; Linux
-  (shlock		#x0004)		; open with shared file lock
+  (shared-lock		#x0004)		; open with shared file lock
-  (exlock		#x0008)		; open with exclusive 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
+;;; fcntl() commands
-;;;; Rough sketch only. Will define a separate proc for each fcntl command.
+(define-enum-constants fcntl
-;
+  (dup-fdes			0)      ; F_DUPFD
-;;;; fcntl commands
+  (get-fdes-flags		1)      ; F_GETFD
-;dup
+  (set-fdes-flags		2)      ; F_SETFD
-;
+  (get-status-flags		3)      ; F_GETFL
-;get-flags	; Only gives close-on-exec bit.
+  (set-status-flags		4)      ; F_SETFL
-;set-flags
+  (get-owner			9)	; F_GETOWN (Not POSIX)
-;
+  (set-owner			8)	; F_SETOWN (Not POSIX)
-;get-status	; Returns open flags + get-status flags (below)
+  (get-record-lock		5)	; F_GETLK
-;set-status	; Can set: append, sync, async, nbio, nonblocking, no-delay
+  (set-record-lock-noblock	6)	; F_SETLK
-;
+  (set-record-lock		7))	; F_SETLKW
-;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 fdes-flags (F_GETFD)
 
-(define fcntl/dupfd			0)
+(define fdflags/close-on-exec 		1)
-(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 lock/read	0)	; F_RDLCK
+;;; fcntl status-flags (F_GETFL)
-(define lock/release	2)	; F_UNLCK
+;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
-(define lock/write	1)	; F_WRLCK
+;;; (define fdstatus/... ...)
+
+;;; fcntl lock values.
+
+(define-enum-constants lock
+  (read		0)	; F_RDLCK
+  (release	2)	; F_UNLCK
+  (write	1))	; F_WRLCK

scsh/linux/signals.scm

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

scsh/network.scm

@@ -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))))))
 

scsh/newports.scm

@@ -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)
+(define (alloc-input-fdport fd revealed)
-  (make-extensible-input-port (make-fdport-data fd)
+  (make-extensible-input-port (make-fdport-data fd revealed)
 			      input-fdport-methods))
 
-(define (make-output-fdport fd)
+(define (alloc-output-fdport fd revealed)
-  (make-extensible-output-port (make-fdport-data fd)
+  (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))
+  (let ((fd (apply open-fdes fname flags maybe-mode))
-	 (access (bitwise-and flags open/access-mask))
+	(access (bitwise-and flags open/access-mask)))
-	 (port ((if (or (= access open/read) (= access open/read+write))
+    ((if (or (= access open/read) (= access open/read+write))
-		    make-input-fdport
+	 make-input-fdport
-		    make-output-fdport)
+	 make-output-fdport)
-		fd)))
+     fd 0)))
-    (%install-port fd port)
-    port))
 
 (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)))
+	 (count (fdport-data:revealed data))
-    (set-fdport-data:revealed data (+ count delta))))
+	 (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)
+  (cond  ((%maybe-fdes->port fd) =>
-		  (let ((port (port-maker fd)))
+	  (lambda (p)
-		    (%install-port fd port)
+	    (increment-revealed-count p 1)
-		    port))))
+	    p))
-    (increment-revealed-count port 1)
+	 (else (port-maker fd 1))))
-    port))
 
 (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) 

scsh/next/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/next/errno.scm

@@ -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

scsh/next/fdflags.scm

@@ -1,12 +1,7 @@
 ;;; Flags for open(2) and fcntl(2).
 ;;; Copyright (c) 1993 by Olin Shivers.
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-opens form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   ;; 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)
+;;; fcntl fdes-flags (F_GETFD)
-(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
 
-(define lock/read	1)	; F_RDLCK
+(define fdflags/close-on-exec 		1)
-(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

scsh/next/signals.scm

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

scsh/scsh.scm

@@ -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)))

scsh/solaris/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o100)	; _IOLBF
   (none		4))	; _IONBF

scsh/solaris/errno.scm

@@ -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		

scsh/solaris/fdflags.scm

@@ -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 fdflags/close-on-exec 		1)
-(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 lock/read	1)	; F_RDLCK
+;;; fcntl status-flags (F_GETFL)
-(define lock/write	2)	; F_WRLCK
+;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
-(define lock/release	3)	; F_UNLCK
+;;; (define fdstatus/... ...)
+
+;;; fcntl lock values.
+
+(define-enum-constants lock
+  (read		1)	; F_RDLCK
+  (write	2)	; F_WRLCK
+  (release	3))	; F_UNLCK

scsh/solaris/signals.scm

@@ -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)

scsh/sunos/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/sunos/errno.scm

@@ -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

scsh/sunos/fdflags.scm

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

scsh/sunos/signals.scm

@@ -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 

scsh/tty.scm

@@ -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))
+	       (let ((access (bitwise-and flags open/access-mask)))
-		      (port ((if (or (= access open/read)
+		 ((if (or (= access open/read)
-				     (= access open/read+write))
+			  (= access open/read+write))
-				 make-input-fdport
+		      make-input-fdport
-				 make-output-fdport)
+		      make-output-fdport)
-			     fd)))
+		  fd 1)))
-		 (%install-port fd port)
-		 port))
 	      ((= errno/intr errno) (lp))
 	      (else (errno-error errno open-control-tty ttyname flags)))))))
 

scsh/ultrix/bufpol.scm

@@ -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
+(define-enum-constants bufpol
-  (syntax-rules ()
-    ((define-bufpols form ...)
-     (begin (define-enum-constant "bufpol" . form) ...))))
-
-(define-bufpols
   (block	0)	; _IOFBF
   (line		#o200)	; _IOLBF
   (none		4))	; _IONBF

scsh/ultrix/errno.scm

@@ -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

scsh/ultrix/fdflags.scm

@@ -2,12 +2,7 @@
 ;;; Copyright (c) 1993 by Olin Shivers.
 ;;; Copyright (c) 1994 by Brian D. Carlstrom.
 
-(define-syntax define-open-flags
+(define-enum-constants open
-  (syntax-rules ()
-    ((define-errnos form ...)
-     (begin (define-enum-constant "open" . form) ...))))
-
-(define-open-flags
   (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)
+;;; fcntl() commands
-(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
 
-(define	lock/read 	1)	; F_RDLCK
+(define-enum-constants fcntl
-(define	lock/write 	2)	; F_WRLCK
+  (dup-fdes 			0)      ; F_DUPFD
-(define	lock/release 	3)	; F_UNLCK
+  (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

scsh/ultrix/signals.scm

@@ -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