Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 91b6be10 by Julian Ospald at 2025-10-20T18:21:03-04:00 Improve error handling in 'getPackageArchives' When the library dirs in the package conf files are not set up correctly, the JS linker will happily ignore such packages and not link against them, although they're part of the link plan. Fixes #26383 - - - - - 6c5269da by Sven Tennie at 2025-10-20T18:21:44-04:00 Align coding style Improve readability by using the same style for all constructor calls in this function. - - - - - 3d305889 by Sven Tennie at 2025-10-20T18:21:44-04:00 Reduce complexity by removing joins with mempty ldArgs, cArgs and cppArgs are all `mempty`. Thus concatenating them adds nothing but some complexity while reading the code. - - - - - 38d65187 by Matthew Pickering at 2025-10-21T13:12:20+01:00 Fix stack decoding when using profiled runtime There are three fixes in this commit. * We need to replicate the `InfoTable` and `InfoTableProf` approach for the other stack constants (see the new Stack.ConstantsProf file). * Then we need to appropiately import the profiled or non-profiled versions. * Finally, there was an incorrect addition in `stackFrameSize`. We need to cast after performing addition on words. Fixes #26507 - - - - - 17231bfb by fendor at 2025-10-21T13:12:20+01:00 Add regression test for #26507 - - - - - ad88789e by Simon Peyton Jones at 2025-10-24T19:34:27-04:00 Postscript to fix for #26255 This MR has comments only - - - - - 16 changed files: - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Errors.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - libraries/ghc-internal/tests/stack-annotation/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | @@ -666,12 +667,19 @@ renderLinkerStats s = getPackageArchives :: StgToJSConfig -> UnitEnv -> [UnitId] -> IO [FilePath] -getPackageArchives cfg unit_env units = - filterM doesFileExist [ ST.unpack p "lib" ++ ST.unpack l ++ profSuff <.> "a" - | u <- units - , p <- getInstalledPackageLibDirs ue_state u - , l <- getInstalledPackageHsLibs ue_state u - ] +getPackageArchives cfg unit_env units = do + fmap concat $ forM units $ \u -> do + let archives = [ ST.unpack p "lib" ++ ST.unpack l ++ profSuff <.> "a" + | p <- getInstalledPackageLibDirs ue_state u + , l <- getInstalledPackageHsLibs ue_state u + ] + foundArchives <- filterM doesFileExist archives + if | not (null archives) + , null foundArchives + -> do + throwGhcExceptionIO (InstallationError $ "Could not find any library archives for unit-id: " <> (renderWithContext (csContext cfg) $ ppr u)) + | otherwise + -> pure foundArchives where ue_state = ue_homeUnitState unit_env ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -557,9 +557,9 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- if there's a *given* insoluble here (= inaccessible code) -- If there are no other errors to report, report suppressed errors. - -- See Note [Suppressing confusing errors]. NB: with -fdefer-type-errors - -- we might have reported warnings only from `reportable_items`, but we - -- still want to suppress the `suppressed_items`. + -- See (SCE3) in Note [Suppressing confusing errors]. + -- NB: with -fdefer-type-errors we might have reported warnings only from + -- reportable_items`, but we still want to suppress the `suppressed_items`. ; when (null reportable_items) $ do { (_, more_leftovers) <- tryReporters ctxt_for_insols (report1++report2) suppressed_items @@ -762,7 +762,7 @@ isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of Certain errors we might encounter are potentially confusing to users. If there are any other errors to report, at all, we want to suppress these. -Which errors are suppressed? +Which errors should be suppressed? (SCE1) Superclasses of Wanteds. These are generated only in case they trigger functional dependencies. If such a constraint is unsolved, then its "parent" constraint must @@ -777,9 +777,6 @@ Which errors are suppressed? We definitely want to report d1 and not d2! Happily it's easy to filter out those superclass-Wanteds, becuase their Origin betrays them. - See test T18851 for an example of how it is (just, barely) possible for the /only/ - errors to be superclass-of-Wanted constraints. - (SCE2) Errors which arise from the interaction of two Wanted fun-dep constraints. Example: @@ -810,9 +807,15 @@ Which errors are suppressed? Mechanism: -We use the `suppress` function within reportWanteds to filter out these two -cases, then report all other errors. Lastly, we return to these suppressed -ones and report them only if there have been no errors so far. +We use the `suppress` function within reportWanteds to filter out these +"suppress" cases, then report all other errors. After doing so, we return to these +suppressed ones and report them only if there have been no errors so far. + +(SCE3) How can it happen that there are /only/ suppressed errors? See test T18851 + for an example of how it is (just, barely) possible for the /only/ errors to + be superclass-of-Wanted constraints. + + Note [Constraints to ignore] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== hadrian/src/Rules/Gmp.hs ===================================== @@ -11,7 +11,7 @@ import Target import Utilities import Hadrian.BuildPath import Hadrian.Expression -import Settings.Builders.Common (cArgs, getStagedCCFlags) +import Settings.Builders.Common (getStagedCCFlags) -- | Build in-tree GMP library objects (if GmpInTree flag is set) and return -- their paths. @@ -125,8 +125,7 @@ gmpRules = do cFlags <- interpretInContext ctx $ mconcat - [ cArgs - , getStagedCCFlags + [ getStagedCCFlags -- gmp symbols are only used by bignum logic in -- ghc-internal and shouldn't be exported by the -- ghc-internal shared library. ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -130,17 +130,14 @@ fixLibffiMakefile top = configureEnvironment :: Stage -> Action [CmdOption] configureEnvironment stage = do context <- libffiContext stage - cFlags <- interpretInContext context $ mconcat - [ cArgs - , getStagedCCFlags ] - ldFlags <- interpretInContext context ldArgs + cFlags <- interpretInContext context getStagedCCFlags sequence [ builderEnvironment "CC" $ Cc CompileC stage , builderEnvironment "CXX" $ Cc CompileC stage - , builderEnvironment "AR" (Ar Unpack stage) + , builderEnvironment "AR" $ Ar Unpack stage , builderEnvironment "NM" Nm , builderEnvironment "RANLIB" Ranlib , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w" - , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ] + , return . AddEnv "LDFLAGS" $ "-w" ] -- Need the libffi archive and `trackAllow` all files in the build directory. -- See [Libffi indicating inputs]. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -188,18 +188,16 @@ configureArgs cFlags' ldFlags' = do values <- unwords <$> expr not (null values) ? arg ("--configure-option=" ++ key ++ "=" ++ values) - cFlags = mconcat [ remove ["-Werror"] cArgs - , getStagedCCFlags + cFlags = mconcat [ getStagedCCFlags -- See https://github.com/snowleopard/hadrian/issues/523 , arg $ "-iquote" , arg $ top -/- pkgPath pkg , cFlags' ] - ldFlags = ldArgs <> ldFlags' mconcat [ conf "CFLAGS" cFlags - , conf "LDFLAGS" ldFlags + , conf "LDFLAGS" ldFlags' , conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir , conf "--with-iconv-libraries" $ arg =<< getSetting IconvLibDir , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir ===================================== hadrian/src/Settings/Builders/Common.hs ===================================== @@ -5,7 +5,7 @@ module Settings.Builders.Common ( module Oracles.Setting, module Settings, module UserSettings, - cIncludeArgs, ldArgs, cArgs, cppArgs, cWarnings, + cIncludeArgs, cWarnings, packageDatabaseArgs, bootPackageDatabaseArgs, getStagedCCFlags, wayCcArgs ) where @@ -38,15 +38,6 @@ cIncludeArgs = do , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ] , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ] -ldArgs :: Args -ldArgs = mempty - -cArgs :: Args -cArgs = mempty - -cppArgs :: Args -cppArgs = mempty - -- TODO: should be in a different file cWarnings :: Args cWarnings = mconcat ===================================== hadrian/src/Settings/Builders/DeriveConstants.hs ===================================== @@ -40,8 +40,7 @@ includeCcArgs :: Args includeCcArgs = do stage <- getStage rtsPath <- expr $ rtsBuildPath stage - mconcat [ cArgs - , cWarnings + mconcat [ cWarnings , prgFlags . ccProgram . tgtCCompiler <$> expr (targetStage Stage1) , queryTargetTarget tgtUnregisterised ? arg "-DUSE_MINIINTERPRETER" , arg "-Irts" ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,7 @@ getCFlags = do autogen <- expr $ autogenPath context let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] - mconcat [ remove ["-O"] (cArgs <> getStagedCCFlags) + mconcat [ remove ["-O"] getStagedCCFlags -- Either "-E" is not part of the configured cpp args, or we can't add those args to invocations of things like this -- ROMES:TODO: , prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig , cIncludeArgs @@ -64,6 +64,5 @@ getCFlags = do getLFlags :: Expr [String] getLFlags = mconcat [ prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTarget - , ldArgs , getContextData ldOpts , getContextData depLdOpts ] ===================================== libraries/ghc-internal/cbits/Stack_c.c ===================================== @@ -9,13 +9,13 @@ #include "rts/storage/InfoTables.h" StgWord stackFrameSize(StgStack *stack, StgWord offset) { - StgClosure *c = (StgClosure *)stack->sp + offset; + StgClosure *c = (StgClosure *)(stack->sp + offset); ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); return stack_frame_sizeW(c); } StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) { - StgClosure *frame = (StgClosure *)stack->sp + offset; + StgClosure *frame = (StgClosure *)(stack->sp + offset); ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame)); const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame); ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -300,6 +300,7 @@ Library GHC.Internal.Stack.CCS GHC.Internal.Stack.CloneStack GHC.Internal.Stack.Constants + GHC.Internal.Stack.ConstantsProf GHC.Internal.Stack.Decode GHC.Internal.Stack.Types GHC.Internal.Stats ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GHC.Internal.Stack.ConstantsProf where + +import GHC.Internal.Base +import GHC.Internal.Enum +import GHC.Internal.Num +import GHC.Internal.Show +import GHC.Internal.Real + +-- This file is a copy of GHC.Internal.Stack.Constants, but compiled with PROFILING +-- defined, since hsc is only invoked once per build in the vanilla way. +-- +-- Also see GHC.Internal.Heap.InfoTable{Prof} +#define PROFILING +#include "Rts.h" +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#undef BLOCKS_PER_MBLOCK +#include "DerivedConstants.h" + +newtype ByteOffset = ByteOffset { offsetInBytes :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +newtype WordOffset = WordOffset { offsetInWords :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +offsetStgCatchFrameHandler :: WordOffset +offsetStgCatchFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchFrame_handler) + (#size StgHeader) + +sizeStgCatchFrame :: Int +sizeStgCatchFrame = bytesToWords $ + (#const SIZEOF_StgCatchFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchSTMFrameCode :: WordOffset +offsetStgCatchSTMFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_code) + (#size StgHeader) + +offsetStgCatchSTMFrameHandler :: WordOffset +offsetStgCatchSTMFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_handler) + (#size StgHeader) + +sizeStgCatchSTMFrame :: Int +sizeStgCatchSTMFrame = bytesToWords $ + (#const SIZEOF_StgCatchSTMFrame_NoHdr) + (#size StgHeader) + +offsetStgUpdateFrameUpdatee :: WordOffset +offsetStgUpdateFrameUpdatee = byteOffsetToWordOffset $ + (#const OFFSET_StgUpdateFrame_updatee) + (#size StgHeader) + +sizeStgUpdateFrame :: Int +sizeStgUpdateFrame = bytesToWords $ + (#const SIZEOF_StgUpdateFrame_NoHdr) + (#size StgHeader) + +offsetStgAtomicallyFrameCode :: WordOffset +offsetStgAtomicallyFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_code) + (#size StgHeader) + +offsetStgAtomicallyFrameResult :: WordOffset +offsetStgAtomicallyFrameResult = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_result) + (#size StgHeader) + +sizeStgAtomicallyFrame :: Int +sizeStgAtomicallyFrame = bytesToWords $ + (#const SIZEOF_StgAtomicallyFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningAltCode :: WordOffset +offsetStgCatchRetryFrameRunningAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_running_alt_code) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningFirstCode :: WordOffset +offsetStgCatchRetryFrameRunningFirstCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_first_code) + (#size StgHeader) + +offsetStgCatchRetryFrameAltCode :: WordOffset +offsetStgCatchRetryFrameAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_alt_code) + (#size StgHeader) + +sizeStgCatchRetryFrame :: Int +sizeStgCatchRetryFrame = bytesToWords $ + (#const SIZEOF_StgCatchRetryFrame_NoHdr) + (#size StgHeader) + +offsetStgRetFunFrameSize :: WordOffset +-- StgRetFun has no header, but only a pointer to the info table at the beginning. +offsetStgRetFunFrameSize = byteOffsetToWordOffset (#const OFFSET_StgRetFun_size) + +offsetStgRetFunFrameFun :: WordOffset +offsetStgRetFunFrameFun = byteOffsetToWordOffset (#const OFFSET_StgRetFun_fun) + +offsetStgRetFunFramePayload :: WordOffset +offsetStgRetFunFramePayload = byteOffsetToWordOffset (#const OFFSET_StgRetFun_payload) + +sizeStgRetFunFrame :: Int +sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) + +sizeStgAnnFrame :: Int +sizeStgAnnFrame = bytesToWords $ + (#const SIZEOF_StgAnnFrame_NoHdr) + (#size StgHeader) + +offsetStgAnnFrameAnn :: WordOffset +offsetStgAnnFrameAnn = byteOffsetToWordOffset $ + (#const OFFSET_StgAnnFrame_ann) + (#size StgHeader) + +offsetStgBCOFrameInstrs :: ByteOffset +offsetStgBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader) + +offsetStgBCOFrameLiterals :: ByteOffset +offsetStgBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader) + +offsetStgBCOFramePtrs :: ByteOffset +offsetStgBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader) + +offsetStgBCOFrameArity :: ByteOffset +offsetStgBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader) + +offsetStgBCOFrameSize :: ByteOffset +offsetStgBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader) + +offsetStgClosurePayload :: WordOffset +offsetStgClosurePayload = byteOffsetToWordOffset $ + (#const OFFSET_StgClosure_payload) + (#size StgHeader) + +sizeStgClosure :: Int +sizeStgClosure = bytesToWords (#size StgHeader) + +byteOffsetToWordOffset :: ByteOffset -> WordOffset +byteOffsetToWordOffset = WordOffset . bytesToWords . fromInteger . toInteger + +bytesToWords :: Int -> Int +bytesToWords b = + if b `mod` bytesInWord == 0 then + fromIntegral $ b `div` bytesInWord + else + error "Unexpected struct alignment!" + +bytesInWord :: Int +bytesInWord = (#const SIZEOF_VOID_P) + ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -54,9 +54,19 @@ import GHC.Internal.Heap.Closures GenStackField(..) ) import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS) -import GHC.Internal.Heap.InfoTable import GHC.Internal.Stack.Annotation +-- See Note [No way-dependent imports] +#if defined(PROFILING) +import GHC.Internal.Stack.Constants () +import GHC.Internal.Stack.ConstantsProf +import GHC.Internal.Heap.InfoTable () +import GHC.Internal.Heap.InfoTableProf +#else +import GHC.Internal.Heap.InfoTable +import GHC.Internal.Heap.InfoTableProf () import GHC.Internal.Stack.Constants +import GHC.Internal.Stack.ConstantsProf () +#endif import GHC.Internal.Stack.CloneStack import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE) ===================================== libraries/ghc-internal/tests/backtraces/T26507.hs ===================================== @@ -0,0 +1,7 @@ +import GHC.Internal.Control.Exception +import GHC.Internal.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + throwIO $ ErrorCall "Throw error" ===================================== libraries/ghc-internal/tests/backtraces/T26507.stderr ===================================== @@ -0,0 +1,8 @@ +T26507: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Throw error + +IPE backtrace: +HasCallStack backtrace: + throwIO, called at T26507.hs:7:3 in main:Main + ===================================== libraries/ghc-internal/tests/backtraces/all.T ===================================== @@ -1,2 +1,6 @@ test('T14532a', [], compile_and_run, ['']) test('T14532b', [], compile_and_run, ['']) +test('T26507', [ when(have_profiling(), extra_ways(['prof'])) + , when(js_arch(), skip) + , exit_code(1)], compile_and_run, ['']) + ===================================== libraries/ghc-internal/tests/stack-annotation/all.T ===================================== @@ -1,7 +1,10 @@ # Javascript backend don't support annotation frames, yet -setTestOpts(when(js_arch(), skip)) +# and test with profiling way if available (#26507) +ann_frame_opts = [ when(js_arch(), skip) + , when(have_profiling(), extra_ways(['prof'])) + , extra_files(['TestUtils.hs'])] -test('ann_frame001', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame002', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame003', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) -test('ann_frame004', [extra_files(['TestUtils.hs'])], compile_and_run, ['']) +test('ann_frame001', ann_frame_opts, compile_and_run, ['']) +test('ann_frame002', ann_frame_opts, compile_and_run, ['']) +test('ann_frame003', ann_frame_opts, compile_and_run, ['']) +test('ann_frame004', ann_frame_opts, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4e6e0df69e566f6f1eb840e3562a07... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4e6e0df69e566f6f1eb840e3562a07... You're receiving this email because of your account on gitlab.haskell.org.