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

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