Ignore:
Timestamp:
Sep 22, 2008, 3:13:30 PM (11 years ago)
Author:
gb
Message:

Try to work around the fact that the mingw headers on Windows
define the fields of "timeval" structures to be signed.

Tentatively prefer "HOME" (Cygwn) to "USERPROFILE" as an env var
that points to the user's home directory, then back out of that
(there are issues related to getting CCL and XEmacs to agree
on where "home" should be.)

When waiting on an external process, try to make the wait
"alertable"; continue the infinite wait if we got an interrupt
while waiting.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/linux-files.lisp

    r10822 r10825  
    574574      (values nil nil))))
    575575
     576;;; The mingw headers define timeval.tv_sec and timeval.tv_usec to be
     577;;; signed 32-bit quantities.
     578(macrolet ((timeval-ref (ptr accessor)
     579             #+windows-target `(logand #xfffffffff (pref ,ptr ,accessor))
     580             #-windows-target `(pref ,ptr ,accessor))
     581           (set-timeval-ref (ptr accessor new)
     582           `(setf (pref ,ptr ,accessor)
     583             #+windows-target (u32->s32 ,new)
     584             #-windows-target ,new)))
     585 
    576586(defun timeval->milliseconds (tv)
    577     (+ (* 1000 (pref tv :timeval.tv_sec)) (round (pref tv :timeval.tv_usec) 1000)))
     587    (+ (* 1000 (timeval-ref tv :timeval.tv_sec)) (round (timeval-ref tv :timeval.tv_usec) 1000)))
    578588
    579589(defun timeval->microseconds (tv)
    580     (+ (* 1000000 (pref tv :timeval.tv_sec)) (pref tv :timeval.tv_usec)))
     590    (+ (* 1000000 (timeval-ref tv :timeval.tv_sec)) (timeval-ref tv :timeval.tv_usec)))
    581591
    582592(defun %add-timevals (result a b)
    583   (let* ((seconds (+ (pref a :timeval.tv_sec) (pref b :timeval.tv_sec)))
    584          (micros (+ (pref a :timeval.tv_usec) (pref b :timeval.tv_usec))))
     593  (let* ((seconds (+ (timeval-ref a :timeval.tv_sec) (timeval-ref b :timeval.tv_sec)))
     594         (micros (+ (timeval-ref a :timeval.tv_usec) (timeval-ref b :timeval.tv_usec))))
    585595    (if (>= micros 1000000)
    586596      (setq seconds (1+ seconds) micros (- micros 1000000)))
    587     (setf (pref result :timeval.tv_sec) seconds
    588           (pref result :timeval.tv_usec) micros)
     597    (set-timeval-ref result :timeval.tv_sec seconds)
     598    (set-timeval-ref result :timeval.tv_usec micros)
    589599    result))
    590600
    591601(defun %sub-timevals (result a b)
    592   (let* ((seconds (- (pref a :timeval.tv_sec) (pref b :timeval.tv_sec)))
    593          (micros (- (pref a :timeval.tv_usec) (pref b :timeval.tv_usec))))
     602  (let* ((seconds (- (timeval-ref a :timeval.tv_sec) (timeval-ref b :timeval.tv_sec)))
     603         (micros (- (timeval-ref a :timeval.tv_usec) (timeval-ref b :timeval.tv_usec))))
    594604    (if (< micros 0)
    595605      (setq seconds (1- seconds) micros (+ micros 1000000)))
    596     (setf (pref result :timeval.tv_sec) seconds
    597           (pref result :timeval.tv_usec) micros)
     606    (set-timeval-ref result :timeval.tv_sec  seconds)
     607    (set-timeval-ref result :timeval.tv_usec micros)
    598608    result))
    599609
     
    601611;;; time denoted by the timeval b.
    602612(defun %timeval<= (a b)
    603   (let* ((asec (pref a :timeval.tv_sec))
    604          (bsec (pref b :timeval.tv_sec)))
     613  (let* ((asec (timeval-ref a :timeval.tv_sec))
     614         (bsec (timeval-ref b :timeval.tv_sec)))
    605615    (or (< asec bsec)
    606616        (and (= asec bsec)
    607              (< (pref a :timeval.tv_usec)
    608                 (pref b :timeval.tv_usec))))))
    609 
     617             (< (timeval-ref a :timeval.tv_usec)
     618                (timeval-ref b :timeval.tv_usec))))))
     619
     620); windows signed nonsense.
    610621
    611622#-windows-target
     
    699710  (declare (ignore userid))
    700711  #+windows-target
    701   (with-native-utf-16-cstrs ((key "USERPROFILE"))
    702     (let* ((p (#__wgetenv key)))
    703       (unless (%null-ptr-p p)
    704         (get-foreign-namestring p))))
     712  (dolist (k '(#||"HOME"||# "USERPROFILE"))
     713    (with-native-utf-16-cstrs ((key k))
     714      (let* ((p (#__wgetenv key)))
     715        (unless (%null-ptr-p p)
     716          (return (get-foreign-namestring p))))))
    705717  #-windows-target
    706718  (rlet ((pwd :passwd)
     
    15971609          (setf (paref handles (:array #>HANDLE) 0) (external-process-pid p))
    15981610          (setf (paref handles (:array #>HANDLE) 1) (#__get_osfhandle in-fd))
    1599           (let ((rc (#_WaitForMultipleObjects 2 handles #$FALSE #$INFINITE)))
     1611          (let ((rc (ignoring-eintr
     1612                     (let* ((code (#_WaitForMultipleObjectsEx 2 handles #$FALSE #$INFINITE #$true)))
     1613                       (if (eql code #$WAIT_IO_COMPLETION)
     1614                         (- #$EINTR)
     1615                         code)))))
    16001616            (if (eq rc #$WAIT_OBJECT_0)
    16011617              (setf terminated t)
     
    16101626                      (write-sequence string out-stream :end n))))))))
    16111627        (progn
    1612           (#_WaitForSingleObject (external-process-pid p) #$INFINITE)
     1628          (ignoring-eintr
     1629           (let* ((code (#_WaitForSingleObjectEx (external-process-pid p) #$INFINITE #$true)))
     1630             (if (eql code #$WAIT_IO_COMPLETION)
     1631               (- #$EINTR)
     1632               code)))
    16131633          (setf terminated t))))))
    16141634 
Note: See TracChangeset for help on using the changeset viewer.