[Git][ghc/ghc][wip/T25577] 3 commits: testsuite/ghc-api: Eliminate Makefile usage from various GHC API tests
Cheng Shao (@TerrorJack)
gitlab at gitlab.haskell.org
Sat Mar 8 00:36:16 UTC 2025
Cheng Shao pushed to branch wip/T25577 at Glasgow Haskell Compiler / GHC
Commits:
1f979f37 by Ben Gamari at 2025-03-08T00:35:48+00:00
testsuite/ghc-api: Eliminate Makefile usage from various GHC API tests
These tests can be expressed perfectly well using the testsuite driver
itself.
- - - - -
b4db5ef4 by Ben Gamari at 2025-03-08T00:36:03+00: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.
- - - - -
1857ebc5 by Ben Gamari at 2025-03-08T00:36:03+00: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,6 +441,48 @@ encodeAddend(ObjectCode * oc, Section * section,
barf("unsupported relocation type: %d\n", ri->r_type);
}
+/* 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;
+ }
+ }
+ }
+}
+
static bool
isGotLoad(struct relocation_info * ri) {
return ri->r_type == ARM64_RELOC_GOT_LOAD_PAGE21
@@ -448,14 +491,19 @@ 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) {
- return (symbol->n_type & N_EXT) /* is an external symbol */
- && (N_UNDF == (symbol->n_type & N_TYPE) /* and is undefined */
- || NO_SECT != symbol->n_sect); /* or is defined in a
- * different section */
+needGotSlot(MachOSymbol * symbol) {
+ // Does it have any internal references?
+ if (symbol->needs_got) {
+ return true;
+ }
+
+ return (symbol->nlist->n_type & N_EXT) /* is an external symbol */
+ && (N_UNDF == (symbol->nlist->n_type & N_TYPE) /* and is undefined */
+ || NO_SECT != symbol->nlist->n_sect); /* or is defined in a
+ * different section */
}
static bool
@@ -463,7 +511,7 @@ 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 +524,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 +675,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 +689,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 +1500,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 +1608,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
=====================================
@@ -3,7 +3,6 @@
module Main where
import GHC
-import GHC.Paths
import Unsafe.Coerce
import Control.Monad.IO.Class
import System.Environment (getArgs)
=====================================
testsuite/tests/ghc-api/all.T
=====================================
@@ -1,12 +1,38 @@
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}"')
+ # needs to spawn c compiler process, and wasm doesn't have
+ # process support
+ , req_process],
+ compile_and_run,
+ ['-package ghc'])
+
+test('T8639_api',
+ [extra_run_opts(f'"{config.libdir}"')
+ # wasm rts linker only works in dyn ways, normal way statically
+ # linked wasm module doesn't support it
+ , req_rts_linker
+ , when(arch('wasm32'), skip)],
+ compile_and_run,
+ ['-package ghc'])
+
+test('T8628',
+ [extra_run_opts(f'"{config.libdir}"')
+ # same with T8639_api
+ , req_rts_linker
+ , when(arch('wasm32'), skip)],
+ 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 +43,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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e98c0f0d2ec0a84ff9afb387e710da6fc6b6c00e...1857ebc59c8f3c8289e6cdd58de6da7acea7268d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e98c0f0d2ec0a84ff9afb387e710da6fc6b6c00e...1857ebc59c8f3c8289e6cdd58de6da7acea7268d
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/20250307/50ba66f3/attachment-0001.html>
More information about the ghc-commits
mailing list