[Git][ghc/ghc][wip/ncg-simd] 2 commits: emit ymm/zmm when appropriate

sheaf (@sheaf) gitlab at gitlab.haskell.org
Mon Jun 10 16:04:09 UTC 2024



sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC


Commits:
35121e83 by sheaf at 2024-06-10T12:19:37+02:00
emit ymm/zmm when appropriate

- - - - -
75ec79c1 by sheaf at 2024-06-10T18:03:15+02:00
fix reg2reg for vectors

- - - - -


11 changed files:

- compiler/GHC/Cmm/Reg.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs


Changes:

=====================================
compiler/GHC/Cmm/Reg.hs
=====================================
@@ -97,7 +97,7 @@ pprReg :: CmmReg -> SDoc
 pprReg r
    = case r of
         CmmLocal  local                   -> pprLocalReg  local
-        CmmGlobal (GlobalRegUse global _) -> pprGlobalReg global
+        CmmGlobal (GlobalRegUse global ty) -> pprGlobalReg global <> dcolon <> ppr ty
 
 cmmRegType :: CmmReg -> CmmType
 cmmRegType (CmmLocal  reg) = localRegType reg


=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -433,8 +433,10 @@ isMetaInstr instr
 
 -- | Copy the value in a register to another one.
 -- Must work for all register classes.
-mkRegRegMoveInstr :: Reg -> Reg -> Instr
-mkRegRegMoveInstr src dst = ANN (text "Reg->Reg Move: " <> ppr src <> text " -> " <> ppr dst) $ MOV (OpReg W64 dst) (OpReg W64 src)
+mkRegRegMoveInstr :: Format -> Reg -> Reg -> Instr
+mkRegRegMoveInstr _fmt src dst
+  = ANN (text "Reg->Reg Move: " <> ppr src <> text " -> " <> ppr dst) $ MOV (OpReg W64 dst) (OpReg W64 src)
+  -- SIMD NCG TODO: incorrect for vector formats
 
 -- | Take the source and destination from this reg -> reg move instruction
 -- or Nothing if it's not one


=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -134,6 +134,7 @@ class Instruction instr where
         --      Must work for all register classes.
         mkRegRegMoveInstr
                 :: Platform
+                -> Format
                 -> Reg          -- ^ source register
                 -> Reg          -- ^ destination register
                 -> instr


=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -664,12 +664,14 @@ isMetaInstr instr
 -- | Copy the value in a register to another one.
 -- Must work for all register classes.
 mkRegRegMoveInstr
-    :: Reg
+    :: Format
+    -> Reg
     -> Reg
     -> Instr
 
-mkRegRegMoveInstr src dst
+mkRegRegMoveInstr _fmt src dst
     = MR dst src
+    -- SIMD NCG TODO: handle vector format
 
 
 -- | Make an unconditional jump instruction.


=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -161,14 +161,14 @@ cleanForward _ _ _ acc []
 cleanForward platform blockId assoc acc (li1 : li2 : instrs)
 
         | LiveInstr (SPILL  reg1  _ slot1) _      <- li1
-        , LiveInstr (RELOAD slot2 reg2 _)  _      <- li2
+        , LiveInstr (RELOAD slot2 reg2 fmt) _      <- li2
         , slot1 == slot2
         = do
                 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
                 cleanForward platform blockId assoc acc
-                -- SIMD NCG TODO: is mkRegRegMoveInstr here OK for vectors?
-                 $ li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing
+                 $ li1 : LiveInstr (mkRegRegMoveInstr platform fmt reg1 reg2) Nothing
                        : instrs
+                   -- SIMD NCG TODO: is this "fmt" correct?
 
 cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
         | Just (r1, r2) <- takeRegRegMoveInstr i1
@@ -230,7 +230,7 @@ cleanReload
         -> LiveInstr instr
         -> CleanM (Assoc Store, Maybe (LiveInstr instr))
 
-cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg _) _)
+cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg fmt) _)
 
         -- If the reg we're reloading already has the same value as the slot
         --      then we can erase the instruction outright.
@@ -248,7 +248,8 @@ cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg _) _)
                                 $ assoc
 
                 return  ( assoc'
-                        , Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
+                        , Just $ LiveInstr (mkRegRegMoveInstr platform fmt reg2 reg) Nothing)
+            -- SIMD NCG TODO: is this fmt correct?
 
         -- Gotta keep this instr.
         | otherwise


=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -712,7 +712,7 @@ saveClobberedTemps clobbered dying
                   setFreeRegsR (frAllocateReg platform my_reg freeRegs)
 
                   let new_assign = addToUFM_Directly assig temp (InReg (RealRegUsage my_reg fmt))
-                  let instr = mkRegRegMoveInstr platform
+                  let instr = mkRegRegMoveInstr platform fmt
                                   (RegReal reg) (RegReal my_reg)
 
                   return (new_assign,(instr : instrs))


=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -363,10 +363,9 @@ makeMove delta vreg src dst
       let platform = ncgPlatform config
 
       case (src, dst) of
-          (InReg (RealRegUsage s _), InReg (RealRegUsage d _)) ->
+          (InReg (RealRegUsage s _), InReg (RealRegUsage d fmt)) ->
               do recordSpill (SpillJoinRR vreg)
-                 -- SIMD NCG TODO: does reg-2-reg work for vector registers?
-                 return $ [mkRegRegMoveInstr platform (RegReal s) (RegReal d)]
+                 return $ [mkRegRegMoveInstr platform fmt (RegReal s) (RegReal d)]
           (InMem s, InReg (RealRegUsage d cls)) ->
               do recordSpill (SpillJoinRM vreg)
                  return $ mkLoadInstr config (RegReal d) cls delta s


=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -153,8 +153,8 @@ instance Instruction instr => Instruction (InstrSR instr) where
                 Instr instr     -> isMetaInstr instr
                 _               -> False
 
-        mkRegRegMoveInstr platform r1 r2
-            = Instr (mkRegRegMoveInstr platform r1 r2)
+        mkRegRegMoveInstr platform fmt r1 r2
+            = Instr (mkRegRegMoveInstr platform fmt r1 r2)
 
         takeRegRegMoveInstr i
          = case i of


=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1569,6 +1569,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
                 CmmInt 1 _ -> exp `snocOL`
                               (MOVH format (OpReg r) (OpAddr addr)) `snocOL`
                               (MOV FF64 (OpAddr addr) (OpReg dst))
+                 -- SIMD NCG TODO: avoid going via the stack here?
                 _          -> panic "Error in offset while unpacking"
       return (Any format code)
     vector_float_unpack _ w c e


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -911,17 +911,15 @@ isMetaInstr instr
 -- | Make a reg-reg move instruction.
 mkRegRegMoveInstr
     :: Platform
+    -> Format
     -> Reg
     -> Reg
     -> Instr
 
-mkRegRegMoveInstr platform src dst
- = case targetClassOfReg platform src of
-        RcInteger -> case platformArch platform of
-                     ArchX86    -> MOV II32 (OpReg src) (OpReg dst)
-                     ArchX86_64 -> MOV II64 (OpReg src) (OpReg dst)
-                     _          -> panic "X86.mkRegRegMoveInstr: Bad arch"
-        RcFloatOrVector    ->  MOV FF64 (OpReg src) (OpReg dst)
+mkRegRegMoveInstr _platform fmt src dst =
+  case fmt of
+    VecFormat {} -> MOVU fmt (OpReg src) (OpReg dst)
+    _ -> MOV fmt (OpReg src) (OpReg dst)
 
 -- | Check whether an instruction represents a reg-reg move.
 --      The register allocator attempts to eliminate reg->reg moves whenever it can,


=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -301,7 +301,7 @@ pprReg platform f r
     ppr32_reg_no :: Format -> Int -> doc
     ppr32_reg_no II8   = ppr32_reg_byte
     ppr32_reg_no II16  = ppr32_reg_word
-    ppr32_reg_no _     = ppr32_reg_long
+    ppr32_reg_no fmt   = ppr32_reg_long fmt
 
     ppr32_reg_byte i =
       case i of {
@@ -319,20 +319,20 @@ pprReg platform f r
         _  -> text "very naughty I386 word register"
       }
 
-    ppr32_reg_long i =
+    ppr32_reg_long fmt i =
       case i of {
          0 -> text "%eax";    1 -> text "%ebx";
          2 -> text "%ecx";    3 -> text "%edx";
          4 -> text "%esi";    5 -> text "%edi";
          6 -> text "%ebp";    7 -> text "%esp";
-         _  -> ppr_reg_float i
+         _  -> ppr_reg_float fmt i
       }
 
     ppr64_reg_no :: Format -> Int -> doc
     ppr64_reg_no II8   = ppr64_reg_byte
     ppr64_reg_no II16  = ppr64_reg_word
     ppr64_reg_no II32  = ppr64_reg_long
-    ppr64_reg_no _     = ppr64_reg_quad
+    ppr64_reg_no fmt   = ppr64_reg_quad fmt
 
     ppr64_reg_byte i =
       case i of {
@@ -373,7 +373,7 @@ pprReg platform f r
         _  -> text "very naughty x86_64 register"
       }
 
-    ppr64_reg_quad i =
+    ppr64_reg_quad fmt i =
       case i of {
          0 -> text "%rax";     1 -> text "%rbx";
          2 -> text "%rcx";     3 -> text "%rdx";
@@ -383,11 +383,35 @@ pprReg platform f r
         10 -> text "%r10";    11 -> text "%r11";
         12 -> text "%r12";    13 -> text "%r13";
         14 -> text "%r14";    15 -> text "%r15";
-        _  -> ppr_reg_float i
+        _  -> ppr_reg_float fmt i
       }
 
-ppr_reg_float :: IsLine doc => Int -> doc
-ppr_reg_float i = case i of
+ppr_reg_float :: IsLine doc => Format -> Int -> doc
+ppr_reg_float fmt i
+  | W256 <- size
+  = case i of
+        16 -> text "%ymm0" ;   17 -> text "%ymm1"
+        18 -> text "%ymm2" ;   19 -> text "%ymm3"
+        20 -> text "%ymm4" ;   21 -> text "%ymm5"
+        22 -> text "%ymm6" ;   23 -> text "%ymm7"
+        24 -> text "%ymm8" ;   25 -> text "%ymm9"
+        26 -> text "%ymm10";   27 -> text "%ymm11"
+        28 -> text "%ymm12";   29 -> text "%ymm13"
+        30 -> text "%ymm14";   31 -> text "%ymm15"
+        _  -> text "very naughty x86 register"
+  | W512 <- size
+  = case i of
+        16 -> text "%zmm0" ;   17 -> text "%zmm1"
+        18 -> text "%zmm2" ;   19 -> text "%zmm3"
+        20 -> text "%zmm4" ;   21 -> text "%zmm5"
+        22 -> text "%zmm6" ;   23 -> text "%zmm7"
+        24 -> text "%zmm8" ;   25 -> text "%zmm9"
+        26 -> text "%zmm10";   27 -> text "%zmm11"
+        28 -> text "%zmm12";   29 -> text "%zmm13"
+        30 -> text "%zmm14";   31 -> text "%zmm15"
+        _  -> text "very naughty x86 register"
+  | otherwise
+  = case i of
         16 -> text "%xmm0" ;   17 -> text "%xmm1"
         18 -> text "%xmm2" ;   19 -> text "%xmm3"
         20 -> text "%xmm4" ;   21 -> text "%xmm5"
@@ -397,6 +421,7 @@ ppr_reg_float i = case i of
         28 -> text "%xmm12";   29 -> text "%xmm13"
         30 -> text "%xmm14";   31 -> text "%xmm15"
         _  -> text "very naughty x86 register"
+  where size = formatToWidth fmt
 
 pprFormat :: IsLine doc => Format -> doc
 pprFormat x = case x of



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbd321e81cf7876ebb3ea50d5136fb71b9125932...75ec79c179a2c4999fbff4b7e4baa1d12621d6a2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbd321e81cf7876ebb3ea50d5136fb71b9125932...75ec79c179a2c4999fbff4b7e4baa1d12621d6a2
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/20240610/be9f151e/attachment-0001.html>


More information about the ghc-commits mailing list