about summary refs log tree commit diff
path: root/third_party/lisp/sclf/mp/cmu.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/sclf/mp/cmu.lisp')
-rw-r--r--third_party/lisp/sclf/mp/cmu.lisp115
1 files changed, 0 insertions, 115 deletions
diff --git a/third_party/lisp/sclf/mp/cmu.lisp b/third_party/lisp/sclf/mp/cmu.lisp
deleted file mode 100644
index 6617f6dadd..0000000000
--- a/third_party/lisp/sclf/mp/cmu.lisp
+++ /dev/null
@@ -1,115 +0,0 @@
-;;;
-;;; Code freely lifted from various places with compatible license
-;;; terms.  Most of this code is copyright Gilbert Baumann
-;;; <unk6@rz.uni-karlsruhe.de>.  The bugs are copyright Walter
-;;; C. Pelissero <walter@pelissero.de>.
-;;;
-
-;;; This library is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Library General Public
-;;; License as published by the Free Software Foundation; either
-;;; version 2 of the License, or (at your option) any later version.
-;;;
-;;; This library is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Library General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Library General Public
-;;; License along with this library; if not, write to the 
-;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
-;;; Boston, MA  02111-1307  USA.
-
-(in-package :sclf)
-
-(defun make-lock (&optional name)
-  (mp:make-lock name))
-
-(defun make-recursive-lock (&optional name)
-  (mp:make-lock name :kind :recursive))
-
-(defmacro with-lock-held ((lock &key whostate (wait t) timeout) &body forms)
-  `(mp:with-lock-held (,lock ,(or whostate "Lock Wait")
-			     :wait wait
-			     ,@(when timeout (list :timeout timeout)))
-     ,@forms))
-
-(defmacro with-recursive-lock-held ((lock &key wait timeout) &body forms)
-  `(mp:with-lock-held (,lock
-		       ,@(when wait (list :wait wait))
-		       ,@(when timeout (list :timeout timeout)))
-     ,@forms))
-
-(defstruct condition-variable
-  (lock (make-lock "condition variable"))
-  (value nil)
-  (process-queue nil))
-
-(defun %release-lock (lock) ; copied from with-lock-held in multiproc.lisp
-  #+i486 (kernel:%instance-set-conditional
-	  lock 2 mp:*current-process* nil)
-  #-i486 (when (eq (lock-process lock) mp:*current-process*)
-	   (setf (lock-process lock) nil)))
-
-(defun condition-wait (cv lock &optional timeout)
-  (declare (ignore timeout))		;For now
-  (loop
-     (let ((cv-lock (condition-variable-lock cv)))
-       (with-lock-held (cv-lock)
-	 (when (condition-variable-value cv)
-	   (setf (condition-variable-value cv) nil)
-	   (return-from condition-wait t))
-	 (setf (condition-variable-process-queue cv)
-	       (nconc (condition-variable-process-queue cv)
-		      (list mp:*current-process*)))
-	 (%release-lock lock))
-       (mp:process-add-arrest-reason mp:*current-process* cv)
-       (let ((cv-val nil))
-	 (with-lock-held (cv-lock)
-	   (setq cv-val (condition-variable-value cv))
-	   (when cv-val
-	     (setf (condition-variable-value cv) nil)))
-	 (when cv-val
-	   (mp::lock-wait lock "waiting for condition variable lock")
-	   (return-from condition-wait t))))))
-
-(defun condition-notify (cv)
-  (with-lock-held ((condition-variable-lock cv))
-    (let ((proc (pop (condition-variable-process-queue cv))))
-      ;; The waiting process may have released the CV lock but not
-      ;; suspended itself yet
-      (when proc
-	(loop
-	 for activep = (mp:process-active-p proc)
-	 while activep
-	 do (mp:process-yield))
-	(setf (condition-variable-value cv) t)
-	(mp:process-revoke-arrest-reason proc cv))))
-  ;; Give the other process a chance
-  (mp:process-yield))
-
-(defun process-execute (process function)
-  (mp:process-preset process function)
-  ;; For some obscure reason process-preset doesn't make the process
-  ;; runnable.  I'm sure it's me who didn't understand how
-  ;; multiprocessing works under CMUCL, despite the vast documentation
-  ;; available.
-  (mp:enable-process process)
-  (mp:process-add-run-reason process :enable))
-
-(defun destroy-process (process)
-  ;; silnetly ignore a process that is trying to destroy itself
-  (unless (eq (mp:current-process)
-	      process)
-    (mp:destroy-process process)))
-
-(defun restart-process (process)
-  (mp:restart-process process)
-  (mp:enable-process process)
-  (mp:process-add-run-reason process :enable))
-
-(defun process-alive-p (process)
-  (mp:process-alive-p process))
-
-(defun process-join (process)
-  (error "PROCESS-JOIN not support under CMUCL."))