;;; an lvar.
;;;
;;; If the lvar isn't annotated (meaning the values are discarded) or
-;;; is unknown-values, the then we make temporaries for each supplied
+;;; is unknown-values, then we make temporaries for each supplied
;;; value, providing a place to compute the result in until we decide
;;; what to do with it (if anything.)
;;;
;;; Return a list of TNs wired to the standard value passing
;;; conventions that can be used to receive values according to the
-;;; unknown-values convention. This is used with together
+;;; unknown-values convention. This is used together with
;;; MOVE-LVAR-RESULT for delivering unknown values to a fixed values
;;; lvar.
;;;
;;; If necessary, emit coercion code needed to deliver the RESULTS to
;;; the specified lvar. NODE and BLOCK provide context for emitting
;;; code. Although usually obtained from STANDARD-RESULT-TNs or
-;;; LVAR-RESULT-TNs, RESULTS my be a list of any type or
+;;; LVAR-RESULT-TNs, RESULTS may be a list of any type or
;;; number of TNs.
;;;
;;; If the lvar is fixed values, then move the results into the lvar
(let ((lab (gen-label)))
(setf (ir2-physenv-environment-start env) lab)
- (vop note-environment-start node block lab)))
+ (vop note-environment-start node block lab)
+ #!+sb-safepoint
+ (unless (policy fun (>= inhibit-safepoints 2))
+ (vop sb!vm::insert-safepoint node block))))
(values))
\f
2block
#!+sb-dyncount *dynamic-counts-tn* #!-sb-dyncount nil
num))))
+ #!+sb-safepoint
+ (let ((first-node (block-start-node block)))
+ (unless (or (and (bind-p first-node)
+ (xep-p (bind-lambda first-node)))
+ (and (valued-node-p first-node)
+ (node-lvar first-node)
+ (eq (lvar-fun-name
+ (node-lvar first-node))
+ '%nlx-entry)))
+ (when (and (rest (block-pred block))
+ (block-loop block)
+ (member (loop-kind (block-loop block))
+ '(:natural :strange))
+ (eq block (loop-head (block-loop block)))
+ (policy first-node (< inhibit-safepoints 2)))
+ (vop sb!vm::insert-safepoint first-node 2block))))
(ir2-convert-block block)
(incf num))))))
(values))