X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-unithread.lisp;h=651573d43c8078f10af34fd63ff804b58046ba27;hb=84271f268f29364b57bfeb1b37642311eb8ab910;hp=c79c0119c4e4cd08d8932ad360617b3357ffb836;hpb=2e0b8031efc55c4b59ebf09cd263cf95e435cdfa;p=sbcl.git diff --git a/src/code/target-unithread.lisp b/src/code/target-unithread.lisp index c79c011..651573d 100644 --- a/src/code/target-unithread.lisp +++ b/src/code/target-unithread.lisp @@ -1,8 +1,15 @@ (in-package "SB!THREAD") +;;; used bu debug-int.lisp to access interrupt contexts +#!-sb-fluid (declaim (inline sb!vm::current-thread-offset-sap)) +(defun sb!vm::current-thread-offset-sap (n) + (declare (type (unsigned-byte 27) n)) + (sb!sys:sap-ref-sap (alien-sap (extern-alien "all_threads" (* t))) + (* n 4))) + (defun current-thread-id () - (sb!sys:sap-int - (sb!vm::current-thread-offset-sap sb!vm::thread-pid-slot))) + (sb!sys:sap-ref-32 (alien-sap (extern-alien "all_threads" (* t))) + (* sb!vm::thread-pid-slot 4))) ;;;; queues, locks @@ -49,7 +56,7 @@ (let ((h (car (waitqueue-data queue)))) (setf (waitqueue-lock queue) 0) (when h - (sb!unix:unix-kill h :sigcont))))) + (sb!unix:unix-kill h sb!unix:sigcont))))) ;;;; mutex @@ -84,11 +91,20 @@ (setf old-value t1)))) (defmacro with-mutex ((mutex &key value (wait-p t)) &body body) - (declare (ignore mutex value wait-p)) - `(progn ,@body)) - -;;; what's the best thing to do with these on unithread? -#+NIl + (cond ((not wait-p) + `(unless (mutex-value ,mutex) + (unwind-protect + (progn + (setf (mutex-value ,mutex) (or ,value t)) + ,@body) + (setf (mutex-value ,mutex) nil)))) + (t + `(progn ,@body)))) + +;;; what's the best thing to do with these on unithread? commented +;;; functions are the thread versions, just to remind me what they do +;;; there +#+nil (defun condition-wait (queue lock) "Atomically release LOCK and enqueue ourselves on QUEUE. Another thread may subsequently notify us using CONDITION-NOTIFY, at which @@ -107,11 +123,12 @@ time we reacquire LOCK and return to the caller." "Notify one of the processes waiting on QUEUE" (signal-queue-head queue)) - -;;;; multiple independent listeners - -(defvar *session-lock* nil) +(defun maybe-install-futex-functions () nil) ;;;; job control +(defun init-job-control () t) (defun debugger-wait-until-foreground-thread (stream) t) +(defun get-foreground () t) +(defun release-foreground (&optional next) t) +(defun terminate-session ())