%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
-% $Id: CgLetNoEscape.lhs,v 1.11 1998/12/02 13:17:50 simonm Exp $
+% $Id: CgLetNoEscape.lhs,v 1.16 2001/10/25 02:13:11 sof Exp $
%
%********************************************************
%* *
import StgSyn
import CgMonad
import AbsCSyn
-import CLabel ( CLabel )
import CgBindery ( letNoEscapeIdInfo, bindArgsToRegs,
bindNewToStack, buildContLivenessMask, CgIdInfo,
import CgStackery ( mkTaggedVirtStkOffsets,
allocStackTop, deAllocStackTop, freeStackSlots )
import CgUsages ( setRealAndVirtualSp, getRealSp, getSpRelOffset )
-import CLabel ( mkReturnPtLabel )
+import CLabel ( mkReturnInfoLabel )
import ClosureInfo ( mkLFLetNoEscape )
import CostCentre ( CostCentreStack )
import Id ( idPrimRep, Id )
import Var ( idUnique )
import PrimRep ( PrimRep(..), retPrimRepSize )
import BasicTypes ( RecFlag(..) )
+import Unique ( Unique )
+import Util ( splitAtList )
\end{code}
%************************************************************************
arity = length args
lf_info = mkLFLetNoEscape arity
uniq = idUnique binder
- lbl = mkReturnPtLabel uniq
in
-- saveVolatileVarsAndRegs done earlier in cgExpr.
(allocStackTop retPrimRepSize `thenFC` \_ ->
nukeDeadBindings full_live_in_rhss)
- (deAllocStackTop retPrimRepSize `thenFC` \_ ->
- buildContLivenessMask uniq `thenFC` \ liveness ->
- forkAbsC (cgLetNoEscapeBody binder cc args body lbl)
+ (deAllocStackTop retPrimRepSize `thenFC` \_ ->
+ buildContLivenessMask uniq `thenFC` \ liveness ->
+ forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
`thenFC` \ code ->
- getSRTLabel `thenFC` \ srt_label ->
- absC (CRetDirect uniq code (srt_label,srt) liveness)
+ getSRTInfo srt `thenFC` \ srt_info ->
+ absC (CRetDirect uniq code srt_info liveness)
`thenC` returnFC ())
`thenFC` \ (vSp, _) ->
-> CostCentreStack
-> [Id] -- Args
-> StgExpr -- Body
- -> CLabel -- Entry label
+ -> Unique -- Unique for entry label
-> Code
-cgLetNoEscapeBody binder cc all_args body lbl
+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) = splitAt (length arg_regs) all_args
+ (reg_args, stk_args) = splitAtList arg_regs all_args
(sp_stk_args, stk_offsets, stk_tags)
= mkTaggedVirtStkOffsets sp idPrimRep stk_args
-- fill in the frame header only if we fail a heap check:
-- otherwise it isn't needed.
getSpRelOffset sp `thenFC` \sp_rel ->
- let frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
+ let lbl = mkReturnInfoLabel uniq
+ 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 arg_regs stk_tags frame_hdr_asst (Just lbl) (
+ altHeapCheck False arg_regs stk_tags frame_hdr_asst (Just uniq) (
cgExpr body
)