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 713 - (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 :     type reduceOpnd = I.operand -> int
47 :    
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 :     val temps = foldr C.addReg C.empty [23, 24, 25, 26, 28]
57 :    
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 Rewrite = AlphaRewrite(AlphaInstr)
179 :     structure Asm = AlphaAsm
180 :     structure MLTreeComp = AlphaMLTreeComp
181 :    
182 :     val sp = I.C.stackptrR
183 :     val spill = UserRegion.spill
184 :    
185 :     (* I'm assuming only r31 and the stack pointer is dedicated *)
186 :     fun range(from,to) = if from > to then []
187 :     else from::range(from+1,to)
188 :     val dedicatedRegs = [I.C.stackptrR, I.C.GPReg 31]
189 :     val dedicatedFRegs = [I.C.FPReg 31]
190 :     val availRegs = SortedList.difference(
191 :     range(I.C.GPReg 0, I.C.GPReg 31),
192 :     SortedList.uniq dedicatedRegs)
193 :     val availFRegs = range(I.C.FPReg 0, I.C.FPReg 30)
194 :    
195 :     val initialSpillOffset = 0 (* This is probably wrong!!!!! *)
196 :     val spillAreaSize = 4000
197 :    
198 :     fun pure _ = false
199 :    
200 :     (* make copies *)
201 :     fun copyR((rds as [_], rss as [_]), _) =
202 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE}
203 :     | copyR((rds, rss), I.COPY{tmp, ...}) =
204 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
205 :     fun copyF((fds as [_], fss as [_]), _) =
206 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE}
207 :     | copyF((fds, fss), I.FCOPY{tmp, ...}) =
208 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
209 :    
210 :     (* spill copy temp *)
211 :     fun spillCopyTmp(I.COPY{tmp,dst,src,impl},loc) =
212 :     I.COPY{tmp=SOME(I.Displace{base=sp, disp=loc}),
213 :     dst=dst,src=src,impl=impl}
214 :     fun spillFcopyTmp(I.FCOPY{tmp,dst,src,impl},loc) =
215 :     I.FCOPY{tmp=SOME(I.Displace{base=sp, disp=loc}),
216 :     dst=dst,src=src,impl=impl}
217 :    
218 :     (* spill register *)
219 :     fun spillInstrR(r,offset) =
220 :     [I.STORE{stOp=I.STL, b=sp, d=I.IMMop offset, r=r, mem=spill}]
221 :     fun spillInstrF(r,offset) =
222 :     [I.FSTORE{stOp=I.STT, b=sp, d=I.IMMop offset, r=r, mem=spill}]
223 :    
224 :     (* reload register *)
225 :     fun reloadInstrR(r,offset,rest) =
226 :     I.LOAD{ldOp=I.LDL, b=sp, d=I.IMMop offset, r=r, mem=spill}::rest
227 :     fun reloadInstrF(r,offset,rest) =
228 :     I.FLOAD{ldOp=I.LDT, b=sp, d=I.IMMop offset, r=r, mem=spill}::rest
229 :     )
230 :    

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