1 ;;;; This file contains the implementation-independent code for the
2 ;;;; representation selection phase in the compiler. Representation
3 ;;;; selection decides whether to use non-descriptor representations
4 ;;;; for objects and emits the appropriate representation-specific move
7 ;;;; This software is part of the SBCL system. See the README file for
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
20 ;;;; Problems in the VM definition often show up here, so we try to be
21 ;;;; as implementor-friendly as possible.
23 ;;; Given a TN ref for a VOP argument or result, return these values:
24 ;;; 1. True if the operand is an argument, false otherwise.
25 ;;; 2. The ordinal position of the operand.
26 ;;; 3. True if the operand is a more operand, false otherwise.
27 ;;; 4. The costs for this operand.
28 ;;; 5. The load-scs vector for this operand (NIL if more-p.)
29 ;;; 6. True if the costs or SCs in the VOP-INFO are inconsistent with
30 ;;; the currently recorded ones.
31 (defun get-operand-info (ref)
32 (declare (type tn-ref ref
))
33 (let* ((arg-p (not (tn-ref-write-p ref
)))
34 (vop (tn-ref-vop ref
))
35 (info (vop-info vop
)))
36 (flet ((frob (refs costs load more-cost
)
37 (do ((refs refs
(tn-ref-across refs
))
38 (costs costs
(cdr costs
))
39 (load load
(cdr load
))
45 (or (position-in #'tn-ref-across ref refs
)
46 (error "couldn't find REF?"))
53 (let ((parse (vop-parse-or-lose (vop-info-name info
))))
54 (multiple-value-bind (ccosts cscs
)
55 (compute-loading-costs
57 (vop-parse-args parse
)
58 (vop-parse-results parse
))
68 (not (and (equalp ccosts
(car costs
))
69 (equalp cscs
(car load
))))))))))))
71 (frob (vop-args vop
) (vop-info-arg-costs info
)
72 (vop-info-arg-load-scs info
)
73 (vop-info-more-arg-costs info
))
74 (frob (vop-results vop
) (vop-info-result-costs info
)
75 (vop-info-result-load-scs info
)
76 (vop-info-more-result-costs info
))))))
78 ;;; Convert a load-costs vector to the list of SCs allowed by the
79 ;;; operand restriction.
80 (defun listify-restrictions (restr)
81 (declare (type sc-vector restr
))
83 (dotimes (i sc-number-limit
)
84 (when (eq (svref restr i
) t
)
85 (res (svref *backend-sc-numbers
* i
))))
88 ;;; Try to give a helpful error message when REF has no cost specified
89 ;;; for some SC allowed by the TN's PRIMITIVE-TYPE.
90 (defun bad-costs-error (ref)
91 (declare (type tn-ref ref
))
92 (let* ((tn (tn-ref-tn ref
))
93 (ptype (tn-primitive-type tn
)))
94 (multiple-value-bind (arg-p pos more-p costs load-scs incon
)
95 (get-operand-info ref
)
97 (dolist (scn (primitive-type-scs ptype
))
98 (unless (svref costs scn
)
99 (losers (svref *backend-sc-numbers
* scn
))))
102 (error "Representation selection flamed out for no obvious reason.~@
103 Try again after recompiling the VM definition."))
105 (error "~S is not valid as the ~:R ~:[result~;argument~] to the~@
106 ~S VOP, since the TN's primitive type ~S allows SCs:~% ~S~@
107 ~:[which cannot be coerced or loaded into the allowed SCs:~
109 Current cost info inconsistent with that in effect at compile ~
110 time. Recompile.~%Compilation order may be incorrect.~]"
112 (template-name (vop-info (tn-ref-vop ref
)))
113 (primitive-type-name ptype
)
114 (mapcar #'sc-name
(losers))
117 (mapcar #'sc-name
(listify-restrictions load-scs
)))
120 ;;; Try to give a helpful error message when we fail to do a coercion
122 (defun bad-coerce-error (op)
123 (declare (type tn-ref op
))
124 (let* ((op-tn (tn-ref-tn op
))
125 (op-sc (tn-sc op-tn
))
126 (op-scn (sc-number op-sc
))
127 (ptype (tn-primitive-type op-tn
))
128 (write-p (tn-ref-write-p op
)))
129 (multiple-value-bind (arg-p pos more-p costs load-scs incon
)
130 (get-operand-info op
)
131 (declare (ignore costs more-p
))
132 (collect ((load-lose)
135 (dotimes (i sc-number-limit
)
136 (let ((i-sc (svref *backend-sc-numbers
* i
)))
137 (when (eq (svref load-scs i
) t
)
138 (cond ((not (sc-allowed-by-primitive-type i-sc ptype
))
140 ((not (find-move-vop op-tn write-p i-sc ptype
142 (let ((vops (if write-p
143 (svref (sc-move-vops op-sc
) i
)
144 (svref (sc-move-vops i-sc
) op-scn
))))
146 (dolist (vop vops
) (move-lose (template-name vop
)))
147 (no-move-scs i-sc
))))
149 (error "Representation selection flamed out for no ~
150 obvious reason."))))))
152 (unless (or (load-lose) (no-move-scs) (move-lose))
153 (error "Representation selection flamed out for no obvious reason.~@
154 Try again after recompiling the VM definition."))
156 (error "~S is not valid as the ~:R ~:[result~;argument~] to VOP:~
157 ~% ~S~%Primitive type: ~S~@
158 SC restrictions:~% ~S~@
159 ~@[The primitive type disallows these loadable SCs:~% ~S~%~]~
160 ~@[No move VOPs are defined to coerce to these allowed SCs:~
162 ~@[These move VOPs couldn't be used due to operand type ~
163 restrictions:~% ~S~%~]~
165 Current cost info inconsistent with that in effect at compile ~
166 time. Recompile.~%Compilation order may be incorrect.~]"
168 (template-name (vop-info (tn-ref-vop op
)))
169 (primitive-type-name ptype
)
170 (mapcar #'sc-name
(listify-restrictions load-scs
))
171 (mapcar #'sc-name
(load-lose))
172 (mapcar #'sc-name
(no-move-scs))
176 (defun bad-move-arg-error (val pass
)
177 (declare (type tn val pass
))
178 (error "no :MOVE-ARG VOP defined to move ~S (SC ~S) to ~
180 val
(sc-name (tn-sc val
))
181 pass
(sc-name (tn-sc pass
))))
183 ;;;; VM consistency checking
185 ;;;; We do some checking of the consistency of the VM definition at
188 ;;; FIXME: should probably be conditional on #!+SB-SHOW
189 (defun check-move-fun-consistency ()
190 (dotimes (i sc-number-limit
)
191 (let ((sc (svref *backend-sc-numbers
* i
)))
193 (let ((moves (sc-move-funs sc
)))
194 (dolist (const (sc-constant-scs sc
))
195 (unless (svref moves
(sc-number const
))
196 (warn "no move function defined to load SC ~S from constant ~
198 (sc-name sc
) (sc-name const
))))
200 (dolist (alt (sc-alternate-scs sc
))
201 (unless (svref moves
(sc-number alt
))
202 (warn "no move function defined to load SC ~S from alternate ~
204 (sc-name sc
) (sc-name alt
)))
205 (unless (svref (sc-move-funs alt
) i
)
206 (warn "no move function defined to save SC ~S to alternate ~
208 (sc-name sc
) (sc-name alt
)))))))))
210 ;;;; representation selection
212 ;;; VOPs that we ignore in initial cost computation. We ignore SET in
213 ;;; the hopes that nobody is setting specials inside of loops. We
214 ;;; ignore TYPE-CHECK-ERROR because we don't want the possibility of
215 ;;; error to bias the result. Notes are suppressed for T-C-E as well,
216 ;;; since we don't need to worry about the efficiency of that case.
217 (defparameter *ignore-cost-vops
* '(set type-check-error
))
218 (defparameter *suppress-note-vops
* '(type-check-error))
220 ;;; We special-case the move VOP, since using this costs for the
221 ;;; normal MOVE would spuriously encourage descriptor representations.
222 ;;; We won't actually need to coerce to descriptor and back, since we
223 ;;; will replace the MOVE with a specialized move VOP. What we do is
224 ;;; look at the other operand. If its representation has already been
225 ;;; chosen (e.g. if it is wired), then we use the appropriate move
226 ;;; costs, otherwise we just ignore the references.
227 (defun add-representation-costs (refs scs costs
228 ops-slot costs-slot more-costs-slot
230 (declare (type function ops-slot costs-slot more-costs-slot
))
231 (do ((ref refs
(tn-ref-next ref
)))
233 (flet ((add-costs (cost)
235 (let ((res (svref cost scn
)))
237 (bad-costs-error ref
))
238 (incf (svref costs scn
) res
)))))
239 (let* ((vop (tn-ref-vop ref
))
240 (info (vop-info vop
)))
241 (unless (find (vop-info-name info
) *ignore-cost-vops
*)
242 (case (vop-info-name info
)
248 (vop-results vop
))))))
252 (let ((res (svref (sc-move-costs
253 (svref *backend-sc-numbers
* scn
))
256 (incf (svref costs scn
) res
))))
258 (let ((res (svref (sc-move-costs rep
) scn
)))
260 (incf (svref costs scn
) res
))))))))
262 (do ((cost (funcall costs-slot info
) (cdr cost
))
263 (op (funcall ops-slot vop
) (tn-ref-across op
)))
265 (add-costs (funcall more-costs-slot info
)))
267 (add-costs (car cost
))
271 ;;; Return the best representation for a normal TN. SCs is a list
272 ;;; of the SC numbers of the SCs to select from. Costs is a scratch
275 ;;; What we do is sum the costs for each reference to TN in each of
276 ;;; the SCs, and then return the SC having the lowest cost. A second
277 ;;; value is returned which is true when the selection is unique which
278 ;;; is often not the case for the MOVE VOP.
279 (defun select-tn-representation (tn scs costs
)
280 (declare (type tn tn
) (type sc-vector costs
))
282 (setf (svref costs scn
) 0))
284 (add-representation-costs (tn-reads tn
) scs costs
285 #'vop-args
#'vop-info-arg-costs
286 #'vop-info-more-arg-costs
288 (add-representation-costs (tn-writes tn
) scs costs
289 #'vop-results
#'vop-info-result-costs
290 #'vop-info-more-result-costs
293 (let ((min most-positive-fixnum
)
297 (let ((cost (svref costs scn
)))
304 (values (svref *backend-sc-numbers
* min-scn
) unique
)))
306 ;;; Prepare for the possibility of a TN being allocated on the number
307 ;;; stack by setting NUMBER-STACK-P in all functions that TN is
308 ;;; referenced in and in all the functions in their tail sets. REFS is
309 ;;; a TN-REFS list of references to the TN.
310 (defun note-number-stack-tn (refs)
311 (declare (type (or tn-ref null
) refs
))
313 (do ((ref refs
(tn-ref-next ref
)))
315 (let* ((lambda (block-home-lambda
317 (vop-block (tn-ref-vop ref
)))))
318 (tails (lambda-tail-set lambda
)))
320 (setf (ir2-physenv-number-stack-p
322 (lambda-physenv fun
)))
326 (dolist (fun (tail-set-funs tails
))
331 ;;; If TN is a variable, return the name. If TN is used by a VOP
332 ;;; emitted for a return, then return a string indicating this.
333 ;;; Otherwise, return NIL.
334 (defun get-operand-name (tn arg-p
)
335 (declare (type tn tn
))
336 (let* ((actual (if (eq (tn-kind tn
) :alias
) (tn-save-tn tn
) tn
))
337 (reads (tn-reads tn
))
338 (leaf (tn-leaf actual
)))
339 (cond ((lambda-var-p leaf
) (leaf-source-name leaf
))
340 ((and (not arg-p
) reads
341 (return-p (vop-node (tn-ref-vop reads
))))
346 ;;; If policy indicates, give an efficiency note for doing the
347 ;;; coercion VOP, where OP is the operand we are coercing for and
348 ;;; DEST-TN is the distinct destination in a move.
349 (defun maybe-emit-coerce-efficiency-note (vop op dest-tn
)
350 (declare (type vop-info vop
) (type tn-ref op
) (type (or tn null
) dest-tn
))
351 (let* ((note (or (template-note vop
) (template-name vop
)))
352 (cost (template-cost vop
))
353 (op-vop (tn-ref-vop op
))
354 (op-node (vop-node op-vop
))
355 (op-tn (tn-ref-tn op
))
356 (*compiler-error-context
* op-node
))
357 (cond ((eq (tn-kind op-tn
) :constant
))
358 ((policy op-node
(and (<= speed inhibit-warnings
)
359 (<= space inhibit-warnings
))))
360 ((member (template-name (vop-info op-vop
)) *suppress-note-vops
*))
362 (let* ((op-info (vop-info op-vop
))
363 (op-note (or (template-note op-info
)
364 (template-name op-info
)))
365 (arg-p (not (tn-ref-write-p op
)))
366 (name (get-operand-name op-tn arg-p
))
367 (pos (1+ (or (position-in #'tn-ref-across op
370 (vop-results op-vop
)))
371 (error "couldn't find op? bug!")))))
373 "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
374 the ~:R ~:[result~;argument~] of ~A"
375 note cost name arg-p name
378 (compiler-notify "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]"
379 note cost
(get-operand-name op-tn t
)
380 (get-operand-name dest-tn nil
)))))
383 ;;; Find a move VOP to move from the operand OP-TN to some other
384 ;;; representation corresponding to OTHER-SC and OTHER-PTYPE. SLOT is
385 ;;; the SC slot that we grab from (move or move-arg). WRITE-P
386 ;;; indicates that OP is a VOP result, so OP is the move result and
387 ;;; other is the arg, otherwise OP is the arg and other is the result.
389 ;;; If an operand is of primitive type T, then we use the type of the
390 ;;; other operand instead, effectively intersecting the argument and
391 ;;; result type assertions. This way, a move VOP can restrict
392 ;;; whichever operand makes more sense, without worrying about which
393 ;;; operand has the type info.
394 (defun find-move-vop (op-tn write-p other-sc other-ptype slot
)
395 (declare (type tn op-tn
) (type sc other-sc
)
396 (type primitive-type other-ptype
)
397 (type function slot
))
398 (let* ((op-sc (tn-sc op-tn
))
399 (op-scn (sc-number op-sc
))
400 (other-scn (sc-number other-sc
))
401 (any-ptype *backend-t-primitive-type
*)
402 (op-ptype (tn-primitive-type op-tn
)))
403 (let ((other-ptype (if (eq other-ptype any-ptype
) op-ptype other-ptype
))
404 (op-ptype (if (eq op-ptype any-ptype
) other-ptype op-ptype
)))
405 (dolist (info (if write-p
406 (svref (funcall slot op-sc
) other-scn
)
407 (svref (funcall slot other-sc
) op-scn
))
409 (when (and (operand-restriction-ok
410 (first (template-arg-types info
))
411 (if write-p other-ptype op-ptype
)
413 (operand-restriction-ok
414 (first (template-result-types info
))
415 (if write-p op-ptype other-ptype
)
419 ;;; Emit a coercion VOP for OP BEFORE the specified VOP or die trying.
420 ;;; SCS is the operand's LOAD-SCS vector, which we use to determine
421 ;;; what SCs the VOP will accept. We pick any acceptable coerce VOP,
422 ;;; since it practice it seems uninteresting to have more than one
425 ;;; On the X86 port, stack SCs may be placed in the list of operand
426 ;;; preferred SCs, and to prevent these stack SCs being selected when
427 ;;; a register SC is available the non-stack SCs are searched first.
429 ;;; What we do is look at each SC allowed by both the operand
430 ;;; restriction and the operand primitive-type, and see whether there
431 ;;; is a move VOP which moves between the operand's SC and load SC. If
432 ;;; we find such a VOP, then we make a TN having the load SC as the
435 ;;; DEST-TN is the TN that we are moving to, for a move or move-arg.
436 ;;; This is only for efficiency notes.
438 ;;; If the TN is an unused result TN, then we don't actually emit the
439 ;;; move; we just change to the right kind of TN.
440 (defun emit-coerce-vop (op dest-tn scs before
)
441 (declare (type tn-ref op
) (type sc-vector scs
) (type (or vop null
) before
)
442 (type (or tn null
) dest-tn
))
443 (let* ((op-tn (tn-ref-tn op
))
444 (ptype (tn-primitive-type op-tn
))
445 (write-p (tn-ref-write-p op
))
446 (vop (tn-ref-vop op
))
447 (node (vop-node vop
))
448 (block (vop-block vop
)))
449 (flet ((check-sc (scn sc
)
450 (when (sc-allowed-by-primitive-type sc ptype
)
451 (let ((res (find-move-vop op-tn write-p sc ptype
454 (when (>= (vop-info-cost res
)
455 *efficiency-note-cost-threshold
*)
456 (maybe-emit-coerce-efficiency-note res op dest-tn
))
457 (let ((temp (make-representation-tn ptype scn
)))
458 (change-tn-ref-tn op temp
)
461 (emit-move-template node block res op-tn temp before
))
462 ((and (null (tn-reads op-tn
))
463 (eq (tn-kind op-tn
) :normal
)))
465 (emit-move-template node block res temp op-tn
468 ;; Search the non-stack load SCs first.
469 (dotimes (scn sc-number-limit
)
470 (let ((sc (svref *backend-sc-numbers
* scn
)))
471 (when (and (eq (svref scs scn
) t
)
472 (not (eq (sb-kind (sc-sb sc
)) :unbounded
))
474 (return-from emit-coerce-vop
))))
475 ;; Search the stack SCs if the above failed.
476 (dotimes (scn sc-number-limit
(bad-coerce-error op
))
477 (let ((sc (svref *backend-sc-numbers
* scn
)))
478 (when (and (eq (svref scs scn
) t
)
479 (eq (sb-kind (sc-sb sc
)) :unbounded
)
483 ;;; Scan some operands and call EMIT-COERCE-VOP on any for which we
484 ;;; can't load the operand. The coerce VOP is inserted Before the
485 ;;; specified VOP. Dest-TN is the destination TN if we are doing a
486 ;;; move or move-arg, and is NIL otherwise. This is only used for
487 ;;; efficiency notes.
488 #!-sb-fluid
(declaim (inline coerce-some-operands
))
489 (defun coerce-some-operands (ops dest-tn load-scs before
)
490 (declare (type (or tn-ref null
) ops
) (list load-scs
)
491 (type (or tn null
) dest-tn
) (type (or vop null
) before
))
492 (do ((op ops
(tn-ref-across op
))
493 (scs load-scs
(cdr scs
)))
495 (unless (svref (car scs
)
496 (sc-number (tn-sc (tn-ref-tn op
))))
497 (emit-coerce-vop op dest-tn
(car scs
) before
)))
500 ;;; Emit coerce VOPs for the args and results, as needed.
501 (defun coerce-vop-operands (vop)
502 (declare (type vop vop
))
503 (let ((info (vop-info vop
)))
504 (coerce-some-operands (vop-args vop
) nil
(vop-info-arg-load-scs info
) vop
)
505 (coerce-some-operands (vop-results vop
) nil
(vop-info-result-load-scs info
)
509 ;;; Iterate over the more operands to a call VOP, emitting move-arg
510 ;;; VOPs and any necessary coercions. We determine which FP to use by
511 ;;; looking at the MOVE-ARGS annotation. If the vop is a :LOCAL-CALL,
512 ;;; we insert any needed coercions before the ALLOCATE-FRAME so that
513 ;;; lifetime analysis doesn't get confused (since otherwise, only
514 ;;; passing locations are written between A-F and call.)
515 (defun emit-arg-moves (vop)
516 (let* ((info (vop-info vop
))
517 (node (vop-node vop
))
518 (block (vop-block vop
))
519 (how (vop-info-move-args info
))
520 (args (vop-args vop
))
521 (fp-tn (tn-ref-tn args
))
522 (nfp-tn (if (eq how
:local-call
)
523 (tn-ref-tn (tn-ref-across args
))
525 (pass-locs (first (vop-codegen-info vop
)))
526 (prev (vop-prev vop
)))
527 (do ((val (do ((arg args
(tn-ref-across arg
))
528 (req (template-arg-types info
) (cdr req
)))
531 (pass pass-locs
(cdr pass
)))
534 (let* ((val-tn (tn-ref-tn val
))
535 (pass-tn (first pass
))
536 (pass-sc (tn-sc pass-tn
))
537 (res (find-move-vop val-tn nil pass-sc
538 (tn-primitive-type pass-tn
)
539 #'sc-move-arg-vops
)))
541 (bad-move-arg-error val-tn pass-tn
))
543 (change-tn-ref-tn val pass-tn
)
545 (cond ((not (sc-number-stack-p pass-sc
)) fp-tn
)
548 (aver (eq how
:known-return
))
549 (setq nfp-tn
(make-number-stack-pointer-tn))
551 (svref *backend-sc-numbers
*
552 (first (primitive-type-scs
553 (tn-primitive-type nfp-tn
)))))
554 (emit-context-template
556 (template-or-lose 'compute-old-nfp
)
558 (aver (not (sc-number-stack-p (tn-sc nfp-tn
))))
560 (new (emit-move-arg-template node block res val-tn this-fp
563 (cond ((eq how
:local-call
)
564 (aver (eq (vop-info-name (vop-info prev
))
567 (prev (vop-next prev
))
569 (ir2-block-start-vop block
)))))
570 (coerce-some-operands (vop-args new
) pass-tn
571 (vop-info-arg-load-scs res
)
575 ;;; Scan the IR2 looking for move operations that need to be replaced
576 ;;; with special-case VOPs and emitting coercion VOPs for operands of
577 ;;; normal VOPs. We delete moves to TNs that are never read at this
578 ;;; point, rather than possibly converting them to some expensive move
580 (defun emit-moves-and-coercions (block)
581 (declare (type ir2-block block
))
582 (do ((vop (ir2-block-start-vop block
)
585 (let ((info (vop-info vop
))
586 (node (vop-node vop
))
587 (block (vop-block vop
)))
589 ((eq (vop-info-name info
) 'move
)
590 (let* ((args (vop-args vop
))
592 (y (tn-ref-tn (vop-results vop
)))
593 (res (find-move-vop x nil
(tn-sc y
) (tn-primitive-type y
)
595 (cond ((and (null (tn-reads y
))
596 (eq (tn-kind y
) :normal
))
600 (when (>= (vop-info-cost res
)
601 *efficiency-note-cost-threshold
*)
602 (maybe-emit-coerce-efficiency-note res args y
))
603 (emit-move-template node block res x y vop
)
606 (coerce-vop-operands vop
)))))
607 ((vop-info-move-args info
)
608 (emit-arg-moves vop
))
610 (coerce-vop-operands vop
))))))
612 ;;; If TN is in a number stack SC, make all the right annotations.
613 ;;; Note that this should be called after TN has been referenced,
614 ;;; since it must iterate over the referencing environments.
615 #!-sb-fluid
(declaim (inline note-if-number-stack
))
616 (defun note-if-number-stack (tn 2comp restricted
)
617 (declare (type tn tn
) (type ir2-component
2comp
))
619 (eq (sb-name (sc-sb (tn-sc tn
))) 'non-descriptor-stack
)
620 (sc-number-stack-p (tn-sc tn
)))
621 (unless (ir2-component-nfp 2comp
)
622 (setf (ir2-component-nfp 2comp
) (make-nfp-tn)))
623 (note-number-stack-tn (tn-reads tn
))
624 (note-number-stack-tn (tn-writes tn
)))
627 ;;; This is the entry to representation selection. First we select the
628 ;;; representation for all normal TNs, setting the TN-SC. After
629 ;;; selecting the TN representations, we set the SC for all :ALIAS TNs
630 ;;; to be the representation chosen for the original TN. We then scan
631 ;;; all the IR2, emitting any necessary coerce and move-arg VOPs.
632 ;;; Finally, we scan all TNs looking for ones that might be placed on
633 ;;; the number stack, noting this so that the number-FP can be
634 ;;; allocated. This must be done last, since references in new
635 ;;; environments may be introduced by MOVE-ARG insertion.
636 (defun select-representations (component)
637 (let ((costs (make-array sc-number-limit
))
638 (2comp (component-info component
)))
640 ;; First pass; only allocate SCs where there is a distinct choice.
641 (do ((tn (ir2-component-normal-tns 2comp
)
644 (aver (tn-primitive-type tn
))
646 (let* ((scs (primitive-type-scs (tn-primitive-type tn
))))
648 (multiple-value-bind (sc unique
)
649 (select-tn-representation tn scs costs
)
651 (setf (tn-sc tn
) sc
))))
654 (svref *backend-sc-numbers
* (first scs
))))))))
656 (do ((tn (ir2-component-normal-tns 2comp
)
659 (aver (tn-primitive-type tn
))
661 (let* ((scs (primitive-type-scs (tn-primitive-type tn
)))
663 (select-tn-representation tn scs costs
)
664 (svref *backend-sc-numbers
* (first scs
)))))
666 (setf (tn-sc tn
) sc
))))
668 (do ((alias (ir2-component-alias-tns 2comp
)
671 (setf (tn-sc alias
) (tn-sc (tn-save-tn alias
))))
673 (do-ir2-blocks (block component
)
674 (emit-moves-and-coercions block
))
676 (macrolet ((frob (slot restricted
)
677 `(do ((tn (,slot
2comp
) (tn-next tn
)))
679 (note-if-number-stack tn
2comp
,restricted
))))
680 (frob ir2-component-normal-tns nil
)
681 (frob ir2-component-wired-tns t
)
682 (frob ir2-component-restricted-tns t
)))