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/sparc/sparc.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/OldCGen/sparc/sparc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* sparc.sml
2 :     *
3 :     * Copyright 1989 by AT&T Bell Laboratories
4 :     *
5 :     * AUTHOR: John Reppy
6 :     * Cornell University
7 :     * Ithaca, NY 14853
8 :     * jhr@cs.cornell.edu
9 :     *
10 :     *)
11 :    
12 :     functor SparcCM (
13 :     structure C : CODER
14 :     where type 'a instruction = 'a SparcInstr.instruction
15 :     and type 'a sdi = 'a SparcInstr.sdi) : CMACHINE =
16 :     struct
17 :    
18 :     structure P = CPS.P
19 :     structure D = SparcSpec.ObjDesc
20 :    
21 :     val lwtoi = LargeWord.toInt (* for converting descriptors *)
22 :    
23 :     val itow = Word.fromInt
24 :     val wtoi = Word.toIntX
25 :    
26 :     fun low10 n = wtoi(Word.andb(itow n, 0w1023))
27 :     fun high22 n = wtoi(Word.~>>(itow n, 0w10))
28 :     fun andConst(x, w) = wtoi (Word.andb(itow x, w))
29 :    
30 :     (* Architecture depedent features *)
31 :     val wordSzB = 4
32 :    
33 :     structure C' : sig
34 :     eqtype label
35 :     val mark : unit -> unit
36 :     val comment : string -> unit
37 :     exception BadReal of string
38 :     end = C
39 :     open C'
40 :    
41 :     structure S' : sig
42 :     datatype register = REG of int
43 :     datatype fregister = FREG of int
44 :     datatype 'label labelexp
45 :     = LABELexp of { (* An offset relative to a label. The value of a *)
46 :     base : 'label, (* label expression is ((dst - base) + offset). *)
47 :     dst : 'label,
48 :     offset : int
49 :     }
50 :     datatype 'label operand
51 :     = REGrand of register (* A register value *)
52 :     | IMrand of int (* A small integer constant (13 bits) *)
53 :     | LABrand of 'label labelexp (* A small valued label expression (13 bits) *)
54 :     | HIrand of 'label labelexp (* The high 22 bits of a label expression *)
55 :     | LOrand of 'label labelexp (* The low 10 bits of a label expression *)
56 :     datatype cond_code
57 :     = CC_A | CC_E | CC_NE | CC_G | CC_GE | CC_L | CC_LE | CC_GEU | CC_LEU | CC_GU | CC_LU
58 :     datatype fcond_code
59 :     = FCC_A | FCC_U (* unordered *) | FCC_G | FCC_UG | FCC_L | FCC_UL
60 :     | FCC_LG | FCC_NE | FCC_E | FCC_UE | FCC_GE | FCC_UGE | FCC_LE
61 :     | FCC_ULE | FCC_O
62 :    
63 :     end = SparcInstr
64 :     open S'
65 :    
66 :     (* Offsets to important stack locations.
67 :     * NOTE: the following must track SPARC.prim.asm in the runtime
68 :     *)
69 :     val mulAddrOffset = IMrand 72
70 :     val divAddrOffset = IMrand 76
71 :     val umulAddrOffset = IMrand 80
72 :     val udivAddrOffset = IMrand 84
73 :     val cvti2dAddrOffset = IMrand 88
74 :     val startGCOffset = IMrand SparcSpec.startgcOffset
75 :    
76 :     val zeroR = REG 0 (* %g0 *)
77 :     val zeroRand = REGrand zeroR
78 :    
79 :     local
80 :    
81 :     fun emit_ld args = C.emit (SparcInstr.I_ld args)
82 :     fun emit_ldb args = C.emit (SparcInstr.I_ldb args)
83 :     fun emit_ldf args = C.emit (SparcInstr.I_ldf args)
84 :     fun emit_st args = C.emit (SparcInstr.I_st args)
85 :     fun emit_stb args = C.emit (SparcInstr.I_stb args)
86 :     fun emit_stf args = C.emit (SparcInstr.I_stf args)
87 :     fun emit_sethi args = C.emit (SparcInstr.I_sethi args)
88 :     fun emit_bcc args = C.emit (SparcInstr.I_bcc args)
89 :     fun emit_fbcc args = C.emit (SparcInstr.I_fbcc args)
90 :     fun emit_jmpl args = C.emit (SparcInstr.I_jmpl args)
91 :     fun emit_jmp (r, offset) = C.emit (SparcInstr.I_jmpl(r, offset, zeroR))
92 :     fun emit_add args = C.emit (SparcInstr.I_add args)
93 :     fun emit_addcc args = C.emit (SparcInstr.I_addcc args)
94 :     fun emit_taddcctv args = C.emit (SparcInstr.I_taddcctv args)
95 :     fun emit_sub args = C.emit (SparcInstr.I_sub args)
96 :     fun emit_subcc args = C.emit (SparcInstr.I_subcc args)
97 :     fun emit_sra args = C.emit (SparcInstr.I_sra args)
98 :     fun emit_srl args = C.emit (SparcInstr.I_srl args)
99 :     fun emit_sll args = C.emit (SparcInstr.I_sll args)
100 :     fun emit_and args = C.emit (SparcInstr.I_and args)
101 :     fun emit_andcc args = C.emit (SparcInstr.I_andcc args)
102 :     fun emit_or args = C.emit (SparcInstr.I_or args)
103 :     fun emit_xor args = C.emit (SparcInstr.I_xor args)
104 :     fun emit_not args = C.emit (SparcInstr.I_not args)
105 :     fun emit_tvs () = C.emit SparcInstr.I_tvs
106 :     fun emit_fadd args = C.emit (SparcInstr.I_fadd args)
107 :     fun emit_fsub args = C.emit (SparcInstr.I_fsub args)
108 :     fun emit_fmul args = C.emit (SparcInstr.I_fmul args)
109 :     fun emit_fdiv args = C.emit (SparcInstr.I_fdiv args)
110 :     fun emit_fneg args = C.emit (SparcInstr.I_fneg args)
111 :     fun emit_fabs args = C.emit (SparcInstr.I_fabs args)
112 :     fun emit_fcmp args = C.emit (SparcInstr.I_fcmp args)
113 :     fun emit_fmov args = C.emit (SparcInstr.I_fmov args)
114 :     fun emit_fitod args = C.emit (SparcInstr.I_fitod args)
115 :    
116 :     local
117 :     fun mkLabExp (lab, n) = LABELexp{base= C.baseLab, dst= lab, offset= (n-4096)}
118 :     in
119 :    
120 :     fun setBaseAddr (lab, reg) =
121 :     C.emitSDI (
122 :     SparcInstr.SetBaseAddr(mkLabExp(lab, 0), reg))
123 :    
124 :     fun loadAddr (lab, n, dst) = (
125 :     C.emitSDI (SparcInstr.LoadAddr(mkLabExp(lab, n), dst)))
126 :    
127 :     fun load (lab, n, dst, tmpR) = (
128 :     C.emitSDI (SparcInstr.Load(mkLabExp(lab, n), dst, tmpR)))
129 :    
130 :     fun loadF (lab, n, dst, tmpR) = (
131 :     C.emitSDI (SparcInstr.LoadF(mkLabExp(lab, n), dst, tmpR)))
132 :    
133 :     end (* local *)
134 :    
135 :     in
136 :    
137 :     datatype EA
138 :     = Immed of int
139 :     | Word32 of Word32.word
140 :     | ImmedLab of label
141 :     | Direct of register
142 :     | FDirect of fregister
143 :    
144 :     datatype condition = EQL | NEQ | GTR | GEQ | LSS | LEQ
145 :     | GEU | GTU | LTU | LEU
146 :    
147 :     val immed = Immed
148 :     val immed32 = Word32
149 :    
150 :    
151 :     (** Dedicated registers **)
152 :     val exnptr = Direct(REG 7) (* %g7 *)
153 :     val arithtemps = []
154 :     val varptr = Direct(REG 29) (* %i5 *)
155 :     val varptr_indexable = true
156 :     val standardclosure = Direct(REG 26) (* %i2 *)
157 :     val standardarg = Direct(REG 24) (* %i0 *)
158 :     val standardcont = Direct(REG 25) (* %i1 *)
159 :     val standardlink = Direct(REG 1) (* %g1 *)
160 :     val miscregs = map (Direct o REG) [ (* %g2-%g3, %o0-%o1, %l0-%l7, %i4 *)
161 :     2, 3, 8, 9, 16, 17, 18, 19, 20, 21, 22, 23, 28
162 :     ]
163 :     (* Note: cc treats none of the floating point registers as callee save. *)
164 :     val savedfpregs = [] : EA list
165 :     val floatregs = let fun from(n,m) = if n > m then [] else n :: from(n+2,m)
166 :     in map (FDirect o FREG) (from(0,31))
167 :     end
168 :     val dataptrR = REG 6 (* %g6 *)
169 :     val storeptrR = REG 5 (* %g5 *)
170 :     val limitptrR = REG 4 (* %g4 *)
171 :     val limitptrRand = REGrand limitptrR
172 :     (* the following two registers are used for calling ml_mul & ml_div *)
173 :     val spR = REG 14 (* %sp (%o6) *)
174 :     val linkR = REG 15 (* %o7, link register *)
175 :     val maskR = REG 13 (* %o5, also used as temporary *)
176 :     val checkR = REG 12 (* %o4, also used as temporary *)
177 :    
178 :     (** Temporary registers **
179 :     * We use registers %o2-%o5 as temporaries. They are used in a round-robin
180 :     * order to facilitate instruction scheduling.
181 :     *)
182 :     local
183 :     val rear = ref 0 and queue = ref 0w0
184 :     fun ins i = let
185 :     val r = !rear
186 :     in
187 :     queue := Word.orb(Word.<<(itow i, itow r), !queue);
188 :     rear := r + 5
189 :     end
190 :     fun remove () = let
191 :     val q = !queue
192 :     val x = wtoi (Word.andb (q, 0w31))
193 :     in
194 :     queue := Word.>> (q, 0w5);
195 :     rear := !rear - 5;
196 :     x
197 :     end
198 :     val _ = app ins [10, 11, 12, 13] (* %o2-%o5 *)
199 :     in
200 :    
201 :     (* Registers %o2, %o3 & %o4 are also used to call ml_mul and ml_div. *)
202 :     val arg1EA = Direct(REG 10) and arg2EA = Direct(REG 11)
203 :     val opAddrR = REG 12
204 :    
205 :     (* Get a temporary register. *)
206 :     fun getTmpReg () = REG(remove())
207 :    
208 :     (* should be cleaned up in the future *)
209 :     val tmpfpreg = (FREG 30)
210 :    
211 :     (* If r is a temporary register, then free it. *)
212 :     fun freeReg (REG r) = if ((9 < r) andalso (r < 14)) then (ins r) else ()
213 :    
214 :     (* Free a temporary register. *)
215 :     fun freeTmpReg (REG r) = ins r
216 :    
217 :     end (* local *)
218 :    
219 :    
220 :     (* align is a nop, since strings are automatically padded. *)
221 :     fun align () = ()
222 :    
223 :     val emitlong = C.emitLong
224 :     val realconst = C.emitReal
225 :     val emitstring = C.emitString
226 :    
227 :     fun emitlab (n, ImmedLab lab) = C.emitLabel (lab, n)
228 :     | emitlab _ = ErrorMsg.impossible "[SparcCM.emitlab]"
229 :    
230 :     val newlabel = ImmedLab o C.newLabel
231 :     fun define (ImmedLab lab) = C.define lab
232 :     | define _ = ErrorMsg.impossible "[SparcCM.define]"
233 :    
234 :     datatype immed_size = Immed13 | Immed32
235 :    
236 :     fun sizeImmed n = if (~4096 <= n) andalso (n < 4096) then Immed13 else Immed32
237 :    
238 :    
239 :     (** Utility operations **)
240 :    
241 :     fun emitMove (src, dst) = emit_or (zeroR, REGrand src, dst)
242 :    
243 :     fun loadImmed32 (n, r) = let
244 :     val lo10 = low10 n
245 :     in
246 :     emit_sethi (IMrand(high22 n), r);
247 :     if (lo10 <> 0) then emit_or(r, IMrand lo10, r) else ()
248 :     end
249 :    
250 :     fun loadImmed (n, r) = (
251 :     case (sizeImmed n)
252 :     of Immed13 => emit_or(zeroR, IMrand n, r)
253 :     | Immed32 => loadImmed32 (n, r))
254 :    
255 :     local
256 :     structure W = Word32
257 :     in
258 :     fun loadWord32(w, rd) = let
259 :     val lo10 = W.toIntX (W.andb (w, 0w1023))
260 :     val hi22 = W.toIntX (W.~>> (w, 0w10))
261 :     in
262 :     emit_sethi(IMrand hi22, rd);
263 :     if lo10 = 0 then () else emit_or(rd, IMrand lo10, rd)
264 :     end
265 :     end
266 :    
267 :     fun op32 f (r1, n, r2) = let val tmpR = getTmpReg()
268 :     in
269 :     loadImmed32 (n, tmpR);
270 :     f (r1, REGrand tmpR, r2);
271 :     freeTmpReg tmpR
272 :     end
273 :    
274 :     fun loadReg(r, offset, dst) = (
275 :     case (sizeImmed offset)
276 :     of Immed13 => emit_ld (r, IMrand offset, dst)
277 :     | Immed32 => (op32 emit_ld) (r, offset, dst))
278 :    
279 :     fun store (src, r, offset) = (
280 :     case (sizeImmed offset)
281 :     of Immed13 => emit_st (r, IMrand offset, src)
282 :     | Immed32 => (op32 emit_st) (r, offset, src))
283 :    
284 :    
285 :     fun loadFReg(r, offset, dst) = (
286 :     case (sizeImmed offset)
287 :     of Immed13 => emit_ldf (r, IMrand offset, dst)
288 :     | Immed32 => (op32 emit_ldf) (r, offset, dst))
289 :    
290 :     fun storeFReg (src, r, offset) = (
291 :     case (sizeImmed offset)
292 :     of Immed13 => emit_stf (r, IMrand offset, src)
293 :     | Immed32 => (op32 emit_stf) (r, offset, src))
294 :    
295 :    
296 :     fun addImmed (r, n, dst) = (
297 :     case (sizeImmed n)
298 :     of Immed13 => emit_add (r, IMrand n, dst)
299 :     | Immed32 => (op32 emit_add) (r, n, dst))
300 :    
301 :     fun compareImmed (r, n) = (
302 :     case (sizeImmed n)
303 :     of Immed13 => emit_subcc (r, IMrand n, zeroR)
304 :     | Immed32 => (op32 emit_subcc) (r, n, zeroR))
305 :    
306 :     fun sparcCC EQL = CC_E | sparcCC NEQ = CC_NE
307 :     | sparcCC GTR = CC_G | sparcCC GEQ = CC_GE
308 :     | sparcCC LSS = CC_L | sparcCC LEQ = CC_LE
309 :     | sparcCC GEU = CC_GEU | sparcCC GTU = CC_GU
310 :     | sparcCC LEU = CC_LEU | sparcCC LTU = CC_LU
311 :    
312 :    
313 :     (** CMachine instructions **)
314 :    
315 :     (* move (src, dst) *)
316 :     fun move (Immed n, Direct r) = loadImmed (n, r)
317 :     | move (Word32 w, Direct dst) = loadWord32(w, dst)
318 :     | move (ImmedLab lab, Direct r) = loadAddr (lab, 0, r)
319 :     | move (FDirect (FREG fs), FDirect (FREG fd)) = let
320 :     fun even x = (andConst(x, 0wx1) = 0)
321 :     in
322 :     if (even fs andalso even fd)
323 :     then (
324 :     emit_fmov(FREG fs, FREG fd);
325 :     emit_fmov(FREG (fs+1), FREG (fd+1)))
326 :     else ErrorMsg.impossible "[SparcCM.move: bad floating point registers]"
327 :     end
328 :     | move (Direct r1, Direct r2) = if (r1 = r2) then () else emitMove (r1, r2)
329 :     | move _ = ErrorMsg.impossible "[SparcCM.move]"
330 :    
331 :    
332 :     (* spR is the stack pointer; pregs_offset is the initial stack offset
333 :     * for pseudo registers, it should be consistent with the offset
334 :     * in the SPARC.prim.asm file.
335 :     *)
336 :     val pregs_offset = 104
337 :    
338 :     fun loadpseudo (Direct x,Immed i) =
339 :     emit_ld(spR, IMrand(2*(i-1)+pregs_offset), x)
340 :     (* print ("loadpseudo **** "^(Int.toString(i))^" \n") *)
341 :     | loadpseudo (Direct x,Direct y) = (* this case is never used *)
342 :     let val tmpR = getTmpReg()
343 :     in emit_sll(y, IMrand 1, tmpR);
344 :     emit_add(spR, REGrand tmpR, tmpR);
345 :     emit_ld(tmpR, IMrand (pregs_offset-2), x);
346 :     freeTmpReg tmpR
347 :     end
348 :     | loadpseudo _ = ErrorMsg.impossible "[loadpseudo]"
349 :    
350 :     fun storepseudo(Direct x,Immed i) =
351 :     emit_st(spR, IMrand(2*(i-1)+pregs_offset), x)
352 :     (* print ("storepseudo **** "^(Int.toString(i))^" \n"); *)
353 :     | storepseudo(Direct x,Direct y) = (* this case is never used *)
354 :     let val tmpR = getTmpReg()
355 :     in emit_sll(y, IMrand 1, tmpR);
356 :     emit_add(spR, REGrand tmpR, tmpR);
357 :     emit_st(tmpR, IMrand (pregs_offset-2), x);
358 :     freeTmpReg tmpR
359 :     end
360 :     | storepseudo _ = ErrorMsg.impossible "[storepseudo]"
361 :    
362 :     (* fun loadpseudo (x, i) = ()
363 :     fun storepseudo (x, i) = ()
364 :     *)
365 :    
366 :     fun testLimit () = emit_subcc (dataptrR, limitptrRand, zeroR)
367 :    
368 :     fun decLimit n = (* for polling *)
369 :     if (n < 2048) then
370 :     emit_sub (limitptrR, IMrand n, limitptrR)
371 :     else (emit_sethi (IMrand(high22 n), checkR);
372 :     emit_or (checkR, IMrand(low10 n), checkR);
373 :     emit_sub (limitptrR, REGrand checkR, limitptrR))
374 :    
375 :     (* checkLimit (n):
376 :     * Generate code to check the heap limit to see if there is enough free space
377 :     * to allocate n bytes.
378 :     * NOTE: THIS CODE USES TEMP REGS BY ALIASES.
379 :     * Thus it is important that none of the emitted pseudo-instructions
380 :     * below uses getTmpReg(), directly or indirectly.
381 :     *)
382 :     fun checkLimit (max_allocation, restart, mask, rlab, fregs) =
383 :     let val lab' = C.newLabel()
384 :     val n = max_allocation - 4096
385 :     val _ = if (n > 0) then
386 :     if (n < 2048)
387 :     then (emit_add (dataptrR,IMrand n,checkR);
388 :     emit_subcc (checkR, limitptrRand, zeroR))
389 :     else (emit_sethi (IMrand(high22 n), checkR);
390 :     emit_or (checkR, IMrand(low10 n), checkR);
391 :     emit_add (dataptrR, REGrand checkR, checkR);
392 :     emit_subcc (checkR, limitptrRand, zeroR))
393 :     else ()
394 :     val _ = emit_bcc (CC_LU, lab');
395 :     in (case fregs
396 :     of [] => (emit_ld (spR, startGCOffset, checkR);
397 :     move (mask, Direct maskR);
398 :     move (restart, Direct linkR);
399 :     emit_jmp (checkR, zeroRand))
400 :     | _ => (let val k = length fregs
401 :     val desc = lwtoi(D.makeDesc(k * 8, D.tag_string))
402 :     val retlab = C.newLabel()
403 :    
404 :     (* cps/limit.sml makes sure that there is enough
405 :     space left to save these floating
406 :     point registers *)
407 :     fun deposit([], _) = ()
408 :     | deposit((FDirect(FREG fpr))::r, i) =
409 :     (storeFReg(FREG fpr, dataptrR, i);
410 :     storeFReg(FREG(fpr + 1), dataptrR, i+4);
411 :     deposit(r,i+8))
412 :    
413 :     fun restore(s, [], _) = ()
414 :     | restore(s, (FDirect(FREG fpr))::r, i) =
415 :     (loadFReg(s, (i), FREG fpr);
416 :     loadFReg(s, (i+4), FREG(fpr+1));
417 :     restore(s, r, i+8))
418 :    
419 :     in deposit(fregs, 4);
420 :     move(immed desc, Direct checkR);
421 :     (* emit_or(dataptrR, IMrand 4, dataptrR); *)(*align*)
422 :     store(checkR, dataptrR, 0);
423 :     addImmed(dataptrR, 4, maskR);
424 :     addImmed (dataptrR, k*8+4, dataptrR);
425 :     emit_st(spR, IMrand(4+pregs_offset), maskR);
426 :     (* I am using pseudo register #2 here !!! *)
427 :    
428 :     emit_ld (spR, startGCOffset, checkR);
429 :     move (mask, Direct maskR);
430 :     move (ImmedLab retlab, Direct linkR);
431 :     emit_jmp (checkR, zeroRand);
432 :    
433 :     C.define retlab;
434 :     emit_ld(spR, IMrand(4+pregs_offset), maskR);
435 :     (* I am using pseudo register #2 here !!! *)
436 :     move (rlab, Direct linkR);
437 :     restore(maskR, fregs, 0);
438 :     testLimit();
439 :     emit_jmp (linkR, zeroRand)
440 :     end));
441 :     C.define lab'
442 :     end
443 :    
444 :     (* beginStdFn ():
445 :     * Note the beginning of a standard function. This requires generating
446 :     * code to load the base code block address into baseCodePtr.
447 :     *)
448 :     fun beginStdFn(ImmedLab lab, Direct reg) = setBaseAddr(lab,reg)
449 :    
450 :     (* jmp (dst):
451 :     * Unconditional jump to destination.
452 :     *)
453 :     fun jmp (ImmedLab lab) = emit_bcc (CC_A, lab)
454 :     | jmp (Direct r) = emit_jmp (r, zeroRand)
455 :     | jmp _ = ErrorMsg.impossible "[SparcCM.jmp]"
456 :    
457 :     (* record (vl, dst):
458 :     * makes a new record, puts address of it into the destination specified
459 :     * by the second arg. The contents are numbered from ~1 and up.
460 :     *)
461 :     fun record (vl : (EA * CPS.accesspath) list, Direct dst) = let
462 :     val minBlockSize = 6
463 :     (* generate code to move one or more adjacent fields from one record into
464 :     * adjacent fields in the new record. If the block is big enough, then
465 :     * use a block copy loop.
466 :     *)
467 :     fun blockMove (srcR, startindx, path, offset) = let
468 :     (* check a CPS path to see how large the block is *)
469 :     fun chkpath (cnt, i,
470 :     path as (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) =
471 :     if (r = srcR) andalso (i+offset = j)
472 :     then chkpath (cnt+1, i+1, rest)
473 :     else (cnt, path)
474 :     | chkpath (cnt, _, rest) = (cnt, rest)
475 :     (* generate code to move fields individually *)
476 :     fun moveFields (0, _, _) = ()
477 :     | moveFields (n, srcOffset, dstOffset) = let val tmpR = getTmpReg()
478 :     in
479 :     loadReg(srcR, srcOffset, tmpR);
480 :     store (tmpR, dataptrR, dstOffset);
481 :     freeTmpReg tmpR;
482 :     moveFields(n-1, srcOffset+wordSzB, dstOffset+wordSzB)
483 :     end
484 :     val (blksz, rest) = chkpath(1, startindx+1, path)
485 :     in
486 :     if (blksz < minBlockSize)
487 :     then moveFields(blksz, (startindx+offset)*wordSzB, startindx*wordSzB)
488 :     else if (offset = 0)
489 :     then let
490 :     val lab = C.newLabel()
491 :     val indxR = getTmpReg() and tmpR = getTmpReg()
492 :     in
493 :     loadImmed (startindx*wordSzB, indxR);
494 :     C.define lab;
495 :     emit_ld (srcR, REGrand indxR, tmpR);
496 :     compareImmed (indxR, (startindx+blksz)*wordSzB);
497 :     emit_st (dataptrR, REGrand indxR, tmpR);
498 :     emit_add (indxR, IMrand wordSzB, indxR);
499 :     emit_bcc (CC_L, lab);
500 :     freeTmpReg indxR; freeTmpReg tmpR
501 :     end
502 :     else let
503 :     val lab = C.newLabel()
504 :     val indxR1 = getTmpReg() and indxR2 = getTmpReg()
505 :     val tmpR = getTmpReg()
506 :     in
507 :     loadImmed ((startindx+offset)*wordSzB, indxR1);
508 :     loadImmed (startindx*wordSzB, indxR2);
509 :     C.define lab;
510 :     emit_ld (srcR, REGrand indxR1, tmpR);
511 :     emit_add (indxR1, IMrand wordSzB, indxR1);
512 :     emit_st (dataptrR, REGrand indxR2, tmpR);
513 :     emit_add (indxR2, IMrand wordSzB, indxR2);
514 :     compareImmed (indxR1, (startindx+offset+blksz)*wordSzB);
515 :     emit_bcc (CC_L, lab);
516 :     freeTmpReg indxR1; freeTmpReg indxR2; freeTmpReg tmpR
517 :     end;
518 :     freeReg srcR;
519 :     (wordSzB*(startindx+blksz), rest)
520 :     end (* blockMove *)
521 :     (* For each field in the record generate the necessary moves to initialize
522 :     * it in the new record. Fields are initialized in ascending order.
523 :     *)
524 :     fun fields (dstOffset, nil) = dstOffset
525 :     | fields (dstOffset, (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) = let
526 :     val indx = dstOffset div wordSzB
527 :     in
528 :     fields (blockMove (r, indx, rest, j-indx))
529 :     end
530 :     | fields (dstOffset, (Direct r, CPS.SELp(j, p)) :: rest) = let
531 :     val tmpR = getTmpReg()
532 :     in
533 :     loadReg(r, j*wordSzB, tmpR);
534 :     freeReg r;
535 :     fields (dstOffset, (Direct tmpR, p) :: rest)
536 :     end
537 :     | fields (dstOffset, (Direct r, CPS.OFFp 0) :: rest) = (
538 :     store (r, dataptrR, dstOffset);
539 :     freeReg r;
540 :     fields (dstOffset+wordSzB, rest))
541 :     | fields (dstOffset, (Direct r, CPS.OFFp j) :: rest) = let
542 :     val tmpR = getTmpReg()
543 :     val offset = j*wordSzB
544 :     in
545 :     case (sizeImmed offset)
546 :     of Immed13 => emit_add (r, IMrand offset, tmpR)
547 :     | Immed32 => (
548 :     loadImmed32 (offset, tmpR);
549 :     emit_add (r, REGrand tmpR, tmpR))
550 :     (* end case *);
551 :     store (tmpR, dataptrR, dstOffset);
552 :     freeTmpReg tmpR; freeReg r;
553 :     fields (dstOffset+wordSzB, rest)
554 :     end
555 :     | fields (dstOffset, (x, p) :: rest) = let
556 :     val tmpR = getTmpReg()
557 :     in
558 :     move (x, Direct tmpR);
559 :     fields (dstOffset, (Direct tmpR, p) :: rest)
560 :     end
561 :     val szB = fields (0, vl)
562 :     in
563 :     addImmed (dataptrR, wordSzB, dst);
564 :     addImmed (dataptrR, szB, dataptrR)
565 :     end
566 :     | record _ = ErrorMsg.impossible "[SparcCM.record]"
567 :    
568 :     (* recordStore(x, y, alwaysBoxed) records a store operation into mem[x+2*(y-1)].
569 :     * The flag alwaysBoxed is true if the value stored is guaranteed to be boxed.
570 :     *)
571 :     fun recordStore (x, y, alwaysBoxed) = let
572 :     fun storeListUpdate r = (
573 :     emit_st (dataptrR, zeroRand, r);
574 :     emit_st (dataptrR, IMrand 4, storeptrR);
575 :     emitMove (dataptrR, storeptrR);
576 :     addImmed (dataptrR, 8, dataptrR))
577 :     in
578 :     case (x, y)
579 :     of (Direct r, Immed 1) => storeListUpdate r
580 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
581 :     in
582 :     addImmed (r, 2*(i-1), tmpR);
583 :     storeListUpdate tmpR;
584 :     freeTmpReg tmpR
585 :     end
586 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
587 :     in
588 :     emit_sub (r2, IMrand 1, tmpR);
589 :     emit_add (tmpR, REGrand tmpR, tmpR);
590 :     emit_add (r1, REGrand tmpR, tmpR);
591 :     storeListUpdate tmpR;
592 :     freeTmpReg tmpR
593 :     end
594 :     | _ => ErrorMsg.impossible "[SparcCM.recordStore]"
595 :     (* end case *)
596 :     end (* recordStore *)
597 :     (*** STOREPTR
598 :     fun recordStore (x, y, alwaysBoxed) = let
599 :     (* NOTE: eventually we can optimize the case where alwaysBoxed = false *)
600 :     fun storeVectorUpdate r = (
601 :     emit_st (limitptrR, IMrand 4092, r);
602 :     emit_sub (limitptrR, IMrand 4, limitptrR))
603 :     in
604 :     case (x, y)
605 :     of (Direct r, Immed 1) => storeVectorUpdate r
606 :     | (Direct r, Immed i) => let val tmpR = getTmpReg()
607 :     in
608 :     addImmed (r, 2*(i-1), tmpR);
609 :     storeVectorUpdate tmpR;
610 :     freeTmpReg tmpR
611 :     end
612 :     | (Direct r1, Direct r2) => let val tmpR = getTmpReg()
613 :     in
614 :     emit_sub (r2, IMrand 1, tmpR);
615 :     emit_add (tmpR, REGrand tmpR, tmpR);
616 :     emit_add (r1, REGrand tmpR, tmpR);
617 :     storeVectorUpdate tmpR;
618 :     freeTmpReg tmpR
619 :     end
620 :     | _ => ErrorMsg.impossible "[SparcCM.recordStore]"
621 :     (* end case *)
622 :     end (* recordStore *)
623 :     ***)
624 :     (*** STOREPTR
625 :     fun recordStore (x, y, _) = record ([
626 :     (Immed(lwtoi(D.makeDesc(3, D.tag_record))), CPS.OFFp 0),
627 :     (x, CPS.OFFp 0), (y, CPS.OFFp 0), (storeptr, CPS.OFFp 0)
628 :     ], storeptr)
629 :     ***)
630 :    
631 :    
632 :    
633 :     fun recordcont _ = ErrorMsg.impossible "[SparcCM.recordcont not implemented yet]"
634 :    
635 :     (* select (i, x, y): y <- mem[x + 4*i] *)
636 :     fun select (i, Direct r, Direct dst) = loadReg(r, i*4, dst)
637 :     | select (i, ImmedLab lab, Direct dst) =
638 :     let val tmpR = getTmpReg()
639 :     in load (lab, i*4, dst, tmpR);
640 :     freeTmpReg tmpR
641 :     end
642 :     | select _ = ErrorMsg.impossible "[SparcCM.select]"
643 :    
644 :     (* offset (i, x, y): y <- (x + 4*i) *)
645 :     fun offset (i, Direct r, Direct dst) = addImmed (r, 4*i, dst)
646 :     | offset (i, ImmedLab lab, Direct dst) = loadAddr (lab, i, dst)
647 :     | offset _ = ErrorMsg.impossible "[SparcCM.offset]"
648 :    
649 :     local
650 :     fun moveByte movFn = let
651 :     fun mov (Direct r, Direct base, Direct indx) = movFn(base, REGrand indx, r)
652 :     | mov (Direct r, Direct base, Immed indx) = (
653 :     case (sizeImmed indx)
654 :     of Immed13 => movFn (base, IMrand indx, r)
655 :     | Immed32 => (op32 movFn) (base, indx, r))
656 :     | mov _ = ErrorMsg.impossible "[SparcCM.moveByte]"
657 :     in
658 :     mov
659 :     end
660 :     val loadByte = moveByte emit_ldb
661 :     val storeByte = moveByte emit_stb
662 :     in
663 :    
664 :     (* fetchindexb (x, y, z) fetches an unsigned byte: y <- mem[x+z] *)
665 :     fun fetchindexb (base, dst, indx) = loadByte(dst, base, indx)
666 :    
667 :     (* storeindexb (x, y, z) stores a byte: mem[y+z] <- x *)
668 :     fun storeindexb (Immed i, base, indx) = let
669 :     val tmpR = getTmpReg()
670 :     in
671 :     loadImmed (i, tmpR);
672 :     storeByte (Direct tmpR, base, indx);
673 :     freeTmpReg tmpR
674 :     end
675 :     | storeindexb arg = storeByte arg
676 :     end (* local *)
677 :    
678 :     (* jmpindexb (x): pc <- (x+y) *)
679 :     fun jmpindexb(ImmedLab lab, Direct y) = let
680 :     val tmpR1 = getTmpReg()
681 :     in
682 :     loadAddr (lab, 0, tmpR1);
683 :     emit_jmp (tmpR1, REGrand y);
684 :     freeTmpReg tmpR1
685 :     end
686 :     | jmpindexb _ = ErrorMsg.impossible "[SparcCM.jmpindexb]"
687 :    
688 :     (* fetchindexl (x, y, z) fetches a word: y <- mem[x+2*(z-1)] *)
689 :     fun fetchindexl (Direct r1, Direct dst, Direct r2) = let
690 :     val tmpR = getTmpReg()
691 :     in
692 :     emit_sub (r2, IMrand 1, tmpR);
693 :     emit_add (tmpR, REGrand tmpR, tmpR);
694 :     emit_ld (r1, REGrand tmpR, dst);
695 :     freeTmpReg tmpR
696 :     end
697 :     | fetchindexl (Direct r1, Direct dst, Immed i) = loadReg(r1, 2*(i-1), dst)
698 :     | fetchindexl (ImmedLab lab, Direct dst, Direct r) = let
699 :     val tmpR1 = getTmpReg()
700 :     in
701 :     loadAddr (lab, ~2, tmpR1);
702 :     emit_add (r, REGrand tmpR1, tmpR1);
703 :     emit_ld (r, REGrand tmpR1, dst);
704 :     freeTmpReg tmpR1
705 :     end
706 :     | fetchindexl _ = ErrorMsg.impossible "[SparcCM.fetchindexl]"
707 :    
708 :     (*storeindexl (x, y, z) stores a word: mem[y+2*(z-1)] <- x *)
709 :     fun storeindexl (Direct src, Direct r1, Direct r2) = let val tmpR = getTmpReg()
710 :     in
711 :     emit_sub (r2, IMrand 1, tmpR);
712 :     emit_add (tmpR, REGrand tmpR, tmpR);
713 :     emit_st (r1, REGrand tmpR, src);
714 :     freeTmpReg tmpR
715 :     end
716 :     | storeindexl (Direct src, Direct r, Immed i) = store (src, r, 2*(i-1))
717 :     | storeindexl (Immed n, x, y) = let val tmpR = getTmpReg()
718 :     in
719 :     loadImmed (n, tmpR);
720 :     storeindexl (Direct tmpR, x, y);
721 :     freeTmpReg tmpR
722 :     end
723 :     | storeindexl (ImmedLab lab, x, y) = let
724 :     val tmpR1 = getTmpReg()
725 :     in
726 :     loadAddr (lab, 0, tmpR1);
727 :     storeindexl (Direct tmpR1, x, y);
728 :     freeTmpReg tmpR1
729 :     end
730 :     | storeindexl _ = ErrorMsg.impossible "[SparcCM.storeindexl]"
731 :    
732 :    
733 :     (* fetchindexd(x,y,z): y <- mem[x+4*(z-1)] *)
734 :     fun fetchindexd(Direct x, FDirect(FREG fp), Direct z) = let
735 :     val tmpR = getTmpReg()
736 :     in
737 :     emit_sll (z, IMrand 2, tmpR);
738 :     emit_add (tmpR, REGrand x, tmpR);
739 :     emit_ldf (tmpR, IMrand ~4, FREG fp);
740 :     emit_ldf (tmpR, zeroRand, FREG(fp+1));
741 :     freeTmpReg tmpR
742 :     end
743 :     | fetchindexd(Direct x, FDirect(FREG fp), Immed i) = let
744 :     val offset = 4*(i-1)
745 :     in
746 :     case sizeImmed (offset+4)
747 :     of Immed13 => (
748 :     emit_ldf(x, IMrand offset, FREG fp);
749 :     emit_ldf(x, IMrand(offset+4), FREG(fp+1)))
750 :     | Immed32 => let val tmpR = getTmpReg()
751 :     in
752 :     loadImmed(offset,tmpR);
753 :     emit_add(x,REGrand tmpR,tmpR);
754 :     emit_ldf(tmpR,zeroRand,FREG fp);
755 :     emit_ldf(tmpR,IMrand 4,FREG(fp+1));
756 :     freeTmpReg tmpR
757 :     end
758 :     end
759 :     | fetchindexd _ = ErrorMsg.impossible "[SparcCM.fetchindexd]"
760 :    
761 :     (* storeindexd: mem[y+4*(z-1)] <- x *)
762 :     fun storeindexd (FDirect(FREG fp), Direct y, Direct z) = let
763 :     val tmpR = getTmpReg()
764 :     in
765 :     emit_sll (z, IMrand 2, tmpR);
766 :     emit_add (tmpR, REGrand y, tmpR);
767 :     emit_stf (tmpR, IMrand ~4, FREG fp);
768 :     emit_stf (tmpR ,zeroRand, FREG (fp+1));
769 :     freeTmpReg tmpR
770 :     end
771 :     | storeindexd (FDirect(FREG fp), Direct y, Immed i) = let
772 :     val offset = 4*(i-1)
773 :     in
774 :     case (sizeImmed (offset+4))
775 :     of Immed13 => (
776 :     emit_stf (y, IMrand offset, FREG fp);
777 :     emit_stf (y, IMrand (offset+4), FREG(fp+1)))
778 :     | Immed32 => let
779 :     val tmpR = getTmpReg()
780 :     in
781 :     loadImmed(offset, tmpR);
782 :     emit_add(y, REGrand tmpR, tmpR);
783 :     emit_stf(tmpR, zeroRand, FREG fp);
784 :     emit_stf(tmpR, IMrand 4, FREG(fp+1));
785 :     freeTmpReg tmpR
786 :     end
787 :     end
788 :     | storeindexd _ = ErrorMsg.impossible "[SparcCM.storeindexd]"
789 :    
790 :     (* ashl (n, x, y) shift left: y <- (x << n), with n >= 0 *)
791 :     fun ashl (Direct cntR, Direct src, Direct dst) =
792 :     emit_sll(src, REGrand cntR, dst)
793 :     | ashl (Immed cnt, Direct src, Direct dst) =
794 :     emit_sll (src, IMrand(andConst(cnt, 0w31)), dst)
795 :     | ashl (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
796 :     in
797 :     loadImmed (src, tmpR);
798 :     emit_sll (tmpR, REGrand cntR, dst);
799 :     freeTmpReg tmpR
800 :     end
801 :     | ashl (Immed cnt, Immed src, Direct dst) = (
802 :     loadImmed (wtoi (Word.<<(itow src, itow cnt)), dst))
803 :     | ashl (shamt, Word32 w, dst) = let val tmpR = getTmpReg()
804 :     in
805 :     loadWord32 (w, tmpR);
806 :     ashl (shamt, Direct tmpR, dst);
807 :     freeTmpReg tmpR
808 :     end
809 :     | ashl _ = ErrorMsg.impossible "[SparcCM.ashl]"
810 :    
811 :     (* ashr (n, x, y) shift right: y <- (x >> n), with n >= 0 *)
812 :     fun ashr (Direct cntR, Direct src, Direct dst) =
813 :     emit_sra (src, REGrand cntR, dst)
814 :     | ashr (Immed cnt, Direct src, Direct dst) =
815 :     emit_sra (src, IMrand(andConst(cnt, 0w31)), dst)
816 :     | ashr (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
817 :     in
818 :     loadImmed (src, tmpR);
819 :     emit_sra (tmpR, REGrand cntR, dst);
820 :     freeTmpReg tmpR
821 :     end
822 :     | ashr (Immed cnt, Immed src, Direct dst) = (
823 :     loadImmed (wtoi (Word.~>>(itow src, itow cnt)), dst))
824 :     | ashr (shamt, Word32 w, dst) = let val tmpR = getTmpReg()
825 :     in
826 :     loadWord32 (w, tmpR);
827 :     ashr(shamt, Direct tmpR, dst);
828 :     freeTmpReg tmpR
829 :     end
830 :     | ashr _ = ErrorMsg.impossible "[SparcCM.ashr]"
831 :    
832 :     local
833 :     fun adjArgs f (a as Immed _, b, c) = f (b, a, c)
834 :     | adjArgs f (a as Word32 _, b, c) = f(b, a, c)
835 :     | adjArgs f args = f args
836 :     fun adjSubArgs f (a, Immed 0, c) = f(Direct(zeroR), a, c)
837 :     | adjSubArgs f (a, Immed b, c) = let val tmpR = getTmpReg()
838 :     in
839 :     loadImmed (b, tmpR);
840 :     f (Direct tmpR, a, c);
841 :     freeTmpReg tmpR
842 :     end
843 :     | adjSubArgs f (a, Word32 w, c) = let val tmpR = getTmpReg()
844 :     in
845 :     loadWord32(w, tmpR);
846 :     adjSubArgs f (a, Direct tmpR, c);
847 :     freeTmpReg tmpR
848 :     end
849 :     | adjSubArgs f (a, b, c) = f (b, a, c)
850 :     fun arithOp f (Direct r1, Direct r2, Direct dst) = f (r1, REGrand r2, dst)
851 :     | arithOp f (Word32 w1, w2 as Word32 _, t) = let
852 :     val tmpR = getTmpReg()
853 :     in
854 :     loadWord32(w1, tmpR);
855 :     arithOp f (Direct tmpR, w2, t);
856 :     freeTmpReg tmpR
857 :     end
858 :     | arithOp f (Immed i1, i2 as Immed _, t) = let
859 :     val tmpR = getTmpReg()
860 :     in
861 :     loadImmed(i1, tmpR);
862 :     arithOp f (Direct tmpR, i2, t);
863 :     freeTmpReg tmpR
864 :     end
865 :     | arithOp f (r1, Word32 w, r2) = let
866 :     val tmpR = getTmpReg()
867 :     in
868 :     loadWord32(w, tmpR);
869 :     arithOp f (r1, Direct tmpR, r2);
870 :     freeTmpReg tmpR
871 :     end
872 :     | arithOp f (Immed i1, r2, dst) = let
873 :     val tmpR = getTmpReg()
874 :     in
875 :     loadImmed(i1, tmpR);
876 :     arithOp f (Direct tmpR, r2, dst);
877 :     freeTmpReg tmpR
878 :     end
879 :     | arithOp f (Word32 w, r2, dst) = let
880 :     val tmpR = getTmpReg()
881 :     in
882 :     loadWord32(w, tmpR);
883 :     arithOp f (Direct tmpR, r2, dst);
884 :     freeTmpReg tmpR
885 :     end
886 :     | arithOp f (Direct r, Immed n, Direct dst) = (
887 :     case (sizeImmed n)
888 :     of Immed13 => f (r, IMrand n, dst)
889 :     | Immed32 => let val tmpR = getTmpReg()
890 :     in
891 :     loadImmed32 (n, tmpR);
892 :     f (r, REGrand tmpR, dst);
893 :     freeTmpReg tmpR
894 :     end)
895 :     | arithOp _ _ = ErrorMsg.impossible "[SparcCM.arithOp]"
896 :     val addt' = adjArgs (arithOp (fn args => (emit_addcc args; emit_tvs())))
897 :     in
898 :    
899 :     val orb = adjArgs (arithOp emit_or)
900 :     val andb = adjArgs (arithOp emit_and)
901 :     val xorb = adjArgs (arithOp emit_xor)
902 :     fun notb (Direct src, Direct dst) = emit_not (src, dst)
903 :     | notb _ = ErrorMsg.impossible "[SparcCM.notb]"
904 :    
905 :     val add = adjArgs (arithOp emit_add)
906 :     fun addt (Immed a, b as Immed _, dst) = let val tmpR = getTmpReg ()
907 :     (* This should only occur when we need to build a constant larger than
908 :     * 2^29. Note, we assume that "b" is tagged (see "cps/generic.sml").
909 :     *)
910 :     in
911 :     loadImmed (a, tmpR);
912 :     addt' (Direct tmpR, b, dst);
913 :     freeTmpReg tmpR
914 :     end
915 :     | addt (Word32 a, b as Word32 _, dst) = let val tmpR = getTmpReg ()
916 :     in
917 :     loadWord32 (a, tmpR);
918 :     addt' (Direct tmpR, b, dst);
919 :     freeTmpReg tmpR
920 :     end
921 :    
922 :     | addt args = addt' args
923 :    
924 :     val sub = adjSubArgs (arithOp emit_sub)
925 :     val subt = adjSubArgs (arithOp (fn args => (emit_subcc args; emit_tvs())))
926 :    
927 :     fun lshr (Direct cntR, Direct src, Direct dst) =
928 :     emit_srl (src, REGrand cntR, dst)
929 :     | lshr (Immed cnt, Direct src, Direct dst) =
930 :     emit_srl (src, IMrand(andConst(cnt, 0w31)), dst)
931 :     | lshr (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
932 :     in
933 :     loadImmed (src, tmpR);
934 :     emit_srl (tmpR, REGrand cntR, dst);
935 :     freeTmpReg tmpR
936 :     end
937 :     | lshr (Immed cnt, Immed src, dst) = let val tmpR = getTmpReg()
938 :     in
939 :     loadImmed (src, tmpR);
940 :     lshr (Immed cnt, Direct tmpR, dst);
941 :     freeTmpReg tmpR
942 :     end
943 :     | lshr (shamt, Word32 w, dst) = let val tmpR = getTmpReg ()
944 :     in
945 :     loadWord32 (w, tmpR);
946 :     lshr (shamt, Direct tmpR, dst);
947 :     freeTmpReg tmpR
948 :     end
949 :     | lshr _ = ErrorMsg.impossible "[SparcCM.lshr]"
950 :    
951 :     end (* local *)
952 :    
953 :     (* mult/divt:
954 :     * mult (a, b): b <- (a * b) (with overflow checking done by ml_mul)
955 :     * divt (a, b): b <- (b div a)
956 :     * mulu (a, b): b <- (a * b) (unsigned; no overflow)
957 :     * divu (a, b): b <- (b div a) (unsigned)
958 :     *)
959 :     local
960 :     (* call an off-line arithmetic routine. *)
961 :     fun intOp opAddrOffset (a, b as Direct _) = (
962 :     emit_ld (spR, opAddrOffset, opAddrR);
963 :     move (a, arg2EA);
964 :     move (b, arg1EA);
965 :     emit_jmpl (opAddrR, zeroRand, linkR);
966 :     move (arg1EA, b))
967 :     | intOp _ _ = ErrorMsg.impossible "[SparcCM.intOp]"
968 :     in
969 :     val mult = intOp mulAddrOffset
970 :     val divt = intOp divAddrOffset
971 :     val mulu = intOp umulAddrOffset
972 :     val divtu = intOp udivAddrOffset
973 :     end (* local *)
974 :    
975 :     (* bbs (i, dst, lab): test the i'th bit of dst and jump to lab if it is zero *)
976 :     fun bbs (Immed i, Direct r, ImmedLab lab) = (
977 :     emit_andcc (r, IMrand(wtoi (Word.<<((0w1, itow i)))), zeroR);
978 :     emit_bcc (CC_NE, lab))
979 :     | bbs _ = ErrorMsg.impossible "[SparcCM.bbs]"
980 :    
981 :     local
982 :     fun revCC CC_A = CC_A
983 :     | revCC CC_E = CC_E | revCC CC_NE = CC_NE
984 :     | revCC CC_L = CC_G | revCC CC_LE = CC_GE
985 :     | revCC CC_G = CC_L | revCC CC_GE = CC_LE
986 :     | revCC CC_LEU = CC_GEU | revCC CC_GEU = CC_LEU
987 :     | revCC CC_LU = CC_GU | revCC CC_GU = CC_LU
988 :    
989 :     fun compare (cc, a as Immed _, b as Direct _) = compare (revCC cc, b, a)
990 :     | compare (cc, Direct r1, Direct r2) = (
991 :     emit_subcc (r1, REGrand r2, zeroR); cc)
992 :     | compare (cc, Direct r1, Immed n) = (compareImmed (r1, n); cc)
993 :     | compare (cc, Immed a, Immed n) = let val tmpR = getTmpReg()
994 :     in
995 :     loadImmed(a, tmpR);
996 :     compareImmed(tmpR, n);
997 :     freeTmpReg tmpR;
998 :     cc
999 :     end
1000 :     | compare(cc, Word32 w, b) = let
1001 :     val tmpR = getTmpReg()
1002 :     in
1003 :     loadWord32(w, tmpR);
1004 :     compare(cc, Direct tmpR, b) before freeTmpReg tmpR
1005 :     end
1006 :     | compare(cc, a, Word32 w) = let
1007 :     val tmpR = getTmpReg()
1008 :     in
1009 :     loadWord32(w, tmpR);
1010 :     compare(cc, a, Direct tmpR) before freeTmpReg tmpR
1011 :     end
1012 :     | compare _ = ErrorMsg.impossible "[SparcCM.compare]"
1013 :     in
1014 :     (* ibranch (cond, a, b, lab): if (a <cond> b) then pc <- lab *)
1015 :     fun ibranch (cond, a, b, ImmedLab lab) =
1016 :     emit_bcc (compare (sparcCC cond, a, b), lab)
1017 :     end (* local *)
1018 :    
1019 :    
1020 :     (*
1021 :     * Floating point arithmetic instructions
1022 :     *)
1023 :     local
1024 :     (* Fetch a ML real value into a floating-point register pair *)
1025 :     fun fetchReal (Direct r, FREG i) = (
1026 :     emit_ldf (r, zeroRand, FREG i);
1027 :     emit_ldf (r, IMrand 4, FREG(i+1)))
1028 :     | fetchReal (ImmedLab lab, dst) = let val tmpR = getTmpReg()
1029 :     in
1030 :     loadF (lab, 0, dst, tmpR);
1031 :     freeTmpReg tmpR
1032 :     end
1033 :     | fetchReal _ = ErrorMsg.impossible "[SparcCM.fetchReal]"
1034 :     fun floatOp fOp (FDirect fpr1, FDirect fpr2, FDirect fpr3) = fOp(fpr1,fpr2,fpr3)
1035 :     | floatOp _ _ = ErrorMsg.impossible "[SparcCM.floatOp]"
1036 :     in
1037 :    
1038 :     fun loadfloat (src, FDirect fpr) = fetchReal(src, fpr)
1039 :     | loadfloat _ = ErrorMsg.impossible "[SparcCM.loadfloat]"
1040 :    
1041 :     fun storefloat (FDirect(FREG fpr), Direct gpr) = let val tmpR = getTmpReg()
1042 :     in
1043 :     loadImmed (lwtoi D.desc_reald, tmpR);
1044 :     (** ALIGN **)
1045 :     emit_st (dataptrR, zeroRand, tmpR);
1046 :     emit_stf (dataptrR, IMrand 4, FREG fpr);
1047 :     emit_stf (dataptrR, IMrand 8, FREG (fpr+1));
1048 :     addImmed (dataptrR, 4, gpr);
1049 :     emit_add (dataptrR, IMrand 12, dataptrR);
1050 :     freeTmpReg tmpR
1051 :     end
1052 :     | storefloat _ = ErrorMsg.impossible "[SparcCM.storefloat]"
1053 :    
1054 :     fun fprecord (tag, vl : (EA * CPS.accesspath) list, Direct dst) =
1055 :     let open CPS
1056 :     val len = (List.length vl) * 8 + 4
1057 :     fun fields (_,_,_,_,nil) = ()
1058 :     | fields (t1,t2,f1 as (FREG fpr),i,
1059 :     (Direct r,SELp(j,OFFp 0))::rest) =
1060 :     (loadFReg(r, (j*8), FREG fpr);
1061 :     loadFReg(r, (j*8+4), FREG(fpr+1));
1062 :     fields(t1,t2,f1,i,(FDirect f1,OFFp 0)::rest))
1063 :     | fields (t1,t2,f1,i,(Direct r, SELp(j, p))::rest) =
1064 :     (loadReg(r, j*4, t1);
1065 :     fields (t2,t1,f1,i,(Direct t1,p)::rest))
1066 :     | fields (t1,t2,f1,i,(FDirect(FREG fpr), OFFp 0) :: rest) =
1067 :     (storeFReg(FREG fpr, dataptrR, i);
1068 :     storeFReg(FREG(fpr + 1), dataptrR, i+4);
1069 :     fields (t1,t2,f1,i-8,rest))
1070 :     | fields (t1,t2,f1,i,(Direct r, OFFp _)::rest) =
1071 :     ErrorMsg.impossible "wrong-type in fprecord in sparc.sml"
1072 :     | fields (t1,t2,f1,i,(x,p)::rest) =
1073 :     (move (x, Direct t1);
1074 :     fields(t2,t1,f1,i,(Direct t1,p)::rest))
1075 :    
1076 :     val tmpR1 = getTmpReg()
1077 :     val tmpR2 = getTmpReg()
1078 :     val tmpF1 = tmpfpreg
1079 :     in
1080 :     emit_or(dataptrR, IMrand 4, dataptrR); (*align*)
1081 :     move(tag,Direct tmpR1);
1082 :     store(tmpR1, dataptrR, 0);
1083 :     fields (tmpR1, tmpR2, tmpF1, len-8, rev vl);
1084 :     addImmed (dataptrR, wordSzB, dst);
1085 :     freeTmpReg tmpR1;
1086 :     freeTmpReg tmpR2;
1087 :     addImmed (dataptrR, len, dataptrR)
1088 :     end
1089 :     | fprecord _ = ErrorMsg.impossible "[SparcCM.fprecord]"
1090 :    
1091 :     val faddd = floatOp emit_fadd
1092 :     val fsubd = floatOp emit_fsub
1093 :     val fmuld = floatOp emit_fmul
1094 :     val fdivd = floatOp emit_fdiv
1095 :    
1096 :     fun fnegd (FDirect (fpr1 as FREG f1), FDirect (fpr2 as FREG f2)) = (
1097 :     emit_fneg (fpr1, fpr2);
1098 :     if (fpr1 <> fpr2) then emit_fmov (FREG(f1+1), FREG(f2+1)) else ())
1099 :     | fnegd _ = ErrorMsg.impossible "[SparcCM.fnegd]"
1100 :    
1101 :     fun fabsd (FDirect (fpr1 as FREG f1), FDirect (fpr2 as FREG f2)) = (
1102 :     emit_fabs (fpr1, fpr2);
1103 :     if (fpr1 <> fpr2) then emit_fmov (FREG(f1+1), FREG(f2+1)) else ())
1104 :     | fabsd _ = ErrorMsg.impossible "[SparcCM.fabsd]"
1105 :    
1106 :     (* convert an int to a double. Because there is no data-path from general
1107 :     * purpose registers to the FP registers, we use the heap as a staging point.
1108 :     *)
1109 :     local
1110 :     fun convert (gpr, fpr) = (
1111 :     emit_st (spR, cvti2dAddrOffset, gpr);
1112 :     emit_ldf (spR, cvti2dAddrOffset, fpr);
1113 :     emit_fitod (fpr, fpr))
1114 :     in
1115 :     fun cvti2d (Direct r, FDirect fpr) = convert (r, fpr)
1116 :     | cvti2d (Immed i, FDirect fpr) = let val tmpR = getTmpReg()
1117 :     in
1118 :     loadImmed (i, tmpR);
1119 :     convert (tmpR, fpr);
1120 :     freeTmpReg tmpR
1121 :     end
1122 :     | cvti2d _ = ErrorMsg.impossible "[SparcCM.cvti2d]"
1123 :     end (* local fun convert ... *)
1124 :    
1125 :     fun fbranchd (cond, FDirect fp1, FDirect fp2, ImmedLab lab) = let
1126 :     fun sparcFCC P.fEQ = FCC_E
1127 :     | sparcFCC P.fULG = FCC_NE
1128 :     | sparcFCC P.fUN = FCC_U
1129 :     | sparcFCC P.fLEG = FCC_O
1130 :     | sparcFCC P.fGT = FCC_G
1131 :     | sparcFCC P.fGE = FCC_GE
1132 :     | sparcFCC P.fUGT = FCC_UG
1133 :     | sparcFCC P.fUGE = FCC_UGE
1134 :     | sparcFCC P.fLT = FCC_L
1135 :     | sparcFCC P.fLE = FCC_LE
1136 :     | sparcFCC P.fULT = FCC_UL
1137 :     | sparcFCC P.fULE = FCC_ULE
1138 :     | sparcFCC P.fLG = FCC_LG
1139 :     | sparcFCC P.fUE = FCC_UE
1140 :     in
1141 :     emit_fcmp(fp1,fp2);
1142 :     emit_fbcc(sparcFCC cond, lab)
1143 :     end
1144 :     | fbranchd _ = ErrorMsg.impossible "[SparcCM.fbranchd]"
1145 :     end (* local *)
1146 :    
1147 :     end (* local *)
1148 :    
1149 :     end (* functor SparcCM *)
1150 :    
1151 :    
1152 :     (*
1153 :     * $Log: sparc.sml,v $
1154 :     * Revision 1.5 1998/02/12 20:48:48 jhr
1155 :     * Removed references to System.Tags.
1156 :     *
1157 :     * Revision 1.4 1997/12/03 19:04:58 george
1158 :     * removed rangeChk
1159 :     *
1160 :     * Revision 1.3 1997/09/10 20:34:13 jhr
1161 :     * Fixed heap limit check to use unsigned comparison.
1162 :     *
1163 :     * Revision 1.2 1997/05/20 12:29:07 dbm
1164 :     * SML '97 sharing, where structure.
1165 :     *
1166 :     * Revision 1.1.1.1 1997/01/14 01:38:45 george
1167 :     * Version 109.24
1168 :     *
1169 :     *)

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