X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgBindery.lhs;h=d5a2c69d600aa3e5b606f786c47b075a59e8ef2c;hb=c6eadadbefe2ec5709e9d31893f79c4ff78754b4;hp=f78edda6554b1f8376159ac3ae015181b0acae1f;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index f78edda..d5a2c69 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[CgBindery]{Utility functions related to doing @CgBindings@}
@@ -18,10 +19,11 @@ module CgBindery (
 	nukeVolatileBinds,
 	nukeDeadBindings,
 	getLiveStackSlots,
+        getLiveStackBindings,
 
 	bindArgsToStack,  rebindToStack,
 	bindNewToNode, bindNewToReg, bindArgsToRegs,
-	bindNewToTemp, 
+	bindNewToTemp,
 	getArgAmode, getArgAmodes, 
 	getCgIdInfo, 
 	getCAddrModeIfVolatile, getVolatileRegs,
@@ -31,26 +33,24 @@ module CgBindery (
 #include "HsVersions.h"
 
 import CgMonad
-import CgHeapery	( getHpRelOffset )
-import CgStackery	( freeStackSlots, getSpRelOffset )
-import CgUtils		( cgLit, cmmOffsetW )
-import CLabel		( mkClosureLabel, pprCLabel )
-import ClosureInfo	( mkLFImported, mkLFArgument, LambdaFormInfo )
+import CgHeapery
+import CgStackery
+import CgUtils
+import CLabel
+import ClosureInfo
 
 import Cmm
 import PprCmm		( {- instance Outputable -} )
-import SMRep		( CgRep(..), WordOff, isFollowableArg, 
-			  isVoidArg, cgRepSizeW, argMachRep, 
-			  idCgRep, typeCgRep )
-import Id		( Id, idName )
+import SMRep
+import Id
 import VarEnv
-import VarSet		( varSetElems )
-import Literal		( literalType )
-import Maybes		( catMaybes )
-import Name		( isExternalName )
-import StgSyn		( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
-import Unique           ( Uniquable(..) )
-import UniqSet		( elementOfUniqSet )
+import VarSet
+import Literal
+import Maybes
+import Name
+import StgSyn
+import Unique
+import UniqSet
 import Outputable
 \end{code}
 
@@ -240,8 +240,8 @@ getCgIdInfo id
 	    name = idName id
 	in
 	if isExternalName name then do
-	    hmods <- getHomeModules 
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel hmods name))
+	    this_pkg <- getThisPackage
+	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel this_pkg name))
 	    return (stableIdInfo id ext_lbl (mkLFImported id))
 	else
 	if isVoidArg (idCgRep id) then
@@ -392,13 +392,16 @@ bindNewToNode id offset lf_info
 -- Create a new temporary whose unique is that in the id,
 -- bind the id to it, and return the addressing mode for the
 -- temporary.
-bindNewToTemp :: Id -> FCode CmmReg
+bindNewToTemp :: Id -> FCode LocalReg
 bindNewToTemp id
-  = do	addBindC id (regIdInfo id temp_reg lf_info)
+  = do	addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
 	return temp_reg
   where
     uniq     = getUnique id
-    temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
+    temp_reg = LocalReg uniq (argMachRep (idCgRep id)) kind
+    kind     = if isFollowableArg (idCgRep id)
+               then KindPtr
+               else KindNonPtr
     lf_info  = mkLFArgument id	-- Always used of things we
 				-- know nothing about
 
@@ -492,3 +495,14 @@ getLiveStackSlots
 				   cg_rep = rep } <- varEnvElts binds, 
 		        isFollowableArg rep] }
 \end{code}
+
+\begin{code}
+getLiveStackBindings :: FCode [(VirtualSpOffset, CgIdInfo)]
+getLiveStackBindings
+  = do { binds <- getBinds
+       ; return [(off, bind) |
+                 bind <- varEnvElts binds,
+                 CgIdInfo { cg_stb = VirStkLoc off,
+                            cg_rep = rep} <- [bind],
+                 isFollowableArg rep] }
+\end{code}