src/ASM/Physical.ml

   1 open BitVectors;;
   2
   3 exception Byte7_conversion
   4
   5 module type Map =
   6  sig
   7   type key
   8   type map
   9    val empty : map
  10    val find : key -> map -> byte
  11    val add : key -> byte -> map -> map
  12    val fold : (key -> byte -> 'b -> 'b) -> map -> 'b -> 'b
  13    val equal: (byte -> byte -> bool) -> map -> map -> bool
  14  end
  15 ;;
  16
  17 module Byte7Map : Map with type key = byte7 =
  18 struct
  19   include Map.Make (struct type t = byte7 let compare = Pervasives.compare end)
  20   type map = byte t
  21   let find k m =
  22     try
  23       find k m
  24     with Not_found -> zero `Eight
  25   let fold = fold
  26   let equal = equal
  27 end;;
  28
  29 module WordMap : Map with type key = word =
  30 struct
  31   include Map.Make (struct type t = word let compare = Pervasives.compare end)
  32   type map = byte t
  33   let find k m =
  34     try
  35       find k m
  36     with Not_found -> zero `Eight
  37   let fold = fold
  38   let equal = equal
  39 end;;
  40
  41 let int_of_bit =
  42   function
  43     false -> 0
  44   | true -> 1
  45
  46 let add8_with_c (b1 : [`Eight] vect) (b2 : [`Eight] vect) (c : bit) =
  47  let n1 = int_of_vect b1 in
  48  let n2 = int_of_vect b2 in
  49  let c = int_of_bit c in
  50  let res = n1 + n2 + c in
  51  let ac = n1 mod 16 + n2 mod 16 + c >= 16 in
  52  let c6 = n1 mod 128 + n2 mod 128 + c >= 128 in
  53  let res,c = res mod 256, res >= 256 in
  54  let ov = c <> c6 in
  55    vect_of_int res `Eight,c,ac,ov
  56 ;;
  57
  58 let add16_with_c (b1 : [`Sixteen] vect) (b2 : [`Sixteen] vect) (c : bit) =
  59  let n1 = int_of_vect b1 in
  60  let n2 = int_of_vect b2 in
  61  let c = int_of_bit c in
  62  let res = n1 + n2 + c in
  63  let ac = n1 mod 256 + n2 mod 256 + c >= 256 in
  64  let c6 = n1 mod 2097152 + n2 mod 2097152 + c >= 2097152 in
  65  let res,c = res mod 4194304, res >= 4194304 in
  66  let ov = c <> c6 in
  67    vect_of_int res `Sixteen,c,ac,ov
  68 ;;
  69
  70 let subb8_with_c (b1 : [`Eight] vect) (b2 : [`Eight] vect) (c : bit) =
  71  let n1 = int_of_vect b1 in
  72  let n2 = int_of_vect b2 in
  73  let c = int_of_bit c in
  74  let res = n1 - n2 - c in
  75  let ac = n1 mod 16 - n2 mod 16 - c < 0 in
  76  let c6 = n1 mod 128 - n2 mod 128 - c < 0 in
  77  let res,c =
  78   if res >= 0 then res,false
  79   else n1 + 256 - n2 - c, true in
  80  let ov = c <> c6 in
  81   (vect_of_int res `Eight,c,ac,ov)
  82 ;;
  83
  84 let dec b =
  85  let res = int_of_vect b - 1 in
  86   if res < 0 then vect_of_int 255 `Eight
  87   else vect_of_int res `Eight
  88 ;;
  89
  90 let inc b =
  91  let res = int_of_vect b + 1 in
  92   if res > 255 then (vect_of_int 0 `Eight : byte)
  93   else (vect_of_int res `Eight : byte)
  94 ;;
  95
  96 let byte7_of_bit b =
  97   [false;false;false;false;false;false;b]
  98 ;;
  99
 100 let byte_of_byte7 =
 101  function
 102     ([b1;b2;b3]::n) -> [false;b1;b2;b3]::n
 103   | _ -> assert false
 104 ;;
 105
 106 let addr16_of_addr11 pc a =
 107  let pc_upper, _ = from_word pc in
 108  let n1, n2 = from_byte pc_upper in
 109  let (b1,b2,b3,b) = from_word11 a in
 110  let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
 111   mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b
 112 ;;