[Git][ghc/ghc][master] x86 NCG: fix regUsageOfInstr for VMOVU & friends

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Nov 20 23:11:32 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1fc02399 by sheaf at 2024-11-20T18:11:03-05:00
x86 NCG: fix regUsageOfInstr for VMOVU & friends

This commit fixes the implementation of 'regUsageOfInstr' for vector
operations that take an 'Operand' as the destination, by ensuring that
when the destination is an address then the address should be *READ*,
and not *WRITTEN*.

Getting this wrong is a disaster, as it means the register allocator
has incorrect information, which can lead to it discard stores to
registers, segfaults ensuing.

Fixes #25486

- - - - -


5 changed files:

- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- + testsuite/tests/simd/should_run/T25486.hs
- + testsuite/tests/simd/should_run/T25486.stdout
- testsuite/tests/simd/should_run/all.T


Changes:

=====================================
compiler/GHC/CmmToAsm/Format.hs
=====================================
@@ -273,6 +273,9 @@ instance Show RegWithFormat where
 instance Uniquable RegWithFormat where
   getUnique = getUnique . regWithFormat_reg
 
+instance Outputable VirtualRegWithFormat where
+  ppr (VirtualRegWithFormat reg fmt) = ppr reg <+> dcolon <+> ppr fmt
+
 instance Outputable RegWithFormat where
   ppr (RegWithFormat reg fmt) = ppr reg <+> dcolon <+> ppr fmt
 


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -373,8 +373,9 @@ regUsageOfInstr platform instr
       | otherwise
       -> usageRW fmt src dst
     MOVD   fmt src dst    ->
-      -- NB: MOVD/MOVQ always zero any remaining upper part of destination
-      mkRU (use_R fmt src []) (use_R (movdOutFormat fmt) dst [])
+      -- NB: MOVD and MOVQ always zero any remaining upper part of destination,
+      -- so the destination is "written" not "modified".
+      usageRW' fmt (movdOutFormat fmt) src dst
     CMOV _ fmt src dst    -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
     MOVZxL fmt src dst    -> usageRW fmt src dst
     MOVSxL fmt src dst    -> usageRW fmt src dst
@@ -475,7 +476,7 @@ regUsageOfInstr platform instr
 
     -- vector instructions
     VBROADCAST fmt src dst   -> mkRU (use_R fmt src []) [mk fmt dst]
-    VEXTRACT     fmt _off src dst -> mkRU [mk fmt src] (use_R fmt dst [])
+    VEXTRACT     fmt _off src dst -> usageRW fmt (OpReg src) dst
     INSERTPS     fmt (ImmInt off) src dst
       -> mkRU ((use_R fmt src []) ++ [mk fmt dst | not doesNotReadDst]) [mk fmt dst]
         where
@@ -488,12 +489,12 @@ regUsageOfInstr platform instr
     INSERTPS fmt _off src dst
       -> mkRU ((use_R fmt src []) ++ [mk fmt dst]) [mk fmt dst]
 
-    VMOVU        fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
-    MOVU         fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
-    MOVL         fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
-    MOVH         fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
-    MOVDQU       fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
-    VMOVDQU      fmt src dst   -> mkRU (use_R fmt src []) (use_R fmt dst [])
+    VMOVU        fmt src dst   -> usageRW fmt src dst
+    MOVU         fmt src dst   -> usageRW fmt src dst
+    MOVL         fmt src dst   -> usageRM fmt src dst
+    MOVH         fmt src dst   -> usageRM fmt src dst
+    MOVDQU       fmt src dst   -> usageRW fmt src dst
+    VMOVDQU      fmt src dst   -> usageRW fmt src dst
 
     PXOR fmt (OpReg src) dst
       | src == dst
@@ -531,11 +532,12 @@ regUsageOfInstr platform instr
       -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
 
     MINMAX _ _ fmt src dst
-      -> mkRU (use_R fmt src $ use_R fmt dst []) (use_R fmt dst [])
+      -> usageRM fmt src dst
     VMINMAX _ _ fmt src1 src2 dst
       -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst]
     _other              -> panic "regUsage: unrecognised instr"
  where
+
     -- # Definitions
     --
     -- Written: If the operand is a register, it's written. If it's an
@@ -551,6 +553,11 @@ regUsageOfInstr platform instr
     usageRW fmt op (OpAddr ea)      = mkRUR (use_R fmt op $! use_EA ea [])
     usageRW _ _ _                   = panic "X86.RegInfo.usageRW: no match"
 
+    usageRW' :: HasDebugCallStack => Format -> Format -> Operand -> Operand -> RegUsage
+    usageRW' fmt1 fmt2 op (OpReg reg) = mkRU (use_R fmt1 op []) [mk fmt2 reg]
+    usageRW' fmt1 _    op (OpAddr ea) = mkRUR (use_R fmt1 op $! use_EA ea [])
+    usageRW' _  _ _ _                 = panic "X86.RegInfo.usageRW: no match"
+
     -- 2 operand form; first operand Read; second Modified
     usageRM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
     usageRM fmt op (OpReg reg)      = mkRU (use_R fmt op [mk fmt reg]) [mk fmt reg]


=====================================
testsuite/tests/simd/should_run/T25486.hs
=====================================
@@ -0,0 +1,48 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+import GHC.IO
+import Data.Array.Base
+import Data.Array.IO.Internals
+import Control.Monad
+import Foreign.Marshal.Array
+
+writeFloatX4OffAddr :: Ptr Float -> Int -> FloatX4# -> IO ()
+writeFloatX4OffAddr (Ptr addr) (I# i) v =
+  IO $ \s -> (# writeFloatX4OffAddr# addr i v s, () #)
+
+writeAsFloatX4OffAddr :: Ptr Float -> Int -> FloatX4# -> IO ()
+writeAsFloatX4OffAddr (Ptr addr) (I# i) v =
+  IO $ \s -> (# writeFloatOffAddrAsFloatX4# addr i v s, () #)
+
+writeFloatX4 :: IOUArray Int Float -> Int -> FloatX4# -> IO ()
+writeFloatX4 (IOUArray (STUArray l _ _ mba)) i v = case i - l of
+  I# i# -> IO $ \s -> (# writeFloatX4Array# mba i# v s, () #)
+
+writeAsFloatX4 :: IOUArray Int Float -> Int -> FloatX4# -> IO ()
+writeAsFloatX4 (IOUArray (STUArray l _ _ mba)) i v = case i - l of
+  I# i# -> IO $ \s -> (# writeFloatArrayAsFloatX4# mba i# v s, () #)
+
+main :: IO ()
+main = do
+  let v = packFloatX4# (# 0.1#, 1.1#, 2.2#, 3.3# #)
+
+  xs <- withArray ([0..15] :: [Float]) $ \ptr -> do
+    writeFloatX4OffAddr ptr 2 v
+    peekArray 16 ptr
+  print xs
+
+  ys <- withArray ([0..15] :: [Float]) $ \ptr -> do
+    writeAsFloatX4OffAddr ptr 2 v
+    peekArray 16 ptr
+  print ys
+
+  ma <- newListArray (0, 9) ([0..9] :: [Float])
+  writeFloatX4 ma 1 v
+  print =<< getElems ma
+
+  ma <- newListArray (0, 9) ([0..9] :: [Float])
+  writeAsFloatX4 ma 1 v
+  print =<< getElems ma


=====================================
testsuite/tests/simd/should_run/T25486.stdout
=====================================
@@ -0,0 +1,4 @@
+[0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,0.1,1.1,2.2,3.3,12.0,13.0,14.0,15.0]
+[0.0,1.0,0.1,1.1,2.2,3.3,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0]
+[0.0,1.0,2.0,3.0,0.1,1.1,2.2,3.3,8.0,9.0]
+[0.0,0.1,1.1,2.2,3.3,5.0,6.0,7.0,8.0,9.0]


=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -90,3 +90,4 @@ test('T25062_V64'
 
 test('T25169', [], compile_and_run, [''])
 test('T25455', [], compile_and_run, [''])
+test('T25486', [], compile_and_run, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fc02399fcc82a222033919c8d3c5db4b382cb97
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/20241120/94c9cf98/attachment-0001.html>


More information about the ghc-commits mailing list