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

Commits:

13 changed files:

Changes:

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -165,7 +165,7 @@ import GHC.JS.Syntax
    165 165
    166 166 
     import GHC.IfaceToCore  ( typecheckIface, typecheckWholeCoreBindings )
    167 167
    168 
    -import GHC.Iface.Load   ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface )
    168 
    +import GHC.Iface.Load   ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface, loadSysInterface )
    169 169 
     import GHC.Iface.Make
    170 170 
     import GHC.Iface.Recomp
    171 171 
     import GHC.Iface.Tidy
    ... ... @@ -1765,7 +1765,7 @@ hscCheckSafe' m l = do
    1765 1765 
             -- so we need to call 'getModuleInterface' to load from disk
    1766 1766 
             case iface of
    1767 1767 
                 Just _  -> return iface
    1768 
    -            Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)
    1768 
    +            Nothing -> liftIO $ initIfaceLoad hsc_env (Just <$> loadSysInterface (text "checkSafeImports") m)
    1769 1769
    1770 1770
    1771 1771 
     -- | Check the list of packages are trusted.

  • docs/users_guide/profiling.rst
    ... ... @@ -1003,6 +1003,11 @@ follows:
    1003 1003 
         The flags below are marked with ``:noindex:`` to avoid duplicate
    1004 1004 
         ID warnings from Sphinx.
    1005 1005
    1006 
    +.. rts-flag:: -hT ⟨type⟩
    1007 
    +    :noindex:
    1008 
    +
    1009 
    +    Restrict the profile to closures with the specified closure types.
    1010 
    +
    1006 1011 
     .. rts-flag:: -hc ⟨name⟩
    1007 1012 
         :noindex:
    1008 1013
    ... ... @@ -1050,6 +1055,13 @@ follows:
    1050 1055 
         biographies, where ⟨bio⟩ is one of ``lag``, ``drag``, ``void``, or
    1051 1056 
         ``use``.
    1052 1057
    1058 
    +.. rts-flag:: -hi ⟨addr⟩
    1059 
    +    :noindex:
    1060 
    +
    1061 
    +    Restrict the profile to closures with specified info table addresses. The
    1062 
    +    address should start with ``0x`` and be lowercase hexadecimal, just like the
    1063 
    +    addresses produced by :rts-flag:`-hi`.
    1064 
    +
    1053 1065 
     For example, the following options will generate a retainer profile
    1054 1066 
     restricted to ``Branch`` and ``Leaf`` constructors:
    1055 1067

  • hadrian/src/Rules/Generate.hs
    ... ... @@ -606,8 +606,12 @@ generateVersionHs = do
    606 606 
     generatePlatformHostHs :: Expr String
    607 607 
     generatePlatformHostHs = do
    608 608 
         trackGenerateHs
    609 
    -    cHostPlatformArch <- queryHost (archOS_arch . tgtArchOs)
    610 
    -    cHostPlatformOS   <- queryHost (archOS_OS . tgtArchOs)
    609 
    +    stage <- getStage
    610 
    +    let chooseHostQuery = case stage of
    611 
    +            Stage0 {} -> queryHost
    612 
    +            _         -> queryTarget
    613 
    +    cHostPlatformArch <- chooseHostQuery (archOS_arch . tgtArchOs)
    614 
    +    cHostPlatformOS   <- chooseHostQuery (archOS_OS . tgtArchOs)
    611 615 
         return $ unlines
    612 616 
             [ "module GHC.Platform.Host where"
    613 617 
             , ""

  • libraries/base/changelog.md
    ... ... @@ -6,7 +6,6 @@
    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))
    7 7 
       * Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356))
    8 8 
       * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
    9 
    -  * `GHC.Exts.IOPort#` and its related operations have been removed  ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
    10 9 
       * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351))
    11 10 
       * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350))
    12 11 
       * 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 @@
    37 36 
           * `GHC.TypeNats.Internal`
    38 37 
           * `GHC.ExecutionStack.Internal`.
    39 38 
       * Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
    40 
    -
    39 
    +  * `GHC.Exts.IOPort#` and its related operations have been removed  ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
    41 40 
       * 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)).
    42 41 
       * 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)).
    43 42

  • libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
    ... ... @@ -312,6 +312,8 @@ data ProfFlags = ProfFlags
    312 312 
         , retainerSelector         :: Maybe String
    313 313 
         , bioSelector              :: Maybe String
    314 314 
         , eraSelector              :: Word -- ^ @since base-4.20.0.0
    315 
    +    , closureTypeSelector      :: Maybe String
    316 
    +    , infoTableSelector        :: Maybe String
    315 317 
         } deriving ( Show -- ^ @since base-4.8.0.0
    316 318 
                    , Generic -- ^ @since base-4.15.0.0
    317 319 
                    )
    ... ... @@ -613,6 +615,8 @@ getProfFlags = do
    613 615 
                 <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
    614 616 
                 <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)
    615 617 
                 <*> #{peek PROFILING_FLAGS, eraSelector} ptr
    618 
    +            <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, closureTypeSelector} ptr)
    619 
    +            <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, infoTableSelector} ptr)
    616 620
    617 621 
     getTraceFlags :: IO TraceFlags
    618 622 
     getTraceFlags = do

  • rts/ProfHeap.c
    ... ... @@ -181,6 +181,28 @@ static void dumpCensus( Census *census );
    181 181
    182 182 
     static bool closureSatisfiesConstraints( const StgClosure* p );
    183 183
    184 
    +static const char *closureTypeIdentity( const StgClosure *p )
    185 
    +{
    186 
    +    const StgInfoTable *info = get_itbl(p);
    187 
    +    switch (info->type) {
    188 
    +    case CONSTR:
    189 
    +    case CONSTR_1_0:
    190 
    +    case CONSTR_0_1:
    191 
    +    case CONSTR_2_0:
    192 
    +    case CONSTR_1_1:
    193 
    +    case CONSTR_0_2:
    194 
    +    case CONSTR_NOCAF:
    195 
    +        return GET_CON_DESC(itbl_to_con_itbl(info));
    196 
    +    default:
    197 
    +        return closure_type_names[info->type];
    198 
    +    }
    199 
    +}
    200 
    +
    201 
    +static void formatIPELabel( char *str, size_t size, uint64_t table_id )
    202 
    +{
    203 
    +    snprintf(str, size, "0x%" PRIx64, table_id);
    204 
    +}
    205 
    +
    184 206 
     /* ----------------------------------------------------------------------------
    185 207 
      * Find the "closure identity", which is a unique pointer representing
    186 208 
      * the band to which this closure's heap space is attributed in the
    ... ... @@ -215,26 +237,9 @@ closureIdentity( const StgClosure *p )
    215 237 
     #endif
    216 238
    217 239 
         case HEAP_BY_CLOSURE_TYPE:
    218 
    -    {
    219 
    -        const StgInfoTable *info;
    220 
    -        info = get_itbl(p);
    221 
    -        switch (info->type) {
    222 
    -        case CONSTR:
    223 
    -        case CONSTR_1_0:
    224 
    -        case CONSTR_0_1:
    225 
    -        case CONSTR_2_0:
    226 
    -        case CONSTR_1_1:
    227 
    -        case CONSTR_0_2:
    228 
    -        case CONSTR_NOCAF:
    229 
    -            return GET_CON_DESC(itbl_to_con_itbl(info));
    230 
    -        default:
    231 
    -            return closure_type_names[info->type];
    232 
    -        }
    233 
    -    }
    240 
    +        return closureTypeIdentity(p);
    234 241 
         case HEAP_BY_INFO_TABLE:
    235 
    -    {
    236 242 
             return (void *) (p->header.info);
    237 
    -    }
    238 243
    239 244 
         default:
    240 245 
             barf("closureIdentity");
    ... ... @@ -664,6 +669,8 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, uint32_t max_length)
    664 669 
         fprintf(fp, "%s", buf);
    665 670 
     }
    666 671
    672 
    +#endif /* PROFILING */
    673 
    +
    667 674 
     bool
    668 675 
     strMatchesSelector( const char* str, const char* sel )
    669 676 
     {
    ... ... @@ -688,8 +695,6 @@ strMatchesSelector( const char* str, const char* sel )
    688 695 
        }
    689 696 
     }
    690 697
    691 
    -#endif /* PROFILING */
    692 
    -
    693 698 
     /* -----------------------------------------------------------------------------
    694 699 
      * Figure out whether a closure should be counted in this census, by
    695 700 
      * testing against all the specified constraints.
    ... ... @@ -697,11 +702,8 @@ strMatchesSelector( const char* str, const char* sel )
    697 702 
     static bool
    698 703 
     closureSatisfiesConstraints( const StgClosure* p )
    699 704 
     {
    700 
    -#if !defined(PROFILING)
    701 
    -    (void)p;   /* keep gcc -Wall happy */
    702 
    -    return true;
    703 
    -#else
    704 
    -   bool b;
    705 
    +    bool b;
    706 
    +#if defined(PROFILING)
    705 707
    706 708 
        // The CCS has a selected field to indicate whether this closure is
    707 709 
        // deselected by not being mentioned in the module, CC, or CCS
    ... ... @@ -721,7 +723,8 @@ closureSatisfiesConstraints( const StgClosure* p )
    721 723 
            if (!b) return false;
    722 724 
        }
    723 725 
        if (RtsFlags.ProfFlags.eraSelector) {
    724 
    -      return (p->header.prof.hp.era == RtsFlags.ProfFlags.eraSelector);
    726 
    +       b = p->header.prof.hp.era == RtsFlags.ProfFlags.eraSelector;
    727 
    +       if (!b) return false;
    725 728 
        }
    726 729 
        if (RtsFlags.ProfFlags.retainerSelector) {
    727 730 
            RetainerSet *rs;
    ... ... @@ -742,8 +745,21 @@ closureSatisfiesConstraints( const StgClosure* p )
    742 745 
            }
    743 746 
            return false;
    744 747 
        }
    745 
    -   return true;
    748 
    +#else
    749 
    +    if (RtsFlags.ProfFlags.closureTypeSelector) {
    750 
    +        b = strMatchesSelector( closureTypeIdentity(p),
    751 
    +                                RtsFlags.ProfFlags.closureTypeSelector );
    752 
    +        if (!b) return false;
    753 
    +    }
    754 
    +    if (RtsFlags.ProfFlags.infoTableSelector) {
    755 
    +        char str[100];
    756 
    +        formatIPELabel(str, sizeof str, lookupIPEId(p->header.info));
    757 
    +        b = strMatchesSelector( str,
    758 
    +                                RtsFlags.ProfFlags.infoTableSelector );
    759 
    +        if (!b) return false;
    760 
    +    }
    746 761 
     #endif /* PROFILING */
    762 
    +    return true;
    747 763 
     }
    748 764
    749 765 
     /* -----------------------------------------------------------------------------
    ... ... @@ -858,12 +874,11 @@ aggregateCensusInfo( void )
    858 874 
     static void
    859 875 
     recordIPEHeapSample(FILE *hp_file, uint64_t table_id, size_t count)
    860 876 
     {
    861 
    -    // Print to heap profile file
    862 
    -    fprintf(hp_file, "0x%" PRIx64, table_id);
    863 
    -
    864 
    -    // Create label string for tracing
    865 877 
         char str[100];
    866 
    -    sprintf(str, "0x%" PRIx64, table_id);
    878 
    +    formatIPELabel(str, sizeof str, table_id);
    879 
    +
    880 
    +    // Print to heap profile file
    881 
    +    fprintf(hp_file, "%s\t%" FMT_Word "\n", str, (W_)(count * sizeof(W_)));
    867 882
    868 883 
         // Emit the profiling sample (convert count to bytes)
    869 884 
         traceHeapProfSampleString(str, count * sizeof(W_));
    ... ... @@ -961,7 +976,9 @@ dumpCensus( Census *census )
    961 976
    962 977 
             switch (RtsFlags.ProfFlags.doHeapProfile) {
    963 978 
             case HEAP_BY_CLOSURE_TYPE:
    964 
    -            fprintf(hp_file, "%s", (char *)ctr->identity);
    979 
    +            fprintf(hp_file, "%s\t%" FMT_Word "\n",
    980 
    +                    (char *)ctr->identity,
    981 
    +                    (W_)(count * sizeof(W_)));
    965 982 
                 traceHeapProfSampleString((char *)ctr->identity,
    966 983 
                                           count * sizeof(W_));
    967 984 
                 break;
    ... ... @@ -979,19 +996,26 @@ dumpCensus( Census *census )
    979 996 
             case HEAP_BY_CCS:
    980 997 
                 fprint_ccs(hp_file, (CostCentreStack *)ctr->identity,
    981 998 
                            RtsFlags.ProfFlags.ccsLength);
    999 
    +            fprintf(hp_file, "\t%" FMT_Word "\n",
    1000 
    +                    (W_)(count * sizeof(W_)));
    982 1001 
                 traceHeapProfSampleCostCentre((CostCentreStack *)ctr->identity,
    983 1002 
                                               count * sizeof(W_));
    984 1003 
                 break;
    985 1004 
             case HEAP_BY_ERA:
    986 
    -            fprintf(hp_file, "%" FMT_Word, (StgWord)ctr->identity);
    1005 
    +        {
    987 1006 
                 char str_era[100];
    988 
    -            sprintf(str_era, "%" FMT_Word, (StgWord)ctr->identity);
    1007 
    +            snprintf(str_era, sizeof str_era, "%" FMT_Word,
    1008 
    +                     (StgWord)ctr->identity);
    1009 
    +            fprintf(hp_file, "%s\t%" FMT_Word "\n",
    1010 
    +                    str_era, (W_)(count * sizeof(W_)));
    989 1011 
                 traceHeapProfSampleString(str_era, count * sizeof(W_));
    990 1012 
                 break;
    1013 
    +        }
    991 1014 
             case HEAP_BY_MOD:
    992 1015 
             case HEAP_BY_DESCR:
    993 1016 
             case HEAP_BY_TYPE:
    994 
    -            fprintf(hp_file, "%s", (char *)ctr->identity);
    1017 
    +            fprintf(hp_file, "%s\t%" FMT_Word "\n",
    1018 
    +                    (char *)ctr->identity, (W_)(count * sizeof(W_)));
    995 1019 
                 traceHeapProfSampleString((char *)ctr->identity,
    996 1020 
                                           count * sizeof(W_));
    997 1021 
                 break;
    ... ... @@ -1002,29 +1026,28 @@ dumpCensus( Census *census )
    1002 1026 
                 // it might be the distinguished retainer set rs_MANY:
    1003 1027 
                 if (rs == &rs_MANY) {
    1004 1028 
                     fprintf(hp_file, "MANY");
    1005 
    -                break;
    1006 
    -            }
    1029 
    +            } else {
    1007 1030
    1008 
    -            // Mark this retainer set by negating its id, because it
    1009 
    -            // has appeared in at least one census.  We print the
    1010 
    -            // values of all such retainer sets into the log file at
    1011 
    -            // the end.  A retainer set may exist but not feature in
    1012 
    -            // any censuses if it arose as the intermediate retainer
    1013 
    -            // set for some closure during retainer set calculation.
    1014 
    -            if (rs->id > 0)
    1015 
    -                rs->id = -(rs->id);
    1016 
    -
    1017 
    -            // report in the unit of bytes: * sizeof(StgWord)
    1018 
    -            printRetainerSetShort(hp_file, rs, (W_)count * sizeof(W_)
    1019 
    -                                             , RtsFlags.ProfFlags.ccsLength);
    1031 
    +                // Mark this retainer set by negating its id, because it
    1032 
    +                // has appeared in at least one census.  We print the
    1033 
    +                // values of all such retainer sets into the log file at
    1034 
    +                // the end.  A retainer set may exist but not feature in
    1035 
    +                // any censuses if it arose as the intermediate retainer
    1036 
    +                // set for some closure during retainer set calculation.
    1037 
    +                if (rs->id > 0)
    1038 
    +                    rs->id = -(rs->id);
    1039 
    +
    1040 
    +                // report in the unit of bytes: * sizeof(StgWord)
    1041 
    +                printRetainerSetShort(hp_file, rs, (W_)(count * sizeof(W_))
    1042 
    +                                                , RtsFlags.ProfFlags.ccsLength);
    1043 
    +            }
    1044 
    +            fprintf(hp_file, "\t%" FMT_Word "\n", (W_)(count * sizeof(W_)));
    1020 1045 
                 break;
    1021 1046 
             }
    1022 1047 
     #endif
    1023 1048 
             default:
    1024 1049 
                 barf("dumpCensus; doHeapProfile");
    1025 1050 
             }
    1026 
    -
    1027 
    -        fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_));
    1028 1051 
         }
    1029 1052
    1030 1053 
         // 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
    237 237 
                 // size = strlen(tmp);
    238 238 
             }
    239 239 
         }
    240 
    -    fputs(tmp, f);
    240 
    +    fprintf(f, "%s\t%" FMT_Word "\n", tmp, total_size);
    241 241 
         traceHeapProfSampleString(tmp, total_size);
    242 242 
     }
    243 243

  • rts/RtsFlags.c
    ... ... @@ -112,9 +112,7 @@ static void bad_option (const char *s);
    112 112 
     static void read_debug_flags(const char *arg);
    113 113 
     #endif
    114 114
    115 
    -#if defined(PROFILING)
    116 115 
     static bool read_heap_profiling_flag(const char *arg);
    117 
    -#endif
    118 116
    119 117 
     #if defined(TRACING)
    120 118 
     static void read_trace_flags(const char *arg);
    ... ... @@ -237,6 +235,9 @@ void initRtsFlagsDefaults(void)
    237 235 
         RtsFlags.ProfFlags.eraSelector        = 0;
    238 236 
     #endif
    239 237
    238 
    +    RtsFlags.ProfFlags.closureTypeSelector = NULL;
    239 
    +    RtsFlags.ProfFlags.infoTableSelector   = NULL;
    240 
    +
    240 241 
     #if defined(TRACING)
    241 242 
         RtsFlags.TraceFlags.tracing       = TRACE_NONE;
    242 243 
         RtsFlags.TraceFlags.timestamp     = false;
    ... ... @@ -403,6 +404,8 @@ usage_text[] = {
    403 404 
     "    -hr<cc>...   closures with specified retainers",
    404 405 
     "    -hb<bio>...  closures with specified biographies (lag,drag,void,use)",
    405 406 
     "    -he<era>...  closures with specified era",
    407 
    +"    -hT<typ>,... specified closure types",
    408 
    +"    -hi<adr>,... closures with specified info table addresses",
    406 409 
     "",
    407 410 
     "  -R<size>       Set the maximum retainer set size (default: 8)",
    408 411 
     "",
    ... ... @@ -418,6 +421,9 @@ usage_text[] = {
    418 421 
     "  -h       Heap residency profile (output file <program>.hp)",
    419 422 
     "  -hT      Produce a heap profile grouped by closure type",
    420 423 
     "  -hi      Produce a heap profile grouped by info table address",
    424 
    +"  A subset of closures may be selected thusly:",
    425 
    +"    -hT<typ>,... specified closure types",
    426 
    +"    -hi<adr>,... closures with specified info table addresses",
    421 427 
     "  -po<file>  Override profiling output file name prefix (program name by default)",
    422 428 
     #endif /* PROFILING */
    423 429
    ... ... @@ -924,11 +930,10 @@ error = true;
    924 930 
     #endif
    925 931
    926 932 
     #if defined(PROFILING)
    927 
    -# define PROFILING_BUILD_ONLY(x)   x
    933 
    +# define PROFILING_BUILD_ONLY(_arg, x)   x
    928 934 
     #else
    929 
    -# define PROFILING_BUILD_ONLY(x) \
    930 
    -errorBelch("the flag %s requires the program to be built with -prof", \
    931 
    -           rts_argv[arg]);                                            \
    935 
    +# define PROFILING_BUILD_ONLY(arg, x) \
    936 
    +errorBelch("the flag %s requires the program to be built with -prof", arg); \
    932 937 
     error = true;
    933 938 
     #endif
    934 939
    ... ... @@ -1485,11 +1490,11 @@ error = true;
    1485 1490 
                           RtsFlags.CcFlags.outputFileNameStem = rts_argv[arg]+3;
    1486 1491 
                           break;
    1487 1492 
                       default:
    1488 
    -                      PROFILING_BUILD_ONLY();
    1493 
    +                      PROFILING_BUILD_ONLY(rts_argv[arg],);
    1489 1494
    1490 1495 
                     } break;
    1491 1496 
     #else
    1492 
    -                PROFILING_BUILD_ONLY(
    1497 
    +                PROFILING_BUILD_ONLY(rts_argv[arg],
    1493 1498 
                     switch (rts_argv[arg][2]) {
    1494 1499 
                       case 'a':
    1495 1500 
                         RtsFlags.CcFlags.doCostCentres = COST_CENTRES_ALL;
    ... ... @@ -1527,43 +1532,25 @@ error = true;
    1527 1532
    1528 1533 
                   case 'R':
    1529 1534 
                       OPTION_SAFE;
    1530 
    -                  PROFILING_BUILD_ONLY(
    1535 
    +                  PROFILING_BUILD_ONLY(rts_argv[arg],
    1531 1536 
                           RtsFlags.ProfFlags.maxRetainerSetSize =
    1532 1537 
                             atof(rts_argv[arg]+2);
    1533 1538 
                       ) break;
    1534 1539 
                   case 'L':
    1535 1540 
                       OPTION_SAFE;
    1536 
    -                  PROFILING_BUILD_ONLY(
    1541 
    +                  PROFILING_BUILD_ONLY(rts_argv[arg],
    1537 1542 
                           RtsFlags.ProfFlags.ccsLength = atof(rts_argv[arg]+2);
    1538 1543 
                           if(RtsFlags.ProfFlags.ccsLength <= 0) {
    1539 1544 
                             bad_option(rts_argv[arg]);
    1540 1545 
                           }
    1541 1546 
                       ) break;
    1542 1547 
                   case 'h': /* serial heap profile */
    1543 
    -#if !defined(PROFILING)
    1544 
    -                switch (rts_argv[arg][2]) {
    1545 
    -                  case '\0':
    1546 
    -                    errorBelch("-h is deprecated, use -hT instead.");
    1547 
    -
    1548 
    -                    FALLTHROUGH;
    1549 
    -                  case 'T':
    1550 
    -                    OPTION_UNSAFE;
    1551 
    -                    RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
    1552 
    -                    break;
    1553 
    -                  case 'i':
    1554 
    -                    OPTION_UNSAFE;
    1555 
    -                    RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE;
    1556 
    -                    break;
    1557 
    -                  default:
    1558 
    -                    OPTION_SAFE;
    1559 
    -                    PROFILING_BUILD_ONLY();
    1560 
    -                }
    1561 
    -#else
    1548 
    +#if defined(PROFILING)
    1562 1549 
                     OPTION_SAFE;
    1563 
    -                PROFILING_BUILD_ONLY(
    1564 
    -                    error = read_heap_profiling_flag(rts_argv[arg]);
    1565 
    -                );
    1566 
    -#endif /* PROFILING */
    1550 
    +#else
    1551 
    +                OPTION_UNSAFE;
    1552 
    +#endif
    1553 
    +                error = read_heap_profiling_flag(rts_argv[arg]);
    1567 1554 
                     break;
    1568 1555
    1569 1556 
                   case 'i': /* heap sample interval */
    ... ... @@ -1840,7 +1827,7 @@ error = true;
    1840 1827 
                     case 'c': /* Debugging tool: show current cost centre on
    1841 1828 
                                an exception */
    1842 1829 
                         OPTION_SAFE;
    1843 
    -                    PROFILING_BUILD_ONLY(
    1830 
    +                    PROFILING_BUILD_ONLY(rts_argv[arg],
    1844 1831 
                             RtsFlags.ProfFlags.showCCSOnException = true;
    1845 1832 
                             );
    1846 1833 
                         unchecked_arg_start++;
    ... ... @@ -2341,139 +2328,171 @@ static void read_debug_flags(const char* arg)
    2341 2328 
     }
    2342 2329 
     #endif
    2343 2330
    2344 
    -#if defined(PROFILING)
    2345 2331 
     // Parse a "-h" flag, returning whether the parse resulted in an error.
    2346 2332 
     static bool read_heap_profiling_flag(const char *arg)
    2347 2333 
     {
    2348 
    -    // Already parsed "-h"
    2349 
    -
    2334 
    +    // Already parsed arg[0:2] = "-h"
    2350 2335 
         bool error = false;
    2351 
    -    switch (arg[2]) {
    2352 
    -    case '\0':
    2353 
    -      errorBelch("-h is deprecated, use -hc instead.");
    2354 
    -      FALLTHROUGH;
    2355 
    -    case 'C':
    2356 
    -    case 'c':
    2357 
    -    case 'M':
    2358 
    -    case 'm':
    2359 
    -    case 'D':
    2360 
    -    case 'd':
    2361 
    -    case 'Y':
    2362 
    -    case 'y':
    2363 
    -    case 'i':
    2364 
    -    case 'R':
    2365 
    -    case 'r':
    2366 
    -    case 'B':
    2367 
    -    case 'b':
    2368 
    -    case 'e':
    2369 
    -    case 'T':
    2370 
    -        if (arg[2] != '\0' && arg[3] != '\0') {
    2371 
    -            {
    2372 
    -                const char *left  = strchr(arg, '{');
    2373 
    -                const char *right = strrchr(arg, '}');
    2374 
    -
    2375 
    -                // curly braces are optional, for
    2376 
    -                // backwards compat.
    2377 
    -                if (left)
    2378 
    -                    left = left+1;
    2379 
    -                else
    2380 
    -                    left = arg + 3;
    2381 
    -
    2382 
    -                if (!right)
    2383 
    -                    right = arg + strlen(arg);
    2384 
    -
    2385 
    -                char *selector = stgStrndup(left, right - left + 1);
    2386 
    -
    2387 
    -                switch (arg[2]) {
    2388 
    -                case 'c': // cost centre label select
    2389 
    -                    RtsFlags.ProfFlags.ccSelector = selector;
    2390 
    -                    break;
    2391 
    -                case 'C':
    2392 
    -                    RtsFlags.ProfFlags.ccsSelector = selector;
    2393 
    -                    break;
    2394 
    -                case 'M':
    2395 
    -                case 'm': // cost centre module select
    2396 
    -                    RtsFlags.ProfFlags.modSelector = selector;
    2397 
    -                    break;
    2398 
    -                case 'D':
    2399 
    -                case 'd': // closure descr select
    2400 
    -                    RtsFlags.ProfFlags.descrSelector = selector;
    2401 
    -                    break;
    2402 
    -                case 'Y':
    2403 
    -                case 'y': // closure type select
    2404 
    -                    RtsFlags.ProfFlags.typeSelector = selector;
    2405 
    -                    break;
    2406 
    -                case 'R':
    2407 
    -                case 'r': // retainer select
    2408 
    -                    RtsFlags.ProfFlags.retainerSelector = selector;
    2409 
    -                    break;
    2410 
    -                case 'B':
    2411 
    -                case 'b': // biography select
    2412 
    -                    RtsFlags.ProfFlags.bioSelector = selector;
    2413 
    -                    break;
    2414 
    -                case 'E':
    2415 
    -                case 'e': // era select
    2416 
    -                    RtsFlags.ProfFlags.eraSelector = strtoul(selector, (char **) NULL, 10);
    2417 
    -                    break;
    2418 
    -                default:
    2419 
    -                    stgFree(selector);
    2420 
    -                }
    2421 
    -            }
    2422 
    -            break;
    2423 
    -        }
    2336 
    +    char property;
    2337 
    +    const char *filter;
    2338 
    +    if (arg[2] != '\0') {
    2339 
    +        property = arg[2];
    2340 
    +        filter = arg + 3;
    2341 
    +    } else {
    2342 
    +#if defined(PROFILING)
    2343 
    +        errorBelch("-h is deprecated, use -hc instead.");
    2344 
    +        property = 'c';
    2345 
    +        filter = arg + 2;
    2346 
    +#else
    2347 
    +        errorBelch("-h is deprecated, use -hT instead.");
    2348 
    +        property = 'T';
    2349 
    +        filter = arg + 2;
    2350 
    +#endif
    2351 
    +    }
    2352 
    +    // here property is initialized, and filter is a pointer inside arg
    2424 2353
    2425 
    -        if (RtsFlags.ProfFlags.doHeapProfile != 0) {
    2426 
    -            errorBelch("multiple heap profile options");
    2427 
    -            error = true;
    2428 
    -            break;
    2429 
    -        }
    2354 
    +    if (filter[0] != '\0') {
    2355 
    +        // For backwards compat, extract the portion between curly braces, else
    2356 
    +        // use the entire string
    2357 
    +        const char *left = strchr(filter, '{');
    2358 
    +        const char *right = strrchr(filter, '}');
    2430 2359
    2431 
    -        switch (arg[2]) {
    2432 
    -        case '\0':
    2360 
    +        if (left)
    2361 
    +            left = left + 1;
    2362 
    +        else
    2363 
    +            left = filter;
    2364 
    +
    2365 
    +        if (!right)
    2366 
    +            right = filter + strlen(filter);
    2367 
    +
    2368 
    +        char *selector = stgStrndup(left, right - left);
    2369 
    +        switch (property) {
    2370 
    +#if defined(PROFILING)
    2371 
    +        case 'c': // cost centre label select
    2372 
    +            RtsFlags.ProfFlags.ccSelector = selector;
    2373 
    +            break;
    2433 2374 
             case 'C':
    2434 
    -        case 'c':
    2435 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
    2375 
    +            RtsFlags.ProfFlags.ccsSelector = selector;
    2436 2376 
                 break;
    2437 2377 
             case 'M':
    2438 
    -        case 'm':
    2439 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
    2378 
    +        case 'm': // cost centre module select
    2379 
    +            RtsFlags.ProfFlags.modSelector = selector;
    2440 2380 
                 break;
    2441 2381 
             case 'D':
    2442 
    -        case 'd':
    2443 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
    2382 
    +        case 'd': // closure descr select
    2383 
    +            RtsFlags.ProfFlags.descrSelector = selector;
    2444 2384 
                 break;
    2445 2385 
             case 'Y':
    2446 
    -        case 'y':
    2447 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
    2386 
    +        case 'y': // closure type select
    2387 
    +            RtsFlags.ProfFlags.typeSelector = selector;
    2448 2388 
                 break;
    2449 
    -        case 'i':
    2450 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE;
    2389 
    +        case 'R':
    2390 
    +        case 'r': // retainer select
    2391 
    +            RtsFlags.ProfFlags.retainerSelector = selector;
    2451 2392 
                 break;
    2393 
    +        case 'B':
    2394 
    +        case 'b': // biography select
    2395 
    +            RtsFlags.ProfFlags.bioSelector = selector;
    2396 
    +            break;
    2397 
    +        case 'E':
    2398 
    +        case 'e': // era select
    2399 
    +            RtsFlags.ProfFlags.eraSelector = strtoul(selector, (char **) NULL, 10);
    2400 
    +            break;
    2401 
    +#else
    2402 
    +        case 'c':
    2403 
    +        case 'C':
    2404 
    +        case 'M':
    2405 
    +        case 'm':
    2406 
    +        case 'D':
    2407 
    +        case 'd':
    2408 
    +        case 'Y':
    2409 
    +        case 'y':
    2452 2410 
             case 'R':
    2453 2411 
             case 'r':
    2454 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER;
    2455 
    -            break;
    2456 2412 
             case 'B':
    2457 2413 
             case 'b':
    2458 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV;
    2414 
    +        case 'E':
    2415 
    +        case 'e':
    2416 
    +            PROFILING_BUILD_ONLY(arg,);
    2459 2417 
                 break;
    2460 
    -        case 'T':
    2461 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
    2418 
    +        case 'T': /* closure type select */
    2419 
    +            RtsFlags.ProfFlags.closureTypeSelector = selector;
    2462 2420 
                 break;
    2463 
    -        case 'e':
    2464 
    -            RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_ERA;
    2421 
    +        case 'i': /* info table select */
    2422 
    +            RtsFlags.ProfFlags.infoTableSelector = selector;
    2465 2423 
                 break;
    2466 
    -        }
    2467 
    -        break;
    2468 2424
    2469 
    -    default:
    2470 
    -        errorBelch("invalid heap profile option: %s", arg);
    2471 
    -        error = true;
    2425 
    +#endif /* PROFILING */
    2426 
    +        default:
    2427 
    +            stgFree(selector);
    2428 
    +        }
    2429 
    +    } else {
    2430 
    +        if (RtsFlags.ProfFlags.doHeapProfile != 0) {
    2431 
    +            errorBelch("multiple heap profile options");
    2432 
    +            error = true;
    2433 
    +        } else {
    2434 
    +            switch (property) {
    2435 
    +#if defined(PROFILING)
    2436 
    +            case 'C':
    2437 
    +            case 'c':
    2438 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
    2439 
    +                break;
    2440 
    +            case 'M':
    2441 
    +            case 'm':
    2442 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
    2443 
    +                break;
    2444 
    +            case 'D':
    2445 
    +            case 'd':
    2446 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
    2447 
    +                break;
    2448 
    +            case 'Y':
    2449 
    +            case 'y':
    2450 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
    2451 
    +                break;
    2452 
    +            case 'R':
    2453 
    +            case 'r':
    2454 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER;
    2455 
    +                break;
    2456 
    +            case 'B':
    2457 
    +            case 'b':
    2458 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV;
    2459 
    +                break;
    2460 
    +            case 'e':
    2461 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_ERA;
    2462 
    +                break;
    2463 
    +#else
    2464 
    +            case 'C':
    2465 
    +            case 'c':
    2466 
    +            case 'M':
    2467 
    +            case 'm':
    2468 
    +            case 'D':
    2469 
    +            case 'd':
    2470 
    +            case 'Y':
    2471 
    +            case 'y':
    2472 
    +            case 'R':
    2473 
    +            case 'r':
    2474 
    +            case 'B':
    2475 
    +            case 'b':
    2476 
    +            case 'e':
    2477 
    +                PROFILING_BUILD_ONLY(arg,);
    2478 
    +                break;
    2479 
    +#endif /* PROFILING*/
    2480 
    +            case 'T':
    2481 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
    2482 
    +                break;
    2483 
    +            case 'i':
    2484 
    +                RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFO_TABLE;
    2485 
    +                break;
    2486 
    +            default:
    2487 
    +                errorBelch("invalid heap profile option: %s", arg);
    2488 
    +                error = true;
    2489 
    +                break;
    2490 
    +            }
    2491 
    +        }
    2472 2492 
         }
    2473 2493
    2474 2494 
         return error;
    2475 2495 
     }
    2476 
    -#endif
    2477 2496
    2478 2497 
     #if defined(TRACING)
    2479 2498 
     static void read_trace_flags(const char *arg)

  • rts/include/rts/Flags.h
    ... ... @@ -170,6 +170,8 @@ typedef struct _PROFILING_FLAGS {
    170 170 
         const char*         retainerSelector;
    171 171 
         StgWord             eraSelector;
    172 172 
         const char*         bioSelector;
    173 
    +    const char*         closureTypeSelector;
    174 
    +    const char*         infoTableSelector;
    173 175
    174 176 
     } PROFILING_FLAGS;
    175 177

  • testsuite/tests/cross/should_run/T26449.hs
    1 
    +import Control.Monad
    2 
    +import GHC.Platform.ArchOS
    3 
    +import GHC.Platform.Host
    4 
    +import System.Info
    5 
    +
    6 
    +main :: IO ()
    7 
    +main =
    8 
    +  when ((arch, os) /= (arch', os')) $
    9 
    +    fail $
    10 
    +      "System.Info says host platform is "
    11 
    +        <> show (arch, os)
    12 
    +        <> " but GHC.Platform.Host says "
    13 
    +        <> show (arch', os')
    14 
    +  where
    15 
    +    (arch', os') =
    16 
    +      (stringEncodeArch hostPlatformArch, stringEncodeOS hostPlatformOS)

  • testsuite/tests/cross/should_run/all.T
    1 
    +test('T26449', [], compile_and_run, [''])

  • testsuite/tests/interface-stability/ghc-experimental-exports.stdout
    ... ... @@ -6363,7 +6363,9 @@ module GHC.RTS.Flags.Experimental where
    6363 6363 
                      ccsSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6364 6364 
                      retainerSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6365 6365 
                      bioSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6366 
    -                 eraSelector :: GHC.Internal.Types.Word}
    6366 
    +                 eraSelector :: GHC.Internal.Types.Word,
    6367 
    +                 closureTypeSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6368 
    +                 infoTableSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String}
    6367 6369 
       type RTSFlags :: *
    6368 6370 
       data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
    6369 6371 
       type RtsTime :: *

  • testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
    ... ... @@ -6366,7 +6366,9 @@ module GHC.RTS.Flags.Experimental where
    6366 6366 
                      ccsSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6367 6367 
                      retainerSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6368 6368 
                      bioSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6369 
    -                 eraSelector :: GHC.Internal.Types.Word}
    6369 
    +                 eraSelector :: GHC.Internal.Types.Word,
    6370 
    +                 closureTypeSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String,
    6371 
    +                 infoTableSelector :: GHC.Internal.Maybe.Maybe GHC.Internal.Base.String}
    6370 6372 
       type RTSFlags :: *
    6371 6373 
       data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags, hpcFlags :: HpcFlags}
    6372 6374 
       type RtsTime :: *

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