[Git][ghc/ghc][wip/wasm-internal-interpreter] 15 commits: Revert "Add necessary flag for js linking"

Cheng Shao pushed to branch wip/wasm-internal-interpreter at Glasgow Haskell Compiler / GHC Commits: c1cab0c3 by Sylvain Henry at 2025-09-26T10:36:30-04:00 Revert "Add necessary flag for js linking" This reverts commit 84f68e2231b2eddb2e1dc4e90af394ef0f2e803f. This commit didn't have the expected effect. See discussion in #26290. Instead we export HEAP8 and HEAPU8 from rts/js/mem.js - - - - - 0a434a80 by Sylvain Henry at 2025-09-26T10:36:30-04:00 JS: export HEAPU8 (#26290) This is now required by newer Emscripten versions. - - - - - b10296a9 by Andreas Klebinger at 2025-09-26T10:37:11-04:00 sizeExpr: Improve Tick handling. When determining if we scrutinize a function argument we now properly look through ticks. Fixes #26444. - - - - - d9e2a9a7 by mniip at 2025-09-26T16:00:50-04:00 rts: Refactor parsing of -h flags We have a nontrivial amount of heap profiling flags available in the non-profiled runtime, so it makes sense to reuse the parsing code between the profiled and the non-profiled runtime, only restricting which flags are allowed. - - - - - 089e45aa by mniip at 2025-09-26T16:00:50-04:00 rts: Fix parsing of -h options with braces When the "filter by" -h options were introduced in bc210f7d267e8351ccb66972f4b3a650eb9338bb, the braces were mandatory. Then in 3c22fb21fb18e27ce8d941069a6915fce584a526, the braces were made optional. Then in d1ce35d2271ac8b79cb5e37677b1a989749e611c the brace syntax stopped working, and no one seems to have noticed. - - - - - 423f1472 by mniip at 2025-09-26T16:00:50-04:00 rts: add -hT<type> and -hi<table id> heap filtering options (#26361) They are available in non-profiled builds. Along the way fixed a bug where combining -he<era> and -hr<retainer> would ignore whether the retainer matches or not. - - - - - 4cda4785 by mniip at 2025-09-26T16:00:50-04:00 docs: Document -hT<type> and -hi<addr> - - - - - 982ad30f by mniip at 2025-09-26T16:00:50-04:00 rts: Refactor dumping the heap census Always do the printing of the total size right next to where the bucket label is printed. This prevents accidentally printing a label without the corresponding amount. Fixed a bug where exactly this happened for -hi profile and the 0x0 (uncategorized) info table. There is now also much more symmetry between fprintf(hp_file,...) and the corresponding traceHeapProfSampleString. - - - - - 8cbe006a by Cheng Shao at 2025-09-26T16:01:34-04:00 hadrian: fix GHC.Platform.Host generation for cross stage1 This patch fixes incorrectly GHC.Platform.Host generation logic for cross stage1 in hadrian (#26449). Also adds T26449 test case to witness the fix. Co-authored-by: Codex - - - - - 0ddd0fdc by soulomoon at 2025-09-28T19:24:10-04:00 Remove hptAllInstances usage during upsweep Previously, during the upsweep phase when checking safe imports, we were loading the module interface with runTcInteractive, which in turn calls hptAllInstances. This accesses non-below modules from the home package table. Change the implementation of checkSafeImports to use initTcWithGbl and loadSysInterface to load the module interface, since we already have TcGblEnv at hand. This eliminates the unnecessary use of runTcInteractive and hptAllInstances during the upsweep phase. - - - - - e05c496c by Ben Gamari at 2025-09-28T19:24:59-04:00 base: Update changelog to reflect timing of IOPort# removal This change will make 9.14 afterall. - - - - - bdc9d130 by Cheng Shao at 2025-09-28T19:25:45-04:00 rts: fix wasm JSFFI initialization constructor code This commit fixes wasm JSFFI initialization constructor code so that the constructor is self-contained and avoids invoking a fake __main_argc_argv function. The previous approach of reusing __main_void logic in wasi-libc saves a tiny bit of code, at the expense of link-time trouble whenever GHC links a wasm module without -no-hs-main, in which case the driver-generated main function would clash with the definition here, resulting in a linker error. It's simply better to avoid messing with the main function, and it would additionally allow linking wasm32-wasi command modules that does make use of synchronous JSFFI. - - - - - 5d59fc8f by Cheng Shao at 2025-09-28T19:26:27-04:00 rts: provide stub implementations of ExecPage functions for wasm This patch provides stub implementations of ExecPage functions for wasm. They are never actually invoked at runtime for any non-TNTC platform, yet they can cause link-time errors of missing symbols when the GHCi.InfoTable module gets linked into the final wasm module (e.g. a GHC API program). - - - - - 9708fcc1 by Cheng Shao at 2025-09-29T01:46:30+02:00 ghci: fix lookupSymbolInDLL behavior on wasm This patch fixes lookupSymbolInDLL behavior on wasm to return Nothing instead of throwing. On wasm, we only have lookupSymbol, and the driver would attempt to call lookupSymbolInDLL first before falling back to lookupSymbol, so lookupSymbolInDLL needs to return Nothing gracefully for the fallback behavior to work. - - - - - 32ffe4e2 by Cheng Shao at 2025-09-29T01:46:30+02:00 hadrian/compiler: enable internal-interpreter for ghc library in wasm stage1 - - - - - 26 changed files: - compiler/GHC.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter/Types.hs - docs/users_guide/profiling.rst - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghci/GHCi/ObjLink.hs - m4/fptools_set_c_ld_flags.m4 - rts/ExecPage.c - rts/ProfHeap.c - rts/RetainerSet.c - rts/RtsFlags.c - rts/include/rts/Flags.h - rts/js/mem.js - rts/wasm/JSFFI.c - testsuite/driver/testlib.py - + testsuite/tests/cross/should_run/T26449.hs - + testsuite/tests/cross/should_run/all.T - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -716,17 +716,14 @@ setTopSessionDynFlags dflags = do -- see Note [Target code interpreter] interp <- if +#if !defined(wasm32_HOST_ARCH) -- Wasm dynamic linker | ArchWasm32 <- platformArch $ targetPlatform dflags -> do s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader dyld <- liftIO $ makeAbsolute $ topDir dflags "dyld.mjs" -#if defined(wasm32_HOST_ARCH) - let libdir = sorry "cannot spawn child process on wasm" -#else libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries" -#endif let profiled = ways dflags `hasWay` WayProf way_tag = if profiled then "_p" else "" let cfg = @@ -747,6 +744,7 @@ setTopSessionDynFlags dflags = do wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env } pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache +#endif -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -637,6 +637,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr where is_top_arg (Var v) | v `elem` top_args = Just v is_top_arg (Cast e _) = is_top_arg e + is_top_arg (Tick _t e) = is_top_arg e is_top_arg _ = Nothing where ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -165,7 +165,7 @@ import GHC.JS.Syntax import GHC.IfaceToCore ( typecheckIface, typecheckWholeCoreBindings ) -import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface ) +import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface, loadSysInterface ) import GHC.Iface.Make import GHC.Iface.Recomp import GHC.Iface.Tidy @@ -1765,7 +1765,7 @@ hscCheckSafe' m l = do -- so we need to call 'getModuleInterface' to load from disk case iface of Just _ -> return iface - Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m) + Nothing -> liftIO $ initIfaceLoad hsc_env (Just <$> loadSysInterface (text "checkSafeImports") m) -- | Check the list of packages are trusted. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3763,12 +3763,18 @@ makeDynFlagsConsistent dflags -- only supports dynamic code | LinkInMemory <- ghcLink dflags , sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags +#if defined(wasm32_HOST_ARCH) + , not (ways dflags `hasWay` WayDyn) +#else , not (ways dflags `hasWay` WayDyn && gopt Opt_ExternalInterpreter dflags) +#endif = flip loopNoWarn "Forcing dynamic way because target RTS linker only supports dynamic code" $ -- See checkOptions, -fexternal-interpreter is -- required when using --interactive with a non-standard -- way (-prof, -static, or -dynamic). +#if !defined(wasm32_HOST_ARCH) setGeneralFlag' Opt_ExternalInterpreter $ +#endif addWay' WayDyn dflags | LinkInMemory <- ghcLink dflags ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1564,6 +1564,9 @@ gccSearchDirCache = unsafePerformIO $ newIORef [] -- which dominate a large percentage of startup time on Windows. getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath] getGccSearchDirectory logger dflags key = do +#if defined(wasm32_HOST_ARCH) + pure [] +#else cache <- readIORef gccSearchDirCache case lookup key cache of Just x -> return x @@ -1590,6 +1593,7 @@ getGccSearchDirectory logger dflags key = do x:_ -> case break (=='=') x of (_ , []) -> [] (_, (_:xs)) -> xs +#endif -- | Get a list of system search directories, this to alleviate pressure on -- the findSysDll function. ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -214,7 +214,7 @@ data JSInterpConfig = JSInterpConfig data WasmInterpConfig = WasmInterpConfig { wasmInterpDyLD :: !FilePath -- ^ Location of dyld.mjs script - , wasmInterpLibDir :: FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc + , wasmInterpLibDir :: !FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc , wasmInterpOpts :: ![String] -- ^ Additional command line arguments for iserv -- wasm ghci browser mode ===================================== docs/users_guide/profiling.rst ===================================== @@ -1003,6 +1003,11 @@ follows: The flags below are marked with ``:noindex:`` to avoid duplicate ID warnings from Sphinx. +.. rts-flag:: -hT ⟨type⟩ + :noindex: + + Restrict the profile to closures with the specified closure types. + .. rts-flag:: -hc ⟨name⟩ :noindex: @@ -1050,6 +1055,13 @@ follows: biographies, where ⟨bio⟩ is one of ``lag``, ``drag``, ``void``, or ``use``. +.. rts-flag:: -hi ⟨addr⟩ + :noindex: + + Restrict the profile to closures with specified info table addresses. The + address should start with ``0x`` and be lowercase hexadecimal, just like the + addresses produced by :rts-flag:`-hi`. + For example, the following options will generate a retainer profile restricted to ``Branch`` and ``Leaf`` constructors: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -606,8 +606,12 @@ generateVersionHs = do generatePlatformHostHs :: Expr String generatePlatformHostHs = do trackGenerateHs - cHostPlatformArch <- queryHost (archOS_arch . tgtArchOs) - cHostPlatformOS <- queryHost (archOS_OS . tgtArchOs) + stage <- getStage + let chooseHostQuery = case stage of + Stage0 {} -> queryHost + _ -> queryTarget + cHostPlatformArch <- chooseHostQuery (archOS_arch . tgtArchOs) + cHostPlatformOS <- chooseHostQuery (archOS_OS . tgtArchOs) return $ unlines [ "module GHC.Platform.Host where" , "" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -90,7 +90,7 @@ packageArgs = do -- (#14335) and completely untested in CI for cross -- backends at the moment, so we might as well disable it -- for cross GHC. - [ andM [expr (ghcWithInterpreter stage), notCross] `cabalFlag` "internal-interpreter" + [ stage1 `cabalFlag` "internal-interpreter" , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" ===================================== libraries/base/changelog.md ===================================== @@ -6,7 +6,6 @@ * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) * Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356)) * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332)) - * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351)) * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339)) @@ -37,7 +36,7 @@ * `GHC.TypeNats.Internal` * `GHC.ExecutionStack.Internal`. * Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) - + * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) * Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)). * Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)). ===================================== libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc ===================================== @@ -312,6 +312,8 @@ data ProfFlags = ProfFlags , retainerSelector :: Maybe String , bioSelector :: Maybe String , eraSelector :: Word -- ^ @since base-4.20.0.0 + , closureTypeSelector :: Maybe String + , infoTableSelector :: Maybe String } deriving ( Show -- ^ @since base-4.8.0.0 , Generic -- ^ @since base-4.15.0.0 ) @@ -613,6 +615,8 @@ getProfFlags = do <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr) <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr) <*> #{peek PROFILING_FLAGS, eraSelector} ptr + <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, closureTypeSelector} ptr) + <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, infoTableSelector} ptr) getTraceFlags :: IO TraceFlags getTraceFlags = do ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -103,8 +103,7 @@ foreign import javascript unsafe "__ghc_wasm_jsffi_dyld.lookupSymbol($1)" js_lookupSymbol :: JSString -> IO (Ptr a) lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) -lookupSymbolInDLL _ sym = - throwIO $ ErrorCall $ "lookupSymbolInDLL: unsupported on wasm for " <> sym +lookupSymbolInDLL _ _ = pure Nothing resolveObjs :: IO Bool resolveObjs = pure True ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -109,9 +109,6 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $2="$$2 -mcmodel=medium" ;; - javascript*) - $3="$$3 -sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8" - esac AC_MSG_RESULT([done]) ===================================== rts/ExecPage.c ===================================== @@ -10,15 +10,23 @@ #include "linker/MMap.h" ExecPage *allocateExecPage(void) { +#if defined(wasm32_HOST_ARCH) + return NULL; +#else ExecPage *page = (ExecPage *) mmapAnon(getPageSize()); return page; +#endif } void freezeExecPage(ExecPage *page) { +#if !defined(wasm32_HOST_ARCH) mprotectForLinker(page, getPageSize(), MEM_READ_EXECUTE); flushExec(getPageSize(), page); +#endif } void freeExecPage(ExecPage *page) { +#if !defined(wasm32_HOST_ARCH) munmapForLinker(page, getPageSize(), "freeExecPage"); +#endif } ===================================== rts/ProfHeap.c ===================================== @@ -181,6 +181,28 @@ static void dumpCensus( Census *census ); static bool closureSatisfiesConstraints( const StgClosure* p ); +static const char *closureTypeIdentity( const StgClosure *p ) +{ + const StgInfoTable *info = get_itbl(p); + switch (info->type) { + case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_2_0: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_NOCAF: + return GET_CON_DESC(itbl_to_con_itbl(info)); + default: + return closure_type_names[info->type]; + } +} + +static void formatIPELabel( char *str, size_t size, uint64_t table_id ) +{ + snprintf(str, size, "0x%" PRIx64, table_id); +} + /* ---------------------------------------------------------------------------- * Find the "closure identity", which is a unique pointer representing * the band to which this closure's heap space is attributed in the @@ -215,26 +237,9 @@ closureIdentity( const StgClosure *p ) #endif case HEAP_BY_CLOSURE_TYPE: - { - const StgInfoTable *info; - info = get_itbl(p); - switch (info->type) { - case CONSTR: - case CONSTR_1_0: - case CONSTR_0_1: - case CONSTR_2_0: - case CONSTR_1_1: - case CONSTR_0_2: - case CONSTR_NOCAF: - return GET_CON_DESC(itbl_to_con_itbl(info)); - default: - return closure_type_names[info->type]; - } - } + return closureTypeIdentity(p); case HEAP_BY_INFO_TABLE: - { return (void *) (p->header.info); - } default: barf("closureIdentity"); @@ -664,6 +669,8 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, uint32_t max_length) fprintf(fp, "%s", buf); } +#endif /* PROFILING */ + bool strMatchesSelector( const char* str, const char* sel ) { @@ -688,8 +695,6 @@ strMatchesSelector( const char* str, const char* sel ) } } -#endif /* PROFILING */ - /* ----------------------------------------------------------------------------- * Figure out whether a closure should be counted in this census, by * testing against all the specified constraints. @@ -697,11 +702,8 @@ strMatchesSelector( const char* str, const char* sel ) static bool closureSatisfiesConstraints( const StgClosure* p ) { -#if !defined(PROFILING) - (void)p; /* keep gcc -Wall happy */ - return true; -#else - bool b; + bool b; +#if defined(PROFILING) // The CCS has a selected field to indicate whether this closure is // deselected by not being mentioned in the module, CC, or CCS @@ -721,7 +723,8 @@ closureSatisfiesConstraints( const StgClosure* p ) if (!b) return false; } if (RtsFlags.ProfFlags.eraSelector) { - return (p->header.prof.hp.era == RtsFlags.ProfFlags.eraSelector); + b = p->header.prof.hp.era == RtsFlags.ProfFlags.eraSelector; + if (!b) return false; } if (RtsFlags.ProfFlags.retainerSelector) { RetainerSet *rs; @@ -742,8 +745,21 @@ closureSatisfiesConstraints( const StgClosure* p ) } return false; } - return true; +#else + if (RtsFlags.ProfFlags.closureTypeSelector) { + b = strMatchesSelector( closureTypeIdentity(p), + RtsFlags.ProfFlags.closureTypeSelector ); + if (!b) return false; + } + if (RtsFlags.ProfFlags.infoTableSelector) { + char str[100]; + formatIPELabel(str, sizeof str, lookupIPEId(p->header.info)); + b = strMatchesSelector( str, + RtsFlags.ProfFlags.infoTableSelector ); + if (!b) return false; + } #endif /* PROFILING */ + return true; } /* ----------------------------------------------------------------------------- @@ -858,12 +874,11 @@ aggregateCensusInfo( void ) static void recordIPEHeapSample(FILE *hp_file, uint64_t table_id, size_t count) { - // Print to heap profile file - fprintf(hp_file, "0x%" PRIx64, table_id); - - // Create label string for tracing char str[100]; - sprintf(str, "0x%" PRIx64, table_id); + formatIPELabel(str, sizeof str, table_id); + + // Print to heap profile file + fprintf(hp_file, "%s\t%" FMT_Word "\n", str, (W_)(count * sizeof(W_))); // Emit the profiling sample (convert count to bytes) traceHeapProfSampleString(str, count * sizeof(W_)); @@ -961,7 +976,9 @@ dumpCensus( Census *census ) switch (RtsFlags.ProfFlags.doHeapProfile) { case HEAP_BY_CLOSURE_TYPE: - fprintf(hp_file, "%s", (char *)ctr->identity); + fprintf(hp_file, "%s\t%" FMT_Word "\n", + (char *)ctr->identity, + (W_)(count * sizeof(W_))); traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; @@ -979,19 +996,26 @@ dumpCensus( Census *census ) case HEAP_BY_CCS: fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, RtsFlags.ProfFlags.ccsLength); + fprintf(hp_file, "\t%" FMT_Word "\n", + (W_)(count * sizeof(W_))); traceHeapProfSampleCostCentre((CostCentreStack *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_ERA: - fprintf(hp_file, "%" FMT_Word, (StgWord)ctr->identity); + { char str_era[100]; - sprintf(str_era, "%" FMT_Word, (StgWord)ctr->identity); + snprintf(str_era, sizeof str_era, "%" FMT_Word, + (StgWord)ctr->identity); + fprintf(hp_file, "%s\t%" FMT_Word "\n", + str_era, (W_)(count * sizeof(W_))); traceHeapProfSampleString(str_era, count * sizeof(W_)); break; + } case HEAP_BY_MOD: case HEAP_BY_DESCR: case HEAP_BY_TYPE: - fprintf(hp_file, "%s", (char *)ctr->identity); + fprintf(hp_file, "%s\t%" FMT_Word "\n", + (char *)ctr->identity, (W_)(count * sizeof(W_))); traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; @@ -1002,29 +1026,28 @@ dumpCensus( Census *census ) // it might be the distinguished retainer set rs_MANY: if (rs == &rs_MANY) { fprintf(hp_file, "MANY"); - break; - } + } else { - // Mark this retainer set by negating its id, because it - // has appeared in at least one census. We print the - // values of all such retainer sets into the log file at - // the end. A retainer set may exist but not feature in - // any censuses if it arose as the intermediate retainer - // set for some closure during retainer set calculation. - if (rs->id > 0) - rs->id = -(rs->id); - - // report in the unit of bytes: * sizeof(StgWord) - printRetainerSetShort(hp_file, rs, (W_)count * sizeof(W_) - , RtsFlags.ProfFlags.ccsLength); + // Mark this retainer set by negating its id, because it + // has appeared in at least one census. We print the + // values of all such retainer sets into the log file at + // the end. A retainer set may exist but not feature in + // any censuses if it arose as the intermediate retainer + // set for some closure during retainer set calculation. + if (rs->id > 0) + rs->id = -(rs->id); + + // report in the unit of bytes: * sizeof(StgWord) + printRetainerSetShort(hp_file, rs, (W_)(count * sizeof(W_)) + , RtsFlags.ProfFlags.ccsLength); + } + fprintf(hp_file, "\t%" FMT_Word "\n", (W_)(count * sizeof(W_))); break; } #endif default: barf("dumpCensus; doHeapProfile"); } - - fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } // Print the unallocated data into the 0 band for info table profiling. ===================================== rts/RetainerSet.c ===================================== @@ -237,7 +237,7 @@ printRetainerSetShort(FILE *f, RetainerSet *rs, W_ total_size, uint32_t max_leng // size = strlen(tmp); } } - fputs(tmp, f); + fprintf(f, "%s\t%" FMT_Word "\n", tmp, total_size); traceHeapProfSampleString(tmp, total_size); } ===================================== rts/RtsFlags.c ===================================== @@ -112,9 +112,7 @@ static void bad_option (const char *s); static void read_debug_flags(const char *arg); #endif -#if defined(PROFILING) static bool read_heap_profiling_flag(const char *arg); -#endif #if defined(TRACING) static void read_trace_flags(const char *arg); @@ -237,6 +235,9 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.eraSelector = 0; #endif + RtsFlags.ProfFlags.closureTypeSelector = NULL; + RtsFlags.ProfFlags.infoTableSelector = NULL; + #if defined(TRACING) RtsFlags.TraceFlags.tracing = TRACE_NONE; RtsFlags.TraceFlags.timestamp = false; @@ -403,6 +404,8 @@ usage_text[] = { " -hr<cc>... closures with specified retainers", " -hb<bio>... closures with specified biographies (lag,drag,void,use)", " -he<era>... closures with specified era", +" -hT<typ>,... specified closure types", +" -hi<adr>,... closures with specified info table addresses", "", " -R<size> Set the maximum retainer set size (default: 8)", "", @@ -418,6 +421,9 @@ usage_text[] = { " -h Heap residency profile (output file <program>.hp)", " -hT Produce a heap profile grouped by closure type", " -hi Produce a heap profile grouped by info table address", +" A subset of closures may be selected thusly:", +" -hT<typ>,... specified closure types", +" -hi<adr>,... closures with specified info table addresses", " -po<file> Override profiling output file name prefix (program name by default)", #endif /* PROFILING */ @@ -924,11 +930,10 @@ error = true; #endif #if defined(PROFILING) -# define PROFILING_BUILD_ONLY(x) x +# define PROFILING_BUILD_ONLY(_arg, x) x #else -# define PROFILING_BUILD_ONLY(x) \ -errorBelch("the flag %s requires the program to be built with -prof", \ - rts_argv[arg]); \ +# define PROFILING_BUILD_ONLY(arg, x) \ +errorBelch("the flag %s requires the program to be built with -prof", arg); \ error = true; #endif @@ -1485,11 +1490,11 @@ error = true; RtsFlags.CcFlags.outputFileNameStem = rts_argv[arg]+3; break; default: - PROFILING_BUILD_ONLY(); + PROFILING_BUILD_ONLY(rts_argv[arg],); } break; #else - PROFILING_BUILD_ONLY( + PROFILING_BUILD_ONLY(rts_argv[arg], switch (rts_argv[arg][2]) { case 'a': RtsFlags.CcFlags.doCostCentres = COST_CENTRES_ALL; @@ -1527,43 +1532,25 @@ error = true; case 'R': OPTION_SAFE; - PROFILING_BUILD_ONLY( + PROFILING_BUILD_ONLY(rts_argv[arg], RtsFlags.ProfFlags.maxRetainerSetSize = atof(rts_argv[arg]+2); ) break; case 'L': OPTION_SAFE; - PROFILING_BUILD_ONLY( + PROFILING_BUILD_ONLY(rts_argv[arg], RtsFlags.ProfFlags.ccsLength = atof(rts_argv[arg]+2); if(RtsFlags.ProfFlags.ccsLength <= 0) { bad_option(rts_argv[arg]); } ) break; case 'h': /* serial heap profile */ -#if !defined(PROFILING) - switch (rts_argv[arg][2]) { - case '\0': - errorBelch("-h is deprecated, use -hT instead."); - - FALLTHROUGH; - case 'T': - OPTION_UNSAFE; - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE; - break; - case 'i': - OPTION_UNSAFE; - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE; - break; - default: - OPTION_SAFE; - PROFILING_BUILD_ONLY(); - } -#else +#if defined(PROFILING) OPTION_SAFE; - PROFILING_BUILD_ONLY( - error = read_heap_profiling_flag(rts_argv[arg]); - ); -#endif /* PROFILING */ +#else + OPTION_UNSAFE; +#endif + error = read_heap_profiling_flag(rts_argv[arg]); break; case 'i': /* heap sample interval */ @@ -1840,7 +1827,7 @@ error = true; case 'c': /* Debugging tool: show current cost centre on an exception */ OPTION_SAFE; - PROFILING_BUILD_ONLY( + PROFILING_BUILD_ONLY(rts_argv[arg], RtsFlags.ProfFlags.showCCSOnException = true; ); unchecked_arg_start++; @@ -2341,139 +2328,171 @@ static void read_debug_flags(const char* arg) } #endif -#if defined(PROFILING) // Parse a "-h" flag, returning whether the parse resulted in an error. static bool read_heap_profiling_flag(const char *arg) { - // Already parsed "-h" - + // Already parsed arg[0:2] = "-h" bool error = false; - switch (arg[2]) { - case '\0': - errorBelch("-h is deprecated, use -hc instead."); - FALLTHROUGH; - case 'C': - case 'c': - case 'M': - case 'm': - case 'D': - case 'd': - case 'Y': - case 'y': - case 'i': - case 'R': - case 'r': - case 'B': - case 'b': - case 'e': - case 'T': - if (arg[2] != '\0' && arg[3] != '\0') { - { - const char *left = strchr(arg, '{'); - const char *right = strrchr(arg, '}'); - - // curly braces are optional, for - // backwards compat. - if (left) - left = left+1; - else - left = arg + 3; - - if (!right) - right = arg + strlen(arg); - - char *selector = stgStrndup(left, right - left + 1); - - switch (arg[2]) { - case 'c': // cost centre label select - RtsFlags.ProfFlags.ccSelector = selector; - break; - case 'C': - RtsFlags.ProfFlags.ccsSelector = selector; - break; - case 'M': - case 'm': // cost centre module select - RtsFlags.ProfFlags.modSelector = selector; - break; - case 'D': - case 'd': // closure descr select - RtsFlags.ProfFlags.descrSelector = selector; - break; - case 'Y': - case 'y': // closure type select - RtsFlags.ProfFlags.typeSelector = selector; - break; - case 'R': - case 'r': // retainer select - RtsFlags.ProfFlags.retainerSelector = selector; - break; - case 'B': - case 'b': // biography select - RtsFlags.ProfFlags.bioSelector = selector; - break; - case 'E': - case 'e': // era select - RtsFlags.ProfFlags.eraSelector = strtoul(selector, (char **) NULL, 10); - break; - default: - stgFree(selector); - } - } - break; - } + char property; + const char *filter; + if (arg[2] != '\0') { + property = arg[2]; + filter = arg + 3; + } else { +#if defined(PROFILING) + errorBelch("-h is deprecated, use -hc instead."); + property = 'c'; + filter = arg + 2; +#else + errorBelch("-h is deprecated, use -hT instead."); + property = 'T'; + filter = arg + 2; +#endif + } + // here property is initialized, and filter is a pointer inside arg - if (RtsFlags.ProfFlags.doHeapProfile != 0) { - errorBelch("multiple heap profile options"); - error = true; - break; - } + if (filter[0] != '\0') { + // For backwards compat, extract the portion between curly braces, else + // use the entire string + const char *left = strchr(filter, '{'); + const char *right = strrchr(filter, '}'); - switch (arg[2]) { - case '\0': + if (left) + left = left + 1; + else + left = filter; + + if (!right) + right = filter + strlen(filter); + + char *selector = stgStrndup(left, right - left); + switch (property) { +#if defined(PROFILING) + case 'c': // cost centre label select + RtsFlags.ProfFlags.ccSelector = selector; + break; case 'C': - case 'c': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS; + RtsFlags.ProfFlags.ccsSelector = selector; break; case 'M': - case 'm': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD; + case 'm': // cost centre module select + RtsFlags.ProfFlags.modSelector = selector; break; case 'D': - case 'd': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR; + case 'd': // closure descr select + RtsFlags.ProfFlags.descrSelector = selector; break; case 'Y': - case 'y': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE; + case 'y': // closure type select + RtsFlags.ProfFlags.typeSelector = selector; break; - case 'i': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE; + case 'R': + case 'r': // retainer select + RtsFlags.ProfFlags.retainerSelector = selector; break; + case 'B': + case 'b': // biography select + RtsFlags.ProfFlags.bioSelector = selector; + break; + case 'E': + case 'e': // era select + RtsFlags.ProfFlags.eraSelector = strtoul(selector, (char **) NULL, 10); + break; +#else + case 'c': + case 'C': + case 'M': + case 'm': + case 'D': + case 'd': + case 'Y': + case 'y': case 'R': case 'r': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER; - break; case 'B': case 'b': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV; + case 'E': + case 'e': + PROFILING_BUILD_ONLY(arg,); break; - case 'T': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE; + case 'T': /* closure type select */ + RtsFlags.ProfFlags.closureTypeSelector = selector; break; - case 'e': - RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_ERA; + case 'i': /* info table select */ + RtsFlags.ProfFlags.infoTableSelector = selector; break; - } - break; - default: - errorBelch("invalid heap profile option: %s", arg); - error = true; +#endif /* PROFILING */ + default: + stgFree(selector); + } + } else { + if (RtsFlags.ProfFlags.doHeapProfile != 0) { + errorBelch("multiple heap profile options"); + error = true; + } else { + switch (property) { +#if defined(PROFILING) + case 'C': + case 'c': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS; + break; + case 'M': + case 'm': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD; + break; + case 'D': + case 'd': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR; + break; + case 'Y': + case 'y': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE; + break; + case 'R': + case 'r': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER; + break; + case 'B': + case 'b': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV; + break; + case 'e': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_ERA; + break; +#else + case 'C': + case 'c': + case 'M': + case 'm': + case 'D': + case 'd': + case 'Y': + case 'y': + case 'R': + case 'r': + case 'B': + case 'b': + case 'e': + PROFILING_BUILD_ONLY(arg,); + break; +#endif /* PROFILING*/ + case 'T': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE; + break; + case 'i': + RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE; + break; + default: + errorBelch("invalid heap profile option: %s", arg); + error = true; + break; + } + } } return error; } -#endif #if defined(TRACING) static void read_trace_flags(const char *arg) ===================================== rts/include/rts/Flags.h ===================================== @@ -170,6 +170,8 @@ typedef struct _PROFILING_FLAGS { const char* retainerSelector; StgWord eraSelector; const char* bioSelector; + const char* closureTypeSelector; + const char* infoTableSelector; } PROFILING_FLAGS; ===================================== rts/js/mem.js ===================================== @@ -1,5 +1,5 @@ //#OPTIONS:CPP -//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8 +//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8,HEAPU8 // #define GHCJS_TRACE_META 1 ===================================== rts/wasm/JSFFI.c ===================================== @@ -5,6 +5,8 @@ #include "Threads.h" #include "sm/Sanity.h" +#include + #if defined(__wasm_reference_types__) extern HsBool rts_JSFFI_flag; @@ -12,21 +14,8 @@ extern HsStablePtr rts_threadDelay_impl; extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure; extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure; -int __main_void(void); - -int __main_argc_argv(int, char*[]); - -int __main_argc_argv(int argc, char *argv[]) { - RtsConfig __conf = defaultRtsConfig; - __conf.rts_opts_enabled = RtsOptsAll; - __conf.rts_hs_main = false; - hs_init_ghc(&argc, &argv, __conf); - // See Note [threadDelay on wasm] for details. - rts_JSFFI_flag = HS_BOOL_TRUE; - getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure); - rts_threadDelay_impl = getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure); - return 0; -} +__attribute__((__weak__)) +int __main_argc_argv(int argc, char *argv[]); // Note [JSFFI initialization] // ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -66,11 +55,69 @@ int __main_argc_argv(int argc, char *argv[]) { // by the GHC codegen, and priority 102 to the initialization logic // here to ensure hs_init_ghc() sees everything it needs to see. __attribute__((constructor(102))) static void __ghc_wasm_jsffi_init(void) { - // See - // https://gitlab.haskell.org/ghc/wasi-libc/-/blob/master/libc-bottom-half/sour... - // for its definition. It initializes some libc state, then calls - // __main_argc_argv defined above. - __main_void(); + // If linking static code without -no-hs-main, then the driver + // emitted main() is in charge of its own RTS initialization, so + // skip. +#if !defined(__PIC__) + if (__main_argc_argv) { + return; + } +#endif + + // Code below is mirrored from + // https://gitlab.haskell.org/haskell-wasm/wasi-libc/-/blob/master/libc-bottom-..., + // fetches argc/argv using wasi api + __wasi_errno_t err; + + // Get the sizes of the arrays we'll have to create to copy in the args. + size_t argv_buf_size; + size_t argc; + err = __wasi_args_sizes_get(&argc, &argv_buf_size); + if (err != __WASI_ERRNO_SUCCESS) { + _Exit(EX_OSERR); + } + + // Add 1 for the NULL pointer to mark the end, and check for overflow. + size_t num_ptrs = argc + 1; + if (num_ptrs == 0) { + _Exit(EX_SOFTWARE); + } + + // Allocate memory for storing the argument chars. + char *argv_buf = malloc(argv_buf_size); + if (argv_buf == NULL) { + _Exit(EX_SOFTWARE); + } + + // Allocate memory for the array of pointers. This uses `calloc` both to + // handle overflow and to initialize the NULL pointer at the end. + char **argv = calloc(num_ptrs, sizeof(char *)); + if (argv == NULL) { + free(argv_buf); + _Exit(EX_SOFTWARE); + } + + // Fill the argument chars, and the argv array with pointers into those chars. + // TODO: Remove the casts on `argv_ptrs` and `argv_buf` once the witx is + // updated with char8 support. + err = __wasi_args_get((uint8_t **)argv, (uint8_t *)argv_buf); + if (err != __WASI_ERRNO_SUCCESS) { + free(argv_buf); + free(argv); + _Exit(EX_OSERR); + } + + // Now that we have argc/argv, proceed to initialize the GHC RTS + RtsConfig __conf = defaultRtsConfig; + __conf.rts_opts_enabled = RtsOptsAll; + __conf.rts_hs_main = false; + hs_init_ghc((int *)&argc, &argv, __conf); + // See Note [threadDelay on wasm] for details. + rts_JSFFI_flag = HS_BOOL_TRUE; + getStablePtr(( + StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure); + rts_threadDelay_impl = getStablePtr(( + StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure); } typedef __externref_t HsJSVal; ===================================== testsuite/driver/testlib.py ===================================== @@ -3005,7 +3005,7 @@ def normalise_errmsg(s: str) -> str: # Emscripten displays cache info and old emcc doesn't support EMCC_LOGGING=0 s = re.sub('cache:INFO: .*\n', '', s) # Old emcc warns when we export HEAP8 but new one requires it (see #26290) - s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','') + 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','') return s ===================================== testsuite/tests/cross/should_run/T26449.hs ===================================== @@ -0,0 +1,16 @@ +import Control.Monad +import GHC.Platform.ArchOS +import GHC.Platform.Host +import System.Info + +main :: IO () +main = + when ((arch, os) /= (arch', os')) $ + fail $ + "System.Info says host platform is " + <> show (arch, os) + <> " but GHC.Platform.Host says " + <> show (arch', os') + where + (arch', os') = + (stringEncodeArch hostPlatformArch, stringEncodeOS hostPlatformOS) ===================================== testsuite/tests/cross/should_run/all.T ===================================== @@ -0,0 +1 @@ +test('T26449', [], compile_and_run, ['']) ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -6363,7 +6363,9 @@ module GHC.RTS.Flags.Experimental where ccsSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, retainerSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, bioSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, - eraSelector :: GHC.Internal.Types.Word} + eraSelector :: GHC.Internal.Types.Word, + closureTypeSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, + infoTableSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String} type RTSFlags :: * data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags} type RtsTime :: * ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -6366,7 +6366,9 @@ module GHC.RTS.Flags.Experimental where ccsSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, retainerSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, bioSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, - eraSelector :: GHC.Internal.Types.Word} + eraSelector :: GHC.Internal.Types.Word, + closureTypeSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String, + infoTableSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String} type RTSFlags :: * data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags} type RtsTime :: * ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -324,10 +324,6 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do ArchOS ArchPPC OSAIX -> -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) - ArchOS ArchJavaScript OSGhcjs -> - -- Since https://github.com/emscripten-core/emscripten/blob/main/ChangeLog.md#407---0... - -- the emcc linker does not export the HEAP8 memory view which is used by the js RTS by default anymore. - return $ ccLink2 & _prgFlags %++ "-sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8" _ -> return ccLink2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77b7dfc021686576418c9fcb19713ce... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77b7dfc021686576418c9fcb19713ce... You're receiving this email because of your account on gitlab.haskell.org.