;;; 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)))
\f
;;;; miscellaneous external functions
-#!-mp ; The multi-processing version is defined in multi-proc.lisp.
(defun sleep (n)
#!+sb-doc
"This function causes execution to be suspended for N seconds. N may
(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)
+ (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")
- (let ((eof-marker (cons :eof nil)))
- (loop
- ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
- (scrub-control-stack)
+ (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
- (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)))))))
+ (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)
projects / sbcl.git / blobdiff