- Improved CLOEXEC support for unrevealed ports.

- sleazy-call/fdes useage introduced for speed.
- fcntl support added.

scsh/syscalls.scm

@@ -92,7 +92,6 @@
 	(prog (stringify prog))
 	(env (if (eq? env #t) #t
 		 (list->vector (alist->env-list env)))))
-    (cloexec-unrevealed-ports)
     (%%exec prog argv env)))
 
 
@@ -534,7 +533,7 @@
 (define-errno-syscall (sync-file fd/port)
   (lambda (fd/port)
     (if (output-port? fd/port) (force-output fd/port))
-    (call/fdes fd/port sync-file/errno)))
+    (sleazy-call/fdes fd/port sync-file/errno)))
 
 
 ;;; Amazingly bogus syscall -- doesn't *actually* sync the filesys.
@@ -1019,19 +1018,16 @@
   (set_fdbuf (desc data) (integer policy) (integer size))
   (to-scheme integer "False_on_zero"))	; errno
 
+(define-foreign %set-cloexec (set_cloexec (integer fd) (bool val))
+  (to-scheme integer "errno_or_false"))
+
 (define-foreign %init-fdports! (init_fdports) ignore)
 
-(define-foreign %cloexec-unrevealed-ports (cloexec_unrevealed) desc)
-
-(define (cloexec-unrevealed-ports)
-  ;; Loop if interrupted.
-  (and (%cloexec-unrevealed-ports) (cloexec-unrevealed-ports)))
-
 (define-foreign %install-port/errno
-  (install_port (integer fd) (desc port))
+  (install_port (integer fd) (desc port) (integer revealed))
   (to-scheme integer "False_on_zero")) ; Win: #f, lose: errno
   
-(define-errno-syscall (%install-port fd port) %install-port/errno)
+(define-errno-syscall (%install-port fd port revealed) %install-port/errno)
 
 
 (define-foreign %maybe-fdes->port (maybe_fdes2port (integer fd))
@@ -1076,10 +1072,31 @@
 (define-errno-syscall (%fcntl-read fd command) %fcntl-read/errno value)
 (define-errno-syscall (%fcntl-write fd command val) %fcntl-write/errno)
 
-(define (i/o-flags fd/port)
-  (call/fdes fd/port
-    (lambda (fd) (%fcntl-read fd fcntl/get-file-flags))))
+;;; fcntl()'s F_GETFD and F_SETFD.
+;;; Note that the SLEAZY- prefix on the CALL/FDES isn't an optimisation.
+;;; Straight CALL/FDES modifies unrevealed file descriptors by clearing
+;;; their CLOEXEC bit when it reveals them -- so it would interfere with
+;;; the reading.
 
+(define (fdes-flags fd/port)
+  (sleazy-call/fdes fd/port
+    (lambda (fd) (%fcntl-read fd fcntl/get-fdes-flags))))
+
+(define (set-fdes-flags fd/port flags)
+  (sleazy-call/fdes fd/port
+    (lambda (fd) (%fcntl-write fd fcntl/set-fdes-flags flags))))
+
+;;; fcntl()'s F_GETFL and F_SETFL.
+;;; Get: Returns open flags + get-status flags (below)
+;;; Set: append, sync, async, nbio, nonblocking, no-delay
+
+(define (fdes-status fd/port)
+  (sleazy-call/fdes fd/port
+    (lambda (fd) (%fcntl-read fd fcntl/get-status-flags))))
+
+(define (set-fdes-status fd/port flags)
+  (sleazy-call/fdes fd/port
+    (lambda (fd) (%fcntl-write fd fcntl/set-status-flags flags))))
 
 ;;; Miscellaneous
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

scsh/syscalls1.c

@@ -147,6 +147,20 @@ int scm_utime(char const *path, int ac_hi, int ac_lo, int mod_hi, int mod_lo)
 int scm_utime_now(char const *path) {return utime(path, 0);}
 
 
+int set_cloexec(int fd, int val)
+{
+  int flags = fcntl(fd, F_GETFD);
+  if( flags == -1 ) return errno;
+  val = -val;	/* 0 -> 0 and 1 -> -1 */
+
+  /* If it's already what we want, just return. */
+  if( (flags & FD_CLOEXEC) == (FD_CLOEXEC & val) ) return 0;
+
+  flags = (flags & ~FD_CLOEXEC) | (val & FD_CLOEXEC);
+  return fcntl(fd, F_SETFD, flags) ? errno : 0;
+  }
+
+
 /* Two versions of CWD
 *******************************************************************************
 */