home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / vax / vaxmcode.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  8.7 KB  |  283 lines
  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.  
  11. fun eword i = [chr(Bits.andb(i,255)), chr(Bits.andb(Bits.rshift(i,8),255))]
  12.  
  13. fun elong i = eword(Bits.andb(i,65535)) @ eword(Bits.rshift(i,16))
  14.     
  15. fun intsize(i) =
  16.         if i >= ~128 andalso i < 128
  17.         then 1
  18.     else if i >= ~32768 andalso i < 32768
  19.         then 2
  20.     else 4;
  21.  
  22.   fun emitlong i = implode(elong i)
  23.  
  24.   fun sizejump(mode,oldsize,s,d) =
  25.    let fun which (r,a,b) =
  26.             case oldsize of 1 => r := a | _ => r := b
  27.     in case (mode,intsize(d-(s+oldsize)))
  28.            of  (MODE,i) => i+1
  29.             | (LABPTR _, _) => 4
  30.         | (BYTEDISPL, _) => 1
  31.         | (WHICH _, _) => 1
  32.         | (COND x, 1) => (which x; 1)
  33.         | (COND x, 2) => (which x; 4)
  34.         | (COND x, _) => (which x; 7)
  35.         | (JBR,1) => 2
  36.         | (JBR,2) => 3
  37.         | (JBR,_) => 6
  38.    end
  39.  
  40.   fun emitjump(MODE,2,s,d) = chr(10*16+15) ^ sbyte(d-s-2)
  41.     | emitjump(MODE,3,s,d) = implode(chr(12*16+15) :: eword(d-s-3))
  42.     | emitjump(MODE,5,s,d) = implode(chr(14*16+15) :: elong (d-s-5))
  43.     | emitjump(BYTEDISPL,1,s,d) = sbyte(d-s-1)
  44.     | emitjump(LABPTR i, _,s,d) = emitlong(d-s+i)
  45.     | emitjump(WHICH(ref i,_,_), _,_,_) = chr i
  46.     | emitjump(COND _, 1,s,d) = sbyte(d-s-1)
  47.     | emitjump(COND _, 4,s,d) = implode(chr 3 :: chr(3*16+1) :: eword(d-s-4))
  48.     | emitjump(COND _, 7,s,d) = implode(chr 6 :: chr(16+7) :: chr(14*16+15) 
  49.                     :: elong (d-s-7))
  50.     | emitjump(JBR,2,s,d) = chr(16+1) ^ sbyte (d-s-2)
  51.     | emitjump(JBR,3,s,d) = implode(chr(3*16+1) :: eword (d-s-3))
  52.     | emitjump(JBR,6,s,d) = implode(chr(16+7):: chr(14*16+15) :: elong (d-s-6))
  53.     | emitjump _ = ErrorMsg.impossible "emitjump"
  54.   
  55. end (* Jumps *)
  56.  
  57. structure Emitter : BACKPATCH = Backpatch(Jumps)
  58.  
  59. structure Coder : VAXCODER = struct
  60.  
  61. open Emitter Jumps
  62.  
  63. fun emitbyte i = emitstring(chr i)
  64. fun signedbyte i = emitbyte(if i<0 then 256+i else i)
  65. (*******
  66. fun emitword i =
  67.     if i<0 then emitword(65536+i)
  68.     else (emitbyte(i mod 256); emitbyte(i div 256));
  69. fun emitlong i =
  70.         if i<0 
  71.       then let val a = ~i;
  72.            val b = a mod 65536;
  73.            val c = a div 65536;
  74.         in emitword(~b);
  75.            emitword(~c + (if b=0 then 0 else ~1))
  76.            end
  77.       else (emitword(i mod 65536); emitword(i div 65536))
  78. *******)
  79. fun emitword i = (emitbyte(Bits.andb(i,255));
  80.           emitbyte(Bits.andb(Bits.rshift(i,8),255)))
  81. fun emitlong i = (emitword(Bits.andb(i,65535)); emitword(Bits.rshift(i,16)))
  82.  
  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. structure VaxRealConst = RealConst(
  120.   struct
  121.     val significant = 53 (* 52 + redundant 1/2 bit *)
  122.     val minexp = ~1024 and maxexp = 1023
  123.     open Bits
  124.     fun transreal (sign,frac,exp) =
  125.            if frac(0,1)=0 then "\000\000\000\000\000\000\000\000"
  126.         else implode[chr(andb(255,orb(lshift(exp+1024,4),frac(1,4)))),
  127.                  chr(orb(lshift(sign,7),rshift(exp+1024,4))),
  128.                  chr(frac(13,8)),
  129.                  chr(frac(5,8)),
  130.                  chr(frac(29,8)),
  131.                  chr(frac(21,8)),
  132.                  chr(frac(45,8)),
  133.                  chr(frac(37,8))]
  134.   end)
  135. exception BadReal = VaxRealConst.BadReal
  136. fun realconst s = emitstring(VaxRealConst.realconst s)
  137.  
  138. fun regmode(mode,r) = emitbyte(mode*16+r)
  139.  
  140. fun emitarg (direct(reg r)) = regmode(5,r)
  141.   | emitarg (autoinc(reg r)) = regmode(8,r)
  142.   | emitarg (autodec(reg r)) = regmode(7,r)
  143.   | emitarg (immed i) = 
  144.     if i>=0 andalso i<64 then emitbyte i
  145.         else (emitarg(autoinc pc); emitlong i)
  146.   | emitarg (displace(i,reg r)) =
  147.      if i=0 then regmode(6,r)
  148.      else (case intsize i 
  149.          of  1 => (regmode(10,r); signedbyte i)
  150.            | 2 => (regmode(12,r); emitword i)
  151.            | 4 => (regmode(14,r); emitlong i))
  152.   | emitarg (deferred(i,reg r)) =
  153.     (case intsize i of
  154.          1 => (regmode(11,r); signedbyte i)
  155.        | 2 => (regmode(13,r); emitword i)
  156.        | 4 => (regmode(15,r); emitlong i))
  157.   | emitarg (index(ea, reg r)) = (regmode(4,r); emitarg ea)
  158.   | emitarg (address lab) = jump(MODE,lab) (* no good for branches *)
  159.  
  160. fun emit2arg (arg1,arg2) = (emitarg arg1; emitarg arg2)
  161.  
  162. fun emit3arg (arg1,arg2,arg3) = (emitarg arg1; emitarg arg2; emitarg arg3)
  163.  
  164. fun pure (autoinc _) = false
  165.   | pure (autodec _) = false
  166.   | pure _ = true
  167.  
  168. fun args23(f2,f3) (args as (a,b,c)) = 
  169.     if b=c andalso pure b then (f2(a,b)) else f3 args
  170.  
  171. fun immedbyte(i) =
  172.     if i>=0 andalso i<64 then emitbyte i
  173.         else (emitarg(autoinc pc); signedbyte i);
  174.  
  175. fun immedword(i) =
  176.     if i>=0 andalso i<64 then emitbyte i
  177.         else (emitarg(autoinc pc); emitword i);
  178.  
  179. fun emitlab (i,lab) = jump(LABPTR i, lab)
  180.  
  181. fun jbr (address lab) = jump(JBR,lab)
  182. fun bbc (immed 0, arg, address lab) =
  183.         let val r = (ref 0, 14*16+9,14*16+8)
  184.          in jump(WHICH r, lab); emitarg arg; jump(COND r, lab)
  185.         end
  186.   | bbc (arg1, arg2, address lab) =
  187.         let val r = (ref 0, 14*16+1,14*16+0)
  188.          in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
  189.         end
  190. fun bbs (immed 0, arg, address lab) =
  191.         let val r = (ref 0, 14*16+8,14*16+9)
  192.          in jump(WHICH r, lab); emitarg arg; jump(COND r, lab)
  193.         end
  194.   | bbs (arg1, arg2, address lab) =
  195.         let val r = (ref 0, 14*16+0,14*16+1)
  196.          in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
  197.         end
  198.  
  199. fun movb (immed i, arg2) = (emitbyte(9*16); immedbyte i; emitarg arg2)
  200.   | movb args = (emitbyte (9*16); emit2arg args)
  201.  
  202. fun movzbl args = (emitbyte (9*16+10); emit2arg args)
  203.  
  204. fun pushal args = (emitbyte (13*16+15); emitarg args)
  205.  
  206. fun addl2 (immed 1, arg) = (emitbyte(13*16+6); emitarg arg)
  207.   | addl2 args = (emitbyte (12*16); emit2arg args)
  208.  
  209. fun moval (arg, autodec(reg 14)) = pushal arg
  210.   | moval (args as (displace(i, reg p),direct (reg q))) =
  211.         if p=q andalso i> ~128 andalso i < 128
  212.         then addl2(immed i, direct(reg p))
  213.             else (emitbyte (13*16+14); emit2arg args)
  214.   | moval args = (emitbyte (13*16+14); emit2arg args)
  215.  
  216. fun movl (immedlab l, arg) = moval(address l, arg)
  217.   | movl (arg, autodec(reg 14)) = (emitbyte(13*16+13); emitarg arg)
  218.   | movl (immed 0, arg) = (emitbyte(13*16+4); emitarg arg)
  219.   | movl args = (emitbyte (13*16); emit2arg args)
  220.  
  221. fun movq args = (emitbyte (7*16+13); emit2arg args)
  222. fun movg args = (emitword (20733); emit2arg args)
  223.  
  224. fun rsb () = emitbyte 5
  225. fun cmpl args = (emitbyte (13*16+1); emit2arg args)
  226. fun addl3 args = (emitbyte (12*16+1); emit3arg args)
  227. val addl3 = args23 (addl2,addl3)
  228. fun subl2 args = (emitbyte (12*16+2); emit2arg args)
  229. fun subl3 args = (emitbyte (12*16+3); emit3arg args)
  230. val subl3 = args23 (subl2,subl3)
  231. fun bisl3 args = (emitbyte (12*16+9); emit3arg args)
  232. fun bicl3 args = (emitbyte (12*16+11); emit3arg args)
  233. fun xorl3 args = (emitbyte (12*16+13); emit3arg args)
  234. fun ashl(immed i,arg2,arg3)=(emitbyte(7*16+8);immedbyte i;emitarg arg2;emitarg arg3)
  235.   | ashl args = (emitbyte (7*16+8); emit3arg args)
  236. fun mull2 args = (emitbyte (12*16+4); emit2arg args)
  237. fun divl3 args = (emitbyte (12*16+7); emit3arg args)
  238. fun divl2 args = (emitbyte (12*16+6); emit2arg args)
  239. val divl3 = args23 (divl2,divl3)
  240. fun jmp (arg as address lab) = jbr arg
  241.   | jmp arg = (emitbyte (16+7); emitarg arg)
  242. fun brb (displace(i,reg 15)) = (emitbyte (16+1); signedbyte i)
  243. fun brw (displace(i,reg 15)) = (emitbyte (3*16+1); emitword i)
  244.  
  245. local fun condj(i,j) =
  246.     fn (address lab) => let val r = (ref 0,16+i,16+j)
  247.                      in jump(WHICH r, lab); jump(COND r, lab)
  248.                     end
  249.      | displace(k, reg 15) => (emitbyte (16+i); signedbyte k)
  250.  in val beql = condj(3,2)
  251.     val bneq = condj(2,3)
  252.     val jne = bneq
  253.     val bgeq = condj(8,9)
  254.     val bgtr = condj(4,5)
  255.     val blss = condj(9,8)
  256.     val bleq = condj(5,4)
  257.     val bgequ = condj(14, 15)
  258. end
  259. fun sobgeq (arg,address lab) = (emitbyte (15*16+4); emitarg arg;
  260.                 jump(BYTEDISPL,lab))
  261.  
  262. fun movg args = (emitword(20733); emit2arg args)
  263. fun mnegg args = (emitword(21245); emit2arg args)
  264. fun addg3 args = (emitword(16893); emit3arg args)
  265. fun subg3 args = (emitword(17405); emit3arg args)
  266. fun mulg3 args = (emitword(17917); emit3arg args)
  267. fun divg3 args = (emitword(18429); emit3arg args)
  268. fun cmpg args = (emitword(20989); emit2arg args)
  269.  
  270. fun cvtwg args = (emitword(0x4dfd); emit2arg args)
  271.  
  272. fun push arg = movl(arg,autodec sp)
  273. fun pusha arg = pushal arg
  274. fun pop arg = movl(autoinc sp,arg)
  275.  
  276. fun comment _ = ()
  277.  
  278. end (* Coder *)
  279.  
  280. val finish = Emitter.finish
  281.  
  282. end (* structure MCode *)
  283.