[project @ 2004-08-13 10:45:16 by simonmar]

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

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index e66f7a7..3c8a470 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCSyn.lhs
+++ b/ghc/compiler/absCSyn/AbsCSyn.lhs
@@ -1,5 +1,7 @@
 %
 %

-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+% $Id: AbsCSyn.lhs,v 1.56 2003/11/17 14:47:53 simonmar Exp $

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

@@ -12,98 +14,27 @@ From @AbstractC@, one may convert to real C (for portability) or to
 raw assembler/machine code.
 
 \begin{code}
 raw assembler/machine code.
 
 \begin{code}

+module AbsCSyn where   -- export everything
+

 #include "HsVersions.h"
 
 #include "HsVersions.h"
 

-module AbsCSyn (
-       -- export everything
-       AbstractC(..),
-       CStmtMacro(..),
-       CExprMacro(..),
-       CAddrMode(..),
-       ReturnInfo(..),
-       mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
-       mkIntCLit, 
-       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,
-       isVolatileReg,
-
-       -- closure info
-       ClosureInfo, LambdaFormInfo, UpdateFlag, SMRep,
-
-       -- stuff from AbsCFuns and PprAbsC...
-       nonemptyAbsC, flattenAbsC, getAmodeKind,
-       mixedTypeLocn, mixedPtrLocn,
-#ifdef __GLASGOW_HASKELL__
-       writeRealC,
-#endif
-       dumpRealC,
-       kindFromMagicId, -- UNUSED: getDestinationRegs,
-       amodeCanSurviveGC,
-
-#ifdef GRAN
-       CostRes(Cost),
-#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 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 {-# SOURCE #-} ClosureInfo ( ClosureInfo )
+
+import CLabel
+import Constants       ( mAX_Vanilla_REG, mAX_Float_REG,
+                         mAX_Double_REG, spRelToInt )
+import CostCentre       ( CostCentre, CostCentreStack )
+import Literal         ( mkMachInt, Literal(..) )
+import ForeignCall     ( CCallSpec )
+import PrimRep         ( PrimRep(..) )
+import MachOp          ( MachOp(..) )
+import Unique           ( Unique )
+import StgSyn          ( StgOp )
+import TyCon           ( TyCon )
+import Bitmap          ( Bitmap, mAX_SMALL_BITMAP_SIZE )
+import SMRep           ( StgWord, StgHalfWord )
+import FastTypes
+import FastString

 \end{code}
 
 @AbstractC@ is a list of Abstract~C statements, but the data structure
 \end{code}
 
 @AbstractC@ is a list of Abstract~C statements, but the data structure

@@ -120,17 +51,17 @@ 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}
   | CAssign
 stored in a mixed type location.)
 
 \begin{code}
   | CAssign

-       CAddrMode       -- target
-       CAddrMode       -- source
+       !CAddrMode      -- target
+       !CAddrMode      -- source

 
   | 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)
 

@@ -139,12 +70,12 @@ stored in a mixed type location.)
                        -- (for the benefit of the native code generators)
                        -- Equivalent to CJump in C land
 
                        -- (for the benefit of the native code generators)
                        -- Equivalent to CJump in C land
 

-  | CReturn            -- This used to be RetVecRegRel
-       CAddrMode       -- Any base address mode
-       ReturnInfo      -- How to get the return address from the base address
+  | CReturn            -- Perform a return
+       CAddrMode       -- Address of a RET_<blah> info table
+       ReturnInfo      -- Whether it's a direct or vectored return

 
 

-  | CSwitch CAddrMode
-       [(BasicLit, AbstractC)] -- alternatives
+  | CSwitch !CAddrMode
+       [(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.

@@ -154,7 +85,6 @@ stored in a mixed type location.)
                                --  CSwitch m [(tag,code)] AbsCNop == code
 
   | CCodeBlock CLabel AbstractC
                                --  CSwitch m [(tag,code)] AbsCNop == code
 
   | CCodeBlock CLabel AbstractC

-                       -- [amode analog: CLabelledCode]

                        -- A labelled block of code; this "statement" is not
                        -- executed; rather, the labelled code will be hoisted
                        -- out to the top level (out of line) & it can be
                        -- A labelled block of code; this "statement" is not
                        -- executed; rather, the labelled code will be hoisted
                        -- out to the top level (out of line) & it can be

@@ -162,28 +92,46 @@ stored in a mixed type location.)
 
   | CInitHdr           -- to initialise the header of a closure (both fixed/var parts)
        ClosureInfo
 
   | CInitHdr           -- to initialise the header of a closure (both fixed/var parts)
        ClosureInfo

-       RegRelative     -- address of the info ptr
-       CAddrMode       -- cost centre to place in closure
+       CAddrMode       -- address of the info ptr
+       !CAddrMode      -- cost centre to place in closure

                        --   CReg CurCostCentre or CC_HDR(R1.p{-Node-})
                        --   CReg CurCostCentre or CC_HDR(R1.p{-Node-})

-       Bool            -- inplace update or allocate
+       Int             -- size of closure, for profiling
+
+  -- NEW CASES FOR EXPANDED PRIMOPS
+
+  | CMachOpStmt                        -- Machine-level operation
+       CAddrMode               -- result
+       MachOp
+       [CAddrMode]             -- Arguments
+        (Maybe [MagicId])      -- list of regs which need to be preserved
+       -- across the primop.  This is allowed to be Nothing only if
+       -- machOpIsDefinitelyInline returns True.  And that in turn may
+       -- only return True if we are absolutely sure that the mach op
+       -- can be done inline on all platforms.  
+
+  | CSequential                -- Do the nested AbstractCs sequentially.
+       [AbstractC]     -- In particular, as far as the AbsCUtils.doSimultaneously
+                       -- is concerned, these stmts are to be treated as atomic
+                       -- and are not to be reordered.
+
+  -- end of NEW CASES FOR EXPANDED PRIMOPS

 
   | COpStmt
        [CAddrMode]     -- Results
 
   | COpStmt
        [CAddrMode]     -- Results

-       PrimOp
+       StgOp

        [CAddrMode]     -- Arguments
        [CAddrMode]     -- Arguments

-       Int             -- Live registers (may be obtainable from volatility? ADR)

        [MagicId]       -- Potentially volatile/live registers
                        -- (to save/restore around the call/op)
 
        -- 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).
        [MagicId]       -- Potentially volatile/live registers
                        -- (to save/restore around the call/op)
 
        -- 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

@@ -191,75 +139,94 @@ stored in a mixed type location.)
                        -- For example { a := b, b := a }
                        --      needs to go via (at least one) temporary
 
                        -- For example { a := b, b := a }
                        --      needs to go via (at least one) temporary
 

+  | CCheck             -- heap or stack checks, or both.  
+       CCheckMacro     -- These might include some code to fill in tags 
+       [CAddrMode]     -- on the stack, so we can't use CMacroStmt below.
+       AbstractC
+
+  | CRetDirect                 -- Direct return
+        !Unique                        -- for making labels
+       AbstractC               -- return code
+       C_SRT                   -- SRT info
+       Liveness                -- stack liveness at the return point
+

   -- see the notes about these next few; they follow below...
   | CMacroStmt         CStmtMacro      [CAddrMode]
   -- see the notes about these next few; they follow below...
   | CMacroStmt         CStmtMacro      [CAddrMode]

-  | CCallProfCtrMacro  FAST_STRING     [CAddrMode]
-  | CCallProfCCMacro   FAST_STRING     [CAddrMode]
+  | CCallProfCtrMacro  FastString      [CAddrMode]
+  | CCallProfCCMacro   FastString      [CAddrMode]
+
+    {- The presence of this constructor is a makeshift solution;
+       it being used to work around a gcc-related problem of
+       handling typedefs within statement blocks (or, rather,
+       the inability to do so.)
+       
+       The AbstractC flattener takes care of lifting out these
+       typedefs if needs be (i.e., when generating .hc code and
+       compiling 'foreign import dynamic's)
+    -}
+  | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-}
+                CCallSpec Unique [CAddrMode] [CAddrMode]

 
   -- *** the next three [or so...] are DATA (those above are CODE) ***
 
   | CStaticClosure
 
   -- *** the next three [or so...] are DATA (those above are CODE) ***
 
   | CStaticClosure

-       CLabel  -- The (full, not base) label to use for labelling the closure.
-       ClosureInfo     
-       CAddrMode       -- cost centre identifier to place in closure   
-       [CAddrMode]     -- free vars; ptrs, then non-ptrs
-
+       CLabel                  -- The closure's label
+       ClosureInfo             -- Todo: maybe info_lbl & closure_lbl instead?
+       CAddrMode               -- cost centre identifier to place in closure
+       [CAddrMode]             -- free vars; ptrs, then non-ptrs.
+
+  | CSRT CLabel [CLabel]       -- SRT declarations: basically an array of 
+                               -- pointers to static closures.
+  
+  | CBitmap Liveness           -- A "large" bitmap to be emitted
+
+  | CSRTDesc                   -- A "large" SRT descriptor (one that doesn't
+                               -- fit into the half-word bitmap in the itbl).
+       !CLabel                 -- Label for this SRT descriptor
+       !CLabel                 -- Pointer to the SRT
+       !Int                    -- Offset within the SRT
+       !Int                    -- Length
+       !Bitmap                 -- Bitmap

 
   | CClosureInfoAndCode
 
   | CClosureInfoAndCode

-       ClosureInfo     -- Explains placement and layout of closure
-       AbstractC       -- Slow entry point code
-       (Maybe AbstractC)
-                       -- Fast entry point code, if any
-       CAddrMode       -- Address of update code; Nothing => should never be used
-                       -- (which is the case for all except constructors)
-       String          -- Closure description; NB we can't get this from
-                       -- ClosureInfo, because the latter refers to the *right* hand
-                       -- side of a defn, whereas the "description" refers to *left*
-                       -- hand side
-
-  | CRetVector                 -- Return vector with "holes"
-                               -- (Nothings) for the default
-       CLabel                  -- vector-table label
-       [Maybe CAddrMode]
-       AbstractC               -- (and what to put in a "hole" [when Nothing])
-
-  | CRetUnVector       -- Direct return
-       CLabel          -- unvector-table label
-       CAddrMode       -- return code
-
-  | CFlatRetVector     -- A labelled block of static data
-       CLabel          -- This is the flattened version of CRetVector
+       ClosureInfo             -- Explains placement and layout of closure
+       AbstractC               -- Entry point code
+
+  | CRetVector                 -- A labelled block of static data
+       CLabel

        [CAddrMode]
        [CAddrMode]

+       C_SRT                   -- SRT info
+       Liveness                -- stack liveness at the return point
+
+  | CClosureTbl                -- table of constructors for enumerated types
+       TyCon                   -- which TyCon this table is for
+
+  | CModuleInitBlock           -- module initialisation block
+       CLabel                  -- "plain" label for init block
+       CLabel                  -- label for init block (with ver + way info)
+       AbstractC               -- initialisation code

 
 

-  | CCostCentreDecl    -- A cost centre *declaration*
-       Bool            -- True  <=> local => full declaration
-                       -- False <=> extern; just say so
+  | CCostCentreDecl            -- A cost centre *declaration*
+       Bool                    -- True  <=> local => full declaration
+                               -- False <=> extern; just say so

        CostCentre
 
        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
-
-#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 -}
+  | CCostCentreStackDecl       -- A cost centre stack *declaration*
+       CostCentreStack         -- this is the declaration for a
+                               -- pre-defined singleton CCS (see 
+                               -- CostCentre.lhs)
+
+  | CSplitMarker               -- Split into separate object modules here
+
+-- C_SRT is what StgSyn.SRT gets translated to... 
+-- we add a label for the table, and expect only the 'offset/length' form
+
+data C_SRT = NoC_SRT
+          | C_SRT !CLabel !Int{-offset-} !StgHalfWord{-bitmap or escape-}
+
+needsSRT :: C_SRT -> Bool
+needsSRT NoC_SRT       = False
+needsSRT (C_SRT _ _ _) = True

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

@@ -274,32 +241,49 @@ macros.  An example is @STK_CHK@, which checks for stack-space
 overflow.  This enumeration type lists all such macros:
 \begin{code}
 data CStmtMacro
 overflow.  This enumeration type lists all such macros:
 \begin{code}
 data CStmtMacro

-  = ARGS_CHK_A_LOAD_NODE
-  | ARGS_CHK_A
-  | ARGS_CHK_B_LOAD_NODE
-  | ARGS_CHK_B
-  | HEAP_CHK
-  | STK_CHK
-  | UPD_CAF
-  | UPD_IND
-  | UPD_INPLACE_NOPTRS
-  | UPD_INPLACE_PTRS
-  | UPD_BH_UPDATABLE
-  | UPD_BH_SINGLE_ENTRY
-  | PUSH_STD_UPD_FRAME
-  | POP_STD_UPD_FRAME
---UNUSED:  | PUSH_CON_UPD_FRAME 
-  | SET_ARITY
-  | CHK_ARITY
-  | 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 
+  = UPD_CAF                            -- update CAF closure with indirection
+  | UPD_BH_UPDATABLE                   -- eager backholing
+  | UPD_BH_SINGLE_ENTRY                        -- more eager blackholing
+  | PUSH_UPD_FRAME                     -- push update frame
+  | SET_TAG                            -- set TagReg if it exists
+      -- dataToTag# primop -- *only* used in unregisterised builds.
+      -- (see AbsCUtils.dsCOpStmt)
+  | DATA_TO_TAGZH
+
+  | REGISTER_FOREIGN_EXPORT            -- register a foreign exported fun
+  | REGISTER_IMPORT                    -- register an imported module
+  | REGISTER_DIMPORT                    -- register an imported module from
+                                        -- another DLL
+
+  | 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 
+\end{code}
+
+Heap/Stack checks.  There are far too many of these.

 
 

+\begin{code}
+data CCheckMacro
+
+  = HP_CHK_NP                          -- heap/stack checks when
+  | STK_CHK_NP                         -- node points to the closure
+  | HP_STK_CHK_NP
+
+  | HP_CHK_FUN                         -- heap/stack checks when
+  | STK_CHK_FUN                                -- node doesn't point
+  | HP_STK_CHK_FUN
+                                       -- case alternative heap checks:
+
+  | HP_CHK_NOREGS                      --   no registers live
+  | HP_CHK_UNPT_R1                     --   R1 is boxed/unlifted
+  | HP_CHK_UNBX_R1                     --   R1 is unboxed
+  | HP_CHK_F1                          --   FloatReg1 (only) is live 
+  | HP_CHK_D1                          --   DblReg1   (only) is live
+  | HP_CHK_L1                          --   LngReg1   (only) is live
+
+  | HP_CHK_UNBX_TUPLE                  -- unboxed tuple heap check

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

@@ -311,50 +295,15 @@ The @String@ names a macro that, if \tr{#define}d, will perform some
 cost-centre-profiling-related action.
 \end{description}
 
 cost-centre-profiling-related action.
 \end{description}
 

-HERE ARE SOME OLD NOTES ABOUT HEAP-CHK ENTRY POINTS:
-
-\item[@CCallStgC@:]
-Some parts of the system, {\em notably the storage manager}, are
-implemented by C~routines that must know something about the internals
-of the STG world, e.g., where the heap-pointer is.  (The
-``C-as-assembler'' documents describes this stuff in detail.)
-
-This is quite a tricky business, especially with ``optimised~C,'' so
-we keep close tabs on these fellows.  This enumeration type lists all
-such ``STG~C'' routines:
-
-HERE ARE SOME *OLD* NOTES ABOUT HEAP-CHK ENTRY POINTS:
-
-Heap overflow invokes the garbage collector (of your choice :-), and
-we have different entry points, to tell the GC the exact configuration
-before it.
-\begin{description}
-\item[Branch of a boxed case:]
-The @Node@ register points off to somewhere legitimate, the @TagReg@
-holds the tag, and the @RetReg@ points to the code for the
-alterative which should be resumed. (ToDo: update)
-
-\item[Branch of an unboxed case:]
-The @Node@ register points nowhere of any particular interest, a
-kind-specific register (@IntReg@, @FloatReg@, etc.) holds the unboxed
-value, and the @RetReg@ points to the code for the alternative
-which should be resumed. (ToDo: update)
-
-\item[Closure entry:]
-The @Node@ register points to the closure, and the @RetReg@ points
-to the code to be resumed. (ToDo: update)
-\end{description}
-

 %************************************************************************
 %*                                                                     *
 \subsection[CAddrMode]{C addressing modes}
 %*                                                                     *
 %************************************************************************
 
 %************************************************************************
 %*                                                                     *
 \subsection[CAddrMode]{C addressing modes}
 %*                                                                     *
 %************************************************************************
 

-Addressing modes: these have @PrimitiveKinds@ pinned on them.

 \begin{code}
 data CAddrMode
 \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)

@@ -367,73 +316,41 @@ data CAddrMode
                        --      which gives the magic location itself
                        --      (NB: superceded by CReg)
 
                        --      which gives the magic location itself
                        --      (NB: superceded by CReg)
 

-  | CReg MagicId       -- To replace (CAddr MagicId 0)
+             -- JRS 2002-02-05: CAddr is really scummy and should be fixed.
+             -- The effect is that the semantics of CAddr depend on what the
+             -- contained RegRelative is; it is decidely non-orthogonal.

 
 

-  | CTableEntry            -- CVal should be generalized to allow this
-               CAddrMode   -- Base
-               CAddrMode   -- Offset
-               PrimKind    -- For casting
+  | CReg MagicId       -- To replace (CAddr MagicId 0)

 
 

-  | 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.
 
   | 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
-
-  | CUnVecLbl          -- A choice of labels left up to the back end
-             CLabel    -- direct
-             CLabel    -- vectored
+           PrimRep     -- the kind is so we can generate accurate C decls

 
 

-  | 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 specified character.  It is guaranteed to be in

-                       -- the range 0..255.
+                       -- the range mIN_CHARLIKE..mAX_CHARLIKE

 
   | CIntLike CAddrMode -- The address of a static int-like closure for the
 
   | CIntLike CAddrMode -- The address of a static int-like closure for the

-                       -- specified small integer.  It is guaranteed to be in the
-                       -- range mIN_INTLIKE..mAX_INTLIKE
-
-  | CString FAST_STRING        -- The address of the null-terminated string
-  | CLit    BasicLit
-  | CLitLit FAST_STRING        -- completely literal literal: just spit this String
-                       -- into the C output
-           PrimKind
-
-  | COffset HeapOffset -- A literal constant, not an offset *from* anything!
-                       -- ToDo: this should really be CLitOffset
-
-  | CCode AbstractC    -- Some code.  Used mainly for return addresses.
-
-  | CLabelledCode CLabel AbstractC  -- Almost defunct? (ToDo?) --JSM
-                       -- Some code that must have a particular label
-                       -- (which is jumpable to)
-
-  | CJoinPoint         -- This is used as the amode of a let-no-escape-bound variable
-       VirtualSpAOffset        -- SpA and SpB values after any volatile free vars
-       VirtualSpBOffset        -- of the rhs have been saved on stack.
-                               -- Just before the code for the thing is jumped to,
-                               -- SpA/B will be set to these values,
-                               -- and then any stack-passed args pushed,
-                               -- then the code for this thing will be entered
-
+                       -- specified small integer.  It is guaranteed to be in
+                       -- the range mIN_INTLIKE..mAX_INTLIKE
+
+  | CLit    Literal
+
+  | CJoinPoint         -- This is used as the amode of a let-no-escape-bound
+                       -- variable.
+       VirtualSpOffset   -- Sp value after any volatile free vars
+                         -- of the rhs have been saved on stack.
+                         -- Just before the code for the thing is jumped to,
+                         -- Sp will be set to this value,
+                         -- and then any stack-passed args pushed,
+                         -- then the code for this thing will be entered

   | CMacroExpr
   | 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
-
-  | CCostCentre                -- If Bool is True ==> it to be printed as a String,
-       CostCentre      -- (*not* as a C identifier or some such).
-       Bool            -- (It's not just the double-quotes on either side;
-                       -- spaces and other funny characters will have been
-                       -- fiddled in the non-String variant.)
-
-mkCCostCentre cc
-  = --ASSERT(not (currentOrSubsumedCosts cc))
-    --FALSE: We do put subsumedCC in static closures
-    CCostCentre cc False
+       [CAddrMode]     -- and its arguments

 \end{code}
 
 Various C macros for values which are dependent on the back-end layout.
 \end{code}
 
 Various C macros for values which are dependent on the back-end layout.

@@ -441,18 +358,32 @@ Various C macros for values which are dependent on the back-end layout.
 \begin{code}
 
 data CExprMacro
 \begin{code}
 
 data CExprMacro

-  = INFO_PTR
-  | ENTRY_CODE
-  | INFO_TAG
-  | EVAL_TAG
-  deriving(Text)
-
+  = ENTRY_CODE
+  | ARG_TAG                            -- stack argument tagging
+  | GET_TAG                            -- get current constructor tag
+  | CCS_HDR
+  | BYTE_ARR_CTS               -- used when passing a ByteArray# to a ccall
+  | PTRS_ARR_CTS               -- similarly for an Array#
+  | ForeignObj_CLOSURE_DATA    -- and again for a ForeignObj#

 \end{code}
 
 \end{code}
 

-A tiny convenience:
+Convenience functions:
+

 \begin{code}
 mkIntCLit :: Int -> CAddrMode
 mkIntCLit i = CLit (mkMachInt (toInteger i))
 \begin{code}
 mkIntCLit :: Int -> CAddrMode
 mkIntCLit i = CLit (mkMachInt (toInteger i))

+
+mkWordCLit :: StgWord -> CAddrMode
+mkWordCLit wd = CLit (MachWord (fromIntegral wd))
+
+mkCString :: FastString -> CAddrMode
+mkCString s = CLit (MachStr s)
+
+mkCCostCentre :: CostCentre -> CAddrMode
+mkCCostCentre cc = CLbl (mkCC_Label cc) DataPtrRep
+
+mkCCostCentreStack :: CostCentreStack -> CAddrMode
+mkCCostCentreStack ccs = CLbl (mkCCS_Label ccs) DataPtrRep

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

@@ -463,227 +394,147 @@ mkIntCLit i = CLit (mkMachInt (toInteger i))
 
 \begin{code}
 data RegRelative
 
 \begin{code}
 data RegRelative

-  = HpRel       VirtualHeapOffset      -- virtual offset of Hp
-                VirtualHeapOffset      -- virtual offset of The Thing
-  | SpARel      VirtualSpAOffset       -- virtual offset of SpA
-                VirtualSpAOffset       -- virtual offset of The Thing
-  | SpBRel      VirtualSpBOffset       -- virtual offset of SpB
-                VirtualSpBOffset       -- virtual offset of The Thing
-  | NodeRel     VirtualHeapOffset
+  = HpRel      FastInt -- }
+  | SpRel      FastInt -- }- offsets in StgWords
+  | NodeRel    FastInt -- }
+  | CIndex     CAddrMode CAddrMode PrimRep     -- pointer arithmetic :-)
+                                               -- CIndex a b k === (k*)a[b]

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

+hpRel :: VirtualHeapOffset     -- virtual offset of Hp
+      -> VirtualHeapOffset     -- virtual offset of The Thing
+      -> RegRelative           -- integer offset
+hpRel hp off = HpRel (iUnbox (hp - off))
+
+spRel :: VirtualSpOffset       -- virtual offset of Sp
+      -> VirtualSpOffset       -- virtual offset of The Thing
+      -> RegRelative           -- integer offset
+spRel sp off = SpRel (iUnbox (spRelToInt sp off))
+
+nodeRel :: VirtualHeapOffset
+        -> RegRelative
+nodeRel off = NodeRel (iUnbox off)
+

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

-\subsection[MagicId]{@MagicIds@: registers and such}
+\subsection[Liveness]{Liveness Masks}

 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-Much of what happens in Abstract-C is in terms of ``magic'' locations,
-such as the stack pointer, heap pointer, etc.  If possible, these will
-be held in registers.
-
-Here are some notes about what's active when:
-\begin{description}
-\item[Always active:]
-       Hp, HpLim, SpA, SpB, SuA, SuB
-
-\item[Entry set:]
-       ArgPtr1 (= Node)...
+We represent liveness bitmaps as a BitSet (whose internal
+representation really is a bitmap).  These are pinned onto case return
+vectors to indicate the state of the stack for the garbage collector.

 
 

-\item[Return set:]
-Ptr regs: RetPtr1 (= Node), RetPtr2...
-Int/char regs:  RetData1 (= TagReg = IntReg), RetData2...
-Float regs: RetFloat1, ...
-Double regs: RetDouble1, ...
-\end{description}
+In the compiled program, liveness bitmaps that fit inside a single
+word (StgWord) are stored as a single word, while larger bitmaps are
+stored as a pointer to an array of words. 

 
 \begin{code}
 
 \begin{code}

-data MagicId
-  = BaseReg    -- mentioned only in nativeGen
-
-  | StkOReg    -- mentioned only in nativeGen
-
-  -- Argument and return registers
-  | VanillaReg         -- pointers, unboxed ints and chars
-       PrimKind        -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind
-                       --      (in case we need to distinguish)
-       FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
+data Liveness = Liveness CLabel !Int Bitmap

 
 

-  | FloatReg   -- single-precision floating-point registers
-       FAST_INT        -- its number (1 .. mAX_Float_REG)
+maybeLargeBitmap :: Liveness -> AbstractC
+maybeLargeBitmap liveness@(Liveness _ size _)
+  | size <= mAX_SMALL_BITMAP_SIZE = AbsCNop
+  | otherwise                     = CBitmap liveness
+\end{code}

 
 

-  | DoubleReg  -- double-precision floating-point registers
-       FAST_INT        -- its number (1 .. mAX_Double_REG)
+%************************************************************************
+%*                                                                     *
+\subsection[HeapOffset]{@Heap Offsets@}
+%*                                                                     *
+%************************************************************************

 
 

-  | TagReg     -- to return constructor tags; as almost all returns are vectored,
-               -- this is rarely used.
+This used to be a grotesquely complicated datatype in an attempt to
+hide the details of header sizes from the compiler itself.  Now these
+constants are imported from the RTS, and we deal in real Ints.

 
 

-  | RetReg     -- topmost return address from the B stack
+\begin{code}
+type HeapOffset = Int                  -- ToDo: remove

 
 

-  | SpA                -- Stack ptr; points to last occupied stack location.
-               -- Stack grows downward.
-  | SuA        -- mentioned only in nativeGen
+type VirtualHeapOffset = HeapOffset
+type VirtualSpOffset   = Int
+\end{code}

 
 

-  | SpB                -- Basic values, return addresses and update frames.
-               -- Grows upward.
-  | SuB                -- mentioned only in nativeGen
+%************************************************************************
+%*                                                                     *
+\subsection[MagicId]{@MagicIds@: registers and such}
+%*                                                                     *
+%************************************************************************

 
 

-  | Hp         -- Heap ptr; points to last occupied heap location.
-               -- Free space at lower addresses.
+\begin{code}
+data MagicId
+  = BaseReg    -- mentioned only in nativeGen

 
 

-  | HpLim      -- Heap limit register: mentioned only in nativeGen
+  -- Argument and return registers
+  | VanillaReg         -- pointers, unboxed ints and chars
+       PrimRep
+       FastInt -- its number (1 .. mAX_Vanilla_REG)

 
 

-  | LivenessReg        -- (parallel only) used when we need to record explicitly
-               -- what registers are live
+  | FloatReg           -- single-precision floating-point registers
+       FastInt -- its number (1 .. mAX_Float_REG)

 
 

-  | ActivityReg                -- mentioned only in nativeGen
-  | StdUpdRetVecReg    -- mentioned only in nativeGen
-  | StkStubReg         -- register holding STK_STUB_closure (for stubbing dead stack slots)
+  | DoubleReg          -- double-precision floating-point registers
+       FastInt -- its number (1 .. mAX_Double_REG)

 
 

-  | CurCostCentre -- current cost centre register.
+  -- 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
+  | CurCostCentre      -- current cost centre register.
+  | VoidReg            -- see "VoidPrim" type; just a placeholder; 
+                       --   no actual register
+  | LongReg            -- long int registers (64-bit, really)
+       PrimRep         -- Int64Rep or Word64Rep
+       FastInt -- its number (1 .. mAX_Long_REG)

 
 

-  | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
+  | CurrentTSO         -- pointer to current thread's TSO
+  | CurrentNursery     -- pointer to allocation area
+  | HpAlloc            -- allocation count for heap check failure

 
 

-#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 PtrRep     (_ILIT 1) -- A convenient alias for Node
+tagreg  = VanillaReg WordRep    (_ILIT 2) -- A convenient alias for TagReg

 
 

-node   = VanillaReg PtrKind     ILIT(1) -- A convenient alias for Node
-infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr
+nodeReg = CReg node

 \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)
-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 ==# tag reg2
+     where
+       tag BaseReg          = (_ILIT(0) :: FastInt)
+       tag Sp               = _ILIT(1)
+       tag SpLim            = _ILIT(3)
+       tag Hp               = _ILIT(4)
+       tag HpLim            = _ILIT(5)
+       tag CurCostCentre    = _ILIT(6)
+       tag VoidReg          = _ILIT(7)
+
+       tag (VanillaReg _ i) = _ILIT(8) +# i
+
+       tag (FloatReg i)  = _ILIT(8) +# maxv +# i
+       tag (DoubleReg i) = _ILIT(8) +# maxv +# maxf +# i
+       tag (LongReg _ i) = _ILIT(8) +# maxv +# maxf +# maxd +# i
+
+        maxv = iUnbox mAX_Vanilla_REG
+        maxf = iUnbox mAX_Float_REG
+        maxd = iUnbox mAX_Double_REG

 \end{code}
 
 Returns True for any register that {\em potentially} dies across
 C calls (or anything near equivalent).  We just say @True@ and
 let the (machine-specific) registering macros sort things out...
 \end{code}
 
 Returns True for any register that {\em potentially} dies across
 C calls (or anything near equivalent).  We just say @True@ and
 let the (machine-specific) registering macros sort things out...

-\begin{code}
-isVolatileReg :: MagicId -> Bool
-
-isVolatileReg any      = True
---isVolatileReg (FloatReg _)   = True
---isVolatileReg (DoubleReg _)  = True
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection[AbsCSyn-printing]{Pretty-printing Abstract~C}
-%*                                                                     *
-%************************************************************************
-
-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}
 
 \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 -}
+isVolatileReg :: MagicId -> Bool
+isVolatileReg any = True

 \end{code}
 \end{code}