[Git][ghc/ghc][wip/supersven/riscv-vectors] 3 commits: Assert vector register width

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Mon Jan 27 18:39:53 UTC 2025



Sven Tennie pushed to branch wip/supersven/riscv-vectors at Glasgow Haskell Compiler / GHC


Commits:
e430c7f1 by Sven Tennie at 2025-01-27T18:03:58+01:00
Assert vector register width

- - - - -
2162e78f by Sven Tennie at 2025-01-27T18:48:33+01:00
Combine float lit cases

- - - - -
fa321f9c by Sven Tennie at 2025-01-27T19:39:22+01:00
Tighten Vector Ppr constraints

- - - - -


3 changed files:

- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -471,8 +471,27 @@ litToImm' = OpImm . litToImm
 getRegister :: CmmExpr -> NatM Register
 getRegister e = do
   config <- getConfig
+  assertVectorRegWidth e
   getRegister' config (ncgPlatform config) e
 
+assertVectorRegWidth :: CmmExpr -> NatM ()
+assertVectorRegWidth expr = do
+  config <- getConfig
+  let platform = ncgPlatform config
+      mbRegMinBits :: Maybe Int = fromIntegral <$> ncgVectorMinBits config
+      format = cmmTypeFormat $ cmmExprType platform expr
+  if isVecFormat format then
+   case mbRegMinBits of
+    Nothing -> pprPanic
+                "CmmExpr results in vector format, but no vector register configured (see -mvector-min-width-bits in docs)"
+                (pdoc platform expr)
+    Just regMinBits | (formatInBytes format) * 8 <= regMinBits -> pure ()
+                    | otherwise -> pprPanic 
+                      "CmmExpr results in vector format which is bigger than the configured vector register size (see -mvector-min-width-bits in docs)"
+                      (pdoc platform expr)
+  else
+    pure ()
+
 -- | The register width to be used for an operation on the given width
 -- operand.
 opRegWidth :: Width -> Width
@@ -581,29 +600,17 @@ getRegister' config plat expr =
           let op = litToImm' lit
               format = floatFormat w
           pure $ Any format (\dst -> unitOL $ annExpr expr (MOV (OpReg format dst) op))
-        CmmFloat _f W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (pdoc plat expr)
-        CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr)
-        CmmFloat f W32 -> do
-          -- TODO: Besides width, much duplication with the W64 case!
-          let word = castFloatToWord32 (fromRational f) :: Word32
-              format_int = intFormat W32
-              format_dst = floatFormat W32
-          intReg <- getNewRegNat format_int
-          return
-            ( Any
-                format_dst
-                ( \dst ->
-                    toOL
-                      [ annExpr expr
-                          $ MOV (OpReg format_int intReg) (OpImm (ImmInteger (fromIntegral word))),
-                        MOV (OpReg format_dst dst) (OpReg format_int intReg)
-                      ]
-                )
-            )
-        CmmFloat f W64 -> do
-          let word = castDoubleToWord64 (fromRational f) :: Word64
-              format_int = intFormat W64
-              format_dst = floatFormat W64
+        CmmFloat f w -> do
+          let
+              toWord :: Rational -> Integer
+              toWord r = case w of
+                        W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (pdoc plat expr)  
+                        W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr)
+                        W32 -> fromIntegral $ castFloatToWord32 (fromRational r)
+                        W64 -> fromIntegral $ castDoubleToWord64 (fromRational r)
+                        w -> pprPanic ("getRegister' (CmmLit:CmmFloat), no support for width " ++ show w) (pdoc plat expr)
+              format_int = intFormat w
+              format_dst = floatFormat w
           intReg <- getNewRegNat format_int
           return
             ( Any
@@ -611,12 +618,11 @@ getRegister' config plat expr =
                 ( \dst ->
                     toOL
                       [ annExpr expr
-                          $ MOV (OpReg format_int intReg) (OpImm (ImmInteger (fromIntegral word))),
+                          $ MOV (OpReg format_int intReg) (OpImm (ImmInteger (toWord f))),
                         MOV (OpReg format_dst dst) (OpReg format_int intReg)
                       ]
                 )
             )
-        CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (pdoc plat expr)
         CmmVec lits
           | VecFormat l sFmt <- cmmTypeFormat $ cmmLitType plat lit,
             (f : fs) <- lits,


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -983,3 +983,6 @@ isVectorReg :: Reg -> Bool
 isVectorReg (RegReal (RealRegSingle i)) | isVectorRegNo i = True
 isVectorReg (RegVirtual (VirtualRegD _)) = True
 isVectorReg _ = False
+
+allVectorRegOps :: [Operand] -> Bool
+allVectorRegOps = all isVectorRegOp


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -315,6 +315,9 @@ negOp (OpImm (ImmInt i)) = OpImm (ImmInt (negate i))
 negOp (OpImm (ImmInteger i)) = OpImm (ImmInteger (negate i))
 negOp op = pprPanic "RV64.negOp" (text $ show op)
 
+pprOps :: (IsLine doc) => Platform -> [Operand] -> doc
+pprOps platform = hsep . map (pprOp platform)
+
 -- | Pretty print an operand
 pprOp :: (IsLine doc) => Platform -> Operand -> doc
 pprOp plat op = case op of
@@ -753,16 +756,12 @@ pprInstr platform instr = case instr of
   VMV o1 _o2 -> pprPanic "RV64.pprInstr - VMV can only target registers." (pprOp platform o1)
   VID op@(OpReg fmt _reg) -> configVec fmt $$ op1 (text "\tvid.v") op
   VID op -> pprPanic "RV64.pprInstr - VID can only target registers." (pprOp platform op)
-  -- TODO: This expects int register as third operand: Generalize by calculating
-  -- the instruction suffix (".vx")
-  VMSEQ o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvmseq.vx") o1 o2 o3
-  VMSEQ o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VMSEQ can only target registers." (pprOp platform o1)
-  -- TODO: All operands need to be vector registers. Make this more general or
-  -- validate this constraint.
-  VMERGE o1@(OpReg fmt _reg) o2 o3 o4 -> configVec fmt $$ op4 (text "\tvmerge.vvm") o1 o2 o3 o4
-  VMERGE o1 _o2 _o3 _o4 -> pprPanic "RV64.pprInstr - VMERGE can only target registers." (pprOp platform o1)
-  VSLIDEDOWN o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvslidedown.vx") o1 o2 o3
-  VSLIDEDOWN o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VSLIDEDOWN can only target registers." (pprOp platform o1)
+  VMSEQ o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2] && isIntOp o3 -> configVec fmt $$ op3 (text "\tvmseq.vx") o1 o2 o3
+  VMSEQ o1 o2 o3 -> pprPanic "RV64.pprInstr - VMSEQ wrong operands." (pprOps platform [o1, o2, o3])
+  VMERGE o1@(OpReg fmt _reg) o2 o3 o4 | allVectorRegOps [o1, o2, o3, o4] -> configVec fmt $$ op4 (text "\tvmerge.vvm") o1 o2 o3 o4
+  VMERGE o1 o2 o3 o4 -> pprPanic "RV64.pprInstr - VMERGE wrong operands." (pprOps platform [o1, o2, o3, o4])
+  VSLIDEDOWN o1@(OpReg fmt _reg) o2 o3 |allVectorRegOps [o1, o2] && isIntOp o3-> configVec fmt $$ op3 (text "\tvslidedown.vx") o1 o2 o3
+  VSLIDEDOWN o1 o2 o3 -> pprPanic "RV64.pprInstr - VSLIDEDOWN wrong operands." (pprOps platform [o1, o2, o3])
   -- TODO: adjust VSETIVLI to contain only format?
   VSETIVLI (OpReg fmt dst) len width grouping ta ma ->
     line
@@ -778,29 +777,29 @@ pprInstr platform instr = case instr of
       <+> pprTA ta
       <> comma
       <+> pprMasking ma
-  VSETIVLI o1 _ _ _ _ _ -> pprPanic "RV64.pprInstr - VSETIVLI can only target registers." (pprOp platform o1)
-  VNEG o1@(OpReg fmt _reg) o2 -> configVec fmt $$ op2 (text "\tvfneg.v") o1 o2
-  VNEG o1 _o2 -> pprPanic "RV64.pprInstr - VNEG can only target registers." (pprOp platform o1)
-  VADD o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfadd.vv") o1 o2 o3
-  VADD o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VADD can only target registers." (pprOp platform o1)
-  VSUB o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfsub.vv") o1 o2 o3
-  VSUB o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VSUB can only target registers." (pprOp platform o1)
-  VMUL o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfmul.vv") o1 o2 o3
-  VMUL o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VMUL can only target registers." (pprOp platform o1)
-  VQUOT o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfdiv.vv") o1 o2 o3
-  VQUOT o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VQUOT can only target registers." (pprOp platform o1)
-  VSMIN o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvmin.vv") o1 o2 o3
-  VSMIN o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VSMIN can only target registers." (pprOp platform o1)
-  VSMAX o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvmax.vv") o1 o2 o3
-  VSMAX o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VSMAX can only target registers." (pprOp platform o1)
-  VUMIN o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvminu.vv") o1 o2 o3
-  VUMIN o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VUMIN can only target registers." (pprOp platform o1)
-  VUMAX o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvmaxu.vv") o1 o2 o3
-  VUMAX o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VUMAX can only target registers." (pprOp platform o1)
-  VFMIN o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfmin.vv") o1 o2 o3
-  VFMIN o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VFMIN can only target registers." (pprOp platform o1)
-  VFMAX o1@(OpReg fmt _reg) o2 o3 -> configVec fmt $$ op3 (text "\tvfmax.vv") o1 o2 o3
-  VFMAX o1 _o2 _o3 -> pprPanic "RV64.pprInstr - VFMAX can only target registers." (pprOp platform o1)
+  VSETIVLI o1 _ _ _ _ _ -> pprPanic "RV64.pprInstr - VSETIVLI wrong operands." (pprOp platform o1)
+  VNEG o1@(OpReg fmt _reg) o2 | allVectorRegOps [o1, o2] -> configVec fmt $$ op2 (text "\tvfneg.v") o1 o2
+  VNEG o1 o2 -> pprPanic "RV64.pprInstr - VNEG wrong operands." (pprOps platform [o1, o2])
+  VADD o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfadd.vv") o1 o2 o3
+  VADD o1 o2 o3 -> pprPanic "RV64.pprInstr - VADD wrong operands." (pprOps platform [o1, o2, o3])
+  VSUB o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfsub.vv") o1 o2 o3
+  VSUB o1 o2 o3 -> pprPanic "RV64.pprInstr - VSUB wrong operands." (pprOps platform [o1, o2, o3])
+  VMUL o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfmul.vv") o1 o2 o3
+  VMUL o1 o2 o3 -> pprPanic "RV64.pprInstr - VMUL wrong operands." (pprOps platform [o1, o2, o3])
+  VQUOT o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfdiv.vv") o1 o2 o3
+  VQUOT o1 o2 o3 -> pprPanic "RV64.pprInstr - VQUOT wrong operands." (pprOps platform [o1, o2, o3])
+  VSMIN o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvmin.vv") o1 o2 o3
+  VSMIN o1 o2 o3 -> pprPanic "RV64.pprInstr - VSMIN wrong operands." (pprOps platform [o1, o2, o3])
+  VSMAX o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvmax.vv") o1 o2 o3
+  VSMAX o1 o2 o3 -> pprPanic "RV64.pprInstr - VSMAX wrong operands." (pprOps platform [o1, o2, o3])
+  VUMIN o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvminu.vv") o1 o2 o3
+  VUMIN o1 o2 o3 -> pprPanic "RV64.pprInstr - VUMIN wrong operands." (pprOps platform [o1, o2, o3])
+  VUMAX o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvmaxu.vv") o1 o2 o3
+  VUMAX o1 o2 o3 -> pprPanic "RV64.pprInstr - VUMAX wrong operands." (pprOps platform [o1, o2, o3])
+  VFMIN o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfmin.vv") o1 o2 o3
+  VFMIN o1 o2 o3 -> pprPanic "RV64.pprInstr - VFMIN wrong operands." (pprOps platform [o1, o2, o3])
+  VFMAX o1@(OpReg fmt _reg) o2 o3 | allVectorRegOps [o1, o2, o3] -> configVec fmt $$ op3 (text "\tvfmax.vv") o1 o2 o3
+  VFMAX o1 o2 o3 -> pprPanic "RV64.pprInstr - VFMAX wrong operands." (pprOps platform [o1, o2, o3])
   instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ instrCon instr
   where
     op1 op o1 = line $ op <+> pprOp platform o1



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/715a80b12d5479512c9bd0130c8070c28b65f1cb...fa321f9c00874feb7900690feb90cf991c4e5c63

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/715a80b12d5479512c9bd0130c8070c28b65f1cb...fa321f9c00874feb7900690feb90cf991c4e5c63
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/20250127/bea22b4b/attachment-0001.html>


More information about the ghc-commits mailing list