diff --git a/bin/bctest.ml b/bin/bctest.ml new file mode 100644 index 0000000..fe8db5f --- /dev/null +++ b/bin/bctest.ml @@ -0,0 +1,123 @@ +module Bc = struct + [@@@warning "-32"] + type t = { + buf : Buffer.t; + out : out_channel; + } + + let make out = + { buf = Buffer.create 256; out } + + let flush t = + output_string t.out (Buffer.contents t.buf); + Buffer.clear t.buf + + let write_16 t x = + assert (Int64.to_int x land 3 = 1); + Buffer.add_int16_le t.buf (Int64.to_int x) + + let write_32 t x = + assert (Int64.to_int x land 3 = 2); + Buffer.add_int32_le t.buf (Int64.to_int32 x) + + let write_48 _t x = + assert (x land 3 = 3); + failwith "..." + + let ( << ) = Int64.shift_left + let ( |+ ) = Int64.logor + let _0 = Int64.zero + let _1 = Int64.one + + let rep_uint i = + assert (0 <= i && i < 0x400); + Int64.of_int i + + let rep_sint i = + assert (-0x200 <= i && i < 0x200); + Int64.of_int (i land 0x3ff) + + let rep_s24 i = + assert (-0x800000 <= i && i < 0x800000); + Int64.of_int (i land 0xffffff) + + type r = [`R of int] + type v = [r | `K of int] + type l = [`SubI of r * int | `SubR of r * r] + + let rep_v : [< v] -> int64 = function + | `R i -> (rep_uint i) |+ (_0 << 10) + | `K i -> (rep_uint i) |+ (_1 << 10) + + let rep_r : [< r] -> int64 = + rep_v + + let rep_l : l -> int64 = function + | `SubI (a, i) -> (rep_r a) |+ (rep_sint i << 10) |+ (_0 << 20) + | `SubR (a, i) -> (rep_r a) |+ (rep_r i << 10) |+ (_1 << 20) + + let write_v i t a = + assert (i >= 0 && i <= 32 && (i land 7 = 5)); + write_16 t (Int64.of_int i |+ (rep_v a << 5)) + + let write_rv i t a b = + assert (i >= 0 && i <= 255 && (i land 7 = 2)); + write_32 t (Int64.of_int i |+ (rep_r a << 8) |+ (rep_v b << 18)) + + let write_o i t o = + write_32 t (Int64.of_int i |+ (rep_s24 o << 8)) + + let write_opr i t a b = + match a, b with + | (#r as a), (#v as b) -> write_rv i t a b + | (#r as a), (#l as b) -> let _ = (a,b) in failwith "..." + + let write_cbr i t a b = + write_rv (i lor 8) t a b + + let ret = write_v 0x05 + let btr = write_v 0x0d + let jmp = write_o 0x06 + let mov = write_opr 0x02 + let con = write_opr 0x12 + let add = write_opr 0x22 + let sub = write_opr 0x32 + let mul = write_opr 0x42 + let div = write_opr 0x52 + let mod_= write_opr 0x62 + let neg_= write_opr 0x72 + let not_= write_opr 0x82 + (* let ? = write_opr 0x92 *) + let ceq = write_opr 0xa2 + let beq = write_cbr 0xa2 + let cne = write_opr 0xb2 + let bne = write_cbr 0xb2 + let clt = write_opr 0xc2 + let blt = write_cbr 0xc2 + let cge = write_opr 0xd2 + let bge = write_cbr 0xd2 + let cgt = write_opr 0xe2 + let bgt = write_cbr 0xe2 + let cle = write_opr 0xf2 + let ble = write_cbr 0xf2 +end + +let bc = Bc.make stdout + +let () = + begin + Bc.mov bc (`R 0) (`K 0); (* 0 *) + Bc.mov bc (`R 1) (`K 1); (* 2 *) + Bc.bgt bc (`R 0) (`R 1); (* 4 *) + Bc.jmp bc (+9 (* L3 *)); (* 6 *) + Bc.jmp bc (+3 (* L2 *)); (* 8 *) + Bc.ret bc (`R 0); (* L1: 10 *) + Bc.mov bc (`R 0) (`K 2); (* L2: 11 *) + Bc.jmp bc (-3 (* L1 *)); (* 13 *) + Bc.mov bc (`R 0) (`K 3); (* L3: 15 *) + Bc.jmp bc (-7 (* L1 *)); (* 17 *) + end + +let () = + Bc.flush bc + diff --git a/bin/dune b/bin/dune index 4d891a5..557aae2 100644 --- a/bin/dune +++ b/bin/dune @@ -1,4 +1,11 @@ (executable (public_name spicec) (name main) + (modules main) (libraries spice fmt logs)) + +(executable + (public_name spice_bctest) + (name bctest) + (modules bctest) + (libraries fmt logs))