Skip to content
Snippets Groups Projects
Commit fa09c5d2 authored by ram's avatar ram
Browse files

Merged in new %TOP-LEVEL from working code sources.

parent 20682d65
No related branches found
No related tags found
No related merge requests found
...@@ -64,13 +64,10 @@ ...@@ -64,13 +64,10 @@
"The fixnum closest in value to negative infinity.") "The fixnum closest in value to negative infinity.")
(defvar *prompt* "* " "The string with which Lisp prompts you.")
;;; Random information: ;;; Random information:
(defvar compiler-version "???") (defvar compiler-version "???")
(defvar *lisp-implementation-version* "2.7(?)") (defvar *lisp-implementation-version* "3.0(?)")
(defvar *in-the-compiler* () (defvar *in-the-compiler* ()
"Bound to T while running code inside the compiler. Macros may test this to "Bound to T while running code inside the compiler. Macros may test this to
...@@ -1166,44 +1163,76 @@ ...@@ -1166,44 +1163,76 @@
(defvar ++ nil "Gets the previous value of + when a new value is read.") (defvar ++ nil "Gets the previous value of + when a new value is read.")
(defvar +++ nil "Gets the previous value of ++ when a new value is read.") (defvar +++ nil "Gets the previous value of ++ when a new value is read.")
(defvar - nil "Holds the form curently being evaluated.") (defvar - nil "Holds the form curently being evaluated.")
(defvar *prompt* nil "The top-level prompt string.") (defvar *prompt* "* "
(defvar %temp% nil "Random temporary, clobbered by top level loop.") "The top-level prompt string. This also may be a function of no arguments
that returns a simple-string.")
(defvar *in-top-level-catcher* nil (defvar *in-top-level-catcher* nil
"True if we are within the Top-Level-Catcher. This is used by interrupt "True if we are within the Top-Level-Catcher. This is used by interrupt
handlers to see whether it is o.k. to throw.") handlers to see whether it is o.k. to throw.")
(defun interactive-eval (form)
"Evaluate FORM, returning whatever it returns but adjust ***, **, *, +++, ++,
+, ///, //, /, and -."
(setf +++ ++
++ +
+ -
- form)
(let ((results (multiple-value-list (eval form))))
(setf /// //
// /
/ results
*** **
** *
* (car results)))
(unless (boundp '*)
;; The bogon returned an unbound marker.
(setf * nil)
(cerror "Go on with * set to NIL."
"EVAL returned an unbound marker."))
(values-list /))
(defconstant eofs-before-quit 10)
(defun %top-level () (defun %top-level ()
"Top-level READ-EVAL-PRINT loop. Do not call this." "Top-level READ-EVAL-PRINT loop. Do not call this."
(let ((this-eval nil) (* nil) (** nil) (*** nil) (let ((* nil) (** nil) (*** nil)
(- nil) (+ nil) (++ nil) (+++ nil) (- nil) (+ nil) (++ nil) (+++ nil)
(/// nil) (// nil) (/ nil) (%temp% nil)) (/// nil) (// nil) (/ nil)
(magic-eof-cookie (cons :eof nil))
(number-of-eofs 0))
(loop (loop
(with-simple-restart (abort "Return to Top-Level.") (with-simple-restart (abort "Return to Top-Level.")
(catch 'top-level-catcher (catch 'top-level-catcher
;;
;; Prevent the user from irrevocably wedging the hooks.
(setq *evalhook* nil)
(setq *applyhook* nil)
(let ((*in-top-level-catcher* t)) (let ((*in-top-level-catcher* t))
(loop (loop
(fresh-line) (fresh-line)
(princ *prompt*) (princ (if (functionp *prompt*)
(setq +++ ++ ++ + + - - (read)) (funcall *prompt*)
(setq this-eval (multiple-value-list (eval -))) *prompt*))
(dolist (x this-eval) (force-output)
(fresh-line) (let ((form (read *standard-input* nil magic-eof-cookie)))
(prin1 x)) (cond ((not (eq form magic-eof-cookie))
(setq /// // // / / this-eval) (let ((results
(setq %temp% (car this-eval)) (multiple-value-list (interactive-eval form))))
;; (dolist (result results)
;; Make sure nobody passes back an unbound marker. (fresh-line)
(unless (boundp '%temp%) (prin1 result)))
(setq %temp% nil) (setf number-of-eofs 0))
(cerror "Go on, but set * to NIL." ((eql (incf number-of-eofs) 1)
"Eval returned an unbound marker.")) (let ((stream (make-synonym-stream '*terminal-io*)))
(setq *** ** ** * * %temp%)))))))) (setf *standard-input* stream)
(setf *standard-output* stream)
(format t "~&Received EOF on *standard-input*, ~
switching to *terminal-io*.~%")))
((> number-of-eofs eofs-before-quit)
(format t "~&Received more than ~D EOFs; Aborting.~%"
eofs-before-quit)
(quit))
(t
(format t "~&Received EOF.~%")))))))))))
;;; %Halt -- Interface ;;; %Halt -- Interface
;;; ;;;
;;; A convenient way to get into the assembly level debugger. ;;; A convenient way to get into the assembly level debugger.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment