![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sparc.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 / sparc|
Return to sparc.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / sparc |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: (* sparc.sml
3: *
4: * J.H. Reppy
5: * Cornell University
6: * Ithaca, NY 14853
7: * [email protected]
8: *
9: * HISTORY:
10: * 11/20/89 created
11: *)
12:
13: functor SparcCM (
14: structure C : CODER
15: sharing type C.instruction = SparcInstr.instruction
16: and type C.sdi = SparcInstr.sdi
17: and type C.label = SparcInstr.label) : CMACHINE =
18: struct
19:
20: structure C' : sig
21: eqtype label
22: val newLabel : unit -> label
23: val emitLong : int -> unit
24: val emitString : string -> unit
25: val emitReal : string -> unit
26: val emitLabel : (label * int) -> unit
27: val mark : unit -> unit
28: val comment : string -> unit
29: end = C
30: open C'
31:
32: structure S' : sig
33: eqtype label
34: datatype register = REG of int
35: datatype fregister = FREG of int
36: datatype labelexp
37: = LABELexp of { (* An offset relative to a label. The value of a *)
38: base : label, (* label expression is ((dst - base) + offset). *)
39: dst : label,
40: offset : int
41: }
42: datatype operand
43: = REGrand of register (* A register value *)
44: | IMrand of int (* A small integer constant (13 bits) *)
45: | LABrand of labelexp (* A small valued label expression (13 bits) *)
46: | HIrand of labelexp (* The high 22 bits of a label expression *)
47: | LOrand of labelexp (* The low 10 bits of a label expression *)
48: datatype condition = EQL | NEQ | GTR | GEQ | LSS | LEQ
49: end = SparcInstr
50: open S'
51:
52: val zeroR = REG 0 (* %g0 *)
53: val zeroRand = REGrand zeroR
54:
55: local
56:
57: fun emit_ld args = C.emit (SparcInstr.I_ld args)
58: fun emit_ldb args = C.emit (SparcInstr.I_ldb args)
59: fun emit_ldf args = C.emit (SparcInstr.I_ldf args)
60: fun emit_st args = C.emit (SparcInstr.I_st args)
61: fun emit_stb args = C.emit (SparcInstr.I_stb args)
62: fun emit_stf args = C.emit (SparcInstr.I_stf args)
63: fun emit_sethi args = C.emit (SparcInstr.I_sethi args)
64: fun emit_ba args = C.delay (SparcInstr.I_ba args)
65: fun emit_bcc args = C.delay (SparcInstr.I_bcc args)
66: fun emit_fbcc args = C.delay (SparcInstr.I_fbcc args)
67: fun emit_jmpl args = C.delay (SparcInstr.I_jmpl args)
68: fun emit_jmp (r, offset) = C.delay (SparcInstr.I_jmpl(r, offset, zeroR))
69: fun emit_add args = C.emit (SparcInstr.I_add args)
70: fun emit_addcc args = C.emit (SparcInstr.I_addcc args)
71: fun emit_taddcctv args = C.emit (SparcInstr.I_taddcctv args)
72: fun emit_sub args = C.emit (SparcInstr.I_sub args)
73: fun emit_subcc args = C.emit (SparcInstr.I_subcc args)
74: fun emit_sra args = C.emit (SparcInstr.I_sra args)
75: fun emit_sll args = C.emit (SparcInstr.I_sll args)
76: fun emit_and args = C.emit (SparcInstr.I_and args)
77: fun emit_andcc args = C.emit (SparcInstr.I_andcc args)
78: fun emit_or args = C.emit (SparcInstr.I_or args)
79: fun emit_xor args = C.emit (SparcInstr.I_xor args)
80: fun emit_not args = C.emit (SparcInstr.I_not args)
81: fun emit_tvs () = C.emit SparcInstr.I_tvs
82: fun emit_fadd args = C.emit (SparcInstr.I_fadd args)
83: fun emit_fsub args = C.emit (SparcInstr.I_fsub args)
84: fun emit_fmul args = C.emit (SparcInstr.I_fmul args)
85: fun emit_fdiv args = C.emit (SparcInstr.I_fdiv args)
86: fun emit_fneg args = C.emit (SparcInstr.I_fneg args)
87: fun emit_fcmp args = C.delay (SparcInstr.I_fcmp args)
88:
89: local
90: fun mkLabExp (lab, n) = LABELexp{base= C.baseLab, dst= lab, offset= (n-4096)}
91: in
92:
93: fun setBaseAddr (contReg, lab, tmpR) = C.emitSDI (
94: SparcInstr.SetBaseAddr(ref true, contReg, mkLabExp(lab, 0), tmpR))
95:
96: fun loadAddr (lab, n, dst, tmpR) = C.emitSDI (
97: SparcInstr.LoadAddr(mkLabExp(lab, n), dst, tmpR))
98:
99: fun load (lab, n, dst, tmpR) = C.emitSDI (
100: SparcInstr.Load(mkLabExp(lab, n), dst, tmpR))
101:
102: fun loadF (lab, n, dst, tmpR) = C.emitSDI (
103: SparcInstr.LoadF(mkLabExp(lab, n), dst, tmpR))
104:
105: end (* local *)
106:
107: in
108:
109: datatype EA
110: = Immed of int
111: | ImmedLab of label
112: | Direct of register
113:
114: val immed = Immed
115: fun isimmed (Immed n) = SOME n | isimmed _ = NONE
116: fun isreg (Direct(REG i)) = SOME i | isreg _ = NONE
117: fun eqreg (a : EA) b = (a = b)
118:
119: (** Dedicated registers **)
120: val exnptr = Direct(REG 7) (* %g7 *)
121: val storeptr = Direct(REG 5) (* %g5 *)
122: val arithtemp = Direct(REG 8) (* %o0 *)
123: val arithtemp2 = Direct(REG 9) (* %o1 *)
124: val standardclosure = Direct(REG 26) (* %i2 *)
125: val standardarg = Direct(REG 24) (* %i0 *)
126: val standardcont = Direct(REG 25) (* %i1 *)
127: val miscregs = map (Direct o REG) [ (* %g1-%g3, %l0-%l7, %i4-%i5 *)
128: 1, 2, 3, 16, 17, 18, 19, 20, 21, 22, 23, 28, 29
129: ]
130:
131: val dataptrR = REG 6 (* %g6 *)
132: val limitptrR = REG 4 (* %g4 *)
133: val limitptrRand = REGrand limitptrR
134: val arithtempRand = REGrand(REG 8)
135: val spR = REG 14 (* %sp (%o6) *)
136: val linkR = REG 15 (* %o7, link register *)
137:
138: (** Temporary registers **
139: * We use registers %o2-%o5 as temporaries. They are used in a round-robin
140: * order to facilitate instruction scheduling.
141: *)
142: local
143: val rear = ref 0 and queue = ref 0
144: fun ins i = let
145: val r = !rear
146: in
147: queue := Bits.orb(Bits.lshift(i, r), !queue);
148: rear := r + 5
149: end
150: fun remove () = let
151: val q = !queue
152: val x = Bits.andb (q, 31)
153: in
154: queue := Bits.rshift (q, 5);
155: rear := !rear - 5;
156: x
157: end
158: val _ = app ins [10, 11, 12, 13] (* %o2-%o5 *)
159: in
160:
161: (* Registers %o2, %o3 & %o4 are also used to call ml_mul and ml_div. *)
162: val arg1EA = Direct(REG 10) and arg2EA = Direct(REG 11)
163: val opAddrR = REG 12
164:
165: (* Get a temporary register. *)
166: fun getTmpReg () = REG(remove())
167:
168: (* If r is a temporary register, then free it. *)
169: fun freeReg (REG r) = if ((9 < r) andalso (r < 14)) then (ins r) else ()
170:
171: (* Free a temporary register. *)
172: fun freeTmpReg (REG r) = ins r
173:
174: end (* local *)
175:
176:
177: (* align is a nop, since strings are automatically padded. *)
178: fun align () = ()
179:
180: val mark = mark
181:
182: val emitlong = emitLong
183: val realconst = emitReal
184: val emitstring = emitString
185:
186: fun emitlab (n, ImmedLab lab) = emitLabel (lab, n)
187: | emitlab _ = ErrorMsg.impossible "[SparcCM.emitlab]"
188:
189: val newlabel = ImmedLab o newLabel
190: fun define (ImmedLab lab) = C.define lab
191: | define _ = ErrorMsg.impossible "[SparcCM.define]"
192:
193: datatype immed_size = Immed13 | Immed32
194:
195: fun sizeImmed n = if (~4096 <= n) andalso (n < 4096) then Immed13 else Immed32
196:
197:
198: (** Utility operations **)
199:
200: fun emitMove (src, dst) = emit_or (zeroR, REGrand src, dst)
201:
202: fun loadImmed32 (n, r) = let
203: val lo10 = Bits.andb(n, 1023)
204: in
205: emit_sethi (IMrand(Bits.rshift(n, 10)), r);
206: if (lo10 <> 0) then emit_or(r, IMrand lo10, r) else ()
207: end
208:
209: fun loadImmed (n, r) = (
210: case (sizeImmed n)
211: of Immed13 => emit_or(zeroR, IMrand n, r)
212: | Immed32 => loadImmed32 (n, r))
213:
214: fun op32 f (r1, n, r2) = let val tmpR = getTmpReg()
215: in
216: loadImmed32 (n, tmpR);
217: f (r1, REGrand tmpR, r2);
218: freeTmpReg tmpR
219: end
220:
221: fun loadReg(r, offset, dst) = (
222: case (sizeImmed offset)
223: of Immed13 => emit_ld (r, IMrand offset, dst)
224: | Immed32 => (op32 emit_ld) (r, offset, dst))
225:
226: fun store (src, r, offset) = (
227: case (sizeImmed offset)
228: of Immed13 => emit_st (r, IMrand offset, src)
229: | Immed32 => (op32 emit_st) (r, offset, src))
230:
231: fun addImmed (r, n, dst) = (
232: case (sizeImmed n)
233: of Immed13 => emit_add (r, IMrand n, dst)
234: | Immed32 => (op32 emit_add) (r, n, dst))
235:
236: fun compareImmed (r, n) = (
237: case (sizeImmed n)
238: of Immed13 => emit_subcc (r, IMrand n, zeroR)
239: | Immed32 => (op32 emit_subcc) (r, n, zeroR))
240:
241:
242: (** CMachine instructions **)
243:
244: (* move (src, dst) *)
245: fun move (Immed n, Direct r) = loadImmed (n, r)
246: | move (ImmedLab lab, Direct r) = let val tmpR = getTmpReg()
247: in
248: loadAddr (lab, 0, r, tmpR);
249: freeTmpReg tmpR
250: end
251: | move (Direct r1, Direct r2) = emitMove (r1, r2)
252: | move _ = ErrorMsg.impossible "[SparcCM.move]"
253:
254: (* checkLimit (n):
255: * Generate code to check the heap limit to see if there is enough free space
256: * to allocate n bytes.
257: * NOTE: The handler in "runtime/SPARC.dep.c" is sensitive to the code
258: * sequences generated here.
259: *)
260: fun checkLimit maxAllocSize = (
261: if (maxAllocSize <= 4096)
262: then emit_taddcctv (dataptrR, limitptrRand, zeroR)
263: else let
264: val n = maxAllocSize - 4096
265: val tmpR = getTmpReg()
266: in
267: if (n < 2048)
268: then (
269: emit_add (limitptrR, IMrand n, tmpR);
270: emit_taddcctv (dataptrR, REGrand tmpR, zeroR))
271: else (
272: emit_sethi (IMrand(Bits.rshift(n, 10)), tmpR);
273: emit_or (tmpR, IMrand(Bits.andb(n, 1023)), tmpR);
274: emit_add (limitptrR, REGrand tmpR, tmpR);
275: emit_taddcctv (dataptrR, REGrand tmpR, zeroR));
276: freeTmpReg tmpR
277: end)
278:
279: (* beginStdFn (cl, lab):
280: * Note the beginning of a standard function with entry label lab, and
281: * register cl containing its closure. This requires generating code to
282: * load the base code block address into baseCodePtr.
283: *)
284: fun beginStdFn (Direct closureReg, ImmedLab lab) = let val tmpR = getTmpReg()
285: in
286: setBaseAddr (closureReg, lab, tmpR);
287: freeTmpReg tmpR
288: end
289: | beginStdFn _ = ErrorMsg.impossible "[SparcCM.beginStdFn]"
290:
291: (* jmp (dst):
292: * Unconditional jump to destination.
293: *)
294: fun jmp (ImmedLab lab) = emit_ba lab
295: | jmp (Direct r) = emit_jmp (r, zeroRand)
296: | jmp _ = ErrorMsg.impossible "[SparcCM.jmp]"
297:
298: (* record (vl, dst):
299: * makes a new record, puts address of it into the destination specified
300: * by the second arg. The contents are numbered from ~1 and up.
301: *)
302: fun record (vl : (EA * CPS.accesspath) list, Direct dst) = let
303: val len = length vl
304: val minBlockSize = 6
305: (* generate code to move one or more adjacent fields from one record into
306: * adjacent fields in the new record. If the block is big enough, then
307: * use a block copy loop.
308: *)
309: fun blockMove (srcR, startindx, path, offset) = let
310: (* check a CPS path to see how large the block is *)
311: fun chkpath (cnt, i,
312: path as (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) =
313: if (r = srcR) andalso (i+offset = j)
314: then chkpath (cnt+1, i-1, rest)
315: else (cnt, path)
316: | chkpath (cnt, _, rest) = (cnt, rest)
317: (* generate code to move fields individually *)
318: fun moveFields (0, _) = ()
319: | moveFields (n, indx) = let val tmpR = getTmpReg()
320: in
321: loadReg(srcR, (indx+offset)*4, tmpR);
322: store (tmpR, dataptrR, indx*4);
323: freeTmpReg tmpR;
324: moveFields(n-1, indx-1)
325: end
326: val (blksz, rest) = chkpath(1, startindx-1, path)
327: in
328: if (blksz < minBlockSize)
329: then moveFields(blksz, startindx)
330: else if (offset = 0)
331: then let
332: val lab = newLabel()
333: val indxR = getTmpReg() and tmpR = getTmpReg()
334: in
335: loadImmed (startindx*4, indxR);
336: C.define lab;
337: emit_ld (srcR, REGrand indxR, tmpR);
338: compareImmed (indxR, (startindx-blksz)*4);
339: emit_st (dataptrR, REGrand indxR, tmpR);
340: emit_sub (indxR, IMrand 4, indxR);
341: emit_bcc (GTR, lab);
342: freeTmpReg indxR; freeTmpReg tmpR
343: end
344: else let
345: val lab = newLabel()
346: val indxR1 = getTmpReg() and indxR2 = getTmpReg()
347: val tmpR = getTmpReg()
348: in
349: loadImmed ((startindx+offset)*4, indxR1);
350: loadImmed (startindx*4, indxR2);
351: C.define lab;
352: emit_ld (srcR, REGrand indxR1, tmpR);
353: emit_sub (indxR1, IMrand 4, indxR1);
354: emit_st (dataptrR, REGrand indxR2, tmpR);
355: emit_sub (indxR2, IMrand 4, indxR2);
356: compareImmed (indxR1, (startindx+offset-blksz)*4);
357: emit_bcc (GTR, lab);
358: freeTmpReg indxR1; freeTmpReg indxR2; freeTmpReg tmpR
359: end;
360: freeReg srcR;
361: (startindx-blksz, rest)
362: end (* blockMove *)
363: (* For each field in the record generate the necessary moves to initialize
364: * it in the new record.
365: *)
366: fun fields (_, nil) = ()
367: | fields (i, (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) =
368: fields (blockMove (r, i, rest, j-i))
369: | fields (i, (Direct r, CPS.SELp(j, p)) :: rest) = let
370: val tmpR = getTmpReg()
371: in
372: loadReg(r, j*4, tmpR);
373: freeReg r;
374: fields (i, (Direct tmpR, p) :: rest)
375: end
376: | fields (i, (Direct r, CPS.OFFp 0) :: rest) = (
377: store (r, dataptrR, i*4);
378: freeReg r;
379: fields (i-1, rest))
380: | fields (i, (Direct r, CPS.OFFp j) :: rest) = let
381: val tmpR = getTmpReg()
382: val offset = j*4
383: in
384: case sizeImmed offset
385: of Immed13 => emit_add (r, IMrand offset, tmpR)
386: | Immed32 => (
387: loadImmed32 (offset, tmpR);
388: emit_add (r, REGrand tmpR, tmpR))
389: (* end case *);
390: store (tmpR, dataptrR, i*4);
391: freeTmpReg tmpR; freeReg r;
392: fields (i-1, rest)
393: end
394: | fields (i, (x, p) :: rest) = let
395: val tmpR = getTmpReg()
396: in
397: move (x, Direct tmpR);
398: fields (i, (Direct tmpR, p) :: rest)
399: end
400: in
401: fields (len-2, rev vl);
402: emitMove (dataptrR, dst);
403: addImmed (dataptrR, len*4, dataptrR)
404: end
405: | record _ = ErrorMsg.impossible "[SparcCM.record]"
406:
407: (* select (i, x, y): y <- mem[x + 4*i] *)
408: fun select (i, Direct r, Direct dst) = loadReg(r, i*4, dst)
409: | select (i, ImmedLab lab, Direct dst) = let val tmpR = getTmpReg()
410: in
411: load (lab, i*4, dst, tmpR);
412: freeTmpReg tmpR
413: end
414: | select _ = ErrorMsg.impossible "[SparcCM.select]"
415:
416: (* offset (i, x, y): y <- (x + 4*i) *)
417: fun offset (i, Direct r, Direct dst) = addImmed (r, 4*i, dst)
418: | offset (i, ImmedLab lab, Direct dst) = let val tmpR = getTmpReg()
419: in
420: loadAddr (lab, i, dst, tmpR);
421: freeTmpReg tmpR
422: end
423: | offset _ = ErrorMsg.impossible "[SparcCM.offset]"
424:
425: (* fetchindexb (x, y) fetches an unsigned byte: y <- mem[x+arithtemp] *)
426: fun fetchindexb (Direct r, Direct dst) = emit_ldb (r, arithtempRand, dst)
427: | fetchindexb _ = ErrorMsg.impossible "[SparcCM.fetchindexb]"
428:
429: (* storeindexb (x, y) stores a byte: mem[y+arithtemp] <- x *)
430: fun storeindexb (Direct src, Direct r) = emit_stb (r, arithtempRand, src)
431: | storeindexb _ = ErrorMsg.impossible "[SparcCM.storeindexb]"
432:
433: (* jmpindexb (x): pc <- (x+arithtemp) *)
434: fun jmpindexb (ImmedLab lab) = let
435: val tmpR1 = getTmpReg() and tmpR2 = getTmpReg()
436: in
437: loadAddr (lab, 0, tmpR1, tmpR2);
438: emit_jmp (tmpR1, arithtempRand);
439: freeTmpReg tmpR1; freeTmpReg tmpR2
440: end
441: | jmpindexb _ = ErrorMsg.impossible "[SparcCM.jmpindexb]"
442:
443: (* fetchindexl (x, y, z) fetches a word: y <- mem[x+2*(z-1)] *)
444: fun fetchindexl (Direct r1, Direct dst, Direct r2) = let
445: val tmpR = getTmpReg()
446: in
447: emit_sub (r2, IMrand 1, tmpR);
448: emit_add (tmpR, REGrand tmpR, tmpR);
449: emit_ld (r1, REGrand tmpR, dst);
450: freeTmpReg tmpR
451: end
452: | fetchindexl (Direct r1, Direct dst, Immed i) = loadReg(r1, 2*(i-1), dst)
453: | fetchindexl (ImmedLab lab, Direct dst, Direct r) = let
454: val tmpR1 = getTmpReg() and tmpR2 = getTmpReg()
455: in
456: loadAddr (lab, ~2, tmpR1, tmpR2);
457: emit_add (r, REGrand tmpR1, tmpR1);
458: emit_ld (r, REGrand tmpR1, dst);
459: freeTmpReg tmpR1; freeTmpReg tmpR2
460: end
461: | fetchindexl _ = ErrorMsg.impossible "[SparcCM.fetchindexl]"
462:
463: (*storeindexl (x, y, z) stores a word: mem[y+2*(z-1)] <- x *)
464: fun storeindexl (Direct src, Direct r1, Direct r2) = let val tmpR = getTmpReg()
465: in
466: emit_sub (r2, IMrand 1, tmpR);
467: emit_add (tmpR, REGrand tmpR, tmpR);
468: emit_st (r1, REGrand tmpR, src);
469: freeTmpReg tmpR
470: end
471: | storeindexl (Direct src, Direct r, Immed i) = store (src, r, 2*(i-1))
472: | storeindexl (Immed n, x, y) = let val tmpR = getTmpReg()
473: in
474: loadImmed (n, tmpR);
475: storeindexl (Direct tmpR, x, y);
476: freeTmpReg tmpR
477: end
478: | storeindexl (ImmedLab lab, x, y) = let
479: val tmpR1 = getTmpReg() and tmpR2 = getTmpReg()
480: in
481: loadAddr (lab, 0, tmpR1, tmpR2);
482: storeindexl (Direct tmpR1, x, y);
483: freeTmpReg tmpR1; freeTmpReg tmpR2
484: end
485: (** NOTE: in a sane world the following case would be unecessary, but they
486: ** are used in an ugly profiling hack.
487: **)
488: | storeindexl (Direct src, ImmedLab lab, Immed i) = let
489: val tmpR1 = getTmpReg() and tmpR2 = getTmpReg()
490: in
491: loadAddr (lab, 2*(i-1), tmpR1, tmpR2);
492: emit_st (tmpR1, zeroRand, src);
493: freeTmpReg tmpR1; freeTmpReg tmpR2
494: end
495: | storeindexl _ = ErrorMsg.impossible "[SparcCM.storeindexl]"
496:
497: (* ashl (n, x, y) shift left: y <- (x << n), with n >= 0 *)
498: fun ashl (Direct cntR, Direct src, Direct dst) =
499: emit_sll(src, REGrand cntR, dst)
500: | ashl (Immed cnt, Direct src, Direct dst) =
501: emit_sll (src, IMrand(Bits.andb(cnt, 31)), dst)
502: | ashl (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
503: in
504: loadImmed (src, tmpR);
505: emit_sll (tmpR, REGrand cntR, dst);
506: freeTmpReg tmpR
507: end
508: | ashl _ = ErrorMsg.impossible "[SparcCM.ashl]"
509:
510: (* ashr (n, x, y) shift right: y <- (x >> n), with n >= 0 *)
511: fun ashr (Direct cntR, Direct src, Direct dst) =
512: emit_sra (src, REGrand cntR, dst)
513: | ashr (Immed cnt, Direct src, Direct dst) =
514: emit_sra (src, IMrand(Bits.andb(cnt, 31)), dst)
515: | ashr (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
516: in
517: loadImmed (src, tmpR);
518: emit_sra (tmpR, REGrand cntR, dst);
519: freeTmpReg tmpR
520: end
521: | ashr (Immed cnt, Immed src, Direct dst) = (
522: print "[missed constant fold ("; print src; print " >> "; print cnt; print ")]\n";
523: loadImmed (Bits.rshift(src, cnt), dst))
524: | ashr _ = ErrorMsg.impossible "[SparcCM.ashr]"
525:
526: local
527: fun adjArgs f (a as Immed _, b, c) = f (b, a, c)
528: | adjArgs f args = f args
529: fun adjSubArgs f (a, Immed b, c) = let val tmpR = getTmpReg()
530: in
531: loadImmed (b, tmpR);
532: f (Direct tmpR, a, c);
533: freeTmpReg tmpR
534: end
535: | adjSubArgs f (a, b, c) = f (b, a, c)
536: fun arithOp f (Direct r1, Direct r2, Direct dst) = f (r1, REGrand r2, dst)
537: | arithOp f (Direct r, Immed n, Direct dst) = (
538: case (sizeImmed n)
539: of Immed13 => f (r, IMrand n, dst)
540: | Immed32 => let val tmpR = getTmpReg()
541: in
542: loadImmed32 (n, tmpR);
543: f (r, REGrand tmpR, dst);
544: freeTmpReg tmpR
545: end)
546: | arithOp _ _ = ErrorMsg.impossible "[SparcCM.arithOp]"
547: val addt = adjArgs (arithOp (fn args => (emit_addcc args; emit_tvs())))
548: in
549:
550: val orb = adjArgs (arithOp emit_or)
551: val andb = adjArgs (arithOp emit_and)
552: val xorb = adjArgs (arithOp emit_xor)
553: fun notb (Direct src, Direct dst) = emit_not (src, dst)
554: | notb _ = ErrorMsg.impossible "[SparcCM.notb]"
555:
556: val addl3 = adjArgs (arithOp emit_add)
557: fun addl3t (Immed a, b as Immed _, dst) = let val tmpR = getTmpReg ()
558: (* This should only occur when we need to build a constant larger than
559: * 2^29. Note, we assume that "b" is tagged (see "cps/generic.sml").
560: *)
561: in
562: loadImmed (a, tmpR);
563: addt (Direct tmpR, b, dst);
564: freeTmpReg tmpR
565: end
566: | addl3t args = addt args
567:
568: val subl3 = adjSubArgs (arithOp emit_sub)
569: val subl3t = adjSubArgs (arithOp (fn args => (emit_subcc args; emit_tvs())))
570:
571: end (* local *)
572:
573: (* mull2t/divl2t:
574: * mull2t (a, b): b <- (a * b) (with overflow checking done by ml_mul)
575: * divl2t (a, b): b <- (b div a)
576: *)
577: local
578: fun intOp opAddrOffset (a, b as Direct _) = (
579: emit_ld (spR, opAddrOffset, opAddrR);
580: move (a, arg2EA);
581: move (b, arg1EA);
582: emit_jmpl (opAddrR, zeroRand, linkR);
583: move (arg1EA, b))
584: | intOp _ _ = ErrorMsg.impossible "[SparcCM.intOp]"
585: val mulAddrOffset = IMrand 72
586: val divAddrOffset = IMrand 76
587: in
588: val mull2t = intOp mulAddrOffset
589: val divl2 = intOp divAddrOffset
590: end (* local *)
591:
592: (* bbs (i, dst, lab): test the i'th bit of dst and jump to lab if it is zero *)
593: fun bbs (Immed i, Direct r, ImmedLab lab) = (
594: emit_andcc (r, IMrand(Bits.lshift(1, i)), zeroR);
595: emit_bcc (NEQ, lab))
596: | bbs _ = ErrorMsg.impossible "[SparcCM.bbs]"
597:
598: local
599: (* reverse a condition (eg., (a <= b) <==> (b >= a) *)
600: fun revCond NEQ = NEQ | revCond EQL = EQL
601: | revCond LEQ = GEQ | revCond GEQ = LEQ
602: | revCond LSS = GTR | revCond GTR = LSS
603: in
604:
605: (* ibranch (cond, a, b, lab): if (a <cond> b) then pc <- lab *)
606: fun ibranch (cond, a as Immed _, b as Direct _, l) = ibranch (revCond cond, b, a, l)
607: | ibranch (cond, Direct r1, b, ImmedLab lab) = (
608: case b
609: of Direct r2 => emit_subcc (r1, REGrand r2, zeroR)
610: | Immed n => (
611: case (sizeImmed n)
612: of Immed13 => emit_subcc (r1, IMrand n, zeroR)
613: | Immed32 => let val tmpR = getTmpReg()
614: in
615: loadImmed32 (n, tmpR);
616: emit_subcc (r1, REGrand tmpR, zeroR);
617: freeTmpReg tmpR
618: end)
619: | _ => ErrorMsg.impossible "[SparcCM.ibranch.case]"
620: (* end case *);
621: emit_bcc (cond, lab))
622: | ibranch _ = ErrorMsg.impossible "[SparcCM.ibranch]"
623:
624: end (* local *)
625:
626:
627: (** Floating point instructions **
628: * These instructions take ML real values as arguments (ie., addresses of
629: * heap objects) and store their results in the heap.
630: *)
631:
632: local
633: val f0 = FREG 0
634: val f1 = FREG 1
635: val f2 = FREG 2
636: (* the tag code for real values. *)
637: val realTag = (8*System.Tags.power_tags + System.Tags.tag_string)
638: (* finishReal(r): emit code to store the result of a real operation
639: * (in %f0, %f1) in the heap, and put the result address in r.
640: *)
641: fun finishReal r = let val tmpR = getTmpReg()
642: in
643: loadImmed (realTag, tmpR);
644: emit_st (dataptrR, IMrand(~4), tmpR);
645: emit_stf (dataptrR, zeroRand, f0);
646: emit_stf (dataptrR, IMrand 4, f1);
647: emitMove (dataptrR, r);
648: emit_add (dataptrR, IMrand 12, dataptrR);
649: freeTmpReg tmpR
650: end
651: (* Fetch a ML real value into a floating-point register pair *)
652: fun fetchReal (Direct r, FREG i) = (
653: emit_ldf (r, zeroRand, FREG i);
654: emit_ldf (r, IMrand 4, FREG(i+1)))
655: | fetchReal (ImmedLab lab, dst) = let val tmpR = getTmpReg()
656: in
657: loadF (lab, 0, dst, tmpR);
658: freeTmpReg tmpR
659: end
660: | fetchReal _ = ErrorMsg.impossible "[SparcCM.fetchReal]"
661:
662: fun floatOp fOp (a, b, Direct dst) = (
663: fetchReal (a, f0);
664: fetchReal (b, f2);
665: fOp (f0, f2, f0);
666: finishReal dst)
667: | floatOp _ _ = ErrorMsg.impossible "[SparcCM.floatOp]"
668: in
669:
670: (* Negate the first arg and return a pointer to the result in the second *)
671: fun mnegg (src, Direct dst) = (
672: fetchReal (src, f0);
673: emit_fneg (f0, f0);
674: finishReal dst)
675: | mnegg _ = ErrorMsg.impossible "[SparcCM.mnegg]"
676:
677: (* Add the first two arguments and store the result in the third *)
678: val addg3 = floatOp emit_fadd
679:
680: (* Subtract the second argument from the first and store the result in the third *)
681: val subg3 = floatOp emit_fsub
682:
683: (* Multiply the first two arguments and store the result in the third *)
684: val mulg3 = floatOp emit_fmul
685:
686: (* Divide the first argument by the second and store the result in the third *)
687: val divg3 = floatOp emit_fdiv
688:
689: (* Conditionally branch on the float values of two arguments. *)
690: fun gbranch (cond, a, b, ImmedLab lab) = (
691: fetchReal (a, f0);
692: fetchReal (b, f2);
693: emit_fcmp (f0, f2);
694: emit_fbcc (cond, lab))
695: | gbranch _ = ErrorMsg.impossible "[SparcCM.gbranch]"
696:
697: end (* local *)
698:
699: fun profile _ = ()
700:
701: end (* local *)
702:
703: end (* functor SparcCM *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.