[Git][ghc/ghc][wip/ncg-simd] WIP commit
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Thu Aug 15 10:32:10 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
f759277e by sheaf at 2024-08-15T12:31:59+02:00
WIP commit
- - - - -
7 changed files:
- rts/include/stg/MachRegs/x86.h
- testsuite/tests/unboxedsums/T22187.hs → testsuite/tests/simd/should_run/T22187.hs
- + testsuite/tests/simd/should_run/T22187_run.hs
- testsuite/tests/unboxedsums/T22187_run.stdout → testsuite/tests/simd/should_run/T22187_run.stdout
- testsuite/tests/simd/should_run/all.T
- − testsuite/tests/unboxedsums/T22187_run.hs
- testsuite/tests/unboxedsums/all.T
Changes:
=====================================
rts/include/stg/MachRegs/x86.h
=====================================
@@ -107,9 +107,14 @@
#define REG_MachSp rsp
/*
-Map both Fn and Dn to register xmmn so that we can pass a function any
-combination of up to six Float# or Double# arguments without touching
-the stack. See Note [Overlapping global registers] for implications.
+Map Fn, Dn and XMMn to register xmm(n-1).
+The (n-1) is due to the fact that Cmm register numbers start at 1, but
+X86_64 xmm register numbers start at 0.
+
+The aliasing allows us to pass a function any combination of up to
+six Float#, Double# or vector arguments without touching the stack
+(when using the System V calling convention).
+See Note [Overlapping global registers] for implications.
*/
#define REG_F1 xmm0
=====================================
testsuite/tests/unboxedsums/T22187.hs → testsuite/tests/simd/should_run/T22187.hs
=====================================
=====================================
testsuite/tests/simd/should_run/T22187_run.hs
=====================================
@@ -0,0 +1,89 @@
+{-# language MagicHash, UnboxedTuples, UnboxedSums #-}
+
+module Main ( main ) where
+
+import GHC.Exts
+import GHC.Int
+import GHC.Word
+import GHC.Float
+
+--foo :: (# Int64X2# | Bool | DoubleX2# #)
+-- -> (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #)
+--foo (# i64x2 | | #) =
+-- case unpackInt64X2# i64x2 of
+-- (# i1, i2 #) ->
+-- let
+-- s = sum $ map fromIntegral
+-- [ I64# i1, I64# i2 ]
+-- in (# s | | #)
+--
+--foo (# | b | #) = if b then (# 0 | | #) else (# | | 'F' #)
+--foo (# | | dx2 #) = (# | bar dx2 | #)
+
+bar :: DoubleX2# -> (# FloatX4#, Int64#, Int64# #)
+bar dx2 =
+ case unpackDoubleX2# dx2 of
+ (# d1, d2 #) ->
+ let (# m1, e1 #) = decodeDouble_Int64# d1
+ (# m2, e2 #) = decodeDouble_Int64# d2
+ v = packFloatX4#
+ (# double2Float# d1
+ , int2Float# e1
+ , double2Float# d2
+ , int2Float# e2 #)
+ in (# v, m1, m2 #)
+
+--show_it :: (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #) -> String
+--show_it (# i | | #) = "(# " ++ show i ++ " | | #)"
+--show_it (# | t3 | #) = showT3 t3
+--show_it (# | | c #) = "(# | | " ++ show c ++ " #)"
+
+showT3 :: (# FloatX4#, Int64#, Int64# #) -> String
+showT3 (# fx4, m1, m2 #) = "(# | (# " ++ showFloatX4 fx4 ++ ", " ++ show (I64# m1) ++ ", " ++ show (I64# m2) ++ " #) | #)"
+
+showFloatX4 :: FloatX4# -> String
+showFloatX4 fx4 = case unpackFloatX4# fx4 of
+ (# f1, f2, f3, f4 #) ->
+ "(# " ++ show (F# f1) ++ ", " ++ show (F# f2) ++ ", "
+ ++ show (F# f3) ++ ", " ++ show (F# f4) ++ " #)"
+
+main :: IO ()
+main = do
+ --putStrLn $ show_it ( foo (# broadcastInt64X2# ( intToInt64# 1# ) | | #) )
+ --putStrLn $ show_it ( foo (# | False | #) )
+ --putStrLn $ show_it ( foo (# | True | #) )
+ let dx2 = packDoubleX2# (# 128.0##, -0.0025## #)
+ --putStrLn $ show_it ( foo (# | | dx2 #) )
+
+ putStrLn $ showT3 ( bar dx2 )
+
+
+{-
+
+we expect to see:
+
+ let (# m1, e1 #) = decodeDouble_Int64# d1
+ (# m2, e2 #) = decodeDouble_Int64# d2
+ v = packFloatX4#
+ (# double2Float# d1
+ , int2Float# e1
+ , double2Float# d2
+ , int2Float# e2 #)
+ in (# v, m1, m2 #)
+
+but instead we get something like
+
+ let (# m1, e1 #) = decodeDouble_Int64# d1
+
+ v = packFloatX4#
+ (# double2Float# d1
+ , int2Float# e1
+ , double2Float# d2
+ , int2Float# e1 #)
+ in (# v, m1, m1 #)
+
+note that e2 -> e1, m2 -> m1
+so it looks like the call to decodeDouble_Int64# d1 is clobbering
+the result of decodeDouble_Int64# d2 or something?
+
+-}
=====================================
testsuite/tests/unboxedsums/T22187_run.stdout → testsuite/tests/simd/should_run/T22187_run.stdout
=====================================
@@ -1,4 +1,4 @@
(# 2 | | #)
(# | | 'F' #)
(# 0 | | #)
-(# | (# (# 128.0, -45.0, -2.5e-3, -45.0 #), 4503599627370496, -5764607523034235 #) | #)
+(# | (# (# 128.0, -45.0, -2.5e-3, -61.0 #), 4503599627370496, -5764607523034235 #) | #)
=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -47,6 +47,9 @@ test('simd013',
compile_and_run, ['simd013C.c'])
+test('T22187',[],compile,[''])
+test('T22187_run',[],compile_and_run,[''])
+
test('T25062_V16', [], compile_and_run, [''])
test('T25062_V32', [ unless(have_cpu_feature('avx2'), skip)
, only_ways(llvm_ways) # SIMD NCG TODO: support 256 bit wide vectors
=====================================
testsuite/tests/unboxedsums/T22187_run.hs deleted
=====================================
@@ -1,50 +0,0 @@
-{-# language MagicHash, UnboxedTuples, UnboxedSums #-}
-
-module Main ( main ) where
-
-import GHC.Exts
-import GHC.Int
-import GHC.Word
-import GHC.Float
-
-foo :: (# Int64X2# | Bool | DoubleX2# #)
- -> (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #)
-foo (# i64x2 | | #) =
- case unpackInt64X2# i64x2 of
- (# i1, i2 #) ->
- let
- s = sum $ map fromIntegral
- [ I64# i1, I64# i2 ]
- in (# s | | #)
-
-foo (# | b | #) = if b then (# 0 | | #) else (# | | 'F' #)
-foo (# | | dx2 #) =
- case unpackDoubleX2# dx2 of
- (# d1, d2 #) ->
- let (# m1, e1 #) = decodeDouble_Int64# d1
- (# m2, e2 #) = decodeDouble_Int64# d2
- v = packFloatX4#
- (# double2Float# d1
- , int2Float# e1
- , double2Float# d2
- , int2Float# e1 #)
- in (# | (# v, m1, m2 #) | #)
-
-show_it :: (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #) -> String
-show_it (# i | | #) = "(# " ++ show i ++ " | | #)"
-show_it (# | (# fx4, m1, m2 #) | #) = "(# | (# " ++ showFloatX4 fx4 ++ ", " ++ show (I64# m1) ++ ", " ++ show (I64# m2) ++ " #) | #)"
-show_it (# | | c #) = "(# | | " ++ show c ++ " #)"
-
-showFloatX4 :: FloatX4# -> String
-showFloatX4 fx4 = case unpackFloatX4# fx4 of
- (# f1, f2, f3, f4 #) ->
- "(# " ++ show (F# f1) ++ ", " ++ show (F# f2) ++ ", "
- ++ show (F# f3) ++ ", " ++ show (F# f4) ++ " #)"
-
-main :: IO ()
-main = do
- putStrLn $ show_it ( foo (# broadcastInt64X2# ( intToInt64# 1# ) | | #) )
- putStrLn $ show_it ( foo (# | False | #) )
- putStrLn $ show_it ( foo (# | True | #) )
- let dx2 = packDoubleX2# (# 128.0##, -0.0025## #)
- putStrLn $ show_it ( foo (# | | dx2 #) )
=====================================
testsuite/tests/unboxedsums/all.T
=====================================
@@ -36,10 +36,6 @@ test('T20858b', [extra_files(['T20858.hs'])
, ghci_script, ['T20858b.script'])
test('T20859', normal, compile, [''])
-test('T22187',[only_ways(llvm_ways)],compile,[''])
-test('T22187_run',[only_ways(llvm_ways)
- ,unless(arch('x86_64') or arch('aarch64'), skip)],compile_and_run,[''])
-
test('unpack_sums_1', normal, compile_and_run, ['-O'])
test('unpack_sums_2', normal, compile, ['-O'])
test('unpack_sums_3', normal, compile_and_run, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f759277e63fa2cd80e66df3ed489b258f249f292
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f759277e63fa2cd80e66df3ed489b258f249f292
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/20240815/5ffd5d78/attachment-0001.html>
More information about the ghc-commits
mailing list