PreviousUpNext

15.4.218  src/lib/compiler/back/low/block-placement/forward-jumps-to-jumps-g.pkg

## forward-jumps-to-jumps-g.pkg
#
# If a jump just jumps to another jump,
# save an instruction by jumping directly to final destination.
#
# Basically, we run right after block placement         # make_final_basic_block_order_list_g                           is from   src/lib/compiler/back/low/block-placement/make-final-basic-block-order-list-g.pkg
# and right before jump-squashing.                      # squash_jumps_and_make_machinecode_bytevector_intel32_g        is from   src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-intel32-g.pkg
#                                                       # squash_jumps_and_make_machinecode_bytevector_sparc32_g        is from   src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-sparc32-g.pkg
#                                                       # squash_jumps_and_make_machinecode_bytevector_pwrpc32_g        is from   src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-pwrpc32-g.pkg        
#
# TODO:
#       check for jumps to the next block.
#       jump tables (SWITCH edges).     XXX BUGGO FIXME

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





###          "He jumped so high..."
###              -- Jerry Jeff Walker, "Mr. Bojangles"



stipulate
    package fil =  file__premicrothread;                                        # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
    package odg =  oop_digraph;                                                 # oop_digraph                   is from   src/lib/graph/oop-digraph.pkg
    package lbl =  codelabel;                                                   # codelabel                     is from   src/lib/compiler/back/low/code/codelabel.pkg
    package lhc =  lowhalf_control;                                             # lowhalf_control               is from   src/lib/compiler/back/low/control/lowhalf-control.pkg
    package lem =  lowhalf_error_message;                                       # lowhalf_error_message         is from   src/lib/compiler/back/low/control/lowhalf-error-message.pkg
herein

    # This generic is invoked (only) from:
    #
    #     src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg
    #
    generic package   forward_jumps_to_jumps_g   (
        #             ========================
        #
        package mcg: Machcode_Controlflow_Graph;                                # Machcode_Controlflow_Graph    is from   src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api

        package mu:  Machcode_Universals                                        # Machcode_Universals           is from   src/lib/compiler/back/low/code/machcode-universals.api
                     where
                         mcf == mcg::mcf;                                       # "mcf" == "machcode_form" (abstract machine code).

        # Control flag that when set TRUE allows jumps to labels outside
        # of the machcode_controlflow_graph to be chained.  Set this FALSE when there are many
        # short jumps to a long jump that exits the machcode_controlflow_graph.
        #
        chain_escapes:  Ref( Bool );

        # Control flag that when set TRUE allows the direction (forward or
        # backward) of conditional jumps to be changed.  Set this FALSE
        # when the direction of conditional branches is used to predict
        # the branch.
        #
        reverse_direction:  Ref( Bool );

    )
    : (weak) api {
        #
        package mcg:  Machcode_Controlflow_Graph;                               # Machcode_Controlflow_Graph    is from   src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api
        #
        forward_jomps_to_jumps
            :
            (mcg::Machcode_Controlflow_Graph, List(mcg::Node))
            ->
            (mcg::Machcode_Controlflow_Graph, List(mcg::Node));

    }
    {
        # Export to client packages:
        #       
        package mcg =  mcg;

        stipulate
            # Flags:
            #
            disable_jump_to_jump_forwarding
                =
                lhc::make_bool
                  (
                    "disable_jump_to_jump_forwarding",
                    "whether jump-to-jump forwarding is disabled"
                  );

            dump_machcode_controlflow_graph_after_jump_to_jump_forwarding
                =
                lhc::make_bool
                  (
                    "dump_machcode_controlflow_graph_after_jump_to_jump_forwarding",
                    "whether flow graph is shown after jump-to-jump forwarding"
                  );

            dump_strm =  lhc::debug_stream;


            fun error msg
                =
                lem::error("forward_jumps_to_jumps_g", msg);
        herein

            # Here 'nodes' is the final basic-block order list generated by
            #
            #     src/lib/compiler/back/low/block-placement/make-final-basic-block-order-list-g.pkg
            #
            fun forward_jomps_to_jumps (mcg, nodes)
                =
                (mcg, nodes)
                where
                    mcg ->  odg::DIGRAPH { node_info, out_edges, set_out_edges, in_edges, forall_nodes, remove_node, ... };
                    #
                    chain_escapes     =  *chain_escapes;
                    reverse_direction =  *reverse_direction;

                    # This flag is set to note that
                    # we need to filter out unreachable
                    # nodes after jump chaining.
                    #   
                    need_filter =  REF FALSE;

                    # The exit block:
                    # 
                    exit_node_id =  mcg::exit_node_id_of_graph  mcg;



                    fun label_of blk_id                 # Map a block ID to a label 
                        =
                        case (node_info blk_id)
                            #
                            mcg::BBLOCK { labels=>REF (lab ! _), ... }
                                =>
                                lab;

                            mcg::BBLOCK { labels, ... }
                                =>
                                {   lab = lbl::make_anonymous_codelabel ();

                                    labels := [lab];
                                    lab;
                                };
                        esac;


                    fun jump_label_of instruction
                        =
                        case (mu::branch_targets instruction)
                            #
                            [mu::LABELLED lab]
                                =>
                                lab;

                            _   =>   error ("jumpLabelOf");
                        esac;


                    # Given a destination block ID,
                    # check to see if it is a block that
                    # consists a single jump instruction.
                    #
                    # If so, return the block ID and label
                    # of the block at the end of the jump chain;
                    # otherwise return NULL.
                    #
                    fun follow_chain blk_id
                        =
                        case (node_info blk_id)
                            #
                            mcg::BBLOCK { ops as REF [i], kind=>mcg::NORMAL, ... }
                                =>
                                #  A normal block with one instruction 
                                #
                                case (out_edges blk_id)
                                    #
                                    [e as (_, dst, mcg::EDGE_INFO { kind=>mcg::JUMP, execution_frequency, notes } )]
                                        =>
                                        if (dst != exit_node_id   or   chain_escapes)
                                            #
                                            # The instruction must be a jump so
                                            # transitively follow it to get the target,
                                            # but be careful to avoid infinite loops.

                                            set_out_edges (blk_id, []);

                                            case (follow_chain  dst)
                                                #
                                                NULL =>
                                                    {   set_out_edges (blk_id, [e]);
                                                        THE (dst, jump_label_of i);
                                                    };

                                                (some_lab as THE (dst', lab))
                                                    =>
                                                    {   ops := [mu::jump lab];

                                                        set_out_edges (
                                                            blk_id,
                                                            [(blk_id, dst', mcg::EDGE_INFO { kind => mcg::JUMP, execution_frequency, notes } )]
                                                        );

                                                        some_lab;
                                                    };
                                            esac;
                                        else
                                            NULL;
                                        fi;

                                    _ => NULL;
                                esac;

                            _ => NULL;
                        esac;                               # fun follow_chain

                    # For each normal block,
                    # check the outgoing edges
                    # to see if they can be redirected:
                    #
                    fun do_block (blk_id, mcg::BBLOCK { ops, kind=>mcg::NORMAL, ... } )
                            =>
                            {   fun set_targets labs
                                    =
                                    {   my (jmp, rest)
                                            =
                                            case *ops
                                                #
                                                jmp ! rest =>  (jmp, rest);
                                                []         =>  error "set_targets: empty ops";
                                            esac;

                                        new_jmp
                                            = 
                                            case labs
                                                #
                                                [lab]        =>  mu::set_jump_target (jmp, lab);
                                                [lab1, lab2] =>  mu::set_branch_targets { i=>jmp, f=>lab1, t=>lab2 };
                                                _            =>  error "set_targets";
                                            esac;


                                        need_filter :=  TRUE;
                                        ops         :=  new_jmp ! rest;
                                    };

                                case (out_edges blk_id)
                                    #
                                    [ (_, dst, info as mcg::EDGE_INFO { kind => mcg::JUMP, ... } ) ]
                                        =>
                                        case (follow_chain dst)
                                            #
                                            THE (dst', lab)
                                                =>
                                                {   set_targets [lab];
                                                    set_out_edges (blk_id, [(blk_id, dst', info)]);
                                                };

                                            NULL =>   ();
                                        esac;

                                    [ (_, dst1, info as mcg::EDGE_INFO { kind => mcg::BRANCH TRUE, ... } ), e2 ]
                                        =>
                                        case (follow_chain dst1)
                                            #
                                            THE (dst', lab)
                                                =>
                                                {   set_targets [label_of(#2 e2), lab];
                                                    set_out_edges (blk_id, [(blk_id, dst', info), e2]);
                                                };

                                            NULL =>  ();
                                        esac;

                                    [ e1, (_, dst2, info as mcg::EDGE_INFO { kind => mcg::BRANCH TRUE, ... } ) ]
                                        =>
                                        case (follow_chain dst2)
                                            #
                                            THE (dst', lab)
                                                =>
                                                {   set_targets [label_of(#2 e1), lab];
                                                    set_out_edges (blk_id, [e1, (blk_id, dst', info)]);
                                                };

                                            NULL => ();
                                        esac;

                                    _ => ();
                                esac;
                            };

                        do_block _
                            =>
                            ();
                    end;

                    entry_node_id =   mcg::entry_node_id_of_graph  mcg;

                    # Any basic block without any in-edges can be dropped
                    # as dead code -- except of course for the ENTRY node:
                    #
                    fun keep_block (blk_id, _)
                        =
                        if (null (in_edges blk_id)
                        and blk_id != entry_node_id)
                            #
                            remove_node blk_id;
                            FALSE;
                        else
                            TRUE;
                        fi;

                    nodes = if *disable_jump_to_jump_forwarding
                                #
                                nodes;
                            else 
                                forall_nodes  do_block;

                                if *need_filter   list::filter  keep_block  nodes;
                                else                                        nodes;
                                fi;
                            fi;

                    if *dump_machcode_controlflow_graph_after_jump_to_jump_forwarding
                        #
                        pr_node =  mcg::dump_node (*dump_strm, mcg);

                        fil::write (*dump_strm, "[ after jump-chain elimination ]\n");

                        list::apply pr_node nodes;
                    fi;
                end;
        end;
    };
end;

## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext