Translating thread and wait to js and test harness for multi-threaded programs (#229)

* [interpreter] Fix regsitry to be per-thread

* Rebuild either patterns; fix tests

* [test/js] use newer version of testharness

* [interpreter] remove bogus unittest in Makefile

* [interpreter] fix match_result definition in js generation

* [test/js] thread/wait in js generation and tests

---------

Co-authored-by: Andreas Rossberg <rossberg@mpi-sws.org>

Author: zilinc

interpreter/Makefile

@@ -1,6 +1,6 @@
 # This Makefile uses dune but does not rely on ocamlfind or the Opam
 # package manager to build. However, Opam package management is available
-# optionally through the check/install/uninstall targets.
+# optionally through the install target.
 #
 # The $(JSLIB).js target requires Js_of_ocaml (using ocamlfind).
 #
@@ -9,80 +9,77 @@
 
 # Configuration
 
-NAME = wasm
-OPT =		$(NAME).exe
-ZIP =		$(NAME).zip
+NAME =		wasm
+LIB =		$(NAME)
 JSLIB =		wast.js
+ZIP =		$(NAME).zip
 
-BUILDDIR = _build/default
+BUILDDIR =	_build/default
 
 JS =		# set to JS shell command to run JS tests, empty to skip
 
 
 # Main targets
 
-.PHONY:		default opt jslib all zip smallint
+.PHONY:		default all ci jslib zip
+
+default:	$(NAME)
+all:		default partest
+ci:		all jslib zip
 
-default:	$(OPT)
 jslib:		$(JSLIB)
-all:		$(OPT) test
 zip:		$(ZIP)
-smallint:	smallint.exe
-ci:		all jslib
 
-# Building executable
-.PHONY:		$(NAME).exe
-$(NAME).exe:
-	rm -f $(NAME)
-	dune build $@
-	cp $(BUILDDIR)/$(OPT) $(NAME)
 
-.PHONY:		smallint.exe
-smallint.exe:
-	dune build $@
+# Building
 
-# Building JavaScript library
+.PHONY:                $(NAME) $(JSLIB)
 
-$(JSLIB):	$(BUILDDIR)/$(JSLIB)
-	cp $< $@
+$(NAME):
+	rm -f $@
+	dune build $@.exe
+	ln $(BUILDDIR)/$@.exe $@
 
-$(BUILDDIR)/$(JSLIB):
-	dune build $(JSLIB)
+$(JSLIB):
+	rm -f $@
+	dune build $(@:%.js=%.bc.js)
+	ln $(BUILDDIR)/$(@:%.js=%.bc.js) $@
 
-# Executing test suite
+
+# Test suite
 
 TESTDIR =	../test/core
-# Skip _output directory, since that's a tmp directory, and list all other wast files.
-TESTFILES =	$(shell cd $(TESTDIR); ls *.wast; ls [a-z]*/*.wast)
+TESTFILES =	$(shell cd $(TESTDIR) > /dev/null; ls *.wast; ls [a-z]*/*.wast)
 TESTS =		$(TESTFILES:%.wast=%)
 
-.PHONY:		test partest dune-test
+.PHONY: test partest quiettest
+
+test: $(NAME)
+	$(TESTDIR)/run.py --wasm `pwd`/$(NAME) $(if $(JS),--js '$(JS)',)
+
+test/%: $(NAME)
+	$(TESTDIR)/run.py --wasm `pwd`/$(NAME) $(if $(JS),--js '$(JS)',) $(TESTDIR)/$*.wast
 
-test:		$(OPT) smallint
-		$(TESTDIR)/run.py --wasm `pwd`/$(BUILDDIR)/$(OPT) $(if $(JS),--js '$(JS)',)
-		dune exec ./smallint.exe
+run/%: $(NAME)
+	./$(NAME) $(TESTDIR)/$*.wast
 
-test/%:		$(OPT)
-		$(TESTDIR)/run.py --wasm `pwd`/$(BUILDDIR)/$(OPT) $(if $(JS),--js '$(JS)',) $(TESTDIR)/$*.wast
+partest: $(NAME)
+	make -j10 quiettest
 
-run/%:		$(OPT)
-		./$(OPT) $(TESTDIR)/$*.wast
+quiettest: $(TESTS:%=quiettest/%)
+	@echo All tests passed.
 
-partest:	$(TESTS:%=quiettest/%)
-		@echo All tests passed.
+quiettest/%: $(NAME)
+	@ ( \
+	  $(TESTDIR)/run.py 2>$(@F).out --wasm `pwd`/$(NAME) $(if $(JS),--js '$(JS)',) $(TESTDIR)/$*.wast && \
+	  rm $(@F).out \
+	) || \
+	(cat $(@F).out && rm $(@F).out && exit 1)
 
-quiettest/%:	$(OPT)
-		@ ( \
-		  $(TESTDIR)/run.py 2>$(@F).out --wasm `pwd`/$(BUILDDIR)/$(OPT) $(if $(JS),--js '$(JS)',) $(TESTDIR)/$*.wast && \
-		  rm $(@F).out \
-		) || \
-		cat $(@F).out || rm $(@F).out || exit 1
 
-smallinttest:	smallint
-	dune exec ./smallint.exe
+# Packaging
 
-dunetest:
-	dune test
+.PHONY: install
 
 install:
 	dune build -p $(NAME) @install
@@ -101,15 +98,16 @@ opam-release/%:
 	rm opam-$*.zip
 	@echo Created file ./opam, submit to github opam-repository/packages/wasm/wasm.$*/opam
 
-# Miscellaneous targets
-
-.PHONY:		clean
-
 $(ZIP):
 	git archive --format=zip --prefix=$(NAME)/ -o $@ HEAD
 
+
+# Cleanup
+
+.PHONY: clean distclean
+
 clean:
 	dune clean
 
 distclean: clean
-	rm -f $(NAME) $(JSLIB)
+	rm -f $(NAME) $(JSLIB) $(ZIP)

interpreter/binary/encode.ml

@@ -59,7 +59,6 @@ struct
     if -64L <= i && i < 64L then byte b
     else (byte (b lor 0x80); s64 (Int64.shift_right i 7))
 
-  let u1 i = u64 Int64.(logand (of_int i) 1L)
   let u32 i = u64 Int64.(logand (of_int32 i) 0xffffffffL)
   let s7 i = s64 (Int64.of_int i)
   let s32 i = s64 (Int64.of_int32 i)

interpreter/dune

@@ -54,7 +54,7 @@
 (env
  (_
   (flags
-   (-w +a-4-27-42-44-45-70 -warn-error +a-3))))
+   (-w +a-4-27-42-44-45-70 -warn-error +a-3-32))))
 
 (rule
  (alias runtest)

interpreter/host/env.ml

@@ -41,6 +41,6 @@ let exit vs =
 
 let lookup name t =
   match Utf8.encode name, t with
-  | "abort", ExternFuncType t -> ExternFunc (Func.alloc_host t abort)
-  | "exit", ExternFuncType t -> ExternFunc (Func.alloc_host t exit)
-  | _ -> raise Not_found
+  | "abort", ExternFuncType t -> Some (ExternFunc (Func.alloc_host t abort))
+  | "exit", ExternFuncType t -> Some (ExternFunc (Func.alloc_host t exit))
+  | _ -> None

interpreter/host/spectest.ml

@@ -37,7 +37,7 @@ let print (FuncType (_, out)) vs =
   List.map default_value out
 
 
-let lookup name t =
+let lookup' name t =
   match Utf8.encode name, t with
   | "print", _ -> ExternFunc (func print (FuncType ([], [])))
   | "print_i32", _ -> ExternFunc (func print (FuncType ([NumType I32Type], [])))
@@ -55,3 +55,6 @@ let lookup name t =
   | "table", _ -> ExternTable table
   | "memory", _ -> ExternMemory memory
   | _ -> raise Not_found
+
+let lookup name t =
+  try Some (lookup' name t) with Not_found -> None

interpreter/main/main.ml

@@ -2,8 +2,8 @@ let name = "wasm"
 let version = "2.0.1"
 
 let configure () =
-  Import.register (Utf8.decode "spectest") Spectest.lookup;
-  Import.register (Utf8.decode "env") Env.lookup
+  Import.register_global (Utf8.decode "spectest") Spectest.lookup;
+  Import.register_global (Utf8.decode "env") Env.lookup
 
 let banner () =
   print_endline (name ^ " " ^ version ^ " reference interpreter")

interpreter/script/import.ml

@@ -1,20 +1,36 @@
 open Source
+open Types
 open Ast
 
 module Unknown = Error.Make ()
 exception Unknown = Unknown.Error  (* indicates unknown import name *)
 
 module Registry = Map.Make(struct type t = Ast.name let compare = compare end)
-let registry = ref Registry.empty
 
-let register name lookup = registry := Registry.add name lookup !registry
+type registry = (name -> extern_type -> Instance.extern option) Registry.t ref
 
-let lookup (m : module_) (im : import) : Instance.extern =
+type lookup_export = name -> extern_type -> Instance.extern option
+
+
+let global : registry = ref Registry.empty
+let registry () : registry = ref !global
+
+let register r name lookup = r := Registry.add name lookup !r
+let register_global name lookup = register global name lookup
+
+let lookup r module_name item_name et : Instance.extern option =
+  match Registry.find_opt module_name !r with
+  | Some f -> f item_name et
+  | None -> None
+
+let lookup_import r (m : module_) (im : import) : Instance.extern =
   let {module_name; item_name; idesc} = im.it in
-  let t = import_type m im in
-  try Registry.find module_name !registry item_name t with Not_found ->
-    Unknown.error im.at
-      ("unknown import \"" ^ string_of_name module_name ^
-        "\".\"" ^ string_of_name item_name ^ "\"")
+  let et = import_type m im in
+    match lookup r module_name item_name et with
+    | Some ext -> ext
+    | None ->
+      Unknown.error im.at
+        ("unknown import \"" ^ string_of_name module_name ^
+          "\".\"" ^ string_of_name item_name ^ "\"")
 
-let link m = List.map (lookup m) m.it.imports
+let link r m = List.map (lookup_import r m) m.it.imports

interpreter/script/import.mli

@@ -1,8 +1,17 @@
+open Types
+open Ast
+
+type registry
+
 exception Unknown of Source.region * string
 
-val link : Ast.module_ -> Instance.extern list (* raises Unknown *)
+val registry : unit -> registry
+
+val lookup : registry -> name -> name -> extern_type -> Instance.extern option
+val link : registry -> module_ -> Instance.extern list (* raises Unknown *)
+
+
+type lookup_export = name -> extern_type -> Instance.extern option
 
-val register :
-  Ast.name ->
-  (Ast.name -> Types.extern_type -> Instance.extern (* raises Not_found *)) ->
-  unit
+val register : registry -> name -> lookup_export -> unit
+val register_global : name -> lookup_export -> unit