X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=424b2b8b1354621c28aff33fbcdbec8ec6c7d9a0;hb=d7f6139a91d7d9b0667a597584ae306d958bb2f4;hp=89a3ca605a3f38b2ba7232198603322f83750036;hpb=72408d179d7396904e25e9a3dc423d2634e65072;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 89a3ca6..424b2b8 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -118,11 +118,6 @@
 (def-alien-type caddr-t (* char))
 (def-alien-type swblk-t long)
 (def-alien-type size-t unsigned-int)
-(def-alien-type time-t long)
-(def-alien-type clock-t
-  #!+linux long
-  #!+bsd   unsigned-long)
-(def-alien-type uid-t unsigned-int)
 (def-alien-type ssize-t int)
 
 ;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
@@ -131,33 +126,8 @@
 ;;; those functions in C as a wrapper layer.
 (def-alien-type fd-mask unsigned-long)
 
-;;; FIXME: Isn't there some way to use a C wrapper to avoid this hand-copying?
-(def-alien-type dev-t
-  #!+linux uquad-t
-  #!+bsd   unsigned-int)
-(def-alien-type uid-t unsigned-int)
-(def-alien-type gid-t unsigned-int)
-(def-alien-type ino-t
-  #!+linux unsigned-long
-  #!+bsd   unsigned-int)
-(def-alien-type mode-t
-  #!+linux unsigned-int
-  #!+bsd   unsigned-short)
-(def-alien-type nlink-t
-  #!+linux unsigned-int
-  #!+bsd   unsigned-short)
-(/show0 "unix.lisp 263")
-
-;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
-;;; unless we have extreme provocation. Reading directories is not extreme
-;;; enough, since it doesn't need to be blindingly fast: we can just implement
-;;; those functions in C as a wrapper layer.
-
-(def-alien-type off-t
-  #!+linux long
-  #!+bsd   quad-t)
-
-(defconstant fd-setsize 1024)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant fd-setsize 1024))
 
 (def-alien-type nil
   (struct fd-set
@@ -165,23 +135,11 @@
 
 (/show0 "unix.lisp 304")
 
-;;;; direntry.h
-;;;; dirent.h
-;;;; 
-;;;; (CMU CL copied stuff out of these, but as of 0.6.11.41, SBCL
-;;;; doesn't need to, instead calling C-level wrapper code to handle
-;;;; all the opendir/readdir/closedir stuff.)
 
 ;;;; fcntl.h
 ;;;;
 ;;;; POSIX Standard: 6.5 File Control Operations	<fcntl.h>
 
-(/show0 "unix.lisp 356")
-(defconstant r_ok 4 #!+sb-doc "Test for read permission")
-(defconstant w_ok 2 #!+sb-doc "Test for write permission")
-(defconstant x_ok 1 #!+sb-doc "Test for execute permission")
-(defconstant f_ok 0 #!+sb-doc "Test for presence of file")
-
 ;;; Open the file whose pathname is specified by PATH for reading
 ;;; and/or writing as specified by the FLAGS argument. Various FLAGS
 ;;; masks (O_RDONLY etc.) are defined in fcntlbits.h.
@@ -202,31 +160,6 @@
   (declare (type unix-fd fd))
   (void-syscall ("close" int) fd))
 
-;;;; fcntlbits.h
-
-(/show0 "unix.lisp 337")
-(defconstant o_rdonly  0) ; read-only flag
-(defconstant o_wronly  1) ; write-only flag
-(defconstant o_rdwr    2) ; read/write flag
-(defconstant o_accmode 3) ; access mode mask
-(defconstant o_creat ; create-if-nonexistent flag (not fcntl)
-  #!+linux #o100
-  #!+bsd   #x0200)
-(/show0 "unix.lisp 345")
-(defconstant o_excl ; error if already exists (not fcntl)
-  #!+linux #o200
-  #!+bsd   #x0800)
-(defconstant o_noctty ; Don't assign controlling tty. (not fcntl)
-  #!+linux #o400
-  #!+bsd   #x8000)
-(defconstant o_trunc ; truncation flag (not fcntl)
-  #!+linux #o1000
-  #!+bsd   #x0400)
-(defconstant o_append ; append flag
-  #!+linux #o2000
-  #!+bsd   #x0008)
-(/show0 "unix.lisp 361")
-
 ;;;; timebits.h
 
 ;; A time value that is accurate to the nearest
@@ -261,81 +194,6 @@
     (ru-nvcsw long)		    ; voluntary context switches
     (ru-nivcsw long)))		    ; involuntary context switches
 
-;;;; statbuf.h
-
-;;; FIXME: This should go into C code so that we don't need to hand-copy
-;;; it from header files.
-#!+Linux
-(def-alien-type nil
-  (struct stat
-    (st-dev dev-t)
-    (st-pad1 unsigned-short)
-    (st-ino ino-t)
-    (st-mode mode-t)
-    (st-nlink  nlink-t)
-    (st-uid  uid-t)
-    (st-gid  gid-t)
-    (st-rdev dev-t)
-    (st-pad2  unsigned-short)
-    (st-size off-t)
-    (st-blksize unsigned-long)
-    (st-blocks unsigned-long)
-    (st-atime time-t)
-    (unused-1 unsigned-long)
-    (st-mtime time-t)
-    (unused-2 unsigned-long)
-    (st-ctime time-t)
-    (unused-3 unsigned-long)
-    (unused-4 unsigned-long)
-    (unused-5 unsigned-long)))
-
-#!+bsd
-(def-alien-type nil
-  (struct timespec-t
-    (tv-sec long)
-    (tv-nsec long)))
-
-#!+bsd
-(def-alien-type nil
-  (struct stat
-    (st-dev dev-t)
-    (st-ino ino-t)
-    (st-mode mode-t)
-    (st-nlink nlink-t)
-    (st-uid uid-t)
-    (st-gid gid-t)
-    (st-rdev dev-t)
-    (st-atime (struct timespec-t))
-    (st-mtime (struct timespec-t))
-    (st-ctime (struct timespec-t))
-    (st-size    unsigned-long)		; really quad
-    (st-sizeh   unsigned-long)		;
-    (st-blocks  unsigned-long)		; really quad
-    (st-blocksh unsigned-long)
-    (st-blksize unsigned-long)
-    (st-flags   unsigned-long)
-    (st-gen     unsigned-long)
-    (st-lspare  long)
-    (st-qspare (array long 4))
-    ))
-
-;; encoding of the file mode
-
-;;; These bits determine file type.
-(defconstant s-ifmt   #o0170000)
-
-;; basic file types, exist even on System V
-(defconstant s-ififo  #o0010000) ; FIFO
-(defconstant s-ifchr  #o0020000) ; Character device
-(defconstant s-ifdir  #o0040000) ; Directory
-(defconstant s-ifblk  #o0060000) ; Block device
-(defconstant s-ifreg  #o0100000) ; Regular file
-
-;; more file types: These don't actually exist on System V, but having
-;; them doesn't hurt.
-(defconstant s-iflnk  #o0120000) ; Symbolic link
-(defconstant s-ifsock #o0140000) ; Socket
-
 ;;;; unistd.h
 
 ;;; Given a file path (a string) and one of four constant modes,
@@ -419,6 +277,11 @@
   (declare (type unix-pathname path))
   (void-syscall ("chdir" c-string) path))
 
+(defun unix-mkdir (name mode)
+  (declare (type unix-pathname name)
+	   (type unix-file-mode mode))
+  (void-syscall ("mkdir" c-string int) name mode))
+
 ;;; Return the current directory as a SIMPLE-STRING.
 (defun unix-current-directory ()
   ;; FIXME: Gcc justifiably complains that getwd is dangerous and should
@@ -645,82 +508,89 @@
 
 ;;;; sys/stat.h
 
-;;; FIXME: This is only used in this file, and needn't be in target Lisp
-;;; runtime. It's also unclear why it needs to be a macro instead of a
-;;; function. Perhaps it should become a FLET.
-(defmacro extract-stat-results (buf)
-  `(values T
-	   #!+bsd
-	   (slot ,buf 'st-dev)
-	   #!+linux
-	   (+ (deref (slot ,buf 'st-dev) 0)
-	      (* (+ +max-u-long+  1)
-		 (deref (slot ,buf 'st-dev) 1)))   ;;; let's hope this works..
-	   (slot ,buf 'st-ino)
-	   (slot ,buf 'st-mode)
-	   (slot ,buf 'st-nlink)
-	   (slot ,buf 'st-uid)
-	   (slot ,buf 'st-gid)
-	   #!+bsd
-	   (slot ,buf 'st-rdev)
-	   #!+linux
-	   (+ (deref (slot ,buf 'st-rdev) 0)
-	      (* (+ +max-u-long+  1)
-		 (deref (slot ,buf 'st-rdev) 1)))   ;;; let's hope this works..
-	   #!+linux (slot ,buf 'st-size)
-	   #!+bsd
-	   (+ (slot ,buf 'st-size)
-	      (* (+ +max-u-long+ 1)
-		 (slot ,buf 'st-sizeh)))
-	   #!+linux (slot ,buf 'st-atime)
-	   #!+bsd   (slot (slot ,buf 'st-atime) 'tv-sec)
-	   #!+linux (slot ,buf 'st-mtime)
-	   #!+bsd   (slot (slot ,buf 'st-mtime) 'tv-sec)
-	   #!+linux (slot ,buf 'st-ctime)
-	   #!+bsd   (slot (slot ,buf 'st-ctime) 'tv-sec)
-	   (slot ,buf 'st-blksize)
-	   #!+linux (slot ,buf 'st-blocks)
-	   #!+bsd
-	   (+ (slot ,buf 'st-blocks)
-	      (* (+ +max-u-long+ 1)
-		 (slot ,buf 'st-blocksh)))
-	   ))
-
-;;; Retrieve information about the specified file returning them in
-;;; the form of multiple values. See the UNIX Programmer's Manual for
-;;; a description of the values returned. If the call fails, then NIL
-;;; and an error number is returned instead.
+;;; This is a structure defined in src/runtime/wrap.c, to look
+;;; basically like "struct stat" according to stat(2). It may not
+;;; actually correspond to the real in-memory stat structure that the
+;;; syscall uses, and that's OK. Linux in particular is packed full of
+;;; stat macros, and trying to keep Lisp code in correspondence with
+;;; it is more pain than it's worth, so we just let our C runtime
+;;; synthesize a nice consistent structure for us.
+;;;
+;;; Note that st-dev is a long, not a dev-t. This is because dev-t on
+;;; linux 32 bit archs is a 64 bit quantity, but alien doesn's support
+;;; those. We don't actually access that field anywhere, though, so
+;;; until we can get 64 bit alien support it'll do.
+(def-alien-type nil
+  (struct wrapped_stat
+    (st-dev unsigned-long)              ;would be dev-t in a real stat
+    (st-ino ino-t)
+    (st-mode mode-t)
+    (st-nlink  nlink-t)
+    (st-uid  uid-t)
+    (st-gid  gid-t)
+    (st-rdev unsigned-long)             ;ditto
+    (st-size off-t)
+    (st-blksize unsigned-long)
+    (st-blocks unsigned-long)
+    (st-atime time-t)
+    (st-mtime time-t)
+    (st-ctime time-t)))
+
+;;; shared C-struct-to-multiple-VALUES conversion for the stat(2)
+;;; family of Unix system calls
+(defun %extract-stat-results (wrapped-stat)
+  (declare (type (alien (* (struct wrapped_stat)))))
+  (values t
+	  (slot wrapped-stat 'st-dev)
+	  (slot wrapped-stat 'st-ino)
+	  (slot wrapped-stat 'st-mode)
+	  (slot wrapped-stat 'st-nlink)
+	  (slot wrapped-stat 'st-uid)
+	  (slot wrapped-stat 'st-gid)
+	  (slot wrapped-stat 'st-rdev)
+	  ;; FIXME: OpenBSD has a 64-bit st_size slot, which is
+	  ;; basically a good thing, except that it is too
+	  ;; 21st-century for sbcl-0.6.12.8's FFI to handle. As a
+	  ;; quick kludgy workaround, we return a 0 placeholder from
+	  ;; this function, and downstream we stub out the FILE-LENGTH
+	  ;; operation (which is the only place that SBCL actually
+	  ;; uses the SIZE value returned from any UNIX-STAT-ish call).
+	  #!+openbsd 0
+	  #!-openbsd (slot wrapped-stat 'st-size)
+	  (slot wrapped-stat 'st-atime)
+	  (slot wrapped-stat 'st-mtime)
+	  (slot wrapped-stat 'st-ctime)
+	  (slot wrapped-stat 'st-blksize)
+	  (slot wrapped-stat 'st-blocks)))
+
+;;; The stat(2) family of Unix system calls are implemented as calls
+;;; to C-level wrapper functions which copies all the raw "struct
+;;; stat" slots into a system-independent format, so that we don't
+;;; need to mess around with tweaking the Lisp code to correspond to
+;;; different OS/CPU combinations.
+;;;    stat(2) <->  stat_wrapper()
+;;;   fstat(2) <-> fstat_wrapper()
+;;;   lstat(2) <-> lstat_wrapper()
+;;; Then this function is used to convert all the stat slots into
+;;; multiple return values.
 (defun unix-stat (name)
   (declare (type unix-pathname name))
-  (when (string= name "")
-    (setf name "."))
-  (with-alien ((buf (struct stat)))
-    (syscall ("stat" c-string (* (struct stat)))
-	     (extract-stat-results buf)
+  (with-alien ((buf (struct wrapped_stat)))
+    (syscall ("stat_wrapper" c-string (* (struct wrapped_stat)))
+	     (%extract-stat-results buf)
 	     name (addr buf))))
-
-;;; like UNIX-STAT except the file is specified by the file descriptor FD
-(defun unix-fstat (fd)
-  (declare (type unix-fd fd))
-  (with-alien ((buf (struct stat)))
-    (syscall ("fstat" int (* (struct stat)))
-	     (extract-stat-results buf)
-	     fd (addr buf))))
-
-;;; like UNIX-STAT except the specified file must be a symbolic link
 (defun unix-lstat (name)
   (declare (type unix-pathname name))
-  (with-alien ((buf (struct stat)))
-    (syscall ("lstat" c-string (* (struct stat)))
-	     (extract-stat-results buf)
+  (with-alien ((buf (struct wrapped_stat)))
+    (syscall ("lstat_wrapper" c-string (* (struct wrapped_stat)))
+	     (%extract-stat-results buf)
 	     name (addr buf))))
-
-;;; UNIX-MKDIR accepts a name and a mode and attempts to create the
-;;; corresponding directory with mode mode.
-(defun unix-mkdir (name mode)
-  (declare (type unix-pathname name)
-	   (type unix-file-mode mode))
-  (void-syscall ("mkdir" c-string int) name mode))
+(defun unix-fstat (fd)
+  (declare (type unix-fd fd))
+  (with-alien ((buf (struct wrapped_stat)))
+    (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
+	     (%extract-stat-results buf)
+	     fd (addr buf))))
 
 ;;;; time.h
 
@@ -728,8 +598,8 @@
 ;; timeval' but has nanoseconds instead of microseconds.
 (def-alien-type nil
     (struct timespec
-	    (tv-sec long)   ;Seconds
-	    (tv-nsec long))) ;Nanoseconds
+	    (tv-sec long)   ; seconds
+	    (tv-nsec long))) ; nanoseconds
 
 ;; used by other time functions
 (def-alien-type nil
@@ -789,7 +659,6 @@
 	      (addr tv)
 	      (addr tz))))
 
-;;;; asm/errno.h
 
 (defconstant ENOENT 2) ; Unix error code, "No such file or directory"
 (defconstant EINTR 4) ; Unix error code, "Interrupted system call"
@@ -804,6 +673,7 @@
 ;;; enough of them all in one place here that they should probably be
 ;;; removed by hand.
 
+
 ;;;; support routines for dealing with Unix pathnames
 
 (defun unix-file-kind (name &optional check-for-links)
@@ -1021,4 +891,4 @@
      ,@(loop for index upfrom 0 below (/ fd-setsize 32)
 	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
 
-(/show0 "unix.lisp 3555")
+