![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ns32mcode.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 / ns32|
Return to ns32mcode.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / ns32 |
1.1 ! root 1: (* Copyright 1989 by AT&T Bell Laboratories *) ! 2: structure NS32MCode : NS32MCODER = struct ! 3: ! 4: structure Jumps = struct ! 5: datatype JumpKind = DISPL of int ! 6: | LNGDISPL of int ! 7: | LABPTR of int ! 8: fun isquick k = (k<=7 andalso k>= ~8) ! 9: ! 10: fun eword i = ! 11: if i<0 then eword(65536+i) ! 12: else chr(i mod 256) ^ chr(i div 256) ! 13: ! 14: fun erword i = ! 15: if i<0 then erword(65536+i) ! 16: else chr(i div 256) ^ chr(i mod 256) ! 17: ! 18: fun elong i = ! 19: if i<0 ! 20: then let val a = ~i; ! 21: val b = a mod 65536; ! 22: val c = a div 65536; ! 23: in eword(~b) ^ eword(~c + if b=0 then 0 else ~1) ! 24: end ! 25: else eword(i mod 65536) ^ eword(i div 65536) ! 26: ! 27: val emitlong = elong ! 28: ! 29: fun intsize(i) = ! 30: if i<=63 andalso i>= ~64 ! 31: then 1 ! 32: else if i<=8191 andalso i>= ~8192 ! 33: then 2 ! 34: else 4; ! 35: ! 36: fun Ldisp (len,d) = ! 37: if len=1 andalso d<=63 andalso d>= ~64 ! 38: then if d>=0 then chr(d) ! 39: else chr(128+d) ! 40: else if len=2 andalso d<=8191 andalso d>= ~8192 ! 41: then if d>=0 then erword(128*256+d) ! 42: else erword(128*256+d+16384) ! 43: else if d>=0 ! 44: then erword(192*256+(d div 65536)) ^ erword(d mod 65536) ! 45: else let val a = ~d ! 46: val b = a mod 65536 ! 47: val c = a div 65536 ! 48: in erword(~c + if b=0 then 0 else ~1) ^ erword(~b) ! 49: end ! 50: ! 51: fun sizejump(LABPTR _,oldsize,s,d) = 4 ! 52: | sizejump(LNGDISPL _,oldsize,s,d) = 4 ! 53: | sizejump(DISPL i,oldsize,s,d) = ! 54: case oldsize of ! 55: 0 => intsize(d-s+i) ! 56: | 1 => 2 (* I question this! -- A. Appel *) ! 57: | _ => 4 ! 58: ! 59: fun emitjump(LABPTR i,4,s,d) = elong(d-s+i) ! 60: | emitjump(DISPL i,sz,s,d) = Ldisp(sz,d-s+i) (* initial pc is i bytes back *) ! 61: | emitjump(LNGDISPL i,4,s,d) = Ldisp(4,d-s+i) (* initial pc is i bytes back *) ! 62: | emitjump(_,sz,s,d) = ErrorMsg.impossible "bad size in emitjump" ! 63: ! 64: end (* Jumps *) ! 65: ! 66: structure Emitter : BACKPATCH = Backpatch(Jumps) ! 67: ! 68: structure Coder : NS32CODER = struct ! 69: ! 70: open Emitter Jumps ! 71: ! 72: fun emitbyte i = emitstring(chr i) ! 73: fun signedbyte i = emitbyte(if i<0 then 256+i else i) ! 74: fun emitword i = emitstring(eword i) ! 75: fun emitrword i = emitstring(erword i) ! 76: fun emitlong i = emitstring(elong i) ! 77: ! 78: val mkjump = jump ! 79: ! 80: fun emitdisp d = ! 81: if d<=63 andalso d>= ~64 ! 82: then ((if d>=0 then emitbyte(d) ! 83: else emitbyte(128+d)); ! 84: 1) ! 85: else if d<=8191 andalso d>= ~8192 ! 86: then ((if d>=0 then emitrword(128*256+d) ! 87: else emitrword(128*256+d+16384)); ! 88: 2) ! 89: else if d>=0 ! 90: then (emitrword(192*256+(d div 65536)); ! 91: emitrword(d mod 65536); ! 92: 4) ! 93: else let val a = ~d ! 94: val b = a mod 65536 ! 95: val c = a div 65536 ! 96: in emitrword(~c + if b=0 then 0 else ~1); ! 97: emitrword(~b); ! 98: 4 ! 99: end ! 100: ! 101: datatype Register = Genreg of int ! 102: | FloatReg of int ! 103: | FP ! 104: | SP ! 105: | SB ! 106: | PC ! 107: ! 108: val r0 = Genreg 0 ! 109: val r1 = Genreg 1 ! 110: val r2 = Genreg 2 ! 111: val r3 = Genreg 3 ! 112: val r4 = Genreg 4 ! 113: val r5 = Genreg 5 ! 114: val r6 = Genreg 6 ! 115: val r7 = Genreg 7 ! 116: val fp = FP ! 117: val sp = SP ! 118: val sb = SB ! 119: val pc = PC ! 120: val fp0 = FloatReg 0 ! 121: ! 122: datatype Size = Byte | Word | Long ! 123: ! 124: datatype EA = Direct of Register ! 125: | Topofstack ! 126: | Displace of int * Register ! 127: | Immed of int ! 128: | Immedlab of Label ! 129: | Abs of int ! 130: | OffAddress of Label * int ! 131: | Index of EA * Register * Size ! 132: ! 133: fun address lab = OffAddress(lab,0) (* old Address style *) ! 134: ! 135: (* This is identical to M68PrimReal except that emitword is different, ! 136: and the bias is off by two. *) ! 137: (* This is broken, because it is really the VAX G-float rep, not ! 138: the NS32 IEEE rep. *) ! 139: structure NS32PrimReal : PRIMREAL = ! 140: struct ! 141: val significant = 53 (* 52 + redundant 1/2 bit *) ! 142: fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range") ! 143: (* Convert a portion of a boolean array to the appropriate integer. *) ! 144: exception Bits ! 145: fun bits(a,start,width) = ! 146: let fun b true = 1 ! 147: | b false = 0 ! 148: fun f 0 = b (a sub start) ! 149: | f n = b (a sub (start+n)) + 2 * f(n-1) ! 150: in if Array.length a < start+width orelse start < 0 orelse width < 0 ! 151: then raise Bits ! 152: else f (width-1) ! 153: end ! 154: fun emitreal (sign,frac,exp) = ! 155: let val exponent = exp + 1022 ! 156: fun emit () = ! 157: let val word0 = ! 158: case frac sub 0 of (* zero? *) ! 159: true => Bits.orb(Bits.lshift(sign,15), ! 160: Bits.orb(Bits.lshift(exponent,4), ! 161: bits(frac,1,4))) ! 162: | false => 0 ! 163: val word1 = bits(frac,5,16) ! 164: val word2 = bits(frac,21,16) ! 165: val word3 = bits(frac,37,16) ! 166: in emitword word3; ! 167: emitword word2; ! 168: emitword word1; ! 169: emitword word0 ! 170: end ! 171: in if exponent < 1 orelse exponent > 2047 ! 172: then outofrange "" (* A hack *) ! 173: else emit() ! 174: end ! 175: end ! 176: structure NS32RealConst = RealConst(NS32PrimReal) ! 177: open NS32RealConst ! 178: ! 179: (* The label value, offset i, will be backpatched pc-relative. *) ! 180: fun emitlab (i,lab) = mkjump(LABPTR i, lab) ! 181: ! 182: fun procreg (Direct FP) = 8 ! 183: | procreg (Direct SB) = 10 ! 184: | procreg _ = ErrorMsg.impossible "procreg in ns32mcode" ! 185: ! 186: fun imsize k = if k<0 then 3 ! 187: else if k<128 then 0 ! 188: else 1 ! 189: ! 190: fun quick k = if k>=0 then k else k+16 ! 191: ! 192: fun gen (Direct(Genreg r)) = r ! 193: | gen (Direct(FloatReg r)) = r ! 194: | gen (Direct other) = ErrorMsg.impossible "gen direct in ns32mcode" ! 195: | gen (Displace(d,Genreg r)) = r+8 ! 196: | gen (Displace(d,FP)) = 24 ! 197: | gen (Displace(d,SP)) = 25 ! 198: | gen (Displace(d,SB)) = 26 ! 199: | gen (Displace(d,PC)) = 27 ! 200: | gen (Displace(d,other)) = ErrorMsg.impossible "gen displace in ns32mcode" ! 201: | gen (Topofstack) = 23 ! 202: | gen (Immed k) = 20 ! 203: | gen (Abs k) = 21 ! 204: | gen (Index(p,Genreg r,Byte)) = 28 ! 205: | gen (Index(p,Genreg r,Word)) = 29 ! 206: | gen (Index(p,Genreg r,Long)) = 30 ! 207: | gen (Index(p,other,sz)) = ErrorMsg.impossible "gen indexreg in ns32mcode" ! 208: (* Labels are always pc-relative, see jump widget in emitextn. *) ! 209: | gen (OffAddress li) = 27 (* assuming all labels are done pc-relative *) ! 210: | gen (Immedlab lab) = ErrorMsg.impossible "gen immedlab in ns32mcode" ! 211: ! 212: fun emitimmed d = ! 213: if d>=0 ! 214: then (emitrword(d div 65536); ! 215: emitrword(d mod 65536)) ! 216: else let val a = ~d ! 217: val b = a mod 25536 ! 218: val c = a div 25536 ! 219: in emitrword(~c + if b=0 then 0 else ~1); ! 220: emitrword(~b) ! 221: end ! 222: ! 223: ! 224: fun extnjumps (OffAddress _) = true ! 225: | extnjumps (Index(OffAddress _,_,_)) = true ! 226: | extnjumps _ = false ! 227: ! 228: fun emitextnc (_,Direct _) = 0 ! 229: | emitextnc (_,Displace(d,_)) = emitdisp(d) ! 230: | emitextnc (_,Topofstack) = 0 ! 231: | emitextnc (_,Immed k) = (emitimmed(k); 4) ! 232: | emitextnc (_,Abs k) = emitdisp(k) ! 233: | emitextnc (_,Index(Index _,_,_)) = ErrorMsg.impossible "illegal extn mode in ns32mcode" ! 234: | emitextnc (off,Index(p,Genreg r,sz)) = (emitbyte(r+8*gen(p)); ! 235: emitextnc(off+1,p)) + 1 ! 236: | emitextnc (_,Index(p,other,sz)) = ErrorMsg.impossible "illegal extn reg in ns32mcode" ! 237: | emitextnc (off,OffAddress(lab,i)) = (mkjump(LNGDISPL(i+off),lab); 4) ! 238: | emitextnc (_,Immedlab lab) = ErrorMsg.impossible "immedlab extn in ns32mcode" ! 239: ! 240: fun emitextn (_,Direct _) = () ! 241: | emitextn (_,Displace(d,_)) = (emitdisp(d); ()) ! 242: | emitextn (_,Topofstack) = () ! 243: | emitextn (_,Immed k) = emitimmed(k) ! 244: | emitextn (_,Abs k) = (emitdisp(k); ()) ! 245: | emitextn (_,Index(Index _,_,_)) = ErrorMsg.impossible "illegal extn mode in ns32mcode" ! 246: | emitextn (off,Index(p,Genreg r,sz)) = (emitbyte(r+8*gen(p)); ! 247: emitextn(off+1,p)) ! 248: | emitextn (_,Index(p,other,sz)) = ErrorMsg.impossible "illegal extn reg in ns32mcode" ! 249: | emitextn (off,OffAddress(lab,i)) = mkjump(DISPL(i+off),lab) ! 250: | emitextn (_,Immedlab lab) = ErrorMsg.impossible "immedlab extn in ns32mcode" ! 251: ! 252: fun shortinstr(b,(src,dest)) = ! 253: (emitword(b+64*gen(dest)+2048*gen(src)); ! 254: if extnjumps(dest) ! 255: then let val off = emitextnc(2,src) ! 256: in emitextn(2+off,dest); () ! 257: end ! 258: else (emitextn(2,src); emitextn(0,dest))) ! 259: ! 260: fun longinstr(w,(src,dest)) = ! 261: (let val gd = gen(dest) ! 262: in emitword(w+16384*(gd mod 4)); ! 263: emitbyte((gd div 4) + 8*gen(src)) ! 264: end; ! 265: if extnjumps(dest) ! 266: then let val off = emitextnc(3,src) ! 267: in emitextn(3+off,dest); () ! 268: end ! 269: else (emitextn(3,src); emitextn(0,dest))) ! 270: ! 271: ! 272: fun lprl (src,preg) = (emitword(111+128*procreg(preg)+2048*gen(src)); ! 273: emitextn(2,src); ()) ! 274: fun sprl (preg,dest) = (emitword(47+128*procreg(preg)+2048*gen(dest)); ! 275: emitextn(2,dest); ()) ! 276: fun tbit (off as Immed k,base) = shortinstr(55,(off,base)) ! 277: | tbit (off,base) = ErrorMsg.impossible "bad tbit in ns32mcode" ! 278: ! 279: fun bfs (OffAddress(lab,i)) = (emitbyte(138); ! 280: mkjump(DISPL(1+i), lab)) ! 281: ! 282: fun movql (Immed k,dest) = (emitword(95+128*quick(k)+2048*gen(dest)); ! 283: emitextn(2,dest); ()) ! 284: | movql (src,dest) = ErrorMsg.impossible "illegal movql in ns32mcode" ! 285: ! 286: (* Size problem, must detect immediate. *) ! 287: fun movb (src as Immed k, dest) = ! 288: (emitword(20+64*gen(dest)+2048*gen(src)); ! 289: if k>127 orelse k< ~128 ! 290: then ErrorMsg.impossible "illegal movb in ns32mcode" ! 291: else signedbyte(k); (* force to byte size *) ! 292: emitextn(3,dest); ()) ! 293: | movb args = shortinstr(20,args) ! 294: ! 295: (* Size problem, but will always be moving from mem, so ok. *) ! 296: fun movzbl args = longinstr(206+256*24,args) ! 297: ! 298: fun lea args = shortinstr(39,args) ! 299: ! 300: fun movl (Immedlab l, arg) = lea(address l, arg) ! 301: | movl (args as (Immed k, dest)) = ! 302: if isquick(k) ! 303: then movql args ! 304: else shortinstr(23,args) ! 305: | movl args = shortinstr(23,args) ! 306: ! 307: (* Really addql for case Immed 1 *) ! 308: fun addl (args as (Immed k, dest)) = ! 309: if isquick(k) ! 310: then (emitword(15+128*quick(k)+2048*gen(dest)); ! 311: emitextn(2,dest); ()) ! 312: else shortinstr(3,args) ! 313: | addl args = shortinstr(3,args) ! 314: fun subl args = shortinstr(35,args) ! 315: fun negl args = longinstr(78+256*35,args) ! 316: (* Size problem, must force count to byte size *) ! 317: fun ashl (count as Immed k, dest) = ! 318: (let val gd = gen(dest) ! 319: in emitword(78+256*7+16384*(gd mod 4)); ! 320: emitbyte((gd div 4) + 8*gen(count)) ! 321: end; ! 322: if k>127 orelse k< ~128 ! 323: then ErrorMsg.impossible "illegal ashl in ns32mcode" ! 324: else signedbyte(k); (* force to byte size *) ! 325: emitextn(4,dest); ()) ! 326: | ashl args = longinstr(78+256*7,args) ! 327: fun andl args = shortinstr(43,args) ! 328: fun orl args = shortinstr(27,args) ! 329: fun xorl args = shortinstr(59,args) ! 330: fun coml args = longinstr(78+256*55,args) ! 331: fun mull args = longinstr(128+78+256*35,args) ! 332: fun divl args = longinstr(128+78+256*63,args) ! 333: ! 334: fun br (OffAddress(lab,i)) = (emitbyte(234); ! 335: mkjump(DISPL(1+i),lab)) ! 336: ! 337: fun jump (arg as OffAddress _) = br arg ! 338: | jump arg = (emitword(127+512+2048*gen(arg)); ! 339: emitextn(2,arg); ()) ! 340: ! 341: fun bfs (OffAddress(lab,i)) = (emitbyte(138); ! 342: mkjump(DISPL(1+i), lab)) ! 343: ! 344: local fun condj(c) = ! 345: fn (OffAddress(lab,i)) => (emitbyte(10+16*c); ! 346: mkjump(DISPL(1+i), lab)) ! 347: | Displace(k, PC) => (emitbyte(10+16*c); ! 348: emitdisp(k); ()) ! 349: in val beq = condj(0) ! 350: val bne = condj(1) ! 351: val bge = condj(13) ! 352: val bgt = condj(6) ! 353: val blt = condj(12) ! 354: val ble = condj(7) ! 355: end ! 356: ! 357: fun cmpl (args as (Immed k,arg2)) = ! 358: if isquick(k) ! 359: then (emitword(31+128*quick(k)+2048*gen(arg2)); ! 360: emitextn(2, arg2); ()) ! 361: else shortinstr(7,args) ! 362: | cmpl args = shortinstr(7,args) ! 363: ! 364: fun movg args = longinstr(190+256*4,args) ! 365: fun negg args = longinstr(190+256*20,args) ! 366: fun addg args = longinstr(190,args) ! 367: fun subg args = longinstr(190+256*16,args) ! 368: fun mulg args = longinstr(190+256*48,args) ! 369: fun divg args = longinstr(190+256*32,args) ! 370: fun cmpg args = longinstr(190+256*8,args) ! 371: ! 372: fun comment _ = () ! 373: ! 374: end (* Coder *) ! 375: ! 376: val finish = Emitter.finish ! 377: ! 378: end (* structure MCode *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.