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 /MLRISC/trunk/IR/mlrisc-cfg.sml
ViewVC logotype

Diff of /MLRISC/trunk/IR/mlrisc-cfg.sml

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

revision 411, Fri Sep 3 00:25:03 1999 UTC revision 429, Wed Sep 8 09:47:00 1999 UTC
# Line 9  Line 9 
9      structure P : PSEUDO_OPS      structure P : PSEUDO_OPS
10      structure GraphImpl : GRAPH_IMPLEMENTATION      structure GraphImpl : GRAPH_IMPLEMENTATION
11      structure Asm : INSTRUCTION_EMITTER      structure Asm : INSTRUCTION_EMITTER
     structure Ctrl : MLRISC_CONTROL  
12         sharing Asm.I = I         sharing Asm.I = I
13         sharing Asm.P = P         sharing Asm.P = P
14     ) : CONTROL_FLOW_GRAPH =     ) : CONTROL_FLOW_GRAPH =
# Line 66  Line 65 
65      type node = block Graph.node      type node = block Graph.node
66    
67      datatype info =      datatype info =
68          INFO of { regmap      : C.regmap ref,          INFO of { regmap      : C.regmap,
69                    annotations : Annotations.annotations ref,                    annotations : Annotations.annotations ref,
70                    firstBlock  : int ref,                    firstBlock  : int ref,
71                    reorder     : bool ref                    reorder     : bool ref
# Line 156  Line 155 
155           |  NONE => ()           |  NONE => ()
156          ) handle Overflow => print("Bad footer\n")          ) handle Overflow => print("Bad footer\n")
157    
158      fun emitStuff outline regmap (block as BLOCK{insns,data,labels,...}) =      fun emitStuff outline annotations regmap
159         let val S as S.STREAM{pseudoOp,defineLabel,emit,...} = Asm.makeStream()             (block as BLOCK{insns,data,labels,...}) =
160           let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
161                   Asm.makeStream annotations
162             val emit = emit (I.C.lookup regmap)             val emit = emit (I.C.lookup regmap)
163         in  emitHeader S block;         in  emitHeader S block;
164             app (fn PSEUDO p => pseudoOp p             app (fn PSEUDO p => pseudoOp p
# Line 168  Line 169 
169         end         end
170    
171      val emit = emitStuff false      val emit = emitStuff false
172      val emitOutline = emitStuff true      val emitOutline = emitStuff true []
173    
174     (*========================================================================     (*========================================================================
175      *      *
# Line 177  Line 178 
178      *========================================================================*)      *========================================================================*)
179      fun cfg info = GraphImpl.graph("CFG",info,10)      fun cfg info = GraphImpl.graph("CFG",info,10)
180      fun new(regmap) =      fun new(regmap) =
181          let val info = INFO{ regmap      = ref regmap,          let val info = INFO{ regmap      = regmap,
182                               annotations = ref [],                               annotations = ref [],
183                               firstBlock  = ref 0,                               firstBlock  = ref 0,
184                               reorder     = ref false                               reorder     = ref false
# Line 185  Line 186 
186          in  cfg info end          in  cfg info end
187    
188      fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =      fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
189          let val info = INFO{ regmap      = ref(! (#regmap graph_info)),          let val info = INFO{ regmap      = #regmap graph_info,
190                               annotations = ref [],                               annotations = ref [],
191                               firstBlock  = #firstBlock graph_info,                               firstBlock  = #firstBlock graph_info,
192                               reorder     = #reorder graph_info                               reorder     = #reorder graph_info
# Line 193  Line 194 
194          in  UpdateGraphInfo.update CFG info end          in  UpdateGraphInfo.update CFG info end
195    
196      fun init(G.GRAPH cfg) =      fun init(G.GRAPH cfg) =
197          if #order cfg () = 0 then          (case #entries cfg () of
198               [] =>
199             let val i     = #new_id cfg ()             let val i     = #new_id cfg ()
200                 val start = newStart(i,ref 0)                 val start = newStart(i,ref 0)
201                 val _     = #add_node cfg (i,start)                 val _     = #add_node cfg (i,start)
# Line 204  Line 206 
206                 #set_entries cfg [i];                 #set_entries cfg [i];
207                 #set_exits cfg [j]                 #set_exits cfg [j]
208             end             end
209          else ()          |  _ => ()
210            )
211    
212      fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =      fun changed(G.GRAPH{graph_info=INFO{reorder,annotations,...},...}) =
213           (app (fn CHANGED f => f() | _ => ()) (!annotations);           (app (fn CHANGED f => f() | _ => ()) (!annotations);
214            reorder := true)            reorder := true)
215    
216      fun regmap(G.GRAPH{graph_info=INFO{regmap,...},...}) = !regmap      fun regmap(G.GRAPH{graph_info=INFO{regmap,...},...}) = regmap
217      fun setRegmap(G.GRAPH{graph_info=INFO{regmap,...},...},r) = regmap := r  
218      fun setAnnotations(G.GRAPH{graph_info=INFO{annotations,...},...},a) =      fun setAnnotations(G.GRAPH{graph_info=INFO{annotations,...},...},a) =
219          annotations := a          annotations := a
220      fun reglookup cfg =  
221          let val regmap = regmap cfg      fun getAnnotations(G.GRAPH{graph_info=INFO{annotations=ref a,...},...}) = a
222              val look   = Intmap.map regmap  
223              fun lookup r = look r handle _ => r      fun reglookup cfg = C.lookup(regmap cfg)
224          in  lookup end  
225      fun get f (BLOCK{annotations,...}) = A.get f (!annotations)      fun get f (BLOCK{annotations,...}) = A.get f (!annotations)
226      fun liveOut b =      fun liveOut b =
227           case get (fn LIVEOUT x => SOME x | _ => NONE) b of           case get (fn LIVEOUT x => SOME x | _ => NONE) b of
# Line 275  Line 278 
278         val _      = AsmStream.withStream S f x         val _      = AsmStream.withStream S f x
279     in  StringStream.getString buffer end     in  StringStream.getString buffer end
280    
281     fun show_block regmap block =     fun show_block an regmap block =
282     let val text = getString (emit regmap) block     let val text = getString (emit an regmap) block
283     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
284              (String.tokens (fn #" " => true | _ => false) text)              (String.tokens (fn #" " => true | _ => false) text)
285     end     end
286    
287     fun headerText block = getString     fun headerText block = getString
288          (fn b => emitHeader (Asm.makeStream()) b) block          (fn b => emitHeader (Asm.makeStream []) b) block
289     fun footerText block = getString     fun footerText block = getString
290          (fn b => emitFooter (Asm.makeStream()) b) block          (fn b => emitFooter (Asm.makeStream []) b) block
291    
292     fun edgeStyle(i,j,e as EDGE{k,a,...}) =     fun edgeStyle(i,j,e as EDGE{k,a,...}) =
293     let val a = L.LABEL(show_edge e) :: !a     let val a = L.LABEL(show_edge e) :: !a
# Line 293  Line 296 
296         | _ => L.COLOR "red" :: a         | _ => L.COLOR "red" :: a
297     end     end
298    
299     val outline = Ctrl.getFlag "view-outline"     val outline = MLRiscControl.getFlag "view-outline"
300    
301     fun viewStyle cfg =     fun viewStyle cfg =
302     let val regmap = regmap cfg     let val regmap = regmap cfg
303           val an     = getAnnotations cfg
304         fun node (n,b as BLOCK{annotations,...}) =         fun node (n,b as BLOCK{annotations,...}) =
305             if !outline then             if !outline then
306                L.LABEL(getString (emitOutline regmap) b) :: !annotations                L.LABEL(getString (emitOutline regmap) b) :: !annotations
307             else             else
308                L.LABEL(show_block regmap b) :: !annotations                L.LABEL(show_block an regmap b) :: !annotations
309     in  { graph = fn _ => [],     in  { graph = fn _ => [],
310           edge  = edgeStyle,           edge  = edgeStyle,
311           node  = node           node  = node
# Line 312  Line 316 
316    
317     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
318     let val regmap = regmap cfg     let val regmap = regmap cfg
319           val an     = getAnnotations cfg
320         fun node(n,b as BLOCK{annotations,...}) =         fun node(n,b as BLOCK{annotations,...}) =
321            if #has_node subgraph n then            if #has_node subgraph n then
322               L.LABEL(show_block regmap b) :: !annotations               L.LABEL(show_block an regmap b) :: !annotations
323            else            else
324               L.COLOR "lightblue"::L.LABEL(headerText b) :: !annotations               L.COLOR "lightblue"::L.LABEL(headerText b) :: !annotations
325         fun edge(i,j,e) =         fun edge(i,j,e) =

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

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