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

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