Implement unboxed sum primitive type
[ghc.git] / compiler / cmm / CmmExpr.hs
index e57c6ec..784724d 100644 (file)
@@ -1,23 +1,27 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module CmmExpr
     ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
+    , CmmArg(..)
     , CmmReg(..), cmmRegType
     , CmmLit(..), cmmLitType
     , LocalReg(..), localRegType
-    , GlobalReg(..), globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
-    , VGcPtr(..), vgcFlag      -- Temporary!
-    , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
-    , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
-            , regSetToList
-    , regUsedIn
+    , GlobalReg(..), isArgReg, globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
+    , VGcPtr(..)
+
+    , DefinerOfRegs, UserOfRegs
+    , foldRegsDefd, foldRegsUsed, filterRegsUsed
+    , foldLocalRegsDefd, foldLocalRegsUsed
+
+    , RegSet, LocalRegSet, GlobalRegSet
+    , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
+    , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
+    , regSetToList
+
     , Area(..)
     , module CmmMachOp
     , module CmmType
@@ -26,17 +30,20 @@ where
 
 #include "HsVersions.h"
 
-import CmmType
-import CmmMachOp
 import BlockId
 import CLabel
+import CmmMachOp
+import CmmType
+import DynFlags
+import Outputable (panic)
+import Type
 import Unique
 
 import Data.Set (Set)
 import qualified Data.Set as Set
 
 -----------------------------------------------------------------------------
---             CmmExpr
+--              CmmExpr
 -- An expression.  Expressions have no side effects.
 -----------------------------------------------------------------------------
 
@@ -47,26 +54,31 @@ data CmmExpr
   | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
   | CmmStackSlot Area {-# UNPACK #-} !Int
                                 -- addressing expression of a stack slot
+                                -- See Note [CmmStackSlot aliasing]
   | CmmRegOff !CmmReg Int
-       -- CmmRegOff reg i
-       --        ** is shorthand only, meaning **
-       -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
-       --      where rep = typeWidth (cmmRegType reg)
-
-instance Eq CmmExpr where      -- Equality ignores the types
-  CmmLit l1                == CmmLit l2         = l1==l2
-  CmmLoad e1 _             == CmmLoad e2 _      = e1==e2
-  CmmReg r1                == CmmReg r2         = r1==r2
-  CmmRegOff r1 i1   == CmmRegOff r2 i2   = r1==r2 && i1==i2
-  CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2
+        -- CmmRegOff reg i
+        --        ** is shorthand only, meaning **
+        -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]
+        --      where rep = typeWidth (cmmRegType reg)
+
+instance Eq CmmExpr where       -- Equality ignores the types
+  CmmLit l1          == CmmLit l2          = l1==l2
+  CmmLoad e1 _       == CmmLoad e2 _       = e1==e2
+  CmmReg r1          == CmmReg r2          = r1==r2
+  CmmRegOff r1 i1    == CmmRegOff r2 i2    = r1==r2 && i1==i2
+  CmmMachOp op1 es1  == CmmMachOp op2 es2  = op1==op2 && es1==es2
   CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
-  _e1               == _e2               = False
+  _e1                == _e2                = False
 
 data CmmReg
   = CmmLocal  {-# UNPACK #-} !LocalReg
   | 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
@@ -75,14 +87,14 @@ data Area
                    -- See Note [Continuation BlockId] in CmmNode.
   deriving (Eq, Ord)
 
-{- Note [Old Area] 
+{- Note [Old Area]
 ~~~~~~~~~~~~~~~~~~
 There is a single call area 'Old', allocated at the extreme old
 end of the stack frame (ie just younger than the return address)
 which holds:
-  * incoming (overflow) parameters, 
+  * incoming (overflow) parameters,
   * outgoing (overflow) parameter to tail calls,
-  * outgoing (overflow) result values 
+  * outgoing (overflow) result values
   * the update frame (if any)
 
 Its size is the max of all these requirements.  On entry, the stack
@@ -91,58 +103,137 @@ necessarily at the young end of the Old area.
 
 End of note -}
 
+
+{- Note [CmmStackSlot aliasing]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When do two CmmStackSlots alias?
+
+ - T[old+N] aliases with U[young(L)+M] for all T, U, L, N and M
+ - T[old+N] aliases with U[old+M] only if the areas actually overlap
+
+Or more informally, different Areas may overlap with each other.
+
+An alternative semantics, that we previously had, was that different
+Areas do not overlap.  The problem that lead to redefining the
+semantics of stack areas is described below.
+
+e.g. if we had
+
+    x = Sp[old + 8]
+    y = Sp[old + 16]
+
+    Sp[young(L) + 8]  = L
+    Sp[young(L) + 16] = y
+    Sp[young(L) + 24] = x
+    call f() returns to L
+
+if areas semantically do not overlap, then we might optimise this to
+
+    Sp[young(L) + 8]  = L
+    Sp[young(L) + 16] = Sp[old + 8]
+    Sp[young(L) + 24] = Sp[old + 16]
+    call f() returns to L
+
+and now young(L) cannot be allocated at the same place as old, and we
+are doomed to use more stack.
+
+  - old+8  conflicts with young(L)+8
+  - old+16 conflicts with young(L)+16 and young(L)+8
+
+so young(L)+8 == old+24 and we get
+
+    Sp[-8]  = L
+    Sp[-16] = Sp[8]
+    Sp[-24] = Sp[0]
+    Sp -= 24
+    call f() returns to L
+
+However, if areas are defined to be "possibly overlapping" in the
+semantics, then we cannot commute any loads/stores of old with
+young(L), and we will be able to re-use both old+8 and old+16 for
+young(L).
+
+    x = Sp[8]
+    y = Sp[0]
+
+    Sp[8] = L
+    Sp[0] = y
+    Sp[-8] = x
+    Sp = Sp - 8
+    call f() returns to L
+
+Now, the assignments of y go away,
+
+    x = Sp[8]
+    Sp[8] = L
+    Sp[-8] = x
+    Sp = Sp - 8
+    call f() returns to L
+-}
+
 data CmmLit
   = CmmInt !Integer  Width
-       -- Interpretation: the 2's complement representation of the value
-       -- is truncated to the specified size.  This is easier than trying
-       -- to keep the value within range, because we don't know whether
-       -- it will be used as a signed or unsigned value (the CmmType doesn't
-       -- distinguish between signed & unsigned).
+        -- Interpretation: the 2's complement representation of the value
+        -- is truncated to the specified size.  This is easier than trying
+        -- to keep the value within range, because we don't know whether
+        -- it will be used as a signed or unsigned value (the CmmType doesn't
+        -- distinguish between signed & unsigned).
   | CmmFloat  Rational Width
-  | CmmLabel    CLabel                 -- Address of label
-  | CmmLabelOff CLabel Int             -- Address of label + byte offset
-  
+  | CmmVec [CmmLit]                     -- Vector literal
+  | CmmLabel    CLabel                  -- Address of label
+  | CmmLabelOff CLabel Int              -- Address of label + byte offset
+
         -- Due to limitations in the C backend, the following
         -- MUST ONLY be used inside the info table indicated by label2
         -- (label2 must be the info label), and label1 must be an
         -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
         -- Don't use it at all unless tablesNextToCode.
         -- It is also used inside the NCG during when generating
-        -- position-independent code. 
+        -- position-independent code.
   | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
 
   | CmmBlock {-# UNPACK #-} !BlockId     -- Code label
         -- Invariant: must be a continuation BlockId
         -- See Note [Continuation BlockId] in CmmNode.
 
-  | CmmHighStackMark -- stands for the max stack space used during a procedure
+  | CmmHighStackMark -- A late-bound constant that stands for the max
+                     -- #bytes of stack space used during a procedure.
+                     -- During the stack-layout pass, CmmHighStackMark
+                     -- is replaced by a CmmInt for the actual number
+                     -- of bytes used
   deriving Eq
 
-cmmExprType :: CmmExpr -> CmmType
-cmmExprType (CmmLit lit)       = cmmLitType lit
-cmmExprType (CmmLoad _ rep)    = rep
-cmmExprType (CmmReg reg)       = cmmRegType reg
-cmmExprType (CmmMachOp op args) = machOpResultType op (map cmmExprType args)
-cmmExprType (CmmRegOff reg _)   = cmmRegType reg
-cmmExprType (CmmStackSlot _ _)  = bWord -- an address
+cmmExprType :: DynFlags -> CmmExpr -> CmmType
+cmmExprType dflags (CmmLit lit)        = cmmLitType dflags lit
+cmmExprType _      (CmmLoad _ rep)     = rep
+cmmExprType dflags (CmmReg reg)        = cmmRegType dflags reg
+cmmExprType dflags (CmmMachOp op args) = machOpResultType dflags op (map (cmmExprType dflags) args)
+cmmExprType dflags (CmmRegOff reg _)   = cmmRegType dflags reg
+cmmExprType dflags (CmmStackSlot _ _)  = bWord dflags -- an address
 -- Careful though: what is stored at the stack slot may be bigger than
 -- an address
 
-cmmLitType :: CmmLit -> CmmType
-cmmLitType (CmmInt _ width)     = cmmBits  width
-cmmLitType (CmmFloat _ width)   = cmmFloat width
-cmmLitType (CmmLabel lbl)      = cmmLabelType lbl
-cmmLitType (CmmLabelOff lbl _)  = cmmLabelType lbl
-cmmLitType (CmmLabelDiffOff {}) = bWord
-cmmLitType (CmmBlock _)        = bWord
-cmmLitType (CmmHighStackMark)   = bWord
-
-cmmLabelType :: CLabel -> CmmType
-cmmLabelType lbl | isGcPtrLabel lbl = gcWord
-                | otherwise        = bWord
-
-cmmExprWidth :: CmmExpr -> Width
-cmmExprWidth e = typeWidth (cmmExprType e)
+cmmLitType :: DynFlags -> CmmLit -> CmmType
+cmmLitType _      (CmmInt _ width)     = cmmBits  width
+cmmLitType _      (CmmFloat _ width)   = cmmFloat width
+cmmLitType _      (CmmVec [])          = panic "cmmLitType: CmmVec []"
+cmmLitType cflags (CmmVec (l:ls))      = let ty = cmmLitType cflags l
+                                         in if all (`cmmEqType` ty) (map (cmmLitType cflags) ls)
+                                            then cmmVec (1+length ls) ty
+                                            else panic "cmmLitType: CmmVec"
+cmmLitType dflags (CmmLabel lbl)       = cmmLabelType dflags lbl
+cmmLitType dflags (CmmLabelOff lbl _)  = cmmLabelType dflags lbl
+cmmLitType dflags (CmmLabelDiffOff {}) = bWord dflags
+cmmLitType dflags (CmmBlock _)         = bWord dflags
+cmmLitType dflags (CmmHighStackMark)   = bWord dflags
+
+cmmLabelType :: DynFlags -> CLabel -> CmmType
+cmmLabelType dflags lbl
+ | isGcPtrLabel lbl = gcWord dflags
+ | otherwise        = bWord dflags
+
+cmmExprWidth :: DynFlags -> CmmExpr -> Width
+cmmExprWidth dflags e = typeWidth (cmmExprType dflags e)
 
 --------
 --- Negation for conditional branches
@@ -153,7 +244,7 @@ maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
 maybeInvertCmmExpr _ = Nothing
 
 -----------------------------------------------------------------------------
---             Local registers
+--              Local registers
 -----------------------------------------------------------------------------
 
 data LocalReg
@@ -165,24 +256,27 @@ 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
 
-cmmRegType :: CmmReg -> CmmType
-cmmRegType (CmmLocal  reg)     = localRegType reg
-cmmRegType (CmmGlobal reg)     = globalRegType reg
+cmmRegType :: DynFlags -> CmmReg -> CmmType
+cmmRegType _      (CmmLocal  reg) = localRegType reg
+cmmRegType dflags (CmmGlobal reg) = globalRegType dflags reg
 
 localRegType :: LocalReg -> CmmType
 localRegType (LocalReg _ rep) = rep
 
 -----------------------------------------------------------------------------
---    Register-use information for expressions and other types 
+--    Register-use information for expressions and other types
 -----------------------------------------------------------------------------
 
--- | Sets of local registers
+-- | Sets of registers
 
 -- These are used for dataflow facts, and a common operation is taking
 -- the union of two RegSets and then asking whether the union is the
@@ -190,16 +284,19 @@ localRegType (LocalReg _ rep) = rep
 -- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
 -- Sets.
 
-type RegSet              =  Set LocalReg
-emptyRegSet             :: RegSet
-nullRegSet              :: RegSet -> Bool
-elemRegSet              :: LocalReg -> RegSet -> Bool
-extendRegSet            :: RegSet -> LocalReg -> RegSet
-deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
-mkRegSet                :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
-sizeRegSet              :: RegSet -> Int
-regSetToList            :: RegSet -> [LocalReg]
+type RegSet r     = Set r
+type LocalRegSet  = RegSet LocalReg
+type GlobalRegSet = RegSet GlobalReg
+
+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              :: RegSet r -> Int
+regSetToList            :: RegSet r -> [r]
 
 emptyRegSet      = Set.empty
 nullRegSet       = Set.null
@@ -213,115 +310,152 @@ timesRegSet      = Set.intersection
 sizeRegSet       = Set.size
 regSetToList     = Set.toList
 
-class UserOfLocalRegs a where
-  foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
+class Ord r => UserOfRegs r a where
+  foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
 
-class DefinerOfLocalRegs a where
-  foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsUsed :: UserOfRegs LocalReg a
+                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsUsed = foldRegsUsed
 
-filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
-filterRegsUsed p e =
-    foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+class Ord r => DefinerOfRegs r a where
+  foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b
+
+foldLocalRegsDefd :: DefinerOfRegs LocalReg a
+                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsDefd = foldRegsDefd
+
+filterRegsUsed :: UserOfRegs r e => DynFlags -> (r -> Bool) -> e -> RegSet r
+filterRegsUsed dflags p e =
+    foldRegsUsed dflags
+                 (\regs r -> if p r then extendRegSet regs r else regs)
                  emptyRegSet e
 
-instance UserOfLocalRegs a => UserOfLocalRegs (Maybe a) where
-    foldRegsUsed f z (Just x) = foldRegsUsed f z x
-    foldRegsUsed _ z Nothing = z
+instance UserOfRegs LocalReg CmmReg where
+    foldRegsUsed _ f z (CmmLocal reg) = f z reg
+    foldRegsUsed _ _ z (CmmGlobal _)  = z
+
+instance DefinerOfRegs LocalReg CmmReg where
+    foldRegsDefd _ f z (CmmLocal reg) = f z reg
+    foldRegsDefd _ _ z (CmmGlobal _)  = z
 
-instance UserOfLocalRegs CmmReg where
-    foldRegsUsed f z (CmmLocal reg) = f z reg
-    foldRegsUsed _ z (CmmGlobal _)  = z
+instance UserOfRegs GlobalReg CmmReg where
+    foldRegsUsed _ _ z (CmmLocal _)    = z
+    foldRegsUsed _ f z (CmmGlobal reg) = f z reg
 
-instance DefinerOfLocalRegs CmmReg where
-    foldRegsDefd f z (CmmLocal reg) = f z reg
-    foldRegsDefd _ z (CmmGlobal _)  = z
+instance DefinerOfRegs GlobalReg CmmReg where
+    foldRegsDefd _ _ z (CmmLocal _)    = z
+    foldRegsDefd _ f z (CmmGlobal reg) = f z reg
 
-instance UserOfLocalRegs LocalReg where
-    foldRegsUsed f z r = f z r
+instance Ord r => UserOfRegs r r where
+    foldRegsUsed f z r = f z r
 
-instance DefinerOfLocalRegs LocalReg where
-    foldRegsDefd f z r = f z r
+instance Ord r => DefinerOfRegs r r where
+    foldRegsDefd f z r = f z r
 
-instance UserOfLocalRegs RegSet where
-    foldRegsUsed f = Set.fold (flip f)
+instance Ord r => UserOfRegs r (RegSet r) where
+    foldRegsUsed f = Set.fold (flip f)
 
-instance UserOfLocalRegs CmmExpr where
-  foldRegsUsed f z e = expr z e
+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 f z addr
-          expr z (CmmReg r)          = foldRegsUsed f z r
-          expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
-          expr z (CmmRegOff r _)     = foldRegsUsed f z r
+          expr z (CmmLoad addr _)    = foldRegsUsed dflags f z addr
+          expr z (CmmReg r)          = foldRegsUsed dflags f z r
+          expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
+          expr z (CmmRegOff r _)     = foldRegsUsed dflags f z r
           expr z (CmmStackSlot _ _)  = z
 
-instance UserOfLocalRegs a => UserOfLocalRegs [a] where
-  foldRegsUsed _ set [] = set
-  foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
+instance UserOfRegs r a => UserOfRegs r (Maybe a) where
+    foldRegsUsed dflags f z (Just x) = foldRegsUsed dflags f z x
+    foldRegsUsed _      _ z Nothing = z
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
-  foldRegsDefd _ set [] = set
-  foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
+instance UserOfRegs r a => UserOfRegs r [a] where
+  foldRegsUsed _      _ set [] = set
+  foldRegsUsed dflags f set (x:xs) = foldRegsUsed dflags f (foldRegsUsed dflags f set x) xs
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
-  foldRegsDefd _ set Nothing  = set
-  foldRegsDefd f set (Just x) = foldRegsDefd f set x
-
------------------------------------------------------------------------------
--- Another reg utility
+instance DefinerOfRegs r a => DefinerOfRegs r [a] where
+  foldRegsDefd _      _ set [] = set
+  foldRegsDefd dflags f set (x:xs) = foldRegsDefd dflags f (foldRegsDefd dflags f set x) xs
 
-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
+instance DefinerOfRegs r a => DefinerOfRegs r (Maybe a) where
+  foldRegsDefd _      _ set Nothing  = set
+  foldRegsDefd dflags f set (Just x) = foldRegsDefd dflags f set x
 
 -----------------------------------------------------------------------------
---             Global STG registers
+--              Global STG registers
 -----------------------------------------------------------------------------
 
 data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
-       -- TEMPORARY!!!
 
 -----------------------------------------------------------------------------
---             Global STG registers
+--              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
-  = VanillaReg                 -- pointers, unboxed ints and chars
-       {-# UNPACK #-} !Int     -- its number
-       VGcPtr
+  = VanillaReg                  -- pointers, unboxed ints and chars
+        {-# UNPACK #-} !Int     -- its number
+        VGcPtr
 
-  | FloatReg           -- single-precision floating-point registers
-       {-# UNPACK #-} !Int     -- its number
+  | FloatReg            -- single-precision floating-point registers
+        {-# UNPACK #-} !Int     -- its number
 
-  | DoubleReg          -- double-precision floating-point registers
-       {-# UNPACK #-} !Int     -- its number
+  | DoubleReg           -- double-precision floating-point registers
+        {-# UNPACK #-} !Int     -- its number
 
-  | LongReg            -- long int registers (64-bit, really)
-       {-# UNPACK #-} !Int     -- its number
+  | LongReg             -- long int registers (64-bit, really)
+        {-# UNPACK #-} !Int     -- its number
+
+  | XmmReg                      -- 128-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
+
+  | YmmReg                      -- 256-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
+
+  | ZmmReg                      -- 512-bit SIMD vector register
+        {-# UNPACK #-} !Int     -- its number
 
   -- STG registers
-  | Sp                 -- Stack ptr; points to last occupied stack location.
-  | SpLim              -- Stack limit
-  | Hp                 -- Heap ptr; points to last occupied heap location.
-  | HpLim              -- Heap limit register
+  | Sp                  -- Stack ptr; points to last occupied stack location.
+  | SpLim               -- Stack limit
+  | Hp                  -- Heap ptr; points to last occupied heap location.
+  | HpLim               -- Heap limit register
   | CCCS                -- Current cost-centre stack
   | CurrentTSO          -- pointer to current thread's TSO
-  | CurrentNursery     -- pointer to allocation area
-  | HpAlloc            -- allocation count for heap check failure
+  | CurrentNursery      -- pointer to allocation area
+  | HpAlloc             -- allocation count for heap check failure
 
-               -- We keep the address of some commonly-called 
-               -- functions in the register table, to keep code
-               -- size down:
+                -- We keep the address of some commonly-called
+                -- functions in the register table, to keep code
+                -- size down:
   | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info
-  | GCEnter1           -- stg_gc_enter_1
-  | GCFun              -- stg_gc_fun
+  | GCEnter1            -- stg_gc_enter_1
+  | GCFun               -- stg_gc_fun
 
   -- Base offset for the register table, used for accessing registers
   -- which do not have real registers assigned to them.  This register
@@ -329,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).
@@ -337,10 +480,13 @@ data GlobalReg
   deriving( Show )
 
 instance Eq GlobalReg where
-   VanillaReg i _ == VanillaReg j _ = i==j     -- Ignore type when seeking clashes
+   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 == 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
@@ -353,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
 
@@ -362,6 +510,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)    (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
@@ -374,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
@@ -383,6 +536,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 Sp _ = LT
    compare _ Sp = GT
    compare SpLim _ = LT
@@ -405,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
 
@@ -419,12 +582,27 @@ nodeReg = CmmGlobal node
 node :: GlobalReg
 node = VanillaReg 1 VGcPtr
 
-globalRegType :: GlobalReg -> CmmType
-globalRegType (VanillaReg _ VGcPtr)    = gcWord
-globalRegType (VanillaReg _ VNonGcPtr) = bWord
-globalRegType (FloatReg _)     = cmmFloat W32
-globalRegType (DoubleReg _)    = cmmFloat W64
-globalRegType (LongReg _)      = cmmBits W64
-globalRegType Hp               = gcWord        -- The initialiser for all 
-                                               -- dynamically allocated closures
-globalRegType _                        = bWord
+globalRegType :: DynFlags -> GlobalReg -> CmmType
+globalRegType dflags (VanillaReg _ VGcPtr)    = gcWord dflags
+globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
+globalRegType _      (FloatReg _)      = cmmFloat W32
+globalRegType _      (DoubleReg _)     = cmmFloat W64
+globalRegType _      (LongReg _)       = cmmBits W64
+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
+                                            -- dynamically allocated closures
+globalRegType dflags _                 = bWord dflags
+
+isArgReg :: GlobalReg -> Bool
+isArgReg (VanillaReg {}) = True
+isArgReg (FloatReg {})   = True
+isArgReg (DoubleReg {})  = True
+isArgReg (LongReg {})    = True
+isArgReg (XmmReg {})     = True
+isArgReg (YmmReg {})     = True
+isArgReg (ZmmReg {})     = True
+isArgReg _               = False