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/compiler/OldCGen/mips/mipsmc.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/OldCGen/mips/mipsmc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (view) (download)

1 : monnier 16 (* mipsmc.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     structure KeepMipsMCode : sig
8 :     val code : Word8Array.array ref
9 :     val getCodeString : unit -> Word8Vector.vector
10 :     val cleanup : unit -> unit
11 :     end =
12 :     struct
13 :     open Word8Array
14 :     val code = ref (array(0,0w0))
15 :     fun getCodeString () = let
16 :     val s = extract (!code, 0, SOME(length (!code)))
17 :     in
18 :     code := array(0, 0w0); s
19 :     end
20 :     fun cleanup () = code := array(0,0w0)
21 :     end
22 :    
23 :     (** NOTE: this isn't the right way to parameterize this structure, since it
24 :     ** doesn't force any connection between MachSpec and E.
25 :     **)
26 :     functor MipsMCode(structure MSpec : MACH_SPEC and E : ENDIAN) : EMITTER = struct
27 :    
28 :     structure M = MipsInstrSet
29 :     structure K = KeepMipsMCode
30 :     open M
31 :    
32 :     val error = ErrorMsg.impossible
33 :    
34 :     val << = Word.<<
35 :     val >> = Word.>>
36 :     val ~>> = Word.~>>
37 :     val || = Word.orb
38 :     val & = Word.andb
39 :     infix << >> ~>> || &
40 :    
41 :     val itow = Word.fromInt
42 :    
43 :     val loc = ref 0
44 :    
45 :     fun init n = (K.code := Word8Array.array(n, 0w0); loc := 0)
46 :    
47 :     fun emitByte' b = let
48 :     val i = !loc
49 :     in
50 :     loc := i+1; Word8Array.update (!K.code, i, b)
51 :     end
52 :    
53 :     fun emitByte n = emitByte'(Word8.fromLargeWord(Word.toLargeWord n))
54 :    
55 :     fun emitHiLo(hi,lo) = let
56 :     val (byte0,byte1,byte2,byte3) = E.wordLayout (hi,lo)
57 :     in
58 :     emitByte byte0;
59 :     emitByte byte1;
60 :     emitByte byte2;
61 :     emitByte byte3
62 :     end
63 :    
64 :     fun emitLongX n = let
65 :     val w = itow n
66 :     in
67 :     emitHiLo((w ~>> 0w16) & 0w65535, w & 0w65535)
68 :     end
69 :    
70 :     fun emitLong n = let
71 :     val w = itow n
72 :     in
73 :     emitHiLo((w >> 0w16) & 0w65535, w & 0w65535)
74 :     end
75 :    
76 :     fun emitString s = Word8Vector.app emitByte' (Byte.stringToBytes s)
77 :    
78 :     exception BadReal = IEEEReal.BadReal
79 :     val emitReal = emitString o E.order_real o IEEEReal.realconst
80 :    
81 :     fun emitAddr (INFO{addrOf,...}) (lab,k) = emitLongX (k + addrOf lab - !loc)
82 :    
83 :     fun define _ _ = ()
84 :    
85 :     fun mark() = emitLong(LargeWord.toInt(MSpec.ObjDesc.makeDesc(
86 :     (!loc + 4) div 4, MSpec.ObjDesc.tag_backptr)))
87 :    
88 :     fun comment _ = ()
89 :    
90 :     fun emitInstr info = let
91 :     val labelValue = M.labelValue info
92 :     val hiLabelValue = M.hiLabelValue info
93 :     val loLabelValue = M.loLabelValue info
94 :     val labBranchOff = M.labBranchOff info
95 :    
96 :     (* order of operands is identical to instr. format layout *)
97 :    
98 :     fun R_Type(opcode,rs',rt',rd',shamt,func) =
99 :     case (reg_rep rs', reg_rep rt', reg_rep rd')
100 :     of (Reg' rs, Reg' rt, Reg' rd) =>
101 :     emitHiLo((itow opcode << 0w10) || (itow rs << 0w5) || itow rt,
102 :     (itow rd << 0w11) || (itow shamt << 0w6) || itow func)
103 :     | _ => error "MipsMCode.R_Type:"
104 :    
105 :     fun I_Type(opcode,rs',rt',immed) =
106 :     case (reg_rep rs', reg_rep rt')
107 :     of (Reg' rs, Reg' rt) =>
108 :     emitHiLo((itow opcode << 0w10) || (itow rs << 0w5) || itow rt,
109 :     immed)
110 :     | _ => error "MipsMCode.I_Type:"
111 :    
112 :     fun R_Type_f(opcode,format,ft',fs',fd',func) =
113 :     case (reg_rep ft', reg_rep fs', reg_rep fd')
114 :     of (Freg' ft, Freg' fs, Freg' fd) =>
115 :     emitHiLo((itow opcode << 0w10) || (itow format << 0w5) || itow ft,
116 :     (itow fs << 0w11) || (itow fd << 0w6) || itow func)
117 :     | _ => error "MipsMCode.R_Type_f"
118 :    
119 :     fun I_Type_f(opcode,base',ft',immed) =
120 :     case (reg_rep base', reg_rep ft')
121 :     of (Reg' base, Freg' ft) =>
122 :     emitHiLo((itow opcode << 0w10) || (itow base << 0w5) || itow ft,
123 :     immed)
124 :     | _ => error "MipsMCode.I_Type_f:"
125 :    
126 :     fun immediate_arith (Immed16Op n) = M.chk_immed16 n
127 :     | immediate_arith (LabelOp labexp) = M.chk_immed16(labelValue labexp)
128 :     | immediate_arith (HiLabOp labexp) = hiLabelValue labexp
129 :     | immediate_arith (LoLabOp labexp) = loLabelValue labexp
130 :     | immediate_arith _ = error "MipsMCode.immediate_arith"
131 :    
132 :     fun immediate_mem (Immed16Off n) = M.chk_immed16 n
133 :     | immediate_mem (LabOff labexp) = M.chk_immed16(labelValue labexp)
134 :     | immediate_mem (HiLabOff labexp) = hiLabelValue labexp
135 :     | immediate_mem (LoLabOff labexp) = loLabelValue labexp
136 :    
137 :     fun immediate_branch (opnd as LabOff labexp) = let
138 :     val labOff = labBranchOff opnd
139 :     in
140 :     itow(labOff - ((!loc + 4) div 4))
141 :     end
142 :     | immediate_branch _ = error "MipsMCode.immdiate_branch: bad label"
143 :    
144 :     fun fcond M.UN = 0x31
145 :     | fcond M.EQ = 0x32
146 :     | fcond M.UEQ = 0x33
147 :     | fcond M.OLT = 0x34
148 :     | fcond M.ULT = 0x35
149 :     | fcond M.OLE = 0x36
150 :     | fcond M.ULE = 0x37
151 :     | fcond M.NGLE = 0x39
152 :     | fcond M.NGL = 0x3b
153 :     | fcond M.LT = 0x3c
154 :     | fcond M.NGE = 0x3d
155 :     | fcond M.LE = 0x3e
156 :     | fcond M.NGT = 0x3f
157 :     in
158 :     fn NOP => emitHiLo(0w0,0w0)
159 :    
160 :     | SLT(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,42)
161 :     | SLT(rt,rs,opnd) => I_Type(10,rs,rt,immediate_arith opnd)
162 :     | SLTU(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,43)
163 :     | SLTU(rt,rs,opnd) => I_Type(11,rs,rt,immediate_arith opnd)
164 :     | FCMP(cond, fs, ft) => R_Type_f(17,17,ft,fs,Freg 0, fcond cond)
165 :    
166 :     | JUMP rs => R_Type(0,rs,Reg 0,Reg 0,0,0x8)
167 :     | BEQ(true,rs,rt,opnd) => I_Type(0x4,rs,rt,immediate_branch opnd)
168 :     | BEQ(false,rs,rt,opnd) => I_Type(0x5,rs,rt,immediate_branch opnd)
169 :     | BCOP1(true, opnd) => I_Type_f(17,Reg 8,Freg 1,immediate_branch opnd)
170 :     | BCOP1(false, opnd) => I_Type_f(17,Reg 8,Freg 0,immediate_branch opnd)
171 :    
172 :     | ADD(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x20)
173 :     | ADD(rt,rs,opnd) => I_Type(8,rs,rt,immediate_arith opnd)
174 :     | ADDU(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x21)
175 :     | ADDU(rt,rs,opnd) => I_Type(9,rs,rt,immediate_arith opnd)
176 :     | AND(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x24)
177 :     | AND(rt,rs,opnd) => I_Type(12,rs,rt,immediate_arith opnd)
178 :     | OR(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x25)
179 :     | OR(rt,rs,opnd) => I_Type(13,rs,rt,immediate_arith opnd)
180 :     | XOR(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x26)
181 :     | XOR(rt,rs,opnd) => I_Type(14,rs,rt,immediate_arith opnd)
182 :     | SUB(rd,rs,rt) => R_Type(0,rs,rt,rd,0,0x22)
183 :     | SUBU(rd,rs,rt) => R_Type(0,rs,rt,rd,0,0x23)
184 :    
185 :     | MULT(rs,rt) => R_Type(0,rs,rt,Reg 0,0,0x18)
186 :     | MULTU(rs,rt) => R_Type(0,rs,rt,Reg 0,0,0x19)
187 :     | DIV(rs,rt) => R_Type(0,rs,rt,Reg 0,0,0x1a)
188 :     | DIVU(rs,rt) => R_Type(0,rs,rt,Reg 0,0,0x1b)
189 :     | MFHI rd => R_Type(0,Reg 0,Reg 0,rd,0,0x10)
190 :     | MFLO rd => R_Type(0,Reg 0,Reg 0,rd,0,0x12)
191 :     | BREAK n => R_Type(0,Reg 0,Reg n,Reg 0,0,13)
192 :    
193 :     | ADD_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,0)
194 :     | SUB_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,1)
195 :     | MUL_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,2)
196 :     | DIV_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,3)
197 :     | MOV_DOUBLE(fd,fs) => R_Type_f(17,17,Freg 0,fs,fd,6)
198 :     | NEG_DOUBLE(fd,fs) => R_Type_f(17,17,Freg 0,fs,fd,7)
199 :     | ABS_DOUBLE(fd,fs) => R_Type_f(17,17,Freg 0,fs,fd,5)
200 :     | CVTI2D(fd,fs) => R_Type_f(17,20,Freg 0,fs,fd,0x21)
201 :     | MTC1(rt,fs) =>
202 :     (case reg_rep rt
203 :     of Reg' rt' => R_Type_f(17,4, Freg rt',fs,Freg 0,0)
204 :     | _ => error "MipsMCode.emitInstr: MTC1")
205 :    
206 :     | LBU(rt,base,opnd) => I_Type(0x24,base,rt,immediate_mem opnd)
207 :     | SB(rt,base,opnd) => I_Type(0x28,base,rt,immediate_mem opnd)
208 :     | LW(rt,base,opnd) => I_Type(0x23,base,rt,immediate_mem opnd)
209 :     | SW(rt,base,opnd) => I_Type(0x2b,base,rt,immediate_mem opnd)
210 :     | LWC1(ft,base,opnd) => I_Type_f(0x31,base,ft,immediate_mem opnd)
211 :     | SWC1(ft,base,opnd) => I_Type_f(0x39,base,ft,immediate_mem opnd)
212 :     | LUI(rt,opnd) => I_Type(0xf,Reg 0,rt,immediate_mem opnd)
213 :    
214 :     | SLL(rd,rt,Int5 n) => R_Type(0,Reg 0,rt,rd,n,0)
215 :     | SLLV(rd,rt,rs) => R_Type(0,rs,rt,rd,0,4)
216 :     | SRA(rd,rt,Int5 n) => R_Type(0,Reg 0,rt,rd,n,3)
217 :     | SRAV(rd,rt,rs) => R_Type(0,rs,rt,rd,0,7)
218 :     | SRL(rd,rt,Int5 n) => R_Type(0,Reg 0,rt,rd,n,2)
219 :     | SRLV(rd,rt,rs) => R_Type(0,rs,rt,rd,0,6)
220 :     end (* local *)
221 :    
222 :     end
223 :    
224 :    
225 :    
226 :     (*
227 :     * $Log: mipsmc.sml,v $
228 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:48 george
229 :     * Version 110.5
230 : monnier 16 *
231 :     *)

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