Debugger UI asynchronous thread support.

emacs/ChangeLog

@@ -1,3 +1,7 @@
+2003-10-04  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* gds.el (gds-handle-input): Handle `ready-for-input' status.
+
 2003-08-20  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* guileint: New subdirectory.

emacs/gds.el

@@ -269,7 +269,8 @@
 		      (gds-set gds-statuses client status)
 		      (cond ((eq status 'waiting-for-input)
 			     (gds-debug client))
-			    ((eq status 'running)
+			    ((or (eq status 'running)
+				 (eq status 'ready-for-input))
 			     (if (eq client gds-displayed-client)
 				 (gds-display-state client)))
 			    (t
@@ -416,9 +417,9 @@
     (gds-maybe-delete-region "Status")
     (widget-insert "Status: "
 		   (cdr (assq (cdr (assq client gds-statuses))
-			      '((running . "running")
+			      '((running . "running (cannot accept input)")
 				(waiting-for-input . "waiting for input")
-				(ready-for-input . "ready for input"))))
+				(ready-for-input . "running"))))
 		   "\n\n")
     (let ((output (cdr (assq client gds-outputs))))
       (if (> (length output) 0)
@@ -746,3 +747,13 @@ not of primary interest when debugging application code."
 			module
 			sym
 			behaviour)))))
+
+
+;;;; Evaluating code.
+
+;; The Scheme process to which code is sent is determined in the usual
+;; cmuscheme.el way by the `scheme-buffer' variable (q.v.).
+;; Customizations to the way that code is sent, for example pro- and
+;; postlogs to set up and restore evaluation context correctly in the
+;; Scheme process, are achieved (elsewhere than this file) by advising
+;; `scheme-send-region' accordingly.

ice-9/ChangeLog

@@ -1,3 +1,12 @@
+2003-10-04  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* debugger/ui-client.scm (ui-disable-async-thread,
+	ui-continue-async-thread, start-async-ui-thread): New.
+	(ui-command-loop): Call ui-disable-async-thread and
+	ui-continue-async-thread.
+	(handle-instruction): Read terminating newline char so it doesn't
+	cause following select to pop immediately.
+
 2003-09-25  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* debugger/ui-client.scm, debugger/ui-server.scm: New (work in

ice-9/debugger/ui-client.scm

@@ -26,6 +26,7 @@
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 session)
   #:use-module (ice-9 string-fun)
+  #:use-module (ice-9 threads)
   #:export (ui-port-number
 	    ui-connected?
 	    ui-connect
@@ -62,6 +63,8 @@ decimal IP address where the UI server is running; default is
 				accumulate-output
 				#f #f #f #f)
 			"w"))
+  ;; Start the asynchronous UI thread.
+  (start-async-ui-thread)
   ;; Write initial context to debug server.
   (write-form (list 'name name))
   (write-form (cons 'modules (map module-name (loaded-modules))))
@@ -69,6 +72,50 @@ decimal IP address where the UI server is running; default is
 ;  (ui-command-loop #f)
   )
 
+(define ui-disable-async-thread noop)
+(define ui-continue-async-thread noop)
+
+(define (start-async-ui-thread)
+  (let ((mutex (make-mutex))
+	(condition (make-condition-variable))
+	(admin (pipe)))
+    ;; Start the asynchronous UI thread.
+    (begin-thread
+      (lock-mutex mutex)
+      ;;(write (cons admin ui-port))
+      ;;(newline)
+      (let loop ((avail '()))
+	;;(write avail)
+	;;(newline)
+	(if (null? avail)
+	    (begin
+	      (write-status 'ready-for-input)
+	      (loop (car (select (list ui-port (car admin)) '() '()))))
+	    (let ((port (car avail)))
+	      (if (eq? port ui-port)
+		  (handle-instruction #f (read ui-port))
+		  (begin
+		    ;; Notification from debugger that it wants to take
+		    ;; over.  Read the notification char.
+		    (read-char (car admin))
+		    ;; Wait on condition variable - this allows the
+		    ;; debugger thread to grab the mutex.
+		    (wait-condition-variable condition mutex)))
+	      ;; Loop.
+	      (loop (cdr avail))))))
+    ;; Redefine procs used by debugger thread to take control.
+    (set! ui-disable-async-thread
+	  (lambda ()
+	    (write-char #\x (cdr admin))
+	    (force-output (cdr admin))
+	    ;;(display "ui-disable-async-thread: locking mutex...\n"
+	    ;;	     (current-error-port))
+	    (lock-mutex mutex)))
+    (set! ui-continue-async-thread
+	  (lambda ()
+	    (unlock-mutex mutex)
+	    (signal-condition-variable condition)))))
+
 (define accumulated-output '())
 
 (define (accumulate-output obj)
@@ -89,6 +136,7 @@ decimal IP address where the UI server is running; default is
   "Interact with the UI frontend."
   (or (ui-connected?)
       (error "Not connected to UI server."))
+  (ui-disable-async-thread)
   (catch 'exit-debugger
 	 (lambda ()
 	   (let loop ((state state))
@@ -103,7 +151,8 @@ decimal IP address where the UI server is running; default is
 	     ;; Read next instruction, act on it, and loop with
 	     ;; updated state.
 	     (loop (handle-instruction state (read ui-port)))))
-	 (lambda args *unspecified*)))
+	 (lambda args *unspecified*))
+  (ui-continue-async-thread))
 
 (define (write-stack state)
   ;; Write Emacs-readable representation of current state to UI
@@ -176,6 +225,8 @@ decimal IP address where the UI server is running; default is
   (resolve-module '(ice-9 debugger commands)))
 
 (define (handle-instruction state ins)
+  ;; Read the newline that always follows an instruction.
+  (read-char ui-port)
   ;; Handle instruction from the UI frontend, and return updated state.
   (case (car ins)
     ((query-module)