Skip to content

Update load/store to match design changes #55

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Sep 14, 2015
Merged
Show file tree
Hide file tree
Changes from all commits
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
10 changes: 4 additions & 6 deletions ml-proto/README.md
Original file line number Diff line number Diff line change
Expand Up @@ -127,8 +127,8 @@ type expr =
| SetLocal of var * expr (* write local variable
| LoadGlobal of var (* read global variable
| StoreGlobal of var * expr (* write global variable
| Load of memop * expr (* read memory address
| Store of memop * expr * expr (* write memory address
| Load of loadop * expr (* read memory address
| Store of storeop * expr * expr (* write memory address
| Const of value (* constant
| Unary of unop * expr (* unary arithmetic operator
| Binary of binop * expr * expr (* binary arithmetic operator
Expand All @@ -147,7 +147,6 @@ The S-expression syntax is defined in `parser.mly`, the opcodes in `lexer.mll`.

```
type: i32 | i64 | f32 | f64
memtype: <type> | i8 | i16

value: <int> | <float>
var: <int> | $<name>
Expand All @@ -157,7 +156,6 @@ binop: add | sub | mul | ...
relop: eq | neq | lt | ...
sign: s|u
align: 1|2|4|8|...
memop: (<sign>.)?(<align>.)?
cvtop: trunc_s | trunc_u | extend_s | extend_u | ...

expr:
Expand All @@ -177,8 +175,8 @@ expr:
( set_local <var> <expr> )
( load_global <var> )
( store_global <var> <expr> )
( <type>.load<memop><memtype> <expr> )
( <type>.store<memop><memtype> <expr> <expr> )
( <type>.load((8|16)_<sign>)?(/<align>)? <expr> )
( <type>.store(/<align>)? <expr> <expr> )
( <type>.const <value> )
( <type>.<unop> <expr> )
( <type>.<binop> <expr> <expr> )
Expand Down
59 changes: 31 additions & 28 deletions ml-proto/src/host/lexer.mll
Original file line number Diff line number Diff line change
Expand Up @@ -60,27 +60,32 @@ let floatop t f32 f64 =
| "f64" -> Values.Float64 f64
| _ -> assert false

let mem_type t sign memty =
let mem_type mty =
let open Memory in
match t, sign, memty with
| ("i32" | "i64"), 's', "i8" -> SInt8Mem
| ("i32" | "i64"), 's', "i16" -> SInt16Mem
| ("i32" | "i64"), 's', "i32" -> SInt32Mem
| "i64", 's', "i64" -> SInt64Mem
| ("i32" | "i64"), 'u', "i8" -> UInt8Mem
| ("i32" | "i64"), 'u', "i16" -> UInt16Mem
| ("i32" | "i64"), 'u', "i32" -> UInt32Mem
| "i64", 'u', "i64" -> UInt64Mem
| "f32", ' ', "f32" -> Float32Mem
| "f64", ' ', "f64" -> Float64Mem
match mty with
| "i8" -> Int8Mem
| "i16" -> Int16Mem
| "i32" -> Int32Mem
| "i64" -> Int64Mem
| "f32" -> Float32Mem
| "f64" -> Float64Mem
| _ -> assert false

let memop ty sign memsize a =
let memty = mem_type ty sign memsize in
let align = if a = "" then Memory.mem_size memty else int_of_string a in
{ty = value_type ty; mem = memty; align}
}
let loadop t sign a =
let mem = mem_type t in
let ext = match sign with
| ' ' -> Memory.NX
| 's' -> Memory.SX
| 'u' -> Memory.ZX
| _ -> assert false in
let align = if a = "" then Memory.mem_size mem else int_of_string a in
{mem; ext; align}

let storeop t a =
let mem = mem_type t in
let align = if a = "" then Memory.mem_size mem else int_of_string a in
{mem; align}
}

let space = [' ''\t']
let digit = ['0'-'9']
Expand All @@ -104,6 +109,7 @@ let mixx = "i" ("8" | "16" | "32" | "64")
let mfxx = "f" ("32" | "64")
let sign = "s" | "u"
let align = digit+
let width = digit+

rule token = parse
| "(" { LPAR }
Expand Down Expand Up @@ -138,17 +144,14 @@ rule token = parse
| "load_global" { LOADGLOBAL }
| "store_global" { STOREGLOBAL }

| (ixx as t)".load_"(sign as s)"/"(mixx as m)"/"(align as a)
{ LOAD (memop t s m a) }
| (ixx as t)".load_"(sign as s)"/"(mixx as m) { LOAD (memop t s m "") }
| (ixx as t)".load/"(mixx as m)"/"(align as a) { LOAD (memop t 's' m a) }
| (ixx as t)".load/"(mixx as m) { LOAD (memop t 's' m "") }
| (ixx as t)".store/"(mixx as m)"/"(align as a) { STORE (memop t 's' m a) }
| (ixx as t)".store/"(mixx as m) { STORE (memop t 's' m "") }
| (fxx as t)".load/"(mfxx as m)"/"(align as a) { LOAD (memop t ' ' m a) }
| (fxx as t)".store/"(mfxx as m)"/"(align as a) { STORE (memop t ' ' m a) }
| (fxx as t)".load/"(mfxx as m) { LOAD (memop t ' ' m "") }
| (fxx as t)".store/"(mfxx as m) { STORE (memop t ' ' m "") }
| (nxx as t)".load" { LOAD (loadop t ' ' "") }
| (nxx as t)".load/"(align as a) { LOAD (loadop t ' ' a) }
| (ixx)".load"(width as w)"_"(sign as s) { LOAD (loadop ("i" ^ w) s "") }
| (ixx)".load"(width as w)"_"(sign as s)"/"(align as a) { LOAD (loadop ("i" ^ w) s a) }
| (nxx as t)".store" { STORE (storeop t "") }
| (nxx as t)".store/"(align as a) { STORE (storeop t a) }
| (ixx)".store"(width as w) { STORE (storeop ("i" ^ w) "") }
| (ixx)".store"(width as w)"/"(align as a) { STORE (storeop ("i" ^ w) a) }

| (nxx as t)".switch" { SWITCH (value_type t) }
| (nxx as t)".const" { CONST (value_type t) }
Expand Down
4 changes: 2 additions & 2 deletions ml-proto/src/host/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -113,8 +113,8 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
%token<Ast.binop> BINARY
%token<Ast.relop> COMPARE
%token<Ast.cvt> CONVERT
%token<Ast.memop> LOAD
%token<Ast.memop> STORE
%token<Ast.loadop> LOAD
%token<Ast.storeop> STORE

%start script
%type<Script.script> script
Expand Down
7 changes: 4 additions & 3 deletions ml-proto/src/spec/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,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 = {ty : Types.value_type; mem : Memory.mem_type; align : int}
type loadop = {mem : Memory.mem_type; ext : Memory.extension; align : int}
type storeop = {mem : Memory.mem_type; align : int}


(* Expressions *)
Expand All @@ -87,8 +88,8 @@ and expr' =
| SetLocal of var * expr
| LoadGlobal of var
| StoreGlobal of var * expr
| Load of memop * expr
| Store of memop * expr * expr
| Load of loadop * expr
| Store of storeop * expr * expr
| Const of literal
| Unary of unop * expr
| Binary of binop * expr * expr
Expand Down
37 changes: 12 additions & 25 deletions ml-proto/src/spec/check.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,14 +54,10 @@ let check_func_type actual expected at =
(* Type Synthesis *)

let type_mem = function
| Memory.SInt8Mem -> Int32Type
| Memory.SInt16Mem -> Int32Type
| Memory.SInt32Mem -> Int32Type
| Memory.SInt64Mem -> Int64Type
| Memory.UInt8Mem -> Int32Type
| Memory.UInt16Mem -> Int32Type
| Memory.UInt32Mem -> Int32Type
| Memory.UInt64Mem -> Int64Type
| Memory.Int8Mem -> Int32Type
| Memory.Int16Mem -> Int32Type
| Memory.Int32Mem -> Int32Type
| Memory.Int64Mem -> Int64Type
| Memory.Float32Mem -> Float32Type
| Memory.Float64Mem -> Float64Type

Expand Down Expand Up @@ -184,15 +180,15 @@ let rec check_expr c et e =
check_expr c (Some (global c x)) e1;
check_type None et e.at

| Load (memop, e1) ->
check_memop memop e.at;
| Load (loadop, e1) ->
check_align loadop.align e.at;
check_expr c (Some Int32Type) e1;
check_type (Some (type_mem memop.mem)) et e.at
check_type (Some (type_mem loadop.mem)) et e.at

| Store (memop, e1, e2) ->
check_memop memop e.at;
| Store (storeop, e1, e2) ->
check_align storeop.align e.at;
check_expr c (Some Int32Type) e1;
check_expr c (Some memop.ty) e2;
check_expr c (Some (type_mem storeop.mem)) e2;
check_type None et e.at

| Const v ->
Expand Down Expand Up @@ -238,17 +234,8 @@ and check_arm c t et arm =
check_literal c (Some t) l;
check_expr c (if fallthru then None else et) e

and check_memop {ty; mem; align} at =
require (Lib.Int.is_power_of_two align) at "non-power-of-two alignment";
let open Memory in
match mem, ty with
| (SInt8Mem | SInt16Mem | SInt32Mem), Int32Type
| (UInt8Mem | UInt16Mem | UInt32Mem), Int32Type
| (SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem), Int64Type
| (UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem), Int64Type
| Float32Mem, Float32Type
| Float64Mem, Float64Type -> ()
| _ -> error at "type-inconsistent memory operator"
and check_align align at =
require (Lib.Int.is_power_of_two align) at "non-power-of-two alignment"


(*
Expand Down
6 changes: 3 additions & 3 deletions ml-proto/src/spec/eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -156,12 +156,12 @@ let rec eval_expr (c : config) (e : expr) =
global c x := v1;
None

| Load ({mem; ty; _}, e1) ->
| Load ({mem; ext; align = _}, e1) ->
let v1 = some (eval_expr c e1) e1.at in
(try Some (Memory.load c.modul.memory (Memory.address_of_value v1) mem ty)
(try Some (Memory.load c.modul.memory (Memory.address_of_value v1) mem ext)
with exn -> memory_error e.at exn)

| Store ({mem; _}, e1, e2) ->
| Store ({mem; align = _}, e1, e2) ->
let v1 = some (eval_expr c e1) e1.at in
let v2 = some (eval_expr c e2) e2.at in
(try Memory.store c.modul.memory (Memory.address_of_value v1) mem v2
Expand Down
61 changes: 20 additions & 41 deletions ml-proto/src/spec/memory.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,9 @@ open Bigarray
type address = int
type size = address
type mem_size = int
type extension = SX | ZX | NX
type mem_type =
| SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem
| UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem
| Float32Mem | Float64Mem
Int8Mem | Int16Mem | Int32Mem | Int64Mem | Float32Mem | Float64Mem

type segment =
{
Expand Down Expand Up @@ -42,10 +41,10 @@ let view : memory -> ('c, 'd, c_layout) Array1.t = Obj.magic
(* Queries *)

let mem_size = function
| SInt8Mem | UInt8Mem -> 1
| SInt16Mem | UInt16Mem -> 2
| SInt32Mem | UInt32Mem | Float32Mem -> 4
| SInt64Mem | UInt64Mem | Float64Mem -> 8
| Int8Mem -> 1
| Int16Mem -> 2
| Int32Mem | Float32Mem -> 4
| Int64Mem | Float64Mem -> 8


(* Creation and initialization *)
Expand Down Expand Up @@ -83,51 +82,31 @@ let int64_of_int32_u i = Int64.logand (Int64.of_int32 i) int32_mask

let buf = create 8

let load mem a memty valty =
let load mem a memty ext =
let sz = mem_size memty in
let open Types in
try
Array1.blit (Array1.sub mem a sz) (Array1.sub buf 0 sz);
match memty, valty with
| SInt8Mem, Int32Type -> Int32 (Int32.of_int (view buf : sint8_view).{0})
| SInt8Mem, Int64Type -> Int64 (Int64.of_int (view buf : sint8_view).{0})
| SInt16Mem, Int32Type -> Int32 (Int32.of_int (view buf : sint16_view).{0})
| SInt16Mem, Int64Type -> Int64 (Int64.of_int (view buf : sint16_view).{0})
| SInt32Mem, Int32Type -> Int32 (view buf : sint32_view).{0}
| SInt32Mem, Int64Type ->
Int64 (Int64.of_int32 (view buf : sint32_view).{0})
| SInt64Mem, Int64Type -> Int64 (view buf : sint64_view).{0}
| UInt8Mem, Int32Type -> Int32 (Int32.of_int (view buf : uint8_view).{0})
| UInt8Mem, Int64Type -> Int64 (Int64.of_int (view buf : uint8_view).{0})
| UInt16Mem, Int32Type -> Int32 (Int32.of_int (view buf : uint16_view).{0})
| UInt16Mem, Int64Type -> Int64 (Int64.of_int (view buf : uint16_view).{0})
| UInt32Mem, Int32Type -> Int32 (view buf : uint32_view).{0}
| UInt32Mem, Int64Type ->
Int64 (int64_of_int32_u (view buf : uint32_view).{0})
| UInt64Mem, Int64Type -> Int64 (view buf : uint64_view).{0}
| Float32Mem, Float32Type -> Float32 (view buf : float32_view).{0}
| Float64Mem, Float64Type -> Float64 (view buf : float64_view).{0}
match memty, ext with
| Int8Mem, SX -> Int32 (Int32.of_int (view buf : sint8_view).{0})
| Int8Mem, ZX -> Int32 (Int32.of_int (view buf : uint8_view).{0})
| Int16Mem, SX -> Int32 (Int32.of_int (view buf : sint16_view).{0})
| Int16Mem, ZX -> Int32 (Int32.of_int (view buf : uint16_view).{0})
| Int32Mem, NX -> Int32 (view buf : sint32_view).{0}
| Int64Mem, NX -> Int64 (view buf : sint64_view).{0}
| Float32Mem, NX -> Float32 (view buf : float32_view).{0}
| Float64Mem, NX -> Float64 (view buf : float64_view).{0}
| _ -> raise Type
with Invalid_argument _ -> raise Bounds

let store mem a memty v =
let sz = mem_size memty in
try
(match memty, v with
| SInt8Mem, Int32 x -> (view buf : sint8_view).{0} <- Int32.to_int x
| SInt8Mem, Int64 x -> (view buf : sint8_view).{0} <- Int64.to_int x
| SInt16Mem, Int32 x -> (view buf : sint16_view).{0} <- Int32.to_int x
| SInt16Mem, Int64 x -> (view buf : sint16_view).{0} <- Int64.to_int x
| SInt32Mem, Int32 x -> (view buf : sint32_view).{0} <- x
| SInt32Mem, Int64 x -> (view buf : sint32_view).{0} <- Int64.to_int32 x
| SInt64Mem, Int64 x -> (view buf : sint64_view).{0} <- x
| UInt8Mem, Int32 x -> (view buf : uint8_view).{0} <- Int32.to_int x
| UInt8Mem, Int64 x -> (view buf : uint8_view).{0} <- Int64.to_int x
| UInt16Mem, Int32 x -> (view buf : uint16_view).{0} <- Int32.to_int x
| UInt16Mem, Int64 x -> (view buf : uint16_view).{0} <- Int64.to_int x
| UInt32Mem, Int32 x -> (view buf : uint32_view).{0} <- x
| UInt32Mem, Int64 x -> (view buf : uint32_view).{0} <- Int64.to_int32 x
| UInt64Mem, Int64 x -> (view buf : uint64_view).{0} <- x
| Int8Mem, Int32 x -> (view buf : sint8_view).{0} <- Int32.to_int x
| Int16Mem, Int32 x -> (view buf : sint16_view).{0} <- Int32.to_int x
| Int32Mem, Int32 x -> (view buf : sint32_view).{0} <- x
| Int64Mem, Int64 x -> (view buf : sint64_view).{0} <- x
| Float32Mem, Float32 x -> (view buf : float32_view).{0} <- x
| Float64Mem, Float64 x -> (view buf : float64_view).{0} <- x
| _ -> raise Type);
Expand Down
7 changes: 3 additions & 4 deletions ml-proto/src/spec/memory.mli
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,9 @@ type t = memory
type address = int
type size = address
type mem_size = int
type extension = SX | ZX | NX
type mem_type =
| SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem
| UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem
| Float32Mem | Float64Mem
Int8Mem | Int16Mem | Int32Mem | Int64Mem | Float32Mem | Float64Mem

type segment = {addr : address; data : string}

Expand All @@ -20,7 +19,7 @@ exception Address

val create : size -> memory
val init : memory -> segment list -> unit
val load : memory -> address -> mem_type -> Types.value_type -> Values.value
val load : memory -> address -> mem_type -> extension -> Values.value
val store : memory -> address -> mem_type -> Values.value -> unit

val mem_size : mem_type -> mem_size
Expand Down
Loading