*interpreted-function-cache-minimum-size*
*interpreted-function-cache-threshold*))
-;;; 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*))
+\f
+;;;; eval stack stuff
;;; 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)
\f
;;;; 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))))
(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)))
(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* ()))
(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
;;; 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~%"
(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))))
;; 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))
(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))
(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.
(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))
;; 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))
;; 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.
;; 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."))
;; 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
,@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))
\f
;;;; INTERNAL-EVAL
;;; 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 sb!eval: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
;;; 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)))
(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
(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*)
(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
(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)
(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
(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)
(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
(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
(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))
(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
: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)
(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)))))
;;; 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)
(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))
projects / sbcl.git / blobdiff