[project @ 1997-07-25 23:04:49 by sof]

[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCSyn.lhs

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index 23e7220..ce5d777 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCSyn.lhs
+++ b/ghc/compiler/absCSyn/AbsCSyn.lhs
@@ -1,5 +1,5 @@
 %
 %

-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996

 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 

@@ -14,7 +14,7 @@ raw assembler/machine code.
 \begin{code}
 #include "HsVersions.h"
 
 \begin{code}
 #include "HsVersions.h"
 

-module AbsCSyn (
+module AbsCSyn {- (

        -- export everything
        AbstractC(..),
        CStmtMacro(..),
        -- export everything
        AbstractC(..),
        CStmtMacro(..),

@@ -22,93 +22,51 @@ module AbsCSyn (
        CAddrMode(..),
        ReturnInfo(..),
        mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
        CAddrMode(..),
        ReturnInfo(..),
        mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,

-       mkIntCLit, 
+       mkIntCLit,

        mkAbsCStmtList,
        mkCCostCentre,
 
        mkAbsCStmtList,
        mkCCostCentre,
 

-       -- HeapOffsets, plus some convenient synonyms...
-       HeapOffset,
-       zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
-       maxOff, addOff, subOff, intOffsetIntoGoods,
-       isZeroOff, possiblyEqualHeapOffset,
-       pprHeapOffset,
-       VirtualHeapOffset(..), HpRelOffset(..),
-       VirtualSpAOffset(..), VirtualSpBOffset(..),
-       SpARelOffset(..), SpBRelOffset(..),
-

        -- RegRelatives
        RegRelative(..),
 
        -- registers
        MagicId(..), node, infoptr,
        -- RegRelatives
        RegRelative(..),
 
        -- registers
        MagicId(..), node, infoptr,

-       isVolatileReg,
-
-       -- closure info
-       ClosureInfo, LambdaFormInfo, UpdateFlag, SMRep,
+       isVolatileReg, noLiveRegsMask, mkLiveRegsMask,
+       CostRes(Cost)
+    )-} where

 
 

-       -- stuff from AbsCFuns and PprAbsC...
-       nonemptyAbsC, flattenAbsC, getAmodeKind,
-       mixedTypeLocn, mixedPtrLocn,
-#ifdef __GLASGOW_HASKELL__
-       writeRealC,
-#endif
-       dumpRealC,
-       kindFromMagicId, -- UNUSED: getDestinationRegs,
-       amodeCanSurviveGC,
-
-#ifdef GRAN
-       CostRes(Cost),
+IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(AbsCLoop)
+#else
+# if  ! OMIT_NATIVE_CODEGEN
+import {-# SOURCE #-} MachMisc
+# endif
+import {-# SOURCE #-} ClosureInfo ( ClosureInfo )
+import {-# SOURCE #-} CLabel     ( CLabel )

 #endif
 
 #endif
 

-       -- and stuff to make the interface self-sufficient
-       Outputable(..), NamedThing(..),
-       PrettyRep, ExportFlag, SrcLoc, Unique,
-       CSeq, PprStyle, Pretty(..), Unpretty(..),
-       -- blargh...
-       UniType,
-
-       PrimKind(..), -- re-exported NON-ABSTRACTLY
-       BasicLit(..), mkMachInt, mkMachWord,   -- re-exported NON-ABSTRACTLY
-       Id, ConTag(..), Maybe, PrimOp, SplitUniqSupply, TyCon,
-       CLabel, GlobalSwitch, CostCentre,
-       SimplifierSwitch, UniqSet(..), UniqFM, StgExpr, StgAtom
-    ) where
-
-import AbsCFuns                -- used, and re-exported
-import ClosureInfo     -- ditto
-import Costs
-import PprAbsC         -- ditto
-import HeapOffs                hiding ( hpRelToInt )
-
-import AbsPrel         ( PrimOp
-                         IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
+import Constants       ( mAX_Vanilla_REG, mAX_Float_REG,
+                         mAX_Double_REG, lIVENESS_R1, lIVENESS_R2,
+                         lIVENESS_R3, lIVENESS_R4, lIVENESS_R5,
+                         lIVENESS_R6, lIVENESS_R7, lIVENESS_R8

                        )
                        )

-import CLabelInfo
-import CmdLineOpts     ( GlobalSwitch(..), SimplifierSwitch )
-import BasicLit                ( mkMachInt, mkMachWord, BasicLit(..) )
-import Id              ( Id, ConTag(..), DataCon(..) )
-import Maybes          ( Maybe )
-import Outputable
-import Unpretty                -- ********** NOTE **********
-import PrimKind                ( PrimKind(..) )
-import CostCentre      -- for CostCentre type
-import StgSyn          ( StgExpr, StgAtom, StgBinderInfo )
-import UniqSet         ( UniqSet(..), UniqFM )
-import Unique          ( Unique )
-import Util
-
-#ifndef DPH
-import CgCompInfo      ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG )
-#else
-import CgCompInfo      ( spARelToInt, spBRelToInt )
-import DapInfo         ( virtualHeapOffsetToInt   )
-#endif {- Data Parallel Haskell -}
+import HeapOffs                ( SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
+                         SYN_IE(VirtualHeapOffset), HeapOffset
+                       )
+import CostCentre       ( CostCentre )
+import Literal         ( mkMachInt, Literal )
+import PrimRep         ( isFollowableRep, PrimRep(..) )
+import PrimOp           ( PrimOp )
+import Unique           ( Unique )
+

 \end{code}
 
 @AbstractC@ is a list of Abstract~C statements, but the data structure
 is tree-ish, for easier and more efficient putting-together.
 \begin{code}
 \end{code}
 
 @AbstractC@ is a list of Abstract~C statements, but the data structure
 is tree-ish, for easier and more efficient putting-together.
 \begin{code}

+absCNop = AbsCNop
+

 data AbstractC
   = AbsCNop
   | AbsCStmts          AbstractC AbstractC
 data AbstractC
   = AbsCNop
   | AbsCStmts          AbstractC AbstractC

@@ -120,7 +78,7 @@ A note on @CAssign@: In general, the type associated with an assignment
 is the type of the lhs.  However, when the lhs is a pointer to mixed
 types (e.g. SpB relative), the type of the assignment is the type of
 the rhs for float types, or the generic StgWord for all other types.
 is the type of the lhs.  However, when the lhs is a pointer to mixed
 types (e.g. SpB relative), the type of the assignment is the type of
 the rhs for float types, or the generic StgWord for all other types.

-(In particular, a CharKind on the rhs is promoted to IntKind when
+(In particular, a CharRep on the rhs is promoted to IntRep when

 stored in a mixed type location.)
 
 \begin{code}
 stored in a mixed type location.)
 
 \begin{code}

@@ -130,7 +88,7 @@ stored in a mixed type location.)
 
   | CJump
        CAddrMode       -- Put this in the program counter
 
   | CJump
        CAddrMode       -- Put this in the program counter

-                       -- eg `CJump (CReg (VanillaReg PtrKind 1))' puts Ret1 in PC
+                       -- eg `CJump (CReg (VanillaReg PtrRep 1))' puts Ret1 in PC

                        -- Enter can be done by:
                        --        CJump (CVal NodeRel zeroOff)
 
                        -- Enter can be done by:
                        --        CJump (CVal NodeRel zeroOff)
 

@@ -144,7 +102,7 @@ stored in a mixed type location.)
        ReturnInfo      -- How to get the return address from the base address
 
   | CSwitch CAddrMode
        ReturnInfo      -- How to get the return address from the base address
 
   | CSwitch CAddrMode

-       [(BasicLit, AbstractC)] -- alternatives
+       [(Literal, AbstractC)]  -- alternatives

        AbstractC               -- default; if there is no real Abstract C in here
                                -- (e.g., all comments; see function "nonemptyAbsC"),
                                -- then that means the default _cannot_ occur.
        AbstractC               -- default; if there is no real Abstract C in here
                                -- (e.g., all comments; see function "nonemptyAbsC"),
                                -- then that means the default _cannot_ occur.

@@ -178,12 +136,12 @@ stored in a mixed type location.)
        -- INVARIANT: When a PrimOp which can cause GC is used, the
        -- only live data is tidily on the STG stacks or in the STG
        -- registers (the code generator ensures this).
        -- INVARIANT: When a PrimOp which can cause GC is used, the
        -- only live data is tidily on the STG stacks or in the STG
        -- registers (the code generator ensures this).

-       -- 
+       --

        -- Why this?  Because if the arguments were arbitrary
        -- addressing modes, they might be things like (Hp+6) which
        -- will get utterly spongled by GC.
 
        -- Why this?  Because if the arguments were arbitrary
        -- addressing modes, they might be things like (Hp+6) which
        -- will get utterly spongled by GC.
 

-  | CSimultaneous      -- Perform simultaneously all the statements 
+  | CSimultaneous      -- Perform simultaneously all the statements

        AbstractC       -- in the nested AbstractC.  They are only
                        -- allowed to be CAssigns, COpStmts and AbsCNops, so the
                        -- "simultaneous" part just concerns making
        AbstractC       -- in the nested AbstractC.  They are only
                        -- allowed to be CAssigns, COpStmts and AbsCNops, so the
                        -- "simultaneous" part just concerns making

@@ -200,8 +158,8 @@ stored in a mixed type location.)
 
   | CStaticClosure
        CLabel  -- The (full, not base) label to use for labelling the closure.
 
   | CStaticClosure
        CLabel  -- The (full, not base) label to use for labelling the closure.

-       ClosureInfo     
-       CAddrMode       -- cost centre identifier to place in closure   
+       ClosureInfo
+       CAddrMode       -- cost centre identifier to place in closure

        [CAddrMode]     -- free vars; ptrs, then non-ptrs
 
 
        [CAddrMode]     -- free vars; ptrs, then non-ptrs
 
 

@@ -239,30 +197,12 @@ stored in a mixed type location.)
                        -- False <=> extern; just say so
        CostCentre
 
                        -- False <=> extern; just say so
        CostCentre
 

-{-UNUSED:
-  | CComment           -- to insert a comment into the output
-       FAST_STRING
--}
-

   | CClosureUpdInfo
        AbstractC       -- InRegs Info Table (CClosureInfoTable)
                        --                    ^^^^^^^^^^^^^^^^^
                        --                                out of date -- HWL
 
   | CSplitMarker       -- Split into separate object modules here
   | CClosureUpdInfo
        AbstractC       -- InRegs Info Table (CClosureInfoTable)
                        --                    ^^^^^^^^^^^^^^^^^
                        --                                out of date -- HWL
 
   | CSplitMarker       -- Split into separate object modules here

-
-#ifdef DPH
-  | CNativeInfoTableAndCode
-       ClosureInfo     -- Explains placement and layout of closure
-       String          -- closure description
-       AbstractC       -- We want to apply the trick outlined in the STG 
-                       -- paper of putting the info table before the normal 
-                       -- entry point to a function (well a very similar 
-                       -- trick, see nativeDap/NOTES.static). By putting the 
-                       -- abstractC here we stop the info table 
-                       -- wandering off :-) (No post mangler hacking going
-                       -- on here Will :-)
-#endif {- Data Parallel Haskell -}

 \end{code}
 
 About @CMacroStmt@, etc.: notionally, they all just call some
 \end{code}
 
 About @CMacroStmt@, etc.: notionally, they all just call some

@@ -291,18 +231,13 @@ data CStmtMacro
   | UPD_BH_SINGLE_ENTRY
   | PUSH_STD_UPD_FRAME
   | POP_STD_UPD_FRAME
   | UPD_BH_SINGLE_ENTRY
   | PUSH_STD_UPD_FRAME
   | POP_STD_UPD_FRAME

---UNUSED:  | PUSH_CON_UPD_FRAME 
-  | SET_ARITY
-  | CHK_ARITY

   | SET_TAG
   | SET_TAG

-#ifdef GRAN
-  | GRAN_FETCH                 -- for GrAnSim only  -- HWL 
-  | GRAN_RESCHEDULE            -- for GrAnSim only  -- HWL 
-  | GRAN_FETCH_AND_RESCHEDULE  -- for GrAnSim only  -- HWL 
-  | THREAD_CONTEXT_SWITCH      -- for GrAnSim only  -- HWL 
-#endif
-  deriving Text 
-
+  | GRAN_FETCH                 -- for GrAnSim only  -- HWL
+  | GRAN_RESCHEDULE            -- for GrAnSim only  -- HWL
+  | GRAN_FETCH_AND_RESCHEDULE  -- for GrAnSim only  -- HWL
+  | THREAD_CONTEXT_SWITCH      -- for GrAnSim only  -- HWL
+  | GRAN_YIELD                 -- for GrAnSim only  -- HWL 
+  deriving Text

 \end{code}
 
 \item[@CCallProfCtrMacro@:]
 \end{code}
 
 \item[@CCallProfCtrMacro@:]

@@ -357,7 +292,7 @@ to the code to be resumed. (ToDo: update)
 Addressing modes: these have @PrimitiveKinds@ pinned on them.
 \begin{code}
 data CAddrMode
 Addressing modes: these have @PrimitiveKinds@ pinned on them.
 \begin{code}
 data CAddrMode

-  = CVal  RegRelative PrimKind
+  = CVal  RegRelative PrimRep

                        -- On RHS of assign: Contents of Magic[n]
                        -- On LHS of assign: location Magic[n]
                        -- (ie at addr Magic+n)
                        -- On RHS of assign: Contents of Magic[n]
                        -- On LHS of assign: location Magic[n]
                        -- (ie at addr Magic+n)

@@ -375,23 +310,21 @@ data CAddrMode
   | CTableEntry            -- CVal should be generalized to allow this
                CAddrMode   -- Base
                CAddrMode   -- Offset
   | CTableEntry            -- CVal should be generalized to allow this
                CAddrMode   -- Base
                CAddrMode   -- Offset

-               PrimKind    -- For casting
+               PrimRep    -- For casting

 
 

-  | CTemp Unique PrimKind      -- Temporary locations
+  | CTemp Unique PrimRep       -- Temporary locations

        -- ``Temporaries'' correspond to local variables in C, and registers in
        -- native code.
        -- ``Temporaries'' correspond to local variables in C, and registers in
        -- native code.

-       -- OLD: The kind (that used to be there) is redundant, but it's REALLY helpful for
-       -- generating C declarations

 
   | CLbl    CLabel     -- Labels in the runtime system, etc.
                        -- See comment under CLabelledData about (String,Name)
 
   | CLbl    CLabel     -- Labels in the runtime system, etc.
                        -- See comment under CLabelledData about (String,Name)

-           PrimKind    -- the kind is so we can generate accurate C decls
+           PrimRep     -- the kind is so we can generate accurate C decls

 
   | CUnVecLbl          -- A choice of labels left up to the back end
              CLabel    -- direct
              CLabel    -- vectored
 
 
   | CUnVecLbl          -- A choice of labels left up to the back end
              CLabel    -- direct
              CLabel    -- vectored
 

-  | CCharLike CAddrMode        -- The address of a static char-like closure for 
+  | CCharLike CAddrMode        -- The address of a static char-like closure for

                        -- the specified character.  It is guaranteed to be in
                        -- the range 0..255.
 
                        -- the specified character.  It is guaranteed to be in
                        -- the range 0..255.
 

@@ -400,10 +333,10 @@ data CAddrMode
                        -- range mIN_INTLIKE..mAX_INTLIKE
 
   | CString FAST_STRING        -- The address of the null-terminated string
                        -- range mIN_INTLIKE..mAX_INTLIKE
 
   | CString FAST_STRING        -- The address of the null-terminated string

-  | CLit    BasicLit
+  | CLit    Literal

   | CLitLit FAST_STRING        -- completely literal literal: just spit this String
                        -- into the C output
   | CLitLit FAST_STRING        -- completely literal literal: just spit this String
                        -- into the C output

-           PrimKind
+           PrimRep

 
   | COffset HeapOffset -- A literal constant, not an offset *from* anything!
                        -- ToDo: this should really be CLitOffset
 
   | COffset HeapOffset -- A literal constant, not an offset *from* anything!
                        -- ToDo: this should really be CLitOffset

@@ -423,9 +356,9 @@ data CAddrMode
                                -- then the code for this thing will be entered
 
   | CMacroExpr
                                -- then the code for this thing will be entered
 
   | CMacroExpr

-       PrimKind        -- the kind of the result
+       PrimRep         -- the kind of the result

        CExprMacro      -- the macro to generate a value
        CExprMacro      -- the macro to generate a value

-        [CAddrMode]    -- and its arguments
+       [CAddrMode]     -- and its arguments

 
   | CCostCentre                -- If Bool is True ==> it to be printed as a String,
        CostCentre      -- (*not* as a C identifier or some such).
 
   | CCostCentre                -- If Bool is True ==> it to be printed as a String,
        CostCentre      -- (*not* as a C identifier or some such).

@@ -478,7 +411,6 @@ data ReturnInfo
   = DirectReturn                       -- Jump directly, if possible
   | StaticVectoredReturn Int           -- Fixed tag, starting at zero
   | DynamicVectoredReturn CAddrMode    -- Dynamic tag given by amode, starting at zero
   = DirectReturn                       -- Jump directly, if possible
   | StaticVectoredReturn Int           -- Fixed tag, starting at zero
   | DynamicVectoredReturn CAddrMode    -- Dynamic tag given by amode, starting at zero

-

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -514,7 +446,7 @@ data MagicId
 
   -- Argument and return registers
   | VanillaReg         -- pointers, unboxed ints and chars
 
   -- Argument and return registers
   | VanillaReg         -- pointers, unboxed ints and chars

-       PrimKind        -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind
+       PrimRep         -- PtrRep, IntRep, CharRep, StablePtrRep or ForeignObjRep

                        --      (in case we need to distinguish)
        FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
 
                        --      (in case we need to distinguish)
        FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
 

@@ -545,7 +477,6 @@ data MagicId
   | LivenessReg        -- (parallel only) used when we need to record explicitly
                -- what registers are live
 
   | LivenessReg        -- (parallel only) used when we need to record explicitly
                -- what registers are live
 

-  | ActivityReg                -- mentioned only in nativeGen (UNUSED)

   | StdUpdRetVecReg    -- mentioned only in nativeGen
   | StkStubReg         -- register holding STK_STUB_closure (for stubbing dead stack slots)
 
   | StdUpdRetVecReg    -- mentioned only in nativeGen
   | StkStubReg         -- register holding STK_STUB_closure (for stubbing dead stack slots)
 

@@ -553,67 +484,63 @@ data MagicId
 
   | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
 
 
   | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
 

-#ifdef DPH
--- In DPH we use:  
---     (VanillaReg X)  for pointers, ints, chars floats 
---     (DataReg X)     for ints chars or floats
---     (DoubleReg X)   first 32 bits of double in register X, second 32 in
---                     register X+1; DoubleReg is a synonymn for 
---                     DataReg X; DataReg X+1
-
-  | DataReg
-       PrimKind
-       Int
-#endif {- Data Parallel Haskell -}
-
-node   = VanillaReg PtrKind     ILIT(1) -- A convenient alias for Node
-infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr
+node   = VanillaReg PtrRep     ILIT(1) -- A convenient alias for Node
+infoptr = VanillaReg DataPtrRep ILIT(2) -- An alias for InfoPtr
+
+--------------------
+noLiveRegsMask :: Int  -- Mask indicating nothing live
+noLiveRegsMask = 0
+
+mkLiveRegsMask
+       :: [MagicId]    -- Candidate live regs; depends what they have in them
+       -> Int
+
+mkLiveRegsMask regs
+  = foldl do_reg noLiveRegsMask regs
+  where
+    do_reg acc (VanillaReg kind reg_no)
+      | isFollowableRep kind
+      = acc + (reg_tbl !! IBOX(reg_no _SUB_ ILIT(1)))
+
+    do_reg acc anything_else = acc
+
+    reg_tbl -- ToDo: mk Array!
+      = [lIVENESS_R1, lIVENESS_R2, lIVENESS_R3, lIVENESS_R4,
+        lIVENESS_R5, lIVENESS_R6, lIVENESS_R7, lIVENESS_R8]

 \end{code}
 
 We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 
 \begin{code}
 instance Eq MagicId where
 \end{code}
 
 We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 
 \begin{code}
 instance Eq MagicId where

-#ifdef DPH
-    (FloatReg  f1) == (FloatReg  f2) = f1 == f2
-    (DoubleReg d1) == (DoubleReg d2) = d1 == d2
-    (DataReg _ d1) == (DataReg _ d2) = d1 == d2
-#endif {- Data Parallel Haskell -}
-    reg1          == reg2           = tagOf_MagicId reg1 _EQ_ tagOf_MagicId reg2
-
-tagOf_MagicId BaseReg          = (ILIT(0) :: FAST_INT)
-tagOf_MagicId StkOReg          = ILIT(1)
-tagOf_MagicId TagReg           = ILIT(2)
-tagOf_MagicId RetReg           = ILIT(3)
-tagOf_MagicId SpA              = ILIT(4)
-tagOf_MagicId SuA              = ILIT(5)
-tagOf_MagicId SpB              = ILIT(6)
-tagOf_MagicId SuB              = ILIT(7)
-tagOf_MagicId Hp               = ILIT(8)
-tagOf_MagicId HpLim            = ILIT(9)
-tagOf_MagicId LivenessReg      = ILIT(10)
---tagOf_MagicId ActivityReg    = ILIT(11) -- UNUSED
-tagOf_MagicId StdUpdRetVecReg  = ILIT(12)
-tagOf_MagicId StkStubReg       = ILIT(13)
-tagOf_MagicId CurCostCentre    = ILIT(14)
-tagOf_MagicId VoidReg          = ILIT(15)
-
-tagOf_MagicId (VanillaReg _ i) = ILIT(15) _ADD_ i
-
-#ifndef DPH
-tagOf_MagicId (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
-  where
-    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
-
-tagOf_MagicId (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
-  where
-    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
-    maxf = case mAX_Float_REG   of { IBOX(x) -> x }
-
-#else
-tagOf_MagicId (DoubleReg i)        = ILIT(1066) _ADD_ i -- Hacky, but we want disjoint
-tagOf_MagicId (DataReg _ IBOX(i))   = ILIT(1066) _ADD_ i -- range with Vanillas
-#endif {- Data Parallel Haskell -}
+    reg1 == reg2 = tag reg1 _EQ_ tag reg2
+     where
+       tag BaseReg          = (ILIT(0) :: FAST_INT)
+       tag StkOReg          = ILIT(1)
+       tag TagReg           = ILIT(2)
+       tag RetReg           = ILIT(3)
+       tag SpA              = ILIT(4)
+       tag SuA              = ILIT(5)
+       tag SpB              = ILIT(6)
+       tag SuB              = ILIT(7)
+       tag Hp               = ILIT(8)
+       tag HpLim            = ILIT(9)
+       tag LivenessReg      = ILIT(10)
+       tag StdUpdRetVecReg  = ILIT(12)
+       tag StkStubReg       = ILIT(13)
+       tag CurCostCentre    = ILIT(14)
+       tag VoidReg          = ILIT(15)
+
+       tag (VanillaReg _ i) = ILIT(15) _ADD_ i
+
+       tag (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
+         where
+           maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
+
+       tag (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
+         where
+           maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
+           maxf = case mAX_Float_REG   of { IBOX(x) -> x }

 \end{code}
 
 Returns True for any register that {\em potentially} dies across
 \end{code}
 
 Returns True for any register that {\em potentially} dies across

@@ -622,7 +549,7 @@ let the (machine-specific) registering macros sort things out...
 \begin{code}
 isVolatileReg :: MagicId -> Bool
 
 \begin{code}
 isVolatileReg :: MagicId -> Bool
 

-isVolatileReg any      = True
+isVolatileReg any = True

 --isVolatileReg (FloatReg _)   = True
 --isVolatileReg (DoubleReg _)  = True
 \end{code}
 --isVolatileReg (FloatReg _)   = True
 --isVolatileReg (DoubleReg _)  = True
 \end{code}

@@ -634,59 +561,3 @@ isVolatileReg any  = True
 %************************************************************************
 
 It's in \tr{PprAbsC.lhs}.
 %************************************************************************
 
 It's in \tr{PprAbsC.lhs}.

-
-%************************************************************************
-%*                                                                     *
-\subsection[EqInstances]{Eq instance for RegRelative & CAddrMode}
-%*                                                                     *
-%************************************************************************
-
-DPH requires CAddrMode to be in class Eq for its register allocation
-algorithm. The code for equality is rather conservative --- it doesnt
-matter if two things are determined to be not equal (even if they really are,
-i.e with CVal's), we just generate less efficient code.
-
-NOTE(07/04/93) It does matter, its doing really bad with the reg relative
-              stuff.
-
-\begin{code}
-#ifdef DPH
-instance Eq CAddrMode where
-  (CVal r _)          == (CVal r' _)        = r `eqRRel` r'    
-  (CAddr r)           == (CAddr r')         = r `eqRRel` r'
-  (CReg reg)          == (CReg reg')        = reg == reg'
-  (CTemp u _)         == (CTemp u' _)       = u == u'
-  (CLbl l _)          == (CLbl l' _)        = l == l'
-  (CUnVecLbl d v)     == (CUnVecLbl d' v')  = d == d' && v == v'
-  (CCharLike c)       == (CCharLike c')     = c == c'
-  (CIntLike c)        == (CIntLike c')      = c == c'
-  (CString str)       == (CString str')     = str == str'
-  (CLit lit)          == (CLit lit')        = lit == lit'
-  (COffset off)       == (COffset off')     = possiblyEqualHeapOffset off off'
-  (CCode _)           == (CCode _)          = panic "(==) Code in CAddrMode"
-  (CLabelledCode _ _) == (CLabelledCode _ _)= panic "(==) LabCode in CAddrMode"
-  _                   == _                  = False
-
-
-eqRRel :: RegRelative -> RegRelative -> Bool
-eqRRel (NodeRel x) (NodeRel y)   
-  = virtualHeapOffsetToInt x == virtualHeapOffsetToInt y
-
-eqRRel l@(SpARel _ _) r@(SpARel _ _)    
-  = spARelToInt l == spARelToInt r
-
-eqRRel l@(SpBRel _ _) r@(SpBRel _ _)    
-  = spBRelToInt l == spBRelToInt r
-
-eqRRel (HpRel hp off) (HpRel hp' off')  
-  = (virtualHeapOffsetToInt (hp  `subOff` off)) == 
-    (virtualHeapOffsetToInt (hp' `subOff` off'))
-
-eqRRel _ _ = False
-
-eqRetInfo:: ReturnInfo -> ReturnInfo -> Bool
-eqRetInfo DirectReturn             DirectReturn              = True
-eqRetInfo (StaticVectoredReturn x)  (StaticVectoredReturn x') = x == x'
-eqRetInfo _                        _                         = False
-#endif {- Data Parallel Haskell -}
-\end{code}