From 4be3b4230c24b2457476363895da585df55f87d5 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 17 May 1991 15:54:33 +0000 Subject: [PATCH] .../systems-work/clx/dependent.lisp, 24-May-90 16:00:24, Edit by Chiles. Wrote CALL-UNIX-SELECT to avoid problems with MACH:UNIX-SELECT returning nil when someone interrupts the system since calls to MACH:UNIX-SELECT occur within a WITHOUT-INTERRUPTS. .../systems-work/clx/dependent.lisp, 18-May-90 14:08:20, Edit by Chiles. X-TYPE-ERROR incorrectly supplies the condition slot :error-string which should be :type-string. --- clx/dependent.lisp | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/clx/dependent.lisp b/clx/dependent.lisp index 1bc3a85a8..765a1a7fa 100644 --- a/clx/dependent.lisp +++ b/clx/dependent.lisp @@ -1446,7 +1446,7 @@ (loop (let ((available-p (cond ((and timeout (zerop timeout)) - (mach::unix-select (1+ fd) (ash 1 fd) 0 0 0)) + (call-unix-select (1+ fd) (ash 1 fd) 0 0 0)) (timeout (let ((remaining (- endtime (get-internal-real-time)))) (when (minusp remaining) (return :TIMEOUT)) @@ -1454,10 +1454,9 @@ (truncate remaining internal-time-units-per-second) (let ((msecs (truncate (* 1000000 rem)))) - (mach::unix-select (1+ fd) (ash 1 fd) 0 0 + (call-unix-select (1+ fd) (ash 1 fd) 0 0 secs msecs))))) - (t (mach::unix-select (1+ fd) (ash 1 fd) 0 0 nil))))) - + (t (call-unix-select (1+ fd) (ash 1 fd) 0 0 nil))))) (when (not (zerop available-p)) (multiple-value-bind (length err) (read-into-ibuff display needed) (cond ((null length) @@ -1670,16 +1669,30 @@ (let ((fd (display-input-stream display))) (cond ((null fd)) ((or (null timeout) (= timeout 0)) - (if (zerop (mach::unix-select (1+ fd) (ash 1 fd) 0 0 timeout)) + (if (zerop (call-unix-select (1+ fd) (ash 1 fd) 0 0 timeout)) :timeout nil)) (t (multiple-value-bind (secs rem) (truncate timeout) (let ((usecs (truncate (* 1000000 rem)))) - (if (zerop (mach::unix-select (1+ fd) (ash 1 fd) 0 0 secs usecs)) + (if (zerop (call-unix-select (1+ fd) (ash 1 fd) 0 0 secs usecs)) :timeout nil))))))) +#+CMU +;;; CALL-UNIX-SELECT -- Internal. +;;; +;;; Since all our calls to MACH:UNIX-SELECT are within a WITHOUT-INTERRUPTS, +;;; it returns nil when someone interrupts the system. It gets interrupted +;;; since it is a system call. We loop over it whenever it returns nil to +;;; simulate the WITHOUT-INTERRUPTS. +;;; +(defun call-unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) + (loop + (let ((res (mach:unix-select nfds rdfds wrfds xpfds to-secs to-usecs))) + (when res (return res))))) + + #+Genera (defun buffer-input-wait-default (display timeout) (declare (type display display) @@ -2029,6 +2042,7 @@ ;; good compiler support for TYPEP. The definitions for CARD32, CARD16, INT16, etc. ;; include range checks. You can modify TYPE? to do less extensive checking ;; for these types if you desire. + ;; ;; ### This comment is a lie! TYPE? is really also used for run-time type ;; dispatching, not just type checking. -- Ram. @@ -2069,7 +2083,7 @@ (x-error 'x-type-error :datum object :expected-type type - :error-string error-string)) + #-CMU :error-string #+CMU :type-string error-string)) ;;----------------------------------------------------------------------------- -- GitLab