Skip to content
This repository was archived by the owner on Apr 25, 2025. It is now read-only.
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
9 changes: 1 addition & 8 deletions interpreter/binary/decode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -323,14 +323,7 @@ let rec instr s =

| 0x16 as b -> illegal s pos b

| 0x17 ->
let bt = block_type s in
let locs = locals s in
let es = instr_block s in
end_ s;
let_ bt locs es

| 0x18 | 0x19 as b -> illegal s pos b
| 0x17 | 0x18 | 0x19 as b -> illegal s pos b

| 0x1a -> drop
| 0x1b -> select None
Expand Down
2 changes: 0 additions & 2 deletions interpreter/binary/encode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -189,8 +189,6 @@ struct
op 0x04; block_type bt; list instr es1;
if es2 <> [] then op 0x05;
list instr es2; end_ ()
| Let (bt, locs, es) ->
op 0x17; block_type bt; locals locs; list instr es; end_ ()

| Br x -> op 0x0c; var x
| BrIf x -> op 0x0d; var x
Expand Down
52 changes: 17 additions & 35 deletions interpreter/exec/eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ type 'a stack = 'a list
type frame =
{
inst : module_inst;
locals : value ref list;
locals : value option ref list;
}

type code = value stack * admin_instr list
Expand All @@ -64,7 +64,6 @@ and admin_instr' =
| ReturningInvoke of value stack * func_inst
| Breaking of int32 * value stack
| Label of int * instr list * code
| Local of int * value list * code
| Frame of int * frame * code

type config =
Expand All @@ -74,8 +73,8 @@ type config =
budget : int; (* to model stack overflow *)
}

let frame inst = {inst; locals = []}
let config inst vs es = {frame = frame inst; code = vs, es; budget = 300}
let frame inst locals = {inst; locals}
let config inst vs es = {frame = frame inst []; code = vs, es; budget = 300}

let plain e = Plain e.it @@ e.at

Expand Down Expand Up @@ -184,16 +183,6 @@ let rec step (c : config) : config =
else
vs', [Plain (Block (bt, es1)) @@ e.at]

| Let (bt, locals, es'), vs ->
let vs0, vs' = split (List.length locals) vs e.at in
let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in
let vs1, vs2 = split (List.length ts1) vs' e.at in
vs2, [
Local (List.length ts2, List.rev vs0,
(vs1, [Plain (Block (bt, es')) @@ e.at])
) @@ e.at
]

| Br x, vs ->
[], [Breaking (x.it, vs) @@ e.at]

Expand Down Expand Up @@ -266,14 +255,19 @@ let rec step (c : config) : config =
v1 :: vs', []

| LocalGet x, vs ->
!(local c.frame x) :: vs, []
(match !(local c.frame x) with
| Some v ->
v :: vs, []
| None ->
Crash.error e.at "read of uninitialized local"
)

| LocalSet x, v :: vs' ->
local c.frame x := v;
local c.frame x := Some v;
vs', []

| LocalTee x, v :: vs' ->
local c.frame x := v;
local c.frame x := Some v;
v :: vs', []

| GlobalGet x, vs ->
Expand Down Expand Up @@ -676,18 +670,6 @@ let rec step (c : config) : config =
let c' = step {c with code = code'} in
vs, [Label (n, es0, c'.code) @@ e.at]

| Local (n, vs0, (vs', [])), vs ->
vs' @ vs, []

| Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' ->
vs' @ vs, [e']

| Local (n, vs0, code'), vs ->
let frame' = {c.frame with locals = List.map ref vs0 @ c.frame.locals} in
let c' = step {c with frame = frame'; code = code'} in
let vs0' = List.map (!) (take (List.length vs0) c'.frame.locals e.at) in
vs, [Local (n, vs0', c'.code) @@ e.at]

| Frame (n, frame', (vs', [])), vs ->
vs' @ vs, []

Expand All @@ -710,17 +692,17 @@ let rec step (c : config) : config =

| Invoke f, vs ->
let FuncType (ts1, ts2) = Func.type_of f in
let args, vs' = split (List.length ts1) vs e.at in
let n1, n2 = List.length ts1, List.length ts2 in
let args, vs' = split n1 vs e.at in
(match f with
| Func.AstFunc (_, inst', func) ->
let {locals; body; _} = func.it in
let m = Lib.Promise.value inst' in
let ts = List.map (fun t -> Types.sem_value_type m.types t.it) locals in
let vs0 = List.rev args @ List.map default_value ts in
let locals' = List.map (fun t -> t @@ func.at) ts1 @ locals in
let bt = VarBlockType (SemVar (alloc (FuncDefType (FuncType ([], ts2))))) in
let es0 = [Plain (Let (bt, locals', body)) @@ func.at] in
vs', [Frame (List.length ts2, frame m, (List.rev vs0, es0)) @@ e.at]
let locals' = List.(rev (map Option.some args) @ map default_value ts) in
let frame' = {inst = m; locals = List.map ref locals'} in
let instr' = [Label (n2, [], ([], List.map plain body)) @@ func.at] in
vs', [Frame (n2, frame', ([], instr')) @@ e.at]

| Func.HostFunc (_, f) ->
(try List.rev (f (List.rev args)) @ vs', []
Expand Down
4 changes: 2 additions & 2 deletions interpreter/host/spectest.ml
Original file line number Diff line number Diff line change
Expand Up @@ -29,10 +29,10 @@ let print_value v =
Printf.printf "%s : %s\n"
(string_of_value v) (string_of_value_type (type_of_value v))

let print (FuncType (_, out)) vs =
let print _ vs =
List.iter print_value vs;
flush_all ();
List.map default_value out
[]


let lookup name t =
Expand Down
20 changes: 10 additions & 10 deletions interpreter/runtime/value.ml
Original file line number Diff line number Diff line change
Expand Up @@ -133,22 +133,22 @@ let eq v1 v2 =
(* Defaults *)

let default_num = function
| I32Type -> I32 I32.zero
| I64Type -> I64 I64.zero
| F32Type -> F32 F32.zero
| F64Type -> F64 F64.zero
| I32Type -> Some (Num (I32 I32.zero))
| I64Type -> Some (Num (I64 I64.zero))
| F32Type -> Some (Num (F32 F32.zero))
| F64Type -> Some (Num (F64 F64.zero))

let default_vec = function
| V128Type -> V128 V128.zero
| V128Type -> Some (Vec (V128 V128.zero))

let default_ref = function
| (Nullable, t) -> NullRef t
| (NonNullable, _) -> assert false
| (Nullable, t) -> Some (Ref (NullRef t))
| (NonNullable, _) -> None

let default_value = function
| NumType t' -> Num (default_num t')
| VecType t' -> Vec (default_vec t')
| RefType t' -> Ref (default_ref t')
| NumType t' -> default_num t'
| VecType t' -> default_vec t'
| RefType t' -> default_ref t'
| BotType -> assert false


Expand Down
1 change: 0 additions & 1 deletion interpreter/syntax/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,6 @@ and instr' =
| Block of block_type * instr list (* execute in sequence *)
| Loop of block_type * instr list (* loop header *)
| If of block_type * instr list * instr list (* conditional *)
| Let of block_type * local list * instr list (* local bindings *)
| Br of idx (* break to n-th surrounding label *)
| BrIf of idx (* conditional break *)
| BrTable of idx list * idx (* indexed break *)
Expand Down
3 changes: 0 additions & 3 deletions interpreter/syntax/free.ml
Original file line number Diff line number Diff line change
Expand Up @@ -108,9 +108,6 @@ let rec instr (e : instr) =
| Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty
| Block (bt, es) | Loop (bt, es) -> block_type bt ++ block es
| If (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2
| Let (bt, ts, es) ->
let free = block_type bt ++ block es in
{free with locals = Lib.Fun.repeat (List.length ts) shift free.locals}
| Br x | BrIf x | BrOnNull x | BrOnNonNull x -> labels (idx x)
| BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs)
| Return | CallRef | ReturnCallRef -> empty
Expand Down
1 change: 0 additions & 1 deletion interpreter/syntax/operators.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@ let select t = Select t
let block bt es = Block (bt, es)
let loop bt es = Loop (bt, es)
let if_ bt es1 es2 = If (bt, es1, es2)
let let_ bt ts es = Let (bt, ts, es)

let br x = Br x
let br_if x = BrIf x
Expand Down
13 changes: 10 additions & 3 deletions interpreter/syntax/types.ml
Original file line number Diff line number Diff line change
@@ -1,11 +1,14 @@
(* Types *)

type name = int list
type type_idx = int32
type local_idx = int32
type name = Utf8.unicode

and syn_var = int32
and syn_var = type_idx
and sem_var = def_type Lib.Promise.t
and var = SynVar of syn_var | SemVar of sem_var

and init = Initialized | Uninitialized
and nullability = NonNullable | Nullable
and num_type = I32Type | I64Type | F32Type | F64Type
and vec_type = V128Type
Expand All @@ -16,6 +19,7 @@ and value_type =
NumType of num_type | VecType of vec_type | RefType of ref_type | BotType

and result_type = value_type list
and instr_type = result_type * result_type * local_idx list
and func_type = FuncType of result_type * result_type
and def_type = FuncDefType of func_type

Expand All @@ -24,6 +28,7 @@ type mutability = Immutable | Mutable
type table_type = TableType of Int32.t limits * ref_type
type memory_type = MemoryType of Int32.t limits
type global_type = GlobalType of value_type * mutability
type local_type = LocalType of value_type * init
type extern_type =
| ExternFuncType of func_type
| ExternTableType of table_type
Expand Down Expand Up @@ -207,10 +212,12 @@ let string_of_name n =
List.iter escape n;
Buffer.contents b

let string_of_idx x = I32.to_string_u x

let rec string_of_var =
let inner = ref false in
function
| SynVar x -> I32.to_string_u x
| SynVar x -> string_of_idx x
| SemVar x ->
if !inner then "..." else
( inner := true;
Expand Down
3 changes: 0 additions & 3 deletions interpreter/text/arrange.ml
Original file line number Diff line number Diff line change
Expand Up @@ -448,9 +448,6 @@ let rec instr e =
| If (bt, es1, es2) ->
"if", block_type bt @
[Node ("then", list instr es1); Node ("else", list instr es2)]
| Let (bt, locals, es) ->
"let", block_type bt @ decls "local" (List.map Source.it locals) @
list instr es
| Br x -> "br " ^ var x, []
| BrIf x -> "br_if " ^ var x, []
| BrTable (xs, x) ->
Expand Down
83 changes: 8 additions & 75 deletions interpreter/text/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -142,19 +142,6 @@ let force_locals (c : context) =
List.fold_right Stdlib.(@@) !(c.deferred_locals) ();
c.deferred_locals := []

let merge_locals (c : context) (c' : context) at =
force_locals c'; (* check that there aren't too many locals locally *)
if VarMap.is_empty c'.locals.map then
defer_locals c (fun () -> bind "local" c.locals c'.locals.count at)
else
(
force_locals c;
let n = c.locals.count in
ignore (bind "local" c.locals c'.locals.count at);
c.locals.map <- VarMap.union (fun x i1 i2 -> Some i1)
c.locals.map (scoped "local" n c'.locals at).map
)


let lookup category space x =
try VarMap.find x.it space.map
Expand Down Expand Up @@ -241,7 +228,7 @@ let inline_func_type_explicit (c : context) x ft at =
%token NAT INT FLOAT STRING VAR
%token NUM_TYPE VEC_TYPE VEC_SHAPE FUNCREF EXTERNREF REF EXTERN NULL MUT
%token UNREACHABLE NOP DROP SELECT
%token BLOCK END IF THEN ELSE LOOP LET
%token BLOCK END IF THEN ELSE LOOP
%token BR BR_IF BR_TABLE BR_ON_NULL BR_ON_NON_NULL
%token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF
%token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET
Expand Down Expand Up @@ -618,10 +605,6 @@ block_instr :
| IF labeling_opt block ELSE labeling_end_opt instr_list END labeling_end_opt
{ fun c -> let c' = $2 c ($5 @ $8) in
let ts, es1 = $3 c' in if_ ts es1 ($6 c') }
| LET labeling_opt let_block END labeling_end_opt
{ let at = at () in
fun c -> let c' = enter_let ($2 c $5) at in
let ts, ls, es = $3 c c' in let_ ts ls es }

block :
| type_use block_param_body
Expand Down Expand Up @@ -653,59 +636,6 @@ block_result_body :
FuncType (ins, snd $3 c @ out), es }


let_block :
| type_use let_block_param_body
{ let at = at () in
fun c c' -> let ft, ls, es = $2 c c' in
let x = inline_func_type_explicit c ($1 c type_) ft at in
VarBlockType (SynVar x.it), ls, es }
| let_block_param_body /* Sugar */
{ let at = at () in
fun c c' -> let ft, ls, es = $1 c c' in
let bt =
match ft with
| FuncType ([], []) -> ValBlockType None
| FuncType ([], [t]) -> ValBlockType (Some t)
| ft -> VarBlockType (SynVar (inline_func_type c ft at).it)
in bt, ls, es }

let_block_param_body :
| let_block_result_body { $1 }
| LPAR PARAM value_type_list RPAR let_block_param_body
{ fun c c' ->
let FuncType (ins, out), ls, es = $5 c c' in
FuncType (snd $3 c @ ins, out), ls, es }

let_block_result_body :
| let_block_local_body
{ let at = at () in
fun c c' -> let ls, es = $1 c c' at in FuncType ([], []), ls, es }
| LPAR RESULT value_type_list RPAR let_block_result_body
{ fun c c' ->
let FuncType (ins, out), ls, es = $5 c c' in
FuncType (ins, snd $3 c @ out), ls, es }

let_block_local_body :
| instr_list
{ fun c c' at -> merge_locals c' c at; [], $1 c' }
| LPAR LOCAL local_type_list RPAR let_block_local_body
{ let at3 = ati 3 in let at4 = ati 4 in
fun c c' at -> ignore (anon_locals c' (fst $3) at3);
let at' = {left = at.left; right = at4.right} in
let ls, es = $5 c c' at' in snd $3 c @ ls, es }
| LPAR LOCAL bind_var local_type RPAR let_block_local_body /* Sugar */
{ let at5 = ati 5 in
fun c c' at -> ignore (bind_local c' $3);
let at' = {left = at.left; right = at5.right} in
let ls, es = $6 c c' at' in $4 c :: ls, es }

local_type :
| value_type { let at = at () in fun c -> $1 c @@ at }

local_type_list :
| /* empty */ { 0l, fun c -> [] }
| local_type local_type_list { I32.add (fst $2) 1l, fun c -> $1 c :: snd $2 c }

expr : /* Sugar */
| LPAR expr1 RPAR
{ let at = at () in fun c -> let es, e' = $2 c in es @ [e' @@ at] }
Expand All @@ -726,10 +656,6 @@ expr1 : /* Sugar */
| IF labeling_opt if_block
{ fun c -> let c' = $2 c [] in
let bt, (es, es1, es2) = $3 c c' in es, if_ bt es1 es2 }
| LET labeling_opt let_block
{ let at = at () in
fun c -> let c' = enter_let ($2 c []) at in
let bt, ls, es = $3 c c' in [], let_ bt ls es }

select_expr_results :
| LPAR RESULT value_type_list RPAR select_expr_results
Expand Down Expand Up @@ -893,6 +819,13 @@ func_body :
{ fun c -> ignore (bind_local c $3); let f = $6 c in
{f with locals = $4 c :: f.locals} }

local_type :
| value_type { let at = at () in fun c -> $1 c @@ at }

local_type_list :
| /* empty */ { 0l, fun c -> [] }
| local_type local_type_list { I32.add (fst $2) 1l, fun c -> $1 c :: snd $2 c }


/* Tables, Memories & Globals */

Expand Down
Loading