Implement unboxed sum primitive type
[ghc.git] / compiler / cmm / CmmExpr.hs
index 1d6c97f..784724d 100644 (file)
@@ -6,11 +6,12 @@
 
 module CmmExpr
     ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
+    , CmmArg(..)
     , CmmReg(..), cmmRegType
     , CmmLit(..), cmmLitType
     , LocalReg(..), localRegType
     , GlobalReg(..), isArgReg, globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
-    , VGcPtr(..), vgcFlag       -- Temporary!
+    , VGcPtr(..)
 
     , DefinerOfRegs, UserOfRegs
     , foldRegsDefd, foldRegsUsed, filterRegsUsed
@@ -20,7 +21,6 @@ module CmmExpr
     , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
     , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
     , regSetToList
-    , regUsedIn
 
     , Area(..)
     , module CmmMachOp
@@ -30,13 +30,14 @@ where
 
 #include "HsVersions.h"
 
-import CmmType
-import CmmMachOp
 import BlockId
 import CLabel
+import CmmMachOp
+import CmmType
 import DynFlags
-import Unique
 import Outputable (panic)
+import Type
+import Unique
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -74,6 +75,10 @@ data CmmReg
   | CmmGlobal GlobalReg
   deriving( Eq, Ord )
 
+data CmmArg
+  = CmmExprArg CmmExpr
+  | CmmRubbishArg Type -- See StgRubbishArg in StgSyn.hs
+
 -- | A stack area is either the stack slot where a variable is spilled
 -- or the stack space where function arguments and results are passed.
 data Area
@@ -251,8 +256,11 @@ data LocalReg
 instance Eq LocalReg where
   (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
 
+-- This is non-deterministic but we do not currently support deterministic
+-- code-generation. See Note [Unique Determinism and code generation]
+-- See Note [No Ord for Unique]
 instance Ord LocalReg where
-  compare (LocalReg u1 _) (LocalReg u2 _) = compare u1 u2
+  compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
 
 instance Uniquable LocalReg where
   getUnique (LocalReg uniq _) = uniq
@@ -280,15 +288,15 @@ type RegSet r     = Set r
 type LocalRegSet  = RegSet LocalReg
 type GlobalRegSet = RegSet GlobalReg
 
-emptyRegSet             :: Ord r => RegSet r
-nullRegSet              :: Ord r => RegSet r -> Bool
+emptyRegSet             :: RegSet r
+nullRegSet              :: RegSet r -> Bool
 elemRegSet              :: Ord r => r -> RegSet r -> Bool
 extendRegSet            :: Ord r => RegSet r -> r -> RegSet r
 deleteFromRegSet        :: Ord r => RegSet r -> r -> RegSet r
 mkRegSet                :: Ord r => [r] -> RegSet r
 minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
-sizeRegSet              :: Ord r => RegSet r -> Int
-regSetToList            :: Ord r => RegSet r -> [r]
+sizeRegSet              :: RegSet r -> Int
+regSetToList            :: RegSet r -> [r]
 
 emptyRegSet      = Set.empty
 nullRegSet       = Set.null
@@ -347,7 +355,9 @@ instance Ord r => DefinerOfRegs r r where
 instance Ord r => UserOfRegs r (RegSet r) where
     foldRegsUsed _ f = Set.fold (flip f)
 
-instance UserOfRegs r CmmReg => UserOfRegs r CmmExpr where
+instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
+  -- The (Ord r) in the context is necessary here
+  -- See Note [Recursive superclasses] in TcInstDcls
   foldRegsUsed dflags f z e = expr z e
     where expr z (CmmLit _)          = z
           expr z (CmmLoad addr _)    = foldRegsUsed dflags f z addr
@@ -373,29 +383,38 @@ instance DefinerOfRegs r a => DefinerOfRegs r (Maybe a) where
   foldRegsDefd dflags f set (Just x) = foldRegsDefd dflags f set x
 
 -----------------------------------------------------------------------------
--- Another reg utility
-
-regUsedIn :: CmmReg -> CmmExpr -> Bool
-_   `regUsedIn` CmmLit _         = False
-reg `regUsedIn` CmmLoad e  _     = reg `regUsedIn` e
-reg `regUsedIn` CmmReg reg'      = reg == reg'
-reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
-reg `regUsedIn` CmmMachOp _ es   = any (reg `regUsedIn`) es
-_   `regUsedIn` CmmStackSlot _ _ = False
-
------------------------------------------------------------------------------
 --              Global STG registers
 -----------------------------------------------------------------------------
 
 data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
-        -- TEMPORARY!!!
 
 -----------------------------------------------------------------------------
 --              Global STG registers
 -----------------------------------------------------------------------------
-vgcFlag :: CmmType -> VGcPtr
-vgcFlag ty | isGcPtrType ty = VGcPtr
-           | otherwise      = VNonGcPtr
+{-
+Note [Overlapping global registers]
+
+The backend might not faithfully implement the abstraction of the STG
+machine with independent registers for different values of type
+GlobalReg. Specifically, certain pairs of registers (r1, r2) may
+overlap in the sense that a store to r1 invalidates the value in r2,
+and vice versa.
+
+Currently this occurs only on the x86_64 architecture where FloatReg n
+and DoubleReg n are assigned the same microarchitectural register, in
+order to allow functions to receive more Float# or Double# arguments
+in registers (as opposed to on the stack).
+
+There are no specific rules about which registers might overlap with
+which other registers, but presumably it's safe to assume that nothing
+will overlap with special registers like Sp or BaseReg.
+
+Use CmmUtils.regsOverlap to determine whether two GlobalRegs overlap
+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!
+-}
 
 data GlobalReg
   -- Argument and return registers
@@ -415,10 +434,10 @@ data GlobalReg
   | XmmReg                      -- 128-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
 
-  | YmmReg                      -- 256-bit SIMD vector register 
+  | YmmReg                      -- 256-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
 
-  | ZmmReg                      -- 512-bit SIMD vector register 
+  | ZmmReg                      -- 512-bit SIMD vector register
         {-# UNPACK #-} !Int     -- its number
 
   -- STG registers
@@ -444,6 +463,15 @@ data GlobalReg
   -- (where necessary) in the native code generator.
   | BaseReg
 
+  -- The register used by the platform for the C stack pointer. This is
+  -- a break in the STG abstraction used exclusively to setup stack unwinding
+  -- information.
+  | MachSp
+
+  -- The is a dummy register used to indicate to the stack unwinder where
+  -- a routine would return to.
+  | UnwindReturnReg
+
   -- Base Register for PIC (position-independent code) calculations
   -- Only used inside the native code generator. It's exact meaning differs
   -- from platform to platform (see module PositionIndependentCode).
@@ -471,6 +499,8 @@ instance Eq GlobalReg where
    GCEnter1 == GCEnter1 = True
    GCFun == GCFun = True
    BaseReg == BaseReg = True
+   MachSp == MachSp = True
+   UnwindReturnReg == UnwindReturnReg = True
    PicBaseReg == PicBaseReg = True
    _r1 == _r2 = False
 
@@ -495,6 +525,8 @@ instance Ord GlobalReg where
    compare GCEnter1 GCEnter1 = EQ
    compare GCFun GCFun = EQ
    compare BaseReg BaseReg = EQ
+   compare MachSp MachSp = EQ
+   compare UnwindReturnReg UnwindReturnReg = EQ
    compare PicBaseReg PicBaseReg = EQ
    compare (VanillaReg _ _) _ = LT
    compare _ (VanillaReg _ _) = GT
@@ -532,6 +564,10 @@ instance Ord GlobalReg where
    compare _ GCFun = GT
    compare BaseReg _ = LT
    compare _ BaseReg = GT
+   compare MachSp _ = LT
+   compare _ MachSp = GT
+   compare UnwindReturnReg _ = LT
+   compare _ UnwindReturnReg = GT
    compare EagerBlackholeInfo _ = LT
    compare _ EagerBlackholeInfo = GT