Changeset 10460 for trunk/source/level-1/l1-lisp-threads.lisp
- Timestamp:
- Aug 13, 2008, 11:39:42 AM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-lisp-threads.lisp
r10210 r10460 36 36 37 37 (defun %nanosleep (seconds nanoseconds) 38 (rlet ((a :timespec) 39 (b :timespec)) 40 (setf (pref a :timespec.tv_sec) seconds 41 (pref a :timespec.tv_nsec) nanoseconds) 42 (let* ((aptr a) 43 (bptr b)) 44 (loop 45 (let* ((result 46 (external-call #+darwin-target "_nanosleep" 47 #-darwin-target "nanosleep" 48 :address aptr 49 :address bptr 50 :signed-fullword))) 51 (declare (type (signed-byte 32) result)) 52 (if (and (< result 0) 53 (eql (%get-errno) (- #$EINTR))) 54 ;; x86-64 Leopard bug. 55 (let* ((asec (pref aptr :timespec.tv_sec)) 56 (bsec (pref bptr :timespec.tv_sec))) 57 (if (and (>= bsec 0) 58 (or (< bsec asec) 59 (and (= bsec asec) 60 (< (pref bptr :timespec.tv_nsec) 61 (pref aptr :timespec.tv_nsec))))) 62 (psetq aptr bptr bptr aptr) 63 (return))) 64 (return))))))) 38 (with-process-whostate ("Sleep") 39 (rlet ((a :timespec) 40 (b :timespec)) 41 (setf (pref a :timespec.tv_sec) seconds 42 (pref a :timespec.tv_nsec) nanoseconds) 43 (let* ((aptr a) 44 (bptr b)) 45 (loop 46 (let* ((result 47 (external-call #+darwin-target "_nanosleep" 48 #-darwin-target "nanosleep" 49 :address aptr 50 :address bptr 51 :signed-fullword))) 52 (declare (type (signed-byte 32) result)) 53 (if (and (< result 0) 54 (eql (%get-errno) (- #$EINTR))) 55 ;; x86-64 Leopard bug. 56 (let* ((asec (pref aptr :timespec.tv_sec)) 57 (bsec (pref bptr :timespec.tv_sec))) 58 (if (and (>= bsec 0) 59 (or (< bsec asec) 60 (and (= bsec asec) 61 (< (pref bptr :timespec.tv_nsec) 62 (pref aptr :timespec.tv_nsec))))) 63 (psetq aptr bptr bptr aptr) 64 (return))) 65 (return)))))))) 65 66 66 67 … … 321 322 (%fixnum-ref tcr target::tcr.flags)) 322 323 323 (defun tcr-exhausted-p (tcr) 324 (or (null tcr) 325 (eql tcr 0) 326 (unless (logbitp arch::tcr-flag-bit-awaiting-preset 327 (the fixnum (tcr-flags tcr))) 328 (let* ((vs-area (%fixnum-ref tcr target::tcr.vs-area))) 329 (declare (fixnum vs-area)) 330 (or (zerop vs-area) 331 (eq (%fixnum-ref vs-area target::area.high) 332 (%fixnum-ref tcr target::tcr.save-vsp))))))) 324 333 325 334 326 (defun thread-exhausted-p (thread) 335 327 (or (null thread) 336 ( tcr-exhausted-p(lisp-thread.tcr thread))))328 (null (lisp-thread.tcr thread)))) 337 329 338 330 (defun thread-total-run-time (thread)
Note: See TracChangeset
for help on using the changeset viewer.