style(3p/lisp): expand tabs in npg, mime4cl and sclf
Done using
find third_party/lisp/{sclf,mime4cl,npg} \
-name '*.lisp' -or -name '*.asd' \
-exec bash -c 'expand -i -t 8 "$0" | sponge "$0"' {} \;
Change-Id: If84afac9c1d5cbc74e137a5aa0ae61472f0f1e90
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5066
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
This commit is contained in:
sterni
parent
40014c70b3
commit
25cb0ad32f
25 changed files with 2467 additions and 2467 deletions
54
third_party/lisp/sclf/mp/cmu.lisp
vendored
54
third_party/lisp/sclf/mp/cmu.lisp
vendored
|
|
@ -30,14 +30,14 @@
|
|||
|
||||
(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)))
|
||||
: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)))
|
||||
,@(when wait (list :wait wait))
|
||||
,@(when timeout (list :timeout timeout)))
|
||||
,@forms))
|
||||
|
||||
(defstruct condition-variable
|
||||
|
|
@ -47,31 +47,31 @@
|
|||
|
||||
(defun %release-lock (lock) ; copied from with-lock-held in multiproc.lisp
|
||||
#+i486 (kernel:%instance-set-conditional
|
||||
lock 2 mp:*current-process* nil)
|
||||
lock 2 mp:*current-process* nil)
|
||||
#-i486 (when (eq (lock-process lock) mp:*current-process*)
|
||||
(setf (lock-process lock) nil)))
|
||||
(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))
|
||||
(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))))))
|
||||
(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))
|
||||
|
|
@ -79,12 +79,12 @@
|
|||
;; 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))))
|
||||
(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))
|
||||
|
||||
|
|
@ -100,7 +100,7 @@
|
|||
(defun destroy-process (process)
|
||||
;; silnetly ignore a process that is trying to destroy itself
|
||||
(unless (eq (mp:current-process)
|
||||
process)
|
||||
process)
|
||||
(mp:destroy-process process)))
|
||||
|
||||
(defun restart-process (process)
|
||||
|
|
|
|||
94
third_party/lisp/sclf/mp/sbcl.lisp
vendored
94
third_party/lisp/sclf/mp/sbcl.lisp
vendored
|
|
@ -24,8 +24,8 @@
|
|||
(in-package :sclf)
|
||||
|
||||
(defstruct (process
|
||||
(:constructor %make-process)
|
||||
(:predicate processp))
|
||||
(:constructor %make-process)
|
||||
(:predicate processp))
|
||||
name
|
||||
state
|
||||
whostate
|
||||
|
|
@ -53,10 +53,10 @@
|
|||
(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))
|
||||
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"))
|
||||
|
|
@ -65,7 +65,7 @@
|
|||
|
||||
(defun make-process (function &key name)
|
||||
(let ((p (%make-process :name name
|
||||
:function function)))
|
||||
:function function)))
|
||||
(sb-thread:with-mutex (*all-processes-lock*)
|
||||
(pushnew p *all-processes*))
|
||||
(restart-process p)))
|
||||
|
|
@ -73,7 +73,7 @@
|
|||
(defun process-kill-thread (process)
|
||||
(let ((thread (process-thread process)))
|
||||
(when (and thread
|
||||
(sb-thread:thread-alive-p 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.
|
||||
|
|
@ -85,13 +85,13 @@
|
|||
|
||||
(defun restart-process (p)
|
||||
(labels ((boing ()
|
||||
(let ((*current-process* p)
|
||||
(function (process-function p)))
|
||||
(when function
|
||||
(funcall function)))))
|
||||
(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)))
|
||||
(sb-thread:make-thread #'boing :name (process-name p)))
|
||||
p)))
|
||||
|
||||
(defun destroy-process (process)
|
||||
|
|
@ -115,26 +115,26 @@
|
|||
(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)))
|
||||
(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)))
|
||||
(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)))
|
||||
(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)
|
||||
|
|
@ -175,13 +175,13 @@
|
|||
(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))))))
|
||||
(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)
|
||||
|
|
@ -193,24 +193,24 @@
|
|||
`(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))))))
|
||||
(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))
|
||||
(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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue