[project @ 1997-08-02 21:27:13 by sof]

[ghc-hetmet.git] / ghc / compiler / codeGen / ClosureInfo.lhs

diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index e43d936..a71f3c0 100644 (file)
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -17,6 +17,7 @@ module ClosureInfo (
 
        mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkVapLFInfo,
        mkLFImported, mkLFArgument, mkLFLetNoEscape,
+       UpdateFlag,
 
        closureSize, closureHdrSize,
        closureNonHdrSize, closureSizeWithoutFixedHdr,
@@ -27,12 +28,15 @@ module ClosureInfo (
        layOutStaticNoFVClosure, layOutPhantomClosure,
        mkVirtHeapOffsets,
 
-       nodeMustPointToIt, getEntryConvention,
+       nodeMustPointToIt, getEntryConvention, 
+       SYN_IE(FCode), CgInfoDownwards, CgState, 
+
        blackHoleOnEntry,
 
        staticClosureRequired,
        slowFunEntryCodeRequired, funInfoTableRequired,
        stdVapRequired, noUpdVapRequired,
+       StgBinderInfo,
 
        closureId, infoTableLabelFromCI, fastLabelFromCI,
        closureLabelFromCI,
@@ -40,6 +44,7 @@ module ClosureInfo (
        closureLFInfo, closureSMRep, closureUpdReqd,
        closureSingleEntry, closureSemiTag, closureType,
        closureReturnsUnboxedType, getStandardFormThunkInfo,
+       GenStgArg,
 
        isToplevClosure,
        closureKind, closureTypeDescr,          -- profiling
@@ -52,9 +57,13 @@ module ClosureInfo (
     ) where
 
 IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
 IMPORT_DELOOPER(AbsCLoop)              -- here for paranoia-checking
+#endif
 
-import AbsCSyn
+import AbsCSyn         ( MagicId, node, mkLiveRegsMask,
+                         {- GHC 0.29 only -} AbstractC, CAddrMode
+                       )
 import StgSyn
 import CgMonad
 
@@ -66,7 +75,7 @@ import Constants      ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
 import CgRetConv       ( assignRegs, dataReturnConvAlg,
                          DataReturnConvention(..)
                        )
-import CLabel          ( mkStdEntryLabel, mkFastEntryLabel,
+import CLabel          ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
                          mkPhantomInfoTableLabel, mkInfoTableLabel,
                          mkConInfoTableLabel, mkStaticClosureLabel, 
                          mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
@@ -732,7 +741,7 @@ nodeMustPointToIt lf_info
        -- having Node point to the result of an update.  SLPJ
        -- 27/11/92.
 
-       LFThunk _ no_fvs updatable _
+       LFThunk _ no_fvs updatable NonStandardThunk
          -> returnFC (updatable || not no_fvs || do_profiling)
 
          -- For the non-updatable (single-entry case):
@@ -742,6 +751,15 @@ nodeMustPointToIt lf_info
          -- or profiling (in which case we need to recover the cost centre
          --             from inside it)
 
+       LFThunk _ no_fvs updatable some_standard_form_thunk
+         -> returnFC True
+         -- Node must point to any standard-form thunk.
+         -- For example,
+         --            x = f y
+         -- generates a Vap thunk for (f y), and even if y is a global
+         -- variable we must still make Node point to the thunk before entering it
+         -- because that's what the standard-form code expects.
+
        LFArgument  -> returnFC True
        LFImported  -> returnFC True
        LFBlackHole -> returnFC True
@@ -977,14 +995,17 @@ staticClosureRequired binder other_binder_info other_lf_info = True
 slowFunEntryCodeRequired       -- Assumption: it's a function, not a thunk.
        :: Id
        -> StgBinderInfo
+       -> EntryConvention
        -> Bool
-slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
+slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
   = arg_occ            -- There's an argument occurrence
     || unsat_occ       -- There's an unsaturated call
     || externallyVisibleId binder
-    {- HAS FREE VARS AND IS PARALLEL WORLD -}
+    || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
+           {- The last case deals with the parallel world; a function usually
+              as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
 
-slowFunEntryCodeRequired binder NoStgBinderInfo = True
+slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
 
 funInfoTableRequired
        :: Id