40 |
;; Once connected, the TCP socket port to the UI server. |
;; Once connected, the TCP socket port to the UI server. |
41 |
(define ui-port #f) |
(define ui-port #f) |
42 |
|
|
43 |
(define* (ui-connect name #:optional host) |
(define* (ui-connect name debug #:optional host) |
44 |
"Connect to the debug UI server as @var{name}, a string that should |
"Connect to the debug UI server as @var{name}, a string that should |
45 |
be sufficient to describe the calling application to the debug UI |
be sufficient to describe the calling application to the debug UI |
46 |
user. The optional @var{host} arg specifies the hostname or dotted |
user. The optional @var{host} arg specifies the hostname or dotted |
68 |
;; Write initial context to debug server. |
;; Write initial context to debug server. |
69 |
(write-form (list 'name name)) |
(write-form (list 'name name)) |
70 |
(write-form (cons 'modules (map module-name (loaded-modules)))) |
(write-form (cons 'modules (map module-name (loaded-modules)))) |
71 |
(debug-stack (make-stack #t ui-connect) #:continuable) |
;; If `debug' is true, debug immediately. |
72 |
|
(if debug |
73 |
|
(debug-stack (make-stack #t ui-connect) #:continuable)) |
74 |
; (ui-command-loop #f) |
; (ui-command-loop #f) |
75 |
) |
) |
76 |
|
|
288 |
(with-output-to-string (lambda () (write value)))) |
(with-output-to-string (lambda () (write value)))) |
289 |
values))) |
values))) |
290 |
(let ((value #f)) |
(let ((value #f)) |
291 |
(let ((output |
(let* ((do-eval (if m |
292 |
(with-output-to-string |
(lambda () |
293 |
(lambda () |
(display "Evaluating in module ") |
294 |
(if m |
(write (module-name m)) |
295 |
(begin |
(newline) |
296 |
(display "Evaluating in module ") |
(set! value |
297 |
(write (module-name m)) |
(call-with-values (lambda () |
298 |
(newline) |
(eval x m)) |
299 |
(set! value |
value-consumer))) |
300 |
(call-with-values (lambda () (eval x m)) |
(lambda () |
301 |
value-consumer))) |
(display "Evaluating in current module ") |
302 |
(begin |
(write (module-name (current-module))) |
303 |
(display "Evaluating in current module ") |
(newline) |
304 |
(write (module-name (current-module))) |
(set! value |
305 |
(newline) |
(call-with-values (lambda () |
306 |
(set! value |
(primitive-eval x)) |
307 |
(call-with-values (lambda () (primitive-eval x)) |
value-consumer))))) |
308 |
value-consumer)))))))) |
(output |
309 |
|
(with-output-to-string |
310 |
|
(lambda () |
311 |
|
(catch #t |
312 |
|
do-eval |
313 |
|
(lambda (key . args) |
314 |
|
(case key |
315 |
|
((misc-error signal unbound-variable |
316 |
|
numerical-overflow) |
317 |
|
(apply display-error #f |
318 |
|
(current-output-port) args) |
319 |
|
(set! value '("error-in-evaluation"))) |
320 |
|
(else |
321 |
|
(display "EXCEPTION: ") |
322 |
|
(display key) |
323 |
|
(display " ") |
324 |
|
(write args) |
325 |
|
(newline) |
326 |
|
(set! value |
327 |
|
'("unhandled-exception-in-evaluation")))))))))) |
328 |
(list output value)))) |
(list output value)))) |
329 |
|
|
330 |
(define (write-status status) |
(define (write-status status) |