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

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

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

revision 743, Thu Dec 7 15:31:24 2000 UTC revision 744, Fri Dec 8 04:11:42 2000 UTC
# Line 62  Line 62 
62      type node = block Graph.node      type node = block Graph.node
63    
64      datatype info =      datatype info =
65          INFO of { regmap      : C.regmap,          INFO of { annotations : Annotations.annotations ref,
                   annotations : Annotations.annotations ref,  
66                    firstBlock  : int ref,                    firstBlock  : int ref,
67                    reorder     : bool ref                    reorder     : bool ref
68                  }                  }
# Line 80  Line 79 
79                (* escaping live out information *)                (* escaping live out information *)
80      val LIVEOUT = Annotations.new      val LIVEOUT = Annotations.new
81            (SOME(fn c => "Liveout: "^            (SOME(fn c => "Liveout: "^
82                          (LineBreak.lineBreak 75 (C.cellsetToString c))))                          (LineBreak.lineBreak 75
83                                (C.CellSet.toString c))))
84      exception Changed of string * (unit -> unit)      exception Changed of string * (unit -> unit)
85      val CHANGED = Annotations.new'      val CHANGED = Annotations.new'
86            {create=Changed,            {create=Changed,
# Line 149  Line 149 
149      fun emitFooter (S.STREAM{comment,...}) (BLOCK{annotations,...}) =      fun emitFooter (S.STREAM{comment,...}) (BLOCK{annotations,...}) =
150          (case #get LIVEOUT (!annotations) of          (case #get LIVEOUT (!annotations) of
151              SOME s =>              SOME s =>
152              let val regs = String.tokens Char.isSpace(C.cellsetToString s)              let val regs = String.tokens Char.isSpace(C.CellSet.toString s)
153                  val K = 7                  val K = 7
154                  fun f(_,[],s,l)    = s::l                  fun f(_,[],s,l)    = s::l
155                    | f(0,vs,s,l)    = f(K,vs,"   ",s::l)                    | f(0,vs,s,l)    = f(K,vs,"   ",s::l)
# Line 161  Line 161 
161           |  NONE => ()           |  NONE => ()
162          ) handle Overflow => print("Bad footer\n")          ) handle Overflow => print("Bad footer\n")
163    
164      fun emitStuff outline annotations regmap      fun emitStuff outline annotations
165             (block as BLOCK{insns,data,labels,...}) =             (block as BLOCK{insns,data,labels,...}) =
166         let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =         let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
167                 Asm.makeStream annotations                 Asm.makeStream annotations
            val emit = emit (I.C.lookup regmap)  
168         in  emitHeader S block;         in  emitHeader S block;
169             app (fn PSEUDO p => pseudoOp p             app (fn PSEUDO p => pseudoOp p
170                   | LABEL l  => defineLabel l) (!data);                   | LABEL l  => defineLabel l) (!data);
# Line 183  Line 182 
182      *      *
183      *========================================================================*)      *========================================================================*)
184      fun cfg info = GraphImpl.graph("CFG",info,10)      fun cfg info = GraphImpl.graph("CFG",info,10)
185      fun new(regmap) =      fun new() =
186          let val info = INFO{ regmap      = regmap,          let val info = INFO{ annotations = ref [],
                              annotations = ref [],  
187                               firstBlock  = ref 0,                               firstBlock  = ref 0,
188                               reorder     = ref false                               reorder     = ref false
189                             }                             }
190          in  cfg info end          in  cfg info end
191    
192      fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =      fun subgraph(CFG as G.GRAPH{graph_info=INFO graph_info,...}) =
193          let val info = INFO{ regmap      = #regmap graph_info,          let val info = INFO{ annotations = ref [],
                              annotations = ref [],  
194                               firstBlock  = #firstBlock graph_info,                               firstBlock  = #firstBlock graph_info,
195                               reorder     = #reorder graph_info                               reorder     = #reorder graph_info
196                             }                             }
# Line 223  Line 220 
220              reorder := true              reorder := true
221          end          end
222    
     fun regmap(G.GRAPH{graph_info=INFO{regmap,...},...}) = regmap  
   
223      fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a      fun annotations(G.GRAPH{graph_info=INFO{annotations=a,...},...}) = a
224    
225      fun liveOut (BLOCK{annotations, ...}) =      fun liveOut (BLOCK{annotations, ...}) =
# Line 306  Line 301 
301         val _      = AsmStream.withStream S f x         val _      = AsmStream.withStream S f x
302     in  StringOutStream.getString buffer end     in  StringOutStream.getString buffer end
303    
304     fun show_block an regmap block =     fun show_block an block =
305     let val text = getString (emit an regmap) block     let val text = getString (emit an) block
306     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
307              (String.tokens (fn #" " => true | _ => false) text)              (String.tokens (fn #" " => true | _ => false) text)
308     end     end
# Line 334  Line 329 
329     val outline = MLRiscControl.getFlag "view-outline"     val outline = MLRiscControl.getFlag "view-outline"
330    
331     fun viewStyle cfg =     fun viewStyle cfg =
332     let val regmap = regmap cfg     let val an     = !(annotations cfg)
        val an     = !(annotations cfg)  
333         fun node (n,b as BLOCK{annotations,...}) =         fun node (n,b as BLOCK{annotations,...}) =
334             if !outline then             if !outline then
335                L.LABEL(getString (emitOutline regmap) b) :: getStyle annotations                L.LABEL(getString emitOutline b) :: getStyle annotations
336             else             else
337                L.LABEL(show_block an regmap b) :: getStyle annotations                L.LABEL(show_block an b) :: getStyle annotations
338     in  { graph = fn _ => [],     in  { graph = fn _ => [],
339           edge  = edgeStyle,           edge  = edgeStyle,
340           node  = node           node  = node
# Line 350  Line 344 
344     fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg     fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg
345    
346     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =     fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =
347     let val regmap = regmap cfg     let val an     = !(annotations cfg)
        val an     = !(annotations cfg)  
348         fun node(n,b as BLOCK{annotations,...}) =         fun node(n,b as BLOCK{annotations,...}) =
349            if #has_node subgraph n then            if #has_node subgraph n then
350               L.LABEL(show_block an regmap b) :: getStyle annotations               L.LABEL(show_block an b) :: getStyle annotations
351            else            else
352               L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations               L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations
353         fun edge(i,j,e) =         fun edge(i,j,e) =

Legend:
Removed from v.743  
changed lines
  Added in v.744

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