[Sbcl-commits] CVS: sbcl/contrib/sb-aclrepl toplevel.lisp,NONE,1.1 README,1.1,1.2 debug.lisp,1.1,1.2 inspect.lisp,1.13,1.14 repl.lisp,1.10,1.11 sb-aclrepl.asd,1.7,1.8

[Kevin R. <kev...@us...>]

Update of /cvsroot/sbcl/sbcl/contrib/sb-aclrepl
In directory sc8-pr-cvs1:/tmp/cvs-serv19153/contrib/sb-aclrepl

Modified Files:
	README debug.lisp inspect.lisp repl.lisp sb-aclrepl.asd 
Added Files:
	toplevel.lisp 
Log Message:
0.pre8.100:
    * sb-aclrepl changes
       - Update README with examples and contact information
       - Strip out break-stack concept from repl.lisp
       - Fix bug in trimming *history* when *max-history* is reached
       - Add display of single-float, double-float, bignum hexidecimal contents
       - Fix reporting of object addresses (mask lowtag bits)
       - Add ":i slot <id>" command
       - Some non-active experimental code is in toplevel.lisp and debug.lisp,
         but this is #+ignore'd while in development.


--- NEW FILE: toplevel.lisp ---
;;;; Toplevel for sb-aclrepl

(cl:defpackage :sb-aclrepl
  (:use :cl :sb-ext))

(cl:in-package :sb-aclrepl)

(defvar *break-level* 0 "Current break level")
(defvar *inspect-reason* nil
  "Boolean if break level was started for inspecting.")
(defvar *continuable-reason* nil
  "Boolean if break level was started by continuable error.")
(defvar *noprint* nil "Boolean is output should be displayed")
(defvar *input* nil "Input stream")
(defvar *output* nil "Output stream")

(defun aclrepl (&key
		(break-level (1+ *break-level*))
		;; Break level is started to inspect an object
		inspect
		;; Signals a continuable error
		continuable)
  (let ((*break-level* break-level)
	(*inspect-reason* inspect)
	(*continuable-reason* continuable))
    (loop
     ;; (See comment preceding the definition of SCRUB-CONTROL-STACK.)
     (sb-impl::scrub-control-stack)
     (unless *noprint*
       (funcall (the function sb-int:*repl-prompt-fun*) *output*)
       (force-output *output*))
     (let* ((form (funcall (the function sb-int:*repl-read-form-fun*)
			   *input* *output*))
	    (results (multiple-value-list (interactive-eval form))))
       (unless *noprint*
	 (dolist (result results)
	   (fresh-line *output*)
	   (prin1 result *output*)))))))


;;; read-eval-print loop for the default system toplevel
(defun toplevel-aclrepl-fun (noprint)
  (let ((* nil) (** nil) (*** nil)
	(- nil)
	(+ nil) (++ nil) (+++ nil)
	(/// nil) (// nil) (/ nil))
    ;; WITH-SIMPLE-RESTART doesn't actually restart its body as some
    ;; (like WHN for an embarrassingly long time ca. 2001-12-07) might
    ;; think, but instead drops control back out at the end. So when a
    ;; TOPLEVEL or outermost-ABORT restart happens, we need this outer
    ;; LOOP wrapper to grab control and start over again. (And it also
    ;; wraps CATCH 'TOPLEVEL-CATCHER for similar reasons.)
    (loop
     ;; There should only be one TOPLEVEL restart, and it's here, so
     ;; restarting at TOPLEVEL always bounces you all the way out here.
     (with-simple-restart (toplevel
			   "Restart at toplevel READ/EVAL/PRINT loop.")
       ;; We add a new ABORT restart for every debugger level, so 
       ;; restarting at ABORT in a nested debugger gets you out to the
       ;; innermost enclosing debugger, and only when you're in the
       ;; outermost, unnested debugger level does restarting at ABORT 
       ;; get you out to here.
       (with-simple-restart
	   (abort
	    "~@<Reduce debugger level (leaving debugger, returning to toplevel).~@:>")
	 (catch 'toplevel-catcher
	   #-sunos (sb-unix:unix-sigsetmask 0)	; FIXME: What is this for?
	   ;; in the event of a control-stack-exhausted-error, we should
	   ;; have unwound enough stack by the time we get here that this
	   ;; is now possible
	   (sb-kernel::protect-control-stack-guard-page 1)
	   (let ((*noprint* noprint)
		 (*input* *standard-input*)
		 (*output* *standard-output*))
	     (aclrepl :break-level 0))
	   (sb-impl::critically-unreachable "after REPL")))))))

#+ignore
(when (boundp 'sb-impl::*toplevel-repl-fun*)
  (setq sb-impl::*toplevel-repl-fun* #'toplevel-aclrepl-fun))

Index: README
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/README,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- README	5 Apr 2003 20:51:43 -0000	1.1
+++ README	25 Apr 2003 02:54:07 -0000	1.2
@@ -1,6 +1,37 @@
+INTRODUCTION
+============
+
 The sb-aclrepl module offers an AllegroCL style Read-Eval-Print Loop for
 SBCL. An AllegroCL style inspector is integrated. Adding an AllegroCL style
 debugger is planned.
 
+USAGE
+=====
+To start sb-aclrepl as your read-eval-print loop, execute the command
+  (require 'sb-aclrepl)
+
+You can also all this command to your ~/.sbclrc to have sb-aclrepl be the default REPL
+for your SBCL sessions.
+
+EXAMPLE ~/.sbclrc FILE
+======================
+
+(ignore-errors (require 'sb-aclrepl))
+
+(when (find-package 'sb-aclrepl)
+  (push :aclrepl *features*))
+
+#+aclrepl
+(progn
+  (setq sb-aclrepl:*max-history* 100)
+  (setf (sb-aclrepl:alias "asdc") #'(lambda (sys) (asdf:oos 'asdf:load-op sys)))
+  (sb-aclrepl:alias "l" (sys) (asdf:oos 'asdf:load-op sys))
+  (sb-aclrepl:alias "t" (sys) (asdf:oos 'asdf:test-op sys))
+  ;; The 1 below means that two characaters ("up") are required
+  (sb-aclrepl:alias ("up" 1 "Use package") (package) (use-package package))
+  ;; The 0 below means only the first letter ("r") is required, such as ":r base64"
+  (sb-aclrepl:alias ("require" 0 "Require module") (sys) (require sys))
+)
+
 Questions, comments, or bug reports should be sent to Kevin Rosenberg
-<ke...@ro...>.
+<ke...@ro...>.

Index: debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/debug.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- debug.lisp	20 Apr 2003 00:07:51 -0000	1.1
+++ debug.lisp	25 Apr 2003 02:54:07 -0000	1.2
@@ -8,20 +8,106 @@
 
 (defun debugger (condition)
   "Enter the debugger."
-  (print "Entering debugger")
   (let ((old-hook *debugger-hook*))
     (when old-hook
       (let ((*debugger-hook* nil))
 	(funcall old-hook condition old-hook))))
+  (%debugger condition))
 
-  (format t "~&Error: ~A~%" condition)
-  (format t "~&  [Condition type: ~A]~%" (type-of condition))
-  (format t "~%")
-  (format t "~&Restart actions (select using :continue)~%")
+#+ignore
+(when (boundp 'sb-debug::*invoke-debugger-fun*)
+  (setq sb-debug::*invoke-debugger-fun* #'debugger))
+
+(defun print-condition (condition)
+  (format *output* "~&Error: ~A~%" condition))
+
+(defun print-condition-type (condition)
+  (format *output* "~&  [Condition type: ~A]~%" (type-of condition)))
+
+(defun print-restarts ()
+  (format *output* "~&Restart actions (select using :continue)~%")
   (let ((restarts (compute-restarts)))
     (dotimes (i (length restarts))
-      (format t "~&~2D: ~A~%" i (nth i restarts)))
-    (new-break :restarts (cons condition restarts)))
-  (sb-impl::toplevel-repl nil))
+      (format *output* "~&~2D: ~A~%" i (nth i restarts)))))
 
-;(setq sb-debug::*invoke-debugger-fun* #'debugger)
+(defun %debugger (condition)
+  (print-condition condition)
+  (print-condition-type condition)
+  (princ #\newline *output*)
+  (print-restarts) 
+  (debug-loop))
+
+(defun continuable-break-p ()
+  (when (eq 'continue
+	    (restart-name (car (compute-restarts))))
+    t))
+
+
+(declaim (special
+	  sb-debug::*debug-command-level sb-debug::*debug-command-level*
+	  sb-debug::*real-stack-top* sb-debug::*stack-top*
+	  sb-debug::*stack-top-hint* sb-debug::*current-frame*
+	  sb-debug::*flush-debug-errors*))
+
+(defun debug-loop ()
+  (let* ((sb-debug::*debug-command-level* (1+ sb-debug::*debug-command-level*))
+	 (sb-debug::*real-stack-top* (sb-di:top-frame))
+	 (sb-debug::*stack-top* (or sb-debug::*stack-top-hint*
+				    sb-debug::*real-stack-top*))
+	 (sb-debug::*stack-top-hint* nil)
+	 (sb-debug::*current-frame* sb-debug::*stack-top*))
+    (handler-bind ((sb-di:debug-condition
+		    (lambda (condition)
+		      (princ condition sb-debug::*debug-io*)
+		      (sb-int:/show0 "handling d-c by THROWing DEBUG-LOOP-CATCHER")
+		      (throw 'debug-loop-catcher nil))))
+      (fresh-line)
+      (sb-debug::print-frame-call sb-debug::*current-frame* :verbosity 2)
+      (loop
+	(catch 'debug-loop-catcher
+	  (handler-bind ((error (lambda (condition)
+				  (when sb-debug::*flush-debug-errors*
+				    (clear-input *debug-io*)
+				    (princ condition)
+				    ;; FIXME: Doing input on *DEBUG-IO*
+				    ;; and output on T seems broken.
+				    (format t
+					    "~&error flushed (because ~
+					     ~S is set)"
+					    'sb-debug::*flush-debug-errors*)
+				    (sb-int:/show0 "throwing DEBUG-LOOP-CATCHER")
+				    (throw 'debug-loop-catcher nil)))))
+	    ;; We have to bind LEVEL for the restart function created by
+	    ;; WITH-SIMPLE-RESTART.
+	    (let ((level sb-debug::*debug-command-level*)
+		  (restart-commands (sb-debug::make-restart-commands)))
+	      (with-simple-restart (abort
+				   "~@<Reduce debugger level (to debug level ~W).~@:>"
+				    level)
+		(sb-debug::debug-prompt *debug-io*)
+		(force-output *debug-io*)
+		(let* ((exp (read *debug-io*))
+		       (cmd-fun (sb-debug::debug-command-p exp restart-commands)))
+		  (cond ((not cmd-fun)
+			 (sb-debug::debug-eval-print exp))
+			((consp cmd-fun)
+			 (format t "~&Your command, ~S, is ambiguous:~%"
+				 exp)
+			 (dolist (ele cmd-fun)
+			   (format t "   ~A~%" ele)))
+			(t
+			 (funcall cmd-fun))))))))))))
+
+#+ignore
+(defun debug-loop ()
+  (let ((continuable (continuable-break-p)))
+    (if continuable
+      (aclrepl :continuable t)
+      (with-simple-restart (abort
+			    "~@<Reduce debugger level (to debug level ~W).~@:>"
+			    *break-level*)
+	(aclrepl)))))
+
+#+ignore
+(when (boundp 'sb-debug::*debug-loop-fun*)
+  (setq sb-debug::*debug-loop-fun* #'debug-loop))

Index: inspect.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/inspect.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- inspect.lisp	21 Apr 2003 23:02:49 -0000	1.13
+++ inspect.lisp	25 Apr 2003 02:54:07 -0000	1.14
@@ -10,7 +10,7 @@
 (cl:in-package #:sb-aclrepl)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant +default-inspect-length+ 10))
+  (defconstant +default-inspect-length+ 20))
 
 (defstruct inspect
   ;; stack of parents of inspected object
@@ -25,8 +25,6 @@
   "Raw mode for object display.")
 (defparameter *inspect-length* +default-inspect-length+
   "maximum number of components to print") 
-(defparameter *inspect-skip* 0
-  "number of initial components to skip when displaying an object") 
 (defparameter *skip-address-display* nil
   "Skip displaying addresses of objects.")
 
@@ -39,6 +37,7 @@
 :i ?           display this help
 :i *           inspect the current * value
 :i + <form>    inspect the (eval form)
+:i slot <name> inspect component of object, even if name is an istep cmd
 :i <index>     inspect the numbered component of object
 :i <name>      inspect the named component of object
 :i <form>      evaluation and inspect form
@@ -47,7 +46,6 @@
 :i <           inspect previous parent component
 :i >           inspect next parent component
 :i set <index> <form> set indexed component to evalated form
-i set <name> <form>  set named component to evalated form
 :i print <max> set the maximum number of components to print
 :i skip <n>    skip a number of components when printing
 :i tree        print inspect stack
@@ -59,278 +57,267 @@
   (defvar *inspect-unbound-object-marker* (gensym "INSPECT-UNBOUND-OBJECT-")))
 
 
-;; Setup binding for multithreading
-(let ((*current-inspect* nil)
-      (*inspect-raw* nil)
-      (*inspect-length* +default-inspect-length+)
-      (*inspect-skip* 0)
-      (*skip-address-display* nil))
-  
-  (defun inspector (object input-stream output-stream)
-    (declare (ignore input-stream))
+(defun inspector (object input-stream output-stream)
+  (declare (ignore input-stream))
+  (let ((*current-inspect* nil)
+	(*inspect-raw* nil)
+	(*inspect-length* *inspect-length*)
+	(*skip-address-display* nil))
     (setq object (eval object))
     (setq *current-inspect* (make-inspect))
-    (new-break :inspect *current-inspect*)
-    (reset-stack)
-    (setf (inspect-object-stack *current-inspect*) (list object))
-    (setf (inspect-select-stack *current-inspect*)
-	  (list (format nil "(inspect ...)")))
-    (redisplay output-stream))
+    (reset-stack object "(inspect ...)")
+    (redisplay output-stream)
+    (catch 'inspect-quit
+      (aclrepl :inspect t))
+    (values)))
 
-  (setq sb-impl::*inspect-fun* #'inspector)
-  
-  (defun istep (args stream)
-    (unless *current-inspect*
-      (setq *current-inspect* (make-inspect)))
-    (istep-dispatch args
-		     (first args)
-		     (when (first args) (read-from-string (first args)))
-		     stream))
+(setq sb-impl::*inspect-fun* #'inspector)
 
-  (defun istep-dispatch (args option-string option stream)
-    (cond
-      ((or (string= "=" option-string) (zerop (length args)))
-       (istep-cmd-redisplay stream))
-      ((or (string= "-" option-string) (string= "^" option-string))
-       (istep-cmd-parent stream))
-      ((string= "*" option-string)
-       (istep-cmd-inspect-* stream))
-      ((string= "+" option-string)
-       (istep-cmd-inspect-new-form (read-from-string (second args)) stream))
-      ((or (string= "<" option-string)
-	   (string= ">" option-string))
-       (istep-cmd-select-parent-component option-string stream))
-      ((string-equal "set" option-string)
-       (istep-cmd-set (second args) (third args) stream))
-      ((string-equal "raw" option-string)
-       (istep-cmd-set-raw (second args) stream))
-      ((string-equal "q" option-string)
-       (istep-cmd-reset))
-      ((string-equal "?" option-string)
-       (istep-cmd-help stream))
-      ((string-equal "skip" option-string)
-       (istep-cmd-skip (second args) stream))
-      ((string-equal "tree" option-string)
-       (istep-cmd-tree stream)) 
-      ((string-equal "print" option-string)
-       (istep-cmd-print (second args) stream))
-      ((or (symbolp option)
-	   (integerp option))
-       (istep-cmd-select-component option stream))
-      (t
-       (istep-cmd-set-stack option stream))))
+(defun istep (args stream)
+  (unless *current-inspect*
+    (setq *current-inspect* (make-inspect)))
+  (istep-dispatch args
+		  (first args)
+		  (when (first args) (read-from-string (first args)))
+		  stream))
 
-  (defun set-current-inspect (inspect)
-    (setq *current-inspect* inspect))
+(defun istep-dispatch (args option-string option stream)
+  (cond
+    ((or (string= "=" option-string) (zerop (length args)))
+     (istep-cmd-redisplay stream))
+    ((or (string= "-" option-string) (string= "^" option-string))
+     (istep-cmd-parent stream))
+    ((string= "*" option-string)
+     (istep-cmd-inspect-* stream))
+    ((string= "+" option-string)
+     (istep-cmd-inspect-new-form (read-from-string (second args)) stream))
+    ((or (string= "<" option-string)
+	 (string= ">" option-string))
+     (istep-cmd-select-parent-component option-string stream))
+    ((string-equal "set" option-string)
+     (istep-cmd-set (second args) (third args) stream))
+    ((string-equal "raw" option-string)
+     (istep-cmd-set-raw (second args) stream))
+    ((string-equal "q" option-string)
+     (istep-cmd-reset))
+    ((string-equal "?" option-string)
+     (istep-cmd-help stream))
+    ((string-equal "skip" option-string)
+     (istep-cmd-skip (second args) stream))
+    ((string-equal "tree" option-string)
+     (istep-cmd-tree stream)) 
+    ((string-equal "print" option-string)
+     (istep-cmd-print (second args) stream))
+    ((string-equal "slot" option-string)
+     (istep-cmd-select-component (read-from-string (second args)) stream))
+    ((or (symbolp option)
+	 (integerp option))
+     (istep-cmd-select-component option stream))
+    (t
+     (istep-cmd-set-stack option stream))))
 
-  (defun reset-stack ()
-    (setf (inspect-object-stack *current-inspect*) nil)
-    (setf (inspect-select-stack *current-inspect*) nil))
+(defun set-current-inspect (inspect)
+  (setq *current-inspect* inspect))
 
-  (defun output-inspect-note (stream note &rest args)
-    (apply #'format stream note args)
-    (princ #\Newline stream))
+(defun reset-stack (&optional object label)
+  (cond
+    ((null label)
+     (setf (inspect-object-stack *current-inspect*) nil)
+     (setf (inspect-select-stack *current-inspect*) nil))
+    (t
+     (setf (inspect-object-stack *current-inspect*) (list object))
+     (setf (inspect-select-stack *current-inspect*) (list label)))))
 
-  (defun stack ()
-     (inspect-object-stack *current-inspect*))
+(defun output-inspect-note (stream note &rest args)
+  (apply #'format stream note args)
+  (princ #\Newline stream))
 
-  (defun redisplay (stream)
-    (display-current stream))
+(defun stack ()
+  (inspect-object-stack *current-inspect*))
 
-  ;;;
-  ;;; istep command processing
-  ;;;
-  
-  (defun istep-cmd-redisplay (stream)
-    (redisplay stream))
+(defun redisplay (stream &optional (skip 0))
+  (display-current stream *inspect-length* skip))
 
-  (defun istep-cmd-parent (stream)
-    (cond
-      ((> (length (inspect-object-stack *current-inspect*)) 1)
-       (setf (inspect-object-stack *current-inspect*)
-	     (cdr (inspect-object-stack *current-inspect*)))
-       (setf (inspect-select-stack *current-inspect*)
-	     (cdr (inspect-select-stack *current-inspect*)))
-       (redisplay stream))
-      ((stack)
+;;;
+;;; istep command processing
+;;;
+
+(defun istep-cmd-redisplay (stream)
+  (redisplay stream))
+
+(defun istep-cmd-parent (stream)
+  (cond
+    ((> (length (inspect-object-stack *current-inspect*)) 1)
+     (setf (inspect-object-stack *current-inspect*)
+	   (cdr (inspect-object-stack *current-inspect*)))
+     (setf (inspect-select-stack *current-inspect*)
+	   (cdr (inspect-select-stack *current-inspect*)))
+     (redisplay stream))
+    ((stack)
        (output-inspect-note stream "Object has no parent"))
-      (t
-       (no-object-msg stream))))
-  
-  (defun istep-cmd-inspect-* (stream)
-    (reset-stack) 
-    (setf (inspect-object-stack *current-inspect*) (list *))
-    (setf (inspect-select-stack *current-inspect*) (list "(inspect *)"))
-    (set-break-inspect *current-inspect*)
-    (redisplay stream))
+    (t
+     (no-object-msg stream))))
 
-  (defun istep-cmd-inspect-new-form (form stream)
-    (inspector (eval form) nil stream))
+(defun istep-cmd-inspect-* (stream)
+  (reset-stack * "(inspect *")
+  (redisplay stream))
 
-  (defun istep-cmd-select-parent-component (option stream)
-    (if (stack)
-	(if (eql (length (stack)) 1)
-	    (output-inspect-note stream "Object does not have a parent")
-	    (let ((parent (second (stack)))
-		  (id (car (inspect-select-stack *current-inspect*))))
-	      (multiple-value-bind (position parts)
-		  (find-part-id parent id)
-		(let ((new-position (if (string= ">" option)
-					(1+ position)
-					(1- position))))
-		  (if (< -1 new-position (parts-count parts))
-		      (let* ((value (component-at parts new-position)))
-			(setf (car (inspect-object-stack *current-inspect*))
-			      value)
-			(setf (car (inspect-select-stack *current-inspect*))
-			      (id-at parts new-position))
-			(redisplay stream))
-		      (output-inspect-note stream
-					   "Parent has no selectable component indexed by ~d"
-					   new-position))))))
-	(no-object-msg stream)))
+(defun istep-cmd-inspect-new-form (form stream)
+  (inspector (eval form) nil stream))
 
-  (defun istep-cmd-set-raw (option-string stream)
-    (when (inspect-object-stack *current-inspect*)
-      (cond
-	((null option-string)
-	 (setq *inspect-raw* t))
-	((eq (read-from-string option-string) t)
-	 (setq *inspect-raw* t))
-	((eq (read-from-string option-string) nil)
-	 (setq *inspect-raw* nil)))
-      (redisplay stream)))
+(defun istep-cmd-select-parent-component (option stream)
+  (if (stack)
+      (if (eql (length (stack)) 1)
+	  (output-inspect-note stream "Object does not have a parent")
+	  (let ((parent (second (stack)))
+		(id (car (inspect-select-stack *current-inspect*))))
+	    (multiple-value-bind (position parts)
+		(find-part-id parent id)
+	      (let ((new-position (if (string= ">" option)
+				      (1+ position)
+				      (1- position))))
+		(if (< -1 new-position (parts-count parts))
+		    (let* ((value (component-at parts new-position)))
+		      (setf (car (inspect-object-stack *current-inspect*))
+			    value)
+		      (setf (car (inspect-select-stack *current-inspect*))
+			    (id-at parts new-position))
+		      (redisplay stream))
+		    (output-inspect-note stream
+					 "Parent has no selectable component indexed by ~d"
+					 new-position))))))
+      (no-object-msg stream)))
 
-  (defun istep-cmd-reset ()
-    (reset-stack)
-    (set-break-inspect *current-inspect*))
+(defun istep-cmd-set-raw (option-string stream)
+  (when (inspect-object-stack *current-inspect*)
+    (cond
+      ((null option-string)
+       (setq *inspect-raw* t))
+      ((eq (read-from-string option-string) t)
+       (setq *inspect-raw* t))
+      ((eq (read-from-string option-string) nil)
+       (setq *inspect-raw* nil)))
+    (redisplay stream)))
 
-  (defun istep-cmd-help (stream)
-    (format stream *inspect-help*))
+(defun istep-cmd-reset ()
+  (reset-stack)
+  (throw 'inspect-quit nil))
 
-  (defun istep-cmd-skip (option-string stream)
-    (if option-string
-	(let ((len (read-from-string option-string)))
-	  (if (and (integerp len) (>= len 0))
-	      (let ((*inspect-skip* len)) 
-		(redisplay stream))
-	      (output-inspect-note stream "Skip length invalid")))
-	(output-inspect-note stream "Skip length missing")))
+(defun istep-cmd-help (stream)
+  (format stream *inspect-help*))
 
-  (defun istep-cmd-print (option-string stream)
-    (if option-string
-	(let ((len (read-from-string option-string)))
-	  (if (and (integerp len) (plusp len))
-	      (setq *inspect-length* len)
-	      (output-inspect-note stream "Cannot set print limit to ~A~%" len)))
-	(output-inspect-note stream "Print length missing")))
+(defun istep-cmd-skip (option-string stream)
+  (if option-string
+      (let ((len (read-from-string option-string)))
+	(if (and (integerp len) (>= len 0))
+	    (redisplay stream len)
+	    (output-inspect-note stream "Skip length invalid")))
+      (output-inspect-note stream "Skip length missing")))
 
-  (defun select-description (select)
-    (typecase select
-      (integer
-       (format nil "which is componenent number ~d of" select))
-      (symbol
-       (format nil "which is the ~a component of" select))
-      (string
-       (format nil "which was selected by ~A" select))
-      (t
-       (write-to-string select))))
-  
-  (defun istep-cmd-tree (stream)
-    (let ((stack (inspect-object-stack *current-inspect*)))
-      (if stack
-	  (progn
-	    (output-inspect-note stream "The current object is:")
-	    (dotimes (i (length stack))
-	      (output-inspect-note
+(defun istep-cmd-print (option-string stream)
+  (if option-string
+      (let ((len (read-from-string option-string)))
+	(if (and (integerp len) (plusp len))
+	    (setq *inspect-length* len)
+	    (output-inspect-note stream "Cannot set print limit to ~A~%" len)))
+      (output-inspect-note stream "Print length missing")))
+
+(defun select-description (select)
+  (typecase select
+    (integer
+     (format nil "which is componenent number ~d of" select))
+    (symbol
+     (format nil "which is the ~a component of" select))
+    (string
+     (format nil "which was selected by ~A" select))
+    (t
+     (write-to-string select))))
+
+(defun istep-cmd-tree (stream)
+  (let ((stack (inspect-object-stack *current-inspect*)))
+    (if stack
+	(progn
+	  (output-inspect-note stream "The current object is:")
+	  (dotimes (i (length stack))
+	    (output-inspect-note
 	       stream "~A, ~A"
 	       (inspected-description (nth i stack))
 	       (select-description
 		(nth i (inspect-select-stack *current-inspect*))))))
-	  (no-object-msg stream))))
-
-  (defun istep-cmd-set (id-string value-string stream)
-    (if (stack)
-	(let ((id (when id-string (read-from-string id-string))))
-	  (multiple-value-bind (position parts)
-	      (find-part-id (car (stack)) id)
-	    (if parts
-		(if position
-		    (when value-string
-		      (let ((new-value (eval (read-from-string value-string))))
-			(let ((result (set-component-value (car (stack))
-							   id
-							   new-value
-							   (component-at
-							    parts position))))
-			  (typecase result
-			    (string
-			     (output-inspect-note stream result))
-			    (t
-			     (redisplay stream))))))
-		    (output-inspect-note
-		     stream
-		     "Object has no selectable component named by ~A" id))
-		(output-inspect-note stream
-				     "Object has no selectable components"))))
-	(no-object-msg stream)))
+	(no-object-msg stream))))
 
-  (defun istep-cmd-select-component (id stream)
-    (if (stack)
+(defun istep-cmd-set (id-string value-string stream)
+  (if (stack)
+      (let ((id (when id-string (read-from-string id-string))))
 	(multiple-value-bind (position parts)
 	    (find-part-id (car (stack)) id)
-	  (cond
-	    ((integerp position)
-	     (let* ((value (component-at parts position)))
-	       (cond ((eq value *inspect-unbound-object-marker*)
-		      (output-inspect-note stream "That slot is unbound"))
-		     (t
-		      (push value (inspect-object-stack *current-inspect*))
-		      (push id (inspect-select-stack *current-inspect*))
-		      (redisplay stream)))))
-	    ((null parts)
-	     (output-inspect-note stream "Object does not contain any subobjects"))
-	    (t
-	     (typecase id
-	       (symbol
-		(output-inspect-note
-		 stream "Object has no selectable component named ~A"
-		 id))
-	       (integer
-		(output-inspect-note
-		 stream "Object has no selectable component indexed by ~d"
-		 id)
-		(output-inspect-note
-		 stream "Enter a valid index (~:[0-~W~;0~])"
-		 (= (parts-count parts) 1)
-		 (1- (parts-count parts))))))))
-	(no-object-msg stream)))
+	  (if parts
+	      (if position
+		  (when value-string
+		    (let ((new-value (eval (read-from-string value-string))))
+		      (let ((result (set-component-value (car (stack))
+							 id
+							 new-value
+							 (component-at
+							  parts position))))
+			(typecase result
+			  (string
+			   (output-inspect-note stream result))
+			  (t
+			   (redisplay stream))))))
+		  (output-inspect-note
+		   stream
+		   "Object has no selectable component named by ~A" id))
+	      (output-inspect-note stream
+				   "Object has no selectable components"))))
+      (no-object-msg stream)))
 
-  (defun istep-cmd-set-stack (form stream)
-    (reset-stack)
-    (let ((object (eval form)))
-      (setf (inspect-object-stack *current-inspect*) (list object))
-      (setf (inspect-select-stack *current-inspect*)
-	    (list (format nil ":i ..."))))
-    (set-break-inspect *current-inspect*)
-    (redisplay stream))
+(defun istep-cmd-select-component (id stream)
+  (if (stack)
+      (multiple-value-bind (position parts)
+	  (find-part-id (car (stack)) id)
+	(cond
+	  ((integerp position)
+	   (let* ((value (component-at parts position)))
+	     (cond ((eq value *inspect-unbound-object-marker*)
+		    (output-inspect-note stream "That slot is unbound"))
+		   (t
+		    (push value (inspect-object-stack *current-inspect*))
+		    (push id (inspect-select-stack *current-inspect*))
+		    (redisplay stream)))))
+	  ((null parts)
+	   (output-inspect-note stream "Object does not contain any subobjects"))
+	  (t
+	   (typecase id
+	     (symbol
+	      (output-inspect-note
+	       stream "Object has no selectable component named ~A"
+	       id))
+	     (integer
+	      (output-inspect-note
+	       stream "Object has no selectable component indexed by ~d"
+	       id))))))
+      (no-object-msg stream)))
 
-  ;;;
-  ;;; aclrepl-specific inspection display
-  ;;;
+(defun istep-cmd-set-stack (form stream)
+  (reset-stack (eval form) ":i ...")
+  (redisplay stream))
 
-  (defun no-object-msg (s)
-    (output-inspect-note s "No object is being inspected"))
-  
-  (defun display-current (s)
-    (if (stack)
-	(let ((inspected (car (stack))))
-	  (setq cl:* inspected)
-	  (display-inspect inspected s *inspect-length* *inspect-skip*))
-	(no-object-msg)))
-  
-  ) ;; end binding for multithreading
 
+(defun no-object-msg (s)
+  (output-inspect-note s "No object is being inspected"))
+
+(defun display-current (s length skip)
+  (if (stack)
+      (let ((inspected (car (stack))))
+	(setq cl:* inspected)
+	(display-inspect inspected s length skip))
+      (no-object-msg s)))
+
+
+;;;
+;;; aclrepl-specific inspection display
+;;;
 
 (defun display-inspect (object stream &optional length (skip 0))
   (multiple-value-bind (elements labels count)
@@ -338,17 +325,26 @@
     (fresh-line stream)
     (format stream "~A" (inspected-description object))
     (unless (or *skip-address-display*
+		(eq object *inspect-unbound-object-marker*)
 		(characterp object) (typep object 'fixnum))
-      (format stream " at #x~X" (sb-kernel:get-lisp-obj-address object)))
+      (format stream " at #x~X" (logand
+				 (sb-kernel:get-lisp-obj-address object)
+				 (lognot sb-vm:lowtag-mask)))) 
     (dotimes (i count)
       (fresh-line stream)
       (display-labeled-element (elt elements i) (elt labels i) stream))))
   
+(defun hex32-label-p (label)
+  (and (consp label) (eq (cdr label) :hex32)))
+
 (defun array-label-p (label)
-  (and (stringp (cdr label)) (char= (char (cdr label) 0) #\[)))
+  (and (consp label)
+       (stringp (cdr label))
+       (char= (char (cdr label) 0) #\[)))
 
 (defun named-or-array-label-p (label)
-  (consp label))
+  (and (consp label)
+       (not (hex32-label-p label))))
 
 (defun display-labeled-element (element label stream)
   (cond
@@ -364,6 +360,8 @@
 	     (car label)
 	     (format nil "~A " (cdr label))
 	     (inspected-description element)))
+    ((hex32-label-p label)
+     (format stream "~4,' D-> #x~8,'0X" (car label) element))
     (t
      (format stream "~4,' D-> ~A" label (inspected-description element)))))
 
@@ -398,15 +396,19 @@
   (let* ((parts (inspected-parts object))
 	 (name (if (symbolp id) (symbol-name id) id)))
     (values
-     (if (numberp id)
-	 (when (< -1 id (parts-count parts)) id)
-	 (case (parts-seq-type parts)
-	   (:named
-	    (position name (the list (parts-components parts))
-		      :key #'car :test #'string-equal))
-	   ((:dotted-list :cyclic-list)
-	    (when (string-equal name "tail")
-	      (1- (parts-count parts))))))
+     (cond
+       ((and (numberp id)
+	     (< -1 id (parts-count parts))
+	     (not (eq (parts-seq-type parts) :bignum)))
+	id)
+       (t
+	(case (parts-seq-type parts)
+	  (:named
+	   (position name (the list (parts-components parts))
+		     :key #'car :test #'string-equal))
+	  ((:dotted-list :cyclic-list)
+	   (when (string-equal name "tail")
+	     (1- (parts-count parts)))))))
      parts)))
 
 (defun component-at (parts position)
@@ -426,6 +428,8 @@
 	 (cdr (elt components position)))
 	(:array
 	 (aref (the array components) position))
+	(:bignum
+	 (bignum-component-at components position))
 	(t
 	 (elt components position))))))
 
@@ -513,9 +517,13 @@
   "Helper function for inspected-elements. Conses the
 position with the label if the label is a string."
   (let ((id (id-at parts position)))
-    (if (stringp id)
-	(cons position id)
-	id)))
+    (cond
+      ((stringp id)
+       (cons position id))
+      ((eq (parts-seq-type parts) :bignum)
+       (cons position :hex32))
+      (t
+	id))))
 
 (defun array-index-string (index parts)
   "Formats an array index in row major format."
@@ -610,18 +618,39 @@
 	      ((:dotted :cyclic) "+tail")
 	      (t "")))))
 
+
+(defun ref32-hexstr (obj &optional (offset 0))
+  (format nil "~8,'0X" (ref32 obj offset)))
+
+(defun ref32 (obj &optional (offset 0))
+  (sb-sys::without-gcing
+   (sb-sys:sap-ref-32
+    (sb-sys:int-sap
+     (logand (sb-kernel:get-lisp-obj-address obj) (lognot sb-vm:lowtag-mask)))
+    offset)))
+
+(defun description-maybe-internals (fmt objects internal-fmt &rest args)
+  (let ((base (apply #'format nil fmt objects)))
+    (if *skip-address-display*
+	base
+	(concatenate 'string
+		     base " " (apply #'format nil internal-fmt args)))))
+	      
 (defmethod inspected-description ((object double-float))
-  (format nil "double-float ~W" object))
+  (description-maybe-internals "double-float ~W" (list object)
+			       "[#~A ~A]"
+			       (ref32-hexstr object 12)
+			       (ref32-hexstr object 8)))
 
 (defmethod inspected-description ((object single-float))
-  (format nil "single-float ~W" object))
+  (description-maybe-internals "single-float ~W" (list object)
+			       "[#x~A]"
+			       (ref32-hexstr object 4)))
 
 (defmethod inspected-description ((object fixnum))
-  (format nil "fixnum ~W~A" object
-	  (if *skip-address-display*
-	      ""
-	      (format nil " [#x~8,'0X]" object
-		      (sb-kernel:get-lisp-obj-address object)))))
+  (description-maybe-internals "fixnum ~W" (list object)
+			       "[#x~8,'0X]"
+			       (sb-kernel:get-lisp-obj-address object)))
 
 (defmethod inspected-description ((object complex))
   (format nil "complex number ~W" object))
@@ -629,18 +658,29 @@
 (defmethod inspected-description ((object simple-string))
   (format nil "a simple-string (~W) ~W" (length object) object))
 
+(defun bignum-words (bignum)
+  "Return the number of 32-bit words in a bignum"
+  (ash
+   (logand (ref32 bignum)
+	   (lognot sb-vm:widetag-mask))
+   (- sb-vm:n-widetag-bits))) 
+
+(defun bignum-component-at (bignum offset)
+  "Return the 32-bit word at 32-bit wide offset"
+  (ref32 bignum (* 4 (1+ offset))))
+
 (defmethod inspected-description ((object bignum))
-  (format nil "bignum ~W" object))
+  (format nil  "bignum ~W with ~D 32-bit word~:*~P" object
+	  (bignum-words object)))
 
 (defmethod inspected-description ((object ratio))
   (format nil "ratio ~W" object))
 
 (defmethod inspected-description ((object character))
-  (format nil "character ~W char-code~A" object (char-code object)
-	  (if *skip-address-display*
-	      ""
-	      (format nil " [#x~8,'0X]" object
-		      (sb-kernel:get-lisp-obj-address object)))))
+  (description-maybe-internals "character ~W char-code #x~4,'0X"
+			       (list object (char-code object))
+			       "[#x~8,'0X]"
+			       (sb-kernel:get-lisp-obj-address object)))
 
 (defmethod inspected-description ((object t))
   (format nil "a generic object ~W" object))
@@ -670,6 +710,8 @@
 ;;;      If SEQ-TYPE is :vector, then each element is a value of an vector
 ;;;      If SEQ-TYPE is :array, then each element is a value of an array
 ;;;        with rank >= 2. The 
+;;;      If SEQ-TYPE is :bignum, then object is just a bignum and not a
+;;;        a sequence 
 ;;;
 ;;;   COUNT is the total number of components in the OBJECT
 ;;;
@@ -789,6 +831,9 @@
   (let ((components (list (cons "numerator" (numerator object))
 			(cons "denominator" (denominator object)))))
     (list components (length components) :named nil)))
+
+(defmethod inspected-parts ((object bignum))
+    (list object (bignum-words object) :bignum nil))
 
 (defmethod inspected-parts ((object t))
   (list nil 0 nil nil))

Index: repl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/repl.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- repl.lisp	21 Apr 2003 23:02:49 -0000	1.10
+++ repl.lisp	25 Apr 2003 02:54:07 -0000	1.11
@@ -7,12 +7,6 @@
 ;;;; any given time, for this functionality is on the ACL website:
 ;;;;   <http://www.franz.com/support/documentation/6.2/doc/top-level.htm>.
 
-(cl:defpackage :sb-aclrepl
-  (:use :cl :sb-ext)
-  (:export #:*prompt* #:*exit-on-eof* #:*max-history*
-	   #:*use-short-package-name* #:*command-char*
-	   #:alias))
-
 (cl:in-package :sb-aclrepl)
 
 (defstruct user-cmd
@@ -22,17 +16,6 @@
   (args nil)  ; args for cmd func
   (hnum nil)) ; history number
 
-(defstruct break-data
-  ;; numeric break level
-  level
-  ;; inspect data for a break level
-  inspect
-  ;; T when break initiated by an inspect
-  inspect-initiated
-  ;; restarts list for a break level
-  restarts 
-  ;; T if break level is a continuable break
-  continuable) 
 
 ;;; cmd table entry
 (defstruct cmd-table-entry
@@ -54,7 +37,7 @@
   "The top-level directory stack")
 (defparameter *command-char* #\:
   "Prefix character for a top-level command")
-(defvar *max-history* 24
+(defvar *max-history* 100
   "Maximum number of history commands to remember")
 (defvar *exit-on-eof* t
   "If T, then exit when the EOF character is entered.")
@@ -62,15 +45,14 @@
   "History list")
 (defparameter *cmd-number* 1
   "Number of the next command")
-(defparameter *repl-output* nil
-  "The output stream for the repl")
-(defparameter *repl-input* nil
-  "The input stream for the repl")
-(defparameter *break-stack*  (list (make-break-data :level 0))
-  "A stack of break data stored as a list of break-level structs")
 
 (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))
@@ -84,13 +66,10 @@
       (*use-short-package-name* t)
       (*dir-stack* nil)
       (*command-char* #\:)
-      (*max-history* 24)
+      (*max-history* 100)
       (*exit-on-eof* t)
       (*history* nil)
       (*cmd-number* 1)
-      (*repl-output* nil)
-      (*repl-input* nil)
-      (*break-stack* (list (make-break-data :level 0)))
       )
       
 (defun prompt-package-name ()
@@ -126,35 +105,41 @@
 		     (string-trim-whitespace (subseq line first-space-pos))
 		     "")))
 	   (declare (string line))
-	   (if (numberp (read-from-string cmd-string))
-	       (let ((cmd (get-history (read-from-string cmd-string))))
-		 (if (eq cmd *null-cmd*)
-		     (make-user-cmd :func :history-error
-				    :input (read-from-string cmd-string))
-		     (make-user-cmd :func (user-cmd-func cmd)
+	   (cond
+	     ((numberp (read-from-string cmd-string))
+	      (let ((cmd (get-history (read-from-string cmd-string))))
+		(if (eq cmd *null-cmd*)
+		    (make-user-cmd :func :history-error
+				   :input (read-from-string cmd-string))
+		    (make-user-cmd :func (user-cmd-func cmd)
 				    :input (user-cmd-input cmd)
 				    :args (user-cmd-args cmd)
-				    :hnum *cmd-number*)))
-	       (let ((cmd-entry (find-cmd cmd-string)))
-		 (if cmd-entry
-		     (make-user-cmd :func (cmd-table-entry-func cmd-entry)
-				    :input line
-				    :args (parse-args
-					   (cmd-table-entry-parsing cmd-entry)
+				    :hnum *cmd-number*))))
+	     ((or (zerop (length cmd-string))
+		  (whitespace-char-p (char cmd-string 0)))
+	      *null-cmd*)
+	     (t
+	      (let ((cmd-entry (find-cmd cmd-string)))
+		(if cmd-entry
+		    (make-user-cmd :func (cmd-table-entry-func cmd-entry)
+				   :input line
+				   :args (parse-args
+					  (cmd-table-entry-parsing cmd-entry)
 					   cmd-args-string)
-				    :hnum *cmd-number*)
-		     (make-user-cmd :func :cmd-error
-				    :input cmd-string)
-		     )))))
+				   :hnum *cmd-number*)
+		    (make-user-cmd :func :cmd-error
+				   :input cmd-string)))))))
 	((eql next-char #\newline)
 	 (read-char input-stream)
 	 *null-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*))))))))
+	((eql next-char :eof)
+	 *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*))))))))
 
 (defun make-cte (name-param func desc parsing group abbr-len)
   (let ((name (etypecase name-param
@@ -195,7 +180,8 @@
 (defun add-to-history (cmd)
   (unless (and *history* (user-cmd= cmd (car *history*)))
     (when (>= (length *history*) *max-history*)
-      (setq *history* (nbutlast *history* (+ (length *history*) *max-history* 1))))
+      (setq *history* (nbutlast *history*
+				(1+ (- (length *history*) *max-history*)))))
     (push cmd *history*)
     (incf *cmd-number*)))
 
@@ -230,23 +216,23 @@
      (let ((new (truename string-dir)))
        (when (pathnamep new)
 	 (setf cl:*default-pathname-defaults* new)))))
-  (format *repl-output* "~A~%" (namestring cl:*default-pathname-defaults*))
+  (format *output* "~A~%" (namestring cl:*default-pathname-defaults*))
   (values))
 
 (defun pwd-cmd ()
-  (format *repl-output* "Lisp's current working directory is ~s.~%"
+  (format *output* "Lisp's current working directory is ~s.~%"
 	  (namestring cl:*default-pathname-defaults*))
   (values))
 
 (defun trace-cmd (&rest args)
   (if args
-      (format *repl-output* "~A~%" (eval (sb-debug::expand-trace args)))
-      (format *repl-output* "~A~%" (sb-debug::%list-traced-funs)))
+      (format *output* "~A~%" (eval (sb-debug::expand-trace args)))
+      (format *output* "~A~%" (sb-debug::%list-traced-funs)))
   (values))
 
 (defun untrace-cmd (&rest args)
   (if args
-      (format *repl-output* "~A~%"
+      (format *output* "~A~%"
 	      (eval
 	       (sb-int:collect ((res))
 		(let ((current args))
@@ -257,7 +243,7 @@
 			      `(sb-debug::untrace-1 ,(pop current))
 			      `(sb-debug::untrace-1 ',name))))))
 		`(progn ,@(res) t))))
-      (format *repl-output* "~A~%" (eval (sb-debug::untrace-all))))
+      (format *output* "~A~%" (eval (sb-debug::untrace-all))))
   (values))
 
 #+sb-thread
@@ -276,11 +262,11 @@
   #+sb-thread
   (let ((other-pids (other-thread-pids)))
     (when other-pids
-      (format *repl-output* "There exists the following processes~%")
-      (format *repl-output* "~{~5d~%~}" other-pids)
-      (format *repl-output* "Do you want to exit lisp anyway [n]? ")
-      (force-output *repl-output*)
-      (let ((input (string-trim-whitespace (read-line *repl-input*))))
+      (format *output* "There exists the following processes~%")
+      (format *output* "~{~5d~%~}" other-pids)
+      (format *output* "Do you want to exit lisp anyway [n]? ")
+      (force-output *output*)
+      (let ((input (string-trim-whitespace (read-line *input*))))
 	(if (and (plusp (length input))
 		 (or (char= #\y (char input 0))
 		     (char= #\Y (char input 0))))
@@ -290,16 +276,16 @@
 	      (map nil #'sb-thread:destroy-thread pids)
 	      (sleep 0.2))
 	    (return-from exit-cmd)))))
-  (quit :unix-status status)
+  (sb-ext:quit :unix-status status)
   (values))
 
 (defun package-cmd (&optional pkg)
   (cond
     ((null pkg)
-     (format *repl-output* "The ~A package is current.~%"
+     (format *output* "The ~A package is current.~%"
 	     (package-name cl:*package*)))
     ((null (find-package (write-to-string pkg)))
-     (format *repl-output* "Unknown package: ~A.~%" pkg))
+     (format *output* "Unknown package: ~A.~%" pkg))
     (t
      (setf cl:*package* (find-package (write-to-string pkg)))))
   (values))
@@ -325,7 +311,7 @@
 				   (string-left-trim "~/" arg))
 				  (user-homedir-pathname))
 		 arg)))
-	(format *repl-output* "loading ~S~%" file)
+	(format *output* "loading ~S~%" file)
 	(load file))))
   (values))
 
@@ -365,16 +351,16 @@
 	(setq last-files-loaded string-files)
 	(setq string-files last-files-loaded))
     (dolist (arg (string-to-list-skip-spaces string-files))
-      (format *repl-output* "loading ~a~%" arg)
+      (format *output* "loading ~a~%" arg)
       (load (compile-file-as-needed arg)))
     (values)))
 
 (defun inspect-cmd (arg)
-  (inspector arg nil *repl-output*)
+  (inspector arg nil *output*)
   (values))
 
 (defun istep-cmd (&optional arg-string)
-  (istep (string-to-list-skip-spaces arg-string) *repl-output*)
+  (istep (string-to-list-skip-spaces arg-string) *output*)
   (values))
 
 (defun describe-cmd (&rest args)
@@ -383,7 +369,7 @@
   (values))
 
 (defun macroexpand-cmd (arg)
-  (pprint (macroexpand arg) *repl-output*)
+  (pprint (macroexpand arg) *output*)
   (values))
 
 (defun history-cmd ()
@@ -392,10 +378,10 @@
     (dotimes (i n)
       (declare (fixnum i))
       (let ((hist (nth (- n i 1) *history*)))
-	(format *repl-output* "~3A " (user-cmd-hnum hist))
+	(format *output* "~3A " (user-cmd-hnum hist))
 	(if (stringp (user-cmd-input hist))
-	    (format *repl-output* "~A~%" (user-cmd-input hist))
-	    (format *repl-output* "~W~%" (user-cmd-input hist))))))
+	    (format *output* "~A~%" (user-cmd-input hist))
+	    (format *output* "~W~%" (user-cmd-input hist))))))
   (values))
 
 (defun help-cmd (&optional cmd)
@@ -403,15 +389,15 @@
     (cmd
      (let ((cmd-entry (find-cmd cmd)))
        (if cmd-entry
-	   (format *repl-output* "Documentation for ~A: ~A~%"
+	   (format *output* "Documentation for ~A: ~A~%"
 		   (cmd-table-entry-name cmd-entry)
 		   (cmd-table-entry-desc cmd-entry)))))
     (t
-     (format *repl-output* "~11A ~4A ~A~%" "COMMAND" "ABBR" "DESCRIPTION")
-     (format *repl-output* "~11A ~4A ~A~%" "<n>" ""
+     (format *output* "~11A ~4A ~A~%" "COMMAND" "ABBR" "DESCRIPTION")
+     (format *output* "~11A ~4A ~A~%" "<n>" ""
 	     "re-execute <n>th history command")
      (dolist (doc-entry (get-cmd-doc-list :cmd))
-       (format *repl-output* "~11A ~4A ~A~%" (first doc-entry)
+       (format *output* "~11A ~4A ~A~%" (first doc-entry)
 	       (second doc-entry) (third doc-entry)))))
   (values))
 
@@ -419,37 +405,39 @@
   (let ((doc-entries (get-cmd-doc-list :alias)))
     (typecase doc-entries
       (cons
-       (format *repl-output* "~11A ~A ~4A~%" "ALIAS" "ABBR" "DESCRIPTION")
+       (format *output* "~11A ~A ~4A~%" "ALIAS" "ABBR" "DESCRIPTION")
        (dolist (doc-entry doc-entries)
-	 (format *repl-output* "~11A ~4A ~A~%" (first doc-entry) (second doc-entry) (third doc-entry))))
+	 (format *output* "~11A ~4A ~A~%" (first doc-entry) (second doc-entry) (third doc-entry))))
       (t
-       (format *repl-output* "No aliases are defined~%"))))
+       (format *output* "No aliases are defined~%"))))
   (values))
 
 (defun shell-cmd (string-arg)
   (sb-ext:run-program "/bin/sh" (list "-c" string-arg)
-		      :input nil :output *repl-output*)
+		      :input nil :output *output*)
   (values))
 
 (defun pushd-cmd (string-arg)
   (push string-arg *dir-stack*)
-  (cd-cmd *repl-output* string-arg)
+  (cd-cmd *output* string-arg)
   (values))
 
 (defun popd-cmd ()
   (if *dir-stack*
       (let ((dir (pop *dir-stack*)))
 	(cd-cmd dir))
-      (format *repl-output* "No directory on stack to pop.~%"))
+      (format *output* "No directory on stack to pop.~%"))
   (values))
 
 (defun pop-cmd (&optional (n 1))
+  #+ignore
   (let ((new-level (- (length *break-stack*) n 1)))
     (when (minusp new-level)
       (setq new-level 0))
     (dotimes (i (- (length *break-stack*) new-level 1))
       (pop *break-stack*)))
   ;; Find inspector 
+  #+ignore
   (do* ((i (1- (length *break-stack*)) (1- i))
 	(found nil))
        ((or found (minusp i)))
@@ -457,20 +445,20 @@
       (when inspect
 	(set-current-inspect inspect)
 	(setq found t))))
+  (when *inspect-reason*
+      (throw 'inspect-quit nil))
   (values))
 
-(defun continue-cmd (n)
-  (let ((restarts (break-data-restarts (car *break-stack*))))
+(defun continue-cmd (&optional (n 0))
+  (let ((restarts (compute-restarts)))
     (if restarts
 	(if (< -1 n (length restarts))
-	    (progn
-	      (invoke-restart-interactively (nth n restarts))
-	      )
-	    (format *repl-output* "~&There is no such restart"))
-	(format *repl-output* "~&There are no restarts"))))
+	    (invoke-restart-interactively (nth n restarts))
+	    (format *output* "~&There is no such restart"))
+	(format *output* "~&There are no restarts"))))
 
 (defun error-cmd ()
-  )
+  (print-restarts))
 
 (defun current-cmd ()
   )
@@ -490,11 +478,11 @@
   (let ((pids (thread-pids))
 	(current-pid (sb-thread:current-thread-id)))
     (dolist (pid pids)
-      (format *repl-output* "~&~D" pid)
+      (format *output* "~&~D" pid)
       (when (= pid current-pid)
-	(format *repl-output* " [current listener]"))))
+	(format *output* " [current listener]"))))
   #-sb-thread
-  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (format *output* "~&Threads are not supported in this version of sbcl")
   (values))
 
 (defun kill-cmd (&rest selected-pids)
@@ -504,12 +492,12 @@
       (if (find selected-pid pids :test #'eql)
 	  (progn
 	    (sb-thread:destroy-thread selected-pid)
-	    (format *repl-output* "~&Thread ~A destroyed" selected-pid))
-	  (format *repl-output* "~&No thread ~A exists" selected-pid))))
+	    (format *output* "~&Thread ~A destroyed" selected-pid))
+	  (format *output* "~&No thread ~A exists" selected-pid))))
   #-sb-thread
   (declare (ignore selected-pids))
   #-sb-thread
-  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (format *output* "~&Threads are not supported in this version of sbcl")
   (values))
 
 (defun signal-cmd (signal &rest selected-pids)
@@ -519,13 +507,13 @@
       (if (find selected-pid pids :test #'eql)
 	  (progn
 	    (sb-unix:unix-kill selected-pid signal)
-	    (format *repl-output* "~&Signal ~A sent to thread ~A"
+	    (format *output* "~&Signal ~A sent to thread ~A"
 		    signal selected-pid))
-	  (format *repl-output* "~&No thread ~A exists" selected-pid))))
+	  (format *output* "~&No thread ~A exists" selected-pid))))
   #-sb-thread
   (declare (ignore signal selected-pids))
   #-sb-thread
-  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (format *output* "~&Threads are not supported in this version of sbcl")
   (values))
 
 (defun focus-cmd (&optional process)
@@ -533,22 +521,23 @@
   (declare (ignore process))
   #+sb-thread
   (when process
-    (format *repl-output* "~&Focusing on next thread waiting waiting for the debugger~%"))
+    (format *output* "~&Focusing on next thread waiting waiting for the debugger~%"))
   #+sb-thread
   (progn
     (sb-thread:release-foreground)
     (sleep 1))
   #-sb-thread
-  (format *repl-output* "~&Threads are not supported in this version of sbcl")
+  (format *output* "~&Threads are not supported in this version of sbcl")
   (values))
 
 (defun reset-cmd ()
+  #+ignore
   (setf *break-stack* (last *break-stack*))
   (values))
 
 (defun dirs-cmd ()
   (dolist (dir *dir-stack*)
-    (format *repl-output* "~a~%" dir))
+    (format *output* "~a~%" dir))
   (values))
 
 
@@ -562,14 +551,14 @@
 	 ("cf" 2 cf-cmd "compile file" :parsing :string)
 	 ("cload" 2 cload-cmd "compile if needed and load file"
 	  :parsing :string)
-	 #+aclrepl-debugger("current" 3 current-cmd "print the expression for the current stack frame")
-	 #+aclrepl-debugger ("continue" 4 continue-cmd "continue from a continuable error")
+	 ("current" 3 current-cmd "print the expression for the current stack frame")
+	 ("continue" 4 continue-cmd "continue from a continuable error")
 	 ("describe" 2 describe-cmd "describe an object")
 	 ("macroexpand" 2 macroexpand-cmd "macroexpand an expression")
 	 ("package" 2 package-cmd "change current package")
-	 #+aclrepl-debugger ("error" 3 error-cmd "print the last error message")
+	 ("error" 3 error-cmd "print the last error message")
 	 ("exit" 2 exit-cmd "exit sbcl")
-	 #+aclrepl-debugger("frame" 2 frame-cmd "print info about the current frame")
+	 ("frame" 2 frame-cmd "print info about the current frame")
 	 ("help" 2 help-cmd "print this help")
 	 ("history" 3 history-cmd "print the recent history")
 	 ("inspect" 2 inspect-cmd "inspect an object")
@@ -577,7 +566,7 @@
 	 #+sb-thread ("kill" 2 kill-cmd "kill (destroy) processes")
 	 #+sb-thread ("signal" 2 signal-cmd "send a signal to processes")
 	 #+sb-thread ("focus" 2 focus-cmd "focus the top level on a process")
-	 #+aclrepl-debugger("local" 3 local-cmd "print the value of a local variable")
+	 ("local" 3 local-cmd "print the value of a local variable")
 	 ("pwd" 3 pwd-cmd "print current directory")
 	 ("pushd" 2 pushd-cmd "push directory on stack" :parsing :string)
 	 ("pop" 3 pop-cmd "pop up `n' (default 1) break levels")
@@ -588,7 +577,7 @@
 	 ("untrace" 4 untrace-cmd "untrace a function")
 	 ("dirs" 2 dirs-cmd "show directory stack")
 	 ("shell" 2 shell-cmd "execute a shell cmd" :parsing :string)
-	 #+aclrepl-debugger ("zoom" 2 zoom-cmd "print the runtime stack")
+	 ("zoom" 2 zoom-cmd "print the runtime stack")
 	 )))
   (dolist (cmd cmd-table)
     (destructuring-bind (cmd-string abbr-len func-name desc &key parsing) cmd
@@ -673,21 +662,24 @@
   (string-trim '(#\space #\tab #\return)
 	       str))
 
-(defun whitespace-char-not-newline-p (x)
+(defun whitespace-char-p (x)
   (and (characterp x)
        (or (char= x #\space)
 	   (char= x #\tab)
+	   (char= x #\newline)
 	   (char= x #\return))))
 
+(defun whitespace-char-not-newline-p (x)
+  (and (whitespace-char-p x)
+       (not (char= x #\newline))))
+
 
 ;;;; linking into SBCL hooks
 
 
 (defun repl-prompt-fun (stream)
-  (let* ((break-data (car *break-stack*))
-	 (break-level (break-data-level break-data)))
-    (when (zerop break-level)
-      (setq break-level nil))
+  (let ((break-level
+	 (if (zerop *break-level*) nil  *break-level*)))
     #+sb-thread
     (let ((lock sb-thread::*session-lock*))
       (sb-thread::get-foreground)
@@ -695,82 +687,64 @@
 	(when stopped-threads
 	  (format stream "~{~&Thread ~A suspended~}~%" stopped-threads))))
     (if (functionp *prompt*)
-	(write-string (funcall *prompt* break-level
-			       (break-data-inspect-initiated break-data)
-			       (break-data-continuable break-data)
+	(write-string (funcall *prompt*
+			       *inspect-reason*
+			       *continuable-reason*
 			       (prompt-package-name) *cmd-number*)
 		      stream)
 	(handler-case 
 	    (format nil *prompt* break-level
-		    (break-data-inspect-initiated break-data)
-		    (break-data-continuable break-data)
+		    *inspect-reason*
+		    *continuable-reason*
 		    (prompt-package-name) *cmd-number*)
 	  (error ()
 	    (format stream "~&Prompt error>  "))
 	  (:no-error (prompt)
 	    (format stream "~&~A" prompt))))))
   
-(defun process-cmd (user-cmd input-stream output-stream)
+(defun process-cmd (user-cmd)
   ;; Processes a user command. Returns t if the user-cmd was a top-level
   ;; command
   (cond ((eq user-cmd *eof-cmd*)
 	 (when *exit-on-eof*
-	   (quit))
-	 (format output-stream "EOF~%")
+	   (sb-ext:quit))
+	 (format *output* "EOF~%")
 	 t)
 	((eq user-cmd *null-cmd*)
 	 t)
 	((eq (user-cmd-func user-cmd) :cmd-error)
-	 (format output-stream "Unknown top-level command: ~s.~%"
+	 (format *output* "Unknown top-level command: ~s.~%"
 		 (user-cmd-input user-cmd))
-	 (format output-stream "Type `:help' for the list of commands.~%")
+	 (format *output* "Type `:help' for the list of commands.~%")
 	 t)
 	((eq (user-cmd-func user-cmd) :history-error)
-	 (format output-stream "Input numbered ~d is not on the history list~%"
+	 (format *output* "Input numbered ~d is not on the history list~%"
 		 (user-cmd-input user-cmd))
 	 t)
 	((functionp (user-cmd-func user-cmd))
 	 (add-to-history user-cmd)
-	 (let ((*repl-output* output-stream)
-	       (*repl-input* input-stream))
-	   (apply (user-cmd-func user-cmd) (user-cmd-args user-cmd)))
+	 (apply (user-cmd-func user-cmd) (user-cmd-args user-cmd))
 	 (fresh-line)
 	 t)
 	(t
 	 (add-to-history user-cmd)
 	 nil))) ; nope, not in my job description
 
-(defun repl-read-form-fun (input-stream output-stream)
+(defun repl-read-form-fun (input output)
   ;; Pick off all the leading ACL magic commands, then return a normal
   ;; Lisp form.
-  (loop for user-cmd = (read-cmd input-stream) do
-	(if (process-cmd user-cmd input-stream output-stream)
+  (let ((*input* input)
+	(*output* output))
+    (loop for user-cmd = (read-cmd *input*) do
+	(if (process-cmd user-cmd)
 	    (progn
-	      (funcall sb-int:*repl-prompt-fun* output-stream)
-	      (force-output output-stream))
-	    (return (user-cmd-input user-cmd)))))
+	      (funcall sb-int:*repl-prompt-fun* *output*)
+	      (force-output *output*))
+	    (return (user-cmd-input user-cmd))))))
 
 
 (setf sb-int:*repl-prompt-fun* #'repl-prompt-fun
       sb-int:*repl-read-form-fun* #'repl-read-form-fun)
-
-;;; Break level processing
-
-;; use an initial break-level to hold current inspect toplevel at
-;; break-level 0
-
-(defun new-break (&key restarts inspect continuable)
-  (push
-   (make-break-data :level (length *break-stack*)
-		    :restarts restarts
-		    :inspect inspect
-		    :inspect-initiated (when inspect t)
-		    :continuable continuable)
-   *break-stack*))
-
-(defun set-break-inspect (inspect)
-  "sets the inspect data for the current break level"
-  (setf (break-data-inspect (car *break-stack*)) inspect))
 
 ) ;; close special variables bindings
 

Index: sb-aclrepl.asd
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/sb-aclrepl.asd,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- sb-aclrepl.asd	23 Apr 2003 16:36:23 -0000	1.7
+++ sb-aclrepl.asd	25 Apr 2003 02:54:07 -0000	1.8
@@ -6,7 +6,8 @@
 (defsystem sb-aclrepl
     :author "Kevin Rosenberg <ke...@ro...>"
     :description "An AllegroCL compatible REPL"
-    :components ((:file "repl")
+    :components ((:file "toplevel")
+		 (:file "repl" :depends-on ("toplevel"))
 		 (:file "inspect" :depends-on ("repl"))
 		 (:file "debug" :depends-on ("repl"))))