Revert "Add support for SIMD operations in the NCG"
authorBen Gamari <ben@smart-cactus.org>
Tue, 9 Jul 2019 18:49:32 +0000 (14:49 -0400)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Tue, 16 Jul 2019 06:40:43 +0000 (02:40 -0400)
Unfortunately this will require more work; register allocation is
quite broken.

This reverts commit acd795583625401c5554f8e04ec7efca18814011.

45 files changed:
compiler/cmm/CmmCallConv.hs
compiler/cmm/CmmExpr.hs
compiler/cmm/CmmLint.hs
compiler/cmm/CmmMachOp.hs
compiler/cmm/CmmType.hs
compiler/cmm/PprC.hs
compiler/cmm/PprCmmExpr.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/StgCmmPrim.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/Regs.hs
compiler/main/DynFlags.hs
compiler/nativeGen/Format.hs
compiler/nativeGen/NCGMonad.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/Reg.hs
compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegClass.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/SPARC/Regs.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Instr.hs
compiler/nativeGen/X86/Ppr.hs
compiler/nativeGen/X86/RegInfo.hs
compiler/nativeGen/X86/Regs.hs
includes/CodeGen.Platform.hs
testsuite/tests/codeGen/should_run/all.T
testsuite/tests/codeGen/should_run/cgrun083.hs [deleted file]
testsuite/tests/codeGen/should_run/cgrun083.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd000.hs [deleted file]
testsuite/tests/codeGen/should_run/simd000.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd001.hs [deleted file]
testsuite/tests/codeGen/should_run/simd001.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd002.hs [deleted file]
testsuite/tests/codeGen/should_run/simd002.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd003.hs [deleted file]
testsuite/tests/codeGen/should_run/simd003.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd004.hs [deleted file]
testsuite/tests/codeGen/should_run/simd004.stdout [deleted file]
testsuite/tests/codeGen/should_run/simd005.hs [deleted file]
testsuite/tests/codeGen/should_run/simd005.stdout [deleted file]

index 6df910e..4e6a9d2 100644 (file)
@@ -64,20 +64,13 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
       assign_regs assts (r:rs) regs | isVecType ty   = vec
                                     | isFloatType ty = float
                                     | otherwise      = int
-        where vec = case regs of
-                      (vs, fs, ds, ls, s:ss)
-                        | passVectorInReg w dflags
-                          -> let elt_ty = vecElemType ty
-                                 reg_ty = if isFloatType elt_ty
-                                          then Float else Integer
-                                 reg_class = case w of
-                                               W128 -> XmmReg
-                                               W256 -> YmmReg
-                                               W512 -> ZmmReg
-                                               _    -> panic "CmmCallConv.assignArgumentsPos: Invalid vector width"
-                              in k (RegisterParam
-                                     (reg_class s (vecLength ty) (typeWidth elt_ty) reg_ty),
-                                     (vs, fs, ds, ls, ss))
+        where vec = case (w, regs) of
+                      (W128, (vs, fs, ds, ls, s:ss))
+                          | passVectorInReg W128 dflags -> k (RegisterParam (XmmReg s), (vs, fs, ds, ls, ss))
+                      (W256, (vs, fs, ds, ls, s:ss))
+                          | passVectorInReg W256 dflags -> k (RegisterParam (YmmReg s), (vs, fs, ds, ls, ss))
+                      (W512, (vs, fs, ds, ls, s:ss))
+                          | passVectorInReg W512 dflags -> k (RegisterParam (ZmmReg s), (vs, fs, ds, ls, ss))
                       _ -> (assts, (r:rs))
               float = case (w, regs) of
                         (W32, (vs, fs, ds, ls, s:ss))
@@ -96,7 +89,6 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
                       (_, (vs, fs, ds, l:ls, ss)) | widthInBits w > widthInBits (wordWidth dflags)
                           -> k (RegisterParam l, (vs, fs, ds, ls, ss))
                       _   -> (assts, (r:rs))
-
               k (asst, regs') = assign_regs ((r, asst) : assts) rs regs'
               ty = arg_ty r
               w  = typeWidth ty
@@ -210,13 +202,11 @@ nodeOnly = ([VanillaReg 1], [], [], [], [])
 -- only use this functionality in hand-written C-- code in the RTS.
 realArgRegsCover :: DynFlags -> [GlobalReg]
 realArgRegsCover dflags
-    | passFloatArgsInXmm dflags
-      = map ($VGcPtr) (realVanillaRegs dflags) ++
-        realLongRegs dflags ++
-        map (\x -> XmmReg x 2 W64 Integer) (realXmmRegNos dflags)
-    | otherwise
-      = map ($VGcPtr) (realVanillaRegs dflags) ++
-        realFloatRegs dflags ++
-        realDoubleRegs dflags ++
-        realLongRegs dflags ++
-        map (\x -> XmmReg x 2 W64 Integer) (realXmmRegNos dflags)
+    | passFloatArgsInXmm dflags = map ($VGcPtr) (realVanillaRegs dflags) ++
+                                  realLongRegs dflags ++
+                                  map XmmReg (realXmmRegNos dflags)
+    | otherwise                 = map ($VGcPtr) (realVanillaRegs dflags) ++
+                                  realFloatRegs dflags ++
+                                  realDoubleRegs dflags ++
+                                  realLongRegs dflags ++
+                                  map XmmReg (realXmmRegNos dflags)
index 79eaf8f..901df5d 100644 (file)
@@ -14,7 +14,6 @@ module CmmExpr
     , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
     , node, baseReg
     , VGcPtr(..)
-    , GlobalVecRegTy(..)
 
     , DefinerOfRegs, UserOfRegs
     , foldRegsDefd, foldRegsUsed
@@ -42,7 +41,6 @@ import Outputable (panic)
 import Unique
 
 import Data.Set (Set)
-import Data.Monoid ((<>))
 import qualified Data.Set as Set
 
 import BasicTypes (Alignment, mkAlignment, alignmentOf)
@@ -394,7 +392,6 @@ data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
 -----------------------------------------------------------------------------
 {-
 Note [Overlapping global registers]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 The backend might not faithfully implement the abstraction of the STG
 machine with independent registers for different values of type
@@ -416,26 +413,6 @@ on a particular platform. The instance Eq GlobalReg is syntactic
 equality of STG registers and does not take overlap into
 account. However it is still used in UserOfRegs/DefinerOfRegs and
 there are likely still bugs there, beware!
-
-
-Note [SIMD registers]
-~~~~~~~~~~~~~~~~~~~~~
-
-GHC's treatment of SIMD registers is heavily modelled after the x86_64
-architecture. Namely we have 128- (XMM), 256- (YMM), and 512-bit (ZMM)
-registers. Furthermore, we treat each possible format in these registers as a
-distinct register which overlaps with the others. For instance, we XMM1 as a
-2xI64 register is distinct from but overlaps with (in the sense defined in Note
-[Overlapping global registers]) its use as a 4xI32 register.
-
-This model makes it easier to fit SIMD registers into the NCG, which generally
-expects that each global register has a single, known CmmType.
-
-In the future we could consider further refactoring this to eliminate the
-XMM, YMM, and ZMM register names (which are quite x86-specific) and instead just
-having a set of NxM-bit vector registers (e.g. Vec2x64A, Vec2x64B, ...,
-Vec4x32A, ..., Vec4x64A).
-
 -}
 
 data GlobalReg
@@ -455,15 +432,12 @@ data GlobalReg
 
   | XmmReg                      -- 128-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
-        !Length !Width !GlobalVecRegTy
 
   | YmmReg                      -- 256-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
-        !Length !Width !GlobalVecRegTy
 
   | ZmmReg                      -- 512-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
-        !Length !Width !GlobalVecRegTy
 
   -- STG registers
   | Sp                  -- Stack ptr; points to last occupied stack location.
@@ -504,17 +478,17 @@ data GlobalReg
 
   deriving( Show )
 
-data GlobalVecRegTy = Integer | Float
-  deriving (Show, Eq, Ord)
-
 instance Eq GlobalReg where
    VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
    FloatReg i == FloatReg j = i==j
    DoubleReg i == DoubleReg j = i==j
    LongReg i == LongReg j = i==j
-   XmmReg i l w grt == XmmReg j l' w' grt' = i==j && l == l' && w == w' && grt == grt'
-   YmmReg i l w grt == YmmReg j l' w' grt' = i==j && l == l' && w == w' && grt == grt'
-   ZmmReg i l w grt == ZmmReg j l' w' grt' = i==j && l == l' && w == w' && grt == grt'
+   -- NOTE: XMM, YMM, ZMM registers actually are the same registers
+   -- at least with respect to store at YMM i and then read from XMM i
+   -- and similarly for ZMM etc.
+   XmmReg i == XmmReg j = i==j
+   YmmReg i == YmmReg j = i==j
+   ZmmReg i == ZmmReg j = i==j
    Sp == Sp = True
    SpLim == SpLim = True
    Hp == Hp = True
@@ -538,21 +512,9 @@ instance Ord GlobalReg where
    compare (FloatReg i)  (FloatReg  j) = compare i j
    compare (DoubleReg i) (DoubleReg j) = compare i j
    compare (LongReg i)   (LongReg   j) = compare i j
-   compare (XmmReg i l w grt)
-           (XmmReg j l' w' grt')       = compare i j
-                                         <> compare l l'
-                                         <> compare w w'
-                                         <> compare grt grt'
-   compare (YmmReg i l w grt)
-           (YmmReg j l' w' grt')       = compare i j
-                                         <> compare l l'
-                                         <> compare w w'
-                                         <> compare grt grt'
-   compare (ZmmReg i l w grt)
-           (ZmmReg j l' w' grt')       = compare i j
-                                         <> compare l l'
-                                         <> compare w w'
-                                         <> compare grt grt'
+   compare (XmmReg i)    (XmmReg    j) = compare i j
+   compare (YmmReg i)    (YmmReg    j) = compare i j
+   compare (ZmmReg i)    (ZmmReg    j) = compare i j
    compare Sp Sp = EQ
    compare SpLim SpLim = EQ
    compare Hp Hp = EQ
@@ -576,12 +538,12 @@ instance Ord GlobalReg where
    compare _ (DoubleReg _)    = GT
    compare (LongReg _) _      = LT
    compare _ (LongReg _)      = GT
-   compare (XmmReg _ _ _ _) _ = LT
-   compare _ (XmmReg _ _ _ _) = GT
-   compare (YmmReg _ _ _ _) _ = LT
-   compare _ (YmmReg _ _ _ _) = GT
-   compare (ZmmReg _ _ _ _) _ = LT
-   compare _ (ZmmReg _ _ _ _) = GT
+   compare (XmmReg _) _       = LT
+   compare _ (XmmReg _)       = GT
+   compare (YmmReg _) _       = LT
+   compare _ (YmmReg _)       = GT
+   compare (ZmmReg _) _       = LT
+   compare _ (ZmmReg _)       = GT
    compare Sp _ = LT
    compare _ Sp = GT
    compare SpLim _ = LT
@@ -634,15 +596,12 @@ globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
 globalRegType _      (FloatReg _)      = cmmFloat W32
 globalRegType _      (DoubleReg _)     = cmmFloat W64
 globalRegType _      (LongReg _)       = cmmBits W64
-globalRegType _      (XmmReg _ l w ty) = case ty of
-                                           Integer -> cmmVec l (cmmBits w)
-                                           Float   -> cmmVec l (cmmFloat w)
-globalRegType _      (YmmReg _ l w ty) = case ty of
-                                           Integer -> cmmVec l (cmmBits w)
-                                           Float   -> cmmVec l (cmmFloat w)
-globalRegType _      (ZmmReg _ l w ty) = case ty of
-                                           Integer -> cmmVec l (cmmBits w)
-                                           Float   -> cmmVec l (cmmFloat w)
+-- TODO: improve the internal model of SIMD/vectorized registers
+-- the right design SHOULd improve handling of float and double code too.
+-- see remarks in "NOTE [SIMD Design for the future]"" in StgCmmPrim
+globalRegType _      (XmmReg _)        = cmmVec 4 (cmmBits W32)
+globalRegType _      (YmmReg _)        = cmmVec 8 (cmmBits W32)
+globalRegType _      (ZmmReg _)        = cmmVec 16 (cmmBits W32)
 
 globalRegType dflags Hp                = gcWord dflags
                                             -- The initialiser for all
index 53dcd70..d5c3f84 100644 (file)
@@ -148,13 +148,9 @@ lintCmmMiddle node = case node of
             dflags <- getDynFlags
             erep <- lintCmmExpr expr
             let reg_ty = cmmRegType dflags reg
-            case isVecCatType reg_ty of
-              True -> if ((typeWidth reg_ty) == (typeWidth erep))
-                         then return ()
-                         else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty
-              _    -> if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
-                         then return ()
-                          else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty
+            if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
+                then return ()
+                else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty
 
   CmmStore l r -> do
             _ <- lintCmmExpr l
index 38d9edb..9740d21 100644 (file)
@@ -136,9 +136,8 @@ data MachOp
   | MO_VU_Rem  Length Width
 
   -- Floting point vector element insertion and extraction operations
-  | MO_VF_Broadcast Length Width   -- Broadcast a scalar into a vector
-  | MO_VF_Insert    Length Width   -- Insert scalar into vector
-  | MO_VF_Extract   Length Width   -- Extract scalar from vector
+  | MO_VF_Insert  Length Width   -- Insert scalar into vector
+  | MO_VF_Extract Length Width   -- Extract scalar from vector
 
   -- Floating point vector operations
   | MO_VF_Add  Length Width
@@ -431,7 +430,6 @@ machOpResultType dflags mop tys =
     MO_VU_Quot l w      -> cmmVec l (cmmBits w)
     MO_VU_Rem  l w      -> cmmVec l (cmmBits w)
 
-    MO_VF_Broadcast l w -> cmmVec l (cmmFloat w)
     MO_VF_Insert  l w   -> cmmVec l (cmmFloat w)
     MO_VF_Extract _ w   -> cmmFloat w
 
@@ -524,21 +522,16 @@ machOpArgReps dflags op =
     MO_VU_Quot _ r      -> [r,r]
     MO_VU_Rem  _ r      -> [r,r]
 
-    -- offset is always W32 as mentioned in StgCmmPrim.hs
-    MO_VF_Broadcast l r -> [vecwidth l r, r]
-    MO_VF_Insert    l r -> [vecwidth l r, r, W32]
-    MO_VF_Extract   l r -> [vecwidth l r, W32]
+    MO_VF_Insert  l r   -> [typeWidth (vec l (cmmFloat r)),r,wordWidth dflags]
+    MO_VF_Extract l r   -> [typeWidth (vec l (cmmFloat r)),wordWidth dflags]
 
-    -- NOTE: The below is owing to the fact that floats use the SSE registers
-    MO_VF_Add  l w      -> [vecwidth l w, vecwidth l w]
-    MO_VF_Sub  l w      -> [vecwidth l w, vecwidth l w]
-    MO_VF_Mul  l w      -> [vecwidth l w, vecwidth l w]
-    MO_VF_Quot l w      -> [vecwidth l w, vecwidth l w]
-    MO_VF_Neg  l w      -> [vecwidth l w]
+    MO_VF_Add  _ r      -> [r,r]
+    MO_VF_Sub  _ r      -> [r,r]
+    MO_VF_Mul  _ r      -> [r,r]
+    MO_VF_Quot _ r      -> [r,r]
+    MO_VF_Neg  _ r      -> [r]
 
     MO_AlignmentCheck _ r -> [r]
-    where
-      vecwidth l w = widthFromBytes (l*widthInBytes w)
 
 -----------------------------------------------------------------------------
 -- CallishMachOp
index 17b5887..43d23c7 100644 (file)
@@ -6,7 +6,6 @@ module CmmType
     , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
     , isFloatType, isGcPtrType, isBitsType
     , isWord32, isWord64, isFloat64, isFloat32
-    , isVecCatType
 
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
@@ -134,7 +133,7 @@ cInt :: DynFlags -> CmmType
 cInt dflags = cmmBits (cIntWidth  dflags)
 
 ------------ Predicates ----------------
-isFloatType, isGcPtrType, isBitsType, isVecCatType :: CmmType -> Bool
+isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
 isFloatType (CmmType FloatCat    _) = True
 isFloatType _other                  = False
 
@@ -144,9 +143,6 @@ isGcPtrType _other               = False
 isBitsType (CmmType BitsCat _) = True
 isBitsType _                   = False
 
-isVecCatType (CmmType (VecCat _ _) _) = True
-isVecCatType _other                   = False
-
 isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
 -- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)
 -- isFloat32 and 64 are obvious
index a60a262..7227edd 100644 (file)
@@ -713,10 +713,6 @@ pprMachOp_for_C mop = case mop of
                                 (panic $ "PprC.pprMachOp_for_C: MO_VU_Rem"
                                       ++ " should have been handled earlier!")
 
-        MO_VF_Broadcast {} -> pprTrace "offending mop:"
-                                 (text "MO_VF_Broadcast")
-                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Broadcast"
-                                      ++ " should have been handled earlier!")
         MO_VF_Insert {}   -> pprTrace "offending mop:"
                                 (text "MO_VF_Insert")
                                 (panic $ "PprC.pprMachOp_for_C: MO_VF_Insert"
index 2080c1f..7bf73f1 100644 (file)
@@ -261,9 +261,9 @@ pprGlobalReg gr
         FloatReg   n   -> char 'F' <> int n
         DoubleReg  n   -> char 'D' <> int n
         LongReg    n   -> char 'L' <> int n
-        XmmReg     n _ _ _ -> text "XMM" <> int n
-        YmmReg     n _ _ _ -> text "YMM" <> int n
-        ZmmReg     n _ _ _ -> text "ZMM" <> int n
+        XmmReg     n   -> text "XMM" <> int n
+        YmmReg     n   -> text "YMM" <> int n
+        ZmmReg     n   -> text "ZMM" <> int n
         Sp             -> text "Sp"
         SpLim          -> text "SpLim"
         Hp             -> text "Hp"
index 2cbcfc6..0ff9bd8 100644 (file)
@@ -57,27 +57,27 @@ baseRegOffset dflags (DoubleReg 4)       = oFFSET_StgRegTable_rD4 dflags
 baseRegOffset dflags (DoubleReg 5)       = oFFSET_StgRegTable_rD5 dflags
 baseRegOffset dflags (DoubleReg 6)       = oFFSET_StgRegTable_rD6 dflags
 baseRegOffset _      (DoubleReg n)       = panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
-baseRegOffset dflags (XmmReg 1 _ _ _)    = oFFSET_StgRegTable_rXMM1 dflags
-baseRegOffset dflags (XmmReg 2 _ _ _)    = oFFSET_StgRegTable_rXMM2 dflags
-baseRegOffset dflags (XmmReg 3 _ _ _)    = oFFSET_StgRegTable_rXMM3 dflags
-baseRegOffset dflags (XmmReg 4 _ _ _)    = oFFSET_StgRegTable_rXMM4 dflags
-baseRegOffset dflags (XmmReg 5 _ _ _)    = oFFSET_StgRegTable_rXMM5 dflags
-baseRegOffset dflags (XmmReg 6 _ _ _)    = oFFSET_StgRegTable_rXMM6 dflags
-baseRegOffset _      (XmmReg n _ _ _)    = panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
-baseRegOffset dflags (YmmReg 1 _ _ _)    = oFFSET_StgRegTable_rYMM1 dflags
-baseRegOffset dflags (YmmReg 2 _ _ _)    = oFFSET_StgRegTable_rYMM2 dflags
-baseRegOffset dflags (YmmReg 3 _ _ _)    = oFFSET_StgRegTable_rYMM3 dflags
-baseRegOffset dflags (YmmReg 4 _ _ _)    = oFFSET_StgRegTable_rYMM4 dflags
-baseRegOffset dflags (YmmReg 5 _ _ _)    = oFFSET_StgRegTable_rYMM5 dflags
-baseRegOffset dflags (YmmReg 6 _ _ _)    = oFFSET_StgRegTable_rYMM6 dflags
-baseRegOffset _      (YmmReg n _ _ _)    = panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")
-baseRegOffset dflags (ZmmReg 1 _ _ _)    = oFFSET_StgRegTable_rZMM1 dflags
-baseRegOffset dflags (ZmmReg 2 _ _ _)    = oFFSET_StgRegTable_rZMM2 dflags
-baseRegOffset dflags (ZmmReg 3 _ _ _)    = oFFSET_StgRegTable_rZMM3 dflags
-baseRegOffset dflags (ZmmReg 4 _ _ _)    = oFFSET_StgRegTable_rZMM4 dflags
-baseRegOffset dflags (ZmmReg 5 _ _ _)    = oFFSET_StgRegTable_rZMM5 dflags
-baseRegOffset dflags (ZmmReg 6 _ _ _)    = oFFSET_StgRegTable_rZMM6 dflags
-baseRegOffset _      (ZmmReg n _ _ _)    = panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")
+baseRegOffset dflags (XmmReg 1)          = oFFSET_StgRegTable_rXMM1 dflags
+baseRegOffset dflags (XmmReg 2)          = oFFSET_StgRegTable_rXMM2 dflags
+baseRegOffset dflags (XmmReg 3)          = oFFSET_StgRegTable_rXMM3 dflags
+baseRegOffset dflags (XmmReg 4)          = oFFSET_StgRegTable_rXMM4 dflags
+baseRegOffset dflags (XmmReg 5)          = oFFSET_StgRegTable_rXMM5 dflags
+baseRegOffset dflags (XmmReg 6)          = oFFSET_StgRegTable_rXMM6 dflags
+baseRegOffset _      (XmmReg n)          = panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
+baseRegOffset dflags (YmmReg 1)          = oFFSET_StgRegTable_rYMM1 dflags
+baseRegOffset dflags (YmmReg 2)          = oFFSET_StgRegTable_rYMM2 dflags
+baseRegOffset dflags (YmmReg 3)          = oFFSET_StgRegTable_rYMM3 dflags
+baseRegOffset dflags (YmmReg 4)          = oFFSET_StgRegTable_rYMM4 dflags
+baseRegOffset dflags (YmmReg 5)          = oFFSET_StgRegTable_rYMM5 dflags
+baseRegOffset dflags (YmmReg 6)          = oFFSET_StgRegTable_rYMM6 dflags
+baseRegOffset _      (YmmReg n)          = panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")
+baseRegOffset dflags (ZmmReg 1)          = oFFSET_StgRegTable_rZMM1 dflags
+baseRegOffset dflags (ZmmReg 2)          = oFFSET_StgRegTable_rZMM2 dflags
+baseRegOffset dflags (ZmmReg 3)          = oFFSET_StgRegTable_rZMM3 dflags
+baseRegOffset dflags (ZmmReg 4)          = oFFSET_StgRegTable_rZMM4 dflags
+baseRegOffset dflags (ZmmReg 5)          = oFFSET_StgRegTable_rZMM5 dflags
+baseRegOffset dflags (ZmmReg 6)          = oFFSET_StgRegTable_rZMM6 dflags
+baseRegOffset _      (ZmmReg n)          = panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")
 baseRegOffset dflags Sp                  = oFFSET_StgRegTable_rSp dflags
 baseRegOffset dflags SpLim               = oFFSET_StgRegTable_rSpLim dflags
 baseRegOffset dflags (LongReg 1)         = oFFSET_StgRegTable_rL1 dflags
index 9a6cf6c..c3f9d5a 100644 (file)
@@ -669,7 +669,7 @@ emitPrimOp _      [res] Word2DoubleOp [w] = emitPrimCall [res]
 -- SIMD primops
 emitPrimOp dflags [res] (VecBroadcastOp vcat n w) [e] = do
     checkVecCompatibility dflags vcat n w
-    doVecBroadcastOp (vecElemInjectCast dflags vcat w) ty zeros e res
+    doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros (replicate n e) res
   where
     zeros :: CmmExpr
     zeros = CmmLit $ CmmVec (replicate n zero)
@@ -1765,8 +1765,9 @@ vecElemProjectCast _      _        _   =  Nothing
 
 checkVecCompatibility :: DynFlags -> PrimOpVecCat -> Length -> Width -> FCode ()
 checkVecCompatibility dflags vcat l w = do
-    when (hscTarget dflags /= HscLlvm && hscTarget dflags /= HscAsm) $ do
-        sorry "SIMD vector instructions not supported for the C backend or GHCi"
+    when (hscTarget dflags /= HscLlvm) $ do
+        sorry $ unlines ["SIMD vector instructions require the LLVM back-end."
+                         ,"Please use -fllvm."]
     check vecWidth vcat l w
   where
     check :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()
@@ -1791,38 +1792,6 @@ checkVecCompatibility dflags vcat l w = do
 
 ------------------------------------------------------------------------------
 -- Helpers for translating vector packing and unpacking.
-doVecBroadcastOp :: Maybe MachOp  -- Cast from element to vector component
-                 -> CmmType       -- Type of vector
-                 -> CmmExpr       -- Initial vector
-                 -> CmmExpr     -- Elements
-                 -> CmmFormal     -- Destination for result
-                 -> FCode ()
-doVecBroadcastOp maybe_pre_write_cast ty z es res = do
-    dst <- newTemp ty
-    emitAssign (CmmLocal dst) z
-    vecBroadcast dst es 0
-  where
-    vecBroadcast :: CmmFormal -> CmmExpr -> Int -> FCode ()
-    vecBroadcast src e _ = do
-        dst <- newTemp ty
-        if isFloatType (vecElemType ty)
-          then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Broadcast len wid)
-                                                    [CmmReg (CmmLocal src), cast e])
-               --TODO : Add the MachOp MO_V_Broadcast
-          else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)
-                                                    [CmmReg (CmmLocal src), cast e])
-        emitAssign (CmmLocal res) (CmmReg (CmmLocal dst))
-
-    cast :: CmmExpr -> CmmExpr
-    cast val = case maybe_pre_write_cast of
-                 Nothing   -> val
-                 Just cast -> CmmMachOp cast [val]
-
-    len :: Length
-    len = vecLength ty
-
-    wid :: Width
-    wid = typeWidth (vecElemType ty)
 
 doVecPackOp :: Maybe MachOp  -- Cast from element to vector component
             -> CmmType       -- Type of vector
@@ -1840,16 +1809,16 @@ doVecPackOp maybe_pre_write_cast ty z es res = do
         emitAssign (CmmLocal res) (CmmReg (CmmLocal src))
 
     vecPack src (e : es) i = do
-      dst <- newTemp ty
-      if isFloatType (vecElemType ty)
-        then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)
-                                         [CmmReg (CmmLocal src), cast e, iLit])
-        else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)
-                                         [CmmReg (CmmLocal src), cast e, iLit])
-      vecPack dst es (i + 1)
+        dst <- newTemp ty
+        if isFloatType (vecElemType ty)
+          then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)
+                                                    [CmmReg (CmmLocal src), cast e, iLit])
+          else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)
+                                                    [CmmReg (CmmLocal src), cast e, iLit])
+        vecPack dst es (i + 1)
       where
         -- vector indices are always 32-bits
-        iLit = CmmLit (CmmInt ((toInteger i) * 16) W32)
+        iLit = CmmLit (CmmInt (toInteger i) W32)
 
     cast :: CmmExpr -> CmmExpr
     cast val = case maybe_pre_write_cast of
index a5a5683..81f3b9f 100644 (file)
@@ -152,12 +152,12 @@ llvmFunArgs dflags live =
     where platform = targetPlatform dflags
           isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` live
           isPassed r = not (isSSE r) || isLive r
-          isSSE (FloatReg _)      = True
-          isSSE (DoubleReg _)     = True
-          isSSE (XmmReg _ _ _ _ ) = True
-          isSSE (YmmReg _ _ _ _ ) = True
-          isSSE (ZmmReg _ _ _ _ ) = True
-          isSSE _                 = False
+          isSSE (FloatReg _)  = True
+          isSSE (DoubleReg _) = True
+          isSSE (XmmReg _)    = True
+          isSSE (YmmReg _)    = True
+          isSSE (ZmmReg _)    = True
+          isSSE _             = False
 
 -- | Llvm standard fun attributes
 llvmStdFunAttrs :: [LlvmFuncAttr]
index 8fea6e0..86a5938 100644 (file)
@@ -1287,7 +1287,6 @@ genMachOp _ op [x] = case op of
     MO_VU_Quot    _ _ -> panicOp
     MO_VU_Rem     _ _ -> panicOp
 
-    MO_VF_Broadcast _ _ -> panicOp
     MO_VF_Insert  _ _ -> panicOp
     MO_VF_Extract _ _ -> panicOp
 
@@ -1484,7 +1483,6 @@ genMachOp_slow opt op [x, y] = case op of
 
     MO_VS_Neg {} -> panicOp
 
-    MO_VF_Broadcast  {} -> panicOp
     MO_VF_Insert  {} -> panicOp
     MO_VF_Extract {} -> panicOp
 
@@ -1846,9 +1844,9 @@ funEpilogue live = do
     let liveRegs = alwaysLive ++ live
         isSSE (FloatReg _)  = True
         isSSE (DoubleReg _) = True
-        isSSE (XmmReg _ _ _ _) = True
-        isSSE (YmmReg _ _ _ _) = True
-        isSSE (ZmmReg _ _ _ _) = True
+        isSSE (XmmReg _)    = True
+        isSSE (YmmReg _)    = True
+        isSSE (ZmmReg _)    = True
         isSSE _             = False
 
     -- Set to value or "undef" depending on whether the register is
index 6d188d9..8cdf3c6 100644 (file)
@@ -60,24 +60,24 @@ lmGlobalReg dflags suf reg
         DoubleReg 4    -> doubleGlobal $ "D4" ++ suf
         DoubleReg 5    -> doubleGlobal $ "D5" ++ suf
         DoubleReg 6    -> doubleGlobal $ "D6" ++ suf
-        XmmReg 1 _ _ _ -> xmmGlobal $ "XMM1" ++ suf
-        XmmReg 2 _ _ _ -> xmmGlobal $ "XMM2" ++ suf
-        XmmReg 3 _ _ _ -> xmmGlobal $ "XMM3" ++ suf
-        XmmReg 4 _ _ _ -> xmmGlobal $ "XMM4" ++ suf
-        XmmReg 5 _ _ _ -> xmmGlobal $ "XMM5" ++ suf
-        XmmReg 6 _ _ _ -> xmmGlobal $ "XMM6" ++ suf
-        YmmReg 1 _ _ _ -> ymmGlobal $ "YMM1" ++ suf
-        YmmReg 2 _ _ _ -> ymmGlobal $ "YMM2" ++ suf
-        YmmReg 3 _ _ _ -> ymmGlobal $ "YMM3" ++ suf
-        YmmReg 4 _ _ _ -> ymmGlobal $ "YMM4" ++ suf
-        YmmReg 5 _ _ _ -> ymmGlobal $ "YMM5" ++ suf
-        YmmReg 6 _ _ _ -> ymmGlobal $ "YMM6" ++ suf
-        ZmmReg 1 _ _ _ -> zmmGlobal $ "ZMM1" ++ suf
-        ZmmReg 2 _ _ _ -> zmmGlobal $ "ZMM2" ++ suf
-        ZmmReg 3 _ _ _ -> zmmGlobal $ "ZMM3" ++ suf
-        ZmmReg 4 _ _ _ -> zmmGlobal $ "ZMM4" ++ suf
-        ZmmReg 5 _ _ _ -> zmmGlobal $ "ZMM5" ++ suf
-        ZmmReg 6 _ _ _ -> zmmGlobal $ "ZMM6" ++ suf
+        XmmReg 1       -> xmmGlobal $ "XMM1" ++ suf
+        XmmReg 2       -> xmmGlobal $ "XMM2" ++ suf
+        XmmReg 3       -> xmmGlobal $ "XMM3" ++ suf
+        XmmReg 4       -> xmmGlobal $ "XMM4" ++ suf
+        XmmReg 5       -> xmmGlobal $ "XMM5" ++ suf
+        XmmReg 6       -> xmmGlobal $ "XMM6" ++ suf
+        YmmReg 1       -> ymmGlobal $ "YMM1" ++ suf
+        YmmReg 2       -> ymmGlobal $ "YMM2" ++ suf
+        YmmReg 3       -> ymmGlobal $ "YMM3" ++ suf
+        YmmReg 4       -> ymmGlobal $ "YMM4" ++ suf
+        YmmReg 5       -> ymmGlobal $ "YMM5" ++ suf
+        YmmReg 6       -> ymmGlobal $ "YMM6" ++ suf
+        ZmmReg 1       -> zmmGlobal $ "ZMM1" ++ suf
+        ZmmReg 2       -> zmmGlobal $ "ZMM2" ++ suf
+        ZmmReg 3       -> zmmGlobal $ "ZMM3" ++ suf
+        ZmmReg 4       -> zmmGlobal $ "ZMM4" ++ suf
+        ZmmReg 5       -> zmmGlobal $ "ZMM5" ++ suf
+        ZmmReg 6       -> zmmGlobal $ "ZMM6" ++ suf
         MachSp         -> wordGlobal $ "MachSp" ++ suf
         _other         -> panic $ "LlvmCodeGen.Reg: GlobalReg (" ++ (show reg)
                                 ++ ") not supported!"
index 2315be3..1f7de17 100644 (file)
@@ -219,7 +219,6 @@ module DynFlags (
         -- * SSE and AVX
         isSseEnabled,
         isSse2Enabled,
-        isSse4_1Enabled,
         isSse4_2Enabled,
         isBmiEnabled,
         isBmi2Enabled,
@@ -5903,8 +5902,6 @@ isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
     ArchX86    -> True
     _          -> False
 
-isSse4_1Enabled :: DynFlags -> Bool
-isSse4_1Enabled dflags = sseVersion dflags >= Just SSE4
 
 isSse4_2Enabled :: DynFlags -> Bool
 isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
index a0e4e99..3147289 100644 (file)
 --
 module Format (
     Format(..),
-    ScalarFormat(..),
     intFormat,
     floatFormat,
     isFloatFormat,
-    isVecFormat,
     cmmTypeFormat,
     formatToWidth,
     formatInBytes
@@ -27,29 +25,6 @@ import GhcPrelude
 import Cmm
 import Outputable
 
-
--- Note [GHC's data format representations]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- GHC has severals types that represent various aspects of data format.
--- These include:
---
---  * 'CmmType.CmmType': The data classification used throughout the C--
---    pipeline. This is a pair of a CmmCat and a Width.
---
---  * 'CmmType.CmmCat': What the bits in a C-- value mean (e.g. a pointer, integer, or floating-point value)
---
---  * 'CmmType.Width': The width of a C-- value.
---
---  * 'CmmType.Length': The width (measured in number of scalars) of a vector value.
---
---  * 'Format.Format': The data format representation used by much of the backend.
---
---  * 'Format.ScalarFormat': The format of a 'Format.VecFormat'\'s scalar.
---
---  * 'RegClass.RegClass': Whether a register is an integer, float-point, or vector register
---
-
 -- It looks very like the old MachRep, but it's now of purely local
 -- significance, here in the native code generator.  You can change it
 -- without global consequences.
@@ -72,16 +47,8 @@ data Format
         | II64
         | FF32
         | FF64
-        | VecFormat !Length !ScalarFormat !Width
         deriving (Show, Eq)
 
-data ScalarFormat = FmtInt8
-                  | FmtInt16
-                  | FmtInt32
-                  | FmtInt64
-                  | FmtFloat
-                  | FmtDouble
-                  deriving (Show, Eq)
 
 -- | Get the integer format of this width.
 intFormat :: Width -> Format
@@ -114,33 +81,13 @@ isFloatFormat format
         FF64    -> True
         _       -> False
 
--- | Check if a format represents a vector
-isVecFormat :: Format -> Bool
-isVecFormat (VecFormat {}) = True
-isVecFormat _              = False
 
 -- | Convert a Cmm type to a Format.
 cmmTypeFormat :: CmmType -> Format
 cmmTypeFormat ty
         | isFloatType ty        = floatFormat (typeWidth ty)
-        | isVecType ty          = vecFormat ty
         | otherwise             = intFormat (typeWidth ty)
 
-vecFormat :: CmmType -> Format
-vecFormat ty =
-  let l      = vecLength ty
-      elemTy = vecElemType ty
-   in if isFloatType elemTy
-      then case typeWidth elemTy of
-             W32 -> VecFormat l FmtFloat  W32
-             W64 -> VecFormat l FmtDouble W64
-             _   -> pprPanic "Incorrect vector element width" (ppr elemTy)
-      else case typeWidth elemTy of
-             W8  -> VecFormat l FmtInt8  W8
-             W16 -> VecFormat l FmtInt16 W16
-             W32 -> VecFormat l FmtInt32 W32
-             W64 -> VecFormat l FmtInt64 W64
-             _   -> pprPanic "Incorrect vector element width" (ppr elemTy)
 
 -- | Get the Width of a Format.
 formatToWidth :: Format -> Width
@@ -152,7 +99,7 @@ formatToWidth format
         II64            -> W64
         FF32            -> W32
         FF64            -> W64
-        VecFormat l _ w -> widthFromBytes (l*widthInBytes w)
+
 
 formatInBytes :: Format -> Int
 formatInBytes = widthInBytes . formatToWidth
index 67730aa..3680c1c 100644 (file)
@@ -250,6 +250,7 @@ getNewRegNat rep
       dflags <- getDynFlags
       return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)
 
+
 getNewRegPairNat :: Format -> NatM (Reg,Reg)
 getNewRegPairNat rep
  = do u <- getUniqueNat
index 7e5df6a..a49526c 100644 (file)
@@ -1909,8 +1909,6 @@ genCCall' dflags gcp target dest_regs args
                           FF32 -> (1, 1, 4, fprs)
                           FF64 -> (2, 1, 8, fprs)
                           II64 -> panic "genCCall' passArguments II64"
-                          VecFormat {}
-                               -> panic "genCCall' passArguments vector format"
 
                       GCP32ELF ->
                           case cmmTypeFormat rep of
@@ -1921,8 +1919,6 @@ genCCall' dflags gcp target dest_regs args
                           FF32 -> (0, 1, 4, fprs)
                           FF64 -> (0, 1, 8, fprs)
                           II64 -> panic "genCCall' passArguments II64"
-                          VecFormat {}
-                               -> panic "genCCall' passArguments vector format"
                       GCP64ELF _ ->
                           case cmmTypeFormat rep of
                           II8  -> (1, 0, 8, gprs)
@@ -1934,8 +1930,6 @@ genCCall' dflags gcp target dest_regs args
                           -- the FPRs.
                           FF32 -> (1, 1, 8, fprs)
                           FF64 -> (1, 1, 8, fprs)
-                          VecFormat {}
-                               -> panic "genCCall' passArguments vector format"
 
         moveResult reduceToFF32 =
             case dest_regs of
index b7316e6..4254f23 100644 (file)
@@ -29,7 +29,7 @@ import BlockId
 import CLabel
 import PprCmmExpr ()
 
-import Unique                ( getUnique )
+import Unique                ( pprUniqueAlways, getUnique )
 import GHC.Platform
 import FastString
 import Outputable
@@ -168,7 +168,10 @@ pprReg r
   = case r of
       RegReal    (RealRegSingle i) -> ppr_reg_no i
       RegReal    (RealRegPair{})   -> panic "PPC.pprReg: no reg pairs on this arch"
-      RegVirtual v                 -> ppr v
+      RegVirtual (VirtualRegI  u)  -> text "%vI_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegHi u)  -> text "%vHi_"  <> pprUniqueAlways u
+      RegVirtual (VirtualRegF  u)  -> text "%vF_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegD  u)  -> text "%vD_"   <> pprUniqueAlways u
 
   where
     ppr_reg_no :: Int -> SDoc
@@ -187,8 +190,7 @@ pprFormat x
                 II32 -> sLit "w"
                 II64 -> sLit "d"
                 FF32 -> sLit "fs"
-                FF64 -> sLit "fd"
-                VecFormat _ _ _ -> panic "PPC.Ppr.pprFormat: VecFormat")
+                FF64 -> sLit "fd")
 
 
 pprCond :: Cond -> SDoc
@@ -373,7 +375,6 @@ pprInstr (LD fmt reg addr) = hcat [
             II64 -> sLit "d"
             FF32 -> sLit "fs"
             FF64 -> sLit "fd"
-            VecFormat _ _ _ -> panic "PPC.Ppr.pprInstr: VecFormat"
             ),
         case addr of AddrRegImm _ _ -> empty
                      AddrRegReg _ _ -> char 'x',
@@ -413,7 +414,6 @@ pprInstr (LA fmt reg addr) = hcat [
             II64 -> sLit "d"
             FF32 -> sLit "fs"
             FF64 -> sLit "fd"
-            VecFormat _ _ _ -> panic "PPC.Ppr.pprInstr: VecFormat"
             ),
         case addr of AddrRegImm _ _ -> empty
                      AddrRegReg _ _ -> char 'x',
index dff2f07..7f69ea0 100644 (file)
@@ -56,7 +56,6 @@ data VirtualReg
         | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
         | VirtualRegF  {-# UNPACK #-} !Unique
         | VirtualRegD  {-# UNPACK #-} !Unique
-        | VirtualRegVec {-# UNPACK #-} !Unique
 
         deriving (Eq, Show)
 
@@ -70,7 +69,6 @@ instance Ord VirtualReg where
   compare (VirtualRegHi a) (VirtualRegHi b) = nonDetCmpUnique a b
   compare (VirtualRegF a) (VirtualRegF b) = nonDetCmpUnique a b
   compare (VirtualRegD a) (VirtualRegD b) = nonDetCmpUnique a b
-  compare (VirtualRegVec a) (VirtualRegVec b) = nonDetCmpUnique a b
 
   compare VirtualRegI{} _ = LT
   compare _ VirtualRegI{} = GT
@@ -78,8 +76,7 @@ instance Ord VirtualReg where
   compare _ VirtualRegHi{} = GT
   compare VirtualRegF{} _ = LT
   compare _ VirtualRegF{} = GT
-  compare VirtualRegVec{} _ = LT
-  compare _ VirtualRegVec{} = GT
+
 
 
 instance Uniquable VirtualReg where
@@ -89,7 +86,6 @@ instance Uniquable VirtualReg where
                 VirtualRegHi u  -> u
                 VirtualRegF u   -> u
                 VirtualRegD u   -> u
-                VirtualRegVec u -> u
 
 instance Outputable VirtualReg where
         ppr reg
@@ -99,9 +95,8 @@ instance Outputable VirtualReg where
                 -- this code is kinda wrong on x86
                 -- because float and double occupy the same register set
                 -- namely SSE2 register xmm0 .. xmm15
-                VirtualRegF  u  -> text "%vFloat_"  <> pprUniqueAlways u
-                VirtualRegD  u  -> text "%vDouble_" <> pprUniqueAlways u
-                VirtualRegVec u -> text "%vVec_"    <> pprUniqueAlways u
+                VirtualRegF  u  -> text "%vFloat_"   <> pprUniqueAlways u
+                VirtualRegD  u  -> text "%vDouble_"   <> pprUniqueAlways u
 
 
 
@@ -112,7 +107,6 @@ renameVirtualReg u r
         VirtualRegHi _  -> VirtualRegHi u
         VirtualRegF _   -> VirtualRegF  u
         VirtualRegD _   -> VirtualRegD  u
-        VirtualRegVec _ -> VirtualRegVec u
 
 
 classOfVirtualReg :: VirtualReg -> RegClass
@@ -122,8 +116,6 @@ classOfVirtualReg vr
         VirtualRegHi{}  -> RcInteger
         VirtualRegF{}   -> RcFloat
         VirtualRegD{}   -> RcDouble
-        -- Below is an awful, largely x86-specific hack
-        VirtualRegVec{} -> RcDouble
 
 
 
index 23d7c6b..5d4fd41 100644 (file)
@@ -195,6 +195,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
 
 
 
+
 -- Specification Code ----------------------------------------------------------
 --
 --      The trivColorable function for each particular architecture should
index d452edf..5a4f1c6 100644 (file)
@@ -2,7 +2,6 @@
 
 module RegAlloc.Linear.FreeRegs (
     FR(..),
-    allFreeRegs,
     maxSpillSlots
 )
 
@@ -70,10 +69,6 @@ instance FR SPARC.FreeRegs where
     frInitFreeRegs = SPARC.initFreeRegs
     frReleaseReg   = SPARC.releaseReg
 
--- | For debugging output.
-allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg]
-allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs plat rcls fr) allRegClasses
-
 maxSpillSlots :: DynFlags -> Int
 maxSpillSlots dflags
               = case platformArch (targetPlatform dflags) of
index b29712e..cdaf738 100644 (file)
@@ -884,10 +884,8 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                         $ vcat
                                 [ text "allocating vreg:  " <> text (show r)
                                 , text "assignment:       " <> ppr assig
-                                , text "freeRegs:         " <> text (showRegs freeRegs)
-                                , text "initFreeRegs:     " <> text (showRegs (frInitFreeRegs platform `asTypeOf` freeRegs))
-                                ]
-                        where showRegs = show . map (\reg -> (reg, targetClassOfRealReg platform reg)) . allFreeRegs platform
+                                , text "freeRegs:         " <> text (show freeRegs)
+                                , text "initFreeRegs:     " <> text (show (frInitFreeRegs platform `asTypeOf` freeRegs)) ]
 
                 result
 
index d73a340..fbbb786 100644 (file)
@@ -1,14 +1,15 @@
 -- | An architecture independent description of a register's class.
 module RegClass
-        ( RegClass(..)
-        , allRegClasses
-        ) where
+        ( RegClass (..) )
+
+where
 
 import GhcPrelude
 
 import  Outputable
 import  Unique
 
+
 -- | The class of a register.
 --      Used in the register allocator.
 --      We treat all registers in a class as being interchangable.
@@ -17,11 +18,7 @@ data RegClass
         = RcInteger
         | RcFloat
         | RcDouble
-        deriving (Eq, Show)
-
-allRegClasses :: [RegClass]
-allRegClasses =
-    [ RcInteger, RcFloat, RcDouble ]
+        deriving Eq
 
 
 instance Uniquable RegClass where
@@ -30,6 +27,6 @@ instance Uniquable RegClass where
     getUnique RcDouble  = mkRegClassUnique 2
 
 instance Outputable RegClass where
-    ppr RcInteger         = Outputable.text "I"
-    ppr RcFloat           = Outputable.text "F"
-    ppr RcDouble          = Outputable.text "D"
+    ppr RcInteger       = Outputable.text "I"
+    ppr RcFloat         = Outputable.text "F"
+    ppr RcDouble        = Outputable.text "D"
index aa355f9..fc67f77 100644 (file)
@@ -45,6 +45,7 @@ import CLabel
 import Hoopl.Label
 import Hoopl.Collections
 
+import Unique           ( pprUniqueAlways )
 import Outputable
 import GHC.Platform
 import FastString
@@ -147,7 +148,12 @@ pprReg :: Reg -> SDoc
 pprReg reg
  = case reg of
         RegVirtual vr
-         -> ppr vr
+         -> case vr of
+                VirtualRegI   u -> text "%vI_"   <> pprUniqueAlways u
+                VirtualRegHi  u -> text "%vHi_"  <> pprUniqueAlways u
+                VirtualRegF   u -> text "%vF_"   <> pprUniqueAlways u
+                VirtualRegD   u -> text "%vD_"   <> pprUniqueAlways u
+
 
         RegReal rr
          -> case rr of
@@ -215,8 +221,7 @@ pprFormat x
         II32    -> sLit ""
         II64    -> sLit "d"
         FF32    -> sLit ""
-        FF64    -> sLit "d"
-        VecFormat _ _ _ -> panic "SPARC.Ppr.pprFormat: VecFormat")
+        FF64    -> sLit "d")
 
 
 -- | Pretty print a format for an instruction suffix.
@@ -230,8 +235,7 @@ pprStFormat x
         II32  -> sLit ""
         II64  -> sLit "x"
         FF32  -> sLit ""
-        FF64  -> sLit "d"
-        VecFormat _ _ _ -> panic "SPARC.Ppr.pprFormat: VecFormat")
+        FF64  -> sLit "d")
 
 
 
index e46dbd0..0d7edc3 100644 (file)
@@ -104,6 +104,7 @@ virtualRegSqueeze cls vr
                 VirtualRegD{}           -> 1
                 _other                  -> 0
 
+
 {-# INLINE realRegSqueeze #-}
 realRegSqueeze :: RegClass -> RealReg -> Int
 
@@ -133,6 +134,7 @@ realRegSqueeze cls rr
 
                 RealRegPair{}           -> 1
 
+
 -- | All the allocatable registers in the machine,
 --      including register pairs.
 allRealRegs :: [RealReg]
index ed3684e..13662f6 100644 (file)
@@ -111,25 +111,12 @@ sse2Enabled = do
     ArchX86    -> return True
     _          -> panic "trying to generate x86/x86_64 on the wrong platform"
 
-sse4_1Enabled :: NatM Bool
-sse4_1Enabled = do
-  dflags <- getDynFlags
-  return (isSse4_1Enabled dflags)
 
 sse4_2Enabled :: NatM Bool
 sse4_2Enabled = do
   dflags <- getDynFlags
   return (isSse4_2Enabled dflags)
 
-sseEnabled :: NatM Bool
-sseEnabled = do
-  dflags <- getDynFlags
-  return (isSseEnabled dflags)
-
-avxEnabled :: NatM Bool
-avxEnabled = do
-  dflags <- getDynFlags
-  return (isAvxEnabled dflags)
 
 cmmTopCodeGen
         :: RawCmmDecl
@@ -228,7 +215,6 @@ stmtToInstrs bid stmt = do
     CmmAssign reg src
       | isFloatType ty         -> assignReg_FltCode format reg src
       | is32Bit && isWord64 ty -> assignReg_I64Code      reg src
-      | isVecType ty           -> assignReg_VecCode format reg src
       | otherwise              -> assignReg_IntCode format reg src
         where ty = cmmRegType dflags reg
               format = cmmTypeFormat ty
@@ -236,7 +222,6 @@ stmtToInstrs bid stmt = do
     CmmStore addr src
       | isFloatType ty         -> assignMem_FltCode format addr src
       | is32Bit && isWord64 ty -> assignMem_I64Code      addr src
-      | isVecType ty           -> assignMem_VecCode format addr src
       | otherwise              -> assignMem_IntCode format addr src
         where ty = cmmExprType dflags src
               format = cmmTypeFormat ty
@@ -323,15 +308,6 @@ getRegisterReg platform  (CmmGlobal mid)
         -- platform.  Hence ...
 
 
-getVecRegisterReg :: Platform -> Bool -> Format -> CmmReg -> Reg
-getVecRegisterReg _ use_avx format (CmmLocal (LocalReg u pk))
-  | isVecType pk && use_avx = RegVirtual (mkVirtualReg u format)
-  | otherwise               = pprPanic
-                              (unlines ["avx flag is not enabled" ,
-                                        "or this is not a vector register"])
-                              (ppr pk)
-getVecRegisterReg platform _use_avx _format c = getRegisterReg platform c
-
 -- | Memory addressing modes passed up the tree.
 data Amode
         = Amode AddrMode InstrBlock
@@ -527,13 +503,6 @@ iselExpr64 expr
 
 
 --------------------------------------------------------------------------------
-
--- This is a helper data type which helps reduce the code duplication for
--- the code generation of arithmetic operations. This is not specifically
--- targetted for any particular type like Int8, Int32 etc
-data VectorArithInstns = VA_Add | VA_Sub | VA_Mul | VA_Div
-
-
 getRegister :: CmmExpr -> NatM Register
 getRegister e = do dflags <- getDynFlags
                    is32Bit <- is32BitPlatform
@@ -551,24 +520,16 @@ getRegister' dflags is32Bit (CmmReg reg)
             do reg' <- getPicBaseNat (archWordFormat is32Bit)
                return (Fixed (archWordFormat is32Bit) reg' nilOL)
         _ ->
-            do use_sse2 <- sse2Enabled
-               use_avx <- avxEnabled
-               let cmmregtype = cmmRegType dflags reg
-               if isVecType cmmregtype
-                 then return (vectorRegister cmmregtype use_avx use_sse2)
-                 else return (standardRegister cmmregtype)
-  where
-    vectorRegister :: CmmType -> Bool -> Bool -> Register
-    vectorRegister reg_ty use_avx use_sse2
-      | use_avx || use_sse2 =
-        let vecfmt   = cmmTypeFormat reg_ty
-            platform = targetPlatform dflags
-        in (Fixed vecfmt (getVecRegisterReg platform True vecfmt reg) nilOL)
-      | otherwise = panic "Please enable the -mavx or -msse2 flag"
-
-    standardRegister crt =
-      let platform = targetPlatform dflags
-       in (Fixed (cmmTypeFormat crt) (getRegisterReg platform reg) nilOL)
+            do
+               let
+                 fmt = cmmTypeFormat (cmmRegType dflags reg)
+                 format  = fmt
+               --
+               let platform = targetPlatform dflags
+               return (Fixed format
+                             (getRegisterReg platform  reg)
+                             nilOL)
+
 
 getRegister' dflags is32Bit (CmmRegOff r n)
   = getRegister' dflags is32Bit $ mangleIndexTree dflags r n
@@ -670,69 +631,7 @@ getRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
       return $ Any II64 (\dst -> unitOL $
         LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst))
 
-getRegister' _ _ (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
-  sse4_1 <- sse4_1Enabled
-  sse2   <- sse2Enabled
-  sse    <- sseEnabled
-  case mop of
-    MO_VF_Insert l W32  | sse4_1 && sse -> vector_float_pack l W32 x y z
-                        | otherwise
-                          -> sorry "Please enable the -msse4 and -msse flag"
-    MO_VF_Insert l W64  | sse2   && sse -> vector_float_pack l W64 x y z
-                        | otherwise
-                          -> sorry "Please enable the -msse2 and -msse flag"
-    _other                              -> incorrectOperands
-    where
-    vector_float_pack :: Length
-                      -> Width
-                      -> CmmExpr
-                      -> CmmExpr
-                      -> CmmExpr
-                      -> NatM Register
-    vector_float_pack len W32 expr1 expr2 (CmmLit offset)
-      = do
-      fn          <- getAnyReg expr1
-      (r, exp)    <- getSomeReg expr2
-      let f        = VecFormat len FmtFloat W32
-          imm      = litToImm offset
-          code dst = exp `appOL`
-                     (fn dst) `snocOL`
-                     (INSERTPS f (OpImm imm) (OpReg r) dst)
-       in return $ Any f code
-    vector_float_pack len W64 expr1 expr2 (CmmLit offset)
-      = do
-      Amode addr addr_code <- getAmode expr2
-      (r, exp) <- getSomeReg expr1
-
-      -- fn <- getAnyReg expr1
-      -- (r, exp) <- getSomeReg expr2
-      let f = VecFormat len FmtDouble W64
-          code dst
-            = case offset of
-                CmmInt 0  _ -> exp `appOL` addr_code `snocOL`
-                               (MOVL f (OpAddr addr) (OpReg r)) `snocOL`
-                               (MOVU f (OpReg r) (OpReg dst))
-                CmmInt 16 _ -> exp `appOL` addr_code `snocOL`
-                               (MOVH f (OpAddr addr) (OpReg r)) `snocOL`
-                               (MOVU f (OpReg r) (OpReg dst))
-                _ -> panic "Error in offset while packing"
-          -- code dst
-          --   = case offset of
-          --       CmmInt 0  _ -> exp `appOL`
-          --                      (fn dst) `snocOL`
-          --                      (MOVL f (OpReg r) (OpReg dst))
-          --       CmmInt 16 _ -> exp `appOL`
-          --                      (fn dst) `snocOL`
-          --                      (MOVH f (OpReg r) (OpReg dst))
-          --       _ -> panic "Error in offset while packing"
-       in return $ Any f code
-    vector_float_pack _ _ _ c _
-      = pprPanic "Pack not supported for : " (ppr c)
-
 getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
-    sse2   <- sse2Enabled
-    sse    <- sseEnabled
-    avx    <- avxEnabled
     case mop of
       MO_F_Neg w  -> sse2NegCode w x
 
@@ -809,28 +708,23 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
       MO_FS_Conv from to -> coerceFP2Int from to x
       MO_SF_Conv from to -> coerceInt2FP from to x
 
-      MO_V_Insert {}      -> needLlvm
-      MO_V_Extract {}     -> needLlvm
-      MO_V_Add {}         -> needLlvm
-      MO_V_Sub {}         -> needLlvm
-      MO_V_Mul {}         -> needLlvm
-      MO_VS_Quot {}       -> needLlvm
-      MO_VS_Rem {}        -> needLlvm
-      MO_VS_Neg {}        -> needLlvm
-      MO_VU_Quot {}       -> needLlvm
-      MO_VU_Rem {}        -> needLlvm
-      MO_VF_Broadcast {}  -> incorrectOperands
-      MO_VF_Insert {}     -> incorrectOperands
-      MO_VF_Extract {}    -> incorrectOperands
-      MO_VF_Add {}        -> incorrectOperands
-      MO_VF_Sub {}        -> incorrectOperands
-      MO_VF_Mul {}        -> incorrectOperands
-      MO_VF_Quot {}       -> incorrectOperands
-
-      MO_VF_Neg l w  | avx           -> vector_float_negate_avx l w x
-                     | sse && sse2   -> vector_float_negate_sse l w x
-                     | otherwise
-                       -> sorry "Please enable the -mavx or -msse, -msse2 flag"
+      MO_V_Insert {}   -> needLlvm
+      MO_V_Extract {}  -> needLlvm
+      MO_V_Add {}      -> needLlvm
+      MO_V_Sub {}      -> needLlvm
+      MO_V_Mul {}      -> needLlvm
+      MO_VS_Quot {}    -> needLlvm
+      MO_VS_Rem {}     -> needLlvm
+      MO_VS_Neg {}     -> needLlvm
+      MO_VU_Quot {}    -> needLlvm
+      MO_VU_Rem {}     -> needLlvm
+      MO_VF_Insert {}  -> needLlvm
+      MO_VF_Extract {} -> needLlvm
+      MO_VF_Add {}     -> needLlvm
+      MO_VF_Sub {}     -> needLlvm
+      MO_VF_Mul {}     -> needLlvm
+      MO_VF_Quot {}    -> needLlvm
+      MO_VF_Neg {}     -> needLlvm
 
       _other -> pprPanic "getRegister" (pprMachOp mop)
    where
@@ -868,45 +762,8 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
             = do e_code <- getRegister' dflags is32Bit expr
                  return (swizzleRegisterRep e_code new_format)
 
-        vector_float_negate_avx :: Length -> Width -> CmmExpr -> NatM Register
-        vector_float_negate_avx l w expr = do
-          tmp                  <- getNewRegNat (VecFormat l FmtFloat w)
-          (reg, exp)           <- getSomeReg expr
-          Amode addr addr_code <- memConstant (mkAlignment $ widthInBytes W32) (CmmFloat 0.0 W32)
-          let format   = case w of
-                           W32 -> VecFormat l FmtFloat w
-                           W64 -> VecFormat l FmtDouble w
-                           _ -> pprPanic "Cannot negate vector of width" (ppr w)
-              code dst = case w of
-                           W32 -> exp `appOL` addr_code `snocOL`
-                                  (VBROADCAST format addr tmp) `snocOL`
-                                  (VSUB format (OpReg reg) tmp dst)
-                           W64 -> exp `appOL` addr_code `snocOL`
-                                  (MOVL format (OpAddr addr) (OpReg tmp)) `snocOL`
-                                  (MOVH format (OpAddr addr) (OpReg tmp)) `snocOL`
-                                  (VSUB format (OpReg reg) tmp dst)
-                           _ -> pprPanic "Cannot negate vector of width" (ppr w)
-          return (Any format code)
-
-        vector_float_negate_sse :: Length -> Width -> CmmExpr -> NatM Register
-        vector_float_negate_sse l w expr = do
-          tmp                  <- getNewRegNat (VecFormat l FmtFloat w)
-          (reg, exp)           <- getSomeReg expr
-          let format   = case w of
-                           W32 -> VecFormat l FmtFloat w
-                           W64 -> VecFormat l FmtDouble w
-                           _ -> pprPanic "Cannot negate vector of width" (ppr w)
-              code dst = exp `snocOL`
-                         (XOR format (OpReg tmp) (OpReg tmp)) `snocOL`
-                         (MOVU format (OpReg tmp) (OpReg dst)) `snocOL`
-                         (SUB format (OpReg reg) (OpReg dst))
-          return (Any format code)
 
 getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
-  sse4_1 <- sse4_1Enabled
-  sse2   <- sse2Enabled
-  sse    <- sseEnabled
-  avx    <- avxEnabled
   case mop of
       MO_F_Eq _ -> condFltReg is32Bit EQQ x y
       MO_F_Ne _ -> condFltReg is32Bit NE  x y
@@ -971,49 +828,13 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
       MO_VS_Quot {}    -> needLlvm
       MO_VS_Rem {}     -> needLlvm
       MO_VS_Neg {}     -> needLlvm
-
-      MO_VF_Broadcast l W32 | avx       -> vector_float_broadcast_avx l W32 x y
-                            | sse4_1    -> vector_float_broadcast_sse l W32 x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse4 flag"
-
-      MO_VF_Broadcast l W64 | sse2      -> vector_float_broadcast_avx l W64 x y
-                            | otherwise -> sorry "Please enable the -msse2 flag"
-
-      MO_VF_Extract l W32   | avx       -> vector_float_unpack l W32 x y
-                            | sse       -> vector_float_unpack_sse l W32 x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse flag"
-
-      MO_VF_Extract l W64   | sse2      -> vector_float_unpack l W64 x y
-                            | otherwise -> sorry "Please enable the -msse2 flag"
-
-      MO_VF_Add l w         | avx              -> vector_float_op_avx VA_Add l w x y
-                            | sse  && w == W32 -> vector_float_op_sse VA_Add l w x y
-                            | sse2 && w == W64 -> vector_float_op_sse VA_Add l w x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse flag"
-
-      MO_VF_Sub l w         | avx              -> vector_float_op_avx VA_Sub l w x y
-                            | sse  && w == W32 -> vector_float_op_sse VA_Sub l w x y
-                            | sse2 && w == W64 -> vector_float_op_sse VA_Sub l w x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse flag"
-
-      MO_VF_Mul l w         | avx              -> vector_float_op_avx VA_Mul l w x y
-                            | sse  && w == W32 -> vector_float_op_sse VA_Mul l w x y
-                            | sse2 && w == W64 -> vector_float_op_sse VA_Mul l w x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse flag"
-
-      MO_VF_Quot l w        | avx              -> vector_float_op_avx VA_Div l w x y
-                            | sse  && w == W32 -> vector_float_op_sse VA_Div l w x y
-                            | sse2 && w == W64 -> vector_float_op_sse VA_Div l w x y
-                            | otherwise
-                              -> sorry "Please enable the -mavx or -msse flag"
-
-      MO_VF_Insert {}                  -> incorrectOperands
-      MO_VF_Neg {}                     -> incorrectOperands
+      MO_VF_Insert {}  -> needLlvm
+      MO_VF_Extract {} -> needLlvm
+      MO_VF_Add {}     -> needLlvm
+      MO_VF_Sub {}     -> needLlvm
+      MO_VF_Mul {}     -> needLlvm
+      MO_VF_Quot {}    -> needLlvm
+      MO_VF_Neg {}     -> needLlvm
 
       _other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop)
   where
@@ -1109,171 +930,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
     -- TODO: There are other interesting patterns we want to replace
     --     with a LEA, e.g. `(x + offset) + (y << shift)`.
 
-    -----------------------
-    -- Vector operations---
-    vector_float_op_avx :: VectorArithInstns
-                        -> Length
-                        -> Width
-                        -> CmmExpr
-                        -> CmmExpr
-                        -> NatM Register
-    vector_float_op_avx op l w expr1 expr2 = do
-      (reg1, exp1) <- getSomeReg expr1
-      (reg2, exp2) <- getSomeReg expr2
-      let format   = case w of
-                       W32 -> VecFormat l FmtFloat  W32
-                       W64 -> VecFormat l FmtDouble W64
-                       _ -> pprPanic "Operation not supported for width " (ppr w)
-          code dst = case op of
-            VA_Add -> arithInstr VADD
-            VA_Sub -> arithInstr VSUB
-            VA_Mul -> arithInstr VMUL
-            VA_Div -> arithInstr VDIV
-            where
-              -- opcode src2 src1 dst <==> dst = src1 `opcode` src2
-              arithInstr instr = exp1 `appOL` exp2 `snocOL`
-                                 (instr format (OpReg reg2) reg1 dst)
-      return (Any format code)
-
-    vector_float_op_sse :: VectorArithInstns
-                        -> Length
-                        -> Width
-                        -> CmmExpr
-                        -> CmmExpr
-                        -> NatM Register
-    vector_float_op_sse op l w expr1 expr2 = do
-      (reg1, exp1) <- getSomeReg expr1
-      (reg2, exp2) <- getSomeReg expr2
-      let format   = case w of
-                       W32 -> VecFormat l FmtFloat  W32
-                       W64 -> VecFormat l FmtDouble W64
-                       _ -> pprPanic "Operation not supported for width " (ppr w)
-          code dst = case op of
-            VA_Add -> arithInstr ADD
-            VA_Sub -> arithInstr SUB
-            VA_Mul -> arithInstr MUL
-            VA_Div -> arithInstr FDIV
-            where
-              -- opcode src2 src1 <==> src1 = src1 `opcode` src2
-              arithInstr instr
-                = exp1 `appOL` exp2 `snocOL`
-                  (MOVU format (OpReg reg1) (OpReg dst)) `snocOL`
-                  (instr format (OpReg reg2) (OpReg dst))
-      return (Any format code)
     --------------------
-    vector_float_unpack :: Length
-                        -> Width
-                        -> CmmExpr
-                        -> CmmExpr
-                        -> NatM Register
-    vector_float_unpack l W32 expr (CmmLit lit)
-      = do
-      (r, exp) <- getSomeReg expr
-      let format   = VecFormat l FmtFloat W32
-          imm      = litToImm lit
-          code dst
-            = case lit of
-                CmmInt 0 _ -> exp `snocOL` (VMOVU format (OpReg r) (OpReg dst))
-                CmmInt _ _ -> exp `snocOL` (VPSHUFD format (OpImm imm) (OpReg r) dst)
-                _          -> panic "Error in offset while unpacking"
-      return (Any format code)
-    vector_float_unpack l W64 expr (CmmLit lit)
-      = do
-      dflags <- getDynFlags
-      (r, exp) <- getSomeReg expr
-      let format   = VecFormat l FmtDouble W64
-          addr     = spRel dflags 0
-          code dst
-            = case lit of
-                CmmInt 0 _ -> exp `snocOL`
-                              (MOVL format (OpReg r) (OpAddr addr)) `snocOL`
-                              (MOV FF64 (OpAddr addr) (OpReg dst))
-                CmmInt 1 _ -> exp `snocOL`
-                              (MOVH format (OpReg r) (OpAddr addr)) `snocOL`
-                              (MOV FF64 (OpAddr addr) (OpReg dst))
-                _          -> panic "Error in offset while unpacking"
-      return (Any format code)
-    vector_float_unpack _ w c e
-      = pprPanic "Unpack not supported for : " (ppr c $$ ppr e $$ ppr w)
-    -----------------------
-
-    vector_float_unpack_sse :: Length
-                            -> Width
-                            -> CmmExpr
-                            -> CmmExpr
-                            -> NatM Register
-    vector_float_unpack_sse l W32 expr (CmmLit lit)
-      = do
-      (r,exp) <- getSomeReg expr
-      let format   = VecFormat l FmtFloat W32
-          imm      = litToImm lit
-          code dst
-            = case lit of
-                CmmInt 0 _ -> exp `snocOL` (MOVU format (OpReg r) (OpReg dst))
-                CmmInt _ _ -> exp `snocOL` (PSHUFD format (OpImm imm) (OpReg r) dst)
-                _          -> panic "Error in offset while unpacking"
-      return (Any format code)
-    vector_float_unpack_sse _ w c e
-      = pprPanic "Unpack not supported for : " (ppr c $$ ppr e $$ ppr w)
-    -----------------------
-    vector_float_broadcast_avx :: Length
-                           -> Width
-                           -> CmmExpr
-                           -> CmmExpr
-                           -> NatM Register
-    vector_float_broadcast_avx len W32 expr1 expr2
-      = do
-      dflags    <- getDynFlags
-      fn        <- getAnyReg expr1
-      (r', exp) <- getSomeReg expr2
-      let f    = VecFormat len FmtFloat W32
-          addr = spRel dflags 0
-       in return $ Any f (\r -> exp    `appOL`
-                                (fn r) `snocOL`
-                                (MOVU f (OpReg r') (OpAddr addr)) `snocOL`
-                                (VBROADCAST f addr r))
-    vector_float_broadcast_avx len W64 expr1 expr2
-      = do
-      dflags    <- getDynFlags
-      fn        <- getAnyReg  expr1
-      (r', exp) <- getSomeReg expr2
-      let f    = VecFormat len FmtDouble W64
-          addr = spRel dflags 0
-       in return $ Any f (\r -> exp    `appOL`
-                                (fn r) `snocOL`
-                                (MOVU f (OpReg r') (OpAddr addr)) `snocOL`
-                                (MOVL f (OpAddr addr) (OpReg r)) `snocOL`
-                                (MOVH f (OpAddr addr) (OpReg r)))
-    vector_float_broadcast_avx _ _ c _
-      = pprPanic "Broadcast not supported for : " (ppr c)
-    -----------------------
-    vector_float_broadcast_sse :: Length
-                               -> Width
-                               -> CmmExpr
-                               -> CmmExpr
-                               -> NatM Register
-    vector_float_broadcast_sse len W32 expr1 expr2
-      = do
-      dflags   <- getDynFlags
-      fn       <- getAnyReg  expr1  -- destination
-      (r, exp) <- getSomeReg expr2  -- source
-      let f        = VecFormat len FmtFloat W32
-          addr     = spRel dflags 0
-          code dst = exp `appOL`
-                     (fn dst) `snocOL`
-                     (MOVU f (OpReg r) (OpAddr addr)) `snocOL`
-                     (insertps 0) `snocOL`
-                     (insertps 16) `snocOL`
-                     (insertps 32) `snocOL`
-                     (insertps 48)
-            where
-              insertps off =
-                INSERTPS f (OpImm $ litToImm $ CmmInt off W32) (OpAddr addr) dst
-
-       in return $ Any f code
-    vector_float_broadcast_sse _ _ c _
-      = pprPanic "Broadcast not supported for : " (ppr c)
-    -----------------------
     sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
     sub_code rep x (CmmLit (CmmInt y _))
         | is32BitInteger (-y) = add_int rep x (-y)
@@ -1326,21 +983,6 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
 
            return (Fixed format result code)
 
-getRegister' _ _ (CmmLoad mem pk)
-  | isVecType pk = do
-      use_avx <- avxEnabled
-      use_sse <- sseEnabled
-      Amode addr mem_code <- getAmode mem
-      let format = cmmTypeFormat pk
-          code dst
-            | use_avx = mem_code `snocOL`
-                        VMOVU format (OpAddr addr) (OpReg dst)
-            | use_sse = mem_code `snocOL`
-                        MOVU format (OpAddr addr) (OpReg dst)
-            | otherwise = pprPanic (unlines ["avx or sse flag not enabled",
-                                            "for loading to "])
-                          (ppr pk)
-      return (Any format code)
 
 getRegister' _ _ (CmmLoad mem pk)
   | isFloatType pk
@@ -1407,24 +1049,10 @@ getRegister' dflags is32Bit (CmmLit lit)
         -- small memory model (see gcc docs, -mcmodel=small).
 
 getRegister' dflags _ (CmmLit lit)
-  | isVecType cmmtype = vectorRegister cmmtype
-  | otherwise         = standardRegister cmmtype
-  where
-    cmmtype = cmmLitType dflags lit
-    vectorRegister ctype
-      = do
-      --NOTE:
-      -- This operation is only used to zero a register. For loading a
-      -- vector literal there are pack and broadcast operations
-      let format = cmmTypeFormat ctype
-          code dst = unitOL (XOR format (OpReg dst) (OpReg dst))
-      return (Any format code)
-    standardRegister ctype
-      = do
-      let format = cmmTypeFormat ctype
-          imm = litToImm lit
-          code dst = unitOL (MOV format (OpImm imm) (OpReg dst))
-      return (Any format code)
+  = do let format = cmmTypeFormat (cmmLitType dflags lit)
+           imm = litToImm lit
+           code dst = unitOL (MOV format (OpImm imm) (OpReg dst))
+       return (Any format code)
 
 getRegister' _ _ other
     | isVecExpr other  = needLlvm
@@ -1490,14 +1118,8 @@ getNonClobberedReg expr = do
                 return (reg, code)
 
 reg2reg :: Format -> Reg -> Reg -> Instr
-reg2reg format@(VecFormat _ FmtFloat W32) src dst
-  = VMOVU format (OpReg src) (OpReg dst)
-reg2reg format@(VecFormat _ FmtDouble W64) src dst
-  = VMOVU format (OpReg src) (OpReg dst)
-reg2reg (VecFormat _ _ _) _ _
-  = panic "MOV operation not implemented for vectors"
-reg2reg format src dst
-  = MOV format (OpReg src) (OpReg dst)
+reg2reg format src dst = MOV format (OpReg src) (OpReg dst)
+
 
 --------------------------------------------------------------------------------
 getAmode :: CmmExpr -> NatM Amode
@@ -1559,9 +1181,6 @@ getAmode' _ (CmmMachOp (MO_Add _)
 getAmode' _ (CmmMachOp (MO_Add _) [x,y])
   = x86_complex_amode x y 0 0
 
-getAmode' _ (CmmLit lit@(CmmFloat _ w))
-  = memConstant (mkAlignment $ widthInBytes w) lit
-
 getAmode' is32Bit (CmmLit lit) | is32BitLit is32Bit lit
   = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
 
@@ -1942,8 +1561,7 @@ assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
 assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
 assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
 
-assignMem_VecCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_VecCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
+
 -- integer assignment to memory
 
 -- specific case of adding/subtracting an integer to a particular address.
@@ -2020,29 +1638,6 @@ assignReg_FltCode _ reg src = do
   let platform = targetPlatform dflags
   return (src_code (getRegisterReg platform  reg))
 
-assignMem_VecCode pk addr src = do
-  (src_reg, src_code) <- getNonClobberedReg src
-  Amode addr addr_code <- getAmode addr
-  use_avx <- avxEnabled
-  use_sse <- sseEnabled
-  let
-        code | use_avx   = src_code `appOL`
-                           addr_code `snocOL`
-                           (VMOVU pk (OpReg src_reg) (OpAddr addr))
-             | use_sse   = src_code `appOL`
-                           addr_code `snocOL`
-                           (MOVU pk (OpReg src_reg) (OpAddr addr))
-             | otherwise = sorry "Please enable the -mavx or -msse flag"
-  return code
-
-assignReg_VecCode format reg src = do
-  use_avx <- avxEnabled
-  use_sse <- sseEnabled
-  src_code <- getAnyReg src
-  dflags <- getDynFlags
-  let platform = targetPlatform dflags
-      flag     = use_avx || use_sse
-  return (src_code (getVecRegisterReg platform flag format reg))
 
 genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock
 
@@ -3767,7 +3362,6 @@ sse2NegCode w x = do
       x@II16 -> wrongFmt x
       x@II32 -> wrongFmt x
       x@II64 -> wrongFmt x
-      x@VecFormat {} -> wrongFmt x
 
       where
         wrongFmt x = panic $ "sse2NegCode: " ++ show x
@@ -3782,33 +3376,29 @@ sse2NegCode w x = do
   return (Any fmt code)
 
 isVecExpr :: CmmExpr -> Bool
-isVecExpr (CmmMachOp (MO_V_Insert {}) _)     = True
-isVecExpr (CmmMachOp (MO_V_Extract {}) _)    = True
-isVecExpr (CmmMachOp (MO_V_Add {}) _)        = True
-isVecExpr (CmmMachOp (MO_V_Sub {}) _)        = True
-isVecExpr (CmmMachOp (MO_V_Mul {}) _)        = True
-isVecExpr (CmmMachOp (MO_VS_Quot {}) _)      = True
-isVecExpr (CmmMachOp (MO_VS_Rem {}) _)       = True
-isVecExpr (CmmMachOp (MO_VS_Neg {}) _)       = True
-isVecExpr (CmmMachOp (MO_VF_Broadcast {}) _) = True
-isVecExpr (CmmMachOp (MO_VF_Insert {}) _)    = True
-isVecExpr (CmmMachOp (MO_VF_Extract {}) _)   = True
-isVecExpr (CmmMachOp (MO_VF_Add {}) _)       = True
-isVecExpr (CmmMachOp (MO_VF_Sub {}) _)       = True
-isVecExpr (CmmMachOp (MO_VF_Mul {}) _)       = True
-isVecExpr (CmmMachOp (MO_VF_Quot {}) _)      = True
-isVecExpr (CmmMachOp (MO_VF_Neg {}) _)       = True
-isVecExpr (CmmMachOp _ [e])                  = isVecExpr e
-isVecExpr _                                  = False
+isVecExpr (CmmMachOp (MO_V_Insert {}) _)   = True
+isVecExpr (CmmMachOp (MO_V_Extract {}) _)  = True
+isVecExpr (CmmMachOp (MO_V_Add {}) _)      = True
+isVecExpr (CmmMachOp (MO_V_Sub {}) _)      = True
+isVecExpr (CmmMachOp (MO_V_Mul {}) _)      = True
+isVecExpr (CmmMachOp (MO_VS_Quot {}) _)    = True
+isVecExpr (CmmMachOp (MO_VS_Rem {}) _)     = True
+isVecExpr (CmmMachOp (MO_VS_Neg {}) _)     = True
+isVecExpr (CmmMachOp (MO_VF_Insert {}) _)  = True
+isVecExpr (CmmMachOp (MO_VF_Extract {}) _) = True
+isVecExpr (CmmMachOp (MO_VF_Add {}) _)     = True
+isVecExpr (CmmMachOp (MO_VF_Sub {}) _)     = True
+isVecExpr (CmmMachOp (MO_VF_Mul {}) _)     = True
+isVecExpr (CmmMachOp (MO_VF_Quot {}) _)    = True
+isVecExpr (CmmMachOp (MO_VF_Neg {}) _)     = True
+isVecExpr (CmmMachOp _ [e])                = isVecExpr e
+isVecExpr _                                = False
 
 needLlvm :: NatM a
 needLlvm =
     sorry $ unlines ["The native code generator does not support vector"
                     ,"instructions. Please use -fllvm."]
 
-incorrectOperands :: NatM a
-incorrectOperands = sorry "Incorrect number of operands"
-
 -- | This works on the invariant that all jumps in the given blocks are required.
 --   Starting from there we try to make a few more jumps redundant by reordering
 --   them.
index 47b62e6..6e5d656 100644 (file)
@@ -328,36 +328,6 @@ data Instr
         | CMPXCHG     Format Operand Operand -- src (r), dst (r/m), eax implicit
         | MFENCE
 
-        -- Vector Instructions --
-        -- NOTE: Instructions follow the AT&T syntax
-        -- Constructors and deconstructors
-        | VBROADCAST  Format AddrMode Reg
-        | VEXTRACT    Format Operand Reg Operand
-        | INSERTPS    Format Operand Operand Reg
-
-        -- move operations
-        | VMOVU       Format Operand Operand
-        | MOVU        Format Operand Operand
-        | MOVL        Format Operand Operand
-        | MOVH        Format Operand Operand
-
-        -- logic operations
-        | VPXOR       Format Reg Reg Reg
-
-        -- Arithmetic
-        | VADD       Format Operand Reg Reg
-        | VSUB       Format Operand Reg Reg
-        | VMUL       Format Operand Reg Reg
-        | VDIV       Format Operand Reg Reg
-
-        -- Shuffle
-        | VPSHUFD    Format Operand Operand Reg
-        | PSHUFD     Format Operand Operand Reg
-
-        -- Shift
-        | PSLLDQ     Format Operand Reg
-        | PSRLDQ     Format Operand Reg
-
 data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
 
 
@@ -460,31 +430,6 @@ x86_regUsageOfInstr platform instr
     CMPXCHG _ src dst   -> usageRMM src dst (OpReg eax)
     MFENCE -> noUsage
 
-    -- vector instructions
-    VBROADCAST _ src dst   -> mkRU (use_EA src []) [dst]
-    VEXTRACT     _ off src dst -> mkRU ((use_R off []) ++ [src]) (use_R dst [])
-    INSERTPS     _ off src dst
-      -> mkRU ((use_R off []) ++ (use_R src []) ++ [dst]) [dst]
-
-    VMOVU        _ src dst   -> mkRU (use_R src []) (use_R dst [])
-    MOVU         _ src dst   -> mkRU (use_R src []) (use_R dst [])
-    MOVL         _ src dst   -> mkRU (use_R src []) (use_R dst [])
-    MOVH         _ src dst   -> mkRU (use_R src []) (use_R dst [])
-    VPXOR        _ s1 s2 dst -> mkRU [s1,s2] [dst]
-
-    VADD         _ s1 s2 dst -> mkRU ((use_R s1 []) ++ [s2]) [dst]
-    VSUB         _ s1 s2 dst -> mkRU ((use_R s1 []) ++ [s2]) [dst]
-    VMUL         _ s1 s2 dst -> mkRU ((use_R s1 []) ++ [s2]) [dst]
-    VDIV         _ s1 s2 dst -> mkRU ((use_R s1 []) ++ [s2]) [dst]
-
-    VPSHUFD      _ off src dst
-      -> mkRU (concatMap (\op -> use_R op []) [off, src]) [dst]
-    PSHUFD       _ off src dst
-      -> mkRU (concatMap (\op -> use_R op []) [off, src]) [dst]
-
-    PSLLDQ       _ off dst -> mkRU (use_R off []) [dst]
-    PSRLDQ       _ off dst -> mkRU (use_R off []) [dst]
-
     _other              -> panic "regUsage: unrecognised instr"
  where
     -- # Definitions
@@ -643,32 +588,6 @@ x86_patchRegsOfInstr instr env
     CMPXCHG fmt src dst  -> patch2 (CMPXCHG fmt) src dst
     MFENCE               -> instr
 
-    -- vector instructions
-    VBROADCAST   fmt src dst   -> VBROADCAST fmt (lookupAddr src) (env dst)
-    VEXTRACT     fmt off src dst
-      -> VEXTRACT fmt (patchOp off) (env src) (patchOp dst)
-    INSERTPS    fmt off src dst
-      -> INSERTPS fmt (patchOp off) (patchOp src) (env dst)
-
-    VMOVU      fmt src dst   -> VMOVU fmt (patchOp src) (patchOp dst)
-    MOVU       fmt src dst   -> MOVU  fmt (patchOp src) (patchOp dst)
-    MOVL       fmt src dst   -> MOVL  fmt (patchOp src) (patchOp dst)
-    MOVH       fmt src dst   -> MOVH  fmt (patchOp src) (patchOp dst)
-    VPXOR      fmt s1 s2 dst -> VPXOR fmt (env s1) (env s2) (env dst)
-
-    VADD       fmt s1 s2 dst -> VADD fmt (patchOp s1) (env s2) (env dst)
-    VSUB       fmt s1 s2 dst -> VSUB fmt (patchOp s1) (env s2) (env dst)
-    VMUL       fmt s1 s2 dst -> VMUL fmt (patchOp s1) (env s2) (env dst)
-    VDIV       fmt s1 s2 dst -> VDIV fmt (patchOp s1) (env s2) (env dst)
-
-    VPSHUFD      fmt off src dst
-      -> VPSHUFD fmt (patchOp off) (patchOp src) (env dst)
-    PSHUFD       fmt off src dst
-      -> PSHUFD  fmt (patchOp off) (patchOp src) (env dst)
-    PSLLDQ       fmt off dst
-      -> PSLLDQ  fmt (patchOp off) (env dst)
-    PSRLDQ       fmt off dst
-      -> PSRLDQ  fmt (patchOp off) (env dst)
     _other              -> panic "patchRegs: unrecognised instr"
 
   where
index a3f27ba..095d9eb 100644 (file)
@@ -41,6 +41,7 @@ import DynFlags
 import Cmm              hiding (topInfoTable)
 import BlockId
 import CLabel
+import Unique           ( pprUniqueAlways )
 import GHC.Platform
 import FastString
 import Outputable
@@ -279,7 +280,10 @@ pprReg f r
           if target32Bit platform then ppr32_reg_no f i
                                   else ppr64_reg_no f i
       RegReal    (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
-      RegVirtual v                 -> ppr v
+      RegVirtual (VirtualRegI  u)  -> text "%vI_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegHi u)  -> text "%vHi_"  <> pprUniqueAlways u
+      RegVirtual (VirtualRegF  u)  -> text "%vF_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegD  u)  -> text "%vD_"   <> pprUniqueAlways u
 
   where
     ppr32_reg_no :: Format -> Int -> SDoc
@@ -391,11 +395,6 @@ pprFormat x
                 II64  -> sLit "q"
                 FF32  -> sLit "ss"      -- "scalar single-precision float" (SSE2)
                 FF64  -> sLit "sd"      -- "scalar double-precision float" (SSE2)
-
-                VecFormat _ FmtFloat W32  -> sLit "ps"
-                VecFormat _ FmtDouble W64 -> sLit "pd"
-                -- TODO: Add Ints and remove panic
-                VecFormat {} -> panic "Incorrect width"
                 )
 
 pprFormat_x87 :: Format -> SDoc
@@ -784,41 +783,6 @@ pprInstr (IDIV fmt op)   = pprFormatOp (sLit "idiv") fmt op
 pprInstr (DIV fmt op)    = pprFormatOp (sLit "div")  fmt op
 pprInstr (IMUL2 fmt op)  = pprFormatOp (sLit "imul") fmt op
 
--- Vector Instructions
-
-pprInstr (VADD format s1 s2 dst)
-  = pprFormatOpRegReg (sLit "vadd") format s1 s2 dst
-pprInstr (VSUB format s1 s2 dst)
-  = pprFormatOpRegReg (sLit "vsub") format s1 s2 dst
-pprInstr (VMUL format s1 s2 dst)
-  = pprFormatOpRegReg (sLit "vmul") format s1 s2 dst
-pprInstr (VDIV format s1 s2 dst)
-  = pprFormatOpRegReg (sLit "vdiv") format s1 s2 dst
-pprInstr (VBROADCAST format from to)
-  = pprBroadcast (sLit "vbroadcast") format from to
-pprInstr (VMOVU format from to)
-  = pprFormatOpOp (sLit "vmovu") format from to
-pprInstr (MOVU format from to)
-  = pprFormatOpOp (sLit "movu") format from to
-pprInstr (MOVL format from to)
-  = pprFormatOpOp (sLit "movl") format from to
-pprInstr (MOVH format from to)
-  = pprFormatOpOp (sLit "movh") format from to
-pprInstr (VPXOR format s1 s2 dst)
-  = pprXor (sLit "vpxor") format s1 s2 dst
-pprInstr (VEXTRACT format offset from to)
-  = pprFormatOpRegOp (sLit "vextract") format offset from to
-pprInstr (INSERTPS format offset addr dst)
-  = pprInsert (sLit "insertps") format offset addr dst
-pprInstr (VPSHUFD format offset src dst)
-  = pprShuf (sLit "vpshufd") format offset src dst
-pprInstr (PSHUFD format offset src dst)
-  = pprShuf (sLit "pshufd") format offset src dst
-pprInstr (PSLLDQ format offset dst)
-  = pprShiftLeft (sLit "pslldq") format offset dst
-pprInstr (PSRLDQ format offset dst)
-  = pprShiftRight (sLit "psrldq") format offset dst
-
 -- x86_64 only
 pprInstr (MUL format op1 op2) = pprFormatOpOp (sLit "mul") format op1 op2
 pprInstr (MUL2 format op) = pprFormatOp (sLit "mul") format op
@@ -911,23 +875,6 @@ pprMnemonic  :: PtrString -> Format -> SDoc
 pprMnemonic name format =
    char '\t' <> ptext name <> pprFormat format <> space
 
-pprGenMnemonic  :: PtrString -> Format -> SDoc
-pprGenMnemonic name _ =
-   char '\t' <> ptext name <> ptext (sLit "") <> space
-
-pprBroadcastMnemonic  :: PtrString -> Format -> SDoc
-pprBroadcastMnemonic name format =
-   char '\t' <> ptext name <> pprBroadcastFormat format <> space
-
-pprBroadcastFormat :: Format -> SDoc
-pprBroadcastFormat x
-  = ptext (case x of
-             VecFormat _ FmtFloat W32  -> sLit "ss"
-             VecFormat _ FmtDouble W64 -> sLit "sd"
-             -- TODO: Add Ints and remove panic
-             VecFormat {} -> panic "Incorrect width"
-             _ -> panic "Scalar Format invading vector operation"
-          )
 
 pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
 pprFormatImmOp name format imm op1
@@ -974,16 +921,7 @@ pprOpOp name format op1 op2
         pprOperand format op2
     ]
 
-pprFormatOpRegOp :: PtrString -> Format -> Operand -> Reg -> Operand -> SDoc
-pprFormatOpRegOp name format off reg1 op2
-  = hcat [
-        pprMnemonic name format,
-        pprOperand format off,
-        comma,
-        pprReg format reg1,
-        comma,
-        pprOperand format op2
-    ]
+
 
 pprRegReg :: PtrString -> Reg -> Reg -> SDoc
 pprRegReg name reg1 reg2
@@ -1006,17 +944,6 @@ pprFormatOpReg name format op1 reg2
         pprReg (archWordFormat (target32Bit platform)) reg2
     ]
 
-pprFormatOpRegReg :: PtrString -> Format -> Operand -> Reg -> Reg -> SDoc
-pprFormatOpRegReg name format op1 reg2 reg3
-  = hcat [
-        pprMnemonic name format,
-        pprOperand format op1,
-        comma,
-        pprReg format reg2,
-        comma,
-        pprReg format reg3
-    ]
-
 pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
 pprCondOpReg name format cond op1 reg2
   = hcat [
@@ -1081,68 +1008,3 @@ pprFormatOpOpCoerce name format1 format2 op1 op2
 pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
-
-
--- Custom pretty printers
--- These instructions currently don't follow a uniform suffix pattern
--- in their names, so we have custom pretty printers for them.
-
-pprBroadcast :: PtrString -> Format -> AddrMode -> Reg -> SDoc
-pprBroadcast name format op dst
-  = hcat [
-        pprBroadcastMnemonic name format,
-        pprAddr op,
-        comma,
-        pprReg format dst
-    ]
-
-pprXor :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
-pprXor name format reg1 reg2 reg3
-  = hcat [
-        pprGenMnemonic name format,
-        pprReg format reg1,
-        comma,
-        pprReg format reg2,
-        comma,
-        pprReg format reg3
-    ]
-
-pprInsert :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
-pprInsert name format off src dst
-  = hcat [
-        pprGenMnemonic name format,
-        pprOperand format off,
-        comma,
-        pprOperand format src,
-        comma,
-        pprReg format dst
-    ]
-
-pprShuf :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
-pprShuf name format op1 op2 reg3
-  = hcat [
-        pprGenMnemonic name format,
-        pprOperand format op1,
-        comma,
-        pprOperand format op2,
-        comma,
-        pprReg format reg3
-    ]
-
-pprShiftLeft :: PtrString -> Format -> Operand -> Reg -> SDoc
-pprShiftLeft name format off reg
-  = hcat [
-        pprGenMnemonic name format,
-        pprOperand format off,
-        comma,
-        pprReg format reg
-    ]
-
-pprShiftRight :: PtrString -> Format -> Operand -> Reg -> SDoc
-pprShiftRight name format off reg
-  = hcat [
-        pprGenMnemonic name format,
-        pprOperand format off,
-        comma,
-        pprReg format reg
-    ]
index a7784ba..19056be 100644 (file)
@@ -22,8 +22,6 @@ import UniqFM
 import X86.Regs
 
 
---TODO:
--- Add VirtualRegAVX and inspect VecFormat and allocate
 mkVirtualReg :: Unique -> Format -> VirtualReg
 mkVirtualReg u format
    = case format of
@@ -33,7 +31,6 @@ mkVirtualReg u format
         -- For now we map both to being allocated as "Double" Registers
         -- on X86/X86_64
         FF64    -> VirtualRegD u
-        VecFormat {} -> VirtualRegVec u
         _other  -> VirtualRegI u
 
 regDotColor :: Platform -> RealReg -> SDoc
index f0e4c7d..2d9fd88 100644 (file)
@@ -84,7 +84,6 @@ virtualRegSqueeze cls vr
          -> case vr of
                 VirtualRegD{}           -> 1
                 VirtualRegF{}           -> 0
-                VirtualRegVec{}         -> 1
                 _other                  -> 0
 
 
index 34c943d..27a9324 100644 (file)
@@ -495,13 +495,13 @@ activeStgRegs = [
     ,DoubleReg 1
 #endif
 #if defined(REG_XMM1)
-    ,XmmReg 1 2 W64 Integer
+    ,XmmReg 1
 #endif
 #if defined(REG_YMM1)
-    ,YmmReg 1 4 W64 Integer
+    ,YmmReg 1
 #endif
 #if defined(REG_ZMM1)
-    ,ZmmReg 1 8 W64 Integer
+    ,ZmmReg 1
 #endif
 #if defined(REG_F2)
     ,FloatReg 2
@@ -510,13 +510,13 @@ activeStgRegs = [
     ,DoubleReg 2
 #endif
 #if defined(REG_XMM2)
-    ,XmmReg 2 2 W64 Integer
+    ,XmmReg 2
 #endif
 #if defined(REG_YMM2)
-    ,YmmReg 2 4 W64 Integer
+    ,YmmReg 2
 #endif
 #if defined(REG_ZMM2)
-    ,ZmmReg 2 8 W64 Integer
+    ,ZmmReg 2
 #endif
 #if defined(REG_F3)
     ,FloatReg 3
@@ -525,13 +525,13 @@ activeStgRegs = [
     ,DoubleReg 3
 #endif
 #if defined(REG_XMM3)
-    ,XmmReg 3 2 W64 Integer
+    ,XmmReg 3
 #endif
 #if defined(REG_YMM3)
-    ,YmmReg 3 4 W64 Integer
+    ,YmmReg 3
 #endif
 #if defined(REG_ZMM3)
-    ,ZmmReg 3 8 W64 Integer
+    ,ZmmReg 3
 #endif
 #if defined(REG_F4)
     ,FloatReg 4
@@ -540,13 +540,13 @@ activeStgRegs = [
     ,DoubleReg 4
 #endif
 #if defined(REG_XMM4)
-    ,XmmReg 4 2 W64 Integer
+    ,XmmReg 4
 #endif
 #if defined(REG_YMM4)
-    ,YmmReg 4 4 W64 Integer
+    ,YmmReg 4
 #endif
 #if defined(REG_ZMM4)
-    ,ZmmReg 4 8 W64 Integer
+    ,ZmmReg 4
 #endif
 #if defined(REG_F5)
     ,FloatReg 5
@@ -555,13 +555,13 @@ activeStgRegs = [
     ,DoubleReg 5
 #endif
 #if defined(REG_XMM5)
-    ,XmmReg 5 2 W64 Integer
+    ,XmmReg 5
 #endif
 #if defined(REG_YMM5)
-    ,YmmReg 5 4 W64 Integer
+    ,YmmReg 5
 #endif
 #if defined(REG_ZMM5)
-    ,ZmmReg 5 8 W64 Integer
+    ,ZmmReg 5
 #endif
 #if defined(REG_F6)
     ,FloatReg 6
@@ -570,13 +570,13 @@ activeStgRegs = [
     ,DoubleReg 6
 #endif
 #if defined(REG_XMM6)
-    ,XmmReg 6 2 W64 Integer
+    ,XmmReg 6
 #endif
 #if defined(REG_YMM6)
-    ,YmmReg 6 4 W64 Integer
+    ,YmmReg 6
 #endif
 #if defined(REG_ZMM6)
-    ,ZmmReg 6 8 W64 Integer
+    ,ZmmReg 6
 #endif
 #else /* MAX_REAL_XMM_REG == 0 */
 #if defined(REG_F1)
@@ -733,62 +733,62 @@ globalRegMaybe (DoubleReg 6)            =
 # endif
 # if MAX_REAL_XMM_REG != 0
 #  if defined(REG_XMM1)
-globalRegMaybe (XmmReg 1 _ _ _)         = Just (RealRegSingle REG_XMM1)
+globalRegMaybe (XmmReg 1)               = Just (RealRegSingle REG_XMM1)
 #  endif
 #  if defined(REG_XMM2)
-globalRegMaybe (XmmReg 2 _ _ _)         = Just (RealRegSingle REG_XMM2)
+globalRegMaybe (XmmReg 2)               = Just (RealRegSingle REG_XMM2)
 #  endif
 #  if defined(REG_XMM3)
-globalRegMaybe (XmmReg 3 _ _ _)         = Just (RealRegSingle REG_XMM3)
+globalRegMaybe (XmmReg 3)               = Just (RealRegSingle REG_XMM3)
 #  endif
 #  if defined(REG_XMM4)
-globalRegMaybe (XmmReg 4 _ _ _)         = Just (RealRegSingle REG_XMM4)
+globalRegMaybe (XmmReg 4)               = Just (RealRegSingle REG_XMM4)
 #  endif
 #  if defined(REG_XMM5)
-globalRegMaybe (XmmReg 5 _ _ _)         = Just (RealRegSingle REG_XMM5)
+globalRegMaybe (XmmReg 5)               = Just (RealRegSingle REG_XMM5)
 #  endif
 #  if defined(REG_XMM6)
-globalRegMaybe (XmmReg 6 _ _ _)         = Just (RealRegSingle REG_XMM6)
+globalRegMaybe (XmmReg 6)               = Just (RealRegSingle REG_XMM6)
 #  endif
 # endif
 # if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0
 #  if defined(REG_YMM1)
-globalRegMaybe (YmmReg 1 _ _ _)         = Just (RealRegSingle REG_YMM1)
+globalRegMaybe (YmmReg 1)               = Just (RealRegSingle REG_YMM1)
 #  endif
 #  if defined(REG_YMM2)
-globalRegMaybe (YmmReg 2 _ _ _)         = Just (RealRegSingle REG_YMM2)
+globalRegMaybe (YmmReg 2)               = Just (RealRegSingle REG_YMM2)
 #  endif
 #  if defined(REG_YMM3)
-globalRegMaybe (YmmReg 3 _ _ _)         = Just (RealRegSingle REG_YMM3)
+globalRegMaybe (YmmReg 3)               = Just (RealRegSingle REG_YMM3)
 #  endif
 #  if defined(REG_YMM4)
-globalRegMaybe (YmmReg 4 _ _ _)         = Just (RealRegSingle REG_YMM4)
+globalRegMaybe (YmmReg 4)               = Just (RealRegSingle REG_YMM4)
 #  endif
 #  if defined(REG_YMM5)
-globalRegMaybe (YmmReg 5 _ _ _)         = Just (RealRegSingle REG_YMM5)
+globalRegMaybe (YmmReg 5)               = Just (RealRegSingle REG_YMM5)
 #  endif
 #  if defined(REG_YMM6)
-globalRegMaybe (YmmReg 6 _ _ _)         = Just (RealRegSingle REG_YMM6)
+globalRegMaybe (YmmReg 6)               = Just (RealRegSingle REG_YMM6)
 #  endif
 # endif
 # if defined(MAX_REAL_ZMM_REG) && MAX_REAL_ZMM_REG != 0
 #  if defined(REG_ZMM1)
-globalRegMaybe (ZmmReg 1 _ _ _)         = Just (RealRegSingle REG_ZMM1)
+globalRegMaybe (ZmmReg 1)               = Just (RealRegSingle REG_ZMM1)
 #  endif
 #  if defined(REG_ZMM2)
-globalRegMaybe (ZmmReg 2 _ _ _)         = Just (RealRegSingle REG_ZMM2)
+globalRegMaybe (ZmmReg 2)               = Just (RealRegSingle REG_ZMM2)
 #  endif
 #  if defined(REG_ZMM3)
-globalRegMaybe (ZmmReg 3 _ _ _)         = Just (RealRegSingle REG_ZMM3)
+globalRegMaybe (ZmmReg 3)               = Just (RealRegSingle REG_ZMM3)
 #  endif
 #  if defined(REG_ZMM4)
-globalRegMaybe (ZmmReg 4 _ _ _)         = Just (RealRegSingle REG_ZMM4)
+globalRegMaybe (ZmmReg 4)               = Just (RealRegSingle REG_ZMM4)
 #  endif
 #  if defined(REG_ZMM5)
-globalRegMaybe (ZmmReg 5 _ _ _)         = Just (RealRegSingle REG_ZMM5)
+globalRegMaybe (ZmmReg 5)               = Just (RealRegSingle REG_ZMM5)
 #  endif
 #  if defined(REG_ZMM6)
-globalRegMaybe (ZmmReg 6 _ _ _)         = Just (RealRegSingle REG_ZMM6)
+globalRegMaybe (ZmmReg 6)               = Just (RealRegSingle REG_ZMM6)
 #  endif
 # endif
 # if defined(REG_Sp)
index eb6fee5..20ac9cc 100644 (file)
@@ -80,20 +80,11 @@ test('cgrun069',
 test('cgrun070', normal, compile_and_run, [''])
 test('cgrun071', [when(have_cpu_feature('sse4_2'), extra_hc_opts('-msse4.2'))], compile_and_run, [''])
 test('cgrun072', normal, compile_and_run, [''])
-test('cgrun074', normal, compile_and_run, [''])
 test('cgrun075', normal, compile_and_run, [''])
 test('cgrun076', normal, compile_and_run, [''])
 test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], compile_and_run, [''])
 test('cgrun078', omit_ways(['ghci']), compile_and_run, [''])
 
-# N.B. Only NCG and LLVM backends support SIMD operations
-test('simd000', when(unregisterised(), skip), compile_and_run, [''])
-test('simd001', when(unregisterised(), skip), compile_and_run, [''])
-test('simd002', when(unregisterised(), skip), compile_and_run, [''])
-test('simd003', when(unregisterised(), skip), compile_and_run, [''])
-test('simd004', when(unregisterised(), skip), compile_and_run, [''])
-test('simd005', when(unregisterised(), skip), compile_and_run, [''])
-
 test('T1852', normal, compile_and_run, [''])
 test('T1861', extra_run_opts('0'), compile_and_run, [''])
 test('T2080', normal, compile_and_run, [''])
@@ -152,6 +143,7 @@ test('T9001', normal, compile_and_run, [''])
 test('T9013', omit_ways(['ghci']),  # ghci doesn't support unboxed tuples
      compile_and_run, [''])
 test('T9340', normal, compile_and_run, [''])
+test('cgrun074', normal, compile_and_run, [''])
 test('CmmSwitchTest32', unless(wordsize(32), skip), compile_and_run, [''])
 test('CmmSwitchTest64', unless(wordsize(64), skip), compile_and_run, [''])
 # Skipping WAY=ghci, because it is not broken.
diff --git a/testsuite/tests/codeGen/should_run/cgrun083.hs b/testsuite/tests/codeGen/should_run/cgrun083.hs
deleted file mode 100644 (file)
index cac889e..0000000
+++ /dev/null
@@ -1,70 +0,0 @@
-{-# OPTIONS_GHC -O2 #-}
-{-# OPTIONS_GHC -msse #-}
-{-# OPTIONS_GHC -msse2 #-}
-{-# OPTIONS_GHC -msse4 #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- tests for SSE based vector load/stores operations
-
-import GHC.Exts
-import GHC.IO
-
-data ByteArray = BA (MutableByteArray# RealWorld)
-
-data FloatX4  = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-
-instance Eq FloatX4 where
-  (FX4# a) == (FX4# b)
-    = case (unpackFloatX4# a) of
-        (# a1, a2, a3, a4 #) ->
-          case (unpackFloatX4# b) of
-            (# b1, b2, b3, b4 #) -> (F# a1) == (F# b1) &&
-                                    (F# a2) == (F# b2) &&
-                                    (F# a3) == (F# b3) &&
-                                    (F# a4) == (F# b4)
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-instance Eq DoubleX2 where
-  (DX2# a) == (DX2# b)
-    = case (unpackDoubleX2# a) of
-        (# a1, a2 #) ->
-          case (unpackDoubleX2# b) of
-            (# b1, b2 #) -> (D# a1) == (D# b1) &&
-                            (D# a2) == (D# b2)
-
-writeFloatArray :: ByteArray -> Int -> Float -> IO ()
-writeFloatArray (BA ba) (I# i) (F# n) = IO $ \s ->
-    case writeFloatArray# ba i n s of s' -> (# s', () #)
-
-readFloatX4 :: ByteArray -> Int -> IO FloatX4
-readFloatX4 (BA ba) (I# i) = IO $ \s ->
-    case readFloatArrayAsFloatX4# ba i s of (# s', r #) -> (# s', FX4# r #)
-
-writeDoubleArray :: ByteArray -> Int -> Double -> IO ()
-writeDoubleArray (BA ba) (I# i) (D# n) = IO $ \s ->
-    case writeDoubleArray# ba i n s of s' -> (# s', () #)
-
-readDoubleX2 :: ByteArray -> Int -> IO DoubleX2
-readDoubleX2 (BA ba) (I# i) = IO $ \s ->
-    case readDoubleArrayAsDoubleX2# ba i s of (# s', r #) -> (# s', DX2# r #)
-
-main :: IO ()
-main = do
-    ba <- IO $ \s -> case newAlignedPinnedByteArray# 64# 64# s of (# s', ba #) -> (# s', BA ba #)
-
-    mapM_ (\i -> writeFloatArray ba i (realToFrac i + realToFrac i / 10)) [0..16]
-    print =<< readFloatX4 ba 0
-
-    mapM_ (\i -> writeDoubleArray ba i (realToFrac i + realToFrac i / 10)) [0..8]
-    print =<< readDoubleX2 ba 0
diff --git a/testsuite/tests/codeGen/should_run/cgrun083.stdout b/testsuite/tests/codeGen/should_run/cgrun083.stdout
deleted file mode 100644 (file)
index bc41b3d..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-(0.0,1.1,2.2,3.3)
-(0.0,1.1)
diff --git a/testsuite/tests/codeGen/should_run/simd000.hs b/testsuite/tests/codeGen/should_run/simd000.hs
deleted file mode 100644 (file)
index 47d6949..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# OPTIONS_GHC -mavx #-}
-{-# OPTIONS_GHC -msse4 #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- !!! test broadcasting, packing and unpacking for vector types
-
-import GHC.Exts
-
-main :: IO ()
-main = do
-    -- FloatX4#
-    case unpackFloatX4# (broadcastFloatX4# 1.5#) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-    case unpackFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-
-    -- DoubleX2#
-    case unpackDoubleX2# (broadcastDoubleX2# 6.5##) of
-        (# a, b #) -> print (D# a, D# b)
-    case unpackDoubleX2# (packDoubleX2# (# 8.9##,7.2## #)) of
-        (# a, b #) -> print (D# a, D# b)
diff --git a/testsuite/tests/codeGen/should_run/simd000.stdout b/testsuite/tests/codeGen/should_run/simd000.stdout
deleted file mode 100644 (file)
index e5f9d38..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-(1.5,1.5,1.5,1.5)
-(4.5,7.8,2.3,6.5)
-(6.5,6.5)
-(8.9,7.2)
diff --git a/testsuite/tests/codeGen/should_run/simd001.hs b/testsuite/tests/codeGen/should_run/simd001.hs
deleted file mode 100644 (file)
index c45e3bf..0000000
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# OPTIONS_GHC -mavx #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- !!! test the lifting of unlifted vector types and
--- defining various typeclass instances for the lifted types
-
-import GHC.Exts
-
-data FloatX4  = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-
-instance Eq FloatX4 where
-  (FX4# a) == (FX4# b)
-    = case (unpackFloatX4# a) of
-        (# a1, a2, a3, a4 #) ->
-          case (unpackFloatX4# b) of
-            (# b1, b2, b3, b4 #) -> (F# a1) == (F# b1) &&
-                                    (F# a2) == (F# b2) &&
-                                    (F# a3) == (F# b3) &&
-                                    (F# a4) == (F# b4)
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-instance Eq DoubleX2 where
-  (DX2# a) == (DX2# b)
-    = case (unpackDoubleX2# a) of
-        (# a1, a2 #) ->
-          case (unpackDoubleX2# b) of
-            (# b1, b2 #) -> (D# a1) == (D# b1) &&
-                            (D# a2) == (D# b2)
-
-main :: IO ()
-main = do
-  print (FX4# (broadcastFloatX4# 1.5#))
-  print $ (FX4# (broadcastFloatX4# 1.5#)) == (FX4# (broadcastFloatX4# 2.5#))
-  print $ (FX4# (broadcastFloatX4# 3.5#)) == (FX4# (broadcastFloatX4# 3.5#))
-
-  print (DX2# (broadcastDoubleX2# 2.5##))
-  print $ (DX2# (broadcastDoubleX2# 1.5##)) == (DX2# (broadcastDoubleX2# 2.5##))
-  print $ (DX2# (broadcastDoubleX2# 3.5##)) == (DX2# (broadcastDoubleX2# 3.5##))
diff --git a/testsuite/tests/codeGen/should_run/simd001.stdout b/testsuite/tests/codeGen/should_run/simd001.stdout
deleted file mode 100644 (file)
index 899f900..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-(1.5,1.5,1.5,1.5)
-False
-True
-(2.5,2.5)
-False
-True
diff --git a/testsuite/tests/codeGen/should_run/simd002.hs b/testsuite/tests/codeGen/should_run/simd002.hs
deleted file mode 100644 (file)
index 8c61546..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# OPTIONS_GHC -mavx #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- !!! test arithmetic vector operations
-
-import GHC.Exts
-
-data FloatX4 = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-main :: IO ()
-main = do
-  print (FX4# (plusFloatX4# (broadcastFloatX4# 1.3#) (broadcastFloatX4# 2.2#)))
-  print (FX4# (minusFloatX4# (broadcastFloatX4# 3.5#) (broadcastFloatX4# 2.2#)))
-  print (FX4# (timesFloatX4# (broadcastFloatX4# 2.4#) (broadcastFloatX4# 2.2#)))
-  print (FX4# (divideFloatX4# (broadcastFloatX4# 9.2#) (broadcastFloatX4# 4.0#)))
-  print (FX4# (negateFloatX4# (broadcastFloatX4# 3.5#)))
-
-  print (DX2# (plusDoubleX2# (broadcastDoubleX2# 1.3##) (broadcastDoubleX2# 2.2##)))
-  print (DX2# (minusDoubleX2# (broadcastDoubleX2# 3.5##) (broadcastDoubleX2# 2.2##)))
-  print (DX2# (timesDoubleX2# (broadcastDoubleX2# 2.4##) (broadcastDoubleX2# 2.2##)))
-  print (DX2# (divideDoubleX2# (broadcastDoubleX2# 9.2##) (broadcastDoubleX2# 4.0##)))
-  print (DX2# (negateDoubleX2# (broadcastDoubleX2# 3.5##)))
diff --git a/testsuite/tests/codeGen/should_run/simd002.stdout b/testsuite/tests/codeGen/should_run/simd002.stdout
deleted file mode 100644 (file)
index 302d71a..0000000
+++ /dev/null
@@ -1,10 +0,0 @@
-(3.5,3.5,3.5,3.5)
-(1.3,1.3,1.3,1.3)
-(5.28,5.28,5.28,5.28)
-(2.3,2.3,2.3,2.3)
-(-3.5,-3.5,-3.5,-3.5)
-(3.5,3.5)
-(1.2999999999999998,1.2999999999999998)
-(5.28,5.28)
-(2.3,2.3)
-(-3.5,-3.5)
diff --git a/testsuite/tests/codeGen/should_run/simd003.hs b/testsuite/tests/codeGen/should_run/simd003.hs
deleted file mode 100644 (file)
index de3ae5a..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# OPTIONS_GHC -msse4 #-}
-{-# OPTIONS_GHC -mavx #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- !!! test the packing of floats and doubles into a vector
-
-import GHC.Exts
-
-data FloatX4 = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-main :: IO ()
-main = do
-  print (FX4# (packFloatX4# (# 9.2#, 8.15#, 7.0#, 6.4# #)))
-  print (DX2# (packDoubleX2# (# 7.2##, 9.3## #)))
diff --git a/testsuite/tests/codeGen/should_run/simd003.stdout b/testsuite/tests/codeGen/should_run/simd003.stdout
deleted file mode 100644 (file)
index 230e465..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-(9.2,8.15,7.0,6.4)
-(7.2,9.3)
diff --git a/testsuite/tests/codeGen/should_run/simd004.hs b/testsuite/tests/codeGen/should_run/simd004.hs
deleted file mode 100644 (file)
index 5216822..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-{-# OPTIONS_GHC -O2 #-}
-{-# OPTIONS_GHC -mavx #-}
-{-# OPTIONS_GHC -msse4 #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- !!! test if enabling -O2 produces wrong results while
---     packing , broadcasting, unpacking vectors and for
---     arithmetic operations as well for avx instructions
-
-import GHC.Exts
-
-data FloatX4  = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-
-instance Eq FloatX4 where
-  (FX4# a) == (FX4# b)
-    = case (unpackFloatX4# a) of
-        (# a1, a2, a3, a4 #) ->
-          case (unpackFloatX4# b) of
-            (# b1, b2, b3, b4 #) -> (F# a1) == (F# b1) &&
-                                    (F# a2) == (F# b2) &&
-                                    (F# a3) == (F# b3) &&
-                                    (F# a4) == (F# b4)
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-instance Eq DoubleX2 where
-  (DX2# a) == (DX2# b)
-    = case (unpackDoubleX2# a) of
-        (# a1, a2 #) ->
-          case (unpackDoubleX2# b) of
-            (# b1, b2 #) -> (D# a1) == (D# b1) &&
-                            (D# a2) == (D# b2)
-
-
-main :: IO ()
-main = do
-
-    -- !!! test broadcasting, packing and unpacking for vector types
-    -- FloatX4#
-    case unpackFloatX4# (broadcastFloatX4# 1.5#) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-    case unpackFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-
-    -- DoubleX2#
-    case unpackDoubleX2# (broadcastDoubleX2# 6.5##) of
-        (# a, b #) -> print (D# a, D# b)
-    case unpackDoubleX2# (packDoubleX2# (# 8.9##,7.2## #)) of
-        (# a, b #) -> print (D# a, D# b)
-
-
-    -- !!! test the lifting of unlifted vector types and
-    -- defining various typeclass instances for the lifted types
-
-    print (FX4# (broadcastFloatX4# 1.5#))
-    print $ (FX4# (broadcastFloatX4# 1.5#)) == (FX4# (broadcastFloatX4# 2.5#))
-    print $ (FX4# (broadcastFloatX4# 3.5#)) == (FX4# (broadcastFloatX4# 3.5#))
-
-    print (DX2# (broadcastDoubleX2# 2.5##))
-    print $ (DX2#
-             (broadcastDoubleX2# 1.5##)) == (DX2# (broadcastDoubleX2# 2.5##))
-    print $ (DX2#
-             (broadcastDoubleX2# 3.5##)) == (DX2# (broadcastDoubleX2# 3.5##))
-
-
-    -- !!! test arithmetic vector operations
-    print (FX4# (plusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                              (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (minusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                               (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (timesFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                               (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (divideFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                                (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (negateFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))))
-
-    print (DX2# (plusDoubleX2# (broadcastDoubleX2# 1.3##)
-                               (broadcastDoubleX2# 2.2##)))
-    print (DX2# (minusDoubleX2# (broadcastDoubleX2# 3.5##)
-                                (broadcastDoubleX2# 2.2##)))
-    print (DX2# (timesDoubleX2# (broadcastDoubleX2# 2.4##)
-                                (broadcastDoubleX2# 2.2##)))
-    print (DX2# (divideDoubleX2# (broadcastDoubleX2# 9.2##)
-                                 (broadcastDoubleX2# 4.0##)))
-    print (DX2# (negateDoubleX2# (broadcastDoubleX2# 3.5##)))
diff --git a/testsuite/tests/codeGen/should_run/simd004.stdout b/testsuite/tests/codeGen/should_run/simd004.stdout
deleted file mode 100644 (file)
index ee90e73..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(1.5,1.5,1.5,1.5)
-(4.5,7.8,2.3,6.5)
-(6.5,6.5)
-(8.9,7.2)
-(1.5,1.5,1.5,1.5)
-False
-True
-(2.5,2.5)
-False
-True
-(12.7,14.1,7.0,15.7)
-(-3.6999998,1.5,-2.3999999,-2.6999998)
-(36.899998,49.140003,10.809999,59.8)
-(0.5487805,1.2380953,0.4893617,0.70652175)
-(-4.5,-7.8,-2.3,-6.5)
-(3.5,3.5)
-(1.2999999999999998,1.2999999999999998)
-(5.28,5.28)
-(2.3,2.3)
-(-3.5,-3.5)
\ No newline at end of file
diff --git a/testsuite/tests/codeGen/should_run/simd005.hs b/testsuite/tests/codeGen/should_run/simd005.hs
deleted file mode 100644 (file)
index b074066..0000000
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# OPTIONS_GHC -O2 #-}
-{-# OPTIONS_GHC -msse #-}
-{-# OPTIONS_GHC -msse2 #-}
-{-# OPTIONS_GHC -msse4 #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
--- tests for SSE based vector operations
-
-import GHC.Exts
-
-data FloatX4  = FX4# FloatX4#
-
-instance Show FloatX4 where
-  show (FX4# f) = case (unpackFloatX4# f) of
-    (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d))
-
-
-instance Eq FloatX4 where
-  (FX4# a) == (FX4# b)
-    = case (unpackFloatX4# a) of
-        (# a1, a2, a3, a4 #) ->
-          case (unpackFloatX4# b) of
-            (# b1, b2, b3, b4 #) -> (F# a1) == (F# b1) &&
-                                    (F# a2) == (F# b2) &&
-                                    (F# a3) == (F# b3) &&
-                                    (F# a4) == (F# b4)
-
-data DoubleX2 = DX2# DoubleX2#
-
-instance Show DoubleX2 where
-  show (DX2# d) = case (unpackDoubleX2# d) of
-    (# a, b #) -> show ((D# a), (D# b))
-
-
-instance Eq DoubleX2 where
-  (DX2# a) == (DX2# b)
-    = case (unpackDoubleX2# a) of
-        (# a1, a2 #) ->
-          case (unpackDoubleX2# b) of
-            (# b1, b2 #) -> (D# a1) == (D# b1) &&
-                            (D# a2) == (D# b2)
-
-main :: IO ()
-main = do
-
-    -- !!! test broadcasting, packing and unpacking for vector types
-    -- FloatX4#
-    case unpackFloatX4# (broadcastFloatX4# 1.5#) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-    case unpackFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) of
-        (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d)
-
-    -- DoubleX2#
-    case unpackDoubleX2# (broadcastDoubleX2# 6.5##) of
-        (# a, b #) -> print (D# a, D# b)
-    case unpackDoubleX2# (packDoubleX2# (# 8.9##,7.2## #)) of
-        (# a, b #) -> print (D# a, D# b)
-
-
-    -- !!! test the lifting of unlifted vector types and
-    -- defining various typeclass instances for the lifted types
-
-    print (FX4# (broadcastFloatX4# 1.5#))
-    print $ (FX4# (broadcastFloatX4# 1.5#)) == (FX4# (broadcastFloatX4# 2.5#))
-    print $ (FX4# (broadcastFloatX4# 3.5#)) == (FX4# (broadcastFloatX4# 3.5#))
-
-    print (DX2# (broadcastDoubleX2# 2.5##))
-    print $ (DX2#
-             (broadcastDoubleX2# 1.5##)) == (DX2# (broadcastDoubleX2# 2.5##))
-    print $ (DX2#
-             (broadcastDoubleX2# 3.5##)) == (DX2# (broadcastDoubleX2# 3.5##))
-
-
-    -- !!! test arithmetic vector operations
-    print (FX4# (plusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                              (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (minusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                               (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (timesFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                               (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (divideFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))
-                                (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #))))
-    print (FX4# (negateFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #))))
-
-    print (DX2# (plusDoubleX2# (broadcastDoubleX2# 1.3##)
-                               (broadcastDoubleX2# 2.2##)))
-    print (DX2# (minusDoubleX2# (broadcastDoubleX2# 3.5##)
-                                (broadcastDoubleX2# 2.2##)))
-    print (DX2# (timesDoubleX2# (broadcastDoubleX2# 2.4##)
-                                (broadcastDoubleX2# 2.2##)))
-    print (DX2# (divideDoubleX2# (broadcastDoubleX2# 9.2##)
-                                 (broadcastDoubleX2# 4.0##)))
-    print (DX2# (negateDoubleX2# (broadcastDoubleX2# 3.5##)))
diff --git a/testsuite/tests/codeGen/should_run/simd005.stdout b/testsuite/tests/codeGen/should_run/simd005.stdout
deleted file mode 100644 (file)
index 8438682..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-(1.5,1.5,1.5,1.5)
-(4.5,7.8,2.3,6.5)
-(6.5,6.5)
-(8.9,7.2)
-(1.5,1.5,1.5,1.5)
-False
-True
-(2.5,2.5)
-False
-True
-(12.7,14.1,7.0,15.7)
-(-3.6999998,1.5,-2.3999999,-2.6999998)
-(36.899998,49.140003,10.809999,59.8)
-(0.5487805,1.2380953,0.4893617,0.70652175)
-(-4.5,-7.8,-2.3,-6.5)
-(3.5,3.5)
-(1.2999999999999998,1.2999999999999998)
-(5.28,5.28)
-(2.3,2.3)
-(-3.5,-3.5)