;;;; leaf reference
;;; Return the TN that holds the value of THING in the environment ENV.
+(declaim (ftype (function ((or nlx-info lambda-var) physenv) tn)
+ find-in-physenv))
(defun find-in-physenv (thing physenv)
- (declare (type (or nlx-info lambda-var) thing) (type physenv physenv)
- (values tn))
- (or (cdr (assoc thing (ir2-physenv-environment (physenv-info physenv))))
+ (or (cdr (assoc thing (ir2-physenv-closure (physenv-info physenv))))
(etypecase thing
(lambda-var
;; I think that a failure of this assertion means that we're
(declare (type ref node) (type ir2-block block))
(let* ((cont (node-cont node))
(leaf (ref-leaf node))
- (name (leaf-name leaf))
(locs (continuation-result-tns
cont (list (primitive-type (leaf-type leaf)))))
(res (first locs)))
(constant
(if (legal-immediate-constant-p leaf)
(emit-move node block (constant-tn leaf) res)
- (let ((name-tn (emit-constant name)))
+ (let* ((name (leaf-source-name leaf))
+ (name-tn (emit-constant name)))
(if (policy node (zerop safety))
(vop fast-symbol-value node block name-tn res)
(vop symbol-value node block name-tn res)))))
(functional
(ir2-convert-closure node block leaf res))
(global-var
- (let ((unsafe (policy node (zerop safety))))
+ (let ((unsafe (policy node (zerop safety)))
+ (name (leaf-source-name leaf)))
(ecase (global-var-kind leaf)
- ((:special :global :constant)
+ ((:special :global)
(aver (symbolp name))
(let ((name-tn (emit-constant name)))
(if unsafe
;;; This gets interesting when the referenced function is a closure:
;;; we must make the closure and move the closed over values into it.
;;;
-;;; LEAF is either a :TOP-LEVEL-XEP functional or the XEP lambda for
+;;; LEAF is either a :TOPLEVEL-XEP functional or the XEP lambda for
;;; the called function, since local call analysis converts all
;;; closure references. If a TL-XEP, we know it is not a closure.
;;;
;;; If a closed-over LAMBDA-VAR has no refs (is deleted), then we
;;; don't initialize that slot. This can happen with closures over
-;;; top-level variables, where optimization of the closure deleted the
+;;; top level variables, where optimization of the closure deleted the
;;; variable. Since we committed to the closure format when we
-;;; pre-analyzed the top-level code, we just leave an empty slot.
+;;; pre-analyzed the top level code, we just leave an empty slot.
(defun ir2-convert-closure (node block leaf res)
(declare (type ref node) (type ir2-block block)
(type functional leaf) (type tn res))
(clambda
(physenv-closure (get-lambda-physenv leaf)))
(functional
- (aver (eq (functional-kind leaf) :top-level-xep))
+ (aver (eq (functional-kind leaf) :toplevel-xep))
nil))))
(cond (closure
(let ((this-env (node-physenv node)))
(global-var
(ecase (global-var-kind leaf)
((:special :global)
- (aver (symbolp (leaf-name leaf)))
- (vop set node block (emit-constant (leaf-name leaf)) val)))))
+ (aver (symbolp (leaf-source-name leaf)))
+ (vop set node block (emit-constant (leaf-source-name leaf)) val)))))
(when locs
(emit-move node block val (first locs))
(move-continuation-result node block locs cont)))
dest))
(values))
-;;; If necessary, emit coercion code needed to deliver the Results to
+;;; If necessary, emit coercion code needed to deliver the RESULTS to
;;; the specified continuation. NODE and BLOCK provide context for
;;; emitting code. Although usually obtained from STANDARD-RESULT-TNs
;;; or CONTINUATION-RESULT-TNs, RESULTS my be a list of any type or
(locs loc))))
(when old-fp
- (dolist (thing (ir2-physenv-environment called-env))
+ (dolist (thing (ir2-physenv-closure called-env))
(temps (find-in-physenv (car thing) this-1env))
(locs (cdr thing)))
((node-tail-p node)
(ir2-convert-tail-local-call node block fun))
(t
- (let ((start (block-label (node-block (lambda-bind fun))))
+ (let ((start (block-label (lambda-block fun)))
(returns (tail-set-info (lambda-tail-set fun)))
(cont (node-cont node)))
(ecase (if returns
(declare (type bind node) (type ir2-block block) (type clambda fun))
(let ((start-label (entry-info-offset (leaf-info fun)))
(env (physenv-info (node-physenv node))))
- (let ((ef (functional-entry-function fun)))
+ (let ((ef (functional-entry-fun fun)))
(cond ((and (optional-dispatch-p ef) (optional-dispatch-more-entry ef))
;; Special case the xep-allocate-frame + copy-more-arg case.
(vop xep-allocate-frame node block start-label t)
(t
;; No more args, so normal entry.
(vop xep-allocate-frame node block start-label nil)))
- (if (ir2-physenv-environment env)
+ (if (ir2-physenv-closure env)
(let ((closure (make-normal-tn *backend-t-primitive-type*)))
(vop setup-closure-environment node block start-label closure)
(when (getf (functional-plist ef) :fin-function)
(vop funcallable-instance-lexenv node block closure closure))
(let ((n -1))
- (dolist (loc (ir2-physenv-environment env))
+ (dolist (loc (ir2-physenv-closure env))
(vop closure-ref node block closure (incf n) (cdr loc)))))
(vop setup-environment node block start-label)))
- (unless (eq (functional-kind fun) :top-level)
+ (unless (eq (functional-kind fun) :toplevel)
(let ((vars (lambda-vars fun))
(n 0))
(when (leaf-refs (first vars))
(let* ((fun (bind-lambda node))
(env (physenv-info (lambda-physenv fun))))
(aver (member (functional-kind fun)
- '(nil :external :optional :top-level :cleanup)))
+ '(nil :external :optional :toplevel :cleanup)))
(when (external-entry-point-p fun)
(init-xep-environment node block fun)
;;; stack. It returns the OLD-FP and RETURN-PC for the current
;;; function as multiple values.
(defoptimizer (sb!kernel:%caller-frame-and-pc ir2-convert) (() node block)
- (let ((env (physenv-info (node-physenv node))))
+ (let ((ir2-physenv (physenv-info (node-physenv node))))
(move-continuation-result node block
- (list (ir2-physenv-old-fp env)
- (ir2-physenv-return-pc env))
+ (list (ir2-physenv-old-fp ir2-physenv)
+ (ir2-physenv-return-pc ir2-physenv))
(node-cont node))))
\f
;;;; multiple values
;;; This is trivial, given our assumption of a shallow-binding
;;; implementation.
(defoptimizer (%special-bind ir2-convert) ((var value) node block)
- (let ((name (leaf-name (continuation-value var))))
+ (let ((name (leaf-source-name (continuation-value var))))
(vop bind node block (continuation-tn node block value)
(emit-constant name))))
(defoptimizer (%special-unbind ir2-convert) ((var) node block)
(ir2-continuation-locs (continuation-info (second args)))
nil))
(nil)))
-
(move-continuation-result node block () (node-cont node))
(values))
(eq (basic-combination-kind last) :full))
(let* ((fun (basic-combination-fun last))
(use (continuation-use fun))
- (name (and (ref-p use) (leaf-name (ref-leaf use)))))
+ (name (and (ref-p use)
+ (leaf-has-source-name-p (ref-leaf use))
+ (leaf-source-name (ref-leaf use)))))
(unless (or (node-tail-p last)
(info :function :info name)
(policy last (zerop safety)))
projects / sbcl.git / blobdiff