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