Type-indexed tags. (WebAssembly#18)

This patch adapts the internal and external representation of tags such that they are parameterised by a type index rather than an immediate type. In addition, it also updates the implementation of exception handling to match that of WebAssembly/exception-handling.

Co-authored-by: Andreas Rossberg <[email protected]>

interpreter/Makefile

@@ -19,7 +19,7 @@ WINMAKE =	winmake.bat
 
 DIRS =		util syntax binary text valid runtime exec script host main
 LIBS =		bigarray
-FLAGS = 	-lexflags -ml -cflags '-w +a-4-27-42-44-45 -warn-error +a-3'
+FLAGS = 	-lexflags -ml -cflags '-w +a-4-27-42-44-45-70 -warn-error +a-3'
 OCBA =		ocamlbuild $(FLAGS) $(DIRS:%=-I %)
 OCB =		$(OCBA) $(LIBS:%=-libs %)
 JS =		# set to JS shell command to run JS tests

interpreter/binary/decode.ml

@@ -138,6 +138,9 @@ let sized f s =
 
 open Types
 
+let var s = vu32 s
+let zero s = expect 0x00 s "zero byte expected"
+
 let var_type s =
   let pos = pos s in
   match vs33 s with
@@ -204,16 +207,10 @@ let memory_type s =
   let lim = limits vu32 s in
   MemoryType lim
 
-let resumability s =
-  match u8 s with
-  | 0 -> Terminal
-  | 1 -> Resumable
-  | _ -> error s (pos s - 1) "malformed resumability"
-
 let tag_type s =
-  let res = resumability s in
-  let ft = func_type s in  (* TODO *)
-  TagType (ft, res)
+  zero s;
+  let x = var_type s in
+  TagType x
 
 let mutability s =
   match u8 s with
@@ -232,11 +229,8 @@ let global_type s =
 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
@@ -301,24 +295,29 @@ let rec instr s =
 
   | 0x06 ->
     let bt = block_type s in
-    let es1 = instr_block s in
-    let xo =
-      if peek s = Some 0x07 then begin
-        expect 0x07 s "CATCH or CATCH_ALL opcode expected";
-        Some (at var s)
-      end
-      else begin
-        expect 0x19 s "CATCH or CATCH_ALL opcode expected";
+    let es = instr_block s in
+    let ct = catch_list s in
+    let ca =
+      if peek s = Some 0x19 then begin
+        ignore (u8 s);
+        Some (instr_block s)
+      end else
         None
-      end
     in
-    let es2 = instr_block s in
-    end_ s;
-    try_ bt es1 xo es2
+    if ct <> [] || ca <> None then begin
+      end_ s;
+      try_catch bt es ct ca
+    end else begin
+      match op s with
+      | 0x0b -> try_catch bt es [] None
+      | 0x18 -> try_delegate bt es (at var s)
+      | b -> illegal s pos b
+    end
   | 0x07 -> error s pos "misplaced CATCH opcode"
   | 0x08 -> throw (at var s)
+  | 0x09 -> rethrow (at var s)
 
-  | 0x09 | 0x0a as b -> illegal s pos b
+  | 0x0a as b -> illegal s pos b
   | 0x0b -> error s pos "misplaced END opcode"
 
   | 0x0c -> br (at var s)
@@ -351,8 +350,7 @@ let rec instr s =
     end_ s;
     let_ bt locs es
 
-  | 0x18 as b -> illegal s pos b
-
+  | 0x18 -> error s pos "misplaced DELEGATE opcode"
   | 0x19 -> error s pos "misplaced CATCH_ALL opcode"
 
   | 0x1a -> drop
@@ -607,6 +605,14 @@ and instr_block' s es =
     let pos = pos s in
     let e' = instr s in
     instr_block' s (Source.(e' @@ region s pos pos) :: es)
+and catch_list s =
+  if peek s = Some 0x07 then begin
+    ignore (u8 s);
+    let tag = at var s in
+    let instrs = instr_block s in
+    (tag, instrs) :: catch_list s
+  end else
+    []
 
 let const s =
   let c = at instr_block s in

interpreter/binary/encode.ml

@@ -141,15 +141,11 @@ struct
     | Immutable -> u8 0
     | Mutable -> u8 1
 
-  let resumability = function
-    | Terminal -> u8 0
-    | Resumable -> u8 1
-
   let global_type = function
     | GlobalType (t, mut) -> value_type t; mutability mut
 
-  let tag_type = function
-    | TagType (ft, res) -> resumability res; func_type ft  (* TODO *)
+  let tag_type (TagType x) =
+    vu32 0x00l; var_type x
 
   (* Expressions *)
 
@@ -192,14 +188,22 @@ struct
     | Let (bt, locs, es) ->
       op 0x17; block_type bt; locals locs; list instr es; end_ ()
 
-    | Try (bt, es1, xo, es2) ->
-      op 0x06; block_type bt; list instr es1;
-      (match xo with
-      | Some x -> op 0x07; var x
-      | None -> op 0x19
-      );
-      list instr es2; end_ ()
+    | TryCatch (bt, es, ct, ca) ->
+      op 0x06; block_type bt; list instr es;
+      let catch (tag, es) =
+        op 0x07; var tag; list instr es
+      in
+      list catch ct;
+      begin match ca with
+        | None -> ()
+        | Some es -> op 0x19; list instr es
+      end;
+      end_ ()
+    | TryDelegate (bt, es, x) ->
+      op 0x06; block_type bt; list instr es;
+      op 0x18; var x
     | Throw x -> op 0x08; var x
+    | Rethrow x -> op 0x09; var x
 
     | Br x -> op 0x0c; var x
     | BrIf x -> op 0x0d; var x
@@ -527,8 +531,7 @@ struct
 
   (* Tag section *)
   let tag tag =
-    let {tagtype} = tag.it in
-    tag_type tagtype
+    tag_type tag.it.tagtype
 
   let tag_section ts =
     section 13 (vec tag) ts (ts <> [])