From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Wed, 16 Apr 2003 00:58:58 +0000 (+0000)
Subject: sb-aclrepl improvments [0.pre8.60]:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0b50ec4bd716d2bf3aecb0931c4ced8255c3d542;p=sbcl.git

sb-aclrepl improvments [0.pre8.60]:
 - Add code from prompt-fun in target-thread.lisp to aclrepl's prompt-fun
 - Add :signal and :df commands
 - Improve :kill command
---

diff --git a/contrib/sb-aclrepl/inspect.lisp b/contrib/sb-aclrepl/inspect.lisp
index c694008..cef37b1 100644
--- a/contrib/sb-aclrepl/inspect.lisp
+++ b/contrib/sb-aclrepl/inspect.lisp
@@ -389,12 +389,15 @@ POSITION is NIL if the id is invalid or not found."
 	 position)))))
 
 (defun label-at-maybe-with-index (parts position)
+  "Helper function for inspected-elements. Conses the
+position with the label is the label is a string."
   (let ((label (label-at parts position)))
     (if (stringp label)
 	(cons position label)
 	label)))
 
 (defun array-index-string (index parts)
+  "Formats an array index in row major format."
   (let ((rev-dimensions (parts-seq-hint parts)))
     (if (null rev-dimensions)
 	"[]"
diff --git a/contrib/sb-aclrepl/repl.lisp b/contrib/sb-aclrepl/repl.lisp
index 7059ffc..fe22375 100644
--- a/contrib/sb-aclrepl/repl.lisp
+++ b/contrib/sb-aclrepl/repl.lisp
@@ -490,16 +490,43 @@
   (format *repl-output* "~&Threads are not supported in this version of sbcl")
   (values))
 
-(defun kill-cmd (selected-pid)
+(defun kill-cmd (&rest selected-pids)
   #+sb-thread
   (let ((pids (thread-pids)))
-    (if (find selected-pid pids :test #'eql)
-	(progn
-	  (sb-thread:destroy-thread selected-pid)
-	  (format *repl-output* "Thread ~D destroyed" selected-pid))
-	(format *repl-output* "No thread ~D exists" selected-pid)))
+    (dolist (selected-pid selected-pids) 
+      (if (find selected-pid pids :test #'eql)
+	  (progn
+	    (sb-thread:destroy-thread selected-pid)
+	    (format *repl-output* "~&Thread ~A destroyed" selected-pid))
+	  (format *repl-output* "~&No thread ~A exists" selected-pid))))
+  #-sb-thread
+  (declare (ignore selected-pids))
+  #-sb-thread
+  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (values))
+
+(defun signal-cmd (signal &rest selected-pids)
+  #+sb-thread
+  (let ((pids (thread-pids)))
+    (dolist (selected-pid selected-pids)
+      (if (find selected-pid pids :test #'eql)
+	  (progn
+	    (sb-unix:unix-kill selected-pid signal)
+	    (format *repl-output* "~&Signal ~A sent to thread ~A"
+		    signal selected-pid))
+	  (format *repl-output* "~&No thread ~A exists" selected-pid))))
+  #-sb-thread
+  (declare (ignore selected-pids))
+  #-sb-thread
+  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (values))
+
+(defun release-foreground-cmd ()
+  #+sb-thread
+  (progn
+    (sb-thread:release-foreground)
+    (sleep 1))
   #-sb-thread
-  (declare (ignore selected-pid))
   #-sb-thread
   (format *repl-output* "~&Threads are not supported in this version of sbcl")
   (values))
@@ -536,7 +563,9 @@
 	 ("history" 3 history-cmd "print the recent history")
 	 ("inspect" 2 inspect-cmd "inspect an object")
 	 ("istep" 1 istep-cmd "navigate within inspection of a lisp object" :parsing :string)
-	 #+sb-thread ("kill" 2 kill-cmd "kill a process")
+	 #+sb-thread ("kill" 2 kill-cmd "kill (destroy) processes")
+	 #+sb-thread ("signal" 2 signal-cmd "send a signal to processes")
+	 #+sb-thread ("rf" 2 release-foreground-cmd "release foreground")
 	 #+aclrepl-debugger("local" 3 local-cmd "print the value of a local variable")
 	 ("pwd" 3 pwd-cmd "print current directory")
 	 ("pushd" 2 pushd-cmd "push directory on stack" :parsing :string)
@@ -641,11 +670,18 @@
 
 ;;;; linking into SBCL hooks
 
+
 (defun repl-prompt-fun (stream)
   (let* ((break-data (car *break-stack*))
 	 (break-level (break-data-level break-data)))
     (when (zerop break-level)
       (setq break-level nil))
+    #+sb-thread
+    (let ((lock sb-thread::*session-lock*))
+      (sb-thread::get-foreground)
+      (let ((stopped-threads (sb-thread::waitqueue-data lock)))
+	(when stopped-threads
+	  (format stream "~{~&Thread ~A suspended~}~%" stopped-threads))))
     (if (functionp *prompt*)
 	(write-string (funcall *prompt* break-level
 			       (break-data-inspect-initiated break-data)