X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=d8473d137307d8b57720e134d950449d20d1ba3d;hb=b2f01c86f388284405fa28405fe97898fe158c02;hp=d6ac73a336f2a0c1086c8d3f3d981e6a7950b1c7;hpb=fe962ba01d267b92f638c8f0d19be41054219f04;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index d6ac73a..d8473d1 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -295,19 +295,19 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (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 @@ -660,7 +660,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (struct wrapped_stat (st-dev #!-(or mips largefile) unsigned-int #!+mips unsigned-long - #!+largefile dev-t) + #!+largefile #!-mips dev-t) (st-ino ino-t) (st-mode mode-t) (st-nlink nlink-t) @@ -668,7 +668,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (st-gid gid-t) (st-rdev #!-(or mips largefile) unsigned-int #!+mips unsigned-long - #!+largefile dev-t) + #!+largefile #!-mips dev-t) (st-size #!-(or darwin mips largefile) unsigned-int #!+(or darwin mips largefile) off-t) #!+(and darwin) @@ -987,13 +987,14 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (return pathname) (push pathname previous-pathnames)))) + +(defconstant micro-seconds-per-internal-time-unit + (/ 1000000 sb!xc:internal-time-units-per-second)) + ;;; UNIX specific code, that has been cleanly separated from the ;;; Windows build. #!-win32 (progn - (defconstant micro-seconds-per-internal-time-unit - (/ 1000000 sb!xc:internal-time-units-per-second)) - (declaim (inline system-internal-run-time system-real-time-values))