[project @ 2004-08-13 10:45:16 by simonmar]
[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCSyn.lhs
index 6bd34a6..3c8a470 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.34 2000/10/12 13:11:46 simonmar Exp $
+% $Id: AbsCSyn.lhs,v 1.56 2003/11/17 14:47:53 simonmar Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -14,26 +14,7 @@ From @AbstractC@, one may convert to real C (for portability) or to
 raw assembler/machine code.
 
 \begin{code}
-module AbsCSyn {- (
-       -- export everything
-       AbstractC(..),
-       CStmtMacro(..),
-       CExprMacro(..),
-       CAddrMode(..),
-       ReturnInfo(..),
-       mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
-       mkIntCLit,
-       mkAbsCStmtList,
-       mkCCostCentre,
-
-       -- RegRelatives
-       RegRelative(..),
-
-       -- registers
-       MagicId(..), node, infoptr,
-       isVolatileReg,
-       CostRes(Cost)
-    )-} where
+module AbsCSyn where   -- export everything
 
 #include "HsVersions.h"
 
@@ -44,20 +25,21 @@ 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 PrimOp           ( PrimOp, CCall )
+import MachOp          ( MachOp(..) )
 import Unique           ( Unique )
-import StgSyn          ( SRT(..) )
+import StgSyn          ( StgOp )
 import TyCon           ( TyCon )
-import BitSet                          -- for liveness masks
-
+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
 is tree-ish, for easier and more efficient putting-together.
 \begin{code}
-absCNop = AbsCNop
-
 data AbstractC
   = AbsCNop
   | AbsCStmts          AbstractC AbstractC
@@ -111,12 +93,32 @@ stored in a mixed type location.)
   | CInitHdr           -- to initialise the header of a closure (both fixed/var parts)
        ClosureInfo
        CAddrMode       -- address of the info ptr
-       CAddrMode       -- cost centre to place in closure
+       !CAddrMode      -- cost centre to place in closure
                        --   CReg CurCostCentre or CC_HDR(R1.p{-Node-})
+       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
-       PrimOp
+       StgOp
        [CAddrMode]     -- Arguments
        [MagicId]       -- Potentially volatile/live registers
                        -- (to save/restore around the call/op)
@@ -145,13 +147,13 @@ stored in a mixed type location.)
   | CRetDirect                 -- Direct return
         !Unique                        -- for making labels
        AbstractC               -- return code
-       (CLabel,SRT)            -- SRT info
+       C_SRT                   -- SRT info
        Liveness                -- stack liveness at the return point
 
   -- 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
@@ -163,42 +165,45 @@ stored in a mixed type location.)
        compiling 'foreign import dynamic's)
     -}
   | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-}
-                CCall [CAddrMode] [CAddrMode]
+                CCallSpec Unique [CAddrMode] [CAddrMode]
 
   -- *** 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
+       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 CLabel LivenessMask        -- A larger-than-32-bits bitmap.
+  | 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
        ClosureInfo             -- Explains placement and layout of closure
-       AbstractC               -- Slow entry point code
-       (Maybe AbstractC)
-                               -- Fast entry point code, if any
-       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
+       AbstractC               -- Entry point code
 
   | CRetVector                 -- A labelled block of static data
        CLabel
        [CAddrMode]
-       (CLabel,SRT)            -- SRT info
+       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                  -- label for init block
+       CLabel                  -- "plain" label for init block
+       CLabel                  -- label for init block (with ver + way info)
        AbstractC               -- initialisation code
 
   | CCostCentreDecl            -- A cost centre *declaration*
@@ -212,6 +217,16 @@ stored in a mixed type location.)
                                -- 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
@@ -226,15 +241,14 @@ macros.  An example is @STK_CHK@, which checks for stack-space
 overflow.  This enumeration type lists all such macros:
 \begin{code}
 data CStmtMacro
-  = ARGS_CHK                           -- arg satisfaction check
-  | ARGS_CHK_LOAD_NODE                 -- arg check for top-level functions
-  | UPD_CAF                            -- update CAF closure with indirection
+  = 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
-  | PUSH_SEQ_FRAME                     -- push seq frame
-  | UPDATE_SU_FROM_UPD_FRAME           -- pull Su out of the 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
@@ -256,11 +270,10 @@ data CCheckMacro
   = HP_CHK_NP                          -- heap/stack checks when
   | STK_CHK_NP                         -- node points to the closure
   | HP_STK_CHK_NP
-  | HP_CHK_SEQ_NP                      -- for 'seq' style case alternatives
 
-  | HP_CHK                             -- heap/stack checks when
-  | STK_CHK                            -- node doesn't point
-  | HP_STK_CHK
+  | 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
@@ -269,9 +282,8 @@ data CCheckMacro
   | HP_CHK_F1                          --   FloatReg1 (only) is live 
   | HP_CHK_D1                          --   DblReg1   (only) is live
   | HP_CHK_L1                          --   LngReg1   (only) is live
-  | HP_CHK_UT_ALT                      --   unboxed tuple return.
 
-  | HP_CHK_GEN                         -- generic heap check
+  | HP_CHK_UNBX_TUPLE                  -- unboxed tuple heap check
 \end{code}
 
 \item[@CCallProfCtrMacro@:]
@@ -304,6 +316,10 @@ data CAddrMode
                        --      which gives the magic location itself
                        --      (NB: superceded by CReg)
 
+             -- 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.
+
   | CReg MagicId       -- To replace (CAddr MagicId 0)
 
   | CTemp !Unique !PrimRep     -- Temporary locations
@@ -345,9 +361,10 @@ data CExprMacro
   = ENTRY_CODE
   | ARG_TAG                            -- stack argument tagging
   | GET_TAG                            -- get current constructor tag
-  | UPD_FRAME_UPDATEE
   | 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}
 
 Convenience functions:
@@ -356,7 +373,10 @@ Convenience functions:
 mkIntCLit :: Int -> CAddrMode
 mkIntCLit i = CLit (mkMachInt (toInteger i))
 
-mkCString :: FAST_STRING -> CAddrMode
+mkWordCLit :: StgWord -> CAddrMode
+mkWordCLit wd = CLit (MachWord (fromIntegral wd))
+
+mkCString :: FastString -> CAddrMode
 mkCString s = CLit (MachStr s)
 
 mkCCostCentre :: CostCentre -> CAddrMode
@@ -388,16 +408,16 @@ data ReturnInfo
 hpRel :: VirtualHeapOffset     -- virtual offset of Hp
       -> VirtualHeapOffset     -- virtual offset of The Thing
       -> RegRelative           -- integer offset
-hpRel _IBOX(hp) _IBOX(off) = HpRel (hp _SUB_ off)
+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 (case spRelToInt sp off of { _IBOX(i) -> i })
+spRel sp off = SpRel (iUnbox (spRelToInt sp off))
 
 nodeRel :: VirtualHeapOffset
         -> RegRelative
-nodeRel _IBOX(off) = NodeRel off
+nodeRel off = NodeRel (iUnbox off)
 
 \end{code}
 
@@ -411,11 +431,17 @@ 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.
 
+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}
-type LivenessMask = [BitSet]
+data Liveness = Liveness CLabel !Int Bitmap
 
-data Liveness = LvSmall BitSet
-              | LvLarge CLabel
+maybeLargeBitmap :: Liveness -> AbstractC
+maybeLargeBitmap liveness@(Liveness _ size _)
+  | size <= mAX_SMALL_BITMAP_SIZE = AbsCNop
+  | otherwise                     = CBitmap liveness
 \end{code}
 
 %************************************************************************
@@ -433,9 +459,6 @@ type HeapOffset = Int                       -- ToDo: remove
 
 type VirtualHeapOffset = HeapOffset
 type VirtualSpOffset   = Int
-
-type HpRelOffset       = HeapOffset
-type SpRelOffset       = Int
 \end{code}
 
 %************************************************************************
@@ -461,7 +484,6 @@ data MagicId
 
   -- STG registers
   | Sp                 -- Stack ptr; points to last occupied stack location.
-  | Su                 -- Stack update frame pointer
   | SpLim              -- Stack limit
   | Hp                 -- Heap ptr; points to last occupied heap location.
   | HpLim              -- Heap limit register
@@ -474,10 +496,11 @@ data MagicId
 
   | CurrentTSO         -- pointer to current thread's TSO
   | CurrentNursery     -- pointer to allocation area
+  | HpAlloc            -- allocation count for heap check failure
 
 
-node   = VanillaReg PtrRep     _ILIT(1) -- A convenient alias for Node
-tagreg  = VanillaReg WordRep    _ILIT(2) -- A convenient alias for TagReg
+node   = VanillaReg PtrRep     (_ILIT 1) -- A convenient alias for Node
+tagreg  = VanillaReg WordRep    (_ILIT 2) -- A convenient alias for TagReg
 
 nodeReg = CReg node
 \end{code}
@@ -490,7 +513,6 @@ instance Eq MagicId where
      where
        tag BaseReg          = (_ILIT(0) :: FastInt)
        tag Sp               = _ILIT(1)
-       tag Su               = _ILIT(2)
        tag SpLim            = _ILIT(3)
        tag Hp               = _ILIT(4)
        tag HpLim            = _ILIT(5)