[interpreter] Add event section (WebAssembly#151)

* [interpreter] Add event section

* fixup! [interpreter] Add event section

* fixup! [interpreter] Add event section

Author: thibaudmichaud

interpreter/binary/decode.ml

@@ -135,6 +135,9 @@ let sized f s =
 
 open Types
 
+let zero s = expect 0x00 s "zero byte expected"
+let var s = vu32 s
+
 let num_type s =
   match vs7 s with
   | -0x01 -> I32Type
@@ -189,17 +192,17 @@ let global_type s =
   let mut = mutability s in
   GlobalType (t, mut)
 
+let event_type s =
+  zero s; at var s
+
 
 (* Decode instructions *)
 
 open Ast
 open Operators
 
-let var s = vu32 s
-
 let op s = u8 s
 let end_ s = expect 0x0b s "END opcode expected"
-let zero s = expect 0x00 s "zero byte expected"
 
 let memop s =
   let align = vu32 s in
@@ -527,6 +530,7 @@ let id s =
     | 10 -> `CodeSection
     | 11 -> `DataSection
     | 12 -> `DataCountSection
+    | 13 -> `EventSection
     | _ -> error s (pos s) "malformed section id"
     ) bo
 
@@ -555,6 +559,7 @@ let import_desc s =
   | 0x01 -> TableImport (table_type s)
   | 0x02 -> MemoryImport (memory_type s)
   | 0x03 -> GlobalImport (global_type s)
+  | 0x04 -> EventImport (event_type s)
   | _ -> error s (pos s - 1) "malformed import kind"
 
 let import s =
@@ -592,6 +597,14 @@ let memory s =
 let memory_section s =
   section `MemorySection (vec (at memory)) [] s
 
+(* Event section *)
+
+let event s =
+  let etype = event_type s in
+  {etype}
+
+let event_section s =
+  section `EventSection (vec (at event)) [] s
 
 (* Global section *)
 
@@ -612,6 +625,7 @@ let export_desc s =
   | 0x01 -> TableExport (at var s)
   | 0x02 -> MemoryExport (at var s)
   | 0x03 -> GlobalExport (at var s)
+  | 0x04 -> EventExport (at var s)
   | _ -> error s (pos s - 1) "malformed export kind"
 
 let export s =
@@ -787,6 +801,8 @@ let module_ s =
   iterate custom_section s;
   let memories = memory_section s in
   iterate custom_section s;
+  let events = event_section s in
+  iterate custom_section s;
   let globals = global_section s in
   iterate custom_section s;
   let exports = export_section s in
@@ -812,7 +828,8 @@ let module_ s =
   let funcs =
     List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at)
       func_types func_bodies
-  in {types; tables; memories; globals; funcs; imports; exports; elems; datas; start}
+  in {types; tables; memories; events; globals; funcs; imports; exports; elems;
+      datas; start}
 
 
 let decode name bs = at module_ (stream name bs)

interpreter/binary/encode.ml

@@ -90,6 +90,9 @@ let encode m =
     (* Types *)
 
     open Types
+    open Source
+
+    let var x = vu32 x.it
 
     let num_type = function
       | I32Type -> vs7 (-0x01)
@@ -118,6 +121,8 @@ let encode m =
     let memory_type = function
       | MemoryType lim -> limits vu32 lim
 
+    let event_type x = vu32 0x00l; var x
+
     let mutability = function
       | Immutable -> u8 0
       | Mutable -> u8 1
@@ -127,7 +132,6 @@ let encode m =
 
     (* Expressions *)
 
-    open Source
     open Ast
     open Values
 
@@ -136,8 +140,6 @@ let encode m =
 
     let memop {align; offset; _} = vu32 (Int32.of_int align); vu32 offset
 
-    let var x = vu32 x.it
-
     let block_type = function
       | VarBlockType x -> vs33 x.it
       | ValBlockType None -> vs7 (-0x40)
@@ -426,6 +428,7 @@ let encode m =
       | TableImport t -> u8 0x01; table_type t
       | MemoryImport t -> u8 0x02; memory_type t
       | GlobalImport t -> u8 0x03; global_type t
+      | EventImport t -> u8 0x04; event_type t
 
     let import im =
       let {module_name; item_name; idesc} = im.it in
@@ -456,6 +459,12 @@ let encode m =
     let memory_section mems =
       section 5 (vec memory) mems (mems <> [])
 
+    (* Event section *)
+    let event (e : event) = u8 0x00; var e.it.etype
+
+    let event_section es =
+      section 13 (vec event) es (es <> [])
+
     (* Global section *)
     let global g =
       let {gtype; ginit} = g.it in
@@ -471,6 +480,7 @@ let encode m =
       | TableExport x -> u8 1; var x
       | MemoryExport x -> u8 2; var x
       | GlobalExport x -> u8 3; var x
+      | EventExport x -> u8 4; var x
 
     let export ex =
       let {name = n; edesc} = ex.it in
@@ -579,6 +589,7 @@ let encode m =
       func_section m.it.funcs;
       table_section m.it.tables;
       memory_section m.it.memories;
+      event_section m.it.events;
       global_section m.it.globals;
       export_section m.it.exports;
       start_section m.it.start;

interpreter/exec/eval.ml

@@ -85,6 +85,7 @@ let type_ (inst : module_inst) x = lookup "type" inst.types x
 let func (inst : module_inst) x = lookup "function" inst.funcs x
 let table (inst : module_inst) x = lookup "table" inst.tables x
 let memory (inst : module_inst) x = lookup "memory" inst.memories x
+let event (inst : module_inst) x = lookup "event" inst.events x
 let global (inst : module_inst) x = lookup "global" inst.globals x
 let elem (inst : module_inst) x = lookup "element segment" inst.elems x
 let data (inst : module_inst) x = lookup "data segment" inst.datas x
@@ -580,6 +581,9 @@ let create_memory (inst : module_inst) (mem : memory) : memory_inst =
   let {mtype} = mem.it in
   Memory.alloc mtype
 
+let create_event (inst : module_inst) (e : event) : event_inst =
+  Event.alloc (type_ inst e.it.etype)
+
 let create_global (inst : module_inst) (glob : global) : global_inst =
   let {gtype; ginit} = glob.it in
   let v = eval_const inst ginit in
@@ -593,6 +597,7 @@ let create_export (inst : module_inst) (ex : export) : export_inst =
     | TableExport x -> ExternTable (table inst x)
     | MemoryExport x -> ExternMemory (memory inst x)
     | GlobalExport x -> ExternGlobal (global inst x)
+    | EventExport x -> ExternEvent (event inst x)
   in (name, ext)
 
 let create_elem (inst : module_inst) (seg : elem_segment) : elem_inst =
@@ -612,6 +617,7 @@ let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst)
   | ExternFunc func -> {inst with funcs = func :: inst.funcs}
   | ExternTable tab -> {inst with tables = tab :: inst.tables}
   | ExternMemory mem -> {inst with memories = mem :: inst.memories}
+  | ExternEvent event -> {inst with events = event :: inst.events}
   | ExternGlobal glob -> {inst with globals = glob :: inst.globals}
 
 let init_func (inst : module_inst) (func : func_inst) =
@@ -654,7 +660,7 @@ let run_start start =
 
 let init (m : module_) (exts : extern list) : module_inst =
   let
-    { imports; tables; memories; globals; funcs; types;
+    { imports; tables; memories; events; globals; funcs; types;
       exports; elems; datas; start
     } = m.it
   in
@@ -670,6 +676,7 @@ let init (m : module_) (exts : extern list) : module_inst =
     { inst1 with
       tables = inst1.tables @ List.map (create_table inst1) tables;
       memories = inst1.memories @ List.map (create_memory inst1) memories;
+      events = inst1.events @ List.map (create_event inst1) events;
       globals = inst1.globals @ List.map (create_global inst1) globals;
     }
   in

interpreter/runtime/event.ml

@@ -0,0 +1,10 @@
+open Types
+
+type event = {ty : func_type}
+type t = event
+
+let alloc ty =
+   {ty}
+
+let type_of evt =
+  evt.ty

interpreter/runtime/event.mli

@@ -0,0 +1,7 @@
+open Types
+
+type event = {ty : func_type}
+type t = event
+
+val alloc : func_type -> event
+val type_of : event -> func_type

interpreter/runtime/instance.ml

@@ -6,6 +6,7 @@ type module_inst =
   funcs : func_inst list;
   tables : table_inst list;
   memories : memory_inst list;
+  events : event_inst list;
   globals : global_inst list;
   exports : export_inst list;
   elems : elem_inst list;
@@ -15,6 +16,7 @@ type module_inst =
 and func_inst = module_inst ref Func.t
 and table_inst = Table.t
 and memory_inst = Memory.t
+and event_inst = Event.t
 and global_inst = Global.t
 and export_inst = Ast.name * extern
 and elem_inst = Values.ref_ list ref
@@ -24,6 +26,7 @@ and extern =
   | ExternFunc of func_inst
   | ExternTable of table_inst
   | ExternMemory of memory_inst
+  | ExternEvent of event_inst
   | ExternGlobal of global_inst
 
 
@@ -47,14 +50,15 @@ let () =
 (* Auxiliary functions *)
 
 let empty_module_inst =
-  { types = []; funcs = []; tables = []; memories = []; globals = [];
-    exports = []; elems = []; datas = [] }
+  { types = []; funcs = []; tables = []; memories = []; events = [];
+    globals = []; exports = []; elems = []; datas = [] }
 
 let extern_type_of = function
   | ExternFunc func -> ExternFuncType (Func.type_of func)
   | ExternTable tab -> ExternTableType (Table.type_of tab)
   | ExternMemory mem -> ExternMemoryType (Memory.type_of mem)
   | ExternGlobal glob -> ExternGlobalType (Global.type_of glob)
+  | ExternEvent event -> ExternEventType (Event.type_of event)
 
 let export inst name =
   try Some (List.assoc name inst.exports) with Not_found -> None

interpreter/script/run.ml

@@ -215,6 +215,7 @@ let print_import m im =
     | ExternFuncType t -> "func", string_of_func_type t
     | ExternTableType t -> "table", string_of_table_type t
     | ExternMemoryType t -> "memory", string_of_memory_type t
+    | ExternEventType t -> "event", string_of_func_type t
     | ExternGlobalType t -> "global", string_of_global_type t
   in
   Printf.printf "  import %s \"%s\" \"%s\" : %s\n"
@@ -228,6 +229,7 @@ let print_export m ex =
     | ExternFuncType t -> "func", string_of_func_type t
     | ExternTableType t -> "table", string_of_table_type t
     | ExternMemoryType t -> "memory", string_of_memory_type t
+    | ExternEventType t -> "event", string_of_func_type t
     | ExternGlobalType t -> "global", string_of_global_type t
   in
   Printf.printf "  export %s \"%s\" : %s\n"

interpreter/syntax/ast.ml

@@ -150,6 +150,13 @@ and memory' =
   mtype : memory_type;
 }
 
+type event = event' Source.phrase
+and event' =
+{
+  etype : var;
+}
+
+
 type segment_mode = segment_mode' Source.phrase
 and segment_mode' =
   | Passive
@@ -182,6 +189,7 @@ and export_desc' =
   | TableExport of var
   | MemoryExport of var
   | GlobalExport of var
+  | EventExport of var
 
 type export = export' Source.phrase
 and export' =
@@ -196,6 +204,7 @@ and import_desc' =
   | TableImport of table_type
   | MemoryImport of memory_type
   | GlobalImport of global_type
+  | EventImport of var
 
 type import = import' Source.phrase
 and import' =
@@ -212,6 +221,7 @@ and module_' =
   globals : global list;
   tables : table list;
   memories : memory list;
+  events : event list;
   funcs : func list;
   start : var option;
   elems : elem_segment list;
@@ -229,6 +239,7 @@ let empty_module =
   globals = [];
   tables = [];
   memories = [];
+  events = [];
   funcs = [];
   start = None;
   elems = [];
@@ -248,6 +259,7 @@ let import_type (m : module_) (im : import) : extern_type =
   | FuncImport x -> ExternFuncType (func_type_for m x)
   | TableImport t -> ExternTableType t
   | MemoryImport t -> ExternMemoryType t
+  | EventImport x -> ExternEventType (func_type_for m x)
   | GlobalImport t -> ExternGlobalType t
 
 let export_type (m : module_) (ex : export) : extern_type =
@@ -268,6 +280,10 @@ let export_type (m : module_) (ex : export) : extern_type =
   | GlobalExport x ->
     let gts = globals its @ List.map (fun g -> g.it.gtype) m.it.globals in
     ExternGlobalType (nth gts x.it)
+  | EventExport x ->
+    let ets =
+      events its @ List.map (fun (e : event) -> func_type_for m e.it.etype) m.it.events
+    in ExternEventType (nth ets x.it)
 
 let string_of_name n =
   let b = Buffer.create 16 in