X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Feval.lisp;h=d3ab8b9bc976987df8296da0637fec08e0556586;hb=4bb696ba74f1f47333ff45995b82eb51acbee29d;hp=79afc72c10a8bf7a730dfa0d7668d01c34f158c4;hpb=099d6dd1f6a5ac2ffec5c14d07a4b905322ef968;p=sbcl.git

diff --git a/src/compiler/eval.lisp b/src/compiler/eval.lisp
index 79afc72..d3ab8b9 100644
--- a/src/compiler/eval.lisp
+++ b/src/compiler/eval.lisp
@@ -34,75 +34,81 @@
 (declaim (type list *interpreted-function-cache*))
 
 ;;; Setting this causes the stack operations to dump a trace.
-;;;
-;;; FIXME: perhaps should be #!+SB-SHOW
+#+!sb-show
 (defvar *eval-stack-trace* nil)
 
-;;; Push value on *eval-stack*, growing the stack if necessary. This returns
-;;; value. We save *eval-stack-top* in a local and increment the global before
-;;; storing value on the stack to prevent a GC timing problem. If we stored
-;;; value on the stack using *eval-stack-top* as an index, and we GC'ed before
-;;; incrementing *eval-stack-top*, then INTERPRETER-GC-HOOK would clear the
+;;; Push value on *EVAL-STACK*, growing the stack if necessary. This
+;;; returns value. We save *EVAL-STACK-TOP* in a local and increment
+;;; the global before storing value on the stack to prevent a GC
+;;; timing problem. If we stored value on the stack using
+;;; *EVAL-STACK-TOP* as an index, and we GC'ed before incrementing
+;;; *EVAL-STACK-TOP*, then INTERPRETER-GC-HOOK would clear the
 ;;; location.
 (defun eval-stack-push (value)
   (let ((len (length (the simple-vector *eval-stack*))))
     (when (= len *eval-stack-top*)
-      (when *eval-stack-trace* (format t "[PUSH: growing stack.]~%"))
+      #+!sb-show (when *eval-stack-trace*
+		   (format t "[PUSH: growing stack.]~%"))
       (let ((new-stack (make-array (ash len 1))))
 	(replace new-stack *eval-stack* :end1 len :end2 len)
 	(setf *eval-stack* new-stack))))
   (let ((top *eval-stack-top*))
-    (when *eval-stack-trace* (format t "pushing ~D.~%" top))
+    #+!sb-show (when *eval-stack-trace* (format t "pushing ~D.~%" top))
     (incf *eval-stack-top*)
     (setf (svref *eval-stack* top) value)))
 
-;;; This returns the last value pushed on *eval-stack* and decrements the top
-;;; pointer. We forego setting elements off the end of the stack to nil for GC
-;;; purposes because there is a *before-gc-hook* to take care of this for us.
-;;; However, because of the GC hook, we must be careful to grab the value
-;;; before decrementing *eval-stack-top* since we could GC between the
-;;; decrement and the reference, and the hook would clear the stack slot.
+;;; Return the last value pushed on *EVAL-STACK* and decrement the top
+;;; pointer. We forego setting elements off the end of the stack to
+;;; nil for GC purposes because there is a *BEFORE-GC-HOOK* to take
+;;; care of this for us. However, because of the GC hook, we must be
+;;; careful to grab the value before decrementing *EVAL-STACK-TOP*
+;;; since we could GC between the decrement and the reference, and the
+;;; hook would clear the stack slot.
 (defun eval-stack-pop ()
   (when (zerop *eval-stack-top*)
     (error "attempt to pop empty eval stack"))
   (let* ((new-top (1- *eval-stack-top*))
 	 (value (svref *eval-stack* new-top)))
-    (when *eval-stack-trace* (format t "popping ~D --> ~S.~%" new-top value))
+    #+!sb-show (when *eval-stack-trace*
+		 (format t "popping ~D --> ~S.~%" new-top value))
     (setf *eval-stack-top* new-top)
     value))
 
-;;; This allocates n locations on the stack, bumping the top pointer and
-;;; growing the stack if necessary. We set new slots to nil in case we GC
-;;; before having set them; we don't want to hold on to potential garbage
-;;; from old stack fluctuations.
+;;; Allocate N locations on the stack, bumping the top pointer and
+;;; growing the stack if necessary. We set new slots to nil in case we
+;;; GC before having set them; we don't want to hold on to potential
+;;; garbage from old stack fluctuations.
 (defun eval-stack-extend (n)
   (let ((len (length (the simple-vector *eval-stack*))))
     (when (> (+ n *eval-stack-top*) len)
-      (when *eval-stack-trace* (format t "[EXTEND: growing stack.]~%"))
+      #+!sb-show (when *eval-stack-trace*
+		   (format t "[EXTEND: growing stack.]~%"))
       (let ((new-stack (make-array (+ n (ash len 1)))))
 	(replace new-stack *eval-stack* :end1 len :end2 len)
 	(setf *eval-stack* new-stack))))
   (let ((new-top (+ *eval-stack-top* n)))
-  (when *eval-stack-trace* (format t "extending to ~D.~%" new-top))
+    #+!sb-show (when *eval-stack-trace*
+		 (format t "extending to ~D.~%" new-top))
     (do ((i *eval-stack-top* (1+ i)))
 	((= i new-top))
       (setf (svref *eval-stack* i) nil))
     (setf *eval-stack-top* new-top)))
 
-;;; The anthesis of EVAL-STACK-EXTEND.
+;;; the antithesis of EVAL-STACK-EXTEND
 (defun eval-stack-shrink (n)
-  (when *eval-stack-trace*
-    (format t "shrinking to ~D.~%" (- *eval-stack-top* n)))
+  #+!sb-show (when *eval-stack-trace*
+	       (format t "shrinking to ~D.~%" (- *eval-stack-top* n)))
   (decf *eval-stack-top* n))
 
 ;;; This is used to shrink the stack back to a previous frame pointer.
-(defun eval-stack-set-top (ptr)
-  (when *eval-stack-trace* (format t "setting top to ~D.~%" ptr))
+(defun eval-stack-reset-top (ptr)
+  #+!sb-show (when *eval-stack-trace*
+	       (format t "setting top to ~D.~%" ptr))
   (setf *eval-stack-top* ptr))
 
-;;; This returns a local variable from the current stack frame. This is used
-;;; for references the compiler represents as a lambda-var leaf. This is a
-;;; macro for SETF purposes.
+;;; Return a local variable from the current stack frame. This is used
+;;; for references the compiler represents as a lambda-var leaf. It is
+;;; a macro as a quick and dirty way of making it SETFable.
 ;;;
 ;;; FIXME: used only in this file, needn't be in runtime
 (defmacro eval-stack-local (fp offset)
@@ -110,12 +116,12 @@
 
 ;;;; interpreted functions
 
-;;; The list of INTERPRETED-FUNCTIONS that have translated definitions.
+;;; the list of INTERPRETED-FUNCTIONS that have translated definitions
 (defvar *interpreted-function-cache* nil)
 (declaim (type list *interpreted-function-cache*))
 
-;;; Return a function that will lazily convert Lambda when called, and will
-;;; cache translations.
+;;; Return a function that will lazily convert LAMBDA when called, and
+;;; will cache translations.
 (defun make-interpreted-function (lambda)
   (let ((res (%make-interpreted-function :lambda lambda
 					 :arglist (second lambda))))
@@ -132,8 +138,7 @@
 (defun convert-interpreted-fun (fun)
   (declare (type interpreted-function fun))
   (let* ((new (interpreted-function-definition
-	       (internal-eval `#',(interpreted-function-lambda fun)
-			      (interpreted-function-converted-once fun)))))
+	       (internal-eval `#',(interpreted-function-lambda fun)))))
     (setf (interpreted-function-definition fun) new)
     (setf (interpreted-function-converted-once fun) t)
     (let ((name (interpreted-function-%name fun)))
@@ -231,11 +236,10 @@
     (incf (interpreted-function-gcs fun))))
 (pushnew 'interpreter-gc-hook sb!ext:*before-gc-hooks*)
 
+;;; Clear all entries in the eval function cache. This allows the internal
+;;; representation of the functions to be reclaimed, and also lazily forces
+;;; macroexpansions to be recomputed.
 (defun flush-interpreted-function-cache ()
-  #!+sb-doc
-  "Clear all entries in the eval function cache. This allows the internal
-  representation of the functions to be reclaimed, and also lazily forces
-  macroexpansions to be recomputed."
   (dolist (fun *interpreted-function-cache*)
     (setf (interpreted-function-definition fun) nil))
   (setq *interpreted-function-cache* ()))
@@ -309,7 +313,7 @@
 			    (compute-closure node ,lambda frame-ptr closure)))
 		       ;; No need to clean up stack slots for GC due to
 		       ;; SB!EXT:*BEFORE-GC-HOOK*.
-		       (eval-stack-set-top frame-ptr)
+		       (eval-stack-reset-top frame-ptr)
 		       (return-from
 			internal-apply-loop
 			(internal-apply ,lambda ,args ,calling-closure
@@ -351,7 +355,8 @@
 ;;; This controls printing visited nodes in INTERNAL-APPLY-LOOP. We use it
 ;;; here, and INTERNAL-INVOKE uses it to print function call looking output
 ;;; to further describe sb!c::combination nodes.
-(defvar *internal-apply-node-trace* nil)
+#!+sb-show (defvar *internal-apply-node-trace* nil)
+#!+sb-show
 (defun maybe-trace-funny-fun (node name &rest args)
   (when *internal-apply-node-trace*
     (format t "(~S ~{ ~S~})  c~S~%"
@@ -379,7 +384,7 @@
 	 (sb!c::%special-bind
 	  (let ((value (eval-stack-pop))
 		(global-var (eval-stack-pop)))
-	    (maybe-trace-funny-fun node ,name global-var value)
+	    #!+sb-show (maybe-trace-funny-fun node ,name global-var value)
 	    (sb!sys:%primitive sb!c:bind
 			       value
 			       (sb!c::global-var-name global-var))))
@@ -387,7 +392,7 @@
 	  ;; Throw away arg telling me which special, and tell the dynamic
 	  ;; binding mechanism to unbind one variable.
 	  (eval-stack-pop)
-	  (maybe-trace-funny-fun node ,name)
+	  #!+sb-show (maybe-trace-funny-fun node ,name)
 	  (sb!sys:%primitive sb!c:unbind))
 	 (sb!c::%catch
 	  (let* ((tag (eval-stack-pop))
@@ -400,7 +405,7 @@
 		 (values
 		  (multiple-value-list
 		   (catch tag
-		     (maybe-trace-funny-fun node ,name tag)
+		     #!+sb-show (maybe-trace-funny-fun node ,name tag)
 		     (multiple-value-setq (block node cont last-cont)
 		       (internal-apply-loop (sb!c::continuation-next cont)
 					    frame-ptr lambda args closure))
@@ -415,7 +420,7 @@
 		  (t
 		   ;; Fix up the interpreter's stack after having thrown here.
 		   ;; We won't need to do this in the final implementation.
-		   (eval-stack-set-top stack-top)
+		   (eval-stack-reset-top stack-top)
 		   ;; Take the values received in the list bound above, and
 		   ;; massage them into the form expected by the continuation
 		   ;; of the non-local-exit info.
@@ -444,7 +449,7 @@
 		 (stack-top *eval-stack-top*))
 	    (unwind-protect
 		(progn
-		  (maybe-trace-funny-fun node ,name)
+		  #!+sb-show (maybe-trace-funny-fun node ,name)
 		  (multiple-value-setq (block node cont last-cont)
 		    (internal-apply-loop (sb!c::continuation-next cont)
 					 frame-ptr lambda args closure))
@@ -460,7 +465,7 @@
 		     ;; Fix up the interpreter's stack after having thrown
 		     ;; here. We won't need to do this in the final
 		     ;; implementation.
-		     (eval-stack-set-top stack-top)
+		     (eval-stack-reset-top stack-top)
 		     ;; Push some bogus values for exit context to keep the
 		     ;; MV-BIND in the UNWIND-PROTECT translation happy.
 		     (eval-stack-push '(nil nil 0))
@@ -477,11 +482,11 @@
 	  ;; Return the current state of evaluation to the previous invocation
 	  ;; of INTERNAL-APPLY-LOOP which happens to be running in the
 	  ;; SB!C::%CATCH branch of this code.
-	  (maybe-trace-funny-fun node ,name)
+	  #!+sb-show (maybe-trace-funny-fun node ,name)
 	  (return-from internal-apply-loop
 		       (values block node cont last-cont)))
 	 (sb!c::%nlx-entry
-	  (maybe-trace-funny-fun node ,name)
+	  #!+sb-show (maybe-trace-funny-fun node ,name)
 	  ;; This just marks a spot in the code for CATCH, UNWIND-PROTECT, and
 	  ;; non-local lexical exits (GO or RETURN-FROM).
 	  ;; Do nothing since sb!c::%catch does it all when it catches a THROW.
@@ -496,8 +501,8 @@
 		 ;; consistency checking. SB!C::%MORE-ARG-CONTEXT always runs
 		 ;; within an XEP, so the lambda has an extra arg.
 		 (more-args (nthcdr fixed-arg-count args)))
-	    (maybe-trace-funny-fun node ,name fixed-arg-count)
-	    (assert (eq (sb!c::continuation-info cont) :multiple))
+	    #!+sb-show (maybe-trace-funny-fun node ,name fixed-arg-count)
+	    (aver (eq (sb!c::continuation-info cont) :multiple))
 	    (eval-stack-push (list more-args (length more-args)))))
 	 (sb!c::%unknown-values
 	  (error "SB!C::%UNKNOWN-VALUES should never be in interpreter's IR1."))
@@ -507,8 +512,8 @@
 	  ;; have non-locally lexically exited. Return the :fell-through flag
 	  ;; and the current state of evaluation to the previous invocation
 	  ;; of INTERNAL-APPLY-LOOP which happens to be running in the
-	  ;; sb!c::entry branch of INTERNAL-APPLY-LOOP.
-	  (maybe-trace-funny-fun node ,name)
+	  ;; SB!C::ENTRY branch of INTERNAL-APPLY-LOOP.
+	  #!+sb-show (maybe-trace-funny-fun node ,name)
 	  ;; Discard the NLX-INFO arg...
 	  (eval-stack-pop)
 	  (return-from internal-apply-loop
@@ -561,15 +566,11 @@
 		     ,@letp-bind)
 		,local-branch))
 	     ((eq (sb!c::continuation-info ,fun) :unused)
-	      (assert (typep ,kind 'sb!c::function-info))
+	      (aver (typep ,kind 'sb!c::function-info))
 	      (do-funny-function (sb!c::continuation-function-name ,fun)))
 	     (t
-	      (assert (typep ,kind 'sb!c::function-info))
+	      (aver (typep ,kind 'sb!c::function-info))
 	      (do-combination :full nil ,type))))))
-
-(defun trace-eval (on)
-  (setf *eval-stack-trace* on)
-  (setf *internal-apply-node-trace* on))
 
 ;;;; INTERNAL-EVAL
 
@@ -577,21 +578,14 @@
 ;;; APPLY on it. If *ALREADY-EVALED-THIS* is true, then we bind it to
 ;;; NIL around the apply to limit the inhibition to the lexical scope
 ;;; of the EVAL-WHEN.
-(defun internal-eval (form &optional quietly)
-  (let ((res (sb!c:compile-for-eval form quietly)))
+#!+sb-interpreter
+(defun internal-eval (form)
+  (let ((res (sb!c:compile-for-eval form)))
     (if *already-evaled-this*
 	(let ((*already-evaled-this* nil))
 	  (internal-apply res nil '#()))
 	(internal-apply res nil '#()))))
 
-;;; Later this will probably be the same weird internal thing the compiler
-;;; makes to represent these things.
-(defun make-indirect-value-cell (value)
-  (list value))
-;;; FIXME: used only in this file, needn't be in runtime
-(defmacro indirect-value (value-cell)
-  `(car ,value-cell))
-
 ;;; This passes on a node's value appropriately, possibly returning from
 ;;; function to do so. When we are tail-p, don't push the value, return it on
 ;;; the system's actual call stack; when we blow out of function this way, we
@@ -603,32 +597,34 @@
 ;;; FIXME: maybe used only in this file, if so, needn't be in runtime
 (defmacro value (node info value frame-ptr function)
   `(cond ((sb!c::node-tail-p ,node)
-	  (eval-stack-set-top ,frame-ptr)
+	  (eval-stack-reset-top ,frame-ptr)
 	  (return-from ,function ,value))
 	 ((member ,info '(:multiple :return) :test #'eq)
 	  (eval-stack-push (list ,value)))
-	 (t (assert (eq ,info :single))
+	 (t (aver (eq ,info :single))
 	    (eval-stack-push ,value))))
 
+#!+sb-show
 (defun maybe-trace-nodes (node)
   (when *internal-apply-node-trace*
     (format t "<~A-node> c~S~%"
 	    (type-of node)
 	    (sb!c::cont-num (sb!c::node-cont node)))))
 
-;;; This interprets lambda, a compiler IR1 data structure representing a
-;;; function, applying it to args. Closure is the environment in which to run
-;;; lambda, the variables and such closed over to form lambda. The call occurs
-;;; on the interpreter's stack, so save the current top and extend the stack
-;;; for this lambda's call frame. Then store the args into locals on the
-;;; stack.
+;;; Interpret LAMBDA, a compiler IR1 data structure representing a
+;;; function, applying it to ARGS. CLOSURE is the environment in which
+;;; to run LAMBDA, the variables and such closed over to form LAMBDA.
+;;; The call occurs on the interpreter's stack, so save the current
+;;; top and extend the stack for this lambda's call frame. Then store
+;;; the args into locals on the stack.
 ;;;
-;;; Args is the list of arguments to apply to. If IGNORE-UNUSED is true, then
-;;; values for un-read variables are present in the argument list, and must be
-;;; discarded (always true except in a local call.)  Args may run out of values
-;;; before vars runs out of variables (in the case of an XEP with optionals);
-;;; we just do CAR of nil and store nil. This is not the proper defaulting
-;;; (which is done by explicit code in the XEP.)
+;;; ARGS is the list of arguments to apply to. If IGNORE-UNUSED is
+;;; true, then values for un-read variables are present in the
+;;; argument list, and must be discarded (always true except in a
+;;; local call.) ARGS may run out of values before VARS runs out of
+;;; variables (in the case of an XEP with optionals); we just do CAR
+;;; of NIL and store NIL. This is not the proper defaulting (which is
+;;; done by explicit code in the XEP.)
 (defun internal-apply (lambda args closure &optional (ignore-unused t))
   (let ((frame-ptr *eval-stack-top*))
     (eval-stack-extend (sb!c:lambda-eval-info-frame-size (sb!c::lambda-info lambda)))
@@ -639,7 +635,7 @@
 	(cond ((sb!c::leaf-refs var)
 	       (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
 		     (if (sb!c::lambda-var-indirect var)
-			 (make-indirect-value-cell (pop args))
+			 (sb!c::make-value-cell (pop args))
 			 (pop args))))
 	      (ignore-unused (pop args)))))
     (internal-apply-loop (sb!c::lambda-bind lambda) frame-ptr lambda args
@@ -683,41 +679,42 @@
 	(let ((cont (sb!c::node-cont node)))
 	  (etypecase node
 	    (sb!c::ref
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (let ((info (sb!c::continuation-info cont)))
 	       (unless (eq info :unused)
 		 (value node info (leaf-value node frame-ptr closure)
 			frame-ptr internal-apply-loop))))
 	    (sb!c::combination
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (combination-node :normal))
 	    (sb!c::cif
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     ;; IF nodes always occur at the end of a block, so pick another.
 	     (set-block (if (eval-stack-pop)
 			    (sb!c::if-consequent node)
 			    (sb!c::if-alternative node))))
 	    (sb!c::bind
-	     (maybe-trace-nodes node)
-	     ;; Ignore bind nodes since INTERNAL-APPLY extends the stack for
-	     ;; all of a lambda's locals, and the sb!c::combination branch
-	     ;; handles LET binds (moving values off stack top into locals).
+	     #!+sb-show (maybe-trace-nodes node)
+	     ;; Ignore bind nodes since INTERNAL-APPLY extends the
+	     ;; stack for all of a lambda's locals, and the
+	     ;; SB!C::COMBINATION branch handles LET binds (moving
+	     ;; values off stack top into locals).
 	     )
 	    (sb!c::cset
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (let ((info (sb!c::continuation-info cont))
 		   (res (set-leaf-value node frame-ptr closure
 					(eval-stack-pop))))
 	       (unless (eq info :unused)
 		 (value node info res frame-ptr internal-apply-loop))))
 	    (sb!c::entry
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (let ((info (cdr (assoc node (sb!c:lambda-eval-info-entries
 					   (sb!c::lambda-info lambda))))))
 	       ;; No info means no-op entry for CATCH or UNWIND-PROTECT.
 	       (when info
-		 ;; Store stack top for restoration in local exit situation
-		 ;; in sb!c::exit branch.
+		 ;; Store stack top for restoration in local exit
+		 ;; situation in SB!C::EXIT branch.
 		 (setf (eval-stack-local frame-ptr
 					 (sb!c:entry-node-info-st-top info))
 		       *eval-stack-top*)
@@ -759,7 +756,7 @@
 				(sb!c::block-start
 				 (car (sb!c::block-succ block))))))))))))
 	    (sb!c::exit
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (let* ((incoming-values (sb!c::exit-value node))
 		    (values (if incoming-values (eval-stack-pop))))
 	       (cond
@@ -768,7 +765,7 @@
 		      (sb!c::node-block (sb!c::exit-entry node))))
 		 ;; Local exit.
 		 ;; Fixup stack top and massage values for destination.
-		 (eval-stack-set-top
+		 (eval-stack-reset-top
 		  (eval-stack-local frame-ptr
 				    (sb!c:entry-node-info-st-top
 				     (cdr (assoc (sb!c::exit-entry node)
@@ -776,10 +773,10 @@
 						  (sb!c::lambda-info lambda)))))))
 		 (ecase (sb!c::continuation-info cont)
 		   (:single
-		    (assert incoming-values)
+		    (aver incoming-values)
 		    (eval-stack-push (car values)))
 		   ((:multiple :return)
-		    (assert incoming-values)
+		    (aver incoming-values)
 		    (eval-stack-push values))
 		   (:unused)))
 		(t
@@ -795,12 +792,12 @@
 			(values values (sb!c::nlx-info-target info) nil cont)
 			(values :non-local-go (sb!c::nlx-info-target info)))))))))
 	    (sb!c::creturn
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (let ((values (eval-stack-pop)))
-	       (eval-stack-set-top frame-ptr)
+	       (eval-stack-reset-top frame-ptr)
 	       (return-from internal-apply-loop (values-list values))))
 	    (sb!c::mv-combination
-	     (maybe-trace-nodes node)
+	     #!+sb-show (maybe-trace-nodes node)
 	     (combination-node :mv-call)))
 	  ;; See function doc below.
 	  (reference-this-var-to-keep-it-alive node)
@@ -829,12 +826,13 @@
 (defun reference-this-var-to-keep-it-alive (node)
   node)
 
-;;; This sets a sb!c::cset node's var to value, returning value. When var is
-;;; local, we have to compare its home environment to the current one, node's
-;;; environment. If they're the same, we check to see whether the var is
-;;; indirect, and store the value on the stack or in the value cell as
-;;; appropriate. Otherwise, var is a closure variable, and since we're
-;;; setting it, we know its location contains an indirect value object.
+;;; This sets a SB!C::CSET node's var to value, returning value. When
+;;; var is local, we have to compare its home environment to the
+;;; current one, node's environment. If they're the same, we check to
+;;; see whether the var is indirect, and store the value on the stack
+;;; or in the value cell as appropriate. Otherwise, var is a closure
+;;; variable, and since we're setting it, we know its location
+;;; contains an indirect value object.
 (defun set-leaf-value (node frame-ptr closure value)
   (let ((var (sb!c::set-var node)))
     (etypecase var
@@ -843,33 +841,31 @@
       (sb!c::global-var
        (setf (symbol-value (sb!c::global-var-name var)) value)))))
 
-;;; This does SET-LEAF-VALUE for a lambda-var leaf. The debugger tools'
-;;; internals uses this also to set interpreted local variables.
-
-;;; MNA: cmucl-commit: Tue, 26 Sep 2000 09:40:37 -0700 (PDT)
-;;; Within set-leaf-value-lambda-var, avoid trying to set a lexical
-;;; variable with no refs since the compiler deletes such variables.
+;;; This does SET-LEAF-VALUE for a LAMBDA-VAR leaf. The debugger tools'
+;;; internals use this also to set interpreted local variables.
 (defun set-leaf-value-lambda-var (node var frame-ptr closure value)
+  ;; Note: We avoid trying to set a lexical variable with no refs
+  ;; because the compiler deletes such variables.
   (when (sb!c::leaf-refs var)
     (let ((env (sb!c::node-environment node)))
       (cond ((not (eq (sb!c::lambda-environment (sb!c::lambda-var-home var))
                       env))
-              (setf (indirect-value
-                     (svref closure
-                            (position var (sb!c::environment-closure env)
-                                      :test #'eq)))
-                      value))
+	     (sb!c::value-cell-set
+              (svref closure
+                     (position var (sb!c::environment-closure env)
+                               :test #'eq))
+              value))
             ((sb!c::lambda-var-indirect var)
-              (setf (indirect-value
-                     (eval-stack-local frame-ptr (sb!c::lambda-var-info var)))
-                      value))
+	     (sb!c::value-cell-set
+              (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
+              value))
             (t
-              (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
-                      value))))))
+	     (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
+		   value))))))
 
-;;; This figures out how to return a value for a ref node. Leaf is the ref's
-;;; structure that tells us about the value, and it is one of the following
-;;; types:
+;;; This figures out how to return a value for a ref node. LEAF is the
+;;; ref's structure that tells us about the value, and it is one of
+;;; the following types:
 ;;;    constant   -- It knows its own value.
 ;;;    global-var -- It's either a value or function reference. Get it right.
 ;;;    local-var  -- This may on the stack or in the current closure, the
@@ -954,38 +950,42 @@
 		     (position leaf (sb!c::environment-closure env)
 			       :test #'eq)))))
     (if (sb!c::lambda-var-indirect leaf)
-	(indirect-value temp)
+	(sb!c::value-cell-ref temp)
 	temp)))
 
-;;; This computes a closure for a local call and for returned call'able closure
-;;; objects. Sometimes the closure is a simple-vector of no elements. Node
-;;; is either a reference node or a combination node. Leaf is either the leaf
-;;; of the reference node or the lambda to internally apply for the combination
-;;; node. Frame-ptr is the current frame pointer for fetching current values
-;;; to store in the closure. Closure is the current closure, the currently
-;;; interpreting lambda's closed over environment.
-;;;
-;;; A computed closure is a vector corresponding to the list of closure
-;;; variables described in an environment. The position of a lambda-var in
-;;; this closure list is the index into the closure vector of values.
+;;; Compute a closure for a local call and for returned call'able
+;;; closure objects. Sometimes the closure is a SIMPLE-VECTOR of no
+;;; elements. NODE is either a reference node or a combination node.
+;;; LEAF is either the leaf of the reference node or the lambda to
+;;; internally apply for the combination node. FRAME-PTR is the
+;;; current frame pointer for fetching current values to store in the
+;;; closure. CLOSURE is the current closure, the closed-over
+;;; environment of the currently interpreting LAMBDA.
 ;;;
-;;; Functional-env is the environment description for leaf, the lambda for
-;;; which we're computing a closure. This environment describes which of
-;;; lambda's vars we find in lambda's closure when it's running, versus finding
-;;; them on the stack. For each lambda-var in the functional environment's
-;;; closure list, if the lambda-var's home environment is the current
-;;; environment, then get a value off the stack and store it in the closure
-;;; we're computing. Otherwise that lambda-var's value comes from somewhere
-;;; else, but we have it in our current closure, the environment we're running
-;;; in as we compute this new closure. Find this value the same way we do in
-;;; LEAF-VALUE, by finding the lambda-var's position in the current
-;;; environment's description of the current closure.
+;;; A computed closure is a vector corresponding to the list of
+;;; closure variables described in an environment. The position of a
+;;; lambda-var in this closure list is the index into the closure
+;;; vector of values.
 (defun compute-closure (node leaf frame-ptr closure)
   (let* ((current-env (sb!c::node-environment node))
 	 (current-closure-vars (sb!c::environment-closure current-env))
+	 ;; FUNCTIONAL-ENV is the environment description for leaf,
+	 ;; the lambda for which we're computing a closure. This
+	 ;; environment describes which of lambda's vars we find in
+	 ;; lambda's closure when it's running, versus finding them on
+	 ;; the stack.
 	 (functional-env (sb!c::lambda-environment leaf))
 	 (functional-closure-vars (sb!c::environment-closure functional-env))
 	 (functional-closure (make-array (length functional-closure-vars))))
+    ;; For each lambda-var VAR in the functional environment's closure
+    ;; list, if the VAR's home environment is the current environment,
+    ;; then get a value off the stack and store it in the closure
+    ;; we're computing. Otherwise VAR's value comes from somewhere
+    ;; else, but we have it in our current closure, the environment
+    ;; we're running in as we compute this new closure. Find this
+    ;; value the same way we do in LEAF-VALUE, by finding VAR's
+    ;; position in the current environment's description of the
+    ;; current closure.
     (do ((vars functional-closure-vars (cdr vars))
 	 (i 0 (1+ i)))
 	((null vars))
@@ -1010,7 +1010,7 @@
 			      (sb!c::nlx-info-cleanup ele))
 			     (sb!c::lambda-eval-info-entries
 			      (sb!c::lambda-info
-			       ;; lambda INTERNAL-APPLY-LOOP tosses around.
+			       ;; the lambda INTERNAL-APPLY-LOOP tosses around
 			       (sb!c::environment-function
 				(sb!c::node-environment node))))))))
 		     (svref closure
@@ -1018,38 +1018,40 @@
 				      :test #'eq))))))))
     functional-closure))
 
-;;; INTERNAL-APPLY uses this to invoke a function from the interpreter's stack
-;;; on some arguments also taken from the stack. When tail-p is non-nil,
-;;; control does not return to INTERNAL-APPLY to further interpret the current
-;;; IR1 lambda, so INTERNAL-INVOKE must clean up the current interpreter's
-;;; stack frame.
+;;; INTERNAL-APPLY uses this to invoke a function from the
+;;; interpreter's stack on some arguments also taken from the stack.
+;;; When tail-p is non-nil, control does not return to INTERNAL-APPLY
+;;; to further interpret the current IR1 lambda, so INTERNAL-INVOKE
+;;; must clean up the current interpreter's stack frame.
 (defun internal-invoke (arg-count &optional tailp)
   (let ((args (eval-stack-args arg-count)) ;LET says this init form runs first.
 	(fun (eval-stack-pop)))
-    (when tailp (eval-stack-set-top tailp))
-    (when *internal-apply-node-trace*
-      (format t "(~S~{ ~S~})~%" fun args))
+    (when tailp (eval-stack-reset-top tailp))
+    #!+sb-show (when *internal-apply-node-trace*
+		 (format t "(~S~{ ~S~})~%" fun args))
     (apply fun args)))
 
-;;; Almost just like INTERNAL-INVOKE. We call MV-EVAL-STACK-ARGS, and our
-;;; function is in a list on the stack instead of simply on the stack.
+;;; This is almost just like INTERNAL-INVOKE. We call
+;;; MV-EVAL-STACK-ARGS, and our function is in a list on the stack
+;;; instead of simply on the stack.
 (defun mv-internal-invoke (arg-count &optional tailp)
-  (let ((args (mv-eval-stack-args arg-count)) ;LET runs this init form first.
+  (let ((args (mv-eval-stack-args arg-count)) ; LET runs this init form first.
 	(fun (car (eval-stack-pop))))
-    (when tailp (eval-stack-set-top tailp))
-    (when *internal-apply-node-trace*
-      (format t "(~S~{ ~S~})~%" fun args))
+    (when tailp (eval-stack-reset-top tailp))
+    #!+sb-show (when *internal-apply-node-trace*
+		 (format t "(~S~{ ~S~})~%" fun args))
     (apply fun args)))
 
-;;; This returns a list of the top arg-count elements on the interpreter's
+;;; Return a list of the top arg-count elements on the interpreter's
 ;;; stack. This removes them from the stack.
 (defun eval-stack-args (arg-count)
   (let ((args nil))
     (dotimes (i arg-count args)
       (push (eval-stack-pop) args))))
 
-;;; This assumes the top count elements on interpreter's stack are lists. This
-;;; returns a single list with all the elements from these lists.
+;;; This assumes the top count elements on interpreter's stack are
+;;; lists. This returns a single list with all the elements from these
+;;; lists.
 (defun mv-eval-stack-args (count)
   (if (= count 1)
       (eval-stack-pop)
@@ -1080,23 +1082,24 @@
       (when (sb!c::leaf-refs v)
 	(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
 	      (if (sb!c::lambda-var-indirect v)
-		  (make-indirect-value-cell (pop args))
+		  (sb!c::make-value-cell (pop args))
 		  (pop args)))))))
 
-;;; This is similar to STORE-LET-VARS, but the values for the locals appear on
-;;; the stack in a list due to forms that delivered multiple values to this
-;;; lambda/let. Unlike STORE-LET-VARS, there is no control over the delivery
-;;; of a value for an unreferenced var, so we drop the corresponding value on
-;;; the floor when no one references it. INTERNAL-APPLY uses this for
-;;; sb!c::mv-combination nodes representing LET's.
+;;; This is similar to STORE-LET-VARS, but the values for the locals
+;;; appear on the stack in a list due to forms that delivered multiple
+;;; values to this lambda/let. Unlike STORE-LET-VARS, there is no
+;;; control over the delivery of a value for an unreferenced var, so
+;;; we drop the corresponding value on the floor when no one
+;;; references it. INTERNAL-APPLY uses this for sb!c::mv-combination
+;;; nodes representing LET's.
 (defun store-mv-let-vars (lambda frame-ptr count)
-  (assert (= count 1))
+  (aver (= count 1))
   (let ((args (eval-stack-pop)))
     (dolist (v (sb!c::lambda-vars lambda))
       (if (sb!c::leaf-refs v)
 	  (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
 		(if (sb!c::lambda-var-indirect v)
-		    (make-indirect-value-cell (pop args))
+		    (sb!c::make-value-cell (pop args))
 		    (pop args)))
 	  (pop args)))))
 
@@ -1114,7 +1117,7 @@
 ;;; the recursion. You must do this instead of NREVERSE'ing the args list, so
 ;;; when we run out of values, we store nil's in the correct lambda-vars.
 (defun store-mv-let-vars (lambda frame-ptr count)
-  (assert (= count 1))
+  (aver (= count 1))
   (print  (sb!c::lambda-vars lambda))
   (store-mv-let-vars-aux frame-ptr (sb!c::lambda-vars lambda) (eval-stack-pop)))
 (defun store-mv-let-vars-aux (frame-ptr vars args)
@@ -1124,7 +1127,7 @@
 	(when (sb!c::leaf-refs v)
 	  (setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
 		(if (sb!c::lambda-var-indirect v)
-		    (make-indirect-value-cell (car remaining-args))
+		    (sb!c::make-value-cell (car remaining-args))
 		    (car remaining-args))))
 	(cdr remaining-args))
       args))