Fix handling of wasi-rts symbols (#882)

tweag · Dec 11, 2021 · a5db10a · a5db10a
1 parent fa12a8f
commit a5db10a
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 14 deletions.
diff --git a/asterius/src/Asterius/Backends/Binaryen.hs b/asterius/src/Asterius/Backends/Binaryen.hs
@@ -251,6 +251,8 @@ data MarshalEnv = MarshalEnv
     envSymbolMap :: SM.SymbolMap Word32,
     -- | Symbols of functions and function imports
     envSymbolSet :: Set.Set EntitySymbol,
+    -- | LibC symbols, external -> internal
+    envLibCSymbolMap :: SM.SymbolMap EntitySymbol,
     -- | The current module reference.
     envModuleRef :: Binaryen.Module
   }
@@ -316,7 +318,19 @@ marshalExpression e =
       Binaryen.switch m nsp (fromIntegral nl) dn c (coerce nullPtr)
   Call {..} -> do
     syms <- reader envSymbolSet
-    if | Set.member target syms -> do
+    libc_syms <- reader envLibCSymbolMap
+    if | SM.member target libc_syms && Set.member target syms -> do
+          fail $ "[ERROR] conflicting symbol: " <> show target
+       | Just v <- SM.lookup target libc_syms -> do
+          os <- mapM marshalExpression operands
+          rts <- marshalReturnTypes callReturnTypes
+          m <- askModuleRef
+          a <- askArena
+          lift $ do
+            (ops, osl) <- marshalV a os
+            tp <- marshalBS a (entityName v)
+            Binaryen.call m tp ops (fromIntegral osl) rts
+       | Set.member target syms -> do
           os <-
             mapM
               marshalExpression
@@ -586,7 +600,8 @@ marshalModule verbose_err sym_map last_data_offset hs_mod@Module {..} = do
               { envArena = a,
               envIsVerboseErrOn = verbose_err,
               envSymbolMap = sym_map,
-              envSymbolSet = Set.fromList [mkEntitySymbol internalName | FunctionImport {..} <- functionImports ] <> Set.fromList [mkEntitySymbol k | k <- M.keys functionMap' ] <> Set.fromList [mkEntitySymbol k | k <- libc_syms],
+              envSymbolSet = Set.fromList [mkEntitySymbol internalName | FunctionImport {..} <- functionImports ] <> Set.fromList [mkEntitySymbol k | k <- M.keys functionMap' ],
+              envLibCSymbolMap = libc_syms,
               envModuleRef = m
             }
         fts = generateWasmFunctionTypeSet hs_mod
@@ -608,6 +623,7 @@ marshalModule verbose_err sym_map last_data_offset hs_mod@Module {..} = do
       case memoryImport of
         Just mem_import -> marshalMemoryImport m mem_import
         _ -> pure ()
+  Binaryen.validate m
   pure m
 
 relooperAddBlock ::
@@ -697,17 +713,18 @@ binaryenFunctionType m in_name = do
   pure FunctionType {paramTypes = args_tys, returnTypes = res_tys}
 
 binaryenModuleExportNames ::
-  Binaryen.Module -> IO [BS.ByteString]
+  Binaryen.Module -> IO (SM.SymbolMap EntitySymbol)
 binaryenModuleExportNames m = do
   n <- Binaryen.getNumExports m
-  fmap catMaybes $
+  fmap (SM.fromList . catMaybes) $
     for [0 .. n - 1] $ \i -> do
       e <- Binaryen.getExportByIndex m (fromIntegral i)
       k <- Binaryen.Export.getKind e
       if k == Binaryen.externalFunction
         then do
           in_name <- BS.packCString =<< Binaryen.Export.getValue e
-          pure $ Just in_name
+          ext_name <- BS.packCString =<< Binaryen.Export.getName e
+          pure $ Just (mkEntitySymbol ext_name, mkEntitySymbol in_name)
         else pure Nothing
 
 foreign import ccall unsafe "BinaryenGetMemoryInitial" c_BinaryenGetMemoryInitial :: Binaryen.Module -> IO Binaryen.Index
diff --git a/asterius/src/Asterius/EDSL/LibC.hs b/asterius/src/Asterius/EDSL/LibC.hs
@@ -14,24 +14,24 @@ memcmp lhs rhs n =
 
 memcpy :: Expression -> Expression -> Expression -> Expression
 memcpy dst src n =
-  Call
+  Drop $ Call
     { target = "memcpy",
       operands = [dst, src, n],
-      callReturnTypes = []
+      callReturnTypes = [I32]
     }
 
 memmove :: Expression -> Expression -> Expression -> Expression
 memmove dst src n =
-  Call
+  Drop $ Call
     { target = "memmove",
       operands = [dst, src, n],
-      callReturnTypes = []
+      callReturnTypes = [I32]
     }
 
 memset :: Expression -> Expression -> Expression -> Expression
 memset dst c n =
-  Call
+  Drop $ Call
     { target = "memset",
       operands = [dst, c, n],
-      callReturnTypes = []
+      callReturnTypes = [I32]
     }
diff --git a/nix.cabal.project b/nix.cabal.project
@@ -11,7 +11,7 @@ source-repository-package
 source-repository-package
   type:     git
   location: https://github.com/tweag/ghc-asterius.git
-  tag:      731d16885bd6fc89ee950e398907ab0fc41dfd9b
+  tag:      9d92010d23de47a50df2bb0b0f795fe9f9699f4d
   subdir:
     ahc-bin
     ahc-pkg

diff --git a/nix/sources.json b/nix/sources.json
@@ -2,8 +2,8 @@
     "ghc-asterius": {
         "branch": "asterius-8.10-dejavu",
         "repo": "https://github.com/tweag/ghc-asterius.git",
-        "rev": "9aab1b1ae5c6286032bb927f106f74ff48bd1857",
-        "sha256": "1clvl69vmwsvs3d9dr9lfxfm1cmb074bz6ldax9hxvqycih9kly4",
+        "rev": "12b4543e3fad11c4717fe0db2dace406956aa8ed",
+        "sha256": "0jd8m7nz14bwd556ivnnm5j3lp85jjpk8q6x3a7zkcdvcryif03p",
         "type": "git"
     },
     "haskell-nix": {