[Git][ghc/ghc][wip/sjakobi/deprecate-option-v2] 7 commits: docs: mention -hiedir in docs for -outputdir

Simon Jakobi gitlab at gitlab.haskell.org
Wed Jun 24 11:51:41 UTC 2020



Simon Jakobi pushed to branch wip/sjakobi/deprecate-option-v2 at Glasgow Haskell Compiler / GHC


Commits:
1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00
docs: mention -hiedir in docs for -outputdir

[skip ci]

- - - - -
729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00
Hadrian: fix build on Mac OS Catalina (#17798)

- - - - -
95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00
Relax allocation threshold for T12150.

This test performs little work, so the most minor allocation
changes often cause the test to fail.

Increasing the threshold to 2% should help with this.

- - - - -
8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00
hadrian: Bump pinned cabal.project to an existent index-state

- - - - -
08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00
Fix uninitialized field read in Linker.c

Valgrind report of the bug when running the test `linker_unload`:

    ==29666== Conditional jump or move depends on uninitialised value(s)
    ==29666==    at 0x369C5B4: setOcInitialStatus (Linker.c:1305)
    ==29666==    by 0x369C6C5: mkOc (Linker.c:1347)
    ==29666==    by 0x36C027A: loadArchive_ (LoadArchive.c:522)
    ==29666==    by 0x36C0600: loadArchive (LoadArchive.c:626)
    ==29666==    by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload)
    ==29666==
    ==29666== Conditional jump or move depends on uninitialised value(s)
    ==29666==    at 0x369C5B4: setOcInitialStatus (Linker.c:1305)
    ==29666==    by 0x369C6C5: mkOc (Linker.c:1347)
    ==29666==    by 0x369C9F6: preloadObjectFile (Linker.c:1507)
    ==29666==    by 0x369CA8D: loadObj_ (Linker.c:1536)
    ==29666==    by 0x369CB17: loadObj (Linker.c:1557)
    ==29666==    by 0x3866BC: main (linker_unload.c:33)

The problem is `mkOc` allocates a new `ObjectCode` and calls
`setOcInitialStatus` without initializing the `status` field.
`setOcInitialStatus` reads the field as first thing:

    static void setOcInitialStatus(ObjectCode* oc) {
        if (oc->status == OBJECT_DONT_RESOLVE)
          return;

        if (oc->archiveMemberName == NULL) {
            oc->status = OBJECT_NEEDED;
        } else {
            oc->status = OBJECT_LOADED;
        }
    }

`setOcInitialStatus` is unsed in two places for two different purposes:
in `mkOc` where we don't have the `status` field initialized yet (`mkOc`
is supposed to initialize it), and `loadOc` where we do have `status`
field initialized and we want to update it. Instead of splitting the
function into two functions which are both called just once I inline the
functions in the use sites and remove it.

Fixes #18342

- - - - -
da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00
fix windows bootstrap due to linker changes

- - - - -
83a5500e by Simon Jakobi at 2020-06-24T13:50:09+02:00
Deprecate Data.Semigroup.Option

Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html

GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028

Corresponding PRs for deepseq:
* https://github.com/haskell/deepseq/pull/55
* https://github.com/haskell/deepseq/pull/57

Bumps the deepseq submodule.

- - - - -


13 changed files:

- docs/users_guide/separate_compilation.rst
- hadrian/cabal.project
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/Data/Semigroup.hs
- libraries/base/changelog.md
- libraries/deepseq
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PathUtils.h
- rts/linker/LoadArchive.c
- rts/linker/PEi386.c
- testsuite/tests/perf/compiler/all.T


Changes:

=====================================
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


=====================================
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/Builders/Ghc.hs
=====================================
@@ -153,6 +153,7 @@ findHsDependencies = builder (Ghc FindHsDependencies) ? do
             , ghcVersion > [8,9,0] ? arg "-include-cpp-deps"
 
             , commonGhcArgs
+            , defaultGhcWarningsArgs
             , arg "-include-pkg-deps"
             , arg "-dep-makefile", arg =<< getOutput
             , pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]


=====================================
hadrian/src/Settings/Warnings.hs
=====================================
@@ -11,7 +11,9 @@ 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 ? arg "-optc-Wno-unknown-pragmas"
+    , arg "-optP-Wno-nonportable-include-path" -- #17798
+    ]
 
 -- | Package-specific warnings-related arguments, mostly suppressing various warnings.
 ghcWarningsArgs :: Args


=====================================
libraries/base/Data/Semigroup.hs
=====================================
@@ -350,8 +350,6 @@ instance Bifoldable Arg where
 instance Bitraversable Arg where
   bitraverse f g (Arg a b) = Arg <$> f a <*> g b
 
--- | Use @'Option' ('First' a)@ to get the behavior of
--- 'Data.Monoid.First' from "Data.Monoid".
 newtype First a = First { getFirst :: a }
   deriving ( Bounded  -- ^ @since 4.9.0.0
            , Eq       -- ^ @since 4.9.0.0
@@ -408,8 +406,6 @@ instance Monad First where
 instance MonadFix First where
   mfix f = fix (f . getFirst)
 
--- | Use @'Option' ('Last' a)@ to get the behavior of
--- 'Data.Monoid.Last' from "Data.Monoid"
 newtype Last a = Last { getLast :: a }
   deriving ( Bounded  -- ^ @since 4.9.0.0
            , Eq       -- ^ @since 4.9.0.0
@@ -514,6 +510,8 @@ mtimesDefault n x
   | n == 0    = mempty
   | otherwise = unwrapMonoid (stimes n (WrapMonoid x))
 
+{-# DEPRECATED Option, option "will be removed in GHC 8.14; use 'Maybe' instead." #-}
+
 -- | 'Option' is effectively 'Maybe' with a better instance of
 -- 'Monoid', built off of an underlying 'Semigroup' instead of an
 -- underlying 'Monoid'.
@@ -523,8 +521,7 @@ mtimesDefault n x
 --
 -- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been
 -- corrected to lift a 'Semigroup' instance instead of a 'Monoid'
--- instance. Consequently, this type is no longer useful. It will be
--- marked deprecated in GHC 8.8 and removed in GHC 8.10.
+-- instance. Consequently, this type is no longer useful.
 newtype Option a = Option { getOption :: Maybe a }
   deriving ( Eq       -- ^ @since 4.9.0.0
            , Ord      -- ^ @since 4.9.0.0


=====================================
libraries/base/changelog.md
=====================================
@@ -14,6 +14,9 @@
   * The planned deprecation of `Data.Monoid.First` and `Data.Monoid.Last`
     is scrapped due to difficulties with the suggested migration path.
 
+  * `Data.Semigroup.Option` and the accompanying `option` function are
+    deprecated and scheduled for removal in 4.16.
+
   * Add `Generic` instances to `Fingerprint`, `GiveGCStats`, `GCFlags`,
     `ConcFlags`, `DebugFlags`, `CCFlags`, `DoHeapProfile`, `ProfFlags`,
     `DoTrace`, `TraceFlags`, `TickyFlags`, `ParFlags`, `RTSFlags`, `RTSStats`,


=====================================
libraries/deepseq
=====================================
@@ -1 +1 @@
-Subproject commit 13c1c84415da727ab56e9fa33aca5046b6683848
+Subproject commit 0ade68f6f54d621132e9bb5f9e3c5fe01f45091f


=====================================
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",
@@ -1297,26 +1291,9 @@ void freeObjectCode (ObjectCode *oc)
     stgFree(oc);
 }
 
-/* -----------------------------------------------------------------------------
-* Sets the initial status of a fresh ObjectCode
-*/
-static void setOcInitialStatus(ObjectCode* oc) {
-    /* If a target has requested the ObjectCode not to be resolved then
-       honor this requests.  Usually this means the ObjectCode has not been
-       initialized and can't be.  */
-    if (oc->status == OBJECT_DONT_RESOLVE)
-      return;
-
-    if (oc->archiveMemberName == NULL) {
-        oc->status = OBJECT_NEEDED;
-    } else {
-        oc->status = OBJECT_LOADED;
-    }
-}
-
 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,14 +1316,18 @@ 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;
    }
 
-   setOcInitialStatus( oc );
+   if (oc->archiveMemberName == NULL) {
+       oc->status = OBJECT_NEEDED;
+   } else {
+       oc->status = OBJECT_LOADED;
+   }
 
    oc->fileSize          = imageSize;
    oc->n_symbols         = 0;
@@ -1638,8 +1619,17 @@ HsInt loadOc (ObjectCode* oc)
 #  endif
 #endif
 
-   /* loaded, but not resolved yet, ensure the OC is in a consistent state */
-   setOcInitialStatus( oc );
+   /* Loaded, but not resolved yet, ensure the OC is in a consistent state.
+      If a target has requested the ObjectCode not to be resolved then honor
+      this requests.  Usually this means the ObjectCode has not been initialized
+      and can't be. */
+   if (oc->status != OBJECT_DONT_RESOLVE) {
+       if (oc->archiveMemberName == NULL) {
+           oc->status = OBJECT_NEEDED;
+       } else {
+           oc->status = OBJECT_LOADED;
+       }
+   }
    IF_DEBUG(linker, debugBelch("loadOc: done.\n"));
 
    return 1;
@@ -1743,7 +1733,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
=====================================
@@ -234,9 +234,14 @@ test('T12707',
      compile,
      [''])
 
+# This test is meant to test regressions involving the
+# pattern match checker. Any regression there will show
+# up massively, but otherwise it hardly allocates. So we
+# are slightly more generous with the allocation threshold
+# to avoid spurious errors.
 test('T12150',
      [ only_ways(['optasm']),
-       collect_compiler_stats('bytes allocated', 1)
+       collect_compiler_stats('bytes allocated', 2)
      ],
     compile,
      [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d5f22c88afc62e9d4b53aeb0b5b60ae6fe0f6ea...83a5500e4f1b4a0e5c1a46a3f17bc9011f430a21

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d5f22c88afc62e9d4b53aeb0b5b60ae6fe0f6ea...83a5500e4f1b4a0e5c1a46a3f17bc9011f430a21
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/20200624/72f3e5cd/attachment-0001.html>


More information about the ghc-commits mailing list