add GRT instruction and implement missing comparators

This commit is contained in:
tali 2023-11-30 13:16:20 -05:00
parent b89ddd45b5
commit 2bdb1511ab
3 changed files with 27 additions and 11 deletions

View File

@ -40,15 +40,19 @@ let compile modl =
| Ast.Add -> emit (ADD (ret, rhs))
| Ast.Sub -> emit (SUB (ret, rhs))
| Ast.Mul -> emit (MUL (ret, rhs))
| Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod"
| 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 ->
| Ast.Lst_eql ->
emit (LST (ret, rhs));
emit (NOT ret)
| _ -> Fmt.failwith "Bcc.compile_exp: TODO: %S" (Ast.string_of_binop op));
| Ast.Grt -> emit (GRT (ret, rhs))
| Ast.Grt_eql ->
emit (LST (ret, rhs));
emit (NOT ret));
Reg ret
| Ast.If (cnd, e1, e2) ->
let l1 = Code.make_basic_block [] in

View File

@ -23,6 +23,7 @@ and ins =
| MUL of regidx * operand
| EQL of regidx * operand
| LST of regidx * operand
| GRT of regidx * operand
| NOT of regidx
| CON of regidx * Value.vtable
| GET of regidx * regidx
@ -58,8 +59,13 @@ let frame_size prog =
| _ -> acc
in
let ins acc = function
| MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) | EQL (r, v) | LST (r, v) ->
op (reg acc r) v
| MOV (r, v)
| ADD (r, v)
| SUB (r, v)
| MUL (r, v)
| EQL (r, v)
| LST (r, v)
| GRT (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)
@ -112,6 +118,7 @@ let pp_ins ~label ppf = function
| 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
| GRT (l, r) -> Fmt.pf ppf "grt %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
@ -128,13 +135,12 @@ let pp_program ppf pr =
let basic_blocks = ref [ ep, "START" ] in
let work_list = ref [ ep ] in
let label bb =
match List.find (fun (bb', _) -> bb == bb') !basic_blocks with
| _, name -> name
| exception Not_found ->
let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
basic_blocks := (bb, name) :: !basic_blocks;
work_list := !work_list @ [ bb ];
name
try List.assq bb !basic_blocks
with Not_found ->
let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
basic_blocks := (bb, name) :: !basic_blocks;
work_list := !work_list @ [ bb ];
name
in
let rec loop i =
match !work_list with

View File

@ -26,6 +26,11 @@ module Op = struct
| Value.Int x, Value.Int y -> Value.bool (Int64.compare x y < 0)
| _, _ -> raise (Runtime_error "cannot compare non integer values")
let grt 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
@ -70,6 +75,7 @@ let exec fr = function
| 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.GRT (l, r) -> fr.regs.(l) <- Op.grt 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)