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

1. Hacked fork so that if it fails and the zombie autoreap policy is 'early, 

we do a zombie-reap and then retry the fork. This way, if the fork fails
because the process table filled up, you can clean up and win.

It's not the right answer, but the right answer depends on handling SIGCHLD
interrupts, so we can't implement it now.

2. Hacked the optional arg handling to use the new LET-OPT machinery.
This commit is contained in:
shivers 1996-04-19 18:26:31 +00:00
parent 1a0d6a2af4
commit 6b42e9d7aa
1 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scsh/syscalls.scm
View File

@ -117,7 +117,7 @@
ignore)
(define (%exit . maybe-status)
(%exit/errno (optional-arg maybe-status 0))
(%exit/errno (:optional maybe-status 0))
(error "Yikes! %exit returned."))
@ -125,9 +125,22 @@
(multi-rep (to-scheme pid_t errno_or_false)
pid_t))
(define-errno-syscall (%%fork) %%fork/errno
pid)
;;; If the fork fails, and we are doing early zombie reaping, then reap
;;; some zombies to try and free up a some space in the process table,
;;; and try again.
;;;
;;; This ugly little hack will have to stay in until I do early
;;; zombie reaping with SIGCHLD interrupts.
(define (%%fork-with-retry/errno)
(receive (err pid) (%%fork/errno)
(cond ((and err (eq? 'early (autoreap-policy)))
(reap-zombies)
(%%fork/errno))
(else (values err pid)))))
(define-errno-syscall (%%fork) %%fork-with-retry/errno
pid)
;;; Posix waitpid(2) call.
(define-foreign %wait-pid/errno (wait_pid (integer pid) (integer options))
@ -148,7 +161,7 @@
(define-simple-errno-syscall (%chdir dir) %chdir/errno)
(define (chdir . maybe-dir)
(let ((dir (optional-arg maybe-dir ".")))
(let ((dir (:optional maybe-dir ".")))
(%chdir (ensure-file-name-is-nondirectory dir))))
@ -358,7 +371,7 @@
(to-scheme integer errno_or_false))
(define (create-directory path . maybe-mode)
(let ((mode (optional-arg maybe-mode #o777))
(let ((mode (:optional maybe-mode #o777))
(fname (ensure-file-name-is-nondirectory path)))
(cond ((create-directory/errno fname mode) =>
(lambda (err)
@ -481,7 +494,7 @@
(vector-ref ans-vec 13))))))))
(define (file-info fd/port/fname . maybe-chase?)
(let ((chase? (optional-arg maybe-chase? #t)))
(let ((chase? (:optional maybe-chase? #t)))
(receive (err info) (file-info/errno fd/port/fname chase?)
(if err (errno-error err file-info fd/port/fname chase?)
info))))
@ -585,7 +598,7 @@
(define seek/end 2)
(define (seek fd/port offset . maybe-whence)
(let ((whence (optional-arg maybe-whence seek/set)))
(let ((whence (:optional maybe-whence seek/set)))
(receive (err cursor)
((if (integer? fd/port) %fd-seek/errno %fdport-seek/errno)
fd/port
@ -622,7 +635,7 @@
fd)
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
(%open path flags (optional-arg maybe-mode #o666)))
(%open path flags (:optional maybe-mode #o666)))
(define-foreign pipe-fdes/errno (scheme_pipe)
@ -837,8 +850,8 @@
ignore)
(define (directory-files . args)
(receive (dir dotfiles?)
(parse-optionals args "." #f)
(let-optionals args ((dir ".")
(dotfiles? #f))
(check-arg string? dir directory-files)
(receive (err cvec numfiles)
(%open-dir (ensure-file-name-is-nondirectory dir))
@ -850,7 +863,7 @@
files))))))
(define (match-files regexp . maybe-dir)
(let ((dir (optional-arg maybe-dir ".")))
(let ((dir (:optional maybe-dir ".")))
(check-arg string? dir match-files)
(receive (err cvec numfiles)
(%open-dir (ensure-file-name-is-nondirectory dir))