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

Annotation of /sml/branches/SMLNJ/src/compiler/OldCGen/mips/mips.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 100 - (view) (download)

1 : monnier 16 (* mips.sml
2 :     *
3 :     * Copyright (c) 1992 by AT&T Bell Laboratories
4 :     *
5 :     *)
6 :    
7 :     functor MipsCM(structure C: CODER
8 :     where type 'a instruction = 'a MipsInstrSet.instruction
9 :     and type 'a sdi = 'a MipsInstrSet.sdi
10 :     structure E: ENDIAN
11 :     structure MachSpec: MACH_SPEC) : CMACHINE =
12 :     struct
13 :    
14 :     structure D = MachSpec.ObjDesc
15 :     val dtoi = LargeWord.toInt (* convert descriptors to int *)
16 :    
17 :     structure M = MipsInstrSet
18 :     open M
19 :     type EA = C.label M.EA
20 :    
21 : monnier 100 fun bug s = ErrorMsg.impossible ("mips/mips.sml: " ^ s)
22 : monnier 16
23 :     val wtoi = Word.toIntX
24 :    
25 :     exception BadReal = C.BadReal
26 :     val align = fn () => ()
27 :     val mark = C.mark
28 :     val emitlong = C.emitLong
29 :     val realconst = C.emitReal
30 :     val emitstring = C.emitString
31 :     val newlabel = M.ImmedLab o C.newLabel
32 :     val immed = M.Immed
33 :     val emitSDI = C.emitSDI
34 :     val emit = C.emit
35 :    
36 :     fun emitlab(k,ImmedLab lab) = C.emitLabel(lab,k)
37 : monnier 100 | emitlab _ = bug "MipsCM.emitlab"
38 : monnier 16
39 :     fun define(ImmedLab lab) = C.define lab
40 : monnier 100 | define _ = bug "MipsCM.define"
41 : monnier 16
42 :    
43 :     (* Register Map
44 :     Reg gc desc
45 :     -------------------------------------
46 :     0 n zero
47 :     1 n temporary reg
48 :     2 y standard arg
49 :     3 y standard continuation
50 :     4 y standard closure
51 :     5 y standard link
52 :     6-18 y misc regs
53 :     19 n limit reg
54 :     20 n var pointer
55 :     21 n temporary reg & heapExhausted reg.
56 :     22 n store pointer
57 :     23 n allocation pointer
58 :     24 n base reg
59 :     25 n temporary reg & maskReg
60 :     26-27 n reserved for OS kernel
61 :     28 n C global pointer
62 :     29 n C stack pointer
63 :     30 y exnptr
64 :     31 n temporary reg & gclink register
65 :     *)
66 :     val varptr_indexable = true
67 :     val standardlink : EA = Direct(Reg 5)
68 :     val standardarg : EA = Direct(Reg 2)
69 :     val standardcont : EA = Direct(Reg 3)
70 :     val standardclosure : EA = Direct(Reg 4)
71 :     val miscregs : EA list = map (Direct o Reg)
72 :     [6,7,8,9,10,11,12,13,14,15,16,17,18]
73 :    
74 :     val limit as Direct limit' : EA = Direct(M.limitReg)
75 :     val varptr : EA = Direct(Reg 20)
76 :     val stackptr' = (Reg 29)
77 :    
78 :     val storeptr as Direct storeptr' : EA = Direct(Reg 22)
79 :     val dataptr as Direct dataptr' : EA = Direct(M.allocReg)
80 :    
81 :     val exnptr = Direct(M.exnptrReg)
82 :    
83 :     val floatregs: EA list = map (Direct o Freg)
84 :     [0,2,4,6,8,10,12,14,16,18]
85 :     val savedfpregs: EA list = map (Direct o Freg) [20,22,24,26,28]
86 :    
87 :     val arithtemps: EA list = []
88 :    
89 :     local
90 :     exception NoTmpRegs
91 :     val tmpRegs = [M.heapExhaustedReg,M.maskReg,M.linkReg,Reg 1]
92 :     val queue = ref tmpRegs
93 :     in
94 :     fun getTmpReg() = case !queue
95 :     of hd :: rest => (queue := rest; hd)
96 :     | _ => raise NoTmpRegs
97 :     fun freeTmpReg reg = queue := !queue @ [reg]
98 :    
99 :     (*** should be cleaned up in the future ***)
100 :     val tmpfpreg = (Freg 30)
101 :    
102 :     end
103 :    
104 :    
105 :     fun emitBRANCH(cond,rs,rt,lab) =
106 :     let val flabel = C.newLabel()
107 :     val tmpR = getTmpReg()
108 :     in
109 :     emitSDI(M.BRANCH(cond,rs,rt,lab,tmpR,flabel));
110 :     C.define flabel;
111 :     freeTmpReg tmpR
112 :     end
113 :    
114 :     fun emitBRANCH_COP1(cond,lab) =
115 :     let val flabel = C.newLabel()
116 :     val tmpR = getTmpReg()
117 :     in
118 :     emitSDI(M.BRANCH_COP1(cond,lab,tmpR,flabel));
119 :     C.define flabel;
120 :     freeTmpReg tmpR
121 :     end
122 :    
123 :    
124 :     datatype immedSize = IMMED16 | IMMED32
125 :    
126 :     fun immed_size n = if (~32764<=n) andalso (n<=32764)
127 :     then IMMED16
128 :     else IMMED32
129 :    
130 :     val immed32 = M.Immed32
131 :    
132 :     fun load_immed(n,r) =
133 :     case (immed_size n)
134 :     of IMMED16 => emit(M.ADD(r,Reg 0,Immed16Op n))
135 :     | IMMED32 => let val (hi,lo) = M.split n
136 :     in emit (M.LUI(r,Immed16Off(wtoi hi)));
137 :     emit (M.ADD(r,r,Immed16Op(wtoi lo)))
138 :     end
139 :    
140 :     local
141 :     structure W = Word32
142 :     in
143 :     fun load_immed32(w, rd) = let
144 :     val lo = W.andb(w, 0w65535)
145 :     val hi = W.~>>(w, 0w16)
146 :     in emit(M.LUI(rd, Immed16Off(W.toIntX hi)));
147 :     emit(M.OR(rd, rd, Immed16Op(W.toInt lo)))
148 :     end
149 :     end
150 :    
151 :     fun do_immed_arith(instr,rt,rs,n) =
152 :     case (immed_size n)
153 :     of IMMED16 => emit(instr(rt,rs,Immed16Op n))
154 :     | IMMED32 => let
155 :     val (hi,lo) = M.split n
156 :     val tmpR = getTmpReg()
157 :     in
158 :     emit (M.LUI(tmpR,Immed16Off(wtoi hi)));
159 :     emit (M.ADD(tmpR,tmpR,Immed16Op(wtoi lo)));
160 :     emit (instr(rt,rs,RegOp tmpR));
161 :     freeTmpReg tmpR
162 :     end
163 :    
164 :     fun do_immed_mem(instr,rt,base,n) =
165 :     case (immed_size n)
166 :     of IMMED16 => emit(instr(rt,base,Immed16Off n))
167 :     | IMMED32 => let
168 :     val (hi,lo) = M.split n
169 :     val tmpR = getTmpReg()
170 :     in
171 :     emit (M.LUI(tmpR,Immed16Off(wtoi hi)));
172 :     emit (M.ADD(tmpR,tmpR,RegOp base));
173 :     emit (instr(rt,tmpR,Immed16Off(wtoi lo)));
174 :     freeTmpReg tmpR
175 :     end
176 :    
177 :     fun do_immed_logical(instr,rt,rs,n) =
178 :     if n >=0 andalso n < 65536 then
179 :     emit(instr(rt,rs,Immed16Op n))
180 :     else let val tmpR = getTmpReg()
181 :     in
182 :     load_immed(n,tmpR);
183 :     emit(instr(rt,rs,RegOp tmpR));
184 :     freeTmpReg tmpR
185 :     end
186 :    
187 :     (*
188 :     * move(a,b) means b <- a
189 :     *)
190 :     val Reg0 = Reg 0
191 :     val RegOp0 : C.label M.arithOpnd = RegOp(Reg 0)
192 :    
193 :     fun move(Direct a, Direct b) =
194 :     (case (reg_rep a, reg_rep b)
195 :     of (Freg' _, Freg' _) => emit(M.MOV_DOUBLE(b,a))
196 : monnier 100 | (Freg' _, _) => bug "MipsCM.move: destination not a float reg"
197 :     | (_, Freg' _) => bug "MipsCM.move: source not a float reg"
198 : monnier 16 | (Reg' a', Reg' b') => if a'=b' then ()
199 :     else emit(M.ADD(b,a,RegOp0)))
200 :     | move(ImmedLab lab, Direct dst) = emitSDI(LOADADDR(dst,lab,0))
201 :     | move(Immed n, Direct dst) = load_immed(n,dst)
202 :     | move(Immed32 w, rd as Direct dst) = load_immed32(w,dst)
203 : monnier 100 | move _ = bug "MipsCM.move"
204 : monnier 16
205 :     fun jmp (Direct r) = emit(M.JUMP r)
206 :     | jmp (ImmedLab lab) = emitBRANCH(true,Reg0,Reg0,lab)
207 : monnier 100 | jmp _ = bug "MipsCM.jmp: bad target"
208 : monnier 16
209 :     (* stackptr' is the stack pointer; pregs_offset is the stack offset
210 :     * of pseudo registers, it should be consistent with the offset in
211 :     * the MIPS.prim.asm file.
212 :     *)
213 :     val pregs_offset = 16
214 :    
215 :     fun loadpseudo (Direct x,Immed i) =
216 :     do_immed_mem(M.LW,x,stackptr',2*(i-1)+pregs_offset)
217 :     | loadpseudo (Direct x,Direct y) = (* this case is never used *)
218 :     let val tmpR = getTmpReg()
219 :     in emit(M.SLL(tmpR,y,Int5 1));
220 :     emit(M.ADD(tmpR,stackptr',RegOp tmpR));
221 :     emit(M.LW(x,tmpR,Immed16Off (pregs_offset-2)));
222 :     freeTmpReg tmpR
223 :     end
224 : monnier 100 | loadpseudo _ = bug "[loadpseudo]"
225 : monnier 16
226 :     fun storepseudo(Direct x,Immed i) =
227 :     do_immed_mem(M.SW,x,stackptr',2*(i-1)+pregs_offset)
228 :     | storepseudo(Direct x,Direct y) = (* this case is never used *)
229 :     let val tmpR = getTmpReg()
230 :     in emit (M.SLL(tmpR,y,Int5 1));
231 :     emit (M.ADD(tmpR,tmpR,RegOp stackptr'));
232 :     emit (M.SW(x,tmpR,Immed16Off (pregs_offset-2)));
233 :     freeTmpReg tmpR
234 :     end
235 : monnier 100 | storepseudo _ = bug "[storepseudo]"
236 : monnier 16
237 :    
238 :     (*
239 :     * jmpindexb(x,y) means pc <- (x+y)
240 :     *)
241 :     fun jmpindexb(ImmedLab lab,Direct y) =
242 :     let val tmpR = getTmpReg()
243 :     in
244 :     emitSDI(LOADADDR(tmpR,lab,0));
245 :     emit(M.ADD(tmpR,y,RegOp tmpR));
246 :     emit(M.JUMP tmpR);
247 :     freeTmpReg tmpR
248 :     end
249 : monnier 100 | jmpindexb _ = bug "MipsCM.jmpindexb"
250 : monnier 16
251 :    
252 :     (* should be rewritten to use all the temp registers *)
253 :     fun record(vl, Direct z) = let
254 :     open CPS
255 :     val len = List.length vl
256 :     fun f(_,i,nil) = ()
257 :     | f((t1,t2),i,(Direct r, SELp(j,p))::rest) =
258 :     (* follow ptrs to get the item *)
259 :     (emit(M.LW(t1,r,Immed16Off(j*4)));
260 :     f((t2,t1),i,(Direct t1,p)::rest))
261 :     | f(t,i,(Direct r,OFFp 0)::rest) =
262 :     (* simple store, last first *)
263 :     (emit(M.SW(r,dataptr',Immed16Off(i*4))); f(t,i-1,rest))
264 : monnier 100 | f((t1,t2),i,(Direct r, OFFp j)::rest) =
265 :     bug "unexpected non-zero OFFp record fields"
266 :     (*
267 : monnier 16 | f((t1,t2),i,(Direct r, OFFp j)::rest) =
268 :     (emit(M.ADD(t1,r,Immed16Op(4*j)));
269 :     f((t2,t1),i,(Direct t1,OFFp 0)::rest))
270 : monnier 100 *)
271 : monnier 16 | f((t1,t2),i,(ea,p)::rest) =
272 :     (* convert to register-based *)
273 :     (move(ea,Direct t1); f((t2,t1),i,(Direct t1,p)::rest))
274 :     val tmpR1 = getTmpReg()
275 :     val tmpR2 = getTmpReg()
276 :     in
277 :     (* store first word in 0(dataptr') *)
278 :     f((tmpR1,tmpR2),len-1,rev vl);
279 :     freeTmpReg tmpR1;
280 :     freeTmpReg tmpR2;
281 :     emit (M.ADD(z,dataptr',Immed16Op 4));
282 :     do_immed_arith(M.ADD,dataptr',dataptr',4*len)
283 :     end
284 : monnier 100 | record _ = bug "MipsCM.record: result not a register"
285 : monnier 16
286 :    
287 :     (* should be rewritten to use all the temp registers *)
288 :     fun recordcont(vl, Direct z, n) = let
289 :     open CPS
290 :     val len = List.length vl
291 :     val _ = if (len > n)
292 : monnier 100 then bug "continuation records is larger than framesize"
293 : monnier 16 else ()
294 :     fun f(_,i,nil) = ()
295 :     | f((t1,t2),i,(Direct r, SELp(j,p))::rest) =
296 :     (* follow ptrs to get the item *)
297 :     (emit(M.LW(t1,r,Immed16Off(j*4)));
298 :     f((t2,t1),i,(Direct t1,p)::rest))
299 :     | f(t,i,(Direct r,OFFp 0)::rest) =
300 :     (* simple store, last first *)
301 :     (emit(M.SW(r,dataptr',Immed16Off(i*4))); f(t,i-1,rest))
302 :     | f((t1,t2),i,(Direct r, OFFp j)::rest) =
303 :     (emit(M.ADD(t1,r,Immed16Op(4*j)));
304 :     f((t2,t1),i,(Direct t1,OFFp 0)::rest))
305 :     | f((t1,t2),i,(ea,p)::rest) =
306 :     (* convert to register-based *)
307 :     (move(ea,Direct t1); f((t2,t1),i,(Direct t1,p)::rest))
308 :     val tmpR1 = getTmpReg()
309 :     val tmpR2 = getTmpReg()
310 :     in
311 :     (* store first word in 0(dataptr') *)
312 :     f((tmpR1,tmpR2),len-1,rev vl);
313 :     freeTmpReg tmpR1;
314 :     freeTmpReg tmpR2;
315 :     emit (M.ADD(z,dataptr',Immed16Op 4));
316 :     do_immed_arith(M.ADD,dataptr',dataptr',4*n)
317 :     end
318 : monnier 100 | recordcont _ = bug "MipsCM.record: result not a register"
319 : monnier 16
320 :    
321 :     (* recordStore(x, y, alwaysBoxed) records a store operation into mem[x+2*(y-1)].
322 :     * The flag alwaysBoxed is true if the value stored is guaranteed to be boxed.
323 :     *)
324 :     fun recordStore (x, y, _) = let
325 :     fun storeListUpdate r = (
326 :     emit (M.SW(r, dataptr', Immed16Off 0));
327 :     emit (M.SW(storeptr', dataptr', Immed16Off 4));
328 :     emit (M.ADD(storeptr', dataptr', RegOp0));
329 :     emit (M.ADD(dataptr', dataptr', Immed16Op 8)))
330 :     in
331 :     case (x, y)
332 :     of (Direct r, Immed 1) => storeListUpdate r
333 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
334 :     in
335 :     do_immed_arith (M.ADD, tmpR, r, 2*(i-1));
336 :     storeListUpdate tmpR;
337 :     freeTmpReg tmpR
338 :     end
339 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
340 :     in
341 :     emit (M.ADD(tmpR, r2, Immed16Op ~1));
342 :     emit (M.ADD(tmpR, tmpR, RegOp tmpR));
343 :     emit (M.ADD(tmpR, tmpR, RegOp r1));
344 :     storeListUpdate tmpR;
345 :     freeTmpReg tmpR
346 :     end
347 :     | _ => ErrorMsg.impossible "[MipsCM.recordStore]"
348 :     (* end case *)
349 :     end (* recordStore *)
350 :     (*** STOREPTR
351 :     fun recordStore (x, y, alwaysBoxed) = let
352 :     (* NOTE: eventually we can optimize the case where alwaysBoxed = false *)
353 :     fun storeVectorUpdate r = (
354 :     emit (M.SW(r, M.limitReg, Immed16Off 4092));
355 :     emit (M.ADD(M.limitReg, M.limitReg, Immed16Op ~4)))
356 :     in
357 :     case (x, y)
358 :     of (Direct r, Immed 1) => storeVectorUpdate r
359 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
360 :     in
361 :     do_immed_arith (M.ADD, tmpR, r, 2*(i-1));
362 :     storeVectorUpdate tmpR;
363 :     freeTmpReg tmpR
364 :     end
365 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
366 :     in
367 :     emit (M.ADD(tmpR, r2, Immed16Op ~1));
368 :     emit (M.ADD(tmpR, tmpR, RegOp tmpR));
369 :     emit (M.ADD(tmpR, tmpR, RegOp r1));
370 :     storeVectorUpdate tmpR;
371 :     freeTmpReg tmpR
372 :     end
373 :     | _ => ErrorMsg.impossible "[MipsCM.recordStore]"
374 :     (* end case *)
375 :     end (* recordStore *)
376 :     ***)
377 :     (*** STOREPTR
378 :     fun recordStore (x, y, _) = record ([
379 :     (Immed(dtoi(D.makeDesc(3, dtoi D.tag_record))), CPS.OFFp 0),
380 :     (x, CPS.OFFp 0), (y, CPS.OFFp 0), (storeptr, CPS.OFFp 0)
381 :     ], storeptr)
382 :     ***)
383 :    
384 :    
385 :     fun select(i,Direct v',Direct w) = do_immed_mem(M.LW,w,v',i*4)
386 :     | select(i,ImmedLab lab,Direct w) = emitSDI(LOAD(w,lab,i*4))
387 : monnier 100 | select _ = bug "MipsCM.select: bad dst"
388 : monnier 16
389 :    
390 :     fun offset(i,v,Direct w) =
391 :     (case v
392 :     of Direct v' => do_immed_arith(M.ADD,w,v',i*4)
393 :     | ImmedLab lab => let val tmpR = getTmpReg()
394 :     in
395 :     emitSDI(LOADADDR(tmpR,lab,0));
396 :     do_immed_arith(M.ADD,w,tmpR,i*4);
397 :     freeTmpReg tmpR
398 :     end
399 : monnier 100 | _ => bug "MipsCM.offset: bad src")
400 :     | offset _ = bug "MipsCM.offset: bad dst"
401 : monnier 16
402 :    
403 :     (* fetchindexb(x,y,z) fetches a byte: y <- mem[x+z],
404 :     * where y is not x or z
405 :     *)
406 :     fun fetchindexb(Direct x,Direct y,Immed indx) = do_immed_mem(M.LBU,y,x,indx)
407 :     | fetchindexb(Direct x,Direct y,Direct indx) = let
408 :     val tmpR = getTmpReg()
409 :     in
410 :     emit (M.ADD(tmpR,indx,RegOp x));
411 :     emit (M.LBU(y,tmpR,Immed16Off 0));
412 :     freeTmpReg tmpR
413 :     end
414 : monnier 100 | fetchindexb _ = bug "MipsCM.fetchindexb"
415 : monnier 16
416 :    
417 :     (*
418 :     * storeindexb(x,y,z) stores a byte: mem[y+z] <- x.
419 :     *)
420 :     fun storeindexb(Immed xi,y,z) =
421 :     let val tmpR = getTmpReg()
422 :     in
423 :     do_immed_arith(M.ADD,tmpR,Reg0,xi);
424 :     storeindexb(Direct tmpR,y,z);
425 :     freeTmpReg tmpR
426 :     end
427 :     | storeindexb(Direct x,Direct y,Direct indx) =
428 :     let val tmpR = getTmpReg()
429 :     in
430 :     emit (M.ADD(tmpR,y,RegOp indx));
431 :     emit (M.SB(x,tmpR,Immed16Off 0));
432 :     freeTmpReg tmpR
433 :     end
434 :     | storeindexb(Direct x,Direct y,Immed indx) = do_immed_mem(M.SB,x,y,indx)
435 : monnier 100 | storeindexb _ = bug "MipsCM.storeindexb"
436 : monnier 16
437 :    
438 :     (*
439 :     * fetchindexl(x,y,z) fetches a word: y <- mem[x+2*(z-1)]
440 :     *)
441 :     fun fetchindexl(x,Direct y,Direct z') =
442 :     let val tmpR = getTmpReg()
443 :     in
444 :     emit(M.SLL(tmpR,z',Int5 1));
445 :     (case x
446 :     of Direct x' => (emit (M.ADD(tmpR,x',RegOp tmpR));
447 :     emit (M.LW(y,tmpR,Immed16Off ~2)))
448 :     | Immed n => do_immed_mem(M.LW,y,tmpR,n-2)
449 :     | ImmedLab lab =>
450 :     let val tmpR2 = getTmpReg()
451 :     in
452 :     emitSDI(M.LOADADDR(tmpR2,lab,0));
453 :     emit(M.ADD(tmpR,tmpR,RegOp tmpR2));
454 :     freeTmpReg tmpR2;
455 :     emit(M.LW(y,tmpR,Immed16Off ~2))
456 :     end);
457 :     freeTmpReg tmpR
458 :     end
459 :     | fetchindexl(x,Direct y,Immed z') =
460 :     (case x
461 :     of Direct x' => do_immed_mem(M.LW,y,x',2*(z'-1))
462 :     | Immed n => do_immed_mem(M.LW,y,Reg0,n+2*(z'-1))
463 :     | ImmedLab lab => emitSDI(LOAD(y,lab,2*(z'-1))))
464 : monnier 100 | fetchindexl _ = bug "MipsCM.fetchindexl"
465 : monnier 16
466 :    
467 :     (*
468 :     * storeindexl(x,y,z) stores a word: mem[y+2*(z-1)] <- x
469 :     *)
470 :     fun storeindexl(Direct x,Direct y,Direct z) =
471 :     let val tmpR = getTmpReg()
472 :     in
473 :     emit (M.SLL(tmpR,z,Int5 1));
474 :     emit (M.ADD(tmpR,tmpR,RegOp y));
475 :     emit (M.SW(x,tmpR,Immed16Off ~2));
476 :     freeTmpReg tmpR
477 :     end
478 :     | storeindexl(Direct x,Direct y,Immed zi) = do_immed_mem(M.SW,x,y,2*(zi-1))
479 :     | storeindexl(Immed xi,y,z) = let val tmpR = getTmpReg()
480 :     in
481 :     load_immed(xi,tmpR);
482 :     storeindexl(Direct tmpR,y,z);
483 :     freeTmpReg tmpR
484 :     end
485 :     | storeindexl(ImmedLab lab,y,z) = let val tmpR = getTmpReg()
486 :     in
487 :     emitSDI(M.LOADADDR(tmpR,lab,0));
488 :     storeindexl(Direct tmpR,y,z);
489 :     freeTmpReg tmpR
490 :     end
491 : monnier 100 | storeindexl _ = bug "MipsCM.storeindexl: bad args"
492 : monnier 16
493 :    
494 :     (*
495 :     * three - can *only* be used for commutative operators
496 :     *)
497 :     fun three f (do_immed, x as Direct x', y as Direct y', ea) =
498 :     (case ea
499 :     of Immed zi => do_immed(f,x',y',zi)
500 :     | Immed32 w => let val tmpR = getTmpReg()
501 :     in load_immed32(w,tmpR);
502 :     three f (do_immed, x, y, Direct tmpR);
503 :     freeTmpReg tmpR
504 :     end
505 :     | Direct z' => emit(f(x',y',RegOp z'))
506 :     | ImmedLab lab => let val tmpR = getTmpReg()
507 :     in
508 :     emitSDI(M.LOADADDR(tmpR,lab,0));
509 :     emit(f(x',y',RegOp tmpR));
510 :     freeTmpReg tmpR
511 :     end)
512 :    
513 :     | three f (do_immed,Direct x', ea, Direct z') =
514 :     three f (do_immed,Direct x',Direct z',ea)
515 :     | three f (do_immed,x, Immed yi,z) = let val tmpR = getTmpReg()
516 :     in
517 :     load_immed(yi,tmpR);
518 :     three f (do_immed,x,Direct tmpR,z);
519 :     freeTmpReg tmpR
520 :     end
521 :     | three f (do_immed,x, Immed32 w,z) = let val tmpR = getTmpReg()
522 :     in
523 :     load_immed32(w,tmpR);
524 :     three f (do_immed,x,Direct tmpR,z);
525 :     freeTmpReg tmpR
526 :     end
527 : monnier 100 | three _ _ = bug "MipsCM.three: bad args"
528 : monnier 16
529 :     fun add(x,y,z) = three M.ADDU (do_immed_arith,z,x,y)
530 :     fun orb(x,y,z) = three M.OR (do_immed_logical,z,x,y)
531 :     fun andb(x,y,z) = three M.AND (do_immed_logical,z,x,y)
532 :     fun xorb(x,y,z) = three M.XOR (do_immed_logical,z,x,y)
533 :    
534 :     (* Subtraction may appear a bit odd.
535 :     * The MIPS machine instruction and MIPSCODER.sub both subtract
536 :     * their second operand from their first operand.
537 :     * The CMACHINE.sub subtracts the first operand from the second.
538 :     * This will certainly lead to endless confusion.
539 :     *
540 :     * sub(a,b,c) mean c <- b-a
541 :     *)
542 :     fun sub (Direct x,Direct y,Direct z) = emit(M.SUBU(z,y,x))
543 :     | sub (Immed xi,y,z) = let val tmpR = getTmpReg()
544 :     in load_immed(xi,tmpR);
545 :     sub (Direct tmpR,y,z);
546 :     freeTmpReg tmpR
547 :     end
548 :     | sub (Immed32 w,y,z) = let val tmpR = getTmpReg()
549 :     in load_immed32(w,tmpR);
550 :     sub(Direct tmpR, y, z);
551 :     freeTmpReg tmpR
552 :     end
553 :     | sub (x,Immed 0,dest) = sub (x, Direct(Reg0), dest)
554 :     | sub (x,Immed y,z) = let val tmpR = getTmpReg()
555 :     in load_immed(y,tmpR);
556 :     sub (x,Direct tmpR,z);
557 :     freeTmpReg tmpR
558 :     end
559 :     | sub (x, Immed32 w, z) = let val tmpR = getTmpReg()
560 :     in load_immed32(w,tmpR);
561 :     sub(x, Direct tmpR, z);
562 :     freeTmpReg tmpR
563 :     end
564 : monnier 100 | sub _ = bug "MipsCM.sub: mismatched args"
565 : monnier 16
566 :     fun notb(a,b) = sub (a, Immed ~1, b)
567 :    
568 :    
569 :     (*
570 :     * integer arithmetic with overflow trapping - addt subt mult divt
571 :     *)
572 :     fun addt (Immed ai, Immed bi, Direct rd) =
573 :     (load_immed(ai,rd); do_immed_arith(M.ADD,rd,rd,bi))
574 :     | addt (Immed32 aw, b, c as Direct rd) =
575 :     (load_immed32(aw,rd); addt(b, c, c))
576 :     | addt (x, y, z) = three M.ADD (do_immed_arith,z,x,y)
577 :    
578 :     fun subt (Immed xi,y,z) = addt(y,Immed (~xi),z)
579 :     | subt (Direct x,Direct y,Direct z)= emit(M.SUB(z,y,x))
580 :     | subt (x,Immed 0,dest) = subt (x, Direct(Reg0), dest)
581 :     | subt (x,Immed k,dest) = let val tmpR = getTmpReg()
582 :     in
583 :     do_immed_arith(M.ADD,tmpR,Reg0,k);
584 :     subt (x,Direct tmpR,dest);
585 :     freeTmpReg tmpR
586 :     end
587 :     | subt (Immed32 x, y, z) = let val tmpR = getTmpReg()
588 :     in
589 :     load_immed32(x, tmpR);
590 :     subt(Direct tmpR, y, z);
591 :     freeTmpReg tmpR
592 :     end
593 :     | subt (x, Immed32 y, z) = let val tmpR = getTmpReg()
594 :     in
595 :     load_immed32(y, tmpR);
596 :     subt(x, Direct tmpR, z);
597 :     freeTmpReg tmpR
598 :     end
599 :    
600 : monnier 100 | subt _ = bug "MipsCM.subt: mismatched args"
601 : monnier 16
602 :     (* The Mips multiplies two 32-bit quantities to get a 64-bit result.
603 :     * That result fits in 32 bits if and only if the high-order word is zero
604 :     * or negative one, and it has the same sign as the low order word.
605 :     * Thus, we can add the sign bit of the low order word to the high order
606 :     * word, and we have overflow if and only if the result is nonzero.
607 :     *)
608 :     fun mult(ea,y as Direct y') =
609 :     let val tmpR = getTmpReg()
610 :     in
611 :     (case ea
612 :     of Immed xi =>
613 :     (do_immed_arith(M.ADD,tmpR,Reg0, xi); mult(Direct tmpR,y))
614 :     | Immed32 wi =>
615 :     (load_immed32(wi, tmpR); mult(Direct tmpR, y))
616 :     | Direct x' =>
617 :     let val ok = C.newLabel()
618 :     in emit (M.MULT(x',y'));
619 :     emit (M.MFLO y');
620 :     emit (M.SLT(y',y',RegOp (Reg0)));
621 :     emit (M.MFHI tmpR);
622 :     emit (M.ADD(tmpR,y',RegOp tmpR));
623 :     emit (M.MFLO y');
624 :     emitBRANCH(true,tmpR,Reg0,ok);
625 :     emit (M.LUI(tmpR,Immed16Off 32767));
626 :     emit (M.ADD(tmpR,tmpR,RegOp tmpR));
627 :     C.define ok
628 :     end
629 : monnier 100 | _ => bug "MipsCM.mult");
630 : monnier 16 freeTmpReg tmpR
631 :     end
632 : monnier 100 | mult _ = bug "MipsCM.mult: result not a register"
633 : monnier 16
634 :     fun mulu(Direct x,Direct y) =
635 :     (emit(M.MULTU(x,y)); emit(M.MFLO y))
636 :     | mulu(Immed32 xi,y) = let val tmpR = getTmpReg()
637 :     in
638 :     load_immed32(xi,tmpR);
639 :     mulu(Direct tmpR,y);
640 :     freeTmpReg tmpR
641 :     end
642 : monnier 100 | mulu _ = bug "mulu"
643 : monnier 16
644 :    
645 :     (*
646 :     * divt(a,b) means b <- b div a
647 :     *)
648 :     fun divt(Direct x',Direct y') =
649 :     let val oklabel = C.newLabel()
650 :     in
651 :     (* emit (M.DIV(y',x')); *)
652 :     emitBRANCH(false,Reg0,x',oklabel);
653 :     emit(M.BREAK 7);
654 :     C.define oklabel;
655 :     emit (M.DIV(y',x'));
656 :     emit (M.MFLO y')
657 :     end
658 :     | divt(Immed xi, y) =
659 :     let val tmpR = getTmpReg()
660 :     in
661 :     do_immed_arith(M.ADD,tmpR,Reg0,xi);
662 :     divt(Direct tmpR,y);
663 :     freeTmpReg tmpR
664 :     end
665 :     | divt(Immed32 xi, y) =
666 :     let val tmpR = getTmpReg()
667 :     in
668 :     load_immed32(xi, tmpR);
669 :     divt(Direct tmpR, y);
670 :     freeTmpReg tmpR
671 :     end
672 : monnier 100 | divt _ = bug "MipsCM.divt: mismatched args"
673 : monnier 16
674 :     fun divtu(Direct x',Direct y') = let
675 :     val oklabel = C.newLabel()
676 :     in
677 :     emitBRANCH(false,Reg0,x',oklabel);
678 :     emit(M.BREAK 7);
679 :     C.define oklabel;
680 :     emit (M.DIVU(y',x'));
681 :     emit (M.MFLO y')
682 :     end
683 :     | divtu(Immed32 w,y) = let
684 :     val tmpR = getTmpReg()
685 :     in
686 :     load_immed32(w,tmpR);
687 :     divtu(Direct tmpR,y);
688 :     freeTmpReg tmpR
689 :     end
690 :    
691 :    
692 :     fun ashr(shamt,Direct rt,Direct rd) =
693 :     (case shamt
694 :     of Direct rs => emit(M.SRAV(rd,rt,rs))
695 :     | Immed n =>
696 :     if n >= 32 orelse n < 0 then
697 : monnier 100 bug "MipsCM.ashr: Too large a shift distance"
698 : monnier 16 else
699 :     emit(M.SRA(rd,rt,Int5 n))
700 : monnier 100 | _ => bug "MipsCM.ashr")
701 : monnier 16 | ashr(shamt,Immed n,dst) = let val tmpR = getTmpReg()
702 :     in
703 :     load_immed(n,tmpR);
704 :     ashr(shamt,Direct tmpR,dst);
705 :     freeTmpReg tmpR
706 :     end
707 :     | ashr(shamt, Immed32 w, dst) = let val tmpR = getTmpReg()
708 :     in load_immed32(w,tmpR);
709 :     ashr(shamt, Direct tmpR, dst);
710 :     freeTmpReg tmpR
711 :     end
712 : monnier 100 | ashr _ = bug "MipsCM.ashr: bad args"
713 : monnier 16
714 :     fun lshr(shamt,Direct rt,Direct rd) =
715 :     (case shamt
716 :     of Direct rs => emit(M.SRLV(rd,rt,rs))
717 :     | Immed n =>
718 :     if n >= 32 orelse n < 0 then
719 : monnier 100 bug "MipsCM.lshr: bad shift distance"
720 : monnier 16 else
721 :     emit(M.SRL(rd,rt,Int5 n))
722 : monnier 100 | _ => bug "MipsCM.ashr")
723 : monnier 16 | lshr(shamt,Immed n,dst) = let val tmpR = getTmpReg()
724 :     in
725 :     load_immed(n,tmpR);
726 :     lshr(shamt,Direct tmpR,dst);
727 :     freeTmpReg tmpR
728 :     end
729 :     | lshr(shamt, Immed32 w, dst) = let val tmpR = getTmpReg()
730 :     in
731 :     load_immed32(w,tmpR);
732 :     lshr(shamt,Direct tmpR,dst);
733 :     freeTmpReg tmpR
734 :     end
735 :    
736 : monnier 100 | lshr _ = bug "MipsCM.ashr: bad args"
737 : monnier 16
738 :     fun ashl(shamt,Direct rt,Direct rd) =
739 :     (case shamt
740 :     of Direct rs => emit(M.SLLV(rd,rt,rs))
741 :     | Immed n =>
742 :     if n >= 32 orelse n < 0 then
743 : monnier 100 bug "MipsCM.ashl: Too large a shift distance"
744 : monnier 16 else
745 :     emit(M.SLL(rd,rt,Int5 n))
746 : monnier 100 | _ => bug "MipsCM.ashl")
747 : monnier 16 | ashl(shamt,Immed n,dst) = let val tmpR = getTmpReg()
748 :     in
749 :     load_immed(n,tmpR);
750 :     ashl(shamt,Direct tmpR,dst);
751 :     freeTmpReg tmpR
752 :     end
753 :     | ashl(shamt,Immed32 w,dst) = let val tmpR = getTmpReg()
754 :     in
755 :     load_immed32(w,tmpR);
756 :     ashl(shamt,Direct tmpR,dst);
757 :     freeTmpReg tmpR
758 :     end
759 : monnier 100 | ashl _ = bug "MipsCM.ashl: bad args"
760 : monnier 16
761 :     datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
762 :     | GEU | GTU | LTU | LEU
763 :    
764 :     (** NOTE: these optimizations ought to be done in the CPS phase!!!
765 :     ** ALSO: maybe we want to add a "wbranch" function and get rid of the
766 :     ** unsigned condition codes.
767 :     **)
768 :     fun ibranch(cond,Immed a,Immed b,ImmedLab lab) = let
769 :     val condVal = (case cond
770 :     of EQL => a=b | NEQ => a<>b | LSS => a<b
771 :     | LEQ => a<=b | GTR => a>b | GEQ => a>=b
772 :     | GTU => (Word.fromInt a > Word.fromInt b)
773 :     | GEU => (Word.fromInt a >= Word.fromInt b)
774 :     | LTU => (Word.fromInt a < Word.fromInt b)
775 :     | LEU => (Word.fromInt a <= Word.fromInt b)
776 :     (* end case *))
777 :     in
778 :     if condVal then emitBRANCH(true,Reg0,Reg0,lab) else ()
779 :     end
780 :     | ibranch(cond,Immed32 a,Immed32 b,ImmedLab lab) = let
781 :     val wtoi = Int32.fromLarge o Word32.toLargeIntX
782 :     fun cmpi32(cmp, a, b) = cmp(wtoi a, wtoi b)
783 :     in
784 :     if (case cond
785 :     of EQL => a = b
786 :     | NEQ => a <> b
787 :     | GEU => Word32.>=(a,b)
788 :     | GTU => Word32.>(a,b)
789 :     | LTU => Word32.<(a,b)
790 :     | LEU => Word32.<=(a,b)
791 :     | LEQ => cmpi32(Int32.<=, a, b)
792 :     | LSS => cmpi32(Int32.<, a, b)
793 :     | GEQ => cmpi32(Int32.>=, a, b)
794 :     | GTR => cmpi32(Int32.>, a, b))
795 :     then emitBRANCH(true, Reg0, Reg0, lab)
796 :     else ()
797 :     end
798 :     | ibranch(cond,Immed32 a,b,lab) = let val tmpR = getTmpReg()
799 :     in load_immed32(a,tmpR);
800 :     ibranch(cond,Direct tmpR,b,lab);
801 :     freeTmpReg tmpR
802 :     end
803 :     | ibranch(cond,a,Immed32 b,lab) = let val tmpR = getTmpReg()
804 :     in load_immed32(b,tmpR);
805 :     ibranch(cond,a,Direct tmpR,lab);
806 :     freeTmpReg tmpR
807 :     end
808 :     | ibranch(cond,Immed n,Direct t,label) =
809 :     let val tmpR = getTmpReg()
810 :     in
811 :     load_immed(n,tmpR);
812 :     ibranch(cond,Direct tmpR,Direct t,label);
813 :     freeTmpReg tmpR
814 :     end
815 :     | ibranch(cond,Direct rs,Immed n,label) =
816 :     (*
817 :     * could do a better job of this case (ref.G.Kane, table C.2)
818 :     *)
819 :     let val tmpR = getTmpReg()
820 :     in
821 :     load_immed(n,tmpR);
822 :     ibranch(cond,Direct rs,Direct tmpR,label);
823 :     freeTmpReg tmpR
824 :     end
825 :     | ibranch(cond,Direct rs,Direct rt,ImmedLab lab) = let val tmpR = getTmpReg()
826 :     in
827 :     case cond
828 :     of NEQ => emitBRANCH(false,rs,rt,lab)
829 :     | EQL => emitBRANCH(true,rs,rt,lab)
830 :     | LEQ => (emit(M.SLT(tmpR,rt,RegOp rs));
831 :     emitBRANCH(true,tmpR,Reg0,lab))
832 :     | GEQ => (emit(M.SLT(tmpR,rs,RegOp rt));
833 :     emitBRANCH(true,tmpR,Reg0,lab))
834 :     | LSS => (emit(M.SLT(tmpR,rs,RegOp rt));
835 :     emitBRANCH(false,tmpR,Reg0,lab))
836 :     | GTR => (emit(M.SLT(tmpR,rt,RegOp rs));
837 :     emitBRANCH(false,tmpR,Reg0,lab))
838 :     | GEU => (emit(M.SLTU(tmpR,rs,RegOp rt));
839 :     emitBRANCH(true,tmpR,Reg0,lab))
840 :     | GTU => (emit(M.SLTU(tmpR,rt,RegOp rs));
841 :     emitBRANCH(false,tmpR,Reg0,lab))
842 :     | LTU => (emit(M.SLTU(tmpR,rs,RegOp rt));
843 :     emitBRANCH(false,tmpR,Reg0,lab))
844 :     | LEU => (emit(M.SLTU(tmpR,rt,RegOp rs));
845 :     emitBRANCH(true,tmpR,Reg0,lab))
846 :     (*esac*);
847 :     freeTmpReg tmpR
848 :     end
849 : monnier 100 | ibranch _ = bug "MipsCM.ibranch: bad args"
850 : monnier 16
851 :     (*
852 :     * bbs - branch on bit set.
853 :     *)
854 :     fun bbs(Immed k, Direct y, ImmedLab label) =
855 :     let val tmpR = getTmpReg()
856 :     in
857 :     do_immed_logical(M.AND,tmpR,y,
858 :     Word.toIntX(Word.<<(0w1, Word.fromInt k)));
859 :     emitBRANCH(false,tmpR,Reg0,label);
860 :     freeTmpReg tmpR
861 :     end
862 : monnier 100 | bbs _ = bug "MipsCM.bbs: bad args"
863 : monnier 16
864 :    
865 :     fun floatreg (Direct fpr) =
866 :     (case reg_rep fpr
867 :     of Freg' _ => fpr
868 : monnier 100 | _ => bug "MipsCM.floatreg: expected floatreg")
869 :     | floatreg _ = bug "MipsCM.floatreg: expected floatreg"
870 : monnier 16
871 :     local
872 :     val real_tag = dtoi D.desc_reald
873 :     val lowOff = E.low_order_offset
874 :    
875 :     fun store_float(n',dst,offset) =
876 :     case (reg_rep n', dst)
877 :     of (Freg' n, Direct dst') =>
878 :     if n mod 2 <> 0 then
879 : monnier 100 bug "MipsCM.store_float: bad float reg"
880 : monnier 16 else (do_immed_mem (M.SWC1,Freg(n+1-lowOff),dst',offset+4);
881 :     do_immed_mem (M.SWC1,Freg(n+lowOff),dst',offset))
882 : monnier 100 | _ => bug "MipsCM.store_float: bad args"
883 : monnier 16
884 :     fun load_float(dest',src,offset) =
885 :     case reg_rep dest'
886 :     of Freg' dest =>
887 : monnier 100 if dest mod 2 <> 0 then bug "MipsCM.load_float.1"
888 : monnier 16 else
889 :     (case src
890 :     of Direct src' =>
891 :     (do_immed_mem(M.LWC1,Freg(dest+lowOff),src',offset);
892 :     do_immed_mem(M.LWC1,Freg(dest+1-lowOff),src',offset+4))
893 :     | ImmedLab lab =>
894 :     let val tmpR = getTmpReg()
895 :     in emitSDI(LOADF(Freg dest,lab,offset,tmpR));
896 :     freeTmpReg tmpR
897 :     end
898 : monnier 100 | _ => bug "MipsCM.load_float.3")
899 :     | _ => bug "MipsCM.load_float.2"
900 : monnier 16
901 :     in
902 :     fun storefloat(src,Direct dst) =
903 :     (case reg_rep dst
904 :     of Reg' result =>
905 :     (store_float(floatreg src,dataptr,4);
906 :     let val tmpR = getTmpReg()
907 :     in
908 :     emit (M.ADD(tmpR,Reg0,Immed16Op real_tag));
909 :     emit (M.SW(tmpR,dataptr',Immed16Off 0));
910 :     emit (M.ADD(Reg result,dataptr',Immed16Op 4));
911 :     emit (M.ADD(dataptr',dataptr',Immed16Op 12));
912 :     freeTmpReg tmpR
913 :     end)
914 : monnier 100 | _ => bug "MipsCM.storefloat: bad args")
915 :     | storefloat _ = bug "MipsCM.storefloat: bad args.2"
916 : monnier 16
917 :     fun loadfloat(src, dst) = load_float(floatreg dst,src,0)
918 :     (* y <- mem[x+4*(z-1)] *)
919 :     fun fetchindexd(Direct x, y, z) =
920 :     (case z
921 :     of Immed i => load_float(floatreg y, Direct x, 4*(i-1))
922 :     | Direct z' => let val tmpR = getTmpReg()
923 :     in
924 :     emit (M.SLL(tmpR,z',Int5 2));
925 :     emit (M.ADD(tmpR,x,RegOp tmpR));
926 :     load_float(floatreg y, Direct tmpR, ~4);
927 :     freeTmpReg tmpR
928 :     end
929 : monnier 100 | _ => bug "MipsCM.fetchindexd")
930 :     | fetchindexd _ = bug "MipsCM.fetchindexd"
931 : monnier 16
932 :     (* mem[y+4*(z-1)] <- x *)
933 :     fun storeindexd(x, Direct y, z) =
934 :     (case z
935 :     of Immed i => store_float(floatreg x,Direct y, 4*(i-1))
936 :     | Direct z' => let val tmpR = getTmpReg()
937 :     in
938 :     emit (M.SLL(tmpR,z',Int5 2));
939 :     emit (M.ADD(tmpR,y,RegOp tmpR));
940 :     store_float(floatreg x,Direct tmpR,~4);
941 :     freeTmpReg tmpR
942 :     end
943 : monnier 100 | _ => bug "MipsCM.storeindexd")
944 :     | storeindexd _ = bug "MipsCM.storeindexd"
945 : monnier 16
946 :     fun fprecord(tag, vl, Direct z) =
947 :     let open CPS
948 :     val len = (List.length vl) * 8 + 4
949 :     fun f(_,_,_,i,nil) = ()
950 :     | f(t1,t2,f1,i,(Direct r, SELp(j,OFFp 0))::rest) =
951 :     (case (reg_rep r, reg_rep f1)
952 :     of (Reg' src, Freg' dest) =>
953 :     (do_immed_mem(M.LWC1,Freg(dest+lowOff),r,j*8);
954 :     do_immed_mem(M.LWC1,Freg(dest+1-lowOff),r,j*8+4);
955 :     f(t1,t2,f1,i,(Direct f1, OFFp 0)::rest))
956 : monnier 100 | _ => bug "wrong register assignment1 in mips.sml")
957 : monnier 16 | f(t1,t2,f1,i,(Direct r, SELp(j,p))::rest) =
958 :     (case reg_rep r
959 :     of (Reg' src) =>
960 :     (do_immed_mem(M.LW,t1,r,j*4);
961 :     f(t2,t1,f1,i,(Direct t1,p)::rest))
962 : monnier 100 | _ => bug "wrong register assignment3 in mips.sml")
963 : monnier 16 | f(t1,t2,f1,i,(Direct r, OFFp 0)::rest) =
964 :     (case reg_rep r
965 :     of (Freg' n) =>
966 :     (do_immed_mem(M.SWC1,Freg(n+1-lowOff),dataptr',i+4);
967 :     do_immed_mem(M.SWC1,Freg(n+lowOff),dataptr',i);
968 :     f(t1,t2,f1,i-8,rest))
969 : monnier 100 | _ => bug "wrong register assignment2 in mips.sml")
970 : monnier 16 | f(t1,t2,f1,i,(Direct r, OFFp j)::rest) =
971 : monnier 100 bug "non-zero offset elements in fprecord in mips.sml"
972 : monnier 16 | f(t1,t2,f1,i,(ea, p)::rest) =
973 :     (move(ea,Direct t1); f(t2,t1,f1,i,(Direct t1,p)::rest))
974 :    
975 :     val tmpR1 = getTmpReg()
976 :     val tmpR2 = getTmpReg()
977 :     val tmpF1 = tmpfpreg
978 :     in
979 :     orb(dataptr,Immed 4,dataptr); (* align *)
980 :     move(tag,Direct tmpR1);
981 :     emit(M.SW(tmpR1,dataptr',Immed16Off 0));
982 :     f(tmpR1,tmpR2,tmpF1,len-8,rev vl);
983 :     freeTmpReg tmpR1;
984 :     freeTmpReg tmpR2;
985 :     emit (M.ADD(z,dataptr',Immed16Op 4));
986 :     do_immed_arith(M.ADD,dataptr',dataptr',len)
987 :     end
988 : monnier 100 | fprecord _ = bug "MipsCM.fprecord: result not a register"
989 : monnier 16
990 :     end
991 :    
992 :     (* Note: mipsdepend will ensure that nothing generated here gets reordered.
993 :     * Also note that an unsigned comparison is necessary, since this is a pointer
994 :     * comparison.
995 :     *)
996 :     fun testLimit() = emit(M.SLTU(M.heapExhaustedReg,dataptr',RegOp(limit')))
997 :     fun decLimit n = do_immed_arith(M.ADD,limit',limit',~n) (* for polling *)
998 :    
999 :     val startgc_offset = MachSpec.startgcOffset
1000 :    
1001 :     fun checkLimit(max_allocation, lab, mask, rlab, fregs) =
1002 :     (* NOTE: THIS CODE USES TEMP REGS BY ALIASES.
1003 :     Thus it is important that none of the emitted pseudo-instructions
1004 :     below uses getTmpReg(), directly or indirectly. *)
1005 :     let val lab' = C.newLabel()
1006 :     val _ = if max_allocation > 4096 then
1007 :     (do_immed_arith(M.ADD,M.heapExhaustedReg,dataptr',
1008 :     max_allocation - 4096);
1009 :     emit(M.SLTU(M.heapExhaustedReg,M.heapExhaustedReg,
1010 :     RegOp(limit'))))
1011 :     else ()
1012 :     val _ = emitBRANCH(false,M.heapExhaustedReg, Reg0, lab')
1013 :     in (case fregs
1014 :     of [] => (do_immed_mem(M.LW,M.heapExhaustedReg,stackptr',
1015 :     startgc_offset);
1016 :     move(mask, Direct M.maskReg);
1017 :     move(lab, Direct M.linkReg);
1018 :     emit(M.JUMP M.heapExhaustedReg))
1019 :     | _ => (let val k = length fregs
1020 :     val lowOff = E.low_order_offset
1021 :     val desc = dtoi(D.makeDesc(k * 8, D.tag_string))
1022 :     val retlab = C.newLabel()
1023 :    
1024 :     fun deposit([], _) = ()
1025 :     | deposit((Direct x)::r, i) =
1026 :     (case (reg_rep x)
1027 :     of (Freg' n) =>
1028 :     (do_immed_mem(M.SWC1,Freg(n+1-lowOff),
1029 :     dataptr',i+4);
1030 :     do_immed_mem(M.SWC1,Freg(n+lowOff),
1031 :     dataptr',i);
1032 :     deposit(r, i+8))
1033 : monnier 100 | _ => bug "wrong register checkLimit")
1034 : monnier 16
1035 :     fun restore(s, [], _) = ()
1036 :     | restore(s, (Direct x)::r, i) =
1037 :     (case (reg_rep x)
1038 :     of (Freg' n) =>
1039 :     (do_immed_mem(M.LWC1,Freg(n+1-lowOff),
1040 :     s,i+4);
1041 :     do_immed_mem(M.LWC1,Freg(n+lowOff),
1042 :     s,i);
1043 :     restore(s, r, i+8))
1044 : monnier 100 | _ => bug "wrong register checkLimit")
1045 : monnier 16
1046 :     in deposit(fregs,4);
1047 :     move(immed desc, Direct M.heapExhaustedReg);
1048 :     (* orb(dataptr,Immed 4,dataptr);*) (* align *)
1049 :     emit(M.SW(M.heapExhaustedReg, dataptr', Immed16Off 0));
1050 :     emit(M.ADD(M.maskReg, dataptr', Immed16Op 4));
1051 :     do_immed_arith(M.ADD,dataptr',dataptr',k*8+4);
1052 :     do_immed_mem(M.SW,M.maskReg,stackptr',4+pregs_offset);
1053 :     (* I am using pseudo register #2 here !!! *)
1054 :    
1055 :     do_immed_mem(M.LW,M.heapExhaustedReg,stackptr',
1056 :     startgc_offset);
1057 :     move(mask, Direct M.maskReg);
1058 :     move(ImmedLab retlab, Direct M.linkReg);
1059 :     emit(M.JUMP M.heapExhaustedReg);
1060 :    
1061 :     C.define retlab;
1062 :     do_immed_mem(M.LW,M.maskReg,stackptr',4+pregs_offset);
1063 :     (* I am using pseudo register #2 here !!! *)
1064 :     move(rlab, Direct M.linkReg);
1065 :     restore(M.maskReg, fregs, 0);
1066 :     emit(M.JUMP M.linkReg)
1067 :     end));
1068 :     C.define lab'
1069 :     end
1070 :    
1071 :     fun beginStdFn(ImmedLab lab, Direct reg) = emitSDI(M.SETBASEADDR(lab,reg))
1072 :    
1073 :     local
1074 :     structure P = CPS.P
1075 :     fun floating_arith f (x,y,z) = emit(f(floatreg x,floatreg y,floatreg z))
1076 :     in
1077 :     fun fmuld(x,y,z) = floating_arith M.MUL_DOUBLE (z,x,y)
1078 :     fun fdivd(x,y,z) = floating_arith M.DIV_DOUBLE (z,x,y)
1079 :     fun faddd(x,y,z) = floating_arith M.ADD_DOUBLE (z,x,y)
1080 :     fun fsubd(x,y,z) = floating_arith M.SUB_DOUBLE (z,x,y)
1081 :     fun fnegd(op1,result) = emit(M.NEG_DOUBLE(floatreg result,floatreg op1))
1082 :     fun fabsd(op1,result) = emit(M.ABS_DOUBLE(floatreg result,floatreg op1))
1083 :    
1084 :     fun fbranchd (cond, op1, op2, ImmedLab label) = let
1085 :     fun compare P.fEQ = (M.EQ, true)
1086 :     | compare P.fULG = (M.EQ, false)
1087 :     | compare P.fGT = (M.NGT, false)
1088 :     | compare P.fGE = (M.NGE, false)
1089 :     | compare P.fLT = (M.LT, true)
1090 :     | compare P.fLE = (M.LE, true)
1091 :     | compare P.fLG = (M.UEQ, false)
1092 :     | compare P.fLEG = (M.NGLE, false)
1093 :     | compare P.fUGT = (M.LE, false)
1094 :     | compare P.fUGE = (M.LT, false)
1095 :     | compare P.fULT = (M.ULT, true)
1096 :     | compare P.fULE = (M.ULE, true)
1097 :     | compare P.fUE = (M.UEQ, true)
1098 :     | compare P.fUN = (M.EQ, true)
1099 :    
1100 :     val (cmp, test) = compare cond
1101 :     in
1102 :     emit(M.FCMP(cmp, floatreg op1, floatreg op2));
1103 :     emitBRANCH_COP1(test, label)
1104 :     end
1105 : monnier 100 | fbranchd _ = bug "MipsCM.fbranchd: insane target"
1106 : monnier 16 end
1107 :    
1108 :    
1109 :     fun cvti2d(Direct src,dst as Direct dst') =
1110 :     (case (reg_rep src, reg_rep dst')
1111 :     of (Reg' _, Freg' _) => (emit (M.MTC1(src, dst'));
1112 :     emit (M.CVTI2D(dst', dst'))))
1113 :     | cvti2d(Immed n, dst) =
1114 :     let val tmpR = getTmpReg()
1115 :     in do_immed_arith(M.ADD,tmpR,Reg0,n);
1116 :     cvti2d(Direct tmpR,dst);
1117 :     freeTmpReg tmpR
1118 :     end
1119 :    
1120 :     val comment = C.comment
1121 :     end
1122 :    
1123 :    
1124 :    
1125 :    
1126 :    
1127 :    
1128 :    
1129 :     (*
1130 :     * $Log: mips.sml,v $
1131 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:47 george
1132 :     * Version 110.5
1133 : monnier 16 *
1134 :     *)

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