From 5c5e3c8a6ea208746e33ce35782a83d6e86fbc0b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 26 Nov 2018 20:40:21 +0200
Subject: [PATCH 01/22] thinking about how to generate breakpoints for jit

---
 interpreter/merkle/secretstack.ml | 47 +++++++++++++++++++++++++++----
 1 file changed, 42 insertions(+), 5 deletions(-)

diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 5987698..6c64eb5 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -73,6 +73,27 @@ let una_stack id x = {x with stack=id::popn 1 x.stack}
 let bin_stack id x = {x with stack=id::popn 2 x.stack}
 let n_stack n id x = {x with stack=id::popn n x.stack}
 
+let info = Hashtbl.create 100
+
+let rec gen n a = if n = 0 then [] else a (n-1) :: gen (n-1) a
+
+let generate_entry id_to_local (lst, others) =
+   let open Merkle in
+   let stack_size = List.length lst + others in
+   (* others will have to be moved to make space *)
+   let n = List.length lst in
+   gen n (fun i -> DUP 1) @ (* fillers *)
+   gen others (fun i -> DUP (others-i+n+1)) @ (* this should copy the others *)
+   List.flatten (List.mapi (fun i id -> [DUP (stack_size + List.assoc id_to_local id); SWAP (stack_size-i); DROP 1]) lst) (* access local variable, then write to filled location *)
+
+let generate_exit id_to_local (lst, others) =
+   let open Merkle in
+   let stack_size = List.length lst + others in
+   (* others will have to be moved over the hidden variables *)
+   let n = List.length lst in
+   List.flatten (gen others (fun i -> [DUP (others-i+1); SWAP (others-i+1+n); DROP 1])) @ (* this should copy the others *)
+   [DROP others]
+
 let rec compile marked (ctx : context) expr = compile' marked ctx (Int32.of_int expr.at.right.line) expr.it
 and compile' marked ctx id = function
  | Block (ty, lst) ->
@@ -90,7 +111,13 @@ and compile' marked ctx id = function
  | Loop (_, lst) ->
    let old_return = ctx.block_return in
    let extra = ctx.ptr - ctx.locals in
-   if extra > 0 then trace ("loop start " ^ string_of_int extra);
+   (* we should mark the extra here, too *)
+   if extra > 0 then begin
+      trace ("loop start " ^ string_of_int extra);
+      let hidden = take extra ctx.stack in
+      marked := hidden @ !marked;
+      Hashtbl.add info id (marked, 0);
+   end;
    let ctx = {ctx with bptr=ctx.bptr+1; block_return={level=ctx.ptr; rets=0}::old_return} in
    let ctx = compile_block marked ctx lst in
    if extra > 0 then trace ("loop end " ^ string_of_int extra);
@@ -99,14 +126,22 @@ and compile' marked ctx id = function
    (* Will just push the pc *)
    let FuncType (par,ret) = Hashtbl.find ctx.f_types v.it in
    let extra = ctx.ptr - ctx.locals - List.length par in
-   if extra > 0 then trace ("call " ^ string_of_int extra);
-   marked := (take extra (popn (List.length par) ctx.stack)) @ !marked;
+   if extra > 0 then begin
+      trace ("call " ^ string_of_int extra);
+      let hidden = take extra (popn (List.length par) ctx.stack) in
+      marked := hidden @ !marked;
+      Hashtbl.add info id (marked, List.length par);
+   end;
    {ctx with ptr=ctx.ptr+List.length ret-List.length par; stack=make id (List.length ret) @ popn (List.length par) ctx.stack}
  | CallIndirect v ->
    let FuncType (par,ret) = Hashtbl.find ctx.f_types2 v.it in
    let extra = ctx.ptr - ctx.locals - List.length par - 1 in
-   if extra > 0 then trace ("calli " ^ string_of_int extra);
-   marked := (take extra (popn (List.length par+1) ctx.stack)) @ !marked;
+   if extra > 0 then begin
+      trace ("calli " ^ string_of_int extra);
+      let hidden = take extra (popn (List.length par+1) ctx.stack) in
+      marked := hidden @ !marked;
+      Hashtbl.add info id (marked, List.length par+1);
+   end;
    {ctx with ptr=ctx.ptr+List.length ret-List.length par-1; stack=make id (List.length ret) @ popn (List.length par + 1) ctx.stack}
  | If (ty, texp, fexp) ->
    let a_ptr = ctx.ptr-1 in
@@ -179,6 +214,7 @@ let compile_func ctx func =
   let func = do_it func (fun f -> {f with body=relabel f.body}) in
   let res = assoc_types (Valid.func_context ctx.tctx func) func in
   let marked = ref [] in
+  Hashtbl.clear info;
   let ctx = compile' marked {ctx with ptr=locals; locals=locals} 0l (Block (ret, func.it.body)) in
   (* find types for marked expressions *)
   let find_type expr =
@@ -187,6 +223,7 @@ let compile_func ctx func =
       | _ -> trace ("Warning: empty type") ; raise Not_found
      with Not_found -> ( trace ("Warning: cannot find type") ; I32Type)
      in
+  (* Association list from expression ids to local variables *)
   let marked = List.mapi (fun i x -> x, (find_type x, {it=Int32.of_int (i+locals); at=no_region})) !marked in
   trace ("---- function end " ^ string_of_int ctx.ptr);
   do_it func (fun f -> {f with locals=f.locals@List.map (fun (_,(t,_)) -> t) marked; body=tee_locals marked func})

From a70fe05a39e978dbea1c3927d887389a633da023 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Tue, 27 Nov 2018 08:46:27 +0200
Subject: [PATCH 02/22] refactored some utils into a file

---
 interpreter/main/main.ml          |   2 +-
 interpreter/merkle/addglobals.ml  |   2 +-
 interpreter/merkle/buildstack.ml  |   9 +-
 interpreter/merkle/critical.ml    |   7 +-
 interpreter/merkle/floaterror.ml  |   4 +-
 interpreter/merkle/intfloat.ml    |   6 +-
 interpreter/merkle/merge.ml       |  18 ++--
 interpreter/merkle/merkle.ml      | 165 +++---------------------------
 interpreter/merkle/mproof.ml      |   4 +-
 interpreter/merkle/mrun.ml        |   1 +
 interpreter/merkle/secretstack.ml |  45 +-------
 interpreter/merkle/shiftmem.ml    |   4 +-
 interpreter/merkle/stacksize.ml   |  14 ++-
 13 files changed, 48 insertions(+), 233 deletions(-)

diff --git a/interpreter/main/main.ml b/interpreter/main/main.ml
index 69c45a6..a1225d3 100644
--- a/interpreter/main/main.ml
+++ b/interpreter/main/main.ml
@@ -294,7 +294,7 @@ let () =
     | true, m :: _ ->
       let open Source in
       let open Ast in
-      let lst = Merkle.func_imports m in
+      let lst = Sourceutil.func_imports m in
       let import_name n = "[\"" ^ Utf8.encode n.it.module_name ^ "\",\"" ^ Utf8.encode n.it.item_name ^ "\"]" in
       Printf.printf "[%s]\n" (String.concat ", " (List.map import_name lst))
     | _ -> () );
diff --git a/interpreter/merkle/addglobals.ml b/interpreter/merkle/addglobals.ml
index 341783f..e2b5266 100644
--- a/interpreter/merkle/addglobals.ml
+++ b/interpreter/merkle/addglobals.ml
@@ -4,7 +4,7 @@ open Merge
 open Ast
 open Types
 open Source
-open Merkle
+open Sourceutil
 
 (* remap function calls *)
 let rec remap_func' map gmap gmap2 ftmap = function
diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index da66223..1aadc99 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -13,10 +13,7 @@ open Ast
 open Source
 open Types
 open Values
-
-let do_it x f = {x with it=f x.it}
-
-let it e = {it=e; at=no_region}
+open Sourceutil
 
 type ctx = {
   tctx : Valid.context;
@@ -211,7 +208,7 @@ let list_to_map lst =
 let process m =
   do_it m (fun m ->
     (* add function types *)
-    let i_num = List.length (Merkle.func_imports (it m)) in
+    let i_num = List.length (func_imports (it m)) in
     let ftypes = m.types @ [
       it (FuncType ([], [I32Type]));
       it (FuncType ([I32Type; I32Type], []));
@@ -264,7 +261,7 @@ let process m =
             globals=m.globals @ [it {gtype=GlobalType (I64Type, Mutable); value=it [it (Const (it (I64 0L)))]}];
             exports=List.map (Merge.remap_export remap (fun x -> x) (fun x -> x) "") m.exports;
             elems=List.map (Merge.remap_elements remap) m.elems; } in
-    let ftab, ttab = Merkle.make_tables pre_m in
+    let ftab, ttab = make_tables pre_m in
     let ctx = {
       g64 = it (Int32.of_int (List.length m.globals));
       tctx = Valid.module_context (it pre_m);
diff --git a/interpreter/merkle/critical.ml b/interpreter/merkle/critical.ml
index bff8e89..4a4e5e3 100644
--- a/interpreter/merkle/critical.ml
+++ b/interpreter/merkle/critical.ml
@@ -3,10 +3,7 @@ open Ast
 open Source
 open Types
 open Values
-
-let do_it x f = {x with it=f x.it}
-
-let it e = {it=e; at=no_region}
+open Sourceutil
 
 (*
 type ctx = {
@@ -48,7 +45,7 @@ let process_function ctx f =
 let process m =
   do_it m (fun m ->
     (* add function types *)
-    let i_num = List.length (Merkle.func_imports (it m)) in
+    let i_num = List.length (func_imports (it m)) in
     let ftypes = m.types @ [
        it (FuncType ([], [I32Type]));
        it (FuncType ([I32Type], []));
diff --git a/interpreter/merkle/floaterror.ml b/interpreter/merkle/floaterror.ml
index 91085aa..439eeb7 100644
--- a/interpreter/merkle/floaterror.ml
+++ b/interpreter/merkle/floaterror.ml
@@ -4,9 +4,7 @@ open Source
 open Ast
 open Types
 open Values
-open Merkle 
-
-let do_it x f = {x with it=f x.it}
+open Sourceutil
 
 let process m =
   let rec convert_op' = function
diff --git a/interpreter/merkle/intfloat.ml b/interpreter/merkle/intfloat.ml
index 7920bc5..aecae36 100644
--- a/interpreter/merkle/intfloat.ml
+++ b/interpreter/merkle/intfloat.ml
@@ -3,17 +3,15 @@ open Source
 open Ast
 open Types
 open Values
-open Merkle 
+open Sourceutil
 
 (* just simply merge two files *)
 
-let do_it x f = {x with it=f x.it}
-
 let simple_add n i = Int32.add i (Int32.of_int n)
 
 let merge a b =
   let funcs_a = a.it.funcs in
-  let num = List.length (Merkle.func_imports a) + List.length funcs_a in
+  let num = List.length (func_imports a) + List.length funcs_a in
   let num_ft = List.length a.it.types in
   let funcs_b = List.map (Merge.remap (simple_add num) (fun x -> x) (simple_add num_ft)) b.it.funcs in
   {a with it={(a.it) with funcs = funcs_a@funcs_b;
diff --git a/interpreter/merkle/merge.ml b/interpreter/merkle/merge.ml
index 0e8ec67..3564f3b 100644
--- a/interpreter/merkle/merge.ml
+++ b/interpreter/merkle/merge.ml
@@ -1,7 +1,7 @@
 
 open Ast
 open Source
-open Merkle
+open Sourceutil
 
 (* remap function calls *)
 let rec remap_func' map gmap ftmap = function
@@ -97,13 +97,13 @@ let merge a b =
       let loc = Int32.of_int (List.length !imports) in
       Hashtbl.add map (Int32.of_int num) loc;
       imports := imp :: !imports;
-      Run.trace ("Got import " ^ name ^ ", linked to " ^ Int32.to_string loc);
+      trace ("Got import " ^ name ^ ", linked to " ^ Int32.to_string loc);
 (*      if name = "_env__llvm_bswap_i64" || (String.length name > 11 && String.sub name 0 11 = "_env_invoke") then () else *)
       Hashtbl.add taken_cur name loc;
       Hashtbl.add taken name loc
     end else begin
       let loc = Hashtbl.find taken name in
-      Run.trace ("Dropping import " ^ name ^ ", linked to " ^ Int32.to_string loc);
+      trace ("Dropping import " ^ name ^ ", linked to " ^ Int32.to_string loc);
       Hashtbl.add map (Int32.of_int num) loc
     end in
   (* first just have to calculate total number of imports *)
@@ -115,7 +115,7 @@ let merge a b =
   List.iteri (fun n x -> add_import taken_globals taken_imports_b g_imports gmap2 n x) (global_imports b);
   let num_f = List.length !f_imports in
   let num_g = List.length !g_imports in
-  Run.trace ("Function imports: " ^ string_of_int num_f ^ "; Global imports: " ^ string_of_int num_g);
+  trace ("Function imports: " ^ string_of_int num_f ^ "; Global imports: " ^ string_of_int num_g);
   (* now can calculate the export positions *)
   let taken_imports = Hashtbl.create 10 in
   let taken_imports_a = Hashtbl.create 10 in
@@ -140,8 +140,8 @@ let merge a b =
   f_imports := [];
   List.iteri (fun n x -> add_import taken_imports taken_imports_a f_imports map1 n x) imports_a;
   List.iteri (fun n x -> add_import taken_imports taken_imports_b f_imports map2 n x) imports_b;
-  Run.trace ("Function imports: " ^ string_of_int num_f ^ "; Global imports: " ^ string_of_int num_g);
-  Run.trace ("Functions A: " ^ string_of_int (List.length a.it.funcs) ^ "; Functions B: " ^ string_of_int (List.length b.it.funcs));
+  trace ("Function imports: " ^ string_of_int num_f ^ "; Global imports: " ^ string_of_int num_g);
+  trace ("Functions A: " ^ string_of_int (List.length a.it.funcs) ^ "; Functions B: " ^ string_of_int (List.length b.it.funcs));
   (* add remapping for functions *)
   List.iteri (fun i _ ->
     Hashtbl.add map1 (Int32.of_int (i + num_fa)) (Int32.of_int (i + num_fa + offset_a))) a.it.funcs;
@@ -149,10 +149,10 @@ let merge a b =
     Hashtbl.add map2 (Int32.of_int (i + num_fb)) (Int32.of_int (i + num_fb + offset_b))) b.it.funcs;
   (* add remapping for globals *)
   List.iteri (fun i _ ->
-    Run.trace ("global " ^ string_of_int i ^ " -> " ^ string_of_int (i + num_ga + offset_ga));
+    trace ("global " ^ string_of_int i ^ " -> " ^ string_of_int (i + num_ga + offset_ga));
     Hashtbl.add gmap1 (Int32.of_int (i + num_ga)) (Int32.of_int (i + num_ga + offset_ga))) a.it.globals;
   List.iteri (fun i _ ->
-    Run.trace ("global " ^ string_of_int i ^ " -> " ^ string_of_int (i + num_gb + offset_gb));
+    trace ("global " ^ string_of_int i ^ " -> " ^ string_of_int (i + num_gb + offset_gb));
     Hashtbl.add gmap2 (Int32.of_int (i + num_gb)) (Int32.of_int (i + num_gb + offset_gb))) b.it.globals;
   (* remap exports *)
   let exports_a = List.map (remap_export (Hashtbl.find map1) (Hashtbl.find gmap1) ftmap1 "") a.it.exports in
@@ -162,7 +162,7 @@ let merge a b =
   let funcs_b = List.map (remap (Hashtbl.find map2) (Hashtbl.find gmap2) ftmap2) b.it.funcs in
   let more_imports = other_imports a @ List.filter drop_table_import (other_imports b) in
   (* table elements have to be remapped *)
-  Run.trace ("Remapping globals");
+  trace ("Remapping globals");
   {a with it={(a.it) with funcs = funcs_a@funcs_b;
      globals = List.map (remap_global (Hashtbl.find map1) (Hashtbl.find gmap1) ftmap1) a.it.globals @
                List.map (remap_global (Hashtbl.find map2) (Hashtbl.find gmap2) ftmap2) b.it.globals;
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index f8291e5..4690c03 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -5,6 +5,7 @@ open Ast
 open Source
 open Types
 open Values
+open Sourceutil
 
 let (@) a b = List.rev_append (List.rev a) b
 
@@ -15,65 +16,12 @@ let _ =
   Hashtbl.add custom_calls "_readBlock" 1;
   Hashtbl.add custom_calls "_internalStep" 2
 
-let trace = Byteutil.trace
-
 (* perhaps we need to link the modules first *)
 
 (* have a separate call stack? *)
 
 (* perhaps the memory will include the stack? nope *)
 
-let value_bool v = not (v = I32 0l || v = I64 0L)
-
-let value_to_int = function
- | I32 i -> Int32.to_int i
- | I64 i -> Int64.to_int i
- | _ -> 0
-
-let value_to_int64 = function
- | I32 i -> Int64.of_int32 i
- | I64 i -> i
- | _ -> 0L
-
-let i x = I32 (Int32.of_int x)
-
-let is_float_op = function
- | I32 _ | I64 _ -> false
- | _ -> true
-
-let req_type = function
- | I32 I32Op.ExtendSI32 -> I32Type
- | I32 I32Op.ExtendUI32 -> I32Type
- | I32 I32Op.WrapI64 -> I64Type
- | I32 I32Op.TruncSF32 -> F32Type
- | I32 I32Op.TruncUF32 -> F32Type
- | I32 I32Op.TruncSF64 -> F64Type
- | I32 I32Op.TruncUF64 -> F64Type
- | I32 I32Op.ReinterpretFloat -> F32Type
- | I64 I64Op.ExtendSI32 -> I32Type
- | I64 I64Op.ExtendUI32 -> I32Type
- | I64 I64Op.WrapI64 -> I64Type
- | I64 I64Op.TruncSF32 -> F32Type
- | I64 I64Op.TruncUF32 -> F32Type
- | I64 I64Op.TruncSF64 -> F64Type
- | I64 I64Op.TruncUF64 -> F64Type
- | I64 I64Op.ReinterpretFloat -> F64Type
- | F32 F32Op.ConvertSI32 -> I32Type
- | F32 F32Op.ConvertUI32 -> I32Type
- | F32 F32Op.ConvertSI64 -> I64Type
- | F32 F32Op.ConvertUI64 -> I64Type
- | F32 F32Op.PromoteF32 -> F32Type
- | F32 F32Op.DemoteF64 -> F64Type
- | F32 F32Op.ReinterpretInt -> I32Type
- 
- | F64 F64Op.ConvertSI32 -> I32Type
- | F64 F64Op.ConvertUI32 -> I32Type
- | F64 F64Op.ConvertSI64 -> I64Type
- | F64 F64Op.ConvertUI64 -> I64Type
- | F64 F64Op.PromoteF32 -> F32Type
- | F64 F64Op.DemoteF64 -> F64Type
- | F64 F64Op.ReinterpretInt -> I64Type
-
 type inst =
  | EXIT
  | UNREACHABLE
@@ -137,8 +85,6 @@ type context = {
 
 (* Push the break points to stack? they can have own stack, also returns will have the same *)
 
-let rec make a n = if n = 0 then [] else a :: make a (n-1) 
-
 let rec adjust_stack_aux diff num =
   if num = 0 then [] else
   begin
@@ -285,12 +231,6 @@ and compile_block ctx = function
 
 (* Initialize local variables with correct types *)
 
-let type_to_str = function
- | I32Type -> "i32"
- | I64Type -> "i64"
- | F32Type -> "f32"
- | F64Type -> "f64"
-
 let find_export_name m num =
   let rec get_exports = function
    | [] -> "internal function"
@@ -348,92 +288,6 @@ let resolve_inst2 tab = function
 
 let empty_ctx mdle = {ptr=0; label=0; bptr=0; block_return=[]; f_types2=Hashtbl.create 1; f_types=Hashtbl.create 1; mdle}
 
-let make_tables m =
-  let ftab = Hashtbl.create 10 in
-  let ttab = Hashtbl.create 10 in
-  List.iteri (fun i f -> Hashtbl.add ttab (Int32.of_int i) f.it) m.types;
-  let rec get_imports i = function
-   | [] -> []
-   | {it=im; _} :: tl ->
-     match im.idesc.it with
-     | FuncImport tvar ->
-        let ty = Hashtbl.find ttab tvar.it in
-        Hashtbl.add ftab (Int32.of_int i) ty;
-        im :: get_imports (i+1) tl
-     | _ -> get_imports i tl in
-  let f_imports = get_imports 0 m.imports in
-  let num_imports = List.length f_imports in
-  List.iteri (fun i f ->
-    let ty = Hashtbl.find ttab f.it.ftype.it in
-    Hashtbl.add ftab (Int32.of_int (i + num_imports)) ty) m.funcs;
-  ftab, ttab
-
-let elem x = {it=x; at=no_region}
-
-let func_imports m =
-  let rec do_get = function
-   | [] -> []
-   | ({it={idesc={it=FuncImport _;_};_};_} as el)::tl -> el :: do_get tl
-   | _::tl -> do_get tl in
-  do_get m.it.imports
-
-let global_imports m =
-  let rec do_get = function
-   | [] -> []
-   | ({it={idesc={it=GlobalImport _;_};_};_} as el)::tl -> el :: do_get tl
-   | _::tl -> do_get tl in
-  do_get m.it.imports
-
-let other_imports m =
-  let rec do_get = function
-   | [] -> []
-   | {it={idesc={it=FuncImport _;_};_};_}::tl -> do_get tl
-   | {it={idesc={it=GlobalImport _;_};_};_}::tl -> do_get tl
-   | el::tl -> el :: do_get tl in
-  do_get m.it.imports
-
-let other_imports_nomem m =
-  let rec do_get = function
-   | [] -> []
-   | {it={idesc={it=FuncImport _;_};_};_}::tl -> do_get tl
-   | {it={idesc={it=GlobalImport _;_};_};_}::tl -> do_get tl
-   | {it={idesc={it=MemoryImport _;_};_};_}::tl -> do_get tl
-   | el::tl -> el :: do_get tl in
-  do_get m.it.imports
-
-let find_function m func =
-  let ftab = Hashtbl.create 10 in
-  let ttab = Hashtbl.create 10 in
-  List.iteri (fun i f -> Hashtbl.add ttab (Int32.of_int i) f.it) m.types;
-  let rec get_imports i = function
-   | [] -> []
-   | {it=im; _} :: tl ->
-     match im.idesc.it with
-     | FuncImport tvar ->
-        let ty = Hashtbl.find ttab tvar.it in
-        Hashtbl.add ftab (Int32.of_int i) ty;
-        im :: get_imports (i+1) tl
-     | _ -> get_imports i tl in
-  let num_imports = List.length (get_imports 0 m.imports) in
-  let entry = ref (-1) in
-  List.iteri (fun i f ->
-    if f = func then ( entry := i + num_imports )) m.funcs;
-  !entry
-
-let find_function_index m inst name =
-  ( match Instance.export inst name with
-  | Some (Instance.ExternalFunc (Instance.AstFunc (_, func))) -> find_function m func
-  | _ -> raise Not_found )
-
-let find_global_index m inst name =
-  let num_imports = 0l (* Int32.of_int (List.length (global_imports m)) *) in
-  let rec get_exports = function
-   | [] -> trace ("Cannot Find global: " ^ Utf8.encode name); raise Not_found
-   | {it=im; _} :: tl ->
-     match im.edesc.it with
-     | GlobalExport tvar -> if im.name = name then Int32.add tvar.it num_imports else get_exports tl
-     | _ -> get_exports tl in
-  Int32.to_int (get_exports m.it.exports)
 
 let malloc_string mdle malloc str =
   let open Memory in
@@ -551,7 +405,20 @@ let flatten_tl lst =
   | a::tl -> do_flatten (a @ acc) tl in
   do_flatten [] (List.rev lst)
 
-let kludge = ref (fun m -> 1)
+let generate_entry id_to_local (lst, others) =
+   let stack_size = List.length lst + others in
+   (* others will have to be moved to make space *)
+   let n = List.length lst in
+   gen n (fun i -> DUP 1) @ (* fillers *)
+   gen others (fun i -> DUP (others-i+n+1)) @ (* this should copy the others *)
+   List.flatten (List.mapi (fun i id -> [DUP (stack_size + List.assoc id_to_local id); SWAP (stack_size-i); DROP 1]) lst) (* access local variable, then write to filled location *)
+
+let generate_exit id_to_local (lst, others) =
+   let stack_size = List.length lst + others in
+   (* others will have to be moved over the hidden variables *)
+   let n = List.length lst in
+   List.flatten (gen others (fun i -> [DUP (others-i+1); SWAP (others-i+1+n); DROP 1])) @ (* this should copy the others *)
+   [DROP others]
 
 let compile_test m func vs init inst =
   (* debug_exports m; *)
@@ -640,7 +507,7 @@ let compile_test m func vs init inst =
      if mname = "env" && fname = "_cosf" then [STUB "cosf"; RETURN] else
      if mname = "env" && fname = "_sinf" then [STUB "sinf"; RETURN] else
      if mname = "env" && fname = "pushFrame" then
-         let stack_limit = Int32.of_int (Byteutil.pow2 !Flags.stack_size - !kludge (elem m)) in
+         let stack_limit = Int32.of_int (Byteutil.pow2 !Flags.stack_size - Stacksize.check (elem m)) in
          let call_limit = Int32.of_int (Byteutil.pow2 !Flags.call_size - 1) in
          let num_globals = List.length (global_imports (elem m)) + List.length m.globals in
          let call_stack = num_globals + 2 in
diff --git a/interpreter/merkle/mproof.ml b/interpreter/merkle/mproof.ml
index af82305..b35f6ac 100644
--- a/interpreter/merkle/mproof.ml
+++ b/interpreter/merkle/mproof.ml
@@ -1,11 +1,9 @@
 
-open Merkle
 open Values
 open Mrun
 open Mbinary
 open Byteutil
-
-let trace = Merkle.trace
+open Sourceutil
 
 let to_hex a = "\"0x" ^ w256_to_string a ^ "\""
 
diff --git a/interpreter/merkle/mrun.ml b/interpreter/merkle/mrun.ml
index 0861731..1650e5c 100644
--- a/interpreter/merkle/mrun.ml
+++ b/interpreter/merkle/mrun.ml
@@ -2,6 +2,7 @@
 open Merkle
 open Values
 open Types
+open Sourceutil
 
 let rec pow2 n = if n = 0 then 1 else 2 * pow2 (n-1)
 
diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 6c64eb5..13770aa 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -1,15 +1,11 @@
 
-open Merkle
 open Ast
 open Source
 open Types
+open Sourceutil
 
 (* Analyze stack *)
 
-let do_it x f = {x with it=f x.it}
-
-let it e = {it=e; at=no_region}
-
 type control = {
   rets : int;
   level : int;
@@ -27,18 +23,6 @@ type context = {
   tctx : Valid.context;
 }
 
-let relabel lst =
-   let uniq = ref 1 in
-   let rec compile expr =
-      incr uniq;
-      {it=compile' expr.it; at={left=no_pos; right={file="label"; line= !uniq; column=0}}}
-   and compile' = function
-    | Block (ty, lst) -> Block (ty, List.map compile lst)
-    | Loop (ty, lst) -> Loop (ty, List.map compile lst)
-    | If (ty, texp, fexp) -> If (ty, List.map compile texp, List.map compile fexp)
-    | a -> a in
-  List.map compile lst
-
 (* Associating instructions with types *)
 let assoc_types ctx func =
   let res = Hashtbl.create 10 in
@@ -61,39 +45,12 @@ let assoc_types ctx func =
 
 (* the idea would be to add local variables so that there are never hidden elements in the stack when making a call *)
 
-let rec popn n = function
- | a::tl when n > 0 -> popn (n-1) tl
- | lst -> lst
-
-let rec take n = function
- | a::tl when n > 0 -> a :: take (n-1) tl
- | lst -> []
-
 let una_stack id x = {x with stack=id::popn 1 x.stack}
 let bin_stack id x = {x with stack=id::popn 2 x.stack}
 let n_stack n id x = {x with stack=id::popn n x.stack}
 
 let info = Hashtbl.create 100
 
-let rec gen n a = if n = 0 then [] else a (n-1) :: gen (n-1) a
-
-let generate_entry id_to_local (lst, others) =
-   let open Merkle in
-   let stack_size = List.length lst + others in
-   (* others will have to be moved to make space *)
-   let n = List.length lst in
-   gen n (fun i -> DUP 1) @ (* fillers *)
-   gen others (fun i -> DUP (others-i+n+1)) @ (* this should copy the others *)
-   List.flatten (List.mapi (fun i id -> [DUP (stack_size + List.assoc id_to_local id); SWAP (stack_size-i); DROP 1]) lst) (* access local variable, then write to filled location *)
-
-let generate_exit id_to_local (lst, others) =
-   let open Merkle in
-   let stack_size = List.length lst + others in
-   (* others will have to be moved over the hidden variables *)
-   let n = List.length lst in
-   List.flatten (gen others (fun i -> [DUP (others-i+1); SWAP (others-i+1+n); DROP 1])) @ (* this should copy the others *)
-   [DROP others]
-
 let rec compile marked (ctx : context) expr = compile' marked ctx (Int32.of_int expr.at.right.line) expr.it
 and compile' marked ctx id = function
  | Block (ty, lst) ->
diff --git a/interpreter/merkle/shiftmem.ml b/interpreter/merkle/shiftmem.ml
index 2b8bd25..ecc9be6 100644
--- a/interpreter/merkle/shiftmem.ml
+++ b/interpreter/merkle/shiftmem.ml
@@ -1,11 +1,9 @@
 
 open Source
 open Ast
-open Merkle
+open Sourceutil
 open Values
 
-let do_it x f = {x with it=f x.it}
-
 (* offset in load, store and memory segments *)
 
 let rec convert_inst' num = function
diff --git a/interpreter/merkle/stacksize.ml b/interpreter/merkle/stacksize.ml
index 63b4d83..c1fdaa1 100644
--- a/interpreter/merkle/stacksize.ml
+++ b/interpreter/merkle/stacksize.ml
@@ -1,8 +1,8 @@
 
-open Merkle
 open Ast
 open Source
 open Types
+open Sourceutil
 
 type control = {
   rets : int;
@@ -135,7 +135,7 @@ let check_func ctx func =
 let add_functions m =
   do_it m (fun m ->
     (* add function types *)
-    let i_num = List.length (Merkle.func_imports (it m)) in
+    let i_num = List.length (func_imports (it m)) in
     let ftypes = m.types @ [
        it (FuncType ([I32Type], []));
        ] in
@@ -170,7 +170,11 @@ let check m =
       f_types2=ttab; f_types=ftab;
       locals=0; stack=[] } in
    let lst = List.sort compare (List.map (fun x -> check_func ctx x) m.it.funcs) in
-   if lst <> [] then prerr_endline ("Highest " ^ string_of_int (List.hd (List.rev lst)))
+   if lst <> [] then
+     let highest = List.hd (List.rev lst) in
+     prerr_endline ("Highest " ^ string_of_int highest);
+     highest
+   else 1
 
 let process_func ctx push_f pop_f func =
    let limit = Int32.of_int (check_func ctx func) in
@@ -183,8 +187,8 @@ let process_func ctx push_f pop_f func =
 
 let process m =
    let m = add_functions m in
-   let push_f = Int32.of_int (List.length (Merkle.func_imports m) - 2) in
-   let pop_f = Int32.of_int (List.length (Merkle.func_imports m) - 1) in
+   let push_f = Int32.of_int (List.length (func_imports m) - 2) in
+   let pop_f = Int32.of_int (List.length (func_imports m) - 1) in
    let ftab, ttab = Secretstack.make_tables m.it in
    let ctx = {
       ptr=0; bptr=0; block_return=[]; 

From f4ccc0d08b11da58f97e9f3f45a55a0230905f7e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Tue, 27 Nov 2018 08:46:44 +0200
Subject: [PATCH 03/22] to this file

---
 interpreter/merkle/sourceutil.ml | 182 +++++++++++++++++++++++++++++++
 1 file changed, 182 insertions(+)
 create mode 100644 interpreter/merkle/sourceutil.ml

diff --git a/interpreter/merkle/sourceutil.ml b/interpreter/merkle/sourceutil.ml
new file mode 100644
index 0000000..5c17dec
--- /dev/null
+++ b/interpreter/merkle/sourceutil.ml
@@ -0,0 +1,182 @@
+open Ast
+open Source
+open Types
+open Values
+
+(* Analyze stack *)
+
+let do_it x f = {x with it=f x.it}
+
+let it e = {it=e; at=no_region}
+
+let relabel lst =
+   let uniq = ref 1 in
+   let rec compile expr =
+      incr uniq;
+      {it=compile' expr.it; at={left=no_pos; right={file="label"; line= !uniq; column=0}}}
+   and compile' = function
+    | Block (ty, lst) -> Block (ty, List.map compile lst)
+    | Loop (ty, lst) -> Loop (ty, List.map compile lst)
+    | If (ty, texp, fexp) -> If (ty, List.map compile texp, List.map compile fexp)
+    | a -> a in
+  List.map compile lst
+
+let rec popn n = function
+ | a::tl when n > 0 -> popn (n-1) tl
+ | lst -> lst
+
+let rec take n = function
+ | a::tl when n > 0 -> a :: take (n-1) tl
+ | lst -> []
+
+let rec gen n a = if n = 0 then [] else a (n-1) :: gen (n-1) a
+
+let value_bool v = not (v = I32 0l || v = I64 0L)
+
+let value_to_int = function
+ | I32 i -> Int32.to_int i
+ | I64 i -> Int64.to_int i
+ | _ -> 0
+
+let value_to_int64 = function
+ | I32 i -> Int64.of_int32 i
+ | I64 i -> i
+ | _ -> 0L
+
+let i x = I32 (Int32.of_int x)
+
+let is_float_op = function
+ | I32 _ | I64 _ -> false
+ | _ -> true
+
+let req_type = function
+ | I32 I32Op.ExtendSI32 -> I32Type
+ | I32 I32Op.ExtendUI32 -> I32Type
+ | I32 I32Op.WrapI64 -> I64Type
+ | I32 I32Op.TruncSF32 -> F32Type
+ | I32 I32Op.TruncUF32 -> F32Type
+ | I32 I32Op.TruncSF64 -> F64Type
+ | I32 I32Op.TruncUF64 -> F64Type
+ | I32 I32Op.ReinterpretFloat -> F32Type
+ | I64 I64Op.ExtendSI32 -> I32Type
+ | I64 I64Op.ExtendUI32 -> I32Type
+ | I64 I64Op.WrapI64 -> I64Type
+ | I64 I64Op.TruncSF32 -> F32Type
+ | I64 I64Op.TruncUF32 -> F32Type
+ | I64 I64Op.TruncSF64 -> F64Type
+ | I64 I64Op.TruncUF64 -> F64Type
+ | I64 I64Op.ReinterpretFloat -> F64Type
+ | F32 F32Op.ConvertSI32 -> I32Type
+ | F32 F32Op.ConvertUI32 -> I32Type
+ | F32 F32Op.ConvertSI64 -> I64Type
+ | F32 F32Op.ConvertUI64 -> I64Type
+ | F32 F32Op.PromoteF32 -> F32Type
+ | F32 F32Op.DemoteF64 -> F64Type
+ | F32 F32Op.ReinterpretInt -> I32Type
+ 
+ | F64 F64Op.ConvertSI32 -> I32Type
+ | F64 F64Op.ConvertUI32 -> I32Type
+ | F64 F64Op.ConvertSI64 -> I64Type
+ | F64 F64Op.ConvertUI64 -> I64Type
+ | F64 F64Op.PromoteF32 -> F32Type
+ | F64 F64Op.DemoteF64 -> F64Type
+ | F64 F64Op.ReinterpretInt -> I64Type
+
+let rec make a n = if n = 0 then [] else a :: make a (n-1) 
+
+let trace = Byteutil.trace
+
+let make_tables m =
+  let ftab = Hashtbl.create 10 in
+  let ttab = Hashtbl.create 10 in
+  List.iteri (fun i f -> Hashtbl.add ttab (Int32.of_int i) f.it) m.types;
+  let rec get_imports i = function
+   | [] -> []
+   | {it=im; _} :: tl ->
+     match im.idesc.it with
+     | FuncImport tvar ->
+        let ty = Hashtbl.find ttab tvar.it in
+        Hashtbl.add ftab (Int32.of_int i) ty;
+        im :: get_imports (i+1) tl
+     | _ -> get_imports i tl in
+  let f_imports = get_imports 0 m.imports in
+  let num_imports = List.length f_imports in
+  List.iteri (fun i f ->
+    let ty = Hashtbl.find ttab f.it.ftype.it in
+    Hashtbl.add ftab (Int32.of_int (i + num_imports)) ty) m.funcs;
+  ftab, ttab
+
+let elem x = {it=x; at=no_region}
+
+let func_imports m =
+  let rec do_get = function
+   | [] -> []
+   | ({it={idesc={it=FuncImport _;_};_};_} as el)::tl -> el :: do_get tl
+   | _::tl -> do_get tl in
+  do_get m.it.imports
+
+let global_imports m =
+  let rec do_get = function
+   | [] -> []
+   | ({it={idesc={it=GlobalImport _;_};_};_} as el)::tl -> el :: do_get tl
+   | _::tl -> do_get tl in
+  do_get m.it.imports
+
+let other_imports m =
+  let rec do_get = function
+   | [] -> []
+   | {it={idesc={it=FuncImport _;_};_};_}::tl -> do_get tl
+   | {it={idesc={it=GlobalImport _;_};_};_}::tl -> do_get tl
+   | el::tl -> el :: do_get tl in
+  do_get m.it.imports
+
+let other_imports_nomem m =
+  let rec do_get = function
+   | [] -> []
+   | {it={idesc={it=FuncImport _;_};_};_}::tl -> do_get tl
+   | {it={idesc={it=GlobalImport _;_};_};_}::tl -> do_get tl
+   | {it={idesc={it=MemoryImport _;_};_};_}::tl -> do_get tl
+   | el::tl -> el :: do_get tl in
+  do_get m.it.imports
+
+let find_function m func =
+  let ftab = Hashtbl.create 10 in
+  let ttab = Hashtbl.create 10 in
+  List.iteri (fun i f -> Hashtbl.add ttab (Int32.of_int i) f.it) m.types;
+  let rec get_imports i = function
+   | [] -> []
+   | {it=im; _} :: tl ->
+     match im.idesc.it with
+     | FuncImport tvar ->
+        let ty = Hashtbl.find ttab tvar.it in
+        Hashtbl.add ftab (Int32.of_int i) ty;
+        im :: get_imports (i+1) tl
+     | _ -> get_imports i tl in
+  let num_imports = List.length (get_imports 0 m.imports) in
+  let entry = ref (-1) in
+  List.iteri (fun i f ->
+    if f = func then ( entry := i + num_imports )) m.funcs;
+  !entry
+
+let find_function_index m inst name =
+  ( match Instance.export inst name with
+  | Some (Instance.ExternalFunc (Instance.AstFunc (_, func))) -> find_function m func
+  | _ -> raise Not_found )
+
+let find_global_index m inst name =
+  let num_imports = 0l (* Int32.of_int (List.length (global_imports m)) *) in
+  let rec get_exports = function
+   | [] -> trace ("Cannot Find global: " ^ Utf8.encode name); raise Not_found
+   | {it=im; _} :: tl ->
+     match im.edesc.it with
+     | GlobalExport tvar -> if im.name = name then Int32.add tvar.it num_imports else get_exports tl
+     | _ -> get_exports tl in
+  Int32.to_int (get_exports m.it.exports)
+
+let type_to_str = function
+ | I32Type -> "i32"
+ | I64Type -> "i64"
+ | F32Type -> "f32"
+ | F64Type -> "f64"
+
+

From 94869183fc7c6ec12dc0ba43ed793570aa0e1094 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Wed, 5 Dec 2018 09:41:47 +0200
Subject: [PATCH 04/22] add global variable to tell what is the stack frame
 size limit

---
 interpreter/merkle/addglobals.ml | 55 ++++----------------------------
 interpreter/merkle/intfloat.ml   |  8 ++---
 interpreter/merkle/merkle.ml     |  6 ++--
 interpreter/merkle/sourceutil.ml | 44 +++++++++++++++++++++++++
 interpreter/merkle/stacksize.ml  |  5 +--
 5 files changed, 59 insertions(+), 59 deletions(-)

diff --git a/interpreter/merkle/addglobals.ml b/interpreter/merkle/addglobals.ml
index e2b5266..fbdf927 100644
--- a/interpreter/merkle/addglobals.ml
+++ b/interpreter/merkle/addglobals.ml
@@ -57,11 +57,11 @@ let add_import taken special imports map map2 num imp =
     let loc = Int32.of_int (List.length !imports) in
     Hashtbl.add map (Int32.of_int num) loc;
     imports := imp :: !imports;
-    Run.trace ("Got import " ^ name);
+    trace ("Got import " ^ name);
     Hashtbl.add taken name loc
   end else begin
     let loc = Hashtbl.find taken name in
-    Run.trace ("Dropping import " ^ name);
+    trace ("Dropping import " ^ name);
     Hashtbl.add map (Int32.of_int num) loc
   end;
   if Hashtbl.mem special name then begin
@@ -70,51 +70,8 @@ let add_import taken special imports map map2 num imp =
 
 let int_global i = GetGlobal {it=Int32.of_int i; at=no_region}
 
-let int_const y = Const (elem (Values.I32 (Int32.of_int y)))
-let int64_const y = Const (elem (Values.I64 y))
-let f64_const y = Const (elem (Values.F64 y))
-
-let int_binary i =
-  let res = Bytes.create 4 in
-  Bytes.set res 0 (Char.chr (i land 0xff));
-  Bytes.set res 1 (Char.chr ((i lsr 8) land 0xff));
-  Bytes.set res 2 (Char.chr ((i lsr 16) land 0xff));
-  Bytes.set res 3 (Char.chr ((i lsr 24) land 0xff));
-  Bytes.to_string res
-
-let generate_data (addr, i) : string segment =
-  elem {
-    offset=elem [elem (int_const (addr*4))];
-    index=elem 0l;
-    init=int_binary i;
-  }
-
 (* need to add a TOTAL_MEMORY global *)
 
-let add_i32_global m name tmem =
-  let open Types in
-  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
-  do_it m (fun m -> {m with
-    globals=m.globals@[elem {value=elem [elem (int_const tmem)]; gtype=GlobalType (I32Type, Immutable)}];
-    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
-
-let add_i64_global m name tmem =
-  let open Types in
-  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
-  do_it m (fun m -> {m with
-    globals=m.globals@[elem {value=elem [elem (int64_const tmem)]; gtype=GlobalType (I64Type, Immutable)}];
-    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
-
-let add_f64_global m name tmem =
-  let open Types in
-  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
-  do_it m (fun m -> {m with
-    globals=m.globals@[elem {value=elem [elem (f64_const tmem)]; gtype=GlobalType (F64Type, Immutable)}];
-    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
-
-let has_import m name =
-  List.exists (fun im -> Utf8.encode im.it.item_name = name) m.it.imports
-
 let add_globals m fn =
   let globals, mem, tmem = load_file fn in
   let m = if !Flags.asmjs then add_i32_global m "ASMJS" 0 else m in
@@ -141,7 +98,7 @@ let add_globals m fn =
     let name = "_env_" ^ x in
     let inst = Const (elem (Values.I32 (Int32.of_int y))) in
     Hashtbl.add special_globals name inst;
-    Run.trace ("Blah " ^ name ^ " fddd " ^ string_of_int (555+i));
+    trace ("Blah " ^ name ^ " fddd " ^ string_of_int (555+i));
     Hashtbl.add taken_globals name (Int32.add 555l (Int32.of_int i)) in
   List.iteri reserve_export globals;
   List.iteri (fun n x -> add_import taken_globals special_globals g_imports gmap1 gmap2 n x) (global_imports m);
@@ -153,10 +110,10 @@ let add_globals m fn =
   let offset_ga = num_g - num_ga in
 
   List.iteri (fun i _ ->
-    Run.trace ("global " ^ string_of_int (i+num_ga) ^ " -> " ^ string_of_int (i + num_ga + offset_ga));
+    trace ("global " ^ string_of_int (i+num_ga) ^ " -> " ^ string_of_int (i + num_ga + offset_ga));
     Hashtbl.add gmap1 (Int32.of_int (i + num_ga)) (Int32.of_int (i + num_ga + offset_ga))) m.it.globals;
 
-  List.iter (fun (x,y) -> Run.trace ("Global " ^ x ^ " = " ^ string_of_int y)) globals;
+  List.iter (fun (x,y) -> trace ("Global " ^ x ^ " = " ^ string_of_int y)) globals;
   (* initialize these globals differently *)
   (* when initializing globals, cannot access previous globals *)
   (* remap exports *)
@@ -164,7 +121,7 @@ let add_globals m fn =
   (* funcs will have to be remapped *)
   let funcs_a = List.map (remap (fun x -> x) (Hashtbl.find gmap1) (Hashtbl.find gmap2) ftmap1) m.it.funcs in
   (* table elements have to be remapped *)
-  Run.trace ("Remapping globals");
+  trace ("Remapping globals");
   let new_data = List.map generate_data mem in
   let mem_size = Int32.of_int (Byteutil.pow2 (!Flags.memory_size - 13)) in
   let mem = {
diff --git a/interpreter/merkle/intfloat.ml b/interpreter/merkle/intfloat.ml
index aecae36..43b6f34 100644
--- a/interpreter/merkle/intfloat.ml
+++ b/interpreter/merkle/intfloat.ml
@@ -20,7 +20,7 @@ let merge a b =
      exports = a.it.exports@List.filter Merge.drop_table (List.map (Merge.remap_export (simple_add num) (fun x -> x) (simple_add num_ft) "") b.it.exports);
      elems = a.it.elems;
      types=a.it.types@b.it.types;
-     data=a.it.data@b.it.data@[Addglobals.generate_data (256, !Flags.memory_offset)]}}
+     data=a.it.data@b.it.data@[generate_data (256, !Flags.memory_offset)]}}
 
 let convert_type' = function
  | I32Type -> I32Type
@@ -153,13 +153,9 @@ let convert_float m =
   and convert_body lst = List.flatten (List.map convert_op lst) in
   let convert_func f = do_it f (fun f -> {f with body=convert_body f.body}) in
   let convert_global g = do_it g (fun g -> {value=do_it g.value convert_body; gtype=convert_gtype g.gtype}) in
-  Run.trace "Converting floats";
+  trace "Converting floats";
   do_it m (fun m -> {m with funcs=List.map convert_func m.funcs; globals=List.map convert_global m.globals})
 
 let process a b =
   convert_float (convert_types (merge a b))
   
-
-
-
-
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index 4690c03..25d6c8e 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -317,8 +317,10 @@ let init_fs_stack mdle inst =
   prerr_endline ("All globals " ^ string_of_int (List.length mdle.globals));
   let stack_max = List.length (global_imports (elem mdle)) + 3 in *)
   prerr_endline ("Warning: asm.js initialization is very dependant on the filesystem.wasm");
-  let len = List.length (global_imports (elem mdle)) + List.length mdle.globals in
-  let stack_ptr = len - 20 in (* this is the difficult place *)
+  let asmjs = find_global_index (elem mdle) inst (Utf8.decode "ASMJS") in
+  (* let len = List.length (global_imports (elem mdle)) + List.length mdle.globals in
+  let stack_ptr = len - 20 in *)
+  let stack_ptr = asmjs - 16 in (* this is the difficult place *)
   let stack_max = stack_ptr + 1 in
   let malloc = find_function_index mdle inst (Utf8.decode "_malloc") in
   [PUSH (i 1024); CALL malloc; DUP 1; DUP 1;
diff --git a/interpreter/merkle/sourceutil.ml b/interpreter/merkle/sourceutil.ml
index 5c17dec..230d756 100644
--- a/interpreter/merkle/sourceutil.ml
+++ b/interpreter/merkle/sourceutil.ml
@@ -180,3 +180,47 @@ let type_to_str = function
  | F64Type -> "f64"
 
 
+let int_const y = Const (elem (Values.I32 (Int32.of_int y)))
+let int64_const y = Const (elem (Values.I64 y))
+let f64_const y = Const (elem (Values.F64 y))
+
+let int_binary i =
+  let res = Bytes.create 4 in
+  Bytes.set res 0 (Char.chr (i land 0xff));
+  Bytes.set res 1 (Char.chr ((i lsr 8) land 0xff));
+  Bytes.set res 2 (Char.chr ((i lsr 16) land 0xff));
+  Bytes.set res 3 (Char.chr ((i lsr 24) land 0xff));
+  Bytes.to_string res
+
+let generate_data (addr, i) : string segment =
+  elem {
+    offset=elem [elem (int_const (addr*4))];
+    index=elem 0l;
+    init=int_binary i;
+  }
+
+let add_i32_global m name tmem =
+  let open Types in
+  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
+  do_it m (fun m -> {m with
+    globals=m.globals@[elem {value=elem [elem (int_const tmem)]; gtype=GlobalType (I32Type, Immutable)}];
+    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
+
+let add_i64_global m name tmem =
+  let open Types in
+  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
+  do_it m (fun m -> {m with
+    globals=m.globals@[elem {value=elem [elem (int64_const tmem)]; gtype=GlobalType (I64Type, Immutable)}];
+    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
+
+let add_f64_global m name tmem =
+  let open Types in
+  let idx = Int32.of_int (List.length (global_imports m) + List.length m.it.globals) in
+  do_it m (fun m -> {m with
+    globals=m.globals@[elem {value=elem [elem (f64_const tmem)]; gtype=GlobalType (F64Type, Immutable)}];
+    exports=m.exports@[elem {name=Utf8.decode name; edesc=elem (GlobalExport (elem idx))}]})
+
+let has_import m name =
+  List.exists (fun im -> Utf8.encode im.it.item_name = name) m.it.imports
+
+
diff --git a/interpreter/merkle/stacksize.ml b/interpreter/merkle/stacksize.ml
index c1fdaa1..a1372ca 100644
--- a/interpreter/merkle/stacksize.ml
+++ b/interpreter/merkle/stacksize.ml
@@ -173,8 +173,8 @@ let check m =
    if lst <> [] then
      let highest = List.hd (List.rev lst) in
      prerr_endline ("Highest " ^ string_of_int highest);
-     highest
-   else 1
+     max 10 highest
+   else 10
 
 let process_func ctx push_f pop_f func =
    let limit = Int32.of_int (check_func ctx func) in
@@ -187,6 +187,7 @@ let process_func ctx push_f pop_f func =
 
 let process m =
    let m = add_functions m in
+   let m = add_i32_global m "FRAME_MAX" (check m) in
    let push_f = Int32.of_int (List.length (func_imports m) - 2) in
    let pop_f = Int32.of_int (List.length (func_imports m) - 1) in
    let ftab, ttab = Secretstack.make_tables m.it in

From d702be40bbc1ec74f1a1d82774fc37bf2e0450f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Wed, 5 Dec 2018 10:42:52 +0200
Subject: [PATCH 05/22] more helpers for asm.js handling

---
 interpreter/merkle/addglobals.ml | 32 +++++++++++++++++++++++++++++++-
 interpreter/merkle/merkle.ml     | 18 +++++++++---------
 interpreter/merkle/sourceutil.ml |  2 +-
 3 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/interpreter/merkle/addglobals.ml b/interpreter/merkle/addglobals.ml
index fbdf927..11e2bba 100644
--- a/interpreter/merkle/addglobals.ml
+++ b/interpreter/merkle/addglobals.ml
@@ -72,9 +72,39 @@ let int_global i = GetGlobal {it=Int32.of_int i; at=no_region}
 
 (* need to add a TOTAL_MEMORY global *)
 
+let add_setters m =
+  let asmjs = find_global_index m (Utf8.decode "ASMJS") in
+  do_it m (fun m ->
+    (* add function types *)
+    let ftypes = m.types @ [
+       it (FuncType ([I32Type], []));
+       ] in
+    let ftypes_len = List.length m.types in
+    let set_type = it (Int32.of_int (ftypes_len)) in
+    let make_func num =
+      elem {
+        ftype = set_type;
+        locals = [];
+        body = List.map it [GetLocal (it 0l); SetGlobal (it num)];
+      } in
+    (* add exports *)
+    let fnum = List.length (func_imports (it m)) + List.length m.funcs in
+    let added = [
+       it {name=Utf8.decode "setHelperStack"; edesc=it (FuncExport (it (Int32.of_int fnum)))};
+       it {name=Utf8.decode "setHelperStackLimit"; edesc=it (FuncExport (it (Int32.of_int (fnum+1))))};
+    ] in
+    let stack_ptr = asmjs - 16 in (* this is the difficult place *)
+    let stack_max = stack_ptr + 1 in
+    let set1 = make_func (Int32.of_int stack_ptr) in
+    let set2 = make_func (Int32.of_int stack_max) in
+    {m with funcs=m.funcs @ [set1; set2];
+            types=ftypes;
+            exports=m.exports @ added; })
+
 let add_globals m fn =
   let globals, mem, tmem = load_file fn in
-  let m = if !Flags.asmjs then add_i32_global m "ASMJS" 0 else m in
+  let m =
+     if !Flags.asmjs then add_setters (add_i32_global m "ASMJS" 1) else m in
   let m = add_i32_global m "TOTAL_MEMORY" tmem in
   (* let m = add_i32_global m "GAS" 0 in *)
   let m = add_i32_global m "GAS_LIMIT" (!Flags.gas_limit) in
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index 25d6c8e..156071b 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -317,7 +317,7 @@ let init_fs_stack mdle inst =
   prerr_endline ("All globals " ^ string_of_int (List.length mdle.globals));
   let stack_max = List.length (global_imports (elem mdle)) + 3 in *)
   prerr_endline ("Warning: asm.js initialization is very dependant on the filesystem.wasm");
-  let asmjs = find_global_index (elem mdle) inst (Utf8.decode "ASMJS") in
+  let asmjs = find_global_index (elem mdle) (Utf8.decode "ASMJS") in
   (* let len = List.length (global_imports (elem mdle)) + List.length mdle.globals in
   let stack_ptr = len - 20 in *)
   let stack_ptr = asmjs - 16 in (* this is the difficult place *)
@@ -332,13 +332,13 @@ let init_system mdle inst =
   (* This is the last point that we can use to initialize metering *)
   let num_globals = List.length (global_imports (elem mdle)) + List.length mdle.globals in
   ( try
-      let initial_gas_limit = find_global_index (elem mdle) inst (Utf8.decode "GAS_LIMIT") in
+      let initial_gas_limit = find_global_index (elem mdle) (Utf8.decode "GAS_LIMIT") in
       let gas_limit = num_globals in
       let gas = num_globals + 1 in
       [LOADGLOBAL initial_gas_limit; CONV (I64 I64Op.ExtendUI32); PUSH (I64 1000000L); BIN (I64 I64Op.Mul); STOREGLOBAL gas_limit; PUSH (I64 0L); STOREGLOBAL gas]
     with Not_found -> [] ) @
   simple_call mdle inst "__post_instantiate" @
-  (if (try ignore (find_global_index (elem mdle) inst (Utf8.decode "ASMJS")); true with Not_found -> false) then init_fs_stack mdle inst else [] ) @
+  (if (try ignore (find_global_index (elem mdle) (Utf8.decode "ASMJS")); true with Not_found -> false) then init_fs_stack mdle inst else [] ) @
   simple_call mdle inst "_initSystem"
 
 let find_initializers mdle =
@@ -469,12 +469,12 @@ let compile_test m func vs init inst =
      if mname = "env" && fname = "_outputData" then [OUTPUTDATA;RETURN] else
      if mname = "env" && fname = "_sbrk" then
        [STUB "sbrk";
-        LOADGLOBAL (find_global_index (elem m) inst (Utf8.decode "DYNAMICTOP_PTR"));
+        LOADGLOBAL (find_global_index (elem m) (Utf8.decode "DYNAMICTOP_PTR"));
         LOAD {ty=I32Type; align=0; offset=Int32.of_int !Flags.memory_offset; sz=None};
         DUP 1;
         DUP 3;
         BIN (I32 I32Op.Add);
-        LOADGLOBAL (find_global_index (elem m) inst (Utf8.decode "DYNAMICTOP_PTR"));
+        LOADGLOBAL (find_global_index (elem m) (Utf8.decode "DYNAMICTOP_PTR"));
         DUP 2;
         STORE {ty=I32Type; align=0; offset=Int32.of_int !Flags.memory_offset; sz=None};
         DUP 2;
@@ -495,7 +495,7 @@ let compile_test m func vs init inst =
      if mname = "env" && fname = "abort" then [UNREACHABLE] else
      if mname = "env" && fname = "_exit" then exit_code else
      if mname = "env" && fname = "getTotalMemory" then
-        try [LOADGLOBAL (find_global_index (elem m) inst (Utf8.decode "TOTAL_MEMORY")); RETURN]
+        try [LOADGLOBAL (find_global_index (elem m) (Utf8.decode "TOTAL_MEMORY")); RETURN]
         with Not_found ->
         ( prerr_endline "Warning, cannot find global variable TOTAL_MEMORY. Use emscripten-module-wrapper to run files that were generated by emscripten";
           [PUSH (i (1024*1024*1500)); RETURN] ) else
@@ -529,7 +529,7 @@ let compile_test m func vs init inst =
           RETURN; LABEL (-11); UNREACHABLE] else
      if mname = "env" && fname = "usegas" then
        try
-         let _ (* initial gas limit *) = find_global_index (elem m) inst (Utf8.decode "GAS_LIMIT") in
+         let _ (* initial gas limit *) = find_global_index (elem m) (Utf8.decode "GAS_LIMIT") in
          let num_globals = List.length (global_imports (elem m)) + List.length m.globals in
          let gas_limit = num_globals in
          let gas = num_globals + 1 in
@@ -538,8 +538,8 @@ let compile_test m func vs init inst =
      if mname = "env" && fname = "_debugString" then [STUB (mname ^ " . " ^ fname); RETURN] else
      if mname = "env" && fname = "_debugBuffer" then [STUB (mname ^ " . " ^ fname); DROP 1; RETURN] else
      if mname = "env" && fname = "_debugInt" then [STUB (mname ^ " . " ^ fname); RETURN] else
-     if mname = "env" && fname = "_getSystem" then [LOADGLOBAL (find_global_index (elem m) inst (Utf8.decode "_system_ptr")); RETURN] else
-     if mname = "env" && fname = "_setSystem" then [STOREGLOBAL (find_global_index (elem m) inst (Utf8.decode "_system_ptr")); RETURN] else
+     if mname = "env" && fname = "_getSystem" then [LOADGLOBAL (find_global_index (elem m) (Utf8.decode "_system_ptr")); RETURN] else
+     if mname = "env" && fname = "_setSystem" then [STOREGLOBAL (find_global_index (elem m) (Utf8.decode "_system_ptr")); RETURN] else
      if mname = "env" && Hashtbl.mem custom_calls fname then [CUSTOM (Hashtbl.find custom_calls fname); RETURN] else
      generic_stub m inst mname fname ) f_imports in
   let module_codes = List.mapi (fun i f ->
diff --git a/interpreter/merkle/sourceutil.ml b/interpreter/merkle/sourceutil.ml
index 230d756..0fa9b79 100644
--- a/interpreter/merkle/sourceutil.ml
+++ b/interpreter/merkle/sourceutil.ml
@@ -163,7 +163,7 @@ let find_function_index m inst name =
   | Some (Instance.ExternalFunc (Instance.AstFunc (_, func))) -> find_function m func
   | _ -> raise Not_found )
 
-let find_global_index m inst name =
+let find_global_index m name =
   let num_imports = 0l (* Int32.of_int (List.length (global_imports m)) *) in
   let rec get_exports = function
    | [] -> trace ("Cannot Find global: " ^ Utf8.encode name); raise Not_found

From 9dcec2c0933923e3e1d2fa6f97a4684ac0efb583 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 10 Dec 2018 08:51:02 +0200
Subject: [PATCH 06/22] only store needed locals

---
 interpreter/merkle/buildstack.ml  | 36 ++++++++++++++++++-------------
 interpreter/merkle/floaterror.ml  |  1 -
 interpreter/merkle/mbinary.ml     |  1 +
 interpreter/merkle/merkle.ml      |  2 +-
 interpreter/merkle/mrun.ml        |  2 +-
 interpreter/merkle/secretstack.ml |  8 ++++---
 6 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index 1aadc99..d360035 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -33,11 +33,15 @@ type ctx = {
   store_local_i64 : var;
   store_local_f32 : var;
   store_local_f64 : var;
-  
+
+  store_indirect : var;
+
   adjust_stack_i32 : var;
   adjust_stack_i64 : var;
   adjust_stack_f32 : var;
   adjust_stack_f64 : var;
+  
+  orig_locals : int;
 }
 
 (* perhaps should get everything as args, just be a C function: add them to env *)
@@ -120,9 +124,9 @@ let determine_type tctx block =
   | _ -> raise (Failure "typing error")
 
 let store_locals ctx =
-   let num_locals = List.length ctx.tctx.Valid.locals in
+(*   let num_locals = List.length ctx.tctx.Valid.locals in *)
    let res = ref [] in
-   for i = 0 to num_locals - 1 do
+   for i = 0 to ctx.orig_locals - 1 do
       let var = it (Int32.of_int i) in
       let lst = match Valid.local ctx.tctx var with
       | I32Type -> [GetLocal var; Call ctx.store_local_i32]
@@ -133,7 +137,6 @@ let store_locals ctx =
    done;
    !res
 
-
 let rec remap_blocks label inst =
   let handle {it=v; _} = if Int32.of_int label > v then it v else it (Int32.add v 1l) in
   do_it inst (function
@@ -170,12 +173,8 @@ let rec process_inst ctx inst =
   | If (ty, l1, l2) -> [If (ty, List.flatten (List.map (process_inst ctx) l1), List.flatten (List.map (process_inst ctx) l2))]
   | Loop (ty, lst) -> [Loop (ty, List.map it s_block @ List.flatten (List.map (process_inst ctx) lst))]
   (* Just before call, store all locals (arguments will be stored later, but what if builtin) *)
-  (*
-  | Call x -> s_block @ [Call x] @ e_block (ctx.var_type x.it)
-  | CallIndirect x -> s_block @ [CallIndirect x] @ e_block (ctx.lookup_type x.it)
-  *)
   | Call x -> s_block @ e_block (Call x) (ctx.var_type x.it) @ s_block
-  | CallIndirect x -> s_block @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block
+  | CallIndirect x -> s_block @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block
   | a -> [a] in
   List.map it res
 
@@ -205,7 +204,14 @@ let list_to_map lst =
   List.iter (fun el -> Hashtbl.add res el true) lst;
   res
 
-let process m =
+let process m_orig =
+  let m = Secretstack.relabel m_orig in
+  let m = Secretstack.process m in
+  let _, ttab = make_tables m.it in
+  let orig_locals = List.map (fun f ->
+      let FuncType (par,_) = Hashtbl.find ttab f.it.ftype.it in
+      List.length f.it.locals + List.length par) m_orig.it.funcs in
+  (* Information about hidden variables is at [Secretstack.info] *)
   do_it m (fun m ->
     (* add function types *)
     let i_num = List.length (func_imports (it m)) in
@@ -246,6 +252,7 @@ let process m =
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "adjustStackF32"; idesc=it (FuncImport adjust_stack_f32)}; (* for each type, need a different function *)
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "adjustStackF64"; idesc=it (FuncImport adjust_stack_f64)}; (* for each type, need a different function *)
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "testStep"; idesc=it (FuncImport count_type)};
+       it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storeIndirect"; idesc=it (FuncImport adjust_stack_i32)};
     ] in
     let imps = m.imports @ added in
     (*
@@ -276,15 +283,14 @@ let process m =
       adjust_stack_f32 = it (Int32.of_int (i_num+8));
       adjust_stack_f64 = it (Int32.of_int (i_num+9));
       is_critical = it (Int32.of_int (i_num+10));
+      store_indirect = it (Int32.of_int (i_num+11));
       var_type = Hashtbl.find ftab;
       lookup_type = Hashtbl.find ttab;
       (* possible = (fun loc -> Hashtbl.mem pos_tab loc);
       bottom = List.hd (List.rev pos_lst); *)
       label = 0;
+      orig_locals = 0;
     } in
-    let res = {pre_m with funcs=List.map (process_function ctx) pre_m.funcs} in
-    res
-    )
-
-
+    let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i} f) pre_m.funcs} in
+    res)
 
diff --git a/interpreter/merkle/floaterror.ml b/interpreter/merkle/floaterror.ml
index 439eeb7..a9f1aaa 100644
--- a/interpreter/merkle/floaterror.ml
+++ b/interpreter/merkle/floaterror.ml
@@ -2,7 +2,6 @@
 
 open Source
 open Ast
-open Types
 open Values
 open Sourceutil
 
diff --git a/interpreter/merkle/mbinary.ml b/interpreter/merkle/mbinary.ml
index ae5622b..cec9841 100644
--- a/interpreter/merkle/mbinary.ml
+++ b/interpreter/merkle/mbinary.ml
@@ -171,6 +171,7 @@ let alu_byte = function
  | Convert (F64 F64Op.PromoteF32) -> op 0xbb
  | Convert (F64 F64Op.DemoteF64) -> assert false
  | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf
+ | _ -> assert false
 
 let in_code_byte = function
  | NoIn -> 0x00
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index 156071b..4c95b13 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -416,7 +416,7 @@ let generate_entry id_to_local (lst, others) =
    List.flatten (List.mapi (fun i id -> [DUP (stack_size + List.assoc id_to_local id); SWAP (stack_size-i); DROP 1]) lst) (* access local variable, then write to filled location *)
 
 let generate_exit id_to_local (lst, others) =
-   let stack_size = List.length lst + others in
+   (* let stack_size = List.length lst + others in *)
    (* others will have to be moved over the hidden variables *)
    let n = List.length lst in
    List.flatten (gen others (fun i -> [DUP (others-i+1); SWAP (others-i+1+n); DROP 1])) @ (* this should copy the others *)
diff --git a/interpreter/merkle/mrun.ml b/interpreter/merkle/mrun.ml
index 1650e5c..8b64bf6 100644
--- a/interpreter/merkle/mrun.ml
+++ b/interpreter/merkle/mrun.ml
@@ -478,7 +478,7 @@ let write_register vm regs v = function
    set_input_name vm s2 s1 v
  | InputDataOut ->
    let s2 = value_to_int regs.reg1 in
-   let s1 = value_to_int regs.reg2 in
+(*   let s1 = value_to_int regs.reg2 in *)
    let v = value_to_int v in
    let s1 = if v < 0 then v + 256 else v in
    trace ("output data to file number " ^ string_of_int s2 ^ ": " ^ string_of_int s1);
diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 13770aa..286fc27 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -120,7 +120,6 @@ and compile' marked ctx id = function
    let c = List.nth ctx.block_return num in
    {ctx with ptr=ctx.ptr - c.rets; stack=popn c.rets ctx.stack}
  | BrIf x ->
-   let num = Int32.to_int x.it in
    {ctx with ptr = ctx.ptr-1; stack=popn 1 ctx.stack}
  | BrTable (tab, def) ->
    let num = Int32.to_int def.it in
@@ -168,10 +167,8 @@ let compile_func ctx func =
   trace ("---- function start params:" ^ string_of_int (List.length par) ^ " locals: " ^ string_of_int (List.length func.it.locals));
   (* Just params are now in the stack *)
   let locals = List.length par + List.length func.it.locals in
-  let func = do_it func (fun f -> {f with body=relabel f.body}) in
   let res = assoc_types (Valid.func_context ctx.tctx func) func in
   let marked = ref [] in
-  Hashtbl.clear info;
   let ctx = compile' marked {ctx with ptr=locals; locals=locals} 0l (Block (ret, func.it.body)) in
   (* find types for marked expressions *)
   let find_type expr =
@@ -205,7 +202,12 @@ let make_tables m =
     Hashtbl.add ftab (Int32.of_int (i + num_imports)) ty) m.funcs;
   ftab, ttab
 
+let relabel m =
+  do_it m (fun m ->
+     {m with funcs=List.map (fun func -> do_it func (fun f -> {f with body=relabel f.body})) m.funcs})
+
 let process m_ =
+  Hashtbl.clear info;
   do_it m_ (fun m ->
      let ftab, ttab = make_tables m in
      let ctx = {

From fc3772ea116f418c9d07efd4e3a15b3dc432418f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 10 Dec 2018 08:55:00 +0200
Subject: [PATCH 07/22] only store needed locals

---
 interpreter/merkle/buildstack.ml  | 2 ++
 interpreter/merkle/secretstack.ml | 4 ++++
 2 files changed, 6 insertions(+)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index d360035..c7b2da2 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -161,6 +161,8 @@ let store_top ctx = function
  | F64Type -> [Call ctx.adjust_stack_f64]
 
 let rec process_inst ctx inst =
+  let id = Int32.of_int expr.at.right.line in
+  
   let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 286fc27..4fd61fa 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -162,6 +162,8 @@ let tee_locals assoc func =
   and compile_list lst = List.flatten (List.map compile lst) in
   compile_list func.it.body
 
+let func_info = ref []
+
 let compile_func ctx func =
   let FuncType (par,ret) = Hashtbl.find ctx.f_types2 func.it.ftype.it in
   trace ("---- function start params:" ^ string_of_int (List.length par) ^ " locals: " ^ string_of_int (List.length func.it.locals));
@@ -180,6 +182,7 @@ let compile_func ctx func =
   (* Association list from expression ids to local variables *)
   let marked = List.mapi (fun i x -> x, (find_type x, {it=Int32.of_int (i+locals); at=no_region})) !marked in
   trace ("---- function end " ^ string_of_int ctx.ptr);
+  func_info := !func_info @ [marked];
   do_it func (fun f -> {f with locals=f.locals@List.map (fun (_,(t,_)) -> t) marked; body=tee_locals marked func})
 
 let make_tables m =
@@ -208,6 +211,7 @@ let relabel m =
 
 let process m_ =
   Hashtbl.clear info;
+  func_info := [];
   do_it m_ (fun m ->
      let ftab, ttab = make_tables m in
      let ctx = {

From bb564a6e6c3cb8d2f18acaa2fabfc0b8a648b2cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 10 Dec 2018 09:19:01 +0200
Subject: [PATCH 08/22] first attempt at new version of building the stack

---
 interpreter/merkle/buildstack.ml  | 25 ++++++++++++++++++++-----
 interpreter/merkle/secretstack.ml |  6 +++---
 2 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index c7b2da2..fe439a6 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -42,6 +42,8 @@ type ctx = {
   adjust_stack_f64 : var;
   
   orig_locals : int;
+  
+  func_idx : int;
 }
 
 (* perhaps should get everything as args, just be a C function: add them to env *)
@@ -133,7 +135,8 @@ let store_locals ctx =
       | F32Type -> [GetLocal var; Call ctx.store_local_f32]
       | F64Type -> [GetLocal var; Call ctx.store_local_f64]
       | I64Type -> [Const (it (I32 64l)); GetLocal var; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.store_local_i64] in
-      res := !res @ (Const (it (I32 (Int32.of_int i))) :: lst)
+(*      res := !res @ (Const (it (I32 (Int32.of_int i))) :: lst) *)
+      res := !res @ lst
    done;
    !res
 
@@ -160,10 +163,21 @@ let store_top ctx = function
  | I64Type -> [SetGlobal ctx.g64; Const (it (I32 64l)); GetGlobal ctx.g64; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.adjust_stack_i64; GetGlobal ctx.g64]
  | F64Type -> [Call ctx.adjust_stack_f64]
 
+let store_hidden ctx id =
+  let exprs, _ = Hashtbl.find Secretstack.info id in
+  let dta = List.nth !Secretstack.func_info ctx.func_idx in
+  let handle e_id =
+     let (ty, var) = List.assoc e_id dta in
+     match ty with
+     | I32Type -> [GetLocal var; Call ctx.store_local_i32]
+     | F32Type -> [GetLocal var; Call ctx.store_local_f32]
+     | F64Type -> [GetLocal var; Call ctx.store_local_f64]
+     | I64Type -> [Const (it (I32 64l)); GetLocal var; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.store_local_i64] in
+  List.flatten (List.map handle exprs)
+
 let rec process_inst ctx inst =
-  let id = Int32.of_int expr.at.right.line in
-  
-  let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx), [])] in
+  let id = Int32.of_int inst.at.right.line in
+  let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
    | FuncType (_, [ty]) -> call :: store_top ctx ty (* adjust stack will have to check if it is critical *)
@@ -292,7 +306,8 @@ let process m_orig =
       bottom = List.hd (List.rev pos_lst); *)
       label = 0;
       orig_locals = 0;
+      func_idx = 0;
     } in
-    let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i} f) pre_m.funcs} in
+    let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i; func_idx=i} f) pre_m.funcs} in
     res)
 
diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 4fd61fa..19785b4 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -73,7 +73,7 @@ and compile' marked ctx id = function
       trace ("loop start " ^ string_of_int extra);
       let hidden = take extra ctx.stack in
       marked := hidden @ !marked;
-      Hashtbl.add info id (marked, 0);
+      Hashtbl.add info id (hidden, 0);
    end;
    let ctx = {ctx with bptr=ctx.bptr+1; block_return={level=ctx.ptr; rets=0}::old_return} in
    let ctx = compile_block marked ctx lst in
@@ -87,7 +87,7 @@ and compile' marked ctx id = function
       trace ("call " ^ string_of_int extra);
       let hidden = take extra (popn (List.length par) ctx.stack) in
       marked := hidden @ !marked;
-      Hashtbl.add info id (marked, List.length par);
+      Hashtbl.add info id (hidden, List.length par);
    end;
    {ctx with ptr=ctx.ptr+List.length ret-List.length par; stack=make id (List.length ret) @ popn (List.length par) ctx.stack}
  | CallIndirect v ->
@@ -97,7 +97,7 @@ and compile' marked ctx id = function
       trace ("calli " ^ string_of_int extra);
       let hidden = take extra (popn (List.length par+1) ctx.stack) in
       marked := hidden @ !marked;
-      Hashtbl.add info id (marked, List.length par+1);
+      Hashtbl.add info id (hidden, List.length par+1);
    end;
    {ctx with ptr=ctx.ptr+List.length ret-List.length par-1; stack=make id (List.length ret) @ popn (List.length par + 1) ctx.stack}
  | If (ty, texp, fexp) ->

From 3248e6aa3e0a36354050ac0daf566832467e4eed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 10 Dec 2018 12:02:28 +0200
Subject: [PATCH 09/22] added support for creating the call stack

---
 interpreter/merkle/buildstack.ml | 19 ++++++++++++-
 interpreter/merkle/compiler.ml   |  4 +--
 interpreter/merkle/merkle.ml     | 47 ++++++++++++++++----------------
 interpreter/merkle/mrun.ml       | 16 +++++------
 interpreter/script/run.ml        |  9 ++++++
 5 files changed, 61 insertions(+), 34 deletions(-)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index fe439a6..a832c25 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -35,6 +35,7 @@ type ctx = {
   store_local_f64 : var;
 
   store_indirect : var;
+  store_call : var;
 
   adjust_stack_i32 : var;
   adjust_stack_i64 : var;
@@ -44,6 +45,9 @@ type ctx = {
   orig_locals : int;
   
   func_idx : int;
+  
+  find_return_pc : int32 -> int;
+  
 }
 
 (* perhaps should get everything as args, just be a C function: add them to env *)
@@ -177,7 +181,10 @@ let store_hidden ctx id =
 
 let rec process_inst ctx inst =
   let id = Int32.of_int inst.at.right.line in
-  let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id), [])] in
+  let save_call =
+    try [Const (it (I32 (Int32.of_int (ctx.find_return_pc id)))); Call ctx.store_call]
+    with Not_found -> [] in
+  let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ save_call), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
    | FuncType (_, [ty]) -> call :: store_top ctx ty (* adjust stack will have to check if it is critical *)
@@ -222,6 +229,13 @@ let list_to_map lst =
 
 let process m_orig =
   let m = Secretstack.relabel m_orig in
+  let code = Run.get_code m in
+  let return_pc = Hashtbl.create 100 in
+  let handle i = function
+   | Merkle.CALL (_, id) -> Hashtbl.add return_pc id i
+   | Merkle.CALLI id -> Hashtbl.add return_pc id i
+   | _ -> () in
+  List.iteri handle code;
   let m = Secretstack.process m in
   let _, ttab = make_tables m.it in
   let orig_locals = List.map (fun f ->
@@ -269,6 +283,7 @@ let process m_orig =
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "adjustStackF64"; idesc=it (FuncImport adjust_stack_f64)}; (* for each type, need a different function *)
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "testStep"; idesc=it (FuncImport count_type)};
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storeIndirect"; idesc=it (FuncImport adjust_stack_i32)};
+       it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storeReturnPC"; idesc=it (FuncImport store_type_i32)};
     ] in
     let imps = m.imports @ added in
     (*
@@ -300,6 +315,7 @@ let process m_orig =
       adjust_stack_f64 = it (Int32.of_int (i_num+9));
       is_critical = it (Int32.of_int (i_num+10));
       store_indirect = it (Int32.of_int (i_num+11));
+      store_call = it (Int32.of_int (i_num+12));
       var_type = Hashtbl.find ftab;
       lookup_type = Hashtbl.find ttab;
       (* possible = (fun loc -> Hashtbl.mem pos_tab loc);
@@ -307,6 +323,7 @@ let process m_orig =
       label = 0;
       orig_locals = 0;
       func_idx = 0;
+      find_return_pc = (fun x -> Hashtbl.find return_pc x);
     } in
     let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i; func_idx=i} f) pre_m.funcs} in
     res)
diff --git a/interpreter/merkle/compiler.ml b/interpreter/merkle/compiler.ml
index ea7d9be..ad208b2 100644
--- a/interpreter/merkle/compiler.ml
+++ b/interpreter/merkle/compiler.ml
@@ -106,14 +106,14 @@ let compile labels = function
     "vm.stack_ptr--; r1 = vm.stack[vm.stack_ptr];" ^
     "if (r1 < 0 || r1 >= " ^ string_of_int x ^ ") r1 = " ^ string_of_int x ^ ";" ^
     "vm.pc = vm.pc + 1 + r1; goto *jumptable[vm.pc];"
- | CALL x ->
+ | CALL (x,_) ->
     Hashtbl.add labels x true;
     "vm.callstack[vm.call_ptr] = vm.pc+1;" ^
     "vm.call_ptr++;" ^
     "vm.pc = " ^ string_of_int x ^ "-1;" ^
     "goto label_" ^ string_of_int x ^ ";"
  | CHECKCALLI _ -> "vm.pc++;"
- | CALLI ->
+ | CALLI _ ->
     "vm.stack_ptr--;" ^
     "r1 = vm.stack[vm.stack_ptr];" ^
     "vm.callstack[vm.call_ptr] = vm.pc+1;" ^
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index 4c95b13..51b0a83 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -30,7 +30,7 @@ type inst =
  | JUMPI of int
  | JUMPZ of int
  | JUMPFORWARD of int (* size of jump table *)
- | CALL of int
+ | CALL of int * Int32.t
  | LABEL of int
  | RETURN
  | LOAD of loadop
@@ -43,7 +43,7 @@ type inst =
  | STOREGLOBAL of int
  | CURMEM
  | GROW                     (* Grow memory *)
- | CALLI                    (* indirect call *)
+ | CALLI of Int32.t                   (* indirect call (extra ID) *)
  | CHECKCALLI of Int64.t    (* check type of indirect call *)
  | PUSH of value                  (* constant *)
  | TEST of testop                    (* numeric test *)
@@ -97,8 +97,8 @@ let adjust_stack diff num =
   ( (* trace ("Adjusting stack: " ^ string_of_int num  ^ " return values, " ^ string_of_int diff ^ " extra values"); *)
     adjust_stack_aux diff num @ [DROP diff] )
 
-let rec compile ctx expr = compile' ctx expr.it
-and compile' ctx = function
+let rec compile ctx expr = compile' ctx (Int32.of_int expr.at.right.line) expr.it
+and compile' ctx id = function
  | Unreachable ->
    ctx, [UNREACHABLE]
  | Nop ->
@@ -147,8 +147,8 @@ and compile' ctx = function
    let end_label = ctx.label+1 in
    let a_ptr = ctx.ptr-1 in
    let ctx = {ctx with ptr=a_ptr; label=ctx.label+3} in
-   let ctx, tbody = compile' ctx (Block (ty, texp)) in
-   let ctx, fbody = compile' {ctx with ptr=a_ptr} (Block (ty, fexp)) in
+   let ctx, tbody = compile' ctx id (Block (ty, texp)) in
+   let ctx, fbody = compile' {ctx with ptr=a_ptr} id (Block (ty, fexp)) in
    ctx, [JUMPZ else_label] @ tbody @ [JUMP end_label; LABEL else_label] @ fbody @ [LABEL end_label]
  | Br x ->
    let num = Int32.to_int x.it in
@@ -197,11 +197,12 @@ and compile' ctx = function
    (* Will just push the pc *)
    (* trace ("Function call " ^ Int32.to_string v.it); *)
    let FuncType (par,ret) = Hashtbl.find ctx.f_types v.it in
-   {ctx with ptr=ctx.ptr+List.length ret-List.length par}, [CALL (Int32.to_int v.it)]
+   {ctx with ptr=ctx.ptr+List.length ret-List.length par}, [CALL (Int32.to_int v.it, id)]
  | CallIndirect v ->
    let FuncType (par,ret) = Hashtbl.find ctx.f_types2 v.it in
+   
    (* trace ("call indirect type: " ^ Int64.to_string (Byteutil.ftype_hash (FuncType (par,ret)))); *)
-   {ctx with ptr=ctx.ptr+List.length ret-List.length par-1}, [CHECKCALLI (Byteutil.ftype_hash (FuncType (par,ret))); CALLI]
+   {ctx with ptr=ctx.ptr+List.length ret-List.length par-1}, [CHECKCALLI (Byteutil.ftype_hash (FuncType (par,ret))); CALLI id]
  | Select ->
    (* trace "select"; *)
    let else_label = ctx.label in
@@ -254,7 +255,7 @@ let compile_func ctx idx func =
   trace ("---- function start params:" ^ string_of_int (List.length par) ^ " locals: " ^ string_of_int (List.length func.it.locals) ^ " type: " ^ Int32.to_string func.it.ftype.it);
   trace ("Type hash: " ^ Int64.to_string (Byteutil.ftype_hash (FuncType (par,ret))));
   (* Just params are now in the stack *)
-  let ctx, body = compile' {ctx with ptr=ctx.ptr+List.length par+List.length func.it.locals} (Block (ret, func.it.body)) in
+  let ctx, body = compile' {ctx with ptr=ctx.ptr+List.length par+List.length func.it.locals} 0l (Block (ret, func.it.body)) in
   trace ("---- function end " ^ string_of_int ctx.ptr);
   ctx,
   ( if false (* !Flags.trace *) then [STUB (find_export_name ctx.mdle idx ^ " Idx " ^ string_of_int idx ^ " Params " ^ String.concat "," (List.map type_to_str par) ^  " Return " ^ String.concat "," (List.map type_to_str ret))] else [] ) @
@@ -283,7 +284,7 @@ let resolve_to n lst =
   List.map (resolve_inst tab) lst
 
 let resolve_inst2 tab = function
- | CALL l -> CALL (Hashtbl.find tab l)
+ | CALL (l, id) -> CALL (Hashtbl.find tab l, id)
  | a -> a
 
 let empty_ctx mdle = {ptr=0; label=0; bptr=0; block_return=[]; f_types2=Hashtbl.create 1; f_types=Hashtbl.create 1; mdle}
@@ -299,16 +300,16 @@ let malloc_string mdle malloc str =
   done;
   res := [DUP 1; PUSH (i 0); STORE {ty=I32Type; align=0; offset=Int32.of_int (len-1); sz=Some Mem8}] :: !res;
   (* array address is left *)
-  [PUSH (i len); CALL malloc] @ List.flatten (List.rev (!res))
+  [PUSH (i len); CALL (malloc, 0l)] @ List.flatten (List.rev (!res))
 
 let make_args mdle inst lst =
   let malloc = find_function_index mdle inst (Utf8.decode "_malloc") in
   [PUSH (i (List.length lst)); (* argc *)
-   PUSH (i (List.length lst * 4)); CALL malloc] @ (* argv *)
+   PUSH (i (List.length lst * 4)); CALL (malloc, 0l)] @ (* argv *)
   List.flatten (List.mapi (fun i str -> [DUP 1] @ malloc_string mdle malloc str @ [STORE {ty=I32Type; align=0; offset=Int32.of_int (i*4 + !Flags.memory_offset); sz=None}]) lst)
 
 let simple_call mdle inst name =
-  try [STUB name; CALL (find_function_index mdle inst (Utf8.decode name))]
+  try [STUB name; CALL (find_function_index mdle inst (Utf8.decode name), 0l)]
   with Not_found -> []
 
 let init_fs_stack mdle inst =
@@ -323,7 +324,7 @@ let init_fs_stack mdle inst =
   let stack_ptr = asmjs - 16 in (* this is the difficult place *)
   let stack_max = stack_ptr + 1 in
   let malloc = find_function_index mdle inst (Utf8.decode "_malloc") in
-  [PUSH (i 1024); CALL malloc; DUP 1; DUP 1;
+  [PUSH (i 1024); CALL (malloc, 0l); DUP 1; DUP 1;
    STOREGLOBAL stack_ptr;
    BIN (I32 I32Op.Add);
    STOREGLOBAL stack_max]
@@ -369,15 +370,15 @@ let make_cxx_init mdle inst =
 let generic_stub m inst mname fname =
   try
   [STUB (mname ^ " . " ^ fname);
-   CALL (find_function_index m inst (Utf8.decode "_callArguments"));
+   CALL (find_function_index m inst (Utf8.decode "_callArguments"), 0l);
    DROP_N;
-   CALL (find_function_index m inst (Utf8.decode "_callMemory"));
+   CALL (find_function_index m inst (Utf8.decode "_callMemory"), 0l);
    (* Just handle zero or one return values *)
-   CALL (find_function_index m inst (Utf8.decode "_callReturns"));
+   CALL (find_function_index m inst (Utf8.decode "_callReturns"), 0l);
    JUMPI (-2);
    JUMP (-3);
    LABEL (-2);
-   CALL (find_function_index m inst (Utf8.decode "_getReturn")); (* here we should do a type adjustment???? *)
+   CALL (find_function_index m inst (Utf8.decode "_getReturn"), 0l); (* here we should do a type adjustment???? *)
    LABEL (-3);
    RETURN]
   with Not_found -> [STUB (mname ^ " . " ^ fname); RETURN]
@@ -455,7 +456,7 @@ let compile_test m func vs init inst =
   (* perhaps could do something with the function type *)
   (* one idea would be to use a debugging message *)
   let exit_code =
-    try [CALL (find_function_index m inst (Utf8.decode "_finalizeSystem")); EXIT]
+    try [CALL (find_function_index m inst (Utf8.decode "_finalizeSystem"), 0l); EXIT]
     with Not_found -> [EXIT] in
   let import_codes = List.map (fun im ->
      let mname = Utf8.encode im.module_name in
@@ -485,10 +486,10 @@ let compile_test m func vs init inst =
      (* invoke index, a1, a2*)
      if mname = "env" && String.length fname > 7 && String.sub fname 0 7 = "invoke_" then
        let number = String.sub fname 7 (String.length fname - 7) in
-       [CALL (find_function_index m inst (Utf8.decode ("dynCall_" ^ number))); RETURN] else
+       [CALL (find_function_index m inst (Utf8.decode ("dynCall_" ^ number)), 0l); RETURN] else
      if mname = "env" && String.length fname > 8 && String.sub fname 0 8 = "_invoke_" then
        let number = String.sub fname 8 (String.length fname - 8) in
-       try [ (* STUB fname; *) CALL (find_function_index m inst (Utf8.decode ("_dynCall_" ^ number))); RETURN]
+       try [ (* STUB fname; *) CALL (find_function_index m inst (Utf8.decode ("_dynCall_" ^ number)), 0l); RETURN]
        with Not_found ->
          prerr_endline ("Warning: cannot find dynamic call number " ^ number);
          [RETURN] else
@@ -500,7 +501,7 @@ let compile_test m func vs init inst =
         ( prerr_endline "Warning, cannot find global variable TOTAL_MEMORY. Use emscripten-module-wrapper to run files that were generated by emscripten";
           [PUSH (i (1024*1024*1500)); RETURN] ) else
      if mname = "env" && fname = "setTempRet0" then
-        try [STUB "setTempRet0 (found)"; CALL (find_function_index m inst (Utf8.decode ("setTempRet0"))); RETURN]
+        try [STUB "setTempRet0 (found)"; CALL (find_function_index m inst (Utf8.decode ("setTempRet0")), 0l); RETURN]
         with Not_found -> [STUB "setTempRet0"; DROP 1; RETURN] else
 (*     if mname = "env" && fname = "_rintf" then [UNA (F32 F32Op.Nearest); RETURN] else *)
      if mname = "env" && fname = "_rintf" then [STUB "rintf"; RETURN] else
@@ -553,7 +554,7 @@ let compile_test m func vs init inst =
      trace ("Function " ^ string_of_int n ^ " at " ^ string_of_int l_acc);
      let x = resolve_to l_acc fcode in
      build (n+1) (x::acc) (List.length x + l_acc) tl in
-  let test_code = init @ List.map (fun v -> PUSH v) vs @ [CALL !entry] @ exit_code in
+  let test_code = init @ List.map (fun v -> PUSH v) vs @ [CALL (!entry, 0l)] @ exit_code in
   let codes = build 0 [test_code] (List.length test_code) (import_codes @ List.map snd module_codes) in
   trace ("Here, working");
   let flat_code = flatten_tl (List.rev codes) in
diff --git a/interpreter/merkle/mrun.ml b/interpreter/merkle/mrun.ml
index 8b64bf6..5836f8b 100644
--- a/interpreter/merkle/mrun.ml
+++ b/interpreter/merkle/mrun.ml
@@ -700,9 +700,9 @@ let get_code = function
  | JUMPI x -> {noop with immed=i x; read_reg1 = Immed; read_reg2 = StackIn0; read_reg3 = ReadPc; alu_code = CheckJump; pc_ch=StackReg; stack_ch=StackDec}
  | JUMPZ x -> {noop with immed=i x; read_reg1 = Immed; read_reg2 = StackIn0; read_reg3 = ReadPc; alu_code = CheckJumpZ; pc_ch=StackReg; stack_ch=StackDec}
  | JUMPFORWARD x -> {noop with immed=i x; read_reg1 = StackIn0; read_reg2 = ReadPc; alu_code = CheckJumpForward; pc_ch=StackReg; stack_ch=StackDec}
- | CALL x -> {noop with immed=i x; read_reg1=Immed; read_reg2 = ReadPc; write1 = (Reg2, CallOut); call_ch = StackInc; pc_ch=StackReg}
+ | CALL (x, _) -> {noop with immed=i x; read_reg1=Immed; read_reg2 = ReadPc; write1 = (Reg2, CallOut); call_ch = StackInc; pc_ch=StackReg}
  | CHECKCALLI x -> {noop with immed=I64 x; read_reg1=StackIn0; read_reg2=TableTypeIn; alu_code=CheckDynamicCall; pc_ch=StackInc}
- | CALLI -> {noop with read_reg2=ReadPc; read_reg1=StackIn0; read_reg3=TableIn; pc_ch=StackReg3; write1 = (Reg2, CallOut); call_ch = StackInc; stack_ch=StackDec}
+ | CALLI _ -> {noop with read_reg2=ReadPc; read_reg1=StackIn0; read_reg3=TableIn; pc_ch=StackReg3; write1 = (Reg2, CallOut); call_ch = StackInc; stack_ch=StackDec}
  | INPUTSIZE -> {noop with read_reg1=StackIn0; read_reg2=InputSizeIn; write1 = (Reg2, StackOut1)}
  | INPUTNAME -> {noop with read_reg1=StackIn0; read_reg2=StackIn1; read_reg3=InputNameIn; write1 = (Reg3, StackOut2); stack_ch=StackDec}
  | INPUTDATA -> {noop with read_reg1=StackIn0; read_reg2=StackIn1; read_reg3=InputDataIn; write1 = (Reg3, StackOut2); stack_ch=StackDec}
@@ -871,11 +871,11 @@ let vm_step vm = match vm.code.(vm.pc) with
    let idx = if idx < 0 || idx >= x then x else idx in
    vm.pc <- vm.pc + 1 + idx;
    vm.stack_ptr <- vm.stack_ptr - 1
- | CALL x ->
+ | CALL (x,_) ->
    vm.call_stack.(vm.call_ptr) <- vm.pc+1;
    vm.call_ptr <- vm.call_ptr + 1;
    vm.pc <- x
- | CALLI ->
+ | CALLI _ ->
    let addr = value_to_int vm.stack.(vm.stack_ptr-1) in
    vm.stack_ptr <- vm.stack_ptr - 1;
    vm.call_stack.(vm.call_ptr) <- vm.pc+1;
@@ -1173,7 +1173,7 @@ let trace_step vm =
    let x = vm.stack.(vm.stack_ptr-1) in
    "JUMPZ " ^ (if not (value_bool x) then " jump" else " no jump") ^ " " ^ string_of_value x
  | JUMPFORWARD x -> "JUMPFORWARD " ^ string_of_value vm.stack.(vm.stack_ptr-1)
- | CALL x -> "CALL " ^ string_of_int x
+ | CALL (x,_) -> "CALL " ^ string_of_int x
  | LABEL _ -> "LABEL ???"
  | RETURN -> "RETURN"
  | LOAD x ->
@@ -1202,7 +1202,7 @@ let trace_step vm =
  | TEST op -> "TEST"
  | BIN op -> "BIN " ^ string_of_value vm.stack.(vm.stack_ptr-2) ^ " " ^ string_of_value vm.stack.(vm.stack_ptr-1)
  | CMP op -> "CMP " ^ string_of_value vm.stack.(vm.stack_ptr-2) ^ " " ^ string_of_value vm.stack.(vm.stack_ptr-1)
- | CALLI -> "CALLI"
+ | CALLI _ -> "CALLI"
  | CHECKCALLI x -> "CHECKCALLI"
  | SETSTACK v -> "SETSTACK"
  | SETCALLSTACK v -> "SETCALLSTACK"
@@ -1227,7 +1227,7 @@ let trace_clean vm = match vm.code.(vm.pc) with
  | JUMPI x -> "JUMPI"
  | JUMPZ x -> "JUMPZ"
  | JUMPFORWARD x -> "JUMPFORWARD"
- | CALL x -> "CALL " ^ string_of_int x
+ | CALL (x,_) -> "CALL " ^ string_of_int x
  | LABEL _ -> "LABEL ???"
  | RETURN -> "RETURN"
  | LOAD x ->
@@ -1249,7 +1249,7 @@ let trace_clean vm = match vm.code.(vm.pc) with
  | TEST op -> "TEST"
  | BIN op -> "BIN"
  | CMP op -> "CMP"
- | CALLI -> "CALLI"
+ | CALLI _ -> "CALLI"
  | CHECKCALLI x -> "CHECKCALLI"
  | SETSTACK v -> "SETSTACK"
  | SETCALLSTACK v -> "SETCALLSTACK"
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index 5065b57..a3f6eb2 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -391,6 +391,15 @@ let setup_vm inst mdle func vs =
 (*  prerr_endline "Initialized"; *)
   vm
 
+let get_code mdle =
+  let imports = Import.link mdle in
+  let inst = Eval.init mdle imports in
+  let func = match Instance.export inst (Utf8.decode "_main") with
+      | Some (Instance.ExternalFunc (Instance.AstFunc (_, func))) -> func
+      | _ -> raise (Failure "no main function") in
+  let vm = setup_vm inst mdle.it func [] in
+  Array.to_list vm.Mrun.code
+
 let take_array n arr =
   let res = ref [] in
   for i = 0 to n-1 do

From 4d314c69164082b6b56f4a08ed17d2df1cba53c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Tue, 11 Dec 2018 10:38:32 +0200
Subject: [PATCH 10/22] now generates valid code for dumping the stack

---
 interpreter/merkle/buildstack.ml  | 47 +++++++++++++++++--------------
 interpreter/merkle/secretstack.ml |  2 +-
 interpreter/merkle/sourceutil.ml  |  3 +-
 3 files changed, 29 insertions(+), 23 deletions(-)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index a832c25..1c982a2 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -168,23 +168,28 @@ let store_top ctx = function
  | F64Type -> [Call ctx.adjust_stack_f64]
 
 let store_hidden ctx id =
-  let exprs, _ = Hashtbl.find Secretstack.info id in
-  let dta = List.nth !Secretstack.func_info ctx.func_idx in
-  let handle e_id =
-     let (ty, var) = List.assoc e_id dta in
-     match ty with
-     | I32Type -> [GetLocal var; Call ctx.store_local_i32]
-     | F32Type -> [GetLocal var; Call ctx.store_local_f32]
-     | F64Type -> [GetLocal var; Call ctx.store_local_f64]
-     | I64Type -> [Const (it (I32 64l)); GetLocal var; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.store_local_i64] in
-  List.flatten (List.map handle exprs)
+  try
+    let exprs, _ = Hashtbl.find Secretstack.info id in
+    let dta = List.nth !Secretstack.func_info ctx.func_idx in
+    let handle e_id =
+      let (ty, var) = List.assoc e_id dta in
+      match ty with
+      | I32Type -> [GetLocal var; Call ctx.store_local_i32]
+      | F32Type -> [GetLocal var; Call ctx.store_local_f32]
+      | F64Type -> [GetLocal var; Call ctx.store_local_f64]
+      | I64Type -> [Const (it (I32 64l)); GetLocal var; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.store_local_i64] in
+    List.flatten (List.map handle exprs)
+  with Not_found -> []
 
 let rec process_inst ctx inst =
   let id = Int32.of_int inst.at.right.line in
-  let save_call =
-    try [Const (it (I32 (Int32.of_int (ctx.find_return_pc id)))); Call ctx.store_call]
-    with Not_found -> [] in
-  let s_block = [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ save_call), [])] in
+  let s_block2 () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx), [])] in
+  let s_block () =
+    let save_call =
+      try [Const (it (I32 (Int32.of_int (ctx.find_return_pc id)))); Call ctx.store_call]
+      with Not_found -> prerr_endline ("warning: call return location not found " ^ Int32.to_string id); [] in
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ save_call), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
    | FuncType (_, [ty]) -> call :: store_top ctx ty (* adjust stack will have to check if it is critical *)
@@ -194,10 +199,10 @@ let rec process_inst ctx inst =
   let res = match inst.it with
   | Block (ty, lst) -> [Block (ty, List.flatten (List.map (process_inst ctx) lst))]
   | If (ty, l1, l2) -> [If (ty, List.flatten (List.map (process_inst ctx) l1), List.flatten (List.map (process_inst ctx) l2))]
-  | Loop (ty, lst) -> [Loop (ty, List.map it s_block @ List.flatten (List.map (process_inst ctx) lst))]
+  | Loop (ty, lst) -> [Loop (ty, List.map it (s_block2 ()) @ List.flatten (List.map (process_inst ctx) lst))]
   (* Just before call, store all locals (arguments will be stored later, but what if builtin) *)
-  | Call x -> s_block @ e_block (Call x) (ctx.var_type x.it) @ s_block
-  | CallIndirect x -> s_block @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block
+  | Call x -> s_block () @ e_block (Call x) (ctx.var_type x.it) @ s_block ()
+  | CallIndirect x -> (* prerr_endline ("at call " ^ Int32.to_string id); *) s_block () @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block ()
   | a -> [a] in
   List.map it res
 
@@ -233,7 +238,7 @@ let process m_orig =
   let return_pc = Hashtbl.create 100 in
   let handle i = function
    | Merkle.CALL (_, id) -> Hashtbl.add return_pc id i
-   | Merkle.CALLI id -> Hashtbl.add return_pc id i
+   | Merkle.CALLI id -> Hashtbl.add return_pc id i (* ; prerr_endline ("adding " ^ Int32.to_string id) *)
    | _ -> () in
   List.iteri handle code;
   let m = Secretstack.process m in
@@ -247,10 +252,10 @@ let process m_orig =
     let i_num = List.length (func_imports (it m)) in
     let ftypes = m.types @ [
       it (FuncType ([], [I32Type]));
-      it (FuncType ([I32Type; I32Type], []));
       it (FuncType ([I32Type], []));
-      it (FuncType ([I32Type; F32Type], []));
-      it (FuncType ([I32Type; F64Type], []));
+      it (FuncType ([], []));
+      it (FuncType ([F32Type], []));
+      it (FuncType ([F64Type], []));
       
       it (FuncType ([I32Type], [I32Type]));
       it (FuncType ([], []));
diff --git a/interpreter/merkle/secretstack.ml b/interpreter/merkle/secretstack.ml
index 19785b4..0c82da4 100644
--- a/interpreter/merkle/secretstack.ml
+++ b/interpreter/merkle/secretstack.ml
@@ -94,7 +94,7 @@ and compile' marked ctx id = function
    let FuncType (par,ret) = Hashtbl.find ctx.f_types2 v.it in
    let extra = ctx.ptr - ctx.locals - List.length par - 1 in
    if extra > 0 then begin
-      trace ("calli " ^ string_of_int extra);
+      trace ("calli " ^ string_of_int extra ^ " adding info for " ^ Int32.to_string id);
       let hidden = take extra (popn (List.length par+1) ctx.stack) in
       marked := hidden @ !marked;
       Hashtbl.add info id (hidden, List.length par+1);
diff --git a/interpreter/merkle/sourceutil.ml b/interpreter/merkle/sourceutil.ml
index 0fa9b79..75563a2 100644
--- a/interpreter/merkle/sourceutil.ml
+++ b/interpreter/merkle/sourceutil.ml
@@ -9,8 +9,9 @@ let do_it x f = {x with it=f x.it}
 
 let it e = {it=e; at=no_region}
 
+let uniq = ref 1
+
 let relabel lst =
-   let uniq = ref 1 in
    let rec compile expr =
       incr uniq;
       {it=compile' expr.it; at={left=no_pos; right={file="label"; line= !uniq; column=0}}}

From ba6497b50ba942aae03d04d504ea5fb11c510f3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Thu, 13 Dec 2018 09:02:48 +0200
Subject: [PATCH 11/22] storing parameters and locals separately when building
 stack

---
 interpreter/merkle/buildstack.ml | 32 +++++++++++++++++++++++++++-----
 interpreter/merkle/critical.ml   | 10 +++++++---
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index 1c982a2..92f3123 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -43,6 +43,7 @@ type ctx = {
   adjust_stack_f64 : var;
   
   orig_locals : int;
+  params : int;
   
   func_idx : int;
   
@@ -129,10 +130,25 @@ let determine_type tctx block =
   | Some x :: _ -> x
   | _ -> raise (Failure "typing error")
 
+let store_params ctx =
+(*   let num_locals = List.length ctx.tctx.Valid.locals in *)
+   let res = ref [] in
+   for i = 0 to ctx.params - 1 do
+      let var = it (Int32.of_int i) in
+      let lst = match Valid.local ctx.tctx var with
+      | I32Type -> [GetLocal var; Call ctx.store_local_i32]
+      | F32Type -> [GetLocal var; Call ctx.store_local_f32]
+      | F64Type -> [GetLocal var; Call ctx.store_local_f64]
+      | I64Type -> [Const (it (I32 64l)); GetLocal var; Store {ty=I64Type; align=0; offset=0l; sz=None}; Call ctx.store_local_i64] in
+(*      res := !res @ (Const (it (I32 (Int32.of_int i))) :: lst) *)
+      res := !res @ lst
+   done;
+   !res
+
 let store_locals ctx =
 (*   let num_locals = List.length ctx.tctx.Valid.locals in *)
    let res = ref [] in
-   for i = 0 to ctx.orig_locals - 1 do
+   for i = ctx.params to ctx.orig_locals - 1 do
       let var = it (Int32.of_int i) in
       let lst = match Valid.local ctx.tctx var with
       | I32Type -> [GetLocal var; Call ctx.store_local_i32]
@@ -190,6 +206,8 @@ let rec process_inst ctx inst =
       try [Const (it (I32 (Int32.of_int (ctx.find_return_pc id)))); Call ctx.store_call]
       with Not_found -> prerr_endline ("warning: call return location not found " ^ Int32.to_string id); [] in
     [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ save_call), [])] in
+  let s_block3 () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
    | FuncType (_, [ty]) -> call :: store_top ctx ty (* adjust stack will have to check if it is critical *)
@@ -201,8 +219,8 @@ let rec process_inst ctx inst =
   | If (ty, l1, l2) -> [If (ty, List.flatten (List.map (process_inst ctx) l1), List.flatten (List.map (process_inst ctx) l2))]
   | Loop (ty, lst) -> [Loop (ty, List.map it (s_block2 ()) @ List.flatten (List.map (process_inst ctx) lst))]
   (* Just before call, store all locals (arguments will be stored later, but what if builtin) *)
-  | Call x -> s_block () @ e_block (Call x) (ctx.var_type x.it) @ s_block ()
-  | CallIndirect x -> (* prerr_endline ("at call " ^ Int32.to_string id); *) s_block () @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block ()
+  | Call x -> s_block () @ e_block (Call x) (ctx.var_type x.it) @ s_block3 ()
+  | CallIndirect x -> (* prerr_endline ("at call " ^ Int32.to_string id); *) s_block () @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block3 ()
   | a -> [a] in
   List.map it res
 
@@ -215,7 +233,7 @@ let process_function ctx f =
   let ctx = {ctx with tctx=Valid.func_context ctx.tctx f} in
   (* let FuncType (_, rets) = ctx.lookup_type f.it.ftype.it in *)
   let s_block = List.map it [
-     Call ctx.store_arg; If ([], List.map it (store_locals ctx), [])
+     Call ctx.store_arg; If ([], List.map it (store_params ctx), [])
   ] in
   do_it f (fun f -> {f with body=s_block @ List.flatten (List.map (process_inst ctx) f.body)})
 
@@ -246,6 +264,9 @@ let process m_orig =
   let orig_locals = List.map (fun f ->
       let FuncType (par,_) = Hashtbl.find ttab f.it.ftype.it in
       List.length f.it.locals + List.length par) m_orig.it.funcs in
+  let f_params = List.map (fun f ->
+      let FuncType (par,_) = Hashtbl.find ttab f.it.ftype.it in
+      List.length par) m_orig.it.funcs in
   (* Information about hidden variables is at [Secretstack.info] *)
   do_it m (fun m ->
     (* add function types *)
@@ -327,9 +348,10 @@ let process m_orig =
       bottom = List.hd (List.rev pos_lst); *)
       label = 0;
       orig_locals = 0;
+      params = 0;
       func_idx = 0;
       find_return_pc = (fun x -> Hashtbl.find return_pc x);
     } in
-    let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i; func_idx=i} f) pre_m.funcs} in
+    let res = {pre_m with funcs=List.mapi (fun i f -> process_function {ctx with orig_locals=List.nth orig_locals i; params=List.nth f_params i; func_idx=i} f) pre_m.funcs} in
     res)
 
diff --git a/interpreter/merkle/critical.ml b/interpreter/merkle/critical.ml
index 4a4e5e3..b6c14be 100644
--- a/interpreter/merkle/critical.ml
+++ b/interpreter/merkle/critical.ml
@@ -15,7 +15,7 @@ type ctx = {
 type ctx = {
   enter_loop : var;
   push_func : var;
-  enter_func : var;
+(*  enter_func : var; *)
   pop : var;
   loc : Int32.t;
   f_loops : Int32.t list;
@@ -43,6 +43,10 @@ let process_function ctx f =
     {f with body= (* List.map it [Const (it (I32 loc)); Call ctx.push_func] @ *) List.flatten (List.map (process_inst ctx) f.body)})
 
 let process m =
+(*
+  let m = Secretstack.relabel m in
+  let m = Secretstack.process m in
+*)
   do_it m (fun m ->
     (* add function types *)
     let i_num = List.length (func_imports (it m)) in
@@ -61,14 +65,14 @@ let process m =
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "popFuncCritical"; idesc=it (FuncImport set_type)};
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "enterLoopCritical"; idesc=it (FuncImport pop_type)};
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "pushFuncCritical"; idesc=it (FuncImport set_type)};
-       it {module_name=Utf8.decode "env"; item_name=Utf8.decode "enterFuncCritical"; idesc=it (FuncImport pop_type)};
+(*       it {module_name=Utf8.decode "env"; item_name=Utf8.decode "enterFuncCritical"; idesc=it (FuncImport pop_type)}; *)
     ] in
     let imps = m.imports @ added in
     let ctx = {
       pop = it (Int32.of_int (i_num+0));
       enter_loop = it (Int32.of_int (i_num+1));
       push_func = it (Int32.of_int (i_num+2));
-      enter_func = it (Int32.of_int (i_num+3));
+(*      enter_func = it (Int32.of_int (i_num+3)); *)
       f_loops = [];
       loc = 0l;
     } in

From 024f6d0172a3aae376ae0f583a49534cf6c702b9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 17 Dec 2018 08:31:15 +0200
Subject: [PATCH 12/22] adding PCs for breakpoints

---
 interpreter/main/flags.ml        |  2 ++
 interpreter/merkle/buildstack.ml | 31 +++++++++++++++++++------------
 interpreter/merkle/merkle.ml     | 16 +++++++++-------
 interpreter/merkle/mrun.ml       |  8 +++++++-
 4 files changed, 37 insertions(+), 20 deletions(-)

diff --git a/interpreter/main/flags.ml b/interpreter/main/flags.ml
index c2d9fe6..1be324f 100644
--- a/interpreter/main/flags.ml
+++ b/interpreter/main/flags.ml
@@ -16,6 +16,8 @@ let debug_error = ref false
 
 let disable_float = ref false
 
+let br_mode = ref false
+
 let trace_from = ref (-1)
 
 let insert_error = ref (-1)
diff --git a/interpreter/merkle/buildstack.ml b/interpreter/merkle/buildstack.ml
index 92f3123..48f5787 100644
--- a/interpreter/merkle/buildstack.ml
+++ b/interpreter/merkle/buildstack.ml
@@ -36,6 +36,7 @@ type ctx = {
 
   store_indirect : var;
   store_call : var;
+  store_pc : var;
 
   adjust_stack_i32 : var;
   adjust_stack_i64 : var;
@@ -199,15 +200,17 @@ let store_hidden ctx id =
 
 let rec process_inst ctx inst =
   let id = Int32.of_int inst.at.right.line in
-  let s_block2 () =
-    [Call ctx.count; If ([], List.map it (store_locals ctx), [])] in
-  let s_block () =
-    let save_call =
-      try [Const (it (I32 (Int32.of_int (ctx.find_return_pc id)))); Call ctx.store_call]
-      with Not_found -> prerr_endline ("warning: call return location not found " ^ Int32.to_string id); [] in
-    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ save_call), [])] in
-  let s_block3 () =
-    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id), [])] in
+  let i_loc =
+     try ctx.find_return_pc id
+     with Not_found -> 0 in
+  let s_block_loop () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ [Const (it (I32 (Int32.of_int i_loc))); Call ctx.store_pc]), [])] in
+  let s_block_call () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ [Const (it (I32 (Int32.of_int i_loc))); Call ctx.store_call; Const (it (I32 (Int32.of_int (i_loc-2)))); Call ctx.store_pc]), [])] in
+  let s_block_calli () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ [Const (it (I32 (Int32.of_int i_loc))); Call ctx.store_call; Const (it (I32 (Int32.of_int (i_loc-2)))); Call ctx.store_pc]), [])] in
+  let s_block_return () =
+    [Call ctx.count; If ([], List.map it (store_locals ctx @ store_hidden ctx id @ [Const (it (I32 (Int32.of_int i_loc))); Call ctx.store_pc]), [])] in
   let e_block call = function
    | FuncType (_, []) -> [call]
    | FuncType (_, [ty]) -> call :: store_top ctx ty (* adjust stack will have to check if it is critical *)
@@ -217,10 +220,10 @@ let rec process_inst ctx inst =
   let res = match inst.it with
   | Block (ty, lst) -> [Block (ty, List.flatten (List.map (process_inst ctx) lst))]
   | If (ty, l1, l2) -> [If (ty, List.flatten (List.map (process_inst ctx) l1), List.flatten (List.map (process_inst ctx) l2))]
-  | Loop (ty, lst) -> [Loop (ty, List.map it (s_block2 ()) @ List.flatten (List.map (process_inst ctx) lst))]
+  | Loop (ty, lst) -> [Loop (ty, List.map it (s_block_loop ()) @ List.flatten (List.map (process_inst ctx) lst))]
   (* Just before call, store all locals (arguments will be stored later, but what if builtin) *)
-  | Call x -> s_block () @ e_block (Call x) (ctx.var_type x.it) @ s_block3 ()
-  | CallIndirect x -> (* prerr_endline ("at call " ^ Int32.to_string id); *) s_block () @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block3 ()
+  | Call x -> s_block_call () @ e_block (Call x) (ctx.var_type x.it) @ s_block_return ()
+  | CallIndirect x -> (* prerr_endline ("at call " ^ Int32.to_string id); *) s_block_calli () @ [Call ctx.store_indirect] @ e_block (CallIndirect x) (ctx.lookup_type x.it) @ s_block_return ()
   | a -> [a] in
   List.map it res
 
@@ -252,9 +255,11 @@ let list_to_map lst =
 
 let process m_orig =
   let m = Secretstack.relabel m_orig in
+  Flags.br_mode := true;
   let code = Run.get_code m in
   let return_pc = Hashtbl.create 100 in
   let handle i = function
+   | Merkle.BREAKPOINT id -> Hashtbl.add return_pc id i
    | Merkle.CALL (_, id) -> Hashtbl.add return_pc id i
    | Merkle.CALLI id -> Hashtbl.add return_pc id i (* ; prerr_endline ("adding " ^ Int32.to_string id) *)
    | _ -> () in
@@ -310,6 +315,7 @@ let process m_orig =
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "testStep"; idesc=it (FuncImport count_type)};
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storeIndirect"; idesc=it (FuncImport adjust_stack_i32)};
        it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storeReturnPC"; idesc=it (FuncImport store_type_i32)};
+       it {module_name=Utf8.decode "env"; item_name=Utf8.decode "storePC"; idesc=it (FuncImport store_type_i32)};
     ] in
     let imps = m.imports @ added in
     (*
@@ -342,6 +348,7 @@ let process m_orig =
       is_critical = it (Int32.of_int (i_num+10));
       store_indirect = it (Int32.of_int (i_num+11));
       store_call = it (Int32.of_int (i_num+12));
+      store_pc = it (Int32.of_int (i_num+13));
       var_type = Hashtbl.find ftab;
       lookup_type = Hashtbl.find ttab;
       (* possible = (fun loc -> Hashtbl.mem pos_tab loc);
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index 51b0a83..c949bb9 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -66,6 +66,7 @@ type inst =
  | SETGLOBALS of int
  | SETMEMORY of int
  | CUSTOM of int
+ | BREAKPOINT of Int32.t
 
 type control = {
   target : int;
@@ -81,6 +82,7 @@ type context = {
   f_types2 : (Int32.t, func_type) Hashtbl.t;
   block_return : control list;
   mdle : Ast.module_';
+  add_points : bool;
 }
 
 (* Push the break points to stack? they can have own stack, also returns will have the same *)
@@ -140,7 +142,7 @@ and compile' ctx id = function
    let ctx = {ctx with label=ctx.label+1; bptr=ctx.bptr+1; block_return={level=ctx.ptr+rets; rets=rets; target=start_label}::old_return} in
    let ctx, body = compile_block ctx lst in
    (* trace ("loop end " ^ string_of_int ctx.ptr); *)
-   {ctx with bptr=ctx.bptr-1; block_return=old_return}, [LABEL start_label] @ body
+   {ctx with bptr=ctx.bptr-1; block_return=old_return}, [LABEL start_label] @ ( if ctx.add_points then [BREAKPOINT id] else [] ) @ body
  | If (ty, texp, fexp) ->
    (* trace ("if " ^ string_of_int ctx.ptr); *)
    let else_label = ctx.label in
@@ -197,12 +199,13 @@ and compile' ctx id = function
    (* Will just push the pc *)
    (* trace ("Function call " ^ Int32.to_string v.it); *)
    let FuncType (par,ret) = Hashtbl.find ctx.f_types v.it in
-   {ctx with ptr=ctx.ptr+List.length ret-List.length par}, [CALL (Int32.to_int v.it, id)]
+   let br = if ctx.add_points then [BREAKPOINT id] else [] in
+   {ctx with ptr=ctx.ptr+List.length ret-List.length par}, br @ [CALL (Int32.to_int v.it, id)] @ br
  | CallIndirect v ->
    let FuncType (par,ret) = Hashtbl.find ctx.f_types2 v.it in
-   
    (* trace ("call indirect type: " ^ Int64.to_string (Byteutil.ftype_hash (FuncType (par,ret)))); *)
-   {ctx with ptr=ctx.ptr+List.length ret-List.length par-1}, [CHECKCALLI (Byteutil.ftype_hash (FuncType (par,ret))); CALLI id]
+   let br = if ctx.add_points then [BREAKPOINT id] else [] in
+   {ctx with ptr=ctx.ptr+List.length ret-List.length par-1}, br @ [CHECKCALLI (Byteutil.ftype_hash (FuncType (par,ret))); CALLI id] @ br
  | Select ->
    (* trace "select"; *)
    let else_label = ctx.label in
@@ -287,8 +290,7 @@ let resolve_inst2 tab = function
  | CALL (l, id) -> CALL (Hashtbl.find tab l, id)
  | a -> a
 
-let empty_ctx mdle = {ptr=0; label=0; bptr=0; block_return=[]; f_types2=Hashtbl.create 1; f_types=Hashtbl.create 1; mdle}
-
+let empty_ctx mdle = {ptr=0; label=0; bptr=0; block_return=[]; f_types2=Hashtbl.create 1; f_types=Hashtbl.create 1; mdle; add_points=false}
 
 let malloc_string mdle malloc str =
   let open Memory in
@@ -545,7 +547,7 @@ let compile_test m func vs init inst =
      generic_stub m inst mname fname ) f_imports in
   let module_codes = List.mapi (fun i f ->
      if f = func then trace "*************** CURRENT ";
-     compile_func {(empty_ctx m) with f_types2=ttab; f_types=ftab} (i + List.length f_imports) f) m.funcs in
+     compile_func {(empty_ctx m) with f_types2=ttab; f_types=ftab; add_points = !Flags.br_mode} (i + List.length f_imports) f) m.funcs in
   let f_resolve = Hashtbl.create 10 in
   let rec build n acc l_acc = function
    | [] -> acc
diff --git a/interpreter/merkle/mrun.ml b/interpreter/merkle/mrun.ml
index 5836f8b..f2d30f4 100644
--- a/interpreter/merkle/mrun.ml
+++ b/interpreter/merkle/mrun.ml
@@ -47,6 +47,7 @@ type alu_code =
  | DebugInt
  | DebugString
  | DebugBuffer
+ | Breakpoint
 
 type reg =
  | Reg1
@@ -631,7 +632,7 @@ let print_conv64 = function
  | I64Op.ReinterpretFloat -> "reinterpret"
 
 exception FloatsDisabled
-
+exception BreakpointExn
 
 let handle_alu vm r1 r2 r3 ireg = function
  | FixMemory (ty, sz) -> mem_load r2 r3 ty sz (value_to_int r1+value_to_int ireg)
@@ -688,11 +689,13 @@ let handle_alu vm r1 r2 r3 ireg = function
    let ptr = value_to_int (vm.stack.(vm.stack_ptr - 1)) in
    prerr_endline ("DEBUG: " ^ string_of_int ptr);
    i 0
+ | Breakpoint -> raise BreakpointExn
 
 open Ast
 
 let get_code = function
  | NOP -> noop
+ | BREAKPOINT _ -> {noop with alu_code=Breakpoint}
  | STUB _ -> noop
  | UNREACHABLE -> {noop with alu_code=Trap}
  | EXIT -> {noop with immed=I64 (Int64.of_int magic_pc); read_reg1 = Immed; pc_ch=StackReg}
@@ -865,6 +868,7 @@ let vm_step vm = match vm.code.(vm.pc) with
    vm.calltable_types.(x) <- value_to_int64 vm.stack.(vm.stack_ptr-1);
    vm.stack_ptr <- vm.stack_ptr - 1
  | EXIT -> vm.pc <- magic_pc
+ | BREAKPOINT _ -> raise BreakpointExn
  | UNREACHABLE -> raise (Eval.Trap (Source.no_region, "unreachable executed"))
  | JUMPFORWARD x ->
    let idx = value_to_int vm.stack.(vm.stack_ptr-1) in
@@ -1152,6 +1156,7 @@ let trace_step vm =
  if Array.length vm.code <= vm.pc then "Microp" else
  match vm.code.(vm.pc) with
  | NOP -> "NOP"
+ | BREAKPOINT _ -> "BREAKPOINT"
  | STUB str -> "STUB " ^ str
  | UNREACHABLE -> "UNREACHABLE"
  | EXIT -> "EXIT"
@@ -1213,6 +1218,7 @@ let trace_step vm =
 
 let trace_clean vm = match vm.code.(vm.pc) with
  | NOP -> "NOP"
+ | BREAKPOINT _ -> "BREAKPOINT"
  | STUB str -> "STUB " ^ str
  | UNREACHABLE -> "UNREACHABLE"
  | EXIT -> "EXIT"

From da371b02d5e33e05c742f7e4a6af4e27532208c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Tue, 18 Dec 2018 18:32:25 +0200
Subject: [PATCH 13/22] loading intermediate state and starting execution form
 there

---
 interpreter/main/main.ml        |  6 ++++++
 interpreter/merkle/loadstate.ml | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+)
 create mode 100644 interpreter/merkle/loadstate.ml

diff --git a/interpreter/main/main.ml b/interpreter/main/main.ml
index a1225d3..48e46ab 100644
--- a/interpreter/main/main.ml
+++ b/interpreter/main/main.ml
@@ -39,6 +39,8 @@ let add_arg source = args := !args @ [source]
 
 let quote s = "\"" ^ String.escaped s ^ "\""
 
+let inter_mode = ref false
+
 let merge_mode = ref false
 let float_mode = ref false
 let float_error_mode = ref false
@@ -81,6 +83,7 @@ let argspec = Arg.align
   "-t", Arg.Set Flags.trace, " trace execution";
   "-v", Arg.Unit banner, " show version";
 
+  "-inter", Arg.Set inter_mode, " start execution at an intermediate state";
   "-critical", Arg.Set critical_mode, " find the critical path to step";
   "-limit-stack", Arg.Set check_stack_mode, " check sizes of stack frames";
   "-build-stack", Arg.Set buildstack_mode, " build the stack for critical path";
@@ -200,6 +203,9 @@ let () =
       Run.create_sexpr_file "critical.wast" () (fun () -> m);
       Run.create_binary_file "critical.wasm" () (fun () -> m)
     | _ -> () );
+    ( match !inter_mode, !lst with
+    | true, m :: _ -> Loadstate.run m
+    | _ -> () );
     ( match !secret_stack_mode, !lst with
     | true, m :: _ ->
       let m = Secretstack.process m in
diff --git a/interpreter/merkle/loadstate.ml b/interpreter/merkle/loadstate.ml
new file mode 100644
index 0000000..3045c7b
--- /dev/null
+++ b/interpreter/merkle/loadstate.ml
@@ -0,0 +1,32 @@
+
+(* Loading an intermediate state and running from there *)
+
+open Source
+open Sourceutil
+
+let load_file vm =
+  let open Yojson.Basic in
+  let open Mrun in
+  let data = from_channel (open_in "state.json") in
+  vm.pc <- Util.to_int (Util.member "pc" data) + 1;
+  let call_lst = List.map Util.to_int (Util.to_list (Util.member "call_stack" data)) in
+  let stack_lst = List.map Util.to_int (Util.to_list (Util.member "stack" data)) in
+  vm.stack <- Array.make (Byteutil.pow2 !Flags.stack_size) (i 0);
+  vm.call_stack <- Array.make (Byteutil.pow2 !Flags.call_size) 0;
+  vm.stack_ptr <- List.length stack_lst;
+  vm.call_ptr <- List.length call_lst;
+  List.iteri (fun j elem -> vm.call_stack.(j) <- elem) call_lst;
+  List.iteri (fun j elem -> vm.stack.(j) <- Values.I64 (Int64.of_int elem)) stack_lst
+
+let run mdle =
+  Flags.br_mode := true;
+  let imports = Import.link mdle in
+  let inst = Eval.init mdle imports in
+  let func = match Instance.export inst (Utf8.decode "_main") with
+      | Some (Instance.ExternalFunc (Instance.AstFunc (_, func))) -> func
+      | _ -> raise (Failure "no main function") in
+  let vm = Run.setup_vm inst mdle.it func [] in
+  load_file vm;
+  (* here we should load *)
+  ignore (Run.run_test_aux vm)
+

From a5f7268da0ecc2901788c388e5fd2c75d9732c8a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Wed, 19 Dec 2018 15:13:48 +0200
Subject: [PATCH 14/22] convert invokes into dyncalls

---
 interpreter/main/main.ml | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/interpreter/main/main.ml b/interpreter/main/main.ml
index 48e46ab..82c267b 100644
--- a/interpreter/main/main.ml
+++ b/interpreter/main/main.ml
@@ -54,6 +54,7 @@ let underscore_mode = ref false
 let counter_mode = ref false
 let test_counter_mode = ref false
 let handle_nan_mode = ref false
+let dyncall_mode = ref false
 
 let critical_mode = ref false
 let buildstack_mode = ref false
@@ -109,6 +110,7 @@ let argspec = Arg.align
   "-counter", Arg.Set counter_mode, " add a counter variable to the file";
   "-test-counter", Arg.Set test_counter_mode, " add a counter variable to the file (new test version)";
   "-handle-nan", Arg.Set handle_nan_mode, " canonize floating point values to remove non-determinism";
+  "-dyncall", Arg.Set dyncall_mode, " simplify dynamic calls";
   "-add-globals", Arg.String (fun s -> globals_file := Some s), " add globals to the module";
   "-init-code", Arg.String (fun s -> add_arg ("(input " ^ quote s ^ ")") ; init_code := Some s), " output initial code for a wasm file";
   "-imports", Arg.Set print_imports, " print imports from the wasm file";
@@ -230,6 +232,12 @@ let () =
       Run.create_sexpr_file "intfloat.wast" () (fun () -> m);
       Run.create_binary_file "intfloat.wasm" () (fun () -> m)
     | _ -> () );
+    ( match !dyncall_mode, !lst with
+    | true, a :: _ ->
+      let m = Dyncall.process a in
+      Run.create_sexpr_file "dyncall.wast" () (fun () -> m);
+      Run.create_binary_file "dyncall.wasm" () (fun () -> m)
+    | _ -> () );
     ( match !float_error_mode, !lst with
     | true, a :: _ ->
       let m = Floaterror.process a in

From 79aa2ed6b772a25275431a6286f851b0c9da233f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Wed, 19 Dec 2018 15:14:00 +0200
Subject: [PATCH 15/22] convert invokes into dyncalls

---
 interpreter/merkle/dyncall.ml | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 interpreter/merkle/dyncall.ml

diff --git a/interpreter/merkle/dyncall.ml b/interpreter/merkle/dyncall.ml
new file mode 100644
index 0000000..f46df6c
--- /dev/null
+++ b/interpreter/merkle/dyncall.ml
@@ -0,0 +1,27 @@
+
+open Ast
+open Source
+open Sourceutil
+
+(* Handling dynamic calls *)
+let process m =
+  let imports = Import.link m in
+  let inst = Eval.init m imports in
+  let tab = Hashtbl.create 10 in
+  let handle_import num im =
+     let mname = Utf8.encode im.it.module_name in
+     let fname = Utf8.encode im.it.item_name in
+     if mname = "env" && String.length fname > 8 && String.sub fname 0 8 = "_invoke_" then begin
+       let number = String.sub fname 8 (String.length fname - 8) in
+       try
+         let idx = find_function_index m.it inst (Utf8.decode ("_dynCall_" ^ number)) in
+         Hashtbl.add tab (Int32.of_int num) (Int32.of_int idx)
+       with Not_found -> prerr_endline ("Warning: cannot find dynamic call with signature " ^ number)
+     end in
+  List.iteri handle_import (Sourceutil.func_imports m);
+  let fmap x = try Hashtbl.find tab x with Not_found -> x in
+  do_it m (fun m ->
+     {m with funcs = List.map (Merge.remap fmap (fun x -> x) (fun x -> x)) m.funcs;
+        elems = List.map (Merge.remap_elements fmap) m.elems;}
+  )
+

From 0598849fc24fff6c3d9231e1325614121be3b391 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Thu, 14 Feb 2019 02:09:56 -0800
Subject: [PATCH 16/22] table import

---
 interpreter/merkle/addglobals.ml | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/interpreter/merkle/addglobals.ml b/interpreter/merkle/addglobals.ml
index 11e2bba..1385225 100644
--- a/interpreter/merkle/addglobals.ml
+++ b/interpreter/merkle/addglobals.ml
@@ -159,9 +159,15 @@ let add_globals m fn =
      module_name=Utf8.decode "env";
      item_name=Utf8.decode "memory";
   } in
+  let table = if other_imports_nomem m = [] then [] else [
+  elem {idesc=elem (TableImport (TableType ({min=100000l; max=None}, AnyFuncType)));
+     module_name=Utf8.decode "env";
+     item_name=Utf8.decode "table";
+  }
+  ] in
   {m with it={(m.it) with funcs = funcs_a; data=m.it.data@new_data;
      globals = List.map (remap_global (fun x -> x) (Hashtbl.find gmap1) (Hashtbl.find gmap2) ftmap1) m.it.globals;
-     imports = List.rev !g_imports @ func_imports m @ other_imports_nomem m @ [elem mem];
+     imports = List.rev !g_imports @ func_imports m @ table @ [elem mem];
      exports = exports_a;
      elems = List.map (remap_elem_segments (fun x -> x) (Hashtbl.find gmap1) (Hashtbl.find gmap2) ftmap1) m.it.elems;
   }}

From 6f8f045be92b015d98723e9503459b187ab2427a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 18 Feb 2019 02:51:14 -0800
Subject: [PATCH 17/22] improved file handling, also unknown calls become
 errors now

---
 interpreter/merkle/mbinary.ml |  1 +
 interpreter/merkle/merkle.ml  |  6 ++++++
 interpreter/script/run.ml     | 18 ++++++++++--------
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/interpreter/merkle/mbinary.ml b/interpreter/merkle/mbinary.ml
index cec9841..520d2b4 100644
--- a/interpreter/merkle/mbinary.ml
+++ b/interpreter/merkle/mbinary.ml
@@ -432,6 +432,7 @@ let rec makeMerkle16 arr idx level =
        if level = 0 then ( if idx < Array.length arr then arr.(idx) else ( (* prerr_endline "here" ; *) zeroword16 ) )
        else keccak (makeMerkle16 arr idx (level-1)) (makeMerkle16 arr (idx+pow2 (level-1)) (level-1)) in
      Hashtbl.add cache16 key res;
+(*     prerr_endline ("here " ^ w256_to_string res); *)
      res
 
 let rec makeMerkle arr idx level =
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index c949bb9..a0150cc 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -369,6 +369,11 @@ let make_cxx_init mdle inst =
   (* @
   [STUB "Initialization finished"] *)
 
+let generic_stub m inst mname fname =
+    try [STUB (mname ^ " . " ^ fname); CALL (find_function_index m inst (Utf8.decode "_finalizeSystem"), 0l); EXIT]
+    with Not_found -> [STUB (mname ^ " . " ^ fname); EXIT]
+
+(*
 let generic_stub m inst mname fname =
   try
   [STUB (mname ^ " . " ^ fname);
@@ -384,6 +389,7 @@ let generic_stub m inst mname fname =
    LABEL (-3);
    RETURN]
   with Not_found -> [STUB (mname ^ " . " ^ fname); RETURN]
+*)
 
 let mem_init_size m =
   if !Flags.run_wasm || !Flags.disable_float then Byteutil.pow2 (!Flags.memory_size - 13) else
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index a3f6eb2..740298f 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -321,14 +321,16 @@ let add_input vm i fname =
   let open Mrun in
   vm.input.file_name.(i) <- terminate fname;
   let fname = if !Flags.input_out then fname ^ ".out" else fname in
-  let ch = open_in_bin fname in
-  let sz = in_channel_length ch in
-  vm.input.file_size.(i) <- sz;
-  let dta = Bytes.create sz in
-  really_input ch dta 0 sz;
-  close_in ch;
-  vm.input.file_data.(i) <- dta;
-  trace ("Added file " ^ fname ^ ", " ^ string_of_int sz ^ " bytes")
+  try
+    let ch = open_in_bin fname in
+    let sz = in_channel_length ch in
+    vm.input.file_size.(i) <- sz;
+    let dta = Bytes.create sz in
+    really_input ch dta 0 sz;
+    close_in ch;
+    vm.input.file_data.(i) <- dta;
+    trace ("Added file " ^ fname ^ ", " ^ string_of_int sz ^ " bytes")
+  with _ -> prerr_endline ("Warning: cannot find file " ^ fname )
 
 let output_files vm =
   let open Mrun in

From 1ed81b1465eaa81fce555f10d192af181efc0bbd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Fri, 22 Feb 2019 01:19:37 -0800
Subject: [PATCH 18/22] added fast output IO hash

---
 interpreter/main/flags.ml | 1 +
 interpreter/main/main.ml  | 1 +
 interpreter/script/run.ml | 3 +++
 3 files changed, 5 insertions(+)

diff --git a/interpreter/main/flags.ml b/interpreter/main/flags.ml
index 1be324f..0b4526f 100644
--- a/interpreter/main/flags.ml
+++ b/interpreter/main/flags.ml
@@ -72,6 +72,7 @@ let input_all_file_proofs = ref false
 let input_proof = ref false
 let input_out = ref false
 let output_proof = ref false
+let output_io_proof = ref false
 
 let sbrk_offset = ref 0l
 
diff --git a/interpreter/main/main.ml b/interpreter/main/main.ml
index 82c267b..98eafd4 100644
--- a/interpreter/main/main.ml
+++ b/interpreter/main/main.ml
@@ -157,6 +157,7 @@ let argspec = Arg.align
   "-input", Arg.Set Flags.input_proof, " output information about input";
   "-input2", Arg.Set Flags.input_out, " output information about input";
   "-output", Arg.Set Flags.output_proof, " output information about output";
+  "-output-io", Arg.Set Flags.output_io_proof, " output information about output";
   "-sbrk-offset", Arg.Int (fun n -> Flags.sbrk_offset := Int32.of_int n), " memory offset used by sbrk";
   "-output-step", Arg.Int (fun x -> Flags.output_file_at := x), " for which step the file will be output";
   "-output-file", Arg.Int (fun x -> Flags.output_file_number := x), " which file will be output at the given step";
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index 740298f..88a11ba 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -429,6 +429,9 @@ let handle_exit vm selected =
   if selected && !Flags.output_proof then begin
      let vm_bin = Mbinary.vm_to_bin vm in
       Printf.printf "{\"vm\": %s, \"hash\": %s, \"steps\": %i, \"files\": %s}\n" (Mproof.vm_to_string vm_bin) (Mproof.to_hex (Mbinary.hash_io_bin vm_bin)) vm.step (print_file_names vm)
+  end;
+  if selected && !Flags.output_io_proof then begin
+      Printf.printf "{\"hash\": %s, \"steps\": %i, \"files\": %s}\n" (Mproof.to_hex (Mbinary.hash_io vm)) vm.step (print_file_names vm)
   end
 
 let run_test_aux vm =

From f582037c837c0a4771fa28436a046b7d466445be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Fri, 22 Feb 2019 01:32:40 -0800
Subject: [PATCH 19/22] added fast output IO hash, also VM

---
 interpreter/merkle/mproof.ml | 12 ++++++++++++
 interpreter/script/run.ml    |  2 +-
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/interpreter/merkle/mproof.ml b/interpreter/merkle/mproof.ml
index b35f6ac..2ff4264 100644
--- a/interpreter/merkle/mproof.ml
+++ b/interpreter/merkle/mproof.ml
@@ -732,6 +732,18 @@ let vm_to_string vm =
   " \"memsize\": " ^ string_of_int vm.bin_memsize ^ " " ^
   "}"
 
+let vm_io_to_string vm =
+  let code_bin = map_hash (fun v -> microp_word (get_code v)) vm.code in
+  let input_size_bin = map_hash u256 vm.input.file_size in
+  let input_name_bin = map_hash string_to_root vm.input.file_name in
+  let input_data_bin = map_hash bytes_to_root vm.input.file_data in
+  "{" ^
+  " \"code\": " ^ to_hex code_bin ^ "," ^
+  " \"input_size\": " ^ to_hex input_size_bin ^ "," ^
+  " \"input_name\": " ^ to_hex input_name_bin ^ "," ^
+  " \"input_data\": " ^ to_hex input_data_bin ^
+  "}"
+
 let proof3_to_string (m, vm, loc) =
   "{ \"vm\": " ^ vm_to_string vm ^ ", \"machine\": " ^ machine_to_string m ^ ", \"merkle\": " ^ loc_to_string loc ^ " }"
 
diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml
index 88a11ba..ad6b5d2 100644
--- a/interpreter/script/run.ml
+++ b/interpreter/script/run.ml
@@ -431,7 +431,7 @@ let handle_exit vm selected =
       Printf.printf "{\"vm\": %s, \"hash\": %s, \"steps\": %i, \"files\": %s}\n" (Mproof.vm_to_string vm_bin) (Mproof.to_hex (Mbinary.hash_io_bin vm_bin)) vm.step (print_file_names vm)
   end;
   if selected && !Flags.output_io_proof then begin
-      Printf.printf "{\"hash\": %s, \"steps\": %i, \"files\": %s}\n" (Mproof.to_hex (Mbinary.hash_io vm)) vm.step (print_file_names vm)
+      Printf.printf "{\"vm\": %s, \"hash\": %s, \"steps\": %i, \"files\": %s}\n" (Mproof.vm_io_to_string vm) (Mproof.to_hex (Mbinary.hash_io vm)) vm.step (print_file_names vm)
   end
 
 let run_test_aux vm =

From f35fee1bfb4135ed8fe18e2b6515e6689989c972 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Thu, 7 Mar 2019 07:18:39 -0800
Subject: [PATCH 20/22] do not print long buffers

---
 interpreter/merkle/mrun.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/interpreter/merkle/mrun.ml b/interpreter/merkle/mrun.ml
index f2d30f4..bd072b7 100644
--- a/interpreter/merkle/mrun.ml
+++ b/interpreter/merkle/mrun.ml
@@ -264,7 +264,7 @@ let get_vm_string vm loc =
 let get_vm_buffer vm loc len =
   let res = ref "" in
 (*  let loc = ref (get_memory_int vm loc) in *)
-  for i = 0 to len - 1 do
+  for i = 0 to min (len - 1) 256 do
     res := !res ^ String.make 1 (get_memory_char vm (loc+i));
   done;
   !res

From 58e29459d0609de5daa9d1406d2b39e315fbdacf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Mon, 18 Mar 2019 01:18:14 -0700
Subject: [PATCH 21/22] set memory offset from global

---
 interpreter/merkle/intfloat.ml | 6 ++++--
 interpreter/merkle/merkle.ml   | 5 +++++
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/interpreter/merkle/intfloat.ml b/interpreter/merkle/intfloat.ml
index 43b6f34..d84693d 100644
--- a/interpreter/merkle/intfloat.ml
+++ b/interpreter/merkle/intfloat.ml
@@ -157,5 +157,7 @@ let convert_float m =
   do_it m (fun m -> {m with funcs=List.map convert_func m.funcs; globals=List.map convert_global m.globals})
 
 let process a b =
-  convert_float (convert_types (merge a b))
-  
+  let res = convert_float (convert_types (merge a b)) in
+  (* Need to add memory offset here *)
+  add_i32_global res "MEMORY_OFFSET" (!Flags.memory_offset)
+
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index a0150cc..b27bdd1 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -433,6 +433,11 @@ let generate_exit id_to_local (lst, others) =
 
 let compile_test m func vs init inst =
   (* debug_exports m; *)
+  (try
+      let g_ind = find_global_index (elem m) (Utf8.decode "MEMORY_OFFSET") in
+      let g = List.nth m.globals g_ind in
+      Flags.memory_offset := value_to_int (Eval.eval_const inst g.it.value)
+   with Not_found -> () );
   trace ("Function types: " ^ string_of_int (List.length m.types));
   trace ("Functions: " ^ string_of_int (List.length m.funcs));
   trace ("Tables: " ^ string_of_int (List.length m.tables));

From dd9e94385cd7fa8583a9bd2b1b79a4ea0a5f0bbe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Sami=20M=C3=A4kel=C3=A4?= <mrsmkl@gmail.com>
Date: Wed, 20 Mar 2019 03:19:42 -0700
Subject: [PATCH 22/22] env.gas is now synonym for env.usegas

---
 interpreter/binary/decode.ml | 12 +++++++++---
 interpreter/merkle/merkle.ml |  2 +-
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml
index a266634..841e685 100644
--- a/interpreter/binary/decode.ml
+++ b/interpreter/binary/decode.ml
@@ -95,7 +95,11 @@ let rec vsN n s =
   else Int64.(logor x (shift_left (vsN (n - 7) s) 7))
 
 let vu1 s = Int64.to_int (vuN 1 s)
-let vu32 s = Int64.to_int32 (vuN 32 s)
+let vu32 s =
+  let res = Int64.to_int32 (vuN 32 s) in
+  (* prerr_endline ("Got int " ^ Int32.to_string res); *)
+  res
+
 let vs7 s = Int64.to_int (vsN 7 s)
 let vs32 s = Int64.to_int32 (vsN 32 s)
 let vs64 s = vsN 64 s
@@ -116,8 +120,10 @@ let vec f s = let n = len32 s in list f n s
 
 let name s =
   let pos = pos s in
-  try Utf8.decode (string s) with Utf8.Utf8 ->
-    error s pos "invalid UTF-8 encoding"
+  let str = string s in
+  (* prerr_endline ("??? " ^ str) ; *)
+  try Utf8.decode str with Utf8.Utf8 ->
+    ( prerr_endline ("??? " ^ str) ; error s pos "invalid UTF-8 encoding" )
 
 let sized f s =
   let size = len32 s in
diff --git a/interpreter/merkle/merkle.ml b/interpreter/merkle/merkle.ml
index b27bdd1..8e17cef 100644
--- a/interpreter/merkle/merkle.ml
+++ b/interpreter/merkle/merkle.ml
@@ -541,7 +541,7 @@ let compile_test m func vs init inst =
           PUSH (I32 0l); LOADGLOBAL frame_stack; BIN (I32 I32Op.Sub); STOREGLOBAL frame_stack;
           LOADGLOBAL call_stack; PUSH (I32 1l); BIN (I32 I32Op.Sub); STOREGLOBAL call_stack;
           RETURN; LABEL (-11); UNREACHABLE] else
-     if mname = "env" && fname = "usegas" then
+     if mname = "env" && fname = "usegas" || mname = "env" && fname = "gas" then
        try
          let _ (* initial gas limit *) = find_global_index (elem m) (Utf8.decode "GAS_LIMIT") in
          let num_globals = List.length (global_imports (elem m)) + List.length m.globals in