From 1cfc9faaa059b9b090971399e4eb8ae9d364335c Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 30 Jun 2003 14:27:52 +0000
Subject: [PATCH] [project @ 2003-06-30 14:27:51 by simonpj]
 ------------------- 	Fix a subtle GC bug 
 -------------------

In GHC 6.0, the top-level definition

	f = g

gets compiled as a *non-updatable* THUNK_STATIC closure.  Being non-updatable,
it gets only 1 payload field.  Alas, the static-link field for a THUNK_STATIC
goes in the 3rd payload field.  Disaster.

Solution: make such things updatable. This is probably good because it turns
f into an IND_STATIC, which gets shorted out.  (Even better would be to allocate
an IND_STATIC in the first place.)
---
 ghc/compiler/coreSyn/CoreUtils.lhs |   10 +++++++++-
 ghc/compiler/stgSyn/CoreToStg.lhs  |   24 ++++++++++++------------
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 7aa9b22..5c26e0d 100644
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -1238,7 +1238,15 @@ is_static in_arg other_expr = go other_expr 0
   where
     go (Var f) n_val_args
 	| not (isDllName (idName f))
-	= n_val_args == 0 || saturated_data_con f n_val_args
+	=  saturated_data_con f n_val_args
+	|| (in_arg && n_val_args == 0)	
+		-- A naked un-applied variable is *not* deemed a static RHS
+		-- E.g.		f = g
+		-- Reason: better to update so that the indirection gets shorted
+		-- 	   out, and the true value will be seen
+		-- NB: if you change this, you'll break the invariant that THUNK_STATICs
+		--     are always updatable.  If you do so, make sure that non-updatable
+		--     ones have enough space for their static link field!
 
     go (App f a) n_val_args
 	| isTypeArg a 			 = go f n_val_args
diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 6e1f012..15e9fc3 100644
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -236,31 +236,31 @@ coreToTopStgRhs
 coreToTopStgRhs scope_fv_info (bndr, rhs)
   = coreToStgExpr rhs 		`thenLne` \ (new_rhs, rhs_fvs, _) ->
     freeVarsToLiveVars rhs_fvs	`thenLne` \ lv_info ->
-    returnLne (mkTopStgRhs upd rhs_fvs (mkSRT lv_info) bndr_info new_rhs, rhs_fvs)
+    returnLne (mkTopStgRhs is_static rhs_fvs (mkSRT lv_info) bndr_info new_rhs, rhs_fvs)
   where
     bndr_info = lookupFVInfo scope_fv_info bndr
+    is_static = rhsIsStatic rhs
 
-    upd  | rhsIsStatic rhs = SingleEntry
-	 | otherwise       = Updatable
-
-mkTopStgRhs :: UpdateFlag -> FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr
+mkTopStgRhs :: Bool -> FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr
 	-> StgRhs
 
-mkTopStgRhs upd rhs_fvs srt binder_info (StgLam _ bndrs body)
-  = StgRhsClosure noCCS binder_info
+mkTopStgRhs is_static rhs_fvs srt binder_info (StgLam _ bndrs body)
+  = ASSERT( is_static )
+    StgRhsClosure noCCS binder_info
 		  (getFVs rhs_fvs)		 
 		  ReEntrant
 		  srt
 		  bndrs body
 	
-mkTopStgRhs upd rhs_fvs srt binder_info (StgConApp con args)
-  | not (isUpdatable upd) -- StgConApps can be updatable (see isCrossDllConApp)
+mkTopStgRhs is_static rhs_fvs srt binder_info (StgConApp con args)
+  | is_static	 -- StgConApps can be updatable (see isCrossDllConApp)
   = StgRhsCon noCCS con args
 
-mkTopStgRhs upd rhs_fvs srt binder_info rhs
-  = StgRhsClosure noCCS binder_info
+mkTopStgRhs is_static rhs_fvs srt binder_info rhs
+  = ASSERT( not is_static )
+    StgRhsClosure noCCS binder_info
 		  (getFVs rhs_fvs)		 
-	          upd
+	          Updatable
 		  srt
 	          [] rhs
 \end{code}
-- 
1.7.10.4