projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Implement SSE2 floating-point support in the x86 native code generator (#594)
[ghc-hetmet.git] / compiler / nativeGen / X86 / Instr.hs
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 6dc229b..f856313 100644 (file)
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -253,10 +253,10 @@ data Instr
        -- use MOV for moving (either movss or movsd (movlpd better?))
        | CVTSS2SD      Reg Reg         -- F32 to F64
        | CVTSD2SS      Reg Reg         -- F64 to F32
-       | CVTTSS2SIQ    Operand Reg     -- F32 to I32/I64 (with truncation)
-       | CVTTSD2SIQ    Operand Reg     -- F64 to I32/I64 (with truncation)
-       | CVTSI2SS      Operand Reg     -- I32/I64 to F32
-       | CVTSI2SD      Operand Reg     -- I32/I64 to F64
+       | CVTTSS2SIQ    Size Operand Reg -- F32 to I32/I64 (with truncation)
+       | CVTTSD2SIQ    Size Operand Reg -- F64 to I32/I64 (with truncation)
+       | CVTSI2SS      Size Operand Reg -- I32/I64 to F32
+       | CVTSI2SD      Size Operand Reg -- I32/I64 to F64
 
        -- use ADD & SUB for arithmetic.  In both cases, operands
        -- are  Operand Reg.
@@ -353,7 +353,6 @@ x86_regUsageOfInstr instr
     CLTD   _           -> mkRU [eax] [edx]
     NOP                        -> mkRU [] []
 
-#if i386_TARGET_ARCH
     GMOV   src dst     -> mkRU [src] [dst]
     GLD    _ src dst   -> mkRU (use_EA src) [dst]
     GST    _ src dst   -> mkRUR (src : use_EA dst)
@@ -379,17 +378,14 @@ x86_regUsageOfInstr instr
     GSIN   _ _ _ src dst -> mkRU [src] [dst]
     GCOS   _ _ _ src dst -> mkRU [src] [dst]
     GTAN   _ _ _ src dst -> mkRU [src] [dst]
-#endif
 
-#if x86_64_TARGET_ARCH
     CVTSS2SD   src dst -> mkRU [src] [dst]
     CVTSD2SS   src dst -> mkRU [src] [dst]
-    CVTTSS2SIQ src dst -> mkRU (use_R src) [dst]
-    CVTTSD2SIQ src dst -> mkRU (use_R src) [dst]
-    CVTSI2SS   src dst -> mkRU (use_R src) [dst]
-    CVTSI2SD   src dst -> mkRU (use_R src) [dst]
+    CVTTSS2SIQ _ src dst -> mkRU (use_R src) [dst]
+    CVTTSD2SIQ _ src dst -> mkRU (use_R src) [dst]
+    CVTSI2SS   _ src dst -> mkRU (use_R src) [dst]
+    CVTSI2SD   _ src dst -> mkRU (use_R src) [dst]
     FDIV _     src dst -> usageRM src dst
-#endif    
 
     FETCHGOT reg        -> mkRU [] [reg]
     FETCHPC  reg        -> mkRU [] [reg]
@@ -483,7 +479,6 @@ x86_patchRegsOfInstr instr env
     JMP op             -> patch1 JMP op
     JMP_TBL op ids      -> patch1 JMP_TBL op $ ids
 
-#if i386_TARGET_ARCH
     GMOV src dst       -> GMOV (env src) (env dst)
     GLD  sz src dst    -> GLD sz (lookupAddr src) (env dst)
     GST  sz src dst    -> GST sz (env src) (lookupAddr dst)
@@ -509,17 +504,14 @@ x86_patchRegsOfInstr instr env
     GSIN sz l1 l2 src dst      -> GSIN sz l1 l2 (env src) (env dst)
     GCOS sz l1 l2 src dst      -> GCOS sz l1 l2 (env src) (env dst)
     GTAN sz l1 l2 src dst      -> GTAN sz l1 l2 (env src) (env dst)
-#endif
 
-#if x86_64_TARGET_ARCH
     CVTSS2SD src dst   -> CVTSS2SD (env src) (env dst)
     CVTSD2SS src dst   -> CVTSD2SS (env src) (env dst)
-    CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst)
-    CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst)
-    CVTSI2SS src dst   -> CVTSI2SS (patchOp src) (env dst)
-    CVTSI2SD src dst   -> CVTSI2SD (patchOp src) (env dst)
+    CVTTSS2SIQ sz src dst -> CVTTSS2SIQ sz (patchOp src) (env dst)
+    CVTTSD2SIQ sz src dst -> CVTTSD2SIQ sz (patchOp src) (env dst)
+    CVTSI2SS sz src dst        -> CVTSI2SS sz (patchOp src) (env dst)
+    CVTSI2SD sz src dst        -> CVTSI2SD sz (patchOp src) (env dst)
     FDIV sz src dst    -> FDIV sz (patchOp src) (patchOp dst)
-#endif    
 
     CALL (Left _)  _   -> instr
     CALL (Right reg) p -> CALL (Right (env reg)) p
@@ -602,30 +594,16 @@ x86_mkSpillInstr
        -> Int          -- spill slot to use
        -> Instr
 
-#if   i386_TARGET_ARCH
-x86_mkSpillInstr reg delta slot
-  = let        off     = spillSlotToOffset slot
-    in
-    let off_w = (off-delta) `div` 4
-    in case targetClassOfReg reg of
-          RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w))
-          _         -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
-
-#elif x86_64_TARGET_ARCH
 x86_mkSpillInstr reg delta slot
   = let        off     = spillSlotToOffset slot
     in
-    let off_w = (off-delta) `div` 8
+    let off_w = (off-delta) `div` IF_ARCH_i386(4,8)
     in case targetClassOfReg reg of
-          RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w))
-          RcDouble  -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
+          RcInteger   -> MOV IF_ARCH_i386(II32,II64)
+                              (OpReg reg) (OpAddr (spRel off_w))
+          RcDouble    -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
+          RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
            _         -> panic "X86.mkSpillInstr: no match"
-               -- ToDo: will it work to always spill as a double?
-               -- does that cause a stall if the data was a float?
-#else
-x86_mkSpillInstr _ _ _
-    =   panic "X86.RegInfo.mkSpillInstr: not defined for this architecture."
-#endif
 
 
 -- | Make a spill reload instruction.
@@ -635,26 +613,16 @@ x86_mkLoadInstr
        -> Int          -- spill slot to use
        -> Instr
 
-#if   i386_TARGET_ARCH
-x86_mkLoadInstr reg delta slot
-  = let off     = spillSlotToOffset slot
-    in
-       let off_w = (off-delta) `div` 4
-        in case targetClassOfReg reg of {
-              RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg);
-              _         -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -}
-#elif x86_64_TARGET_ARCH
 x86_mkLoadInstr reg delta slot
   = let off     = spillSlotToOffset slot
     in
-       let off_w = (off-delta) `div` 8
+       let off_w = (off-delta) `div` IF_ARCH_i386(4,8)
         in case targetClassOfReg reg of
-              RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg)
-              _         -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
-#else
-x86_mkLoadInstr _ _ _
-       = panic "X86.RegInfo.mkLoadInstr: not defined for this architecture."
-#endif
+              RcInteger -> MOV IF_ARCH_i386(II32,II64) 
+                               (OpAddr (spRel off_w)) (OpReg reg)
+              RcDouble  -> GLD FF80 (spRel off_w) reg {- RcFloat/RcDouble -}
+              RcDoubleSSE -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
+              _           -> panic "X86.x86_mkLoadInstr"
 
 spillSlotSize :: Int
 spillSlotSize = IF_ARCH_i386(12, 8)
@@ -715,14 +683,12 @@ x86_mkRegRegMoveInstr src dst
  = case targetClassOfReg src of
 #if   i386_TARGET_ARCH
         RcInteger -> MOV II32 (OpReg src) (OpReg dst)
-        RcDouble  -> GMOV src dst
-       RcFloat   -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
 #else
         RcInteger -> MOV II64 (OpReg src) (OpReg dst)
-        RcDouble  -> MOV FF64 (OpReg src) (OpReg dst)
-       RcFloat   -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
 #endif
-
+        RcDouble    -> GMOV src dst
+        RcDoubleSSE -> MOV FF64 (OpReg src) (OpReg dst)
+       _     -> panic "X86.RegInfo.mkRegRegMoveInstr: no match"
 
 -- | Check whether an instruction represents a reg-reg move.
 --     The register allocator attempts to eliminate reg->reg moves whenever it can,
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)