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/branches/SMLNJ/src/MLRISC/Glue/mlrisc-glue.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/Glue/mlrisc-glue.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)

1 : monnier 245 functor MLRISCGlue
2 :     (structure Asm : EMITTER_NEW
3 :     structure F : FLOWGRAPH
4 :     structure P : INSN_PROPERTIES
5 :     sharing P.I = Asm.I = F.I
6 :     sharing F.P = Asm.P
7 :     val copyProp : F.cluster -> F.cluster
8 :     val branchProb : P.I.instruction -> int
9 :     val patchBranch : {instr:P.I.instruction,backwards:bool} ->
10 :     P.I.instruction list
11 :     ) : MLRISC_GLUE =
12 :     struct
13 :    
14 :     structure F = F
15 :     structure I = F.I
16 :     structure B = F.B
17 :    
18 :     val mlrisc = MLRISC_Control.mlrisc
19 :     val phases = MLRISC_Control.mlrisc_phases
20 :    
21 :     val view_IR = MLRISC_Control.getFlag "view_IR"
22 :     val verbose = MLRISC_Control.getFlag "verbose"
23 :     val viewer = MLRISC_Control.getString "viewer"
24 :    
25 :     fun error msg = MLRiscErrorMsg.impossible("MLRISCGlue."^msg)
26 :    
27 :     structure GraphViewer = GraphViewerFn(AllDisplaysFn(val viewer = viewer))
28 :    
29 :     structure FormatInsn = FormatInstructionFn(Asm)
30 :    
31 :     structure CFG = ControlFlowGraphFn
32 :     (structure I = I
33 :     structure B = B
34 :     structure P = F.P
35 :     structure W = FixedPointFn(val decimal_bits = 8)
36 :     structure GraphImpl = DirectedGraph
37 :     structure Asm = Asm
38 :     )
39 :    
40 :     structure CFG2Cluster = CFG2ClusterFn
41 :     (structure CFG = CFG
42 :     structure F = F
43 :     val patchBranch = patchBranch
44 :     )
45 :    
46 :     structure Cluster2CFG = Cluster2CFGFn
47 :     (structure CFG = CFG
48 :     structure F = F
49 :     structure P = P
50 :     )
51 :    
52 :     structure Dom = DominatorTreeFn(DirectedGraph)
53 :    
54 :     structure CDG = ControlDependenceGraphFn
55 :     (structure Dom = Dom
56 :     structure GraphImpl = DirectedGraph
57 :     )
58 :    
59 :     structure Loop = LoopStructureFn
60 :     (structure Dom = Dom
61 :     structure GraphImpl = DirectedGraph
62 :     )
63 :    
64 :     structure Util = CFGUtilFn
65 :     (structure CFG = CFG
66 :     structure P = P
67 :     )
68 :    
69 :     structure IR = MLRISC_IRFn
70 :     (structure CFG = CFG
71 :     structure CDG = CDG
72 :     structure Loop = Loop
73 :     structure GraphViewer = GraphViewer
74 :     structure Util = Util
75 :     )
76 :    
77 :     structure Guess = StaticBranchPredictionFn(IR)
78 :    
79 :     structure Liveness = LivenessAnalysisFn(CFG)
80 :    
81 :     structure Reshape = ReshapeBranchesFn(structure IR = IR
82 :     structure P = P)
83 :    
84 :     fun view phase ir = if !view_IR then IR.view phase ir else ()
85 :    
86 :     val ssaParams = {copyPropagation=false,keepName=true,semiPruned=false}
87 :    
88 :     fun optimize cluster =
89 :     let datatype rep = IR of IR.IR
90 :     | CLUSTER of F.cluster
91 :     fun doPhase "copy-prop" (CLUSTER c) = CLUSTER(copyProp c)
92 :     | doPhase "cluster->cfg" (CLUSTER c) = IR(Cluster2CFG.cluster2cfg c)
93 :     | doPhase "cfg->cluster" (IR cfg) =
94 :     CLUSTER(CFG2Cluster.cfg2cluster{cfg=cfg,relayout=false})
95 :     | doPhase "guess" (r as IR ir) =
96 :     let fun prob(CFG.BLOCK{insns,...}) =
97 :     case !insns of
98 :     [] => 100
99 :     | jmp::_ => branchProb jmp
100 :     in Guess.profile {loopMultiplier=10,branchProb=prob} ir; r
101 :     end
102 :     | doPhase "reshape" (r as IR ir) = (Reshape.reshapeBranches ir; r)
103 :     | doPhase "view-cfg" (r as IR ir) = (view "cfg" ir; r)
104 :     | doPhase "view-dom" (r as IR ir) = (view "dom" ir; r)
105 :     | doPhase "view-pdom" (r as IR ir) = (view "pdom" ir; r)
106 :     | doPhase "view-doms" (r as IR ir) = (view "doms" ir; r)
107 :     | doPhase "view-cdg" (r as IR ir) = (view "cdg" ir; r)
108 :     | doPhase "view-loop" (r as IR ir) = (view "loop" ir; r)
109 :     | doPhase phase _ = error(phase)
110 :     fun doPhases [] (CLUSTER c) = c
111 :     | doPhases [] _ = error "cluster needed"
112 :     | doPhases (phase::phases) ir =
113 :     (if !verbose then print("["^phase^"]\n") else ();
114 :     doPhases phases (doPhase phase ir))
115 :     in doPhases (!phases) (CLUSTER cluster)
116 :     end
117 :    
118 :     fun codegen cluster = if !mlrisc then optimize cluster else cluster
119 :    
120 :     end

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