#!+win32
(progn
- (defconstant espipe 29)
- ;; For stat-wrapper hack (different-type or non-existing win32 fields).
- (define-alien-type nlink-t short)
- (define-alien-type uid-t short)
- (define-alien-type gid-t short))
+ (defconstant espipe 29))
\f
;;;; hacking the Unix environment
#!+largefile "lseek_largefile"
(function off-t int off-t int))
fd offset whence)))
- (if (minusp result )
+ (if (minusp result)
(values nil (get-errno))
(values result 0))))
(defun unix-write (fd buf offset len)
(declare (type unix-fd fd)
(type (unsigned-byte 32) offset len))
- (int-syscall ("write" int (* char) int)
- fd
- (with-alien ((ptr (* char) (etypecase buf
- ((simple-array * (*))
- ;; This SAP-taking is
- ;; safe as BUF remains
- ;; either in a register
- ;; or on stack.
- (vector-sap buf))
- (system-area-pointer
- buf))))
- (addr (deref ptr offset)))
- len))
+ (flet ((%write (sap)
+ (declare (system-area-pointer sap))
+ (int-syscall ("write" int (* char) int)
+ fd
+ (with-alien ((ptr (* char) sap))
+ (addr (deref ptr offset)))
+ len)))
+ (etypecase buf
+ ((simple-array * (*))
+ (with-pinned-objects (buf)
+ (%write (vector-sap buf))))
+ (system-area-pointer
+ (%write buf)))))
;;; Set up a unix-piping mechanism consisting of an input pipe and an
;;; output pipe. Return two values: if no error occurred the first
;;; st_size is a long, not an off-t, because off-t is a 64-bit
;;; quantity on Alpha. And FIXME: "No one would want a file length
;;; longer than 32 bits anyway, right?":-|
+;;;
+;;; The comment about alien and 64-bit quantities has not been kept in
+;;; sync with the comment now in wrap.h (formerly wrap.c), but it's
+;;; not clear whether either comment is correct. -- RMK 2007-11-14.
(define-alien-type nil
(struct wrapped_stat
- (st-dev #!-(or mips largefile) unsigned-int
- #!+mips unsigned-long
- #!+largefile dev-t)
+ (st-dev wst-dev-t)
(st-ino ino-t)
(st-mode mode-t)
- (st-nlink nlink-t)
- (st-uid uid-t)
- (st-gid gid-t)
- (st-rdev #!-(or mips largefile) unsigned-int
- #!+mips unsigned-long
- #!+largefile dev-t)
- (st-size #!-(or darwin mips largefile) unsigned-int
- #!+(or darwin mips largefile) off-t)
- #!+(and darwin)
- (st-blksize unsigned-int)
- #!-(and darwin)
- (st-blksize unsigned-long)
- (st-blocks unsigned-long)
+ (st-nlink wst-nlink-t)
+ (st-uid wst-uid-t)
+ (st-gid wst-gid-t)
+ (st-rdev wst-dev-t)
+ (st-size wst-off-t)
+ (st-blksize wst-blksize-t)
+ (st-blocks wst-blkcnt-t)
(st-atime time-t)
(st-mtime time-t)
(st-ctime time-t)))