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/trunk/src/compiler/CodeGen/alpha32/alpha32CG.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/alpha32/alpha32CG.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 418 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/CodeGen/alpha32/alpha32CG.sml

1 : monnier 247 (* alpha32CG.sml --- 32 bit DEC alpha code generator
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 : monnier 411 functor Alpha32CG(structure Emitter : INSTRUCTION_EMITTER
7 : monnier 247 where I = Alpha32Instr
8 : monnier 411 where P = Alpha32PseudoOps
9 :     where S.B = Alpha32MLTree.BNames
10 :     ) : MACHINE_GEN =
11 : monnier 247 struct
12 :    
13 :     structure I = Alpha32Instr
14 : monnier 411 structure C = AlphaCells
15 : monnier 247 structure R = Alpha32CpsRegs
16 :     structure B = Alpha32MLTree.BNames
17 :     structure F = Alpha32FlowGraph
18 :     structure Asm = Alpha32AsmEmitter
19 :     structure MLTree = Alpha32MLTree
20 :     structure MachSpec = Alpha32Spec
21 :     structure Ctrl = Control.MLRISC
22 :    
23 :     fun error msg = ErrorMsg.impossible ("Alpha32CG." ^ msg)
24 :    
25 :     val stack = Alpha32Instr.Region.stack
26 :    
27 : monnier 411 structure Alpha32Rewrite = AlphaRewrite(Alpha32Instr)
28 : monnier 247
29 :     (* properties of instruction set *)
30 : monnier 411 structure P = AlphaProps(Alpha32Instr)
31 : monnier 247
32 : monnier 411 structure FreqProps = FreqProps(P)
33 : monnier 247
34 :     (* Label backpatching and basic block scheduling *)
35 :     structure BBSched =
36 :     BBSched2(structure Flowgraph = F
37 :     structure Jumps =
38 : monnier 411 AlphaJumps(structure Instr=Alpha32Instr
39 :     structure Shuffle=Alpha32Shuffle)
40 : monnier 247 structure Emitter = Emitter)
41 :    
42 :     (* flow graph pretty printing routine *)
43 : monnier 411 (*
44 : monnier 247 structure PrintFlowGraph =
45 :     PrintFlowGraphFn (structure FlowGraph = F
46 :     structure Emitter = Asm)
47 : monnier 411 *)
48 : monnier 247
49 :     val intSpillCnt = Ctrl.getInt "ra-int-spills"
50 :     val floatSpillCnt = Ctrl.getInt "ra-float-spills"
51 :     val intReloadCnt = Ctrl.getInt "ra-int-reloads"
52 :     val floatReloadCnt = Ctrl.getInt "ra-float-reloads"
53 :    
54 :     (* register allocation *)
55 :     structure RegAllocation :
56 :     sig
57 :     val ra : F.cluster -> F.cluster
58 :     val cp : F.cluster -> F.cluster
59 :     end =
60 :     struct
61 :    
62 :     (* spill area management *)
63 :     val initialSpillOffset = 128
64 :     val spillOffset = ref initialSpillOffset
65 :     fun newOffset n =
66 :     if n > 4096
67 :     then error "newOffset - spill area is too small"
68 :     else spillOffset := n
69 :     exception RegSpills and FregSpills
70 :    
71 :     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))
72 :     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))
73 :    
74 :     (* get spill location for general registers *)
75 :     fun getRegLoc reg = Intmap.map (!regSpills) reg
76 :     handle RegSpills => let
77 :     val offset = !spillOffset
78 :     in
79 :     newOffset(offset+4);
80 :     Intmap.add (!regSpills) (reg, offset);
81 :     offset
82 :     end
83 :    
84 :     (* get spill location for floating registers *)
85 :     fun getFregLoc freg = Intmap.map (!fregSpills) freg
86 :     handle FregSpills => let
87 :     val offset = !spillOffset
88 :     val fromInt = Word.fromInt
89 :     val aligned = Word.toIntX(Word.andb(fromInt offset+0w7, fromInt ~8))
90 :     in
91 :     newOffset(aligned+8);
92 :     Intmap.add (!fregSpills) (freg, aligned);
93 :     aligned
94 :     end
95 :    
96 :     fun mvInstr(rd, rs) = I.OPERATE{oper=I.BIS, ra=rs, rb=I.REGop 31, rc=rd}
97 :     fun fmvInstr(fd, fs) = I.FOPERATE{oper=I.CPYS, fa=fs, fb=fs, fc=fd}
98 :    
99 :    
100 :     fun spill (stClass, stOp, getLoc, newReg, rewrite, cnts)
101 :     {regmap,instr,reg,id:B.name} = let
102 :     val offset = I.IMMop (getLoc(reg))
103 :     fun spillInstr(src) =
104 :     [stClass{stOp=stOp, r=src, b=C.stackptrR, d=offset, mem=stack}]
105 :     in
106 :     cnts := !cnts + 1;
107 :     case instr
108 :     of I.COPY{dst as [rd], src as [rs], tmp, impl} =>
109 :     if rd=reg then
110 :     {code=spillInstr(rs), instr=NONE, proh=[]:int list}
111 :     else (case tmp
112 :     of SOME(I.Direct r) => let
113 :     val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}
114 :     val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
115 :     in {code=[], instr=SOME instr, proh=[]}
116 :     end
117 :     | _ => error "spill: COPY"
118 :     (*esac*))
119 :     | I.FCOPY{dst as [fd], src as [fs], tmp, impl} => (* reg = fd *)
120 :     if reg=fd then
121 :     {code=spillInstr(fs), instr=NONE, proh=[]}
122 :     else (case tmp
123 :     of SOME(I.FDirect r) => let
124 :     val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}
125 :     val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
126 :     in {code=[], instr=SOME instr, proh=[]}
127 :     end
128 :     | _ => error "spill: COPY"
129 :     (*esac*))
130 :     | _ => let
131 :     val newR = newReg()
132 :     val instr' = rewrite(regmap, instr, reg, newR)
133 :     in {code=spillInstr(newR), instr=SOME instr', proh=[newR]}
134 :     end
135 :     end
136 :    
137 :     fun reload (ldClass, ldOp, getLoc, newReg, rewrite, cnts)
138 :     {regmap,instr,reg,id:B.name} = let
139 :     val offset = I.IMMop (getLoc(reg))
140 :     fun reloadInstr(dst, rest) =
141 :     ldClass{ldOp=ldOp, r=dst, b=C.stackptrR, d=offset, mem=stack}::rest
142 :     in
143 :     cnts := !cnts + 1;
144 :     case instr
145 :     of I.COPY{dst=[rd], src=[rs], ...} => (* reg = rs *)
146 :     {code=reloadInstr(rd, []), proh=[]:int list}
147 :     | I.FCOPY{dst=[fd], src=[fs], ...} => (* reg = fs *)
148 :     {code=reloadInstr(fd, []), proh=[]}
149 :     | _ => let
150 :     val newR = newReg()
151 :     val instr' = rewrite(regmap, instr, reg, newR)
152 :     in {code=reloadInstr(newR, [instr']), proh=[newR]}
153 :     end
154 :     end
155 :    
156 :     fun spillInit () =
157 :     (spillOffset := initialSpillOffset;
158 :     regSpills := Intmap.new(8, RegSpills);
159 :     fregSpills := Intmap.new(8, FregSpills))
160 :    
161 : monnier 411 structure GR = GetReg(val nRegs=32 val available=R.availR val first=0)
162 :     structure FR = GetReg(val nRegs=32 val available=R.availF val first=32)
163 : monnier 247
164 :     structure Alpha32Ra =
165 : monnier 411 AlphaRegAlloc(structure P = P
166 :     structure I = Alpha32Instr
167 :     structure F = F
168 :     structure Asm = Asm)
169 : monnier 247
170 :     (* register allocation for general purpose registers *)
171 :     structure IntRa =
172 :     Alpha32Ra.IntRa
173 :     (structure RaUser = struct
174 :     structure I = Alpha32Instr
175 :     structure B = B
176 :    
177 :     val getreg = GR.getreg
178 :     val spill = spill(I.STORE, I.STL, getRegLoc, C.newReg,
179 :     Alpha32Rewrite.rewriteDef, intSpillCnt)
180 :     val reload = reload(I.LOAD, I.LDL, getRegLoc, C.newReg,
181 :     Alpha32Rewrite.rewriteUse, intReloadCnt)
182 :     val nFreeRegs = length R.availR
183 :     val dedicated = R.dedicatedR
184 :     fun copyInstr((rds, rss), I.COPY{tmp, ...}) =
185 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
186 :     end)
187 :    
188 :     (* register allocation for floating point registers *)
189 :     structure FloatRa =
190 :     Alpha32Ra.FloatRa
191 :     (structure RaUser = struct
192 :     structure I = Alpha32Instr
193 :     structure B = B
194 :    
195 :     val getreg = FR.getreg
196 :     val spill = spill (I.FSTORE, I.STT, getFregLoc, C.newFreg,
197 :     Alpha32Rewrite.frewriteDef, floatSpillCnt)
198 :     val reload = reload (I.FLOAD, I.LDT, getFregLoc, C.newFreg,
199 :     Alpha32Rewrite.frewriteUse, floatReloadCnt)
200 :     val nFreeRegs = length R.availF
201 :     val dedicated = R.dedicatedF
202 :     fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =
203 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
204 :     end)
205 :    
206 :     val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION []
207 :     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION []
208 :     val iCopyProp = IntRa.ra IntRa.COPY_PROPAGATION []
209 :     val fCopyProp = FloatRa.ra FloatRa.COPY_PROPAGATION []
210 :    
211 :     fun ra cluster = let
212 : monnier 411 (* val pg = PrintFlowGraph.printCluster TextIO.stdOut *)
213 : monnier 247 fun intRa cluster = (GR.reset(); iRegAlloc cluster)
214 :     fun floatRa cluster = (FR.reset(); fRegAlloc cluster)
215 :     in spillInit(); (floatRa o intRa) cluster
216 :     end
217 :     val cp = fCopyProp o iCopyProp
218 :     end (* RegAllocation *)
219 :    
220 :     val optimizerHook : (F.cluster->F.cluster) option ref = ref NONE
221 :    
222 :     (* primitives for generation of DEC alpha instruction flowgraphs *)
223 :     structure FlowGraphGen =
224 : monnier 411 ClusterGen(structure Flowgraph = F
225 :     structure InsnProps = P
226 :     structure MLTree = MLTree
227 :     structure Stream = Emitter.S
228 :     val optimize = optimizerHook
229 :     val output = BBSched.bbsched o RegAllocation.ra)
230 : monnier 247
231 :     (* compilation of CPS to MLRISC *)
232 :     structure MLTreeGen =
233 :     MLRiscGen(structure MachineSpec=Alpha32Spec
234 :     structure MLTreeComp=
235 : monnier 411 Alpha(structure AlphaInstr=Alpha32Instr
236 :     structure AlphaMLTree=Alpha32MLTree
237 :     structure Stream = Emitter.S
238 :     structure PseudoInstrs=Alpha32PseudoInstrs
239 :     val mode32bit = true (* simulate 32 bit mode *)
240 : monnier 418 val useSU = false
241 : monnier 411 val multCost = ref 8 (* just guessing *)
242 :     val useMultByConst = ref false (* just guessing *)
243 :     )
244 :     structure Flowgen=FlowGraphGen
245 :     structure Cells=AlphaCells
246 : monnier 247 structure C=Alpha32CpsRegs
247 :     structure PseudoOp=Alpha32PseudoOps)
248 :    
249 :     val copyProp = RegAllocation.cp
250 :     val codegen = MLTreeGen.codegen
251 :     val finish = BBSched.finish
252 :     end
253 :    
254 :    

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