Implement non-trapping grow_memory semantics (#308)

Addresses #307. Clean up some of the memory error condition handling on the way.

ml-proto/host/arrange.ml

@@ -272,7 +272,7 @@ let table tab =
 
 let memory mem =
   let {mlimits = lim} = mem.it in
-  Node ("memory " ^ limits int64 lim, [])
+  Node ("memory " ^ limits int32 lim, [])
 
 let segment head dat seg =
   let {offset; init} = seg.it in

ml-proto/host/encode.ml

@@ -345,7 +345,7 @@ let encode m =
     (* Memory section *)
     let memory mem =
       let {mlimits} = mem.it in
-      limits vu64 mlimits
+      limits vu32 mlimits
 
     let memory_section memo =
       section "memory" (opt memory) memo (memo <> None)

ml-proto/host/encode.ml.rej

@@ -0,0 +1,51 @@
+--- host/encode.ml
++++ host/encode.ml
+@@ -105,31 +105,30 @@
+     let rec expr e =
+       match e.it with
+       | Nop -> op 0x00
+-      | Block es -> op 0x01; list expr es; op 0x17
+-      | Loop es -> op 0x02; list expr es; op 0x17
++      | Block es -> op 0x01; list expr es; op 0x0f
++      | Loop es -> op 0x02; list expr es; op 0x0f
+       | If (e, es1, es2) ->
+         expr e; op 0x03; list expr es1;
+-        if es2 <> [] then op 0x04; list expr es2; op 0x17
++        if es2 <> [] then op 0x04; list expr es2; op 0x0f
+       | Select (e1, e2, e3) -> expr e1; expr e2; expr e3; op 0x05
+       | Br (x, eo) -> opt expr eo; op 0x06; arity1 eo; var x
+       | Br_if (x, eo, e) -> opt expr eo; expr e; op 0x07; arity1 eo; var x
+       | Br_table (xs, x, eo, e) ->
+         opt expr eo; expr e; op 0x08; arity1 eo; vec var32 xs; var32 x
+-
+-      | Ast.I32_const c -> op 0x0a; vs32 c.it
+-      | Ast.I64_const c -> op 0x0b; vs64 c.it
+-      | Ast.F32_const c -> op 0x0c; f32 c.it
+-      | Ast.F64_const c -> op 0x0d; f64 c.it
+-
+-      | Ast.Get_local x -> op 0x0e; var x
+-      | Ast.Set_local (x, e) -> unary e 0x0f; var x
+-      | Ast.Tee_local (x, e) -> unary e 0x10; var x
+-
+-      | Ast.Call (x, es) -> nary es 0x12; var x
+-      | Ast.Call_import (x, es) -> nary es 0x1f; var x
+-      | Ast.Call_indirect (x, e, es) -> expr e; nary es 0x13; var x
+-      | Ast.Return eo -> nary1 eo 0x14
+-      | Ast.Unreachable -> op 0x15
++      | Ast.Return eo -> nary1 eo 0x09
++      | Ast.Unreachable -> op 0x0a
++
++      | Ast.I32_const c -> op 0x10; vs32 c.it
++      | Ast.I64_const c -> op 0x11; vs64 c.it
++      | Ast.F32_const c -> op 0x12; f32 c.it
++      | Ast.F64_const c -> op 0x13; f64 c.it
++
++      | Ast.Get_local x -> op 0x14; var x
++      | Ast.Set_local (x, e) -> unary e 0x15; var x
++
++      | Ast.Call (x, es) -> nary es 0x16; var x
++      | Ast.Call_indirect (x, e, es) -> expr e; nary es 0x17; var x
++      | Ast.Call_import (x, es) -> nary es 0x18; var x
+
+       | I32_load8_s (o, a, e) -> unary e 0x20; memop o a
+       | I32_load8_u (o, a, e) -> unary e 0x21; memop o a

ml-proto/host/parser.mly

@@ -39,6 +39,18 @@ let literal f s =
   | Failure msg -> error s.at ("constant out of range: " ^ msg)
   | _ -> error s.at "constant out of range"
 
+let int s at =
+  try int_of_string s with Failure _ ->
+    error at "int constant out of range"
+
+let int32 s at =
+  try I32.of_string s with Failure _ ->
+    error at "i32 constant out of range"
+
+let int64 s at =
+  try I64.of_string s with Failure _ ->
+    error at "i64 constant out of range"
+
 
 (* Symbolic variables *)
 
@@ -206,7 +218,7 @@ literal :
 ;
 
 var :
-  | NAT { let at = at () in fun c lookup -> int_of_string $1 @@ at }
+  | NAT { let at = at () in fun c lookup -> int $1 at @@ at }
   | VAR { let at = at () in fun c lookup -> lookup c ($1 @@ at) @@ at }
 ;
 var_list :
@@ -365,9 +377,9 @@ elem :
 ;
 
 table_limits :
-  | NAT { {min = Int32.of_string $1; max = None} @@ at () }
+  | NAT { {min = int32 $1 (ati 1); max = None} @@ at () }
   | NAT NAT
-    { {min = Int32.of_string $1; max = Some (Int32.of_string $2)} @@ at () }
+    { {min = int32 $1 (ati 1); max = Some (int32 $2 (ati 2))} @@ at () }
 ;
 table :
   | LPAR TABLE table_limits elem_type RPAR
@@ -386,17 +398,17 @@ data :
 ;
 
 memory_limits :
-  | NAT { {min = Int64.of_string $1; max = None} @@ at () }
+  | NAT { {min = int32 $1 (ati 1); max = None} @@ at () }
   | NAT NAT
-    { {min = Int64.of_string $1; max = Some (Int64.of_string $2)} @@ at () }
+    { {min = int32 $1 (ati 1); max = Some (int32 $2 (ati 2))} @@ at () }
 ;
 memory :
   | LPAR MEMORY memory_limits RPAR
     { fun c -> {mlimits = $3} @@ at (), [] }
   | LPAR MEMORY LPAR DATA text_list RPAR RPAR  /* Sugar */
     { let at = at () in
       fun c ->
-      let size = Int64.(div (add (of_int (String.length $5)) 65535L) 65536L) in
+      let size = Int32.(div (add (of_int (String.length $5)) 65535l) 65536l) in
       {mlimits = {min = size; max = Some size} @@ at} @@ at,
       [{offset = I32_const (0l @@ at) @@ at; init = $5} @@ at] }
 ;