PreviousUpNext

15.4.357  src/lib/compiler/back/low/regor/register-spilling-g.pkg

## register-spilling-g.pkg 
#
# This package manages the spill/reload process. 
# The reason this is detached from the main module is that 
# I can't understand the old code. 
#
# Okay, now I understand the code.
#
# The new code does things slightly differently.
# Here, we are given an op and a list of registers to spill
# and reload.  We rewrite the op until all instances of these
# registers are rewritten.
#
# (12/13/99) Some major caveats when spill coalescing/coloring is used:
# When parallel copies are generated and spill coalescing/coloring is used,
# two special cases have to be identified:
#
# Case 1 (spill_loc dst = spill_loc src)
#        Suppose we have a parallel copy
#             (u, v) <- (x, y)
#        where u has to be spilled and y has to reloaded.  When both
#        u and y are mapped to location M.  The following wrong code may
#        be generated:
#                M <- x  (spill u)
#                v <- M  (reload y)
#        This is incorrect.  Instead, we generate a dummy copy and
#        delay the spill after the reload, like this:  
#               
#               tmp <- x (save value of u)
#               v <- M   (reload y)
#               M <- tmp (spill u)
# Case 2 (spill_loc copy_tmp = spill_loc src)
#        Another case that can cause problems is when the spill location of
#        the copy temporary is the same as that of one of the sources:
#
#              (a, b, v) <- (b, a, u)  where spill_loc (u) = spill_loc (tmp) = v
#
#        The incorrect code is
#              (a, b) <- (b, a) 
#              v <- M
#        But then the shuffle code for the copy can clobber the location M.
#
#              tmp <- M
#              (a, b) <- (b, a) 
#              v <- tmp
#
#       (Note that spill_loc copy_tmp = spill_loc src can never happen) 

# -- Allen Leung

# Compiled by:
#     src/lib/compiler/back/low/lib/lowhalf.lib


###                "As soon as we started programming,
###                 we found to our surprise that it
###                 wasn't as easy to get programs right
###                 as we had thought.
###
###                "Debugging had to be discovered.
###
###                "I can remember the exact instant
###                 when I realized that a large part
###                 of my life from then on was going
###                 to be spent finding mistakes in
###                 my own programs."
###
###                            -- Maurice Wilkes, 1949


stipulate
    package iht =  int_hashtable;                                               # int_hashtable                         is from   src/lib/src/int-hashtable.pkg
    package irc =  iterated_register_coalescing;                                # iterated_register_coalescing          is from   src/lib/compiler/back/low/regor/iterated-register-coalescing.pkg
    package lem =  lowhalf_error_message;                                       # lowhalf_error_message                 is from   src/lib/compiler/back/low/control/lowhalf-error-message.pkg
    package pp  =  standard_prettyprinter;                                      # standard_prettyprinter                is from   src/lib/prettyprint/big/src/standard-prettyprinter.pkg
    package rkj =  registerkinds_junk;                                          # registerkinds_junk                    is from   src/lib/compiler/back/low/code/registerkinds-junk.pkg
    #
    debug = FALSE;
herein

    # We are invoked from:
    #
    #     src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg
    #     src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg
    #     src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
    #
    # See also:
    #
    #     src/lib/compiler/back/low/regor/register-spilling-with-renaming-g.pkg
    #
    generic package   register_spilling_g   (
        #             ===================
        #
        package mu:  Machcode_Universals;                                       # Machcode_Universals                   is from   src/lib/compiler/back/low/code/machcode-universals.api

        package ae:  Machcode_Codebuffer_Pp                                     # Machcode_Codebuffer_Pp                is from   src/lib/compiler/back/low/emit/machcode-codebuffer-pp.api
                     where
                         mcf == mu::mcf;                                        # "mcf" == "machcode_form" (abstract machine code).
    )
    : (weak) Register_Spilling                                                  # Register_Spilling                     is from   src/lib/compiler/back/low/regor/register-spilling.api
    {
        # Export to client packages:
        #
        package mcf = mu::mcf;                                                  # "mcf" == "machcode_form" (abstract machine code).
        package rgk = mcf::rgk;                                                 # "rgk" == "registerkinds".
        package cig = irc::cig;                                                 # "cig" == "codetemp_interference_graph".


        stipulate
            fun error msg
                =
                lem::error("register_spilling", msg);

            ra_keep_dead_copies
                = 
                lowhalf_control::make_bool 
                  (
                    "ra_keep_dead_copies",
                    "Dead copies are not removed when spilling"
                  );

            fun dec1 n
                =
                unt::to_int_x (unt::from_int n - 0u1);

            fun dec { block, op }
                =
                { block, op=>dec1 op };

            package rst = regor_spill_types_g( mcf );                           # regor_spill_types_g   is from   src/lib/compiler/back/low/regor/regor-spill-types-g.pkg
        herein

            include package   rst;                                                      # Export it all to client packages.

            fun uniq codetemps                                                  # This has the effect of sorting by color and dropping any duplicated colors.
                =
                rkj::sortuniq_colored_codetemps codetemps;

            i2s    = int::to_string;

            fun pt2s { block, op }
                =
                "b" + i2s block + ":" + i2s op;


            # spilled_copy_tmps = Lowhalf_control::get_counter "ra-spilled-copy-temps";


            # The following function performs spilling.
            #
            fun spill_rewrite
                { graph as cig::CODETEMP_INTERFERENCE_GRAPH { show_reg, spilled_regs, node_hashtable, mode, ... },
                  spill:  Spill, 
                  spill_copy_tmp:  Spill_Copy_Tmp, 
                  spill_src:  Spill_Src, 
                  rename_src:  Rename_Src,
                  reload:      Reload, 
                  reload_dst:  Reload_Dst, 
                  copy_instr:  Copy_Instr, 
                  registerkind,
                  spill_set, reload_set, kill_set
                }
                =
                spill_rewrite
                where
                    # Must do this to make sure
                    # the interference graph is 
                    # reflected to the registers:

                    irc::update_register_aliases graph;

                    get_spill_loc = irc::spill_loc graph;
                    fun spill_loc_of (rkj::CODETEMP_INFO { id, ... } ) = get_spill_loc id;
                    spill_locs_of = map spill_loc_of;

                    getnode =   (\\ rkj::CODETEMP_INFO { id, ... } =   iht::get  node_hashtable  id);

                    op_def_use = mu::def_use registerkind;

                    # Merge prohibited registers:
                    #
                    enter_spill = iht::set spilled_regs;

                    add_prohibition =  apply  (\\ register =  enter_spill (rkj::interkind_register_id_of register, TRUE)); 

                    get_spills  = cig::ppt_hashtable::find spill_set;
                    get_spills  = \\ p =  case (get_spills p)
                                              THE s => s;
                                              NULL  => [];
                                          esac;

                    get_reloads = cig::ppt_hashtable::find reload_set;
                    get_reloads = \\ p =  case (get_reloads p)
                                              THE s => s;
                                              NULL  => [];
                                          esac;

                    get_kills   = cig::ppt_hashtable::find kill_set;
                    get_kills   = \\ p =  case (get_kills p)
                                              THE s => s;
                                              NULL => [];
                                          esac;

                    fun get_loc (cig::NODE { color=>REF (cig::ALIASED n),    ... }) =>  get_loc n;
                        get_loc (cig::NODE { color=>REF (cig::RAMREG(_, m)), ... }) =>  cig::SPILL_TO_RAMREG m;
                        get_loc (cig::NODE { color=>REF (cig::SPILL_LOC s),  ... }) =>  cig::SPILL_TO_FRESH_FRAME_SLOT  s;
                        get_loc (cig::NODE { color=>REF (cig::SPILLED), id,  ... }) =>  cig::SPILL_TO_FRESH_FRAME_SLOT  id;
                        get_loc (cig::NODE { color=>REF (cig::CODETEMP),  id,  ... }) =>  cig::SPILL_TO_FRESH_FRAME_SLOT  id;
                        #
                        get_loc _ => error "get_loc";
                    end;

                    fun print_regs regs
                        = 
                        apply (\\ r = print (rkj::register_to_string r + " [" + irc::spill_loc_to_string graph (rkj::universal_register_id_of r) + "] "))
                              regs;

                    parallel_copies
                        =
                        unt::bitwise_and (irc::has_parallel_copies, mode) != 0u0;


                    fun chase (rkj::CODETEMP_INFO { color=>REF (rkj::ALIASED c), ... } )
                            =>
                            chase c;
                        #
                        chase other => other;
                    end;


                    fun register_id (rkj::CODETEMP_INFO { id, ... } )
                        =
                        id;


                    fun same_register (rkj::CODETEMP_INFO { id=>x, ... }, rkj::CODETEMP_INFO { id=>y, ... } )
                        =
                        x == y;


                    fun same (x, reg_to_spill)
                        =
                        same_register (chase x, reg_to_spill);


                    # Rewrite the op given
                    # that a bunch of registers have 
                    # to be spilled and reloaded.
                    #
                    fun spill_rewrite { pt, ops, notes }
                        = 
                        loop (reverse ops, pt, [])
                        where
                            # Insert reloading code for an op.
                            # Note: reload code goes after the op, if any.
                            #
                            fun reload_instr (op, reg_to_spill, spill_loc)
                                = 
                                {   my { code, prohibitions, make_reg }
                                        =
                                        reload { instruction => op, reg=>reg_to_spill, spill_loc, notes };

                                    add_prohibition  prohibitions; 
                                    code;
                                };


                            # Renaming the source for an op.
                            #
                            fun rename_instr (op, reg_to_spill, to_src)
                                = 
                                {   my { code, prohibitions, make_reg }
                                       =
                                       rename_src { instruction => op, from_src=>reg_to_spill, to_src };

                                    add_prohibition  prohibitions;

                                    code;
                                };


                            # Remove uses of regToSpill from a set of parallel copies.
                            # If there are multiple uses, then return multiple moves.
                            #   
                            fun extract_uses (reg_to_spill, rds, rss)
                                =
                                loop (rds, rss, [], [], [])
                                where
                                    fun loop (rd ! rds, rs ! rss, new_rds, rds', rss')
                                            =>
                                            if (same (rs, reg_to_spill) )
                                               loop (rds, rss, rd ! new_rds, rds', rss');
                                            else 
                                               loop (rds, rss, new_rds, rd ! rds', rs ! rss');
                                            fi;

                                        loop(_, _, new_rds, rds', rss')
                                            =>
                                            (new_rds, rds', rss');
                                    end;
                                end;


                            # Insert reload code for the sources of a copy.
                            # Transformation:
                            #    d1..dn <- s1..sn
                            # =>
                            #    d1..dn/r <- s1...sn/r.
                            #    reload code
                            #    reload copies
                            #
                            fun reload_copy_src (op, reg_to_spill, spill_loc)
                                = 
                                {   my (dst, src)
                                        =
                                        mu::move_dst_src op;

                                    my (rds, copy_dst, copy_src)
                                        =
                                        extract_uses (reg_to_spill, dst, src);

                                    fun process_moves ([], reload_code)
                                            =>
                                            reload_code; 

                                        process_moves (rd ! rds, reload_code)
                                            =>
                                            {   code =
                                                    reload_dst
                                                      { spill_loc,
                                                        reg => reg_to_spill,
                                                        dst => rd,
                                                        notes
                                                      };

                                                process_moves (rds, code@reload_code);
                                            };
                                    end;

                                    reload_code = process_moves (rds, []);

                                    case copy_dst   
                                        [] => reload_code;
                                        _  => copy_instr((copy_dst, copy_src), op) @ reload_code;
                                    esac;
                                }; 


                            # Insert reload code
                            #
                            fun reload (op, reg_to_spill, spill_loc)
                                =
                                mu::move_instruction op
                                    ??  reload_copy_src (op, reg_to_spill, spill_loc)
                                    ::  reload_instr    (op, reg_to_spill, spill_loc);


                            # Check whether the id is in a list
                            #
                            fun contains_id (id,[])
                                    =>
                                    FALSE;

                                contains_id (id: rkj::Universal_Register_Id, r ! rs)
                                    =>
                                    r == id   or   contains_id (id, rs);
                            end;


                            fun spill_conflict (cig::SPILL_TO_FRESH_FRAME_SLOT        loc,         rs) =>   contains_id (-loc, rs);
                                spill_conflict (cig::SPILL_TO_RAMREG (rkj::CODETEMP_INFO { id, ... } ), rs) =>   contains_id (  id, rs);
                            end;


                            fun contains (r',[])
                                    =>
                                    FALSE;

                                contains (r', r ! rs)
                                    =>
                                    same_register (r', r)
                                    or
                                    contains      (r', rs);
                            end;


                            # Insert spill code for an op.
                            # Spill code occur after the op.
                            # If the value in regToSpill is never used, the client also
                            # has the opportunity to remove the op.
                            #
                            fun spill_instr (op, reg_to_spill, spill_loc, kill)
                                = 
                                code
                                where
                                    my { code, prohibitions, make_reg }
                                       =
                                       spill { instruction => op, kill, spill_loc, notes, reg => reg_to_spill };

                                    add_prohibition  prohibitions;
                                end;

                            # Remove the definition regToSpill <- from 
                            # parallel copies rds <- rss.
                            # Note, there is a guarantee that regToSpill is not aliased
                            # to another register in the rds set.
                            #
                            fun extract_def (reg_to_spill, rds, rss, kill)
                                =
                                loop (rds, rss, [], [])
                                where
                                    fun loop (rd ! rds, rs ! rss, rds', rss')
                                            =>
                                            if (spill_loc_of rd == spill_loc_of rs )

                                                (rs, rds@rds', rss@rss', TRUE);

                                            elif (same (rd, reg_to_spill) )

                                                (rs, rds@rds', rss@rss', kill);

                                            else
                                                loop (rds, rss, rd ! rds', rs ! rss');
                                            fi;

                                       loop _
                                          => 
                                          {   print("rds="); 

                                              apply
                                                  (\\ r = print (rkj::register_to_string r + ":" +
                                                                 i2s (spill_loc_of r) + " ")
                                                  )
                                                  rds;

                                              print("\nrss="); 

                                              apply
                                                  (\\ r = print (rkj::register_to_string r + ":" +
                                                                 i2s (spill_loc_of r) + " ")
                                                  )
                                                  rss;

                                              print "\n";
                                              error("extractDef: " + rkj::register_to_string reg_to_spill);
                                          };
                                    end;
                               end;


                            # Insert spill code for a destination of a copy
                            #    suppose d = r and we have a copy d <- s in
                            #    d1...dn <- s1...sn
                            #
                            #    d1...dn <- s1...sn
                            # =>
                            #    spill s to spill_loc 
                            #    d1...dn/d <- s1...sn/s
                            #
                            #    However, if the spill code may ovewrite the spill location
                            #    shared by other uses, we do the following less 
                            #    efficient scheme:  
                            #
                            #    # save the result of d
                            #    d1...dn, tmp <- s1...sn, s
                            #    spill tmp to spill_loc    # spill d
                            #
                            fun spill_copy_dst (op, reg_to_spill, spill_loc, kill, don't_overwrite)
                                = 
                                {   my (dst, src)
                                        =
                                        mu::move_dst_src op;

                                    my (mv_src, copy_dst, copy_src, kill)
                                        =
                                        extract_def (reg_to_spill, dst, src, kill);

                                    copy = case copy_dst   
                                                 [] => [];
                                                _  => copy_instr((copy_dst, copy_src), op);
                                           esac;

                                    if (kill and not *ra_keep_dead_copies)

                                         # Kill the move:
                                      ( # print ("Copy " + int::to_string (hd mvDst) + " <- " +
                                        #             int::to_string (hd mvSrc) + " removed\n");
                                       copy
                                      );
                                     #  normal spill 

                                    elif (spill_conflict (spill_loc, don't_overwrite))

                                        # Cycle found 

                                        # print("Register r" + int::to_string regToSpill  +  
                                        #           " overwrites [" + int::to_string spill_loc + "]\n")

                                        tmp =  rgk::clone_codetemp_info  reg_to_spill;                  #  new temporary 

                                        copy = copy_instr((tmp ! copy_dst, mv_src ! copy_src),
                                                                  op); 

                                        spill_code = spill_src { src=>tmp, reg=>reg_to_spill,
                                                                 spill_loc,
                                                                 notes };
                                        copy @ spill_code;

                                      else
                                          # Spill the move op:
                                          #
                                          spill_code = spill_src { src=>mv_src, reg=>reg_to_spill,
                                                                   spill_loc,
                                                                   notes };
                                          spill_code @ copy;
                                      fi;
                                };


                            # Insert spill code for a copy
                            #
                            fun spill_copy (op, reg_to_spill, spill_loc, kill, don't_overwrite)
                                =
                                case (mu::move_tmp_r op)   
                                    #
                                    NULL => spill_copy_dst (op, reg_to_spill, spill_loc, kill,
                                                         don't_overwrite);
                                    THE tmp
                                        => 
                                        if (same (tmp, reg_to_spill))

                                            #  spilledCopyTmps := *spilledCopyTmps + 1; 

                                            [ spill_copy_tmp
                                                { copy => op,
                                                  reg  => reg_to_spill,
                                                  spill_loc,
                                                  notes
                                                }
                                            ];
                                        else
                                            spill_copy_dst (op, reg_to_spill, spill_loc, kill, don't_overwrite);
                                        fi;
                                esac;


                            # Insert spill code:
                            #
                            fun spill (op, reg_to_spill, spill_loc, kill_set, don't_overwrite)
                                =
                                {   kill = contains (reg_to_spill, kill_set);

                                    if (mu::move_instruction op)   spill_copy  (op, reg_to_spill, spill_loc, kill, don't_overwrite);
                                    else                           spill_instr (op, reg_to_spill, spill_loc, kill);
                                    fi;
                                };

                            fun contains ([], reg) => FALSE;
                                contains (r ! rs, reg) => same (r, reg) or contains (rs, reg);
                            end;

                            fun has_def (i, reg) = contains(#1 (op_def_use i), reg);
                            fun has_use (i, reg) = contains(#2 (op_def_use i), reg);

                            fun spill_one_reg ([], _, _, _, _)
                                    =>
                                    [];

                                spill_one_reg (i ! ops, r, spill_loc, kill_set, don't_overwrite)
                                    => 
                                    if (has_def (i, r)) 
                                        #
                                        spill_one_reg (spill (i, r, spill_loc, kill_set, don't_overwrite) @ ops,   r, spill_loc, kill_set, don't_overwrite);
                                    else
                                        i ! spill_one_reg (ops, r, spill_loc, kill_set, don't_overwrite);
                                    fi;
                            end;

                            fun reload_one_reg ([], _, _)
                                    =>
                                    [];

                                reload_one_reg (i ! ops, r, spill_loc)
                                    => 
                                    if (has_use (i, r)) 
                                        #
                                        reload_one_reg (reload (i, r, spill_loc) @ ops,   r, spill_loc);
                                    else
                                        i ! reload_one_reg (ops, r, spill_loc);
                                    fi;
                            end;

                            #  This function spills a set of registers for an op 
                            #
                            fun spill_all (ops, [], kill_set, don't_overwrite)
                                    =>
                                    ops; 

                                spill_all (ops, r ! rs, kill_set, don't_overwrite)
                                    => 
                                    {   node     = getnode r;
                                        spill_loc = get_loc node;
                                        spill_all(
                                            spill_one_reg (ops, r, spill_loc, kill_set, don't_overwrite),
                                                 rs, kill_set, don't_overwrite);
                                    };
                            end;

                            # This function reloads a set of registers for an op 
                            #
                            fun reload_all (ops, [])
                                    =>
                                    ops;

                                reload_all (ops, r ! rs)
                                    => 
                                    {   node     = getnode r;
                                        spill_loc = get_loc node;
                                        reload_all (reload_one_reg (ops, r, spill_loc), rs);
                                    };
                            end;

                            fun loop ([], pt, new_ops)
                                    =>
                                    new_ops;

                                loop (op ! rest, pt, new_ops)           # 'pt' is a program point -- a particular instruction within a particular basic block.
                                    => 
                                    {   spill_regs  =  get_spills  pt;
                                        reload_regs =  get_reloads pt;
                                        #
                                        case (spill_regs, reload_regs)
                                            #
                                            ([], [])
                                                =>
                                                loop (rest, dec pt, op ! new_ops);

                                            _ =>
                                                # Eliminate duplicates from
                                                # the spill/reload candidates 
                                                #
                                                {   kill_regs   = get_kills pt;
                                                    spill_regs  = uniq spill_regs;
                                                    reload_regs = uniq reload_regs;

                                                    # Spill locations that we can't
                                                    # overwrite if we are spilling
                                                    # a parallel copy:
                                                    #
                                                    don't_overwrite
                                                        = 
                                                        parallel_copies
                                                            ??  spill_locs_of reload_regs
                                                            ::  [];

                                                    ops = spill_all ([op], spill_regs, kill_regs, don't_overwrite);

                                                    if debug
                                                        #
                                                        print("pt=" + pt2s pt + "\n");

                                                        case spill_regs
                                                            #
                                                            [] => ();

                                                            _  => {   print("Spilling ");
                                                                      print_regs spill_regs;
                                                                      print "\n";
                                                                  };
                                                        esac;

                                                        case reload_regs
                                                            #
                                                            [] => ();
                                                            #
                                                            _  => { print("Reloading "); 
                                                                    print_regs reload_regs; 
                                                                    print "\n";
                                                                  };
                                                        esac;

                                                        print "Before:";
                                                        print   (pp::prettyprint_to_string [] {.
                                                                    buf = ae::make_codebuffer #pp [];
                                                                    buf.put_op  op;
                                                                });
                                                    fi;

                                                    ops = reload_all (ops, reload_regs);

                                                    if debug
                                                        #
                                                        print "After:";
                                                        print   (pp::prettyprint_to_string [] {.
                                                                    buf = ae::make_codebuffer #pp [];
                                                                    apply  buf.put_op  ops;
                                                                });
                                                        print "------------------\n";
                                                    fi;

                                                    fun cat ([],    l) =>  l;
                                                        cat (a ! b, l) =>  cat (b, a ! l);
                                                    end;

                                                    loop (rest, dec pt, cat (ops, new_ops)); 
                                                };
                                         esac;
                                     };
                                end;
                        end;
                end;
        end;                                                    # stipulate
    };                                                          # package
end;                                                            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext