[Git][ghc/ghc][wip/angerman/aarch64-ncg] :broom: :dash:

Moritz Angermann gitlab at gitlab.haskell.org
Fri Sep 11 06:10:04 UTC 2020



Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC


Commits:
eb3db893 by Moritz Angermann at 2020-09-11T06:09:53+00:00
:broom: :dash:

- - - - -


7 changed files:

- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Cond.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
- compiler/GHC/CmmToAsm/PIC.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -18,15 +18,12 @@ import GHC.Prelude hiding (EQ)
 import GHC.Platform.Regs
 import GHC.CmmToAsm.AArch64.Instr
 import GHC.CmmToAsm.AArch64.Regs
-import GHC.CmmToAsm.AArch64.RegInfo
 import GHC.CmmToAsm.AArch64.Cond
-import GHC.CmmToAsm.AArch64.Ppr
 
 import GHC.CmmToAsm.CPrim
 import GHC.Cmm.DebugBlock
 import GHC.CmmToAsm.Monad
-   ( NatM, getNewRegNat, getNewLabelNat
-   , getBlockIdNat, getPicBaseNat, getNewRegPairNat
+   ( NatM, getNewRegNat
    , getPicBaseMaybeNat, getPlatform, getConfig
    , getDebugBlock, getFileId
    )
@@ -34,14 +31,11 @@ import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.PIC
 import GHC.CmmToAsm.Format
 import GHC.CmmToAsm.Config
--- import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
--- import GHC.CmmToAsm.Reg.Target
 import GHC.Platform
 
 -- Our intermediate code:
 import GHC.Cmm.BlockId
--- import GHC.Cmm.Ppr           ( pprExpr )
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
@@ -59,7 +53,6 @@ import Control.Monad    ( mapAndUnzipM, when, foldM )
 import Data.Bits
 import Data.Word
 import Data.Maybe
--- import Data.Int
 import GHC.Float
 
 import GHC.Types.Basic
@@ -67,8 +60,6 @@ import GHC.Types.ForeignCall
 import GHC.Data.FastString
 import GHC.Utils.Misc
 
--- import Debug.Trace
-
 -- @cmmTopCodeGen@ will be our main entry point to code gen.  Here we'll get
 -- @RawCmmDecl@; see GHC.Cmm
 --


=====================================
compiler/GHC/CmmToAsm/AArch64/Cond.hs
=====================================
@@ -2,8 +2,6 @@ module GHC.CmmToAsm.AArch64.Cond  where
 
 import GHC.Prelude
 
-import GHC.Utils.Panic
-
 -- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions
 
 -- XXX: This appears to go a bit overboard? Maybe we should stick with what LLVM


=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -99,7 +99,6 @@ aarch64_regUsageOfInstr platform instr = case instr of
   ANN _ i                  -> aarch64_regUsageOfInstr platform i
   -- 1. Arithmetic Instructions ------------------------------------------------
   ADD dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
-  ADDS dst src1 src2       -> usage (regOp src1 ++ regOp src2, regOp dst)
   CMN l r                  -> usage (regOp l ++ regOp r, [])
   CMP l r                  -> usage (regOp l ++ regOp r, [])
   MSUB dst src1 src2 src3  -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
@@ -223,7 +222,6 @@ aarch64_patchRegsOfInstr instr env = case instr of
     ANN d i        -> ANN d (aarch64_patchRegsOfInstr i env)
     -- 1. Arithmetic Instructions ----------------------------------------------
     ADD o1 o2 o3   -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
-    ADDS o1 o2 o3  -> ADDS (patchOp o1) (patchOp o2) (patchOp o3)
     CMN o1 o2      -> CMN (patchOp o1) (patchOp o2)
     CMP o1 o2      -> CMP (patchOp o1) (patchOp o2)
     MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
@@ -555,7 +553,7 @@ data Instr
     -- | ADC Operand Operand Operang -- rd = rn + rm + C
     -- | ADCS ...
     | ADD Operand Operand Operand -- rd = rn + rm
-    | ADDS Operand Operand Operand -- rd = rn + rm
+    -- | ADDS Operand Operand Operand -- rd = rn + rm
     -- | ADR ...
     -- | ADRP ...
     | CMN Operand Operand -- rd + op2


=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -2,8 +2,6 @@ module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl) where
 
 import GHC.Prelude hiding (EQ)
 
-import Data.List (findIndex, all)
-
 import GHC.CmmToAsm.AArch64.Instr
 import GHC.CmmToAsm.AArch64.Regs
 import GHC.CmmToAsm.AArch64.Cond
@@ -11,8 +9,6 @@ import GHC.CmmToAsm.Ppr
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Format
 import GHC.Platform.Reg
-import GHC.Platform.Reg.Class
-import GHC.CmmToAsm.Reg.Target
 import GHC.CmmToAsm.Config
 
 import GHC.Cmm hiding (topInfoTable)
@@ -72,8 +68,6 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
        else empty) $$
       pprSizeDecl platform info_lbl
 
-pprNatCmmDecl _ _ = undefined
-
 pprLabel :: Platform -> CLabel -> SDoc
 pprLabel platform lbl =
    pprGloblDecl lbl
@@ -81,7 +75,7 @@ pprLabel platform lbl =
    $$ (ppr lbl <> char ':')
 
 pprAlign :: Platform -> Alignment -> SDoc
-pprAlign platform alignment
+pprAlign _platform alignment
         = text "\t.balign " <> int (alignmentBytes alignment)
 
 -- | Print appropriate alignment for the given section type.
@@ -141,6 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
     -- See https://gitlab.haskell.org/ghc/ghc/-/issues/367
     -- This only intends to catch the very trivial case, not the more
     -- compilicated cases.
+    {-
     detectTrivialDeadlock :: [Instr] -> [Instr]
     detectTrivialDeadlock instrs = case (findIndex isSelfBranch instrs) of
       Just n | all (not . aarch64_isJumpishInstr) (take n instrs) ->
@@ -157,6 +152,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
 
       where isSelfBranch (B (TBlock blockid')) = blockid' == blockid
             isSelfBranch _ = False
+    -}
 
     asmLbl = blockLbl blockid
     platform = ncgPlatform config
@@ -254,6 +250,8 @@ pprDataItem config lit
            = let bs = doubleToBytes (fromRational r)
              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 
+        ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)
+
 pprImm :: Imm -> SDoc
 
 pprImm (ImmInt i)     = int i
@@ -339,7 +337,6 @@ pprOp op = case op of
   OpAddr (AddrRegReg r1 r2) -> char '[' <+> pprReg W64 r1 <> comma <+> pprReg W64 r2 <+> char ']'
   OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm im <+> char ']'
   OpAddr (AddrReg r1)       -> char '[' <+> pprReg W64 r1 <+> char ']'
-  OpAddr _          -> panic "AArch64.pprOp: no amode"
 
 pprReg :: Width -> Reg -> SDoc
 pprReg w r = case r of
@@ -349,6 +346,7 @@ pprReg w r = case r of
   RegVirtual (VirtualRegI u)   -> text "%vI_" <> pprUniqueAlways u
   RegVirtual (VirtualRegF u)   -> text "%vF_" <> pprUniqueAlways u
   RegVirtual (VirtualRegD u)   -> text "%vD_" <> pprUniqueAlways u
+  _                            -> pprPanic "AArch64.pprReg" (text $ show r)
 
   where
     ppr_reg_no :: Width -> Int -> SDoc
@@ -459,7 +457,7 @@ pprInstr platform instr = case instr of
 
   BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> ppr (mkLocalBlockLabel (getUnique bid))
   BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> ppr lbl
-  BCOND c (TReg r)     -> panic "AArch64.ppr: No conditional branching to registers!"
+  BCOND _ (TReg _)     -> panic "AArch64.ppr: No conditional branching to registers!"
 
   -- 5. Atomic Instructions ----------------------------------------------------
   -- 6. Conditional Instructions -----------------------------------------------
@@ -467,11 +465,11 @@ pprInstr platform instr = case instr of
 
   CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp o <> comma <+> ppr (mkLocalBlockLabel (getUnique bid))
   CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp o <> comma <+> ppr lbl
-  CBZ c (TReg r)     -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"
+  CBZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"
 
   CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp o <> comma <+> ppr (mkLocalBlockLabel (getUnique bid))
   CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp o <> comma <+> ppr lbl
-  CBNZ c (TReg r)     -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
+  CBNZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
 
   -- 7. Load and Store Instructions --------------------------------------------
   -- NOTE: GHC may do whacky things where it only load the lower part of an
@@ -544,4 +542,10 @@ pprCond c = case c of
   OLT    -> text "mi"
   OLE    -> text "ls"
   OGE    -> text "ge"
-  OGT    -> text "gt"
\ No newline at end of file
+  OGT    -> text "gt"
+
+  -- Unordered
+  UOLT   -> text "lt"
+  UOLE   -> text "le"
+  UOGE   -> text "pl"
+  UOGT   -> text "hi"
\ No newline at end of file


=====================================
compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
=====================================
@@ -5,17 +5,10 @@ module GHC.CmmToAsm.AArch64.RegInfo where
 
 import GHC.Prelude
 
-import GHC.Platform.Reg
-import GHC.Platform.Reg.Class
-import GHC.CmmToAsm.Format
-
 import GHC.CmmToAsm.AArch64.Instr
-
 import GHC.Cmm.BlockId
 import GHC.Cmm
-import GHC.Cmm.CLabel
 
-import GHC.Types.Unique
 import GHC.Utils.Outputable
 
 data JumpDest = DestBlockId BlockId


=====================================
compiler/GHC/CmmToAsm/PIC.hs
=====================================
@@ -268,7 +268,7 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl
 -- is enough for ~64MB of range. Anything else will need to go through a veneer,
 -- which is the job of the linker to build.  We might only want to lookup
 -- Data References through the GOT.
-howToAccessLabel config ArchAArch64 _os this_mod kind lbl
+howToAccessLabel config ArchAArch64 _os this_mod _kind lbl
         | not (ncgExternalDynamicRefs config)
         = AccessDirectly
 


=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -154,6 +154,8 @@ instance Instruction instr => Instruction (InstrSR instr) where
         mkStackDeallocInstr platform amount =
              Instr <$> mkStackDeallocInstr platform amount
 
+        mkComment               = fmap Instr . mkComment
+
 
 -- | An instruction with liveness information.
 data LiveInstr instr



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb3db8938347b148a4b5dd7b3d1fbf1282d12a21
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/20200911/862b2869/attachment-0001.html>


More information about the ghc-commits mailing list