[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Define FFI_GO_CLOSURES
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jun 29 23:18:29 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00
Define FFI_GO_CLOSURES
The libffi shipped with Apple's XCode toolchain does not contain a
definition of the FFI_GO_CLOSURES macro, despite containing references
to said macro. Work around this by defining the macro, following the
model of a similar workaround in OpenJDK [1].
[1] https://github.com/openjdk/jdk17u-dev/pull/741/files
- - - - -
d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00
base: Fix incorrect CPP guard
This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`.
- - - - -
7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00
rts/Trace: Ensure that debugTrace arguments are used
As debugTrace is a macro we must take care to ensure that
the fact is clear to the compiler lest we see warnings.
- - - - -
cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00
rts: Various warnings fixes
- - - - -
dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00
hadrian: Ignore warnings in unix and semaphore-compat
- - - - -
75665082 by Matthew Pickering at 2023-06-29T19:18:11-04:00
hadrian: Fix dependencies of docs:* rule
For the docs:* rule we need to actually build the package rather than
just the haddocks for the dependent packages. Therefore we depend on the
.conf files of the packages we are trying to build documentation for as
well as the .haddock files.
Fixes #23472
- - - - -
ae248f33 by sheaf at 2023-06-29T19:18:18-04:00
Add tests for #22106
Fixes #22106
- - - - -
24 changed files:
- compiler/GHC/Driver/CodeOutput.hs
- hadrian/src/Flavour.hs
- hadrian/src/Rules/Documentation.hs
- libraries/base/include/HsBase.h
- libraries/ghci/GHCi/FFI.hsc
- rts/Interpreter.c
- rts/Schedule.c
- rts/Sparks.c
- rts/Trace.h
- rts/TraverseHeap.c
- rts/adjustor/LibffiAdjustor.c
- + rts/include/rts/ghc_ffi.h
- rts/rts.cabal.in
- rts/sm/GC.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- + testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
- + testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs
- testsuite/tests/overloadedrecflds/should_compile/all.T
Changes:
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
-- wrapper code mentions the ffi_arg type, which comes from ffi.h
ffi_includes
- | platformMisc_libFFI $ platformMisc dflags = "#include <ffi.h>\n"
+ | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n"
| otherwise = ""
stub_h_file_exists
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -128,9 +128,13 @@ werror =
? notStage0
? mconcat
[ arg "-Werror"
- , flag CrossCompiling
- ? package unix
+ -- unix has many unused imports
+ , package unix
? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"]
+ -- semaphore-compat relies on sem_getvalue as provided by unix, which is
+ -- not implemented on Darwin and therefore throws a deprecation warning
+ , package semaphoreCompat
+ ? mconcat [arg "-Wwarn=deprecations"]
]
, builder Ghc
? package rts
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -258,6 +258,15 @@ buildPackageDocumentation = do
need [ takeDirectory file -/- "haddock-prologue.txt"]
haddocks <- haddockDependencies context
+ -- Build Haddock documentation
+ -- TODO: Pass the correct way from Rules via Context.
+ dynamicPrograms <- dynamicGhcPrograms =<< flavour
+ let haddockWay = if dynamicPrograms then dynamic else vanilla
+
+ -- Build the dependencies of the package we are going to build documentation for
+ dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p})
+ | (p, _) <- haddocks]
+
-- `ghc-prim` has a source file for 'GHC.Prim' which is generated just
-- for Haddock. We need to 'union' (instead of '++') to avoid passing
-- 'GHC.PrimopWrappers' (which unfortunately shows up in both
@@ -266,12 +275,8 @@ buildPackageDocumentation = do
vanillaSrcs <- hsSources context
let srcs = vanillaSrcs `union` generatedSrcs
- need $ srcs ++ (map snd haddocks)
+ need $ srcs ++ (map snd haddocks) ++ dep_pkgs
- -- Build Haddock documentation
- -- TODO: Pass the correct way from Rules via Context.
- dynamicPrograms <- dynamicGhcPrograms =<< flavour
- let haddockWay = if dynamicPrograms then dynamic else vanilla
statsFilesDir <- haddockStatsFilesDir
createDirectory statsFilesDir
build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file]
=====================================
libraries/base/include/HsBase.h
=====================================
@@ -540,7 +540,7 @@ INLINE int __hscore_open(char *file, int how, mode_t mode) {
}
#endif
-#if darwin_HOST_OS
+#if defined(darwin_HOST_OS)
// You should not access _environ directly on Darwin in a bundle/shared library.
// See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
#include <crt_externs.h>
=====================================
libraries/ghci/GHCi/FFI.hsc
=====================================
@@ -22,6 +22,14 @@
-}
#if !defined(javascript_HOST_ARCH)
+-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h
+-- We can't include ghc_ffi.h here as we must build with stage0
+#if defined(darwin_HOST_OS)
+#if !defined(FFI_GO_CLOSURES)
+#define FFI_GO_CLOSURES 0
+#endif
+#endif
+
#include <ffi.h>
#endif
=====================================
rts/Interpreter.c
=====================================
@@ -39,7 +39,7 @@
#endif
#endif
-#include "ffi.h"
+#include "rts/ghc_ffi.h"
/* --------------------------------------------------------------------------
* The bytecode interpreter
=====================================
rts/Schedule.c
=====================================
@@ -1160,9 +1160,11 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
barf("allocation of %ld bytes too large (GHC should have complained at compile-time)", (long)cap->r.rHpAlloc);
}
+#if defined(DEBUG)
debugTrace(DEBUG_sched,
"--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n",
(long)t->id, what_next_strs[t->what_next], blocks);
+#endif
// don't do this if the nursery is (nearly) full, we'll GC first.
if (cap->r.rCurrentNursery->link != NULL ||
@@ -1231,9 +1233,11 @@ scheduleHandleYield( Capability *cap, StgTSO *t, uint32_t prev_what_next )
// Shortcut if we're just switching evaluators: just run the thread. See
// Note [avoiding threadPaused] in Interpreter.c.
if (t->what_next != prev_what_next) {
+#if defined(DEBUG)
debugTrace(DEBUG_sched,
"--<< thread %ld (%s) stopped to switch evaluators",
(long)t->id, what_next_strs[t->what_next]);
+#endif
return true;
}
@@ -1806,7 +1810,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
}
}
}
- debugTrace(DEBUG_sched, "%d idle caps", n_idle_caps);
+ debugTrace(DEBUG_sched, "%d idle caps, %d failed grabs", n_idle_caps, n_failed_trygrab_idles);
for (i=0; i < n_capabilities; i++) {
NONATOMIC_ADD(&getCapability(i)->idle, 1);
@@ -2643,7 +2647,6 @@ void
scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap)
{
Task *task;
- DEBUG_ONLY( StgThreadID id );
Capability *cap;
cap = *pcap;
@@ -2662,8 +2665,9 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap)
appendToRunQueue(cap,tso);
- DEBUG_ONLY( id = tso->id );
- debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", id);
+ DEBUG_ONLY(
+ debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", (StgThreadID) tso->id);
+ );
// As the TSO is bound and on the run queue, schedule() will run the TSO.
cap = schedule(cap,task);
@@ -2671,7 +2675,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap)
ASSERT(task->incall->rstat != NoStatus);
ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
- debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", id);
+ debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", (StgThreadID) tso->id);
*pcap = cap;
}
@@ -2793,9 +2797,6 @@ exitScheduler (bool wait_foreign USED_IF_THREADS)
shutdownCapabilities(task, wait_foreign);
- // debugBelch("n_failed_trygrab_idles = %d, n_idle_caps = %d\n",
- // n_failed_trygrab_idles, n_idle_caps);
-
exitMyTask();
}
=====================================
rts/Sparks.c
=====================================
@@ -119,11 +119,10 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
{
SparkPool *pool;
StgClosurePtr spark, tmp, *elements;
- uint32_t n, pruned_sparks; // stats only
+ uint32_t pruned_sparks; // stats only
StgInt botInd,oldBotInd,currInd; // indices in array (always < size)
const StgInfoTable *info;
- n = 0;
pruned_sparks = 0;
pool = cap->sparks;
@@ -216,7 +215,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
if (closure_SHOULD_SPARK(tmp)) {
elements[botInd] = tmp; // keep entry (new address)
botInd++;
- n++;
} else {
pruned_sparks++; // discard spark
cap->spark_stats.fizzled++;
@@ -246,7 +244,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
if (closure_SHOULD_SPARK(spark)) {
elements[botInd] = spark; // keep entry (new address)
botInd++;
- n++;
} else {
pruned_sparks++; // discard spark
cap->spark_stats.fizzled++;
@@ -264,7 +261,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap)
// isAlive() also ignores static closures (see GCAux.c)
elements[botInd] = spark; // keep entry (new address)
botInd++;
- n++;
} else {
pruned_sparks++; // discard spark
cap->spark_stats.fizzled++;
=====================================
rts/Trace.h
=====================================
@@ -235,26 +235,25 @@ void traceThreadLabel_(Capability *cap,
char *label,
size_t len);
+
+#if defined(DEBUG)
+#define DEBUG_RTS 1
+#else
+#define DEBUG_RTS 0
+#endif
+
/*
* Emit a debug message (only when DEBUG is defined)
*/
-#if defined(DEBUG)
#define debugTrace(class, msg, ...) \
- if (RTS_UNLIKELY(class)) { \
+ if (DEBUG_RTS && RTS_UNLIKELY(class)) { \
trace_(msg, ##__VA_ARGS__); \
}
-#else
-#define debugTrace(class, str, ...) /* nothing */
-#endif
-#if defined(DEBUG)
-#define debugTraceCap(class, cap, msg, ...) \
- if (RTS_UNLIKELY(class)) { \
+#define debugTraceCap(class, cap, msg, ...) \
+ if (DEBUG_RTS && RTS_UNLIKELY(class)) { \
traceCap_(cap, msg, ##__VA_ARGS__); \
}
-#else
-#define debugTraceCap(class, cap, str, ...) /* nothing */
-#endif
/*
* Emit a message/event describing the state of a thread
=====================================
rts/TraverseHeap.c
=====================================
@@ -48,7 +48,7 @@ static void debug(const char *s, ...)
va_end(ap);
}
#else
-#define debug(...)
+static void debug(const char *s STG_UNUSED, ...) {}
#endif
// number of blocks allocated for one stack
=====================================
rts/adjustor/LibffiAdjustor.c
=====================================
@@ -11,7 +11,7 @@
#include "Hash.h"
#include "Adjustor.h"
-#include "ffi.h"
+#include "rts/ghc_ffi.h"
#include <string.h>
// Note that ffi_alloc_prep_closure is a non-standard libffi closure
=====================================
rts/include/rts/ghc_ffi.h
=====================================
@@ -0,0 +1,28 @@
+/*
+ * <ffi.h> wrapper working around #23586.
+ *
+ * (c) The University of Glasgow 2023
+ *
+ */
+
+#pragma once
+
+/*
+ * Note [FFI_GO_CLOSURES workaround]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * Apple ships a broken libffi with Xcode which lacks a definition of
+ * FFI_GO_CLOSURES despite having references to said macro. Work around this
+ * for now to avoid -Wundef warnings.
+ *
+ * We choose the value zero here by following the model of OpenJDK.
+ * See https://github.com/openjdk/jdk17u-dev/pull/741/files.
+ *
+ * See #23568.
+ */
+#if defined(darwin_HOST_OS)
+#if !defined(FFI_GO_CLOSURES)
+#define FFI_GO_CLOSURES 0
+#endif
+#endif
+
+#include "ffi.h"
=====================================
rts/rts.cabal.in
=====================================
@@ -237,6 +237,7 @@ library
rts/EventLogConstants.h
rts/EventTypes.h
-- ^ generated
+ rts/ghc_ffi.h
rts/Adjustor.h
rts/ExecPage.h
rts/BlockSignals.h
=====================================
rts/sm/GC.c
=====================================
@@ -691,6 +691,7 @@ GarbageCollect (struct GcConfig config,
}
copied += mut_list_size;
+#if defined(DEBUG)
debugTrace(DEBUG_gc,
"mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)",
(unsigned long)(mut_list_size * sizeof(W_)),
@@ -702,6 +703,7 @@ GarbageCollect (struct GcConfig config,
mutlist_scav_stats.n_TREC_CHUNK,
mutlist_scav_stats.n_TREC_HEADER,
mutlist_scav_stats.n_OTHERS);
+#endif
}
bdescr *next, *prev;
=====================================
rts/sm/NonMoving.c
=====================================
@@ -901,14 +901,12 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO *
// updated their snapshot pointers and move them to the sweep list.
for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) {
struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled;
- uint32_t n_filled = 0;
if (filled) {
struct NonmovingSegment *seg = filled;
while (true) {
// Set snapshot
nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free;
SET_SEGMENT_STATE(seg, FILLED_SWEEPING);
- n_filled++;
if (seg->link) {
seg = seg->link;
} else {
@@ -1161,24 +1159,20 @@ void assert_in_nonmoving_heap(StgPtr p)
}
// Search active segments
- int seg_idx = 0;
struct NonmovingSegment *seg = alloca->active;
while (seg) {
if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) {
return;
}
- seg_idx++;
seg = seg->link;
}
// Search filled segments
- seg_idx = 0;
seg = alloca->filled;
while (seg) {
if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) {
return;
}
- seg_idx++;
seg = seg->link;
}
}
=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -268,7 +268,7 @@ void nonmovingMarkInit() {
#endif
}
-#if defined(THREADED_RTS) && defined(DEBUG)
+#if defined(THREADED_RTS)
static uint32_t markQueueLength(MarkQueue *q);
#endif
static void init_mark_queue_(MarkQueue *queue);
@@ -985,7 +985,7 @@ void freeMarkQueue (MarkQueue *queue)
freeChain_lock(queue->blocks);
}
-#if defined(THREADED_RTS) && defined(DEBUG)
+#if defined(THREADED_RTS)
static uint32_t
markQueueLength (MarkQueue *q)
{
=====================================
rts/sm/Storage.c
=====================================
@@ -53,7 +53,7 @@
#include <string.h>
-#include "ffi.h"
+#include "rts/ghc_ffi.h"
/*
* All these globals require sm_mutex to access in THREADED_RTS mode.
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_A where
+
+import T22106_aux ( foo )
+
+xyzzy = foo
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_B where
+
+import T22106_aux ( T(foo) )
+
+xyzzy r = r { foo = 3 }
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_C where
+
+import T22106_aux ( bar )
+
+xyzzy = bar
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T22106_C.hs:5:9: error: [GHC-88464]
+ Variable not in scope: bar
+ Suggested fix:
+ Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’
+ that has been suppressed by NoFieldSelectors.
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_D where
+
+import T22106_aux ( T(bar) )
+
+xyzzy r = r { bar = 7 }
=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoFieldSelectors #-}
+
+module T22106_aux where
+
+data T = MkT { foo :: Int, bar :: Int }
+foo = ()
=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -50,3 +50,8 @@ test('BootFldReexport'
test('T23220'
, [req_th, extra_files(['T23220_aux.hs'])]
, multimod_compile, ['T23220_aux.hs T23220.hs', '-v0'])
+
+test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0'])
+test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0'])
+test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0'])
+test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db699ff60a26760536df825f2ff8329b38a9c0f4...ae248f33f8b3c470a4f78136699123b6dee66ac1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db699ff60a26760536df825f2ff8329b38a9c0f4...ae248f33f8b3c470a4f78136699123b6dee66ac1
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/20230629/84ccf246/attachment-0001.html>
More information about the ghc-commits
mailing list