![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mips.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / mips|
Return to mips.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / mips |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: functor MipsCM(MipsC : MIPSCODER) : CMACHINE = struct
3:
4: open MipsC System.Tags
5:
6: fun three f (Direct x, ea, Direct y) = f(x,ea,y)
7: | three f (ea, Direct x, Direct y) = f(x,ea,y)
8: | three f _ =ErrorMsg.impossible "neither arg to three f is register in mips"
9:
10:
11: val immed = Immed
12: fun isimmed(Immed i) = SOME i
13: | isimmed _ = NONE
14:
15: fun isreg(Direct(Reg i)) = SOME i | isreg _ = NONE
16: fun eqreg (a: EA) b = a=b
17:
18:
19:
20: val standardarg = Direct(Reg 2)
21: val standardcont = Direct(Reg 3)
22: val standardclosure = Direct(Reg 4)
23: val miscregs = map (Direct o Reg) [5,6,7,8,9,10,11,12,13,14,
24: 15,16,17,18,19]
25: val storeptr as Direct storeptr' = Direct(Reg 22)
26: val dataptr as Direct dataptr' = Direct(Reg 23)
27: val exnptr = Direct(Reg 30)
28:
29: (* internal use only *)
30: val my_arithtemp as Direct my_arithtemp'= Direct(Reg 20)
31: val my_ptrtemp as Direct my_ptrtemp' = Direct(Reg 21)
32:
33: (* exported for external use *)
34: val arithtemp as Direct arithtemp' = Direct(Reg 24)
35: val arithtemp2 as Direct arithtemp2'= Direct(Reg 25)
36:
37:
38: fun move (src,Direct dest) = M.move(src, dest)
39: | move _ = ErrorMsg.impossible "destination of move not register in mips"
40: val align = M.align
41: val mark = M.mark
42:
43: val emitlong = M.emitlong
44: val realconst = M.realconst
45: val emitstring = M.emitstring
46:
47: fun emitlab(i,Immedlab lab) = M.emitlab(i,lab)
48: | emitlab _ = ErrorMsg.impossible "bad emitlab arg in mips"
49: fun newlabel() = Immedlab(M.newlabel())
50: fun define (Immedlab lab) = M.define lab
51: | define _ = ErrorMsg.impossible "bad define arg in mips"
52: fun record(vl, Direct z) =
53: let open CPS
54: val len = List.length vl
55: fun f(i,nil) = ()
56: | f(i,(r, SELp(j,p))::rest) = (* follow ptrs to get the item *)
57: (M.lw(my_ptrtemp', r, j*4); f(i,(my_ptrtemp,p)::rest))
58: | f(i,(Direct r,OFFp 0)::rest) = (* simple store, last first *)
59: (M.sw(r, dataptr, i*4); f(i-1,rest))
60: | f(i,(Direct r, OFFp j)::rest) =
61: (M.add(r, Immed(4*j), my_ptrtemp');
62: f(i,(my_ptrtemp,OFFp 0)::rest))
63: | f(i,(ea,p)::rest) = (* convert to register-based *)
64: (M.move(ea, my_ptrtemp'); f(i,(my_ptrtemp,p)::rest))
65: in f(len - 1, rev vl); (* store first word in [[0(dataptr')]] *)
66: M.add(dataptr', Immed 4, z);
67: M.add(dataptr', Immed(4*len), dataptr')
68: end
69: | record _ = ErrorMsg.impossible "result of record not register in mips"
70:
71: fun select(i, r, Direct s) = M.lw(s, r, i*4)
72: | select _ = ErrorMsg.impossible "result of select not register in mips"
73:
74: fun offset(i, Direct r, Direct s) = M.add(r,Immed(i*4), s)
75: | offset _ = ErrorMsg.impossible "nonregister arg to offset in mips"
76: (* fetchindexb(x,y) fetches a byte: y <- mem[x+arithtemp]
77: y cannot be arithtemp *)
78: fun fetchindexb(x,Direct y) =
79: (M.add(arithtemp',x,my_arithtemp');
80: M.lbu(y,my_arithtemp,0))
81: | fetchindexb _ = ErrorMsg.impossible "fetchb result not register in mips"
82:
83: (* storeindexb(x,y) stores a byte: mem[y+arithtemp] <- x; *)
84: fun storeindexb(Direct x,y) =
85: (M.add(arithtemp',y,my_arithtemp');
86: M.sb(x,my_arithtemp,0))
87: | storeindexb _ = ErrorMsg.impossible "storeb arg not register in mips"
88:
89: (* jmpindexb(x) pc <- (x+arithtemp) *)
90: fun jmpindexb x = (M.add(arithtemp',x,my_arithtemp');
91: M.jump(my_arithtemp'))
92:
93: (* fetchindexl(x,y,z) fetches a word: y <- mem[x+2*(z-1)] *)
94: (* storeindexl(x,y,z) stores a word: mem[y+2*(z-1)] <- x *)
95:
96: fun fetchindexl(x,Direct y, Direct z) =
97: (M.sll(Immed 1,z,my_arithtemp');
98: M.add(my_arithtemp',x,my_arithtemp');
99: M.lw(y, my_arithtemp,~2))
100: | fetchindexl(x,Direct y, Immed z) = M.lw(y, x, z+z-2)
101: | fetchindexl _ = ErrorMsg.impossible "fetchl result not register in mips"
102:
103: fun storeindexl(Direct x,y, Immed 1) = M.sw(x,y,0)
104: | storeindexl(Direct x,y,Direct z) =
105: (M.sll(Immed 1,z,my_arithtemp');
106: M.add(my_arithtemp',y,my_arithtemp');
107: M.sw(x, my_arithtemp,~2))
108: | storeindexl(Direct x,y,Immed z) = M.sw(x,y,z+z-2)
109:
110: | storeindexl(Direct _,_,Immedlab _) =
111: ErrorMsg.impossible "storeindexl(Direct _,_,Immedlab _) in mips"
112:
113: | storeindexl(Immedlab label,y,z) =
114: (M.move(Immedlab label,my_ptrtemp');
115: storeindexl(my_ptrtemp,y,z))
116:
117: | storeindexl(Immed constant,y,offset) =
118: (M.move(Immed constant,my_ptrtemp');
119: storeindexl(my_ptrtemp,y,offset))
120:
121: val addl3 = three M.add
122:
123: fun subl3(Immed k, x, y) = addl3(x, Immed(~k), y)
124: | subl3(Direct x, Direct y, Direct z) = M.sub(y,x,z)
125: | subl3(x, Immed k, dest) =
126: (M.move(Immed k, my_arithtemp');
127: subl3(x, my_arithtemp, dest))
128: | subl3 _ = ErrorMsg.impossible "subl3 args don't match in mips"
129:
130: fun mull2(Direct x, Direct y) = M.mult(y,x,y)
131: | mull2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
132: M.mult(y,my_arithtemp',y))
133: | mull2 _ = ErrorMsg.impossible "mull2 args don't match in mips"
134: fun divl2(Direct x, Direct y) = M.div(y,x,y)
135: | divl2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
136: M.div(y,my_arithtemp',y))
137: | divl2 _ = ErrorMsg.impossible "divl2 args don't match in mips"
138:
139: fun ashr(shamt, Direct op1, Direct result) = M.sra(shamt,op1,result)
140: | ashr(shamt, Immed op1, Direct result) =
141: (M.move(Immed op1,my_arithtemp'); M.sra(shamt,my_arithtemp',result))
142: | ashr _ = ErrorMsg.impossible "ashr args don't match in mips"
143: fun ashl(shamt, Direct op1, Direct result) = M.sll(shamt,op1,result)
144: | ashl(shamt, Immed op1, Direct result) =
145: (M.move(Immed op1,my_arithtemp'); M.sll(shamt,my_arithtemp',result))
146: | ashl _ = ErrorMsg.impossible "ashl args don't match in mips"
147: val addl3t = addl3
148: val subl3t = subl3
149: val ashlt = ashl
150: fun mull2t(x,y as Direct y') =
151: let val ok = M.newlabel()
152: in mull2(x,y);
153: M.mfhi(my_arithtemp');
154: M.slt(y',Direct (Reg 0),my_ptrtemp'); (* 0 or 1 OK in pointer *)
155: M.add(my_arithtemp',my_ptrtemp,my_arithtemp');
156: M.beq(true,my_arithtemp',Reg 0,ok); (* OK if not overflow *)
157: M.lui(my_arithtemp',32767);
158: M.add(my_arithtemp',my_arithtemp,my_arithtemp'); (* overflows *)
159: M.define(ok)
160: end
161: | mull2t _ = ErrorMsg.impossible "result of mull2t not register in mips"
162:
163: val orb = three M.or
164: val andb = three M.and'
165: fun notb (a,b) = subl3(a, Immed ~1, b) (* ~1 - a == one's complement *)
166: val xorb = three M.xor
167: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
168: local
169: fun makeibranch reverse =
170: let
171: fun ibranch (cond, Immed a, Immed b, Immedlab label) =
172: if (case cond of EQL => a=b | NEQ => a<>b | LSS => a<b |
173: LEQ => a<=b | GTR => a>b | GEQ => a>=b)
174: then M.beq(true,Reg 0, Reg 0, label) else ()
175: | ibranch (NEQ, Direct r, Direct s, Immedlab label) =
176: M.beq(false, r, s, label)
177: | ibranch (NEQ, Direct r, x, Immedlab label) =
178: (M.move(x, my_arithtemp');
179: M.beq(false, r, my_arithtemp', label))
180: | ibranch (EQL, Direct r, Direct s, Immedlab label) =
181: M.beq(true, r, s, label)
182: | ibranch (EQL, Direct r, x, Immedlab label) =
183: (M.move(x, my_arithtemp');
184: M.beq(true, r, my_arithtemp', label))
185: | ibranch (LSS, Direct r, x, Immedlab lab) =
186: (M.slt(r,x,my_arithtemp');
187: M.beq(false,Reg 0, my_arithtemp',lab))
188: | ibranch (GEQ, Direct r, x, Immedlab lab) =
189: (M.slt(r,x,my_arithtemp');
190: M.beq(true,Reg 0, my_arithtemp',lab))
191: | ibranch (GTR, x, Direct r, Immedlab lab) =
192: (M.slt(r,x,my_arithtemp');
193: M.beq(false,Reg 0, my_arithtemp',lab))
194: | ibranch (LEQ, x, Direct r, Immedlab lab) =
195: (M.slt(r,x,my_arithtemp');
196: M.beq(true,Reg 0, my_arithtemp',lab))
197: (* These two cases added to prevent infinite reversal *)
198: | ibranch (GTR, Direct r, x, Immedlab lab) =
199: (M.move(x, my_arithtemp');
200: M.slt(my_arithtemp',Direct r,my_arithtemp');
201: M.beq(false,Reg 0,my_arithtemp',lab))
202: | ibranch (LEQ, Direct r, x, Immedlab lab) =
203: (M.move(x, my_arithtemp');
204: M.slt(my_arithtemp',Direct r,my_arithtemp');
205: M.beq(true,Reg 0,my_arithtemp',lab))
206: | ibranch (_, Immedlab _, Immedlab _, _) =
207: ErrorMsg.impossible "bad ibranch args 1 in mips"
208: | ibranch (_, Immedlab _, _, _) =
209: ErrorMsg.impossible "bad ibranch args 1a in mips"
210: | ibranch (_, _, Immedlab _, _) =
211: ErrorMsg.impossible "bad ibranch args 1b in mips"
212: | ibranch (_, _, _, Direct _) =
213: ErrorMsg.impossible "bad ibranch args 2 in mips"
214: | ibranch (_, _, _, Immed _) =
215: ErrorMsg.impossible "bad ibranch args 3 in mips"
216: | ibranch (cond, x, y, l) =
217: let fun rev LEQ = GEQ
218: | rev GEQ = LEQ
219: | rev LSS = GTR
220: | rev GTR = LSS
221: | rev NEQ = NEQ
222: | rev EQL = EQL
223: in if reverse then (makeibranch false) (rev cond, y,x,l)
224: else ErrorMsg.impossible "infinite ibranch reversal in mips"
225:
226: end
227: in ibranch
228: end
229: in
230: val ibranch = makeibranch true
231: end
232:
233: fun jmp (Direct r) = M.jump(r)
234: | jmp (Immedlab lab) = M.beq(true,Reg 0,Reg 0,lab)
235: | jmp (Immed i) = ErrorMsg.impossible "jmp (Immed i) in mips"
236:
237:
238: (* branch on bit set *)
239: fun bbs (Immed k, Direct y, Immedlab label) =
240: (M.and'(y,Immed (Bits.lshift(1,k)),my_arithtemp');
241: M.beq(false,my_arithtemp',Reg 0,label))
242: | bbs _ = ErrorMsg.impossible "bbs args don't match in mips"
243:
244:
245: val floatop1 = Reg 0
246: val floatop2 = Reg 2
247: val floatresult = Reg 0
248:
249: val real_tag = Immed(8*System.Tags.power_tags + System.Tags.tag_string)
250:
251: fun store_float(Reg n,ea,offset) =
252: if n mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
253: else (M.swc1(Reg (n+1),ea,offset+4);M.swc1(Reg n,ea,offset))
254:
255: fun finish_real (Direct result) = (
256: store_float(floatresult,dataptr,4);
257: M.move(real_tag,my_arithtemp');
258: M.sw(my_arithtemp',dataptr,0);
259: M.add(dataptr',Immed 4,result);
260: M.add(dataptr',Immed 12,dataptr'))
261: | finish_real _ =
262: ErrorMsg.impossible "ptr to result of real operation not register in mips"
263:
264: fun load_float(Reg dest,src,offset) =
265: if dest mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
266: else (M.lwc1(Reg dest,src,offset); M.lwc1(Reg (dest+1),src,offset+4))
267:
268: fun two_float instruction (op1,result) = (
269: load_float(floatop1,op1,0);
270: instruction(floatop1,floatresult);
271: finish_real(result))
272:
273: fun three_float instruction (op1,op2,result) = (
274: load_float(floatop1,op1,0);
275: load_float(floatop2,op2,0);
276: instruction(floatop1,floatop2,floatresult);
277: finish_real(result))
278:
279: val mnegg = two_float M.neg_double
280: val mulg3 = three_float M.mul_double
281: val divg3 = three_float M.div_double
282: val addg3 = three_float M.add_double
283: val subg3 = three_float M.sub_double
284:
285:
286: local
287: fun compare(LSS,op1,op2) = (M.slt_double(op1,op2); true)
288: | compare(GEQ,op1,op2) = (M.slt_double(op1,op2); false)
289: | compare(EQL,op1,op2) = (M.seq_double(op1,op2); true)
290: | compare(NEQ,op1,op2) = (M.seq_double(op1,op2); false)
291: | compare(LEQ,op1,op2) = compare(GEQ,op2,op1)
292: | compare(GTR,op1,op2) = compare(LSS,op2,op1)
293: in
294: fun gbranch (cond, op1, op2, Immedlab label) = (
295: load_float(floatop1,op1,0);
296: load_float(floatop2,op2,0);
297: M.bcop1(compare(cond,floatop1,floatop2),label))
298: | gbranch _ = ErrorMsg.impossible "insane gbranch target in mips.nw"
299: end
300:
301:
302: fun checkLimit max_allocation = M.sw(Reg 0, dataptr, max_allocation-4)
303: (* store zero in last location to be used *)
304:
305:
306:
307: fun beginStdFn _ = () (* do nothing, just like the Vax *)
308:
309: fun profile(i,incr) = ()
310:
311:
312: val comment = M.comment
313:
314: (* +DEBUG *)
315: fun diag (s : string) f x =
316: f x handle e =>
317: (print "?exception "; print (System.exn_name e);
318: print " in mips."; print s; print "\n";
319: raise e)
320:
321: val emitlab = diag "emitlab" emitlab
322: val define = diag "define" define
323:
324:
325: val record = diag "record" record
326: val select = diag "select" select
327: val offset = diag "offset" offset
328:
329: val fetchindexb = diag "fetchindexb" fetchindexb
330: val storeindexb = diag "storeindexb" storeindexb
331: val jmpindexb = diag "jmpindexb" jmpindexb
332:
333:
334: val fetchindexl = diag "fetchindexl" fetchindexl
335: val storeindexl = diag "storeindexl" storeindexl
336:
337:
338: val ashr = diag "ashr" ashr
339: val ashl = diag "ashl" ashl
340:
341: val orb = diag "orb" orb
342: val andb = diag "andb" andb
343: val notb = diag "notb" notb
344: val xorb = diag "xorb" xorb
345:
346:
347: val addl3 = diag "addl3" addl3
348: val subl3 = diag "subl3" subl3
349: val mull2 = diag "mull2" mull2
350: val divl2 = diag "divl2" divl2
351:
352:
353: val addl3t = diag "addl3t" addl3t
354: val subl3t = diag "subl3t" subl3t
355: val mull2t = diag "mull2t" mull2t
356: val ashlt = diag "ashlt" ashlt
357:
358:
359: val ibranch = diag "ibranch" ibranch
360: val jmp = diag "jmp" jmp
361: val bbs = diag "bbs" bbs
362:
363: (* -DEBUG *)
364:
365: end (* MipsCM *)
366:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.