;;; 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*
;;; by QUIT) is caught and any final processing and return codes are
;;; handled appropriately.
(defmacro handling-end-of-the-world (&body body)
- (let ((caught (gensym "CAUGHT")))
+ (with-unique-names (caught)
`(let ((,caught (catch '%end-of-the-world
(/show0 "inside CATCH '%END-OF-THE-WORLD")
,@body)))
(error-error "Help! "
*current-error-depth*
" nested errors. "
- "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
+ "SB-KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
t)
(t
(/show0 "returning normally from INFINITE-ERROR-PROTECTOR")
(error-error "Help! "
*current-error-depth*
" nested errors. "
- "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
+ "SB-KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
(progn ,@forms)
t)
(t
(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:fixnumize 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:fixnumize sb!vm:*control-stack-start*)
+ sb!c:*backend-page-size*))
(initial-offset (logand csp (1- bytes-per-scrub-unit))))
(labels
((scrub (ptr offset count)
(/show0 "entering TOPLEVEL-INIT")
(setf sb!thread::*session-lock* (sb!thread:make-mutex :name "the terminal"))
(sb!thread::get-foreground)
- (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
+ (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)
+ (funcall *repl-fun* noprint)
(critically-unreachable "after REPL")))))))
;;; Our default REPL prompt is the minimal traditional one.
(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.")
-(defun repl (noprint)
+(defun repl-fun (noprint)
(/show0 "entering REPL")
(loop
;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
projects / sbcl.git / blobdiff