1 files changed, 0 insertions, 235 deletions
diff --git a/third_party/lisp/sclf/mp/sbcl.lisp b/third_party/lisp/sclf/mp/sbcl.lisp
deleted file mode 100644
index a2cf497ff9..0000000000
--- a/third_party/lisp/sclf/mp/sbcl.lisp
+++ /dev/null
@@ -1,235 +0,0 @@
-;;;
-;;; Code freely lifted from various places with compatible license
-;;; terms.  Most of this code is copyright Daniel Barlow
-;;; <dan@metacircles.com> or 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)
-
-(defstruct (process
-             (:constructor %make-process)
-             (:predicate processp))
-  name
-  state
-  whostate
-  function
-  thread)
-
-(defvar *current-process*
-  (%make-process
-   :name "initial process" :function nil
-   :thread
-   #+#.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or))
-   sb-thread:*current-thread*
-   #-#.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or))
-   (sb-thread:current-thread-id)))
-
-(defvar *all-processes* (list *current-process*))
-
-(defvar *all-processes-lock*
-  (sb-thread:make-mutex :name "Lock around *ALL-PROCESSES*"))
-
-;; we implement disable-process by making the disablee attempt to lock
-;; *permanent-queue*, which is already locked because we locked it
-;; here.  enable-process just interrupts the lock attempt.
-
-(defmacro get-mutex (mutex &optional (wait t))
-  `(
-    #+#.(cl:if (cl:find-symbol "GRAB-MUTEX" "SB-THREAD") '(and) '(or))
-        sb-thread:grab-mutex
-        #-#.(cl:if (cl:find-symbol "GRAB-MUTEX" "SB-THREAD") '(and) '(or))
-        sb-thread:get-mutex
-        ,mutex :waitp ,wait))
-
-(defvar *permanent-queue*
-  (sb-thread:make-mutex :name "Lock for disabled threads"))
-(unless (sb-thread:mutex-owner *permanent-queue*)
-  (get-mutex *permanent-queue* nil))
-
-(defun make-process (function &key name)
-  (let ((p (%make-process :name name
-                          :function function)))
-    (sb-thread:with-mutex (*all-processes-lock*)
-      (pushnew p *all-processes*))
-    (restart-process p)))
-
-(defun process-kill-thread (process)
-  (let ((thread (process-thread process)))
-    (when (and thread
-               (sb-thread:thread-alive-p thread))
-      (assert (not (eq thread sb-thread:*current-thread*)))
-      (sb-thread:terminate-thread thread)
-      ;; Wait until all the clean-up forms are done.
-      (sb-thread:join-thread thread :default nil))
-    (setf (process-thread process) nil)))
-
-(defun process-join (process)
-  (sb-thread:join-thread (process-thread process)))
-
-(defun restart-process (p)
-  (labels ((boing ()
-             (let ((*current-process* p)
-                   (function (process-function p)))
-               (when function
-                 (funcall function)))))
-    (process-kill-thread p)
-    (when (setf (process-thread p)
-                (sb-thread:make-thread #'boing :name (process-name p)))
-      p)))
-
-(defun destroy-process (process)
-  (sb-thread:with-mutex (*all-processes-lock*)
-    (setf *all-processes* (delete process *all-processes*)))
-  (process-kill-thread process))
-
-(defun current-process ()
-  *current-process*)
-
-(defun all-processes ()
-  ;; we're calling DELETE on *ALL-PROCESSES*.  If we look up the value
-  ;; while that delete is executing, we could end up with nonsense.
-  ;; Better use a lock (or call REMOVE instead in DESTROY-PROCESS).
-  (sb-thread:with-mutex (*all-processes-lock*)
-    *all-processes*))
-
-(defun process-yield ()
-  (sb-thread:thread-yield))
-
-(defun process-wait (reason predicate)
-  (let ((old-state (process-whostate *current-process*)))
-    (unwind-protect
-         (progn
-           (setf old-state (process-whostate *current-process*)
-                 (process-whostate *current-process*) reason)
-           (until (funcall predicate)
-             (process-yield)))
-      (setf (process-whostate *current-process*) old-state))))
-
-(defun process-wait-with-timeout (reason timeout predicate)
-  (let ((old-state (process-whostate *current-process*))
-        (end-time (+ (get-universal-time) timeout)))
-    (unwind-protect
-         (progn
-           (setf old-state (process-whostate *current-process*)
-                 (process-whostate *current-process*) reason)
-           (loop 
-              for result = (funcall predicate)
-              until (or result
-                        (> (get-universal-time) end-time))
-              do (process-yield)
-              finally (return result)))
-      (setf (process-whostate *current-process*) old-state))))
-
-(defun process-interrupt (process function)
-  (sb-thread:interrupt-thread (process-thread process) function))
-
-(defun disable-process (process)
-  (sb-thread:interrupt-thread
-   (process-thread process)
-   (lambda ()
-     (catch 'interrupted-wait (get-mutex *permanent-queue*)))))
-
-(defun enable-process (process)
-  (sb-thread:interrupt-thread
-   (process-thread process) (lambda () (throw 'interrupted-wait nil))))
-
-(defmacro without-scheduling (&body body)
-  (declare (ignore body))
-  (error "WITHOUT-SCHEDULING is not supported on this platform."))
-
-(defparameter *atomic-lock*
-  (sb-thread:make-mutex :name "atomic incf/decf"))
-
-(defmacro atomic-incf (place)
-  `(sb-thread:with-mutex (*atomic-lock*)
-    (incf ,place)))
-
-(defmacro atomic-decf (place) 
-  `(sb-thread:with-mutex (*atomic-lock*)
-    (decf ,place)))
-
-;;; 32.3 Locks
-
-(defun make-lock (&optional name)
-  (sb-thread:make-mutex :name name))
-
-(defmacro with-lock-held ((place &key state (wait t) timeout) &body body)
-  (declare (ignore timeout))
-  (let ((old-state (gensym "OLD-STATE")))
-    `(sb-thread:with-mutex (,place :wait-p ,wait)
-       (let (,old-state)
-         (unwind-protect
-              (progn
-                (when ,state
-                  (setf ,old-state (process-state *current-process*))
-                  (setf (process-state *current-process*) ,state))
-                ,@body)
-           (setf (process-state *current-process*) ,old-state))))))
-
-
-(defun make-recursive-lock (&optional name)
-  (sb-thread:make-mutex :name name))
-
-(defmacro with-recursive-lock-held ((place &optional state (wait t) timeout) &body body)
-  (declare (ignore wait timeout))
-  (let ((old-state (gensym "OLD-STATE")))
-  `(sb-thread:with-recursive-lock (,place)
-    (let (,old-state)
-      (unwind-protect
-           (progn
-             (when ,state
-               (setf ,old-state (process-state *current-process*))
-               (setf (process-state *current-process*) ,state))
-             ,@body)
-        (setf (process-state *current-process*) ,old-state))))))
-
-(defun make-condition-variable () (sb-thread:make-waitqueue))
-
-(defun condition-wait (cv lock &optional timeout)
-  (if timeout
-      (handler-case 
-          (sb-ext:with-timeout timeout
-            (sb-thread:condition-wait cv lock)
-            t)
-        (sb-ext:timeout (c)
-          (declare (ignore c))
-          nil))
-      (progn (sb-thread:condition-wait cv lock) t)))
-
-(defun condition-notify (cv)
-  (sb-thread:condition-notify cv))
-
-
-(defvar *process-plists* (make-hash-table)
-  "Hash table mapping processes to a property list.  This is used by
-PROCESS-PLIST.")
-
-(defun process-property-list (process)
-  (gethash process *process-plists*))
-
-(defun (setf process-property-list) (value process)
-  (setf (gethash process *process-plists*) value))
-
-(defun process-execute (process function)
-  (setf (process-function process) function)
-  (restart-process process))
-
-(defun process-alive-p (process)
-  (sb-thread:thread-alive-p (process-thread process)))