From 4850dd81ef284f4eff0078b90000fd94a5e2c5b4 Mon Sep 17 00:00:00 2001
From: Eric Holk <eholk@google.com>
Date: Thu, 3 Aug 2017 12:51:26 -0700
Subject: [PATCH 1/3] Initial exception support in spec interpreter

The spec interpreter can now parse and validate basic try, throw and catch_all
instructions. The interpreter can also evaluate these, although support for all
possibilities is not all there yet.
---
 interpreter/spec/ast.ml       | 12 ++++++++
 interpreter/spec/decode.ml    |  5 ++--
 interpreter/spec/encode.ml    |  8 ++++++
 interpreter/spec/eval.ml      | 53 ++++++++++++++++++++++++++++-------
 interpreter/spec/operators.ml |  4 ++-
 interpreter/spec/valid.ml     | 20 +++++++++++--
 interpreter/text/arrange.ml   |  4 +++
 interpreter/text/lexer.mll    |  6 ++++
 interpreter/text/parser.mly   | 47 ++++++++++++++++++++++++-------
 test/core/exceptions.wast     | 21 ++++++++++++++
 10 files changed, 155 insertions(+), 25 deletions(-)
 create mode 100644 test/core/exceptions.wast

diff --git a/interpreter/spec/ast.ml b/interpreter/spec/ast.ml
index 94822eb7..e95f5d2f 100644
--- a/interpreter/spec/ast.ml
+++ b/interpreter/spec/ast.ml
@@ -96,6 +96,10 @@ and instr' =
   | Unary of unop                     (* unary numeric operator *)
   | Binary of binop                   (* binary numeric operator *)
   | Convert of cvtop                  (* conversion *)
+  | Throw of var                      (* throw exception *)
+  | Try of stack_type * instr list * catch list * catch_all option (* try ... catch ... catch_all block *)
+and catch = (var * instr list) Source.phrase
+and catch_all = instr list Source.phrase
 
 
 (* Globals & Functions *)
@@ -175,6 +179,12 @@ and import' =
   idesc : import_desc;
 }
 
+type exception_ = exception_' Source.phrase
+and exception_' =
+{
+  etype : func_type;
+}
+
 type module_ = module_' Source.phrase
 and module_' =
 {
@@ -188,6 +198,7 @@ and module_' =
   data : string segment list;
   imports : import list;
   exports : export list;
+  exceptions : exception_ list;
 }
 
 
@@ -205,6 +216,7 @@ let empty_module =
   data = [];
   imports = [];
   exports = [];
+  exceptions = [];
 }
 
 open Source
diff --git a/interpreter/spec/decode.ml b/interpreter/spec/decode.ml
index 2cca1245..9e3e6c4d 100644
--- a/interpreter/spec/decode.ml
+++ b/interpreter/spec/decode.ml
@@ -652,8 +652,9 @@ let module_ s =
     s (len s) "function and code section have inconsistent lengths";
   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; data; start}
+      func_types func_bodies in
+  let exceptions = []
+  in {types; tables; memories; globals; funcs; imports; exports; elems; data; start; exceptions}
 
 
 let decode name bs = at module_ (stream name bs)
diff --git a/interpreter/spec/encode.ml b/interpreter/spec/encode.ml
index c93e71ed..fa778229 100644
--- a/interpreter/spec/encode.ml
+++ b/interpreter/spec/encode.ml
@@ -362,6 +362,14 @@ let encode m =
       | Convert (F64 F64Op.DemoteF64) -> assert false
       | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf
 
+      | Throw x -> op 0x08; var x
+      | Try (ts, es, cs, ca) ->
+        op 0x06; stack_type ts; list instr es;
+        match ca with
+        | Some es -> op 0x05; list instr es.it
+        | None -> ();
+        end_ ()
+
     let const c =
       list instr c.it; end_ ()
 
diff --git a/interpreter/spec/eval.ml b/interpreter/spec/eval.ml
index 0511801b..df2d2103 100644
--- a/interpreter/spec/eval.ml
+++ b/interpreter/spec/eval.ml
@@ -39,15 +39,33 @@ let numeric_error at = function
 
 type 'a stack = 'a list
 
+type etag = int32
+type handlers = (etag * instr list) list * instr list option
+
+let empty_handlers : handlers = [], None
+
+let rec handler_for handlers x =
+  match handlers with
+  | [], Some catch_all -> Some (catch_all, 0)
+  | [], None -> None
+  | (y, es) :: _, _ when y = x -> Some (es, 0)
+  | _ :: handlers, catch_all -> handler_for (handlers, catch_all) x
+
+let handlers_from catches catch_all =
+  [], match catch_all with
+  | Some {it = instrs; _} -> Some instrs
+  | None -> None
+    
 type admin_instr = admin_instr' phrase
 and admin_instr' =
   | Plain of instr'
   | Trapped of string
   | Break of int32 * value stack
-  | Label of stack_type * instr list * value stack * admin_instr list
+  | Label of stack_type * instr list * value stack * admin_instr list * handlers
   | Local of instance * value ref list * value stack * admin_instr list
   | Invoke of closure
-
+  | Thrown of int32 * value stack
+      
 type config =
 {
   locals : value ref list;
@@ -121,10 +139,10 @@ let rec step (inst : instance) (c : config) : config =
         vs, []
 
       | Block (ts, es'), vs ->
-        vs, [Label (ts, [], [], List.map plain es') @@ e.at]
+        vs, [Label (ts, [], [], List.map plain es', empty_handlers) @@ e.at]
 
       | Loop (ts, es'), vs ->
-        vs, [Label ([], [e' @@ e.at], [], List.map plain es') @@ e.at]
+        vs, [Label ([], [e' @@ e.at], [], List.map plain es', empty_handlers) @@ e.at]
 
       | If (ts, es1, es2), I32 0l :: vs' ->
         vs', [Plain (Block (ts, es2)) @@ e.at]
@@ -243,6 +261,12 @@ let rec step (inst : instance) (c : config) : config =
         (try Eval_numeric.eval_cvtop cvtop v :: vs', []
         with exn -> vs', [Trapped (numeric_error e.at exn) @@ e.at])
 
+      | Throw x, vs ->
+	[], [Thrown (x.it, vs) @@ e.at]
+
+      | Try (ts, es', catches, catch_all), vs ->
+        vs, [Label (ts, [], [], List.map plain es', handlers_from catches catch_all) @@ e.at]
+	  
       | _ ->
         let s1 = string_of_values (List.rev vs) in
         let s2 = string_of_value_types (List.map type_of (List.rev vs)) in
@@ -256,22 +280,31 @@ let rec step (inst : instance) (c : config) : config =
     | Break (k, vs'), vs ->
       Crash.error e.at "undefined label"
 
-    | Label (ts, es0, vs', []), vs ->
+    | Label (ts, es0, vs', [], handlers), vs ->
       vs' @ vs, []
 
-    | Label (ts, es0, vs', {it = Trapped msg; at} :: es'), vs ->
+    (* TODO(eholk): Should this case trigger catch_all? *)
+    | Label (ts, es0, vs', {it = Trapped msg; at} :: es', handlers), vs ->
       vs, [Trapped msg @@ at]
 
-    | Label (ts, es0, vs', {it = Break (0l, vs0); at} :: es'), vs ->
+    | Label (ts, es0, vs', {it = Thrown (tag, exn_args); at} :: es', handlers), vs ->
+      (match handler_for handlers tag with
+      | Some (instrs, arg_count) -> take arg_count exn_args e.at @ vs, List.map plain instrs
+      | None -> vs, [Thrown (tag, exn_args) @@ at])
+
+    | Label (ts, es0, vs', {it = Break (0l, vs0); at} :: es', handlers), vs ->
       take (List.length ts) vs0 e.at @ vs, List.map plain es0
 
-    | Label (ts, es0, vs', {it = Break (k, vs0); at} :: es'), vs ->
+    | Label (ts, es0, vs', {it = Break (k, vs0); at} :: es', handlers), vs ->
       vs, [Break (Int32.sub k 1l, vs0) @@ at]
 
-    | Label (ts, es0, values, instrs), vs ->
+    | Label (ts, es0, values, instrs, handlers), vs ->
       let c' = step inst {c with values; instrs; depth = c.depth + 1} in
-      vs, [Label (ts, es0, c'.values, c'.instrs) @@ e.at]
+      vs, [Label (ts, es0, c'.values, c'.instrs, handlers) @@ e.at]
 
+    | Thrown _, vs ->
+      vs, [Trapped "webassembly exception" @@ e.at]
+	
     | Local (inst', locals, vs', []), vs ->
       vs' @ vs, []
 
diff --git a/interpreter/spec/operators.ml b/interpreter/spec/operators.ml
index b207b193..1d950a08 100644
--- a/interpreter/spec/operators.ml
+++ b/interpreter/spec/operators.ml
@@ -21,7 +21,9 @@ let br_table xs x = BrTable (xs, x)
 let return = Return
 let if_ ts es1 es2 = If (ts, es1, es2)
 let select = Select
-
+let throw_ x = Throw x
+let try_ tts tes ces = Try (tts, tes, [], Some ces)
+  
 let call x = Call x
 let call_indirect x = CallIndirect x
 
diff --git a/interpreter/spec/valid.ml b/interpreter/spec/valid.ml
index 77ce2c01..73618f9c 100644
--- a/interpreter/spec/valid.ml
+++ b/interpreter/spec/valid.ml
@@ -25,11 +25,12 @@ type context =
   locals : value_type list;
   results : value_type list;
   labels : stack_type list;
+  exceptions : func_type list;
 }
 
 let context m =
   { module_ = m; types = []; funcs = []; tables = []; memories = [];
-    globals = []; locals = []; results = []; labels = [] }
+    globals = []; locals = []; results = []; labels = []; exceptions = [] }
 
 let lookup category list x =
   try Lib.List32.nth list x.it with Failure _ ->
@@ -42,6 +43,7 @@ let global (c : context) x = lookup "global" c.globals x
 let label (c : context) x = lookup "label" c.labels x
 let table (c : context) x = lookup "table" c.tables x
 let memory (c : context) x = lookup "memory" c.memories x
+let exception_ (c : context) x = lookup "exception" c.exceptions x
 
 
 (* Stack typing *)
@@ -286,6 +288,19 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type =
     let t1, t2 = type_cvtop e.at cvtop in
     [t1] --> [t2]
 
+  | Throw x ->
+    let FuncType (ins, out) = exception_ c x in
+    ins -->... []
+
+  | Try (ts, tes, _, ces) ->
+    check_arity (List.length ts) e.at;
+    check_block {c with labels = ts :: c.labels} tes ts e.at;
+    (* TODO(eholk): check catches *)
+    let _ = match ces with
+    | Some ces -> check_block {c with labels = ts :: c.labels} ces.it ts ces.at
+    | None -> ()
+    in [] --> ts
+    
 and check_seq (c : context) (es : instr list) : infer_stack_type =
   match es with
   | [] ->
@@ -428,7 +443,7 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t =
 let check_module (m : module_) =
   let
     { types; imports; tables; memories; globals; funcs; start; elems; data;
-      exports } = m.it
+      exports; exceptions } = m.it
   in
   let c0 = List.fold_right check_import imports {(context m) with types} in
   let c1 =
@@ -436,6 +451,7 @@ let check_module (m : module_) =
       funcs = c0.funcs @ List.map (fun f -> type_ c0 f.it.ftype) funcs;
       tables = c0.tables @ List.map (fun tab -> tab.it.ttype) tables;
       memories = c0.memories @ List.map (fun mem -> mem.it.mtype) memories;
+      exceptions = c0.exceptions @ List.map (fun exc -> exc.it.etype) exceptions;
     }
   in
   let c =
diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index 18bc51f4..251568af 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -243,6 +243,10 @@ let rec instr e =
     | Unary op -> unop op, []
     | Binary op -> binop op, []
     | Convert op -> cvtop op, []
+    | Throw x -> "throw " ^ var x, []
+    | Try (ts, tes, _, ces) -> "try", list instr tes @ match ces with
+      | Some ces -> [Node ("catch_all", list instr ces.it)]
+      | None -> []
   in Node (head, inner)
 
 let const c =
diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll
index 70f4a9c3..7f245522 100644
--- a/interpreter/text/lexer.mll
+++ b/interpreter/text/lexer.mll
@@ -166,6 +166,12 @@ rule token = parse
   | "get_global" { GET_GLOBAL }
   | "set_global" { SET_GLOBAL }
 
+  | "exception" { EXCEPTION }
+  | "try" { TRY }
+  | "catch" { CATCH }
+  | "catch_all" {CATCH_ALL }
+  | "throw" { THROW }
+
   | (nxx as t)".load"
     { LOAD (fun a o ->
         numop t (i32_load (opt a 2)) (i64_load (opt a 3))
diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index e784a59c..6d8172fb 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -61,12 +61,12 @@ let empty_types () = {tmap = VarMap.empty; tlist = []}
 
 type context =
   { types : types; tables : space; memories : space;
-    funcs : space; locals : space; globals : space; labels : int32 VarMap.t }
+    funcs : space; locals : space; globals : space; labels : int32 VarMap.t; exceptions : space }
 
 let empty_context () =
   { types = empty_types (); tables = empty (); memories = empty ();
     funcs = empty (); locals = empty (); globals = empty ();
-    labels = VarMap.empty }
+    labels = VarMap.empty; exceptions = empty () }
 
 let enter_func (c : context) =
   {c with labels = VarMap.empty; locals = empty ()}
@@ -115,6 +115,7 @@ let bind_table (c : context) x = bind "table" c.tables x
 let bind_memory (c : context) x = bind "memory" c.memories x
 let bind_label (c : context) x =
   {c with labels = VarMap.add x.it 0l (VarMap.map (Int32.add 1l) c.labels)}
+let bind_exception (c : context) x = bind "exception" c.exceptions x
 
 let anon category space n =
   let i = space.count in
@@ -131,6 +132,7 @@ let anon_table (c : context) = anon "table" c.tables 1l
 let anon_memory (c : context) = anon "memory" c.memories 1l
 let anon_label (c : context) =
   {c with labels = VarMap.map (Int32.add 1l) c.labels}
+let anon_exception (c : context) = anon "exception" c.exceptions 1l
 
 let empty_type = FuncType ([], [])
 
@@ -154,6 +156,7 @@ let inline_type (c : context) ty at =
 
 %token NAT INT FLOAT TEXT VAR VALUE_TYPE ANYFUNC MUT LPAR RPAR
 %token NOP DROP BLOCK END IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE
+%token EXCEPTION THROW TRY CATCH CATCH_ALL
 %token CALL CALL_INDIRECT RETURN
 %token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL
 %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT
@@ -328,6 +331,7 @@ plain_instr :
   | UNARY { fun c -> $1 }
   | BINARY { fun c -> $1 }
   | CONVERT { fun c -> $1 }
+  | THROW var { fun c -> throw_ ($2 c label) }
 
 block_instr :
   | BLOCK labeling_opt block END labeling_end_opt
@@ -338,8 +342,8 @@ block_instr :
     { fun c -> let c' = $2 c $5 in let ts, es = $3 c' in if_ ts es [] }
   | 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 ts, es1 = $3 c' in if_ ts es1 ($6 c') }
+      
 block :
   | value_type_list instr_list { fun c -> $1, $2 c }
 
@@ -356,7 +360,21 @@ expr1 :  /* Sugar */
   | IF labeling_opt value_type_list if_
     { fun c -> let c' = $2 c [] in
       let es, es1, es2 = $4 c c' in es, if_ $3 es1 es2 }
-
+  | TRY labeling_opt value_type_list try_body
+    { fun c -> let c' = $2 c [] in
+               let ts = $3 in
+               let es, _, cs = $4 c' in
+               [], try_ ts es cs }
+
+/* returns c -> try_instrs, catches, catch_all option; or will eventually */
+try_body :
+  | LPAR CATCH_ALL instr_list RPAR
+    { fun c -> [], [], ($3 c) @@ (at ())}
+  | expr try_body
+    { fun c -> let e = $1 c in
+               let es, cs, ca = $2 c in
+               e @ es, cs, ca }
+      
 if_ :
   | LPAR THEN instr_list RPAR LPAR ELSE instr_list RPAR
     { fun c c' -> [], $3 c', $7 c' }
@@ -508,16 +526,22 @@ memory :
 
 global :
   | LPAR GLOBAL bind_var_opt inline_export global_type const_expr RPAR
-    { let at = at () in
-      fun c -> let x = $3 c anon_global bind_global @@ at in
-      (fun () -> {gtype = $5; value = $6 c} @@ at),
-      $4 (GlobalExport x) c }
+      { let at = at () in
+        fun c -> let x = $3 c anon_global bind_global @@ at in
+                 (fun () -> {gtype = $5; value = $6 c} @@ at),
+                 $4 (GlobalExport x) c }
   /* Duplicate above for empty inline_export_opt to avoid LR(1) conflict. */
   | LPAR GLOBAL bind_var_opt global_type const_expr RPAR
     { let at = at () in
       fun c -> ignore ($3 c anon_global bind_global);
-      (fun () -> {gtype = $4; value = $5 c} @@ at), [] }
+        (fun () -> {gtype = $4; value = $5 c} @@ at), [] }
 
+exception_ :
+  | LPAR EXCEPTION bind_var_opt func_type RPAR
+    { let at = at () in
+      fun c ->
+        ignore ($3 c anon_exception bind_exception);
+        {etype = $4} @@ at }    
 
 /* Imports & Exports */
 
@@ -643,6 +667,9 @@ module_fields :
   | export module_fields
     { fun c -> let m = $2 c in
       {m with exports = $1 c :: m.exports} }
+  | exception_ module_fields
+    { fun c -> let m = $2 c in
+      {m with exceptions = $1 c :: m.exceptions} }
 
 module_ :
   | LPAR MODULE script_var_opt module_fields RPAR
diff --git a/test/core/exceptions.wast b/test/core/exceptions.wast
new file mode 100644
index 00000000..dae34f20
--- /dev/null
+++ b/test/core/exceptions.wast
@@ -0,0 +1,21 @@
+(module
+ (exception $empty_exception (func))
+ 
+ (func (export "throw_unconditional")
+       (throw 0))
+
+ (func (export "try_catch_all") (result i32)
+       (try i32
+	(i32.const 1)
+	(catch_all
+	 (i32.const 0))))
+ 
+  (func (export "try_catch_all_throw") (result i32)
+       (try i32
+	(throw 0)
+	(catch_all
+	 (i32.const 0)))))
+
+(assert_trap (invoke "throw_unconditional") "webassembly exception")
+(assert_return (invoke "try_catch_all") (i32.const 1))
+(assert_return (invoke "try_catch_all_throw") (i32.const 0))

From f70fe10add633a9e53f042238ef35dcb266e7285 Mon Sep 17 00:00:00 2001
From: Eric Holk <eholk@google.com>
Date: Tue, 15 Aug 2017 13:20:20 -0700
Subject: [PATCH 2/3] Add decoding and encoding for exceptions section

This also adds dynamic scopes for error messages to pin down better where
end of stream errors come from.
---
 interpreter/spec/decode.ml | 66 +++++++++++++++++++++++++++++++++-----
 interpreter/spec/encode.ml | 11 +++++--
 2 files changed, 67 insertions(+), 10 deletions(-)

diff --git a/interpreter/spec/decode.ml b/interpreter/spec/decode.ml
index 9e3e6c4d..1aac2bc7 100644
--- a/interpreter/spec/decode.ml
+++ b/interpreter/spec/decode.ml
@@ -38,8 +38,17 @@ let region s left right =
 let error s pos msg = raise (Code (region s pos pos, msg))
 let require b s pos msg = if not b then error s pos msg
 
+let current_scope = ref "binary"
+let with_scope scope f =
+  let old_scope = !current_scope in
+  current_scope := scope;
+  try let result = f () in
+      current_scope := old_scope;
+      result
+  with e -> current_scope := old_scope; raise e
+
 let guard f s =
-  try f s with EOS -> error s (len s) "unexpected end of binary or function"
+  try f s with EOS -> error s (len s) ("unexpected end of " ^ !current_scope)
 
 let get = guard get
 let get_string n = guard (get_string n)
@@ -196,6 +205,7 @@ let memop s =
   Int32.to_int align, offset
 
 let rec instr s =
+  with_scope "instr" (fun () ->
   let pos = pos s in
   match op s with
   | 0x00 -> unreachable
@@ -223,9 +233,18 @@ let rec instr s =
       end_ s;
       if_ ts es1 []
     end
+  | 0x06 ->
+    let ts = stack_type s in
+    let es = instr_block s in
+    let cs = catches s in
+    end_ s;
+    try_ ts es cs
+
+  | 0x08 ->
+    throw_ (at var s)
 
   | 0x05 -> error s pos "misplaced ELSE opcode"
-  | 0x06| 0x07 | 0x08 | 0x09 | 0x0a as b -> illegal s pos b
+  | 0x07 | 0x09 | 0x0a as b -> illegal s pos b
   | 0x0b -> error s pos "misplaced END opcode"
 
   | 0x0c -> br (at var s)
@@ -427,17 +446,36 @@ let rec instr s =
   | 0xbe -> f32_reinterpret_i32
   | 0xbf -> f64_reinterpret_i64
 
-  | b -> illegal s pos b
+  | b -> illegal s pos b)
 
-and instr_block s = List.rev (instr_block' s [])
+and instr_block s =
+  with_scope "block" (fun () ->
+  let es = instr_block' s [] in
+  List.rev es)
 and instr_block' s es =
   match peek s with
-  | None | Some (0x05 | 0x0b) -> es
+  | None | Some (0x05 | 0x07 | 0x0b) -> es
   | _ ->
     let pos = pos s in
     let e' = instr s in
     instr_block' s (Source.(e' @@ region s pos pos) :: es)
 
+(* TODO(eholk): For now catches only can handle a single catch_all *)
+and catches s =
+  match (List.rev (catches' s [])) with
+  | c :: _ -> c
+  | _ -> error s (len s) "too many catches"
+and catches' s cs =
+  match peek s with
+  | None | Some (0x0b) -> cs
+  | Some (0x05) ->
+    expect 0x05 s "CATCH or CATCH_ALL opcode expected";
+    let c = (at (fun s -> instr_block s) s) in
+    c :: catches' s cs
+  | Some (0x07) ->
+    error s (len s) "catch is not yet implemented"
+  | Some (b) -> illegal s (len s) b
+
 let const s =
   let c = at instr_block s in
   end_ s;
@@ -462,6 +500,7 @@ let id s =
     | 9 -> `ElemSection
     | 10 -> `CodeSection
     | 11 -> `DataSection
+    | 13 -> `ExceptionSection
     | _ -> error s (pos s) "invalid section id"
     ) bo
 
@@ -480,6 +519,15 @@ let type_section s =
   section `TypeSection (vec func_type) [] s
 
 
+(* Exception Section *)
+
+let exception_ s =
+  { etype = func_type s }
+
+let exception_section s =
+  section `ExceptionSection (vec (at exception_)) [] s
+
+
 (* Import section *)
 
 let import_desc s =
@@ -570,10 +618,11 @@ let local s =
   Lib.List.make n t
 
 let code _ s =
+  with_scope "function" (fun () ->
   let locals = List.flatten (vec local s) in
   let body = instr_block s in
   end_ s;
-  {locals; body; ftype = Source.((-1l) @@ Source.no_region)}
+  {locals; body; ftype = Source.((-1l) @@ Source.no_region)})
 
 let code_section s =
   section `CodeSection (vec (at (sized code))) [] s
@@ -639,6 +688,8 @@ let module_ s =
   iterate custom_section s;
   let exports = export_section s in
   iterate custom_section s;
+  let exceptions = exception_section s in
+  iterate custom_section s;
   let start = start_section s in
   iterate custom_section s;
   let elems = elem_section s in
@@ -653,8 +704,7 @@ let module_ s =
   let funcs =
     List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at)
       func_types func_bodies in
-  let exceptions = []
-  in {types; tables; memories; globals; funcs; imports; exports; elems; data; start; exceptions}
+  {types; tables; memories; globals; funcs; imports; exports; elems; data; start; exceptions}
 
 
 let decode name bs = at module_ (stream name bs)
diff --git a/interpreter/spec/encode.ml b/interpreter/spec/encode.ml
index fa778229..da0ba570 100644
--- a/interpreter/spec/encode.ml
+++ b/interpreter/spec/encode.ml
@@ -365,9 +365,9 @@ let encode m =
       | Throw x -> op 0x08; var x
       | Try (ts, es, cs, ca) ->
         op 0x06; stack_type ts; list instr es;
-        match ca with
+        (match ca with
         | Some es -> op 0x05; list instr es.it
-        | None -> ();
+        | None -> ());
         end_ ()
 
     let const c =
@@ -388,6 +388,12 @@ let encode m =
     let type_section ts =
       section 1 (vec func_type) ts (ts <> [])
 
+    (* Exception Section *)
+    let exception_ x =
+      func_type x.it.etype
+    let exception_section xs =
+      section 13 (vec exception_) xs (xs <> [])
+
     (* Import section *)
     let import_desc d =
       match d.it with
@@ -505,6 +511,7 @@ let encode m =
       export_section m.it.exports;
       start_section m.it.start;
       elem_section m.it.elems;
+      exception_section m.it.exceptions;
       code_section m.it.funcs;
       data_section m.it.data
   end

From d26c2a245bad63baf226f76729415b53162e11d0 Mon Sep 17 00:00:00 2001
From: Eric Holk <eholk@google.com>
Date: Tue, 15 Aug 2017 14:34:10 -0700
Subject: [PATCH 3/3] Print exceptions in text output

---
 interpreter/text/arrange.ml | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index 251568af..ce4abcff 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -244,9 +244,11 @@ let rec instr e =
     | Binary op -> binop op, []
     | Convert op -> cvtop op, []
     | Throw x -> "throw " ^ var x, []
-    | Try (ts, tes, _, ces) -> "try", list instr tes @ match ces with
-      | Some ces -> [Node ("catch_all", list instr ces.it)]
-      | None -> []
+    | Try (ts, tes, _, ces) ->
+      let catches = match ces with
+	| Some ces -> [Node ("catch_all", list instr ces.it)]
+	| None -> [] in
+      "try", stack_type ts @ list instr tes @ catches
   in Node (head, inner)
 
 let const c =
@@ -329,6 +331,8 @@ let global off i g =
   let {gtype; value} = g.it in
   Node ("global $" ^ nat (off + i), global_type gtype :: const value)
 
+let exception_ i x =
+  Node ("exception $" ^ nat i, [struct_type x.it.etype])
 
 (* Modules *)
 
@@ -360,6 +364,7 @@ let module_with_var_opt x_opt m =
     listi (memory (List.length memory_imports)) m.it.memories @
     listi (global (List.length global_imports)) m.it.globals @
     listi (func_with_index (List.length func_imports)) m.it.funcs @
+    listi exception_ m.it.exceptions @
     list export m.it.exports @
     opt start m.it.start @
     list elems m.it.elems @