- (let* ((cookie (lexenv-cookie (node-lexenv node)))
- (safety (cookie-safety cookie))
- (space (max (cookie-space cookie)
- (cookie-cspeed cookie)))
- (speed (cookie-speed cookie)))
- (if (zerop safety)
- (if (>= speed space) :fast :small)
- (if (>= speed space) :fast-safe :safe))))
-
-;;; Return true if Policy is a safe policy.
-#!-sb-fluid (declaim (inline policy-safe-p))
-(defun policy-safe-p (policy)
- (declare (type policies policy))
- (or (eq policy :safe) (eq policy :fast-safe)))
-
-;;; Called when an unsafe policy indicates that no type check should be done
-;;; on CONT. We delete the type check unless it is :ERROR (indicating a
-;;; compile-time type error.)
-#!-sb-fluid (declaim (inline flush-type-check))
-(defun flush-type-check (cont)
- (declare (type continuation cont))
- (when (member (continuation-type-check cont) '(t :no-check))
- (setf (continuation-%type-check cont) :deleted))
- (values))
-
-;;; An annotated continuation's primitive-type.
-#!-sb-fluid (declaim (inline continuation-ptype))
-(defun continuation-ptype (cont)
- (declare (type continuation cont))
- (ir2-continuation-primitive-type (continuation-info cont)))
-
-;;; Return true if a constant Leaf is of a type which we can legally
-;;; directly reference in code. Named constants with arbitrary pointer values
-;;; cannot, since we must preserve EQLness.
-(defun legal-immediate-constant-p (leaf)
- (declare (type constant leaf))
- (or (null (leaf-name leaf))
- (typecase (constant-value leaf)
- ((or number character) t)
- (symbol (symbol-package (constant-value leaf)))
- (t nil))))
-
-;;; If Cont is used only by a Ref to a leaf that can be delayed, then return
-;;; the leaf, otherwise return NIL.
-(defun continuation-delayed-leaf (cont)
- (declare (type continuation cont))
- (let ((use (continuation-use cont)))
- (and (ref-p use)
- (let ((leaf (ref-leaf use)))
- (etypecase leaf
- (lambda-var (if (null (lambda-var-sets leaf)) leaf nil))
- (constant (if (legal-immediate-constant-p leaf) leaf nil))
- ((or functional global-var) nil))))))
-
-;;; Annotate a normal single-value continuation. If its only use is a ref
-;;; that we are allowed to delay the evaluation of, then we mark the
-;;; continuation for delayed evaluation, otherwise we assign a TN to hold the
-;;; continuation's value. If the continuation has a type check, we make the TN
-;;; according to the proven type to ensure that the possibly erroneous value
-;;; can be represented.
-(defun annotate-1-value-continuation (cont)
- (declare (type continuation cont))
- (let ((info (continuation-info cont)))
- (assert (eq (ir2-continuation-kind info) :fixed))
+ (policy node
+ (let ((eff-space (max space
+ ;; on the theory that if the code is
+ ;; smaller, it will take less time to
+ ;; compile (could lose if the smallest
+ ;; case is out of line, and must
+ ;; allocate many linkage registers):
+ compilation-speed)))
+ (if (zerop safety)
+ (if (>= speed eff-space) :fast :small)
+ (if (>= speed eff-space) :fast-safe :safe)))))
+
+;;; Return true if LTN-POLICY is a safe policy.
+(defun ltn-policy-safe-p (ltn-policy)
+ (ecase ltn-policy
+ ((:safe :fast-safe) t)
+ ((:small :fast) nil)))
+
+;;; an annotated lvar's primitive-type
+#!-sb-fluid (declaim (inline lvar-ptype))
+(defun lvar-ptype (lvar)
+ (declare (type lvar lvar))
+ (ir2-lvar-primitive-type (lvar-info lvar)))
+
+;;; If LVAR is used only by a REF to a leaf that can be delayed, then
+;;; return the leaf, otherwise return NIL.
+(defun lvar-delayed-leaf (lvar)
+ (declare (type lvar lvar))
+ (unless (lvar-dynamic-extent lvar)
+ (let ((use (lvar-uses lvar)))
+ (and (ref-p use)
+ (let ((leaf (ref-leaf use)))
+ (etypecase leaf
+ (lambda-var (if (null (lambda-var-sets leaf)) leaf nil))
+ (constant leaf)
+ ((or functional global-var) nil)))))))
+
+;;; Annotate a normal single-value lvar. If its only use is a ref that
+;;; we are allowed to delay the evaluation of, then we mark the lvar
+;;; for delayed evaluation, otherwise we assign a TN to hold the
+;;; lvar's value.
+(defun annotate-1-value-lvar (lvar)
+ (declare (type lvar lvar))
+ (let ((info (lvar-info lvar)))
+ (aver (eq (ir2-lvar-kind info) :fixed))