![[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.