Merge pull request #47 from dhil/wasmfx-merge

Merge with stack-switching/wasmfx

Author: dhil

README.md

@@ -1,23 +1,34 @@
-[![CI for specs](https://github.com/wasmfx/specfx/actions/workflows/ci-spec.yml/badge.svg)](https://github.com/wasmfx/specfx/actions/workflows/ci-spec.yml)
-[![CI for interpreter & tests](https://github.com/wasmfx/specfx/actions/workflows/ci-interpreter.yml/badge.svg)](https://github.com/wasmfx/specfx/actions/workflows/ci-interpreter.yml)
+# Stack-Switching Proposal for WebAssembly
 
-# Typed Continuations Proposal for WebAssembly
+This repository is a clone of [`WebAssembly/spec`](https://github.com/WebAssembly/spec/). It is meant for discussion, prototype specification, and implementation of a proposal to add
+support for stack-switching.
 
-This repository is a clone of
-[github.com/WebAssembly/spec/](https://github.com/WebAssembly/spec/).
-It is meant for discussion, prototype specification and implementation
-of a proposal to add support for different patterns of non-local
-control flow to WebAssembly.
+See the [explainer](proposals/stack-switching/Explainer.md) for a high-level summary of the proposal.
 
-The proposal is fully implemented as part of the reference interpreter.
+## Previous proposals
+
+The current explainer represents the unification of two previous proposals: Typed Continuations (wasmfx) and Bag of Stacks (bos). (The explainers have now been unified. Once the reference interpreter and examples are adapted for the unified proposal this section will be removed from the README.)
+
+#### Typed Continuations
 
 * See the [explainer](proposals/continuations/Explainer.md) for a high-level summary of the proposal.
 
 * See the [overview](proposals/continuations/Overview.md) for a more formal description of the proposal.
 
+* An [implementation](https://github.com/WebAssembly/stack-switching/tree/wasmfx) is available as an extension to the reference interpreter. It is accesible from the `wasmfx` branch of this repository.
+
 * See the [examples](proposals/continuations/examples) for Wasm code for implementing various different features including lightweight threads, actors, and async/await.
 
-Original `README` from upstream repository follows.
+#### Bag of Stacks Proposal
+
+* See the [explainer](proposals/bag-o-stacks/Explainer.md) for a high-level summary of the proposal.
+
+Original README from upstream repository follows.
+
+--------------------------------------------------------------------------------
+
+[![CI for specs](https://github.com/WebAssembly/stack-switching/actions/workflows/ci-spec.yml/badge.svg)](https://github.com/WebAssembly/stack-switching/actions/workflows/ci-spec.yml)
+[![CI for interpreter & tests](https://github.com/WebAssembly/stack-switching/actions/workflows/ci-interpreter.yml/badge.svg)](https://github.com/WebAssembly/stack-switching/actions/workflows/ci-interpreter.yml)
 
 # spec
 

document/core/conf.py

@@ -66,10 +66,10 @@
 logo = 'static/webassembly.png'
 
 # The name of the GitHub repository this resides in
-repo = 'continuations'
+repo = 'stack-switching'
 
 # The name of the proposal it represents, if any
-proposal = 'continuations'
+proposal = 'stack-switching'
 
 # The draft version string (clear out for release cuts)
 draft = ' (Draft ' + date.today().strftime("%Y-%m-%d") + ')'

interpreter/binary/decode.ml

@@ -337,11 +337,6 @@ let block_type s =
     (fun s -> ValBlockType (Some (val_type s)));
   ] s
 
-let var_pair s =
-  let x = at var s in
-  let y = at var s in
-  x, y
-
 let local s =
   let n = u32 s in
   let t = at val_type s in
@@ -355,6 +350,16 @@ let locals s =
     s pos "too many locals";
   List.flatten (List.map (Lib.Fun.uncurry Lib.List32.make) nts)
 
+let on_clause s =
+  match byte s with
+  | 0x00 ->
+    let x = at var s in
+    let y = at var s in
+    (x, OnLabel y)
+  | 0x01 ->
+    let x = at var s in
+    (x, OnSwitch)
+  | _ -> error s (pos s) "ON opcode expected"
 
 let rec instr s =
   let pos = pos s in
@@ -633,14 +638,18 @@ let rec instr s =
   | 0xe2 -> suspend (at var s)
   | 0xe3 ->
     let x = at var s in
-    let xls = vec var_pair s in
+    let xls = vec on_clause s in
     resume x xls
   | 0xe4 ->
     let x   = at var s in
     let tag = at var s in
-    let xls = vec var_pair s in
+    let xls = vec on_clause s in
     resume_throw x tag xls
   | 0xe5 ->
+    let x = at var s in
+    let y = at var s in
+    switch x y
+  | 0xe6 ->
     let bt = block_type s in
     let es' = instr_block s in
     end_ s;

interpreter/binary/encode.ml

@@ -231,7 +231,6 @@ struct
   let end_ () = op 0x0b
 
   let var x = u32 x.it
-  let var_pair (x, y) = var x; var y
 
   let memop x {align; offset; _} =
     let has_var = x.it <> 0l in
@@ -255,6 +254,16 @@ struct
       | nlocs -> (1, loc) :: nlocs
     in vec local (List.fold_right combine locs [])
 
+  let on_clause (x, y) =
+    match y with
+    | OnSwitch ->
+       byte 0x01; var x
+    | OnLabel y ->
+       byte 0x00; var x; var y
+
+  let resumetable xls =
+    vec on_clause xls
+
   let rec instr e =
     match e.it with
     | Unreachable -> op 0x00
@@ -291,9 +300,10 @@ struct
     | ContNew x -> op 0xe0; var x
     | ContBind (x, y) -> op 0xe1; var x; var y
     | Suspend x -> op 0xe2; var x
-    | Resume (x, xls) -> op 0xe3; var x; vec var_pair xls
-    | ResumeThrow (x, y, xls) -> op 0xe4; var x; var y; vec var_pair xls
-    | Barrier (bt, es) -> op 0xe5; block_type bt; list instr es; end_ ()
+    | Resume (x, xls) -> op 0xe3; var x; resumetable xls
+    | ResumeThrow (x, y, xls) -> op 0xe4; var x; var y; resumetable xls
+    | Switch (x, y) -> op 0xe5; var x; var y
+    | Barrier (bt, es) -> op 0xe6; block_type bt; list instr es; end_ ()
 
     | Throw x -> op 0x08; var x
     | ThrowRef -> op 0x0a

interpreter/exec/eval.ml

@@ -72,10 +72,11 @@ and admin_instr' =
   | Label of int * instr list * code
   | Frame of int * frame * code
   | Handler of int * catch list * code
-  | Handle of (tag_inst * idx) list option * code
-  | Suspending of tag_inst * value stack * ctxt
+  | Handle of handle_table option * code
+  | Suspending of tag_inst * value stack * ref_ option * ctxt
 
 and ctxt = code -> code
+and handle_table = (tag_inst * idx) list * tag_inst list
 
 type cont = int32 * ctxt  (* TODO: represent type properly *)
 type ref_ += ContRef of cont option ref
@@ -223,6 +224,24 @@ let array_oob a i n =
   I64.gt_u (I64.add (I64_convert.extend_i32_u i) (I64_convert.extend_i32_u n))
     (I64_convert.extend_i32_u (Aggr.array_length a))
 
+let handle_table (c : config) xls : handle_table =
+  let suspend =
+    List.filter_map
+      (fun (x, hdl) ->
+        match hdl with
+        | OnLabel l -> Some (tag c.frame.inst x, l)
+        | _ -> None)
+      xls
+  in
+  let switch =
+    List.filter_map
+      (fun (x, hdl) ->
+        match hdl with
+        | OnSwitch -> Some (tag c.frame.inst x)
+        | _ -> None)
+      xls
+  in
+  (suspend, switch)
 
 let rec step (c : config) : config =
   let vs, es = c.code in
@@ -358,7 +377,7 @@ let rec step (c : config) : config =
         let tagt = tag c.frame.inst x in
         let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
         let args, vs' = i32_split (Lib.List32.length ts) vs e.at in
-        vs', [Suspending (tagt, args, fun code -> code) @@ e.at]
+        vs', [Suspending (tagt, args, None, fun code -> code) @@ e.at]
 
       | Resume (x, xls), Ref (NullRef _) :: vs ->
         vs, [Trapping "null continuation reference" @@ e.at]
@@ -367,7 +386,7 @@ let rec step (c : config) : config =
         vs, [Trapping "continuation already consumed" @@ e.at]
 
       | Resume (x, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs ->
-        let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in
+        let hs = handle_table c xls in
         let args, vs' = i32_split n vs e.at in
         cont := None;
         vs', [Handle (Some hs, ctxt (args, [])) @@ e.at]
@@ -381,11 +400,22 @@ let rec step (c : config) : config =
       | ResumeThrow (x, y, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs ->
         let tagt = tag c.frame.inst y in
         let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
-        let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in
-        let args, vs' = split (List.length ts) vs e.at in
+        let hs = handle_table c xls in
+        let args, vs' = i32_split (Lib.List32.length ts) vs e.at in
         cont := None;
         vs', [Handle (Some hs, ctxt (args, [Plain (Throw x) @@ e.at])) @@ e.at]
 
+      | Switch (x, y), Ref (NullRef _) :: vs ->
+         vs, [Trapping "null continuation reference" @@ e.at]
+
+      | Switch (x, y), Ref (ContRef {contents = None}) :: vs ->
+         vs, [Trapping "continuation already consumed" @@ e.at]
+
+      | Switch (x, y), Ref (ContRef {contents = Some (n, ctxt)} as cont) :: vs ->
+         let tagt = tag c.frame.inst y in
+         let args, vs' = i32_split (Int32.sub n 1l) vs e.at in
+         vs', [Suspending (tagt, args, Some cont, fun code -> code) @@ e.at]
+
       | Barrier (bt, es'), vs ->
         let InstrT (ts1, _, _xs) = block_type c.frame.inst bt e.at in
         let args, vs' = i32_split (Lib.List32.length ts1) vs e.at in
@@ -1126,9 +1156,9 @@ let rec step (c : config) : config =
     | Label (n, es0, (vs', [])), vs ->
       vs' @ vs, []
 
-    | Label (n, es0, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs ->
+    | Label (n, es0, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Label (n, es0, compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
 
     | Label (n, es0, (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs ->
       vs, [ReturningInvoke (vs0, f) @@ at]
@@ -1155,9 +1185,9 @@ let rec step (c : config) : config =
     | Frame (n, frame', (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Throwing (a, vs0) @@ at]
 
-    | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs ->
+    | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
 
     | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs ->
       take n vs0 e.at @ vs, []
@@ -1197,6 +1227,10 @@ let rec step (c : config) : config =
     | Handler (n, [], (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Throwing (a, vs0) @@ at]
 
+    | Handler (n, cs, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
+      let ctxt' code = [], [Handler (n, cs, compose (ctxt code) (vs', es')) @@ e.at] in
+      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
+
     | Handler (n, cs, (vs', e' :: es')), vs when is_jumping e' ->
       vs, [e']
 
@@ -1233,16 +1267,25 @@ let rec step (c : config) : config =
     | Handle (None, (vs', {it = Suspending _; at} :: es')), vs ->
       vs, [Trapping "barrier hit by suspension" @@ at]
 
-    | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs
+    | Handle (Some (hs, _), (vs', {it = Suspending (tagt, vs1, None, ctxt); at} :: es')), vs
       when List.mem_assq tagt hs ->
       let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
       let ctxt' code = compose (ctxt code) (vs', es') in
       [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs,
       [Plain (Br (List.assq tagt hs)) @@ e.at]
 
-    | Handle (hso, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs ->
+    | Handle (Some (_, hs) as hso, (vs', {it = Suspending (tagt, vs1, Some (ContRef ({contents = Some (_, ctxt)} as cont)), ctxt'); at} :: es')), vs
+       when List.memq tagt hs ->
+       let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
+       let ctxt'' code = compose (ctxt' code) (vs', es') in
+       let cont' = Ref (ContRef (ref (Some (Int32.add (Lib.List32.length ts) 1l, ctxt'')))) in
+       let args = vs1 @ [cont'] in
+       cont := None;
+       vs' @ vs, [Handle (hso, ctxt (args, [])) @@ e.at]
+
+    | Handle (hso, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Handle (hso, compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
 
     | Handle (hso, (vs', e' :: es')), vs when is_jumping e' ->
       vs, [e']
@@ -1251,7 +1294,8 @@ let rec step (c : config) : config =
       let c' = step {c with code = code'} in
       vs, [Handle (hso, c'.code) @@ e.at]
 
-    | Suspending (_, _, _), _ -> assert false
+    | Suspending (_, _, _, _), _ -> assert false
+
   in {c with code = vs', es' @ List.tl es}
 
 

interpreter/syntax/ast.ml

@@ -139,6 +139,7 @@ type vec = Value.vec Source.phrase
 type name = Utf8.unicode
 
 type block_type = VarBlockType of idx | ValBlockType of val_type option
+type hdl = OnLabel of idx | OnSwitch
 
 type instr = instr' Source.phrase
 and instr' =
@@ -166,8 +167,9 @@ and instr' =
   | ContNew of idx                    (* create continuation *)
   | ContBind of idx * idx             (* bind continuation arguments *)
   | Suspend of idx                    (* suspend continuation *)
-  | Resume of idx * (idx * idx) list  (* resume continuation *)
-  | ResumeThrow of idx * idx * (idx * idx) list (* abort continuation *)
+  | Resume of idx * (idx * hdl) list  (* resume continuation *)
+  | ResumeThrow of idx * idx * (idx * hdl) list (* abort continuation *)
+  | Switch of idx * idx               (* direct switch continuation *)
   | Barrier of block_type * instr list  (* guard against suspension *)
   | Throw of idx                      (* throw exception *)
   | ThrowRef                          (* rethrow exception *)

interpreter/syntax/free.ml

@@ -141,6 +141,10 @@ let block_type = function
   | VarBlockType x -> types (idx x)
   | ValBlockType t -> opt val_type t
 
+let hdl = function
+  | OnLabel x -> labels (idx x)
+  | OnSwitch -> empty
+
 let rec instr (e : instr) =
   match e.it with
   | Unreachable | Nop | Drop -> empty
@@ -176,9 +180,10 @@ let rec instr (e : instr) =
      tables (idx x) ++ types (idx y)
   | ContNew x -> types (idx x)
   | ContBind (x, y) -> types (idx x) ++ types (idx y)
-  | ResumeThrow (x, y, xys) -> types (idx x) ++ tags (idx y) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys
-  | Resume (x, xys) -> types (idx x) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys
+  | ResumeThrow (x, y, xys) -> types (idx x) ++ tags (idx y) ++ list (fun (x, y) -> tags (idx x) ++ hdl y) xys
+  | Resume (x, xys) -> types (idx x) ++ list (fun (x, y) -> tags (idx x) ++ hdl y) xys
   | Suspend x -> tags (idx x)
+  | Switch (x, z) -> types (idx x) ++ tags (idx z)
   | Throw x -> tags (idx x)
   | ThrowRef -> empty
   | TryTable (bt, cs, es) ->

interpreter/syntax/operators.ml

@@ -50,6 +50,7 @@ let cont_bind x y = ContBind (x, y)
 let suspend x = Suspend x
 let resume x xys = Resume (x, xys)
 let resume_throw x y xys = ResumeThrow (x, y, xys)
+let switch x y = Switch (x, y)
 let barrier bt es = Barrier (bt, es)
 let throw x = Throw x
 let throw_ref = ThrowRef

interpreter/text/arrange.ml

@@ -489,6 +489,15 @@ let block_type = function
   | VarBlockType x -> [Node ("type " ^ var x, [])]
   | ValBlockType ts -> decls "result" (list_of_opt ts)
 
+let hdl = function
+  | OnLabel x -> var x
+  | OnSwitch -> "switch"
+
+let resumetable xys =
+  List.map
+    (fun (x, y) -> Node ("on " ^ var x ^ " " ^ hdl y, []))
+    xys
+
 let rec instr e =
   let head, inner =
     match e.it with
@@ -526,11 +535,11 @@ let rec instr e =
     | ContBind (x, y) -> "cont.bind " ^ var x ^ " " ^ var y, []
     | Suspend x -> "suspend " ^ var x, []
     | Resume (x, xys) ->
-      "resume " ^ var x,
-      List.map (fun (x, y) -> Node ("on " ^ var x ^ " " ^ var y, [])) xys
+      "resume " ^ var x, resumetable xys
     | ResumeThrow (x, y, xys) ->
-      "resume_throw " ^ var x ^ " " ^ var y,
-      List.map (fun (x, y) -> Node ("on " ^ var x ^ " " ^ var y, [])) xys
+      "resume_throw " ^ var x ^ " " ^ var y, resumetable xys
+    | Switch (x, z) ->
+      "switch " ^ var x ^ " " ^ var z, []
     | Barrier (bt, es) -> "barrier", block_type bt @ list instr es
     | Throw x -> "throw " ^ var x, []
     | ThrowRef -> "throw_ref", []

interpreter/text/lexer.mll

@@ -231,6 +231,7 @@ rule token = parse
       | "resume" -> RESUME
       | "resume_throw" -> RESUME_THROW
       | "barrier" -> BARRIER
+      | "switch" -> SWITCH
 
 
       | "local.get" -> LOCAL_GET