1 ;;;; Toplevel for sb-aclrepl
3 (cl:defpackage :sb-aclrepl
6 (cl:in-package :sb-aclrepl)
8 (defvar *break-level* 0 "Current break level")
9 (defvar *inspect-reason* nil
10 "Boolean if break level was started for inspecting.")
11 (defvar *continuable-reason* nil
12 "Boolean if break level was started by continuable error.")
13 (defvar *noprint* nil "Boolean is output should be displayed")
14 (defvar *input* nil "Input stream")
15 (defvar *output* nil "Output stream")
18 (break-level (1+ *break-level*))
19 ;; Break level is started to inspect an object
21 ;; Signals a continuable error
23 (let ((*break-level* break-level)
24 (*inspect-reason* inspect)
25 (*continuable-reason* continuable))
27 ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
28 (sb-impl::scrub-control-stack)
30 (funcall (the function sb-int:*repl-prompt-fun*) *output*)
31 (force-output *output*))
32 (let* ((form (funcall (the function sb-int:*repl-read-form-fun*)
34 (results (multiple-value-list (interactive-eval form))))
36 (dolist (result results)
38 (prin1 result *output*)))))))
41 ;;; read-eval-print loop for the default system toplevel
42 (defun toplevel-aclrepl-fun (noprint)
43 (let ((* nil) (** nil) (*** nil)
45 (+ nil) (++ nil) (+++ nil)
46 (/// nil) (// nil) (/ nil))
47 ;; WITH-SIMPLE-RESTART doesn't actually restart its body as some
48 ;; (like WHN for an embarrassingly long time ca. 2001-12-07) might
49 ;; think, but instead drops control back out at the end. So when a
50 ;; TOPLEVEL or outermost-ABORT restart happens, we need this outer
51 ;; LOOP wrapper to grab control and start over again. (And it also
52 ;; wraps CATCH 'TOPLEVEL-CATCHER for similar reasons.)
54 ;; There should only be one TOPLEVEL restart, and it's here, so
55 ;; restarting at TOPLEVEL always bounces you all the way out here.
56 (with-simple-restart (toplevel
57 "Restart at toplevel READ/EVAL/PRINT loop.")
58 ;; We add a new ABORT restart for every debugger level, so
59 ;; restarting at ABORT in a nested debugger gets you out to the
60 ;; innermost enclosing debugger, and only when you're in the
61 ;; outermost, unnested debugger level does restarting at ABORT
62 ;; get you out to here.
65 "~@<Reduce debugger level (leaving debugger, returning to toplevel).~@:>")
66 (catch 'toplevel-catcher
67 #-sunos (sb-unix:unix-sigsetmask 0) ; FIXME: What is this for?
68 ;; in the event of a control-stack-exhausted-error, we should
69 ;; have unwound enough stack by the time we get here that this
71 (sb-kernel::protect-control-stack-guard-page 1)
72 (let ((*noprint* noprint)
73 (*input* *standard-input*)
74 (*output* *standard-output*))
75 (aclrepl :break-level 0))
76 (sb-impl::critically-unreachable "after REPL")))))))
79 (when (boundp 'sb-impl::*toplevel-repl-fun*)
80 (setq sb-impl::*toplevel-repl-fun* #'toplevel-aclrepl-fun))