PreviousUpNext

15.4.363  src/lib/compiler/back/low/regor/register-spilling-per-improved-chow-hennessy-heuristic-g.pkg

## register-spilling-per-improved-chow-hennessy-heuristic-g.pkg
#
# This module implements a Chow-Hennessy-style spill heuristic 
#
# See also:
#     src/lib/compiler/back/low/regor/register-spilling-per-chaitin-heuristic.pkg
#     src/lib/compiler/back/low/regor/register-spilling-per-chow-hennessy-heuristic.pkg
#     src/lib/compiler/back/low/regor/register-spilling-per-improved-chaitin-heuristic-g.pkg

# Compiled by:
#     src/lib/compiler/back/low/lib/register-spilling.lib


stipulate
    package f8b =  eight_byte_float;                                                                    # eight_byte_float                      is from   src/lib/std/eight-byte-float.pkg
    package hpq =  heap_priority_queue;                                                                 # heap_priority_queue                   is from   src/lib/src/heap-priority-queue.pkg
    package irc =  iterated_register_coalescing;                                                        # iterated_register_coalescing          is from   src/lib/compiler/back/low/regor/iterated-register-coalescing.pkg
    package cig =  codetemp_interference_graph;                                                         # codetemp_interference_graph           is from   src/lib/compiler/back/low/regor/codetemp-interference-graph.pkg
herein

    generic package   register_spilling_per_improved_chow_hennessy_heuristic_g   (                      # Nowhere invoked.
        #             ========================================================
        #
        move_ratio:  Float;
    )
    : (weak)  Register_Spilling_Per_Xxx_Heuristic                                                       # Register_Spilling_Per_Xxx_Heuristic   is from   src/lib/compiler/back/low/regor/register-spilling-per-xxx-heuristic.api
    {
        exception NO_CANDIDATE;

        mode = irc::compute_span;

        cache = REF NULL:   Ref( Null_Or( hpq::Priority_Queue( (cig::Node, Float) ) ) );                # XXX BUGGO FIXME more icky thread-hostile global mutable state

        fun init ()
            =
            cache := NULL;


        # Potential spill phase.
        # Find a cheap node to spill according to Chow Hennessy's heuristic.
        #
        fun choose_spill_node
              {
                codetemp_interference_graph as   cig::CODETEMP_INTERFERENCE_GRAPH { span, ... },
                has_been_spilled,
                spill_worklist
              }
            =
            {   fun chase (cig::NODE { color=>REF (cig::ALIASED n), ... } ) =>   chase n;
                    chase n                                                 =>       n;
                end;

                # Savings due to coalescing
                # when a node is not spilled:
                #
                fun move_savings (cig::NODE { movecnt=>REF 0, ... } )
                        =>
                        0.0;

                    move_savings (cig::NODE { movelist, ... } )
                        => 
                        loop (*movelist, [])
                        where
                            fun loop ([], savings)
                                    => 
                                    fold_backward
                                        (fn ((_, a), b) =  f8b::max (a, b))
                                        0.0
                                        savings;

                                loop (cig::MOVE_INT { status=>REF (cig::WORKLIST | cig::GEORGE_MOVE | cig::BRIGGS_MOVE), dst_reg, src_reg, cost, ... } ! mvs, savings)
                                    => 
                                    {   fun add (c,[])
                                                =>
                                                [(c, cost)];

                                            add (c, (x as (c': Int, s)) ! savings)
                                                =>
                                                c == c'   ??  (c', s+cost) ! savings
                                                          ::   x ! add (c, savings);
                                        end;

                                        savings
                                            =
                                            case (chase dst_reg)   
                                                #
                                                cig::NODE { color=>REF (cig::COLORED c), ... }
                                                    =>
                                                    add (c, savings);

                                                _   =>
                                                    case (chase src_reg)   
                                                        #
                                                        cig::NODE { color => REF (cig::COLORED c), ... }
                                                            =>
                                                            add (c, savings);

                                                        _   =>
                                                            savings;
                                                    esac;
                                            esac;

                                        loop (mvs, savings);
                                    };

                                loop(_ ! mvs, savings)
                                    =>
                                    loop (mvs, savings);
                            end;
                        end;
                end;                    # fun move_savings


                # The spill worklist is maintained only lazily.
                #
                # So we have to prune away those nodes that are
                # already removed from the interference graph.
                #
                # After pruning the worklist, it may be the
                # case that there isn't anything to be spilled
                # after all.
                #
                fun chow_hennessy spills
                    =
                    {   # Compute savings due to moves:
                        #
                        spill_savings = irc::move_savings  codetemp_interference_graph;
                        lookup_span = int_hashtable::find (null_or::the *span);

                        lookup_span
                            = 
                            fn r =  case (lookup_span r)

                                         THE s =>  s;
                                         NULL  =>  0.0;
                                    esac;

                        span := NULL;

                        fun loop ([], lll, pruned)
                                =>
                                (lll, pruned);

                            loop (node ! rest, lll, pruned)
                                => 
                                case (chase node)
                                    #
                                    node as cig::NODE { id, priority, defs, uses, degree=>REF deg, color=>REF cig::CODETEMP, ... }
                                        => 
                                        if (has_been_spilled  id) 
                                            #
                                            loop (rest, lll, FALSE);
                                        else
                                            fun newnode ()
                                                =
                                                {   span       =  lookup_span    id;
                                                    savings    =  spill_savings  id;

                                                    spill_cost = *priority;
                                                    total_cost = spill_cost - savings; 

                                                    # rank = ((real totalCost)+0.01) / real (span)

                                                    rank = (total_cost + 0.5 + move_savings (node))
                                                                  // (span + real deg);

                                                    loop (rest, (node, rank) ! lll, FALSE);
                                                };

                                            case (*defs, *uses)
                                                #
                                                (_, [])                 # One def no use. 
                                                     =>
                                                     loop (rest, (node, -1.0 - real (deg)) ! lll, FALSE);

                                                ([d], [u])              # Defs after use; don't use
                                                     =>
                                                     {   fun plus ( { block, op }, n)
                                                             =
                                                             { block, op => op+n };

                                                         (d == plus (u, 1) or d == plus (u, 2) ) 
                                                             ??  loop (rest, lll, FALSE)
                                                             ::  newnode ();
                                                     };

                                                _   =>   newnode();
                                            esac; 
                                        fi; 

                                    _ =>   loop (rest, lll, pruned);            # Discard node 
                                esac;

                        end;

                        loop (spills, [], TRUE);
                    };

                fun choose_node heap
                    =
                    {   fun loop ()
                            = 
                            {   (hpq::delete_min  heap)
                                    ->
                                    (node, cost);

                                case (chase node)
                                    #
                                    node as cig::NODE { color=>REF cig::CODETEMP, ... }
                                        =>
                                        { node=>THE (node), cost, spill_worklist };

                                    _   => loop();
                                esac;    
                            };

                         loop();
                    }
                    except
                        _ = { node => NULL, cost => 0.0, spill_worklist => [] };

                case *cache
                    #
                    THE heap
                        =>
                        choose_node heap;

                    NULL
                        => 
                        {   my (lll, pruned) = chow_hennessy (spill_worklist);

                            if pruned
                                # Done.
                                { node => NULL,
                                  cost => 0.0,
                                  spill_worklist => []
                                };
                            else
                                case lll
                                    #
                                    []  => raise exception NO_CANDIDATE;

                                    _   =>  {   fun rank ( (_, x),
                                                           (_, y)
                                                         )
                                                    =
                                                    f8b::(<) (x, y);

                                                heap   =  hpq::from_list rank lll;

                                                cache :=  THE heap; 

                                                choose_node heap;
                                            };
                                esac;

                            fi;
                        };
                esac;
            };
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext