[Git][ghc/ghc][wip/supersven/ghc-9.10-riscv-ncg] 2 commits: Increase C compiler happiness

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Sun Jun 9 19:35:42 UTC 2024



Sven Tennie pushed to branch wip/supersven/ghc-9.10-riscv-ncg at Glasgow Haskell Compiler / GHC


Commits:
08812af4 by Sven Tennie at 2024-06-09T10:10:39+00:00
Increase C compiler happiness

New warnings (-Werror) prevented the validate flavour from being built.

- - - - -
5d82e908 by Sven Tennie at 2024-06-09T19:33:09+00:00
Ignore signedness for MO_XX_Conv

MO_XX_Conv is used on (unsigned) words, too. Interpreting them as signed
may lead to weird conversions / sign-extensions: E.g. on RISCV64 this
conversion happened for a Word64#:

%MO_XX_Conv_W32_W64(4294967293 :: W32) -> CmmLit (CmmInt (-3) W64)

- - - - -


4 changed files:

- compiler/GHC/Cmm/Opt.hs
- rts/adjustor/LibffiAdjustor.c
- rts/linker/Elf.c
- rts/linker/elf_reloc_riscv64.c


Changes:

=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -68,7 +68,7 @@ cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
       MO_SF_Conv _from to -> CmmLit (CmmFloat (fromInteger x) to)
       MO_SS_Conv  from to -> CmmLit (CmmInt (narrowS from x) to)
       MO_UU_Conv  from to -> CmmLit (CmmInt (narrowU from x) to)
-      MO_XX_Conv  from to -> CmmLit (CmmInt (narrowS from x) to)
+      MO_XX_Conv  from to -> CmmLit (CmmInt (narrowU from x) to)
 
       _ -> panic $ "cmmMachOpFoldM: unknown unary op: " ++ show op
 


=====================================
rts/adjustor/LibffiAdjustor.c
=====================================
@@ -197,8 +197,9 @@ createAdjustor (int cconv,
     // On Linux the parameters of __builtin___clear_cache are currently unused.
     // Add them anyways for future compatibility. (I.e. the parameters couldn't
     // be checked during development.)
+    // TODO: Check the upper boundary e.g. with a debugger.
     __builtin___clear_cache((void *)code,
-                            (void *)code + instrCount * sizeof(uint64_t));
+                            (void *)((uint64_t *) code + instrCount));
     // Memory barrier to ensure nothing circumvents the fence.i / cache flush.
     SEQ_CST_FENCE();
 #endif


=====================================
rts/linker/Elf.c
=====================================
@@ -1128,9 +1128,9 @@ end:
    return result;
 }
 
-// the aarch64 linker uses relocacteObjectCodeAarch64,
-// see elf_reloc_aarch64.{h,c}
-#if !defined(aarch64_HOST_ARCH)
+// the aarch64 and riscv64 linkers use relocacteObjectCodeAarch64,
+// see elf_reloc_aarch64.{h,c}, elf_reloc_riscv64.{h,c}
+#if !defined(aarch64_HOST_ARCH) && !defined(riscv64_HOST_ARCH)
 
 /* Do ELF relocations which lack an explicit addend.  All x86-linux
    and arm-linux relocations appear to be of this form. */


=====================================
rts/linker/elf_reloc_riscv64.c
=====================================
@@ -114,6 +114,7 @@ char *relocationTypeToString(Elf64_Xword type) {
 
 #define Page(x) ((x) & ~0xFFF)
 
+STG_NORETURN
 int32_t decodeAddendRISCV64(Section *section STG_UNUSED,
                             Elf_Rel *rel STG_UNUSED) {
   debugBelch("decodeAddendRISCV64: Relocations with explicit addend are not "
@@ -430,7 +431,7 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
     // relocations aren't pure, but this is how LLVM does it. And, calculating
     // the lower 12 bit without any relation ship to the GOT entry's address
     // makes no sense either.
-      for (unsigned i = relNo; i >= 0 ; i--) {
+      for (int64_t i = relNo; i >= 0 ; i--) {
         Elf_Rela *rel_prime = &relaTab->relocations[i];
 
         addr_t P_prime =
@@ -459,7 +460,7 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
           IF_DEBUG(linker,
                    debugBelch(
                        "Found matching relocation: %s (P: 0x%lx, S: 0x%lx, "
-                       "sym-name: %s) -> %s (P: 0x%lx, S: 0x%lx, sym-name: %s, relNo: %u)",
+                       "sym-name: %s) -> %s (P: 0x%lx, S: %p, sym-name: %s, relNo: %ld)",
                        relocationTypeToString(rel->r_info), P, S, symbol->name,
                        relocationTypeToString(rel_prime->r_info), P_prime,
                        symbol_prime->addr, symbol_prime->name, i));
@@ -492,7 +493,7 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
       SymbolExtra *symbolExtra = makeSymbolExtra(oc, ELF_R_SYM(rel->r_info), S);
       addr_t* FAKE_GOT_S = &symbolExtra->addr;
       IF_DEBUG(linker, debugBelch("R_RISCV_CALL_PLT w/ SymbolExtra = %p , "
-                                  "entry = 0x%lx\n",
+                                  "entry = %p\n",
                                   symbolExtra, FAKE_GOT_S));
       GOT_Target = (addr_t) FAKE_GOT_S;
     }
@@ -515,7 +516,6 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
   case R_RISCV_ADD32:
     FALLTHROUGH;
   case R_RISCV_ADD64:
-    FALLTHROUGH;
     return S + A; // Add V when the value is set
   case R_RISCV_SUB6:
     FALLTHROUGH;
@@ -526,7 +526,6 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
   case R_RISCV_SUB32:
     FALLTHROUGH;
   case R_RISCV_SUB64:
-    FALLTHROUGH;
     return S + A; // Subtract from V when value is set
   case R_RISCV_SET6:
     FALLTHROUGH;
@@ -535,7 +534,6 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
   case R_RISCV_SET16:
     FALLTHROUGH;
   case R_RISCV_SET32:
-    FALLTHROUGH;
     return S + A;
   case R_RISCV_RELAX:
   case R_RISCV_ALIGN:
@@ -563,7 +561,7 @@ int32_t computeAddend(ElfRelocationATable * relaTab, unsigned relNo, Elf_Rel *re
       addr_t* FAKE_GOT_S = &symbolExtra->addr;
       addr_t res = (addr_t) FAKE_GOT_S + A - P;
       IF_DEBUG(linker, debugBelch("R_RISCV_GOT_HI20 w/ SymbolExtra = %p , "
-                                  "entry = 0x%lx , reloc-addend = 0x%lu ",
+                                  "entry = %p , reloc-addend = 0x%lu ",
                                   symbolExtra, FAKE_GOT_S, res));
       return res;
     }
@@ -640,12 +638,13 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) {
 
   /* The main object code */
   void *codeBegin = oc->image + oc->misalignment;
-  __builtin___clear_cache(codeBegin, codeBegin + oc->fileSize);
+  // TODO: Check the upper boundary e.g. with a debugger.
+  __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize));
 
   /* Jump Islands */
+  // TODO: Check the upper boundary e.g. with a debugger.
   __builtin___clear_cache((void *)oc->symbol_extras,
-                          (void *)oc->symbol_extras +
-                              sizeof(SymbolExtra) * oc->n_symbol_extras);
+                          (void *)(oc->symbol_extras + oc->n_symbol_extras));
 
   // Memory barrier to ensure nothing circumvents the fence.i / cache flushes.
   SEQ_CST_FENCE();



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53da5e54a2021cc9042a9a3274dcd5bf840c6d6c...5d82e90884a61740476d00bbf000a8d31143c37f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53da5e54a2021cc9042a9a3274dcd5bf840c6d6c...5d82e90884a61740476d00bbf000a8d31143c37f
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/20240609/5c37a725/attachment-0001.html>


More information about the ghc-commits mailing list