(declaim (type list *history*))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(*prompt* *exit-on-eof* *max-history*
- *use-short-package-name* *command-char*
- alias)))
-
(defvar *eof-marker* :eof)
(defvar *eof-cmd* (make-user-cmd :func :eof))
(defvar *null-cmd* (make-user-cmd :func :null-cmd))
(defparameter *cmd-table-hash*
(make-hash-table :size 30 :test #'equal))
-;; Set up binding for multithreading
-
-(let ((*prompt* #.*default-prompt*)
- (*use-short-package-name* t)
- (*dir-stack* nil)
- (*command-char* #\:)
- (*max-history* 100)
- (*exit-on-eof* t)
- (*history* nil)
- (*cmd-number* 1)
- )
-
(defun prompt-package-name ()
(if *use-short-package-name*
(car (sort (append
(defun read-cmd (input-stream)
;; Reads a command from the user and returns a user-cmd object
- (let ((next-char (peek-char-non-whitespace input-stream)))
- (cond
- ((eql *command-char* next-char)
- (dispatch-command-line input-stream))
- ((eql #\newline next-char)
- (read-char input-stream)
- *null-cmd*)
- ((eql :eof next-char)
- *eof-cmd*)
- (t
- (let* ((eof (cons nil *eof-marker*))
- (form (read input-stream nil eof)))
- (if (eq form eof)
- *eof-cmd*
- (make-user-cmd :input form :func nil :hnum *cmd-number*)))))))
+ (let* ((next-char (peek-char-non-whitespace input-stream))
+ (cmd (cond
+ ((eql *command-char* next-char)
+ (dispatch-command-line input-stream))
+ ((eql #\newline next-char)
+ (read-char input-stream)
+ *null-cmd*)
+ ((eql :eof next-char)
+ *eof-cmd*)
+ (t
+ (let* ((eof (cons nil *eof-marker*))
+ (form (read input-stream nil eof)))
+ (if (eq form eof)
+ *eof-cmd*
+ (make-user-cmd :input form :func nil :hnum *cmd-number*)))))))
+ (if (and (eq cmd *eof-cmd*) (typep input-stream 'string-stream))
+ (throw 'repl-catcher cmd)
+ cmd)))
(defun dispatch-command-line (input-stream)
"Processes an input line that starts with *command-char*"
(values)))
(defun inspect-cmd (arg)
- (inspector-fun arg nil *output*)
+ (inspector-fun (eval arg) nil *output*)
(values))
(defun istep-cmd (&optional arg-string)
(defun pushd-cmd (string-arg)
(push string-arg *dir-stack*)
- (cd-cmd *output* string-arg)
+ (cd-cmd string-arg)
(values))
(defun popd-cmd ()
(values))
(defun reset-cmd ()
- ;; The last restart goes to the toplevel
- (invoke-restart-interactively (car (last (compute-restarts)))))
+ (invoke-restart-interactively (find-restart 'sb-impl::toplevel)))
(defun dirs-cmd ()
(dolist (dir *dir-stack*)
(frame-number (when (and (plusp *break-level*)
sb-debug::*current-frame*)
(sb-di::frame-number sb-debug::*current-frame*))))
- #+sb-thread
- (let ((lock sb-thread::*session-lock*))
- (sb-thread::get-foreground)
- (let ((stopped-threads (sb-thread::waitqueue-data lock)))
- (when stopped-threads
- (format stream "~{~&Thread ~A suspended~}~%" stopped-threads))))
+ (sb-thread::get-foreground)
(fresh-line stream)
(if (functionp *prompt*)
(write-string (funcall *prompt*
(setf sb-int:*repl-prompt-fun* #'repl-prompt-fun
sb-int:*repl-read-form-fun* #'repl-read-form-fun)
-) ;; close special variables bindings
-
+(defmacro with-new-repl-state ((&rest vars) &body forms)
+ (let ((gvars (mapcar (lambda (var) (gensym (symbol-name var))) vars)))
+ `(let (,@(mapcar (lambda (var gvar) `(,gvar ,var)) vars gvars))
+ (lambda (noprint)
+ (let ((*noprint* noprint))
+ (let (,@(mapcar (lambda (var gvar) `(,var ,gvar)) vars gvars))
+ (unwind-protect
+ (progn ,@forms)
+ ,@(mapcar (lambda (var gvar) `(setf ,gvar ,var))
+ vars gvars))))))))
+
+(defun make-repl-fun ()
+ (with-new-repl-state (*break-level* *inspect-break* *continuable-break*
+ *dir-stack* *command-char* *prompt*
+ *use-short-package-name* *max-history* *exit-on-eof*
+ *history* *cmd-number*)
+ (repl :noprint noprint :break-level 0)))
+
+(when (boundp 'sb-impl::*repl-fun-generator*)
+ (setq sb-impl::*repl-fun-generator* #'make-repl-fun))