/[cmucl]/src/clx/dependent.lisp
ViewVC logotype

Diff of /src/clx/dependent.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by pw, Mon Jul 21 15:50:30 1997 UTC revision 1.7 by dtc, Mon Jan 5 05:44:21 1998 UTC
# Line 861  Line 861 
861    
862  ;;; MAKE-PROCESS-LOCK: Creating a process lock.  ;;; MAKE-PROCESS-LOCK: Creating a process lock.
863    
864  #-(or LispM excl Minima)  #-(or LispM excl Minima (and cmu mp))
865  (defun make-process-lock (name)  (defun make-process-lock (name)
866    (declare (ignore name))    (declare (ignore name))
867    nil)    nil)
# Line 882  Line 882 
882  (defun make-process-lock (name)  (defun make-process-lock (name)
883    (minima:make-lock name :recursive t))    (minima:make-lock name :recursive t))
884    
885    #+(and cmu mp)
886    (defun make-process-lock (name)
887      (mp:make-lock name))
888    
889  ;;; HOLDING-LOCK: Execute a body of code with a lock held.  ;;; HOLDING-LOCK: Execute a body of code with a lock held.
890    
891  ;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN  ;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN
# Line 890  Line 894 
894    
895  ;; If you're not sharing DISPLAY objects within a multi-processing  ;; If you're not sharing DISPLAY objects within a multi-processing
896  ;; shared-memory environment, this is sufficient  ;; shared-memory environment, this is sufficient
897  #-(or lispm excl lcl3.0 Minima CMU)  #-(or lispm excl lcl3.0 Minima (and CMU mp))
898  (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)  (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
899    (declare (ignore locator display whostate timeout))    (declare (ignore locator display whostate timeout))
900    `(progn ,@body))    `(progn ,@body))
# Line 904  Line 908 
908  ;;; display connection.  We inhibit GC notifications since display of them  ;;; display connection.  We inhibit GC notifications since display of them
909  ;;; could cause recursive entry into CLX.  ;;; could cause recursive entry into CLX.
910  ;;;  ;;;
911  #+CMU  #+(and CMU (not mp))
912  (defmacro holding-lock ((locator display &optional whostate &key timeout)  (defmacro holding-lock ((locator display &optional whostate &key timeout)
913                          &body body)                          &body body)
914    `(let ((ext:*gc-verbose* nil)    `(let ((ext:*gc-verbose* nil)
# Line 914  Line 918 
918       ,locator ,display ,whostate ,timeout       ,locator ,display ,whostate ,timeout
919       (system:without-interrupts (progn ,@body))))       (system:without-interrupts (progn ,@body))))
920    
921    ;;; HOLDING-LOCK for CMU Common Lisp with multi-processes.
922    ;;;
923    #+(and cmu mp)
924    (defmacro holding-lock ((lock display &optional (whostate "CLX wait")
925                                  &key timeout)
926                            &body body)
927      (declare (ignore display))
928      `(mp:with-lock-held (,lock ,whostate ,@(and timeout `(:timeout ,timeout)))
929        ,@body))
930    
931  #+Genera  #+Genera
932  (defmacro holding-lock ((locator display &optional whostate &key timeout)  (defmacro holding-lock ((locator display &optional whostate &key timeout)
933                          &body body)                          &body body)
# Line 1059  Line 1073 
1073  ;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's  ;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
1074  ;;; value changes.  ;;; value changes.
1075    
1076  #-(or lispm excl lcl3.0 Minima)  #-(or lispm excl lcl3.0 Minima (and cmu mp))
1077  (defun process-block (whostate predicate &rest predicate-args)  (defun process-block (whostate predicate &rest predicate-args)
1078    (declare (ignore whostate))    (declare (ignore whostate))
1079    (or (apply predicate predicate-args)    (or (apply predicate predicate-args)
# Line 1101  Line 1115 
1115             (dynamic-extent predicate))             (dynamic-extent predicate))
1116    (apply #'minima:process-wait whostate predicate predicate-args))    (apply #'minima:process-wait whostate predicate predicate-args))
1117    
1118    #+(and cmu mp)
1119    (defun process-block (whostate predicate &rest predicate-args)
1120      (declare (type function predicate))
1121      (mp:process-wait whostate #'(lambda ()
1122                                    (apply predicate predicate-args))))
1123    
1124  ;;; PROCESS-WAKEUP: Check some other process' wait function.  ;;; PROCESS-WAKEUP: Check some other process' wait function.
1125    
1126  (declaim (inline process-wakeup))  (declaim (inline process-wakeup))
1127    
1128  #-(or excl Genera Minima)  #-(or excl Genera Minima (and cmu mp))
1129  (defun process-wakeup (process)  (defun process-wakeup (process)
1130    (declare (ignore process))    (declare (ignore process))
1131    nil)    nil)
# Line 1130  Line 1150 
1150    (when process    (when process
1151      (minima:process-wakeup process)))      (minima:process-wakeup process)))
1152    
1153    #+(and cmu mp)
1154    (defun process-wakeup (process)
1155      (declare (ignore process))
1156      (mp:process-yield))
1157    
1158  ;;; CURRENT-PROCESS: Return the current process object for input locking and  ;;; CURRENT-PROCESS: Return the current process object for input locking and
1159  ;;; for calling PROCESS-WAKEUP.  ;;; for calling PROCESS-WAKEUP.
1160    
# Line 1137  Line 1162 
1162    
1163  ;;; Default return NIL, which is acceptable even if there is a scheduler.  ;;; Default return NIL, which is acceptable even if there is a scheduler.
1164    
1165  #-(or lispm excl lcl3.0 Minima)  #-(or lispm excl lcl3.0 Minima (and cmu mp))
1166  (defun current-process ()  (defun current-process ()
1167    nil)    nil)
1168    
# Line 1158  Line 1183 
1183  (defun current-process ()  (defun current-process ()
1184    (minima:current-process))    (minima:current-process))
1185    
1186    #+(and cmu mp)
1187    (defun current-process ()
1188      mp:*current-process*)
1189    
1190  ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.  ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
1191    
1192  #-(or lispm excl lcl3.0 Minima)  #-(or lispm excl lcl3.0 Minima cmu)
1193  (defmacro without-interrupts (&body body)  (defmacro without-interrupts (&body body)
1194    `(progn ,@body))    `(progn ,@body))
1195    
# Line 1180  Line 1209 
1209  (defmacro without-interrupts (&body body)  (defmacro without-interrupts (&body body)
1210    `(minima:with-no-other-processes ,@body))    `(minima:with-no-other-processes ,@body))
1211    
1212    #+cmu
1213    (defmacro without-interrupts (&body body)
1214      `(sys:without-interrupts ,@body))
1215    
1216  ;;; CONDITIONAL-STORE:  ;;; CONDITIONAL-STORE:
1217    
1218  ;; This should use GET-SETF-METHOD to avoid evaluating subforms multiple times.  ;; This should use GET-SETF-METHOD to avoid evaluating subforms multiple times.
# Line 1690  Line 1723 
1723            ((listen stream) nil)            ((listen stream) nil)
1724            ((eql timeout 0) :timeout)            ((eql timeout 0) :timeout)
1725            (t            (t
1726             (if (system:wait-until-fd-usable (system:fd-stream-fd stream)             (if #-mp (system:wait-until-fd-usable (system:fd-stream-fd stream)
1727                                              :input timeout)                                                   :input timeout)
1728                   #+mp (mp:process-wait-until-fd-usable
1729                         (system:fd-stream-fd stream) :input timeout)
1730                 nil                 nil
1731                 :timeout)))))                 :timeout)))))
1732    
# Line 2128  Line 2163 
2163    (declare (dbg:error-reporter))    (declare (dbg:error-reporter))
2164    (apply #'sys:signal condition :continue-format-string proceed-format-string keyargs))    (apply #'sys:signal condition :continue-format-string proceed-format-string keyargs))
2165    
2166  #+(or clx-ansi-common-lisp excl lcl3.0)  #+(or clx-ansi-common-lisp excl lcl3.0 (and CMU mp))
2167  (defun x-error (condition &rest keyargs)  (defun x-error (condition &rest keyargs)
2168    (declare (dynamic-extent keyargs))    (declare (dynamic-extent keyargs))
2169    (apply #'error condition keyargs))    (apply #'error condition keyargs))
# Line 2147  Line 2182 
2182  ;;; descriptors, Mach messages, etc.) to come through one routine anyone can  ;;; descriptors, Mach messages, etc.) to come through one routine anyone can
2183  ;;; use to wait for input.  ;;; use to wait for input.
2184  ;;;  ;;;
2185  #+CMU  #+(and CMU (not mp))
2186  (defun x-error (condition &rest keyargs)  (defun x-error (condition &rest keyargs)
2187    (let ((condx (apply #'make-condition condition keyargs)))    (let ((condx (apply #'make-condition condition keyargs)))
2188      (when (eq condition 'closed-display)      (when (eq condition 'closed-display)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5