- test-ref () node t)))
-
-;;; Return a list of primitive-types that we can pass to
-;;; CONTINUATION-RESULT-TNS describing the result types we want for a
-;;; template call. We duplicate here the determination of output type
-;;; that was done in initially selecting the template, so we know that
-;;; the types we find are allowed by the template output type
-;;; restrictions.
-(defun find-template-result-types (call cont template rtypes)
- (declare (type combination call) (type continuation cont)
- (type template template) (list rtypes))
- (let* ((dtype (node-derived-type call))
- (type (if (and (or (eq (template-ltn-policy template) :safe)
- (policy call (= safety 0)))
- (continuation-type-check cont))
- (values-type-intersection
- dtype
- (continuation-asserted-type cont))
- dtype))
- (types (mapcar #'primitive-type
- (if (values-type-p type)
- (append (values-type-required type)
- (values-type-optional type))
- (list type)))))
- (let ((nvals (length rtypes))
- (ntypes (length types)))
- (cond ((< ntypes nvals)
- (append types
- (make-list (- nvals ntypes)
- :initial-element *backend-t-primitive-type*)))
- ((> ntypes nvals)
- (subseq types 0 nvals))
- (t
- types)))))
-
-;;; Return a list of TNs usable in a CALL to TEMPLATE delivering
-;;; values to CONT. As an efficiency hack, we pick off the common case
-;;; where the continuation is fixed values and has locations that
-;;; satisfy the result restrictions. This can fail when there is a
-;;; type check or a values count mismatch.
-(defun make-template-result-tns (call cont template rtypes)
- (declare (type combination call) (type continuation cont)
- (type template template) (list rtypes))
- (let ((2cont (continuation-info cont)))
- (if (and 2cont (eq (ir2-continuation-kind 2cont) :fixed))
- (let ((locs (ir2-continuation-locs 2cont)))
- (if (and (= (length rtypes) (length locs))
- (do ((loc locs (cdr loc))
- (rtype rtypes (cdr rtype)))
- ((null loc) t)
- (unless (operand-restriction-ok
- (car rtype)
- (tn-primitive-type (car loc))
- :t-ok nil)
- (return nil))))
- locs
- (continuation-result-tns
- cont
- (find-template-result-types call cont template rtypes))))
- (continuation-result-tns
- cont
- (find-template-result-types call cont template rtypes)))))
-
-;;; Get the operands into TNs, make TN-Refs for them, and then call
+ test-ref () node t)))
+
+;;; Return a list of primitive-types that we can pass to LVAR-RESULT-TNS
+;;; describing the result types we want for a template call. We are really
+;;; only interested in the number of results required: in normal case
+;;; TEMPLATE-RESULTS-OK has already checked them.
+(defun find-template-result-types (call rtypes)
+ (let* ((type (node-derived-type call))
+ (types
+ (mapcar #'primitive-type
+ (if (values-type-p type)
+ (append (args-type-required type)
+ (args-type-optional type))
+ (list type))))
+ (primitive-t *backend-t-primitive-type*))
+ (loop for rtype in rtypes
+ for type = (or (pop types) primitive-t)
+ collect type)))
+
+;;; Return a list of TNs usable in a CALL to TEMPLATE delivering values to
+;;; LVAR. As an efficiency hack, we pick off the common case where the LVAR is
+;;; fixed values and has locations that satisfy the result restrictions. This
+;;; can fail when there is a type check or a values count mismatch.
+(defun make-template-result-tns (call lvar rtypes)
+ (declare (type combination call) (type (or lvar null) lvar)
+ (list rtypes))
+ (let ((2lvar (when lvar (lvar-info lvar))))
+ (if (and 2lvar (eq (ir2-lvar-kind 2lvar) :fixed))
+ (let ((locs (ir2-lvar-locs 2lvar)))
+ (if (and (= (length rtypes) (length locs))
+ (do ((loc locs (cdr loc))
+ (rtypes rtypes (cdr rtypes)))
+ ((null loc) t)
+ (unless (operand-restriction-ok
+ (car rtypes)
+ (tn-primitive-type (car loc))
+ :t-ok nil)
+ (return nil))))
+ locs
+ (lvar-result-tns
+ lvar
+ (find-template-result-types call rtypes))))
+ (lvar-result-tns
+ lvar
+ (find-template-result-types call rtypes)))))
+
+;;; Get the operands into TNs, make TN-REFs for them, and then call