[project @ 1999-06-24 13:04:13 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 86f90af..e04a4c2 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.29 1999/05/11 16:44:02 keithw Exp $
+% $Id: CgClosure.lhs,v 1.33 1999/06/24 13:04:17 simonmar Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -22,7 +22,6 @@ import {-# SOURCE #-} CgExpr ( cgExpr )
 import CgMonad
 import AbsCSyn
 import StgSyn
-import BasicTypes      ( TopLevelFlag(..) )
 
 import AbsCUtils       ( mkAbstractCs, getAmodeRep )
 import CgBindery       ( getCAddrMode, getArgAmodes,
@@ -36,12 +35,12 @@ import CgHeapery    ( allocDynClosure,
                          fetchAndReschedule, yield,  -- HWL
                          fastEntryChecks, thunkChecks
                        )
-import CgStackery      ( adjustRealSp, mkTaggedVirtStkOffsets, freeStackSlots )
-import CgUsages                ( setRealAndVirtualSp, getVirtSp,
+import CgStackery      ( mkTaggedVirtStkOffsets, freeStackSlots )
+import CgUsages                ( adjustSpAndHp, setRealAndVirtualSp, getVirtSp,
                          getSpRelOffset, getHpRelOffset
                        )
 import CLabel          ( CLabel, mkClosureLabel, mkFastEntryLabel,
-                         mkRednCountsLabel, mkStdEntryLabel
+                         mkRednCountsLabel, mkInfoTableLabel
                        )
 import ClosureInfo     -- lots and lots of stuff
 import CmdLineOpts     ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
@@ -358,8 +357,9 @@ closureCodeBody binder_info closure_info cc all_args body
            absC (mkAbstractCs (zipWith assign_to_reg arg_regs stk_amodes)) 
                                                            `thenC`
 
-           -- Now adjust real stack pointers
-           adjustRealSp sp_stk_args                    `thenC`
+           -- Now adjust real stack pointers (no need to adjust Hp,
+           -- but call this function for convenience).
+           adjustSpAndHp sp_stk_args                   `thenC`
 
            absC (CFallThrough (CLbl fast_label CodePtrRep))
 
@@ -372,21 +372,17 @@ closureCodeBody binder_info closure_info cc all_args body
 
        fast_entry_code
          = profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
-                   mkIntCLit stg_arity         -- total # of args
-
-               {-  CLbl (mkRednCountsLabel name) PtrRep,
-                   CString (_PK_ (showSDoc (ppr name))),
+                   CLbl (mkRednCountsLabel name) PtrRep,
+                   mkCString (_PK_ (showSDoc (ppr name))),
                    mkIntCLit stg_arity,        -- total # of args
                    mkIntCLit sp_stk_args,      -- # passed on stk
-                   CString (_PK_ (map (showTypeCategory . idType) all_args)),
-                   CString SLIT(""), CString SLIT("")
-               -}
+                   mkCString (_PK_ (map (showTypeCategory . idType) all_args))
+               ]                       `thenC`
 
 -- Nuked for now; see comment at end of file
 --                 CString (_PK_ (show_wrapper_name wrapper_maybe)),
 --                 CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
 
-               ]                       `thenC`
 
                -- Bind args to regs/stack as appropriate, and
                -- record expected position of sps.
@@ -401,7 +397,7 @@ closureCodeBody binder_info closure_info cc all_args body
            enterCostCentreCode closure_info cc IsFunction False `thenC`
 
                -- Do the business
-           funWrapper closure_info arg_regs stk_tags slow_label (cgExpr body)
+           funWrapper closure_info arg_regs stk_tags info_label (cgExpr body)
     in
        -- Make a labelled code-block for the slow and fast entry code
     forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)
@@ -429,7 +425,7 @@ closureCodeBody binder_info closure_info cc all_args body
        -- Manufacture labels
     name       = closureName closure_info
     fast_label = mkFastEntryLabel name stg_arity
-    slow_label = mkStdEntryLabel name
+    info_label = mkInfoTableLabel name
 \end{code}
 
 For lexically scoped profiling we have to load the cost centre from
@@ -572,10 +568,10 @@ thunkWrapper closure_info label thunk_code
 funWrapper :: ClosureInfo      -- Closure whose code body this is
           -> [MagicId]         -- List of argument registers (if any)
           -> [(VirtualSpOffset,Int)] -- tagged stack slots
-          -> CLabel            -- slow entry point for heap check ret.
+          -> CLabel            -- info table for heap check ret.
           -> Code              -- Body of function being compiled
           -> Code
-funWrapper closure_info arg_regs stk_tags slow_label fun_body
+funWrapper closure_info arg_regs stk_tags info_label fun_body
   =    -- Stack overflow check
     nodeMustPointToIt (closureLFInfo closure_info)     `thenFC` \ node_points ->
     let
@@ -587,7 +583,7 @@ funWrapper closure_info arg_regs stk_tags slow_label fun_body
       else absC AbsCNop)                                 `thenC`
 
         -- heap and/or stack checks
-    fastEntryChecks arg_regs stk_tags slow_label node_points (
+    fastEntryChecks arg_regs stk_tags info_label node_points (
 
        -- Finally, do the business
     fun_body
@@ -638,13 +634,13 @@ setupUpdate closure_info code
                            link_caf seCafBlackHoleClosureInfo `thenFC` \ _ -> nopC
                          else
                            nopC)                                                       `thenC`
-                        profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [CString cl_name] `thenC`
+                        profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [mkCString cl_name] `thenC`
                         profCtrC SLIT("TICK_UPDF_OMITTED") []                           `thenC`
                        code
        (True ,False) -> pushUpdateFrame (CReg node) code
        (True ,True ) -> -- blackhole the (updatable) CAF:
                         link_caf cafBlackHoleClosureInfo           `thenFC` \ update_closure ->
-                        profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [CString cl_name]    `thenC`
+                        profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [mkCString cl_name]    `thenC`
                         pushUpdateFrame update_closure code
  where
    cl_name :: FAST_STRING