X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=b681336ec231a354c8373f316f48d0e25289fa17;hb=ec066d84dd46611428943d152749b3891a3f4b7c;hp=2390437accf49fa2eb680e64341d9d51aa76f65e;hpb=ce0a49644dce03ca07008e8073897e4ed7b247df;p=sbcl.git diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 2390437..b681336 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -1,16 +1,27 @@ +;;;; support for threads in the target machine + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!THREAD") ;;; FIXME it would be good to define what a thread id is or isn't (our ;;; current assumption is that it's a fixnum). It so happens that on ;;; Linux it's a pid, but it might not be on posix thread implementations -(sb!alien::define-alien-routine ("create_thread" %create-thread) - sb!alien:unsigned-long - (lisp-fun-address sb!alien:unsigned-long)) +(define-alien-routine ("create_thread" %create-thread) + unsigned-long + (lisp-fun-address unsigned-long)) -(sb!alien::define-alien-routine "signal_thread_to_dequeue" - sb!alien:unsigned-int - (thread-id sb!alien:unsigned-long)) +(define-alien-routine "signal_thread_to_dequeue" + unsigned-int + (thread-id unsigned-long)) (defvar *session* nil) @@ -155,16 +166,6 @@ (setf (mutex-value lock) nil) (futex-wake (mutex-value-address lock) 1)) - -(defmacro with-mutex ((mutex &key value (wait-p t)) &body body) - (with-unique-names (got) - `(let ((,got (get-mutex ,mutex ,value ,wait-p))) - (when ,got - (unwind-protect - (progn ,@body) - (release-mutex ,mutex)))))) - - ;;;; condition variables (defun condition-wait (queue lock) @@ -383,33 +384,32 @@ thread is not the foreground thread" (defun debugger-wait-until-foreground-thread (stream) "Returns T if thread had been running in background, NIL if it was interactive." + (declare (ignore stream)) (prog1 (with-mutex ((session-lock *session*)) (not (member (current-thread-id) (session-interactive-threads *session*)))) (get-foreground))) -(defun thread-repl-prompt-fun (out-stream) - (get-foreground) - (let ((stopped-threads (cdr (session-interactive-threads *session*)))) - (when stopped-threads - (format out-stream "~{~&Thread ~A suspended~}~%" stopped-threads)) - (sb!impl::repl-prompt-fun out-stream))) (defun get-foreground () - (loop - (with-mutex ((session-lock *session*)) - (let ((tid (current-thread-id)) - (int-t (session-interactive-threads *session*))) - (when (eql (car int-t) tid) - (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler) - (return-from get-foreground t)) - (unless (member tid int-t) - (setf (cdr (last int-t)) - (list tid))) - (condition-wait - (session-interactive-threads-queue *session*) - (session-lock *session*)))))) + (let ((was-foreground t)) + (loop + (with-mutex ((session-lock *session*)) + (let ((tid (current-thread-id)) + (int-t (session-interactive-threads *session*))) + (when (eql (car int-t) tid) + (unless was-foreground + (format *query-io* "Resuming thread ~A~%" tid)) + (sb!sys:enable-interrupt sb!unix:sigint #'sb!unix::sigint-handler) + (return-from get-foreground t)) + (setf was-foreground nil) + (unless (member tid int-t) + (setf (cdr (last int-t)) + (list tid))) + (condition-wait + (session-interactive-threads-queue *session*) + (session-lock *session*))))))) (defun release-foreground (&optional next) "Background this thread. If NEXT is supplied, arrange for it to have the foreground next"