temporarily remove branch ins
This commit is contained in:
parent
7569cd2ee4
commit
846cae64ff
30
bin/main.ml
30
bin/main.ml
|
@ -8,17 +8,31 @@ let[@warning "-26"] () =
|
|||
let int n = Code.Cst_int (Int64.of_int n) in
|
||||
let reg n = Code.Reg n in
|
||||
|
||||
let posn_vt = Value.make_vtable [ "x"; "y" ] in
|
||||
let vtable = Value.make_vtable [ "x"; "y" ] in
|
||||
let ep =
|
||||
Code.make_basic_block
|
||||
[
|
||||
CON (0, posn_vt);
|
||||
(* MOV (1, int 0); "x" *)
|
||||
(* MOV (2, int 100); *)
|
||||
(* SET (0, 1); *)
|
||||
(* MOV (1, int 1); "y" *)
|
||||
(* MOV (2, int 100); *)
|
||||
(* SET (0, 1); *)
|
||||
(* obj o {...} *)
|
||||
CON (0, vtable);
|
||||
(* o.x = 999 *)
|
||||
MOV (2, int 999);
|
||||
MOV (1, int 0);
|
||||
SET (0, 1);
|
||||
(* o.y = 11 *)
|
||||
MOV (2, int 11);
|
||||
MOV (1, int 1);
|
||||
SET (0, 1);
|
||||
(* _1 = o.x *)
|
||||
MOV (1, int 0);
|
||||
GET (0, 1);
|
||||
(* _2 = o.y *)
|
||||
MOV (2, int 1);
|
||||
GET (0, 2);
|
||||
(* _3 = _1 * _2 *)
|
||||
MUL (2, reg 1);
|
||||
(* o.x = _3 *)
|
||||
MOV (1, int 0);
|
||||
SET (0, 1);
|
||||
]
|
||||
in
|
||||
|
||||
|
|
|
@ -20,8 +20,9 @@ and ins =
|
|||
| SUB of regidx * operand
|
||||
| MUL of regidx * operand
|
||||
| CON of regidx * Value.vtable
|
||||
| GET of regidx * regidx
|
||||
| SET of regidx * regidx
|
||||
| JMP of basic_block
|
||||
| BRT of operand * basic_block * basic_block
|
||||
| RET
|
||||
|
||||
let make_basic_block ins_list = { ins_builder = List.rev ins_list; ins_list }
|
||||
|
@ -53,10 +54,12 @@ let frame_size prog =
|
|||
let ins acc = function
|
||||
| MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) -> op (reg acc r) v
|
||||
| CON (r, _) -> reg acc r
|
||||
| BRT (v, b1, b2) ->
|
||||
enqueue b1;
|
||||
enqueue b2;
|
||||
op acc v
|
||||
| GET (o, v) -> reg (reg acc o) v
|
||||
| SET (o, v) -> reg (reg acc o) (v + 1)
|
||||
(* | BRT (v, b1, b2) -> *)
|
||||
(* enqueue b1; *)
|
||||
(* enqueue b2; *)
|
||||
(* op acc v *)
|
||||
| JMP b ->
|
||||
enqueue b;
|
||||
acc
|
||||
|
@ -83,16 +86,28 @@ let pp_operand ppf = function
|
|||
| Cst_int n -> Fmt.pf ppf "#%s" (Int64.to_string n)
|
||||
| Reg r -> pp_reg ppf r
|
||||
|
||||
let pp_vtable ppf vt =
|
||||
Fmt.pf ppf "(%d){" vt.Value.n_slots;
|
||||
let sep = ref "" in
|
||||
Hashtbl.iter
|
||||
(fun name -> function
|
||||
| Value.Method -> ()
|
||||
| Value.Field idx ->
|
||||
Fmt.pf ppf "%s%s@%d" !sep name idx;
|
||||
sep := ";")
|
||||
vt.elems;
|
||||
Fmt.pf ppf "}"
|
||||
|
||||
let pp_ins ~get_bb_name ppf = function
|
||||
| MOV (l, r) -> Fmt.pf ppf "mov %a, %a" pp_reg l pp_operand r
|
||||
| ADD (l, r) -> Fmt.pf ppf "add %a, %a" pp_reg l pp_operand r
|
||||
| SUB (l, r) -> Fmt.pf ppf "sub %a, %a" pp_reg l pp_operand r
|
||||
| MUL (l, r) -> Fmt.pf ppf "mul %a, %a" pp_reg l pp_operand r
|
||||
| CON (l, vt) -> Fmt.pf ppf "con %a, %a" pp_reg l Value.pp_vtable vt
|
||||
| CON (l, vt) -> Fmt.pf ppf "con %a, %a" pp_reg l pp_vtable vt
|
||||
| GET (o, s) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg s pp_reg o pp_reg s
|
||||
| SET (o, s) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg o pp_reg s pp_reg (s + 1)
|
||||
| RET -> Fmt.pf ppf "ret"
|
||||
| JMP l -> Fmt.pf ppf "jmp %s" (get_bb_name l)
|
||||
| BRT (v, l1, l2) ->
|
||||
Fmt.pf ppf "brt %a, %s, %s" pp_operand v (get_bb_name l1) (get_bb_name l2)
|
||||
|
||||
let pp_program ppf pr =
|
||||
let ep = pr.entrypoint in
|
||||
|
|
|
@ -16,9 +16,15 @@ module Op = struct
|
|||
| Value.Int x, Value.Int y -> Value.Int (Int64.mul x y)
|
||||
| _, _ -> raise (Runtime_error "cannot mul non integer values")
|
||||
|
||||
let is_true = function
|
||||
| Value.True -> true
|
||||
| _ -> false
|
||||
let get o s =
|
||||
match o, s with
|
||||
| Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i)
|
||||
| _ -> raise (Runtime_error "get field of non-object")
|
||||
|
||||
let set o s v =
|
||||
match o, s with
|
||||
| Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i) <- v
|
||||
| _ -> raise (Runtime_error "set field of non-object")
|
||||
end
|
||||
|
||||
type frame = {
|
||||
|
@ -47,11 +53,10 @@ let exec fr = function
|
|||
| Code.SUB (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
|
||||
| Code.MUL (l, r) -> fr.regs.(l) <- Op.mul fr.regs.(l) (eval fr r)
|
||||
| Code.CON (l, vt) -> fr.regs.(l) <- Value.make_obj vt
|
||||
| Code.GET (o, s) -> fr.regs.(s) <- Op.get fr.regs.(o) fr.regs.(s)
|
||||
| Code.SET (o, s) -> Op.set fr.regs.(o) fr.regs.(s) fr.regs.(s + 1)
|
||||
| Code.RET -> fr.pc <- []
|
||||
| Code.JMP l -> fr.pc <- Code.instructions l
|
||||
| Code.BRT (v, l1, l2) ->
|
||||
if Value.equal (eval fr v) True then fr.pc <- Code.instructions l1
|
||||
else fr.pc <- Code.instructions l2
|
||||
|
||||
let rec run fr =
|
||||
match fr.pc with
|
||||
|
|
|
@ -15,18 +15,6 @@ let make_vtable fields =
|
|||
elems = List.to_seq fields |> Seq.mapi (fun i name -> name, Field i) |> Hashtbl.of_seq;
|
||||
}
|
||||
|
||||
let pp_vtable ppf vt =
|
||||
Fmt.pf ppf "<%d>{" vt.n_slots;
|
||||
let sep = ref "" in
|
||||
Hashtbl.iter
|
||||
(fun name -> function
|
||||
| Method -> ()
|
||||
| Field idx ->
|
||||
Fmt.pf ppf "%s%s@%d" !sep name idx;
|
||||
sep := ";")
|
||||
vt.elems;
|
||||
Fmt.pf ppf "}"
|
||||
|
||||
type t =
|
||||
| Nil
|
||||
| True
|
||||
|
|
Loading…
Reference in New Issue