Fold memory and data into memory

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;

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

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

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 }

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 *)
 

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() }

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)