/usr/share/scsh-0.6/misc/syscall.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Some Unix system calls. By no means all of them.
; Cf. external.c
(define pipe
(let ((s48_pipe (get-external "s48_pipe")))
(lambda ()
(let ((results (cons 0 0)))
(unix-system-call s48_pipe 'pipe results)
(values (car results) (cdr results))))))
(define waitpid
(let ((s48_waitpid (get-external "s48_waitpid")))
(lambda (pid options)
(let ((results (cons 0 0)))
(unix-system-call s48_waitpid 'waitpid results pid options)
(values (car results) (cdr results))))))
(define fork
(let ((s48_fork (get-external "s48_fork")))
(lambda ()
(let ((results (cons -2 #f)))
(unix-system-call s48_fork 'fork results)
(car results)))))
(define dup
(let ((s48_dup (get-external "s48_dup")))
(lambda (fd)
(let ((result (cons 0 0)))
(unix-system-call s48_dup 'dup result fd)
(car result)))))
(define close
(let ((s48_close (get-external "s48_close")))
(lambda (fd)
(unix-system-call s48_close 'close fd))))
(define execv
(let ((s48_execv (get-external "s48_execv")))
(lambda (path argv)
(unix-system-call s48_execv 'execv path argv)
(error "execv returned?" path argv))))
(define exit
(let ((s48_exit (get-external "s48_exit")))
(lambda args
(apply external-call s48_exit args)
(error "exit returned!?"))))
; Utility
(define (unix-system-call external id . args)
(let loop ()
(let ((errno (apply external-call external args)))
(if errno
(if (= errno 4) ;EINTR
(begin (warn "interrupted system call" id)
(loop))
(apply call-error (strerror errno) id args))
#t))))
; Utility for printing error messages
(define strerror
(let ((s48_strerror (get-external "s48_strerror")))
(lambda (n)
(let* ((s (make-string 100))
(l (external-call s48_strerror s n)))
(if (integer? l)
(substring s 0 l)
(call-error "miscellaneous error" strerror n))))))
; To coerce a file descriptor to a channel:
; ,open architecture channels
; (open-channel in-fd
; (enum open-channel-option
; raw-input-channel))
; (open-channel out-fd
; (enum open-channel-option
; raw-output-channel))
; To coerce a channel to a port:
; ,open i/o-internal
; (input-channel->port <channel> 1024) ; buffer size
; (output-channel->port <channel> 1024)
; The inverse operation is not available.
; To coerce a channel to a file descriptor:
; (vm-extension 30 channel) => fd
|