diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 9a7a983..f74fd2a 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -42,7 +42,7 @@ ;;; we try again. ;;; ;;; (define-errno-syscall (SYSCALL ARGS) SYSCALL/ERRNO . RET-VALS) ==> -;;; +;;; ;;; (define (SYSCALL . ARGS) ;;; (receive (err . RET-VALS) (SYSCALL/ERRNO . ARGS) ;;; (cond ((not err) (values . RET-VALS)) ; Win @@ -58,9 +58,7 @@ (cond ((not err) (values ret-val ...)) ; Win ((= err errno/intr) (syscall arg ...)) ; Retry - (else (error "syscallerror (this is a JMGhack)" err syscall)))))) ; Lose - -; (else (errno-error err syscall arg ...)))))) ; Lose + (else (errno-error err syscall arg ...)))))) ; Lose ;;; This case handles rest args ((define-errno-syscall (syscall . args) syscall/errno @@ -70,9 +68,7 @@ (cond ((not err) (values ret-val ...)) ; Win ((= err errno/intr) (apply syscall args)) ; Retry - (else (error "syscallerror (this is a JMGhack)" err syscall )))))))) ; Lose - -; (else (apply errno-error err syscall args)))))))); Lose + (else (apply errno-error err syscall args)))))))); Lose ;;; By the way, it would be better to insert a (LET LP () ...) for the ;;; the errno/intr retries, instead of calling the top-level definition @@ -90,7 +86,7 @@ (scheme_exec (string prog) (vector-desc argv) (desc env)) ; string vector or #t. - integer) + fixnum) (define (%%exec prog argv env) (errno-error (%%exec/errno prog argv env) %exec prog argv env)) ; cute. @@ -103,11 +99,11 @@ (define-foreign exit/errno ; errno -- misnomer. - (exit (integer status)) + (exit (fixnum status)) ignore) (define-foreign %exit/errno ; errno -- misnomer - (_exit (integer status)) + (_exit (fixnum status)) ignore) (define (%exit . maybe-status) @@ -138,10 +134,10 @@ pid) ;;; Posix waitpid(2) call. -(define-foreign %wait-pid/errno (wait_pid (integer pid) (integer options)) +(define-foreign %wait-pid/errno (wait_pid (pid_t pid) (fixnum options)) desc ; errno or #f - integer ; process' id - integer) ; process' status + pid_t ; process' id + fixnum) ; process' status ;;; Miscellaneous process state @@ -151,7 +147,7 @@ (define-foreign %chdir/errno (chdir (string directory)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (%chdir dir) %chdir/errno) @@ -163,7 +159,7 @@ (define-foreign cwd/errno (scheme_cwd) - (to-scheme integer "False_on_zero") ; errno or #f + (to-scheme fixnum "False_on_zero") ; errno or #f string) ; directory (or #f on error) (define-errno-syscall (cwd) cwd/errno @@ -176,17 +172,17 @@ (define-foreign user-effective-gid (getegid) gid_t) (define-foreign set-gid/errno (setgid (gid_t id)) no-declare ; for SunOS 4.x - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (set-gid gid) set-gid/errno) (define-foreign %num-supplementary-gids/errno (num_supp_groups) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (multi-rep (to-scheme fixnum errno_or_false) + gid_t)) (define-foreign load-groups/errno (get_groups (vector-desc group-vec)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (multi-rep (to-scheme fixnum errno_or_false) + fixnum)) (define (user-supplementary-gids) (receive (err numgroups) (%num-supplementary-gids/errno) @@ -203,7 +199,7 @@ (define-foreign user-effective-uid (geteuid) uid_t) (define-foreign set-uid/errno (setuid (uid_t id)) no-declare ; for SunOS 4.x - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (set-uid uid_t) set-uid/errno) @@ -226,7 +222,7 @@ (define-foreign process-group (getpgrp) pid_t) (define-foreign %set-process-group/errno (setpgid (pid_t pid) (pid_t groupid)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (%set-process-group pid pgrp) %set-process-group/errno) @@ -265,10 +261,10 @@ (define-foreign process-times/errno (process_times) (to-scheme integer errno_or_false) - integer ; user cpu time - integer ; system cpu time - integer ; user cpu time for me and all my descendants. - integer) ; system cpu time for me and all my descendants. + clock_t ; user cpu time + clock_t ; system cpu time + clock_t ; user cpu time for me and all my descendants. + clock_t) ; system cpu time for me and all my descendants. (define-errno-syscall (process-times) process-times/errno utime stime cutime cstime) @@ -288,16 +284,16 @@ (define-foreign set-file-mode/errno (chmod (string path) (mode_t mode)) no-declare ; integer on SunOS - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) ; IBM's AIX include files declare fchmod(char*, mode_t). ; Amazing, but true. So we must prevent this def-foreign from issuing ; the conflicting, correct declaration. Hence the NO-DECLARE. (define-foreign set-fdes-mode/errno - (fchmod (integer fd) (mode_t mode)) ; integer on SunOS + (fchmod (fixnum fd) (mode_t mode)) ; integer on SunOS no-declare ; Workaround for AIX bug. - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (set-file-mode thing mode) (lambda (thing mode) @@ -309,11 +305,11 @@ ;;; NO-DECLARE: gcc unistd.h bogusness. (define-foreign set-file-uid&gid/errno (chown (string path) (uid_t uid) (gid_t gid)) no-declare - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-foreign set-fdes-uid&gid/errno - (fchown (integer fd) (uid_t uid) (gid_t gid)) - (to-scheme integer errno_or_false)) + (fchown (fixnum fd) (uid_t uid) (gid_t gid)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (set-file-owner thing uid) (lambda (thing uid) @@ -350,7 +346,7 @@ (define-foreign create-hard-link/errno (link (string original-name) (string new-name)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (create-hard-link original-name new-name) create-hard-link/errno) @@ -358,14 +354,14 @@ (define-foreign create-fifo/errno (mkfifo (string path) (mode_t mode)) no-declare ; integer on SunOS - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (create-fifo path mode) create-fifo/errno) (define-foreign create-directory/errno (mkdir (string path) (mode_t mode)) no-declare ; integer on SunOS. - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define (create-directory path . maybe-mode) (let ((mode (:optional maybe-mode #o777)) @@ -385,7 +381,7 @@ (define-foreign %rename-file/errno (rename (string old-name) (string new-name)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (%rename-file old-name new-name) %rename-file/errno) @@ -393,7 +389,7 @@ (define-foreign delete-directory/errno (rmdir (string path)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (delete-directory path) delete-directory/errno) @@ -401,10 +397,10 @@ (define-foreign %utime/errno (scm_utime (string path) (time_t ac) (time_t m)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-foreign %utime-now/errno (scm_utime_now (string path)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) ;;; (SET-FILE-TIMES/ERRNO path [access-time mod-time]) @@ -428,13 +424,13 @@ (define-foreign stat-file/errno (scheme_stat (string path) (vector-desc data) (bool chase?)) - (to-scheme integer "False_on_zero")) ; errno or #f + (to-scheme fixnum "False_on_zero")) ; errno or #f ;(define-errno-syscall (stat-file fd data chase?) stat-file/errno) (define-foreign stat-fdes/errno (scheme_fstat (integer fd) (vector-desc data)) - (to-scheme integer "False_on_zero")) ; errno or #f + (to-scheme fixnum "False_on_zero")) ; errno or #f ;(define-errno-syscall (stat-fdes fd data) stat-fdes/errno) @@ -455,14 +451,7 @@ ;;; Should be redone to return multiple-values. (define (file-info/errno fd/port/fname chase?) - (let ((ans-vec (make-vector 14)) - (time-hack (lambda (lo-24 hi-8) - (let ((val (+ (arithmetic-shift hi-8 24) lo-24))) - (if (zero? (bitwise-and hi-8 #x80)) val - ;; Oops -- it's a negative 32-bit value. - ;; Or in all the sign bits. - (bitwise-ior (bitwise-not #xffffffff) - val))))) + (let ((ans-vec (make-vector 11)) (file-type (lambda (type-code) (vector-ref '#(block-special char-special directory fifo regular socket symlink) @@ -483,12 +472,10 @@ (vector-ref ans-vec 5) (vector-ref ans-vec 6) (vector-ref ans-vec 7) - (time-hack (vector-ref ans-vec 8) - (vector-ref ans-vec 9)) - (time-hack (vector-ref ans-vec 10) - (vector-ref ans-vec 11)) - (time-hack (vector-ref ans-vec 12) - (vector-ref ans-vec 13)))))))) + (vector-ref ans-vec 8) + (vector-ref ans-vec 9) + (vector-ref ans-vec 10))))))) + (define (file-info fd/port/fname . maybe-chase?) (let ((chase? (:optional maybe-chase? #t))) @@ -506,7 +493,7 @@ (define-foreign create-symlink/errno (symlink (string old-name) (string new-name)) no-declare - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) ;(define-errno-syscall (create-symlink old-name new-name) ; create-symlink/errno) @@ -517,11 +504,11 @@ (define-foreign truncate-file/errno (truncate (string path) (off_t length)) no-declare - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-foreign truncate-fdes/errno - (ftruncate (integer fd) (off_t length)) no-declare ; Indigo bogosity. - (to-scheme integer errno_or_false)) + (ftruncate (fixnum fd) (off_t length)) no-declare ; Indigo bogosity. + (to-scheme fixnum errno_or_false)) (define-errno-syscall (truncate-file path length) (lambda (thing length) @@ -532,13 +519,13 @@ (define-foreign delete-file/errno (unlink (string path)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (delete-file path) delete-file/errno) -(define-foreign sync-file/errno (fsync (integer fd)) - (to-scheme integer errno_or_false)) +(define-foreign sync-file/errno (fsync (fixnum fd)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (sync-file fd/port) (lambda (fd/port) @@ -554,8 +541,8 @@ ;;; I/O ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-foreign %close-fdes/errno (close (integer fd)) - (to-scheme integer "errno_or_false")) +(define-foreign %close-fdes/errno (close (fixnum fd)) + (to-scheme fixnum "errno_or_false")) (define (%close-fdes fd) (let lp () @@ -567,24 +554,24 @@ (errno-error errno %close-fdes fd)))))) ; You lose. (define-foreign %dup/errno - (dup (integer fd)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (dup (fixnum fd)) + (multi-rep (to-scheme fixnum errno_or_false) + fixnum)) (define-errno-syscall (%dup fd) %dup/errno new-fd) (define-foreign %dup2/errno - (dup2 (integer fd-from) (integer fd-to)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (dup2 (fixnum fd-from) (fixnum fd-to)) + (multi-rep (to-scheme fixnum errno_or_false) + fixnum)) (define-errno-syscall (%dup2 fd-from fd-to) %dup2/errno new-fd) (define-foreign %fd-seek/errno - (lseek (integer fd) (off_t offset) (integer whence)) + (lseek (fixnum fd) (off_t offset) (fixnum whence)) (multi-rep (to-scheme off_t errno_or_false) off_t)) @@ -606,7 +593,7 @@ (if err (errno-error err tell fd/port) offset)))) (define-foreign %char-ready-fdes?/errno - (char_ready_fdes (integer fd)) + (char_ready_fdes (fixnum fd)) desc) ; errno, #t, or #f (define (%char-ready-fdes? fd) @@ -617,11 +604,11 @@ (define-foreign %open/errno (open (string path) - (integer flags) + (fixnum flags) (mode_t mode)) ; integer on SunOS no-declare ; NOTE - (multi-rep (to-scheme integer errno_or_false) - integer)) + (multi-rep (to-scheme fixnum errno_or_false) + fixnum)) (define-errno-syscall (%open path flags mode) %open/errno fd) @@ -631,9 +618,9 @@ (define-foreign pipe-fdes/errno (scheme_pipe) - (to-scheme integer "False_on_zero") ; Win: #f, lose: errno - integer ; r - integer) ; w + (to-scheme fixnum "False_on_zero") ; Win: #f, lose: errno + fixnum ; r + fixnum) ; w (define-errno-syscall (pipe-fdes) pipe-fdes/errno r w) @@ -647,7 +634,7 @@ (values r w)))) (define-foreign %read-fdes-char - (read_fdes_char (integer fd)) + (read_fdes_char (fixnum fd)) desc) ; Char or errno or #f (eof). (define (read-fdes-char fd) @@ -655,8 +642,8 @@ (if (integer? c) (errno-error c read-fdes-char fd) c))) -(define-foreign write-fdes-char/errno (write_fdes_char (char char) (integer fd)) - (to-scheme integer errno_or_false)) +(define-foreign write-fdes-char/errno (write_fdes_char (char char) (fixnum fd)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (write-fdes-char char fd) write-fdes-char/errno) @@ -666,27 +653,27 @@ (define-foreign read-fdes-substring!/errno (read_fdes_substring (string-desc buf) - (integer start) - (integer end) - (integer fd)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (size_t start) + (size_t end) + (fixnum fd)) + (multi-rep (to-scheme fixnum errno_or_false) + ssize_t)) (define-foreign write-fdes-substring/errno (write_fdes_substring (string-desc buf) - (integer start) - (integer end) - (integer fd)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (size_t start) + (size_t end) + (fixnum fd)) + (multi-rep (to-scheme fixnum errno_or_false) + ssize_t)) ;;; Signals (rather incomplete) ;;; --------------------------- (define-foreign signal-pid/errno - (kill (pid_t pid) (integer signal)) - (to-scheme integer errno_or_false)) + (kill (pid_t pid) (fixnum signal)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (signal-pid pid signal) signal-pid/errno) @@ -786,14 +773,14 @@ bool ; win? static-string ; name (C char**) ; members - integer) ; num members + fixnum) ; num members (define-foreign %name->group-info (group_info_name (string name)) bool ; win? integer ; gid (C char**) ; members - integer) ; num members + fixnum) ; num members (define (gid->group-info gid) (receive (win? name members nmembers) @@ -831,14 +818,14 @@ (define-foreign %open-dir (open_dir (string dir-name)) (to-scheme integer "False_on_zero") ; Win: #f, lose: errno (C char**) ; Vector of strings - integer) ; Length of strings + fixnum) ; Length of strings ;;; Takes a null-terminated C vector of strings -- filenames. ;;; Sorts them in place by the Unix filename order: ., .., dotfiles, others. (define-foreign %sort-file-vector (scm_sort_filevec ((C "const char** ~a") cvec) - (integer veclen)) + (fixnum veclen)) ignore) (define (directory-files . args) @@ -942,7 +929,7 @@ ;;; putenv takes a constant: const char *, cig can't figure that out.. (define-foreign putenv/errno (putenv (string-copy var=val)) no-declare - (to-scheme integer errno_on_nonzero_or_false)) ; #f or errno + (to-scheme fixnum errno_on_nonzero_or_false)) ; #f or errno (define-foreign delete-env (delete_env (string var)) ignore) @@ -960,19 +947,19 @@ ;;; Fd-ports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-foreign %set-cloexec (set_cloexec (integer fd) (bool val)) - (to-scheme integer "errno_or_false")) +(define-foreign %set-cloexec (set_cloexec (fixnum fd) (bool val)) + (to-scheme fixnum "errno_or_false")) ;;; Some of fcntl() ;;;;;;;;;;;;;;;;;;; (define-foreign %fcntl-read/errno (fcntl_read (fixnum fd) (fixnum command)) - (multi-rep (to-scheme integer errno_or_false) - integer)) + (multi-rep (to-scheme fixnum errno_or_false) + fixnum)) (define-foreign %fcntl-write/errno (fcntl_write (fixnum fd) (fixnum command) (fixnum val)) - (to-scheme integer errno_or_false)) + (to-scheme fixnum errno_or_false)) (define-errno-syscall (%fcntl-read fd command) %fcntl-read/errno value) (define-errno-syscall (%fcntl-write fd command val) %fcntl-write/errno) diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index de9637e..8849354 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -247,7 +247,8 @@ int scheme_cwd(const char **dirp) ** but cig can't handle it. */ -int process_times(int *utime, int *stime, int *cutime, int *cstime) +int process_times(clock_t *utime, clock_t *stime, + clock_t *cutime, clock_t *cstime) { struct tms tms; clock_t t = times(&tms); @@ -292,12 +293,12 @@ s48_value read_fdes_char(int fd) int write_fdes_char(char c, int fd) {return write(fd, &c, 1);} -int read_fdes_substring(s48_value buf, int start, int end, int fd) +ssize_t read_fdes_substring(s48_value buf, size_t start, size_t end, int fd) { return read(fd, StrByte(buf,start), end-start); } -int write_fdes_substring(s48_value buf, int start, int end, int fd) +ssize_t write_fdes_substring(s48_value buf, size_t start, size_t end, int fd) { return write(fd, StrByte(buf,start), end-start); } @@ -336,7 +337,7 @@ static int really_stat(int retval, struct stat *s, s48_value vec) { int modes, typecode = -1; - if( 14 != S48_VECTOR_LENGTH(vec) ) return -1; + if( 11 != S48_VECTOR_LENGTH(vec) ) return -1; if( retval < 0 ) return errno; modes = s->st_mode; @@ -357,14 +358,9 @@ static int really_stat(int retval, struct stat *s, s48_value vec) S48_VECTOR_SET(vec,6, s48_enter_fixnum(s->st_gid)); S48_VECTOR_SET(vec,7, s48_enter_fixnum(s->st_size)); - S48_VECTOR_SET(vec,8, s48_enter_fixnum( low24(s->st_atime))); - S48_VECTOR_SET(vec,9, s48_enter_fixnum(hi_but24(s->st_atime))); - - S48_VECTOR_SET(vec,10, s48_enter_fixnum( low24(s->st_mtime))); - S48_VECTOR_SET(vec,11, s48_enter_fixnum(hi_but24(s->st_mtime))); - - S48_VECTOR_SET(vec,12, s48_enter_fixnum( low24(s->st_ctime))); - S48_VECTOR_SET(vec,13, s48_enter_fixnum(hi_but24(s->st_ctime))); + S48_VECTOR_SET(vec,8, s48_enter_integer(s->st_atime)); + S48_VECTOR_SET(vec,9, s48_enter_integer(s->st_mtime)); + S48_VECTOR_SET(vec,10, s48_enter_integer(s->st_ctime)); /* We also used to do st_rdev, st_blksize, and st_blocks. These aren't POSIX, and, e.g., are not around on SGI machines. diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h index 405d972..a5fface 100644 --- a/scsh/syscalls1.h +++ b/scsh/syscalls1.h @@ -14,7 +14,8 @@ int scm_utime_now(char const *path); int scheme_cwd(const char **dirp); -int process_times(int *utime, int *stime, int *cutime, int *cstime); +int process_times(clock_t *utime, clock_t *stime, + clock_t *cutime, clock_t *cstime); int cpu_clock_ticks_per_sec(); @@ -22,11 +23,11 @@ s48_value read_fdes_char(int fd); int write_fdes_char(char c, int fd); -int read_fdes_substring(s48_value buf, int start, int end, int fd); +ssize_t read_fdes_substring(s48_value buf, size_t start, size_t end, int fd); int read_stream_substring(s48_value buf, int start, int end, FILE *f); -int write_fdes_substring(s48_value buf, int start, int end, int fd); +ssize_t write_fdes_substring(s48_value buf, size_t start, size_t end, int fd); int write_stream_substring(s48_value buf, int start, int end, FILE *f);