[Git][ghc/ghc][wip/T24603] Basic NCG support for HelloWorld

[Serge S. Gulin (@gulin.serge)]

Serge S. Gulin pushed to branch wip/T24603 at Glasgow Haskell Compiler / GHC


Commits:
d51b588c by Serge S. Gulin at 2025-02-06T16:18:58+03:00
Basic NCG support for HelloWorld

- - - - -


5 changed files:

- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Session.hs
- utils/ghc-toolchain/exe/Main.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1,6 +1,8 @@
 {-# language GADTs, LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE CPP #-}
+
 module GHC.CmmToAsm.AArch64.CodeGen (
       cmmTopCodeGen
     , generateJumpTableForInstr
@@ -284,7 +286,11 @@ generateJumpTableForInstr config (J_TBL ids (Just lbl) _) =
               )
             where
               blockLabel = blockLbl blockid
+#if defined(mingw32_HOST_OS)
+   in Just (CmmData (Section Text lbl) (CmmStaticsRaw lbl jumpTable))
+#else
    in Just (CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl jumpTable))
+#endif
 generateJumpTableForInstr _ _ = Nothing
 
 -- -----------------------------------------------------------------------------
@@ -2481,9 +2487,7 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
     replace_jump !m !pos instr = do
       case instr of
         ANN ann instr -> do
-          replace_jump m pos instr >>= \
-            (idx,instr':|instrs') ->
-              pure (idx, ANN ann instr':|instrs')
+          replace_jump m pos instr >>= (\(idx,instr':|instrs') -> pure (idx, ANN ann instr':|instrs'))
         BCOND cond t
           -> case target_in_range m t pos of
               InRange -> pure (pos+long_bc_jump_size, NE.singleton instr)


=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -491,6 +491,34 @@ pprInstr platform instr = case instr of
     op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$
     op_add o1 (pprAsmLabel platform lbl <> text "@pageoff")
 
+#elif defined(mingw32_HOST_OS)
+  LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
+    op_adrp o1 (text "__imp_" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":lo12:__imp_" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
+
+  LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
+
+  LDR _f o1 (OpImm (ImmIndex lbl off)) ->
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
+
+  LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
+    op_adrp o1 (text "__imp_" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":lo12:__imp_" <> pprAsmLabel platform lbl)
+
+  LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl)
+
+  LDR _f o1 (OpImm (ImmCLbl lbl)) ->
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl)
+
 #else
   LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
     op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$


=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -211,7 +211,7 @@ platformNcgSupported platform = if
          ArchX86_64    -> True
          ArchPPC       -> True
          ArchPPC_64 {} -> True
-         ArchAArch64   -> platformOS platform /= OSMinGW32
+         ArchAArch64   -> True
          ArchWasm32    -> True
          ArchRISCV64   -> True
          _             -> False


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3588,6 +3588,14 @@ makeDynFlagsConsistent dflags
  , Nothing <- outputFile dflags
  = pgmError "--output must be specified when using --merge-objs"
 
+ | platformTablesNextToCode platform 
+   && os == OSMinGW32 
+   && arch == ArchAArch64
+    = case backendCodeOutput (backend dflags) of
+        LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64"
+        NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64"
+        _ -> (dflags, mempty)
+
  | otherwise = (dflags, mempty)
     where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
           loop updated_dflags warning


=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -348,6 +348,7 @@ tablesNextToCodeSupported archOs =
       ArchPPC      -> False
       ArchPPC_64 _ -> False
       ArchS390X    -> False
+      ArchAArch64  -> archOS_OS archOs /= OSMinGW32
       _            -> True
 
 determineTablesNextToCode



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d51b588c93b80d83aa25241e341fc22e6019262d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d51b588c93b80d83aa25241e341fc22e6019262d
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/20250206/d7ed2766/attachment-0001.html>