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 93 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/CodeGen/alpha32/alpha32CG.sml

1 : monnier 16 (* 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 F = Alpha32FlowGraph) :
9 :     sig
10 :     structure MLTreeGen : CPSGEN
11 :     val finish : unit -> unit
12 :     end =
13 :     struct
14 :    
15 :     structure I = Alpha32Instr
16 :     structure C = Alpha32Cells
17 :     structure R = Alpha32CpsRegs
18 :     structure MLTree = Alpha32MLTree
19 :     structure CG = Control.CG
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 Alpha32Props =
29 :     Alpha32Props(structure Alpha32Instr= I val exnptrR = [14])
30 :    
31 :     (* Label backpatching and basic block scheduling *)
32 :     structure BBSched =
33 :     BBSched2(structure Flowgraph = Alpha32FlowGraph
34 :     structure Jumps =
35 :     Alpha32Jumps(structure Instr=Alpha32Instr
36 :     structure Shuffle=Alpha32Shuffle)
37 :     structure Emitter = Emitter)
38 :    
39 :     (* flow graph pretty printing routine *)
40 :     structure PrintFlowGraph =
41 :     PrintFlowGraphFn (structure FlowGraph = Alpha32FlowGraph
42 :     structure Emitter = Alpha32AsmEmitter)
43 :    
44 :     (* register allocation *)
45 :     structure RegAllocation :
46 :     sig
47 :     val ra : Alpha32FlowGraph.cluster -> Alpha32FlowGraph.cluster
48 :     end =
49 :     struct
50 :    
51 :     (* spill area management *)
52 :     val initialSpillOffset = 128
53 :     val spillOffset = ref initialSpillOffset
54 :     fun newOffset n =
55 :     if n > 4096
56 :     then error "newOffset - spill area is too small"
57 :     else spillOffset := n
58 :     exception RegSpills and FregSpills
59 :    
60 :     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))
61 :     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))
62 :    
63 :     (* get spill location for general registers *)
64 :     fun getRegLoc reg = Intmap.map (!regSpills) reg
65 :     handle RegSpills => let
66 :     val offset = !spillOffset
67 :     in
68 :     newOffset(offset+4);
69 :     Intmap.add (!regSpills) (reg, offset);
70 :     offset
71 :     end
72 :    
73 :     (* get spill location for floating registers *)
74 :     fun getFregLoc freg = Intmap.map (!fregSpills) freg
75 :     handle FregSpills => let
76 :     val offset = !spillOffset
77 :     val fromInt = Word.fromInt
78 :     val aligned = Word.toIntX(Word.andb(fromInt offset+0w7, fromInt ~8))
79 :     in
80 :     newOffset(aligned+8);
81 :     Intmap.add (!fregSpills) (freg, aligned);
82 :     aligned
83 :     end
84 :    
85 :     fun mvInstr(rd, rs) = I.OPERATE{oper=I.BIS, ra=rs, rb=I.REGop 31, rc=rd}
86 :     fun fmvInstr(fd, fs) = I.FOPERATE{oper=I.CPYS, fa=fs, fb=fs, fc=fd}
87 :    
88 :    
89 :     fun spill (stClass, stOp, getLoc, newReg, rewrite) {regmap,instr,reg} = let
90 :     val offset = I.IMMop (getLoc(reg))
91 :     fun spillInstr(src) =
92 :     [stClass{stOp=stOp, r=src, b=C.stackptrR, d=offset, mem=stack}]
93 :     in
94 :     case instr
95 :     of I.COPY{dst as [rd], src as [rs], tmp, impl} =>
96 :     if rd=reg then
97 :     {code=spillInstr(rs), instr=NONE, proh=[]:int list}
98 :     else (case tmp
99 :     of SOME(I.Direct r) => let
100 :     val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}
101 :     val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
102 :     in {code=[], instr=SOME instr, proh=[]}
103 :     end
104 :     | _ => error "spill: COPY"
105 :     (*esac*))
106 :     | I.FCOPY{dst as [fd], src as [fs], tmp, impl} => (* reg = fd *)
107 :     if reg=fd then
108 :     {code=spillInstr(fs), instr=NONE, proh=[]}
109 :     else (case tmp
110 :     of SOME(I.FDirect r) => let
111 :     val loc = I.Displace{base=C.stackptrR, disp=getLoc(r)}
112 :     val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
113 :     in {code=[], instr=SOME instr, proh=[]}
114 :     end
115 :     | _ => error "spill: COPY"
116 :     (*esac*))
117 :     | _ => let
118 :     val newR = newReg()
119 :     val instr' = rewrite(regmap, instr, reg, newR)
120 :     in {code=spillInstr(newR), instr=SOME instr', proh=[newR]}
121 :     end
122 :     end
123 :    
124 :     fun reload (ldClass, ldOp, getLoc, newReg, rewrite) {regmap,instr,reg} = let
125 :     val offset = I.IMMop (getLoc(reg))
126 :     fun reloadInstr(dst, rest) =
127 :     ldClass{ldOp=ldOp, r=dst, b=C.stackptrR, d=offset, mem=stack}::rest
128 :     in
129 :     case instr
130 :     of I.COPY{dst=[rd], src=[rs], ...} => (* reg = rs *)
131 :     {code=reloadInstr(rd, []), proh=[]:int list}
132 :     | I.FCOPY{dst=[fd], src=[fs], ...} => (* reg = fs *)
133 :     {code=reloadInstr(fd, []), proh=[]}
134 :     | _ => let
135 :     val newR = newReg()
136 :     val instr' = rewrite(regmap, instr, reg, newR)
137 :     in {code=reloadInstr(newR, [instr']), proh=[newR]}
138 :     end
139 :     end
140 :    
141 :     fun spillInit () =
142 :     (spillOffset := initialSpillOffset;
143 :     regSpills := Intmap.new(8, RegSpills);
144 :     fregSpills := Intmap.new(8, FregSpills))
145 :    
146 :     structure GR = GetReg(val nRegs=32 val available=R.availR)
147 :     structure FR = GetReg(val nRegs=32 val available=R.availF)
148 :    
149 :     structure Alpha32Ra =
150 :     Alpha32RegAlloc(structure P = Alpha32Props
151 :     structure I = Alpha32Instr
152 :     structure F = Alpha32FlowGraph
153 :     structure Asm = Alpha32AsmEmitter)
154 :    
155 :     (* register allocation for general purpose registers *)
156 :     structure IntRa =
157 :     Alpha32Ra.IntRa
158 :     (structure RaUser = struct
159 :     structure I = Alpha32Instr
160 :    
161 :     val getreg = GR.getreg
162 :     val spill = spill(I.STORE,I.STL, getRegLoc, C.newReg,
163 :     Alpha32Rewrite.rewriteDef)
164 :     val reload = reload(I.LOAD, I.LDL, getRegLoc, C.newReg,
165 :     Alpha32Rewrite.rewriteUse)
166 :     val nFreeRegs = length R.availR
167 :     val dedicated = R.dedicatedR
168 :     fun copyInstr((rds, rss), I.COPY{tmp, ...}) =
169 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
170 :     end)
171 :    
172 :     (* register allocation for floating point registers *)
173 :     structure FloatRa =
174 :     Alpha32Ra.FloatRa
175 :     (structure RaUser = struct
176 :     structure I = Alpha32Instr
177 :    
178 :     val getreg = FR.getreg
179 :     val spill = spill (I.FSTORE, I.STT, getFregLoc, C.newFreg,
180 :     Alpha32Rewrite.frewriteDef)
181 :     val reload = reload (I.FLOAD, I.LDT, getFregLoc, C.newFreg,
182 :     Alpha32Rewrite.frewriteUse)
183 :     val nFreeRegs = length R.availF
184 :     val dedicated = R.dedicatedF
185 :     fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =
186 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
187 :     end)
188 :    
189 :     val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION
190 :     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION
191 :     val iCopyProp = IntRa.ra IntRa.COPY_PROPAGATION
192 :    
193 :     fun ra cluster = let
194 :     val pg = PrintFlowGraph.printCluster TextIO.stdOut
195 :     fun intRa cluster = (GR.reset(); iRegAlloc cluster)
196 :     fun floatRa cluster = (FR.reset(); fRegAlloc cluster)
197 :     in spillInit(); (floatRa o intRa) cluster
198 :     end
199 :     end (* RegAllocation *)
200 :    
201 :     fun codegen cluster = let
202 :     fun phaseToMsg(CG.AFTER_INSTR_SEL) = "After instruction selection"
203 :     | phaseToMsg(CG.AFTER_RA) = "After register allocation"
204 :     | phaseToMsg(CG.AFTER_SCHED) = "After instruction scheduling"
205 :     | phaseToMsg _ = error "phaseToMsg"
206 :     val printGraph = PrintFlowGraph.printCluster (!CG.printFlowgraphStream)
207 :     fun doPhase (phase, f) cluster = let
208 :     fun show(CG.PHASES(ph1, ph2)) = show ph1 orelse show ph2
209 :     | show(ph) = (ph = phase)
210 :     val newCluster = f cluster
211 :     in
212 :     if show (!CG.printFlowgraph) then
213 :     printGraph (phaseToMsg phase) newCluster
214 :     else ();
215 :     newCluster
216 :     end
217 :     val instrSel = doPhase (CG.AFTER_INSTR_SEL, fn x => x)
218 :     val regAlloc = doPhase (CG.AFTER_RA, RegAllocation.ra)
219 :     in
220 :     case !CG.printFlowgraph
221 :     of CG.NO_PHASE => (BBSched.bbsched o RegAllocation.ra) cluster
222 :     | phase => (BBSched.bbsched o regAlloc o instrSel) cluster
223 :     end
224 :    
225 :     (* primitives for generation of DEC alpha instruction flowgraphs *)
226 :     structure FlowGraphGen =
227 :     FlowGraphGen(structure Flowgraph = Alpha32FlowGraph
228 :     structure InsnProps = Alpha32Props
229 :     structure MLTree = MLTree
230 :     val codegen = codegen)
231 :    
232 :     (* compilation of CPS to MLRISC *)
233 :     structure MLTreeGen =
234 :     MLRiscGen(structure MachineSpec=Alpha32Spec
235 :     structure MLTreeComp=
236 :     Alpha32(structure Flowgen=FlowGraphGen
237 :     structure Alpha32Instr=Alpha32Instr
238 :     structure Alpha32MLTree=Alpha32MLTree
239 :     structure PseudoInstrs=Alpha32PseudoInstrs)
240 :     structure Cells=Alpha32Cells
241 :     structure C=Alpha32CpsRegs
242 :     structure ConstType=Alpha32Const
243 :     structure PseudoOp=Alpha32PseudoOps)
244 :    
245 :     val finish = BBSched.finish
246 :     end
247 :    
248 :    
249 :     (*
250 :     * $Log: alpha32CG.sml,v $
251 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:54 george
252 :     * Version 110.5
253 : monnier 16 *
254 :     *)

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