add code interpreter
This commit is contained in:
parent
ee5ca040c7
commit
fb8a2cdcab
|
@ -13,5 +13,11 @@ let () =
|
|||
in
|
||||
|
||||
let prog = Spice.Code.make_program ep in
|
||||
Fmt.pr "%a" Spice.Code.pp_program prog
|
||||
let ret = Spice.run prog in
|
||||
Fmt.pr
|
||||
"{\"program\":%a,\"output\":%a}"
|
||||
Spice.Code.pp_program
|
||||
prog
|
||||
Spice.Value.pp
|
||||
ret
|
||||
with Spice.Error msg -> Logs.err (fun m -> m "%s" msg)
|
||||
|
|
|
@ -40,6 +40,36 @@ type program = { entrypoint : basic_block }
|
|||
|
||||
let make_program entrypoint = { entrypoint }
|
||||
|
||||
let frame_size prog =
|
||||
let visited = ref [] in
|
||||
let work_list = ref [ prog.entrypoint ] in
|
||||
let enqueue bb = if not (List.memq bb !visited) then work_list := bb :: !work_list in
|
||||
let reg acc i = max acc (i + 1) in
|
||||
let op acc = function
|
||||
| Reg i -> reg acc i
|
||||
| _ -> acc
|
||||
in
|
||||
let ins acc = function
|
||||
| MOV (l, r) | ADD (l, r) | SUB (l, r) | MUL (l, r) -> op (reg acc l) r
|
||||
| BRT (v, b1, b2) ->
|
||||
enqueue b1;
|
||||
enqueue b2;
|
||||
op acc v
|
||||
| JMP b ->
|
||||
enqueue b;
|
||||
acc
|
||||
| RET -> acc
|
||||
in
|
||||
let rec loop acc =
|
||||
match !work_list with
|
||||
| [] -> acc
|
||||
| bb :: rest ->
|
||||
visited := bb :: !visited;
|
||||
work_list := rest;
|
||||
List.fold_left ins acc (instructions bb) |> loop
|
||||
in
|
||||
loop 1
|
||||
|
||||
(* pretty printing *)
|
||||
|
||||
let pp_reg ppf r = Fmt.pf ppf "$%d" r
|
||||
|
|
|
@ -0,0 +1,63 @@
|
|||
exception Runtime_error of string
|
||||
|
||||
module Op = struct
|
||||
let add v1 v2 =
|
||||
match v1, v2 with
|
||||
| Value.Int x, Value.Int y -> Value.Int (Int64.add x y)
|
||||
| _, _ -> raise (Runtime_error "cannot add non integer values")
|
||||
|
||||
let sub v1 v2 =
|
||||
match v1, v2 with
|
||||
| Value.Int x, Value.Int y -> Value.Int (Int64.sub x y)
|
||||
| _, _ -> raise (Runtime_error "cannot sub non integer values")
|
||||
|
||||
let mul v1 v2 =
|
||||
match v1, v2 with
|
||||
| Value.Int x, Value.Int y -> Value.Int (Int64.mul x y)
|
||||
| _, _ -> raise (Runtime_error "cannot mul non integer values")
|
||||
|
||||
let is_true = function
|
||||
| Value.True -> true
|
||||
| _ -> false
|
||||
end
|
||||
|
||||
type frame = {
|
||||
regs : Value.t array;
|
||||
mutable pc : Code.ins list;
|
||||
}
|
||||
|
||||
let make_frame prog =
|
||||
{
|
||||
regs = Array.make (Code.frame_size prog) Value.Nil;
|
||||
pc = Code.instructions Code.(prog.entrypoint);
|
||||
}
|
||||
|
||||
let return_value fr = fr.regs.(0)
|
||||
|
||||
let eval fr = function
|
||||
| Code.Cst_nil -> Value.Nil
|
||||
| Code.Cst_true -> Value.Nil
|
||||
| Code.Cst_false -> Value.Nil
|
||||
| Code.Cst_int n -> Value.Int n
|
||||
| Code.Reg i -> fr.regs.(i)
|
||||
|
||||
let exec fr = function
|
||||
| Code.MOV (l, r) -> fr.regs.(l) <- eval fr r
|
||||
| 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.RET -> fr.pc <- []
|
||||
| Code.JMP l -> fr.pc <- Code.instructions l
|
||||
| Code.BRT (v, l1, l2) ->
|
||||
if Value.equal (eval fr v) True then fr.pc <- Code.instructions l1
|
||||
else fr.pc <- Code.instructions l2
|
||||
|
||||
let rec run fr =
|
||||
match fr.pc with
|
||||
| [] -> return_value fr
|
||||
| is :: rest ->
|
||||
fr.pc <- rest;
|
||||
exec fr is;
|
||||
run fr
|
||||
|
||||
let run_program pr = run (make_frame pr)
|
|
@ -16,3 +16,7 @@ let parse input =
|
|||
let compile syn =
|
||||
try Spice_lower.Normalize.to_anf syn
|
||||
with Failure msg -> failf "compilation error: %s" msg
|
||||
|
||||
let run prog =
|
||||
try Spice_runtime.Interp.run_program prog
|
||||
with Spice_runtime.Interp.Runtime_error msg -> failf "runtime error: %s" msg
|
||||
|
|
Loading…
Reference in New Issue