Use solely offset tables in the Haskell world

asterius/rts/rts.mjs

@@ -191,19 +191,7 @@ export async function newAsteriusInstance(req) {
     __asterius_bytestring_cbits.memory = __asterius_memory;
     __asterius_scheduler.setGC(__asterius_gc);
 
-    for (const [f, p, a, r, i] of req.functionsExportsStatic) {
-      __asterius_exports[
-        f
-      ] = __asterius_exports.newHaskellCallback(
-        __asterius_stableptr_manager.newStablePtr(p),
-        a,
-        r,
-        i,
-        () => {}
-      );
-    }
-
-    for (const [f, p, a, r, i] of req.staticsExportsStatic) {
+    for (const [f, p, a, r, i] of req.exportsStatic) {
       __asterius_exports[
         f
       ] = __asterius_exports.newHaskellCallback(

asterius/src/Asterius/Backends/Binaryen.hs

@@ -247,10 +247,10 @@ data MarshalEnv = MarshalEnv
     envIsVerboseErrOn :: Bool,
     -- | Whether the tail call extension is on.
     envAreTailCallsOn :: Bool,
-    -- | The symbol map for the current module (statics).
-    envStaticsSymbolMap :: SM.SymbolMap Int64,
-    -- | The symbol map for the current module (functions).
-    envFunctionsSymbolMap :: SM.SymbolMap Int64,
+    -- | The offset map for the current module (statics).
+    envStaticsOffsetMap :: SM.SymbolMap Word32,
+    -- | The offset map for the current module (functions).
+    envFunctionsOffsetMap :: SM.SymbolMap Word32,
     -- | The current module reference.
     envModuleRef :: Binaryen.Module
   }
@@ -269,13 +269,13 @@ isVerboseErrOn = reader envIsVerboseErrOn
 areTailCallsOn :: CodeGen Bool
 areTailCallsOn = reader envAreTailCallsOn
 
--- | Retrieve the symbol map from the local environment (statics).
-askStaticsSymbolMap :: CodeGen (SM.SymbolMap Int64)
-askStaticsSymbolMap = reader envStaticsSymbolMap
+-- | Retrieve the offset map from the local environment (statics).
+askStaticsOffsetMap :: CodeGen (SM.SymbolMap Word32)
+askStaticsOffsetMap = reader envStaticsOffsetMap
 
--- | Retrieve the symbol map from the local environment (functions).
-askFunctionsSymbolMap :: CodeGen (SM.SymbolMap Int64)
-askFunctionsSymbolMap = reader envFunctionsSymbolMap
+-- | Retrieve the offset map from the local environment (functions).
+askFunctionsOffsetMap :: CodeGen (SM.SymbolMap Word32)
+askFunctionsOffsetMap = reader envFunctionsOffsetMap
 
 -- | Retrieve the reference to the current module.
 askModuleRef :: CodeGen Binaryen.Module
@@ -323,8 +323,8 @@ marshalExpression e = case e of
       Binaryen.switch m nsp (fromIntegral nl) dn c (coerce nullPtr)
   Call {..} -> do
     verbose_err <- isVerboseErrOn
-    func_sym_map <- askFunctionsSymbolMap
-    if  | target `SM.member` func_sym_map -> do
+    fn_off_map <- askFunctionsOffsetMap
+    if  | target `SM.member` fn_off_map -> do
           os <-
             mapM
               marshalExpression
@@ -443,14 +443,14 @@ marshalExpression e = case e of
         Binaryen.returnCall m dst nullPtr 0 Binaryen.none
     -- Case 2: Tail calls are off
     False -> do
-      func_sym_map <- askFunctionsSymbolMap
-      case SM.lookup returnCallTarget64 func_sym_map of
+      fn_off_map <- askFunctionsOffsetMap
+      case SM.lookup returnCallTarget64 fn_off_map of
         Just t -> do
           s <-
             marshalExpression
               SetGlobal
                 { globalSymbol = "__asterius_pc",
-                  value = ConstI64 t
+                  value = ConstI64 $ mkFunctionAddress t
                 }
           m <- askModuleRef
           a <- askArena
@@ -500,13 +500,13 @@ marshalExpression e = case e of
   CFG {..} -> relooperRun graph
   Symbol {..} -> do
     verbose_err <- isVerboseErrOn
-    ss_sym_map <- askStaticsSymbolMap
-    func_sym_map <- askFunctionsSymbolMap
+    ss_off_map <- askStaticsOffsetMap
+    fn_off_map <- askFunctionsOffsetMap
     m <- askModuleRef
-    if  | Just x <- SM.lookup unresolvedSymbol ss_sym_map ->
-          lift $ Binaryen.constInt64 m $ x + fromIntegral symbolOffset
-        | Just x <- SM.lookup unresolvedSymbol func_sym_map ->
-          lift $ Binaryen.constInt64 m $ x + fromIntegral symbolOffset
+    if  | Just x <- SM.lookup unresolvedSymbol ss_off_map ->
+          lift $ Binaryen.constInt64 m $ mkDataAddress $ x + fromIntegral symbolOffset
+        | Just x <- SM.lookup unresolvedSymbol fn_off_map ->
+          lift $ Binaryen.constInt64 m $ mkFunctionAddress $ x + fromIntegral symbolOffset
         | verbose_err ->
           marshalExpression $ barf (entityName unresolvedSymbol) [I64]
         | otherwise ->
@@ -658,11 +658,11 @@ marshalGlobal k Global {..} = do
 marshalModule ::
   Bool ->
   Bool ->
-  SM.SymbolMap Int64 ->
-  SM.SymbolMap Int64 ->
+  SM.SymbolMap Word32 ->
+  SM.SymbolMap Word32 ->
   Module ->
   IO Binaryen.Module
-marshalModule verbose_err tail_calls ss_sym_map func_sym_map hs_mod@Module {..} = do
+marshalModule verbose_err tail_calls ss_off_map fn_off_map hs_mod@Module {..} = do
   m <- Binaryen.Module.create
   Binaryen.setFeatures m
     $ foldl1' (.|.)
@@ -674,8 +674,8 @@ marshalModule verbose_err tail_calls ss_sym_map func_sym_map hs_mod@Module {..}
             { envArena = a,
               envIsVerboseErrOn = verbose_err,
               envAreTailCallsOn = tail_calls,
-              envStaticsSymbolMap = ss_sym_map,
-              envFunctionsSymbolMap = func_sym_map,
+              envStaticsOffsetMap = ss_off_map,
+              envFunctionsOffsetMap = fn_off_map,
               envModuleRef = m
             }
         fts = generateWasmFunctionTypeSet hs_mod

asterius/src/Asterius/Backends/WasmToolkit.hs

@@ -38,7 +38,6 @@ import Control.Monad.Reader
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
 import Data.Coerce
-import Data.Int
 import Data.List
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -464,10 +463,10 @@ data MarshalEnv
         envIsVerboseErrOn :: Bool,
         -- | Whether the tail call extension is on.
         envAreTailCallsOn :: Bool,
-        -- | The symbol map for the current module (statics).
-        envStaticsSymbolMap :: SM.SymbolMap Int64,
-        -- | The symbol map for the current module (functions).
-        envFunctionsSymbolMap :: SM.SymbolMap Int64,
+        -- | The offset map for the current module (statics).
+        envStaticsOffsetMap :: SM.SymbolMap Word32,
+        -- | The offset map for the current module (functions).
+        envFunctionsOffsetMap :: SM.SymbolMap Word32,
         -- | The symbol table for the current module.
         envModuleSymbolTable :: ModuleSymbolTable,
         -- | The de Bruijn context. Used for label access.
@@ -484,13 +483,13 @@ isVerboseErrOn = reader envIsVerboseErrOn
 areTailCallsOn :: MonadReader MarshalEnv m => m Bool
 areTailCallsOn = reader envAreTailCallsOn
 
--- | Retrieve the symbol map from the local environment (statics).
-askStaticsSymbolMap :: MonadReader MarshalEnv m => m (SM.SymbolMap Int64)
-askStaticsSymbolMap = reader envStaticsSymbolMap
+-- | Retrieve the offset map from the local environment (statics).
+askStaticsOffsetMap :: MonadReader MarshalEnv m => m (SM.SymbolMap Word32)
+askStaticsOffsetMap = reader envStaticsOffsetMap
 
--- | Retrieve the symbol map from the local environment (functions).
-askFunctionsSymbolMap :: MonadReader MarshalEnv m => m (SM.SymbolMap Int64)
-askFunctionsSymbolMap = reader envFunctionsSymbolMap
+-- | Retrieve the offset map from the local environment (functions).
+askFunctionsOffsetMap :: MonadReader MarshalEnv m => m (SM.SymbolMap Word32)
+askFunctionsOffsetMap = reader envFunctionsOffsetMap
 
 -- | Retrieve the module symbol table from the local environment.
 askModuleSymbolTable :: MonadReader MarshalEnv m => m ModuleSymbolTable
@@ -698,7 +697,7 @@ makeInstructions expr =
       x <- makeInstructions dropValue
       pure $ x `snocBag` Wasm.Drop
     ReturnCall {..} -> do
-      func_sym_map <- askFunctionsSymbolMap
+      fn_off_map <- askFunctionsOffsetMap
       ModuleSymbolTable {..} <- askModuleSymbolTable
       verbose_err <- isVerboseErrOn
       tail_calls <- areTailCallsOn
@@ -713,11 +712,11 @@ makeInstructions expr =
             | otherwise ->
               pure $ unitBag Wasm.Unreachable
         -- Case 2: Tail calls are off
-        else case SM.lookup returnCallTarget64 func_sym_map of
+        else case SM.lookup returnCallTarget64 fn_off_map of
           Just t -> makeInstructions
             SetGlobal
               { globalSymbol = "__asterius_pc",
-                value = ConstI64 t
+                value = ConstI64 $ mkFunctionAddress $ t
               }
           _
             | verbose_err ->
@@ -751,15 +750,15 @@ makeInstructions expr =
     CFG {..} -> makeInstructions $ relooper graph
     Symbol {..} -> do
       verbose_err <- isVerboseErrOn
-      ss_sym_map <- askStaticsSymbolMap
-      func_sym_map <- askFunctionsSymbolMap
-      if  | Just x <- SM.lookup unresolvedSymbol ss_sym_map ->
+      ss_off_map <- askStaticsOffsetMap
+      fn_off_map <- askFunctionsOffsetMap
+      if  | Just x <- SM.lookup unresolvedSymbol ss_off_map ->
             pure $ unitBag Wasm.I64Const
-              { i64ConstValue = x + fromIntegral symbolOffset
+              { i64ConstValue = mkDataAddress $ x + fromIntegral symbolOffset
               }
-          | Just x <- SM.lookup unresolvedSymbol func_sym_map ->
+          | Just x <- SM.lookup unresolvedSymbol fn_off_map ->
             pure $ unitBag Wasm.I64Const
-              { i64ConstValue = x + fromIntegral symbolOffset
+              { i64ConstValue = mkFunctionAddress $ x + fromIntegral symbolOffset
               }
           | verbose_err ->
             makeInstructions $ barf (entityName unresolvedSymbol) [I64]
@@ -830,18 +829,18 @@ makeModule ::
   MonadError MarshalError m =>
   Bool ->
   Bool ->
-  SM.SymbolMap Int64 ->
-  SM.SymbolMap Int64 ->
+  SM.SymbolMap Word32 ->
+  SM.SymbolMap Word32 ->
   Module ->
   m Wasm.Module
-makeModule verbose_err tail_calls ss_sym_map func_sym_map m = do
+makeModule verbose_err tail_calls ss_off_map fn_off_map m = do
   _module_symtable <- makeModuleSymbolTable m
   let env =
         MarshalEnv
           { envIsVerboseErrOn = verbose_err,
             envAreTailCallsOn = tail_calls,
-            envStaticsSymbolMap = ss_sym_map,
-            envFunctionsSymbolMap = func_sym_map,
+            envStaticsOffsetMap = ss_off_map,
+            envFunctionsOffsetMap = fn_off_map,
             envModuleSymbolTable = _module_symtable,
             envDeBruijnContext = emptyDeBruijnContext,
             envLclContext = emptyLocalContext

asterius/src/Asterius/Foreign/ExportStatic.hs

@@ -8,6 +8,7 @@ module Asterius.Foreign.ExportStatic
 where
 
 import Asterius.Foreign.SupportedTypes
+import Asterius.Internals.MagicNumber
 import Asterius.Types
 import qualified Asterius.Types.SymbolMap as SM
 import Data.Bits
@@ -16,15 +17,16 @@ import Data.Foldable
 import Data.Int
 import Data.List
 import Data.Maybe
+import Data.Word
 
-genExportStaticObj :: FFIMarshalState -> SM.SymbolMap Int64 -> Builder
-genExportStaticObj FFIMarshalState {..} sym_map =
+genExportStaticObj :: FFIMarshalState -> SM.SymbolMap Word32 -> Builder
+genExportStaticObj FFIMarshalState {..} ss_off_map =
   "["
     <> mconcat
       ( intersperse
           ","
           $ catMaybes
-            [ genExportStaticFunc k export_decl sym_map
+            [ genExportStaticFunc k export_decl ss_off_map
               | (k, export_decl) <- SM.toList ffiExportDecls
             ]
       )
@@ -33,15 +35,15 @@ genExportStaticObj FFIMarshalState {..} sym_map =
 genExportStaticFunc ::
   EntitySymbol ->
   FFIExportDecl ->
-  SM.SymbolMap Int64 ->
+  SM.SymbolMap Word32 ->
   Maybe Builder
-genExportStaticFunc k FFIExportDecl {ffiFunctionType = FFIFunctionType {..}, ..} sym_map = do
-  address <- SM.lookup ffiExportClosure sym_map
+genExportStaticFunc k FFIExportDecl {ffiFunctionType = FFIFunctionType {..}, ..} ss_off_map = do
+  off <- SM.lookup ffiExportClosure ss_off_map
   pure $
     "[\""
       <> byteString (entityName k)
       <> "\",0x"
-      <> int64HexFixed address
+      <> int64HexFixed (mkDataAddress off)
       <> ",0x"
       <> int64HexFixed (encodeTys ffiParamTypes)
       <> ",0x"

asterius/src/Asterius/GHCi/Internals.hs

@@ -19,6 +19,7 @@ import Asterius.Ar
 import Asterius.Binary.File
 import Asterius.Binary.NameCache
 import Asterius.CodeGen
+import Asterius.Internals.MagicNumber
 import Asterius.Internals.Temp
 import Asterius.JSRun.NonMain
 import Asterius.Ld
@@ -303,7 +304,7 @@ asteriusWriteIServ hsc_env i a
           asteriusRunTH
             i
             st
-            (fromIntegral (staticsSymbolMap link_report ! sym))
+            (fromIntegral (mkDataAddress $ staticsOffsetMap link_report ! sym))
             ty
             loc
             js_s

asterius/src/Asterius/Internals/MagicNumber.hs

@@ -2,12 +2,16 @@ module Asterius.Internals.MagicNumber
   ( dataTag,
     functionTag,
     invalidAddress,
-    unTag,
+    tableBase,
+    memoryBase,
+    mkDataAddress,
+    mkFunctionAddress,
   )
 where
 
 import Data.Bits
 import Data.Int
+import Data.Word
 
 dataTag :: Int64
 dataTag = 0x00000000001ffff7 -- 2097143
@@ -18,5 +22,17 @@ functionTag = 0x00000000001fffed -- 2097133
 invalidAddress :: Int64
 invalidAddress = 0x001fffffffff0000
 
-unTag :: Int64 -> Int64
-unTag = (.&. 0xFFFFFFFF)
+-- | Base address for functions. NOTE: reserve 0 for the null function pointer.
+tableBase :: Word32
+tableBase = 1
+
+-- | Base address for data segments. NOTE: leave 1KB empty for the
+-- @--low-memory-unused@ optimization to work.
+memoryBase :: Word32
+memoryBase = 1024
+
+mkDataAddress :: Word32 -> Int64
+mkDataAddress off = (dataTag `shiftL` 32) .|. fromIntegral (memoryBase + off)
+
+mkFunctionAddress :: Word32 -> Int64
+mkFunctionAddress off = (functionTag `shiftL` 32) .|. fromIntegral (tableBase + off)

asterius/src/Asterius/JSGen/SPT.hs

@@ -5,17 +5,17 @@ module Asterius.JSGen.SPT
   )
 where
 
+import Asterius.Internals.MagicNumber
 import qualified Asterius.Types.SymbolMap as SM
 import Data.ByteString.Builder
-import Data.Int
 import Data.List
 import Data.Word
 
 genSPT ::
-  SM.SymbolMap Int64 ->
+  SM.SymbolMap Word32 ->
   SM.SymbolMap (Word64, Word64) ->
   Builder
-genSPT sym_map spt_entries =
+genSPT ss_off_map spt_entries =
   "new Map(["
     <> mconcat
       ( intersperse
@@ -24,7 +24,7 @@ genSPT sym_map spt_entries =
               <> word64HexFixed w1
               <> word64HexFixed w0
               <> "n,0x"
-              <> int64HexFixed (sym_map SM.! sym)
+              <> int64HexFixed (mkDataAddress $ ss_off_map SM.! sym)
               <> "]"
             | (sym, (w0, w1)) <- SM.toList spt_entries
           ]