X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-aclrepl%2Frepl.lisp;h=defbc329a1df98c092bd2f9179fbf2c4313c4bc0;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=b77d107de419118a6c572dcd4c15caa333ebb870;hpb=8e11355be91fd1fcadfa575f992a7ee73e4a027a;p=sbcl.git

diff --git a/contrib/sb-aclrepl/repl.lisp b/contrib/sb-aclrepl/repl.lisp
index b77d107..defbc32 100644
--- a/contrib/sb-aclrepl/repl.lisp
+++ b/contrib/sb-aclrepl/repl.lisp
@@ -52,11 +52,6 @@
 
 (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))
@@ -64,18 +59,6 @@
 (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
@@ -86,21 +69,24 @@
 
 (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*"
@@ -425,7 +411,7 @@
     (values)))
 
 (defun inspect-cmd (arg)
-  (inspector-fun arg nil *output*)
+  (inspector-fun (eval arg) nil *output*)
   (values))
 
 (defun istep-cmd (&optional arg-string)
@@ -488,7 +474,7 @@
 
 (defun pushd-cmd (string-arg)
   (push string-arg *dir-stack*)
-  (cd-cmd *output* string-arg)
+  (cd-cmd string-arg)
   (values))
 
 (defun popd-cmd ()
@@ -636,8 +622,7 @@
   (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*)
@@ -792,12 +777,8 @@
 	(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*
 			       break-level
@@ -862,5 +843,23 @@
 (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))