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/alpha32x/alpha32xCG.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/alpha32x/alpha32xCG.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 139 - (view) (download)
Original Path: sml/branches/FLINT/src/compiler/CodeGen/alpha32x/alpha32xCG.sml

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

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