Move load/store alignment closer to design repo

ml-proto/src/ast.ml

@@ -60,7 +60,8 @@ type binop = (Int32Op.binop, Int64Op.binop, Float32Op.binop, Float64Op.binop) op
 type relop = (Int32Op.relop, Int64Op.relop, Float32Op.relop, Float64Op.relop) op
 type cvt = (Int32Op.cvt, Int64Op.cvt, Float32Op.cvt, Float64Op.cvt) op
 
-type memop = {align : Memory.alignment; mem : Memory.mem_type}
+type alignment = int
+type memop = {align : alignment; mem : Memory.mem_type}
 
 
 (* Expressions *)

ml-proto/src/check.ml

@@ -189,10 +189,12 @@ let rec check_expr c ts e =
     check_type [] ts e.at
 
   | Load (memop, e1) ->
+    check_memop memop e.at;
     check_expr c [Int32Type] e1;
     check_type [type_mem memop.mem] ts e.at
 
   | Store (memop, e1, e2) ->
+    check_memop memop e.at;
     check_expr c [Int32Type] e1;
     check_expr c [type_mem memop.mem] e2;
     check_type [] ts e.at
@@ -237,6 +239,13 @@ and check_arm c t ts arm =
   check_literal c [t] l;
   check_expr c (if fallthru then [] else ts) e
 
+and check_memop memop at =
+  require (memop.align = 1 || memop.align = 2 ||
+           memop.align = 4 || memop.align = 8)
+    at "invalid alignment";
+  require (memop.align <= (Memory.mem_size memop.mem))
+    at "alignment too big"
+
 
 (*
  * check_func : context -> func -> unit

ml-proto/src/eval.ml

@@ -64,7 +64,6 @@ end
 (* Type and memory errors *)
 
 let memory_error at = function
-  | Memory.Align -> error at "runtime: unaligned memory access"
   | Memory.Bounds -> error at "runtime: out of bounds memory access"
   | Memory.Address -> error at "runtime: illegal address value"
   | exn -> raise exn
@@ -163,15 +162,15 @@ let rec eval_expr c e =
     global c x := v1;
     []
 
-  | Load ({align; mem; _}, e1) ->
+  | Load ({mem; _}, e1) ->
     let v1 = unary (eval_expr c e1) e1.at in
-    (try [Memory.load c.modul.memory align (Memory.address_of_value v1) mem]
+    (try [Memory.load c.modul.memory (Memory.address_of_value v1) mem]
     with exn -> memory_error e.at exn)
 
-  | Store ({align; mem; _}, e1, e2) ->
+  | Store ({mem; _}, e1, e2) ->
     let v1 = unary (eval_expr c e1) e1.at in
     let v2 = unary (eval_expr c e2) e2.at in
-    (try Memory.store c.modul.memory align (Memory.address_of_value v1) mem v2
+    (try Memory.store c.modul.memory (Memory.address_of_value v1) mem v2
     with exn -> memory_error e.at exn);
     []
 

ml-proto/src/lexer.mll

@@ -80,12 +80,16 @@ let floatop t f32 f64 =
   | "f64" -> Values.Float64 f64
   | _ -> assert false
 
+let default_alignment = function
+  | "i8" -> 1
+  | "i16" -> 2
+  | "i32" | "f32" -> 4
+  | "i64" | "f64" -> 8
+  | _ -> assert false
+
 let memop a s t =
-  let align = match a with
-    | "" -> Memory.Aligned
-    | "unaligned" -> Memory.Unaligned
-    | _ -> assert false
-  in {align; mem = mem_type s t}
+  let align = if a = "" then default_alignment t else int_of_string a in
+  {align; mem = mem_type s t}
 }
 
 
@@ -110,7 +114,7 @@ let nxx = ixx | fxx
 let mixx = "i" ("8" | "16" | "32" | "64")
 let mfxx = "f" ("32" | "64")
 let sign = "s" | "u"
-let align = "" | "unaligned"
+let align = digit+
 
 rule token = parse
   | "(" { LPAR }
@@ -145,12 +149,14 @@ rule token = parse
   | "getglobal" { GETGLOBAL }
   | "setglobal" { SETGLOBAL }
 
-  | "load"(align as a)(sign as s)"."(mixx as t)
-    { LOAD (memop a s t) }
-  | "store"(align as a)(sign as s)"."(mixx as t)
-    { STORE (memop a s t) }
-  | "load"(align as a)"."(mfxx as t) { LOAD (memop a ' ' t) }
-  | "store"(align as a)"."(mfxx as t) { STORE (memop a ' ' t) }
+  | "load"(sign as s)"."(align as a)"."(mixx as t) { LOAD (memop a s t) }
+  | "store"(sign as s)"."(align as a)"."(mixx as t) { STORE (memop a s t) }
+  | "load"(sign as s)"."(mixx as t) { LOAD (memop "" s t) }
+  | "store"(sign as s)"."(mixx as t) { STORE (memop "" s t) }
+  | "load."(align as a)"."(mfxx as t) { LOAD (memop a ' ' t) }
+  | "store."(align as a)"."(mfxx as t) { STORE (memop a ' ' t) }
+  | "load."(mfxx as t) { LOAD (memop "" ' ' t) }
+  | "store."(mfxx as t) { STORE (memop "" ' ' t) }
 
   | "const."(nxx as t) { CONST (value_type t) }
   | "switch."(nxx as t) { SWITCH (value_type t) }

ml-proto/src/memory.ml

@@ -14,6 +14,13 @@ type mem_type =
   | SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem
   | UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem
   | Float32Mem | Float64Mem
+
+let mem_size = function
+  | SInt8Mem | UInt8Mem -> 1
+  | SInt16Mem | UInt16Mem -> 2
+  | SInt32Mem | UInt32Mem | Float32Mem -> 4
+  | SInt64Mem | UInt64Mem | Float64Mem -> 8
+
 type segment =
 {
   addr : address;
@@ -41,7 +48,6 @@ let view : memory -> ('c, 'd, c_layout) Array1.t = Obj.magic
 (* Creation and initialization *)
 
 exception Bounds
-exception Align
 exception Address
 
 let create n =
@@ -59,21 +65,6 @@ let init mem segs =
   try List.iter (init_seg mem) segs with Invalid_argument _ -> raise Bounds
 
 
-(* Alignment *)
-
-let mem_size = function
-  | SInt8Mem | UInt8Mem -> 1
-  | SInt16Mem | UInt16Mem -> 2
-  | SInt32Mem | UInt32Mem | Float32Mem -> 4
-  | SInt64Mem | UInt64Mem | Float64Mem -> 8
-
-let mem_alignment = mem_size
-
-let align ty a =
-  let n = mem_alignment ty in
-  if a mod n <> 0 then raise Align else a / n
-
-
 open Values
 
 let address_of_value = function
@@ -83,53 +74,39 @@ let address_of_value = function
 
 (* Load and store *)
 
-let load_aligned mem a ty =
-  try match ty with
-  | SInt8Mem -> Int32 (Int32.of_int (view mem : sint8_view).{align ty a})
-  | SInt16Mem -> Int32 (Int32.of_int (view mem : sint16_view).{align ty a})
-  | SInt32Mem -> Int32 (view mem : sint32_view).{align ty a}
-  | SInt64Mem -> Int64 (view mem : sint64_view).{align ty a}
-  | UInt8Mem -> Int32 (Int32.of_int (view mem : uint8_view).{align ty a})
-  | UInt16Mem -> Int32 (Int32.of_int (view mem : uint16_view).{align ty a})
-  | UInt32Mem -> Int32 (view mem : uint32_view).{align ty a}
-  | UInt64Mem -> Int64 (view mem : uint64_view).{align ty a}
-  | Float32Mem -> Float32 (view mem : float32_view).{align ty a}
-  | Float64Mem -> Float64 (view mem : float64_view).{align ty a}
-  with Invalid_argument _ -> raise Bounds
-
-let store_aligned mem a ty v =
-  try match ty, v with
-  | SInt8Mem, Int32 x -> (view mem : sint8_view).{align ty a} <- Int32.to_int x
-  | SInt16Mem, Int32 x -> (view mem : sint16_view).{align ty a} <- Int32.to_int x
-  | SInt32Mem, Int32 x -> (view mem : sint32_view).{align ty a} <- x
-  | SInt64Mem, Int64 x -> (view mem : sint64_view).{align ty a} <- x
-  | UInt8Mem, Int32 x -> (view mem : uint8_view).{align ty a} <- Int32.to_int x
-  | UInt16Mem, Int32 x -> (view mem : uint16_view).{align ty a} <- Int32.to_int x
-  | UInt32Mem, Int32 x -> (view mem : uint32_view).{align ty a} <- x
-  | UInt64Mem, Int64 x -> (view mem : uint64_view).{align ty a} <- x
-  | Float32Mem, Float32 x -> (view mem : float32_view).{align ty a} <- x
-  | Float64Mem, Float64 x -> (view mem : float64_view).{align ty a} <- x
-  | _ -> assert false
-  with Invalid_argument _ -> raise Bounds
-
-
 let buf = create 8
 
-let load_unaligned mem a ty =
+let load mem a ty =
+  let sz = mem_size ty in
   try
-    Array1.blit (Array1.sub mem a (mem_size ty)) buf;
-    load_aligned buf 0 ty
+    Array1.blit (Array1.sub mem a sz) (Array1.sub buf 0 sz);
+    match ty with
+    | SInt8Mem -> Int32 (Int32.of_int (view buf : sint8_view).{0})
+    | SInt16Mem -> Int32 (Int32.of_int (view buf : sint16_view).{0})
+    | SInt32Mem -> Int32 (view buf : sint32_view).{0}
+    | SInt64Mem -> Int64 (view buf : sint64_view).{0}
+    | UInt8Mem -> Int32 (Int32.of_int (view buf : uint8_view).{0})
+    | UInt16Mem -> Int32 (Int32.of_int (view buf : uint16_view).{0})
+    | UInt32Mem -> Int32 (view buf : uint32_view).{0}
+    | UInt64Mem -> Int64 (view buf : uint64_view).{0}
+    | Float32Mem -> Float32 (view buf : float32_view).{0}
+    | Float64Mem -> Float64 (view buf : float64_view).{0}
   with Invalid_argument _ -> raise Bounds
 
-let store_unaligned mem a ty v =
+let store mem a ty v =
+  let sz = mem_size ty in
   try
-    store_aligned buf 0 ty v;
-    Array1.blit (Array1.sub buf 0 (mem_size ty))
-      (Array1.sub mem a (mem_size ty))
+    (match ty, v with
+    | SInt8Mem, Int32 x -> (view buf : sint8_view).{0} <- Int32.to_int x
+    | SInt16Mem, Int32 x -> (view buf : sint16_view).{0} <- Int32.to_int x
+    | SInt32Mem, Int32 x -> (view buf : sint32_view).{0} <- x
+    | SInt64Mem, Int64 x -> (view buf : sint64_view).{0} <- x
+    | UInt8Mem, Int32 x -> (view buf : uint8_view).{0} <- Int32.to_int x
+    | UInt16Mem, Int32 x -> (view buf : uint16_view).{0} <- Int32.to_int x
+    | UInt32Mem, Int32 x -> (view buf : uint32_view).{0} <- x
+    | UInt64Mem, Int64 x -> (view buf : uint64_view).{0} <- x
+    | Float32Mem, Float32 x -> (view buf : float32_view).{0} <- x
+    | Float64Mem, Float64 x -> (view buf : float64_view).{0} <- x
+    | _ -> assert false);
+    Array1.blit (Array1.sub buf 0 sz) (Array1.sub mem a sz)
   with Invalid_argument _ -> raise Bounds
-
-
-let load mem align =
-  (match align with Aligned -> load_aligned | Unaligned -> load_unaligned) mem
-let store mem align =
-  (match align with Aligned -> store_aligned | Unaligned -> store_unaligned) mem

ml-proto/src/memory.mli

@@ -6,11 +6,11 @@ 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
+val mem_size : mem_type -> int
 
 type segment =
 {
@@ -19,12 +19,11 @@ type segment =
 }
 
 exception Bounds
-exception Align
 exception Address
 
 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
+val load : memory -> address -> mem_type -> Values.value
+val store : memory -> address -> mem_type -> Values.value -> unit
 
 val address_of_value : Values.value -> address

ml-proto/test/memory.wasm

@@ -1,5 +1,6 @@
 ;; (c) 2015 Andreas Rossberg
 
+;; Test memory section structure
 (module (memory 0 0))
 (module (memory 0 1))
 (module (memory 4096 16777216))
@@ -26,6 +27,17 @@
   (module (memory 100 1000 (segment 0 "a") (segment 2 "b") (segment 1 "c")))
   "data segment not disjoint and ordered")
 
+;; Test alignment annotation rules
+(assertinvalid (module (func (loadu.2.i8 (const.i32 0)))) "alignment too big")
+(assertinvalid (module (func (loadu.4.i16 (const.i32 0)))) "alignment too big")
+(assertinvalid (module (func (loadu.8.i32 (const.i32 0)))) "alignment too big")
+(assertinvalid (module (func (load.8.f32 (const.i32 0)))) "alignment too big")
+(assertinvalid (module (func (loadu.0.i64 (const.i32 0)))) "invalid alignment")
+(assertinvalid (module (func (loadu.3.i64 (const.i32 0)))) "invalid alignment")
+(assertinvalid (module (func (loadu.5.i64 (const.i32 0)))) "invalid alignment")
+(assertinvalid (module (func (loadu.6.i64 (const.i32 0)))) "invalid alignment")
+(assertinvalid (module (func (loadu.7.i64 (const.i32 0)))) "invalid alignment")
+
 (module
   (memory 1024 (segment 0 "ABC\a7D") (segment 20 "WASM"))
 
@@ -77,8 +89,8 @@
           (break)
         )
         (setlocal 2 (converts.i32.f64 (getlocal 0)))
-        (storeunaligned.f64 (getlocal 0) (getlocal 2))
-        (setlocal 1 (loadunaligned.f64 (getlocal 0)))
+        (store.1.f64 (getlocal 0) (getlocal 2))
+        (setlocal 1 (load.1.f64 (getlocal 0)))
         (if
           (neq.f64 (getlocal 2) (getlocal 1))
           (return (const.i32 0))
@@ -96,9 +108,9 @@
       (eq.f64 (load.f64 (const.i32 8)) (cast.i64.f64 (const.i64 -12345)))
       (return (const.f64 0))
     )
-    (storeunaligneds.i64 (const.i32 9) (const.i64 0))
-    (storeunaligneds.i16 (const.i32 15) (const.i32 16453))
-    (return (loadunaligned.f64 (const.i32 9)))
+    (stores.1.i64 (const.i32 9) (const.i64 0))
+    (stores.1.i16 (const.i32 15) (const.i32 16453))
+    (return (load.1.f64 (const.i32 9)))
   )
 
   (export "data" $data)