[Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix float calling convention (a bit)

[Sven Tennie (@supersven)]

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


Commits:
714cb3b1 by Sven Tennie at 2023-08-21T21:28:30+02:00
Fix float calling convention (a bit)

If fp regs are taken, use go regs instead.

- - - - -


4 changed files:

- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- testsuite/tests/codeGen/should_run/CCallConv.hs
- testsuite/tests/codeGen/should_run/CCallConv.stdout
- testsuite/tests/codeGen/should_run/CCallConv_c.c


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1797,17 +1797,14 @@ genCCall target dest_regs arg_regs bid = do
                       ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) str
       passArguments pack [] fpRegs args (stackSpace'+space) accumRegs (stackCode `appOL` accumCode)
 
-    -- Still have gpRegs left, but want to pass a FP argument. Must be passed on the stack then.
-    passArguments pack gpRegs [] ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isFloatFormat format = do
+    -- Still have gpRegs left, but want to pass a FP argument. Must be passed in gpReg then.
+    passArguments pack (gpReg:gpRegs) [] ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isFloatFormat format = do
       let w = formatToWidth format
-          bytes = widthInBits w `div` 8
-          space = if pack then bytes else 8
-          stackSpace' | pack && stackSpace `mod` space /= 0 = stackSpace + space - (stackSpace `mod` space)
-                      | otherwise                           = stackSpace
-          str = STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 2) (ImmInt stackSpace')))
-          stackCode = code_r `snocOL`
-                      ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) str
-      passArguments pack gpRegs [] args (stackSpace'+space) accumRegs (stackCode `appOL` accumCode)
+          mov = MOV (OpReg w gpReg) (OpReg w r)
+          accumCode' = accumCode `appOL`
+                       code_r `snocOL`
+                       ann (text "Pass fp argument in gpReg: " <> ppr r) mov
+      passArguments pack gpRegs [] args stackSpace (gpReg:accumRegs) accumCode'
 
     passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
 


=====================================
testsuite/tests/codeGen/should_run/CCallConv.hs
=====================================
@@ -58,6 +58,20 @@ foreign import ccall "fun32"
     Int32# -> -- s1
     Int64# -- result
 
+foreign import ccall "funFloat"
+  funFloat ::
+    Float# -> -- a0
+    Float# -> -- a1
+    Float# -> -- a2
+    Float# -> -- a3
+    Float# -> -- a4
+    Float# -> -- a5
+    Float# -> -- a6
+    Float# -> -- a7
+    Float# -> -- s0
+    Float# -> -- s1
+    Float# -- result
+
 main :: IO ()
 main =
   -- N.B. the values here aren't choosen by accident: -1 means all bits one in
@@ -74,6 +88,7 @@ main =
       w32 :: Word32# = wordToWord32# (4294967295##)
       res32 :: Int64# = fun32 i32 w32 i32 i32 i32 i32 i32 i32 w32 i32
       expected_res32 :: Int64 = 2 * (fromInteger . fromIntegral) (maxBound :: Word32) + 8 * (-1)
+      resFloat :: Float = F# (funFloat 1.0# 1.1# 1.2# 1.3# 1.4# 1.5# 1.6# 1.7# 1.8# 1.9#)
    in do
         print $ "fun8 result:" ++ show (I64# res8)
         assertEqual expected_res8 (I64# res8)
@@ -81,9 +96,11 @@ main =
         assertEqual expected_res16 (I64# res16)
         print $ "fun32 result:" ++ show (I64# res32)
         assertEqual expected_res32 (I64# res32)
+        print $ "funFloat result:" ++ show resFloat
+        assertEqual (14.5 :: Float) resFloat
 
-assertEqual :: (Integral a, Integral b, Show a, Show b) => a -> b -> IO ()
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
 assertEqual a b =
-  if (fromIntegral a) == (fromIntegral b)
+  if a == b
     then pure ()
     else error $ show a ++ " =/= " ++ show b


=====================================
testsuite/tests/codeGen/should_run/CCallConv.stdout
=====================================
@@ -1,6 +1,7 @@
 "fun8 result:502"
 "fun16 result:131062"
 "fun32 result:8589934582"
+"funFloat result:14.5"
 fun32:
 a0: 0xffffffff -1
 a1: 0xffffffff 4294967295
@@ -34,3 +35,14 @@ a6: 0xffffffff -1
 a7: 0xffffffff -1
 s0: 0xffffffff -1
 s1: 0xff 255
+funFloat:
+a0: 1.000000
+a1: 1.100000
+a2: 1.200000
+a3: 1.300000
+a4: 1.400000
+a5: 1.500000
+a6: 1.600000
+a7: 1.700000
+s0: 1.800000
+s1: 1.900000


=====================================
testsuite/tests/codeGen/should_run/CCallConv_c.c
=====================================
@@ -55,3 +55,20 @@ int64_t fun32(int32_t a0, uint32_t a1, int32_t a2, int32_t a3, int32_t a4,
   return force_int64_precission + a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 +
          s1;
 }
+
+float funFloat(float a0, float a1, float a2, float a3, float a4, float a5,
+             float a6, float a7, float s0, float s1) {
+  printf("funFloat:\n");
+  printf("a0: %f\n", a0);
+  printf("a1: %f\n", a1);
+  printf("a2: %f\n", a2);
+  printf("a3: %f\n", a3);
+  printf("a4: %f\n", a4);
+  printf("a5: %f\n", a5);
+  printf("a6: %f\n", a6);
+  printf("a7: %f\n", a7);
+  printf("s0: %f\n", s0);
+  printf("s1: %f\n", s1);
+
+  return a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 + s1;
+}



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/714cb3b1d19aa23d9d2b0b9b1ba8da85205d4489
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/20230821/c4b6c4a3/attachment-0001.html>