home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / vax / vaxascode.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  5.8 KB  |  188 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. structure VaxAssem = struct val outfile = ref(IO.std_out) end
  3.  
  4. structure VaxAsCode  : VAXCODER = struct
  5.  
  6. open VaxAssem
  7.  
  8. val offset = ref 0
  9.  
  10. type Label = string
  11.  
  12. local val i = ref 0 in
  13. fun newlabel () = (i := !i + 1; "L" ^ makestring (!i))
  14. end
  15.  
  16. fun itoa (i:int) = if i < 0 then "-" ^ makestring (~i)
  17.            else makestring i
  18.  
  19. datatype Register = reg of int
  20.  
  21. val r0 = reg 0
  22. val r1 = reg 1
  23. val r2 = reg 2
  24. val r3 = reg 3
  25. val r4 = reg 4
  26. val r5 = reg 5
  27. val r6 = reg 6
  28. val r7 = reg 7
  29. val r8 = reg 8
  30. val r9 = reg 9
  31. val r10 = reg 10
  32. val r11 = reg 11
  33. val r12 = reg 12
  34. val r13 = reg 13
  35. val sp = reg 14
  36. val pc = reg 15
  37.  
  38. datatype EA = direct of Register
  39.         | autoinc of Register
  40.         | autodec of Register
  41.         | displace of int * Register
  42.         | deferred of int * Register
  43.         | immed of int
  44.         | immedlab of Label
  45.         | address of Label
  46.         | index of EA * Register
  47.  
  48. fun emit s = outputc (!outfile) s
  49.  
  50. fun newline () = (emit "\n"   (*  ; emit(makestring(!offset)); emit "\t" *) )
  51.  
  52. fun emitreg (reg 15) = emit "pc"
  53.   | emitreg (reg 14) = emit "sp"
  54.   | emitreg (reg r) = emit ("r" ^ itoa r)
  55.  
  56. fun emitarg (direct r) = emitreg r
  57.   | emitarg (autoinc r) = (emit "("; emitreg r; emit ")+")
  58.   | emitarg (autodec r) = (emit "-("; emitreg r; emit ")")
  59.   | emitarg (immed i) = emit ("$" ^ itoa i)
  60.   | emitarg (displace(0,r)) = (emit "("; emitreg r; emit ")")
  61.   | emitarg (displace(i,r)) = (emit (itoa i); emit "("; emitreg r; emit ")")
  62.   | emitarg (deferred(i,r)) = (emit ("*"^itoa i); emit "("; emitreg r; emit ")")
  63.   | emitarg (address lab) = emit lab
  64.   | emitarg (index(ea,r)) = (emitarg ea; emit "["; emitreg r; emit "]")
  65.   | emitarg (immedlab lab) = (emit "BOGUS:"; emit lab)
  66.  
  67. fun emit1arg (a) = (emitarg a; newline())
  68.  
  69. fun emit2arg (a,b) = (emitarg a; emit ","; emitarg b; newline())
  70.  
  71. fun emit3arg (a,b,c) =
  72.     (emitarg a; emit ","; emitarg b; emit ","; emitarg c; newline())
  73.  
  74. fun pure (autoinc _) = false
  75.   | pure (autodec _) = false
  76.   | pure _ = true
  77.  
  78. fun args23(f2,f3) (args as (a,b,c)) = 
  79.     if b=c andalso pure b then (f2(a,b)) else f3 args
  80.  
  81. fun emitbarg (displace(n,reg 15)) = (emit "$"; emit(makestring n); newline())
  82.   | emitbarg a = emit1arg a
  83.  
  84. fun align () = emit ".align 2\n"
  85.  
  86. fun mark () = let val lab = newlabel()
  87.           in  emit lab;
  88.           emit ": .long MAKE_DESC((";
  89.           emit lab;
  90.           emit "-base)/4+1,tag_backptr)\n"   (* STRING dependency *)
  91.           end
  92.  
  93. fun define lab = (emit lab; emit ":\n")
  94. fun oct i = let val m = Integer.makestring
  95.         in  m(i div 64)^m((i div 8)mod 8)^m(i mod 8) end
  96. fun c_char "\n" = "\\n"
  97.   | c_char "\t" = "\\t"
  98.   | c_char "\\" = "\\\\"
  99.   | c_char "\"" = "\\\""
  100.   | c_char c = if ord c < 32 then "\\"^oct(ord c) else c
  101. fun a_str s = implode(map c_char (explode s))
  102. fun emitstring s = (emit ".ascii \""; emit(a_str s); emit "\"\n")
  103. exception BadReal of string
  104. fun realconst s = (emit ".gfloat "; emit s; emit "\n")
  105. fun emitlong (i : int) = (emit ".long "; emit(makestring i); emit "\n")
  106.  
  107. fun emitlab (offset,l2) = 
  108.     (emit "5: .long "; emit l2; emit "-5b";
  109.      if offset < 0 then (emit "-"; emit (makestring (~offset)))
  110.                    else (emit "+"; emit (makestring offset));
  111.      emit "\n")
  112.  
  113. fun jbr arg = (emit "jbr "; emit1arg arg)
  114. fun bbc (immed 0, arg1, arg2) = (emit "blbc "; emit2arg(arg1,arg2))
  115.   | bbc args = (emit "bbc "; emit3arg args)
  116. fun bbs (immed 0, arg1, arg2) = (emit "blbs "; emit2arg(arg1,arg2))
  117.   | bbs args = (emit "bbs "; emit3arg args)
  118.  
  119. fun movb args = (emit "movb "; emit2arg args)
  120. fun movzbl args = (emit "movzbl "; emit2arg args)
  121.  
  122. fun pushal arg = (emit "pushal "; emit1arg arg)
  123.  
  124. fun addl2 args = (emit "addl2 "; emit2arg args)
  125.  
  126. fun moval (arg, autodec sp) = pushal arg
  127.   | moval (args as (displace(i, reg p),direct (reg q))) =
  128.         if p=q andalso i> ~128 andalso i < 128
  129.         then addl2(immed i, direct(reg p))
  130.             else (emit "moval "; emit2arg args)
  131.   | moval args = (emit "moval "; emit2arg args)
  132.  
  133. fun movl(immedlab l, arg) = moval(address l, arg)
  134.   | movl (arg, autodec sp) = (emit "pushl "; emit1arg arg)
  135.   | movl (immed 0, arg) = (emit "clrl "; emit1arg arg)
  136.   | movl args = (emit "movl "; emit2arg args)
  137.  
  138. fun movq args = (emit "movq "; emit2arg args)
  139. fun movg args = (emit "movg "; emit2arg args)
  140.  
  141. fun rsb () = emit "rsb\n"
  142. fun cmpl args = (emit "cmpl "; emit2arg args)
  143. fun addl3 args = (emit "addl3 "; emit3arg args)
  144. val addl3 = args23 (addl2,addl3)
  145. fun subl2 args = (emit "subl2 "; emit2arg args)
  146. fun subl3 args = (emit "subl3 "; emit3arg args)
  147. val subl3 = args23 (subl2,subl3)
  148. fun bisl3 args = (emit "bisl3 "; emit3arg args)
  149. fun bicl3 args = (emit "bicl3 "; emit3arg args)
  150. fun xorl3 args = (emit "xorl3 "; emit3arg args)
  151. fun ashl args = (emit "ashl "; emit3arg args)
  152. fun mull2 args = (emit "mull2 "; emit2arg args)
  153. fun divl3 args = (emit "divl3 "; emit3arg args)
  154. fun divl2 args = (emit "divl2 "; emit2arg args)
  155. val divl3 = args23 (divl2,divl3)
  156. fun jmp (arg as address lab) = jbr arg
  157.   | jmp arg = (emit "jmp "; emit1arg arg)
  158. fun brb arg = (emit "brb "; emitbarg arg)
  159. fun brw arg = (emit "brw "; emitbarg arg)
  160.  
  161. fun beql arg = (emit "beql "; emitbarg arg)
  162. fun bneq arg = (emit "bneq "; emitbarg arg)
  163. fun jne arg = (emit "jneq "; emit1arg arg)
  164. fun bgeq arg = (emit "bgeq "; emitbarg arg)
  165. fun bgtr arg = (emit "bgtr "; emitbarg arg)
  166. fun blss arg = (emit "blss "; emitbarg arg)
  167. fun bleq arg = (emit "bleq "; emitbarg arg)
  168. fun bgequ arg = (emit "bgequ "; emitbarg arg)
  169. fun sobgeq arg = (emit "sobgeq "; emit2arg arg)
  170.  
  171. fun movg args = (emit "movg "; emit2arg args)
  172. fun mnegg args = (emit "mnegg "; emit2arg args)
  173. fun addg3 args = (emit "addg3 "; emit3arg args)
  174. fun subg3 args = (emit "subg3 "; emit3arg args)
  175. fun mulg3 args = (emit "mulg3 "; emit3arg args)
  176. fun divg3 args = (emit "divg3 "; emit3arg args)
  177. fun cmpg args = (emit "cmpg "; emit2arg args)
  178.  
  179. fun cvtwg args = (emit "cvtwg "; emit2arg args)
  180.  
  181. fun push arg = movl(arg,autodec sp)
  182. fun pusha arg = moval(arg,autodec sp)
  183. fun pop arg = movl(autoinc sp,arg)
  184.  
  185. val comment = emit
  186.  
  187. end (* structure AsCode *)
  188.