[Git][ghc/ghc][wip/supersven/riscv64-ncg] Linker: Fix PLT jumps
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Wed Feb 21 19:47:26 UTC 2024
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
8e152469 by Sven Tennie at 2024-02-21T20:46:36+01:00
Linker: Fix PLT jumps
- - - - -
8 changed files:
- rts/linker/Elf.c
- rts/linker/ElfTypes.h
- rts/linker/elf_plt.c
- rts/linker/elf_plt.h
- rts/linker/elf_plt_riscv64.c
- rts/linker/elf_reloc_aarch64.c
- rts/linker/elf_reloc_riscv64.c
- rts/linker/macho/plt.h
Changes:
=====================================
rts/linker/Elf.c
=====================================
@@ -101,7 +101,7 @@
# include <elf_abi.h>
#endif
-#if defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)
+#if defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) || defined (riscv64_HOST_ARCH)
# define NEED_GOT
# define NEED_PLT
# include "elf_got.h"
=====================================
rts/linker/ElfTypes.h
=====================================
@@ -150,6 +150,7 @@ typedef
struct _Stub {
void * addr;
void * target;
+ void* got_addr;
/* flags can hold architecture specific information they are used during
* lookup of stubs as well. Thus two stubs for the same target with
* different flags are considered unequal.
=====================================
rts/linker/elf_plt.c
=====================================
@@ -5,7 +5,7 @@
#include <stdint.h>
#include <stdlib.h>
-#if defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)
+#if defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) || defined(riscv64_HOST_ARCH)
#if defined(OBJFORMAT_ELF)
#define STRINGIFY(x) #x
@@ -49,11 +49,13 @@ findStub(Section * section,
bool
makeStub(Section * section,
void* * addr,
+ void* got_addr,
uint8_t flags) {
Stub * s = calloc(1, sizeof(Stub));
ASSERT(s != NULL);
s->target = *addr;
+ s->got_addr = got_addr;
s->flags = flags;
s->next = NULL;
s->addr = (uint8_t *)section->info->stub_offset + 8
=====================================
rts/linker/elf_plt.h
=====================================
@@ -37,7 +37,7 @@ unsigned numberOfStubsForSection( ObjectCode *oc, unsigned sectionIndex);
#define STUB_SIZE ADD_SUFFIX(stubSize)
bool findStub(Section * section, void* * addr, uint8_t flags);
-bool makeStub(Section * section, void* * addr, uint8_t flags);
+bool makeStub(Section * section, void* * addr, void* got_addr, uint8_t flags);
void freeStubs(Section * section);
=====================================
rts/linker/elf_plt_riscv64.c
=====================================
@@ -1,57 +1,81 @@
#include "Rts.h"
#include "elf_compat.h"
#include "elf_plt_riscv64.h"
+#include "rts/Messages.h"
+#include <stdint.h>
#include <stdlib.h>
#if defined(riscv64_HOST_ARCH)
#if defined(OBJFORMAT_ELF)
-const size_t instSizeRISCV64 = 2;
-const size_t stubSizeRISCV64 = 5 * instSizeRISCV64;
+const size_t instSizeRISCV64 = 4;
+const size_t stubSizeRISCV64 = 3 * instSizeRISCV64;
-bool needStubForRelRISCV64(Elf_Rel * rel) {
- switch(ELF64_R_TYPE(rel->r_info)) {
- case R_RISCV_CALL_PLT:
- return true;
- default:
- return false;
- }
+bool needStubForRelRISCV64(Elf_Rel *rel) {
+ switch (ELF64_R_TYPE(rel->r_info)) {
+ case R_RISCV_CALL:
+ case R_RISCV_CALL_PLT:
+ return true;
+ default:
+ return false;
+ }
}
-bool needStubForRelaIRISCV64(Elf_Rela * rela) {
- switch(ELF64_R_TYPE(rela->r_info)) {
- case R_RISCV_CALL_PLT:
- return true;
- default:
- return false;
- }
+bool needStubForRelaRISCV64(Elf_Rela *rela) {
+ switch (ELF64_R_TYPE(rela->r_info)) {
+ case R_RISCV_CALL:
+ case R_RISCV_CALL_PLT:
+ return true;
+ default:
+ return false;
+ }
}
-// The stub is just a long jump to the target address.
-bool makeStubRISCV64(Stub * s) {
- uint32_t *P = (uint32_t*)s->addr;
+// After the global offset table (GOT) has been set up, we can use these three
+// instructions to jump to the target address / function:
+// 1. AUIPC ip, %pcrel_hi(addr)
+// 2. LD ip, %pcrel_lo(addr)(ip)
+// 3. JARL x0, ip, 0
+//
+// We could use the absolute address of the target (because we know it), but
+// that would require loading a 64-bit constant which is a nightmare to do in
+// riscv64 assembly. (See
+// https://github.com/riscv-non-isa/riscv-elf-psabi-doc/blob/5ffe5b5aeedb37b1c1c0c3d94641267d9ad4795a/riscv-elf.adoc#procedure-linkage-table)
+bool makeStubRISCV64(Stub *s) {
+ uint32_t * P = (uint32_t *)s->addr;
+ int32_t addr = (uint64_t) s->got_addr - (uint64_t) P;
- /* target address */
- uint64_t addr = (uint64_t)s->target;
+ uint64_t hi = (addr + 0x800) >> 12;
+ uint64_t lo = addr - (hi << 12);
- // LUI ip, %hi(addr)
- uint32_t luiInst = 0x37; // opcode
- luiInst |= 0x1f << 7; // rd = ip (x31)
- luiInst |= ((addr >> 12) & 0xfffff) << 12; // imm[31:12]
+ debugBelch("makeStubRISCV64: P = %p, got_addr = %p, target = %p, addr = 0x%x "
+ ", hi = 0x%lx, lo = 0x%lx\n",
+ P, s->got_addr, s->target, addr, hi, lo);
- // JALR x0, ip, %lo(addr)
- uint32_t jalrInst = 0x67; // opcode
- jalrInst |= 0x00 << 7; // rd = x0
- jalrInst |= 0x1f << 15; // rs1 = ip (x31)
- jalrInst |= (addr & 0xfff) << 20; // imm[11:0]
+ // AUIPC ip, %pcrel_hi(addr)
+ uint32_t auipcInst = 0b0010111; // opcode
+ auipcInst |= 0x1f << 7; // rd = ip (x31)
+ auipcInst |= hi << 12; // imm[31:12]
- P[0] = luiInst;
- P[1] = jalrInst;
+ // LD ip, %pcrel_lo(addr)(ip)
+ uint32_t ldInst = 0b0000011; // opcode
+ ldInst |= 0x1f << 7; // rd = ip (x31)
+ ldInst |= 0x1f << 15; // rs = ip (x31)
+ ldInst |= 0b11 << 12; // funct3 = 0x3 (LD)
+ ldInst |= lo << 20; // imm[11:0]
- return EXIT_SUCCESS;
+ // JARL x0, ip, 0
+ uint32_t jalrInst = 0b1100111; // opcode
+ jalrInst |= 0x1f << 15; // rs = ip (x31)
+
+ P[0] = auipcInst;
+ P[1] = ldInst;
+ P[2] = jalrInst;
+
+ return EXIT_SUCCESS;
}
-#endif // OBJECTFORMAT_ELF
-#endif // riscv64_HOST_ARCH
+#endif
+#endif
=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -240,7 +240,7 @@ computeAddend(Section * section, Elf_Rel * rel,
/* check if we already have that stub */
if(findStub(section, (void**)&S, 0)) {
/* did not find it. Crete a new stub. */
- if(makeStub(section, (void**)&S, 0)) {
+ if(makeStub(section, (void**)&S, NULL, 0)) {
abort(/* could not find or make stub */);
}
}
=====================================
rts/linker/elf_reloc_riscv64.c
=====================================
@@ -13,6 +13,61 @@
#if defined(OBJFORMAT_ELF)
+char *relocationTypeToString(Elf64_Xword type) {
+ switch (ELF64_R_TYPE(type)) {
+ case R_RISCV_NONE:
+ return "R_RISCV_NONE";
+ case R_RISCV_32:
+ return "R_RISCV_32";
+ case R_RISCV_64:
+ return "R_RISCV_64";
+ case R_RISCV_RELATIVE:
+ return "R_RISCV_RELATIVE";
+ case R_RISCV_COPY:
+ return "R_RISCV_COPY";
+ case R_RISCV_JUMP_SLOT:
+ return "R_RISCV_JUMP_SLOT";
+ case R_RISCV_TLS_DTPMOD32:
+ return "R_RISCV_TLS_DTPMOD32";
+ case R_RISCV_TLS_DTPMOD64:
+ return "R_RISCV_TLS_DTPMOD64";
+ case R_RISCV_TLS_DTPREL32:
+ return "R_RISCV_TLS_DTPREL32";
+ case R_RISCV_TLS_DTPREL64:
+ return "R_RISCV_TLS_DTPREL64";
+ case R_RISCV_TLS_TPREL32:
+ return "R_RISCV_TLS_TPREL32";
+ case R_RISCV_TLS_TPREL64:
+ return "R_RISCV_TLS_TPREL64";
+ case R_RISCV_BRANCH:
+ return "R_RISCV_BRANCH";
+ case R_RISCV_JAL:
+ return "R_RISCV_JAL";
+ case R_RISCV_CALL:
+ return "R_RISCV_CALL";
+ case R_RISCV_CALL_PLT:
+ return "R_RISCV_CALL_PLT";
+ case R_RISCV_GOT_HI20:
+ return "R_RISCV_GOT_HI20";
+ case R_RISCV_PCREL_HI20:
+ return "R_RISCV_PCREL_HI20";
+ case R_RISCV_LO12_I:
+ return "R_RISCV_LO12_I";
+ case R_RISCV_PCREL_LO12_I:
+ return "R_RISCV_PCREL_LO12_I";
+ case R_RISCV_HI20:
+ return "R_RISCV_HI20";
+ case R_RISCV_LO12_S:
+ return "R_RISCV_LO12_S";
+ case R_RISCV_PCREL_LO12_S:
+ return "R_RISCV_PCREL_LO12_S";
+ case R_RISCV_RELAX:
+ return "R_RISCV_RELAX";
+ default:
+ return "Unknown relocation type";
+ }
+}
+
#define Page(x) ((x) & ~0xFFF)
typedef uint64_t addr_t;
@@ -79,6 +134,9 @@ uint32_t extractBits(uint64_t v, uint32_t begin, uint32_t end) {
}
uint32_t setLO12_I(uint32_t insn, uint32_t imm) {
+ debugBelch(
+ "setLO12_I: insn 0x%x imm 0x%x (insn & 0xfffff) 0x%x (imm << 20) 0x%x \n",
+ insn, imm, (insn & 0xfffff), (imm << 20));
return (insn & 0xfffff) | (imm << 20);
}
@@ -97,7 +155,12 @@ void setUType(inst_t *loc, uint32_t val) {
void setIType(inst_t *loc, uint32_t val) {
uint64_t hi = (val + 0x800) >> 12;
uint64_t lo = val - (hi << 12);
- write32le(loc, setLO12_I(read32le(loc), lo & 0xfff));
+ debugBelch("setIType: hi 0x%lx lo 0x%lx\n", hi, lo);
+ debugBelch("setIType: loc %p *loc 0x%x val 0x%x\n", loc, *loc, val);
+ uint32_t insn = setLO12_I(read32le(loc), lo & 0xfff);
+ debugBelch("setIType: insn 0x%x\n", insn);
+ write32le(loc, insn);
+ debugBelch("setIType: loc %p *loc' 0x%x val 0x%x\n", loc, *loc, val);
}
void setSType(inst_t *loc, uint32_t val) {
@@ -163,6 +226,11 @@ void setCJType(cinst_t *loc, uint32_t val) {
bool encodeAddendRISCV64(Section *section, Elf_Rel *rel, int64_t addend) {
addr_t P = (addr_t)((uint8_t *)section->start + rel->r_offset);
+ debugBelch("Relocation type %s 0x%lx (%lu) symbol 0x%lx addend 0x%lx (%lu / "
+ "%ld) P 0x%lx\n",
+ relocationTypeToString(rel->r_info), ELF64_R_TYPE(rel->r_info),
+ ELF64_R_TYPE(rel->r_info), ELF64_R_SYM(rel->r_info), addend,
+ addend, addend, P);
switch (ELF64_R_TYPE(rel->r_info)) {
case R_RISCV_32_PCREL:
case R_RISCV_32:
@@ -194,8 +262,12 @@ bool encodeAddendRISCV64(Section *section, Elf_Rel *rel, int64_t addend) {
setBType((inst_t *)P, addend);
break;
}
+ case R_RISCV_CALL:
case R_RISCV_CALL_PLT: {
+ // We could relax more (in some cases) but right now most important is to
+ // make it work.
setUType((inst_t *)P, addend);
+ setIType(((inst_t *)P) + 1, addend);
break;
}
case R_RISCV_JAL: {
@@ -289,6 +361,9 @@ int64_t computeAddend(Section *section, Elf_Rel *rel, ElfSymbol *symbol,
addr_t GOT_S = (addr_t)symbol->got_addr;
int64_t A = addend;
+
+ debugBelch("%s: P 0x%lx S 0x%lx %s GOT_S 0x%lx A 0x%lx\n",
+ relocationTypeToString(rel->r_info), P, S, symbol->name, GOT_S, A);
switch (ELF64_R_TYPE(rel->r_info)) {
case R_RISCV_32:
return S + A;
@@ -313,8 +388,17 @@ int64_t computeAddend(Section *section, Elf_Rel *rel, ElfSymbol *symbol,
case R_RISCV_BRANCH:
return S + A - P;
case R_RISCV_CALL:
- case R_RISCV_CALL_PLT:
- return S + A - P;
+ case R_RISCV_CALL_PLT: {
+ if (findStub(section, (void **)&S, 0)) {
+ /* did not find it. Crete a new stub. */
+ if (makeStub(section, (void **)&S, (void*) GOT_S, 0)) {
+ abort(/* could not find or make stub */);
+ }
+ }
+ debugBelch("S = 0x%lx A = 0x%lx P = 0x%lx (S + A) - P = 0x%lx \n", S, A,
+ P, (S + A) - P);
+ return (S + A) - P;
+ }
case R_RISCV_ADD8:
case R_RISCV_ADD16:
case R_RISCV_ADD32:
@@ -370,8 +454,8 @@ bool relocateObjectCodeRISCV64(ObjectCode *oc) {
CHECK(0x0 != symbol);
- // TODO: This always fails, because we don't support Rel locations: Do we
- // need this case?
+ // TODO: This always fails, because we don't support Rel locations: Do
+ // we need this case?
/* decode implicit addend */
int64_t addend = decodeAddendRISCV64(targetSection, rel);
=====================================
rts/linker/macho/plt.h
=====================================
@@ -25,7 +25,7 @@ unsigned numberOfStubsForSection( ObjectCode *oc, unsigned sectionIndex);
#define STUB_SIZE ADD_SUFFIX(stubSize)
bool findStub(Section * section, void* * addr, uint8_t flags);
-bool makeStub(Section * section, void* * addr, uint8_t flags);
+bool makeStub(Section * section, void* * addr, void* got_addr, uint8_t flags);
void freeStubs(Section * section);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e1524695ca7a4a6551ba9fa0a70c222a8a4f172
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e1524695ca7a4a6551ba9fa0a70c222a8a4f172
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/20240221/495eaea7/attachment-0001.html>
More information about the ghc-commits
mailing list