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

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/MLRISC/IR/mlrisc-cfg-gen.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/MLRISC/IR/mlrisc-cfg-gen.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Sep 3 00:25:03 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 1  Line 1 
1    (*
2     * This module takes a stream of instructions and build a CFG.
3     * The building can be incremental.
4     *
5     * -- Allen
6     *)
7  functor ControlFlowGraphGenFn  functor ControlFlowGraphGenFn
8     (structure CFG     : CONTROL_FLOW_GRAPH     (structure CFG     : CONTROL_FLOW_GRAPH
9      structure Emitter : CODE_EMITTER      structure Stream  : INSTRUCTION_STREAM
10      structure P       : INSN_PROPERTIES      structure InsnProps : INSN_PROPERTIES
11          sharing CFG.I = Emitter.I = P.I          sharing CFG.I = InsnProps.I
12          sharing CFG.P = Emitter.P          sharing CFG.P = Stream.P
13          sharing CFG.B = Emitter.B          sharing CFG.B = Stream.B
14     ) : CONTROL_FLOW_GRAPH_GEN =     ) : CONTROL_FLOW_GRAPH_GEN =
15  struct  struct
16    
17     structure CFG     = CFG     structure CFG     = CFG
18     structure Props   = P     structure Props   = InsnProps
19     structure I       = CFG.I     structure I       = CFG.I
20     structure B       = CFG.B     structure B       = CFG.B
21     structure P       = CFG.P     structure P       = CFG.P
22     structure G       = Graph     structure G       = Graph
23     structure W       = CFG.W     structure W       = CFG.W
24     structure Emitter = Emitter     structure S       = Stream
25    
26     fun error msg = MLRiscErrorMsg.impossible("ControlFlowGraphGen." ^ msg)     fun error msg = MLRiscErrorMsg.error("ControlFlowGraphGen",msg)
27    
28     fun warning msg = print("Warning: "^msg^"\n")     fun warning msg = print("Warning: "^msg^"\n")
29    
30     fun emitter(CFG as G.GRAPH cfg) =     fun builder(CFG) =
31     let val currentBlock = ref NONE : CFG.block option ref     let val currentBlock = ref NONE : CFG.block option ref
32         val newBlocks    = ref [] : CFG.block list ref         val newBlocks    = ref [] : CFG.block list ref
33         val blkName      = ref B.default         val blkName      = ref B.default
        val _            = CFG.init CFG  
        val [ENTRY]      = #entries cfg ()  
        val [EXIT]       = #exits cfg ()  
34         exception NotFound         exception NotFound
35         val labelMap = Intmap.new(43,NotFound)         val labelMap = Intmap.new(43,NotFound)
36         val newLabel = Intmap.add labelMap         val newLabel = Intmap.add labelMap
37           val CFG = ref CFG
38    
39           fun init _ =
40               (currentBlock := NONE;
41                newBlocks := [];
42                blkName := B.default;
43                Intmap.clear labelMap;
44                CFG.init(!CFG)
45               )
46    
47           val _ = init()
48    
49           fun next cfg = (CFG := cfg; init())
50    
51         fun newBlock() =         fun newBlock() =
52               let val id = #new_id cfg ()               let val G.GRAPH cfg = !CFG
53                   val b  = CFG.newBlock(id,!blkName)                   val id = #new_id cfg ()
54                     val b  = CFG.newBlock(id,!blkName,ref 0)
55               in  currentBlock := SOME b;               in  currentBlock := SOME b;
56                   newBlocks := b :: !newBlocks;                   newBlocks := b :: !newBlocks;
57                   #add_node cfg (id,b);                   #add_node cfg (id,b);
# Line 71  Line 88 
88    
89         fun comment msg =         fun comment msg =
90             let val CFG.BLOCK{annotations,...} = getBlock()             let val CFG.BLOCK{annotations,...} = getBlock()
91             in  annotations := Annotations.COMMENT msg :: !annotations             in  annotations := BasicAnnotations.COMMENT msg :: !annotations
92             end             end
93    
94         fun blockName name = blkName := name         fun annotation a =
95               let val CFG.BLOCK{annotations,...} = getBlock()
96               in  annotations := a :: !annotations
97               end
98    
99         fun blockName name = blkName := name         fun blockName name = blkName := name
100    
101         fun entryLabel(l as Label.Label{id,...}) =         fun entryLabel(l as Label.Label{id,...}) =
102         let val b as CFG.BLOCK{id=j,labels,...} = newPseudoOpBlock()         let val G.GRAPH cfg = !CFG
103               val b as CFG.BLOCK{id=j,labels,...} = newPseudoOpBlock()
104               val ENTRY = case #entries cfg () of
105                              [ENTRY] => ENTRY
106                           |  _ => raise Graph.NotSingleEntry
107         in  labels := l :: !labels;         in  labels := l :: !labels;
108             newLabel(id,b);             newLabel(id,b);
109             #add_edge cfg (ENTRY,j,CFG.EDGE{k=CFG.ENTRY,a=ref [],             #add_edge cfg (ENTRY,j,CFG.EDGE{k=CFG.ENTRY,a=ref [],w=ref 0})
                                            w=ref W.zero})  
110         end         end
111    
112         fun emitInstr i =         fun emitInstr i =
113             let val CFG.BLOCK{insns,...} = getBlock()             let val CFG.BLOCK{insns,...} = getBlock()
114             in  insns := i :: !insns;             in  insns := i :: !insns;
# Line 92  Line 116 
116                    currentBlock := NONE                    currentBlock := NONE
117                 else ()                 else ()
118             end             end
119         fun finish() =  
120             let  fun nextBlock(CFG.BLOCK{id,data=ref [],...}::_) = id         fun finish(regmap,annotations) =
121           let val G.GRAPH cfg = !CFG
122               val EXIT = case #exits cfg () of
123                            [EXIT] => EXIT
124                          | _ => raise Graph.NotSingleExit
125               fun nextBlock(CFG.BLOCK{id,data=ref [],...}::_) = id
126                    | nextBlock _ = error "nextBlock"                    | nextBlock _ = error "nextBlock"
127                  fun target (Label.Label{id,...}) =                  fun target (Label.Label{id,...}) =
128                      let val CFG.BLOCK{id,...} = Intmap.map labelMap id                      let val CFG.BLOCK{id,...} = Intmap.map labelMap id
# Line 116  Line 145 
145                                          Int.toString i^" -> "^Int.toString j)                                          Int.toString i^" -> "^Int.toString j)
146                         ;                         ;
147                         #add_edge cfg (i,j,CFG.EDGE{k=CFG.FALLSTHRU,                         #add_edge cfg (i,j,CFG.EDGE{k=CFG.FALLSTHRU,
148                                                     w=ref W.zero,                                                w=ref 0, a=ref []
                                                    a=ref []  
149                                                    })                                                    })
150                        )                        )
151                    | fallsThru(i,[]) =                    | fallsThru(i,[]) =
152                         error("missing return in block "^Int.toString i)                         error("missing return in block "^Int.toString i)
153                  and jump(i,[Props.ESCAPES],_) =                  and jump(i,[Props.ESCAPES],_) =
154                          #add_edge cfg (i,EXIT,CFG.EDGE{k=CFG.EXIT,                          #add_edge cfg (i,EXIT,CFG.EDGE{k=CFG.EXIT,
155                                                         w=ref W.zero,                                                    w=ref 0,a=ref []
                                                        a=ref []  
156                                                        })                                                        })
157                    | jump(i,[Props.LABELLED L],_) =                    | jump(i,[Props.LABELLED L],_) =
158                         #add_edge cfg (i,target L,CFG.EDGE{k=CFG.JUMP,                         #add_edge cfg (i,target L,CFG.EDGE{k=CFG.JUMP,
159                                                            w=ref W.zero,                                                       w=ref 0, a=ref []})
                                                           a=ref []})  
160                    | jump(i,[Props.LABELLED L,Props.FALLTHROUGH],bs) =                    | jump(i,[Props.LABELLED L,Props.FALLTHROUGH],bs) =
161                         (#add_edge cfg (i,target L,CFG.EDGE{k=CFG.BRANCH true,                         (#add_edge cfg (i,target L,CFG.EDGE{k=CFG.BRANCH true,
162                                                             w=ref W.zero,                                                        w=ref 0, a=ref []
                                                            a=ref []  
163                                                            });                                                            });
164                          #add_edge cfg (i,nextBlock bs,CFG.EDGE                          #add_edge cfg (i,nextBlock bs,CFG.EDGE
165                                                            {k=CFG.BRANCH false,                                                            {k=CFG.BRANCH false,
166                                                             w=ref W.zero,                                                        w=ref 0, a=ref []
                                                            a=ref []  
167                                                            })                                                            })
168                         )                         )
169                    | jump(i,targets,_) =                    | jump(i,targets,_) =
# Line 147  Line 171 
171                               | f(n,Props.LABELLED L::targets) =                               | f(n,Props.LABELLED L::targets) =
172                               (#add_edge cfg (i,target L,CFG.EDGE                               (#add_edge cfg (i,target L,CFG.EDGE
173                                                          {k=CFG.SWITCH n,                                                          {k=CFG.SWITCH n,
174                                                           w=ref W.zero,                                                      w=ref 0, a=ref []});
                                                          a=ref []});  
175                                f(n+1,targets))                                f(n+1,targets))
176                               | f _ = error "jump"                               | f _ = error "jump"
177                         in  f(0,targets) end                         in  f(0,targets) end
178             in  addEdges(rev(!newBlocks))            in  addEdges(rev(!newBlocks));
179                  CFG.setRegmap(!CFG,regmap);
180                  CFG.setAnnotations(!CFG,annotations);
181                  init()
182             end             end
183    
184      in      in  {stream=S.STREAM
185          {  init        = fn _ => (),             {  init        = init,
186             defineLabel = defineLabel,             defineLabel = defineLabel,
187             entryLabel  = entryLabel,             entryLabel  = entryLabel,
188             pseudoOp    = pseudoOp,             pseudoOp    = pseudoOp,
189             emitInstr   = emitInstr,                emit        = fn _ => emitInstr,
190             exitBlock   = exitBlock,             exitBlock   = exitBlock,
191             blockName   = blockName,             blockName   = blockName,
192             comment     = comment,             comment     = comment,
193                  annotation  = annotation,
194             finish      = finish             finish      = finish
195               },
196             next = next
197          }          }
198      end      end
199    
200  end  end
201    
 (*  
  * $Log$  
  *)  

Legend:
Removed from v.410  
changed lines
  Added in v.411

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