[Git][ghc/ghc][wip/T25577] 4 commits: testsuite: Add testcase for #25577
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Feb 28 17:20:15 UTC 2025
Ben Gamari pushed to branch wip/T25577 at Glasgow Haskell Compiler / GHC
Commits:
2ad84bf2 by Ben Gamari at 2025-02-28T11:16:48-05:00
testsuite: Add testcase for #25577
- - - - -
410683c9 by Ben Gamari at 2025-02-28T11:16:48-05:00
testsuite/ghc-api: Eliminate Makefile usage from various GHC API tests
These tests can be expressed perfectly well using the testsuite driver
itself.
- - - - -
7270d772 by Ben Gamari at 2025-02-28T12:19:58-05:00
rts/linker/MachO: Assert that GOT relocations have GOT entries
In #25577 we found that some GOT relocation types were not being given
relocation entries. Add assertions to catch this sort of failure in the
future.
- - - - -
6c726b89 by Ben Gamari at 2025-02-28T12:19:59-05:00
rts/linker/MachO: Account for internal GOT references in GOT construction
Previously we failed to give GOT slots to symbols which were referred to
by GOT relocations in the same module. This lead to #25577.
Fix this by explicitly traversing relocation lists and maintaining a
`needs_got` flag for each symbol.
Fixes #25577.
- - - - -
5 changed files:
- rts/linker/MachO.c
- rts/linker/MachOTypes.h
- testsuite/tests/ghc-api/Makefile
- + testsuite/tests/ghc-api/T25577.hs
- testsuite/tests/ghc-api/all.T
Changes:
=====================================
rts/linker/MachO.c
=====================================
@@ -68,9 +68,10 @@ static void encodeAddend(ObjectCode * oc, Section * section,
/* Global Offset Table logic */
static bool isGotLoad(MachORelocationInfo * ri);
-static bool needGotSlot(MachONList * symbol);
+static bool needGotSlot(MachOSymbol * symbol);
static bool makeGot(ObjectCode * oc);
static void freeGot(ObjectCode * oc);
+static void findInternalGotRefs(ObjectCode * oc);
#endif /* aarch64_HOST_ARCH */
/*
@@ -440,7 +441,49 @@ encodeAddend(ObjectCode * oc, Section * section,
barf("unsupported relocation type: %d\n", ri->r_type);
}
-static bool
+/* Note [Symbols in need of GOT entries]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * As GOT entries require memory, we ideally want to avoid reserving
+ * them for symbols where they are unnecessary. Specifically, most internal
+ * symbols will not be referenced by the GOT, even in position independent code
+ * (since you can instead use direct PC-relative addressing).
+ *
+ * However, it is nevertheless possible for internal symbols to be referenced
+ * via the GOT. Consequently, we use the following strategy to determine whether
+ * a symbol needs a GOT slot:
+ *
+ * a. all undefined external symbols are given GOT entries
+ * b. all external symbols with cross-section refrences are given GOT entries
+ * c. all internal symbols for which there are GOT relocations are given GOT
+ * entries.
+ *
+ * Failing to consider (c) lead to #25577. For this we explicitly traverse
+ * the relocations in findInternalGotRefs() looking for GOT relocations
+ * referencing internal symbols, setting the MachOSymbol.needs_got flag for
+ * each.
+ */
+
+// See Note [Symbols in need of GOT entries]
+static void
+findInternalGotRefs(ObjectCode * oc)
+{
+ for (int curSection = 0; curSection < oc->n_sections; curSection++) {
+ Section * sect = &oc->sections[curSection];
+ if (sect->info == NULL)
+ continue;
+ MachOSection * msect = sect->info->macho_section; // for access convenience
+ MachORelocationInfo * relocs = sect->info->relocation_info;
+ for(uint32_t i = 0; i < msect->nreloc; i++) {
+ MachORelocationInfo *ri = &relocs[i];
+ if (isGotLoad(ri)) {
+ MachOSymbol* symbol = &oc->info->macho_symbols[ri->r_symbolnum];
+ symbol->needs_got = true;
+ }
+ }
+ }
+}
+
+bool
isGotLoad(struct relocation_info * ri) {
return ri->r_type == ARM64_RELOC_GOT_LOAD_PAGE21
|| ri->r_type == ARM64_RELOC_GOT_LOAD_PAGEOFF12;
@@ -448,7 +491,7 @@ isGotLoad(struct relocation_info * ri) {
/*
* Check if we need a global offset table slot for a
- * given symbol
+ * given symbol. See Note [Symbols in need of GOT entries].
*/
static bool
needGotSlot(MachONList * symbol) {
@@ -458,12 +501,12 @@ needGotSlot(MachONList * symbol) {
* different section */
}
-static bool
+bool
makeGot(ObjectCode * oc) {
size_t got_slots = 0;
for(size_t i=0; i < oc->info->n_macho_symbols; i++)
- if(needGotSlot(oc->info->macho_symbols[i].nlist))
+ if(needGotSlot(&oc->info->macho_symbols[i]))
got_slots += 1;
if(got_slots > 0) {
@@ -476,7 +519,7 @@ makeGot(ObjectCode * oc) {
/* update got_addr */
size_t slot = 0;
for(size_t i=0; i < oc->info->n_macho_symbols; i++)
- if(needGotSlot(oc->info->macho_symbols[i].nlist))
+ if(needGotSlot(&oc->info->macho_symbols[i]))
oc->info->macho_symbols[i].got_addr
= ((uint8_t*)oc->info->got_start)
+ (slot++ * sizeof(void *));
@@ -627,6 +670,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section)
barf("explicit_addend and addend can't be set at the same time.");
uint64_t pc = (uint64_t)section->start + ri->r_address;
uint64_t value = (uint64_t)(isGotLoad(ri) ? symbol->got_addr : symbol->addr);
+ ASSERT(!isGotLoad(ri) || (symbol->got_addr != 0));
encodeAddend(oc, section, ri, ((value + addend + explicit_addend) & (-4096)) - (pc & (-4096)));
// reset, just in case.
@@ -640,6 +684,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section)
if(!(explicit_addend == 0 || addend == 0))
barf("explicit_addend and addend can't be set at the same time.");
uint64_t value = (uint64_t)(isGotLoad(ri) ? symbol->got_addr : symbol->addr);
+ ASSERT(!isGotLoad(ri) || (symbol->got_addr != 0));
encodeAddend(oc, section, ri, 0xFFF & (value + addend + explicit_addend));
// reset, just in case.
@@ -1450,6 +1495,8 @@ ocGetNames_MachO(ObjectCode* oc)
}
}
#if defined(aarch64_HOST_ARCH)
+ findInternalGotRefs(oc);
+
/* Setup the global offset table
* This is for symbols that are external, and not defined here.
* So that we can load their address indirectly.
@@ -1556,7 +1603,7 @@ ocResolve_MachO(ObjectCode* oc)
/* fill the GOT table */
for(size_t i = 0; i < oc->info->n_macho_symbols; i++) {
MachOSymbol * symbol = &oc->info->macho_symbols[i];
- if(needGotSlot(symbol->nlist)) {
+ if(needGotSlot(symbol)) {
if(N_UNDF == (symbol->nlist->n_type & N_TYPE)) {
/* an undefined symbol. So we need to ensure we
* have the address.
=====================================
rts/linker/MachOTypes.h
=====================================
@@ -31,6 +31,7 @@ typedef struct _MachOSymbol {
SymbolAddr * addr; /* the final resting place of the symbol */
void * got_addr; /* address of the got slot for this symbol, if any */
MachONList * nlist; /* the nlist symbol entry */
+ bool needs_got; /* See Note [Symbols in need of GOT entries] */
} MachOSymbol;
struct ObjectCodeFormatInfo {
=====================================
testsuite/tests/ghc-api/Makefile
=====================================
@@ -2,29 +2,3 @@ TOP=../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
-clean:
- rm -f *.o *.hi
-
-T6145:
- rm -f T6145.o T6145.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T6145
- ./T6145 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-T8639_api:
- rm -f T8639_api.o T8639_api.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T8639_api
- ./T8639_api "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-T8628:
- rm -f T8628.o T8628.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc -package exceptions T8628
- ./T8628 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-T9015:
- rm -f T9015.o T9015.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T9015
- ./T9015 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-.PHONY: clean T6145 T8639_api T8628 T9015
-
-
=====================================
testsuite/tests/ghc-api/T25577.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import GHC
+import Unsafe.Coerce
+import Control.Monad.IO.Class
+import System.Environment (getArgs)
+import Control.Monad (unless)
+
+main :: IO ()
+main = do
+ [libdir] <- getArgs
+ runGhc (Just libdir) run
+
+run :: Ghc ()
+run = do
+ dyn_flags <- getSessionDynFlags
+ _ <- setSessionDynFlags dyn_flags
+
+ setContext [ IIDecl . simpleImportDecl . mkModuleName $ "Prelude"
+ , IIDecl . simpleImportDecl . mkModuleName $ "Unsafe.Coerce" ]
+
+ wrong
+
+expected :: Double
+expected = 5.5626902089526504e-303
+
+wrong :: Ghc ()
+wrong = do
+ let chck = "5.5626902089526504e-303 :: Double"
+ v <- compileExpr chck
+ let !v' = unsafeCoerce v :: Double
+ unless (v' == expected) $ fail "case 1 failed"
+
+ let chck2 = "5.5626902089526504e-303 :: Rational"
+ v2 <- compileExpr chck2
+ let !v2' = unsafeCoerce v2 :: Rational
+ unless (realToFrac v2' == expected) $ fail "case 2 failed"
=====================================
testsuite/tests/ghc-api/all.T
=====================================
@@ -1,12 +1,28 @@
setTestOpts(when(arch('wasm32'), run_timeout_multiplier(2)))
test('ghcApi', normal, compile_and_run, ['-package ghc'])
-test('T6145', normal, makefile_test, ['T6145'])
-test('T8639_api', req_rts_linker,
- makefile_test, ['T8639_api'])
-test('T8628', req_rts_linker,
- makefile_test, ['T8628'])
-test('T9595', [extra_run_opts('"' + config.libdir + '"')],
+
+test('T6145',
+ [extra_run_opts(f'"{config.libdir}"')],
+ compile_and_run,
+ ['-package ghc'])
+
+test('T8639_api',
+ [extra_run_opts(f'"{config.libdir}"'), req_rts_linker],
+ compile_and_run,
+ ['-package ghc'])
+
+test('T8628',
+ [extra_run_opts(f'"{config.libdir}"'), req_rts_linker],
+ compile_and_run,
+ ['-package ghc -package exceptions'])
+
+test('T9015',
+ [extra_run_opts(f'"{config.libdir}"'), req_rts_linker],
+ compile_and_run,
+ ['-package ghc'])
+
+test('T9595', [extra_run_opts(f'"{config.libdir}"')],
compile_and_run,
['-package ghc'])
test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'),
@@ -17,9 +33,6 @@ test('T10508_api', [ extra_run_opts('"' + config.libdir + '"'),
test('T10942', [extra_run_opts('"' + config.libdir + '"')],
compile_and_run,
['-package ghc'])
-test('T9015', [extra_run_opts('"' + config.libdir + '"')],
- compile_and_run,
- ['-package ghc'])
test('T11579', [extra_run_opts('"' + config.libdir + '"'), js_skip], compile_and_run,
['-package ghc'])
test('T12099', normal, compile_and_run, ['-package ghc'])
@@ -42,3 +55,4 @@ test('T20757', [unless(opsys('mingw32'), skip), exit_code(1), normalise_version(
compile_and_run,
['-package ghc'])
test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc'])
+test('T25577', extra_run_opts(f'"{config.libdir}"'), compile_and_run, ['-package ghc'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91da96528a2c861d95d8b3051a93ddb05b85a733...6c726b895cadebc91fdfca013455ffa2eebdb929
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91da96528a2c861d95d8b3051a93ddb05b85a733...6c726b895cadebc91fdfca013455ffa2eebdb929
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/20250228/4291e480/attachment-0001.html>
More information about the ghc-commits
mailing list