[project @ 2002-02-06 11:13:47 by sewardj]
[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCSyn.lhs
index eac8a27..edc2bc0 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.32 2000/08/02 14:13:26 rrt Exp $
+% $Id: AbsCSyn.lhs,v 1.45 2002/02/06 11:13:47 sewardj Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -17,6 +17,7 @@ raw assembler/machine code.
 module AbsCSyn {- (
        -- export everything
        AbstractC(..),
+       C_SRT(..)
        CStmtMacro(..),
        CExprMacro(..),
        CAddrMode(..),
@@ -44,13 +45,16 @@ 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 FastTypes
 
+import Outputable
 \end{code}
 
 @AbstractC@ is a list of Abstract~C statements, but the data structure
@@ -111,12 +115,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,7 +169,7 @@ 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...
@@ -163,20 +187,20 @@ 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
+       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 CLabel LivenessMask        -- A bitmap to be emitted if and only if
+                               -- it is larger than a target machine word.
 
   | CClosureInfoAndCode
        ClosureInfo             -- Explains placement and layout of closure
@@ -191,7 +215,7 @@ stored in a mixed type location.)
   | 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
@@ -212,6 +236,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-} !Int{-length-}
+
+needsSRT :: C_SRT -> Bool
+needsSRT NoC_SRT       = False
+needsSRT (C_SRT _ _ _) = True
 \end{code}
 
 About @CMacroStmt@, etc.: notionally, they all just call some
@@ -304,6 +338,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
@@ -315,7 +353,7 @@ data CAddrMode
 
   | 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 range mIN_CHARLIKE..mAX_CHARLIKE
 
   | CIntLike CAddrMode -- The address of a static int-like closure for the
                        -- specified small integer.  It is guaranteed to be in
@@ -335,6 +373,10 @@ data CAddrMode
        !PrimRep        -- the kind of the result
        CExprMacro      -- the macro to generate a value
        [CAddrMode]     -- and its arguments
+
+  | CBytesPerWord      -- Word size, in bytes, on this platform
+                       -- required for: half-word loads (used in fishing tags
+                       -- out of info tables), and sizeofByteArray#.
 \end{code}
 
 Various C macros for values which are dependent on the back-end layout.
@@ -374,9 +416,9 @@ mkCCostCentreStack ccs = CLbl (mkCCS_Label ccs) DataPtrRep
 
 \begin{code}
 data RegRelative
-  = HpRel      FAST_INT        -- }
-  | SpRel      FAST_INT        -- }- offsets in StgWords
-  | NodeRel    FAST_INT        -- }
+  = HpRel      FastInt -- }
+  | SpRel      FastInt -- }- offsets in StgWords
+  | NodeRel    FastInt -- }
   | CIndex     CAddrMode CAddrMode PrimRep     -- pointer arithmetic :-)
                                                -- CIndex a b k === (k*)a[b]
 
@@ -388,16 +430,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 +453,18 @@ 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.  When we compile via C
+(especially when we bootstrap via HC files), we generate identical C
+code regardless of whether words are 32- or 64-bit on the target
+machine, by postponing the decision of how to store each liveness
+bitmap to C compilation time (or rather, C preprocessing time).
+
 \begin{code}
 type LivenessMask = [BitSet]
 
-data Liveness = LvSmall BitSet
-              | LvLarge CLabel
+data Liveness = Liveness CLabel LivenessMask
 \end{code}
 
 %************************************************************************
@@ -451,13 +500,13 @@ data MagicId
   -- Argument and return registers
   | VanillaReg         -- pointers, unboxed ints and chars
        PrimRep
-       FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
+       FastInt -- its number (1 .. mAX_Vanilla_REG)
 
   | FloatReg           -- single-precision floating-point registers
-       FAST_INT        -- its number (1 .. mAX_Float_REG)
+       FastInt -- its number (1 .. mAX_Float_REG)
 
   | DoubleReg          -- double-precision floating-point registers
-       FAST_INT        -- its number (1 .. mAX_Double_REG)
+       FastInt -- its number (1 .. mAX_Double_REG)
 
   -- STG registers
   | Sp                 -- Stack ptr; points to last occupied stack location.
@@ -470,14 +519,15 @@ data MagicId
                        --   no actual register
   | LongReg            -- long int registers (64-bit, really)
        PrimRep         -- Int64Rep or Word64Rep
-       FAST_INT        -- its number (1 .. mAX_Long_REG)
+       FastInt -- its number (1 .. mAX_Long_REG)
 
   | 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}
@@ -486,26 +536,26 @@ We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 
 \begin{code}
 instance Eq MagicId where
-    reg1 == reg2 = tag reg1 _EQ_ tag reg2
+    reg1 == reg2 = tag reg1 ==# tag reg2
      where
-       tag BaseReg          = (ILIT(0) :: FAST_INT)
-       tag Sp               = ILIT(1)
-       tag Su               = ILIT(2)
-       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) _ADD_ i
-
-       tag (FloatReg i)  = ILIT(8) _ADD_ maxv _ADD_ i
-       tag (DoubleReg i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ i
-       tag (LongReg _ i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ maxd _ADD_ i
-
-        maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
-        maxf = case mAX_Float_REG   of { IBOX(x) -> x }
-        maxd = case mAX_Double_REG of { IBOX(x) -> x }
+       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)
+       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