Implement unboxed sum primitive type
[ghc.git] / compiler / cmm / CmmExpr.hs
index e1a78a7..784724d 100644 (file)
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module CmmExpr
-    ( CmmType  -- Abstract 
-    , b8, b16, b32, b64, f32, f64, bWord, bHalfWord, gcWord
-    , cInt, cLong
-    , cmmBits, cmmFloat
-    , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
-    , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
-    , Width(..)
-    , widthInBits, widthInBytes, widthInLog, widthFromBytes
-    , wordWidth, halfWordWidth, cIntWidth, cLongWidth
-    , narrowU, narrowS
-    , CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
+    ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
+    , CmmArg(..)
     , CmmReg(..), cmmRegType
     , CmmLit(..), cmmLitType
     , LocalReg(..), localRegType
-    , GlobalReg(..), globalRegType, spReg, hpReg, spLimReg, nodeReg, node
-    , VGcPtr(..), vgcFlag      -- Temporary!
-    , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
-    , DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
-    , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet, timesRegSet
-    , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
-   -- MachOp
-    , MachOp(..) 
-    , pprMachOp, isCommutableMachOp, isAssociativeMachOp
-    , isComparisonMachOp, machOpResultType
-    , machOpArgReps, maybeInvertComparison
-   -- MachOp builders
-    , mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
-    , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
-    , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe 
-    , mo_wordULe, mo_wordUGt, mo_wordULt
-    , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
-    , mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
-    , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
-    , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32
-   )
+    , 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
+    )
 where
 
 #include "HsVersions.h"
 
 import BlockId
 import CLabel
-import Constants
-import FastString
-import FiniteMap
-import Outputable
+import CmmMachOp
+import CmmType
+import DynFlags
+import Outputable (panic)
+import Type
 import Unique
-import UniqSet
 
-import Data.Word
-import Data.Int
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 -----------------------------------------------------------------------------
---             CmmExpr
+--              CmmExpr
 -- An expression.  Expressions have no side effects.
 -----------------------------------------------------------------------------
 
 data CmmExpr
   = CmmLit CmmLit               -- Literal
-  | CmmLoad CmmExpr CmmType     -- Read memory location
-  | CmmReg CmmReg              -- Contents of register
+  | CmmLoad !CmmExpr !CmmType   -- Read memory location
+  | CmmReg !CmmReg              -- Contents of register
   | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
-  | CmmStackSlot Area Int       -- addressing expression of a stack slot
-  | CmmRegOff CmmReg Int       
-       -- CmmRegOff reg i
-       --        ** is shorthand only, meaning **
-       -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-       --      where rep = 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 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
   CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
-  _e1               == _e2               = False
+  _e1                == _e2                = False
 
-data CmmReg 
-  = CmmLocal  LocalReg
+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
-  = RegSlot  LocalReg
-  | CallArea AreaId
-  deriving (Eq, Ord)
-
-data AreaId
   = Old            -- See Note [Old Area]
-  | Young BlockId
+  | Young {-# UNPACK #-} !BlockId  -- Invariant: must be a continuation BlockId
+                   -- 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
@@ -115,56 +103,137 @@ necessarily at the young end of the Old area.
 
 End of note -}
 
-type SubArea    = (Area, Int, Int) -- area, offset, width
-type SubAreaSet = FiniteMap Area [SubArea]
-type AreaMap    = FiniteMap Area Int
+
+{- 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).
+  = 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).
   | 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 BlockId                   -- Code label
-  | CmmHighStackMark -- stands for the max stack space used during a procedure
+
+  | CmmBlock {-# UNPACK #-} !BlockId     -- Code label
+        -- Invariant: must be a continuation BlockId
+        -- See Note [Continuation BlockId] in CmmNode.
+
+  | 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
-
-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)
+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 :: 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
@@ -175,11 +244,11 @@ maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
 maybeInvertCmmExpr _ = Nothing
 
 -----------------------------------------------------------------------------
---             Local registers
+--              Local registers
 -----------------------------------------------------------------------------
 
 data LocalReg
-  = LocalReg !Unique CmmType
+  = LocalReg {-# UNPACK #-} !Unique CmmType
     -- ^ Parameters:
     --   1. Identifier
     --   2. Type
@@ -187,169 +256,206 @@ 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
-type RegSet              =  UniqSet LocalReg
-emptyRegSet             :: RegSet
-elemRegSet              :: LocalReg -> RegSet -> Bool
-extendRegSet            :: RegSet -> LocalReg -> RegSet
-deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
-mkRegSet                :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
-
-emptyRegSet      = emptyUniqSet
-elemRegSet       = elementOfUniqSet
-extendRegSet     = addOneToUniqSet
-deleteFromRegSet = delOneFromUniqSet
-mkRegSet         = mkUniqSet
-minusRegSet      = minusUniqSet
-plusRegSet       = unionUniqSets
-timesRegSet      = intersectUniqSets
-
-class UserOfLocalRegs a where
-  foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
-
-class DefinerOfLocalRegs a where
-  foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
-
-filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
-filterRegsUsed p e =
-    foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+-- | 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
+-- same as one of the inputs.  UniqSet isn't good here, because
+-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
+-- Sets.
+
+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
+elemRegSet       = Set.member
+extendRegSet     = flip Set.insert
+deleteFromRegSet = flip Set.delete
+mkRegSet         = Set.fromList
+minusRegSet      = Set.difference
+plusRegSet       = Set.union
+timesRegSet      = Set.intersection
+sizeRegSet       = Set.size
+regSetToList     = Set.toList
+
+class Ord r => UserOfRegs r a where
+  foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
+
+foldLocalRegsUsed :: UserOfRegs LocalReg a
+                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsUsed = foldRegsUsed
+
+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 CmmReg where
-    foldRegsUsed f z (CmmLocal reg) = f z reg
-    foldRegsUsed _ z (CmmGlobal _)  = z
-
-instance DefinerOfLocalRegs CmmReg where
-    foldRegsDefd f z (CmmLocal reg) = f z reg
-    foldRegsDefd _ z (CmmGlobal _)  = z
-
-instance UserOfLocalRegs LocalReg where
-    foldRegsUsed f z r = f z r
+instance UserOfRegs LocalReg CmmReg where
+    foldRegsUsed _ f z (CmmLocal reg) = f z reg
+    foldRegsUsed _ _ z (CmmGlobal _)  = z
 
-instance DefinerOfLocalRegs LocalReg where
-    foldRegsDefd f z r = f z r
+instance DefinerOfRegs LocalReg CmmReg where
+    foldRegsDefd _ f z (CmmLocal reg) = f z reg
+    foldRegsDefd _ _ z (CmmGlobal _)  = z
 
-instance UserOfLocalRegs RegSet where
-    foldRegsUsed f = foldUniqSet (flip f)
+instance UserOfRegs GlobalReg CmmReg where
+    foldRegsUsed _ _ z (CmmLocal _)    = z
+    foldRegsUsed _ f z (CmmGlobal reg) = f z reg
 
-instance UserOfLocalRegs CmmExpr where
-  foldRegsUsed 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 (CmmStackSlot _ _)  = z
+instance DefinerOfRegs GlobalReg CmmReg where
+    foldRegsDefd _ _ z (CmmLocal _)    = z
+    foldRegsDefd _ f z (CmmGlobal reg) = f z reg
 
-instance UserOfLocalRegs a => UserOfLocalRegs [a] where
-  foldRegsUsed _ set [] = set
-  foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
+instance Ord r => UserOfRegs r r where
+    foldRegsUsed _ f z r = f z r
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
-  foldRegsDefd _ set [] = set
-  foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
-
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
-  foldRegsDefd _ set Nothing  = set
-  foldRegsDefd f set (Just x) = foldRegsDefd f set x
-
-
------------------------------------------------------------------------------
---    Stack slots
------------------------------------------------------------------------------
-
-isStackSlotOf :: CmmExpr -> LocalReg -> Bool
-isStackSlotOf (CmmStackSlot (RegSlot r) _) r' = r == r'
-isStackSlotOf _ _ = False
-
------------------------------------------------------------------------------
---    Stack slot use information for expressions and other types [_$_]
------------------------------------------------------------------------------
+instance Ord r => DefinerOfRegs r r where
+    foldRegsDefd _ f z r = f z r
 
--- Fold over the area, the offset into the area, and the width of the subarea.
-class UserOfSlots a where
-  foldSlotsUsed :: (b -> SubArea -> b) -> b -> a -> b
+instance Ord r => UserOfRegs r (RegSet r) where
+    foldRegsUsed _ f = Set.fold (flip f)
 
-class DefinerOfSlots a where
-  foldSlotsDefd :: (b -> SubArea -> b) -> b -> a -> b
-
-instance UserOfSlots CmmExpr where
-  foldSlotsUsed 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 (CmmStackSlot a i) ty) = f z (a, i, widthInBytes $ typeWidth ty)
-          expr z (CmmLoad addr _)    = foldSlotsUsed f z addr
-          expr z (CmmReg _)          = z
-          expr z (CmmMachOp _ exprs) = foldSlotsUsed f z exprs
-          expr z (CmmRegOff _ _)     = z
+          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 UserOfSlots a => UserOfSlots [a] where
-  foldSlotsUsed _ set [] = set
-  foldSlotsUsed f set (x:xs) = foldSlotsUsed f (foldSlotsUsed 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 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 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
 
+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
-  | CurrentTSO         -- pointer to current thread's TSO
-  | 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:
+  | 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
+
+                -- 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
@@ -357,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).
@@ -365,20 +480,27 @@ 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
    HpLim == HpLim = True
+   CCCS == CCCS = True
    CurrentTSO == CurrentTSO = True
    CurrentNursery == CurrentNursery = True
    HpAlloc == HpAlloc = True
+   EagerBlackholeInfo == EagerBlackholeInfo = True
    GCEnter1 == GCEnter1 = True
    GCFun == GCFun = True
    BaseReg == BaseReg = True
+   MachSp == MachSp = True
+   UnwindReturnReg == UnwindReturnReg = True
    PicBaseReg == PicBaseReg = True
    _r1 == _r2 = False
 
@@ -388,10 +510,14 @@ 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
    compare HpLim HpLim = EQ
+   compare CCCS CCCS = EQ
    compare CurrentTSO CurrentTSO = EQ
    compare CurrentNursery CurrentNursery = EQ
    compare HpAlloc HpAlloc = EQ
@@ -399,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
@@ -408,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
@@ -416,6 +550,8 @@ instance Ord GlobalReg where
    compare _ Hp = GT
    compare HpLim _ = LT
    compare _ HpLim = GT
+   compare CCCS _ = LT
+   compare _ CCCS = GT
    compare CurrentTSO _ = LT
    compare _ CurrentTSO = GT
    compare CurrentNursery _ = LT
@@ -428,11 +564,16 @@ 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
 
 -- convenient aliases
-spReg, hpReg, spLimReg, nodeReg :: CmmReg
+baseReg, spReg, hpReg, spLimReg, nodeReg :: CmmReg
+baseReg = CmmGlobal BaseReg
 spReg = CmmGlobal Sp
 hpReg = CmmGlobal Hp
 spLimReg = CmmGlobal SpLim
@@ -441,704 +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
-
-
------------------------------------------------------------------------------
---             CmmType
------------------------------------------------------------------------------
-
-  -- NOTE: CmmType is an abstract type, not exported from this
-  --      module so you can easily change its representation
-  --
-  -- However Width is exported in a concrete way, 
-  -- and is used extensively in pattern-matching
-
-data CmmType   -- The important one!
-  = CmmType CmmCat Width 
-
-data CmmCat    -- "Category" (not exported)
-   = GcPtrCat  -- GC pointer
-   | BitsCat   -- Non-pointer
-   | FloatCat  -- Float
-   deriving( Eq )
-       -- See Note [Signed vs unsigned] at the end
-
-instance Outputable CmmType where
-  ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)
-
-instance Outputable CmmCat where
-  ppr FloatCat = ptext $ sLit("F")
-  ppr _        = ptext $ sLit("I")
--- Temp Jan 08
---  ppr FloatCat       = ptext $ sLit("float")
---  ppr BitsCat   = ptext $ sLit("bits")
---  ppr GcPtrCat  = ptext $ sLit("gcptr")
-
--- Why is CmmType stratified?  For native code generation, 
--- most of the time you just want to know what sort of register
--- to put the thing in, and for this you need to know how
--- many bits thing has and whether it goes in a floating-point
--- register.  By contrast, the distinction between GcPtr and
--- GcNonPtr is of interest to only a few parts of the code generator.
-
--------- Equality on CmmType --------------
--- CmmType is *not* an instance of Eq; sometimes we care about the
--- Gc/NonGc distinction, and sometimes we don't
--- So we use an explicit function to force you to think about it
-cmmEqType :: CmmType -> CmmType -> Bool        -- Exact equality
-cmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2
-
-cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
-  -- This equality is temporary; used in CmmLint
-  -- but the RTS files are not yet well-typed wrt pointers
-cmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)
-   = c1 `weak_eq` c2 && w1==w2
-   where
-      FloatCat `weak_eq` FloatCat = True 
-      FloatCat `weak_eq` _other          = False
-      _other   `weak_eq` FloatCat = False
-      _word1   `weak_eq` _word2   = True       -- Ignores GcPtr
-
---- Simple operations on CmmType -----
-typeWidth :: CmmType -> Width
-typeWidth (CmmType _ w) = w
-
-cmmBits, cmmFloat :: Width -> CmmType
-cmmBits  = CmmType BitsCat
-cmmFloat = CmmType FloatCat
-
--------- Common CmmTypes ------------
--- Floats and words of specific widths
-b8, b16, b32, b64, f32, f64 :: CmmType
-b8     = cmmBits W8
-b16    = cmmBits W16
-b32    = cmmBits W32
-b64    = cmmBits W64
-f32    = cmmFloat W32
-f64    = cmmFloat W64
-
--- CmmTypes of native word widths
-bWord, bHalfWord, gcWord :: CmmType
-bWord     = cmmBits wordWidth
-bHalfWord = cmmBits halfWordWidth
-gcWord    = CmmType GcPtrCat wordWidth
-
-cInt, cLong :: CmmType
-cInt  = cmmBits cIntWidth
-cLong = cmmBits cLongWidth
-
-
------------- Predicates ----------------
-isFloatType, isGcPtrType :: CmmType -> Bool
-isFloatType (CmmType FloatCat    _) = True
-isFloatType _other                 = False
-
-isGcPtrType (CmmType GcPtrCat _) = True
-isGcPtrType _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
-
-isWord64 (CmmType BitsCat  W64) = True
-isWord64 (CmmType GcPtrCat W64) = True
-isWord64 _other                        = False
-
-isWord32 (CmmType BitsCat  W32) = True
-isWord32 (CmmType GcPtrCat W32) = True
-isWord32 _other                        = False
-
-isFloat32 (CmmType FloatCat W32) = True
-isFloat32 _other                = False
-
-isFloat64 (CmmType FloatCat W64) = True
-isFloat64 _other                = False
-
------------------------------------------------------------------------------
---             Width
------------------------------------------------------------------------------
-
-data Width   = W8 | W16 | W32 | W64 
-            | W80      -- Extended double-precision float, 
-                       -- used in x86 native codegen only.
-                       -- (we use Ord, so it'd better be in this order)
-            | W128
-            deriving (Eq, Ord, Show)
-
-instance Outputable Width where
-   ppr rep = ptext (mrStr rep)
-
-mrStr :: Width -> LitString
-mrStr W8   = sLit("W8")
-mrStr W16  = sLit("W16")
-mrStr W32  = sLit("W32")
-mrStr W64  = sLit("W64")
-mrStr W128 = sLit("W128")
-mrStr W80  = sLit("W80")
-
-
--------- Common Widths  ------------
-wordWidth, halfWordWidth :: Width
-wordWidth | wORD_SIZE == 4 = W32
-         | wORD_SIZE == 8 = W64
-         | otherwise      = panic "MachOp.wordRep: Unknown word size"
-
-halfWordWidth | wORD_SIZE == 4 = W16
-             | wORD_SIZE == 8 = W32
-             | otherwise      = panic "MachOp.halfWordRep: Unknown word size"
-
--- cIntRep is the Width for a C-language 'int'
-cIntWidth, cLongWidth :: Width
-#if SIZEOF_INT == 4
-cIntWidth = W32
-#elif  SIZEOF_INT == 8
-cIntWidth = W64
-#endif
-
-#if SIZEOF_LONG == 4
-cLongWidth = W32
-#elif  SIZEOF_LONG == 8
-cLongWidth = W64
-#endif
-
-widthInBits :: Width -> Int
-widthInBits W8   = 8
-widthInBits W16  = 16
-widthInBits W32  = 32
-widthInBits W64  = 64
-widthInBits W128 = 128
-widthInBits W80  = 80
-
-widthInBytes :: Width -> Int
-widthInBytes W8   = 1
-widthInBytes W16  = 2
-widthInBytes W32  = 4
-widthInBytes W64  = 8
-widthInBytes W128 = 16
-widthInBytes W80  = 10
-
-widthFromBytes :: Int -> Width
-widthFromBytes 1  = W8
-widthFromBytes 2  = W16
-widthFromBytes 4  = W32
-widthFromBytes 8  = W64
-widthFromBytes 16 = W128
-widthFromBytes 10 = W80
-widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)
-
--- log_2 of the width in bytes, useful for generating shifts.
-widthInLog :: Width -> Int
-widthInLog W8   = 0
-widthInLog W16  = 1
-widthInLog W32  = 2
-widthInLog W64  = 3
-widthInLog W128 = 4
-widthInLog W80  = panic "widthInLog: F80"
-
--- widening / narrowing
-
-narrowU :: Width -> Integer -> Integer
-narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
-narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
-narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
-narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
-narrowU _ _ = panic "narrowTo"
-
-narrowS :: Width -> Integer -> Integer
-narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
-narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
-narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
-narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
-narrowS _ _ = panic "narrowTo"
-
------------------------------------------------------------------------------
---             MachOp
------------------------------------------------------------------------------
-
-{- 
-Implementation notes:
-
-It might suffice to keep just a width, without distinguishing between
-floating and integer types.  However, keeping the distinction will
-help the native code generator to assign registers more easily.
--}
-
-
-{- |
-Machine-level primops; ones which we can reasonably delegate to the
-native code generators to handle.  Basically contains C's primops
-and no others.
-
-Nomenclature: all ops indicate width and signedness, where
-appropriate.  Widths: 8\/16\/32\/64 means the given size, obviously.
-Nat means the operation works on STG word sized objects.
-Signedness: S means signed, U means unsigned.  For operations where
-signedness is irrelevant or makes no difference (for example
-integer add), the signedness component is omitted.
-
-An exception: NatP is a ptr-typed native word.  From the point of
-view of the native code generators this distinction is irrelevant,
-but the C code generator sometimes needs this info to emit the
-right casts.  
--}
-
-data MachOp
-  -- Integer operations (insensitive to signed/unsigned)
-  = MO_Add Width
-  | MO_Sub Width
-  | MO_Eq  Width
-  | MO_Ne  Width
-  | MO_Mul Width               -- low word of multiply
-
-  -- Signed multiply/divide
-  | MO_S_MulMayOflo Width      -- nonzero if signed multiply overflows
-  | MO_S_Quot Width            -- signed / (same semantics as IntQuotOp)
-  | MO_S_Rem  Width            -- signed % (same semantics as IntRemOp)
-  | MO_S_Neg  Width            -- unary -
-
-  -- Unsigned multiply/divide
-  | MO_U_MulMayOflo Width      -- nonzero if unsigned multiply overflows
-  | MO_U_Quot Width            -- unsigned / (same semantics as WordQuotOp)
-  | MO_U_Rem  Width            -- unsigned % (same semantics as WordRemOp)
-
-  -- Signed comparisons
-  | MO_S_Ge Width
-  | MO_S_Le Width
-  | MO_S_Gt Width
-  | MO_S_Lt Width
-
-  -- Unsigned comparisons
-  | MO_U_Ge Width
-  | MO_U_Le Width
-  | MO_U_Gt Width
-  | MO_U_Lt Width
-
-  -- Floating point arithmetic
-  | MO_F_Add  Width
-  | MO_F_Sub  Width
-  | MO_F_Neg  Width            -- unary -
-  | MO_F_Mul  Width
-  | MO_F_Quot Width
-
-  -- Floating point comparison
-  | MO_F_Eq Width
-  | MO_F_Ne Width
-  | MO_F_Ge Width
-  | MO_F_Le Width
-  | MO_F_Gt Width
-  | MO_F_Lt Width
-
-  -- Bitwise operations.  Not all of these may be supported 
-  -- at all sizes, and only integral Widths are valid.
-  | MO_And   Width
-  | MO_Or    Width
-  | MO_Xor   Width
-  | MO_Not   Width
-  | MO_Shl   Width
-  | MO_U_Shr Width     -- unsigned shift right
-  | MO_S_Shr Width     -- signed shift right
-
-  -- Conversions.  Some of these will be NOPs.
-  -- Floating-point conversions use the signed variant.
-  | MO_SF_Conv Width Width     -- Signed int -> Float
-  | MO_FS_Conv Width Width     -- Float -> Signed int
-  | MO_SS_Conv Width Width     -- Signed int -> Signed int
-  | MO_UU_Conv Width Width     -- unsigned int -> unsigned int
-  | MO_FF_Conv Width Width     -- Float -> Float
-  deriving (Eq, Show)
-
-pprMachOp :: MachOp -> SDoc
-pprMachOp mo = text (show mo)
-
-
-
--- -----------------------------------------------------------------------------
--- Some common MachReps
-
--- A 'wordRep' is a machine word on the target architecture
--- Specifically, it is the size of an Int#, Word#, Addr# 
--- and the unit of allocation on the stack and the heap
--- Any pointer is also guaranteed to be a wordRep.
-
-mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
-    , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
-    , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe 
-    , mo_wordULe, mo_wordUGt, mo_wordULt
-    , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
-    , mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
-    , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
-    , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32
-    :: MachOp
-
-mo_wordAdd     = MO_Add wordWidth
-mo_wordSub     = MO_Sub wordWidth
-mo_wordEq      = MO_Eq  wordWidth
-mo_wordNe      = MO_Ne  wordWidth
-mo_wordMul     = MO_Mul wordWidth
-mo_wordSQuot   = MO_S_Quot wordWidth
-mo_wordSRem    = MO_S_Rem wordWidth
-mo_wordSNeg    = MO_S_Neg wordWidth
-mo_wordUQuot   = MO_U_Quot wordWidth
-mo_wordURem    = MO_U_Rem wordWidth
-
-mo_wordSGe     = MO_S_Ge  wordWidth
-mo_wordSLe     = MO_S_Le  wordWidth
-mo_wordSGt     = MO_S_Gt  wordWidth
-mo_wordSLt     = MO_S_Lt  wordWidth
-
-mo_wordUGe     = MO_U_Ge  wordWidth
-mo_wordULe     = MO_U_Le  wordWidth
-mo_wordUGt     = MO_U_Gt  wordWidth
-mo_wordULt     = MO_U_Lt  wordWidth
-
-mo_wordAnd     = MO_And wordWidth
-mo_wordOr      = MO_Or  wordWidth
-mo_wordXor     = MO_Xor wordWidth
-mo_wordNot     = MO_Not wordWidth
-mo_wordShl     = MO_Shl wordWidth
-mo_wordSShr    = MO_S_Shr wordWidth 
-mo_wordUShr    = MO_U_Shr wordWidth 
-
-mo_u_8To32     = MO_UU_Conv W8 W32
-mo_s_8To32     = MO_SS_Conv W8 W32
-mo_u_16To32    = MO_UU_Conv W16 W32
-mo_s_16To32    = MO_SS_Conv W16 W32
-
-mo_u_8ToWord   = MO_UU_Conv W8  wordWidth
-mo_s_8ToWord   = MO_SS_Conv W8  wordWidth
-mo_u_16ToWord  = MO_UU_Conv W16 wordWidth
-mo_s_16ToWord  = MO_SS_Conv W16 wordWidth
-mo_s_32ToWord  = MO_SS_Conv W32 wordWidth
-mo_u_32ToWord  = MO_UU_Conv W32 wordWidth
-
-mo_WordTo8     = MO_UU_Conv wordWidth W8
-mo_WordTo16    = MO_UU_Conv wordWidth W16
-mo_WordTo32    = MO_UU_Conv wordWidth W32
-
-mo_32To8       = MO_UU_Conv W32 W8
-mo_32To16      = MO_UU_Conv W32 W16
-
-
--- ----------------------------------------------------------------------------
--- isCommutableMachOp
-
-{- |
-Returns 'True' if the MachOp has commutable arguments.  This is used
-in the platform-independent Cmm optimisations.
-
-If in doubt, return 'False'.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isCommutableMachOp :: MachOp -> Bool
-isCommutableMachOp mop = 
-  case mop of
-       MO_Add _                -> True
-       MO_Eq _                 -> True
-       MO_Ne _                 -> True
-       MO_Mul _                -> True
-       MO_S_MulMayOflo _       -> True
-       MO_U_MulMayOflo _       -> True
-       MO_And _                -> True
-       MO_Or _                 -> True
-       MO_Xor _                -> True
-       _other                  -> False
-
--- ----------------------------------------------------------------------------
--- isAssociativeMachOp
-
-{- |
-Returns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)
-This is used in the platform-independent Cmm optimisations.
-
-If in doubt, return 'False'.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isAssociativeMachOp :: MachOp -> Bool
-isAssociativeMachOp mop = 
-  case mop of
-       MO_Add {} -> True       -- NB: does not include
-       MO_Mul {} -> True --     floatint point!
-       MO_And {} -> True
-       MO_Or  {} -> True
-       MO_Xor {} -> True
-       _other    -> False
-
--- ----------------------------------------------------------------------------
--- isComparisonMachOp
-
-{- | 
-Returns 'True' if the MachOp is a comparison.
-
-If in doubt, return False.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isComparisonMachOp :: MachOp -> Bool
-isComparisonMachOp mop = 
-  case mop of
-    MO_Eq   _  -> True
-    MO_Ne   _  -> True
-    MO_S_Ge _  -> True
-    MO_S_Le _  -> True
-    MO_S_Gt _  -> True
-    MO_S_Lt _  -> True
-    MO_U_Ge _  -> True
-    MO_U_Le _  -> True
-    MO_U_Gt _  -> True
-    MO_U_Lt _  -> True
-    MO_F_Eq  {}        -> True
-    MO_F_Ne  {}        -> True
-    MO_F_Ge  {}        -> True
-    MO_F_Le  {}        -> True
-    MO_F_Gt  {}        -> True
-    MO_F_Lt  {}        -> True
-    _other     -> False
-
--- -----------------------------------------------------------------------------
--- Inverting conditions
-
--- Sometimes it's useful to be able to invert the sense of a
--- condition.  Not all conditional tests are invertible: in
--- particular, floating point conditionals cannot be inverted, because
--- there exist floating-point values which return False for both senses
--- of a condition (eg. !(NaN > NaN) && !(NaN /<= NaN)).
-
-maybeInvertComparison :: MachOp -> Maybe MachOp
-maybeInvertComparison op
-  = case op of -- None of these Just cases include floating point
-       MO_Eq r   -> Just (MO_Ne r)
-       MO_Ne r   -> Just (MO_Eq r)
-       MO_U_Lt r -> Just (MO_U_Ge r)
-       MO_U_Gt r -> Just (MO_U_Le r)
-       MO_U_Le r -> Just (MO_U_Gt r)
-       MO_U_Ge r -> Just (MO_U_Lt r)
-       MO_S_Lt r -> Just (MO_S_Ge r)
-       MO_S_Gt r -> Just (MO_S_Le r)
-       MO_S_Le r -> Just (MO_S_Gt r)
-       MO_S_Ge r -> Just (MO_S_Lt r)
-       MO_F_Eq r -> Just (MO_F_Ne r)
-       MO_F_Ne r -> Just (MO_F_Eq r)
-       MO_F_Ge r -> Just (MO_F_Le r)
-       MO_F_Le r -> Just (MO_F_Ge r)   
-       MO_F_Gt r -> Just (MO_F_Lt r)   
-       MO_F_Lt r -> Just (MO_F_Gt r)   
-       _other    -> Nothing
-
--- ----------------------------------------------------------------------------
--- machOpResultType
-
-{- |
-Returns the MachRep of the result of a MachOp.
--}
-machOpResultType :: MachOp -> [CmmType] -> CmmType
-machOpResultType mop tys =
-  case mop of
-    MO_Add {}          -> ty1  -- Preserve GC-ptr-hood
-    MO_Sub {}          -> ty1  -- of first arg
-    MO_Mul    r                -> cmmBits r
-    MO_S_MulMayOflo r  -> cmmBits r
-    MO_S_Quot r                -> cmmBits r
-    MO_S_Rem  r                -> cmmBits r
-    MO_S_Neg  r                -> cmmBits r
-    MO_U_MulMayOflo r  -> cmmBits r
-    MO_U_Quot r                -> cmmBits r
-    MO_U_Rem  r                -> cmmBits r
-
-    MO_Eq {}           -> comparisonResultRep
-    MO_Ne {}           -> comparisonResultRep
-    MO_S_Ge {}         -> comparisonResultRep
-    MO_S_Le {}         -> comparisonResultRep
-    MO_S_Gt {}         -> comparisonResultRep
-    MO_S_Lt {}         -> comparisonResultRep
-
-    MO_U_Ge {}         -> comparisonResultRep
-    MO_U_Le {}         -> comparisonResultRep
-    MO_U_Gt {}         -> comparisonResultRep
-    MO_U_Lt {}         -> comparisonResultRep
-
-    MO_F_Add r         -> cmmFloat r
-    MO_F_Sub r         -> cmmFloat r
-    MO_F_Mul r         -> cmmFloat r
-    MO_F_Quot r                -> cmmFloat r
-    MO_F_Neg r         -> cmmFloat r
-    MO_F_Eq  {}                -> comparisonResultRep
-    MO_F_Ne  {}                -> comparisonResultRep
-    MO_F_Ge  {}                -> comparisonResultRep
-    MO_F_Le  {}                -> comparisonResultRep
-    MO_F_Gt  {}                -> comparisonResultRep
-    MO_F_Lt  {}                -> comparisonResultRep
-
-    MO_And {}          -> ty1  -- Used for pointer masking
-    MO_Or {}           -> ty1
-    MO_Xor {}          -> ty1
-    MO_Not   r         -> cmmBits r
-    MO_Shl   r         -> cmmBits r
-    MO_U_Shr r         -> cmmBits r
-    MO_S_Shr r         -> cmmBits r
-
-    MO_SS_Conv _ to    -> cmmBits to
-    MO_UU_Conv _ to    -> cmmBits to
-    MO_FS_Conv _ to    -> cmmBits to
-    MO_SF_Conv _ to    -> cmmFloat to
-    MO_FF_Conv _ to    -> cmmFloat to
-  where
-    (ty1:_) = tys
-
-comparisonResultRep :: CmmType
-comparisonResultRep = bWord  -- is it?
-
-
--- -----------------------------------------------------------------------------
--- machOpArgReps
-
--- | This function is used for debugging only: we can check whether an
--- application of a MachOp is "type-correct" by checking that the MachReps of
--- its arguments are the same as the MachOp expects.  This is used when 
--- linting a CmmExpr.
-
-machOpArgReps :: MachOp -> [Width]
-machOpArgReps op = 
-  case op of
-    MO_Add    r                -> [r,r]
-    MO_Sub    r                -> [r,r]
-    MO_Eq     r                -> [r,r]
-    MO_Ne     r                -> [r,r]
-    MO_Mul    r                -> [r,r]
-    MO_S_MulMayOflo r  -> [r,r]
-    MO_S_Quot r                -> [r,r]
-    MO_S_Rem  r                -> [r,r]
-    MO_S_Neg  r                -> [r]
-    MO_U_MulMayOflo r  -> [r,r]
-    MO_U_Quot r                -> [r,r]
-    MO_U_Rem  r                -> [r,r]
-
-    MO_S_Ge r          -> [r,r]
-    MO_S_Le r          -> [r,r]
-    MO_S_Gt r          -> [r,r]
-    MO_S_Lt r          -> [r,r]
-
-    MO_U_Ge r          -> [r,r]
-    MO_U_Le r          -> [r,r]
-    MO_U_Gt r          -> [r,r]
-    MO_U_Lt r          -> [r,r]
-
-    MO_F_Add r         -> [r,r]
-    MO_F_Sub r         -> [r,r]
-    MO_F_Mul r         -> [r,r]
-    MO_F_Quot r                -> [r,r]
-    MO_F_Neg r         -> [r]
-    MO_F_Eq  r         -> [r,r]
-    MO_F_Ne  r         -> [r,r]
-    MO_F_Ge  r         -> [r,r]
-    MO_F_Le  r         -> [r,r]
-    MO_F_Gt  r         -> [r,r]
-    MO_F_Lt  r         -> [r,r]
-
-    MO_And   r         -> [r,r]
-    MO_Or    r         -> [r,r]
-    MO_Xor   r         -> [r,r]
-    MO_Not   r         -> [r]
-    MO_Shl   r         -> [r,wordWidth]
-    MO_U_Shr r         -> [r,wordWidth]
-    MO_S_Shr r         -> [r,wordWidth]
-
-    MO_SS_Conv from _  -> [from]
-    MO_UU_Conv from _   -> [from]
-    MO_SF_Conv from _  -> [from]
-    MO_FS_Conv from _  -> [from]
-    MO_FF_Conv from _  -> [from]
-
-
--------------------------------------------------------------------------
-{-     Note [Signed vs unsigned]
-       ~~~~~~~~~~~~~~~~~~~~~~~~~
-Should a CmmType include a signed vs. unsigned distinction?
-
-This is very much like a "hint" in C-- terminology: it isn't necessary
-in order to generate correct code, but it might be useful in that the
-compiler can generate better code if it has access to higher-level
-hints about data.  This is important at call boundaries, because the
-definition of a function is not visible at all of its call sites, so
-the compiler cannot infer the hints.
-
-Here in Cmm, we're taking a slightly different approach.  We include
-the int vs. float hint in the MachRep, because (a) the majority of
-platforms have a strong distinction between float and int registers,
-and (b) we don't want to do any heavyweight hint-inference in the
-native code backend in order to get good code.  We're treating the
-hint more like a type: our Cmm is always completely consistent with
-respect to hints.  All coercions between float and int are explicit.
-
-What about the signed vs. unsigned hint?  This information might be
-useful if we want to keep sub-word-sized values in word-size
-registers, which we must do if we only have word-sized registers.
-
-On such a system, there are two straightforward conventions for
-representing sub-word-sized values:
-
-(a) Leave the upper bits undefined.  Comparison operations must
-    sign- or zero-extend both operands before comparing them,
-    depending on whether the comparison is signed or unsigned.
-
-(b) Always keep the values sign- or zero-extended as appropriate.
-    Arithmetic operations must narrow the result to the appropriate
-    size.
-
-A clever compiler might not use either (a) or (b) exclusively, instead
-it would attempt to minimize the coercions by analysis: the same kind
-of analysis that propagates hints around.  In Cmm we don't want to
-have to do this, so we plump for having richer types and keeping the
-type information consistent.
-
-If signed/unsigned hints are missing from MachRep, then the only
-choice we have is (a), because we don't know whether the result of an
-operation should be sign- or zero-extended.
-
-Many architectures have extending load operations, which work well
-with (b).  To make use of them with (a), you need to know whether the
-value is going to be sign- or zero-extended by an enclosing comparison
-(for example), which involves knowing above the context.  This is
-doable but more complex.
-
-Further complicating the issue is foreign calls: a foreign calling
-convention can specify that signed 8-bit quantities are passed as
-sign-extended 32 bit quantities, for example (this is the case on the
-PowerPC).  So we *do* need sign information on foreign call arguments.
-
-Pros for adding signed vs. unsigned to MachRep:
-
-  - It would let us use convention (b) above, and get easier
-    code generation for extending loads.
-
-  - Less information required on foreign calls.
-  
-  - MachOp type would be simpler
-
-Cons:
-
-  - More complexity
-
-  - What is the MachRep for a VanillaReg?  Currently it is
-    always wordRep, but now we have to decide whether it is
-    signed or unsigned.  The same VanillaReg can thus have
-    different MachReps in different parts of the program.
-
-  - Extra coercions cluttering up expressions.
-
-Currently for GHC, the foreign call point is moot, because we do our
-own promotion of sub-word-sized values to word-sized values.  The Int8
-type is represnted by an Int# which is kept sign-extended at all times
-(this is slightly naughty, because we're making assumptions about the
-C calling convention rather early on in the compiler).  However, given
-this, the cons outweigh the pros.
-
--}
-
+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