X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-unithread.lisp;h=651573d43c8078f10af34fd63ff804b58046ba27;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=bd57e74e537b07ad19cfdd7f5901188dcac454ae;hpb=d767105094f5836327f9389b061f83a44240a279;p=sbcl.git diff --git a/src/code/target-unithread.lisp b/src/code/target-unithread.lisp index bd57e74..651573d 100644 --- a/src/code/target-unithread.lisp +++ b/src/code/target-unithread.lisp @@ -1,5 +1,6 @@ (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)) @@ -7,8 +8,8 @@ (* 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 ())