[Git][ghc/ghc][wip/supersven/ghc-master-riscv-ncg] WIP: FIXUP for master

[Sven Tennie (@supersven)]

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


Commits:
de95068e by Sven Tennie at 2024-08-05T18:52:14+02:00
WIP: FIXUP for master

Will be squashed later. For now it's convenient to have a separate commit.

- - - - -


3 changed files:

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


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64.hs
=====================================
@@ -42,6 +42,7 @@ instance Instruction RV64.Instr where
   regUsageOfInstr = RV64.regUsageOfInstr
   patchRegsOfInstr = RV64.patchRegsOfInstr
   isJumpishInstr = RV64.isJumpishInstr
+  canFallthroughTo = RV64.canFallthroughTo
   jumpDestsOfInstr = RV64.jumpDestsOfInstr
   patchJumpInstr = RV64.patchJumpInstr
   mkSpillInstr = RV64.mkSpillInstr


=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -619,7 +619,7 @@ getRegister' config plat expr =
                     `snocOL` NEG (OpReg w dst) (OpReg w reg)
               )
         -- TODO: Can this case happen?
-        MO_SF_Conv from to | from < W32 -> do
+        MO_SF_Round from to | from < W32 -> do
           -- extend to the smallest available representation
           (reg_x, code_x) <- signExtendReg from W32 reg
           pure
@@ -630,16 +630,16 @@ getRegister' config plat expr =
                     `appOL` code_x
                     `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg_x)) -- (Signed ConVerT Float)
               )
-        MO_SF_Conv from to ->
+        MO_SF_Round from to ->
           pure
             $ Any
               (floatFormat to)
               ( \dst ->
                   code
                     `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float)
-                    -- TODO: Can this case happen?
               )
-        MO_FS_Conv from to
+        -- TODO: Can this case happen?
+        MO_FS_Truncate from to
           | to < W32 ->
               pure
                 $ Any
@@ -651,7 +651,7 @@ getRegister' config plat expr =
                         annExpr expr (FCVTZS (OpReg W32 dst) (OpReg from reg))
                         `appOL` signExtendAdjustPrecission W32 to dst dst -- (float convert (-> zero) signed)
                   )
-        MO_FS_Conv from to ->
+        MO_FS_Truncate from to ->
           pure
             $ Any
               (intFormat to)
@@ -680,6 +680,9 @@ getRegister' config plat expr =
               )
         MO_SS_Conv from to -> ss_conv from to reg code
         MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` annExpr e (FCVT (OpReg to dst) (OpReg from reg)))
+        MO_WF_Bitcast w    -> return $ Any (floatFormat w)  (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
+        MO_FW_Bitcast w    -> return $ Any (intFormat w)    (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg))
+
         -- Conversions
         -- TODO: Duplication with MO_UU_Conv
         MO_XX_Conv from to
@@ -1874,7 +1877,7 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
       config <- getConfig
       target <-
         cmmMakeDynamicReference config CallReference
-          $ mkForeignLabel name Nothing ForeignLabelInThisPackage IsFunction
+          $ mkForeignLabel name ForeignLabelInThisPackage IsFunction
       let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn
       genCCall (ForeignTarget target cconv) dest_regs arg_regs
 


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -221,6 +221,18 @@ isJumpishInstr instr = case instr of
   BCOND {} -> True
   _ -> False
 
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo insn bid =
+  case insn of
+    B (TBlock target) -> bid == target
+    BCOND _ _ _ (TBlock target) -> bid == target
+    J_TBL targets _ _ -> all isTargetBid targets
+    _ -> False
+  where
+    isTargetBid target = case target of
+      Nothing -> True
+      Just target -> target == bid
+
 -- | Get the `BlockId`s of the jump destinations (if any)
 jumpDestsOfInstr :: Instr -> [BlockId]
 jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de95068e0b7527cb4a6866b75a331e973fdb4af0
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/20240805/95e647d9/attachment-0001.html>