replaced integer by fixnum and removed 32-bit hacks

scsh/syscalls.scm

@@ -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
+  pid_t  ; process' id
-  integer) ; process' status
+  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)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     gid_t))
 
 (define-foreign load-groups/errno (get_groups (vector-desc group-vec))
-  (multi-rep (to-scheme integer errno_or_false)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     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
+  clock_t	; user   cpu time
-  integer	; system cpu time
+  clock_t	; system cpu time
-  integer	; user   cpu time for me and all my descendants.
+  clock_t	; user   cpu time for me and all my descendants.
-  integer)	; system 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))
+  (fchown (fixnum fd) (uid_t uid) (gid_t gid))
-  (to-scheme integer errno_or_false))
+  (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))
+  (let ((ans-vec (make-vector 11))
-	(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)))))
 	(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 8)
-						      (vector-ref ans-vec 9))
+					   (vector-ref ans-vec 9)
-					   (time-hack (vector-ref ans-vec 10)
+					   (vector-ref ans-vec 10)))))))
-						      (vector-ref ans-vec 11))
+						      
-					   (time-hack (vector-ref ans-vec 12)
-						      (vector-ref ans-vec 13))))))))
 		
 (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.
+  (ftruncate (fixnum fd) (off_t length))   no-declare ; Indigo bogosity.
-  (to-scheme integer errno_or_false))
+  (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))
+(define-foreign sync-file/errno (fsync (fixnum fd))
-  (to-scheme integer errno_or_false))
+  (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))
+(define-foreign %close-fdes/errno (close (fixnum fd))
-  (to-scheme integer "errno_or_false"))
+  (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))
+  (dup (fixnum fd))
-  (multi-rep (to-scheme integer errno_or_false)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     fixnum))
 
 (define-errno-syscall (%dup fd) %dup/errno
    new-fd)
 
 (define-foreign %dup2/errno
-  (dup2 (integer fd-from) (integer fd-to))
+  (dup2 (fixnum fd-from) (fixnum fd-to))
-  (multi-rep (to-scheme integer errno_or_false)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     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)
+  (multi-rep (to-scheme fixnum errno_or_false)
-             integer))
+             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
+  (to-scheme fixnum "False_on_zero")	; Win: #f, lose: errno
-  integer	; r
+  fixnum	; r
-  integer)	; w
+  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))
+(define-foreign write-fdes-char/errno (write_fdes_char (char char) (fixnum fd))
-  (to-scheme integer errno_or_false))
+  (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)
+		       (size_t start)
-		       (integer end)
+		       (size_t end)
-		       (integer fd))
+		       (fixnum fd))
-  (multi-rep (to-scheme integer errno_or_false)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     ssize_t))
 
 (define-foreign write-fdes-substring/errno
   (write_fdes_substring (string-desc buf)
-			(integer start)
+			(size_t start)
-			(integer end)
+			(size_t end)
-			(integer fd))
+			(fixnum fd))
-  (multi-rep (to-scheme integer errno_or_false)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     ssize_t))
 
 
 ;;; Signals (rather incomplete)
 ;;; ---------------------------
 
 (define-foreign signal-pid/errno
-  (kill (pid_t pid) (integer signal))
+  (kill (pid_t pid) (fixnum signal))
-  (to-scheme integer errno_or_false))
+  (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))
+(define-foreign %set-cloexec (set_cloexec (fixnum fd) (bool val))
-  (to-scheme integer "errno_or_false"))
+  (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)
+  (multi-rep (to-scheme fixnum errno_or_false)
-	     integer))
+	     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)

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,8, s48_enter_integer(s->st_atime));
-  S48_VECTOR_SET(vec,9, s48_enter_fixnum(hi_but24(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));
-  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)));
 
   /* 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.

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);