[Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Implement MOV for ImmInt immediates

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC


Commits:
44ae8f25 by Sven Tennie at 2023-07-01T17:19:50+02:00
Implement MOV for ImmInt immediates

These cases were likely just forgotten.

- - - - -
518a5645 by Sven Tennie at 2023-07-01T17:24:56+02:00
Load integers in their positive representation and don't sign extend unsigned values in foreign C calls

Otherwise, the sign bits mess up everything!

- - - - -


2 changed files:

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


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -504,26 +504,31 @@ getRegister' config plat expr =
     CmmLit lit ->
       case lit of
         CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL
-        CmmInt i w | isEncodeableInWidth w i -> do
-          pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInteger i)))))
+        CmmInt i w | isEncodeableInWidth w i ->
+                     -- narrowU is important: Negative immediates may be
+                     -- sign-extended on load!
+                     let imm = OpImm . ImmInteger $ narrowU w i
+                     in
+                        pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm)))
 
         -- i does not fit. Be careful to keep the sign.
-        CmmInt i w -> do
+        CmmInt i w ->
           let -- select all but the sign (most significant) bit
               mask = allOneMask (maxBitNo - 1)
               numBits = i .&. mask
               truncatedI = numBits .|. signBit i
-          pure
-            ( Any
-                (intFormat w)
-                ( \dst ->
-                    toOL
-                      [ annExpr
-                          expr
-                          (MOV (OpReg w dst) (OpImm (ImmInteger truncatedI)))
-                      ]
-                )
-            )
+              imm = OpImm . ImmInteger $ narrowU w truncatedI
+          in
+            pure $
+               Any
+                  (intFormat w)
+                  ( \dst ->
+                      toOL
+                        [ annExpr
+                            expr
+                            (MOV (OpReg w dst) imm)
+                        ]
+                  )
           where
             allOneMask :: Int -> Integer
             allOneMask 0 = bit 0
@@ -1744,8 +1749,17 @@ genCCall target dest_regs arg_regs bid = do
       --
     -- Still have GP regs, and we want to pass an GP argument.
 
-    passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do
-      platform <- getPlatform
+    passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format , hint == NoHint = do
+      -- Do not sign-extend unsigned register values. Otherwise, unsigned
+      -- parameters (e.g. uint8_t) are messed up with sign bits.
+      let w = formatToWidth format
+          mov = MOV (OpReg w gpReg) (OpReg w r)
+          accumCode' = accumCode `appOL`
+                       code_r `snocOL`
+                       ann (text "Pass gp argument (NoHint): " <> ppr r) mov
+      passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) accumCode'
+
+    passArguments pack (gpReg:gpRegs) fpRegs ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do
     -- RISCV64 Integer Calling Convention: "When passed in registers or on the
     -- stack, integer scalars narrower than XLEN bits are widened according to
     -- the sign of their type up to 32 bits, then sign-extended to XLEN bits."


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -522,12 +522,17 @@ pprInstr platform instr = case instr of
     | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2
     | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2
     | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2
-    | isImmOp o2
-    , (OpImm (ImmInteger i)) <- o2
+    | (OpImm (ImmInteger i)) <- o2
     , fitsIn12bitImm i
           -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ]
-    | isImmOp o2
-    , (OpImm (ImmInteger i)) <- o2
+    | (OpImm (ImmInt i)) <- o2
+    , fitsIn12bitImm i
+          -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ]
+    | (OpImm (ImmInteger i)) <- o2
+    , fitsIn32bits i
+        -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")"
+                                             , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ]
+    | (OpImm (ImmInt i)) <- o2
     , fitsIn32bits i
         -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")"
                                              , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7687dd327d436475c451670c0de1f22bd799d901...518a5645b59d215b2ba1f663fd460e3a0e79a110

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7687dd327d436475c451670c0de1f22bd799d901...518a5645b59d215b2ba1f663fd460e3a0e79a110
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/20230701/fa57f602/attachment-0001.html>