From 02e0528f5bd7af7b52e5855c58fd974f1f1a5685 Mon Sep 17 00:00:00 2001
From: Luke Wagner <mail@lukewagner.name>
Date: Thu, 20 Aug 2015 21:40:15 -0500
Subject: [PATCH 1/3] Allow multiple data segments

---
 ml-proto/src/ast.ml       |  7 +++++--
 ml-proto/src/check.ml     | 10 ++++++++--
 ml-proto/src/eval.ml      |  4 ++--
 ml-proto/src/memory.ml    | 20 +++++++++++++++-----
 ml-proto/src/memory.mli   | 11 +++++++++--
 ml-proto/src/parser.mly   | 16 ++++++++++------
 ml-proto/src/types.ml     |  1 -
 ml-proto/test/memory.wasm | 13 ++++++++++---
 8 files changed, 59 insertions(+), 23 deletions(-)

diff --git a/ml-proto/src/ast.ml b/ml-proto/src/ast.ml
index 659db2b990..2ac54815c1 100644
--- a/ml-proto/src/ast.ml
+++ b/ml-proto/src/ast.ml
@@ -105,6 +105,9 @@ and arm' =
 
 (* Functions and Modules *)
 
+
+type segment = Memory.segment Source.phrase
+
 type func = func' Source.phrase
 and func' =
 {
@@ -122,8 +125,8 @@ type table = var list Source.phrase
 type modul = modul' Source.phrase
 and modul' =
 {
-  memory : int64 * int64;
-  data : string;
+  memory : Memory.size * Memory.size;
+  data : segment list;
   funcs : func list;
   exports : export list;
   tables : table list;
diff --git a/ml-proto/src/check.ml b/ml-proto/src/check.ml
index 13d6fa562d..4cb8a89320 100644
--- a/ml-proto/src/check.ml
+++ b/ml-proto/src/check.ml
@@ -275,10 +275,16 @@ let check_export c ex =
   let {name = _; func = x} = ex.it in
   ignore (func c x)
 
+let check_data_segment memory prev_end s =
+  let mem_end = fst memory in
+  let seg_end = s.it.Memory.addr + String.length s.it.Memory.data in
+  require (s.it.Memory.addr >= prev_end) s.at "data section not disjoint and ordered";
+  require (mem_end >= seg_end) s.at "data section does not fit memory";
+  seg_end
+
 let check_module m =
   let {funcs; exports; tables; globals; memory; data} = m.it in
-  require (fst memory >= Int64.of_int (String.length data)) m.at
-    "data section does not fit memory";
+  ignore (List.fold_left (check_data_segment memory) 0 data);
   let c = {c0 with funcs = List.map type_func funcs;
                  globals = List.map it globals} in
   let c' = List.fold_left check_table c tables in
diff --git a/ml-proto/src/eval.ml b/ml-proto/src/eval.ml
index 6bf6922d8a..a19eb7b7a5 100644
--- a/ml-proto/src/eval.ml
+++ b/ml-proto/src/eval.ml
@@ -245,8 +245,8 @@ and eval_func m f vs =
 
 let init m =
   let {Ast.funcs; exports; tables; globals; memory = (n, _); data} = m.it in
-  let memory = Memory.create (Int64.to_int n) in
-  Memory.init memory data;
+  let memory = Memory.create n in
+  Memory.init memory (List.map (fun seg -> seg.it) data);
   let func x = List.nth funcs x.it in
   let export ex = ExportMap.add ex.it.name (func ex.it.func) in
   let exports = List.fold_right export exports ExportMap.empty in
diff --git a/ml-proto/src/memory.ml b/ml-proto/src/memory.ml
index a4885b7f15..4e18eccef0 100644
--- a/ml-proto/src/memory.ml
+++ b/ml-proto/src/memory.ml
@@ -8,11 +8,17 @@ open Bigarray
 (* Types and view types *)
 
 type address = int
+type size = address
 type alignment = Aligned | Unaligned
 type mem_type =
   | SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem
   | UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem
   | Float32Mem | Float64Mem
+type segment =
+{
+  addr : address;
+  data : string
+}
 
 type memory = (int, int8_unsigned_elt, c_layout) Array1.t
 type t = memory
@@ -43,13 +49,17 @@ let create n =
   Array1.fill mem 0;
   mem
 
-let init mem s =
-  if String.length s > Array1.dim mem then raise Bounds;
-  (* There currently is no way to blit from a string. *)
-  for i = 0 to String.length s - 1 do
-    (view mem : char_view).{i} <- s.[i]
+let init_seg mem seg =
+  (*
+   * The Check.check_data_segment ensures seg is in bounds.
+   * There currently is no way to blit from a string.
+   *)
+  for i = 0 to String.length seg.data - 1 do
+    (view mem : char_view).{seg.addr + i} <- seg.data.[i]
   done
 
+let init mem segs =
+  List.iter (init_seg mem) segs
 
 (* Alignment *)
 
diff --git a/ml-proto/src/memory.mli b/ml-proto/src/memory.mli
index 5d2b1527b3..40e61aa846 100644
--- a/ml-proto/src/memory.mli
+++ b/ml-proto/src/memory.mli
@@ -5,18 +5,25 @@
 type memory
 type t = memory
 type address = int
+type size = address
 type alignment = Aligned | Unaligned
 type mem_type =
   | SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem
   | UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem
   | Float32Mem | Float64Mem
 
+type segment =
+{
+  addr : address;
+  data : string
+}
+
 exception Bounds
 exception Align
 exception Address
 
-val create : int -> memory
-val init : memory -> string -> unit
+val create : size -> memory
+val init : memory -> segment list -> unit
 val load : memory -> alignment -> address -> mem_type -> Values.value
 val store : memory -> alignment -> address -> mem_type -> Values.value -> unit
 
diff --git a/ml-proto/src/parser.mly b/ml-proto/src/parser.mly
index bfe4cdba73..c11d34b717 100644
--- a/ml-proto/src/parser.mly
+++ b/ml-proto/src/parser.mly
@@ -150,6 +150,10 @@ bind_var :
   | VAR { $1 @@ at() }
 ;
 
+segment :
+  | INT TEXT { {Memory.addr = int_of_string $1; Memory.data = $2} @@ at() }
+;
+
 expr :
   | LPAR oper RPAR { let at = at() in fun c -> $2 c @@ at }
 ;
@@ -258,8 +262,8 @@ export :
 
 module_fields :
   | /* empty */
-    { fun c -> let memory = (Int64.zero, Int64.zero) in
-      {memory; data = ""; funcs = []; exports = []; globals = []; tables = []} }
+    { fun c ->
+      {memory = (0, 0); data = []; funcs = []; exports = []; globals = []; tables = []} }
   | func module_fields
     { fun c -> let f = $1 c in let m = $2 c in
       {m with funcs = f () :: m.funcs} }
@@ -277,13 +281,13 @@ module_fields :
       {m with tables = ($3 c func @@ ati 3) :: m.tables} }
   | LPAR MEMORY INT INT RPAR module_fields
     { fun c -> let m = $6 c in
-      {m with memory = (Int64.of_string $3, Int64.of_string $4)} }
+      {m with memory = (int_of_string $3, int_of_string $4)} }
   | LPAR MEMORY INT RPAR module_fields  /* Sugar */
     { fun c -> let m = $5 c in
-      {m with memory = (Int64.of_string $3, Int64.of_string $3)} }
-  | LPAR DATA TEXT RPAR module_fields
+      {m with memory = (int_of_string $3, int_of_string $3)} }
+  | LPAR DATA segment RPAR module_fields
     { fun c -> let m = $5 c in
-      {m with data = $3 ^ m.data} }
+      {m with data = $3 :: m.data} }
 ;
 modul :
   | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at() }
diff --git a/ml-proto/src/types.ml b/ml-proto/src/types.ml
index be9e56f5c5..2a325e7411 100644
--- a/ml-proto/src/types.ml
+++ b/ml-proto/src/types.ml
@@ -16,7 +16,6 @@ type value_type = Int32Type | Int64Type | Float32Type | Float64Type
 type expr_type = value_type list
 type func_type = {ins : expr_type; outs : expr_type}
 
-
 (* String conversion *)
 
 let string_of_value_type = function
diff --git a/ml-proto/test/memory.wasm b/ml-proto/test/memory.wasm
index 93d8634743..1cef4f02d6 100644
--- a/ml-proto/test/memory.wasm
+++ b/ml-proto/test/memory.wasm
@@ -2,13 +2,20 @@
 
 (module
   (memory 1024)
-  (data "ABC\a7D")
+  (data 0 "ABC\a7D")
+  (data 20 "WASM")
 
   ;; Data section
   (func $data (result i32)
     (and.i32
-      (eq.i32 (getnearu.i8 (const.i32 0)) (const.i32 65))
-      (eq.i32 (getfaru.i8 (const.i64 3)) (const.i32 167))
+      (and.i32
+        (eq.i32 (getnearu.i8 (const.i32 0)) (const.i32 65))
+        (eq.i32 (getfaru.i8 (const.i64 3)) (const.i32 167))
+      )
+      (and.i32
+        (eq.i32 (getnearu.i8 (const.i32 20)) (const.i32 87))
+        (eq.i32 (getfaru.i8 (const.i64 23)) (const.i32 77))
+      )
     )
   )
 

From 9dbd0c470fdbc15db34b79e58c866e03c567e261 Mon Sep 17 00:00:00 2001
From: Luke Wagner <mail@lukewagner.name>
Date: Fri, 21 Aug 2015 11:09:10 -0500
Subject: [PATCH 2/3] Address review comments

---
 ml-proto/src/memory.ml  | 6 ++----
 ml-proto/src/parser.mly | 9 ++++-----
 2 files changed, 6 insertions(+), 9 deletions(-)

diff --git a/ml-proto/src/memory.ml b/ml-proto/src/memory.ml
index 4e18eccef0..e1a489f8f2 100644
--- a/ml-proto/src/memory.ml
+++ b/ml-proto/src/memory.ml
@@ -50,10 +50,8 @@ let create n =
   mem
 
 let init_seg mem seg =
-  (*
-   * The Check.check_data_segment ensures seg is in bounds.
-   * There currently is no way to blit from a string.
-   *)
+  if String.length seg.data > Array1.dim mem then raise Bounds;
+  (* There currently is no way to blit from a string. *)
   for i = 0 to String.length seg.data - 1 do
     (view mem : char_view).{seg.addr + i} <- seg.data.[i]
   done
diff --git a/ml-proto/src/parser.mly b/ml-proto/src/parser.mly
index c11d34b717..4271d2501c 100644
--- a/ml-proto/src/parser.mly
+++ b/ml-proto/src/parser.mly
@@ -150,8 +150,8 @@ bind_var :
   | VAR { $1 @@ at() }
 ;
 
-segment :
-  | INT TEXT { {Memory.addr = int_of_string $1; Memory.data = $2} @@ at() }
+data :
+  | LPAR DATA INT TEXT RPAR { {Memory.addr = int_of_string $3; Memory.data = $4} @@ at() }
 ;
 
 expr :
@@ -285,9 +285,8 @@ module_fields :
   | LPAR MEMORY INT RPAR module_fields  /* Sugar */
     { fun c -> let m = $5 c in
       {m with memory = (int_of_string $3, int_of_string $3)} }
-  | LPAR DATA segment RPAR module_fields
-    { fun c -> let m = $5 c in
-      {m with data = $3 :: m.data} }
+  | data module_fields
+    { fun c -> let m = $2 c in {m with data = $1 :: m.data} }
 ;
 modul :
   | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at() }

From e9d0ccac115cc319cf9d2fb1b0ce684231e3d84b Mon Sep 17 00:00:00 2001
From: Luke Wagner <mail@lukewagner.name>
Date: Fri, 21 Aug 2015 23:14:56 -0500
Subject: [PATCH 3/3] Fold memory and data into memory

---
 ml-proto/src/ast.ml       | 13 +++++++++----
 ml-proto/src/check.ml     | 22 +++++++++++++++-------
 ml-proto/src/eval.ml      | 11 ++++++++---
 ml-proto/src/lexer.mll    |  2 +-
 ml-proto/src/memory.ml    |  3 +--
 ml-proto/src/parser.mly   | 36 ++++++++++++++++++++++--------------
 ml-proto/test/memory.wasm |  4 +---
 7 files changed, 57 insertions(+), 34 deletions(-)

diff --git a/ml-proto/src/ast.ml b/ml-proto/src/ast.ml
index 2ac54815c1..04839eea60 100644
--- a/ml-proto/src/ast.ml
+++ b/ml-proto/src/ast.ml
@@ -105,8 +105,14 @@ and arm' =
 
 (* Functions and Modules *)
 
-
-type segment = Memory.segment Source.phrase
+type memory = memory' Source.phrase
+and memory' =
+{
+  initial : Memory.size;
+  max : Memory.size;
+  segments : segment list;
+}
+and segment = Memory.segment Source.phrase
 
 type func = func' Source.phrase
 and func' =
@@ -125,8 +131,7 @@ type table = var list Source.phrase
 type modul = modul' Source.phrase
 and modul' =
 {
-  memory : Memory.size * Memory.size;
-  data : segment list;
+  memory : memory option;
   funcs : func list;
   exports : export list;
   tables : table list;
diff --git a/ml-proto/src/check.ml b/ml-proto/src/check.ml
index 4cb8a89320..9a96b892d1 100644
--- a/ml-proto/src/check.ml
+++ b/ml-proto/src/check.ml
@@ -275,16 +275,24 @@ let check_export c ex =
   let {name = _; func = x} = ex.it in
   ignore (func c x)
 
-let check_data_segment memory prev_end s =
-  let mem_end = fst memory in
-  let seg_end = s.it.Memory.addr + String.length s.it.Memory.data in
-  require (s.it.Memory.addr >= prev_end) s.at "data section not disjoint and ordered";
-  require (mem_end >= seg_end) s.at "data section does not fit memory";
+let check_segment memory prev_end seg =
+  let seg_end = seg.it.Memory.addr + String.length seg.it.Memory.data in
+  require (seg.it.Memory.addr >= prev_end) seg.at
+    "data section not disjoint and ordered";
+  require (memory.it.initial >= seg_end) seg.at
+    "data section does not fit memory";
   seg_end
 
+let check_memory memory =
+  require (memory.it.initial <= memory.it.max) memory.at
+    "initial memory size must be less than maximum";
+  ignore (List.fold_left (check_segment memory) 0 memory.it.segments)
+
 let check_module m =
-  let {funcs; exports; tables; globals; memory; data} = m.it in
-  ignore (List.fold_left (check_data_segment memory) 0 data);
+  let {funcs; exports; tables; globals; memory} = m.it in
+  match memory with
+    | Some memory -> check_memory memory
+    | None -> ();
   let c = {c0 with funcs = List.map type_func funcs;
                  globals = List.map it globals} in
   let c' = List.fold_left check_table c tables in
diff --git a/ml-proto/src/eval.ml b/ml-proto/src/eval.ml
index a19eb7b7a5..7d2bc8a652 100644
--- a/ml-proto/src/eval.ml
+++ b/ml-proto/src/eval.ml
@@ -244,9 +244,14 @@ and eval_func m f vs =
 (* Modules *)
 
 let init m =
-  let {Ast.funcs; exports; tables; globals; memory = (n, _); data} = m.it in
-  let memory = Memory.create n in
-  Memory.init memory (List.map (fun seg -> seg.it) data);
+  let {Ast.funcs; exports; tables; globals; memory} = m.it in
+  let memory = match memory with
+    | Some {it = {initial; segments} } ->
+        let m = Memory.create initial in
+        Memory.init m (List.map (fun seg -> seg.it) segments);
+        m
+    | None -> Memory.create 0
+  in
   let func x = List.nth funcs x.it in
   let export ex = ExportMap.add ex.it.name (func ex.it.func) in
   let exports = List.fold_right export exports ExportMap.empty in
diff --git a/ml-proto/src/lexer.mll b/ml-proto/src/lexer.mll
index f6e84f08e0..914f78dffb 100644
--- a/ml-proto/src/lexer.mll
+++ b/ml-proto/src/lexer.mll
@@ -245,7 +245,7 @@ rule token = parse
   | "local" { LOCAL }
   | "module" { MODULE }
   | "memory" { MEMORY }
-  | "data" { DATA }
+  | "segment" { SEGMENT }
   | "global" { GLOBAL }
   | "import" { IMPORT }
   | "export" { EXPORT }
diff --git a/ml-proto/src/memory.ml b/ml-proto/src/memory.ml
index e1a489f8f2..f13a081be6 100644
--- a/ml-proto/src/memory.ml
+++ b/ml-proto/src/memory.ml
@@ -50,14 +50,13 @@ let create n =
   mem
 
 let init_seg mem seg =
-  if String.length seg.data > Array1.dim mem then raise Bounds;
   (* There currently is no way to blit from a string. *)
   for i = 0 to String.length seg.data - 1 do
     (view mem : char_view).{seg.addr + i} <- seg.data.[i]
   done
 
 let init mem segs =
-  List.iter (init_seg mem) segs
+  try List.iter (init_seg mem) segs with Invalid_argument _ -> raise Bounds
 
 (* Alignment *)
 
diff --git a/ml-proto/src/parser.mly b/ml-proto/src/parser.mly
index 4271d2501c..1b04f6cd77 100644
--- a/ml-proto/src/parser.mly
+++ b/ml-proto/src/parser.mly
@@ -97,7 +97,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 %token CALL DISPATCH RETURN DESTRUCT
 %token GETLOCAL SETLOCAL GETGLOBAL SETGLOBAL GETMEMORY SETMEMORY
 %token CONST UNARY BINARY COMPARE CONVERT
-%token FUNC PARAM RESULT LOCAL MODULE MEMORY DATA GLOBAL IMPORT EXPORT TABLE
+%token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE
 %token INVOKE ASSERTEQ
 %token EOF
 
@@ -150,10 +150,6 @@ bind_var :
   | VAR { $1 @@ at() }
 ;
 
-data :
-  | LPAR DATA INT TEXT RPAR { {Memory.addr = int_of_string $3; Memory.data = $4} @@ at() }
-;
-
 expr :
   | LPAR oper RPAR { let at = at() in fun c -> $2 c @@ at }
 ;
@@ -255,6 +251,21 @@ func :
 
 /* Modules */
 
+segment :
+  | LPAR SEGMENT INT TEXT RPAR { {Memory.addr = int_of_string $3; Memory.data = $4} @@ at() }
+;
+segment_list :
+  | /* empty */ { [] }
+  | segment segment_list { $1 :: $2 }
+;
+
+memory :
+  | LPAR MEMORY INT INT segment_list RPAR
+    { {initial = int_of_string $3; max = int_of_string $4; segments = $5 } @@ at() }
+  | LPAR MEMORY INT segment_list RPAR
+    { {initial = int_of_string $3; max = int_of_string $3; segments = $4 } @@ at() }
+;
+
 export :
   | LPAR EXPORT TEXT var RPAR
     { let at = at() in fun c -> {name = $3; func = $4 c func} @@ at }
@@ -263,7 +274,7 @@ export :
 module_fields :
   | /* empty */
     { fun c ->
-      {memory = (0, 0); data = []; funcs = []; exports = []; globals = []; tables = []} }
+      {memory = None; funcs = []; exports = []; globals = []; tables = []} }
   | func module_fields
     { fun c -> let f = $1 c in let m = $2 c in
       {m with funcs = f () :: m.funcs} }
@@ -279,14 +290,11 @@ module_fields :
   | LPAR TABLE var_list RPAR module_fields
     { fun c -> let m = $5 c in
       {m with tables = ($3 c func @@ ati 3) :: m.tables} }
-  | LPAR MEMORY INT INT RPAR module_fields
-    { fun c -> let m = $6 c in
-      {m with memory = (int_of_string $3, int_of_string $4)} }
-  | LPAR MEMORY INT RPAR module_fields  /* Sugar */
-    { fun c -> let m = $5 c in
-      {m with memory = (int_of_string $3, int_of_string $3)} }
-  | data module_fields
-    { fun c -> let m = $2 c in {m with data = $1 :: m.data} }
+  | memory module_fields
+    { fun c -> let m = $2 c in
+      match m.memory with
+        | Some _ -> Error.error $1.at "more than one memory section"
+        | None -> {m with memory = Some $1} }
 ;
 modul :
   | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at() }
diff --git a/ml-proto/test/memory.wasm b/ml-proto/test/memory.wasm
index 1cef4f02d6..a2b112ae80 100644
--- a/ml-proto/test/memory.wasm
+++ b/ml-proto/test/memory.wasm
@@ -1,9 +1,7 @@
 ;; (c) 2015 Andreas Rossberg
 
 (module
-  (memory 1024)
-  (data 0 "ABC\a7D")
-  (data 20 "WASM")
+  (memory 1024 (segment 0 "ABC\a7D") (segment 20 "WASM"))
 
   ;; Data section
   (func $data (result i32)