Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion interpreter/binary/decode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -296,7 +296,7 @@ let globaltype s =

let memorytype s =
let at, lim = limits u64 s in
MemoryT (at, lim)
MemoryT (at, PageT 0x10000, lim) (* TODO(custom-page-sizes) *)

let tabletype s =
let t = reftype s in
Expand Down
2 changes: 1 addition & 1 deletion interpreter/binary/encode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -194,7 +194,7 @@ struct
| GlobalT (mut, t) -> valtype t; mutability mut

let memorytype = function
| MemoryT (at, lim) -> limits at lim
| MemoryT (at, pt, lim) -> limits at lim (* TODO(custom-page-sizes) *)

let tabletype = function
| TableT (at, lim, t) -> reftype t; limits at lim
Expand Down
2 changes: 1 addition & 1 deletion interpreter/host/spectest.ml
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ let table64 =
ExternTable (Table.alloc tt (NullRef FuncHT))

let memory =
let mt = MemoryT (I32AT, {min = 1L; max = Some 2L}) in
let mt = MemoryT (I32AT, PageT 0x10000, {min = 1L; max = Some 2L}) in
ExternMemory (Memory.alloc mt)

let func f ts1 ts2 =
Expand Down
12 changes: 6 additions & 6 deletions interpreter/runtime/memory.ml
Original file line number Diff line number Diff line change
Expand Up @@ -31,13 +31,13 @@ let valid_size at i =

let create n =
try
let size = Int64.(mul n page_size) in
let size = Int64.(mul n page_size) in (* TODO(custom-page-sizes *)
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) as ty) =
let alloc (MemoryT (at, pt, lim) as ty) =
assert Free.((memorytype ty).types = Set.empty);
if not (valid_size at lim.min) then raise SizeOverflow;
if not (valid_limits lim) then raise Type;
Expand All @@ -47,16 +47,16 @@ let bound mem =
Array1_64.dim mem.content

let size mem =
Int64.(div (bound mem) page_size)
Int64.(div (bound mem) page_size) (* TODO(custom-page-sizes) *)

let type_of mem =
mem.ty

let addrtype_of mem =
let MemoryT (at, _) = type_of mem in at
let MemoryT (at, _, _) = type_of mem in at

let grow mem delta =
let MemoryT (at, lim) = mem.ty in
let MemoryT (at, pt, lim) = mem.ty in
assert (lim.min = size mem);
let old_size = lim.min in
let new_size = Int64.add old_size delta in
Expand All @@ -67,7 +67,7 @@ let grow mem delta =
let after = create new_size in
let dim = Array1_64.dim mem.content in
Array1.blit (Array1_64.sub mem.content 0L dim) (Array1_64.sub after 0L dim);
mem.ty <- MemoryT (at, lim');
mem.ty <- MemoryT (at, pt, lim');
mem.content <- after

let load_byte mem a =
Expand Down
2 changes: 1 addition & 1 deletion interpreter/syntax/free.ml
Original file line number Diff line number Diff line change
Expand Up @@ -118,7 +118,7 @@ and deftype = function

let tagtype (TagT ut) = typeuse ut
let globaltype (GlobalT (_mut, t)) = valtype t
let memorytype (MemoryT (_at, _lim)) = empty
let memorytype (MemoryT (_at, _pt, _lim)) = empty
let tabletype (TableT (_at, _lim, t)) = reftype t

let externtype = function
Expand Down
10 changes: 7 additions & 3 deletions interpreter/syntax/types.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ type limits = {min : int64; max : int64 option}
type typeuse = Idx of typeidx | Rec of int32 | Def of deftype

and addrtype = I32AT | I64AT
and pagetype = PageT of int
and numtype = I32T | I64T | F32T | F64T
and vectype = V128T
and heaptype =
Expand All @@ -39,7 +40,7 @@ and deftype = DefT of rectype * int32

type tagtype = TagT of typeuse
type globaltype = GlobalT of mut * valtype
type memorytype = MemoryT of addrtype * limits
type memorytype = MemoryT of addrtype * pagetype * limits
type tabletype = TableT of addrtype * limits * reftype
type localtype = LocalT of init * valtype
type externtype =
Expand Down Expand Up @@ -219,7 +220,7 @@ let subst_globaltype s = function
| GlobalT (mut, t) -> GlobalT (mut, subst_valtype s t)

let subst_memorytype s = function
| MemoryT (at, lim) -> MemoryT (subst_addrtype s at, lim)
| MemoryT (at, pt, lim) -> MemoryT (subst_addrtype s at, pt, lim)

let subst_tabletype s = function
| TableT (at, lim, t) -> TableT (subst_addrtype s at, lim, subst_reftype s t)
Expand Down Expand Up @@ -322,6 +323,9 @@ let string_of_numtype = function
let string_of_addrtype at =
string_of_numtype (numtype_of_addrtype at)

let string_of_pagetype = function
| PageT x -> string_of_int x

let string_of_vectype = function
| V128T -> "v128"

Expand Down Expand Up @@ -408,7 +412,7 @@ let string_of_globaltype = function
| GlobalT (mut, t) -> string_of_mut (string_of_valtype t) mut

let string_of_memorytype = function
| MemoryT (at, lim) -> string_of_addrtype at ^ " " ^ string_of_limits lim
| MemoryT (at, pt, lim) -> string_of_addrtype at ^ " " ^ string_of_limits lim ^ " " ^ string_of_pagetype pt

let string_of_tabletype = function
| TableT (at, lim, t) ->
Expand Down
4 changes: 2 additions & 2 deletions interpreter/text/arrange.ml
Original file line number Diff line number Diff line change
Expand Up @@ -118,8 +118,8 @@ let tagtype (TagT ut) =
let globaltype (GlobalT (mut, t)) =
[mutability (atom string_of_valtype t) mut]

let memorytype (MemoryT (at, lim)) =
[Atom (addrtype at ^ " " ^ limits nat64 lim)]
let memorytype (MemoryT (at, pt, lim)) =
[Atom (addrtype at ^ " " ^ limits nat64 lim)] (* TODO(custom-page-sizes) *)

let tabletype (TableT (at, lim, t)) =
[Atom (addrtype at ^ " " ^ limits nat64 lim); atom reftype t]
Expand Down
4 changes: 2 additions & 2 deletions interpreter/text/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -466,7 +466,7 @@ tabletype :
| addrtype limits reftype { fun c -> TableT ($1, $2, $3 c) }

memorytype :
| addrtype limits { fun c -> MemoryT ($1, $2) }
| addrtype limits { fun c -> MemoryT ($1, PageT 0x10000, $2) }

limits :
| NAT { {min = nat64 $1 $loc($1); max = None} }
Expand Down Expand Up @@ -1130,7 +1130,7 @@ memory_fields :
{ fun c x loc ->
let size = Int64.(div (add (of_int (String.length $4)) 65535L) 65536L) in
let offset = [at_const $1 (0L @@ loc) @@ loc] @@ loc in
[Memory (MemoryT ($1, {min = size; max = Some size})) @@ loc],
[Memory (MemoryT ($1, PageT 0x10000, {min = size; max = Some size})) @@ loc],
[Data ($4, Active (x, offset) @@ loc) @@ loc],
[], [] }

Expand Down
4 changes: 2 additions & 2 deletions interpreter/valid/match.ml
Original file line number Diff line number Diff line change
Expand Up @@ -165,8 +165,8 @@ let match_globaltype c (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) =
| Cons -> true
| Var -> match_valtype c t2 t1

let match_memorytype c (MemoryT (at1, lim1)) (MemoryT (at2, lim2)) =
at1 = at2 && match_limits c lim1 lim2
let match_memorytype c (MemoryT (at1, pt1, lim1)) (MemoryT (at2, pt2, lim2)) =
at1 = at2 && pt1 = pt2 && match_limits c lim1 lim2

let match_tabletype c (TableT (at1, lim1, t1)) (TableT (at2, lim2, t2)) =
at1 = at2 && match_limits c lim1 lim2 &&
Expand Down
30 changes: 15 additions & 15 deletions interpreter/valid/valid.ml
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,7 @@ let check_globaltype (c : context) (gt : globaltype) at =
check_valtype c t at

let check_memorytype (c : context) (mt : memorytype) at =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Don't you need to check here that pt is either 1 or 0x10000?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done.

let MemoryT (at_, lim) = mt in
let MemoryT (at_, pt, lim) = mt in
let sz, s =
match at_ with
| I32AT -> 0x1_0000L, "2^16 pages (4 GiB) for i32"
Expand Down Expand Up @@ -384,7 +384,7 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at =
in
require (1 lsl memop.align >= 1 && 1 lsl memop.align <= size) at
"alignment must not be larger than natural";
let MemoryT (at_, _lim) = memory c (0l @@ at) in
let MemoryT (at_, pt, _lim) = memory c (0l @@ at) in
if at_ = I32AT then
require (I64.lt_u memop.offset 0x1_0000_0000L) at
"offset out of range";
Expand Down Expand Up @@ -648,60 +648,60 @@ let rec check_instr (c : context) (e : instr) (s : infer_resulttype) : infer_ins
[] --> [], []

| Load (x, memop) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop num_size (Lib.Option.map fst) e.at in
[NumT (numtype_of_addrtype at)] --> [NumT t], []

| Store (x, memop) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop num_size (fun sz -> sz) e.at in
[NumT (numtype_of_addrtype at); NumT t] --> [], []

| VecLoad (x, memop) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop vec_size (Lib.Option.map fst) e.at in
[NumT (numtype_of_addrtype at)] --> [VecT t], []

| VecStore (x, memop) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop vec_size (fun _ -> None) e.at in
[NumT (numtype_of_addrtype at); VecT t] --> [], []

| VecLoadLane (x, memop, i) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop vec_size (fun sz -> Some sz) e.at in
require (I8.to_int_u i < vec_size t / Pack.packed_size memop.pack) e.at
"invalid lane index";
[NumT (numtype_of_addrtype at); VecT t] --> [VecT t], []

| VecStoreLane (x, memop, i) ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
let t = check_memop c memop vec_size (fun sz -> Some sz) e.at in
require (I8.to_int_u i < vec_size t / Pack.packed_size memop.pack) e.at
"invalid lane index";
[NumT (numtype_of_addrtype at); VecT t] --> [], []

| MemorySize x ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
[] --> [NumT (numtype_of_addrtype at)], []

| MemoryGrow x ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
[NumT (numtype_of_addrtype at)] --> [NumT (numtype_of_addrtype at)], []

| MemoryFill x ->
let MemoryT (at, _lim) = memory c x in
let MemoryT (at, _pt, _lim) = memory c x in
[NumT (numtype_of_addrtype at); NumT I32T;
NumT (numtype_of_addrtype at)] --> [], []

| MemoryCopy (x, y)->
let MemoryT (at1, _lib1) = memory c x in
let MemoryT (at2, _lib2) = memory c y in
let MemoryT (at1, _pt, _lib1) = memory c x in
let MemoryT (at2, _pt, _lib2) = memory c y in
[NumT (numtype_of_addrtype at1); NumT (numtype_of_addrtype at2);
NumT (numtype_of_addrtype (min at1 at2))] --> [], []

| MemoryInit (x, y) ->
let MemoryT (at, _lib) = memory c x in
let MemoryT (at, _pt, _lib) = memory c x in
let () = data c y in
[NumT (numtype_of_addrtype at); NumT I32T; NumT I32T] --> [], []

Expand Down Expand Up @@ -1071,7 +1071,7 @@ let check_datamode (c : context) (mode : segmentmode) =
match mode.it with
| Passive -> ()
| Active (x, offset) ->
let MemoryT (at, _) = memory c x in
let MemoryT (at, _pt, _) = memory c x in
check_const c offset (NumT (numtype_of_addrtype at))
| Declarative -> assert false

Expand Down