X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgLetNoEscape.lhs;h=2876eb08063c1a654ba4c4fe3159db261402c124;hb=3f5e4368fd4e87e116ce34be4cf9dd0f9f96726d;hp=db8dbcd5b2e754e20958eb43799af9fccc70274f;hpb=c83656b25b1bf88e319311ee6b4068bf20dd2e09;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs
index db8dbcd..2876eb0 100644
--- a/ghc/compiler/codeGen/CgLetNoEscape.lhs
+++ b/ghc/compiler/codeGen/CgLetNoEscape.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 %
-% $Id: CgLetNoEscape.lhs,v 1.17 2002/09/04 10:00:46 simonmar Exp $
+% $Id: CgLetNoEscape.lhs,v 1.21 2003/07/02 13:12:37 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -20,24 +20,19 @@ import StgSyn
 import CgMonad
 import AbsCSyn
 
-import CgBindery	( letNoEscapeIdInfo, bindArgsToRegs,
-			  bindNewToStack, buildContLivenessMask, CgIdInfo,
-			  nukeDeadBindings
-			)
-import CgHeapery	( altHeapCheck )
-import CgRetConv	( assignRegs )
-import CgStackery	( mkTaggedVirtStkOffsets, 
-			  allocStackTop, deAllocStackTop, freeStackSlots )
-import CgUsages		( setRealAndVirtualSp, getRealSp, getSpRelOffset )
+import CgBindery	( CgIdInfo, letNoEscapeIdInfo, nukeDeadBindings	)
+import CgCase		( mkRetDirectTarget, restoreCurrentCostCentre )
+import CgCon		( bindUnboxedTupleComponents )
+import CgHeapery	( unbxTupleHeapCheck )
+import CgStackery	( allocStackTop, deAllocStackTop )
+import CgUsages		( getSpRelOffset )
 import CLabel		( mkReturnInfoLabel )
 import ClosureInfo	( mkLFLetNoEscape )
 import CostCentre       ( CostCentreStack )
-import Id		( idPrimRep, Id )
+import Id		( Id )
 import Var		( idUnique )
 import PrimRep		( PrimRep(..), retPrimRepSize )
 import BasicTypes	( RecFlag(..) )
-import Unique		( Unique )
-import Util		( splitAtList )
 \end{code}
 
 %************************************************************************
@@ -155,12 +150,11 @@ cgLetNoEscapeClosure
 -- ToDo: deal with the cost-centre issues
 
 cgLetNoEscapeClosure 
-	binder cc binder_info srt full_live_in_rhss 
+	bndr cc binder_info srt full_live_in_rhss 
 	rhs_eob_info cc_slot rec args body
   = let
 	arity   = length args
 	lf_info = mkLFLetNoEscape arity
-	uniq    = idUnique binder
     in
 
     -- saveVolatileVarsAndRegs done earlier in cgExpr.
@@ -172,63 +166,43 @@ cgLetNoEscapeClosure
 	 nukeDeadBindings full_live_in_rhss)
 
 	(deAllocStackTop retPrimRepSize		`thenFC` \_ ->
-	 buildContLivenessMask uniq		`thenFC` \ liveness ->
-     	 forkAbsC (cgLetNoEscapeBody binder cc args body uniq) 
-						`thenFC` \ code ->
-	 getSRTInfo srt				`thenFC` \ srt_info -> 
-	 absC (CRetDirect uniq code srt_info liveness)
-		`thenC` returnFC ())
-	    	    	    	     	`thenFC` \ (vSp, _) ->
-
-    returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
+	 forkAbsC (
+-- TEMP omit for line-by-line compatibility
+--	    restoreCurrentCostCentre cc_slot	`thenC`
+	    cgLetNoEscapeBody bndr cc args body
+	 )					`thenFC` \ abs_c ->
+	 mkRetDirectTarget bndr abs_c srt
+		-- Ignore the label that comes back from
+		-- mkRetDirectTarget.  It must be conjured up elswhere
+	)    	    	    	     	`thenFC` \ (vSp, _) ->
+
+    returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info)
 \end{code}
 
 \begin{code}
-cgLetNoEscapeBody :: Id
+cgLetNoEscapeBody :: Id		-- Name of the joint point
 		  -> CostCentreStack
 		  -> [Id]	-- Args
 		  -> StgExpr	-- Body
-		  -> Unique     -- Unique for entry label
 		  -> Code
 
-cgLetNoEscapeBody binder cc all_args body uniq
-   = 
-     -- this is where the stack frame lives:
-     getRealSp   `thenFC` \sp -> 
-
-     let
-	arg_kinds	     = map idPrimRep all_args
-	(arg_regs, _)	     = assignRegs [{-nothing live-}] arg_kinds
-	(reg_args, stk_args) = splitAtList arg_regs all_args
-
-    	(sp_stk_args, stk_offsets, stk_tags)
-	  = mkTaggedVirtStkOffsets sp idPrimRep stk_args
-     in
-
-	-- Bind args to appropriate regs/stk locns
-     bindArgsToRegs reg_args arg_regs		    `thenC`
-     mapCs bindNewToStack stk_offsets		    `thenC`
-     setRealAndVirtualSp sp_stk_args		    `thenC`
-
-	-- free up the stack slots containing tags, and the slot
-	-- containing the return address (really frame header).
- 	-- c.f. CgCase.cgUnboxedTupleAlt.
-     freeStackSlots (sp : map fst stk_tags)	    `thenC`
+cgLetNoEscapeBody bndr cc all_args body
+   = bindUnboxedTupleComponents all_args	`thenFC` \ (arg_regs, ptrs, nptrs, ret_slot) ->
 
 	-- Enter the closures cc, if required
      --enterCostCentreCode closure_info cc IsFunction  `thenC`
 
- 	-- fill in the frame header only if we fail a heap check:
-	-- otherwise it isn't needed.
-     getSpRelOffset sp			`thenFC` \sp_rel ->
-     let lbl = mkReturnInfoLabel uniq
+ 	-- The "return address" slot doesn't have a return address in it;
+	-- but the heap-check needs it filled in if the heap-check fails.
+	-- So we pass code to fill it in to the heap-check macro
+     getSpRelOffset ret_slot			`thenFC` \ sp_rel ->
+     let lbl 		= mkReturnInfoLabel (idUnique bndr)
 	 frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
      in
 
 	-- Do heap check [ToDo: omit for non-recursive case by recording in
 	--	in envt and absorbing at call site]
-     altHeapCheck False True arg_regs stk_tags frame_hdr_asst (Just uniq) (
+     unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst (
 	cgExpr body
      )
-
 \end{code}