Annotation of /sml/trunk/src/MLRISC/alpha32/alpha32Asm.sml

Parent Directory | Revision Log

---

Revision 167 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/alpha32/alpha32Asm.sml

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

---

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