iitalics
/
spice
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add comparison instructions and compile some more operators

This commit is contained in:
tali 2023-11-29 22:46:27 -05:00
parent c1eaa5baef
commit 3d88cbe319
5 changed files with 62 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/main.ml
View File

@ -5,7 +5,7 @@ let[@warning "-26"] () =
Logs.set_level (Some Logs.Debug);
try
let ast = parse "val o = obj { val x = 3 }" in
let ast = parse "val ret = 1 + 1 == 2" in
let prog = compile ast in
let ret = run prog in
Fmt.pr "{\"program\":%a,\"output\":%a}" Code.pp_program prog Value.pp ret

21
lib/compile/bcc.ml
View File

@ -30,17 +30,24 @@ let compile modl =
emit_mov ret (Code.cst_of_int slot);
emit (GET (self, ret));
Reg ret)
| Ast.Binop (op, e1, e2) ->
| Ast.Binop (op, lhs, rhs) ->
let ret = !sp in
let lhs = compile_exp env e1 in
let rhs = compile_exp env e2 in
let lhs = compile_exp env lhs in
let rhs = compile_exp env rhs in
sp := ret + 1;
emit_mov ret lhs;
emit
(match op with
| Ast.Add -> ADD (ret, rhs)
| Ast.Sub -> SUB (ret, rhs)
| Ast.Mul -> MUL (ret, rhs)
| Ast.Add -> emit (ADD (ret, rhs))
| Ast.Sub -> emit (SUB (ret, rhs))
| Ast.Mul -> emit (MUL (ret, rhs))
| Ast.Eql -> emit (EQL (ret, rhs))
| Ast.Not_eql ->
emit (EQL (ret, rhs));
emit (NOT ret)
| Ast.Lst -> emit (LST (ret, rhs))
| Ast.Grt_eql ->
emit (LST (ret, rhs));
emit (NOT ret)
| _ -> Fmt.failwith "Bcc.compile_exp: TODO: %S" (Ast.string_of_binop op));
Reg ret
| Ast.Obj body -> compile_obj env body

31
lib/runtime/code.ml
View File

@ -21,10 +21,14 @@ and ins =
| ADD of regidx * operand
| SUB of regidx * operand
| MUL of regidx * operand
| EQL of regidx * operand
| LST of regidx * operand
| NOT of regidx
| CON of regidx * Value.vtable
| GET of regidx * regidx
| SET of regidx * regidx
| JMP of basic_block
| CBR of operand * basic_block * basic_block
| RET
let make_basic_block ins_list = { ins_builder = List.rev ins_list; ins_list }
@ -54,14 +58,15 @@ let frame_size prog =
| _ -> acc
in
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
| MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) | EQL (r, v) | LST (r, v) ->
op (reg acc r) v
| CON (r, _) | NOT r -> reg acc r
| 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 *)
| CBR (v, b1, b2) ->
enqueue b1;
enqueue b2;
op acc v
| JMP b ->
enqueue b;
acc
@ -100,22 +105,26 @@ let pp_vtable ppf vt =
vt.elems;
Fmt.pf ppf "}"
let pp_ins ~get_bb_name ppf = function
let pp_ins ~label 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
| EQL (l, r) -> Fmt.pf ppf "eql %a, %a" pp_reg l pp_operand r
| LST (l, r) -> Fmt.pf ppf "lst %a, %a" pp_reg l pp_operand r
| NOT l -> Fmt.pf ppf "not %a" pp_reg l
| 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)
| CBR (v, b1, b2) -> Fmt.pf ppf "cbr %a, %s, %s" pp_operand v (label b1) (label b2)
| RET -> Fmt.pf ppf "ret"
| JMP l -> Fmt.pf ppf "jmp %s" (get_bb_name l)
| JMP l -> Fmt.pf ppf "jmp %s" (label l)
let pp_program ppf pr =
let ep = pr.entrypoint in
let basic_blocks = ref [ ep, "START" ] in
let work_list = ref [ ep ] in
let get_bb_name bb =
let label bb =
match List.find (fun (bb', _) -> bb == bb') !basic_blocks with
| _, name -> name
| exception Not_found ->
@ -130,11 +139,11 @@ let pp_program ppf pr =
| bb :: rest ->
work_list := rest;
if i > 0 then Fmt.pf ppf ",";
Fmt.pf ppf "%S:[" (get_bb_name bb);
Fmt.pf ppf "%S:[" (label bb);
List.iteri
(fun i is ->
if i > 0 then Fmt.pf ppf ",";
let str = Fmt.str "%a" (pp_ins ~get_bb_name) is in
let str = Fmt.str "%a" (pp_ins ~label) is in
Fmt.pf ppf "%S" str)
(instructions bb);
Fmt.pf ppf "]";

21
lib/runtime/interp.ml
View File

@ -16,6 +16,22 @@ module Op = struct
| Value.Int x, Value.Int y -> Value.Int (Int64.mul x y)
| _, _ -> raise (Runtime_error "cannot mul non integer values")
let eql v1 v2 =
match v1, v2 with
| Value.Int x, Value.Int y -> Value.bool (Int64.equal x y)
| _, _ -> Value.bool (v1 == v2)
let lst v1 v2 =
match v1, v2 with
| Value.Int x, Value.Int y -> Value.bool (Int64.compare x y < 0)
| _, _ -> raise (Runtime_error "cannot compare non integer values")
let truthy = function
| Value.False | Value.Nil -> false
| _ -> true
let not v = Value.bool (not (truthy v))
let get o s =
match o, s with
| Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i)
@ -52,11 +68,16 @@ let exec fr = function
| Code.ADD (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
| 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.EQL (l, r) -> fr.regs.(l) <- Op.eql fr.regs.(l) (eval fr r)
| Code.LST (l, r) -> fr.regs.(l) <- Op.lst fr.regs.(l) (eval fr r)
| Code.NOT l -> fr.regs.(l) <- Op.not fr.regs.(l)
| 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.CBR (v, l1, l2) ->
fr.pc <- Code.instructions (if Op.truthy (eval fr v) then l1 else l2)
let rec run fr =
match fr.pc with

9
lib/runtime/value.ml
View File

@ -22,13 +22,12 @@ type t =
| Int of int64
| Obj of vtable * t array
let equal v1 v2 =
match v1, v2 with
| Int x, Int y -> Int64.equal x y
| _, _ -> v1 == v2
let make_obj vtable = Obj (vtable, Array.make vtable.n_slots Nil)
let bool = function
| true -> True
| false -> False
let rec pp ppf = function
| Obj (vtable, slots) -> pp_obj ppf vtable slots
| Int n -> Fmt.string ppf (Int64.to_string n)