;;; specials initialized by !COLD-INIT
;;; FIXME: These could be converted to DEFVARs.
-(declaim (special *gc-inhibit* *already-maybe-gcing*
- *need-to-collect-garbage*
+(declaim (special *gc-inhibit* *need-to-collect-garbage*
*gc-notify-stream*
*before-gc-hooks* *after-gc-hooks*
#!+x86 *pseudo-atomic-atomic*
(let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
(initial-offset (logand csp (1- bytes-per-scrub-unit)))
(end-of-stack
- (- sb!vm:control-stack-end sb!c:*backend-page-size*)))
+ (- sb!vm::*control-stack-end* sb!c:*backend-page-size*)))
(labels
((scrub (ptr offset count)
(declare (type system-area-pointer ptr)
#!+stack-grows-downward-not-upward
(let* ((csp (sap-int (sb!c::control-stack-pointer-sap)))
- (end-of-stack (+ sb!vm:control-stack-start sb!c:*backend-page-size*))
+ (end-of-stack (+ sb!vm::*control-stack-start* sb!c:*backend-page-size*))
(initial-offset (logand csp (1- bytes-per-scrub-unit))))
(labels
((scrub (ptr offset count)
(defun toplevel-init ()
(/show0 "entering TOPLEVEL-INIT")
-
- (let ((sysinit nil) ; value of --sysinit option
- (userinit nil) ; value of --userinit option
- (reversed-evals nil) ; values of --eval options, in reverse order; and
- ; also --load options, translated into --eval
- (noprint nil) ; Has a --noprint option been seen?
- (options (rest *posix-argv*))) ; skipping program name
+ (setf sb!thread::*session-lock* (sb!thread:make-mutex :name "the terminal"))
+ (sb!thread::get-foreground)
+ (let (;; value of --sysinit option
+ (sysinit nil)
+ ;; value of --userinit option
+ (userinit nil)
+ ;; values of --eval options, in reverse order; and also any
+ ;; other options (like --load) which're translated into --eval
+ ;;
+ ;; The values are stored as strings, so that they can be
+ ;; passed to READ only after their predecessors have been
+ ;; EVALed, so that things work when e.g. REQUIRE in one EVAL
+ ;; form creates a package referred to in the next EVAL form.
+ (reversed-evals nil)
+ ;; Has a --noprint option been seen?
+ (noprint nil)
+ ;; everything in *POSIX-ARGV* except for argv[0]=programname
+ (options (rest *posix-argv*)))
(declare (type list options))
(setf userinit (pop-option))))
((string= option "--eval")
(pop-option)
- (let ((eval-as-string (pop-option)))
- (with-input-from-string (eval-stream eval-as-string)
- (let* ((eof-marker (cons :eof :eof))
- (eval (read eval-stream nil eof-marker))
- (eof (read eval-stream nil eof-marker)))
- (cond ((eq eval eof-marker)
- (error "unable to parse ~S"
- eval-as-string))
- ((not (eq eof eof-marker))
- (error "more than one expression in ~S"
- eval-as-string))
- (t
- (push eval reversed-evals)))))))
+ (push (pop-option) reversed-evals))
((string= option "--load")
(pop-option)
- (push `(load ,(pop-option)) reversed-evals))
+ (push (concatenate 'string "(LOAD \"" (pop-option) "\")")
+ reversed-evals))
((string= option "--noprint")
(pop-option)
(setf noprint t))
((string= option "--noprogrammer")
(warn "treating deprecated --noprogrammer as --disable-debugger")
(pop-option)
- (push '(disable-debugger) reversed-evals))
+ (push "(DISABLE-DEBUGGER)" reversed-evals))
((string= option "--disable-debugger")
(pop-option)
- (push '(disable-debugger) reversed-evals))
+ (push "(DISABLE-DEBUGGER)" reversed-evals))
((string= option "--end-toplevel-options")
(pop-option)
(return))
(return)))))))
(/show0 "done with LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
- ;; Excise all the options that we processed, so that only
+ ;; Delete all the options that we processed, so that only
;; user-level options are left visible to user code.
(setf (rest *posix-argv*) options)
;; Process --eval options.
(/show0 "handling --eval options in TOPLEVEL-INIT")
- (dolist (eval (reverse reversed-evals))
+ (dolist (expr-as-string (reverse reversed-evals))
(/show0 "handling one --eval option in TOPLEVEL-INIT")
- (eval eval)
- (flush-standard-output-streams)))
+ (let ((expr (with-input-from-string (eval-stream
+ expr-as-string)
+ (let* ((eof-marker (cons :eof :eof))
+ (result (read eval-stream nil eof-marker))
+ (eof (read eval-stream nil eof-marker)))
+ (cond ((eq result eof-marker)
+ (error "unable to parse ~S"
+ expr-as-string))
+ ((not (eq eof eof-marker))
+ (error "more than one expression in ~S"
+ expr-as-string))
+ (t
+ result))))))
+ (eval expr)
+ (flush-standard-output-streams))))
(continue ()
:report
"Continue anyway (skipping to toplevel read/eval/print loop)."
;; 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)
+ (repl :noprint noprint :break-level 0)
(critically-unreachable "after REPL")))))))
;;; Our default REPL prompt is the minimal traditional one.
(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
"a function of one argument STREAM for the toplevel REPL to call: Prompt
the user for input.")
-(defun repl (noprint)
- (/show0 "entering REPL")
- (let ((eof-marker (cons :eof nil)))
+(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
+ (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
*standard-input*
*standard-output*))
(results (multiple-value-list (interactive-eval form))))
- (unless noprint
+ (unless *noprint*
(dolist (result results)
(fresh-line)
(prin1 result)))))))
projects / sbcl.git / blobdiff