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/flowgraph/cfg.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/flowgraph/cfg.sml

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

revision 959, Fri Oct 12 21:21:41 2001 UTC revision 984, Wed Nov 21 19:00:08 2001 UTC
# Line 4  Line 4 
4   * -- Allen   * -- Allen
5   *)   *)
6  functor ControlFlowGraph  functor ControlFlowGraph
7     (structure PseudoOps : PSEUDO_OPS     (structure I : INSTRUCTIONS
     structure I : INSTRUCTIONS  
8      structure GraphImpl : GRAPH_IMPLEMENTATION      structure GraphImpl : GRAPH_IMPLEMENTATION
9      structure InsnProps : INSN_PROPERTIES      structure InsnProps : INSN_PROPERTIES
10                          where I = I                          where I = I
11      structure Asm : INSTRUCTION_EMITTER      structure Asm : INSTRUCTION_EMITTER where I = I
12                          where P = PseudoOps  
                           and I = I  
13     ) : CONTROL_FLOW_GRAPH =     ) : CONTROL_FLOW_GRAPH =
14  struct  struct
15    
16      structure I = I      structure I = I
17      structure P = PseudoOps      structure P = Asm.S.P
18      structure C = I.C      structure C = I.C
19      structure W = Freq      structure W = Freq
20      structure G = Graph      structure G = Graph
 (*****  
      structure L = GraphLayout  
 *****)  
21      structure A = Annotations      structure A = Annotations
22      structure S = Asm.S      structure S = Asm.S
23    
# Line 34  Line 29 
29        | NORMAL         (* normal node *)        | NORMAL         (* normal node *)
30        | HYPERBLOCK     (* hyperblock *)        | HYPERBLOCK     (* hyperblock *)
31    
     and data = LABEL  of Label.label  
              | PSEUDO of P.pseudo_op  
   
32      and block =      and block =
33         BLOCK of         BLOCK of
34         {  id          : int,                        (* block id *)         {  id          : int,                        (* block id *)
35            kind        : block_kind,                 (* block kind *)            kind        : block_kind,                 (* block kind *)
36            freq        : weight ref,                 (* execution frequency *)            freq        : weight ref,                 (* execution frequency *)
           data        : data list ref,              (* data preceeding block *)  
37            labels      : Label.label list ref,       (* labels on blocks *)            labels      : Label.label list ref,       (* labels on blocks *)
38            insns       : I.instruction list ref,     (* in rev order *)            insns       : I.instruction list ref,     (* in rev order *)
39              align       : P.pseudo_op option ref,     (* alignment only *)
40            annotations : Annotations.annotations ref (* annotations *)            annotations : Annotations.annotations ref (* annotations *)
41         }         }
42    
# Line 67  Line 59 
59      datatype info =      datatype info =
60          INFO of { annotations : Annotations.annotations ref,          INFO of { annotations : Annotations.annotations ref,
61                    firstBlock  : int ref,                    firstBlock  : int ref,
62                    reorder     : bool ref                    reorder     : bool ref,
63                      data        : P.pseudo_op list ref
64                  }                  }
65    
66      type cfg = (block,edge_info,info) Graph.graph      type cfg = (block,edge_info,info) Graph.graph
# Line 97  Line 90 
90      *      *
91      *========================================================================*)      *========================================================================*)
92      fun defineLabel(BLOCK{labels=ref(l::_),...}) = l      fun defineLabel(BLOCK{labels=ref(l::_),...}) = l
93        | defineLabel(BLOCK{labels, data, ...}) = let        | defineLabel(BLOCK{labels, ...}) = let
94            val l = Label.anon ()            val l = Label.anon ()
95            in            in
96              labels := [l];              labels := [l];
# Line 110  Line 103 
103          BLOCK{ id          = id,          BLOCK{ id          = id,
104                 kind        = kind,                 kind        = kind,
105                 freq        = freq,                 freq        = freq,
                data        = ref [],  
106                 labels      = ref [],                 labels      = ref [],
107                 insns       = ref insns,                 insns       = ref insns,
108                   align       = ref NONE,
109                 annotations = ref []                 annotations = ref []
110               }               }
111    
112      fun copyBlock(id,BLOCK{kind,freq,data,labels,insns,annotations,...}) =      fun copyBlock(id,BLOCK{kind,freq,align,labels,insns,annotations,...}) =
113          BLOCK{ id          = id,          BLOCK{ id          = id,
114                 kind        = kind,                 kind        = kind,
115                 freq        = ref (!freq),                 freq        = ref (!freq),
                data        = ref (!data),  
116                 labels      = ref [],                 labels      = ref [],
117                   align       = ref (!align),
118                 insns       = ref (!insns),                 insns       = ref (!insns),
119                 annotations = ref (!annotations)                 annotations = ref (!annotations)
120               }               }
# Line 170  Line 163 
163          ) handle Overflow => print("Bad footer\n")          ) handle Overflow => print("Bad footer\n")
164    
165      fun emitStuff outline annotations      fun emitStuff outline annotations
166             (block as BLOCK{insns,data,labels,...}) =             (block as BLOCK{insns,labels,...}) =
167         let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =         let val S as S.STREAM{pseudoOp,defineLabel,emit,...} =
168                 Asm.makeStream annotations                 Asm.makeStream annotations
169         in  emitHeader S block;         in  emitHeader S block;
            app (fn PSEUDO p => pseudoOp p  
                  | LABEL l  => defineLabel l) (!data);  
170             app defineLabel (!labels);             app defineLabel (!labels);
171             if outline then () else app emit (rev (!insns));             if outline then () else app emit (rev (!insns));
172             emitFooter S block             emitFooter S block
# Line 193  Line 184 
184      fun new() =      fun new() =
185          let val info = INFO{ annotations = ref [],          let val info = INFO{ annotations = ref [],
186                               firstBlock  = ref 0,                               firstBlock  = ref 0,
187                               reorder     = ref false                               reorder     = ref false,
188                                 data        = ref []
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{ annotations = ref [],          let val info = INFO{ annotations = ref [],
194                               firstBlock  = #firstBlock graph_info,                               firstBlock  = #firstBlock graph_info,
195                               reorder     = #reorder graph_info                               reorder     = #reorder graph_info,
196                                 data        = #data graph_info
197                             }                             }
198          in  UpdateGraphInfo.update CFG info end          in  UpdateGraphInfo.update CFG info end
199    
# Line 314  Line 307 
307     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""     in  foldr (fn (x,"") => x | (x,y) => x^" "^y) ""
308              (String.tokens (fn #" " => true | _ => false) text)              (String.tokens (fn #" " => true | _ => false) text)
309     end     end
   
 (*****  
     fun headerText block = getString  
         (fn b => emitHeader (Asm.makeStream []) b) block  
    fun footerText block = getString  
         (fn b => emitFooter (Asm.makeStream []) b) block  
   
    fun getStyle a = (case #get L.STYLE (!a) of SOME l => l | NONE => [])  
   
    val green = L.COLOR "green"  
    val red   = L.COLOR "red"  
    val yellow = L.COLOR "yellow"  
   
    fun edgeStyle(i,j,e as EDGE{k,a,...}) =  
    let val a = L.LABEL(show_edge e) :: getStyle a  
    in  case k of  
          (ENTRY | EXIT) => green :: a  
        | (FALLSTHRU | BRANCH false) => yellow :: a  
        | _ => red :: a  
    end  
   
    val outline = MLRiscControl.getFlag "view-outline"  
   
    fun viewStyle cfg =  
    let val an     = !(annotations cfg)  
        fun node (n,b as BLOCK{annotations,...}) =  
            if !outline then  
               L.LABEL(getString emitOutline b) :: getStyle annotations  
            else  
               L.LABEL(show_block an b) :: getStyle annotations  
    in  { graph = fn _ => [],  
          edge  = edgeStyle,  
          node  = node  
        }  
    end  
   
    fun viewLayout cfg = L.makeLayout (viewStyle cfg) cfg  
   
    fun subgraphLayout {cfg,subgraph = G.GRAPH subgraph} =  
    let val an     = !(annotations cfg)  
        fun node(n,b as BLOCK{annotations,...}) =  
           if #has_node subgraph n then  
              L.LABEL(show_block an b) :: getStyle annotations  
           else  
              L.COLOR "lightblue"::L.LABEL(headerText b) :: getStyle annotations  
        fun edge(i,j,e) =  
             if #has_edge subgraph (i,j) then edgeStyle(i,j,e)  
             else [L.EDGEPATTERN "dotted"]  
    in  L.makeLayout {graph = fn _ => [],  
                      edge  = edge,  
                      node  = node} cfg  
    end  
 *****)  
   
310  end  end
311    

Legend:
Removed from v.959  
changed lines
  Added in v.984

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