[project @ 2000-10-12 13:11:45 by simonmar]
[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCSyn.lhs
index d88a523..6bd34a6 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.23 1999/05/13 17:30:52 simonm Exp $
+% $Id: AbsCSyn.lhs,v 1.34 2000/10/12 13:11:46 simonmar Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -39,17 +39,13 @@ module AbsCSyn {- (
 
 import {-# SOURCE #-} ClosureInfo ( ClosureInfo )
 
-#if  ! OMIT_NATIVE_CODEGEN
-import {-# SOURCE #-} MachMisc
-#endif
-
 import CLabel
 import Constants       ( mAX_Vanilla_REG, mAX_Float_REG,
                          mAX_Double_REG, spRelToInt )
 import CostCentre       ( CostCentre, CostCentreStack )
-import Const           ( mkMachInt, Literal )
+import Literal         ( mkMachInt, Literal(..) )
 import PrimRep         ( PrimRep(..) )
-import PrimOp           ( PrimOp )
+import PrimOp           ( PrimOp, CCall )
 import Unique           ( Unique )
 import StgSyn          ( SRT(..) )
 import TyCon           ( TyCon )
@@ -114,7 +110,7 @@ stored in a mixed type location.)
 
   | CInitHdr           -- to initialise the header of a closure (both fixed/var parts)
        ClosureInfo
-       RegRelative     -- address of the info ptr
+       CAddrMode       -- address of the info ptr
        CAddrMode       -- cost centre to place in closure
                        --   CReg CurCostCentre or CC_HDR(R1.p{-Node-})
 
@@ -166,7 +162,8 @@ stored in a mixed type location.)
        typedefs if needs be (i.e., when generating .hc code and
        compiling 'foreign import dynamic's)
     -}
-  | CCallTypedef        PrimOp{-CCallOp-} [CAddrMode] [CAddrMode]
+  | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-}
+                CCall [CAddrMode] [CAddrMode]
 
   -- *** the next three [or so...] are DATA (those above are CODE) ***
 
@@ -200,6 +197,10 @@ stored in a mixed type location.)
   | CClosureTbl                -- table of constructors for enumerated types
        TyCon                   -- which TyCon this table is for
 
+  | CModuleInitBlock           -- module initialisation block
+       CLabel                  -- label for init block
+       AbstractC               -- initialisation code
+
   | CCostCentreDecl            -- A cost centre *declaration*
        Bool                    -- True  <=> local => full declaration
                                -- False <=> extern; just say so
@@ -232,13 +233,19 @@ data CStmtMacro
   | 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
+
+  | 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 
-  deriving Text
 \end{code}
 
 Heap/Stack checks.  There are far too many of these.
@@ -265,7 +272,6 @@ data CCheckMacro
   | HP_CHK_UT_ALT                      --   unboxed tuple return.
 
   | HP_CHK_GEN                         -- generic heap check
-  deriving Text
 \end{code}
 
 \item[@CCallProfCtrMacro@:]
@@ -300,11 +306,6 @@ data CAddrMode
 
   | CReg MagicId       -- To replace (CAddr MagicId 0)
 
-  | CTableEntry            -- CVal should be generalized to allow this
-               CAddrMode   -- Base
-               CAddrMode   -- Offset
-               PrimRep    -- For casting
-
   | CTemp !Unique !PrimRep     -- Temporary locations
        -- ``Temporaries'' correspond to local variables in C, and registers in
        -- native code.
@@ -314,17 +315,13 @@ 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
                        -- the range mIN_INTLIKE..mAX_INTLIKE
 
-  | CString FAST_STRING        -- The address of the null-terminated string
   | CLit    Literal
-  | CLitLit FAST_STRING        -- completely literal literal: just spit this String
-                       -- into the C output
-           PrimRep
 
   | CJoinPoint         -- This is used as the amode of a let-no-escape-bound
                        -- variable.
@@ -348,7 +345,8 @@ data CExprMacro
   = ENTRY_CODE
   | ARG_TAG                            -- stack argument tagging
   | GET_TAG                            -- get current constructor tag
-  deriving(Text)
+  | UPD_FRAME_UPDATEE
+  | CCS_HDR
 
 \end{code}
 
@@ -358,6 +356,9 @@ Convenience functions:
 mkIntCLit :: Int -> CAddrMode
 mkIntCLit i = CLit (mkMachInt (toInteger i))
 
+mkCString :: FAST_STRING -> CAddrMode
+mkCString s = CLit (MachStr s)
+
 mkCCostCentre :: CostCentre -> CAddrMode
 mkCCostCentre cc = CLbl (mkCC_Label cc) DataPtrRep
 
@@ -373,9 +374,11 @@ 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]
 
 data ReturnInfo
   = DirectReturn                       -- Jump directly, if possible
@@ -385,22 +388,22 @@ 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 _IBOX(hp) _IBOX(off) = HpRel (hp _SUB_ 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 (case spRelToInt sp off of { _IBOX(i) -> i })
 
 nodeRel :: VirtualHeapOffset
         -> RegRelative
-nodeRel IBOX(off) = NodeRel off
+nodeRel _IBOX(off) = NodeRel off
 
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[RegRelative]{@RegRelatives@: ???}
+\subsection[Liveness]{Liveness Masks}
 %*                                                                     *
 %************************************************************************
 
@@ -448,13 +451,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.
@@ -467,38 +470,42 @@ 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
 
 
-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}
 
 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