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/SMLNJ/src/MLRISC/alpha32/alpha32Asm.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/alpha32/alpha32Asm.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 113 - (view) (download)

1 : monnier 16 (* alpha32Asm.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     functor Alpha32AsmEmitter
8 :     (structure Instr : ALPHA32INSTR
9 :     structure FlowGraph : FLOWGRAPH
10 :     structure Shuffle : ALPHA32SHUFFLE
11 :     sharing FlowGraph.I = Shuffle.I = Instr) : EMITTER_NEW =
12 :     struct
13 :     structure I = Instr
14 :     structure C = I.C
15 :     structure F = FlowGraph
16 :     structure R = I.Region
17 :    
18 :     structure Constant = I.Constant
19 :    
20 :     fun ms n = if n<0 then ("-" ^ Int.toString (~n)) else Int.toString n
21 :    
22 :     fun error msg = MLRiscErrorMsg.impossible ("Alpha32AsEmitter." ^ msg)
23 :    
24 :     fun emit s = TextIO.output(!AsmStream.asmOutStream,s)
25 :    
26 :     fun pseudoOp pOp = emit(F.P.toString pOp)
27 :    
28 :     fun defineLabel(lab) = emit(Label.nameOf lab ^ ":\n")
29 :    
30 :     fun comment msg = emit ("\t/* " ^ msg ^ " */")
31 :    
32 :     fun init size = (comment ("Code Size = " ^ ms size);
33 :     emit ".set\tnoat\n")
34 :    
35 :    
36 :     fun emitInstr(instr,regmap) = let
37 :     datatype register = REG | FREG
38 :    
39 :     fun rmap r = (Intmap.map regmap r) handle _ => r
40 :     fun eReg (i) = emit ("$" ^ ms(rmap i))
41 :     fun eFreg(f) = emit("$f" ^ ms(rmap f))
42 :     fun eLabel lab = emit (Label.nameOf lab)
43 :     fun newline () = emit "\n"
44 :     fun comma() = emit ", "
45 :     fun tab() = emit "\t"
46 :     fun emitLExp lexp = emit(LabelExp.toString lexp)
47 :    
48 :     fun eOperand (I.REGop r) = eReg r
49 :     | eOperand (I.IMMop n) = emit (ms n)
50 :     | eOperand (I.CONSTop c) = emit(Constant.toString c)
51 :     | eOperand (I.LOLABop l) = (emit "LO("; emitLExp l;emit ")")
52 :     | eOperand (I.HILABop l) = (emit "HI("; emitLExp l; emit ")")
53 :     | eOperand (I.LABop l) = emitLExp l
54 :    
55 :     fun parenthesize f = (emit "("; f(); emit ")")
56 :    
57 :     fun eDisp(rd, disp) = (eOperand(disp); parenthesize (fn () => eReg rd))
58 :    
59 :     fun eMemFormat REG (reg, base, disp) =
60 :     (eReg reg; comma(); eDisp (base, disp))
61 :     | eMemFormat FREG (freg, base, disp) =
62 :     (eFreg freg; comma(); eDisp (base, disp))
63 :    
64 :     fun eBrFormat REG (reg, lab) =
65 :     (eReg reg; comma(); eLabel lab)
66 :     | eBrFormat FREG (freg, lab) =
67 :     (eFreg freg; comma(); eLabel lab)
68 :    
69 :     fun eOpFormat (rs, opnd, rd) =
70 :     (eReg rs; comma(); eOperand opnd; comma(); eReg rd)
71 :    
72 :     fun eFOpFormat (f1, f2, fd) =
73 :     (eFreg f1; comma(); eFreg f2; comma(); eFreg fd)
74 :    
75 :     fun eFOpFormat2 (31, f2, fd) = (eFreg f2; comma(); eFreg fd)
76 :     | eFOpFormat2 arg = eFOpFormat arg
77 :    
78 :     fun emitLDA {r, b, d} =
79 :     (eReg r; comma();
80 :     case (b, d)
81 :     of (31, _) => eOperand d
82 :     | _ => (eOperand d; parenthesize(fn () => eReg b))
83 :     (*esac*))
84 :    
85 :     fun emitJumps{r, b, d=0} =
86 :     (eReg r; comma(); parenthesize(fn () => eReg b))
87 :     | emitJumps _ = error "emitJumps"
88 :    
89 :     fun branch(I.BR) = "br"
90 :     | branch(I.BEQ) = "beq"
91 :     | branch(I.BGE) = "bge"
92 :     | branch(I.BGT) = "bgt"
93 :     | branch(I.BLE) = "ble"
94 :     | branch(I.BLT) = "blt"
95 :     | branch(I.BNE) = "bne"
96 :     | branch(I.BLBC) = "blbc"
97 :     | branch(I.BLBS) = "blbs"
98 :     in
99 :     ((case instr
100 :     of I.DEFFREG f => comment("deffreg\t$f" ^ ms(rmap f))
101 :     | I.LDA arg => (emit "\tlda\t"; emitLDA arg)
102 :     | I.LDAH arg =>(emit "\tldah\t"; emitLDA arg)
103 :     | I.LOAD{ldOp, r, b, d, mem} =>
104 :     (emit(case ldOp
105 :     of I.LDL => "\tldl\t"
106 :     | I.LDQ => "\tldq\t"
107 :     | I.LDQ_U => "\tldq_u\t"
108 :     (*esac*));
109 :     eMemFormat REG (r, b, d);
110 :     comment(R.toString mem))
111 :     | I.FLOAD{ldOp, r, b, d, mem} =>
112 :     (emit(case ldOp
113 :     of I.LDT => "\tldt\t"
114 :     | I.LDS => "\tlds\t"
115 :     (*esac*));
116 :     eMemFormat FREG (r, b, d);
117 :     comment (R.toString mem))
118 :     | I.STORE{stOp, r, b, d, mem} =>
119 :     (emit(case stOp
120 :     of I.STL => "\tstl\t"
121 :     | I.STQ => "\tstq\t"
122 :     | I.STQ_U => "\tstq_u\t"
123 :     (*esac*));
124 :     eMemFormat REG (r, b, d);
125 :     comment(R.toString mem))
126 :     | I.FSTORE{stOp=I.STT, r, b, d, mem} =>
127 :     (emit "\tstt\t"; eMemFormat FREG (r, b, d); comment(R.toString mem))
128 :    
129 :     | I.JMPL(arg, _) => (emit "\tjmp\t"; emitJumps arg)
130 :     | I.JSR(arg, defs, uses)=> (emit "\tjsr\t"; emitJumps arg)
131 :     | I.BRANCH(brOp, reg, lab) =>
132 :     (emit("\t" ^ branch brOp ^ "\t"); eBrFormat REG (reg, lab))
133 :     | I.FBRANCH(fbrOp, freg, lab) =>
134 :     (emit("\tf" ^ branch fbrOp ^ "\t"); eBrFormat FREG (freg, lab))
135 :     | I.OPERATE{oper=I.BIS, ra=27, rb=I.REGop 31, rc=29} =>
136 :     emit "\tldgp\t$29, 0($27)"
137 :     | I.OPERATE{oper=I.BIS, ra=26, rb=I.REGop 31, rc=29} =>
138 :     emit "\tldgp\t$29, 0($26)"
139 :     (* ignore empty stack frame allocation/deallocation instructions.
140 :     * This can be generalized to any register if SGNXL is no longer
141 :     * required.
142 :     *)
143 :     | I.OPERATE{oper=I.ADDL, ra=30, rb=rb as I.CONSTop b, rc=30} =>
144 :     if Constant.valueOf b = 0 then ()
145 :     else (emit "\taddl\t"; eOpFormat(30, rb, 30))
146 :     | I.OPERATE{oper=I.SUBL, ra=30, rb=rb as I.CONSTop b, rc=30} =>
147 :     if Constant.valueOf b = 0 then ()
148 :     else (emit "\tsubl\t"; eOpFormat(30, rb, 30))
149 :     | I.OPERATE{oper, ra, rb, rc} =>
150 :     (emit(case oper
151 :     of I.ZAP => "\tzap\t"
152 :     | I.ADDL => "\taddl\t"
153 :     | I.ADDQ => "\taddq\t"
154 :     | I.SUBL => "\tsubl\t"
155 :     | I.SUBQ => "\tsubq\t"
156 :     | I.MULL => "\tmull\t"
157 :     | I.S4ADDL => "\ts4addl\t"
158 :     | I.S8ADDL => "\ts8addl\t"
159 :     | I.CMPULE => "\tcmpule\t"
160 :     | I.CMPULT => "\tcmpult\t"
161 :     | I.CMPEQ => "\tcmpeq\t"
162 :     | I.CMPLE => "\tcmple\t"
163 :     | I.CMPLT => "\tcmplt\t"
164 :     | I.SGNXL => "\taddl\t"
165 :     | I.AND => "\tand\t"
166 :     | I.BIS => "\tbis\t"
167 :     | I.XOR => "\txor\t"
168 :     | I.SRA => "\tsra\t"
169 :     | I.SRL => "\tsrl\t"
170 :     | I.SLL => "\tsll\t"
171 :     | I.INSBL => "\tinsbl\t"
172 :     | I.EXTBL => "\textbl\t"
173 :     | I.EXTQH => "\textqh\t"
174 :     | I.MSKBL => "\tmskbl\t"
175 :     | I.MSKLH => "\tmsklh\t"
176 :     (*esac*));
177 :     eOpFormat(ra, rb, rc))
178 :     | I.PSEUDOARITH{oper, ra, rb, rc, ...} =>
179 :     (emit(case oper
180 :     of I.DIVL => "\tdivl\t"
181 :     | I.DIVLU => "\tdivlu\t"
182 :     (*esac*));
183 :     eOpFormat(ra, rb, rc))
184 :    
185 :     | I.OPERATEV{oper, ra, rb, rc} =>
186 :     (emit(case oper
187 :     of I.ADDLV => "\taddlv\t"
188 :     | I.SUBLV => "\tsublv\t"
189 :     | I.MULLV => "\tmullv\t"
190 :     (*esac*));
191 :     eOpFormat(ra, rb, rc))
192 :    
193 :     | I.FOPERATE{oper, fa, fb, fc} =>
194 :     (emit(case oper
195 :     of I.CPYS => "\tcpys\t"
196 :     | I.CPYSN => "\tcpysn\t"
197 :     | I.CVTLQ => "\tcvtlq\t"
198 :     | I.CVTQT => "\tcvtqt\t"
199 :     | I.CMPTEQ => "\tcmpteqsu\t"
200 :     | I.CMPTLT => "\tcmptltsu\t"
201 :     | I.CMPTLE => "\tcmptlesu\t"
202 :     | I.CMPTUN => "\tcmptunsu\t"
203 :     (*esac*));
204 :     case oper
205 :     of I.CVTQT => eFOpFormat2(fa, fb, fc)
206 :     | _ => eFOpFormat2(fa, fb, fc)
207 :     (*esac*))
208 :     | I.FOPERATEV{oper, fa, fb, fc} =>
209 :     (emit(case oper
210 :     of I.CVTTQ => "\tcvttqc\t"
211 :     | I.ADDT => "\taddtsud\t"
212 :     | I.SUBT => "\tsubtsud\t"
213 :     | I.MULT => "\tmultsud\t"
214 :     | I.DIVT => "\tdivtsud\t"
215 :     (*esac*));
216 :     case oper
217 :     of I.CVTTQ => eFOpFormat2(fa, fb, fc)
218 :     | _ => eFOpFormat(fa, fb, fc)
219 :     (*esac*))
220 :    
221 :     | I.COPY{dst, src, tmp, ...} =>
222 :     app (fn instr => (emit "\t"; emitInstr(instr, regmap)))
223 :     (Shuffle.shuffle
224 :     {regMap=rmap, temp=tmp, dst=dst, src=src})
225 :     | I.FCOPY{dst, src, tmp, ...} =>
226 :     app (fn I => (emit "\t"; emitInstr(I, regmap)))
227 :     (Shuffle.shufflefp
228 :     {regMap=rmap, temp=tmp, dst=dst, src=src})
229 :     | I.TRAPB => emit"\ttrapb\t"
230 :    
231 :     | I.CALL_PAL{code, ...} =>
232 :     (emit "\tcall_pal\t";
233 :     emit(case code
234 :     of I.BPT => "0x80" | I.BUGCHK => "0x81" | I.CALLSYS => "0x83"
235 :     | I.GENTRAP => "0xaa" | I.IMB => "0x86"
236 :     | I.RDUNIQUE => "0x9e" | I.WRUNIQUE => "0x9f"
237 :     (*esac*)))
238 :     (* esac *));
239 :     emit "\n"
240 :     (*esac*))
241 :     end
242 :    
243 :     end
244 :    
245 :    
246 :    
247 :    
248 :    
249 :     (*
250 : monnier 113 * $Log$
251 : monnier 16 *)

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