Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

29 changed files:

Changes:

  • .gitlab/issue_templates/default.md
    ... ... @@ -20,5 +20,5 @@ Optional:
    20 20 
     * System Architecture:
    21 21
    22 22
    23 
    -/label ~bug
    23 
    +/label ~"T::bug"
    24 24 
     /label ~"needs triage"

  • compiler/GHC/ByteCode/Serialize.hs
    ... ... @@ -25,22 +25,26 @@ where
    25 25 
     import GHC.Prelude
    26 26
    27 27 
     import GHC.ByteCode.Binary
    28 
    -import GHC.ByteCode.Types
    29 28 
     import GHC.ByteCode.Recomp.Binary (computeFingerprint)
    30 
    -import GHC.Driver.Env
    29 
    +import GHC.ByteCode.Types
    31 30 
     import GHC.Driver.DynFlags
    31 
    +import GHC.Driver.Env
    32 32 
     import GHC.Iface.Binary
    33 33 
     import GHC.Iface.Recomp.Binary (putNameLiterally)
    34 34 
     import GHC.Linker.Types
    35 
    +import GHC.Settings.Constants (hiVersion)
    35 36 
     import GHC.Unit.Types
    36 37 
     import GHC.Utils.Binary
    37 
    -import GHC.Utils.TmpFs
    38 
    -import GHC.Utils.Logger
    39 38 
     import GHC.Utils.Fingerprint (Fingerprint)
    39 
    +import GHC.Utils.Logger
    40 
    +import GHC.Utils.Panic
    41 
    +import GHC.Utils.TmpFs
    40 42
    41 43 
     import Data.ByteString (ByteString)
    42 
    -import qualified Data.ByteString as BS
    44 
    +import Data.ByteString qualified as BS
    45 
    +import Data.Char (ord)
    43 46 
     import Data.Traversable
    47 
    +import Data.Word
    44 48 
     import System.Directory
    45 49 
     import System.FilePath
    46 50
    ... ... @@ -79,21 +83,35 @@ The ticket where bytecode objects were dicussed is #26298
    79 83
    80 84 
     See Note [-fwrite-byte-code is not the default]
    81 85 
     See Note [Recompilation avoidance with bytecode objects]
    86 
    +See Note [Persistent bytecode file headers]
    82 87
    88 
    +Note [Persistent bytecode file headers]
    89 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    90 
    +Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`)
    91 
    +are version-specific binary formats. Without a small file-level header, stale
    92 
    +or corrupt files are only discovered once we start deserialising the payload,
    93 
    +which can lead to confusing failures.
    94 
    +
    95 
    +To make these failures explicit, we write a file-kind-specific magic word and
    96 
    +the current `hiVersion` ahead of the binary payload. Readers validate this
    97 
    +header before setting up the normal `Name`/`FastString` deserialisation
    98 
    +machinery. This follows the same approach as normal interface files.
    83 99 
     -}
    84 100
    85 101 
     writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()
    86 102 
     writeBytecodeLib lib path = do
    87 103 
       odbco <- encodeBytecodeLib lib
    88 104 
       createDirectoryIfMissing True (takeDirectory path)
    89 
    -  bh' <- openBinMem (1024 * 1024)
    105 
    +  bh' <- openBinMem initBinMemSize
    90 106 
       bh <- addBinNameWriter bh'
    107 
    +  writePersistentBytecodeHeader BytecodeLibraryFile bh
    91 108 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    92 109 
       writeBinMem bh path
    93 110
    94 111 
     readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
    95 112 
     readBytecodeLib hsc_env path = do
    96 113 
       bh' <- readBinMem path
    114 
    +  readPersistentBytecodeHeader BytecodeLibraryFile path bh'
    97 115 
       bh <- addBinNameReader (hsc_NC hsc_env) bh'
    98 116 
       res <- getWithUserData (hsc_NC hsc_env) bh
    99 117 
       pure res
    ... ... @@ -185,6 +203,7 @@ readBinByteCode hsc_env f = do
    185 203 
     readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
    186 204 
     readOnDiskModuleByteCode hsc_env f = do
    187 205 
       bh' <- readBinMem f
    206 
    +  readPersistentBytecodeHeader ModuleByteCodeFile f bh'
    188 207 
       bh <- addBinNameReader (hsc_NC hsc_env) bh'
    189 208 
       getWithUserData (hsc_NC hsc_env) bh
    190 209
    ... ... @@ -192,9 +211,10 @@ readOnDiskModuleByteCode hsc_env f = do
    192 211 
     writeBinByteCode :: FilePath -> ModuleByteCode -> IO ()
    193 212 
     writeBinByteCode f cbc = do
    194 213 
       createDirectoryIfMissing True (takeDirectory f)
    195 
    -  bh' <- openBinMem (1024 * 1024)
    214 
    +  bh' <- openBinMem initBinMemSize
    196 215 
       bh <- addBinNameWriter bh'
    197 216 
       odbco <- encodeOnDiskModuleByteCode cbc
    217 
    +  writePersistentBytecodeHeader ModuleByteCodeFile bh
    198 218 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    199 219 
       writeBinMem bh f
    200 220
    ... ... @@ -213,3 +233,64 @@ fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] ->
    213 233 
     fingerprintModuleByteCodeContents modl cbc foreign_files = do
    214 234 
       foreign_contents <- readObjectFiles foreign_files
    215 235 
       pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents)
    236 
    +
    237 
    +-- ----------------------------------------------------------------------------
    238 
    +-- ByteCode module and library magic header.
    239 
    +-- ----------------------------------------------------------------------------
    240 
    +
    241 
    +data PersistentBytecodeFile
    242 
    +  = ModuleByteCodeFile
    243 
    +  | BytecodeLibraryFile
    244 
    +
    245 
    +-- See Note [Persistent bytecode file headers]
    246 
    +writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO ()
    247 
    +writePersistentBytecodeHeader file_kind bh = do
    248 
    +  put_ bh (persistentBytecodeMagic file_kind)
    249 
    +  put_ bh (show hiVersion)
    250 
    +
    251 
    +readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO ()
    252 
    +readPersistentBytecodeHeader file_kind path bh = do
    253 
    +  let mismatch what expected actual =
    254 
    +        throwGhcExceptionIO $ ProgramError $
    255 
    +          persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++
    256 
    +          ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")"
    257 
    +
    258 
    +  magic <- get bh
    259 
    +  let expected_magic = persistentBytecodeMagic file_kind
    260 
    +  if unFixedLength magic == unFixedLength expected_magic
    261 
    +    then pure ()
    262 
    +    else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic)
    263 
    +
    264 
    +  version <- get bh
    265 
    +  let expected_version = show hiVersion
    266 
    +  if version == expected_version
    267 
    +    then pure ()
    268 
    +    else mismatch "version" expected_version version
    269 
    +
    270 
    +persistentBytecodeFileDescription :: PersistentBytecodeFile -> String
    271 
    +persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file"
    272 
    +persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library"
    273 
    +
    274 
    +persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32
    275 
    +persistentBytecodeMagic file_kind =
    276 
    +  case file_kind of
    277 
    +    ModuleByteCodeFile -> asciiWord32 "gbc0"
    278 
    +    BytecodeLibraryFile -> asciiWord32 "bcl0"
    279 
    +
    280 
    +-- | Encode a 4-letter word into a single Word32.
    281 
    +asciiWord32 :: String -> FixedLengthEncoding Word32
    282 
    +asciiWord32 [a, b, c, d] =
    283 
    +  FixedLengthEncoding $
    284 
    +    (fromIntegral (ord a) `shiftL` 24) .|.
    285 
    +    (fromIntegral (ord b) `shiftL` 16) .|.
    286 
    +    (fromIntegral (ord c) `shiftL` 8)  .|.
    287 
    +    fromIntegral (ord d)
    288 
    +asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters"
    289 
    +
    290 
    +-- ----------------------------------------------------------------------------
    291 
    +-- Constants and utils
    292 
    +-- ----------------------------------------------------------------------------
    293 
    +
    294 
    +-- | Initial ram buffer to allocate for writing .gbc and .bytecodelib files.
    295 
    +initBinMemSize :: Int
    296 
    +initBinMemSize = 1024 * 1024 -- 1 MB

  • compiler/GHC/Driver/Phases.hs
    ... ... @@ -262,7 +262,7 @@ objish_suffixes :: Platform -> [String]
    262 262 
     -- the GHC-compiled code will run
    263 263 
     objish_suffixes platform = case platformOS platform of
    264 264 
       OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
    265 
    -  _         -> [ "o" ]
    265 
    +  _         -> [ "o", "dyn_o"]
    266 266
    267 267 
     dynlib_suffixes :: Platform -> [String]
    268 268 
     dynlib_suffixes platform = case platformOS platform of

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -402,7 +402,7 @@ loadCmdLineLibs' interp hsc_env pls = snd <$>
    402 402 
           let hsc' = hscSetActiveUnitId uid hsc_env
    403 403 
           -- Load potential dependencies first
    404 404 
           (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls)
    405 
    -                          (homeUnitDepends (hsc_units hsc'))
    405 
    +                          (Set.toList (homeUnitDepends (hsc_units hsc')))
    406 406 
           pls'' <- loadCmdLineLibs'' interp hsc' pls'
    407 407 
           return $ (Set.insert uid done', pls'')
    408 408

  • compiler/GHC/Rename/Names.hs
    ... ... @@ -467,11 +467,14 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of
    467 467 
            -- not really correct as pkg_fs is unlikely to be a valid unit-id but
    468 468 
            -- we will report the failure later...
    469 469 
       where
    470 
    -    home_names  = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps
    470 
    +    home_names =
    471 
    +      [ (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))
    472 
    +      | uid <- S.toList hpt_deps
    473 
    +      ]
    471 474
    472 475 
         unit_state = ue_homeUnitState unit_env
    473 476
    474 
    -    hpt_deps :: [UnitId]
    477 
    +    hpt_deps :: S.Set UnitId
    475 478 
         hpt_deps  = homeUnitDepends unit_state
    476 479
    477 480

  • compiler/GHC/StgToCmm/Heap.hs
    1 
    +{-# LANGUAGE OverloadedStrings #-}
    1 2 
     -----------------------------------------------------------------------------
    2 3 
     --
    3 4 
     -- Stg to C--: heap management functions
    ... ... @@ -44,7 +45,7 @@ import GHC.Types.Id ( Id )
    44 45 
     import GHC.Unit
    45 46 
     import GHC.Platform
    46 47 
     import GHC.Platform.Profile
    47 
    -import GHC.Data.FastString( mkFastString, fsLit )
    48 
    +import GHC.Data.FastString( FastString )
    48 49 
     import GHC.Utils.Panic( sorry )
    49 50
    50 51 
     import Control.Monad (when)
    ... ... @@ -125,7 +126,7 @@ allocHeapClosure rep info_ptr use_cc payload = do
    125 126 
                 -- ie 1 *before* the info-ptr word of new object.
    126 127
    127 128 
       base <- getHpRelOffset info_offset
    128 
    -  emitComment $ mkFastString "allocHeapClosure"
    129 
    +  emitComment "allocHeapClosure"
    129 130 
       emitSetDynHdr base info_ptr use_cc
    130 131
    131 132 
       -- Fill in the fields
    ... ... @@ -460,35 +461,41 @@ genericGC checkYield code
    460 461 
            call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []
    461 462 
            heapCheck False checkYield (call <*> mkBranch lretry) code
    462 463
    464 
    +-- | Predefined ("canned") GC functions
    465 
    +--
    466 
    +-- Functions have been added to cover 99% of the GC calls made in GHC and Cabal.
    467 
    +-- See #27142.
    463 468 
     cannedGCEntryPoint :: Platform -> [LocalReg] -> Maybe CmmExpr
    464 
    -cannedGCEntryPoint platform regs
    465 
    -  = case map localRegType regs of
    466 
    -      []  -> Just (mkGcLabel "stg_gc_noregs")
    467 
    -      [ty]
    468 
    -          | isGcPtrType ty -> Just (mkGcLabel "stg_gc_unpt_r1")
    469 
    -          | isFloatType ty -> case width of
    470 
    -                                  W32       -> Just (mkGcLabel "stg_gc_f1")
    471 
    -                                  W64       -> Just (mkGcLabel "stg_gc_d1")
    472 
    -                                  _         -> Nothing
    473 
    -
    474 
    -          | width == wordWidth platform -> Just (mkGcLabel "stg_gc_unbx_r1")
    475 
    -          | width == W64                -> Just (mkGcLabel "stg_gc_l1")
    476 
    -          | otherwise                   -> Nothing
    477 
    -          where
    478 
    -              width = typeWidth ty
    479 
    -      [ty1,ty2]
    480 
    -          |  isGcPtrType ty1
    481 
    -          && isGcPtrType ty2 -> Just (mkGcLabel "stg_gc_pp")
    482 
    -      [ty1,ty2,ty3]
    483 
    -          |  isGcPtrType ty1
    484 
    -          && isGcPtrType ty2
    485 
    -          && isGcPtrType ty3 -> Just (mkGcLabel "stg_gc_ppp")
    486 
    -      [ty1,ty2,ty3,ty4]
    487 
    -          |  isGcPtrType ty1
    488 
    -          && isGcPtrType ty2
    489 
    -          && isGcPtrType ty3
    490 
    -          && isGcPtrType ty4 -> Just (mkGcLabel "stg_gc_pppp")
    491 
    -      _otherwise -> Nothing
    469 
    +cannedGCEntryPoint platform regs =
    470 
    +  case map localRegType regs of
    471 
    +    []   -> ret "stg_gc_noregs"
    472 
    +    [ty]
    473 
    +        | is_gc  ty -> ret "stg_gc_unpt_r1"
    474 
    +        | is_f32 ty -> ret "stg_gc_f1"
    475 
    +        | is_f64 ty -> ret "stg_gc_d1"
    476 
    +        | is_wn ty  -> ret "stg_gc_unbx_r1"
    477 
    +        | is_w64 ty -> ret "stg_gc_l1"
    478 
    +    [ty1,ty2]
    479 
    +        | is_gc ty1 && is_gc ty2 -> ret "stg_gc_pp"
    480 
    +        | is_gc ty1 && is_wn ty2 -> ret "stg_gc_pi"
    481 
    +        | is_wn ty1 && is_gc ty2 -> ret "stg_gc_ip"
    482 
    +        | is_wn ty1 && is_wn ty2 -> ret "stg_gc_ii"
    483 
    +    [ty1,ty2,ty3]
    484 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_ppp"
    485 
    +        | is_w8 ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_bpp"
    486 
    +    [ty1,ty2,ty3,ty4]
    487 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 -> ret "stg_gc_pppp"
    488 
    +    [ty1,ty2,ty3,ty4,ty5]
    489 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 && is_gc ty5 -> ret "stg_gc_ppppp"
    490 
    +    _ -> Nothing
    491 
    +  where
    492 
    +    ret fs = Just (mkGcLabel fs)
    493 
    +    is_gc  ty = isGcPtrType ty
    494 
    +    is_wn  ty = isBitsType ty && typeWidth ty == wordWidth platform
    495 
    +    is_w8  ty = isBitsType ty && typeWidth ty == W8
    496 
    +    is_w64 ty = isBitsType ty && typeWidth ty == W64
    497 
    +    is_f32 ty = isFloatType ty && typeWidth ty == W32
    498 
    +    is_f64 ty = isFloatType ty && typeWidth ty == W64
    492 499
    493 500 
     -- Note [stg_gc arguments]
    494 501 
     -- ~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -514,8 +521,8 @@ generic_gc :: CmmExpr
    514 521 
     generic_gc = mkGcLabel "stg_gc_noregs"
    515 522
    516 523 
     -- | Create a CLabel for calling a garbage collector entry point
    517 
    -mkGcLabel :: String -> CmmExpr
    518 
    -mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))
    524 
    +mkGcLabel :: FastString -> CmmExpr
    525 
    +mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId s))
    519 526
    520 527 
     -------------------------------
    521 528 
     heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a

  • compiler/GHC/Unit/Finder.hs
    ... ... @@ -72,6 +72,7 @@ import GHC.Driver.Config.Finder
    72 72 
     import GHC.Types.Unique.Set
    73 73 
     import qualified Data.List as L(sort)
    74 74 
     import Data.List.NonEmpty ( NonEmpty (..) )
    75 
    +import qualified Data.Set as Set (toList)
    75 76 
     import qualified System.Directory as SD
    76 77 
     import qualified System.OsPath as OsPath
    77 78 
     import qualified Data.List.NonEmpty as NE
    ... ... @@ -241,7 +242,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
    241 242 
                       Nothing -> ue_homeUnitState ue
    242 243 
                       Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
    243 244 
         hpt_deps :: [UnitId]
    244 
    -    hpt_deps  = homeUnitDepends units
    245 
    +    hpt_deps  = Set.toList (homeUnitDepends units)
    245 246 
         other_fopts  = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps
    246 247
    247 248 
     -- | Locate a plugin module requested by the user, for a compiler

  • compiler/GHC/Unit/Home/Graph.hs
    ... ... @@ -229,15 +229,18 @@ updateUnitFlags uid f = unitEnv_adjust update uid
    229 229 
     -- If the argument unit is not present in the graph returns Nothing.
    230 230 
     transitiveHomeDeps :: UnitId -> HomeUnitGraph -> Maybe [UnitId]
    231 231 
     transitiveHomeDeps uid hug = case lookupHugUnitId uid hug of
    232 
    -  Nothing -> Nothing
    232 
    +  Nothing  -> Nothing
    233 233 
       Just hue -> Just $
    234 
    -    Set.toList (loop (Set.singleton uid) (homeUnitDepends (homeUnitEnv_units hue)))
    234 
    +              Set.toList $
    235 
    +              loop (Set.singleton uid)
    236 
    +                   (Set.toList (homeUnitDepends (homeUnitEnv_units hue)))
    235 237 
         where
    236 238 
           loop acc [] = acc
    237 239 
           loop acc (uid:uids)
    238 240 
             | uid `Set.member` acc = loop acc uids
    239 241 
             | otherwise =
    240 
    -          let hue = homeUnitDepends
    242 
    +          let hue = Set.toList
    243 
    +                    . homeUnitDepends
    241 244 
                         . homeUnitEnv_units
    242 245 
                         . expectJust
    243 246 
                         $ lookupHugUnitId uid hug
    ... ... @@ -359,7 +362,11 @@ unitEnv_assocs (UnitEnvGraph x) = Map.assocs x
    359 362 
     hugSCCs :: HomeUnitGraph -> [SCC UnitId]
    360 363 
     hugSCCs hug = sccs where
    361 364 
       mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
    362 
    -  mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
    365 
    +  mkNode (uid, hue) = DigraphNode
    366 
    +                          uid
    367 
    +                          uid
    368 
    +                          (Set.toList (homeUnitDepends (homeUnitEnv_units hue)))
    369 
    +
    363 370 
       nodes = map mkNode (Map.toList $ unitEnv_graph hug)
    364 371
    365 372 
       sccs = stronglyConnCompFromEdgedVerticesOrd nodes

  • compiler/GHC/Unit/State.hs
    ... ... @@ -459,7 +459,7 @@ data UnitState = UnitState {
    459 459 
       -- -Wunused-packages warning.
    460 460 
       explicitUnits :: [(Unit, Maybe PackageArg)],
    461 461
    462 
    -  homeUnitDepends    :: [UnitId],
    462 
    +  homeUnitDepends    :: Set UnitId,
    463 463
    464 464 
       -- | This is a full map from 'ModuleName' to all modules which may possibly
    465 465 
       -- be providing it.  These providers may be hidden (but we'll still want
    ... ... @@ -494,7 +494,7 @@ emptyUnitState = UnitState {
    494 494 
         unwireMap      = emptyUniqMap,
    495 495 
         preloadUnits   = [],
    496 496 
         explicitUnits  = [],
    497 
    -    homeUnitDepends = [],
    497 
    +    homeUnitDepends = Set.empty,
    498 498 
         moduleNameProvidersMap       = emptyUniqMap,
    499 499 
         pluginModuleNameProvidersMap = emptyUniqMap,
    500 500 
         requirementContext           = emptyUniqMap,
    ... ... @@ -1718,7 +1718,7 @@ mkUnitState logger cfg = do
    1718 1718 
       let !state = UnitState
    1719 1719 
              { preloadUnits                 = dep_preload
    1720 1720 
              , explicitUnits                = explicit_pkgs
    1721 
    -         , homeUnitDepends              = Set.toList home_unit_deps
    1721 
    +         , homeUnitDepends              = home_unit_deps
    1722 1722 
              , unitInfoMap                  = pkg_db
    1723 1723 
              , preloadClosure               = emptyUniqSet
    1724 1724 
              , moduleNameProvidersMap       = mod_map

  • rts/HeapStackCheck.cmm
    ... ... @@ -373,8 +373,6 @@ stg_gc_l1 return (L_ l)
    373 373 
         jump stg_gc_noregs (stg_ret_l_info, l) ();
    374 374 
     }
    375 375
    376 
    -/*-- Unboxed tuples with multiple pointers -------------------------------- */
    377 
    -
    378 376 
     stg_gc_pp return (P_ arg1, P_ arg2)
    379 377 
     {
    380 378 
         call stg_gc_noregs();
    ... ... @@ -393,6 +391,36 @@ stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
    393 391 
         return (arg1,arg2,arg3,arg4);
    394 392 
     }
    395 393
    394 
    +stg_gc_ppppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4, P_ arg5)
    395 
    +{
    396 
    +    call stg_gc_noregs();
    397 
    +    return (arg1,arg2,arg3,arg4,arg5);
    398 
    +}
    399 
    +
    400 
    +stg_gc_ip return (W_ arg1, P_ arg2)
    401 
    +{
    402 
    +    call stg_gc_noregs();
    403 
    +    return (arg1,arg2);
    404 
    +}
    405 
    +
    406 
    +stg_gc_pi return (P_ arg1, W_ arg2)
    407 
    +{
    408 
    +    call stg_gc_noregs();
    409 
    +    return (arg1,arg2);
    410 
    +}
    411 
    +
    412 
    +stg_gc_ii return (W_ arg1, W_ arg2)
    413 
    +{
    414 
    +    call stg_gc_noregs();
    415 
    +    return (arg1,arg2);
    416 
    +}
    417 
    +
    418 
    +stg_gc_bpp return (I8 arg1, P_ arg2, P_ arg3)
    419 
    +{
    420 
    +    call stg_gc_noregs();
    421 
    +    return (arg1,arg2,arg3);
    422 
    +}
    423 
    +
    396 424 
     /* -----------------------------------------------------------------------------
    397 425 
        Generic function entry heap check code.
    398 426

  • rts/RtsSymbols.c
    ... ... @@ -499,6 +499,11 @@ extern char **environ;
    499 499 
           SymI_HasDataProto(stg_gc_pp)                                          \
    500 500 
           SymI_HasDataProto(stg_gc_ppp)                                         \
    501 501 
           SymI_HasDataProto(stg_gc_pppp)                                        \
    502 
    +      SymI_HasDataProto(stg_gc_ppppp)                                       \
    503 
    +      SymI_HasDataProto(stg_gc_ip)                                          \
    504 
    +      SymI_HasDataProto(stg_gc_pi)                                          \
    505 
    +      SymI_HasDataProto(stg_gc_ii)                                          \
    506 
    +      SymI_HasDataProto(stg_gc_bpp)                                         \
    502 507 
           SymI_HasDataProto(__stg_gc_fun)                                       \
    503 508 
           SymI_HasDataProto(stg_gc_fun_info)                                    \
    504 509 
           SymI_HasDataProto(stg_yield_noregs)                                   \

  • rts/include/stg/MiscClosures.h
    ... ... @@ -361,6 +361,11 @@ RTS_FUN_DECL(stg_gc_l1);
    361 361 
     RTS_FUN_DECL(stg_gc_pp);
    362 362 
     RTS_FUN_DECL(stg_gc_ppp);
    363 363 
     RTS_FUN_DECL(stg_gc_pppp);
    364 
    +RTS_FUN_DECL(stg_gc_ppppp);
    365 
    +RTS_FUN_DECL(stg_gc_ip);
    366 
    +RTS_FUN_DECL(stg_gc_pi);
    367 
    +RTS_FUN_DECL(stg_gc_ii);
    368 
    +RTS_FUN_DECL(stg_gc_bpp);
    364 369
    365 370 
     RTS_RET(stg_gc_fun);
    366 371 
     RTS_FUN_DECL(__stg_gc_fun);

  • testsuite/driver/testlib.py
    ... ... @@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str:
    3043 3043 
         # Old emcc warns when we export HEAP8 but new one requires it (see #26290)
    3044 3044 
         s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
    3045 3045
    3046 
    +    # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols,
    3047 
    +    # however, these are completely benign stubs.
    3048 
    +    # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116
    3049 
    +    if opsys('darwin'):
    3050 
    +        s = modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l))
    3051 
    +
    3046 3052 
         return s
    3047 3053
    3048 3054 
     # normalise a .prof file, so that we can reasonably compare it against

  • testsuite/tests/driver/all.T
    ... ... @@ -120,9 +120,7 @@ if config.os == 'darwin':
    120 120 
     else:
    121 121 
       only_darwin = skip
    122 122
    123 
    -test('static001', [extra_files(['Static001.hs']),
    124 
    -                   only_darwin,
    125 
    -                   when(arch('x86_64'), expect_broken(8127))],
    123 
    +test('static001', [extra_files(['Static001.hs']), only_darwin],
    126 124 
          makefile_test, ['static001'])
    127 125
    128 126 
     test('dynHelloWorld',

  • testsuite/tests/driver/bytecode-object/Makefile
    ... ... @@ -159,3 +159,9 @@ bytecode_object25:
    159 159 
     	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags)
    160 160 
     	"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths  -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign"
    161 161
    162 
    +# Test that corrupt bytecode file headers are rejected clearly.
    163 
    +bytecode_object26:
    164 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code
    165 
    +	@printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null
    166 
    +	! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr
    167 
    +	@grep -F "bytecode file header mismatch" bytecode_object26.stderr >/dev/null

  • testsuite/tests/driver/bytecode-object/all.T
    ... ... @@ -26,3 +26,4 @@ test('bytecode_object22', bytecode_opts, makefile_test, ['bytecode_object22'])
    26 26 
     test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23'])
    27 27 
     test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24'])
    28 28 
     test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25'])
    29 
    +test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26'])

  • testsuite/tests/plugins/Makefile
    ... ... @@ -238,3 +238,10 @@ test-late-plugin:
    238 238 
     .PHONY: T21730
    239 239 
     T21730:
    240 240 
     	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf
    241 
    +
    242 
    +# Test that .dyn_o files are accepted as valid object files on the command line
    243 
    +# without producing "ignoring unrecognised input" warnings (#24486)
    244 
    +.PHONY: T24486
    245 
    +T24486:
    246 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c T24486_Helper.hs -osuf dyn_o
    247 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T24486.hs T24486_Helper.dyn_o -package-db T24486-plugin/pkg.T24486-plugin/local.package.conf -fplugin T24486_Plugin -plugin-package T24486-plugin

  • testsuite/tests/plugins/T24486-plugin/Makefile
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +clean.%:
    6 
    +	rm -rf pkg.$*
    7 
    +
    8 
    +HERE := $(abspath .)
    9 
    +$(eval $(call canonicalise,HERE))
    10 
    +
    11 
    +package.%:
    12 
    +	$(MAKE) -s --no-print-directory clean.$*
    13 
    +	mkdir pkg.$*
    14 
    +	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
    15 
    +	"$(GHC_PKG)" init pkg.$*/local.package.conf
    16 
    +	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
    17 
    +	pkg.$*/setup build     --distdir pkg.$*/dist -v0
    18 
    +	pkg.$*/setup install   --distdir pkg.$*/dist -v0

  • testsuite/tests/plugins/T24486-plugin/Setup.hs
    1 
    +import Distribution.Simple
    2 
    +main = defaultMain

  • testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
    1 
    +Name:           T24486-plugin
    2 
    +Version:        0.1
    3 
    +Synopsis:       For testing
    4 
    +Cabal-Version:  >= 1.2
    5 
    +Build-Type:     Simple
    6 
    +
    7 
    +Library
    8 
    +    Build-Depends: base, ghc
    9 
    +    Exposed-Modules: T24486_Plugin

  • testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
    1 
    +module T24486_Plugin (plugin) where
    2 
    +
    3 
    +import GHC.Plugins
    4 
    +
    5 
    +plugin :: Plugin
    6 
    +plugin = defaultPlugin

  • testsuite/tests/plugins/T24486.hs
    1 
    +module Main where
    2 
    +
    3 
    +main :: IO ()
    4 
    +main = return ()

  • testsuite/tests/plugins/T24486_Helper.hs
    1 
    +module T24486_Helper where
    2 
    +
    3 
    +helper :: Int
    4 
    +helper = 42

  • testsuite/tests/plugins/all.T
    ... ... @@ -395,3 +395,10 @@ test('T21730',
    395 395 
           pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}')
    396 396 
           ],
    397 397 
          makefile_test, [])
    398 
    +
    399 
    +test('T24486',
    400 
    +     [extra_files(['T24486-plugin/', 'T24486_Helper.hs']),
    401 
    +      when(opsys('mingw32'), skip),
    402 
    +      pre_cmd('$MAKE -s --no-print-directory -C T24486-plugin package.T24486-plugin TOP={top}')
    403 
    +      ],
    404 
    +     makefile_test, [])

  • testsuite/tests/runghc/Makefile
    ... ... @@ -23,6 +23,11 @@ T11247:
    23 23 
     	-'$(RUNGHC)' foo.
    24 24 
     	-'$(RUNGHC)' foo.bar
    25 25
    26 
    +# runghc should honour -osuf for dependencies too (#16145).
    27 
    +T16145:
    28 
    +	'$(RUNGHC)' -- -fobject-code -osuf=hs.o T16145
    29 
    +	printf '%s\n' *.hi *.o *.hs | LC_ALL=C sort
    30 
    +
    26 31 
     T17171a:
    27 32 
     	'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
    28 33 
     T17171b:

  • testsuite/tests/runghc/T16145.hs
    1 
    +module T16145 where
    2 
    +
    3 
    +import T16145_aux
    4 
    +
    5 
    +main = g

  • testsuite/tests/runghc/T16145.stdout
    1 
    +T16145.hi
    2 
    +T16145.hs
    3 
    +T16145.hs.o
    4 
    +T16145_aux.hi
    5 
    +T16145_aux.hs
    6 
    +T16145_aux.hs.o

  • testsuite/tests/runghc/T16145_aux.hs
    1 
    +module T16145_aux where
    2 
    +
    3 
    +g :: IO ()
    4 
    +g = return ()

  • testsuite/tests/runghc/all.T
    ... ... @@ -4,6 +4,8 @@ test('T8601', req_interp, makefile_test, [])
    4 4
    5 5 
     test('T11247', [req_interp, expect_broken(11247)], makefile_test, [])
    6 6
    7 
    +test('T16145', req_interp, makefile_test, [])
    8 
    +
    7 9 
     test('T6132', [],
    8 10 
          compile, [''])
    9 11

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help