[project @ 1998-10-21 11:28:00 by sof]
[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCSyn.lhs
index f23614d..05972fa 100644 (file)
@@ -12,9 +12,7 @@ From @AbstractC@, one may convert to real C (for portability) or to
 raw assembler/machine code.
 
 \begin{code}
-#include "HsVersions.h"
-
-module AbsCSyn (
+module AbsCSyn {- (
        -- export everything
        AbstractC(..),
        CStmtMacro(..),
@@ -26,68 +24,45 @@ module AbsCSyn (
        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,
+       isVolatileReg, noLiveRegsMask, mkLiveRegsMask,
+       CostRes(Cost)
+    )-} where
 
-       -- closure info
-       ClosureInfo, LambdaFormInfo, UpdateFlag, SMRep,
+#include "HsVersions.h"
 
-       -- stuff from AbsCUtils and PprAbsC...
-       nonemptyAbsC, flattenAbsC, getAmodeRep,
-       mixedTypeLocn, mixedPtrLocn,
-       writeRealC,
-       dumpRealC,
-       kindFromMagicId,
-       amodeCanSurviveGC
+import {-# SOURCE #-} ClosureInfo ( ClosureInfo )
+import {-# SOURCE #-} CLabel     ( CLabel )
 
-#ifdef GRAN
-       , CostRes(Cost)
+#if  ! OMIT_NATIVE_CODEGEN
+import {-# SOURCE #-} MachMisc
 #endif
 
-       -- and stuff to make the interface self-sufficient
-    ) where
-
-import AbsCUtils       -- used, and re-exported
-import ClosureInfo     -- ditto
-import Costs
-import PprAbsC         -- ditto
-import HeapOffs                hiding ( hpRelToInt )
-
-import PrelInfo                ( 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 Literal         ( mkMachInt, mkMachWord, Literal(..) )
-import CLabel
-import CgCompInfo      ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG )
-import CostCentre      -- for CostCentre type
-import Id              ( Id, ConTag(..), DataCon(..) )
-import Maybes          ( Maybe )
-import Outputable
-import PrimRep         ( PrimRep(..) )
-import StgSyn          ( GenStgExpr, GenStgArg, StgBinderInfo )
-import UniqSet         ( UniqSet(..), UniqFM )
-import Unpretty                -- ********** NOTE **********
-import Util
+import HeapOffs                ( VirtualSpAOffset, VirtualSpBOffset,
+                         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}
+absCNop = AbsCNop
+
 data AbstractC
   = AbsCNop
   | AbsCStmts          AbstractC AbstractC
@@ -175,6 +150,17 @@ stored in a mixed type location.)
   | CCallProfCtrMacro  FAST_STRING     [CAddrMode]
   | CCallProfCCMacro   FAST_STRING     [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        PrimOp{-CCallOp-} [CAddrMode] [CAddrMode]
+
   -- *** the next three [or so...] are DATA (those above are CODE) ***
 
   | CStaticClosure
@@ -252,17 +238,13 @@ data CStmtMacro
   | UPD_BH_SINGLE_ENTRY
   | PUSH_STD_UPD_FRAME
   | POP_STD_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
+  | GRAN_YIELD                 -- for GrAnSim only  -- HWL 
   deriving Text
-
 \end{code}
 
 \item[@CCallProfCtrMacro@:]
@@ -436,7 +418,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
-
 \end{code}
 
 %************************************************************************
@@ -472,7 +453,7 @@ data MagicId
 
   -- Argument and return registers
   | VanillaReg         -- pointers, unboxed ints and chars
-       PrimRep -- PtrRep, IntRep, CharRep, StablePtrRep or MallocPtrRep
+       PrimRep         -- PtrRep, IntRep, CharRep, StablePtrRep or ForeignObjRep
                        --      (in case we need to distinguish)
        FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
 
@@ -482,6 +463,10 @@ data MagicId
   | DoubleReg  -- double-precision floating-point registers
        FAST_INT        -- its number (1 .. mAX_Double_REG)
 
+  | LongReg            -- long int registers (64-bit, really)
+       PrimRep         -- Int64Rep or Word64Rep
+       FAST_INT        -- its number (1 .. mAX_Long_REG)
+
   | TagReg     -- to return constructor tags; as almost all returns are vectored,
                -- this is rarely used.
 
@@ -512,40 +497,63 @@ data MagicId
 
 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
-    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 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
-
-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 }
+    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 reg =
+          ILIT(15) _ADD_ (
+         case reg of
+           VanillaReg _ i -> i
+           FloatReg i     -> maxv _ADD_ i
+           DoubleReg i    -> maxv _ADD_ maxf _ADD_ i
+           LongReg _ i    -> maxv _ADD_ maxf _ADD_ maxd _ADD_ i
+         )
+         where
+           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 }
 \end{code}
 
 Returns True for any register that {\em potentially} dies across