X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fpack-iterative.lisp;fp=src%2Fcompiler%2Fpack-iterative.lisp;h=89bac87e7ac713419303a95620070228ea3690b5;hb=c295a1ec99a7316523e7674cec71da05da8fc072;hp=0000000000000000000000000000000000000000;hpb=3d544b84f2b7ecd617d220145a775079df6c7919;p=sbcl.git diff --git a/src/compiler/pack-iterative.lisp b/src/compiler/pack-iterative.lisp new file mode 100644 index 0000000..89bac87 --- /dev/null +++ b/src/compiler/pack-iterative.lisp @@ -0,0 +1,642 @@ +;;;; This file contains code for the iterative spilling/coloring +;;;; register allocator + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!REGALLOC") +;;;; Useful references to understand the algorithms and decisions made +;;;; in this allocator. +;;;; +;;;; For more background: +;;;; +;;;; Chaitin, Gregory J. "Register allocation & spilling via graph +;;;; coloring." ACM Sigplan Notices. Vol. 17. No. 6. ACM, 1982. +;;;; (http://web.eecs.umich.edu/~mahlke/courses/583f12/reading/chaitin82.pdf) +;;;; +;;;; Briggs, Preston. "Register allocation via graph coloring." +;;;; Diss. Rice University, 1992. +;;;; (http://www.cs.utexas.edu/~mckinley/380C/lecs/briggs-thesis-1992.pdf) +;;;; +;;;; Shorter or more directly applied articles: +;;;; +;;;; Briggs, Preston, Keith D. Cooper, and Linda Torczon. +;;;; "Improvements to graph coloring register allocation." ACM +;;;; Transactions on Programming Languages and Systems (TOPLAS) 16.3 +;;;; (1994): 428-455. +;;;; (http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.30.2616) +;;;; +;;;; Smith, Michael D., Norman Ramsey, and Glenn Holloway. "A +;;;; generalized algorithm for graph-coloring register allocation." +;;;; ACM SIGPLAN Notices. Vol. 39. No. 6. ACM, 2004. +;;;; (http://www.cs.tufts.edu/~nr/pubs/gcra-abstract.html) +;;;; +;;;; Cooper, Keith D., Anshuman Dasgupta, and Jason Eckhardt. +;;;; "Revisiting graph coloring register allocation: A study of the +;;;; Chaitin-Briggs and Callahan-Koblenz algorithms." Languages and +;;;; Compilers for Parallel Computing. Springer Berlin Heidelberg, +;;;; 2006. 1-16. +;;;; (http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.107.9598) + +;;; Interference graph data structure +(defstruct (ordered-set + (:include sset) + (:conc-name #:oset-)) + (members nil :type list)) + +(defun oset-adjoin (oset element) + (when (sset-adjoin element oset) + (push element (oset-members oset)) + t)) + +(defun oset-delete (oset element) + (when (sset-delete element oset) + (setf (oset-members oset) + (delete element (oset-members oset))) + t)) + +(defun oset-member (oset element) + (sset-member element oset)) + +(defmacro do-oset-elements ((variable oset &optional return) &body body) + `(dolist (,variable (oset-members ,oset) ,return) + ,@body)) + +;; vertex in an interference graph +(def!struct (vertex + (:include sset-element) + (:constructor make-vertex (tn pack-type))) + ;; incidence set, as an ordered list (for reproducibility) + (incidence (make-ordered-set) :type ordered-set) + ;; list of potential locations in the TN's preferred SB for the + ;; vertex, taking into account reserve locations and preallocated + ;; TNs. + (initial-domain nil :type list) + (initial-domain-size 0 :type index) + ;; TN this is a vertex for. + (tn nil :type tn) + ;; type of packing necessary. We should only have to determine + ;; colors for :normal TNs/vertices + (pack-type nil :type (member :normal :wired :restricted)) + ;; color = (cons offset sc) + (color nil :type (or cons null)) + ;; current status, removed from the interference graph or not (on + ;; stack or not) + (invisible nil :type t) + ;; (tn-spill-cost (vertex-tn vertex)) + (spill-cost 0 :type fixnum)) + +(declaim (inline vertex-sc)) +(defun vertex-sc (vertex) + (tn-sc (vertex-tn vertex))) + +;; interference graph +(def!struct (interference-graph + (:constructor %make-interference-graph) + (:conc-name #:ig-)) + ;; sorted set of yet-uncolored (and not necessarily spilled) + ;; vertices: vertices with lower spill cost come first. + (vertices nil :type list) + ;; unsorted set of precolored vertices. + (precolored-vertices nil :type list) + (tn-vertex (bug "missing arg") :type hash-table) + ;; A function that maps TNs to vertices, and then to the vertex's + ;; assigned offset, if any. The offset (or NIL) is returned first, + ;; then the vertex as a second value. + (tn-vertex-mapping (bug "missing arg") :type function)) + +;;; Interference graph construction +;;; +;;; First, compute conflict edges between vertices that aren't +;;; precolored: precolored vertices have already been handled via +;;; domain initialisation. +;;; +;;; This area is ripe for hard-to-explain bugs. If PACK-COLORED starts +;;; AVERing out, it may be useful to comment out most of +;;; INSERT-CONFLICT-EDGES and test for TNS-CONFLICT in a double loop +;;; over the concatenation of all three vertex lists. + +;; Adjoin symmetric edge (A,B) to both A and B. Unless +;; PERHAPS-REDUNDANT, aver that these edges are new. +(defun insert-one-edge (a b &optional perhaps-redundant) + (declare (type vertex a b)) + (aver (neq a b)) + ;; not even in the same storage base => no conflict; + ;; or one is pre-allocated => handled via domain. + (unless (or (neq (sc-sb (vertex-sc a)) (sc-sb (vertex-sc b))) + (tn-offset (vertex-tn a)) + (tn-offset (vertex-tn b))) + (aver (or (oset-adjoin (vertex-incidence a) b) + perhaps-redundant)) + (aver (or (oset-adjoin (vertex-incidence b) a) + perhaps-redundant)))) + +;; Partition the global TNs that appear in that IR2 block, between +;; those that are LIVE throughout the block and the rest. +(defun block-gtns (block tn-vertex) + (declare (type ir2-block block) + (type hash-table tn-vertex)) + (collect ((live-gtns) + (gtns)) + (do ((conflict (ir2-block-global-tns block) + (global-conflicts-next-blockwise + conflict))) + ((null conflict) + (values (live-gtns) (gtns))) + (let ((tn (global-conflicts-tn conflict))) + (awhen (and (not (tn-offset tn)) + (not (eql :component (tn-kind tn))) + (gethash tn tn-vertex)) + (if (eql (global-conflicts-kind conflict) :live) + (live-gtns it) + (gtns (cons it conflict)))))))) + +;; Scan CONFLICTS for conflicts with TNs that come after VERTEX in the +;; local TN order. Also, add edges with all LIVE-GTNs: they conflict +;; with everything but are absent from conflict bitvectors. +(defun insert-block-local-conflicts-for (vertex number conflicts + local-tns ltn-count + gtn-p live-gtns tn-vertex) + (declare (type vertex vertex) (type local-tn-number number) + (type local-tn-bit-vector conflicts) + (type local-tn-vector local-tns) (type local-tn-count ltn-count) + (type list live-gtns) (type hash-table tn-vertex)) + ;; conflict with all live gtns + (dolist (b live-gtns) + (insert-one-edge vertex b gtn-p)) + ;; and add conflicts if LTN number > number + (loop + with local = (tn-local (vertex-tn vertex)) + for j from (1+ number) below ltn-count + when (plusp (sbit conflicts j)) + do (let ((b (aref local-tns j))) + (when (tn-p b) + (aver (or gtn-p + (tn-global-conflicts b) + (eq local (tn-local b)))) + (awhen (gethash b tn-vertex) + (insert-one-edge vertex it (and gtn-p + (tn-global-conflicts b)))))))) + +;; Compute all conflicts in a single IR2 block +(defun insert-block-local-conflicts (block tn-vertex) + (declare (type ir2-block block) + (type hash-table tn-vertex)) + (let* ((local-tns (ir2-block-local-tns block)) + (n (ir2-block-local-tn-count block))) + (multiple-value-bind (live-gtns gtns) + (block-gtns block tn-vertex) + ;; all live gtns conflict with one another + (loop for (a . rest) on live-gtns do + (dolist (b rest) + (insert-one-edge a b t))) + ;; normal gtn-* edges + (loop for (a . conflict) in gtns do + (let ((number (global-conflicts-number conflict)) + (conflicts (global-conflicts-conflicts conflict))) + (insert-block-local-conflicts-for a number conflicts + local-tns n + t live-gtns tn-vertex))) + ;; local-* interference + (dotimes (i n) + (binding* ((a (aref local-tns i)) + (vertex (gethash a tn-vertex) :exit-if-null) + (conflicts (tn-local-conflicts a))) + (unless (or (tn-offset a) + (tn-global-conflicts a)) + (insert-block-local-conflicts-for vertex i conflicts + local-tns n + nil live-gtns tn-vertex))))))) + +;; Compute all conflict edges for component +;; COMPONENT-VERTICES is a list of vertices for :component TNs, +;; GLOBAL-VERTICES a list of vertices for TNs with global conflicts, +;; and LOCAL-VERTICES a list of vertices for local TNs. +;; +;; TN-VERTEX is a hash table from TN -> VERTEX, for all vertices that +;; must be colored. +(defun insert-conflict-edges (component + component-vertices global-vertices + local-vertices tn-vertex) + (declare (type list component-vertices global-vertices local-vertices) + (type hash-table tn-vertex)) + ;; COMPONENT vertices conflict with everything + (loop for (a . rest) on component-vertices + do (dolist (b rest) + (insert-one-edge a b)) + (dolist (b global-vertices) + (insert-one-edge a b)) + (dolist (b local-vertices) + (insert-one-edge a b))) + ;; Find the other edges by enumerating IR2 blocks + (do-ir2-blocks (block component) + (insert-block-local-conflicts block tn-vertex))) + +;;; Interference graph construction, the rest: annotating vertex +;;; structures, and bundling up the conflict graph. +;;; +;;; Also, permanently removing a vertex from a graph, without +;;; reconstructing it from scratch. + +;; Supposing that TN is restricted to its preferred SC, what locations +;; are available? +(defun restricted-tn-locations (tn) + (declare (type tn tn)) + (let* ((sc (tn-sc tn)) + (reserve (sc-reserve-locations sc))) + (loop + for loc in (sc-locations sc) + unless (or (and reserve (memq loc reserve)) ; common case: no reserve + (conflicts-in-sc tn sc loc)) + collect loc))) + +;; walk over vertices, precomputing as much information as possible, +;; and partitioning according to their kind. +;; Return the partition, and a hash table to map tns to vertices. +(defun prepare-vertices (vertices) + (let (component-vertices + global-vertices + local-vertices + (tn-vertex (make-hash-table))) + (loop for i upfrom 0 + for vertex in vertices + do (let* ((tn (vertex-tn vertex)) + (offset (tn-offset tn)) + (sc (tn-sc tn)) + (locs (if offset + (list offset) + (restricted-tn-locations tn)))) + (aver (not (unbounded-tn-p tn))) + (setf (vertex-number vertex) i + (vertex-incidence vertex) (make-ordered-set) + (vertex-initial-domain vertex) locs + (vertex-initial-domain-size vertex) (length locs) + (vertex-color vertex) (and offset + (cons offset sc)) + (vertex-invisible vertex) nil + (vertex-spill-cost vertex) (tn-cost tn) + (gethash tn tn-vertex) vertex) + (cond (offset) ; precolored -> no need to track conflict + ((eql :component (tn-kind tn)) + (push vertex component-vertices)) + ((tn-global-conflicts tn) + (push vertex global-vertices)) + (t + (aver (tn-local tn)) + (push vertex local-vertices))))) + (values component-vertices global-vertices local-vertices + tn-vertex))) + +;; Construct the interference graph for these vertices in the component. +;; All TNs types are included in the graph, both with offset and without, +;; but only those requiring coloring appear in the VERTICES slot. +(defun make-interference-graph (vertices component) + (multiple-value-bind (component-vertices global-vertices local-vertices + tn-vertex) + (prepare-vertices vertices) + (insert-conflict-edges component + component-vertices global-vertices local-vertices + tn-vertex) + ;; Normalize adjacency list ordering, and collect all uncolored + ;; vertices in the graph. + (collect ((colored) + (uncolored)) + (dolist (v vertices) + (let ((incidence (vertex-incidence v))) + (setf (oset-members incidence) + ;; this really doesn't matter, but minimises variability + (sort (oset-members incidence) #'< :key #'vertex-number))) + (cond ((vertex-color v) + (aver (tn-offset (vertex-tn v))) + (colored v)) + (t + (aver (not (tn-offset (vertex-tn v)))) + (uncolored v)))) + ;; Later passes like having this list sorted; do it in advance. + (%make-interference-graph + :vertices (stable-sort (uncolored) #'< :key #'vertex-spill-cost) + :precolored-vertices (colored) + :tn-vertex tn-vertex + :tn-vertex-mapping (lambda (tn) + (awhen (gethash tn tn-vertex) + (values (car (vertex-color it)) + it))))))) + +;; &key reset: whether coloring/invisibility information should be +;; removed from all the remaining vertices +(defun remove-vertex-from-interference-graph (vertex graph &key reset) + (declare (type vertex vertex) (type interference-graph graph)) + (let ((vertices (if reset + (loop for v in (ig-vertices graph) + unless (eql v vertex) + do (aver (not (tn-offset (vertex-tn v)))) + (setf (vertex-invisible v) nil + (vertex-color v) nil) + and collect v) + (remove vertex (ig-vertices graph))))) + (setf (ig-vertices graph) vertices) + (do-oset-elements (neighbor (vertex-incidence vertex) graph) + (oset-delete (vertex-incidence neighbor) vertex)))) + +;;; Support code + +;; Return non-nil if COLOR conflicts with any of NEIGHBOR-COLORS. +;; Take into account element sizes of the respective SCs. +(defun color-conflict-p (color neighbor-colors) + (declare (type (cons integer sc) color)) + (flet ((intervals-intersect-p (x x-width y y-width) + (when (< y x) + (rotatef x y) + (rotatef x-width y-width)) + ;; x <= y. [x, x+x-width] and [y, y+y-width) intersect iff + ;; y \in [x, x+x-width). + (< y (+ x x-width)))) + (destructuring-bind (offset . sc) color + (let ((element-size (sc-element-size sc))) + (loop for (neighbor-offset . neighbor-sc) in neighbor-colors + thereis (intervals-intersect-p + offset element-size + neighbor-offset (sc-element-size neighbor-sc))))))) + +;; Assumes that VERTEX pack-type is :WIRED. +(defun vertex-color-possible-p (vertex color) + (declare (type integer color) (type vertex vertex)) + (and (or (and (neq (vertex-pack-type vertex) :wired) + (not (tn-offset (vertex-tn vertex)))) + (= color (car (vertex-color vertex)))) + (memq color (vertex-initial-domain vertex)) + (not (color-conflict-p + (cons color (vertex-sc vertex)) + (collect ((colors)) + (do-oset-elements (neighbor (vertex-incidence vertex) + (colors)) + (unless (vertex-invisible neighbor) + (colors (vertex-color neighbor))))))))) + +;; Sorted list of all possible locations for vertex in its preferred +;; SC: more heavily loaded (i.e that should be tried first) locations +;; first. vertex-initial-domain is already sorted, only have to +;; remove offsets that aren't currently available. +(defun vertex-domain (vertex) + (declare (type vertex vertex)) + (remove-if-not (lambda (color) + (vertex-color-possible-p vertex color)) + (vertex-initial-domain vertex))) + +;; Return a list of vertices that we might want VERTEX to share its +;; location with. +(defun vertex-target-vertices (vertex tn-offset) + (declare (type vertex vertex) (type function tn-offset)) + (let ((sb (sc-sb (vertex-sc vertex))) + (neighbors (vertex-incidence vertex)) + vertices) + (do-target-tns (current (vertex-tn vertex) :limit 20) + (multiple-value-bind (offset target) + (funcall tn-offset current) + (when (and offset + (eq sb (sc-sb (tn-sc current))) + (not (oset-member neighbors target))) + (pushnew target vertices)))) + (nreverse vertices))) + +;; Choose the "best" color for these vertices: a color is good if as +;; many of these vertices simultaneously take that color, and those +;; that can't have a low spill cost. +(defun vertices-best-color (vertices colors) + (let ((best-color nil) + (best-compatible '()) + (best-cost nil)) + ;; TODO: sort vertices by spill cost, so that high-spill cost ones + ;; are more likely to be compatible? We're trying to find a + ;; maximal 1-colorable subgraph here, ie. a maximum independent + ;; set :\ Still, a heuristic like first attempting to pack in + ;; max-cost vertices may be useful + (dolist (color colors) + (let ((compatible '()) + (cost 0)) + (dolist (vertex vertices) + (when (and (notany (lambda (existing) + (oset-member (vertex-incidence existing) + vertex)) + compatible) + (vertex-color-possible-p vertex color)) + (incf cost (max 1 (vertex-spill-cost vertex))) + (push vertex compatible))) + (when (or (null best-cost) + (> cost best-cost)) + (setf best-color color + best-compatible compatible + best-cost cost)))) + (values best-color best-compatible))) + +;;; Coloring inner loop + +;; Greedily choose the color for this vertex, also moving around any +;; :target vertex to the same color if possible. +(defun find-vertex-color (vertex tn-vertex-mapping) + (awhen (vertex-domain vertex) + (let* ((targets (vertex-target-vertices vertex tn-vertex-mapping)) + (sc (vertex-sc vertex)) + (sb (sc-sb sc))) + (multiple-value-bind (color recolor-vertices) + (if targets + (vertices-best-color targets it) + (values (first it) nil)) + (aver color) + (dolist (target recolor-vertices) + (aver (car (vertex-color target))) + (unless (eql color (car (vertex-color target))) + (aver (eq sb (sc-sb (vertex-sc target)))) + (aver (not (tn-offset (vertex-tn target)))) + #+nil ; this check is slow + (aver (vertex-color-possible-p target color)) + (setf (car (vertex-color target)) color))) + (cons color sc))))) + +;; Partition vertices into those that are likely to be colored and +;; those that are likely to be spilled. Assumes that the interference +;; graph's vertices are sorted with the least spill cost first, so +;; that the stacks end up with the greatest spill cost vertices first. +(defun partition-and-order-vertices (interference-graph) + (flet ((domain-size (vertex) + (vertex-initial-domain-size vertex)) + (degree (vertex) + (count-if-not #'vertex-invisible + (oset-members (vertex-incidence vertex)))) + (eliminate-vertex (vertex) + (setf (vertex-invisible vertex) t))) + (let* ((precoloring-stack '()) + (prespilling-stack '()) + (vertices (ig-vertices interference-graph))) + ;; walk the vertices from least important to most important TN wrt + ;; spill cost. That way the TNs we really don't want to spill are + ;; at the head of the colouring lists. + (loop for vertex in vertices do + (aver (not (vertex-color vertex))) ; we already took those out above + (eliminate-vertex vertex) + ;; FIXME: some interference will be with vertices that don't + ;; take the same number of slots. Find a smarter heuristic. + (cond ((< (degree vertex) (domain-size vertex)) + (push vertex precoloring-stack)) + (t + (push vertex prespilling-stack)))) + (values precoloring-stack prespilling-stack)))) + +;; Try and color the interference graph once. +(defun color-interference-graph (interference-graph) + (let ((tn-vertex (ig-tn-vertex-mapping interference-graph))) + (flet ((color-vertices (vertices) + (dolist (vertex vertices) + (awhen (find-vertex-color vertex tn-vertex) + (setf (vertex-color vertex) it + (vertex-invisible vertex) nil))))) + (multiple-value-bind (probably-colored probably-spilled) + (partition-and-order-vertices interference-graph) + (color-vertices probably-colored) + ;; These might benefit from further ordering... LexBFS? + (color-vertices probably-spilled)))) + interference-graph) + +;;; Iterative spilling logic. + +;; maximum number of spill iterations +(defvar *pack-iterations* 500) + +;; Find the least-spill-cost neighbor in each color. +;; FIXME: this is too slow and isn't the right interface anymore. +;; The code might be fast enough if there were a simple way to detect +;; whether a given vertex is a min-candidate for another uncolored +;; vertex. +;; I'm leaving this around as an idea of what a smart spill choice +;; might be like. -- PK +#+nil +(defun collect-min-spill-candidates (vertex) + (let ((colors '())) + (do-oset-elements (neighbor (vertex-incidence vertex)) + (when (eql :normal (vertex-pack-type neighbor)) + (let* ((color (car (vertex-color neighbor))) + (cell (assoc color colors)) + (cost-neighbor (tn-spill-cost (vertex-tn neighbor)))) + (cond (cell + (when (< cost-neighbor (tn-spill-cost + (vertex-tn (cdr cell)))) + (setf (cdr cell) neighbor))) + (t (push (cons color neighbor) colors)))))) + (remove nil (mapcar #'cdr colors)))) + +;; Try to color the graph. If some TNs are left uncolored, find a +;; spill candidate, force it on the stack, and try again. +(defun iterate-color (vertices component + &optional (iterations *pack-iterations*)) + (let* ((spill-list '()) + ;; presorting edges helps; later sorts are stable, so this + ;; ends up sorting by (sum of) loop depth for TNs with equal + ;; costs. + (vertices (stable-sort (copy-list vertices) #'> + :key (lambda (vertex) + (tn-loop-depth + (vertex-tn vertex))))) + (nvertices (length vertices)) + (graph (make-interference-graph vertices component)) + to-spill) + (labels ((spill-candidates-p (vertex) + (unless (vertex-color vertex) + (aver (eql :normal (vertex-pack-type vertex))) + t)) + (iter (to-spill) + (when to-spill + (setf (vertex-invisible to-spill) t + (vertex-color to-spill) nil) + (push to-spill spill-list) + (setf graph (remove-vertex-from-interference-graph + to-spill graph :reset t))) + (color-interference-graph graph) + (find-if #'spill-candidates-p (ig-vertices graph)))) + (loop repeat iterations + while (setf to-spill (iter to-spill)))) + (let ((colored (ig-vertices graph))) + (aver (= nvertices (+ (length spill-list) (length colored) + (length (ig-precolored-vertices graph))))) + colored))) + +;;; Nice interface + +;; Just pack vertices that have been assigned a color. +(defun pack-colored (colored-vertices optimize) + (dolist (vertex colored-vertices) + (let* ((color (vertex-color vertex)) + (offset (car color)) + (tn (vertex-tn vertex))) + (cond ((tn-offset tn)) + (offset + (aver (not (conflicts-in-sc tn (tn-sc tn) offset))) + (setf (tn-offset tn) offset) + (pack-wired-tn (vertex-tn vertex) optimize)) + (t + ;; we better not have a :restricted TN not packed in its + ;; finite SC + (aver (neq (vertex-pack-type vertex) :restricted))))))) + +;; Pack pre-allocated TNs, collect vertices, and color. +(defun pack-iterative (component 2comp optimize) + (declare (type component component) (type ir2-component 2comp)) + (collect ((vertices)) + ;; Pack TNs that *must* be in a certain location, but still + ;; register them in the interference graph: it's useful to have + ;; them in the graph for targeting purposes. + (do ((tn (ir2-component-wired-tns 2comp) (tn-next tn))) + ((null tn)) + (pack-wired-tn tn optimize) + (unless (unbounded-tn-p tn) + (vertices (make-vertex tn :wired)))) + + ;; Preallocate vertices that *must* be in this finite SC. If + ;; targeting is improved, giving them a high priority in regular + ;; regalloc may be a better idea. + (collect ((component) + (normal)) + (do ((tn (ir2-component-restricted-tns 2comp) (tn-next tn))) + ((null tn)) + (unless (or (tn-offset tn) (unbounded-tn-p tn)) + (vertices (make-vertex tn :restricted)) + (if (eq :component (tn-kind tn)) + (component tn) + (normal tn)))) + ;; First, pack TNs that span the whole component to minimise + ;; fragmentation. Also, pack high cost TNs first, so they get + ;; nice targeting. + (flet ((pack-tns (tns) + (dolist (tn (stable-sort tns #'> :key #'tn-cost)) + (pack-tn tn t optimize)))) + (pack-tns (component)) + (pack-tns (normal)))) + + ;; Now that all pre-packed TNs are registered as vertices, work on + ;; the rest. Walk through all normal TNs, and determine whether + ;; we should try to put them in registers or stick them straight + ;; to the stack. + (do ((tn (ir2-component-normal-tns 2comp) (tn-next tn))) + ((null tn)) + ;; Only consider TNs that aren't forced on the stack and for + ;; which the spill cost is non-negative (i.e. not live across so + ;; many calls that it's simpler to just leave them on the stack) + (when (and (not (tn-offset tn)) + (neq (tn-kind tn) :more) + (not (unbounded-tn-p tn)) + (not (and (sc-save-p (tn-sc tn)) ; SC is caller-save, and + (minusp (tn-cost tn))))) ; TN lives in many calls + ;; otherwise, we'll let the final pass handle them. + (vertices (make-vertex tn :normal)))) + ;; Sum loop depths to guide the spilling logic + (assign-tn-depths component :reducer #'+) + ;; Iteratively find a coloring/spill partition, and allocate those + ;; for which we have a location + (pack-colored (iterate-color (vertices) component) + optimize)) + nil)