replaced integer by fixnum and removed 32-bit hacks
This commit is contained in:
marting
parent
6cc6334039
commit
2b3cb928b5
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue