From: Kevin R. <kev...@us...> - 2003-04-27 17:00:40
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1:/tmp/cvs-serv30414/src/code Modified Files: toplevel.lisp Log Message: 0.pre8.112: - src/code/toplevel.lisp: Remove changes to REPL and rename REPL to REPL-FUN and add hook. - sb-aclrepl/tests.lisp: Add display tests. - sb-aclrepl/toplevel.lisp: New file. Toplevel REPL with support for catching signals - sb-aclrepl/README: state that sb-aclrepl must be loaded in ~/.sbclrc. Index: toplevel.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/toplevel.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- toplevel.lisp 25 Apr 2003 16:31:22 -0000 1.43 +++ toplevel.lisp 27 Apr 2003 17:00:29 -0000 1.44 @@ -521,7 +521,7 @@ ;; have unwound enough stack by the time we get here that this ;; is now possible (sb!kernel::protect-control-stack-guard-page 1) - (repl :noprint noprint :break-level 0) + (funcall *repl-fun* noprint) (critically-unreachable "after REPL"))))))) ;;; Our default REPL prompt is the minimal traditional one. @@ -539,7 +539,6 @@ (quit) form))) - ;;; hooks to support customized toplevels like ACL-style toplevel ;;; from KMR on sbcl-devel 2002-12-21 (defvar *repl-read-form-fun* #'repl-read-form-fun @@ -551,42 +550,32 @@ (defvar *repl-prompt-fun* #'repl-prompt-fun "a function of one argument STREAM for the toplevel REPL to call: Prompt the user for input.") +(defvar *repl-fun* #'repl-fun + "a function of one argument NOPRINT that provides the REPL for the system. + Assumes that *standard-input* and *standard-output* are setup.") -(defvar *noprint* nil "boolean: T if don't print prompt and output") -(defvar *break-level* 0 "current break level") -(defvar *inspect-break* nil "boolean: T if break caused by inspect") -(defvar *continuable-break* nil "boolean: T if break caused by continuable error") - -(defun repl (&key - (break-level (1+ *break-level*)) - (noprint *noprint*) - (inspect nil) - (continuable nil)) - (let ((*noprint* noprint) - (*break-level* break-level) - (*inspect-break* inspect) - (*continuable-break* continuable)) - (/show0 "entering REPL") - (loop - ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.) - (scrub-control-stack) - (unless *noprint* - (funcall *repl-prompt-fun* *standard-output*) - ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own - ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to - ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems - ;; odd. But maybe there *is* a valid reason in some - ;; circumstances? perhaps some deadlock issue when being driven - ;; by another process or something...) - (force-output *standard-output*)) - (let* ((form (funcall *repl-read-form-fun* - *standard-input* - *standard-output*)) - (results (multiple-value-list (interactive-eval form)))) - (unless *noprint* - (dolist (result results) - (fresh-line) - (prin1 result))))))) +(defun repl-fun (noprint) + (/show0 "entering REPL") + (loop + ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.) + (scrub-control-stack) + (unless noprint + (funcall *repl-prompt-fun* *standard-output*) + ;; (Should *REPL-PROMPT-FUN* be responsible for doing its own + ;; FORCE-OUTPUT? I can't imagine a valid reason for it not to + ;; be done here, so leaving it up to *REPL-PROMPT-FUN* seems + ;; odd. But maybe there *is* a valid reason in some + ;; circumstances? perhaps some deadlock issue when being driven + ;; by another process or something...) + (force-output *standard-output*)) + (let* ((form (funcall *repl-read-form-fun* + *standard-input* + *standard-output*)) + (results (multiple-value-list (interactive-eval form)))) + (unless noprint + (dolist (result results) + (fresh-line) + (prin1 result)))))) ;;; suitable value for *DEBUGGER-HOOK* for a noninteractive Unix-y program (defun noprogrammer-debugger-hook-fun (condition old-debugger-hook) |