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

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/block-placement/jump-chain-elim-fn.sml
ViewVC logotype

Annotation of /MLRISC/trunk/block-placement/jump-chain-elim-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : jhr 1090 (* jump-chain-elim-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 :     * Collapse jumps to jumps.
6 : jhr 1129 *
7 :     * TODO:
8 :     * check for jumps to the next block.
9 :     * jump tables (SWITCH edges).
10 : jhr 1090 *)
11 :    
12 :     functor JumpChainElimFn (
13 :    
14 :     structure CFG : CONTROL_FLOW_GRAPH
15 :     structure InsnProps : INSN_PROPERTIES
16 : jhr 1105 where I = CFG.I
17 : jhr 1090
18 : jhr 1139 (* Control flag that when set true allows jumps to labels outside
19 :     * of the CFG to be chained. Set this false when there are many
20 :     * short jumps to a long jump that exits the CFG.
21 :     *)
22 :     val chainEscapes : bool ref
23 :    
24 :     (* Control flag that when set true allows the direction (forward or
25 :     * backward) of conditional jumps to be changed. Set this false
26 :     * when the direction of conditional branches is used to predict
27 :     * the branch.
28 :     *)
29 :     val reverseDirection : bool ref
30 :    
31 : jhr 1090 ) : sig
32 :    
33 :     structure CFG : CONTROL_FLOW_GRAPH
34 :    
35 : george 1133 val run : (CFG.cfg * CFG.node list) -> (CFG.cfg * CFG.node list)
36 : jhr 1090
37 :     end = struct
38 :    
39 :     structure CFG = CFG
40 :     structure IP = InsnProps
41 :     structure G = Graph
42 :    
43 : jhr 1105 (* flags *)
44 : jhr 1129 val disable = MLRiscControl.mkFlag (
45 :     "disable-jump-chain-elim",
46 :     "whether jump chain elimination is disabled")
47 :     val dumpCFG = MLRiscControl.mkFlag (
48 : jhr 1151 "dump-cfg-after-jump-chain-elim",
49 : jhr 1129 "whether flow graph is shown after jump chain elimination")
50 : jhr 1105 val dumpStrm = MLRiscControl.debug_stream
51 :    
52 : george 1133 fun error msg = MLRiscErrorMsg.error("JumpChainElimFn", msg)
53 :    
54 : jhr 1090 fun run (cfg, blocks) = let
55 :     val G.GRAPH{
56 :     node_info, out_edges, set_out_edges, in_edges,
57 : jhr 1164 forall_nodes, remove_node, ...
58 : jhr 1090 } = cfg
59 : jhr 1139 val chainEscapes = !chainEscapes
60 :     val reverseDirection = !reverseDirection
61 :     (* this flag is set to note that we need to filter out unreachable
62 :     * blocks after jump chaining.
63 :     *)
64 : jhr 1090 val needFilter = ref false
65 : jhr 1139 (* the exit block *)
66 : jhr 1164 val exit = CFG.exitId cfg
67 : jhr 1090 (* map a block ID to a label *)
68 :     fun labelOf blkId = (case node_info blkId
69 :     of CFG.BLOCK{labels=ref(lab::_), ...} => lab
70 :     | CFG.BLOCK{labels, ...} => let
71 :     val lab = Label.anon()
72 :     in
73 :     labels := [lab];
74 :     lab
75 :     end
76 :     (* end case *))
77 : george 1133 fun jumpLabelOf instr = (
78 :     case IP.branchTargets instr
79 :     of [IP.LABELLED lab] => lab
80 :     | _ => error ("jumpLabelOf")
81 :     (* end case *))
82 : jhr 1090 (* given a destination block ID, check to see if it is a block that consists
83 :     * a single jump instruction. If so, return the block ID and label of the
84 :     * block at the end of the jump chain; otherwise return NONE.
85 :     *)
86 :     fun followChain blkId = (case node_info blkId
87 : george 1133 of CFG.BLOCK{insns as ref[i], kind=CFG.NORMAL, ...} => (
88 : jhr 1090 (* a normal block with one instruction *)
89 :     case out_edges blkId
90 : jhr 1139 of [e as (_, dst, CFG.EDGE{k=CFG.JUMP, w, a})] =>
91 :     if ((dst <> exit) orelse chainEscapes)
92 :     then (
93 :     (* the instruction must be a jump so transitively follow it
94 :     * to get the target; but be careful to avoid infinite loops.
95 :     *)
96 :     set_out_edges (blkId, []);
97 :     case followChain dst
98 :     of NONE => (
99 :     set_out_edges (blkId, [e]);
100 :     SOME(dst, jumpLabelOf i))
101 :     | (someLab as SOME(dst', lab)) => (
102 :     insns := [IP.jump lab];
103 :     set_out_edges (blkId,
104 :     [(blkId, dst', CFG.EDGE{k=CFG.JUMP, w=w, a=a})]);
105 :     someLab)
106 :     (* end case *))
107 :     else NONE
108 : jhr 1090 | _ => NONE
109 :     (* end case *))
110 :     | _ => NONE
111 :     (* end case *))
112 : jhr 1135 (* For each normal block, check the outgoing edges to see if they
113 :     * can be redirected.
114 :     *)
115 : jhr 1090 fun doBlock (blkId, CFG.BLOCK{insns, kind=CFG.NORMAL, ...}) = let
116 : george 1133 fun setTargets labs = let
117 : mblume 1334 val (jmp, r) =
118 :     case !insns of
119 :     jmp :: r => (jmp, r)
120 :     | [] => error "setTargets: empty insns"
121 : george 1133 val newJmp =
122 :     (case labs
123 :     of [lab] => IP.setJumpTarget(jmp, lab)
124 :     | [lab1,lab2] => IP.setBranchTargets{i=jmp, f=lab1, t=lab2}
125 :     | _ => error "setTargets"
126 :     (*esac*))
127 :     in
128 :     needFilter := true;
129 :     insns := newJmp :: r
130 :     end
131 : jhr 1090 in
132 :     case out_edges blkId
133 :     of [(_, dst, info as CFG.EDGE{k=CFG.JUMP, ...})] => (
134 :     case followChain dst
135 :     of SOME(dst', lab) => (
136 :     setTargets [lab];
137 :     set_out_edges (blkId, [(blkId, dst', info)]))
138 :     | NONE => ()
139 :     (* end case *))
140 :     | [(_, dst1, info as CFG.EDGE{k=CFG.BRANCH true, ...}), e2] => (
141 :     case followChain dst1
142 :     of SOME(dst', lab) => (
143 : jhr 1129 setTargets [labelOf(#2 e2), lab];
144 : jhr 1090 set_out_edges (blkId, [(blkId, dst', info), e2]))
145 :     | NONE => ()
146 :     (* end case *))
147 :     | [e1, (_, dst2, info as CFG.EDGE{k=CFG.BRANCH true, ...})] => (
148 :     case followChain dst2
149 :     of SOME(dst', lab) => (
150 : jhr 1129 setTargets [labelOf(#2 e1), lab];
151 : jhr 1090 set_out_edges (blkId, [e1, (blkId, dst', info)]))
152 :     | NONE => ()
153 :     (* end case *))
154 :     | _ => ()
155 :     (* end case *)
156 :     end
157 :     | doBlock _ = ()
158 : jhr 1164 val entry = CFG.entryId cfg
159 : jhr 1135 fun keepBlock (blkId, _) =
160 :     if null(in_edges blkId) andalso (blkId <> entry)
161 :     then (remove_node blkId; false)
162 :     else true
163 : jhr 1105 val blocks = if !disable
164 :     then blocks
165 :     else (
166 :     forall_nodes doBlock;
167 :     if !needFilter then List.filter keepBlock blocks else blocks)
168 : jhr 1090 in
169 : jhr 1105 if !dumpCFG
170 : jhr 1113 then let
171 :     val prBlock = CFG.dumpBlock (!dumpStrm, cfg)
172 :     in
173 :     TextIO.output(!dumpStrm, "[ after jump-chain elimination ]\n");
174 :     List.app prBlock blocks
175 :     end
176 : jhr 1105 else ();
177 : george 1133 (cfg, blocks)
178 : jhr 1090 end
179 :    
180 :     end

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