[Git][ghc/ghc][wip/decode_cloned_stack] Let ghc-heap depend on the current GHC / RTS version

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Thu Apr 20 06:42:45 UTC 2023



Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC


Commits:
87f9b668 by Sven Tennie at 2023-04-20T06:41:12+00:00
Let ghc-heap depend on the current GHC / RTS version

It strongly depends on the structures in the RTS. Being compatible to
other GHC versions introduces a lot of preprocessor special-case macros.

- - - - -


12 changed files:

- compiler/ghc.cabal.in
- hadrian/src/Packages.hs
- hadrian/src/Settings/Default.hs
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc
- libraries/ghc-heap/GHC/Exts/Stack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghci/ghci.cabal.in


Changes:

=====================================
compiler/ghc.cabal.in
=====================================
@@ -87,7 +87,8 @@ Library
                    exceptions == 0.10.*,
                    stm,
                    ghc-boot   == @ProjectVersionMunged@,
-                   ghc-heap   == @ProjectVersionMunged@,
+                   -- in-tree used for Stage >= 1, pre-built for Stage0
+                   ghc-heap,
                    ghci == @ProjectVersionMunged@
 
     if os(windows)


=====================================
hadrian/src/Packages.hs
=====================================
@@ -53,13 +53,20 @@ isGhcPackage = (`elem` ghcPackages)
 array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps,
   compareSizes, compiler, containers, deepseq, deriveConstants, directory,
   exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
-  ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
+  ghcCompact, ghcConfig, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
   hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
   parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
   terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
   timeout,
   lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
     :: Package
+
+-- | `Package` of the @ghc-heap@ library
+--
+-- N.B.: As it strongly depends on structures of the RTS, needs to be built with
+-- the GHC version to be built (>= @Stage1@)
+ghcHeap:: Package
+
 array               = lib  "array"
 base                = lib  "base"
 binary              = lib  "binary"


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -77,7 +77,6 @@ stage0Packages = do
              , cabalSyntax
              , cabal
              , compiler
-             , containers
              , directory
              , process
              , exceptions
@@ -86,7 +85,6 @@ stage0Packages = do
              , runGhc
              , ghcBoot
              , ghcBootTh
-             , ghcHeap
              , ghci
              , ghcPkg
              , haddock
@@ -132,6 +130,7 @@ stage1Packages = do
         , deepseq
         , exceptions
         , ghc
+        , ghcHeap
         , ghcBignum
         , ghcCompact
         , ghcPkg


=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -88,18 +88,10 @@ class HasHeapRep (a :: TYPE rep) where
         -> IO Closure
         -- ^ Heap representation of the closure.
 
-#if __GLASGOW_HASKELL__ >= 901
 instance HasHeapRep (a :: TYPE ('BoxedRep 'Lifted)) where
-#else
-instance HasHeapRep (a :: TYPE 'LiftedRep) where
-#endif
     getClosureData = getClosureDataFromHeapObject
 
-#if __GLASGOW_HASKELL__ >= 901
 instance HasHeapRep (a :: TYPE ('BoxedRep 'Unlifted)) where
-#else
-instance HasHeapRep (a :: TYPE 'UnliftedRep) where
-#endif
     getClosureData x = getClosureDataFromHeapObject (unsafeCoerce# x)
 
 instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where
@@ -369,9 +361,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do
                                 { info = itbl
                                 , stack_size = FFIClosures.stack_size fields
                                 , stack_dirty = FFIClosures.stack_dirty fields
-#if __GLASGOW_HASKELL__ >= 811
                                 , stack_marking = FFIClosures.stack_marking fields
-#endif
                                 })
             | otherwise
                 -> fail $ "Expected 0 ptr argument to STACK, found "


=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -302,9 +302,7 @@ data GenClosure b
       { info            :: !StgInfoTable
       , stack_size      :: !Word32 -- ^ stack size in *words*
       , stack_dirty     :: !Word8 -- ^ non-zero => dirty
-#if __GLASGOW_HASKELL__ >= 811
       , stack_marking   :: !Word8
-#endif
       }
 
     ------------------------------------------------------------


=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE MagicHash #-}
 
 module GHC.Exts.Heap.FFIClosures_ProfilingEnabled where
@@ -99,9 +98,7 @@ unset bitMask w = w `xor` bitMask
 data StackFields = StackFields {
     stack_size :: Word32,
     stack_dirty :: Word8,
-#if __GLASGOW_HASKELL__ >= 811
     stack_marking :: Word8,
-#endif
     stack_sp :: Addr##
 }
 
@@ -110,9 +107,7 @@ peekStackFields :: Ptr a -> IO StackFields
 peekStackFields ptr = do
     stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32
     dirty' <- (#peek struct StgStack_, dirty) ptr
-#if __GLASGOW_HASKELL__ >= 811
     marking' <- (#peek struct StgStack_, marking) ptr
-#endif
     Ptr sp' <- (#peek struct StgStack_, sp) ptr
 
     -- TODO decode the stack.
@@ -120,8 +115,6 @@ peekStackFields ptr = do
     return StackFields {
         stack_size = stack_size',
         stack_dirty = dirty',
-#if __GLASGOW_HASKELL__ >= 811
         stack_marking = marking',
-#endif
         stack_sp = sp'
     }


=====================================
libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc
=====================================
@@ -6,10 +6,6 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled(
     , peekTopCCS
 ) where
 
-#if __GLASGOW_HASKELL__ >= 811
-
--- See [hsc and CPP workaround]
-
 #define PROFILING
 
 #include "Rts.h"
@@ -158,16 +154,3 @@ peekIndexTable loopBreakers costCenterCacheRef ptr = do
 -- | casts a @Ptr@ to an @Int@
 ptrToInt :: Ptr a -> Int
 ptrToInt (Ptr a##) = I## (addr2Int## a##)
-
-#else
-import Prelude
-import Foreign
-
-import GHC.Exts.Heap.ProfInfo.Types
-
-peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo)
-peekStgTSOProfInfo _ _ = return Nothing
-
-peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack)
-peekTopCCS _ = return Nothing
-#endif


=====================================
libraries/ghc-heap/GHC/Exts/Stack.hs
=====================================
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-#if MIN_TOOL_VERSION_ghc(9,7,0)
 {-# LANGUAGE RecordWildCards #-}
 
 module GHC.Exts.Stack
@@ -28,7 +26,3 @@ stackFrameSize (RetBCO {..}) = sizeStgClosure + 1 + length bcoArgs
 -- The one additional word is a pointer to the next stack chunk
 stackFrameSize (UnderflowFrame {}) = sizeStgClosure + 1
 stackFrameSize _ = error "Unexpected stack frame type"
-
-#else
-module GHC.Exts.Stack where
-#endif


=====================================
libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc
=====================================
@@ -1,10 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module GHC.Exts.Stack.Constants where
 
-#if MIN_TOOL_VERSION_ghc(9,7,0)
-
 import           Prelude
 
 #include "Rts.h"
@@ -126,5 +123,3 @@ bytesToWords b =
 
 bytesInWord :: Int
 bytesInWord = (#const SIZEOF_VOID_P)
-
-#endif


=====================================
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
=====================================
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-#if MIN_TOOL_VERSION_ghc(9,7,0)
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -458,7 +456,3 @@ decodeStack (StackSnapshot stack#) = do
         go :: Maybe StackFrameLocation -> [StackFrameLocation]
         go Nothing = []
         go (Just r) = r : go (advanceStackFrameLocation r)
-
-#else
-module GHC.Exts.Stack.Decode where
-#endif


=====================================
libraries/ghc-heap/ghc-heap.cabal.in
=====================================
@@ -12,7 +12,7 @@ description:
     and retrieving information about those data structures.
 
 build-type:     Simple
-tested-with:    GHC==7.11
+tested-with:    GHC==@ProjectVersionMunged@
 
 source-repository head
   type:     git


=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -80,7 +80,8 @@ library
         deepseq          == 1.4.*,
         filepath         == 1.4.*,
         ghc-boot         == @ProjectVersionMunged@,
-        ghc-heap         == @ProjectVersionMunged@,
+        -- in-tree used for Stage >= 1, pre-built for Stage0
+        ghc-heap,
         template-haskell == 2.20.*,
         transformers     >= 0.5 && < 0.7
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87f9b66867832399e4fd18459d617f2fc7c493e2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87f9b66867832399e4fd18459d617f2fc7c493e2
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230420/cbcfc36b/attachment-0001.html>


More information about the ghc-commits mailing list