X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-unithread.lisp;h=651573d43c8078f10af34fd63ff804b58046ba27;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=e7a1917178b55d114187441874dc92ae401535ed;hpb=c10e4afc31e25003cc2500803ceb7589232e7f6b;p=sbcl.git diff --git a/src/code/target-unithread.lisp b/src/code/target-unithread.lisp index e7a1917..651573d 100644 --- a/src/code/target-unithread.lisp +++ b/src/code/target-unithread.lisp @@ -1,14 +1,15 @@ (in-package "SB!THREAD") -#-sb-fluid (declaim (inline sb!vm::current-thread-offset-sap)) +;;; 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 @@ -55,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 @@ -90,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 @@ -113,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 ())