Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions compiler/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -763,6 +763,7 @@ setTopSessionDynFlags dflags = do
, jsInterpUnitEnv = hsc_unit_env hsc_env
, jsInterpFinderOpts = initFinderOpts dflags
, jsInterpFinderCache = hsc_FC hsc_env
, jsInterpRtsWays = ways dflags
}
return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))

Expand Down
22 changes: 13 additions & 9 deletions compiler/GHC/Driver/DynFlags.hs
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,7 @@ module GHC.Driver.DynFlags (

--
baseUnitId,
rtsWayUnitId',
rtsWayUnitId,


Expand Down Expand Up @@ -1475,16 +1476,19 @@ versionedFilePath platform = uniqueSubdir platform
baseUnitId :: DynFlags -> UnitId
baseUnitId dflags = unitSettings_baseUnitId (unitSettings dflags)

rtsWayUnitId' :: Ways -> UnitId
rtsWayUnitId' ways | ways `hasWay` WayThreaded
, ways `hasWay` WayDebug
= stringToUnitId "rts:threaded-debug"
| ways `hasWay` WayThreaded
= stringToUnitId "rts:threaded-nodebug"
| ways `hasWay` WayDebug
= stringToUnitId "rts:nonthreaded-debug"
| otherwise
= stringToUnitId "rts:nonthreaded-nodebug"

rtsWayUnitId :: DynFlags -> UnitId
rtsWayUnitId dflags | ways dflags `hasWay` WayThreaded
, ways dflags `hasWay` WayDebug
= stringToUnitId "rts:threaded-debug"
| ways dflags `hasWay` WayThreaded
= stringToUnitId "rts:threaded-nodebug"
| ways dflags `hasWay` WayDebug
= stringToUnitId "rts:nonthreaded-debug"
| otherwise
= stringToUnitId "rts:nonthreaded-nodebug"
rtsWayUnitId dflags = rtsWayUnitId' (ways dflags)

-- SDoc
-------------------------------------------
Expand Down
14 changes: 9 additions & 5 deletions compiler/GHC/Runtime/Interpreter/JS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,12 +20,14 @@ module GHC.Runtime.Interpreter.JS
)
where

import GHC.Platform.Ways
import GHC.Prelude
import GHC.Runtime.Interpreter.Types
import GHC.Runtime.Interpreter.Process
import GHC.Runtime.Utils
import GHCi.Message

import GHC.Driver.DynFlags
import GHC.StgToJS.Linker.Types
import GHC.StgToJS.Linker.Linker
import GHC.StgToJS.Types
Expand All @@ -36,9 +38,9 @@ import GHC.Unit.Types
import GHC.Unit.State

import GHC.Utils.Logger
import GHC.Utils.Error
import GHC.Utils.TmpFs
import GHC.Utils.Panic
import GHC.Utils.Error (logInfo)
import GHC.Utils.Outputable (text)
import GHC.Data.FastString

Expand Down Expand Up @@ -155,6 +157,7 @@ spawnJSInterp cfg = do
unit_env = jsInterpUnitEnv cfg
finder_opts = jsInterpFinderOpts cfg
finder_cache = jsInterpFinderCache cfg
rts_ways = jsInterpRtsWays cfg

(std_in, proc) <- startTHRunnerProcess (jsInterpScript cfg) (jsInterpNodeConfig cfg)

Expand Down Expand Up @@ -197,7 +200,7 @@ spawnJSInterp cfg = do
-- cf https://emscripten.org/docs/compiling/Dynamic-Linking.html

-- link rts and its deps
jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst
jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst rts_ways

-- link interpreter and its deps
jsLinkInterp logger tmpfs tmp_dir codegen_cfg unit_env inst
Expand All @@ -214,8 +217,8 @@ spawnJSInterp cfg = do
---------------------------------------------------------

-- | Link JS RTS
jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
jsLinkRts logger tmpfs tmp_dir cfg unit_env inst = do
jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> Ways -> IO ()
jsLinkRts logger tmpfs tmp_dir cfg unit_env inst ways = do
let link_cfg = JSLinkConfig
{ lcNoStats = True -- we don't need the stats
, lcNoRts = False -- we need the RTS
Expand All @@ -228,8 +231,9 @@ jsLinkRts logger tmpfs tmp_dir cfg unit_env inst = do
}

-- link the RTS and its dependencies (things it uses from `ghc-internal`, etc.)
let rts_sublib_unit_id = rtsWayUnitId' ways
let link_spec = LinkSpec
{ lks_unit_ids = [rtsUnitId, ghcInternalUnitId]
{ lks_unit_ids = [rtsUnitId, rts_sublib_unit_id, ghcInternalUnitId]
, lks_obj_root_filter = const False
, lks_extra_roots = mempty
, lks_objs_hs = mempty
Expand Down
3 changes: 1 addition & 2 deletions compiler/GHC/Runtime/Interpreter/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,9 +49,7 @@ import GHCi.RemoteTypes
import GHCi.Message ( Pipe )

import GHC.Platform
#if defined(HAVE_INTERNAL_INTERPRETER)
import GHC.Platform.Ways
#endif
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
Expand Down Expand Up @@ -206,6 +204,7 @@ data JSInterpConfig = JSInterpConfig
, jsInterpUnitEnv :: !UnitEnv
, jsInterpFinderOpts :: !FinderOpts
, jsInterpFinderCache :: !FinderCache
, jsInterpRtsWays :: !Ways
}

------------------------
Expand Down