(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.
;; 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
\f
;;;; resourcebits.h
"
(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))
;;; 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)
;;; 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))
(if (null link)
(return pathname)
(let ((new-pathname
- (simplify-namestring
+ (simplify-namestring
(if (relative-unix-pathname? link)
(let* ((dir-len (1+ (position #\/
pathname
(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)
projects / sbcl.git / blobdiff