![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to vaxmcode.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 / vax|
Return to vaxmcode.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / vax |
1.1 ! root 1: (* Copyright 1989 by AT&T Bell Laboratories *) ! 2: structure VaxMCode : VAXMCODER = struct ! 3: ! 4: structure Jumps = struct ! 5: datatype JumpKind = MODE | WHICH of (int ref * int * int) ! 6: | BYTEDISPL ! 7: | LABPTR of int ! 8: | COND of (int ref * int * int) | JBR ! 9: fun sbyte i = chr(if i<0 then 256+i else i) ! 10: fun eword i = ! 11: if i<0 then eword(65536+i) ! 12: else [chr(i mod 256), chr(i div 256)] ! 13: fun elong i = ! 14: if i<0 ! 15: then let val a = ~i; ! 16: val b = a mod 65536; ! 17: val c = a div 65536; ! 18: in eword(~b) @ eword(~c + if b=0 then 0 else ~1) ! 19: end ! 20: else eword(i mod 65536) @ eword(i div 65536) ! 21: fun intsize(i) = ! 22: if i >= ~128 andalso i < 128 ! 23: then 1 ! 24: else if i >= ~32768 andalso i < 32768 ! 25: then 2 ! 26: else 4; ! 27: ! 28: fun emitlong i = implode(elong i) ! 29: ! 30: fun sizejump(mode,oldsize,s,d) = ! 31: let fun which (r,a,b) = ! 32: case oldsize of 1 => r := a | _ => r := b ! 33: in case (mode,intsize(d-(s+oldsize))) ! 34: of (MODE,i) => i+1 ! 35: | (LABPTR _, _) => 4 ! 36: | (BYTEDISPL, _) => 1 ! 37: | (WHICH _, _) => 1 ! 38: | (COND x, 1) => (which x; 1) ! 39: | (COND x, 2) => (which x; 4) ! 40: | (COND x, _) => (which x; 7) ! 41: | (JBR,1) => 2 ! 42: | (JBR,2) => 3 ! 43: | (JBR,_) => 6 ! 44: end ! 45: ! 46: fun emitjump(MODE,2,s,d) = chr(10*16+15) ^ sbyte(d-s-2) ! 47: | emitjump(MODE,3,s,d) = implode(chr(12*16+15) :: eword(d-s-3)) ! 48: | emitjump(MODE,5,s,d) = implode(chr(14*16+15) :: elong (d-s-5)) ! 49: | emitjump(BYTEDISPL,1,s,d) = sbyte(d-s-1) ! 50: | emitjump(LABPTR i, _,s,d) = emitlong(d-s+i) ! 51: | emitjump(WHICH(ref i,_,_), _,_,_) = chr i ! 52: | emitjump(COND _, 1,s,d) = sbyte(d-s-1) ! 53: | emitjump(COND _, 4,s,d) = implode(chr 3 :: chr(3*16+1) :: eword(d-s-4)) ! 54: | emitjump(COND _, 7,s,d) = implode(chr 6 :: chr(16+7) :: chr(14*16+15) ! 55: :: elong (d-s-7)) ! 56: | emitjump(JBR,2,s,d) = chr(16+1) ^ sbyte (d-s-2) ! 57: | emitjump(JBR,3,s,d) = implode(chr(3*16+1) :: eword (d-s-3)) ! 58: | emitjump(JBR,6,s,d) = implode(chr(16+7):: chr(14*16+15) :: elong (d-s-6)) ! 59: | emitjump _ = ErrorMsg.impossible "emitjump" ! 60: ! 61: end (* Jumps *) ! 62: ! 63: structure Emitter : BACKPATCH = Backpatch(Jumps) ! 64: ! 65: structure Coder : VAXCODER = struct ! 66: ! 67: open Emitter Jumps ! 68: ! 69: fun emitbyte i = emitstring(chr i) ! 70: fun signedbyte i = emitbyte(if i<0 then 256+i else i) ! 71: fun emitword i = ! 72: if i<0 then emitword(65536+i) ! 73: else (emitbyte(i mod 256); emitbyte(i div 256)); ! 74: fun emitlong i = ! 75: if i<0 ! 76: then let val a = ~i; ! 77: val b = a mod 65536; ! 78: val c = a div 65536; ! 79: in emitword(~b); ! 80: emitword(~c + if b=0 then 0 else ~1) ! 81: end ! 82: else (emitword(i mod 65536); emitword(i div 65536)) ! 83: fun intsize(i) = ! 84: if i >= ~128 andalso i < 128 ! 85: then 1 ! 86: else if i >= ~32768 andalso i < 32768 ! 87: then 2 ! 88: else 4; ! 89: ! 90: datatype Register = reg of int ! 91: ! 92: val r0 = reg 0 ! 93: val r1 = reg 1 ! 94: val r2 = reg 2 ! 95: val r3 = reg 3 ! 96: val r4 = reg 4 ! 97: val r5 = reg 5 ! 98: val r6 = reg 6 ! 99: val r7 = reg 7 ! 100: val r8 = reg 8 ! 101: val r9 = reg 9 ! 102: val r10 = reg 10 ! 103: val r11 = reg 11 ! 104: val r12 = reg 12 ! 105: val r13 = reg 13 ! 106: val sp = reg 14 ! 107: val pc = reg 15 ! 108: ! 109: datatype EA = direct of Register ! 110: | autoinc of Register ! 111: | autodec of Register ! 112: | displace of int * Register ! 113: | deferred of int * Register ! 114: | immed of int ! 115: | immedlab of Label ! 116: | address of Label ! 117: | index of EA * Register ! 118: ! 119: (* This is identical to M68PrimReal except that emitword is different, ! 120: and the bias is off by two. *) ! 121: structure VaxPrimReal : PRIMREAL = ! 122: struct ! 123: val significant = 53 (* 52 + redundant 1/2 bit *) ! 124: fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range") ! 125: (* Convert a portion of a boolean array to the appropriate integer. *) ! 126: exception Bits ! 127: fun bits(a,start,width) = ! 128: let fun b true = 1 ! 129: | b false = 0 ! 130: fun f 0 = b (a sub start) ! 131: | f n = b (a sub (start+n)) + 2 * f(n-1) ! 132: in if Array.length a < start+width orelse start < 0 orelse width < 0 ! 133: then raise Bits ! 134: else f (width-1) ! 135: end ! 136: fun emitreal (sign,frac,exp) = ! 137: let val exponent = exp + 1024 ! 138: fun emit () = ! 139: let val word0 = ! 140: case frac sub 0 of (* zero? *) ! 141: true => Bits.orb(Bits.lshift(sign,15), ! 142: Bits.orb(Bits.lshift(exponent,4), ! 143: bits(frac,1,4))) ! 144: | false => 0 ! 145: val word1 = bits(frac,5,16) ! 146: val word2 = bits(frac,21,16) ! 147: val word3 = bits(frac,37,16) ! 148: in emitword word0; ! 149: emitword word1; ! 150: emitword word2; ! 151: emitword word3 ! 152: end ! 153: in if exponent < 1 orelse exponent > 2047 ! 154: then outofrange "" (* A hack *) ! 155: else emit() ! 156: end ! 157: end ! 158: structure VaxRealConst = RealConst(VaxPrimReal) ! 159: open VaxRealConst ! 160: ! 161: fun regmode(mode,r) = emitbyte(mode*16+r) ! 162: ! 163: fun emitarg (direct(reg r)) = regmode(5,r) ! 164: | emitarg (autoinc(reg r)) = regmode(8,r) ! 165: | emitarg (autodec(reg r)) = regmode(7,r) ! 166: | emitarg (immed i) = ! 167: if i>=0 andalso i<64 then emitbyte i ! 168: else (emitarg(autoinc pc); emitlong i) ! 169: | emitarg (displace(i,reg r)) = ! 170: if i=0 then regmode(6,r) ! 171: else (case intsize i ! 172: of 1 => (regmode(10,r); signedbyte i) ! 173: | 2 => (regmode(12,r); emitword i) ! 174: | 4 => (regmode(14,r); emitlong i)) ! 175: | emitarg (deferred(i,reg r)) = ! 176: (case intsize i of ! 177: 1 => (regmode(11,r); signedbyte i) ! 178: | 2 => (regmode(13,r); emitword i) ! 179: | 4 => (regmode(15,r); emitlong i)) ! 180: | emitarg (index(ea, reg r)) = (regmode(4,r); emitarg ea) ! 181: | emitarg (address lab) = jump(MODE,lab) (* no good for branches *) ! 182: ! 183: fun emit2arg (arg1,arg2) = (emitarg arg1; emitarg arg2) ! 184: ! 185: fun emit3arg (arg1,arg2,arg3) = (emitarg arg1; emitarg arg2; emitarg arg3) ! 186: ! 187: fun pure (autoinc _) = false ! 188: | pure (autodec _) = false ! 189: | pure _ = true ! 190: ! 191: fun args23(f2,f3) (args as (a,b,c)) = ! 192: if b=c andalso pure b then (f2(a,b)) else f3 args ! 193: ! 194: fun immedbyte(i) = ! 195: if i>=0 andalso i<64 then emitbyte i ! 196: else (emitarg(autoinc pc); signedbyte i); ! 197: ! 198: fun immedword(i) = ! 199: if i>=0 andalso i<64 then emitbyte i ! 200: else (emitarg(autoinc pc); emitword i); ! 201: ! 202: fun emitlab (i,lab) = jump(LABPTR i, lab) ! 203: ! 204: fun jbr (address lab) = jump(JBR,lab) ! 205: fun bbc (immed 0, arg, address lab) = ! 206: let val r = (ref 0, 14*16+9,14*16+8) ! 207: in jump(WHICH r, lab); emitarg arg; jump(COND r, lab) ! 208: end ! 209: | bbc (arg1, arg2, address lab) = ! 210: let val r = (ref 0, 14*16+1,14*16+0) ! 211: in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab) ! 212: end ! 213: fun bbs (immed 0, arg, address lab) = ! 214: let val r = (ref 0, 14*16+8,14*16+9) ! 215: in jump(WHICH r, lab); emitarg arg; jump(COND r, lab) ! 216: end ! 217: | bbs (arg1, arg2, address lab) = ! 218: let val r = (ref 0, 14*16+0,14*16+1) ! 219: in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab) ! 220: end ! 221: ! 222: fun movb (immed i, arg2) = (emitbyte(9*16); immedbyte i; emitarg arg2) ! 223: | movb args = (emitbyte (9*16); emit2arg args) ! 224: ! 225: fun movzbl args = (emitbyte (9*16+10); emit2arg args) ! 226: ! 227: fun pushal args = (emitbyte (13*16+15); emitarg args) ! 228: ! 229: fun addl2 (immed 1, arg) = (emitbyte(13*16+6); emitarg arg) ! 230: | addl2 args = (emitbyte (12*16); emit2arg args) ! 231: ! 232: fun moval (arg, autodec(reg 14)) = pushal arg ! 233: | moval (args as (displace(i, reg p),direct (reg q))) = ! 234: if p=q andalso i> ~128 andalso i < 128 ! 235: then addl2(immed i, direct(reg p)) ! 236: else (emitbyte (13*16+14); emit2arg args) ! 237: | moval args = (emitbyte (13*16+14); emit2arg args) ! 238: ! 239: fun movl (immedlab l, arg) = moval(address l, arg) ! 240: | movl (arg, autodec(reg 14)) = (emitbyte(13*16+13); emitarg arg) ! 241: | movl (immed 0, arg) = (emitbyte(13*16+4); emitarg arg) ! 242: | movl args = (emitbyte (13*16); emit2arg args) ! 243: ! 244: fun movq args = (emitbyte (7*16+13); emit2arg args) ! 245: ! 246: fun rsb () = emitbyte 5 ! 247: fun cmpl args = (emitbyte (13*16+1); emit2arg args) ! 248: fun addl3 args = (emitbyte (12*16+1); emit3arg args) ! 249: val addl3 = args23 (addl2,addl3) ! 250: fun subl2 args = (emitbyte (12*16+2); emit2arg args) ! 251: fun subl3 args = (emitbyte (12*16+3); emit3arg args) ! 252: val subl3 = args23 (subl2,subl3) ! 253: fun bisl3 args = (emitbyte (12*16+9); emit3arg args) ! 254: fun bicl3 args = (emitbyte (12*16+11); emit3arg args) ! 255: fun xorl3 args = (emitbyte (12*16+13); emit3arg args) ! 256: fun ashl(immed i,arg2,arg3)=(emitbyte(7*16+8);immedbyte i;emitarg arg2;emitarg arg3) ! 257: | ashl args = (emitbyte (7*16+8); emit3arg args) ! 258: fun mull2 args = (emitbyte (12*16+4); emit2arg args) ! 259: fun divl3 args = (emitbyte (12*16+7); emit3arg args) ! 260: fun divl2 args = (emitbyte (12*16+6); emit2arg args) ! 261: val divl3 = args23 (divl2,divl3) ! 262: fun jmp (arg as address lab) = jbr arg ! 263: | jmp arg = (emitbyte (16+7); emitarg arg) ! 264: fun brb (displace(i,reg 15)) = (emitbyte (16+1); signedbyte i) ! 265: fun brw (displace(i,reg 15)) = (emitbyte (3*16+1); emitword i) ! 266: ! 267: local fun condj(i,j) = ! 268: fn (address lab) => let val r = (ref 0,16+i,16+j) ! 269: in jump(WHICH r, lab); jump(COND r, lab) ! 270: end ! 271: | displace(k, reg 15) => (emitbyte (16+i); signedbyte k) ! 272: in val beql = condj(3,2) ! 273: val bneq = condj(2,3) ! 274: val jne = bneq ! 275: val bgeq = condj(8,9) ! 276: val bgtr = condj(4,5) ! 277: val blss = condj(9,8) ! 278: val bleq = condj(5,4) ! 279: end ! 280: fun sobgeq (arg,address lab) = (emitbyte (15*16+4); emitarg arg; ! 281: jump(BYTEDISPL,lab)) ! 282: ! 283: fun movg args = (emitword(20733); emit2arg args) ! 284: fun mnegg args = (emitword(21245); emit2arg args) ! 285: fun addg3 args = (emitword(16893); emit3arg args) ! 286: fun subg3 args = (emitword(17405); emit3arg args) ! 287: fun mulg3 args = (emitword(17917); emit3arg args) ! 288: fun divg3 args = (emitword(18429); emit3arg args) ! 289: fun cmpg args = (emitword(20989); emit2arg args) ! 290: ! 291: fun push arg = movl(arg,autodec sp) ! 292: fun pusha arg = pushal arg ! 293: fun pop arg = movl(autoinc sp,arg) ! 294: ! 295: fun comment _ = () ! 296: ! 297: end (* Coder *) ! 298: ! 299: val finish = Emitter.finish ! 300: ! 301: end (* structure MCode *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.