Skip to content

Commit c16b25a

Browse files
Stable Haskell TeamGHC GitLab CI
authored andcommitted
feat: Modularize RTS and extract headers/filesystem utilities
This commit restructures the Runtime System (RTS) components for better modularity and reusability across different build configurations. The changes enable cleaner separation of concerns and improved support for cross-compilation scenarios. Key changes: - Extract RTS headers into standalone rts-headers package * Moved include/rts/Bytecodes.h to rts-headers * Moved include/rts/storage/ClosureTypes.h to rts-headers * Moved include/rts/storage/FunTypes.h to rts-headers * Moved include/stg/MachRegs/* to rts-headers - Create rts-fs package for filesystem utilities * Extracted filesystem code from utils/fs * Provides reusable filesystem operations for RTS - Rename utils/iserv to utils/ghc-iserv for consistency * Better naming alignment with other GHC utilities * Updated all references throughout the codebase - Update RTS configuration and build files * Modified rts/configure.ac for new structure * Updated rts.cabal with new dependencies * Adjusted .gitignore for new artifacts Rationale: The modularization allows different stages of the compiler build to share common RTS components without circular dependencies. This is particularly important for: - Cross-compilation where host and target RTS differ - JavaScript backend which needs selective RTS components - Stage1/Stage2 builds that require different RTS configurations Contributors: - Moritz Angermann: RTS modularization architecture and implementation - Sylvain Henry: JavaScript backend RTS adjustments - Andrea Bedini: Build system integration This refactoring maintains full backward compatibility while providing a cleaner foundation for multi-target support.
1 parent 9a3f888 commit c16b25a

File tree

30 files changed

+1562
-480
lines changed

30 files changed

+1562
-480
lines changed

compiler/GHC/Driver/Main.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1299,7 +1299,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
12991299
-- when compiling gHC_PRIM without generating code (e.g. with
13001300
-- Haddock), we still want the virtual interface in the cache
13011301
if ms_mod summary == gHC_PRIM
1302-
then return $ HscUpdate (getGhcPrimIface hsc_env)
1302+
then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
13031303
else return $ HscUpdate iface
13041304

13051305

@@ -1314,7 +1314,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
13141314
-- when compiling gHC_PRIM without generating code (e.g. with
13151315
-- Haddock), we still want the virtual interface in the cache
13161316
if ms_mod summary == gHC_PRIM
1317-
then return $ HscUpdate (getGhcPrimIface hsc_env)
1317+
then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
13181318
else return $ HscUpdate iface
13191319

13201320
{-

compiler/GHC/Driver/Pipeline.hs

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,11 +44,14 @@ module GHC.Driver.Pipeline (
4444

4545

4646
import GHC.Prelude
47+
import GHC.Builtin.Names
4748

4849
import GHC.Platform
4950

5051
import GHC.Utils.Monad ( MonadIO(liftIO), mapMaybeM )
5152

53+
import GHC.Builtin.Names
54+
5255
import GHC.Driver.Main
5356
import GHC.Driver.Env hiding ( Hsc )
5457
import GHC.Driver.Errors
@@ -91,6 +94,7 @@ import GHC.Data.StringBuffer ( hPutStringBuffer )
9194
import GHC.Data.Maybe ( expectJust )
9295

9396
import GHC.Iface.Make ( mkFullIface )
97+
import GHC.Iface.Load ( getGhcPrimIface )
9498
import GHC.Runtime.Loader ( initializePlugins )
9599

96100

@@ -819,7 +823,13 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do
819823
let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject))
820824
-- Add the object linkable to the potential bytecode linkable which was generated in HscBackend.
821825
return (mlinkable { homeMod_object = Just linkable })
822-
return (miface, final_linkable)
826+
827+
-- when building ghc-internal with --make (e.g. with cabal-install), we want
828+
-- the virtual interface for gHC_PRIM in the cache, not the empty one.
829+
let miface_final
830+
| ms_mod mod_sum == gHC_PRIM = getGhcPrimIface (hsc_hooks hsc_env)
831+
| otherwise = miface
832+
return (miface_final, final_linkable)
823833

824834
asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
825835
asPipeline use_cpp pipe_env hsc_env location input_fn =

compiler/GHC/Runtime/Heap/Layout.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -438,8 +438,8 @@ cardTableSizeW platform elems =
438438
-----------------------------------------------------------------------------
439439
-- deriving the RTS closure type from an SMRep
440440

441-
#include "ClosureTypes.h"
442-
#include "FunTypes.h"
441+
#include "rts/storage/ClosureTypes.h"
442+
#include "rts/storage/FunTypes.h"
443443
-- Defines CONSTR, CONSTR_1_0 etc
444444

445445
-- | Derives the RTS closure type from an 'SMRep'

compiler/GHC/StgToCmm/Layout.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -549,7 +549,7 @@ mkVirtConstrSizes profile field_reps
549549
-------------------------------------------------------------------------
550550

551551
-- bring in ARG_P, ARG_N, etc.
552-
#include "FunTypes.h"
552+
#include "rts/storage/FunTypes.h"
553553

554554
mkArgDescr :: Platform -> [Id] -> ArgDescr
555555
mkArgDescr platform args

compiler/GHC/StgToCmm/TagCheck.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module GHC.StgToCmm.TagCheck
1212
( emitTagAssertion, emitArgTagCheck, checkArg, whenCheckTags,
1313
checkArgStatic, checkFunctionArgTags,checkConArgsStatic,checkConArgsDyn) where
1414

15-
#include "ClosureTypes.h"
15+
#include "rts/storage/ClosureTypes.h"
1616

1717
import GHC.Prelude
1818

rts-fs/README

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
This "fs" library, used by various ghc utilities is used to share some common
2+
I/O filesystem functions with different packages.

0 commit comments

Comments
 (0)