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 /sml/trunk/src/MLRISC/block-placement/jump-chain-elim-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1113 - (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 :     *)
7 :    
8 :     functor JumpChainElimFn (
9 :    
10 :     structure CFG : CONTROL_FLOW_GRAPH
11 :     structure InsnProps : INSN_PROPERTIES
12 : jhr 1105 where I = CFG.I
13 : jhr 1090
14 :     ) : sig
15 :    
16 :     structure CFG : CONTROL_FLOW_GRAPH
17 :    
18 :     val run : (CFG.cfg * CFG.node list) -> CFG.node list
19 :    
20 :     end = struct
21 :    
22 :     structure CFG = CFG
23 :     structure IP = InsnProps
24 :     structure G = Graph
25 :    
26 : jhr 1105 (* flags *)
27 :     val disable = MLRiscControl.getFlag "disable-jump-chain-elim"
28 :     val dumpCFG = MLRiscControl.getFlag "dump-cfg-jump-chain-elim"
29 :     val dumpStrm = MLRiscControl.debug_stream
30 :    
31 : jhr 1090 fun run (cfg, blocks) = let
32 :     val G.GRAPH{
33 :     node_info, out_edges, set_out_edges, in_edges,
34 : jhr 1105 forall_nodes, remove_node, ...
35 : jhr 1090 } = cfg
36 :     val needFilter = ref false
37 :     (* map a block ID to a label *)
38 :     fun labelOf blkId = (case node_info blkId
39 :     of CFG.BLOCK{labels=ref(lab::_), ...} => lab
40 :     | CFG.BLOCK{labels, ...} => let
41 :     val lab = Label.anon()
42 :     in
43 :     labels := [lab];
44 :     lab
45 :     end
46 :     (* end case *))
47 :     (* given a destination block ID, check to see if it is a block that consists
48 :     * a single jump instruction. If so, return the block ID and label of the
49 :     * block at the end of the jump chain; otherwise return NONE.
50 :     *)
51 :     fun followChain blkId = (case node_info blkId
52 :     of CFG.BLOCK{insns as ref[_], kind=CFG.NORMAL, ...} => (
53 :     (* a normal block with one instruction *)
54 :     case out_edges blkId
55 :     of [e as (_, dst, CFG.EDGE{k=CFG.JUMP, w, a})] => (
56 :     (* the instruction must be a jump so transitively follow it
57 :     * to get the target; but be careful to avoid infinite loops.
58 :     *)
59 :     set_out_edges (blkId, []);
60 :     case followChain dst
61 :     of NONE => (
62 :     set_out_edges (blkId, [e]);
63 :     SOME(dst, labelOf dst))
64 :     | (someLab as SOME(dst', lab)) => (
65 :     insns := [IP.jump lab];
66 :     set_out_edges (blkId,
67 :     [(blkId, dst', CFG.EDGE{k=CFG.JUMP, w=w, a=a})]);
68 :     someLab)
69 :     (* end case *))
70 :     | _ => NONE
71 :     (* end case *))
72 :     | _ => NONE
73 :     (* end case *))
74 :     fun doBlock (blkId, CFG.BLOCK{insns, kind=CFG.NORMAL, ...}) = let
75 :     fun setTargets targets = let
76 :     val jmp::r = !insns
77 :     in
78 :     needFilter := true;
79 :     insns := IP.setTargets(jmp, targets) :: r
80 :     end
81 :     in
82 :     case out_edges blkId
83 :     of [(_, dst, info as CFG.EDGE{k=CFG.JUMP, ...})] => (
84 :     case followChain dst
85 :     of SOME(dst', lab) => (
86 :     setTargets [lab];
87 :     set_out_edges (blkId, [(blkId, dst', info)]))
88 :     | NONE => ()
89 :     (* end case *))
90 :     | [(_, dst1, info as CFG.EDGE{k=CFG.BRANCH true, ...}), e2] => (
91 :     case followChain dst1
92 :     of SOME(dst', lab) => (
93 :     setTargets [lab, labelOf(#2 e2)];
94 :     set_out_edges (blkId, [(blkId, dst', info), e2]))
95 :     | NONE => ()
96 :     (* end case *))
97 :     | [e1, (_, dst2, info as CFG.EDGE{k=CFG.BRANCH true, ...})] => (
98 :     case followChain dst2
99 :     of SOME(dst', lab) => (
100 :     setTargets [lab, labelOf(#2 e1)];
101 :     set_out_edges (blkId, [e1, (blkId, dst', info)]))
102 :     | NONE => ()
103 :     (* end case *))
104 :     (* FIXME: do something about jump tables *)
105 :     | _ => ()
106 :     (* end case *)
107 :     end
108 :     | doBlock _ = ()
109 : jhr 1105 fun keepBlock (blkId, _) = if null(in_edges blkId)
110 :     then (remove_node blkId; false)
111 :     else true
112 :     val blocks = if !disable
113 :     then blocks
114 :     else (
115 :     forall_nodes doBlock;
116 :     if !needFilter then List.filter keepBlock blocks else blocks)
117 : jhr 1090 in
118 : jhr 1105 if !dumpCFG
119 : jhr 1113 then let
120 :     val prBlock = CFG.dumpBlock (!dumpStrm, cfg)
121 :     in
122 :     TextIO.output(!dumpStrm, "[ after jump-chain elimination ]\n");
123 :     List.app prBlock blocks
124 :     end
125 : jhr 1105 else ();
126 :     blocks
127 : jhr 1090 end
128 :    
129 :     end

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