Implement parser support for pagetype (#51 from WebAssembly/parser_impl)

Author: titzer

interpreter/runtime/memory.ml

@@ -22,30 +22,30 @@ let valid_limits {min; max} =
   | None -> true
   | Some m -> I64.le_u min m
 
-let valid_size at i =
-  match at with
-  | I32AT -> I64.le_u i 0xffffL
-  | I64AT -> true
+let valid_size at pt i =
+  match at, pt with
+  | I32AT, PageT ps -> I64.le_u i (Int64.shift_right 0xffff_ffffL ps)
+  | _, _ -> true
 
 let create n (PageT ps) =
   try
-    let size = Int64.(shift_left n ps) in
+    let size = Int64.shift_left n ps in
     let mem = Array1_64.create Int8_unsigned C_layout size in
     Array1.fill mem 0;
     mem
   with Out_of_memory -> raise OutOfMemory
 
 let alloc (MemoryT (at, lim, pt) as ty) =
   assert Free.((memorytype ty).types = Set.empty);
-  if not (valid_size at lim.min) then raise SizeOverflow;
+  if not (valid_size at pt lim.min) then raise SizeOverflow;
   if not (valid_limits lim) then raise Type;
   {ty; content = create lim.min pt}
 
 let bound mem =
   Array1_64.dim mem.content
 
 let pagesize mem =
-  let MemoryT (_, _, PageT x) = mem.ty in (Int64.shift_left 1L x)
+  let MemoryT (_, _, PageT x) = mem.ty in Int64.shift_left 1L x
 
 let size mem =
   Int64.(div (bound mem) (pagesize mem))
@@ -63,7 +63,7 @@ let grow mem delta =
   let new_size = Int64.add old_size delta in
   if I64.gt_u old_size new_size then raise SizeOverflow else
   let lim' = {lim with min = new_size} in
-  if not (valid_size at new_size) then raise SizeOverflow else
+  if not (valid_size at pt new_size) then raise SizeOverflow else
   if not (valid_limits lim') then raise SizeLimit else
   let after = create new_size pt in
   let dim = Array1_64.dim mem.content in

interpreter/text/lexer.mll

@@ -780,6 +780,7 @@ rule token = parse
       | "start" -> START
       | "import" -> IMPORT
       | "export" -> EXPORT
+      | "pagesize" -> PAGESIZE
 
       | "module" -> MODULE
       | "binary" -> BIN

interpreter/text/parser.mly

@@ -321,6 +321,7 @@ let parse_annots (m : module_) : Custom.section list =
 %token VEC_SHUFFLE
 %token<Ast.laneidx -> Ast.instr'> VEC_EXTRACT VEC_REPLACE
 %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL
+%token PAGESIZE
 %token TABLE ELEM MEMORY TAG DATA DECLARE OFFSET ITEM IMPORT EXPORT
 %token MODULE BIN QUOTE DEFINITION INSTANCE
 %token SCRIPT REGISTER INVOKE GET
@@ -465,8 +466,16 @@ subtype :
 tabletype :
   | addrtype limits reftype { fun c -> TableT ($1, $2, $3 c) }
 
+%inline pagetype :
+  | LPAR PAGESIZE NAT RPAR
+    { let n = (nat32 $3 $loc($3)) in
+      if not (Lib.Int32.is_power_of_two_unsigned n) then
+        error (at $sloc) "invalid custom page size: must be power of two";
+      PageT (Int32.to_int (Lib.Int32.log2_unsigned n)) }
+  | /* empty */ { PageT 16 }  /* Sugar */
+
 memorytype :
-  | addrtype limits { fun c -> MemoryT ($1, $2, PageT 16) }
+  | addrtype limits pagetype { fun c -> MemoryT ($1, $2, $3) }
 
 limits :
   | NAT { {min = nat64 $1 $loc($1); max = None} }
@@ -1126,12 +1135,14 @@ memory_fields :
   | inline_export memory_fields  /* Sugar */
     { fun c x loc -> let mems, data, ims, exs = $2 c x loc in
       mems, data, ims, $1 (MemoryX x) c :: exs }
-  | addrtype LPAR DATA string_list RPAR  /* Sugar */
+  | addrtype pagetype LPAR DATA string_list RPAR  /* Sugar */
     { fun c x loc ->
-      let size = Int64.(div (add (of_int (String.length $4)) 65535L) 65536L) in
+      let PageT ps = $2 in
+      let page_size = Int64.shift_left 1L ps in
+      let size = Int64.(div (add (of_int (String.length $5)) (sub page_size 1L)) page_size) in
       let offset = [at_const $1 (0L @@ loc) @@ loc] @@ loc in
-      [Memory (MemoryT ($1, {min = size; max = Some size}, PageT 16)) @@ loc],
-      [Data ($4, Active (x, offset) @@ loc) @@ loc],
+      [Memory (MemoryT ($1, {min = size; max = Some size}, $2)) @@ loc],
+      [Data ($5, Active (x, offset) @@ loc) @@ loc],
       [], [] }
 
 

interpreter/util/lib.ml

@@ -307,15 +307,20 @@ end
 
 module Int32 =
 struct
-  let log2 n =
-    if n <= 0l then failwith "log2";
+  let log2_unsigned n =
     let rec loop acc n =
       if n = 1l then acc else loop (Int32.add acc 1l) (Int32.shift_right_logical n 1) in
     loop 0l n
+  
+  let log2 n =
+    if n <= 0l then failwith "log2" else log2_unsigned n
+  
+  let is_power_of_two_unsigned n =
+    n <> 0l && Int32.(logand n (sub n 1l)) = 0l
 
   let is_power_of_two n =
-    if n < 0l then failwith "is_power_of_two";
-    n <> 0l && Int32.(logand n (sub n 1l)) = 0l
+    if n < 0l then failwith "is_power_of_two" else
+    is_power_of_two_unsigned n
 end
 
 module Int64 =

interpreter/util/lib.mli

@@ -97,7 +97,9 @@ end
 module Int32 :
 sig
   val log2 : int32 -> int32
+  val log2_unsigned : int32 -> int32
   val is_power_of_two : int32 -> bool
+  val is_power_of_two_unsigned : int32 -> bool
 end
 
 module Int64 :

interpreter/valid/valid.ml

@@ -105,7 +105,7 @@ let check_limits {min; max} range at msg =
       "size minimum must not be greater than maximum"
 
 let check_pagetype (PageT ps) at =
-  require (ps = 16 || ps = 0) at "page size must be 1 or 64KiB"
+  require (ps = 16 || ps = 0) at "invalid custom page size"
 
 let check_numtype (c : context) (t : numtype) at =
   ()
@@ -200,13 +200,16 @@ let check_globaltype (c : context) (gt : globaltype) at =
 
 let check_memorytype (c : context) (mt : memorytype) at =
   let MemoryT (at_, lim, pt) = mt in
+  check_pagetype pt at;
   let sz, s =
-    match at_ with
-    | I32AT -> 0x1_0000L, "2^16 pages (4 GiB) for i32"
-    | I64AT -> 0x1_0000_0000_0000L, "2^48 pages (256 TiB) for i64"
+    match at_, pt with
+    | I32AT, PageT 16 -> 0x1_0000L, "2^16 pages (4 GiB) for i32"
+    | I64AT, PageT 16 -> 0x1_0000_0000_0000L, "2^48 pages (256 TiB) for i64"
+    (* TODO: divide by page size, what about error msg? *)
+    | I32AT, _ -> 0xFFFF_FFFFL, "2^32 - 1 bytes for i32"
+    | I64AT, _ -> 0xFFFF_FFFF_FFFF_FFFFL, "2^64 - 1 bytes for i64"
   in
-  check_limits lim sz at ("memory size must be at most " ^ s);
-  check_pagetype pt at
+  check_limits lim sz at ("memory size must be at most " ^ s)
 
 let check_tabletype (c : context) (tt : tabletype) at =
   let TableT (at_, lim, t) = tt in

test/core/custom-page-sizes/custom-page-sizes.wast

@@ -110,7 +110,7 @@
 ;; Inline data segments
 
 ;; pagesize 0
-(assert_malformed (module quote "(memory (pagesize 0) (data))") "invalid custom page size")
+(assert_malformed (module quote "(module (memory (pagesize 0) (data)))") "invalid custom page size")
 
 ;; pagesize 1
 (module

test/core/custom-page-sizes/memory_max.wast

@@ -19,14 +19,26 @@
   (module
     (import "test" "unknown" (func))
     (memory 0xFFFF_FFFF (pagesize 1)))
-  "unknown import")
+  "incompatible import type")
+
+;; i32 (pagesize 1)
+(assert_unlinkable
+  (module
+    (import "test" "unknown" (memory 0xFFFF_FFFF (pagesize 1))))
+  "incompatible import type")
 
 ;; i32 (default pagesize)
 (assert_unlinkable
   (module
     (import "test" "unknown" (func))
     (memory 65536 (pagesize 65536)))
-  "unknown import")
+  "incompatible import type")
+
+;; i32 (default pagesize)
+(assert_unlinkable
+  (module
+    (import "test" "unknown" (memory 65536 (pagesize 65536))))
+  "incompatible import type")
 
 ;; Memory size just over the maximum.
 

test/core/custom-page-sizes/memory_max_i64.wast

@@ -17,16 +17,28 @@
 ;; i64 (pagesize 1)
 (assert_unlinkable
   (module
-    (import "test" "import" (func))
+    (import "test" "unknown" (func))
     (memory i64 0xFFFF_FFFF_FFFF_FFFF (pagesize 1)))
-  "unknown import")
+  "incompatible import type")
+
+;; i64 (pagesize 1)
+(assert_unlinkable
+  (module
+    (import "test" "unknown" (memory i64 0xFFFF_FFFF_FFFF_FFFF (pagesize 1))))
+  "incompatible import type")
 
 ;; i64 (default pagesize)
 (assert_unlinkable
   (module
     (import "test" "unknown" (func))
     (memory i64 0x1_0000_0000_0000 (pagesize 65536)))
-  "unknown import")
+  "incompatible import type")
+
+;; i64 (default pagesize)
+(assert_unlinkable
+  (module
+    (import "test" "unknown" (memory i64 0x1_0000_0000_0000 (pagesize 65536))))
+  "incompatible import type")
 
 ;; Memory size just over the maximum.
 ;;
@@ -36,7 +48,7 @@
 ;; i64 (pagesize 1)
 (assert_malformed
   (module quote "(memory i64 0x1_0000_0000_0000_0000 (pagesize 1))")
-  "constant out of range")
+  "i64 constant out of range")
 
 ;; i64 (default pagesize)
 (assert_invalid