diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 4d7b0bf53..efa004269 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,7 @@ +2003-10-04 Neil Jerram + + * gds.el (gds-handle-input): Handle `ready-for-input' status. + 2003-08-20 Neil Jerram * guileint: New subdirectory. diff --git a/emacs/gds.el b/emacs/gds.el index cd60498aa..3b5923f03 100644 --- a/emacs/gds.el +++ b/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. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 684d81d71..024a9206c 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,12 @@ +2003-10-04 Neil Jerram + + * 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 * debugger/ui-client.scm, debugger/ui-server.scm: New (work in diff --git a/ice-9/debugger/ui-client.scm b/ice-9/debugger/ui-client.scm index 77eb742fa..8fbbe1646 100644 --- a/ice-9/debugger/ui-client.scm +++ b/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)