rework the interpreted bc to resemble the prospective actual bc
This commit is contained in:
parent
12a519cfd7
commit
d66b336435
|
|
@ -7,7 +7,7 @@ exception Error of string
|
|||
let compile_error f =
|
||||
Fmt.kstr (fun msg -> raise (Error msg)) f
|
||||
|
||||
let off (Code.R i) k = Code.R (i + k)
|
||||
let off (`R i) k = `R (i + k)
|
||||
let suc r = off r 1
|
||||
|
||||
let undef_method =
|
||||
|
|
@ -31,87 +31,90 @@ let rec compile_lambda ?clos_map (lam : Ir.lambda) =
|
|||
Not_found -> Fmt.failwith "BUG: '%a' unassigned" Ir.pp_id id
|
||||
in
|
||||
|
||||
let rec emit_exp sp = function
|
||||
let rec emit_exp_v sp = function
|
||||
| Ir.Lit v ->
|
||||
`Cst v
|
||||
|
||||
| Ir.Var id ->
|
||||
get_reg id
|
||||
(get_reg id :> Code.arg)
|
||||
|
||||
| Ir.Let (id, rhs, bdy) ->
|
||||
emit_exp_s sp rhs;
|
||||
set_reg id sp;
|
||||
emit_exp (suc sp) bdy
|
||||
emit_exp_v (suc sp) bdy
|
||||
|
||||
| Ir.Seq (e1, e2) ->
|
||||
emit_exp sp e1 |> ignore;
|
||||
emit_exp sp e2
|
||||
emit_exp_v sp e1 |> ignore;
|
||||
emit_exp_v sp e2
|
||||
|
||||
| ir ->
|
||||
emit_exp_s sp ir;
|
||||
sp
|
||||
|
||||
and emit_exp_s sp = function
|
||||
| Ir.Lit im ->
|
||||
emit (LDI (sp, im))
|
||||
(sp :> Code.arg)
|
||||
|
||||
and emit_exp_s sp : Ir.exp -> unit = function
|
||||
| Ir.Get path ->
|
||||
let obj, loc = emit_path sp path in
|
||||
emit (GET (sp, obj, loc))
|
||||
let loc = emit_path sp path in
|
||||
emit (Get (sp, loc))
|
||||
|
||||
| Ir.Set (path, rhs) ->
|
||||
let obj, loc = emit_path sp path in
|
||||
let rv = emit_exp (suc sp) rhs in
|
||||
emit (SET (rv, obj, loc))
|
||||
let loc = emit_path sp path in
|
||||
let rv = emit_exp_v (suc sp) rhs in
|
||||
emit (Set (loc, rv))
|
||||
|
||||
| Ir.Seq (e1, e2) ->
|
||||
emit_exp sp e1 |> ignore;
|
||||
emit_exp_v sp e1 |> ignore;
|
||||
emit_exp_s sp e2
|
||||
|
||||
| Ir.If (e0, e1, e2) ->
|
||||
let b1 = Code.make_block () in
|
||||
let b2 = Code.make_block () in
|
||||
let b3 = Code.make_block () in
|
||||
let c = emit_exp sp e0 in
|
||||
emit (CBR (c, b1, b2));
|
||||
enter b1; emit_exp_s sp e1; emit (JMP b3);
|
||||
enter b2; emit_exp_s sp e2; emit (JMP b3);
|
||||
let c = emit_exp_v sp e0 in
|
||||
emit (Btr (c, b1, b2));
|
||||
enter b1; emit_exp_s sp e1; emit (Jmp b3);
|
||||
enter b2; emit_exp_s sp e2; emit (Jmp b3);
|
||||
enter b3
|
||||
|
||||
| Ir.Uop (op, e1) ->
|
||||
let r1 = emit_exp sp e1 in
|
||||
emit (match op with
|
||||
| Not -> NOT (sp, r1))
|
||||
let v1 = emit_exp_v sp e1 in
|
||||
let op = match op with Not -> Code.NOT in
|
||||
emit (Opr (op, sp, v1))
|
||||
|
||||
| Ir.Bop (op, e1, e2) ->
|
||||
let r1 = emit_exp sp e1 in
|
||||
let r2 = emit_exp (suc sp) e2 in
|
||||
emit (match op with
|
||||
| Add -> ADD (sp, r1, r2)
|
||||
| Sub -> SUB (sp, r1, r2)
|
||||
| Mul -> MUL (sp, r1, r2)
|
||||
| Div -> failwith "Bcc.compile_exp: TODO(Bop(Div))"
|
||||
| Mod -> failwith "Bcc.compile_exp: TODO(Bop(Mod))"
|
||||
| Eql -> EQL (sp, r1, r2)
|
||||
| Grt -> GRT (sp, r1, r2)
|
||||
| Lst -> LST (sp, r1, r2))
|
||||
let op = match op with
|
||||
| Add -> Code.ADD
|
||||
| Sub -> Code.SUB
|
||||
| Mul -> Code.MUL
|
||||
| Div -> Code.DIV
|
||||
| Mod -> Code.MOD
|
||||
| Eql -> Code.Cmp EQ
|
||||
| Grt -> Code.Cmp GT
|
||||
| Lst -> Code.Cmp LT
|
||||
in
|
||||
emit_exp_s sp e1;
|
||||
let v2 = emit_exp_v (suc sp) e2 in
|
||||
emit (Opr (op, sp, v2))
|
||||
|
||||
| Ir.Call (fn, args) ->
|
||||
let obj, mth = emit_path sp fn in
|
||||
let args =
|
||||
List.mapi
|
||||
(fun i arg ->
|
||||
let rv = off mth (i + 1) in
|
||||
emit_exp_s rv arg; rv)
|
||||
let fn = emit_path sp fn in
|
||||
let args_r, _ =
|
||||
List.fold_left
|
||||
(fun (args, sp) arg ->
|
||||
emit_exp_s sp arg;
|
||||
sp :: args, suc sp)
|
||||
([], suc sp)
|
||||
args
|
||||
in
|
||||
emit (CAL (sp, obj, mth, args))
|
||||
emit (Cal (sp, fn, List.rev args_r))
|
||||
|
||||
| Ir.Obj { vals; funs; clos } ->
|
||||
(* assign each captured id to a slot *)
|
||||
let clos_map = Hashtbl.create 64 in
|
||||
let n_slots =
|
||||
List.fold_left
|
||||
(fun n id ->
|
||||
Hashtbl.add clos_map id n;
|
||||
n + 1)
|
||||
(fun ofs id ->
|
||||
Hashtbl.add clos_map id (`Ofs ofs);
|
||||
ofs + 1)
|
||||
(List.length vals)
|
||||
clos
|
||||
in
|
||||
|
|
@ -132,46 +135,46 @@ let rec compile_lambda ?clos_map (lam : Ir.lambda) =
|
|||
funs;
|
||||
|
||||
(* construct object and save captured id's *)
|
||||
emit (CON (sp, { n_slots; elems; mthds }));
|
||||
let vtb : Code.vtable = { n_slots; elems; mthds } in
|
||||
emit (Con (sp, vtb));
|
||||
Hashtbl.iter
|
||||
(fun id idx ->
|
||||
let obj = sp in
|
||||
let loc = suc sp in
|
||||
emit (LDI (loc, Value.of_int idx));
|
||||
emit (SET (get_reg id, obj, loc)))
|
||||
(fun cap_id clos_ofs ->
|
||||
let cap_v = (get_reg cap_id :> Code.arg) in
|
||||
emit (Set ((sp, clos_ofs), cap_v)))
|
||||
clos_map
|
||||
|
||||
| Ir.Open id ->
|
||||
let idx = try Hashtbl.find (Option.get clos_map) id
|
||||
let clos = get_reg lam.self in
|
||||
let ofs = try Hashtbl.find (Option.get clos_map) id
|
||||
with Not_found -> failwith "BUG: %S not captured"
|
||||
| Invalid_argument _ -> failwith "BUG: no captured variables"
|
||||
in
|
||||
emit (LDI (sp, Value.of_int idx));
|
||||
emit (GET (sp, get_reg lam.self, sp))
|
||||
emit (Get (sp, (clos, ofs)))
|
||||
|
||||
| ir ->
|
||||
let rv = emit_exp sp ir in
|
||||
if rv <> sp then emit (LDR (sp, rv))
|
||||
let rv = emit_exp_v sp ir in
|
||||
if rv <> (sp :> Code.arg) then
|
||||
emit (Mov (sp, rv))
|
||||
|
||||
and emit_path sp (obj, fld) =
|
||||
let obj = get_reg obj in
|
||||
let loc = sp in
|
||||
emit (LOC (loc, obj, fld));
|
||||
obj, loc
|
||||
emit (Loc (loc, obj, fld));
|
||||
obj, (loc :> Code.ofs)
|
||||
|
||||
in
|
||||
|
||||
(* R0 = self *)
|
||||
(* R(i+1) = args[i] *)
|
||||
set_reg lam.self (Code.R 0);
|
||||
set_reg lam.self (`R 0);
|
||||
let sp =
|
||||
List.fold_left
|
||||
(fun sp arg -> set_reg arg sp; suc sp)
|
||||
(Code.R 1)
|
||||
(`R 1)
|
||||
lam.args
|
||||
in
|
||||
let rv = emit_exp sp lam.body in
|
||||
emit (RET rv);
|
||||
let rv = emit_exp_v sp lam.body in
|
||||
emit (Ret rv);
|
||||
|
||||
Code.make_funct
|
||||
(List.length lam.args)
|
||||
|
|
|
|||
|
|
@ -3,53 +3,50 @@ module Ast = Spice_syntax.Ast
|
|||
type imm = Value.t
|
||||
type vtable = Value.vtable
|
||||
|
||||
type reg = R of int [@@unboxed]
|
||||
type reg = [`R of int]
|
||||
type cst = [`Cst of Value.t]
|
||||
type arg = [reg | cst]
|
||||
type ofs = [reg | `Ofs of int]
|
||||
type loc = reg * ofs
|
||||
|
||||
type opr = NOT | NEG | ADD | SUB | MUL | DIV | MOD | Cmp of cnd
|
||||
and cnd = EQ | LT | GT
|
||||
(* and cnd = EQ | NE | LT | GE | GT | LE *)
|
||||
|
||||
type ins =
|
||||
(* registers *)
|
||||
| LDI of reg * imm
|
||||
| LDR of reg * reg
|
||||
(* arithmetic *)
|
||||
| ADD of reg * reg * reg
|
||||
| SUB of reg * reg * reg
|
||||
| MUL of reg * reg * reg
|
||||
(* comparison *)
|
||||
| LST of reg * reg * reg
|
||||
| GRT of reg * reg * reg
|
||||
| EQL of reg * reg * reg
|
||||
| NOT of reg * reg
|
||||
(* objects *)
|
||||
| GET of reg * reg * reg
|
||||
| SET of reg * reg * reg
|
||||
| LOC of reg * reg * string
|
||||
| CON of reg * vtable
|
||||
| CAL of reg * reg * reg * reg list
|
||||
(* control flow *)
|
||||
| RET of reg
|
||||
| JMP of block
|
||||
| CBR of reg * block * block
|
||||
| Mov of reg * arg
|
||||
| Opr of opr * reg * arg
|
||||
| Get of reg * loc
|
||||
| Set of loc * arg
|
||||
| Con of reg * vtable
|
||||
| Loc of reg * reg * string
|
||||
| Cal of reg * loc * reg list
|
||||
| Btr of arg * block * block
|
||||
| Jmp of block
|
||||
| Ret of arg
|
||||
|
||||
and block =
|
||||
{ mutable ins_list_rev : ins list }
|
||||
|
||||
let arg_regs = function
|
||||
| #reg as r -> [r]
|
||||
| #cst -> []
|
||||
|
||||
let loc_regs = function
|
||||
| (r1, (#reg as r2)) -> [r1; r2]
|
||||
| (r1, #ofs) -> [r1]
|
||||
|
||||
let registers = function
|
||||
| JMP _ -> []
|
||||
| RET r
|
||||
| LDI (r, _)
|
||||
| CON (r, _)
|
||||
| CBR (r, _, _) -> [r]
|
||||
| LDR (r1, r2)
|
||||
| NOT (r1, r2)
|
||||
| LOC (r1, r2, _) -> [r1; r2]
|
||||
| ADD (r1, r2, r3)
|
||||
| SUB (r1, r2, r3)
|
||||
| MUL (r1, r2, r3)
|
||||
| LST (r1, r2, r3)
|
||||
| GRT (r1, r2, r3)
|
||||
| EQL (r1, r2, r3)
|
||||
| GET (r1, r2, r3)
|
||||
| SET (r1, r2, r3) -> [r1; r2; r3]
|
||||
| CAL (r1, r2, r3, rs) -> r1::r2::r3::rs
|
||||
| Ret v
|
||||
| Btr (v, _, _) -> arg_regs v
|
||||
| Mov (r, v)
|
||||
| Opr (_, r, v) -> r :: arg_regs v
|
||||
| Get (r, l) -> r :: loc_regs l
|
||||
| Set (l, v) -> arg_regs v @ loc_regs l
|
||||
| Con (r, _) -> [r]
|
||||
| Loc (r1, r2, _) -> [r1; r2]
|
||||
| Cal (r, l, rs) -> loc_regs l @ r :: rs
|
||||
| Jmp _ -> []
|
||||
|
||||
let make_block () =
|
||||
{ ins_list_rev = [] }
|
||||
|
|
@ -78,8 +75,8 @@ let iter_blocks_df f b0 =
|
|||
the whole list is pointless. but just to be safe ... *)
|
||||
List.iter
|
||||
(function
|
||||
| JMP b1 -> enqueue b1
|
||||
| CBR (_, b1, b2) -> enqueue b1; enqueue b2
|
||||
| Jmp b1 -> enqueue b1
|
||||
| Btr (_, b1, b2) -> enqueue b1; enqueue b2
|
||||
| _ -> ())
|
||||
b.ins_list_rev;
|
||||
loop ()
|
||||
|
|
@ -103,7 +100,7 @@ let make_funct n_args entry =
|
|||
fsize :=
|
||||
List.rev_map registers b.ins_list_rev
|
||||
|> List.flatten
|
||||
|> List.fold_left (fun fs (R i) -> max fs (i + 1))
|
||||
|> List.fold_left (fun fs (`R i) -> max fs (i + 1))
|
||||
!fsize)
|
||||
entry;
|
||||
!fsize
|
||||
|
|
@ -113,7 +110,16 @@ let make_funct n_args entry =
|
|||
|
||||
(* pretty printing *)
|
||||
|
||||
let pp_reg ppf (R i) = Fmt.pf ppf "R%d" i
|
||||
let pp_reg ppf (`R i) =
|
||||
Fmt.pf ppf "R%d" i
|
||||
|
||||
let pp_arg ppf = function
|
||||
| #reg as r -> pp_reg ppf r
|
||||
| `Cst c -> Value.pp ppf c
|
||||
|
||||
let pp_loc ppf = function
|
||||
| (r, (#reg as i)) -> Fmt.pf ppf "%a[%a]" pp_reg r pp_reg i
|
||||
| (r, `Ofs ofs) -> Fmt.pf ppf "%a[%d]" pp_reg r ofs
|
||||
|
||||
let pp_vtable ~tbname ppf (vtb : vtable) =
|
||||
Fmt.pf ppf "%s(%d){" (tbname vtb) vtb.n_slots;
|
||||
|
|
@ -127,30 +133,38 @@ let pp_vtable ~tbname ppf (vtb : vtable) =
|
|||
vtb.elems;
|
||||
Fmt.pf ppf "}"
|
||||
|
||||
let string_of_opr = function
|
||||
| NOT -> "not"
|
||||
| NEG -> "neg"
|
||||
| ADD -> "add"
|
||||
| SUB -> "sub"
|
||||
| MUL -> "mul"
|
||||
| DIV -> "div"
|
||||
| MOD -> "mod"
|
||||
| Cmp EQ -> "ceq"
|
||||
| Cmp LT -> "clt"
|
||||
| Cmp GT -> "cgt"
|
||||
(* | Cmp NE -> "cne" *)
|
||||
(* | Cmp GE -> "cge" *)
|
||||
(* | Cmp LE -> "cle" *)
|
||||
|
||||
let pp_ins ~tbname ~label ppf = function
|
||||
| LDI (a, b) -> Fmt.pf ppf "mov %a, %s" pp_reg a (Value.to_string b)
|
||||
| LDR (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_reg b
|
||||
| ADD (a, b, c) -> Fmt.pf ppf "add %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| SUB (a, b, c) -> Fmt.pf ppf "sub %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| MUL (a, b, c) -> Fmt.pf ppf "mul %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| LST (a, b, c) -> Fmt.pf ppf "lst %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| GRT (a, b, c) -> Fmt.pf ppf "grt %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| EQL (a, b, c) -> Fmt.pf ppf "eql %a, %a, %a" pp_reg a pp_reg b pp_reg c
|
||||
| NOT (a, b) -> Fmt.pf ppf "not %a, %a" pp_reg a pp_reg b
|
||||
| GET (a, b, c) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg a pp_reg b pp_reg c
|
||||
| SET (a, b, c) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg b pp_reg c pp_reg a
|
||||
| LOC (a, b, el) -> Fmt.pf ppf "loc %a, %a.%s" pp_reg a pp_reg b el
|
||||
| CON (a, vt) -> Fmt.pf ppf "con %a, %a" pp_reg a (pp_vtable ~tbname) vt
|
||||
| CAL (a, b, c, ds) ->
|
||||
Fmt.pf ppf "cal %a, %a[%a](" pp_reg a pp_reg b pp_reg c;
|
||||
List.iteri (fun i d -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf d) ds;
|
||||
Fmt.pf ppf ")"
|
||||
| RET a -> Fmt.pf ppf "ret %a" pp_reg a
|
||||
| JMP b -> Fmt.pf ppf "jmp %s" (label b)
|
||||
| CBR (a, b1, b2) ->
|
||||
| Mov (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_arg b
|
||||
| Opr (o, a, b) -> Fmt.pf ppf "%s %a, %a" (string_of_opr o) pp_reg a pp_arg b
|
||||
| Get (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_loc b
|
||||
| Set (a, b) -> Fmt.pf ppf "mov %a, %a" pp_loc a pp_arg b
|
||||
| Con (a, vtb) -> Fmt.pf ppf "con %a, %a" pp_reg a (pp_vtable ~tbname) vtb
|
||||
| Loc (a, b, nam) -> Fmt.pf ppf "loc %a, %a.<%s>" pp_reg a pp_reg b nam
|
||||
| Jmp b -> Fmt.pf ppf "jmp %s" (label b)
|
||||
| Ret a -> Fmt.pf ppf "ret %a" pp_arg a
|
||||
| Btr (a, b1, b2) ->
|
||||
let l1 = label b1 in
|
||||
let l2 = label b2 in
|
||||
Fmt.pf ppf "cbr %a, %s, %s" pp_reg a l1 l2
|
||||
Fmt.pf ppf "btr %a, %s, %s" pp_arg a l1 l2
|
||||
| Cal (a, f, args) ->
|
||||
Fmt.pf ppf "cal %a, %a(" pp_reg a pp_loc f;
|
||||
List.iteri (fun i d -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf d) args;
|
||||
Fmt.pf ppf ")"
|
||||
|
||||
let dump ?(recursive = true) println main_fn =
|
||||
let tbqueue = ref [] in
|
||||
|
|
|
|||
|
|
@ -33,21 +33,21 @@ module Prim = struct
|
|||
with
|
||||
Not_found -> runtime_error "no such element %S" name
|
||||
|
||||
let get obj loc =
|
||||
let get (obj, loc) =
|
||||
match obj, Value.to_elem loc with
|
||||
| Value.Obj (_, s), Field i -> s.(i)
|
||||
| Value.Obj (_, _), Method _ -> failwith "Interp.Prim.get: TODO: fcf"
|
||||
| exception Invalid_argument _ -> runtime_error "invalid index"
|
||||
| _ -> runtime_error "get field of non-object"
|
||||
|
||||
let set obj loc v =
|
||||
let set (obj, loc) v =
|
||||
match obj, Value.to_elem loc with
|
||||
| Value.Obj (_, s), Field i -> s.(i) <- v
|
||||
| Value.Obj (_, _), Method _ -> runtime_error "cannot reassign method"
|
||||
| exception Invalid_argument _ -> runtime_error "invalid index"
|
||||
| _ -> runtime_error "set field of non-object"
|
||||
|
||||
let mthd obj loc =
|
||||
let mthd (obj, loc) =
|
||||
match obj, Value.to_elem loc with
|
||||
| Value.Obj (vtable, _), Method i -> obj, vtable.mthds.(i)
|
||||
| Value.Obj (_, _), Field _ -> failwith "Interp.Prim.mthd: TODO: fcf"
|
||||
|
|
@ -58,37 +58,51 @@ module Prim = struct
|
|||
end
|
||||
|
||||
type frame = {
|
||||
r : Value.t array;
|
||||
rg : Value.t array;
|
||||
mutable pc : Code.ins list;
|
||||
mutable rv : Value.t;
|
||||
}
|
||||
|
||||
let jmp fr b = fr.pc <- Code.instructions b
|
||||
|
||||
let rec exec ({ r; _ } as fr) = function
|
||||
| Code.LDI (R a, v) -> r.(a) <- v
|
||||
| Code.LDR (R a, R b) -> r.(a) <- r.(b)
|
||||
| Code.ADD (R a, R b, R c) -> r.(a) <- Prim.add r.(b) r.(c)
|
||||
| Code.SUB (R a, R b, R c) -> r.(a) <- Prim.sub r.(b) r.(c)
|
||||
| Code.MUL (R a, R b, R c) -> r.(a) <- Prim.mul r.(b) r.(c)
|
||||
| Code.LST (R a, R b, R c) -> r.(a) <- Prim.lst r.(b) r.(c)
|
||||
| Code.GRT (R a, R b, R c) -> r.(a) <- Prim.grt r.(b) r.(c)
|
||||
| Code.NOT (R a, R b) -> r.(a) <- Prim.not r.(b)
|
||||
| Code.EQL (R a, R b, R c) -> r.(a) <- Prim.eql r.(b) r.(c)
|
||||
| Code.GET (R a, R b, R c) -> r.(a) <- Prim.get r.(b) r.(c)
|
||||
| Code.SET (R a, R b, R c) -> Prim.set r.(b) r.(c) r.(a)
|
||||
| Code.LOC (R a, R b, el) -> r.(a) <- Prim.loc r.(b) el
|
||||
| Code.CON (R a, vtbl) -> r.(a) <- Value.make_obj vtbl
|
||||
| Code.CAL (R a, R b, R c, args) ->
|
||||
let obj, mthd = Prim.mthd r.(b) r.(c) in
|
||||
let args = List.map (fun (Code.R i) -> r.(i)) args in
|
||||
r.(a) <- call mthd obj args
|
||||
| Code.JMP b -> jmp fr b
|
||||
| Code.CBR (R a, b1, b2) ->
|
||||
jmp fr (if Value.truthy r.(a) then b1 else b2)
|
||||
| Code.RET (R a) ->
|
||||
fr.rv <- r.(a);
|
||||
fr.pc <- []
|
||||
let get fr (`R a) = fr.rg.(a)
|
||||
let set fr (`R a) b = fr.rg.(a) <- b
|
||||
let arg fr = function
|
||||
| #Code.reg as r -> get fr r
|
||||
| `Cst v -> v
|
||||
|
||||
let opr = function
|
||||
| Code.ADD -> Prim.add
|
||||
| Code.SUB -> Prim.sub
|
||||
| Code.MUL -> Prim.mul
|
||||
| Code.DIV -> failwith "Interp: TODO(DIV)"
|
||||
| Code.MOD -> Prim.add
|
||||
| Code.NOT -> fun _ v -> Prim.not v
|
||||
| Code.NEG -> failwith "Interp: TODO(NEG)"
|
||||
| Code.Cmp EQ -> Prim.eql
|
||||
| Code.Cmp GT -> Prim.grt
|
||||
| Code.Cmp LT -> Prim.lst
|
||||
|
||||
let loc fr = function
|
||||
| a, (#Code.reg as b) -> get fr a, get fr b
|
||||
| a, (`Ofs ofs) -> get fr a, Value.of_int ofs
|
||||
|
||||
let rec exec fr = function
|
||||
| Code.Mov (a, b) -> set fr a (arg fr b)
|
||||
| Code.Opr (op, a, b) -> set fr a (opr op (get fr a) (arg fr b))
|
||||
| Code.Get (a, bc) -> set fr a (Prim.get (loc fr bc))
|
||||
| Code.Set (bc, a) -> Prim.set (loc fr bc) (arg fr a)
|
||||
| Code.Loc (a, b, nam) -> set fr a (Prim.loc (get fr b) nam)
|
||||
| Code.Con (a, vtb) -> set fr a (Value.make_obj vtb)
|
||||
| Code.Jmp bl -> jmp fr bl
|
||||
| Code.Btr (a, bl1, bl2) ->
|
||||
jmp fr (if Value.truthy (arg fr a) then bl1 else bl2)
|
||||
| Code.Ret a ->
|
||||
fr.rv <- arg fr a
|
||||
| Code.Cal (a, f, args) ->
|
||||
let obj, mthd = Prim.mthd (loc fr f) in
|
||||
let args = List.map (arg fr) args in
|
||||
set fr a (call mthd obj args)
|
||||
|
||||
and call mthd self args =
|
||||
match mthd with
|
||||
|
|
@ -109,11 +123,11 @@ and run fn self args =
|
|||
runtime_error "wrong number of arguments, expected %d, got %d"
|
||||
n_args (List.length args);
|
||||
|
||||
let r = Array.make frame_size Value.Nil in
|
||||
r.(0) <- self;
|
||||
List.iteri (fun i v -> r.(i + 1) <- v) args;
|
||||
let rg = Array.make frame_size Value.Nil in
|
||||
rg.(0) <- self;
|
||||
List.iteri (fun i v -> rg.(i + 1) <- v) args;
|
||||
|
||||
let fr = { r; pc = []; rv = Nil } in
|
||||
let fr = { rg; pc = []; rv = Nil } in
|
||||
jmp fr entry;
|
||||
step fr;
|
||||
fr.rv
|
||||
|
|
|
|||
Loading…
Reference in New Issue