Add offset immediate to load/store

Author: lukewagner

ml-proto/host/lexer.mll

@@ -61,7 +61,7 @@ let floatop t f32 f64 =
   | _ -> assert false
 
 let memop t =
-  {ty = value_type t; align = None}
+  {ty = value_type t; offset = 0L; align = None}
 
 let mem_size = function
   | "8" -> Memory.Mem8
@@ -109,7 +109,7 @@ let nxx = ixx | fxx
 let mixx = "i" ("8" | "16" | "32" | "64")
 let mfxx = "f" ("32" | "64")
 let sign = "s" | "u"
-let align = digit+
+let digits = digit+
 let mem_size = "8" | "16" | "32"
 
 rule token = parse
@@ -151,7 +151,8 @@ rule token = parse
   | (ixx as t)".store"(mem_size as sz)
     { STORE_WRAP (wrapop t sz) }
 
-  | "align="(align as a) { ALIGN (int_of_string a) }
+  | "offset="(digits as s) { OFFSET (Int64.of_string s) }
+  | "align="(digits as s) { ALIGN (int_of_string s) }
 
   | (nxx as t)".switch" { SWITCH (value_type t) }
   | (nxx as t)".const" { CONST (value_type t) }

ml-proto/host/parser.mly

@@ -47,17 +47,20 @@ let literal s t =
 
 (* Memory operands *)
 
-let memop m align =
+let memop m offset align =
+  assert (m.offset = 0L);
   assert (m.align = None);
-  {m with align}
+  {m with offset; align}
 
-let extop (e : extop) align =
+let extop (e : extop) offset align =
+  assert (e.memop.offset = 0L);
   assert (e.memop.align = None);
-  {e with memop = {e.memop with align}}
+  {e with memop = {e.memop with offset; align}}
 
-let wrapop (w : wrapop) align =
+let wrapop (w : wrapop) offset align =
+  assert (w.memop.offset = 0L);
   assert (w.memop.align = None);
-  {w with memop = {w.memop with align}}
+  {w with memop = {w.memop with offset; align}}
 
 
 (* Symbolic variables *)
@@ -146,7 +149,7 @@ let implicit_decl c t at =
 %token INT FLOAT TEXT VAR VALUE_TYPE LPAR RPAR
 %token NOP BLOCK IF LOOP LABEL BREAK SWITCH CASE FALLTHROUGH
 %token CALL CALL_IMPORT CALL_INDIRECT RETURN
-%token GET_LOCAL SET_LOCAL LOAD STORE LOAD_EXTEND STORE_WRAP ALIGN
+%token GET_LOCAL SET_LOCAL LOAD STORE LOAD_EXTEND STORE_WRAP OFFSET ALIGN
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC TYPE PARAM RESULT LOCAL
 %token MODULE MEMORY SEGMENT IMPORT EXPORT TABLE
@@ -169,6 +172,7 @@ let implicit_decl c t at =
 %token<Ast.memop> STORE
 %token<Ast.extop> LOAD_EXTEND
 %token<Ast.wrapop> STORE_WRAP
+%token<Memory.offset> OFFSET
 %token<int> ALIGN
 
 %nonassoc LOW
@@ -221,6 +225,10 @@ labeling :
   | bind_var { let at = at () in fun c -> bind_label c $1, Labelled @@ at }
 ;
 
+offset :
+  | /* empty */ { 0L }
+  | OFFSET { $1 }
+;
 align :
   | /* empty */ { None }
   | ALIGN { Some $1 }
@@ -254,10 +262,14 @@ expr1 :
     { fun c -> call_indirect ($2 c table, $3 c, $4 c) }
   | GET_LOCAL var { fun c -> get_local ($2 c local) }
   | SET_LOCAL var expr { fun c -> set_local ($2 c local, $3 c) }
-  | LOAD align expr { fun c -> load (memop $1 $2, $3 c) }
-  | STORE align expr expr { fun c -> store (memop $1 $2, $3 c, $4 c) }
-  | LOAD_EXTEND align expr { fun c -> load_extend (extop $1 $2, $3 c) }
-  | STORE_WRAP align expr expr { fun c -> store_wrap (wrapop $1 $2, $3 c, $4 c) }
+  | LOAD offset align expr
+    { fun c -> load (memop $1 $2 $3, $4 c) }
+  | STORE offset align expr expr
+    { fun c -> store (memop $1 $2 $3, $4 c, $5 c) }
+  | LOAD_EXTEND offset align expr
+    { fun c -> load_extend (extop $1 $2 $3, $4 c) }
+  | STORE_WRAP offset align expr expr
+    { fun c -> store_wrap (wrapop $1 $2 $3, $4 c, $5 c) }
   | CONST literal { fun c -> const (literal $2 $1) }
   | UNARY expr { fun c -> unary ($1, $2 c) }
   | BINARY expr expr { fun c -> binary ($1, $2 c, $3 c) }

ml-proto/spec/ast.ml

@@ -62,7 +62,7 @@ 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 = {ty : value_type; align : int option}
+type memop = {ty : value_type; offset : Memory.offset; align : int option}
 type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension}
 type wrapop = {memop : memop; sz : Memory.mem_size}
 type hostop =

ml-proto/spec/check.ml

@@ -232,23 +232,25 @@ and check_case c t et case =
 
 and check_load c et memop e1 at =
   check_has_memory c at;
-  check_align memop.align at;
+  check_memop memop at;
   check_expr c (Some Int32Type) e1;
   check_type (Some memop.ty) et at
 
 and check_store c et memop e1 e2 at =
   check_has_memory c at;
-  check_align memop.align at;
+  check_memop memop at;
   check_expr c (Some Int32Type) e1;
   check_expr c (Some memop.ty) e2;
   check_type (Some memop.ty) et at
 
 and check_has_memory c at =
   require c.has_memory at "memory operators require a memory section"
 
-and check_align align at =
-  Lib.Option.app (fun a ->
-    require (Lib.Int.is_power_of_two a) at "non-power-of-two alignment") align
+and check_memop memop at =
+  require (memop.offset >= 0L) at "negative offset";
+  Lib.Option.app
+    (fun a -> require (Lib.Int.is_power_of_two a) at "non-power-of-two alignment")
+    memop.align
 
 and check_mem_type ty sz at =
   require (ty = Int64Type || sz <> Memory.Mem32) at "memory size too big"

ml-proto/spec/eval.ml

@@ -185,29 +185,32 @@ let rec eval_expr (c : config) (e : expr) =
     local c x := v1;
     Some v1
 
-  | Load ({ty; align = _}, e1) ->
+  | Load ({ty; offset; align = _}, e1) ->
     let mem = some_memory c e.at in
     let v1 = mem_size (eval_expr c e1) e1.at in
-    (try Some (Memory.load mem v1 ty) with exn -> memory_error e.at exn)
+    (try Some (Memory.load mem v1 offset ty)
+      with exn -> memory_error e.at exn)
 
-  | Store ({ty = _; align = _}, e1, e2) ->
+  | Store ({ty = _; offset; align = _}, e1, e2) ->
     let mem = some_memory c e.at in
     let v1 = mem_size (eval_expr c e1) e1.at in
     let v2 = some (eval_expr c e2) e2.at in
-    (try Memory.store mem v1 v2 with exn -> memory_error e.at exn);
+    (try Memory.store mem v1 offset v2
+      with exn -> memory_error e.at exn);
     Some v2
 
-  | LoadExtend ({memop = {ty; align = _}; sz; ext}, e1) ->
+  | LoadExtend ({memop = {ty; offset; align = _}; sz; ext}, e1) ->
     let mem = some_memory c e.at in
     let v1 = mem_size (eval_expr c e1) e1.at in
-    (try Some (Memory.load_extend mem v1 sz ext ty)
+    (try Some (Memory.load_extend mem v1 offset sz ext ty)
       with exn -> memory_error e.at exn)
 
-  | StoreWrap ({memop = {ty; align = _}; sz}, e1, e2) ->
+  | StoreWrap ({memop = {ty; offset; align = _}; sz}, e1, e2) ->
     let mem = some_memory c e.at in
     let v1 = mem_size (eval_expr c e1) e1.at in
     let v2 = some (eval_expr c e2) e2.at in
-    (try Memory.store_wrap mem v1 sz v2 with exn -> memory_error e.at exn);
+    (try Memory.store_wrap mem v1 offset sz v2
+      with exn -> memory_error e.at exn);
     Some v2
 
   | Const v ->

ml-proto/spec/memory.ml

@@ -8,6 +8,7 @@ open Values
 
 type address = int64
 type size = address
+type offset = address
 type mem_size = Mem8 | Mem16 | Mem32
 type extension = SX | ZX
 type segment = {addr : address; data : string}
@@ -79,9 +80,13 @@ let grow mem n =
   Array1.blit (Array1.sub !mem 0 host_old_size) (Array1.sub after 0 host_old_size);
   mem := after
 
-let rec loadn mem n a =
+let effective_address a o =
+  if (Int64.sub Int64.max_int a) < o then raise Bounds;
+  Int64.add a o
+
+let rec loadn mem n ea =
   assert (n > 0 && n <= 8);
-  let i = host_index_of_int64 a n in
+  let i = host_index_of_int64 ea n in
   try loadn' mem n i with Invalid_argument _ -> raise Bounds
 
 and loadn' mem n i =
@@ -91,55 +96,59 @@ and loadn' mem n i =
   else
     Int64.logor byte (Int64.shift_left (loadn' mem (n-1) (i+1)) 8)
 
-let rec storen mem n a v =
+let rec storen mem n ea v =
   assert (n > 0 && n <= 8);
-  let i = host_index_of_int64 a n in
+  let i = host_index_of_int64 ea n in
   try storen' mem n i v with Invalid_argument _ -> raise Bounds
 
 and storen' mem n i v =
   !mem.{i} <- (Int64.to_int v) land 255;
   if (n > 1) then
     storen' mem (n-1) (i+1) (Int64.shift_right v 8)
 
-let load mem a t =
+let load mem a o t =
+  let ea = effective_address a o in
   match t with
-  | Int32Type -> Int32 (Int64.to_int32 (loadn mem 4 a))
-  | Int64Type -> Int64 (loadn mem 8 a)
-  | Float32Type -> Float32 (F32.of_bits (Int64.to_int32 (loadn mem 4 a)))
-  | Float64Type -> Float64 (F64.of_bits (loadn mem 8 a))
+  | Int32Type -> Int32 (Int64.to_int32 (loadn mem 4 ea))
+  | Int64Type -> Int64 (loadn mem 8 ea)
+  | Float32Type -> Float32 (F32.of_bits (Int64.to_int32 (loadn mem 4 ea)))
+  | Float64Type -> Float64 (F64.of_bits (loadn mem 8 ea))
 
-let store mem a v =
+let store mem a o v =
+  let ea = effective_address a o in
   match v with
-  | Int32 x -> storen mem 4 a (Int64.of_int32 x)
-  | Int64 x -> storen mem 8 a x
-  | Float32 x -> storen mem 4 a (Int64.of_int32 (F32.to_bits x))
-  | Float64 x -> storen mem 8 a (F64.to_bits x)
+  | Int32 x -> storen mem 4 ea (Int64.of_int32 x)
+  | Int64 x -> storen mem 8 ea x
+  | Float32 x -> storen mem 4 ea (Int64.of_int32 (F32.to_bits x))
+  | Float64 x -> storen mem 8 ea (F64.to_bits x)
 
-let loadn_sx mem n a =
+let loadn_sx mem n ea =
   assert (n > 0 && n <= 8);
-  let v = loadn mem n a in
+  let v = loadn mem n ea in
   let shift = 64 - (8 * n) in
   Int64.shift_right (Int64.shift_left v shift) shift
 
-let load_extend mem a sz ext t =
+let load_extend mem a o sz ext t =
+  let ea = effective_address a o in
   match sz, ext, t with
-  | Mem8,  ZX, Int32Type -> Int32 (Int64.to_int32 (loadn    mem 1 a))
-  | Mem8,  SX, Int32Type -> Int32 (Int64.to_int32 (loadn_sx mem 1 a))
-  | Mem8,  ZX, Int64Type -> Int64 (loadn mem 1 a)
-  | Mem8,  SX, Int64Type -> Int64 (loadn_sx mem 1 a)
-  | Mem16, ZX, Int32Type -> Int32 (Int64.to_int32 (loadn    mem 2 a))
-  | Mem16, SX, Int32Type -> Int32 (Int64.to_int32 (loadn_sx mem 2 a))
-  | Mem16, ZX, Int64Type -> Int64 (loadn    mem 2 a)
-  | Mem16, SX, Int64Type -> Int64 (loadn_sx mem 2 a)
-  | Mem32, ZX, Int64Type -> Int64 (loadn    mem 4 a)
-  | Mem32, SX, Int64Type -> Int64 (loadn_sx mem 4 a)
+  | Mem8,  ZX, Int32Type -> Int32 (Int64.to_int32 (loadn    mem 1 ea))
+  | Mem8,  SX, Int32Type -> Int32 (Int64.to_int32 (loadn_sx mem 1 ea))
+  | Mem8,  ZX, Int64Type -> Int64 (loadn mem 1 ea)
+  | Mem8,  SX, Int64Type -> Int64 (loadn_sx mem 1 ea)
+  | Mem16, ZX, Int32Type -> Int32 (Int64.to_int32 (loadn    mem 2 ea))
+  | Mem16, SX, Int32Type -> Int32 (Int64.to_int32 (loadn_sx mem 2 ea))
+  | Mem16, ZX, Int64Type -> Int64 (loadn    mem 2 ea)
+  | Mem16, SX, Int64Type -> Int64 (loadn_sx mem 2 ea)
+  | Mem32, ZX, Int64Type -> Int64 (loadn    mem 4 ea)
+  | Mem32, SX, Int64Type -> Int64 (loadn_sx mem 4 ea)
   | _ -> raise Type
 
-let store_wrap mem a sz v =
+let store_wrap mem a o sz v =
+  let ea = effective_address a o in
   match sz, v with
-  | Mem8,  Int32 x -> storen mem 1 a (Int64.of_int32 x)
-  | Mem8,  Int64 x -> storen mem 1 a x
-  | Mem16, Int32 x -> storen mem 2 a (Int64.of_int32 x)
-  | Mem16, Int64 x -> storen mem 2 a x
-  | Mem32, Int64 x -> storen mem 4 a x
+  | Mem8,  Int32 x -> storen mem 1 ea (Int64.of_int32 x)
+  | Mem8,  Int64 x -> storen mem 1 ea x
+  | Mem16, Int32 x -> storen mem 2 ea (Int64.of_int32 x)
+  | Mem16, Int64 x -> storen mem 2 ea x
+  | Mem32, Int64 x -> storen mem 4 ea x
   | _ -> raise Type

ml-proto/spec/memory.mli

@@ -6,6 +6,7 @@ type memory
 type t = memory
 type address = int64
 type size = address
+type offset = address
 type mem_size = Mem8 | Mem16 | Mem32
 type extension = SX | ZX
 type segment = {addr : address; data : string}
@@ -20,8 +21,8 @@ val create : size -> memory
 val init : memory -> segment list -> unit
 val size : memory -> size
 val grow : memory -> size -> unit
-val load : memory -> address -> value_type -> value
-val store : memory -> address -> value -> unit
+val load : memory -> address -> offset -> value_type -> value
+val store : memory -> address -> offset -> value -> unit
 val load_extend :
-  memory -> address -> mem_size -> extension -> value_type -> value
-val store_wrap : memory -> address -> mem_size -> value -> unit
+  memory -> address -> offset -> mem_size -> extension -> value_type -> value
+val store_wrap : memory -> address -> offset -> mem_size -> value -> unit

ml-proto/test/address.wast

@@ -0,0 +1,35 @@
+(module
+    (memory 1024 (segment 0 "abcdefghijklmnopqrstuvwxyz"))
+    (import $print "stdio" "print" (param i32))
+
+    (func $good (param $i i32)
+        (call_import $print (i32.load8_u offset=0 (get_local $i)))  ;; 97 'a'
+        (call_import $print (i32.load8_u offset=1 (get_local $i)))  ;; 98 'b'
+        (call_import $print (i32.load8_u offset=2 (get_local $i)))  ;; 99 'c'
+        (call_import $print (i32.load8_u offset=25 (get_local $i))) ;; 122 'z'
+
+        (call_import $print (i32.load16_u offset=0 (get_local $i)))          ;; 25185 'ab'
+        (call_import $print (i32.load16_u offset=1 align=1 (get_local $i)))  ;; 25442 'bc'
+        (call_import $print (i32.load16_u offset=2 (get_local $i)))          ;; 25699 'cd'
+        (call_import $print (i32.load16_u offset=25 align=1 (get_local $i))) ;; 122 'z\0'
+
+        (call_import $print (i32.load offset=0 (get_local $i)))          ;; 1684234849 'abcd'
+        (call_import $print (i32.load offset=1 align=1 (get_local $i)))  ;; 1701077858 'bcde'
+        (call_import $print (i32.load offset=2 align=2 (get_local $i)))  ;; 1717920867 'cdef'
+        (call_import $print (i32.load offset=25 align=1 (get_local $i))) ;; 122 'z\0\0\0'
+    )
+    (export "good" $good)
+
+    (func $bad1 (param $i i32) (i32.load offset=4294967296 (get_local $i)))
+    (export "bad1" $bad1)
+    (func $bad2 (param $i i32) (i32.load offset=4294967295 (get_local $i)))
+    (export "bad2" $bad2)
+)
+
+(assert_return (invoke "good" (i32.const 0)))
+(assert_return (invoke "good" (i32.const 995)))
+(assert_trap (invoke "good" (i32.const 996)) "runtime: out of bounds memory access")
+(assert_trap (invoke "bad1" (i32.const 0)) "runtime: out of bounds memory access")
+(assert_trap (invoke "bad1" (i32.const 1)) "runtime: out of bounds memory access")
+(assert_trap (invoke "bad2" (i32.const 0)) "runtime: out of bounds memory access")
+(assert_trap (invoke "bad2" (i32.const 1)) "runtime: out of bounds memory access")