summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--emacs/ChangeLog4
-rw-r--r--emacs/gds.el17
-rw-r--r--ice-9/ChangeLog9
-rw-r--r--ice-9/debugger/ui-client.scm53
4 files changed, 79 insertions, 4 deletions
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 <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.
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 <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
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)