[project @ 2002-11-18 14:25:29 by simonpj]

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

diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index 8dfd5f4..b0a080e 100644 (file)
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgTailCall.lhs,v 1.31 2001/10/25 05:07:32 sof Exp $
+% $Id: CgTailCall.lhs,v 1.35 2002/10/25 16:54:56 simonpj Exp $
 %
 %********************************************************
 %*                                                     *
@@ -28,7 +28,6 @@ module CgTailCall (
 
 import CgMonad
 import AbsCSyn
-import PprAbsC         ( pprAmode )
 
 import AbsCUtils       ( mkAbstractCs, getAmodeRep )
 import CgBindery       ( getArgAmodes, getCAddrMode, getCAddrModeAndInfo )
@@ -118,8 +117,7 @@ performPrimReturn :: SDoc   -- Just for debugging (sigh)
 performPrimReturn doc amode
   = let
        kind = getAmodeRep amode
-       ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
-                 dataReturnConvPrim kind
+       ret_reg = dataReturnConvPrim kind
 
        assign_possibly = case kind of
          VoidRep -> AbsCNop
@@ -147,7 +145,7 @@ mkStaticAlgReturnCode :: DataCon    -- The constructor
 mkStaticAlgReturnCode con sequel
   =    -- Generate profiling code if necessary
     (case return_convention of
-       VectoredReturn sz -> profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz]
+       VectoredReturn sz -> profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz]
        other             -> nopC
     )                                  `thenC`
 
@@ -226,7 +224,7 @@ mkDynamicAlgReturnCode tycon dyn_tag sequel
   = case ctrlReturnConvAlg tycon of
        VectoredReturn sz ->
 
-               profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
+               profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
                sequelToAmode sequel            `thenFC` \ ret_addr ->
                absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 
@@ -308,7 +306,7 @@ returnUnboxedTuple amodes before_jump
     let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
     in
 
-    profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
+    profCtrC FSLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
 
     doTailCall amodes ret_regs
                mkUnboxedTupleReturnCode
@@ -345,7 +343,7 @@ tailCallFun
 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
   = nodeMustPointToIt lf_info                  `thenFC` \ node_points ->
        -- we use the name of fun', the Id from the environment, rather than
-       -- fun from the STG tree, in case it is a top-level name that we globalised
+       -- fun from the STG tree, in case it is a top-level name that we externalised
        -- (see cgTopRhsClosure).
     getEntryConvention (idName fun) lf_info
        (map getAmodeRep arg_amodes)            `thenFC` \ entry_conv ->
@@ -360,7 +358,7 @@ tailCallFun fun fun_amode lf_info arg_amodes pending_assts
          = case entry_conv of
              ViaNode ->
                ([],
-                    profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
+                    profCtrC FSLIT("TICK_ENT_VIA_NODE") [] `thenC`
                     absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE 
                                [CVal (nodeRel 0) DataPtrRep]))
                     , 0)
@@ -518,7 +516,7 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts
                    enter_jump
                      -- Enter Node (we know infoptr will have the info ptr in it)!
                      = mkAbstractCs [
-                       CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
+                       CCallProfCtrMacro FSLIT("RET_SEMI_FAILED")
                                        [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
                        CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
                in