(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
(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
- (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)))))
;;; 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
;;; 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
(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))))
(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))))
(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)
(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)))
(t
;; No more args, so normal entry.
(vop xep-allocate-frame node block start-label nil)))
(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))
(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))
(vop closure-ref node block closure (incf n) (cdr loc)))))
(vop setup-environment node block start-label)))
(vop closure-ref node block closure (incf n) (cdr loc)))))
(vop setup-environment node block start-label)))
;;; 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)
;;; 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)
;;; This is trivial, given our assumption of a shallow-binding
;;; implementation.
(defoptimizer (%special-bind ir2-convert) ((var value) node block)
;;; This is trivial, given our assumption of a shallow-binding
;;; implementation.
(defoptimizer (%special-bind ir2-convert) ((var value) node block)
(vop bind node block (continuation-tn node block value)
(emit-constant name))))
(defoptimizer (%special-unbind ir2-convert) ((var) node block)
(vop bind node block (continuation-tn node block value)
(emit-constant name))))
(defoptimizer (%special-unbind ir2-convert) ((var) node block)
(eq (basic-combination-kind last) :full))
(let* ((fun (basic-combination-fun last))
(use (continuation-use fun))
(eq (basic-combination-kind last) :full))
(let* ((fun (basic-combination-fun last))
(use (continuation-use fun))
(unless (or (node-tail-p last)
(info :function :info name)
(policy last (zerop safety)))
(unless (or (node-tail-p last)
(info :function :info name)
(policy last (zerop safety)))