chore: remove sclf from the tree r/4275

SCLF is quite a big utility library (almost 3€ LOC) with limited
portability (CMUCL, SBCL and CLISP to an extent). Continuing to maintain
it is an unnecessary burden, as depot only uses a fraction of it which
is now inlined into the respective users (mime4cl and mblog).

In the future trimming down ex-sclf.lisp may make sense either by
refactoring the code that uses it or by moving interesting utilities
into e.g. klatre.

Change-Id: I2e73825b6bfa372e97847f25c30731a5aad4a1b5
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5922
Tested-by: BuildkiteCI
Autosubmit: sterni <sternenseemann@systemli.org>
Reviewed-by: sterni <sternenseemann@systemli.org>

3 files changed, 0 insertions, 356 deletions

diff --git a/third_party/lisp/sclf/mp/README b/third_party/lisp/sclf/mp/README
deleted file mode 100644
index a0732c029453..000000000000
--- a/third_party/lisp/sclf/mp/README
+++ /dev/null
@@ -1,6 +0,0 @@
-This directory contains an uniforming layer for multiprocessing in the
-style supported by Allegro Common Lisp and CMUCL.  Almost nothing of
-this has been written by me.  It's mostly the work of Gilbert Baumann
-(unk6@rz.uni-karlsruhe.de) and I've shamelessly lifted it from McCLIM.
-The copyright disclaimer in this code is compatible with the one of
-SCLF, so I believe there should be no legal issues.
diff --git a/third_party/lisp/sclf/mp/cmu.lisp b/third_party/lisp/sclf/mp/cmu.lisp
deleted file mode 100644
index 1bdbba79896f..000000000000
--- 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."))
diff --git a/third_party/lisp/sclf/mp/sbcl.lisp b/third_party/lisp/sclf/mp/sbcl.lisp
deleted file mode 100644
index a2cf497ff9bf..000000000000
--- 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)))