[project @ 2002-01-03 11:45:06 by simonmar]

Fix for previous commit: use the SRT on the top-level constructor when
deciding whether it has any CAF references, since not all top-level
bindings have CgInfo pinned on.

diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 6c97105..db81d25 100644 (file)
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -68,8 +68,9 @@ import Outputable
 cgTopRhsCon :: Id              -- Name of thing bound to this RHS
            -> DataCon          -- Id
            -> [StgArg]         -- Args
+           -> SRT
            -> FCode (Id, CgIdInfo)
-cgTopRhsCon id con args
+cgTopRhsCon id con args srt
   = ASSERT( not (isDllConApp con args) )       -- checks for litlit args too
     ASSERT( args `lengthIs` dataConRepArity con )
 
@@ -89,8 +90,12 @@ cgTopRhsCon id con args
            closure_info
            dontCareCCS                 -- because it's static data
            (map fst amodes_w_offsets)  -- Sorted into ptrs first, then nonptrs
-           (mayHaveCafRefs (idCafInfo id))
+           (nonEmptySRT srt)           -- has CAF refs
          )                                     `thenC`
+               -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
+               -- because top-level constructors that were floated by
+               -- CorePrep don't have CafInfo attached.  The SRT is more
+               -- reliable.
 
        -- RETURN
     returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index c9d3522..b7f01cb 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -233,11 +233,10 @@ cgTopRhs :: Id -> StgRhs -> SRT -> FCode (Id, CgIdInfo)
        -- It's already been globalised if necessary
 
 cgTopRhs bndr (StgRhsCon cc con args) srt
-  = forkStatics (cgTopRhsCon bndr con args)
+  = forkStatics (cgTopRhsCon bndr con args srt)
 
 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag args body) srt
-  =     -- There should be no free variables
-    ASSERT(null fvs)
+  = ASSERT(null fvs)    -- There should be no free variables
     let 
        lf_info = mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args
     in