refactor 'stack pointer' manip to be a parameter instead of a ref
This commit is contained in:
parent
fd3b356699
commit
32b3eda926
|
|
@ -10,13 +10,12 @@ type binding = {
|
|||
|
||||
let compile modl =
|
||||
let ep = Code.make_basic_block [] in
|
||||
let sp = ref 0 in
|
||||
let bb = ref ep in
|
||||
|
||||
let emit is = Code.add_ins !bb is in
|
||||
let emit_mov lhs rhs = if rhs <> Code.Reg lhs then emit (MOV (lhs, rhs)) in
|
||||
|
||||
let rec compile_exp env = function
|
||||
let rec compile_exp env sp = function
|
||||
| Ast.Literal Nil -> Code.Cst_nil
|
||||
| Ast.Literal True -> Code.Cst_true
|
||||
| Ast.Literal False -> Code.Cst_false
|
||||
|
|
@ -25,57 +24,50 @@ let compile modl =
|
|||
match Env.find name env with
|
||||
| exception Not_found -> Fmt.failwith "unbound: %S" name
|
||||
| { self; slot } ->
|
||||
let ret = !sp in
|
||||
sp := ret + 1;
|
||||
emit_mov ret (Code.cst_of_int slot);
|
||||
emit (GET (self, ret));
|
||||
Reg ret)
|
||||
emit_mov sp (Code.cst_of_int slot);
|
||||
emit (GET (self, sp));
|
||||
Reg sp)
|
||||
| Ast.Binop (op, lhs, rhs) ->
|
||||
let ret = !sp in
|
||||
let lhs = compile_exp env lhs in
|
||||
emit_mov ret lhs;
|
||||
sp := ret + 1;
|
||||
let rhs = compile_exp env rhs in
|
||||
let lhs = compile_exp env sp lhs in
|
||||
emit_mov sp lhs;
|
||||
let rhs = compile_exp env (sp + 1) rhs in
|
||||
(match op with
|
||||
| Ast.Add -> emit (ADD (ret, rhs))
|
||||
| Ast.Sub -> emit (SUB (ret, rhs))
|
||||
| Ast.Mul -> emit (MUL (ret, rhs))
|
||||
| Ast.Add -> emit (ADD (sp, rhs))
|
||||
| Ast.Sub -> emit (SUB (sp, rhs))
|
||||
| Ast.Mul -> emit (MUL (sp, rhs))
|
||||
| Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod"
|
||||
| Ast.Eql -> emit (EQL (ret, rhs))
|
||||
| Ast.Eql -> emit (EQL (sp, rhs))
|
||||
| Ast.Not_eql ->
|
||||
emit (EQL (ret, rhs));
|
||||
emit (NOT ret)
|
||||
| Ast.Lst -> emit (LST (ret, rhs))
|
||||
emit (EQL (sp, rhs));
|
||||
emit (NOT sp)
|
||||
| Ast.Lst -> emit (LST (sp, rhs))
|
||||
| Ast.Lst_eql ->
|
||||
emit (LST (ret, rhs));
|
||||
emit (NOT ret)
|
||||
| Ast.Grt -> emit (GRT (ret, rhs))
|
||||
emit (LST (sp, rhs));
|
||||
emit (NOT sp)
|
||||
| Ast.Grt -> emit (GRT (sp, rhs))
|
||||
| Ast.Grt_eql ->
|
||||
emit (LST (ret, rhs));
|
||||
emit (NOT ret));
|
||||
Reg ret
|
||||
emit (LST (sp, rhs));
|
||||
emit (NOT sp));
|
||||
Reg sp
|
||||
| Ast.If (cnd, e1, e2) ->
|
||||
let l1 = Code.make_basic_block [] in
|
||||
let l2 = Code.make_basic_block [] in
|
||||
let jp = Code.make_basic_block [] in
|
||||
let tmp = !sp in
|
||||
emit (CBR (compile_exp env cnd, l1, l2));
|
||||
sp := tmp;
|
||||
emit (CBR (compile_exp env sp cnd, l1, l2));
|
||||
bb := l1;
|
||||
emit_mov tmp (compile_exp env e1);
|
||||
emit_mov sp (compile_exp env sp e1);
|
||||
emit (JMP jp);
|
||||
sp := tmp;
|
||||
bb := l2;
|
||||
emit_mov tmp (compile_exp env e2);
|
||||
emit_mov sp (compile_exp env sp e2);
|
||||
emit (JMP jp);
|
||||
sp := tmp + 1;
|
||||
bb := jp;
|
||||
Reg tmp
|
||||
| Ast.Obj body -> compile_obj env body
|
||||
| Ast.Scope body -> compile_scope env body
|
||||
Reg sp
|
||||
| Ast.Obj body -> compile_obj env sp body
|
||||
| Ast.Scope body -> compile_scope env sp body
|
||||
| _ -> failwith "Bcc.compile_exp: TODO"
|
||||
and compile_block env items =
|
||||
let self = !sp in
|
||||
and compile_block env sp items =
|
||||
let self = sp in
|
||||
let sp = sp + 1 in
|
||||
|
||||
(* construct new env and vtable *)
|
||||
let elems = Hashtbl.create (List.length items * 2) in
|
||||
|
|
@ -97,40 +89,36 @@ let compile modl =
|
|||
emit (CON (self, vtable));
|
||||
let emit_set name rhs =
|
||||
let slot = (Env.find name env).slot in
|
||||
emit_mov (self + 2) rhs;
|
||||
emit_mov (self + 1) (Code.cst_of_int slot);
|
||||
emit (SET (self, self + 1))
|
||||
emit_mov sp (Code.cst_of_int slot);
|
||||
emit_mov (sp + 1) rhs;
|
||||
emit (SET (self, sp))
|
||||
in
|
||||
let final_exp =
|
||||
List.fold_left
|
||||
(fun _ -> function
|
||||
| Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
|
||||
| Ast.Item_exp e ->
|
||||
sp := self + 1;
|
||||
Some (compile_exp env e)
|
||||
| Ast.Item_exp exp -> Some (compile_exp env sp exp)
|
||||
| Ast.Item_obj (name, body) ->
|
||||
sp := self + 2;
|
||||
emit_set name (compile_obj env body);
|
||||
emit_set name (compile_obj env (sp + 1) body);
|
||||
None
|
||||
| Ast.Item_val (name, rhs) ->
|
||||
sp := self + 2;
|
||||
emit_set name (compile_exp env rhs);
|
||||
emit_set name (compile_exp env (sp + 1) rhs);
|
||||
None)
|
||||
None
|
||||
items
|
||||
in
|
||||
self, final_exp
|
||||
and compile_obj env items =
|
||||
let self, _ = compile_block env items in
|
||||
sp := self + 1;
|
||||
and compile_obj env sp items =
|
||||
let self, _ = compile_block env sp items in
|
||||
Code.Reg self
|
||||
and compile_scope env items =
|
||||
match compile_block env items with
|
||||
| _, None -> failwith "block must end with an expression"
|
||||
| _, Some ret -> ret
|
||||
and compile_scope env sp items =
|
||||
let _, final_exp = compile_block env sp items in
|
||||
match final_exp with
|
||||
| None -> failwith "block must end with an expression"
|
||||
| Some ret -> ret
|
||||
in
|
||||
|
||||
let env = Env.empty in
|
||||
emit_mov 0 (compile_obj env modl.Ast.items);
|
||||
emit_mov 0 (compile_obj env 0 modl.Ast.items);
|
||||
emit RET;
|
||||
Code.make_program ep
|
||||
|
|
|
|||
Loading…
Reference in New Issue