[project @ 2006-01-17 16:13:18 by simonmar]

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

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index dc5e9ea..1a2cbc5 100644 (file)
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.63 2004/08/13 13:05:54 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.72 2005/05/18 12:06:51 simonmar Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -40,13 +40,12 @@ import MachOp               ( MachHint(..) )
 import Cmm
 import CmmUtils                ( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts,
                          mkLblExpr )
-import CLabel          ( mkRtsDataLabel, mkClosureLabel, mkRednCountsLabel,
-                         mkSlowEntryLabel, mkIndStaticInfoLabel )
+import CLabel
 import StgSyn
-import CmdLineOpts     ( opt_DoTickyProfiling )
+import StaticFlags     ( opt_DoTickyProfiling )
 import CostCentre      
 import Id              ( Id, idName, idType )
-import Name            ( Name )
+import Name            ( Name, isExternalName )
 import Module          ( Module, pprModule )
 import ListSetOps      ( minusList )
 import Util            ( isIn, mapAccumL, zipWithEqual )
@@ -83,7 +82,7 @@ cgTopRhsClosure id ccs binder_info srt upd_flag args body = do
   ; mod_name <- moduleName
   ; let descr         = closureDescription mod_name name
        closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
-       closure_label = mkClosureLabel name
+       closure_label = mkLocalClosureLabel name
        cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
        closure_rep   = mkStaticClosureFields closure_info ccs True []
 
@@ -120,7 +119,8 @@ cgStdRhsClosure bndr cc bndr_info fvs args body lf_info payload
   {    -- LAY OUT THE OBJECT
     amodes <- getArgAmodes payload
   ; mod_name <- moduleName
-  ; let (tot_wds, ptr_wds, amodes_w_offsets) = mkVirtHeapOffsets amodes
+  ; let (tot_wds, ptr_wds, amodes_w_offsets) 
+           = mkVirtHeapOffsets (isLFThunk lf_info) amodes
 
        descr        = closureDescription mod_name (idName bndr)
        closure_info = mkClosureInfo False      -- Not static
@@ -156,7 +156,7 @@ cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do
        -- it in the closure.  Instead, just bind it to Node on entry.
        -- NB we can be sure that Node will point to it, because we
        -- havn't told mkClosureLFInfo about this; so if the binder
-       -- *was* a free var of its RHS, mkClosureLFInfo thinks it *is*
+       -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
        -- stored in the closure itself, so it will make sure that
        -- Node points to it...
     let
@@ -171,7 +171,9 @@ cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do
   ; srt_info <- getSRTInfo name srt
   ; mod_name <- moduleName
   ; let        bind_details :: [(CgIdInfo, VirtualHpOffset)]
-       (tot_wds, ptr_wds, bind_details) = mkVirtHeapOffsets (map add_rep fv_infos)
+       (tot_wds, ptr_wds, bind_details) 
+          = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos)
+
        add_rep info = (cgIdInfoArgRep info, info)
 
        descr        = closureDescription mod_name name
@@ -238,7 +240,7 @@ So it should set up an update frame (if it is shared).
 NB: Thunks cannot have a primitive type!
 
 \begin{code}
-closureCodeBody binder_info cl_info cc [] body = do
+closureCodeBody binder_info cl_info cc [{- No args i.e. thunk -}] body = do
   { body_absC <- getCgStmts $ do
        { tickyEnterThunk cl_info
        ; ldvEnter (CmmReg nodeReg)  -- NB: Node always points when profiling
@@ -262,8 +264,9 @@ argSatisfactionCheck (by calling fetchAndReschedule).  There info if
 Node points to closure is available. -- HWL
 
 \begin{code}
-closureCodeBody binder_info cl_info cc args body = do
-  {    -- Get the current virtual Sp (it might not be zero, 
+closureCodeBody binder_info cl_info cc args body 
+  = ASSERT( length args > 0 )
+  do {         -- Get the current virtual Sp (it might not be zero, 
        -- eg. if we're compiling a let-no-escape).
     vSp <- getVirtSp
   ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
@@ -366,7 +369,7 @@ mkSlowEntryCode cl_info reg_args
 
      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
-     jump_to_entry = CmmJump (mkLblExpr (enterIdLabel name)) []
+     jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name)) []
 \end{code}
 
 
@@ -586,7 +589,11 @@ closureDescription :: Module               -- Module
        -- Not called for StgRhsCon which have global info tables built in
        -- CgConTbls.lhs with a description generated from the data constructor
 closureDescription mod_name name
-  = showSDoc (hcat [char '<', pprModule mod_name,
-                   char '.', ppr name, char '>'])
+  = showSDocDump (char '<' <>
+                   (if isExternalName name
+                     then ppr name -- ppr will include the module name prefix
+                     else pprModule mod_name <> char '.' <> ppr name) <>
+                   char '>')
+   -- showSDocDump, because we want to see the unique on the Name.
 \end{code}