Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/ra/ra-core.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/ra/ra-core.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 475, Wed Nov 10 22:59:58 1999 UTC revision 498, Tue Dec 7 15:44:50 1999 UTC
# Line 69  Line 69 
69    
70    open G    open G
71    
72      val debug = false
73    (*  val tally = false *)
74    
75    
76    val verbose       = MLRiscControl.getFlag "ra-verbose"    val verbose       = MLRiscControl.getFlag "ra-verbose"
77    val ra_spill_coal = MLRiscControl.getCounter "ra-spill-coalescing"    val ra_spill_coal = MLRiscControl.getCounter "ra-spill-coalescing"
78    val ra_spill_prop = MLRiscControl.getCounter "ra-spill-propagation"    val ra_spill_prop = MLRiscControl.getCounter "ra-spill-propagation"
79    
80    (*
81      val good_briggs   = MLRiscControl.getCounter "good-briggs"
82      val bad_briggs    = MLRiscControl.getCounter "bad-briggs"
83      val good_george   = MLRiscControl.getCounter "good-george"
84      val bad_george    = MLRiscControl.getCounter "bad-george"
85      val good_freeze   = MLRiscControl.getCounter "good-freeze"
86      val bad_freeze    = MLRiscControl.getCounter "bad-freeze"
87     *)
88    
89      val NO_OPTIMIZATION  = 0w0
90      val BIASED_SELECTION = 0w1
91      val DEAD_COPY_ELIM   = 0w2
92      val COMPUTE_SPAN     = 0w4
93      val SAVE_COPY_TEMPS  = 0w8
94    
95      local
96    
97      fun isOn(flag,mask) = Word.andb(flag,mask) <> 0w0
98    
99    fun error msg = MLRiscErrorMsg.error("RACore", msg)    fun error msg = MLRiscErrorMsg.error("RACore", msg)
100    
101    (* No overflow checking necessary here *)    (* No overflow checking necessary here *)
# Line 82  Line 105 
105    fun concat([], b) = b    fun concat([], b) = b
106      | concat(x::a, b) = concat(a, x::b)      | concat(x::a, b) = concat(a, x::b)
107    
108      in
109    
110    (*    (*
111     * Bit Matrix routines     * Bit Matrix routines
112     *)     *)
113    structure BM =    structure BM =
114    struct    struct
115       fun hashFun(i, j, shift, size) =       fun hashFun(i, j, shift, size) =
116           W.toIntX(W.andb(W.+(W.<<(W.fromInt i, shift),       let val i    = W.fromInt i
117                    W.fromInt(i+j)), W.fromInt(size -1)))           val j    = W.fromInt j
118             val h    = W.+(W.<<(i, shift), W.+(i, j))
119             val mask = W.-(W.fromInt size, 0w1)
120         in  W.toIntX(W.andb(h, mask)) end
121    
122       val empty = BM{table=SMALL(ref(A.array(0, [])), 0w0), elems=ref 0, edges=0}       val empty = BM{table=SMALL(ref(A.array(0, [])), 0w0), elems=ref 0, edges=0}
123    
# Line 109  Line 137 
137       (*| edges(BM{table=BITMATRIX _, edges, ...}) = edges *)       (*| edges(BM{table=BITMATRIX _, edges, ...}) = edges *)
138    
139       fun member(BM{table=SMALL(table, shift), ...}) =       fun member(BM{table=SMALL(table, shift), ...}) =
140           (fn (NODE{number=i,...}, NODE{number=j,...}) =>           (fn (i, j) =>
141            let val (i,j) = if i < j then (i, j) else (j, i)            let val (i,j) = if i < j then (i, j) else (j, i)
142                val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)                val k = W.+(W.<<(W.fromInt i, 0w15), W.fromInt j)
143                fun find [] = false                fun find [] = false
# Line 118  Line 146 
146            in  find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end            in  find(UA.sub(tab, hashFun(i, j, shift, A.length tab))) end
147           )           )
148         | member(BM{table=LARGE(table, shift), ...}) =         | member(BM{table=LARGE(table, shift), ...}) =
149           (fn (NODE{number=i,...}, NODE{number=j,...}) =>           (fn (i, j) =>
150            let val (i,j) = if i < j then (i, j) else (j, i)            let val (i,j) = if i < j then (i, j) else (j, i)
151                fun find NIL = false                fun find NIL = false
152                  | find(B(i',j',b)) = i = i' andalso j = j' orelse find b                  | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
# Line 127  Line 155 
155           )           )
156       (*       (*
157         | member(BM{table=BITMATRIX table, ...}) =         | member(BM{table=BITMATRIX table, ...}) =
158           (fn (NODE{number=i,...}, NODE{number=j,...}) =>           (fn (i, j) =>
159            let val (i,j) = if i > j then (i, j) else (j, i)            let val (i,j) = if i > j then (i, j) else (j, i)
160                val bit   = W.fromInt(UA.sub(indices, i) + j)                val bit   = W.fromInt(UA.sub(indices, i) + j)
161                val index = W.toIntX(W.>>(bit, 0w3))                val index = W.toIntX(W.>>(bit, 0w3))
# Line 185  Line 213 
213                   val tab = !table                   val tab = !table
214                   val len = A.length tab                   val len = A.length tab
215               in  if !elems < len then               in  if !elems < len then
216                   let val index = hashFun(i, j, shift, len)                   let fun hashFun(i, j, shift, size) =
217                         let val i    = W.fromInt i
218                             val j    = W.fromInt j
219                             val h    = W.+(W.<<(i, shift), W.+(i, j))
220                             val mask = W.-(W.fromInt size, 0w1)
221                         in  W.toIntX(W.andb(h, mask)) end
222                         val index = hashFun(i, j, shift, len)
223                       fun find NIL = false                       fun find NIL = false
224                         | find(B(i',j',b)) = i = i' andalso j = j' orelse find b                         | find(B(i',j',b)) = i = i' andalso j = j' orelse find b
225                       val b = UA.sub(tab, index)                       val b = UA.sub(tab, index)
# Line 287  Line 321 
321      * with the invariant that the left branch is always the taller one      * with the invariant that the left branch is always the taller one
322      *)      *)
323     type elem = elem     type elem = elem
324     datatype pri_queue = TREE of elem * int * pri_queue * pri_queue     datatype pri_queue = TREE of elem * int * pri_queue * pri_queue | EMPTY
                       | EMPTY  
325    
326     fun merge'(EMPTY, EMPTY) = (EMPTY, 0)     fun merge'(EMPTY, EMPTY) = (EMPTY, 0)
327       | merge'(EMPTY, a as TREE(_, d, _, _)) = (a, d)       | merge'(EMPTY, a as TREE(_, d, _, _)) = (a, d)
# Line 297  Line 330 
330         let val (root, l, r1, r2) =         let val (root, l, r1, r2) =
331                 if less(x, y) then (x, l, r, b) else (y, l', r', a)                 if less(x, y) then (x, l, r, b) else (y, l', r', a)
332             val (r, d_r) = merge'(r1, r2)             val (r, d_r) = merge'(r1, r2)
333             val d_l      = case l of             val d_l = case l of EMPTY => 0 | TREE(_, d, _, _) => d
334                              EMPTY => 0             val (l, r, d_t) = if d_l >= d_r then (l, r, d_l+1) else (r, l, d_r+1)
                           | TREE(_, d, _, _) => d  
            val (l, r) = if d_l >= d_r then (l, r) else (r, l)  
            val d_t = 1+(if d_l > d_r then d_l else d_r)  
335         in  (TREE(root, d_t, l, r), d_t) end         in  (TREE(root, d_t, l, r), d_t) end
336    
337     fun merge(EMPTY, a) = a     fun merge(a, b) = #1(merge'(a, b))
      | merge(a, EMPTY) = a  
      | merge(a, b) = #1(merge'(a, b))  
338    
339     fun add (x, EMPTY) =  TREE(x, 1, EMPTY, EMPTY)     fun add (x, EMPTY) =  TREE(x, 1, EMPTY, EMPTY)
340       | add (x, b as TREE(y, d', l', r')) =       | add (x, b as TREE(y, d', l', r')) =
341         if less(x,y) then TREE(x, d'+1, b, EMPTY)         if less(x,y) then TREE(x, d'+1, b, EMPTY)
342         else #1(merge'(TREE(x, 1, EMPTY, EMPTY), b))         else #1(merge'(TREE(x, 1, EMPTY, EMPTY), b))
   
343    end    end
344    
345    structure FZ = PriQueue    structure FZ = PriQueue
# Line 323  Line 350 
350       (type elem=G.move       (type elem=G.move
351        fun less(MV{cost=p1,...}, MV{cost=p2,...}) = p1 > p2        fun less(MV{cost=p1,...}, MV{cost=p2,...}) = p1 > p2
352       )       )
353    
354    type move_queue = MV.pri_queue    type move_queue = MV.pri_queue
355    type freeze_queue = FZ.pri_queue    type freeze_queue = FZ.pri_queue
356    
# Line 333  Line 361 
361    fun chase(NODE{color=ref(ALIASED r), ...}) = chase r    fun chase(NODE{color=ref(ALIASED r), ...}) = chase r
362      | chase x = x      | chase x = x
363    
   fun nodeNumber(NODE{number,...}) = number  
   
   val debug = false  
   
364    fun colorOf(G.GRAPH{showReg,...}) (NODE{number, color, pri,...}) =    fun colorOf(G.GRAPH{showReg,...}) (NODE{number, color, pri,...}) =
365         showReg number^         showReg number^
366             (case !color of             (case !color of
# Line 344  Line 368 
368              | REMOVED   => "r"              | REMOVED   => "r"
369              | ALIASED _ => "a"              | ALIASED _ => "a"
370              | COLORED c => "["^showReg c^"]"              | COLORED c => "["^showReg c^"]"
371              | SPILLED _ => "s"              | SPILLED ~1 => "s"
372                | SPILLED c  => (if c >= 0 then "m" else "s")^
373                                (if c >= 0 andalso number = c then ""
374                                 else "{"^Int.toString c^"}")
375             )             )
376    
377    fun show G (node as NODE{pri,...}) =    fun show G (node as NODE{pri,...}) =
# Line 357  Line 384 
384    let fun pr s = TextIO.output(stream, s)    let fun pr s = TextIO.output(stream, s)
385        val show = show G        val show = show G
386        val colorOf = colorOf G        val colorOf = colorOf G
387        fun prMove(MV{src, dst, status=ref(WORKLIST | MOVE), cost,...}) =        fun prMove(MV{src, dst, status=ref(WORKLIST | BRIGGS_MOVE | GEORGE_MOVE),
388                        cost,...}) =
389              pr(colorOf(chase dst)^" <- "^colorOf(chase src)^              pr(colorOf(chase dst)^" <- "^colorOf(chase src)^
390                 "("^Int.toString(cost)^") ")                 "("^Int.toString(cost)^") ")
391          | prMove _ = ()          | prMove _ = ()
392    
393        fun prAdj(n, n' as NODE{color=ref(SPILLED _),...}) =        fun prAdj(n,n' as NODE{adj, degree, uses, defs,
394             pr(show n'^" spilled\n")                               color, pri, movecnt, movelist, ...}) =
         | prAdj(n, n' as NODE{adj, degree, color,  
                               (*pair,*) pri, movecnt, movelist, ...}) =  
395           (pr(show n');           (pr(show n');
           (* if pair then pr(" pair ") else (); *)  
396            if !verbose then pr(" deg="^Int.toString(!degree)) else ();            if !verbose then pr(" deg="^Int.toString(!degree)) else ();
397            pr(" <-->");             (case !color of
398            app (fn n => (pr " "; pr(show n))) (!adj);                ALIASED n => (pr " => "; pr(show n); pr "\n")
399            pr "\n";              | _ =>
400                  (pr(" <-->");
401                   app (fn n => (pr " "; pr(show n))) (!adj); pr "\n";
402            if !verbose andalso !movecnt > 0 then            if !verbose andalso !movecnt > 0 then
403              (pr("\tmoves "^Int.toString(!movecnt)^": ");              (pr("\tmoves "^Int.toString(!movecnt)^": ");
404               app prMove (!movelist);               app prMove (!movelist);
405               pr "\n"               pr "\n"
406              )              )
407            else ()                 else ();
408                   if n = 10 then
409                   (pr "defs="; app (fn p => pr(Int.toString p^" ")) (!defs);pr"\n";
410                    pr "uses="; app (fn p => pr(Int.toString p^" ")) (!uses);pr"\n"
411                   ) else ()
412                  )
413               )
414           )           )
415    
416    in  pr("=========== K="^Int.toString K^" ===========\n");    in  pr("=========== K="^Int.toString K^" ===========\n");
417        app prAdj (ListMergeSort.sort (fn ((x, _),(y, _)) => x > y)        app prAdj (ListMergeSort.sort (fn ((x, _),(y, _)) => x > y)
418                      (Intmap.intMapToList nodes))                      (Intmap.intMapToList nodes))
# Line 439  Line 473 
473     * Nop if the edge already exists.     * Nop if the edge already exists.
474     * Note: adjacency lists of colored nodes are not stored     * Note: adjacency lists of colored nodes are not stored
475     *       within the interference graph to save space.     *       within the interference graph to save space.
476       * Now we allow spilled node to be added to the edge; these do not
477       * count toward the degree.
478     *)     *)
479    fun addEdge(GRAPH{bitMatrix,...}) =    fun addEdge(GRAPH{bitMatrix,...}) =
480    let val addBitMatrix = BM.add(!bitMatrix)    let val addBitMatrix = BM.add(!bitMatrix)
481        fun add(NODE{color, adj, degree, (* pair=p1, *) number=n1, ...},    in  fn (x as NODE{number=xn, color=colx, adj=adjx, degree=degx, ...},
482                s as NODE{number=n2, (* pair=p2, *) ...}) =            y as NODE{number=yn, color=coly, adj=adjy, degree=degy, ...}) =>
           (case !color of  
              PSEUDO        => (adj := s :: !adj;  
                                (* check for pair <-> pair interference *)  
                                (* if p1 andalso p2 then degree := 2 + !degree  
                                else *) degree := 1 + !degree  
                               )  
            | COLORED _     => () (* not stored *)  
            | ALIASED _     => error "addEdge: ALIASED"  
            | REMOVED       => error "addEdge: REMOVED"  
            | SPILLED _     => error "addEdge: SPILLED"  
           )  
   in  fn (x as NODE{number=xn, ...}, y as NODE{number=yn, ...}) =>  
483            if xn = yn then ()            if xn = yn then ()
484            else if addBitMatrix(xn, yn) then            else if addBitMatrix(xn, yn) then
485                 (add(x, y); add(y, x))            (case (!colx, !coly) of
486            else ()              (PSEUDO,    PSEUDO)    => (adjx := y :: !adjx; degx := !degx + 1;
487                                           adjy := x :: !adjy; degy := !degy + 1)
488              | (PSEUDO,    COLORED _) => (adjx := y :: !adjx; degx := !degx + 1)
489              | (PSEUDO,    SPILLED _) => (adjx := y :: !adjx; adjy := x :: !adjy)
490              | (COLORED _, PSEUDO)    => (adjy := x :: !adjy; degy := !degy + 1)
491              | (COLORED _, COLORED _) => ()
492              | (COLORED _, SPILLED _) => ()
493              | (SPILLED _, PSEUDO)    => (adjx := y :: !adjx; adjy := x :: !adjy)
494              | (SPILLED _, COLORED _) => ()
495              | (SPILLED _, SPILLED _) => ()
496              | _ => error "addEdge"
497              )
498              else () (* edge already there *)
499    end    end
500    
501    (*    (*
# Line 494  Line 530 
530     * Initialize a list of worklists     * Initialize a list of worklists
531     *)     *)
532    fun initWorkLists    fun initWorkLists
533          (GRAPH{nodes, K, bitMatrix, regmap, firstPseudoR, deadCopies, ...})          (GRAPH{nodes, K, bitMatrix, regmap, pseudoCount, blockedCount,
534          {moves, deadCopyElim} =                 firstPseudoR, deadCopies, memMoves, mode, ...}) {moves} =
535    let (* Filter moves that already have an interference    let (* Filter moves that already have an interference
536         * Also initialize the movelist and movecnt fields at this time.         * Also initialize the movelist and movecnt fields at this time.
537         *)         *)
# Line 509  Line 545 
545             )             )
546          | setInfo _ = ()          | setInfo _ = ()
547    
548        fun filter([], mvs') = mvs'        fun filter([], mvs', mem) = (mvs', mem)
549          | filter(MV{src=NODE{color=ref(COLORED _),...},          | filter((mv as MV{src as NODE{number=x, color=ref colSrc,...},
550                      dst=NODE{color=ref(COLORED _),...},...}::mvs, mvs') =                             dst as NODE{number=y, color=ref colDst,...},
551              filter(mvs, mvs')                             cost, ...})::mvs,
552          | filter((mv as MV{src, dst, cost,...})::mvs, mvs') =                   mvs', mem) =
553              if member(src, dst)     (* moves that interfere *)            (case (colSrc, colDst) of
554              then filter(mvs, mvs')              (COLORED _, COLORED _) => filter(mvs, mvs', mem)
555              | (SPILLED _, SPILLED _) => filter(mvs, mvs', mem)
556              | (SPILLED _, _)         => filter(mvs, mvs', mv::mem)
557              | (_, SPILLED _)         => filter(mvs, mvs', mv::mem)
558              | _ =>
559                if member(x, y)     (* moves that interfere *)
560                then filter(mvs, mvs', mem)
561              else (setInfo(src, mv, cost);              else (setInfo(src, mv, cost);
562                    setInfo(dst, mv, cost);                    setInfo(dst, mv, cost);
563                    filter(mvs, MV.add(mv, mvs'))                    filter(mvs, MV.add(mv, mvs'), mem)
564                     )
565                   )                   )
566    
567        fun decDegree [] = ()        fun filter'([], mvs', mem, dead) = (mvs', mem, dead)
568            | filter'((mv as
569                      MV{src as NODE{number=x, color as ref colSrc,
570                                     pri, adj, uses,...},
571                         dst as NODE{number=y, color=ref colDst,
572                                     defs=dstDefs, uses=dstUses,...},
573                         cost, ...})::mvs,
574                     mvs', mem, dead) =
575              (case (colSrc, colDst, dstDefs, dstUses) of
576                (COLORED _, COLORED _, _, _) => filter'(mvs, mvs', mem, dead)
577              | (SPILLED _, SPILLED _, _, _) => filter'(mvs, mvs', mem, dead)
578              | (SPILLED _, _, _, _)         => filter'(mvs, mvs', mv::mem, dead)
579              | (_, SPILLED _, _, _)         => filter'(mvs, mvs', mv::mem, dead)
580              | (_, PSEUDO, ref [pt], ref []) =>
581                (* eliminate dead copy *)
582                let fun decDegree [] = ()
583          | decDegree(NODE{color=ref PSEUDO, degree, ...}::adj) =          | decDegree(NODE{color=ref PSEUDO, degree, ...}::adj) =
584              (degree := !degree - 1; decDegree adj)              (degree := !degree - 1; decDegree adj)
585          | decDegree(_::adj) = decDegree adj          | decDegree(_::adj) = decDegree adj
   
586        fun elimUses([], _, uses, pri, cost) = (uses, pri)        fun elimUses([], _, uses, pri, cost) = (uses, pri)
587          | elimUses(pt::pts, pt' : int, uses, pri, cost) =          | elimUses(pt::pts, pt' : int, uses, pri, cost) =
588            if pt = pt' then elimUses(pts, pt', uses, pri-cost, cost)            if pt = pt' then elimUses(pts, pt', uses, pri-cost, cost)
589            else elimUses(pts, pt', pt::uses, pri, cost)            else elimUses(pts, pt', pt::uses, pri, cost)
590                    val (uses', pri') = elimUses(!uses, pt, [], !pri, cost);
       fun filter'([], mvs', dead) = (mvs', dead)  
         | filter'(MV{src=NODE{color=ref(COLORED _),...},  
                      dst=NODE{color=ref(COLORED _),...},...}::mvs, mvs', dead) =  
             filter'(mvs, mvs', dead)  
         | filter'(MV{dst as NODE{number=r, color as ref PSEUDO, defs=ref [pt],  
                               uses=ref [], adj, ...},  
                      src as NODE{uses, pri, ...}, cost, ...}::mvs,  
                   mvs', dead) =  
             (* eliminate dead copy *)  
             let val (uses', pri') = elimUses(!uses, pt, [], !pri, cost);  
591              in  pri := pri';              in  pri := pri';
592                  uses := uses';                  uses := uses';
593                  color := ALIASED src;                  color := ALIASED src;
594                  decDegree(!adj);                  decDegree(!adj);
595                  filter'(mvs, mvs', r::dead)                  filter'(mvs, mvs', mem, y::dead)
596              end              end
597          | filter'((mv as MV{src, dst, cost,...})::mvs, mvs', dead) =            | _ =>  (* normal moves *)
598              if member(src, dst)     (* moves that interfere *)              if member(x, y)     (* moves that interfere *)
599              then filter'(mvs, mvs', dead)              then filter'(mvs, mvs', mem, dead)
600              else (setInfo(src, mv, cost);              else (setInfo(src, mv, cost);
601                    setInfo(dst, mv, cost);                    setInfo(dst, mv, cost);
602                    filter'(mvs, MV.add(mv, mvs'), dead)                    filter'(mvs, MV.add(mv, mvs'), mem, dead)
603                     )
604                   )                   )
   
605    
606        (*        (*
607         * Scan all nodes in the graph and check which worklist they should         * Scan all nodes in the graph and check which worklist they should
608         * go into.         * go into.
609         *)         *)
610        fun collect([], simp, fz, moves, spill) =        fun collect([], simp, fz, moves, spill, pseudos, blocked) =
611             (pseudoCount := pseudos;
612              blockedCount := blocked;
613            {simplifyWkl = simp,            {simplifyWkl = simp,
614             moveWkl     = moves,             moveWkl     = moves,
615             freezeWkl   = fz,             freezeWkl   = fz,
616             spillWkl    = spill             spillWkl    = spill
617            }            }
618          | collect(node::rest, simp, fz, moves, spill) =           )
619            | collect(node::rest, simp, fz, moves, spill, pseudos, blocked) =
620            (case node of            (case node of
621                NODE{color=ref PSEUDO, movecnt, degree, ...} =>                NODE{color=ref PSEUDO, movecnt, degree, ...} =>
622                   if !degree >= K then                   if !degree >= K then
623                      collect(rest, simp, fz, moves, node::spill)                      collect(rest, simp, fz, moves, node::spill,
624                                pseudos+1, blocked)
625                   else if !movecnt > 0 then                   else if !movecnt > 0 then
626                      collect(rest, simp, FZ.add(node, fz), moves, spill)                      collect(rest, simp, FZ.add(node, fz),
627                                moves, spill, pseudos+1, blocked+1)
628                   else                   else
629                      collect(rest, node::simp, fz, moves, spill)                      collect(rest, node::simp, fz, moves, spill,
630             |  _ => collect(rest, simp, fz, moves, spill)                              pseudos+1, blocked)
631               |  _ => collect(rest, simp, fz, moves, spill, pseudos, blocked)
632            )            )
633    
634        (* First build the move priqueue *)        (* First build the move priqueue *)
635        val mvs = if deadCopyElim then        val (mvs, mem) =
636                  let val (mvs, dead) = filter'(moves, MV.EMPTY, [])                  if isOn(mode, DEAD_COPY_ELIM) then
637                  in  deadCopies := dead; mvs                  let val (mvs, mem, dead) = filter'(moves, MV.EMPTY, [], [])
638                    in  deadCopies := dead; (mvs, mem)
639                  end                  end
640                  else filter(moves, MV.EMPTY)                  else filter(moves, MV.EMPTY, [])
641    
642        (* if copy propagation was done prior to register allocation        (* if copy propagation was done prior to register allocation
643         * then some nodes may already be aliased.  This function updates the         * then some nodes may already be aliased.  This function updates the
# Line 601  Line 655 
655        in  Intmap.app fixup nodes end        in  Intmap.app fixup nodes end
656    
657    in  (* updateAliases(); *)    in  (* updateAliases(); *)
658        collect(Intmap.values nodes, [], FZ.EMPTY, mvs, [])        memMoves := mem;  (* memory moves *)
659          collect(Intmap.values nodes, [], FZ.EMPTY, mvs, [], 0, 0)
660    end    end
661    
662    (*    (*
# Line 612  Line 667 
667    let val getnode = Intmap.map nodes    let val getnode = Intmap.map nodes
668        fun num(NODE{color=ref(COLORED r),...}) = r        fun num(NODE{color=ref(COLORED r),...}) = r
669          | num(NODE{color=ref(ALIASED n),...}) = num n          | num(NODE{color=ref(ALIASED n),...}) = num n
670          | num(NODE{color=ref(SPILLED s),number,...}) = ~1          | num(NODE{color=ref(SPILLED s),...}) = if s >= 0 then s else ~1
671          | num(NODE{number, color=ref PSEUDO,...}) = number          | num(NODE{number, color=ref PSEUDO,...}) = number
672          | num _ = error "regmap"          | num _ = error "regmap"
673        fun lookup r = num(getnode r) handle _ => r (* XXX *)        fun lookup r = num(getnode r) handle _ => r (* XXX *)
# Line 659  Line 714 
714     *  2.  The freeze list may have duplicates     *  2.  The freeze list may have duplicates
715     *)     *)
716    fun iteratedCoalescingPhases    fun iteratedCoalescingPhases
717         (G as GRAPH{K, bitMatrix, spillFlag, trail, stamp, ...}) =         (G as GRAPH{K, bitMatrix, spillFlag, trail, stamp,
718                       pseudoCount, blockedCount, ...}) =
719    let val member = BM.member(!bitMatrix)    let val member = BM.member(!bitMatrix)
720        val addEdge = addEdge G        val addEdge = addEdge G
721        val show = show G        val show = show G
722          val blocked = blockedCount
723    
724        (*        (*
725         * SIMPLIFY node:         * SIMPLIFY node:
726         *   precondition: node must be part of the interference graph (PSEUDO)         *   precondition: node must be part of the interference graph (PSEUDO)
727         *)         *)
728        fun simplify(node as NODE{color, number, adj, (* pair, *)...},        fun simplify(node as NODE{color, number, adj, degree, (*pair,*)...},
729                                  mv, fz, stack) =                                  mv, fz, stack) =
730        let val _ = if debug then print("Simplifying "^show node^"\n") else ()        let val _ = if debug then print("Simplifying "^show node^"\n") else ()
731            fun forallAdj([], mv, fz, stack) = (mv, fz, stack)            fun forallAdj([], mv, fz, stack) = (mv, fz, stack)
732              | forallAdj(n::adj, mv, fz, stack) =              | forallAdj((n as NODE{color=ref PSEUDO, degree as ref d,...})::adj,
733                (case n of                          mv, fz, stack) =
734                  NODE{(* pair=p2, *) color=ref PSEUDO,...} =>                if d = K then
735                    let val (mv, fz, stack) =                let val (mv, fz, stack) = lowDegree(n, mv, fz, stack)
                          decDegree(n, (* pair andalso p2, *) mv, fz, stack)  
736                    in  forallAdj(adj, mv, fz, stack) end                    in  forallAdj(adj, mv, fz, stack) end
737                | _ => forallAdj(adj, mv, fz, stack)                else (degree := d - 1; forallAdj(adj, mv, fz, stack))
738                )              | forallAdj(_::adj, mv, fz, stack) = forallAdj(adj, mv, fz, stack)
739        in  color := REMOVED;        in  color := REMOVED;
740              pseudoCount := !pseudoCount - 1;
741            forallAdj(!adj, mv, fz, node::stack) (* push onto stack *)            forallAdj(!adj, mv, fz, node::stack) (* push onto stack *)
742        end (* simplify *)        end (* simplify *)
743    
744          and simplifyAll([], mv, fz, stack) = (mv, fz, stack)
745            | simplifyAll(node::simp, mv, fz, stack) =
746              let val (mv, fz, stack) = simplify(node, mv, fz, stack)
747              in  simplifyAll(simp, mv, fz, stack) end
748    
749        (*        (*
750         * Decrement the degree of a pseudo node.         * Decrement the degree of a pseudo node.
751         *   precondition: node must be part of the interference graph         *   precondition: node must be part of the interference graph
# Line 696  Line 758 
758         *   fz    -- queue of freeze candidates         *   fz    -- queue of freeze candidates
759         *   stack -- stack of removed nodes         *   stack -- stack of removed nodes
760         *)         *)
761        and decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},        and lowDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
762                      (* false, *) mv, fz, stack) = (* normal edge *)                      (* false, *) mv, fz, stack) =
763               (* normal edge *)
764            (if debug then            (if debug then
765             print("DecDegree "^show node^" d="^Int.toString(d-1)^"\n") else ();             print("DecDegree "^show node^" d="^Int.toString(d-1)^"\n") else ();
766             degree := d - 1;             degree := K - 1;
            if d = K then  
767               (* node is now low degree!!! *)               (* node is now low degree!!! *)
768               let val mv = enableMoves(node :: !adj, mv)             let val mv = enableMoves(!adj, mv)
769               in  if !movecnt > 0 then (* move related *)               in  if !movecnt > 0 then (* move related *)
770                      (mv, FZ.add(node, fz), stack)                    (blocked := !blocked + 1; (mv, FZ.add(node, fz), stack))
771                   else (* non-move related, simplify now! *)                   else (* non-move related, simplify now! *)
772                      simplify(node, mv, fz, stack)                      simplify(node, mv, fz, stack)
773               end               end
            else  
              (mv, fz, stack)  
774            )            )
775         (*         (*
776          | decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},          | decDegree(node as NODE{degree as ref d, movecnt, adj, color,...},
# Line 720  Line 780 
780               (* node is now low degree!!! *)               (* node is now low degree!!! *)
781               let val mv = enableMoves(node :: !adj, mv)               let val mv = enableMoves(node :: !adj, mv)
782               in  if !movecnt > 0 then (* move related *)               in  if !movecnt > 0 then (* move related *)
783                      (mv, FZ.add(node, fz), stack)                      (blocked := !blocked + 1; (mv, FZ.add(node, fz), stack))
784                   else (* non-move related, simplify now! *)                   else (* non-move related, simplify now! *)
785                      simplify(node, mv, fz, stack)                      simplify(node, mv, fz, stack)
786               end               end
# Line 740  Line 800 
800            let (* add valid moves onto the worklist.            let (* add valid moves onto the worklist.
801                 * there are no duplicates on the move worklist!                 * there are no duplicates on the move worklist!
802                 *)                 *)
803                fun addMv([], mv) = mv                fun addMv([], ns, mv) = enableMoves(ns, mv)
804                  | addMv((m as MV{status,dst,src,...})::rest, mv) =                  | addMv((m as MV{status, hicount as ref hi, ...})::rest,
805                            ns, mv) =
806                    (case !status of                    (case !status of
807                       MOVE => (status := WORKLIST;                       (BRIGGS_MOVE | GEORGE_MOVE) =>
808                                addMv(rest, MV.add(m, mv)))                         (* decrements hi, when hi <= 0 enable move *)
809                     | _    => addMv(rest, mv)                         if hi <= 1 then
810                             (status := WORKLIST; addMv(rest, ns, MV.add(m, mv)))
811                           else
812                             (hicount := hi-1; addMv(rest, ns, mv))
813                       | _    => addMv(rest, ns, mv)
814                    )                    )
815            in  (* make sure the nodes are actually in the graph *)            in  (* make sure the nodes are actually in the graph *)
816                case n of                case n of
817                  NODE{movelist, color=ref PSEUDO, movecnt,...} =>                  NODE{movelist, color=ref PSEUDO, movecnt,...} =>
818                    if !movecnt > 0 then (* is it move related? *)                    if !movecnt > 0 then (* is it move related? *)
819                       enableMoves(ns, addMv(!movelist, mv))                       addMv(!movelist, ns, mv)
820                    else                    else
821                       enableMoves(ns, mv)                       enableMoves(ns, mv)
822                | _ => enableMoves(ns, mv)                | _ => enableMoves(ns, mv)
823            end (* enableMoves *)            end (* enableMoves *)
824    
825       (*       (*
       * Simplify a list of nodes  
       *)  
      fun simplifyAll([], mv, fz, stack) = (mv, fz, stack)  
        | simplifyAll(n::ns, mv, fz, stack) =  
          let val (mv, fz, stack) = simplify(n, mv, fz, stack)  
          in  simplifyAll(ns, mv, fz, stack) end  
   
      (*  
826        *  Brigg's conservative coalescing test:        *  Brigg's conservative coalescing test:
827        *    given: an unconstrained move (x, y)        *    given: an unconstrained move (x, y)
828        *    return: true or false        *    return: true or false
829        *)        *)
830       fun conservative(x as NODE{degree=ref dx, adj=xadj, (* pair=px, *) ...},       fun conservative(hicount,
831                          x as NODE{degree=ref dx, adj=xadj, (* pair=px, *) ...},
832                        y as NODE{degree=ref dy, adj=yadj, (* pair=py, *) ...}) =                        y as NODE{degree=ref dy, adj=yadj, (* pair=py, *) ...}) =
833           dx + dy < K orelse           dx + dy < K orelse
834           let (*           let (*
835                *  K-k -- is the number of nodes with deg > K                *  hi -- is the number of nodes with deg > K (without duplicates)
836                *  n -- the number of nodes that have deg = K but not                *  n -- the number of nodes that have deg = K but not neighbors
837                *       neighbors of both x and y.                *         of both x and y
838                *  We use the movecnt as a flag indicating whether                *  We use the movecnt as a flag indicating whether
839                *  a node has been visited.  A negative count is used to mark                *  a node has been visited.  A negative count is used to mark
840                *  a visited node.                *  a visited node.
841                *)                *)
842               fun undo([], v) = v               fun undo([], extraHi) =
843                 | undo(movecnt::tr, v) = (movecnt := ~1 - !movecnt; undo(tr, v))                   extraHi <= 0 orelse (hicount := extraHi; false)
844               fun loop([], [], 0, _, tr) = undo(tr, false)                 | undo(movecnt::tr, extraHi) =
845                 | loop([], [], k, n, tr) = undo(tr, k > n)                     (movecnt := ~1 - !movecnt; undo(tr, extraHi))
846                 | loop([], yadj, k, n, tr) = loop(yadj, [], k, n, tr)               fun loop([], [], hi, n, tr) = undo(tr, (hi + n) - K + 1)
847                   | loop([], yadj, hi, n, tr) = loop(yadj, [], hi, n, tr)
848                 | loop(NODE{color, movecnt as ref m, degree=ref deg, ...}::vs,                 | loop(NODE{color, movecnt as ref m, degree=ref deg, ...}::vs,
849                        yadj, k, n, tr) =                        yadj, hi, n, tr) =
850                        (case !color of                        (case !color of
851                           COLORED _ =>                           COLORED _ =>
852                             if m < 0 then                             if m < 0 then
853                                (* node has been visited before *)                                (* node has been visited before *)
854                                if deg = K then loop(vs, yadj, k, n-1, tr)                           loop(vs, yadj, hi, n, tr)
                               else loop(vs, yadj, k, n, tr)  
855                             else                             else
856                               (movecnt := ~1 - m;  (* mark as visited *)                               (movecnt := ~1 - m;  (* mark as visited *)
857                                loop(vs, yadj, k-1, n, movecnt::tr))                           loop(vs, yadj, hi+1, n, movecnt::tr))
858                         | PSEUDO =>                         | PSEUDO =>
859                             if deg < K then loop(vs, yadj, k, n, tr)                        if deg < K then loop(vs, yadj, hi, n, tr)
860                             else if m >= 0 then                             else if m >= 0 then
861                               (* node has never been visited before *)                               (* node has never been visited before *)
862                                (movecnt := ~1 - m;  (* mark as visited *)                                (movecnt := ~1 - m;  (* mark as visited *)
863                                 if deg = K                                 if deg = K
864                                 then loop(vs, yadj, k, n+1, movecnt::tr)                            then loop(vs, yadj, hi, n+1, movecnt::tr)
865                                 else loop(vs, yadj, k-1, n, movecnt::tr)                            else loop(vs, yadj, hi+1, n, movecnt::tr)
866                                )                                )
867                             else                             else
868                                (* node has been visited before *)                                (* node has been visited before *)
869                                if deg = K then loop(vs, yadj, k, n-1, tr)                           if deg = K then loop(vs, yadj, hi, n-1, tr)
870                                else loop(vs, yadj, k, n, tr)                           else loop(vs, yadj, hi, n, tr)
871                         | _ => loop(vs, yadj, k, n, tr) (* REMOVED/ALIASED *)                    | _ => loop(vs, yadj, hi, n, tr) (* REMOVED/ALIASED *)
872                        )                        )
873           in loop(!xadj, !yadj, K, 0, []) end           in loop(!xadj, !yadj, 0, 0, []) end
874    
875       (*       (*
876        *  Heuristic used to determine whether a pseudo and machine register        *  Heuristic used to determine whether a pseudo and machine register
# Line 820  Line 878 
878        *  Precondition:        *  Precondition:
879        *     The two nodes are assumed not to interfere.        *     The two nodes are assumed not to interfere.
880        *)        *)
881       fun safe(r, NODE{adj, ...}) =       fun safe(hicount, reg, NODE{adj, ...}) =
882       let fun loop [] = true       let fun loop([], hi) = hi = 0 orelse (hicount := hi; false)
883             | loop(n::adj) =             | loop(n::adj, hi) =
884               (case n of               (case n of
885                 NODE{color=ref(COLORED _),...} => loop adj (* can't be r! *)                 (* Note: Actively we only have to consider pseudo nodes and not
886               | NODE{color=ref(ALIASED _),...} => loop adj (* not real *)                  * nodes that are removed, since removed nodes either have
887               | NODE{color=ref(SPILLED _),...} => loop adj (* gone! *)                  * deg < K or else optimistic spilling must be in effect!
888               | NODE{degree,...} => (* PSEUDO or REMOVED *)                  *)
889                  (!degree < K orelse member(n, r)) andalso loop adj                 NODE{degree,number,color=ref(PSEUDO | REMOVED), ...} =>
890                   if !degree < K orelse member(reg, number) then loop(adj, hi)
891                   else loop(adj, hi+1)
892                 | _ => loop(adj, hi)
893               )               )
894       in  loop(!adj) end       in  loop(!adj, 0) end
895    
896       (*       (*
897        *  Decrement the active move count of a node.        *  Decrement the active move count of a node.
# Line 846  Line 907 
907           in  movecnt := newCnt;           in  movecnt := newCnt;
908               movecost := !movecost - cost;               movecost := !movecost - cost;
909               if newCnt = 0 andalso !degree < K (* low degree and movecnt = 0 *)               if newCnt = 0 andalso !degree < K (* low degree and movecnt = 0 *)
910               then simplify(node, mv, fz, stack)               then (blocked := !blocked - 1; simplify(node, mv, fz, stack))
911               else (mv, fz, stack)               else (mv, fz, stack)
912           end           end
913         | decMoveCnt(_, _, _, mv, fz, stack) = (mv, fz, stack)         | decMoveCnt(_, _, _, mv, fz, stack) = (mv, fz, stack)
# Line 858  Line 919 
919        *   Precondition: u <> v and u and v must be unconstrained        *   Precondition: u <> v and u and v must be unconstrained
920        *        *
921        *  u, v   -- two nodes to be merged, must be distinct!        *  u, v   -- two nodes to be merged, must be distinct!
922          *  coloingv -- is u a colored node?
923        *  mvcost -- the cost of the move that has been eliminated        *  mvcost -- the cost of the move that has been eliminated
924        *  mv     -- the queue of moves        *  mv     -- the queue of moves
925        *  fz     -- the queue of freeze candidates        *  fz     -- the queue of freeze candidates
926        *  stack  -- stack of removed nodes        *  stack  -- stack of removed nodes
927        *)        *)
928       fun combine(u, v, mvcost, mv, fz, stack) =       fun combine(u, v, coloringv, mvcost, mv, fz, stack) =
929       let val NODE{color=vcol, pri=pv, movecnt=cntv, movelist=movev, adj=adjv,       let val NODE{color=vcol, pri=pv, movecnt=cntv, movelist=movev, adj=adjv,
930                    defs=defsv, uses=usesv, ...} = v                    defs=defsv, uses=usesv, degree=degv, ...} = v
931           val NODE{color=ucol, pri=pu, movecnt=cntu, movelist=moveu, adj=adju,           val NODE{color=ucol, pri=pu, movecnt=cntu, movelist=moveu, adj=adju,
932                    defs=defsu, uses=usesu, ...} = u                    defs=defsu, uses=usesu, degree=degu, ...} = u
933    
934           (* merge movelists together, taking the opportunity           (* merge movelists together, taking the opportunity
935            * to prune the lists            * to prune the lists
936            *)            *)
937           fun mergeMoveList([], mv) = mv           fun mergeMoveList([], mv) = mv
938             | mergeMoveList((m as MV{status,...})::rest, mv) =             | mergeMoveList((m as MV{status,hicount,...})::rest, mv) =
939                (case !status of                (case !status of
940                  (MOVE | WORKLIST) => mergeMoveList(rest, m::mv)                  BRIGGS_MOVE =>
941                      (* if we are changing a copy from v <-> w to uv <-> w
942                       * makes sure we reset its trigger count, so that it
943                       * will be tested next.
944                       *)
945                      (if coloringv then (status := GEORGE_MOVE; hicount := 0)
946                       else ();
947                       mergeMoveList(rest, m::mv)
948                      )
949                  | GEORGE_MOVE =>
950                      (* if u is colored and v is not, then the move v <-> w
951                       * becomes uv <-> w where w is colored.  This can always
952                       * be discarded.
953                       *)
954                      (if coloringv then mergeMoveList(rest, mv)
955                       else mergeMoveList(rest, m::mv)
956                      )
957                  | WORKLIST => mergeMoveList(rest, m::mv)
958                | _ => mergeMoveList(rest, mv)                | _ => mergeMoveList(rest, mv)
959                )                )
960    
961           (* Form combined node; add the adjacency list of v to u *)           (* Form combined node; add the adjacency list of v to u *)
962           fun union([], mv, fz, stack) = (mv, fz, stack)           fun union([], mv, fz, stack) = (mv, fz, stack)
963             | union((t as NODE{color, (* pair=pt, *) ...})::adj, mv, fz, stack) =             | union((t as NODE{color, (* pair=pt, *)degree, ...})::adj,
964                       mv, fz, stack) =
965                (case !color of                (case !color of
966                   COLORED _ => (addEdge(t, u); union(adj, mv, fz, stack))                   (COLORED _ | SPILLED _) =>
967                       (addEdge(t, u); union(adj, mv, fz, stack))
968                 | PSEUDO =>                 | PSEUDO =>
969                     (addEdge(t, u);                     (addEdge(t, u);
970                      let val (mv, fz, stack) = decDegree(t, mv, fz, stack)                      let val d = !degree
971                        in  if d = K then
972                            let val (mv, fz, stack) = lowDegree(t, mv, fz, stack)
973                      in  union(adj, mv, fz, stack) end                      in  union(adj, mv, fz, stack) end
974                            else (degree := d - 1; union(adj, mv, fz, stack))
975                        end
976                     )                     )
977                 | _ => union(adj, mv, fz, stack)                 | _ => union(adj, mv, fz, stack)
978                )                )
# Line 898  Line 983 
983                     * in the original priority, we substract it twice                     * in the original priority, we substract it twice
984                     * from the new priority.                     * from the new priority.
985                     *)                     *)
986           pu    := !pu + !pv;           pu    := !pu + !pv - mvcost - mvcost;
987                    (* combine the def/use pts of both nodes.                    (* combine the def/use pts of both nodes.
988                     * Strictly speaking, the def/use points of the move                     * Strictly speaking, the def/use points of the move
989                     * should also be removed.  But since we never spill                     * should also be removed.  But since we never spill
# Line 912  Line 997 
997           usesu := concat(!usesu, !usesv);           usesu := concat(!usesu, !usesv);
998           case !ucol of           case !ucol of
999             PSEUDO =>             PSEUDO =>
1000               (if !cntv > 0 then moveu := mergeMoveList(!movev, !moveu) else ();               (if !cntv > 0 then
1001                     (if !cntu > 0 then blocked := !blocked - 1 else ();
1002                      moveu := mergeMoveList(!movev, !moveu)
1003                     )
1004                  else ();
1005                movev := []; (* XXX kill the list to free space *)                movev := []; (* XXX kill the list to free space *)
1006                cntu  := !cntu + !cntv                cntu  := !cntu + !cntv
1007               )               )
# Line 920  Line 1009 
1009           ;           ;
1010           cntv := 0;           cntv := 0;
1011    
1012             let val removingHi = !degv >= K andalso (!degu >= K orelse coloringv)
1013               (* Update the move count of the combined node *)               (* Update the move count of the combined node *)
1014           let val (mv, fz, stack) = union(!adjv, mv, fz, stack)               val (mv, fz, stack) = union(!adjv, mv, fz, stack)
1015           in  decMoveCnt(u, 2, mvcost + mvcost, mv, fz, stack)               val (mv, fz, stack) =
1016                     decMoveCnt(u, 2, mvcost + mvcost, mv, fz, stack)
1017                 (* If either v or u are high degree then at least one high degree
1018                  * node is removed from the neighbors of uv after coalescing
1019                  *)
1020                 val mv = if removingHi then enableMoves(!adju, mv) else mv
1021             in  coalesce(mv, fz, stack)
1022           end           end
1023       end       end
1024    
# Line 930  Line 1026 
1026        *  COALESCE:        *  COALESCE:
1027        *    Repeat coalescing and simplification until mv is empty.        *    Repeat coalescing and simplification until mv is empty.
1028        *)        *)
1029       fun coalesce(MV.EMPTY, fz, stack, undo) = (fz, stack, undo)       and coalesce(MV.EMPTY, fz, stack) = (fz, stack)
1030         | coalesce(MV.TREE(MV{src, dst, status, cost, ...}, _, l, r),         | coalesce(MV.TREE(MV{src, dst, status, hicount, cost, ...}, _, l, r),
1031                            fz, stack, undo)=                    fz, stack) =
1032           let val u = chase src           let (* val _ = coalesce_count := !coalesce_count + 1 *)
1033                 val u = chase src
1034               val v as NODE{color=ref vcol, ...} = chase dst               val v as NODE{color=ref vcol, ...} = chase dst
1035                 (* make u the colored one *)                 (* make u the colored one *)
1036               val (u as NODE{number=u', color=ref ucol, ...},               val (u as NODE{number=u', color=ref ucol, ...},
# Line 944  Line 1041 
1041               val _ = if debug then print ("Coalescing "^show u^"<->"^show v               val _ = if debug then print ("Coalescing "^show u^"<->"^show v
1042                           ^" ("^Int.toString cost^")") else ()                           ^" ("^Int.toString cost^")") else ()
1043               val mv = MV.merge(l, r)               val mv = MV.merge(l, r)
1044               fun coalesceIt(status, v, undo) =               fun coalesceIt(status, v) =
1045                   (status := COALESCED;                   (status := COALESCED;
1046                    if !spillFlag then UNDO(v, status, undo) else undo                   if !spillFlag then trail := UNDO(v, status, !trail) else ()
1047                   )                   )
   
              (* mark u and v as constrained *)  
              fun constrained(status, u, v, mv, fz, stack, undo) =  
                  let val _ = status := CONSTRAINED  
                      val (mv, fz, stack) = decMoveCnt(u, 1, cost, mv, fz, stack)  
                      val (mv, fz, stack) = decMoveCnt(v, 1, cost, mv, fz, stack)  
                  in  (mv, fz, stack, undo) end  
   
              (* coalesce u and v *)  
              fun union(status, u, v, mv, fz, stack, undo) =  
                  let val undo = coalesceIt(status, v, undo)  
                      val (mv, fz, stack) = combine(u, v, cost, mv, fz, stack)  
                  in  (mv, fz, stack, undo) end  
   
1048           in  if u' = v' then (* trivial move *)           in  if u' = v' then (* trivial move *)
1049                  let val undo = coalesceIt(status, v, undo)                  let val _ = if debug then print(" Trivial\n") else ()
1050                      val (mv, fz, stack) =                      val _ = coalesceIt(status, v)
1051                           decMoveCnt(u, 2, cost+cost, mv, fz, stack)                  in  coalesce(decMoveCnt(u, 2, cost+cost, mv, fz, stack))
1052                      val _ = if debug then print(" Trivial\n") else ()                  end
                 in  coalesce(mv, fz, stack, undo) end  
1053               else               else
1054                  (case vcol of                  (case vcol of
1055                    COLORED _ =>                    COLORED _ =>
1056                        (* two colored nodes cannot be coalesced *)                        (* two colored nodes cannot be coalesced *)
1057                       (if debug then print(" Both Colored\n") else ();                       (status := CONSTRAINED;
1058                        status := CONSTRAINED;                        if debug then print(" Both Colored\n") else ();
1059                        coalesce(mv, fz, stack, undo))                        coalesce(mv, fz, stack))
1060                  | _ =>                  | _ =>
1061                    if member(u, v) then                    if member(u', v') then
1062                       (* u and v interfere *)                       (* u and v interfere *)
1063                      (if debug then print(" Interfere\n") else ();                      let val _ = status := CONSTRAINED
1064                       coalesce(constrained(status, u, v, mv, fz, stack, undo)))                          val _ = if debug then print(" Interfere\n") else ();
1065                            val (mv, fz, stack) =
1066                                    decMoveCnt(u, 1, cost, mv, fz, stack)
1067                        in  coalesce(decMoveCnt(v, 1, cost, mv, fz, stack)) end
1068                    else                    else
1069                    case ucol of                    case ucol of
1070                      COLORED _ =>  (* u is colored, v is not *)                      COLORED _ =>  (* u is colored, v is not *)
1071                      if safe(u, v) then                      if safe(hicount, u', v) then
1072                         (if debug then print(" Safe\n") else ();                         (if debug then print(" Safe\n") else ();
1073                          coalesce(union(status, u, v, mv, fz, stack, undo)))                         (*if tally then good_george := !good_george+1 else ();*)
1074                           coalesceIt(status, v);
1075                           combine(u, v, true, cost, mv, fz, stack)
1076                          )
1077                      else                      else
1078                        (status := MOVE; (* remove it from the move list *)                        ((* remove it from the move list *)
1079                           status := GEORGE_MOVE;
1080                           (*if tally then bad_george := !bad_george + 1 else ();*)
1081                         if debug then print(" Unsafe\n") else ();                         if debug then print(" Unsafe\n") else ();
1082                         coalesce(mv, fz, stack, undo)                         coalesce(mv, fz, stack)
1083                        )                        )
1084                    |  _ => (* u, v are not colored *)                    |  _ => (* u, v are not colored *)
1085                     if conservative(u, v) then                     if conservative(hicount, u, v) then
1086                       (if debug then print(" OK\n") else ();                       (if debug then print(" OK\n") else ();
1087                        coalesce(union(status, u, v, mv, fz, stack, undo)))                         (*if tally then good_briggs := !good_briggs+1 else ();*)
1088                           coalesceIt(status, v);
1089                           combine(u, v, false, cost, mv, fz, stack)
1090                          )
1091                     else (* conservative test failed *)                     else (* conservative test failed *)
1092                        (status := MOVE; (* remove it from the move list *)                        ((* remove it from the move list *)
1093                           status := BRIGGS_MOVE;
1094                           (*if tally then bad_briggs := !bad_briggs + 1 else ();*)
1095                         if debug then print(" Non-conservative\n") else ();                         if debug then print(" Non-conservative\n") else ();
1096                         coalesce(mv, fz, stack, undo)                         coalesce(mv, fz, stack)
1097                        )                        )
1098                  )                  )
1099           end           end
# Line 1011  Line 1106 
1106         *    fz    -- a queue of freeze candidates         *    fz    -- a queue of freeze candidates
1107         *    stack -- stack of removed nodes         *    stack -- stack of removed nodes
1108         *)         *)
1109        fun markAsFrozen(node as NODE{number=me, movelist, movecnt as ref mc,...},        fun markAsFrozen(
1110                node as NODE{number=me, degree,
1111                             adj, movelist, movecnt as ref mc,...},
1112                         fz, stack) =                         fz, stack) =
1113        let val _ = if debug then print("Mark as frozen "^Int.toString me^"\n")        let val _ = if debug then print("Mark as frozen "^Int.toString me^"\n")
1114                    else ()                    else ()
# Line 1022  Line 1119 
1119              | elimMoves(MV{status, src, dst, ...}::mvs, simp) =              | elimMoves(MV{status, src, dst, ...}::mvs, simp) =
1120                case !status of                case !status of
1121                  WORKLIST => error "elimMoves"                  WORKLIST => error "elimMoves"
1122                | MOVE => (* mark move as lost *)                | (BRIGGS_MOVE | GEORGE_MOVE) => (* mark move as lost *)
1123                  let val _ = status := LOST                  let val _ = status := LOST
1124                      val src as NODE{number=s,...} = chase src                      val src as NODE{number=s,...} = chase src
1125                      val dst = chase dst                      val you = if s = me then chase dst else src
                     val you = if s = me then dst else src  
1126                  in  case you of                  in  case you of
1127                        NODE{color=ref(COLORED _),...} =>                        NODE{color=ref(COLORED _),...} =>
1128                          elimMoves(mvs, simp)                          elimMoves(mvs, simp)
1129                      | NODE{movecnt as ref c, degree, ...} => (* pseudo *)                      | NODE{movecnt as ref c, degree, ...} => (* pseudo *)
1130                          (movecnt := c - 1;                          (movecnt := c - 1;
1131                           if c = 1 andalso !degree < K then                           if c = 1 andalso !degree < K then
1132                              elimMoves(mvs, you::simp)                             (blocked := !blocked - 1; elimMoves(mvs, you::simp))
1133                           else                           else
1134                              elimMoves(mvs, simp)                              elimMoves(mvs, simp)
1135                          )                          )
1136                  end                  end
1137                |  _   => elimMoves(mvs, simp)                |  _   => elimMoves(mvs, simp)
1138    
1139            val (mv, fz, stack) =            (* Note:
1140                if mc = 0 then (MV.EMPTY, fz, stack)             * We are removing a high degree node, so try to enable all moves
1141               * associated with its neighbors.
1142               *)
1143    
1144              val mv = if !degree >= K then enableMoves(!adj, MV.EMPTY)
1145                       else MV.EMPTY
1146    
1147          in  if mc = 0
1148              then simplify(node, mv, fz, stack)
1149                else                else
1150                let val _ = movecnt := 0;               (movecnt := 0;
1151                    val simp = elimMoves(!movelist, [])                simplifyAll(node::elimMoves(!movelist, []), mv, fz, stack)
1152                in  simplifyAll(simp, MV.EMPTY, fz, stack) end               )
       in  simplify(node, mv, fz, stack)  
1153        end        end
1154    
1155        (*        (*
# Line 1057  Line 1160 
1160         *   stack -- stack of removed nodes         *   stack -- stack of removed nodes
1161         *   undo  -- trail of coalesced moves after potential spill         *   undo  -- trail of coalesced moves after potential spill
1162         *)         *)
1163        fun freeze(fz, stack, undo) =        fun freeze(fz, stack) =
1164        let fun loop(FZ.EMPTY, FZ.EMPTY, stack, undo) = (stack, undo)        let fun loop(FZ.EMPTY, FZ.EMPTY, stack) = stack
1165              | loop(FZ.EMPTY, newFz, _, _) = error "no freeze candidate"              | loop(FZ.EMPTY, newFz, _) = error "no freeze candidate"
1166                (*              | loop(FZ.TREE(node, _, l, r), newFz, stack) =
               let fun loop(FZ.TREE(n,_,l,r)) =  
                       (print("Non candidate "^show n^"\n");  
                        loop(FZ.merge(l,r)))  
                     | loop(FZ.EMPTY) = ()  
               in  dumpGraph G TextIO.stdOut;  
                   loop newFz;  
                   error "no freeze candidate"  
               end  
               *)  
             | loop(FZ.TREE(node, _, l, r), newFz, stack, undo) =  
1167                let val fz = FZ.merge(l, r)                let val fz = FZ.merge(l, r)
1168                in  case node of                in  case node of
1169                       (* This node has not been simplified                       (* This node has not been simplified
1170                        * This must be a move-related node.                        * This must be a move-related node.
1171                        *)                        *)
1172                       NODE{color=ref PSEUDO, degree, movecnt, movecost, ...} =>                       NODE{color=ref PSEUDO, degree, ...} =>
1173                       if !degree >= K (* can't be frozen? *)                       if !degree >= K (* can't be frozen yet? *)
1174                       then (* if !movecnt = 0 (* non-freeze candidate *)                       then
1175                            then loop(fz, newFz, stack, undo)                          ((*if tally then bad_freeze := !bad_freeze+1 else ();*)
1176                            else *) loop(fz, FZ.add(node, newFz), stack, undo)                           loop(fz, newFz, stack))
1177                       else (* freeze node *)                       else (* freeze node *)
1178                       let val _ = if debug then                       let val _ =
1179                                    print("Freezing "^show node                              if debug then print("Freezing "^show node^"\n")
                                        ^" movecnt="^Int.toString(!movecnt)^  
                                         " ("^Int.toString(!movecost)^")\n")  
1180                                   else ()                                   else ()
1181                             (*val _ =
1182                                if tally then good_freeze := !good_freeze + 1
1183                                else ()*)
1184                             val _ = blocked := !blocked - 1;
1185                           val (mv, fz, stack) = markAsFrozen(node, fz, stack)                           val (mv, fz, stack) = markAsFrozen(node, fz, stack)
1186                           val (fz, stack, undo) = coalesce(mv, fz, stack, undo)                           val (fz, stack) = coalesce(mv, fz, stack)
1187                       in  loop(FZ.merge(fz, newFz), FZ.EMPTY, stack, undo)                       in  if !blocked = 0
1188                             then ((* print "[no freezing again]"; *) stack)
1189                             else ((* print("[freezing again "^
1190                                   Int.toString(!blocked)^"]"); *)
1191                                   loop(FZ.merge(fz, newFz), FZ.EMPTY, stack))
1192                         end
1193                      | _ =>
1194                        ((*if tally then bad_freeze := !bad_freeze + 1 else ();*)
1195                         loop(fz, newFz, stack))
1196                       end                       end
1197                    | _ => loop(fz, newFz, stack, undo)        in  if !blocked = 0 then ((* print "[no freezing]"; *) stack)
1198              else ((* print("[freezing "^Int.toString(!blocked)^"]"); *)
1199                    loop(fz, FZ.EMPTY, stack))
1200                end                end
1201        in  loop(fz, FZ.EMPTY, stack, undo)  
1202          (*
1203           * Sort simplify worklist in increasing degree.
1204           * Matula and Beck suggests that we should always remove the
1205           * node with the lowest degree first.  This is an approximation of
1206           * the idea.
1207           *)
1208          (*
1209          val buckets = A.array(K, []) : G.node list A.array
1210          fun sortByDegree nodes =
1211          let fun insert [] = ()
1212                | insert((n as NODE{degree=ref deg, ...})::rest) =
1213                  (UA.update(buckets, deg, n::UA.sub(buckets, deg)); insert rest)
1214              fun collect(~1, L) = L
1215                | collect(deg, L) = collect(deg-1, concat(UA.sub(buckets, deg), L))
1216          in  insert nodes;
1217              collect(K-1, [])
1218        end        end
1219           *)
1220    
1221        (*        (*
1222         * Iterate over simplify, coalesce, freeze         * Iterate over simplify, coalesce, freeze
# Line 1102  Line 1224 
1224        fun iterate{simplifyWkl, moveWkl, freezeWkl, stack} =        fun iterate{simplifyWkl, moveWkl, freezeWkl, stack} =
1225        let (* simplify everything *)        let (* simplify everything *)
1226            val (mv, fz, stack)   =            val (mv, fz, stack)   =
1227                    simplifyAll(simplifyWkl, moveWkl, freezeWkl, stack)                   simplifyAll((* sortByDegree *) simplifyWkl,
1228            val (fz, stack, undo) = coalesce(mv, fz, stack, !trail)                               moveWkl, freezeWkl, stack)
1229            val (stack, undo)     = freeze(fz, stack, undo)            val (fz, stack) = coalesce(mv, fz, stack)
1230        in  trail := undo;            val stack       = freeze(fz, stack)
1231            {stack=stack}        in  {stack=stack}
1232        end        end
1233    in  {markAsFrozen=markAsFrozen, iterate=iterate}    in  {markAsFrozen=markAsFrozen, iterate=iterate}
1234    end    end
# Line 1140  Line 1262 
1262     *    Using optimistic spilling     *    Using optimistic spilling
1263     *)     *)
1264    fun select(G as GRAPH{getreg, getpair, trail, firstPseudoR, stamp,    fun select(G as GRAPH{getreg, getpair, trail, firstPseudoR, stamp,
1265                          spillFlag, proh, ...})                          spillFlag, proh, mode, ...}) {stack} =
              {stack, biased} =  
1266    let fun undoCoalesced END = ()    let fun undoCoalesced END = ()
1267          | undoCoalesced(UNDO(NODE{number, color, ...}, status, trail)) =          | undoCoalesced(UNDO(NODE{number, color, ...}, status, trail)) =
1268            (status := MOVE;            (status := BRIGGS_MOVE;
1269             if number < firstPseudoR then () else color := PSEUDO;             if number < firstPseudoR then () else color := PSEUDO;
1270             undoCoalesced trail             undoCoalesced trail
1271            )            )
# Line 1205  Line 1326 
1326                 * color the move with the same color                 * color the move with the same color
1327                 *)                 *)
1328                fun getPref([], pref) = pref                fun getPref([], pref) = pref
1329                  | getPref(MV{status=ref LOST, src, dst, ...}::mvs, pref) =                  | getPref(MV{status=ref(LOST | BRIGGS_MOVE | GEORGE_MOVE),
1330                                 src, dst, ...}::mvs, pref) =
1331                    let val src as NODE{number=s,...} = chase src                    let val src as NODE{number=s,...} = chase src
1332                        val dst = chase dst                        val other = if s = number then chase dst else src
                       val other = if s = number then dst else src  
1333                    in  case other of                    in  case other of
1334                          NODE{color=ref(COLORED c),...} => getPref(mvs, c::pref)                          NODE{color=ref(COLORED c),...} => getPref(mvs, c::pref)
1335                        | _ => getPref(mvs, pref)                        | _ => getPref(mvs, pref)
# Line 1222  Line 1343 
1343                    in  color := COLORED col; spills                    in  color := COLORED col; spills
1344                    end handle _ => node::spills                    end handle _ => node::spills
1345            in  biasedColoring(stack, spills, stamp+1) end            in  biasedColoring(stack, spills, stamp+1) end
1346        val (spills, st) = if biased        val (spills, st) = if isOn(mode, BIASED_SELECTION)
1347                           then biasedColoring(stack, [], !stamp)                           then biasedColoring(stack, [], !stamp)
1348                           else if !spillFlag then                           else if !spillFlag then
1349                                    optimistic(stack, [], !stamp)                                    optimistic(stack, [], !stamp)
# Line 1240  Line 1361 
1361    end    end
1362    
1363    (*    (*
1364       * Incorporate memory<->register moves into the interference graph
1365       *)
1366      fun initMemMoves(GRAPH{memMoves, ...}) =
1367      let fun move(NODE{movelist, movecost, ...}, mv, cost) =
1368              (movelist := mv :: !movelist;
1369               movecost := cost + !movecost
1370              )
1371    
1372          fun setMove(dst, src, mv, cost) =
1373              (move(dst, mv, cost); move(src, mv, cost))
1374    
1375          fun init [] = ()
1376            | init((mv as MV{dst, src, cost, ...})::mvs) =
1377              let val dst as NODE{color=dstCol, ...} = chase dst
1378                  val src as NODE{color=srcCol, ...} = chase src
1379              in  case (!dstCol, !srcCol) of
1380                    (SPILLED x, SPILLED y) => setMove(dst, src, mv, cost)
1381                  | (SPILLED _, PSEUDO)    => setMove(dst, src, mv, cost)
1382                  | (PSEUDO,    SPILLED _) => setMove(dst, src, mv, cost)
1383                  | (SPILLED _, COLORED _) => () (* skip *)
1384                  | (COLORED _, SPILLED _) => () (* skip *)
1385                  | _ => error "initMemMoves" ;
1386                  init mvs
1387              end
1388          val moves = !memMoves
1389      in  memMoves := [];
1390          init moves
1391      end
1392    
1393      (*
1394     * Spill coalescing.     * Spill coalescing.
1395     * Coalesce non-interfering moves between spilled nodes,     * Coalesce non-interfering moves between spilled nodes,
1396     * in non-increasing order of move cost.     * in non-increasing order of move cost.
1397     *)     *)
1398    fun spillCoalescing(GRAPH{bitMatrix, ...}) nodesToSpill =    fun spillCoalescing(GRAPH{bitMatrix, ...}) =
1399    let fun chase(NODE{color=ref(ALIASED n), ...}) = chase n    let val member = BM.member(!bitMatrix)
1400          | chase n = n        val addEdge = BM.add(!bitMatrix)
1401      in  fn nodesToSpill =>
1402          let
1403              (* Find moves between two spilled nodes *)
1404        fun collectMoves([], mv') = mv'        fun collectMoves([], mv') = mv'
1405          | collectMoves(NODE{movelist, color=ref(SPILLED ~1), ...}::ns, mv') =              | collectMoves(NODE{movelist, color=ref(SPILLED _), ...}::ns, mv') =
1406            let fun addMoves([], mv') = collectMoves(ns, mv')                let fun ins([], mv') = collectMoves(ns, mv')
1407                  | addMoves((mv as MV{dst,src,status=ref LOST, ...})::mvs, mv') =                      | ins(MV{status=ref(COALESCED | CONSTRAINED), ...}::mvs,
1408                              mv') = ins(mvs, mv')
1409                        | ins((mv as MV{dst, src, ...})::mvs, mv') =
1410                     (case (chase dst, chase src) of                     (case (chase dst, chase src) of
1411                        (NODE{color=ref(SPILLED ~1), number=d, ...},                            (NODE{color=ref(SPILLED x), number=d, ...},
1412                         NODE{color=ref(SPILLED ~1), number=s, ...}) =>                             NODE{color=ref(SPILLED y), number=s, ...}) =>
1413                            if d = s then addMoves(mvs, mv')                                if d = s orelse            (* trival move *)
1414                            else addMoves(mvs, MV.add(mv, mv'))                                   (x >= 0 andalso y >= 0) (* both are fixed *)
1415                      | _ => addMoves(mvs, mv')                                then ins(mvs, mv')
1416                                  else ins(mvs, MV.add(mv, mv'))
1417                            | _ => ins(mvs, mv')
1418                     )                     )
1419                  | addMoves(_::mvs, mv') = addMoves(mvs, mv')                in  ins(!movelist, mv') end
           in  addMoves(!movelist, mv') end  
1420          | collectMoves(_::ns, mv') = collectMoves(ns, mv')          | collectMoves(_::ns, mv') = collectMoves(ns, mv')
1421    
1422        val mvs = collectMoves(nodesToSpill, MV.EMPTY)        val mvs = collectMoves(nodesToSpill, MV.EMPTY)
1423    
1424        val member = BM.member(!bitMatrix)            (* Coalesce moves between two spilled nodes *)
       val addEdge = BM.add(!bitMatrix)  
   
1425        fun coalesceMoves(MV.EMPTY) = ()        fun coalesceMoves(MV.EMPTY) = ()
1426          | coalesceMoves(MV.TREE(MV{dst, src, ...}, _, l, r)) =              | coalesceMoves(MV.TREE(MV{dst, src, cost, ...}, _, l, r)) =
1427            let val dst as NODE{number=d, color, adj=adjDst,                let val dst as NODE{color=colorDst, ...} = chase dst
1428                                defs=defsDst, uses=usesDst, ...} = chase dst                    val src = chase src
1429                val src as NODE{number=s, adj=adjSrc,  
1430                                defs=defsSrc, uses=usesSrc, ...} = chase src                    (* Make sure that dst is the non-mem reg node *)
1431                      val (dst, src) =
1432                           case !colorDst of
1433                             SPILLED ~1 => (dst, src)
1434                           | _ => (src, dst)
1435    
1436                      val dst as NODE{number=d, color=colorDst, adj=adjDst,
1437                                      defs=defsDst, uses=usesDst,  ...} = dst
1438                      val src as NODE{number=s, color=colorSrc, adj=adjSrc,
1439                                      defs=defsSrc, uses=usesSrc, ...} = src
1440    
1441                      (* combine adjacency lists *)
1442                fun union([], adjSrc) = adjSrc                fun union([], adjSrc) = adjSrc
1443                  | union((n as NODE{color, adj=adjT,                  | union((n as NODE{color, adj=adjT,
1444                                     number=t, ...})::adjDst, adjSrc) =                                     number=t, ...})::adjDst, adjSrc) =
# Line 1286  Line 1452 
1452                         else union(adjDst, adjSrc)                         else union(adjDst, adjSrc)
1453                     | _ => union(adjDst, adjSrc)                     | _ => union(adjDst, adjSrc)
1454                    )                    )
1455            in  if d = s orelse member(dst, src) then ()                    val mvs = MV.merge(l,r)
1456                else ((* print(Int.toString d ^"<->"^Int.toString s^"\n"); *)                in  if d = s then          (* trivial *)
1457                         coalesceMoves mvs
1458                      else
1459                      (case !colorDst of
1460                        SPILLED x =>
1461                           if x >= 0 orelse  (* both dst and src are mem regs *)
1462                              member(d, s)   (* they interfere *)
1463                           then
1464                             ((* print("Bad "^Int.toString d ^
1465                                       "<->"^Int.toString s^"\n")*))
1466                           else
1467                             ((* print(Int.toString d ^"<->"^Int.toString s^"\n");*)
1468                      ra_spill_coal := !ra_spill_coal + 1;                      ra_spill_coal := !ra_spill_coal + 1;
1469                      color := ALIASED src;                             (* unify *)
1470                              colorDst := ALIASED src;
1471                      adjSrc := union(!adjDst, !adjSrc);                      adjSrc := union(!adjDst, !adjSrc);
1472                      defsSrc := concat(!defsDst, !defsSrc);                            if x >= 0 then ()
1473                      usesSrc := concat(!usesDst, !usesSrc)                            else
1474                     );                              (defsSrc := concat(!defsDst, !defsSrc);
1475                coalesceMoves(MV.merge(l,r))                               usesSrc := concat(!usesDst, !usesSrc))
1476                             )
1477                       | _ => error "coalesceMoves";
1478                       coalesceMoves mvs
1479                      )
1480            end            end
1481    in  coalesceMoves mvs    in  coalesceMoves mvs
1482    end    end
1483      end
1484    
1485    (*    (*
1486     * Spill propagation.     * Spill propagation.
1487     *)     *)
1488    fun spillPropagation(G as GRAPH{bitMatrix, ...}) nodesToSpill =    fun spillPropagation(G as GRAPH{bitMatrix, memRegs, ...}) nodesToSpill =
1489    let val spillCoalescing = spillCoalescing G    let val spillCoalescing = spillCoalescing G
1490        exception SpillProp        exception SpillProp
1491        val visited = Intmap.new(32, SpillProp) : bool Intmap.intmap        val visited = Intmap.new(32, SpillProp) : bool Intmap.intmap
# Line 1310  Line 1493 
1493        val markAsVisited = Intmap.add visited        val markAsVisited = Intmap.add visited
1494        val member = BM.member(!bitMatrix)        val member = BM.member(!bitMatrix)
1495    
       fun chase(NODE{color=ref(ALIASED n), ...}) = chase n  
         | chase n = n  
   
1496        (* compute savings due to spill coalescing.        (* compute savings due to spill coalescing.
1497         * The move list must be associated with a colorable node.         * The move list must be associated with a colorable node.
1498           * The pinned flag is to prevent the spill node from coalescing
1499           * two different fixed memory registers.
1500         *)         *)
1501        fun coalescingSavings([], sc) = sc+sc        fun coalescingSavings([], pinned, sc) = (pinned, sc+sc)
1502          | coalescingSavings(MV{dst, src, status=ref LOST, cost, ...}::mvs, sc) =          | coalescingSavings(MV{status=ref(CONSTRAINED | COALESCED), ...}::mvs,
1503            (case (chase dst, chase src) of                              pinned, sc) = coalescingSavings(mvs, pinned, sc)
1504               (dst as NODE{number=d, color=ref(SPILLED ~1), ...},          | coalescingSavings(MV{dst, src, cost, ...}::mvs, pinned, sc) =
1505                src as NODE{number=s, ...}) =>            let val NODE{number=d, color=dstCol, ...} = chase dst
1506                 if d = s orelse member(dst, src) then coalescingSavings(mvs, sc)                val NODE{number=s, color=srcCol, ...} = chase src
1507                 else coalescingSavings(mvs, sc+cost)                fun savings(x) =
1508             | (dst as NODE{number=d, ...},                    if member(d, s) then coalescingSavings(mvs, pinned, sc)
1509                src as NODE{number=s, color=ref(SPILLED ~1),...}) =>                    else if x = ~1 then coalescingSavings(mvs, pinned, sc+cost)
1510                 if d = s orelse member(dst, src) then coalescingSavings(mvs, sc)                    else if pinned >= 0 andalso pinned <> x then
1511                 else coalescingSavings(mvs, sc+cost)                       (* already coalesced with another mem reg *)
1512             | _ => coalescingSavings(mvs, sc)                       coalescingSavings(mvs, pinned, sc)
1513            )                    else
1514          | coalescingSavings(_::mvs, sc) = coalescingSavings(mvs, sc)                       (* coalescingSavings(mvs, x, sc+cost) *) (* XXX *)
1515                         coalescingSavings(mvs, x, sc+cost)
1516              in  if d = s then
1517                     coalescingSavings(mvs, pinned, sc)
1518                  else
1519                     case (!dstCol, !srcCol) of
1520                       (SPILLED x, PSEUDO) => savings(x)
1521                     | (PSEUDO, SPILLED x) => savings(x)
1522                     | _ => coalescingSavings(mvs, pinned, sc)
1523              end
1524    
1525        (* Insert all colorable neighbors into worklist *)        (* Insert all spillable neighbors onto the worklist *)
1526        fun insert([], worklist) = worklist        fun insert([], worklist) = worklist
1527          | insert((node as NODE{color=ref PSEUDO, number, ...})::adj, worklist) =          | insert((node as NODE{color=ref PSEUDO, number, ...})::adj, worklist) =
1528            if hasBeenVisited number then insert(adj, worklist)            if hasBeenVisited number
1529              then insert(adj, worklist)
1530            else (markAsVisited (number, true);            else (markAsVisited (number, true);
1531                  insert(adj, node::worklist))                  insert(adj, node::worklist))
1532          | insert(_::adj, worklist) = insert(adj, worklist)          | insert(_::adj, worklist) = insert(adj, worklist)
# Line 1342  Line 1534 
1534        val marker = SPILLED(~1)        val marker = SPILLED(~1)
1535    
1536        (* Process all nodes from the worklist *)        (* Process all nodes from the worklist *)
1537        fun propagate([], new, spilled) = (new, spilled)        fun propagate([], spilled) = spilled
1538          | propagate(node::worklist, new, spilled) =          | propagate((node as NODE{color as ref PSEUDO,
1539            let val NODE{pri=ref spillcost, color, number,                                    pri=ref spillcost, number,
1540                         adj, movelist, ...} = node                                    adj, movelist, ...})::worklist,
1541                val savings = coalescingSavings(!movelist, 0)                      spilled) =
1542            in  if savings >= spillcost then  (* propagate spill *)            let val (pinned, savings) = coalescingSavings(!movelist, ~1, 0)
1543              in  if (if pinned >= 0 then savings > spillcost
1544                     else savings >= spillcost) (* XXX *)
1545                  then  (* propagate spill *)
1546                   (ra_spill_prop := !ra_spill_prop + 1;                   (ra_spill_prop := !ra_spill_prop + 1;
1547                    color := marker; (* spill the node *)                    color := marker; (* spill the node *)
1548                    (* print("Propagating "^Int.toString number^"\n"); *)                    (* print("Propagating "^Int.toString number^" "^
1549                    propagate(insert(!adj, worklist), node::new, node::spilled)                          "savings="^Int.toString(savings)^
1550                           " cost="^Int.toString spillcost^"\n"); *)
1551                      (* run spill coalescing *)
1552                      spillCoalescing [node];
1553                      propagate(insert(!adj, worklist), node::spilled)
1554                   )                   )
1555                else                else
1556                   propagate(worklist, new, spilled)                   propagate(worklist, spilled)
1557            end            end
1558            | propagate(_::worklist, spilled) =
1559                propagate(worklist, spilled)
1560    
1561        (* Initialize worklist *)        (* Initialize worklist *)
1562        fun init([], worklist) = worklist        fun init([], worklist) = worklist
1563          | init(NODE{adj, color=ref(SPILLED ~1), ...}::rest, worklist) =          | init(NODE{adj, color=ref(SPILLED _), ...}::rest, worklist) =
1564              init(rest, insert(!adj, worklist))              init(rest, insert(!adj, worklist))
1565          | init(_::rest, worklist) = init(rest, worklist)          | init(_::rest, worklist) = init(rest, worklist)
1566    
# Line 1367  Line 1568 
1568         * Iterate between spill coalescing and propagation         * Iterate between spill coalescing and propagation
1569         *)         *)
1570        fun iterate(spillWorkList, spilled) =        fun iterate(spillWorkList, spilled) =
1571        let val _ = spillCoalescing spillWorkList        let (* run one round of coalescing first *)
1572              val _ = spillCoalescing spillWorkList
1573            val propagationWorkList = init(spillWorkList, [])            val propagationWorkList = init(spillWorkList, [])
1574            val (newNodes, spilled) = propagate(propagationWorkList, [], spilled)            (* iterate on our own spill nodes *)
1575        in  case newNodes of            val spilled = propagate(propagationWorkList, spilled)
1576              [] => spilled            (* try the memory registers too *)
1577            | _  => iterate(newNodes, spilled)            val spilled = propagate(!memRegs, spilled)
1578          in  spilled
1579        end        end
1580    
1581    in  iterate(nodesToSpill, nodesToSpill)    in  iterate(nodesToSpill, nodesToSpill)
1582    end    end
1583    
# Line 1386  Line 1590 
1590        val firstLoc = !spillLoc        val firstLoc = !spillLoc
1591        val _ = spillLoc := firstLoc - 1 (* allocate one location *)        val _ = spillLoc := firstLoc - 1 (* allocate one location *)
1592        fun selectColor([], currLoc) = ()        fun selectColor([], currLoc) = ()
1593          | selectColor(NODE{color as ref(SPILLED _), number, adj, ...}::nodes,          | selectColor(NODE{color as ref(SPILLED ~1), number, adj, ...}::nodes,
1594                        currLoc) =                        currLoc) =
1595            let fun chase(NODE{color=ref(ALIASED n), ...}) = chase n            let fun neighbors [] = ()
                 | chase n = n  
               fun neighbors [] = ()  
1596                  | neighbors(n::ns) =                  | neighbors(n::ns) =
1597                    (case chase n of                    let fun mark(NODE{color=ref(SPILLED loc), ...}) =
1598                        NODE{color=ref(SPILLED loc), ...} =>                             (if loc >= ~1 then () (* no location yet *)
1599                         if loc >= ~1 then () (* no location yet *)                              else A.update(proh, firstLoc - loc, number);
                        else A.update(proh, firstLoc - loc, number)  
                    | _ => ();  
1600                    neighbors ns                    neighbors ns
1601                   )                   )
1602                            | mark(NODE{color=ref(ALIASED n), ...}) = mark n
1603                            | mark _ = neighbors ns
1604                      in  mark n end
1605                val _ = neighbors(!adj)                val _ = neighbors(!adj)
1606                fun findColor(loc, startingPoint) =                fun findColor(loc, startingPoint) =
1607                    let val loc = if loc < firstLoc then !spillLoc + 1 else loc                    let val loc = if loc < firstLoc then !spillLoc + 1 else loc
# Line 1411  Line 1614 
1614                val currLoc = if currLoc < firstLoc then !spillLoc + 1                val currLoc = if currLoc < firstLoc then !spillLoc + 1
1615                              else currLoc                              else currLoc
1616                val loc = findColor(currLoc, currLoc)                val loc = findColor(currLoc, currLoc)
1617                  (* val _ = print("Spill("^Int.toString number^")="^
1618                                Int.toString loc^"\n") *)
1619            in  color := SPILLED loc;            in  color := SPILLED loc;
1620                selectColor(nodes, loc - 1)                selectColor(nodes, loc - 1)
1621            end            end
# Line 1426  Line 1631 
1631    let val enter = Intmap.add regmap    let val enter = Intmap.add regmap
1632        fun set(r, NODE{color=ref(COLORED c),...}) = enter(r, c)        fun set(r, NODE{color=ref(COLORED c),...}) = enter(r, c)
1633          | set(r, NODE{color=ref(ALIASED n),...}) = set(r, n)          | set(r, NODE{color=ref(ALIASED n),...}) = set(r, n)
1634          | set(r, NODE{color=ref(SPILLED _),...}) = enter(r,~1) (* XXX *)          | set(r, NODE{color=ref(SPILLED s),...}) =
1635          | set _ = error "finishRA"               enter(r,if s >= 0 then s else ~1) (* XXX *)
1636            | set(r, _) = error("finishRA "^Int.toString r)
1637    in  Intmap.app set nodes;    in  Intmap.app set nodes;
1638        case !deadCopies of        case !deadCopies of
1639          [] => ()          [] => ()
# Line 1454  Line 1660 
1660    (*    (*
1661     * Clear the interference graph, but keep the nodes     * Clear the interference graph, but keep the nodes
1662     *)     *)
1663    fun clearGraph(GRAPH{bitMatrix, maxRegs, trail, spillFlag, deadCopies, ...}) =    fun clearGraph(GRAPH{bitMatrix, maxRegs, trail, spillFlag,
1664                           deadCopies, memMoves, ...}) =
1665    let val edges = BM.edges(!bitMatrix)    let val edges = BM.edges(!bitMatrix)
1666    in  trail      := END;    in  trail      := END;
1667        spillFlag  := false;        spillFlag  := false;
1668        bitMatrix  := BM.empty;        bitMatrix  := BM.empty;
1669        deadCopies := [];        deadCopies := [];
1670          memMoves   := [];
1671        bitMatrix  := G.newBitMatrix{edges=edges, maxRegs=maxRegs()}        bitMatrix  := G.newBitMatrix{edges=edges, maxRegs=maxRegs()}
1672    end    end
1673    
# Line 1471  Line 1679 
1679    in  Intmap.app init nodes    in  Intmap.app init nodes
1680    end    end
1681    
1682      end (* local *)
1683    
1684  end  end

Legend:
Removed from v.475  
changed lines
  Added in v.498

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0