[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Build with threaded runtime if available
Marge Bot
gitlab at gitlab.haskell.org
Wed Jun 17 20:05:22 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00
hadrian: Build with threaded runtime if available
See #16873.
- - - - -
0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00
T16190: only measure bytes_allocated
Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics
fluctuate by 13%.
- - - - -
4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00
docs: fix formatting in users guide
- - - - -
eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00
Move CLabel assertions into smart constructors (#17957)
It avoids using DynFlags in the Outputable instance of Clabel to check
assertions at pretty-printing time.
- - - - -
244af69d by Adam Sandberg Ericsson at 2020-06-17T16:05:01-04:00
docs: mention -hiedir in docs for -outputdir
[skip ci]
- - - - -
3ecd23eb by Sylvain Henry at 2020-06-17T16:05:06-04:00
Hadrian: fix build on Mac OS Catalina (#17798)
- - - - -
50419833 by Sebastian Graf at 2020-06-17T16:05:06-04:00
hadrian: Bump pinned cabal.project to an existent index-state
- - - - -
3f9c6132 by Tamar Christina at 2020-06-17T16:05:12-04:00
fix windows bootstrap due to linker changes
- - - - -
17 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/StgToCmm/Closure.hs
- docs/users_guide/8.12.1-notes.rst
- docs/users_guide/extending_ghc.rst
- docs/users_guide/exts/explicit_forall.rst
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/separate_compilation.rst
- docs/users_guide/using-warnings.rst
- hadrian/build-cabal
- hadrian/cabal.project
- hadrian/src/Settings/Warnings.hs
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PathUtils.h
- rts/linker/LoadArchive.c
- rts/linker/PEi386.c
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -567,17 +567,27 @@ mkLocalBlockLabel u = LocalBlockLabel u
-- Constructing RtsLabels
mkRtsPrimOpLabel :: PrimOp -> CLabel
-mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
+mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
-mkSelectorInfoLabel :: Bool -> Int -> CLabel
-mkSelectorEntryLabel :: Bool -> Int -> CLabel
-mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
+mkSelectorInfoLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorInfoLabel dflags upd offset =
+ ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+ RtsLabel (RtsSelectorInfoTable upd offset)
-mkApInfoTableLabel :: Bool -> Int -> CLabel
-mkApEntryLabel :: Bool -> Int -> CLabel
-mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
-mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
+mkSelectorEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorEntryLabel dflags upd offset =
+ ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+ RtsLabel (RtsSelectorEntry upd offset)
+
+mkApInfoTableLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApInfoTableLabel dflags upd arity =
+ ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+ RtsLabel (RtsApInfoTable upd arity)
+
+mkApEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApEntryLabel dflags upd arity =
+ ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+ RtsLabel (RtsApEntry upd arity)
-- A call to some primitive hand written Cmm code
@@ -1209,7 +1219,7 @@ pprCLabel dflags = \case
lbl -> getPprStyle $ \sty ->
if useNCG && asmStyle sty
then maybe_underscore $ pprAsmCLbl lbl
- else pprCLbl dflags lbl
+ else pprCLbl platform lbl
where
platform = targetPlatform dflags
@@ -1226,10 +1236,10 @@ pprCLabel dflags = \case
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
= ftext fs <> char '@' <> int sz
- pprAsmCLbl lbl = pprCLbl dflags lbl
+ pprAsmCLbl lbl = pprCLbl platform lbl
-pprCLbl :: DynFlags -> CLabel -> SDoc
-pprCLbl dflags = \case
+pprCLbl :: Platform -> CLabel -> SDoc
+pprCLbl platform = \case
(StringLitLabel u) -> pprUniqueAlways u <> text "_str"
(SRTLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
(LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
@@ -1247,7 +1257,6 @@ pprCLbl dflags = \case
(RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
(RtsLabel (RtsSelectorInfoTable upd_reqd offset)) ->
- ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_info")
@@ -1255,7 +1264,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsSelectorEntry upd_reqd offset)) ->
- ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_entry")
@@ -1263,7 +1271,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsApInfoTable upd_reqd arity)) ->
- ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_info")
@@ -1271,7 +1278,6 @@ pprCLbl dflags = \case
]
(RtsLabel (RtsApEntry upd_reqd arity)) ->
- ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_entry")
@@ -1301,8 +1307,6 @@ pprCLbl dflags = \case
(DynamicLinkerLabel {}) -> panic "pprCLbl DynamicLinkerLabel"
(PicBaseLabel {}) -> panic "pprCLbl PicBaseLabel"
(DeadStripPreventer {}) -> panic "pprCLbl DeadStripPreventer"
- where
- platform = targetPlatform dflags
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <> text
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -637,7 +637,7 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
prof = mkProfilingInfo dflags id val_descr
nonptr_wds = tot_wds - ptr_wds
- info_lbl = mkClosureInfoTableLabel id lf_info
+ info_lbl = mkClosureInfoTableLabel dflags id lf_info
--------------------------------------
-- Other functions over ClosureInfo
@@ -786,14 +786,14 @@ closureLocalEntryLabel dflags
| tablesNextToCode dflags = toInfoLbl . closureInfoLabel
| otherwise = toEntryLbl . closureInfoLabel
-mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
-mkClosureInfoTableLabel id lf_info
+mkClosureInfoTableLabel :: DynFlags -> Id -> LambdaFormInfo -> CLabel
+mkClosureInfoTableLabel dflags id lf_info
= case lf_info of
LFThunk _ _ upd_flag (SelectorThunk offset) _
- -> mkSelectorInfoLabel upd_flag offset
+ -> mkSelectorInfoLabel dflags upd_flag offset
LFThunk _ _ upd_flag (ApThunk arity) _
- -> mkApInfoTableLabel upd_flag arity
+ -> mkApInfoTableLabel dflags upd_flag arity
LFThunk{} -> std_mk_lbl name cafs
LFReEntrant{} -> std_mk_lbl name cafs
@@ -825,13 +825,13 @@ thunkEntryLabel dflags thunk_id c _ _
enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
enterApLabel dflags is_updatable arity
- | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
- | otherwise = mkApEntryLabel is_updatable arity
+ | tablesNextToCode dflags = mkApInfoTableLabel dflags is_updatable arity
+ | otherwise = mkApEntryLabel dflags is_updatable arity
enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
enterSelectorLabel dflags upd_flag offset
- | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
- | otherwise = mkSelectorEntryLabel upd_flag offset
+ | tablesNextToCode dflags = mkSelectorInfoLabel dflags upd_flag offset
+ | otherwise = mkSelectorEntryLabel dflags upd_flag offset
enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
enterIdLabel dflags id c
=====================================
docs/users_guide/8.12.1-notes.rst
=====================================
@@ -21,11 +21,10 @@ Highlights
* Pattern-Match Coverage Checking
- - The revamp of the pattern-match coverage checker that started in 8.10 concludes with this release and implements the
+ - The revamp of the pattern-match coverage checker that started in 8.10 concludes with this release and implements the
novel `*Lower Your Guards* <https://www.microsoft.com/en-us/research/uploads/prod/2020/03/lyg.pdf>`_ algorithm.
- - Compared to 8.10, end users might notice improvements to "long-distance information": :: haskell
+ - Compared to 8.10, end users might notice improvements to "long-distance information": ::
- :linenos:
f True = 1
f x = ... case x of { False -> 2; True -> 3 } ...
@@ -125,14 +124,14 @@ Language
MkT2 :: (forall a. a -> T)
``MkT1`` and ``MkT2`` are rejected because the lack of an outermost
- ``forall`` triggers implicit quantification, making the explicit ``forall``s
+ ``forall`` triggers implicit quantification, making the explicit ``forall``\ s
nested. Furthermore, GADT constructors do not permit the use of nested
- ``forall``s, as explained in :ref:`formal-gadt-syntax`.
+ ``forall``\ s, as explained in :ref:`formal-gadt-syntax`.
- In addition to rejecting nested ``forall``s, GHC is now more stringent about
+ In addition to rejecting nested ``forall``\ s, GHC is now more stringent about
rejecting uses of nested *contexts* in GADT constructors. For example, the
following example, which previous versions of GHC would accept, is now
- rejected:
+ rejected: ::
data U a where
MkU :: (Show a => U a)
=====================================
docs/users_guide/extending_ghc.rst
=====================================
@@ -775,7 +775,7 @@ each case:
package/field-n
To read an interface file from an external tool without linking to GHC, the format
-is described at `Extensible Interface Files<https://gitlab.haskell.org/ghc/ghc/wikis/Extensible-Interface-Files>`_.
+is described at `Extensible Interface Files <https://gitlab.haskell.org/ghc/ghc/wikis/Extensible-Interface-Files>`_.
Source plugin example
^^^^^^^^^^^^^^^^^^^^^
=====================================
docs/users_guide/exts/explicit_forall.rst
=====================================
@@ -112,9 +112,9 @@ Notes:
{-# RULES "f" forall (g :: forall a. a -> b) x. f g x = g x :: b #-}
-- GADT constructors are extra particular about their ``forall``s. In addition
+- GADT constructors are extra particular about their ``forall``\ s. In addition
to adhering to the ``forall``-or-nothing rule, GADT constructors also forbid
- nested ``forall``s. For example, GHC would reject the following GADT: ::
+ nested ``forall``\ s. For example, GHC would reject the following GADT: ::
data T where
MkT :: (forall a. a -> b -> T)
@@ -122,4 +122,4 @@ Notes:
Because of the lack of an outermost ``forall`` in the type of ``MkT``, the
``b`` would be implicitly quantified. In effect, it would be as if one had
written ``MkT :: forall b. (forall a. a -> b -> T)``, which contains nested
- ``forall``s. See :ref:`formal-gadt-syntax`.
+ ``forall``\ s. See :ref:`formal-gadt-syntax`.
=====================================
docs/users_guide/exts/gadt_syntax.rst
=====================================
@@ -161,23 +161,23 @@ Where:
- ``btype`` is a type that is not allowed to have an outermost
``forall``/``=>`` unless it is surrounded by parentheses. For example,
- ``forall a. a`` and ``Eq a => a`` are not legal ``btype``s, but
+ ``forall a. a`` and ``Eq a => a`` are not legal ``btype``\ s, but
``(forall a. a)`` and ``(Eq a => a)`` are legal.
- ``ctype`` is a ``btype`` that has no restrictions on an outermost
- ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``s.
-- ``return_type`` is a type that is not allowed to have ``forall``s, ``=>``s,
- or ``->``s.
+ ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\ s.
+- ``return_type`` is a type that is not allowed to have ``forall``\ s, ``=>``\ s,
+ or ``->``\ s.
This is a simplified grammar that does not fully delve into all of the
implementation details of GHC's parser (such as the placement of Haddock
comments), but it is sufficient to attain an understanding of what is
syntactically allowed. Some further various observations about this grammar:
-- GADT constructor types are currently not permitted to have nested ``forall``s
- or ``=>``s. (e.g., something like ``MkT :: Int -> forall a. a -> T`` would be
+- GADT constructor types are currently not permitted to have nested ``forall``\ s
+ or ``=>``\ s. (e.g., something like ``MkT :: Int -> forall a. a -> T`` would be
rejected.) As a result, ``gadt_sig`` puts all of its quantification and
constraints up front with ``opt_forall`` and ``opt_context``. Note that
- higher-rank ``forall``s and ``=>``s are only permitted if they do not appear
+ higher-rank ``forall``\ s and ``=>``\ s are only permitted if they do not appear
directly to the right of a function arrow in a `prefix_gadt_body`. (e.g.,
something like ``MkS :: Int -> (forall a. a) -> S`` is allowed, since
parentheses separate the ``forall`` from the ``->``.)
=====================================
docs/users_guide/separate_compilation.rst
=====================================
@@ -333,8 +333,8 @@ Redirecting the compilation output(s)
:category:
The ``-outputdir`` option is shorthand for the combination of
- :ghc-flag:`-odir ⟨dir⟩`, :ghc-flag:`-hidir ⟨dir⟩`, :ghc-flag:`-stubdir
- ⟨dir⟩` and :ghc-flag:`-dumpdir ⟨dir⟩`.
+ :ghc-flag:`-odir ⟨dir⟩`, :ghc-flag:`-hidir ⟨dir⟩`, :ghc-flag:`-hiedir ⟨dir⟩`,
+ :ghc-flag:`-stubdir ⟨dir⟩` and :ghc-flag:`-dumpdir ⟨dir⟩`.
.. ghc-flag:: -osuf ⟨suffix⟩
:shortdesc: set the output file suffix
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -239,8 +239,7 @@ of ``-W(no-)*``.
- ``Data.List`` due to the future addition of ``Data.List.singleton`` and
specialisation of exports to the ``[]`` type. See the
- :ref:`mailing list
- <https://groups.google.com/forum/#!topic/haskell-core-libraries/q3zHLmzBa5E>`
+ `mailing list <https://groups.google.com/forum/#!topic/haskell-core-libraries/q3zHLmzBa5E>`_
for details.
This warning can be addressed by either adding an explicit import list or
=====================================
hadrian/build-cabal
=====================================
@@ -1,7 +1,8 @@
#!/usr/bin/env bash
CABAL=cabal
-CABFLAGS="--disable-documentation --disable-profiling --disable-library-profiling $CABFLAGS"
+CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS)
+( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded")
# It is currently more robust to pass Cabal an absolute path to the project file.
PROJ="$PWD/hadrian/cabal.project"
@@ -21,27 +22,13 @@ fi
CABVERSTR=$("$CABAL" --numeric-version)
CABVER=( ${CABVERSTR//./ } )
-build_failed() {
- ( ghc --info | grep -s '("Support SMP","YES")' > /dev/null ) \
- || cat <<EOF
-Your compiler does not support the threaded runtime system.
-Please disable the \`threaded\` Cabal flag in project.cabal.local
-by running:
-
- echo -e "package hadrian\n flags: -threaded" >> project.cabal.local
-
-EOF
- exit 1
-}
-
if [ "${CABVER[0]}" -gt 2 -o "${CABVER[0]}" -eq 2 -a "${CABVER[1]}" -ge 2 ];
then
- "$CABAL" --project-file="$PROJ" new-build $CABFLAGS -j exe:hadrian
+ "$CABAL" --project-file="$PROJ" new-build "${CABFLAGS[@]}" -j exe:hadrian
# use new-exec instead of new-run to make sure that the build-tools (alex & happy) are in PATH
- "$CABAL" --project-file="$PROJ" new-exec $CABFLAGS hadrian -- \
+ "$CABAL" --project-file="$PROJ" new-exec "${CABFLAGS[@]}" hadrian -- \
--directory "$PWD" \
- "$@" \
- || build_failed
+ "$@"
else
echo "Cabal version is too old; you need at least cabal-install 2.2"
exit 2
=====================================
hadrian/cabal.project
=====================================
@@ -1,7 +1,7 @@
packages: ./
-- This essentially freezes the build plan for hadrian
-index-state: 2020-03-28T07:24:23Z
+index-state: 2020-06-16T03:59:14Z
-- N.B. Compile with -O0 since this is not a performance-critical executable
-- and the Cabal takes nearly twice as long to build with -O1. See #16817.
=====================================
hadrian/src/Settings/Warnings.hs
=====================================
@@ -12,7 +12,11 @@ defaultGhcWarningsArgs :: Args
defaultGhcWarningsArgs = mconcat
[ notStage0 ? arg "-Wnoncanonical-monad-instances"
, notM (flag CcLlvmBackend) ? arg "-optc-Wno-error=inline"
- , flag CcLlvmBackend ? arg "-optc-Wno-unknown-pragmas" ]
+ , flag CcLlvmBackend ? mconcat [ arg "-optc-Wno-unknown-pragmas"
+ -- #17798, https://github.com/haskell/cabal/issues/4739
+ , arg "-optP-Wno-nonportable-include-path"
+ ]
+ ]
-- | Package-specific warnings-related arguments, mostly suppressing various warnings.
ghcWarningsArgs :: Args
=====================================
rts/Linker.c
=====================================
@@ -339,7 +339,6 @@ int ghciInsertSymbolTable(
return 1;
}
- pathchar* archiveName = NULL;
debugBelch(
"GHC runtime linker: fatal error: I found a duplicate definition for symbol\n"
" %s\n"
@@ -355,15 +354,10 @@ int ghciInsertSymbolTable(
(char*)key,
obj_name,
pinfo->owner == NULL ? WSTR("(GHCi built-in symbols)") :
- pinfo->owner->archiveMemberName ? archiveName = mkPath(pinfo->owner->archiveMemberName)
+ pinfo->owner->archiveMemberName ? pinfo->owner->archiveMemberName
: pinfo->owner->fileName
);
- if (archiveName)
- {
- stgFree(archiveName);
- archiveName = NULL;
- }
return 0;
}
@@ -873,9 +867,9 @@ SymbolAddr* lookupSymbol_ (SymbolName* lbl)
* Symbol name only used for diagnostics output.
*/
SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo) {
- IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p, owned by %s\n", lbl,
+ IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p, owned by %" PATH_FMT "\n", lbl,
pinfo->value,
- pinfo->owner ? OC_INFORMATIVE_FILENAME(pinfo->owner) : "No owner, probably built-in."));
+ pinfo->owner ? OC_INFORMATIVE_FILENAME(pinfo->owner) : WSTR("No owner, probably built-in.")));
ObjectCode* oc = pinfo->owner;
/* Symbol can be found during linking, but hasn't been relocated. Do so now.
@@ -905,7 +899,7 @@ printLoadedObjects() {
for (oc = objects; oc; oc = oc->next) {
if (oc->sections != NULL) {
int i;
- printf("%s\n", OC_INFORMATIVE_FILENAME(oc));
+ printf("%" PATH_FMT "\n", OC_INFORMATIVE_FILENAME(oc));
for (i=0; i < oc->n_sections; i++) {
if(oc->sections[i].mapped_start != NULL || oc->sections[i].start != NULL) {
printf("\tsec %2d[alloc: %d; kind: %d]: %p - %p; mmaped: %p - %p\n",
@@ -1316,7 +1310,7 @@ static void setOcInitialStatus(ObjectCode* oc) {
ObjectCode*
mkOc( pathchar *path, char *image, int imageSize,
- bool mapped, char *archiveMemberName, int misalignment ) {
+ bool mapped, pathchar *archiveMemberName, int misalignment ) {
ObjectCode* oc;
IF_DEBUG(linker, debugBelch("mkOc: start\n"));
@@ -1339,9 +1333,9 @@ mkOc( pathchar *path, char *image, int imageSize,
oc->fileName = pathdup(path);
if (archiveMemberName) {
- oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1,
+ oc->archiveMemberName = stgMallocBytes( (pathlen(archiveMemberName)+1) * pathsize,
"loadObj" );
- strcpy(oc->archiveMemberName, archiveMemberName);
+ pathcopy(oc->archiveMemberName, archiveMemberName);
} else {
oc->archiveMemberName = NULL;
}
@@ -1743,7 +1737,7 @@ static HsInt resolveObjs_ (void)
r = ocTryLoad(oc);
if (!r)
{
- errorBelch("Could not load Object Code %s.\n", OC_INFORMATIVE_FILENAME(oc));
+ errorBelch("Could not load Object Code %" PATH_FMT ".\n", OC_INFORMATIVE_FILENAME(oc));
IF_DEBUG(linker, printLoadedObjects());
fflush(stderr);
return r;
=====================================
rts/LinkerInternals.h
=====================================
@@ -181,7 +181,7 @@ typedef struct _ObjectCode {
/* If this object is a member of an archive, archiveMemberName is
* like "libarchive.a(object.o)". Otherwise it's NULL.
*/
- char* archiveMemberName;
+ pathchar* archiveMemberName;
/* An array containing ptrs to all the symbol names copied from
this object into the global symbol hash table. This is so that
@@ -348,7 +348,7 @@ resolveSymbolAddr (pathchar* buffer, int size,
HsInt isAlreadyLoaded( pathchar *path );
HsInt loadOc( ObjectCode* oc );
ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
- bool mapped, char *archiveMemberName,
+ bool mapped, pathchar *archiveMemberName,
int misalignment
);
=====================================
rts/PathUtils.h
=====================================
@@ -20,6 +20,7 @@
#define open wopen
#define WSTR(s) L##s
#define pathprintf swprintf
+#define pathcopy wcscpy
#define pathsize sizeof(wchar_t)
#else
#define pathcmp strcmp
@@ -30,6 +31,7 @@
#define WSTR(s) s
#define pathprintf snprintf
#define pathsize sizeof(char)
+#define pathcopy strcpy
#endif
pathchar* pathdup(pathchar *path);
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -483,7 +483,7 @@ static HsInt loadArchive_ (pathchar *path)
DEBUG_LOG("\tisObject = %d\n", isObject);
if (isObject) {
- char *archiveMemberName;
+ pathchar *archiveMemberName;
DEBUG_LOG("Member is an object file...loading...\n");
@@ -515,10 +515,11 @@ static HsInt loadArchive_ (pathchar *path)
}
}
- archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
+ int size = pathlen(path) + thisFileNameSize + 3;
+ archiveMemberName = stgMallocBytes(size * pathsize,
"loadArchive(file)");
- sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
- path, (int)thisFileNameSize, fileName);
+ pathprintf(archiveMemberName, size, WSTR("%" PATH_FMT "(%.*s)"),
+ path, (int)thisFileNameSize, fileName);
oc = mkOc(path, image, memberSize, false, archiveMemberName
, misalignment);
=====================================
rts/linker/PEi386.c
=====================================
@@ -1810,8 +1810,8 @@ makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, char* symbol )
SymbolExtra *extra;
curr_thunk = oc->first_symbol_extra + index;
if (index >= oc->n_symbol_extras) {
- IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%s, index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index));
- barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%s'", symbol, oc->fileName, oc->archiveMemberName);
+ IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%" PATH_FMT ", index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index));
+ barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%" PATH_FMT "'", symbol, oc->fileName, oc->archiveMemberName);
}
extra = oc->symbol_extras + curr_thunk;
@@ -2177,9 +2177,7 @@ resolveSymbolAddr_PEi386 (pathchar* buffer, int size,
wcscat (buffer, WSTR(" "));
if (oc->archiveMemberName)
{
- pathchar* name = mkPath (oc->archiveMemberName);
- wcscat (buffer, name);
- stgFree (name);
+ wcscat (buffer, oc->archiveMemberName);
}
else
{
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -352,7 +352,7 @@ test ('WWRec',
test('T16190',
[ req_th,
unless(have_ncg(), skip), # T16190 tests a NCG feature
- collect_compiler_stats()
+ collect_compiler_stats('bytes allocated',20)
],
multimod_compile,
['T16190.hs', '-v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05df6359f7e82a16a113af9c3317c74188003ad3...3f9c61325bf9c0e79bba0ed710c435bd3b9c202e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05df6359f7e82a16a113af9c3317c74188003ad3...3f9c61325bf9c0e79bba0ed710c435bd3b9c202e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200617/d3eb3c7a/attachment-0001.html>
More information about the ghc-commits
mailing list