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

refactor 'stack pointer' manip to be a parameter instead of a ref

This commit is contained in:
tali 2023-11-30 14:08:32 -05:00
parent fd3b356699
commit 32b3eda926
1 changed files with 43 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
lib/compile/bcc.ml
View File

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