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/branches/FLINT/src/compiler/CodeGen/alpha32x/alpha32xCG.sml
ViewVC logotype

Annotation of /sml/branches/FLINT/src/compiler/CodeGen/alpha32x/alpha32xCG.sml

Parent Directory Parent Directory | Revision Log Revision Log


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

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