[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: AARCH64 linker: skip NONE relocations

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Aug 13 09:06:25 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
e85133e8 by Sylvain Henry at 2024-08-13T05:06:14-04:00
AARCH64 linker: skip NONE relocations

This patch is part of the patches upstreamed from haskell.nix.
See https://github.com/input-output-hk/haskell.nix/pull/1960 for the
original report/patch.

- - - - -
6461bd86 by Brandon Chinn at 2024-08-13T05:06:15-04:00
Support multiline strings in TH

- - - - -
beda4fc5 by Arnaud Spiwack at 2024-08-13T05:06:18-04:00
Don't restrict eta-reduction of linear functions

This commit simply removes code. All the supporting implementation has
been done as part of !12883.

Closes #25129

- - - - -


12 changed files:

- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/HsToCore/Quote.hs
- rts/linker/elf_reloc_aarch64.c
- testsuite/tests/rts/linker/Makefile
- testsuite/tests/rts/linker/T7072-obj.c → testsuite/tests/rts/linker/T7072.c
- testsuite/tests/rts/linker/all.T
- testsuite/tests/rts/linker/T7072-main.c → testsuite/tests/rts/linker/load-object.c
- + testsuite/tests/rts/linker/reloc-none.c
- + testsuite/tests/rts/linker/reloc-none.stderr
- + testsuite/tests/th/TH_MultilineStrings.hs
- + testsuite/tests/th/TH_MultilineStrings.stdout
- testsuite/tests/th/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -2507,14 +2507,6 @@ case where `e` is trivial):
 And here are a few more technical criteria for when it is *not* sound to
 eta-reduce that are specific to Core and GHC:
 
-(L) With linear types, eta-reduction can break type-checking:
-      f :: A ⊸ B
-      g :: A -> B
-      g = \x. f x
-    The above is correct, but eta-reducing g would yield g=f, the linter will
-    complain that g and f don't have the same type. NB: Not unsound in the
-    dynamic semantics, but unsound according to the static semantics of Core.
-
 (J) We may not undersaturate join points.
     See Note [Invariants on join points] in GHC.Core, and #20599.
 
@@ -2774,7 +2766,7 @@ tryEtaReduce rec_ids bndrs body eval_sd
       | fun `elemUnVarSet` rec_ids          -- Criterion (R)
       = False -- Don't eta-reduce in fun in its own recursive RHSs
 
-      | cantEtaReduceFun fun                -- Criteria (L), (J), (W), (B)
+      | cantEtaReduceFun fun                -- Criteria (J), (W), (B)
       = False -- Function can't be eta reduced to arity 0
               -- without violating invariants of Core and GHC
 
@@ -2844,7 +2836,7 @@ tryEtaReduce rec_ids bndrs body eval_sd
     ok_arg _ _ _ _ = Nothing
 
 -- | Can we eta-reduce the given function
--- See Note [Eta reduction soundness], criteria (B), (J), (W) and (L).
+-- See Note [Eta reduction soundness], criteria (B), (J), and (W).
 cantEtaReduceFun :: Id -> Bool
 cantEtaReduceFun fun
   =    hasNoBinding fun -- (B)
@@ -2858,11 +2850,6 @@ cantEtaReduceFun fun
        -- Don't undersaturate StrictWorkerIds.
        -- See Note [CBV Function Ids] in GHC.Types.Id.Info.
 
-    ||  isLinearType (idType fun) -- (L)
-       -- Don't perform eta reduction on linear types.
-       -- If `f :: A %1-> B` and `g :: A -> B`,
-       -- then `g x = f x` is OK but `g = f` is not.
-
 
 {- *********************************************************************
 *                                                                      *


=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -3026,6 +3026,7 @@ repLiteral lit
                  HsChar _ _       -> Just charLName
                  HsCharPrim _ _   -> Just charPrimLName
                  HsString _ _     -> Just stringLName
+                 HsMultilineString _ _ -> Just stringLName
                  HsRat _ _ _      -> Just rationalLName
                  _                -> Nothing
 


=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -294,10 +294,13 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
         for (unsigned i = 0; i < relTab->n_relocations; i++) {
             Elf_Rel *rel = &relTab->relocations[i];
 
+            if(ELF64_R_TYPE(rel->r_info) == COMPAT_R_AARCH64_NONE)
+              continue;
+
             ElfSymbol *symbol =
                     findSymbol(oc,
                                relTab->sectionHeader->sh_link,
-                               ELF64_R_SYM((Elf64_Xword)rel->r_info));
+                               ELF64_R_SYM(rel->r_info));
 
             CHECK(0x0 != symbol);
 
@@ -320,10 +323,13 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
 
             Elf_Rela *rel = &relaTab->relocations[i];
 
+            if(ELF64_R_TYPE(rel->r_info) == COMPAT_R_AARCH64_NONE)
+              continue;
+
             ElfSymbol *symbol =
                     findSymbol(oc,
                                relaTab->sectionHeader->sh_link,
-                               ELF64_R_SYM((Elf64_Xword)rel->r_info));
+                               ELF64_R_SYM(rel->r_info));
 
             CHECK(0x0 != symbol);
             if(0x0 == symbol->addr)


=====================================
testsuite/tests/rts/linker/Makefile
=====================================
@@ -120,10 +120,9 @@ linker_error3:
 
 .PHONY: T7072
 T7072:
-	"$(TEST_HC)" -c T7072-obj.c -o T7072-obj.o
-	"$(TEST_HC)" -c T7072-main.c -o T7072-main.o
-	"$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug
-	./T7072-main T7072-obj.o
+	"$(TEST_HC)" load-object.c -o load-object -no-hs-main -debug
+	"$(TEST_HC)" -c T7072.c -o T7072.o
+	./load-object T7072.o
 
 .PHONY: T20494
 T20494:
@@ -140,3 +139,9 @@ T20918:
 T21618:
 	"$(TEST_HC)" -c T21618_c.c -o T21618_c.o
 	echo main | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) T21618_c.o T21618.hs
+
+.PHONY: reloc-none
+reloc-none:
+	"$(TEST_HC)" load-object.c -o load-object -no-hs-main -debug
+	"$(TEST_HC)" -c reloc-none.c -o reloc-none.o
+	./load-object reloc-none.o


=====================================
testsuite/tests/rts/linker/T7072-obj.c → testsuite/tests/rts/linker/T7072.c
=====================================


=====================================
testsuite/tests/rts/linker/all.T
=====================================
@@ -142,7 +142,7 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip)
 
 
 test('T7072',
-	[extra_files(['T7072-main.c', 'T7072-obj.c']),
+	[extra_files(['load-object.c', 'T7072.c']),
 		unless(opsys('linux'), skip),
 		req_rts_linker],
 	makefile_test, ['T7072'])
@@ -160,3 +160,11 @@ test('T20918',
 test('T21618',
      [unless(opsys('mingw32'), skip), req_rts_linker],
      makefile_test, ['T21618'])
+
+# test R_AARCH64_NONE relocation support
+test('reloc-none',
+	[extra_files(['load-object.c', 'reloc-none.c']),
+		unless(arch('aarch64'), skip),
+                unless(opsys('linux'), skip),
+		req_rts_linker],
+	makefile_test, ['reloc-none'])


=====================================
testsuite/tests/rts/linker/T7072-main.c → testsuite/tests/rts/linker/load-object.c
=====================================
@@ -12,10 +12,10 @@ int main (int argc, char *argv[])
 
     initLinker_(0);
 
-    // Load object file argv[1] repeatedly
+    // Load object file argv[1] once
 
     if (argc != 2) {
-        errorBelch("usage: T7072-main <object-file>");
+        errorBelch("usage: load-object <object-file>");
         exit(1);
     }
 


=====================================
testsuite/tests/rts/linker/reloc-none.c
=====================================
@@ -0,0 +1,8 @@
+static int a[0];
+
+int foo(){
+    asm(".reloc ., R_AARCH64_NONE, 10");
+    asm(".reloc ., R_AARCH64_NONE, a");
+    asm(".reloc ., R_AARCH64_NONE, a+10");
+    return a[0];
+}


=====================================
testsuite/tests/rts/linker/reloc-none.stderr
=====================================
@@ -0,0 +1 @@
+loading succeeded
\ No newline at end of file


=====================================
testsuite/tests/th/TH_MultilineStrings.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE MultilineStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Language.Haskell.TH (runQ)
+
+{-
+Test the MultilineStrings proposal
+https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0569-multiline-strings.rst
+-}
+
+main :: IO ()
+main = do
+  print =<< runQ [|
+      """
+      hello
+      world
+      """
+    |]


=====================================
testsuite/tests/th/TH_MultilineStrings.stdout
=====================================
@@ -0,0 +1 @@
+LitE (StringL "hello\nworld")


=====================================
testsuite/tests/th/all.T
=====================================
@@ -622,3 +622,4 @@ test('T24572a', normal, compile, [''])
 test('T24572b', normal, compile_fail, [''])
 test('T24572c', normal, compile_fail, [''])
 test('T24572d', normal, compile, [''])
+test('TH_MultilineStrings', normal, compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec0b55860ccf8e406e4bcd433a0a55af3f839ea3...beda4fc5c332e27086a2711a0fe63a072323b93c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec0b55860ccf8e406e4bcd433a0a55af3f839ea3...beda4fc5c332e27086a2711a0fe63a072323b93c
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/20240813/16efcedb/attachment-0001.html>


More information about the ghc-commits mailing list