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/MLRISC/demo/demo-alpha.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/demo/demo-alpha.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 744 - (view) (download)

1 : leunga 713 (*
2 :     * The Alpha instruction set, specialized with respect to the
3 :     * user constant and region types.
4 :     *)
5 :     structure AlphaInstr = AlphaInstr
6 :     (structure LabelExp = LabelExp
7 :     structure Region = UserRegion
8 :     )
9 :    
10 :     (*
11 :     * How to serialize parallel copies
12 :     *)
13 :     structure AlphaShuffle = AlphaShuffle(AlphaInstr)
14 :    
15 :     (*
16 :     * The assembler
17 :     *)
18 :     structure AlphaAsm = AlphaAsmEmitter
19 :     (structure Instr = AlphaInstr
20 :     structure Stream = Stream
21 :     structure Shuffle = AlphaShuffle
22 :     val V9 = false (* we'll generate V8 instructions for now *)
23 :     )
24 :    
25 :     (*
26 :     * The flowgraph (cluster) representation specialized to the sparc instruction
27 :     * set.
28 :     *)
29 :     structure AlphaFlowGraph =
30 :     FlowGraph(structure I = AlphaInstr
31 :     structure P = UserPseudoOps
32 :     )
33 :     (*
34 :     * Alpha has no integer division. So they have to be handled specially.
35 :     * The following is stolen from Fermin's C-- source code.
36 :     *)
37 :     structure AlphaPseudoInstrs : ALPHA_PSEUDO_INSTR =
38 :     struct
39 :    
40 :     fun error msg = MLRiscErrorMsg.error ("AlphaPseudoInstrs", msg)
41 :    
42 :     structure I = AlphaInstr
43 :     structure T = MLTree
44 :     structure C = I.C
45 :    
46 : leunga 744 type reduceOpnd = I.operand -> C.cell
47 : leunga 713
48 :     (* reduceOpnd moves the operand to a register if it's not in one
49 :     already (handy).
50 :     div*, rem* are assembler macros. The alpha/osf assembler accepts
51 :     divl $1, 7, $1
52 :     but the alpha/linux assembler insists that the operand be a register
53 :     Sigh ...
54 :     *)
55 :    
56 : leunga 744 val temps = foldr C.addReg C.empty (map C.GPReg [23, 24, 25, 26, 28])
57 : leunga 713
58 :     fun pseudoArith instr ({ra, rb, rc}, reduceOpnd) =
59 :     [I.PSEUDOARITH{oper=instr, ra=ra, rb=I.REGop(reduceOpnd rb), rc=rc, tmps=temps}]
60 :    
61 :     fun divl operands = pseudoArith I.DIVL operands
62 :     fun divlu operands = pseudoArith I.DIVLU operands
63 :     fun divq operands = pseudoArith I.DIVQ operands
64 :     fun divqu operands = pseudoArith I.DIVQU operands
65 :     fun divlv _ = error "divlv"
66 :     fun divqv _ = error "divqv"
67 :    
68 :     fun reml operands = pseudoArith I.REML operands
69 :     fun remlu operands = pseudoArith I.REMLU operands
70 :     fun remq operands = pseudoArith I.REMQ operands
71 :     fun remqu operands = pseudoArith I.REMQU operands
72 :     fun remlv _ = error "remlv"
73 :     fun remqv _ = error "remqv"
74 :    
75 :     val stack = I.Region.stack
76 :     val sp = C.stackptrR
77 :    
78 :     val push16 = I.LDA{r=sp, b=sp, d=I.IMMop (~16)}
79 :     val pop16 = I.LDA{r=sp, b=sp, d=I.IMMop 16}
80 :    
81 :     (**** int to float ****)
82 :    
83 :     (* i32 -> f32 *)
84 :     fun cvtls({opnd, fd}, reduceOpnd) =
85 :     let val ra = reduceOpnd opnd
86 :     in
87 :     [push16,
88 :     I.STORE{stOp=I.STQ, r=ra, b=sp, d=I.IMMop 0, mem=stack},
89 :     I.FLOAD{ldOp=I.LDT, r=fd, b=sp, d=I.IMMop 0, mem=stack},
90 :     pop16,
91 :     I.FUNARY{oper=I.CVTQS, fb=fd, fc=fd}]
92 :     end
93 :    
94 :     (* i32 -> f64 *)
95 :     fun cvtlt({opnd, fd}, reduceOpnd) =
96 :     let val ra = reduceOpnd opnd
97 :     in
98 :     [push16,
99 :     I.STORE{stOp=I.STQ, r=ra, b=sp, d=I.IMMop 0, mem=stack},
100 :     I.FLOAD{ldOp=I.LDT, r=fd, b=sp, d=I.IMMop 0, mem=stack},
101 :     pop16,
102 :     I.FUNARY{oper=I.CVTQT, fb=fd, fc=fd}]
103 :     end
104 :    
105 :     (* i64 -> f32 *)
106 :     val cvtqs = cvtls
107 :    
108 :     (* i64 -> f64 *)
109 :     val cvtqt = cvtlt
110 :    
111 :     (**** float to int ****)
112 :    
113 :     (* TODO: These should really look at the rounding mode, and not generate
114 :     CVTTQ_C blindly *)
115 :    
116 :     (* f32 -> i32 *)
117 :     fun cvtsl({mode, fs, rd}) = let
118 :     val ftmp = AlphaCells.newFreg()
119 :     in
120 :     [I.FUNARY{oper=I.CVTTQC, fb=fs, fc=ftmp},
121 :     push16,
122 :     I.FSTORE{stOp=I.STT, r=ftmp, b=sp, d=I.IMMop 0, mem=stack},
123 :     I.LOAD {ldOp=I.LDL, r=rd, b=sp, d=I.IMMop 0, mem=stack},
124 :     pop16
125 :     ]
126 :     end
127 :    
128 :     (* f64 -> i32 *)
129 :     val cvttl= cvtsl
130 :    
131 :    
132 :     (* f32 -> i64 *)
133 :     fun cvtsq({mode, fs, rd}) = let
134 :     val ftmp = AlphaCells.newFreg()
135 :     in
136 :     [I.FUNARY{oper=I.CVTTQC, fb=fs, fc=ftmp},
137 :     push16,
138 :     I.FSTORE{stOp=I.STT, r=ftmp, b=sp, d=I.IMMop 0, mem=stack},
139 :     I.LOAD {ldOp=I.LDQ, r=rd, b=sp, d=I.IMMop 0, mem=stack},
140 :     pop16
141 :     ]
142 :     end
143 :    
144 :     (* f64 -> i64 *)
145 :     val cvttq = cvtsq
146 :    
147 :    
148 :     end (* AlphaPseudoInstrs *)
149 :    
150 :     (*
151 :     * Instruction selection module for Alpha.
152 :     *)
153 :     structure AlphaMLTreeComp =
154 :     Alpha(structure AlphaInstr = AlphaInstr
155 :     structure AlphaMLTree = MLTree
156 :     structure PseudoInstrs = AlphaPseudoInstrs
157 :     structure ExtensionComp = UserMLTreeExtComp
158 :     (structure I = AlphaInstr
159 :     structure T = AlphaMLTree
160 :     )
161 :     (* Some alpha specific parameters *)
162 :     val mode32bit = false (* simulate 32 bit mode *)
163 :     val multCost = ref 8 (* just guessing *)
164 :     val useMultByConst = ref false (* just guessing *)
165 :     val byteWordLoadStores = ref false
166 :     val SMLNJfloatingPoint = false (* must be true for SML/NJ *)
167 :     )
168 :    
169 :    
170 :     (*
171 :     * Alpha specific backend
172 :     *)
173 :     structure AlphaBackEnd =
174 :     BackEnd
175 :     (structure I = AlphaInstr
176 :     structure Flowgraph = AlphaFlowGraph
177 :     structure InsnProps = AlphaProps(AlphaInstr)
178 :     structure Asm = AlphaAsm
179 :     structure MLTreeComp = AlphaMLTreeComp
180 :    
181 :     val sp = I.C.stackptrR
182 :     val spill = UserRegion.spill
183 :    
184 :     (* I'm assuming only r31 and the stack pointer is dedicated *)
185 : leunga 744 structure RA =
186 :     RISC_RA
187 :     (structure I = I
188 :     structure C = I.C
189 :     structure Flowgraph = Flowgraph
190 :     structure Asm = Asm
191 :     structure Rewrite = AlphaRewrite(AlphaInstr)
192 :     structure InsnProps = InsnProps
193 :     structure Spill = RASpill(structure Asm = Asm
194 :     structure InsnProps = InsnProps)
195 :     structure SpillHeur = ChaitinSpillHeur
196 :     structure SpillTable =
197 :     SpillTable
198 :     (val initialSpillOffset = 0 (* This is probably wrong!!!!! *)
199 :     val spillAreaSz = 4000
200 :     val architecture = "Alpha"
201 :     )
202 : leunga 713
203 : leunga 744 open SpillTable
204 :    
205 :     fun pure _ = false
206 :    
207 :     (* make copies *)
208 :     structure Int =
209 :     struct
210 :     val dedicated = [I.C.stackptrR, I.C.GPReg 31]
211 :     val avail =
212 :     C.SortedCells.return(
213 :     C.SortedCells.difference(
214 :     C.SortedCells.uniq(
215 :     C.Regs C.GP {from=0, to=31, step=1}),
216 :     C.SortedCells.uniq dedicated))
217 : leunga 713
218 : leunga 744 fun copy((rds as [_], rss as [_]), _) =
219 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE}
220 :     | copy((rds, rss), I.COPY{tmp, ...}) =
221 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
222 :     (* spill register *)
223 :     fun spillInstr(_,r,loc) =
224 :     [I.STORE{stOp=I.STL, b=sp, d=I.IMMop(get loc),
225 :     r=r, mem=spill}]
226 : leunga 713
227 : leunga 744 (* spill copy temp *)
228 :     fun spillCopyTmp(_,I.COPY{tmp,dst,src,impl},loc) =
229 :     I.COPY{tmp=SOME(I.Displace{base=sp, disp=get loc}),
230 :     dst=dst,src=src,impl=impl}
231 :    
232 :     (* reload register *)
233 :     fun reloadInstr(_,r,loc) =
234 :     [I.LOAD{ldOp=I.LDL, b=sp, d=I.IMMop(get loc), r=r, mem=spill}]
235 :     end
236 : leunga 713
237 : leunga 744 structure Float =
238 :     struct
239 :     val dedicated = [I.C.FPReg 31]
240 :     val avail = C.Regs C.FP {from=0, to=30, step=1}
241 : leunga 713
242 : leunga 744 fun copy((fds as [_], fss as [_]), _) =
243 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE}
244 :     | copy((fds, fss), I.FCOPY{tmp, ...}) =
245 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
246 :    
247 :     fun spillCopyTmp(_,I.FCOPY{tmp,dst,src,impl},loc) =
248 :     I.FCOPY{tmp=SOME(I.Displace{base=sp, disp=getF loc}),
249 :     dst=dst,src=src,impl=impl}
250 :     fun spillInstr(_,r,loc) =
251 :     [I.FSTORE{stOp=I.STT, b=sp, d=I.IMMop(getF loc), r=r, mem=spill}]
252 :    
253 :     fun reloadInstr(_,r,loc) =
254 :     [I.FLOAD{ldOp=I.LDT, b=sp, d=I.IMMop(getF loc), r=r, mem=spill}]
255 :     end
256 :     )
257 : leunga 713 )
258 :    

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