[Git][ghc/ghc][ghc-8.10] 9 commits: Escape backslashes in json profiling reports properly.
Ben Gamari
gitlab at gitlab.haskell.org
Thu Jul 16 13:43:30 UTC 2020
Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC
Commits:
c9770ef3 by Andreas Klebinger at 2020-07-15T23:39:35-04:00
Escape backslashes in json profiling reports properly.
I also took the liberty to do away the fixed buffer size for escaping.
Using a fixed size here can only lead to issues down the line.
Fixes #18438.
(cherry picked from commit fecafac8065d951c14a23de2395e078328f856cd)
- - - - -
aa2e5863 by Moritz Angermann at 2020-07-15T23:42:39-04:00
[linker/rtsSymbols] More linker symbols
Mostly symbols needed for aarch64/armv7l
and in combination with musl, where we have
to rely on loading *all* objects/archives
- __stack_chk_* only when not DYNAMIC
(cherry picked from commit 5bc6082fdcb278be878f01a2eeb9741d7d82bb49)
- - - - -
dfffd9eb by Artem Pelenitsyn at 2020-07-15T23:50:11-04:00
base: fix sign confusion in log1mexp implementation (fix #17125)
author: claude (https://gitlab.haskell.org/trac-claude)
The correct threshold for log1mexp is -(log 2) with the current specification
of log1mexp. This change improves accuracy for large negative inputs.
To avoid code duplication, a small helper function is added;
it isn't the default implementation in Floating because it needs Ord.
This patch does nothing to address that the Haskell specification is
different from that in common use in other languages.
(cherry picked from commit af5e3a885ddd09dd5f550552c535af3661ff3dbf)
- - - - -
93c06518 by Moritz Angermann at 2020-07-15T23:51:27-04:00
ghc-prim needs to depend on libc and libm
libm is just an empty shell on musl, and all the math functions are contained in
libc.
(cherry picked from commit b455074875d3c8fd3a5787e01dc6f922f3a97bc2)
- - - - -
b33a20c5 by Moritz Angermann at 2020-07-15T23:51:39-04:00
Load .lo as well.
Some archives contain so called linker objects, with the affectionate
.lo suffic. For example the musl libc.a will come in that form. We
still want to load those objects, hence we should not discard them and
look for .lo as well. Ultimately we might want to fix this proerly by
looking at the file magic.
(cherry picked from commit 3fd12af1eaafe304e5916bc1fcfdf31709d360b8)
- - - - -
6560fa8f by Moritz Angermann at 2020-07-15T23:52:20-04:00
Range is actually +/-2^32, not +/-2^31
See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf
(cherry picked from commit f2446ff1578a37822488e0e3968694f66712b969)
- - - - -
820d9ed2 by Ben Gamari at 2020-07-15T23:55:55-04:00
testsuite: Add test for #18151
(cherry picked from commit bd9f558924755f965f5136b5e3d4fa88d34c9778)
- - - - -
be443156 by Ben Gamari at 2020-07-15T23:56:02-04:00
testsuite: Add test for desugaring of PostfixOperators
(cherry picked from commit 95a9eb7396912314f6cfd971fb4523e4062acec6)
- - - - -
cc8800f9 by Ben Gamari at 2020-07-15T23:56:42-04:00
HsToCore: Eta expand left sections
Strangely, the comment next to this code already alluded to the fact
that even simply eta-expanding will sacrifice laziness. It's quite
unclear how we regressed so far.
See #18151.
(cherry picked from commit b1dbd625493ae1bf984cf51177011baf9c677c0a)
- - - - -
12 changed files:
- compiler/deSugar/DsExpr.hs
- libraries/base/GHC/Float.hs
- libraries/ghc-prim/ghc-prim.cabal
- rts/ProfilerReportJson.c
- rts/RtsSymbols.c
- rts/linker/LoadArchive.c
- rts/linker/elf_reloc_aarch64.c
- + testsuite/tests/deSugar/should_run/DsPostfixOperators.hs
- + testsuite/tests/deSugar/should_run/DsPostfixOperators.stdout
- + testsuite/tests/deSugar/should_run/T18151.hs
- + testsuite/tests/deSugar/should_run/T18151.stdout
- testsuite/tests/deSugar/should_run/all.T
Changes:
=====================================
compiler/deSugar/DsExpr.hs
=====================================
@@ -331,26 +331,47 @@ Then we get
That 'g' in the 'in' part is an evidence variable, and when
converting to core it must become a CO.
-Operator sections. At first it looks as if we can convert
-\begin{verbatim}
- (expr op)
-\end{verbatim}
-to
-\begin{verbatim}
- \x -> op expr x
-\end{verbatim}
+
+Note [Desugaring operator sections]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At first it looks as if we can convert
+
+ (expr `op`)
+
+naively to
+
+ \x -> op expr x
But no! expr might be a redex, and we can lose laziness badly this
way. Consider
-\begin{verbatim}
- map (expr op) xs
-\end{verbatim}
-for example. So we convert instead to
-\begin{verbatim}
- let y = expr in \x -> op y x
-\end{verbatim}
-If \tr{expr} is actually just a variable, say, then the simplifier
-will sort it out.
+
+ map (expr `op`) xs
+
+for example. If expr were a redex then eta-expanding naively would
+result in multiple evaluations where the user might only have expected one.
+
+So we convert instead to
+
+ let y = expr in \x -> op y x
+
+Also, note that we must do this for both right and (perhaps surprisingly) left
+sections. Why are left sections necessary? Consider the program (found in #18151),
+
+ seq (True `undefined`) ()
+
+according to the Haskell Report this should reduce to () (as it specifies
+desugaring via eta expansion). However, if we fail to eta expand we will rather
+bottom. Consequently, we must eta expand even in the case of a left section.
+
+If `expr` is actually just a variable, say, then the simplifier
+will inline `y`, eliminating the redundant `let`.
+
+Note that this works even in the case that `expr` is unlifted. In this case
+bindNonRec will automatically do the right thing, giving us:
+
+ case expr of y -> (\x -> op y x)
+
+See #18151.
-}
ds_expr _ e@(OpApp _ e1 op e2)
@@ -359,17 +380,35 @@ ds_expr _ e@(OpApp _ e1 op e2)
; dsWhenNoErrs (mapM dsLExprNoLP [e1, e2])
(\exprs' -> mkCoreAppsDs (text "opapp" <+> ppr e) op' exprs') }
-ds_expr _ (SectionL _ expr op) -- Desugar (e !) to ((!) e)
- = do { op' <- dsLExpr op
- ; dsWhenNoErrs (dsLExprNoLP expr)
- (\expr' -> mkCoreAppDs (text "sectionl" <+> ppr expr) op' expr') }
-
--- dsLExpr (SectionR op expr) -- \ x -> op x expr
+-- dsExpr (SectionL op expr) === (expr `op`) ~> \y -> op expr y
+--
+-- See Note [Desugaring operator sections].
+-- N.B. this also must handle postfix operator sections due to -XPostfixOperators.
+ds_expr _ e@(SectionL _ expr op) = do
+ core_op <- dsLExpr op
+ x_core <- dsLExpr expr
+ case splitFunTys (exprType core_op) of
+ -- Binary operator section
+ (x_ty:y_ty:_, _) -> do
+ dsWhenNoErrs
+ (mapM newSysLocalDsNoLP [x_ty, y_ty])
+ (\[x_id, y_id] ->
+ bindNonRec x_id x_core
+ $ Lam y_id (mkCoreAppsDs (text "sectionl" <+> ppr e)
+ core_op [Var x_id, Var y_id]))
+
+ -- Postfix operator section
+ (_:_, _) -> do
+ return $ mkCoreAppDs (text "sectionl" <+> ppr e) core_op x_core
+
+ _ -> pprPanic "dsExpr(SectionL)" (ppr e)
+
+-- dsExpr (SectionR op expr) === (`op` expr) ~> \x -> op x expr
+--
+-- See Note [Desugaring operator sections].
ds_expr _ e@(SectionR _ op expr) = do
core_op <- dsLExpr op
- -- for the type of x, we need the type of op's 2nd argument
let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
- -- See comment with SectionL
y_core <- dsLExpr expr
dsWhenNoErrs (mapM newSysLocalDsNoLP [x_ty, y_ty])
(\[x_id, y_id] -> bindNonRec y_id y_core $
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -141,6 +141,14 @@ class (Fractional a) => Floating a where
log1pexp x = log1p (exp x)
log1mexp x = log1p (negate (exp x))
+-- | Default implementation for @'log1mexp'@ requiring @'Ord'@ to test
+-- against a threshold to decide which implementation variant to use.
+log1mexpOrd :: (Ord a, Floating a) => a -> a
+{-# INLINE log1mexpOrd #-}
+log1mexpOrd a
+ | a > -(log 2) = log (negate (expm1 a))
+ | otherwise = log1p (negate (exp a))
+
-- | Efficient, machine-independent access to the components of a
-- floating-point number.
class (RealFrac a, Floating a) => RealFloat a where
@@ -398,9 +406,7 @@ instance Floating Float where
log1p = log1pFloat
expm1 = expm1Float
- log1mexp a
- | a <= log 2 = log (negate (expm1Float a))
- | otherwise = log1pFloat (negate (exp a))
+ log1mexp x = log1mexpOrd x
{-# INLINE log1mexp #-}
log1pexp a
| a <= 18 = log1pFloat (exp a)
@@ -539,9 +545,7 @@ instance Floating Double where
log1p = log1pDouble
expm1 = expm1Double
- log1mexp a
- | a <= log 2 = log (negate (expm1Double a))
- | otherwise = log1pDouble (negate (exp a))
+ log1mexp x = log1mexpOrd x
{-# INLINE log1mexp #-}
log1pexp a
| a <= 18 = log1pDouble (exp a)
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -67,6 +67,11 @@ Library
-- on Windows. Required because of mingw32.
extra-libraries: user32, mingw32, mingwex
+ if os(linux)
+ -- we need libm, but for musl and other's we might need libc, as libm
+ -- is just an empty shell.
+ extra-libraries: c, m
+
c-sources:
cbits/atomic.c
cbits/bswap.c
=====================================
rts/ProfilerReportJson.c
=====================================
@@ -15,23 +15,35 @@
#include "ProfilerReportJson.h"
#include "Profiling.h"
-// This only handles characters that you might see in a Haskell cost-centre
-// name.
-static void escapeString(char const* str, char *out, int len)
+#include <string.h>
+
+// I don't think this code is all that perf critical.
+// So we just allocate a new buffer each time around.
+static void escapeString(char const* str, char **buf)
{
- len--; // reserve character in output for terminating NUL
- for (; *str != '\0' && len > 0; str++) {
+ char *out;
+ size_t req_size; //Max required size for decoding.
+ size_t in_size; //Input size, including zero.
+
+ in_size = strlen(str) + 1;
+ // The strings are generally small and short
+ // lived so should be ok to just double the size.
+ req_size = in_size * 2;
+ out = stgMallocBytes(req_size, "writeCCSReportJson");
+ *buf = out;
+ // We provide an outputbuffer twice the size of the input,
+ // and at worse double the output size. So we can skip
+ // length checks.
+ for (; *str != '\0'; str++) {
char c = *str;
if (c == '\\') {
- if (len < 2) break;
- *out = '\\'; out++; len--;
- *out = '\\'; out++; len--;
+ *out = '\\'; out++;
+ *out = '\\'; out++;
} else if (c == '\n') {
- if (len < 2) break;
- *out = '\\'; out++; len--;
- *out = 'n'; out++; len--;
+ *out = '\\'; out++;
+ *out = 'n'; out++;
} else {
- *out = c; out++; len--;
+ *out = c; out++;
}
}
*out = '\0';
@@ -40,11 +52,13 @@ static void escapeString(char const* str, char *out, int len)
static void
logCostCentres(FILE *prof_file)
{
- char tmp[256];
+ char* lbl;
+ char* src_loc;
bool needs_comma = false;
fprintf(prof_file, "[\n");
for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) {
- escapeString(cc->label, tmp, sizeof(tmp));
+ escapeString(cc->label, &lbl);
+ escapeString(cc->srcloc, &src_loc);
fprintf(prof_file,
"%s"
"{\"id\": %" FMT_Int ", "
@@ -53,11 +67,13 @@ logCostCentres(FILE *prof_file)
"\"src_loc\": \"%s\", "
"\"is_caf\": %s}",
needs_comma ? ", " : "",
- cc->ccID, tmp, cc->module, cc->srcloc,
+ cc->ccID, lbl, cc->module, src_loc,
cc->is_caf ? "true" : "false");
needs_comma = true;
}
fprintf(prof_file, "]\n");
+ stgFree(lbl);
+ stgFree(src_loc);
}
static void
@@ -92,15 +108,24 @@ writeCCSReportJson(FILE *prof_file,
CostCentreStack const *stack,
ProfilerTotals totals)
{
+
fprintf(prof_file, "{\n\"program\": \"%s\",\n", prog_name);
fprintf(prof_file, "\"arguments\": [");
- for (int count = 0; prog_argv[count]; count++)
+ for (int count = 0; prog_argv[count]; count++) {
+ char* arg;
+ escapeString(prog_argv[count], &arg);
fprintf(prof_file, "%s\"%s\"",
- count == 0 ? "" : ", ", prog_argv[count]);
+ count == 0 ? "" : ", ", arg);
+ stgFree(arg);
+ }
fprintf(prof_file, "],\n\"rts_arguments\": [");
- for (int count = 0; rts_argv[count]; count++)
+ for (int count = 0; rts_argv[count]; count++) {
+ char* arg;
+ escapeString(rts_argv[count], &arg);
fprintf(prof_file, "%s\"%s\"",
- count == 0 ? "" : ", ", rts_argv[count]);
+ count == 0 ? "" : ", ", arg);
+ stgFree(arg);
+ }
fprintf(prof_file, "],\n");
fprintf(prof_file, "\"end_time\": \"%s\",\n", time_str());
@@ -121,6 +146,7 @@ writeCCSReportJson(FILE *prof_file,
fprintf(prof_file, ",\n\"profile\": ");
logCostCentreStack(prof_file, stack);
fprintf(prof_file, "}\n");
+
}
=====================================
rts/RtsSymbols.c
=====================================
@@ -58,7 +58,6 @@
SymI_HasProto(signal_handlers) \
SymI_HasProto(stg_sig_install) \
SymI_HasProto(rtsTimerSignal) \
- SymI_HasProto(atexit) \
SymI_NeedsDataProto(nocldstop)
#endif
@@ -977,29 +976,213 @@
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
-
// 64-bit support functions in libgcc.a
-#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32)
-#define RTS_LIBGCC_SYMBOLS \
- SymI_NeedsProto(__divdi3) \
- SymI_NeedsProto(__udivdi3) \
- SymI_NeedsProto(__moddi3) \
- SymI_NeedsProto(__umoddi3) \
- SymI_NeedsProto(__muldi3) \
- SymI_NeedsProto(__ashldi3) \
- SymI_NeedsProto(__ashrdi3) \
- SymI_NeedsProto(__lshrdi3) \
- SymI_NeedsProto(__fixunsdfdi)
-#elif defined(__GNUC__) && SIZEOF_VOID_P == 8
-#define RTS_LIBGCC_SYMBOLS \
+// See https://gcc.gnu.org/onlinedocs/gccint/Libgcc.html#Libgcc
+#define RTS_LIBGCC_SYMBOLS_32 \
+ SymI_NeedsProto(__fixunsdfdi) \
+ /* 4 The GCC low-level runtime library */\
+ /* 4.1.1 Arithmetic functions */\
+ /* SymI_NeedsProto(__ashlsi3) */\
+ SymI_NeedsProto(__ashldi3) \
+ /* SymI_NeedsProto(__ashlti3) */\
+ /* These functions return the result of shifting a left by b bits. */\
+ /* SymI_NeedsProto(__ashrsi3) */\
+ SymI_NeedsProto(__ashrdi3) \
+ /* SymI_NeedsProto(__ashrti3) */\
+ /* These functions return the result of arithmetically shifting a right by b bits. */\
+ /* SymI_NeedsProto(__divsi3) */\
+ SymI_NeedsProto(__divdi3) \
+ /* SymI_NeedsProto(__divti3) */\
+ /* These functions return the quotient of the signed division of a and b. */\
+ /* SymI_NeedsProto(__lshrsi3) */ \
+ SymI_NeedsProto(__lshrdi3) \
+ /* SymI_NeedsProto(__lshrti3) */ \
+ /* These functions return the result of logically shifting a right by b bits. */\
+ /* SymI_NeedsProto(__modsi3) */ \
+ SymI_NeedsProto(__moddi3) \
+ /* SymI_NeedsProto(__modti3) */ \
+ /* These functions return the remainder of the signed division of a and b. */\
+ /* SymI_NeedsProto(__mulsi3) */ \
+ SymI_NeedsProto(__muldi3) \
+ /* SymI_NeedsProto(__multi3) */ \
+ /* These functions return the product of a and b. */\
+ SymI_NeedsProto(__negdi2) \
+ /* SymI_NeedsProto(__negti2) */ \
+ /* These functions return the negation of a. */\
+ /* SymI_NeedsProto(__udivsi3) */ \
+ SymI_NeedsProto(__udivdi3) \
+ /* SymI_NeedsProto(__udivti3) */ \
+ /* These functions return the quotient of the unsigned division of a and b. */\
+ SymI_NeedsProto(__udivmoddi4) \
+ /* SymI_NeedsProto(__udivmodti4) */ \
+ /* These functions calculate both the quotient and remainder of the unsigned division of a and b. The return value is the quotient, and the remainder is placed in variable pointed to by c. */\
+ /* SymI_NeedsProto(__umodsi3) */ \
+ SymI_NeedsProto(__umoddi3) \
+ /* SymI_NeedsProto(__umodti3) */ \
+ /* These functions return the remainder of the unsigned division of a and b. */\
+ /* 4.1.2 Comparison functions */\
+ /* The following functions implement integral comparisons. These functions implement a low-level compare, upon which the higher level comparison operators (such as less than and greater than or equal to) can be constructed. The returned values lie in the range zero to two, to allow the high-level operators to be implemented by testing the returned result using either signed or unsigned comparison. */\
+ SymI_NeedsProto(__cmpdi2) \
+ /* SymI_NeedsProto(__cmpti2) */ \
+ /* These functions perform a signed comparison of a and b. If a is less than b, they return 0; if a is greater than b, they return 2; and if a and b are equal they return 1. */\
+ SymI_NeedsProto(__ucmpdi2) \
+ /* SymI_NeedsProto(__ucmpti2) */ \
+ /* These functions perform an unsigned comparison of a and b. If a is less than b, they return 0; if a is greater than b, they return 2; and if a and b are equal they return 1. */\
+ /* 4.1.3 Trapping arithmetic functions */\
+ /* The following functions implement trapping arithmetic. These functions call the libc function abort upon signed arithmetic overflow. */\
+ SymI_NeedsProto(__absvsi2) \
+ SymI_NeedsProto(__absvdi2) \
+ /* These functions return the absolute value of a. */\
+ /* SymI_NeedsProto(__addvsi3) */ \
+ SymI_NeedsProto(__addvdi3) \
+ /* These functions return the sum of a and b; that is a + b. */\
+ /* SymI_NeedsProto(__mulvsi3) */ \
+ SymI_NeedsProto(__mulvdi3) \
+ /* The functions return the product of a and b; that is a * b. */\
+ SymI_NeedsProto(__negvsi2) \
+ SymI_NeedsProto(__negvdi2) \
+ /* These functions return the negation of a; that is -a. */\
+ /* SymI_NeedsProto(__subvsi3) */ \
+ SymI_NeedsProto(__subvdi3) \
+ /* These functions return the difference between b and a; that is a - b. */\
+ /* 4.1.4 Bit operations */\
+ SymI_NeedsProto(__clzsi2) \
+ SymI_NeedsProto(__clzdi2) \
+ /* SymI_NeedsProto(__clzti2) */ \
+ /* These functions return the number of leading 0-bits in a, starting at the most significant bit position. If a is zero, the result is undefined. */\
+ SymI_NeedsProto(__ctzsi2) \
+ SymI_NeedsProto(__ctzdi2) \
+ /* SymI_NeedsProto(__ctzti2) */ \
+ /* These functions return the number of trailing 0-bits in a, starting at the least significant bit position. If a is zero, the result is undefined. */\
+ SymI_NeedsProto(__ffsdi2) \
+ /* SymI_NeedsProto(__ffsti2) */ \
+ /* These functions return the index of the least significant 1-bit in a, or the value zero if a is zero. The least significant bit is index one. */\
+ SymI_NeedsProto(__paritysi2) \
+ SymI_NeedsProto(__paritydi2) \
+ /* SymI_NeedsProto(__parityti2) */\
+ /* These functions return the value zero if the number of bits set in a is even, and the value one otherwise. */\
+ SymI_NeedsProto(__popcountsi2) \
+ SymI_NeedsProto(__popcountdi2) \
+ /* SymI_NeedsProto(__popcountti2) */ \
+ /* These functions return the number of bits set in a. */\
+ SymI_NeedsProto(__bswapsi2) \
+ SymI_NeedsProto(__bswapdi2)
+#define RTS_LIBGCC_SYMBOLS_aarch32 \
+ /* armv6l */\
+ /* TODO: should check for __ARM_EABI__ */\
+ SymI_NeedsProto(__aeabi_d2f) \
+ SymI_NeedsProto(__aeabi_d2iz) \
+ SymI_NeedsProto(__aeabi_d2lz) \
+ SymI_NeedsProto(__aeabi_d2uiz) \
+ SymI_NeedsProto(__aeabi_d2ulz) \
+ SymI_NeedsProto(__aeabi_dadd) \
+ SymI_NeedsProto(__aeabi_dcmpeq) \
+ SymI_NeedsProto(__aeabi_dcmpge) \
+ SymI_NeedsProto(__aeabi_dcmpgt) \
+ SymI_NeedsProto(__aeabi_dcmple) \
+ SymI_NeedsProto(__aeabi_dcmplt) \
+ SymI_NeedsProto(__aeabi_dcmpun) \
+ SymI_NeedsProto(__aeabi_ddiv) \
+ SymI_NeedsProto(__aeabi_dmul) \
+ SymI_NeedsProto(__aeabi_dneg) \
+ SymI_NeedsProto(__aeabi_dsub) \
+ SymI_NeedsProto(__aeabi_f2d) \
+ SymI_NeedsProto(__aeabi_f2iz) \
+ SymI_NeedsProto(__aeabi_f2lz) \
+ SymI_NeedsProto(__aeabi_f2uiz) \
+ SymI_NeedsProto(__aeabi_f2ulz) \
+ SymI_NeedsProto(__aeabi_fadd) \
+ SymI_NeedsProto(__aeabi_fcmpeq) \
+ SymI_NeedsProto(__aeabi_fcmpge) \
+ SymI_NeedsProto(__aeabi_fcmpgt) \
+ SymI_NeedsProto(__aeabi_fcmple) \
+ SymI_NeedsProto(__aeabi_fcmplt) \
+ SymI_NeedsProto(__aeabi_fcmpun) \
+ SymI_NeedsProto(__aeabi_fdiv) \
+ SymI_NeedsProto(__aeabi_fmul) \
+ SymI_NeedsProto(__aeabi_fneg) \
+ SymI_NeedsProto(__aeabi_fsub) \
+ SymI_NeedsProto(__aeabi_i2d) \
+ SymI_NeedsProto(__aeabi_i2f) \
+ SymI_NeedsProto(__aeabi_idiv) \
+ SymI_NeedsProto(__aeabi_idivmod) \
+ SymI_NeedsProto(__aeabi_l2d) \
+ SymI_NeedsProto(__aeabi_l2f) \
+ SymI_NeedsProto(__aeabi_lasr) \
+ SymI_NeedsProto(__aeabi_lcmp) \
+ SymI_NeedsProto(__aeabi_ldivmod) \
+ SymI_NeedsProto(__aeabi_llsl) \
+ SymI_NeedsProto(__aeabi_llsr) \
+ SymI_NeedsProto(__aeabi_lmul) \
+ SymI_NeedsProto(__aeabi_ui2d) \
+ SymI_NeedsProto(__aeabi_ui2f) \
+ SymI_NeedsProto(__aeabi_uidiv) \
+ SymI_NeedsProto(__aeabi_uidivmod) \
+ SymI_NeedsProto(__aeabi_ul2d) \
+ SymI_NeedsProto(__aeabi_ul2f) \
+ SymI_NeedsProto(__aeabi_ulcmp) \
+ SymI_NeedsProto(__aeabi_uldivmod)
+#define RTS_LIBGCC_SYMBOLS_64 \
SymI_NeedsProto(__udivti3) \
SymI_NeedsProto(__umodti3)
+
+/* for aarch64 */
+#define RTS_LIBGCC_SYMBOLS_aarch64 \
+ SymI_NeedsProto(__netf2) \
+ SymI_NeedsProto(__addtf3) \
+ SymI_NeedsProto(__subtf3) \
+ SymI_NeedsProto(__multf3) \
+ SymI_NeedsProto(__extenddftf2) \
+ SymI_NeedsProto(__fixtfsi) \
+ SymI_NeedsProto(__fixunstfsi) \
+ SymI_NeedsProto(__floatsitf) \
+ SymI_NeedsProto(__floatunsitf)
+
+#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && defined(arm_HOST_OS)
+#define RTS_LIBGCC_SYMBOLS RTS_LIBGCC_SYMBOLS_32 RTS_LIBGCC_SYMBOLS_aarch32
+#elif defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32)
+#define RTS_LIBGCC_SYMBOLS RTS_LIBGCC_SYMBOLS_32
+#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 && defined(aarch64_HOST_OS)
+#define RTS_LIBGCC_SYMBOLS RTS_LIBGCC_SYMBOLS_64 RTS_LIBGCC_SYMBOLS_aarch64
+#elif defined(__GNUC__) && SIZEOF_VOID_P == 8
+#define RTS_LIBGCC_SYMBOLS RTS_LIBGCC_SYMBOLS_64
#else
#define RTS_LIBGCC_SYMBOLS
#endif
+#if !defined(mingw32_HOST_OS) && !defined(DYNAMIC) && (defined(_FORTIFY_SOURCE) || defined(__SSP__))
+#define RTS_SSP_SYMBOLS \
+ SymI_NeedsProto(__stack_chk_guard) \
+ SymI_NeedsProto(__stack_chk_fail)
+#else
+#define RTS_SSP_SYMBOLS
+#endif
+#if !defined(DYNAMIC) && defined(linux_HOST_OS)
+// we need these for static musl builds. However when
+// linking shared objects (DLLs) this will fail, hence
+// we do not include them when building with -DDYNAMIC
+#define RTS_LINKER_SYMBOLS \
+ SymI_NeedsProto(__fini_array_start) \
+ SymI_NeedsProto(__fini_array_end)
+#else
+#define RTS_LINKER_SYMBOLS
+#endif
+
+#if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
+ // Symbols that don't have a leading underscore
+ // on Mac OS X. They have to receive special treatment,
+ // see machoInitSymbolsWithoutUnderscore()
+#define RTS_MACHO_NOUNDERLINE_SYMBOLS \
+ SymI_NeedsProto(saveFP) \
+ SymI_NeedsProto(restFP)
+#endif
+
/* entirely bogus claims about types of these symbols */
-#define SymI_NeedsProto(vvv) extern void vvv(void);
+/* to prevent a bit of define expansion, SymI_NeedsProto is a variadic
+ * macro. And we'll concat vvv with the __VA_ARGS__. This prevents
+ * vvv from getting macro expanded.
+ */
+#define SymI_NeedsProto(vvv,...) extern void vvv ## __VA_ARGS__ (void);
#define SymI_NeedsDataProto(vvv) extern StgWord vvv[];
#if defined(COMPILING_WINDOWS_DLL)
#define SymE_HasProto(vvv) SymE_HasProto(vvv);
@@ -1026,6 +1209,8 @@ RTS_DARWIN_ONLY_SYMBOLS
RTS_OPENBSD_ONLY_SYMBOLS
RTS_LIBGCC_SYMBOLS
RTS_LIBFFI_SYMBOLS
+RTS_SSP_SYMBOLS
+RTS_LINKER_SYMBOLS
#undef SymI_NeedsProto
#undef SymI_NeedsDataProto
#undef SymI_HasProto
@@ -1045,7 +1230,7 @@ RTS_LIBFFI_SYMBOLS
#define SymE_HasDataProto(vvv) \
SymE_HasProto(vvv)
-#define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
+#define SymI_NeedsProto(vvv,...) SymI_HasProto(vvv ## __VA_ARGS__)
#define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv)
#define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
#define SymE_NeedsDataProto(vvv) SymE_HasDataProto(vvv)
@@ -1066,6 +1251,8 @@ RTS_LIBFFI_SYMBOLS
#define SymI_HasProto_deprecated(vvv) \
{ #vvv, (void*)0xBAADF00D, true },
+void *RTS_DYNAMIC = NULL;
+
RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_RET_SYMBOLS
@@ -1077,11 +1264,14 @@ RtsSymbolVal rtsSyms[] = {
RTS_LIBGCC_SYMBOLS
RTS_LIBFFI_SYMBOLS
SymI_HasDataProto(nonmoving_write_barrier_enabled)
+ RTS_SSP_SYMBOLS
+ RTS_LINKER_SYMBOLS
#if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
// dyld stub code contains references to this,
// but it should never be called because we treat
// lazy pointers as nonlazy.
{ "dyld_stub_binding_helper", (void*)0xDEADBEEF, false },
#endif
+ { "_DYNAMIC", (void*)(&RTS_DYNAMIC), false },
{ 0, 0, false } /* sentinel */
};
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -461,6 +461,7 @@ static HsInt loadArchive_ (pathchar *path)
/* TODO: Stop relying on file extensions to determine input formats.
Instead try to match file headers. See #13103. */
isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0)
+ || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0)
|| (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0)
|| (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0);
=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -93,12 +93,14 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
// ... hi ] [ Rd ]
//
// imm64 = SignExtend(hi:lo:0x000,64)
- assert(isInt64(32, addend));
+ // Range is 21 bits + the 12 page relative bits
+ // known to be 0. -2^32 <= X < 2^32
+ assert(isInt64(21+12, addend));
assert((addend & 0xfff) == 0); /* page relative */
*(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
- | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
- | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
+ | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
+ | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
break;
}
/* - control flow relocations */
@@ -111,8 +113,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
break;
}
case COMPAT_R_AARCH64_ADR_GOT_PAGE: {
-
- assert(isInt64(32, addend)); /* X in range */
+ /* range is -2^32 <= X < 2^32 */
+ assert(isInt64(21+12, addend)); /* X in range */
assert((addend & 0xfff) == 0); /* page relative */
*(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
=====================================
testsuite/tests/deSugar/should_run/DsPostfixOperators.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE PostfixOperators #-}
+
+main :: IO ()
+main = do
+ print (42 `negate`)
=====================================
testsuite/tests/deSugar/should_run/DsPostfixOperators.stdout
=====================================
@@ -0,0 +1,2 @@
+-42
+
=====================================
testsuite/tests/deSugar/should_run/T18151.hs
=====================================
@@ -0,0 +1,10 @@
+-- According to the Report this should reduce to (). However, in #18151 it was
+-- reported that GHC bottoms.
+x :: ()
+x = seq (True `undefined`) ()
+{-# NOINLINE x #-}
+
+main :: IO ()
+main = do
+ print x
+
=====================================
testsuite/tests/deSugar/should_run/T18151.stdout
=====================================
@@ -0,0 +1 @@
+()
\ No newline at end of file
=====================================
testsuite/tests/deSugar/should_run/all.T
=====================================
@@ -57,9 +57,11 @@ test('T10215', normal, compile_and_run, [''])
test('DsStrictData', normal, compile_and_run, [''])
test('DsStrict', normal, compile_and_run, [''])
test('DsStrictLet', normal, compile_and_run, ['-O'])
+test('DsPostfixOperators', normal, compile_and_run, [''])
test('T11193', exit_code(1), compile_and_run, [''])
test('T11572', exit_code(1), compile_and_run, [''])
test('T11601', exit_code(1), compile_and_run, [''])
test('T11747', normal, compile_and_run, ['-dcore-lint'])
test('T12595', normal, compile_and_run, [''])
test('T13285', normal, compile_and_run, [''])
+test('T18151', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca146208a210242904edde77633ef857200dd45f...cc8800f9f482460ceb2d450137766e0350551740
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca146208a210242904edde77633ef857200dd45f...cc8800f9f482460ceb2d450137766e0350551740
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/20200716/f2f43fc7/attachment-0001.html>
More information about the ghc-commits
mailing list