Use import-os-error-syscall to convert from os-error to syscall-error.

scsh/flock.scm

@@ -8,13 +8,8 @@
 ;;; C syscall interface
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign %set-lock/eintr (fd cmd type whence start len) 
+(import-os-error-syscall %set-lock (fd cmd type whence start len) "set_lock")
-  "set_lock")
+(import-os-error-syscall %get-lock (fd cmd type whence start len) "get_lock")
-(define-retrying-syscall %set-lock %set-lock/eintr)
-
-(define-stubless-foreign %get-lock/eintr (fd cmd type whence start len) 
-  "get_lock")
-(define-retrying-syscall %get-lock %get-lock/eintr)
 
 ;;; The LOCK record type
 ;;;;;;;;;;;;;;;;;;;;;;;;

scsh/network.scm

@@ -180,9 +180,7 @@
 		 (dup->outport port))))
     (make-socket pf in out)))
 
-(define-stubless-foreign %socket/eintr (pf type protocol) "scsh_socket")
+(import-os-error-syscall %socket (pf type protocol) "scsh_socket")
-
-(define-retrying-syscall %socket %socket/eintr)
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 ;;; close syscall
@@ -261,8 +259,7 @@
 	(else
 	 (%listen (socket->fdes sock) backlog))))
 
-(define-stubless-foreign %listen/eintr (sockfd backlog) "scsh_listen")
+(import-os-error-syscall %listen (sockfd backlog) "scsh_listen")
-(define-retrying-syscall %listen %listen/eintr)
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 ;;; accept syscall
@@ -329,8 +326,7 @@
 	(else
 	 (%shutdown (socket->fdes sock) how))))
 
-(define-stubless-foreign %shutdown/eintr (sockfd how) "scsh_shutdown")
+(import-os-error-syscall %shutdown (sockfd how) "scsh_shutdown")
-(define-retrying-syscall %shutdown %shutdown/eintr)
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 ;;; socketpair syscall

scsh/scsh-condition.scm

@@ -7,28 +7,20 @@
 
 (define syscall-error? (condition-predicate 'syscall-error))
 
-(define (errno-error errno syscall . stuff)
+(define (errno-error errno msg syscall . stuff)
-  (let ((msg (errno-msg errno)))
+  (apply signal 'syscall-error errno msg syscall stuff))
-    (apply (structure-ref exceptions signal-exception) 
+
-	   (enum op call-external-value) (enum exception os-error) 
-	   syscall errno msg stuff)))
 
 (define (with-errno-handler* handler thunk)
   (with-handler
     (lambda (condition more)
-      (if (and (exception? condition) (eq? (exception-reason condition) 
+      (if (syscall-error? condition)
-					   'os-error))
+	  (let ((stuff (condition-stuff condition)))
-	  (let ((stuff (exception-arguments condition)))
+	    (handler (car stuff)	; errno
-	    (handler (cadr stuff)	; errno
+		     (cdr stuff))))	; (msg syscall . packet)
-		     (list (caddr stuff)  ;msg
-			   (car stuff)    ;syscall
-			   (cdddr stuff) ;packet
-			   )))) ; (msg syscall . packet)
       (more))
     thunk))
 
-
-
 ;;; (with-errno-handler
 ;;;   ((errno data) ; These are vars bound in this scope.
 ;;;    ((errno/exist) . body1)

scsh/scsh.scm

@@ -874,7 +874,7 @@
 		 (let ((argv (list->vector (cons prog (map stringify arglist)))))
 		   (for-each (lambda (dir)
 			       (let ((binary (string-append dir "/" prog)))
-				 (%%exec/errno binary argv env)))
+				 (%%exec binary argv env)))
 			     (fluid exec-path-list)))))
 	   
 	   (error "No executable found." prog arglist))))))))

scsh/syscalls.scm

@@ -5,71 +5,56 @@
 
 ;;; Need to rationalise names here. getgid. get-gid. "effective" as morpheme?
 
-;;; Macro for converting syscalls that return error codes to ones that
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; raise exceptions on errors.
+;;; Import a C function and convert the exception os-error to a syscall-error
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; DEFINE-ERRNO-SYSCALL defines an error-signalling syscall procedure from 
-;;; one that returns an error code as its first return value -- #f for win,
-;;; errno for lose. If the error code is ERRNO/INTR (interrupted syscall),
-;;; we try again.
 ;;;
-;;; (define-errno-syscall (SYSCALL ARGS) SYSCALL/ERRNO . RET-VALS) ==>
+;;; 1.) Import a C function
+;;; 2.) Turn os-error into syscall-error
+;;; 3.) Retry on EINTR
+;;; The call/cc and the record is due to S48's broken exception system:
+;;; You can't throw an error within a handler
 ;;;
-;;; (define (SYSCALL . ARGS)
-;;;   (receive (err . RET-VALS) (SYSCALL/ERRNO . ARGS)
-;;;     (cond ((not err) (values . RET-VALS))		; Win
-;;;           ((= err errno/intr) (SYSCALL . ARGS))	; Retry
-;;;           (else (errno-error err SYSCALL . ARGS))))); Lose
 
-(define-syntax define-errno-syscall
+(define-record err
+  errno
+  msg
+  stuff)
+
+(define-syntax import-os-error-syscall
   (syntax-rules ()
-    ((define-errno-syscall (syscall arg ...) syscall/errno
+    ((import-os-error-syscall syscall (%arg ...) c-name)
-       ret-val ...)
+     (begin 
-     (define (syscall arg ...)
+       (import-lambda-definition syscall/eintr (%arg ...) c-name)
-       (receive (err ret-val ...) (syscall/errno arg ...)
+       (define (syscall %arg ...)
-         (cond ((not err) (values ret-val ...))			; Win
+	 (let ((arg %arg) ...)
-	       ((= err errno/intr) 
+	   (let ((res
-		(syscall arg ...))		; Retry
+		  (call-with-current-continuation
-	       (else (errno-error err syscall arg ...))))))	; Lose
+		   (lambda (k)
-
+		     (let loop ()
-    ;;; This case handles rest args
+		       (with-handler
-    ((define-errno-syscall (syscall . args) syscall/errno
+			(lambda (condition more)
-       ret-val ...)
+			  (if (and (exception? condition) (eq? (exception-reason condition) 
-     (define (syscall . args)
+							       'os-error))
-       (receive (err ret-val ...) (apply syscall/errno args)
+			      (let ((stuff (exception-arguments condition)))
-         (cond ((not err) (values ret-val ...))			; Win
+				(if (= (cadr stuff) errno/intr)
-	       ((= err errno/intr) 
+				    (loop)
-		(apply syscall args))	; Retry
+				    (k (make-err (cadr stuff)   ; errno
-	       (else (apply errno-error err syscall args)))))))); Lose
+						 (caddr stuff)  ;msg
-
+						 (cdddr stuff) ;packet
-;;; By the way, it would be better to insert a (LET LP () ...) for the
+						 )))) ; (msg syscall . packet)
-;;; the errno/intr retries, instead of calling the top-level definition
+			      (more)))
-;;; (because in Scheme you have to allow for the fact that top-level
+			(lambda ()
-;;; defns can be re-defined, so the compiler can't just turn it into a
+			  (syscall/eintr %arg ...)))))))) ;BOGUS
-;;; jump), but the brain-dead S48 byte-compiler will cons a closure for
+	     (if (err? res)
-;;; the LP loop, which means that little syscalls like read-char can cons
+		 (apply errno-error (err:errno res) (err:msg res) syscall 
-;;; like crazy. So I'm doing it this way. Ech.
+			(err:stuff res))
-
+		 res))))))))
-
-(define-syntax define-retrying-syscall
-  (syntax-rules ()
-   ((define-retrying-syscall syscall syscall/eintr)
-    (define (syscall . args)
-      (let loop ()
-	(with-errno-handler
-	 ((errno packet)
-	  ((errno/intr) (display "eintr")(loop)))
-	 (apply syscall/eintr args)))))))
   
 ;;; Process
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; we can't algin env here, because exec-path/env calls
 ;; %%exec/errno directly  F*&% *P
-(define-stubless-foreign %%exec/errno (prog argv env) "scheme_exec")
+(import-os-error-syscall %%exec (prog argv env) "scheme_exec")
-
-(define (%%exec prog argv env)
-  (errno-error (%%exec/errno prog argv env) %exec prog argv env)) ; cute.
 
 (define (%exec prog arg-list env)
   (let ((argv (mapv! stringify (list->vector arg-list)))
@@ -78,10 +63,10 @@
     (%%exec prog argv env)))
 
 
-(define-stubless-foreign exit/errno ; errno -- misnomer.
+(import-os-error-syscall exit/errno ; errno -- misnomer.
   (status) "scsh_exit")
 
-(define-stubless-foreign %exit/errno ; errno -- misnomer
+(import-os-error-syscall %exit/errno ; errno -- misnomer
   (status) "scsh__exit")
 
 (define (%exit . maybe-status)
@@ -89,21 +74,20 @@
   (error "Yikes! %exit returned."))
 
 
-(define-stubless-foreign %%fork () "scsh_fork")
+(import-os-error-syscall %%fork () "scsh_fork")
 
 ;;; Posix waitpid(2) call.
-(define-stubless-foreign %wait-pid/errno-list (pid options)
+(import-os-error-syscall %wait-pid/list (pid options) "wait_pid")
-  "wait_pid")
 
 (define (%wait-pid/errno pid options)
-  (apply values (%wait-pid/errno-list pid options)))
+  (apply values (%wait-pid/list pid options)))
 
 ;;; Miscellaneous process state
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; Working directory
 
-(define-stubless-foreign %chdir (directory) "scsh_chdir")
+(import-os-error-syscall %chdir (directory) "scsh_chdir")
 
 ;;; These calls change/reveal the process working directory
 ;;; 
@@ -113,30 +97,30 @@
     (%chdir (ensure-file-name-is-nondirectory dir))))
 
 ;; TODO: we get an error if cwd does not exist on startup
-(define-stubless-foreign process-cwd () "scheme_cwd")
+(import-os-error-syscall process-cwd () "scheme_cwd")
 
 ;;; GID
 
-(define-stubless-foreign user-gid  () "scsh_getgid")
+(import-os-error-syscall user-gid  () "scsh_getgid")
 
-(define-stubless-foreign user-effective-gid () "scsh_getegid")
+(import-os-error-syscall user-effective-gid () "scsh_getegid")
 
-(define-stubless-foreign set-gid (gid) "scsh_setgid")
+(import-os-error-syscall set-gid (gid) "scsh_setgid")
 
-(define-stubless-foreign set-effective-gid (gid) "scsh_setegid")
+(import-os-error-syscall set-effective-gid (gid) "scsh_setegid")
 
-(define-stubless-foreign user-supplementary-gids () "get_groups")
+(import-os-error-syscall user-supplementary-gids () "get_groups")
 
 ;;; UID
-(define-stubless-foreign user-uid  () "scsh_getuid")
+(import-os-error-syscall user-uid  () "scsh_getuid")
 
-(define-stubless-foreign user-effective-uid () "scsh_geteuid")
+(import-os-error-syscall user-effective-uid () "scsh_geteuid")
 
-(define-stubless-foreign set-uid (uid) "scsh_setuid")
+(import-os-error-syscall set-uid (uid) "scsh_setuid")
 
-(define-stubless-foreign set-effective-uid (uid) "scsh_seteuid")
+(import-os-error-syscall set-effective-uid (uid) "scsh_seteuid")
 
-(import-lambda-definition %user-login-name () "my_username")
+(import-os-error-syscall %user-login-name () "my_username")
  
 (define (user-login-name)
   (or (%user-login-name)
@@ -144,17 +128,14 @@
 
 ;;; PID
 
-(define-stubless-foreign pid () "scsh_getpid")
+(import-os-error-syscall pid () "scsh_getpid")
-(define-stubless-foreign parent-pid () "scsh_getppid")
+(import-os-error-syscall parent-pid () "scsh_getppid")
 ;;; Process groups and session ids
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign process-group () "scsh_getpgrp")
+(import-os-error-syscall process-group () "scsh_getpgrp")
 
-(define-stubless-foreign %set-process-group/eintr
+(import-os-error-syscall %set-process-group (pid groupid) "setpgid")
-  (pid groupid) "setpgid")
-
-(define-retrying-syscall %set-process-group %set-process-group/eintr)
 
 (define (set-process-group arg1 . maybe-arg2)
   (receive (pid pgrp) (if (null? maybe-arg2)
@@ -163,12 +144,11 @@
 	   (%set-process-group pid pgrp)))
 
 
-(define-stubless-foreign become-session-leader/eintr () "scsh_setsid")
+(import-os-error-syscall become-session-leader () "scsh_setsid")
-(define-retrying-syscall become-session-leader become-session-leader/eintr)
 
 ;;; UMASK
 
-(define-stubless-foreign set-process-umask (mask) "scsh_umask")
+(import-os-error-syscall set-process-umask (mask) "scsh_umask")
 
 (define (process-umask)
   (let ((m (set-process-umask 0)))
@@ -181,13 +161,12 @@
 ;;; OOPS: The POSIX times() has a mildly useful ret value we are throwing away.
 
 
-(define-stubless-foreign process-times/eintr-list () "process_times")
+(import-os-error-syscall process-times/list () "process_times")
 
 (define (process-times)
-  (define-retrying-syscall process-times/list process-times/eintr-list)
   (apply values (process-times/list)))
 
-(define-stubless-foreign cpu-ticks/sec () "cpu_clock_ticks_per_sec")
+(import-os-error-syscall cpu-ticks/sec () "cpu_clock_ticks_per_sec")
 
 ;;; File system
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -200,11 +179,9 @@
       (call/fdes thing fd-op)))
 
 
-(define-stubless-foreign %set-file-mode/eintr (path mode) "scsh_chmod")
+(import-os-error-syscall %set-file-mode (path mode) "scsh_chmod")
-(define-retrying-syscall %set-file-mode %set-file-mode/eintr)
 
-(define-stubless-foreign %set-fdes-mode/eintr (path mode) "scsh_fchmod")
+(import-os-error-syscall %set-fdes-mode (path mode) "scsh_fchmod")
-(define-retrying-syscall %set-fdes-mode %set-fdes-mode/eintr)
 
 (define (set-file-mode thing mode)
   (generic-file-op thing
@@ -212,11 +189,9 @@
 		   (lambda (fname) (%set-file-mode fname mode))))
 
 
-(define-stubless-foreign set-file-uid&gid/eintr (path uid gid) "scsh_chown")
+(import-os-error-syscall set-file-uid&gid (path uid gid) "scsh_chown")
-(define-retrying-syscall set-file-uid&gid set-file-uid&gid/eintr)
 
-(define-stubless-foreign set-fdes-uid&gid/eintr (fd uid gid) "scsh_fchown")
+(import-os-error-syscall set-fdes-uid&gid (fd uid gid) "scsh_fchown")
-(define-retrying-syscall set-fdes-uid&gid set-fdes-uid&gid/eintr)
 
 (define (set-file-owner thing uid)
   (generic-file-op thing
@@ -231,7 +206,7 @@
 
 ;;; Uses real uid and gid, not effective. I don't use this anywhere.
 
-(define-stubless-foreign %file-ruid-access-not? (path perms) "scsh_access")
+(import-os-error-syscall %file-ruid-access-not? (path perms) "scsh_access")
 
 ;(define (file-access? path perms)
 ;  (not (%file-access-not? path perms)))
@@ -246,35 +221,27 @@
 ;  (file-access? fname 4))
 
 
-(define-stubless-foreign create-hard-link/eintr (original-name new-name) 
+(import-os-error-syscall %create-hard-link (original-name new-name) 
   "scsh_link")
-(define-retrying-syscall %create-hard-link create-hard-link/eintr)
 
-(define-stubless-foreign create-fifo/eintr (path mode) "scsh_mkfifo")
+(import-os-error-syscall %create-fifo (path mode) "scsh_mkfifo")
-(define-retrying-syscall %create-fifo create-fifo/eintr)
 
-(define-stubless-foreign create-directory/eintr (path mode) "scsh_mkdir")
+(import-os-error-syscall %%create-directory (path mode) "scsh_mkdir")
-(define-retrying-syscall %%create-directory create-directory/eintr)
 
 (define (%create-directory path . maybe-mode)
   (let ((mode (:optional maybe-mode #o777))
 	(fname (ensure-file-name-is-nondirectory path)))
     (%%create-directory fname mode)))
 
-(define-stubless-foreign read-symlink/eintr (path) "scsh_readlink")
+(import-os-error-syscall read-symlink (path) "scsh_readlink")
-(define-retrying-syscall read-symlink read-symlink/eintr)
 
-(define-stubless-foreign %rename-file/eintr (old-name new-name) "scsh_rename")
+(import-os-error-syscall %rename-file (old-name new-name) "scsh_rename")
-(define-retrying-syscall %rename-file %rename-file/eintr)
 
-(define-stubless-foreign delete-directory/eintr (path) "scsh_rmdir")
+(import-os-error-syscall delete-directory (path) "scsh_rmdir")
-(define-retrying-syscall delete-directory delete-directory/eintr)
 
-(define-stubless-foreign %utime/eintr (path ac m) "scm_utime") 
+(import-os-error-syscall %utime (path ac m) "scm_utime") 
-(define-retrying-syscall %utime %utime/eintr)
 
-(define-stubless-foreign %utime-now/eintr (path) "scm_utime_now")
+(import-os-error-syscall %utime-now (path) "scm_utime_now")
-(define-retrying-syscall %utime-now %utime-now/eintr)		
 
 ;;; (SET-FILE-TIMES path [access-time mod-time])
 
@@ -292,11 +259,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; STAT
 
-(define-stubless-foreign stat-file/eintr (path data chase?) "scheme_stat")
+(import-os-error-syscall stat-file (path data chase?) "scheme_stat")
-(define-retrying-syscall stat-file stat-file/eintr)
 
-(define-stubless-foreign stat-fdes/eintr (fd data) "scheme_fstat")
+(import-os-error-syscall stat-fdes (fd data) "scheme_fstat")
-(define-retrying-syscall stat-fdes stat-fdes/eintr)
 
 (define-record file-info
   type
@@ -351,28 +316,23 @@
 ;;; "no-declare" as there is no agreement among the OS's as to whether or not
 ;;; the OLD-NAME arg is "const". It *should* be const.
 
-(define-stubless-foreign create-symlink/eintr (old-name new-name) "scsh_symlink")
+(import-os-error-syscall %create-symlink (old-name new-name) "scsh_symlink")
-(define-retrying-syscall %create-symlink create-symlink/eintr)
   
 ;;; "no-declare" as there is no agreement among the OS's as to whether or not
 ;;; the PATH arg is "const". It *should* be const.
 
-(define-stubless-foreign %truncate-file/eintr (path length) "scsh_truncate")
+(import-os-error-syscall %truncate-file (path length) "scsh_truncate")
-(define-retrying-syscall %truncate-file %truncate-file/eintr)
 
-(define-stubless-foreign %truncate-fdes/eintr (path length) "scsh_ftruncate")
+(import-os-error-syscall %truncate-fdes (path length) "scsh_ftruncate")
-(define-retrying-syscall %truncate-fdes %truncate-fdes/eintr)
 
 (define (truncate-file thing length)
   (generic-file-op thing
 		   (lambda (fd)    (%truncate-fdes fd    length))
 		   (lambda (fname) (%truncate-file fname length))))
 
-(define-stubless-foreign delete-file/eintr (path) "scsh_unlink")
+(import-os-error-syscall delete-file (path) "scsh_unlink")
-(define-retrying-syscall delete-file delete-file/eintr)
 
-(define-stubless-foreign %sync-file/eintr (fd) "scsh_fsync")
+(import-os-error-syscall %sync-file (fd) "scsh_fsync")
-(define-retrying-syscall %sync-file %sync-file/eintr)
 
 (define (sync-file fd/port)
   (if (output-port? fd/port) (force-output fd/port))
@@ -380,23 +340,18 @@
 
 
 ;;; Amazingly bogus syscall -- doesn't *actually* sync the filesys.
-(define-stubless-foreign sync-file-system () "scsh_sync")
+(import-os-error-syscall sync-file-system () "scsh_sync")
 
 ;;; I/O
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign %close-fdes/eintr (fd) "scsh_close")
+(import-os-error-syscall %close-fdes (fd) "scsh_close")
-(define-retrying-syscall %close-fdes %close-fdes/eintr)
 
-(define-stubless-foreign %dup/eintr (fd) "scsh_dup")
+(import-os-error-syscall %dup (fd) "scsh_dup")
-(define-retrying-syscall %dup %dup/eintr)
 
-(define-stubless-foreign %dup2/eintr (fd-from fd-to) "scsh_dup2")
+(import-os-error-syscall %dup2 (fd-from fd-to) "scsh_dup2")
-(define-retrying-syscall %dup2 %dup2/eintr)
 
-
+(import-os-error-syscall %fd-seek (fd offset whence) "scsh_lseek")
-(define-stubless-foreign %fd-seek/eintr (fd offset whence) "scsh_lseek")
-(define-retrying-syscall %fd-seek %fd-seek/eintr)
 
 
 (define seek/set 0)			;Unix codes for "whence"
@@ -412,11 +367,9 @@
   (let ((fd (if (integer? fd/port) fd/port (port->fdes fd/port))))
     (%fd-seek fd 0 seek/delta)))
 
-(define-stubless-foreign %char-ready-fdes?/eintr (fd) "char_ready_fdes")
+(import-os-error-syscall %char-ready-fdes? (fd) "char_ready_fdes")
-(define-retrying-syscall  %char-ready-fdes? %char-ready-fdes?/eintr)
 
-(define-stubless-foreign %open/eintr (path flags mode) "scsh_open")
+(import-os-error-syscall %open (path flags mode) "scsh_open")
-(define-retrying-syscall %open %open/eintr)
 
 (define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
     (with-cwd-aligned
@@ -424,8 +377,7 @@
       (%open path flags (:optional maybe-mode #o666)))))
 
 
-(define-stubless-foreign pipe-fdes/eintr () "scheme_pipe")
+(import-os-error-syscall pipe-fdes () "scheme_pipe")
-(define-retrying-syscall pipe-fdes pipe-fdes/eintr)
 
 (define (pipe)
   (apply (lambda (r-fd w-fd)
@@ -439,8 +391,7 @@
 ;;; Signals (rather incomplete)
 ;;; ---------------------------
 
-(define-stubless-foreign signal-pid/eintr (pid signal) "scsh_kill")
+(import-os-error-syscall signal-pid (pid signal) "scsh_kill")
-(define-retrying-syscall signal-pid signal-pid/eintr)
 
 (define (signal-process proc signal)
   (signal-pid (cond ((proc? proc)    (proc:pid proc))
@@ -479,12 +430,12 @@
    (list "user-info" (user-info:name ui))))
 
 
-(import-lambda-definition 
+(import-os-error-syscall
  %uid->user-info 
  (uid user-info-record)
  "user_info_uid")
 
-(import-lambda-definition 
+(import-os-error-syscall
  %name->user-info 
  (name user-info-record)
  "user_info_name")
@@ -529,12 +480,12 @@
   ;; Make group-info records print like #{group-info wheel}.
   ((disclose gi) (list "group-info" (group-info:name gi))))
 
-(import-lambda-definition 
+(import-os-error-syscall
  %gid->group-info 
  (gid group-info-record)
  "group_info_gid")
 
-(import-lambda-definition 
+(import-os-error-syscall
  %name->group-info 
  (name group-info-record)
  "group_info_name")
@@ -568,8 +519,7 @@
 ;;; Directory stuff
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign %open-dir/eintr (dir-name) "open_dir")
+(import-os-error-syscall %open-dir (dir-name) "open_dir")
-(define-retrying-syscall %open-dir %open-dir/eintr)
 
 (define (directory-files . args)
   (with-cwd-aligned
@@ -649,7 +599,7 @@
 
 ;;; ENV->ALIST
 
-(define-stubless-foreign %load-env () "scm_envvec")
+(import-os-error-syscall %load-env () "scm_envvec")
 
 (define (environ-env->alist) 
   (let ((env-list.envvec (%load-env)))
@@ -660,30 +610,27 @@
 ;;; ALIST->ENV
 
 ;;; (%create-env ((vector 'X) -> address))
-(define-stubless-foreign %create-env (envvec) "create_env")
+(import-os-error-syscall %create-env (envvec) "create_env")
 
 ;;; assumes aligned env
 (define (envvec-alist->env alist)
   (%create-env (alist->env-vec alist)))
 
-(define-stubless-foreign %align-env (envvec) "align_env")
+(import-os-error-syscall %align-env (envvec) "align_env")
 
-(define-stubless-foreign %free-env (envvec) "free_envvec")
+(import-os-error-syscall %free-env (envvec) "free_envvec")
 
 
 ;;; Fd-ports
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign %set-cloexec/eintr (fd val) "set_cloexec")
+(import-os-error-syscall %set-cloexec (fd val) "set_cloexec")
-(define-retrying-syscall %set-cloexec %set-cloexec/eintr)
 
 ;;; Some of fcntl()
 ;;;;;;;;;;;;;;;;;;;
 
-(define-stubless-foreign %fcntl-read/eintr (fd command) "fcntl_read")
+(import-os-error-syscall %fcntl-read (fd command) "fcntl_read")
-(define-retrying-syscall %fcntl-read %fcntl-read/eintr)
+(import-os-error-syscall %fcntl-write (fd command val) "fcntl_write")
-(define-stubless-foreign %fcntl-write/eintr (fd command val) "fcntl_write")
-(define-retrying-syscall %fcntl-write %fcntl-write/eintr)
 
 ;;; fcntl()'s F_GETFD and F_SETFD.  Note that the SLEAZY- prefix on the
 ;;; CALL/FDES isn't an optimisation; it's *required* for the correct behaviour
@@ -728,16 +675,15 @@
     (let lp ()
       (or (%sleep-until when) (lp)))))
 
-(define-stubless-foreign %sleep-until (secs) "sleep_until")
+(import-os-error-syscall %sleep-until (secs) "sleep_until")
 
-(define-stubless-foreign %gethostname/eintr () "scm_gethostname")
+(import-os-error-syscall %gethostname () "scm_gethostname")
-(define-retrying-syscall %gethostname %gethostname/eintr)
 
 (define system-name %gethostname)
 
-(define-stubless-foreign errno-msg (i) "errno_msg")
+(import-os-error-syscall errno-msg (i) "errno_msg")
 
-(define-stubless-foreign %crypt (key salt) "scm_crypt")
+(import-os-error-syscall %crypt (key salt) "scm_crypt")
 
 (define (crypt key salt)
   (let* ((allowed-char-set  (rx (| alpha digit "." "/")))

scsh/time.scm

@@ -93,8 +93,7 @@
 ; C fun is OS-dependent
 ; TODO: all C files are identical, so move it to time1.c
 ; returns (list secs ticks)
-(define-stubless-foreign %time+ticks/eintr () "time_plus_ticks")
+(import-os-error-syscall %time+ticks () "time_plus_ticks")
-(define-retrying-syscall %time+ticks %time+ticks/eintr)
 
 (define (time+ticks)
   (apply values (%time+ticks)))
@@ -102,15 +101,13 @@
 (define (time+ticks->time secs ticks)
   (+ secs (/ ticks (ticks/sec))))
 
-(define-stubless-foreign %time/eintr () "scheme_time")
+(import-os-error-syscall %time () "scheme_time")
-(define-retrying-syscall %time %time/eintr)
 
-(define-stubless-foreign %date->time/eintr
+(import-os-error-syscall %date->time
   (sec min hour month-day month year
        tz-name	; #f or string
        tz-secs	; #f or int
        summer?) "date2time")
-(define-retrying-syscall %date->time %date->time/eintr)
 
 (define (time . args) ; optional arg [date]
   (if (pair? args)
@@ -131,8 +128,7 @@
 
 ;;; Date
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-stubless-foreign %time->date/eintr (time zone) "time2date")
+(import-os-error-syscall %time->date (time zone) "time2date")
-(define-retrying-syscall %time->date %time->date/eintr)
 
 (define (date . args)	; Optional args [time zone]
   (let ((time (if (pair? args)
@@ -176,12 +172,10 @@
     (cond ((not result) (error "~ without argument in format-date" fmt))
 	  (else result))))
 
-(define-stubless-foreign %format-date/eintr 
+(import-os-error-syscall %format-date 
   (fmt seconds minute hour month-day month year tz-name summer? week-day 
        year-day)
   "format_date")
-(define-retrying-syscall %format-date %format-date/eintr)
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

scsh/tty.scm

@@ -122,9 +122,8 @@
 		      (char->ascii (string-ref control-chars ttychar/time))))
      (sleazy-call/fdes fdport (lambda (fd) (%tty-info fd control-chars))))))
 
-(define-stubless-foreign %tty-info/eintr (fdes control-chars) 
+(import-os-error-syscall %tty-info (fdes control-chars) 
   "scheme_tcgetattr")
-(define-retrying-syscall %tty-info %tty-info/eintr)
 
 
 ;;; JMG: I don't know what the purpose of this code is...
@@ -182,11 +181,10 @@
 		      (tty-info:time info))))))
 
 
-(define-stubless-foreign %set-tty-info/eintr
+(import-os-error-syscall %set-tty-info
   (fdes option control-chars iflag oflag cflag lflag ispeed-code ospeed-code 
 	min time)
   "scheme_tcsetattr")
-(define-retrying-syscall %set-tty-info %set-tty-info/eintr)
 
 ;;; Exported procs
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -209,9 +207,8 @@
     (lambda (fdes)
       (%send-tty-break-fdes fdes (:optional maybe-duration 0)))))
 
-(define-stubless-foreign %send-tty-break-fdes/eintr (fdes duration) 
+(import-os-error-syscall %send-tty-break-fdes (fdes duration) 
   "sch_tcsendbreak")
-(define-retrying-syscall %send-tty-break-fdes %send-tty-break-fdes/eintr)
 
 ;;; Drain the main vein.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -223,8 +220,7 @@
 	 (sleazy-call/fdes fdport %tcdrain))
 	(else (error "Illegal argument to DRAIN-TTY" fdport))))
 
-(define-stubless-foreign %tcdrain/eintr (fdes) "sch_tcdrain")
+(import-os-error-syscall %tcdrain (fdes) "sch_tcdrain")
-(define-retrying-syscall %tcdrain %tcdrain/eintr)
 
 ;;; Flushing the device queues. (tcflush)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -239,8 +235,7 @@
 (define flush-tty/output (make-tty-flusher %flush-tty/output))
 (define flush-tty/both   (make-tty-flusher %flush-tty/both))
 
-(define-stubless-foreign %tcflush/eintr (fdes flag) "sch_tcflush")
+(import-os-error-syscall %tcflush (fdes flag) "sch_tcflush")
-(define-retrying-syscall %tcflush %tcflush/eintr)
 
 ;;; Stopping and starting I/O (tcflow)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -256,8 +251,7 @@
 (define start-tty-input  (make-flow-controller %tcflow/start-in))
 (define stop-tty-input   (make-flow-controller %tcflow/stop-in))
 
-(define-stubless-foreign %tcflow/eintr (fdes action) "sch_tcflow")
+(import-os-error-syscall %tcflow (fdes action) "sch_tcflow")
-(define-retrying-syscall %tcflow %tcflow/eintr)
 
 ;;; Baud rate translation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -287,14 +281,12 @@
 				     proc-group
 				     (proc:pid proc-group))))))
 
-(define-stubless-foreign %set-tty-process-group/eintr (fdes pid) "sch_tcsetpgrp")
+(import-os-error-syscall %set-tty-process-group (fdes pid) "sch_tcsetpgrp")
-(define-retrying-syscall %set-tty-process-group %set-tty-process-group/eintr)
 
 (define (tty-process-group port/fd)
   (sleazy-call/fdes port/fd %tty-process-group))
 
-(define-stubless-foreign %tty-process-group/eintr (fdes) "sch_tcgetpgrp")
+(import-os-error-syscall %tty-process-group (fdes) "sch_tcgetpgrp")
-(define-retrying-syscall %tty-process-group %tty-process-group/eintr)
 
 ;;; (open-control-tty fname [flags])
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -314,8 +306,7 @@
 	     make-output-fdport)
 	 fd 1))))
 
-(define-stubless-foreign %open-control-tty/eintr (ttyname flags) "open_ctty")
+(import-os-error-syscall %open-control-tty (ttyname flags) "open_ctty")
-(define-retrying-syscall %open-control-tty %open-control-tty/eintr)
 
 ;;; Random bits & pieces: isatty ttyname ctermid
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -323,14 +314,11 @@
 ;;; (tty-file-name fd/port) -> string
 ;;; (control-tty-file-name) -> string
 
-(define-stubless-foreign %tty?/eintr (fd) "sch_isatty")
+(import-os-error-syscall %tty? (fd) "sch_isatty")
-(define-retrying-syscall %tty? %tty?/eintr)
 (define (tty? fd/port) (sleazy-call/fdes fd/port %tty?))
 
-(define-stubless-foreign %tty-file-name/eintr (fd) "sch_ttyname")
+(import-os-error-syscall %tty-file-name (fd) "sch_ttyname")
-(define-retrying-syscall %tty-file-name %tty-file-name/eintr)
 
 (define (tty-file-name fd/port) (sleazy-call/fdes fd/port %tty-file-name))
 
-(define-stubless-foreign %ctermid/eintr () "scm_ctermid")
+(import-os-error-syscall control-tty-file-name () "scm_ctermid")
-(define-retrying-syscall control-tty-file-name %ctermid/eintr)