![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mips.nw CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / mips|
Return to mips.nw CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / mips |
1.1 ! root 1: \section{Using [[MIPSCODER]] to implement a [[CMACHINE]]} ! 2: ! 3: <<*>>= ! 4: functor MipsCM(MipsC : MIPSCODER) : CMACHINE = struct ! 5: ! 6: open MipsC System.Tags ! 7: ! 8: <<utility functions>> ! 9: ! 10: <<immediate and register functions>> ! 11: ! 12: <<register definitions>> ! 13: ! 14: <<move>> ! 15: <<alignment, marks, and constants>> ! 16: <<labels>> ! 17: <<record manipulation>> ! 18: <<indexed fetch and store (byte)>> ! 19: <<indexed fetch and store (word)>> ! 20: <<arithmetic>> ! 21: <<shifts>> ! 22: <<arithmetic and shifts with overflow detection>> ! 23: <<bitwise operations>> ! 24: <<branches>> ! 25: ! 26: <<floating point>> ! 27: ! 28: <<memory check>> ! 29: ! 30: <<omitted functions>> ! 31: ! 32: val comment = M.comment ! 33: ! 34: (* +DEBUG *) ! 35: <<DEBUG code>> ! 36: (* -DEBUG *) ! 37: ! 38: end (* MipsCM *) ! 39: ! 40: @ The debugging code replaces possibly offensive functions with functions ! 41: that diagnose their own exceptions. ! 42: <<DEBUG code>>= ! 43: fun diag (s : string) f x = ! 44: f x handle e => ! 45: (print "?exception "; print (System.exn_name e); ! 46: print " in mips."; print s; print "\n"; ! 47: raise e) ! 48: ! 49: <<immediate and register functions>>= ! 50: val immed = Immed ! 51: fun isimmed(Immed i) = SOME i ! 52: | isimmed _ = NONE ! 53: ! 54: fun isreg(Direct(Reg i)) = SOME i | isreg _ = NONE ! 55: fun eqreg (a: EA) b = a=b ! 56: ! 57: ! 58: @ Here's what our register conventions are: ! 59: \input regs ! 60: <<register definitions>>= ! 61: val standardarg = Direct(Reg 2) ! 62: val standardcont = Direct(Reg 3) ! 63: val standardclosure = Direct(Reg 4) ! 64: val miscregs = map (Direct o Reg) [5,6,7,8,9,10,11,12,13,14, ! 65: 15,16,17,18,19] ! 66: val storeptr as Direct storeptr' = Direct(Reg 22) ! 67: val dataptr as Direct dataptr' = Direct(Reg 23) ! 68: val exnptr = Direct(Reg 30) ! 69: ! 70: (* internal use only *) ! 71: val my_arithtemp as Direct my_arithtemp'= Direct(Reg 20) ! 72: val my_ptrtemp as Direct my_ptrtemp' = Direct(Reg 21) ! 73: ! 74: (* exported for external use *) ! 75: val arithtemp as Direct arithtemp' = Direct(Reg 24) ! 76: val arithtemp2 as Direct arithtemp2'= Direct(Reg 25) ! 77: ! 78: <<move>>= ! 79: fun move (src,Direct dest) = M.move(src, dest) ! 80: | move _ = ErrorMsg.impossible "destination of move not register in mips" ! 81: <<alignment, marks, and constants>>= ! 82: val align = M.align ! 83: val mark = M.mark ! 84: ! 85: val emitlong = M.emitlong ! 86: val realconst = M.realconst ! 87: val emitstring = M.emitstring ! 88: ! 89: <<labels>>= ! 90: fun emitlab(i,Immedlab lab) = M.emitlab(i,lab) ! 91: | emitlab _ = ErrorMsg.impossible "bad emitlab arg in mips" ! 92: fun newlabel() = Immedlab(M.newlabel()) ! 93: fun define (Immedlab lab) = M.define lab ! 94: | define _ = ErrorMsg.impossible "bad define arg in mips" ! 95: <<DEBUG code>>= ! 96: val emitlab = diag "emitlab" emitlab ! 97: val define = diag "define" define ! 98: ! 99: ! 100: @ We only ever put the address of a newly created record into a register. ! 101: If I make this out correctly, the first word on the list of ! 102: values [[vl]] is actually a descriptor. ! 103: BUGS: The original routine put the address of the descriptor ! 104: into [[z]]. ! 105: What needs to go into [[z]] is the address of the first word in the record. ! 106: We can get this by adding 4 to the [[dataptr']]. ! 107: <<record manipulation>>= ! 108: fun record(vl, Direct z) = ! 109: let open CPS ! 110: val len = List.length vl ! 111: fun f(i,nil) = () ! 112: | f(i,(r, SELp(j,p))::rest) = (* follow ptrs to get the item *) ! 113: (M.lw(my_ptrtemp', r, j*4); f(i,(my_ptrtemp,p)::rest)) ! 114: | f(i,(Direct r,OFFp 0)::rest) = (* simple store, last first *) ! 115: (M.sw(r, dataptr, i*4); f(i-1,rest)) ! 116: | f(i,(Direct r, OFFp j)::rest) = ! 117: (M.add(r, Immed(4*j), my_ptrtemp'); ! 118: f(i,(my_ptrtemp,OFFp 0)::rest)) ! 119: | f(i,(ea,p)::rest) = (* convert to register-based *) ! 120: (M.move(ea, my_ptrtemp'); f(i,(my_ptrtemp,p)::rest)) ! 121: in f(len - 1, rev vl); (* store first word in [[0(dataptr')]] *) ! 122: M.add(dataptr', Immed 4, z); ! 123: M.add(dataptr', Immed(4*len), dataptr') ! 124: end ! 125: | record _ = ErrorMsg.impossible "result of record not register in mips" ! 126: ! 127: fun select(i, r, Direct s) = M.lw(s, r, i*4) ! 128: | select _ = ErrorMsg.impossible "result of select not register in mips" ! 129: ! 130: fun offset(i, Direct r, Direct s) = M.add(r,Immed(i*4), s) ! 131: | offset _ = ErrorMsg.impossible "nonregister arg to offset in mips" ! 132: <<DEBUG code>>= ! 133: val record = diag "record" record ! 134: val select = diag "select" select ! 135: val offset = diag "offset" offset ! 136: ! 137: @ For the indexed fetch and store, arithtemp is {\em not} tagged---the ! 138: tags are removed at a higher level (in {\tt generic.sml}). ! 139: These could be made faster for the case when they're called with immediate ! 140: constants as [[x]]. ! 141: <<indexed fetch and store (byte)>>= ! 142: (* fetchindexb(x,y) fetches a byte: y <- mem[x+arithtemp] ! 143: y cannot be arithtemp *) ! 144: fun fetchindexb(x,Direct y) = ! 145: (M.add(arithtemp',x,my_arithtemp'); ! 146: M.lbu(y,my_arithtemp,0)) ! 147: | fetchindexb _ = ErrorMsg.impossible "fetchb result not register in mips" ! 148: ! 149: (* storeindexb(x,y) stores a byte: mem[y+arithtemp] <- x; *) ! 150: fun storeindexb(Direct x,y) = ! 151: (M.add(arithtemp',y,my_arithtemp'); ! 152: M.sb(x,my_arithtemp,0)) ! 153: | storeindexb _ = ErrorMsg.impossible "storeb arg not register in mips" ! 154: ! 155: (* jmpindexb(x) pc <- (x+arithtemp) *) ! 156: fun jmpindexb x = (M.add(arithtemp',x,my_arithtemp'); ! 157: M.jump(my_arithtemp')) ! 158: ! 159: <<DEBUG code>>= ! 160: val fetchindexb = diag "fetchindexb" fetchindexb ! 161: val storeindexb = diag "storeindexb" storeindexb ! 162: val jmpindexb = diag "jmpindexb" jmpindexb ! 163: ! 164: ! 165: @ Here it looks like [[z]] is a tagged integer number of words, ! 166: so that [[2*(z-1)]] converts to the appropriate byte offset. ! 167: But I'm just guessing. ! 168: In any case, it saves an instruction to compute [[2*z]] (actually [[z+z]]) ! 169: and ! 170: load (or store) with offset [[~2]]. ! 171: ! 172: Anything stored with [[storeindexl]] is being put into an array, so it ! 173: is safe to treat it as a pointer. ! 174: <<indexed fetch and store (word)>>= ! 175: (* fetchindexl(x,y,z) fetches a word: y <- mem[x+2*(z-1)] *) ! 176: (* storeindexl(x,y,z) stores a word: mem[y+2*(z-1)] <- x *) ! 177: ! 178: fun fetchindexl(x,Direct y, Direct z) = ! 179: (M.sll(Immed 1,z,my_arithtemp'); ! 180: M.add(my_arithtemp',x,my_arithtemp'); ! 181: M.lw(y, my_arithtemp,~2)) ! 182: | fetchindexl(x,Direct y, Immed z) = M.lw(y, x, z+z-2) ! 183: | fetchindexl _ = ErrorMsg.impossible "fetchl result not register in mips" ! 184: ! 185: fun storeindexl(Direct x,y, Immed 1) = M.sw(x,y,0) ! 186: | storeindexl(Direct x,y,Direct z) = ! 187: (M.sll(Immed 1,z,my_arithtemp'); ! 188: M.add(my_arithtemp',y,my_arithtemp'); ! 189: M.sw(x, my_arithtemp,~2)) ! 190: | storeindexl(Direct x,y,Immed z) = M.sw(x,y,z+z-2) ! 191: ! 192: | storeindexl(Direct _,_,Immedlab _) = ! 193: ErrorMsg.impossible "storeindexl(Direct _,_,Immedlab _) in mips" ! 194: ! 195: | storeindexl(Immedlab label,y,z) = ! 196: (M.move(Immedlab label,my_ptrtemp'); ! 197: storeindexl(my_ptrtemp,y,z)) ! 198: ! 199: | storeindexl(Immed constant,y,offset) = ! 200: (M.move(Immed constant,my_ptrtemp'); ! 201: storeindexl(my_ptrtemp,y,offset)) ! 202: ! 203: <<DEBUG code>>= ! 204: val fetchindexl = diag "fetchindexl" fetchindexl ! 205: val storeindexl = diag "storeindexl" storeindexl ! 206: ! 207: ! 208: @ The function [[three]] makes commutative three-operand ! 209: instructions easier to call. ! 210: All three operands become [[EA]]s, and it is enough if either of the ! 211: first two operands is a register. ! 212: <<utility functions>>= ! 213: fun three f (Direct x, ea, Direct y) = f(x,ea,y) ! 214: | three f (ea, Direct x, Direct y) = f(x,ea,y) ! 215: | three f _ =ErrorMsg.impossible "neither arg to three f is register in mips" ! 216: ! 217: @ I assume that shifts are only ever done on arithmetic quantities, ! 218: not pointers, so that I am justified in using [[my_arithtemp']] to ! 219: store intermediate values. This is consistent with being unwilling ! 220: to shift things matching [[Immedlab _]]. ! 221: Appel agrees that pointers aren't shifted, as far as he can remember. ! 222: <<shifts>>= ! 223: fun ashr(shamt, Direct op1, Direct result) = M.sra(shamt,op1,result) ! 224: | ashr(shamt, Immed op1, Direct result) = ! 225: (M.move(Immed op1,my_arithtemp'); M.sra(shamt,my_arithtemp',result)) ! 226: | ashr _ = ErrorMsg.impossible "ashr args don't match in mips" ! 227: fun ashl(shamt, Direct op1, Direct result) = M.sll(shamt,op1,result) ! 228: | ashl(shamt, Immed op1, Direct result) = ! 229: (M.move(Immed op1,my_arithtemp'); M.sll(shamt,my_arithtemp',result)) ! 230: | ashl _ = ErrorMsg.impossible "ashl args don't match in mips" ! 231: <<DEBUG code>>= ! 232: val ashr = diag "ashr" ashr ! 233: val ashl = diag "ashl" ashl ! 234: ! 235: <<bitwise operations>>= ! 236: val orb = three M.or ! 237: val andb = three M.and' ! 238: fun notb (a,b) = subl3(a, Immed ~1, b) (* ~1 - a == one's complement *) ! 239: val xorb = three M.xor ! 240: <<DEBUG code>>= ! 241: val orb = diag "orb" orb ! 242: val andb = diag "andb" andb ! 243: val notb = diag "notb" notb ! 244: val xorb = diag "xorb" xorb ! 245: ! 246: ! 247: @ Subtraction may appear a bit odd. ! 248: The MIPS machine instruction and [[MIPSCODER.sub]] both subtract ! 249: their second operand from their first operand. ! 250: The VAX machine instruction and [[CMACHINE.subl3]] both subtract ! 251: their first operand from their second operand. ! 252: This will certainly lead to endless confusion. ! 253: <<arithmetic>>= ! 254: val addl3 = three M.add ! 255: ! 256: fun subl3(Immed k, x, y) = addl3(x, Immed(~k), y) ! 257: | subl3(Direct x, Direct y, Direct z) = M.sub(y,x,z) ! 258: | subl3(x, Immed k, dest) = ! 259: (M.move(Immed k, my_arithtemp'); ! 260: subl3(x, my_arithtemp, dest)) ! 261: | subl3 _ = ErrorMsg.impossible "subl3 args don't match in mips" ! 262: ! 263: @ We assume that any quantities being multiplied are arithmetic ! 264: quantities, not pointers. ! 265: <<arithmetic>>= ! 266: fun mull2(Direct x, Direct y) = M.mult(y,x,y) ! 267: | mull2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp'); ! 268: M.mult(y,my_arithtemp',y)) ! 269: | mull2 _ = ErrorMsg.impossible "mull2 args don't match in mips" ! 270: fun divl2(Direct x, Direct y) = M.div(y,x,y) ! 271: | divl2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp'); ! 272: M.div(y,my_arithtemp',y)) ! 273: | divl2 _ = ErrorMsg.impossible "divl2 args don't match in mips" ! 274: ! 275: <<DEBUG code>>= ! 276: val addl3 = diag "addl3" addl3 ! 277: val subl3 = diag "subl3" subl3 ! 278: val mull2 = diag "mull2" mull2 ! 279: val divl2 = diag "divl2" divl2 ! 280: ! 281: ! 282: @ The Mips hardware detects two's complement integer overflow on ! 283: add and subtract instructions only. ! 284: The exception is not maskable (see the Mips book, page 5-18). ! 285: At the moment we don't implement any overflow detection for multiplications ! 286: or for left shifts. ! 287: This has consequences only for coping with real constants and for ! 288: compiling user programs. ! 289: <<arithmetic and shifts with overflow detection>>= ! 290: val addl3t = addl3 ! 291: val subl3t = subl3 ! 292: @ The Mips multiplies two 32-bit quantities to get a 64-bit result. ! 293: That result fits in 32 bits if and only if the high-order word is zero or ! 294: negative one, and it has the same sign as the low order word. ! 295: Thus, we can add the sign bit of the low order word to the high order ! 296: word, and we have overflow if and only if the result is nonzero. ! 297: <<arithmetic and shifts with overflow detection>>= ! 298: fun mull2t(x,y as Direct y') = ! 299: let val ok = M.newlabel() ! 300: in mull2(x,y); ! 301: M.mfhi(my_arithtemp'); ! 302: M.slt(y',Direct (Reg 0),my_ptrtemp'); (* 0 or 1 OK in pointer *) ! 303: M.add(my_arithtemp',my_ptrtemp,my_arithtemp'); ! 304: M.beq(true,my_arithtemp',Reg 0,ok); (* OK if not overflow *) ! 305: M.lui(my_arithtemp',32767); ! 306: M.add(my_arithtemp',my_arithtemp,my_arithtemp'); (* overflows *) ! 307: M.define(ok) ! 308: end ! 309: | mull2t _ = ErrorMsg.impossible "result of mull2t not register in mips" ! 310: ! 311: <<DEBUG code>>= ! 312: val addl3t = diag "addl3t" addl3t ! 313: val subl3t = diag "subl3t" subl3t ! 314: val mull2t = diag "mull2t" mull2t ! 315: val ashlt = diag "ashlt" ashlt ! 316: ! 317: ! 318: @ We hack [[ibranch]] to make sure it will only reverse once. ! 319: It's easier than thinking. ! 320: <<branches>>= ! 321: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR ! 322: local ! 323: fun makeibranch reverse = ! 324: let ! 325: fun ibranch (cond, Immed a, Immed b, Immedlab label) = ! 326: if (case cond of EQL => a=b | NEQ => a<>b | LSS => a<b | ! 327: LEQ => a<=b | GTR => a>b | GEQ => a>=b) ! 328: then M.beq(true,Reg 0, Reg 0, label) else () ! 329: | ibranch (NEQ, Direct r, Direct s, Immedlab label) = ! 330: M.beq(false, r, s, label) ! 331: | ibranch (NEQ, Direct r, x, Immedlab label) = ! 332: (M.move(x, my_arithtemp'); ! 333: M.beq(false, r, my_arithtemp', label)) ! 334: | ibranch (EQL, Direct r, Direct s, Immedlab label) = ! 335: M.beq(true, r, s, label) ! 336: | ibranch (EQL, Direct r, x, Immedlab label) = ! 337: (M.move(x, my_arithtemp'); ! 338: M.beq(true, r, my_arithtemp', label)) ! 339: | ibranch (LSS, Direct r, x, Immedlab lab) = ! 340: (M.slt(r,x,my_arithtemp'); ! 341: M.beq(false,Reg 0, my_arithtemp',lab)) ! 342: | ibranch (GEQ, Direct r, x, Immedlab lab) = ! 343: (M.slt(r,x,my_arithtemp'); ! 344: M.beq(true,Reg 0, my_arithtemp',lab)) ! 345: | ibranch (GTR, x, Direct r, Immedlab lab) = ! 346: (M.slt(r,x,my_arithtemp'); ! 347: M.beq(false,Reg 0, my_arithtemp',lab)) ! 348: | ibranch (LEQ, x, Direct r, Immedlab lab) = ! 349: (M.slt(r,x,my_arithtemp'); ! 350: M.beq(true,Reg 0, my_arithtemp',lab)) ! 351: (* These two cases added to prevent infinite reversal *) ! 352: | ibranch (GTR, Direct r, x, Immedlab lab) = ! 353: (M.move(x, my_arithtemp'); ! 354: M.slt(my_arithtemp',Direct r,my_arithtemp'); ! 355: M.beq(false,Reg 0,my_arithtemp',lab)) ! 356: | ibranch (LEQ, Direct r, x, Immedlab lab) = ! 357: (M.move(x, my_arithtemp'); ! 358: M.slt(my_arithtemp',Direct r,my_arithtemp'); ! 359: M.beq(true,Reg 0,my_arithtemp',lab)) ! 360: | ibranch (_, Immedlab _, Immedlab _, _) = ! 361: ErrorMsg.impossible "bad ibranch args 1 in mips" ! 362: | ibranch (_, Immedlab _, _, _) = ! 363: ErrorMsg.impossible "bad ibranch args 1a in mips" ! 364: | ibranch (_, _, Immedlab _, _) = ! 365: ErrorMsg.impossible "bad ibranch args 1b in mips" ! 366: | ibranch (_, _, _, Direct _) = ! 367: ErrorMsg.impossible "bad ibranch args 2 in mips" ! 368: | ibranch (_, _, _, Immed _) = ! 369: ErrorMsg.impossible "bad ibranch args 3 in mips" ! 370: | ibranch (cond, x, y, l) = ! 371: let fun rev LEQ = GEQ ! 372: | rev GEQ = LEQ ! 373: | rev LSS = GTR ! 374: | rev GTR = LSS ! 375: | rev NEQ = NEQ ! 376: | rev EQL = EQL ! 377: in if reverse then (makeibranch false) (rev cond, y,x,l) ! 378: else ErrorMsg.impossible "infinite ibranch reversal in mips" ! 379: ! 380: end ! 381: in ibranch ! 382: end ! 383: in ! 384: val ibranch = makeibranch true ! 385: end ! 386: ! 387: <<branches>>= ! 388: fun jmp (Direct r) = M.jump(r) ! 389: | jmp (Immedlab lab) = M.beq(true,Reg 0,Reg 0,lab) ! 390: | jmp (Immed i) = ErrorMsg.impossible "jmp (Immed i) in mips" ! 391: ! 392: ! 393: (* branch on bit set *) ! 394: fun bbs (Immed k, Direct y, Immedlab label) = ! 395: (M.and'(y,Immed (Bits.lshift(1,k)),my_arithtemp'); ! 396: M.beq(false,my_arithtemp',Reg 0,label)) ! 397: | bbs _ = ErrorMsg.impossible "bbs args don't match in mips" ! 398: ! 399: <<DEBUG code>>= ! 400: val ibranch = diag "ibranch" ibranch ! 401: val jmp = diag "jmp" jmp ! 402: val bbs = diag "bbs" bbs ! 403: ! 404: @ We decided not to include floating point registers in our galaxy of ! 405: effective addresses. ! 406: This means that floating point registers are used only at this level, and ! 407: only to contain intermediate results. ! 408: All operands and final results will be stored in memory, in the usual ! 409: ML format (i.e. as 8-byte strings). ! 410: ! 411: In fact, we can be much more strict than that, and claim that ! 412: all floating point operands will live in FPR0 and FPR2, and that all ! 413: results will appear in FPR0. ! 414: ! 415: We don't make a distinction between general-purpose and floating point ! 416: registers; it's up to the instructions to know the difference. ! 417: <<floating point>>= ! 418: val floatop1 = Reg 0 ! 419: val floatop2 = Reg 2 ! 420: val floatresult = Reg 0 ! 421: ! 422: @ One very common operation is to take the result of a floating point ! 423: operation and put it into a fresh record, newly allocated on the heap. ! 424: This operation is traditionally called [[finish_real]], and it takes one ! 425: argument, the destination register for the new value. ! 426: All real values on the heap are labelled as 8-byte strings. ! 427: To store a floating point, we store the least significant ! 428: word in the lower address, but we store the most significant word ! 429: first, in case that triggers a garbage collection. ! 430: <<floating point>>= ! 431: val real_tag = Immed(8*System.Tags.power_tags + System.Tags.tag_string) ! 432: ! 433: fun store_float(Reg n,ea,offset) = ! 434: if n mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips" ! 435: else (M.swc1(Reg (n+1),ea,offset+4);M.swc1(Reg n,ea,offset)) ! 436: ! 437: fun finish_real (Direct result) = ( ! 438: store_float(floatresult,dataptr,4); ! 439: M.move(real_tag,my_arithtemp'); ! 440: M.sw(my_arithtemp',dataptr,0); ! 441: M.add(dataptr',Immed 4,result); ! 442: M.add(dataptr',Immed 12,dataptr')) ! 443: | finish_real _ = ! 444: ErrorMsg.impossible "ptr to result of real operation not register in mips" ! 445: ! 446: @ Loading a floating point quantity is analogous. ! 447: <<floating point>>= ! 448: fun load_float(Reg dest,src,offset) = ! 449: if dest mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips" ! 450: else (M.lwc1(Reg dest,src,offset); M.lwc1(Reg (dest+1),src,offset+4)) ! 451: ! 452: @ Now we can do a general two- and three-operand floating point operationa. ! 453: The only parameter is the function in [[MipsCoder]] that ! 454: emits the floating point register operation. ! 455: <<floating point>>= ! 456: fun two_float instruction (op1,result) = ( ! 457: load_float(floatop1,op1,0); ! 458: instruction(floatop1,floatresult); ! 459: finish_real(result)) ! 460: ! 461: fun three_float instruction (op1,op2,result) = ( ! 462: load_float(floatop1,op1,0); ! 463: load_float(floatop2,op2,0); ! 464: instruction(floatop1,floatop2,floatresult); ! 465: finish_real(result)) ! 466: ! 467: @ That takes care of everything except branch ! 468: <<floating point>>= ! 469: val mnegg = two_float M.neg_double ! 470: val mulg3 = three_float M.mul_double ! 471: val divg3 = three_float M.div_double ! 472: val addg3 = three_float M.add_double ! 473: val subg3 = three_float M.sub_double ! 474: ! 475: ! 476: @ The Mips doesn't provide all six comparisons in hardware, so the ! 477: next function does the comparison using only less than and equal. ! 478: The result tells [[bcop1]] whether to branch on condition true ! 479: or condition false. ! 480: <<floating point compare>>= ! 481: fun compare(LSS,op1,op2) = (M.slt_double(op1,op2); true) ! 482: | compare(GEQ,op1,op2) = (M.slt_double(op1,op2); false) ! 483: | compare(EQL,op1,op2) = (M.seq_double(op1,op2); true) ! 484: | compare(NEQ,op1,op2) = (M.seq_double(op1,op2); false) ! 485: | compare(LEQ,op1,op2) = compare(GEQ,op2,op1) ! 486: | compare(GTR,op1,op2) = compare(LSS,op2,op1) ! 487: <<floating point>>= ! 488: local ! 489: <<floating point compare>> ! 490: in ! 491: fun gbranch (cond, op1, op2, Immedlab label) = ( ! 492: load_float(floatop1,op1,0); ! 493: load_float(floatop2,op2,0); ! 494: M.bcop1(compare(cond,floatop1,floatop2),label)) ! 495: | gbranch _ = ErrorMsg.impossible "insane gbranch target in mips.nw" ! 496: end ! 497: ! 498: ! 499: @ When a function begins execution, it checks to make sure there is sufficient ! 500: memory available that it can do all its allocation. ! 501: generic does this by calling [[checkLimit : int -> unit]]. ! 502: At the moment, we implement this check by doing a store, ! 503: taking advantage of the virtual memory hardware, which will cause an exception ! 504: if there's not enough memory. ! 505: Later we will replace this store with a check against a limit register, ! 506: which will avoid virtual memory hacking and which will have advantages ! 507: for concurrency. ! 508: <<memory check>>= ! 509: fun checkLimit max_allocation = M.sw(Reg 0, dataptr, max_allocation-4) ! 510: (* store zero in last location to be used *) ! 511: ! 512: @ These two functions have null implementations. ! 513: [[beginStdFn]] is necessary only on the SPARC, since that machine needs to get ! 514: its program counter, and it is awkward to do so in the middle of a function. ! 515: ! 516: [[profile]] is a mysterious relic. ! 517: <<omitted functions>>= ! 518: fun beginStdFn _ = () (* do nothing, just like the Vax *) ! 519: ! 520: fun profile(i,incr) = () ! 521:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.