[Git][ghc/ghc][wip/supersven/ghc-9.10-riscv-ncg] 2 commits: Rename registers

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Sat Jul 27 07:44:08 UTC 2024



Sven Tennie pushed to branch wip/supersven/ghc-9.10-riscv-ncg at Glasgow Haskell Compiler / GHC


Commits:
61b85d44 by Sven Tennie at 2024-07-27T09:43:11+02:00
Rename registers

- - - - -
21d88a0a by Sven Tennie at 2024-07-27T09:43:39+02:00
Format comment

- - - - -


4 changed files:

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


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -205,7 +205,7 @@ genSwitch config expr targets = do
           `appOL` t_code
           `appOL` toOL
             [ COMMENT (ftext "Jump table for switch"),
-              annExpr expr (LSL (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3))),
+              annExpr expr (SLL (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3))),
               ADD (OpReg W64 tmp) (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt2) tableReg),
               LDRU II64 (OpReg W64 tmp) (OpAddr (AddrRegImm tmp (ImmInt 0))),
               J_TBL ids (Just lbl) tmp
@@ -681,9 +681,9 @@ getRegister' config plat expr =
                   `appOL` toOL
                     [ ann
                         (text "MO_SS_Conv: narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to)
-                        (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))),
+                        (SLL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))),
                       -- signed right shift
-                      ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift))
+                      SRA (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift))
                     ]
                   `appOL` truncateReg from to dst
           | otherwise =
@@ -745,7 +745,7 @@ getRegister' config plat expr =
               (intFormat w)
               ( \dst ->
                   code_x
-                    `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
+                    `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
                     `appOL` truncateReg w w dst
               )
     CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)]
@@ -758,7 +758,7 @@ getRegister' config plat expr =
               (intFormat w)
               ( \dst ->
                   code_x
-                    `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
+                    `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
                     `appOL` truncateReg w w dst
               )
     CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
@@ -768,7 +768,7 @@ getRegister' config plat expr =
         $ Any
           (intFormat w)
           ( \dst ->
-              code_x `appOL` code_x' `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
+              code_x `appOL` code_x' `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
           )
     CmmMachOp (MO_S_Shr w) [x, y] -> do
       (reg_x, format_x, code_x) <- getSomeReg x
@@ -778,36 +778,36 @@ getRegister' config plat expr =
         $ Any
           (intFormat w)
           ( \dst ->
-              code_x `appOL` code_x' `appOL` code_y `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y))
+              code_x `appOL` code_x' `appOL` code_y `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y))
           )
     CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
       | w == W8,
         0 <= n,
         n < 8 -> do
           (reg_x, format_x, code_x) <- getSomeReg x
-          return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+          return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
     CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
       | w == W16,
         0 <= n,
         n < 16 -> do
           (reg_x, format_x, code_x) <- getSomeReg x
-          return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+          return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
     CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do
       (reg_x, format_x, code_x) <- getSomeReg x
       (reg_y, _format_y, code_y) <- getSomeReg y
-      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+      return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
     CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
       | w == W32,
         0 <= n,
         n < 32 -> do
           (reg_x, _format_x, code_x) <- getSomeReg x
-          return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+          return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
     CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
       | w == W64,
         0 <= n,
         n < 64 -> do
           (reg_x, _format_x, code_x) <- getSomeReg x
-          return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+          return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
 
     -- 3. Logic &&, ||
     CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)]
@@ -928,9 +928,9 @@ getRegister' config plat expr =
         MO_And w -> bitOp w (\d x y -> unitOL $ annExpr expr (AND d x y))
         MO_Or w -> bitOp w (\d x y -> unitOL $ annExpr expr (OR d x y))
         MO_Xor w -> bitOp w (\d x y -> unitOL $ annExpr expr (XOR d x y))
-        MO_Shl w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSL d x y))
-        MO_U_Shr w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSR d x y))
-        MO_S_Shr w -> intOp True w (\d x y -> unitOL $ annExpr expr (ASR d x y))
+        MO_Shl w -> intOp False w (\d x y -> unitOL $ annExpr expr (SLL d x y))
+        MO_U_Shr w -> intOp False w (\d x y -> unitOL $ annExpr expr (SRL d x y))
+        MO_S_Shr w -> intOp True w (\d x y -> unitOL $ annExpr expr (SRA d x y))
         op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> pdoc plat expr
 
     -- Generic ternary case.
@@ -992,9 +992,9 @@ getRegister' config plat expr =
                 `appOL` code_y
                 `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y
                 `appOL` toOL
-                  [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)),
+                  [ annExpr expr (MULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)),
                     MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y),
-                    ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))),
+                    SRA (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))),
                     ann
                       (text "Set flag if result of MULH contains more than sign bits.")
                       (XOR (OpReg w hi) (OpReg w hi) (OpReg w lo)),
@@ -1078,9 +1078,9 @@ signExtend w w' r r' =
   toOL
     [ ann
         (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w')
-        (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
+        (SLL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
       -- signed (arithmetic) right shift
-      ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
+      SRA (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
     ]
   where
     shift = 64 - widthInBits w
@@ -1105,9 +1105,9 @@ signExtendAdjustPrecission w w' r r'
       toOL
         [ ann
             (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w')
-            (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
+            (SLL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
           -- signed (arithmetic) right shift
-          ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
+          SRA (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
         ]
   where
     shift = 64 - widthInBits w'
@@ -1115,9 +1115,9 @@ signExtendAdjustPrecission w w' r r' =
   toOL
     [ ann
         (text "sign extend register" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w')
-        (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
+        (SLL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
       -- signed (arithmetic) right shift
-      ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
+      SRA (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
     ]
   where
     shift = 64 - widthInBits w
@@ -1135,9 +1135,9 @@ truncateReg w w' r =
   toOL
     [ ann
         (text "truncate register" <+> ppr r <+> ppr w <> text "->" <> ppr w')
-        (LSL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))),
+        (SLL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))),
       -- SHL ignores signedness!
-      LSR (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))
+      SRL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))
     ]
   where
     shift = 64 - widthInBits w'
@@ -1986,7 +1986,7 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
       POP_STACK_FRAME -> 4
       ADD {} -> 1
       MUL {} -> 1
-      SMULH {} -> 1
+      MULH {} -> 1
       NEG {} -> 1
       DIV {} -> 1
       REM {} -> 1
@@ -1995,10 +1995,10 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
       DIVU {} -> 1
       AND {} -> 1
       OR {} -> 1
-      ASR {} -> 1
+      SRA {} -> 1
       XOR {} -> 1
-      LSL {} -> 1
-      LSR {} -> 1
+      SLL {} -> 1
+      SRL {} -> 1
       MOV {} -> 2
       ORI {} -> 1
       XORI {} -> 1


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -75,7 +75,7 @@ regUsageOfInstr platform instr = case instr of
   ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   NEG dst src -> usage (regOp src, regOp dst)
-  SMULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+  MULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   REMU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -83,10 +83,10 @@ regUsageOfInstr platform instr = case instr of
   DIVU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
-  ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+  SRA dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
-  LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
-  LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+  SLL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+  SRL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
   MOV dst src -> usage (regOp src, regOp dst)
   -- ORI's third operand is always an immediate
   ORI dst src1 _ -> usage (regOp src1, regOp dst)
@@ -159,7 +159,7 @@ patchRegsOfInstr instr env = case instr of
   ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
   MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
   NEG o1 o2 -> NEG (patchOp o1) (patchOp o2)
-  SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2) (patchOp o3)
+  MULH o1 o2 o3 -> MULH (patchOp o1) (patchOp o2) (patchOp o3)
   DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3)
   REM o1 o2 o3 -> REM (patchOp o1) (patchOp o2) (patchOp o3)
   REMU o1 o2 o3 -> REMU (patchOp o1) (patchOp o2) (patchOp o3)
@@ -167,10 +167,10 @@ patchRegsOfInstr instr env = case instr of
   DIVU o1 o2 o3 -> DIVU (patchOp o1) (patchOp o2) (patchOp o3)
   AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3)
   OR o1 o2 o3 -> OR (patchOp o1) (patchOp o2) (patchOp o3)
-  ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3)
+  SRA o1 o2 o3 -> SRA (patchOp o1) (patchOp o2) (patchOp o3)
   XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3)
-  LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3)
-  LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3)
+  SLL o1 o2 o3 -> SLL (patchOp o1) (patchOp o2) (patchOp o3)
+  SRL o1 o2 o3 -> SRL (patchOp o1) (patchOp o2) (patchOp o3)
   MOV o1 o2 -> MOV (patchOp o1) (patchOp o2)
   -- o3 cannot be a register for ORI (always an immediate)
   ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3)
@@ -479,15 +479,15 @@ data Instr
   | -- | Logical left shift (zero extened, integer only)
     --
     -- @rd = rs1 << rs2@
-    LSL {- SLL -} Operand Operand Operand
+    SLL Operand Operand Operand
   | -- | Logical right shift (zero extened, integer only)
     --
     -- @rd = rs1 >> rs2@
-    LSR {- SRL -} Operand Operand Operand
+    SRL Operand Operand Operand
   | -- | Arithmetic right shift (sign-extened, integer only)
     --
     -- @rd = rs1 >> rs2@
-    ASR {- SRA -} Operand Operand Operand
+    SRA Operand Operand Operand
   | -- | Store to memory (both, integer and floating point)
     STR Format Operand Operand
   | -- | Load from memory (sign-extended, integer and floating point)
@@ -514,12 +514,10 @@ data Instr
     --
     -- @rd = |rn % rm|@
     REMU Operand Operand Operand
-  | -- TODO: Rename: MULH
-
-    -- | High part of a multiplication that doesn't fit into 64bits (integer only)
+  | -- | High part of a multiplication that doesn't fit into 64bits (integer only)
     --
     -- E.g. for a multiplication with 64bits width: @rd = (rs1 * rs2) >> 64 at .
-    SMULH Operand Operand Operand
+    MULH Operand Operand Operand
   | -- | Unsigned division (integer only)
     --
     -- @rd = |rn รท rm|@
@@ -596,14 +594,14 @@ instrCon i =
     DIV {} -> "DIV"
     REM {} -> "REM"
     REMU {} -> "REMU"
-    SMULH {} -> "SMULH"
+    MULH {} -> "MULH"
     SUB {} -> "SUB"
     DIVU {} -> "DIVU"
     AND {} -> "AND"
-    ASR {} -> "ASR"
+    SRA {} -> "SRA"
     XOR {} -> "XOR"
-    LSL {} -> "LSL"
-    LSR {} -> "LSR"
+    SLL {} -> "SLL"
+    SRL {} -> "SRL"
     MOV {} -> "MOV"
     ORI {} -> "ORI"
     XORI {} -> "ORI"


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -483,7 +483,7 @@ pprInstr platform instr = case instr of
   MUL o1 o2 o3
     | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
     | otherwise -> op3 (text "\tmul") o1 o2 o3
-  SMULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3
+  MULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3
   NEG o1 o2 | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfneg.s") o1 o2
   NEG o1 o2 | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfneg.d") o1 o2
   NEG o1 o2 -> op2 (text "\tneg") o1 o2
@@ -506,11 +506,11 @@ pprInstr platform instr = case instr of
     | isImmOp o3 -> op3 (text "\tandi") o1 o2 o3
     | otherwise -> op3 (text "\tand") o1 o2 o3
   OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3
-  ASR o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3
-  ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3
+  SRA o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3
+  SRA o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3
   XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3
-  LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3
-  LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3
+  SLL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3
+  SRL o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3
   MOV o1 o2
     | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.d") o1 o2 -- fmv.d rd, rs is pseudo op fsgnj.d rd, rs, rs
     | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.s") o1 o2 -- fmv.s rd, rs is pseudo op fsgnj.s rd, rs, rs


=====================================
compiler/GHC/CmmToAsm/RV64/Regs.hs
=====================================
@@ -125,13 +125,10 @@ allFpArgRegs = map regSingle [fa0RegNo .. fa7RegNo]
 
 -- * Addressing modes
 
--- TODO: AddReg seems to be just a special case of AddrRegImm. Maybe we should
--- replace it with AddrRegImm having an Imm of 0.
-
 -- | Addressing modes
 data AddrMode
-  = -- | A register plus some integer, e.g. @8(sp)@ or @-16(sp)@. The offset
-    -- needs to fit into 12bits.
+  = -- | A register plus some immediate integer, e.g. @8(sp)@ or @-16(sp)@. The
+    -- offset needs to fit into 12bits.
     AddrRegImm Reg Imm
   | -- | A register
     AddrReg Reg



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45c672c085cce573c24d048ab018c895d4acb2a3...21d88a0a9476597aa7cf33d024358a876ba5625a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45c672c085cce573c24d048ab018c895d4acb2a3...21d88a0a9476597aa7cf33d024358a876ba5625a
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/20240727/b0bfe879/attachment-0001.html>


More information about the ghc-commits mailing list