X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=606afdabfd3fd2a0dfd0a00d44accbe52af09f45;hb=0e03a9ac950b78d776c4869c809e202d9e929f39;hp=c0a3b8fb7aba52a7c6f19d78e7cdc98b59952537;hpb=fb8e5ded0b56f50de2024efbcc9ce68b401415f5;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index c0a3b8f..606afda 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -167,7 +167,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (declare (type unix-pathname path) (type fixnum flags) (type unix-file-mode mode)) - (int-syscall ("open" c-string int int) path (logior #!+win32 o_binary flags) mode)) + (int-syscall ("open" c-string int int) + path + (logior #!+win32 o_binary + #!+largefile o_largefile + flags) + mode)) ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file ;;; associated with it. @@ -180,10 +185,19 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;; A time value that is accurate to the nearest ;; microsecond but also has a range of years. +;; CLH: Note that tv-usec used to be a time-t, but that this seems +;; problematic on Darwin x86-64 (and wrong). Trying suseconds-t. +#!-win32 +(define-alien-type nil + (struct timeval + (tv-sec time-t) ; seconds + (tv-usec suseconds-t))) ; and microseconds + +#!+win32 (define-alien-type nil (struct timeval - (tv-sec time-t) ; seconds - (tv-usec time-t))) ; and microseconds + (tv-sec time-t) ; seconds + (tv-usec long))) ; and microseconds ;;;; resourcebits.h @@ -257,7 +271,9 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." " (declare (type unix-fd fd) (type (integer 0 2) whence)) - (let ((result (alien-funcall (extern-alien "lseek" (function off-t int off-t int)) + (let ((result (alien-funcall (extern-alien #!-largefile "lseek" + #!+largefile "lseek_largefile" + (function off-t int off-t int)) fd offset whence))) (if (minusp result ) (values nil (get-errno)) @@ -614,23 +630,22 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;;; longer than 32 bits anyway, right?":-| (define-alien-type nil (struct wrapped_stat - #!-mips - (st-dev unsigned-int) ; would be dev-t in a real stat - #!+mips - (st-dev unsigned-long) ; this is _not_ a dev-t on mips + (st-dev #!-(or mips largefile) unsigned-int + #!+mips unsigned-long + #!+largefile dev-t) (st-ino ino-t) (st-mode mode-t) (st-nlink nlink-t) (st-uid uid-t) (st-gid gid-t) - #!-mips - (st-rdev unsigned-int) ; would be dev-t in a real stat - #!+mips - (st-rdev unsigned-long) ; this is _not_ a dev-t on mips - #!-mips - (st-size unsigned-int) ; would be off-t in a real stat - #!+mips - (st-size off-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-atime time-t) @@ -754,6 +769,21 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;;; doesn't work, it returns NIL and the errno. #!-sb-fluid (declaim (inline unix-gettimeofday)) (defun unix-gettimeofday () + #!+(and x86-64 darwin) + (with-alien ((tv (struct timeval))) + ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin, + ;; gettimeofday occasionally fails. passing in a null pointer for + ;; the timezone struct seems to work around the problem. I can't + ;; find any instances in the SBCL where we actually ues the + ;; timezone values, so we just punt for the moment. + (syscall* ("gettimeofday" (* (struct timeval)) + (* (struct timezone))) + (values t + (slot tv 'tv-sec) + (slot tv 'tv-usec)) + (addr tv) + nil)) + #!-(and x86-64 darwin) (with-alien ((tv (struct timeval)) (tz (struct timezone))) (syscall* ("gettimeofday" (* (struct timeval)) @@ -907,7 +937,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (if (null link) (return pathname) (let ((new-pathname - (simplify-namestring + (simplify-namestring (if (relative-unix-pathname? link) (let* ((dir-len (1+ (position #\/ pathname @@ -936,15 +966,53 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (defconstant micro-seconds-per-internal-time-unit (/ 1000000 sb!xc:internal-time-units-per-second)) - (declaim (inline system-internal-real-time system-internal-run-time)) - (defun system-internal-real-time () + (declaim (inline system-internal-run-time + internal-real-time-values)) + + (defun internal-real-time-values () (multiple-value-bind (ignore seconds useconds) (unix-gettimeofday) (declare (ignore ignore) (type (unsigned-byte 32) seconds useconds)) - (let ((uint (truncate useconds - micro-seconds-per-internal-time-unit))) - (declare (type (unsigned-byte 32) uint)) - (+ (* seconds sb!xc:internal-time-units-per-second) - uint)))) + (values seconds (truncate useconds micro-seconds-per-internal-time-unit)))) + + ;; There are two optimizations here that actually matter (on 32-bit + ;; systems): substract the epoch from seconds and milliseconds + ;; separately, as those should remain fixnums for the first 17 years + ;; or so of runtime. Also, avoid doing consing a new bignum if the + ;; result would be = to the last result given. + ;; + ;; Note: the next trick would be to spin a separate thread to update + ;; a global value once per internal tick, so each individual call to + ;; get-internal-real-time would be just a memory read... but that is + ;; probably best left for user-level code. ;) + ;; + ;; Thanks to James Anderson for the optimization hint. + ;; + ;; Yes, it is possible to a computation to be GET-INTERNAL-REAL-TIME + ;; bound. + ;; + ;; --NS 2007-04-05 + (let ((e-sec 0) + (e-msec 0) + (c-sec 0) + (c-msec 0) + (now 0)) + (declare (type (unsigned-byte 32) e-sec c-sec) + (type fixnum e-msec c-msec) + (type unsigned-byte now)) + (defun reinit-internal-real-time () + (setf (values e-sec e-msec) (internal-real-time-values) + c-sec 0 + c-msec 0)) + ;; If two threads call this at the same time, we're still safe, I believe, + ;; as long as NOW is updated before either of C-MSEC or C-SEC. --NS + (defun get-internal-real-time () + (multiple-value-bind (sec msec) (internal-real-time-values) + (unless (and (= msec c-msec) (= sec c-sec)) + (setf now (+ (* (- sec e-sec) sb!xc:internal-time-units-per-second) + (- msec e-msec)) + c-msec msec + c-sec sec)) + now))) (defun system-internal-run-time () (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)