![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to m68.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 / m68|
Return to m68.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / m68 |
1.1 ! root 1: (* Copyright 1989 by AT&T Bell Laboratories *) ! 2: functor M68CM(V : M68CODER) : CMACHINE = struct ! 3: ! 4: structure V' : sig ! 5: datatype Register = DataReg of int ! 6: | AddrReg of int ! 7: | FloatReg of int ! 8: | PC ! 9: ! 10: type Label sharing type Label = V.Label ! 11: datatype Size = Byte | Word | Long ! 12: ! 13: datatype EA = Direct of Register ! 14: | PostInc of Register ! 15: | PreDec of Register ! 16: | Displace of Register * int ! 17: | Index of Register * int * Register * Size ! 18: | Immed of int ! 19: | Immedlab of Label ! 20: | Abs of int ! 21: | Address of Label ! 22: ! 23: end = V ! 24: open V' ! 25: ! 26: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR ! 27: ! 28: (* +DEBUG *) ! 29: fun diag (s : string) f x = ! 30: f x handle e => ! 31: (print "?exception "; print (System.exn_name e); ! 32: print " in m68."; print s; print "\n"; ! 33: raise e) ! 34: (* -DEBUG *) ! 35: ! 36: fun defer(Direct r) = Displace(r,0) ! 37: | defer(Immedlab lab) = Address lab ! 38: | defer _ = ErrorMsg.impossible "defer in cpsm68" ! 39: ! 40: (* DEBUG *) val defer = diag "defer" defer ! 41: ! 42: val exnptr = Direct(DataReg 7) ! 43: val dataptr as Direct dataptr' = Direct(AddrReg 6) ! 44: val arithtemp as Direct arithtemp' = Direct(DataReg 1) ! 45: val arithtemp2 = Direct(DataReg 2) ! 46: val arithtemp3 = Direct(DataReg 4) ! 47: val storeptr = Direct(DataReg 6) ! 48: val standardclosure = Direct(AddrReg 2) ! 49: val standardarg = Direct(AddrReg 0) ! 50: val standardcont = Direct(AddrReg 1) ! 51: val miscregs = map (Direct o AddrReg) [3,4] ! 52: val datalimit = Direct(DataReg 5) ! 53: ! 54: val ptrtemp2 = Direct(DataReg 3) ! 55: val ptrtemp as Direct ptrtemp' = Direct(AddrReg 5) ! 56: ! 57: fun reg(Direct r) = r ! 58: ! 59: fun newlabel() = Immedlab(V.newlabel()) ! 60: (* DEBUG *) val newlabel = diag "newlabel" newlabel ! 61: fun emitlab(i,Immedlab lab) = V.emitlab(i,lab) ! 62: fun define (Immedlab lab) = V.define lab ! 63: ! 64: fun beginStdFn _ = () ! 65: ! 66: (* checkLimit (n): ! 67: * Generate code to check the heap limit to see if there is enough free space ! 68: * to allocate n bytes. ! 69: *) ! 70: fun checkLimit maxAllocSize = ( ! 71: V.comment ("check limit, max alloc = "^(makestring maxAllocSize)^"\n"); ! 72: (* Check the heap limit register *) ! 73: if (maxAllocSize <= 4096) ! 74: then ( ! 75: V.cmpl(dataptr, datalimit); ! 76: V.trapmi()) ! 77: else ( ! 78: V.movl (dataptr, arithtemp3); ! 79: V.addl(Immed(maxAllocSize-4096), arithtemp3); ! 80: V.cmpl(arithtemp3, datalimit); ! 81: V.trapmi())) ! 82: ! 83: val align = V.align ! 84: val mark = V.mark ! 85: fun move(Immedlab l, dest as Direct(AddrReg x)) = V.lea(Address l, dest) ! 86: | move(Immedlab l, dest) = ! 87: (V.lea(Address l, ptrtemp); ! 88: move(ptrtemp,dest)) ! 89: | move(Displace(DataReg(d), i), dest) = ! 90: (V.movl(Direct(DataReg(d)), ptrtemp); ! 91: move(Displace(reg(ptrtemp), i), dest)) ! 92: (* let's hope that ptrtemp never shows up in both src and dest! *) ! 93: | move(src, Address l) = ! 94: (V.lea(Address l, ptrtemp); ! 95: move(src, Displace(reg(ptrtemp), 0))) ! 96: | move x = V.movl x ! 97: (* DEBUG *) val move = diag "move" move ! 98: ! 99: val emitlong = V.emitlong ! 100: val realconst = V.realconst ! 101: val emitstring = V.emitstring ! 102: ! 103: fun ashl(s as Immed k, r, d as Direct(DataReg _)) = ! 104: (if r<>d then move(r,d) else (); V.asll(s,d)) ! 105: | ashl(s as Direct(DataReg _),r,d) = ! 106: (move(r,arithtemp3); V.asll(s,arithtemp3); move(arithtemp3,d)) ! 107: | ashl(s as Immed k,r,d) = ! 108: (move(r,arithtemp3); ! 109: if k>8 ! 110: then (move(s,arithtemp2); V.asll(arithtemp2,arithtemp3)) ! 111: else V.asll(s,arithtemp3); ! 112: move(arithtemp3,d)) ! 113: ! 114: (* DEBUG *) val ashl = diag "ashl" ashl ! 115: ! 116: fun ashr(s as Immed k, r, d as Direct(DataReg _)) = ! 117: (if r<>d then move(r,d) else (); ! 118: if k>8 then (move(s,arithtemp3); V.asrl(arithtemp3,d)) else V.asrl(s,d)) ! 119: | ashr(s as Direct(DataReg _),r,d) = ! 120: (move(r,arithtemp3); V.asrl(s,arithtemp3); move(arithtemp3,d)) ! 121: | ashr(s as Immed k,r,d) = ! 122: (move(r,arithtemp3); ! 123: if k>8 ! 124: then (move(s,arithtemp2); V.asrl(arithtemp2,arithtemp3)) ! 125: else V.asrl(s,arithtemp3); ! 126: move(arithtemp3,d)) ! 127: ! 128: fun jmpindexb lab = V.jra(Index(PC,2,arithtemp',Byte)) ! 129: (* DEBUG *) val jmpindexb = diag "jmpindexb" jmpindexb ! 130: ! 131: fun record(vl, z) = ! 132: let open CPS ! 133: fun f (Direct r, SELp(j,p)) = f(Displace(r,j*4),p) ! 134: | f (Immedlab l, p) = (V.lea(Address l, ptrtemp); f(ptrtemp,p)) ! 135: | f (x,OFFp 0) = V.movl(x, PostInc dataptr') ! 136: | f (Direct r, OFFp j) = (V.lea(Displace(r,j*4),ptrtemp); ! 137: f(ptrtemp,OFFp 0)) ! 138: | f (x,p) = (V.movl(x,ptrtemp); f(ptrtemp,p)) ! 139: in ! 140: app f vl; ! 141: V.lea(Displace(dataptr',~4*(List.length(vl)-1)),z) ! 142: end ! 143: ! 144: fun select(i, Direct r, s) = move(Displace(r,i*4),s) ! 145: | select(0, a, s) = move(defer a,s) ! 146: ! 147: fun offset(i, Direct r, s) = V.lea(Displace(r,i*4),s) ! 148: (* DEBUG *) val select = diag "select" select ! 149: (* DEBUG *) val offset = diag "offset" offset ! 150: ! 151: exception Three ! 152: fun three opcode (a as Direct(AddrReg _), b as Direct(AddrReg _), ! 153: c as Direct(AddrReg _)) = ! 154: (three opcode(a,b,arithtemp3); move(arithtemp3,c)) ! 155: | three opcode (a,b,c) = ! 156: if b=c then opcode(a,b) ! 157: else if a=c then (move(a,arithtemp3); three opcode(arithtemp3,b,c)) ! 158: else (move(b,c); opcode(a,c)) ! 159: ! 160: fun threet opcode (a,b,c as Direct(AddrReg _)) = ! 161: (threet opcode(a,b,arithtemp3); move(arithtemp3,c)) ! 162: | threet opcode (a,b,c) = ! 163: if b=c then (opcode(a,b); V.trapv()) ! 164: else if a=c then (move(a,arithtemp3); threet opcode(arithtemp3,b,c)) ! 165: else (move(b,c); opcode(a,c); V.trapv()) ! 166: ! 167: fun three' opcode (a as Immed _,b,c as Direct(DataReg _)) = ! 168: three opcode(a,b,c) ! 169: | three' opcode (a as Direct(AddrReg _),b,c) = ! 170: (move(b,arithtemp3); move(a,arithtemp2); ! 171: opcode(arithtemp2,arithtemp3); move(arithtemp3,c)) ! 172: | three' opcode (a,b,c) = ! 173: (move(b,arithtemp3); opcode(a,arithtemp3); move(arithtemp3,c)) ! 174: ! 175: fun orb(a as Immed k,b,c as Direct(DataReg _)) = ! 176: if k<65538 ! 177: then if k<=0 ! 178: then raise Match ! 179: else if b=c then V.orl(a,b) else (move(b,c); V.orl(a,c)) ! 180: else (move(a,arithtemp3); ! 181: if b=c then V.orl(arithtemp3,b) else (move(b,c); V.orl(arithtemp3,c))) ! 182: | orb(a as Direct(AddrReg _),b,c) = ! 183: (move(b,arithtemp3); move(a,arithtemp2); ! 184: V.orl(arithtemp2,arithtemp3); move(arithtemp3,c)) ! 185: | orb(a as Immed k,b,c) = ! 186: if k<65536 ! 187: then if k<=0 ! 188: then raise Match ! 189: else (move(b,arithtemp3); V.orl(a,arithtemp3); move(arithtemp3,c)) ! 190: else (move(a,arithtemp2); ! 191: move(b,arithtemp3); ! 192: V.orl(arithtemp2,arithtemp3); ! 193: move(arithtemp3,c)) ! 194: | orb(a,b,c) = (move(b,arithtemp3); V.orl(a,arithtemp3); move(arithtemp3,c)) ! 195: ! 196: fun xorb(a as Immed k,b,c as Direct(DataReg _)) = ! 197: if k<65536 ! 198: then if k<=0 ! 199: then raise Match ! 200: else if b=c then V.eorl(a,b) else (move(b,c); V.eorl(a,c)) ! 201: else (move(a,arithtemp3); ! 202: if b=c then V.eorl(arithtemp3,b) else (move(b,c); V.eorl(arithtemp3,c))) ! 203: | xorb(a as Direct(AddrReg _),b,c) = ! 204: (move(b,arithtemp3); move(a,arithtemp2); ! 205: V.eorl(arithtemp2,arithtemp3); move(arithtemp3,c)) ! 206: | xorb(a as Immed k,b,c) = ! 207: if k<65538 ! 208: then if k<=0 ! 209: then raise Match ! 210: else (move(b,arithtemp3); V.eorl(a,arithtemp3); move(arithtemp3,c)) ! 211: else (move(a,arithtemp2); ! 212: move(b,arithtemp3); ! 213: V.eorl(arithtemp2,arithtemp3); ! 214: move(arithtemp3,c)) ! 215: | xorb(a,b,c) = (move(b,arithtemp3); V.eorl(a,arithtemp3); move(arithtemp3,c)) ! 216: ! 217: fun notb(a,b) = (move(Immed ~1,arithtemp3); V.subl(a,arithtemp3); ! 218: move(arithtemp3,b)) ! 219: val andb = three' V.andl ! 220: val addl3 = three V.addl ! 221: val addl3t = threet V.addl ! 222: val subl3 = three V.subl ! 223: val subl3t = threet V.subl ! 224: val mull2 = V.mull ! 225: fun mull2t x = (mull2 x; V.trapv()) ! 226: val divl2 = V.divl ! 227: ! 228: exception Fetchindexb ! 229: fun fetchindexb(Direct x,y) = (if y=arithtemp then raise Fetchindexb else (); ! 230: move(Immed 0,y); ! 231: V.movb(Index(x,0,arithtemp',Byte),y)) ! 232: (* DEBUG *) val fetchindexb = diag "fetchindexb" fetchindexb ! 233: fun storeindexb(x, Direct y) = V.movb(x,Index(y,0,arithtemp',Byte)) ! 234: (* DEBUG *) val storeindexb = diag "storeindexb" storeindexb ! 235: fun fetchindexl(Direct x,y,Immed k) = move(Displace(x,k+k-2),y) ! 236: | fetchindexl(Direct x,y,Direct z) = move(Index(x,~2,z,Word),y) ! 237: | fetchindexl(Immedlab lab, y, Direct z) = ! 238: (* this is a hack, since it depends on lab being PC+6 *) ! 239: move(Index(PC,4,z,Word), y); ! 240: (* DEBUG *) val fetchindexl = diag "fetchindexl" fetchindexl ! 241: fun storeindexl(x, y, Immed 1) = move(x, defer y) ! 242: | storeindexl(x, Direct y, Immed k) = move(x, Displace(y,k+k-2)) ! 243: | storeindexl(x, Direct y, Direct z) = move(x,Index(y,~2,z,Word)) ! 244: (* DEBUG *) val storeindexl = diag "storeindexl" storeindexl ! 245: ! 246: val fp0 = FloatReg 0 ! 247: ! 248: fun finishreal(c) = (V.cmpl(dataptr,datalimit); ! 249: V.trapmi(); ! 250: V.movl(Immed(8*System.Tags.power_tags ! 251: + System.Tags.tag_string), ! 252: PostInc dataptr'); ! 253: V.movl(dataptr,c); ! 254: V.fmoved(Direct fp0, PostInc dataptr')) ! 255: ! 256: fun float f (a,b,c) = ! 257: (V.fmoved(defer a, Direct fp0); ! 258: f(defer b, Direct fp0); ! 259: finishreal c) ! 260: ! 261: fun mnegg (a,c) = (V.fnegd(defer a, Direct fp0); finishreal c) ! 262: ! 263: val mulg3 = float V.fmuld ! 264: val divg3 = float V.fdivd ! 265: val addg3 = float V.faddd ! 266: val subg3 = float V.fsubd ! 267: ! 268: fun cbranch NEQ = V.jne ! 269: | cbranch EQL = V.jeq ! 270: | cbranch LEQ = V.jle ! 271: | cbranch GEQ = V.jge ! 272: | cbranch LSS = V.jlt ! 273: | cbranch GTR = V.jgt ! 274: ! 275: fun fbranch NEQ = V.fjne ! 276: | fbranch EQL = V.fjeq ! 277: | fbranch LEQ = V.fjle ! 278: | fbranch GEQ = V.fjge ! 279: | fbranch LSS = V.fjlt ! 280: | fbranch GTR = V.fjgt ! 281: ! 282: fun rev LEQ = GEQ ! 283: | rev GEQ = LEQ ! 284: | rev LSS = GTR ! 285: | rev GTR = LSS ! 286: | rev NEQ = NEQ ! 287: | rev EQL = EQL ! 288: ! 289: fun ibranch (cond, op1 as Immed _, op2, label) = ! 290: (V.cmpl(op1, op2); cbranch (rev cond) (defer label)) ! 291: | ibranch (cond, op1, op2, label) = ! 292: (V.cmpl(op2, op1); cbranch cond (defer label)) ! 293: ! 294: fun gbranch (cond, op1, op2, label) = ! 295: (V.fmoved(defer op1,Direct fp0); ! 296: V.fcmpd(defer op2, Direct fp0); ! 297: fbranch cond (defer label)) ! 298: ! 299: fun defer' j = fn x => j(defer x) ! 300: val jmp = defer' V.jra ! 301: fun bbs (x,dest as Direct(AddrReg _) ,l) = (move(dest,ptrtemp2); ! 302: bbs(x,ptrtemp2,l)) ! 303: | bbs (x,y,l) = (V.btst(x,y); V.jne(defer l)) ! 304: (* DEBUG *) val bbs = diag "bbs" bbs ! 305: ! 306: val immed = Immed ! 307: fun isimmed(Immed i) = SOME i ! 308: | isimmed _ = NONE ! 309: fun isreg(Direct(AddrReg i)) = SOME i ! 310: | isreg(Direct(DataReg i)) = SOME(i+8) ! 311: | isreg _ = NONE ! 312: ! 313: fun eqreg (a: EA) b = a=b ! 314: (* DEBUG *) val eqreg = diag "eqreg" eqreg ! 315: ! 316: fun profile(index,incr) = V.addl(Immed incr, Displace(V.sp,4*index)) ! 317: ! 318: val comment = V.comment ! 319: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.