Commit 5cd3527d authored by simonpj's avatar simonpj
Browse files

[project @ 2001-09-26 15:11:50 by simonpj]

-------------------------------
	Code generation and SRT hygiene
	-------------------------------

This is a big tidy up commit.  I don't think it breaks anything,
but it certainly makes the code clearer (to me).

I'm not certain that you can use it without sucking in my other
big commit... they come from the same tree.


Core-to-STG, live variables and Static Reference Tables (SRTs)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
I did a big tidy-up of the live-variable computation in CoreToStg.
The key idea is that the live variables consist of two parts:
	dynamic live vars
	static live vars (CAFs)

These two always travel round together, but they were always
treated separately by the code until now. Now it's a new data type:

type LiveInfo = (StgLiveVars, 	-- Dynamic live variables;
				-- i.e. ones with a nested (non-top-level) binding
		 CafSet)	-- Static live variables;
				-- i.e. top-level variables that are CAFs or refer to them

There's lots of documentation in CoreToStg.

Code generation
~~~~~~~~~~~~~~~
Arising from this, I found that SRT labels were stored in
a LambdaFormInfo during code generation, whereas they *ought*
to be in the ClosureInfo (which in turn contains a LambdaFormInfo).

This led to lots of changes in ClosureInfo, and I took the opportunity
to make it into a labelled record.

Similarly, I made the data type in AbstractC a bit more explicit:

  -- C_SRT is what StgSyn.SRT gets translated to...
  -- we add a label for the table, and expect only the 'offset/length' form

data C_SRT = NoC_SRT
	   | C_SRT CLabel !Int{-offset-} !Int{-length-}

(Previously there were bottoms lying around.)
parent 03aa2ef6
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.37 2001/07/24 05:04:58 ken Exp $
% $Id: AbsCSyn.lhs,v 1.38 2001/09/26 15:11:50 simonpj Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -17,6 +17,7 @@ raw assembler/machine code.
module AbsCSyn {- (
-- export everything
AbstractC(..),
C_SRT(..)
CStmtMacro(..),
CExprMacro(..),
CAddrMode(..),
......@@ -47,7 +48,7 @@ import Literal ( mkMachInt, Literal(..) )
import ForeignCall ( CCallSpec )
import PrimRep ( PrimRep(..) )
import Unique ( Unique )
import StgSyn ( StgOp, SRT(..) )
import StgSyn ( StgOp )
import TyCon ( TyCon )
import BitSet -- for liveness masks
import FastTypes
......@@ -146,7 +147,7 @@ stored in a mixed type location.)
| CRetDirect -- Direct return
!Unique -- for making labels
AbstractC -- return code
(CLabel,SRT) -- SRT info
C_SRT -- SRT info
Liveness -- stack liveness at the return point
-- see the notes about these next few; they follow below...
......@@ -193,7 +194,7 @@ stored in a mixed type location.)
| CRetVector -- A labelled block of static data
CLabel
[CAddrMode]
(CLabel,SRT) -- SRT info
C_SRT -- SRT info
Liveness -- stack liveness at the return point
| CClosureTbl -- table of constructors for enumerated types
......@@ -214,6 +215,16 @@ stored in a mixed type location.)
-- CostCentre.lhs)
| CSplitMarker -- Split into separate object modules here
-- C_SRT is what StgSyn.SRT gets translated to...
-- we add a label for the table, and expect only the 'offset/length' form
data C_SRT = NoC_SRT
| C_SRT CLabel !Int{-offset-} !Int{-length-}
needsSRT :: C_SRT -> Bool
needsSRT NoC_SRT = False
needsSRT (C_SRT _ _ _) = True
\end{code}
About @CMacroStmt@, etc.: notionally, they all just call some
......
......@@ -53,7 +53,7 @@ import Unique ( pprUnique, Unique{-instance NamedThing-} )
import UniqSet ( emptyUniqSet, elementOfUniqSet,
addOneToUniqSet, UniqSet
)
import StgSyn ( SRT(..), StgOp(..) )
import StgSyn ( StgOp(..) )
import BitSet ( BitSet, intBS )
import Outputable
import GlaExts
......@@ -476,8 +476,11 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _
is_constr = maybeToBool maybe_tag
(Just tag) = maybe_tag
needs_srt = infoTblNeedsSRT cl_info
srt = getSRTInfo cl_info
srt = closureSRT cl_info
needs_srt = case srt of
NoC_SRT -> False
other -> True
size = closureNonHdrSize cl_info
......@@ -646,16 +649,12 @@ pp_basic_restores = ptext SLIT("CALLER_RESTORE_SYSTEM")
\end{code}
\begin{code}
pp_srt_info srt =
case srt of
(lbl, NoSRT) ->
hcat [ int 0, comma,
int 0, comma,
int 0, comma ]
(lbl, SRT off len) ->
hcat [ pprCLabel lbl, comma,
int off, comma,
int len, comma ]
pp_srt_info NoC_SRT = hcat [ int 0, comma,
int 0, comma,
int 0, comma ]
pp_srt_info (C_SRT lbl off len) = hcat [ pprCLabel lbl, comma,
int off, comma,
int len, comma ]
\end{code}
\begin{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.52 2001/05/22 13:43:15 simonpj Exp $
% $Id: CgCase.lhs,v 1.53 2001/09/26 15:11:50 simonpj Exp $
%
%********************************************************
%* *
......@@ -402,8 +402,8 @@ cgEvalAlts cc_slot bndr srt alts
[alt] -> let lbl = mkReturnInfoLabel uniq in
cgUnboxedTupleAlt uniq cc_slot True alt
`thenFC` \ abs_c ->
getSRTLabel `thenFC` \srt_label ->
absC (CRetDirect uniq abs_c (srt_label, srt)
getSRTInfo srt `thenFC` \ srt_info ->
absC (CRetDirect uniq abs_c srt_info
liveness_mask) `thenC`
returnFC (CaseAlts (CLbl lbl RetRep) Nothing)
_ -> panic "cgEvalAlts: dodgy case of unboxed tuple type"
......@@ -442,9 +442,9 @@ cgEvalAlts cc_slot bndr srt alts
getAbsC (cgPrimEvalAlts bndr tycon alts deflt) `thenFC` \ abs_c ->
-- Generate the labelled block, starting with restore-cost-centre
getSRTLabel `thenFC` \srt_label ->
getSRTInfo srt `thenFC` \srt_info ->
absC (CRetDirect uniq (cc_restore `mkAbsCStmts` abs_c)
(srt_label,srt) liveness_mask) `thenC`
srt_info liveness_mask) `thenC`
-- Return an amode for the block
returnFC (CaseAlts (CLbl (mkReturnInfoLabel uniq) RetRep) Nothing)
......@@ -807,7 +807,7 @@ mkReturnVector :: Unique
-> FCode CAddrMode
mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
= getSRTLabel `thenFC` \srt_label ->
= getSRTInfo srt `thenFC` \ srt_info ->
let
(return_vec_amode, vtbl_body) = case ret_conv of {
......@@ -815,7 +815,7 @@ mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
UnvectoredReturn 0 ->
ASSERT(null tagged_alt_absCs)
(CLbl ret_label RetRep,
absC (CRetDirect uniq deflt_absC (srt_label, srt) liveness));
absC (CRetDirect uniq deflt_absC srt_info liveness));
UnvectoredReturn n ->
-- find the tag explicitly rather than using tag_reg for now.
......@@ -827,7 +827,7 @@ mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
(CLbl ret_label RetRep,
absC (CRetDirect uniq
(mkAlgAltsCSwitch tag tagged_alt_absCs deflt_absC)
(srt_label, srt)
srt_info
liveness));
VectoredReturn table_size ->
......@@ -835,9 +835,7 @@ mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
(vector_table, alts_absC) =
unzip (map mk_vector_entry [fIRST_TAG .. (table_size+fIRST_TAG-1)])
ret_vector = CRetVector vtbl_label
vector_table
(srt_label, srt) liveness
ret_vector = CRetVector vtbl_label vector_table srt_info liveness
in
(CLbl vtbl_label DataPtrRep,
-- alts come first, because we don't want to declare all the symbols
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.48 2001/09/10 10:07:21 rje Exp $
% $Id: CgClosure.lhs,v 1.49 2001/09/26 15:11:50 simonpj Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -73,17 +73,19 @@ They should have no free variables.
cgTopRhsClosure :: Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
-> SRT
-> [Id] -- Args
-> StgExpr
-> LambdaFormInfo
-> FCode (Id, CgIdInfo)
cgTopRhsClosure id ccs binder_info args body lf_info
cgTopRhsClosure id ccs binder_info srt args body lf_info
=
-- LAY OUT THE OBJECT
getSRTInfo srt `thenFC` \ srt_info ->
let
name = idName id
closure_info = layOutStaticNoFVClosure name lf_info
closure_info = layOutStaticNoFVClosure name lf_info srt_info
closure_label = mkClosureLabel name
cg_id_info = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
in
......@@ -147,7 +149,8 @@ cgStdRhsClosure binder cc binder_info fvs args body lf_info payload
getArgAmodes payload `thenFC` \ amodes ->
let
(closure_info, amodes_w_offsets)
= layOutDynClosure (idName binder) getAmodeRep amodes lf_info
= layOutDynClosure (idName binder) getAmodeRep amodes lf_info NoC_SRT
-- No SRT for a standard-form closure
(use_cc, blame_cc) = chooseDynCostCentres cc args fvs body
in
......@@ -166,13 +169,14 @@ Here's the general case.
cgRhsClosure :: Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
-> SRT
-> [Id] -- Free vars
-> [Id] -- Args
-> StgExpr
-> LambdaFormInfo
-> FCode (Id, CgIdInfo)
cgRhsClosure binder cc binder_info fvs args body lf_info
cgRhsClosure binder cc binder_info srt fvs args body lf_info
= (
-- LAY OUT THE OBJECT
--
......@@ -192,12 +196,14 @@ cgRhsClosure binder cc binder_info fvs args body lf_info
else fvs
in
mapFCs getCAddrModeAndInfo reduced_fvs `thenFC` \ fvs_w_amodes_and_info ->
getSRTInfo srt `thenFC` \ srt_info ->
let
closure_info :: ClosureInfo
bind_details :: [((Id, CAddrMode, LambdaFormInfo), VirtualHeapOffset)]
(closure_info, bind_details)
= layOutDynClosure (idName binder) get_kind fvs_w_amodes_and_info lf_info
= layOutDynClosure (idName binder) get_kind
fvs_w_amodes_and_info lf_info srt_info
bind_fv ((id, _, lf_info), offset) = bindNewToNode id offset lf_info
......
......@@ -38,9 +38,9 @@ import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
mkUnboxedTupleReturnCode )
import CLabel ( mkClosureLabel )
import ClosureInfo ( mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
layOutStaticClosure, closureSize
import ClosureInfo ( mkConLFInfo, mkLFArgument, closureLFInfo,
layOutDynConstr, layOutDynClosure,
layOutStaticConstr, closureSize
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
......@@ -71,19 +71,15 @@ cgTopRhsCon :: Id -- Name of thing bound to this RHS
cgTopRhsCon id con args
= ASSERT(not (isDllConApp con args)) -- checks for litlit args too
ASSERT(length args == dataConRepArity con)
let
name = idName id
closure_label = mkClosureLabel name
lf_info = mkConLFInfo con
in
(
-- LAY IT OUT
getArgAmodes args `thenFC` \ amodes ->
let
(closure_info, amodes_w_offsets)
= layOutStaticClosure name getAmodeRep amodes lf_info
name = idName id
closure_label = mkClosureLabel name
lf_info = closureLFInfo closure_info
(closure_info, amodes_w_offsets) = layOutStaticConstr name con getAmodeRep amodes
in
-- BUILD THE OBJECT
......@@ -93,7 +89,7 @@ cgTopRhsCon id con args
(mkCCostCentreStack dontCareCCS) -- because it's static data
(map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
) `thenC`
`thenC`
-- RETURN
returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
......@@ -186,7 +182,7 @@ buildDynCon binder ccs con args
returnFC (heapIdInfo binder hp_off lf_info)
where
(closure_info, amodes_w_offsets)
= layOutDynClosure (idName binder) getAmodeRep args lf_info
= layOutDynClosure (idName binder) getAmodeRep args lf_info NoC_SRT
lf_info = mkConLFInfo con
use_cc -- cost-centre to stick in the object
......@@ -220,7 +216,9 @@ bindConArgs con args
mapCs bind_arg args_w_offsets
where
bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
(_, args_w_offsets) = layOutDynCon con idPrimRep args
(_, args_w_offsets) = layOutDynConstr bogus_name con idPrimRep args
bogus_name = panic "bindConArgs"
\end{code}
Unboxed tuples are handled slightly differently - the object is
......@@ -235,8 +233,8 @@ bindUnboxedTupleComponents
bindUnboxedTupleComponents args
= -- Assign as many components as possible to registers
let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
(reg_args, stk_args) = splitAt (length arg_regs) args
let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
(reg_args, stk_args) = splitAt (length arg_regs) args
in
-- Allocate the rest on the stack (ToDo: separate out pointers)
......@@ -338,11 +336,9 @@ cgReturnDataCon con amodes
setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
performReturn (AbsCNop) (mkStaticAlgReturnCode con)
where (closure_info, stuff)
= layOutDynClosure (dataConName con)
getAmodeRep amodes lf_info
lf_info = mkConLFInfo con
where
(closure_info, stuff)
= layOutDynConstr (dataConName con) con getAmodeRep amodes
other_sequel -- The usual case
......
......@@ -13,9 +13,7 @@ import CgMonad
import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
import CgTailCall ( performReturn, mkStaticAlgReturnCode )
import ClosureInfo ( layOutStaticClosure, layOutDynCon,
mkConLFInfo, ClosureInfo
)
import ClosureInfo ( layOutStaticConstr, layOutDynConstr, ClosureInfo )
import DataCon ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
import Name ( getOccName )
import OccName ( occNameUserString )
......@@ -114,8 +112,7 @@ genConInfo comp_info tycon data_con
-- To allow the debuggers, interpreters, etc to cope with static
-- data structures (ie those built at compile time), we take care that
-- info-table contains the information we need.
(static_ci,_) = layOutStaticClosure con_name typePrimRep arg_tys
(mkConLFInfo data_con)
(static_ci,_) = layOutStaticConstr con_name data_con typePrimRep arg_tys
body = (initC comp_info (
profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC`
......@@ -149,7 +146,7 @@ mkConCodeAndInfo con
arg_tys = dataConRepArgTys con
(closure_info, arg_things)
= layOutDynCon con typePrimRep arg_tys
= layOutDynConstr (dataConName con) con typePrimRep arg_tys
body_code
= -- NB: We don't set CC when entering data (WDP 94/06)
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgExpr.lhs,v 1.43 2001/05/22 13:43:15 simonpj Exp $
% $Id: CgExpr.lhs,v 1.44 2001/09/26 15:11:50 simonpj Exp $
%
%********************************************************
%* *
......@@ -35,7 +35,7 @@ import CgTailCall ( cgTailCall, performReturn, performPrimReturn,
tailCallPrimOp, returnUnboxedTuple
)
import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
mkApLFInfo, layOutDynCon )
mkApLFInfo, layOutDynConstr )
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
......@@ -325,15 +325,14 @@ mkRhsClosure bndr cc bi srt
cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
where
lf_info = mkSelectorLFInfo (idType bndr) offset_into_int
(isUpdatable upd_flag)
(_, params_w_offsets) = layOutDynCon con idPrimRep params
(isUpdatable upd_flag)
(_, params_w_offsets) = layOutDynConstr bogus_name con idPrimRep params -- Just want the layout
maybe_offset = assocMaybe params_w_offsets selectee
Just the_offset = maybe_offset
offset_into_int = the_offset - fixedHdrSize
is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
bogus_name = panic "mkRhsClosure"
\end{code}
Ap thunks
~~~~~~~~~
......@@ -377,11 +376,9 @@ The default case
~~~~~~~~~~~~~~~~
\begin{code}
mkRhsClosure bndr cc bi srt fvs upd_flag args body
= getSRTLabel `thenFC` \ srt_label ->
let lf_info =
mkClosureLFInfo bndr NotTopLevel fvs upd_flag args srt_label srt
in
cgRhsClosure bndr cc bi fvs args body lf_info
= cgRhsClosure bndr cc bi srt fvs args body lf_info
where
lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
\end{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
% $Id: CgLetNoEscape.lhs,v 1.14 2000/07/11 16:03:37 simonmar Exp $
% $Id: CgLetNoEscape.lhs,v 1.15 2001/09/26 15:11:50 simonpj Exp $
%
%********************************************************
%* *
......@@ -170,12 +170,12 @@ cgLetNoEscapeClosure
(allocStackTop retPrimRepSize `thenFC` \_ ->
nukeDeadBindings full_live_in_rhss)
(deAllocStackTop retPrimRepSize `thenFC` \_ ->
buildContLivenessMask uniq `thenFC` \ liveness ->
(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, _) ->
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgMonad.lhs,v 1.29 2001/08/31 12:39:06 rje Exp $
% $Id: CgMonad.lhs,v 1.30 2001/09/26 15:11:50 simonpj Exp $
%
\section[CgMonad]{The code generation monad}
......@@ -23,7 +23,7 @@ module CgMonad (
EndOfBlockInfo(..),
setEndOfBlockInfo, getEndOfBlockInfo,
setSRTLabel, getSRTLabel,
setSRTLabel, getSRTLabel, getSRTInfo,
setTickyCtrLabel, getTickyCtrLabel,
StackUsage, Slot(..), HeapUsage,
......@@ -53,6 +53,7 @@ import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
import {-# SOURCE #-} CgUsages ( getSpRelOffset )
import AbsCSyn
import StgSyn ( SRT(..) )
import AbsCUtils ( mkAbsCStmts )
import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling )
import CLabel ( CLabel, mkUpdInfoLabel, mkTopTickyCtrLabel )
......@@ -615,15 +616,19 @@ getEndOfBlockInfo = do
\end{code}
\begin{code}
getSRTLabel :: FCode CLabel
getSRTLabel = do
(MkCgInfoDown _ _ srt _ _) <- getInfoDown
return srt
getSRTInfo :: SRT -> FCode C_SRT
getSRTInfo NoSRT = return NoC_SRT
getSRTInfo (SRT off len) = do srt_lbl <- getSRTLabel
return (C_SRT srt_lbl off len)
getSRTLabel :: FCode CLabel -- Used only by cgPanic
getSRTLabel = do MkCgInfoDown _ _ srt_lbl _ _ <- getInfoDown
return srt_lbl
setSRTLabel :: CLabel -> Code -> Code
setSRTLabel srt code = do
(MkCgInfoDown c_info statics _ ticky eob_info) <- getInfoDown
withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
setSRTLabel srt_lbl code
= do MkCgInfoDown c_info statics _ ticky eob_info <- getInfoDown
withInfoDown code (MkCgInfoDown c_info statics srt_lbl ticky eob_info)
\end{code}
\begin{code}
......
This diff is collapsed.
......@@ -50,8 +50,6 @@ import ErrUtils ( dumpIfSet_dyn, showPass )
import Panic ( assertPanic )
#ifdef DEBUG
import Id ( idCafInfo )
import IdInfo ( mayHaveCafRefs )
import Outputable
#endif
\end{code}
......@@ -266,11 +264,9 @@ cgTopRhs bndr (StgRhsCon cc con args) srt
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag args body) srt
= -- There should be no free variables
ASSERT(null fvs)
getSRTLabel `thenFC` \srt_label ->
let lf_info =
mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args srt_label srt
let
lf_info = mkClosureLFInfo bndr TopLevel [{-no fvs-}] upd_flag args
in
maybeGlobaliseId bndr `thenFC` \ bndr' ->
forkStatics (cgTopRhsClosure bndr' cc bi args body lf_info)
maybeGlobaliseId bndr `thenFC` \ bndr' ->
forkStatics (cgTopRhsClosure bndr' cc bi srt args body lf_info)
\end{code}
......@@ -20,8 +20,8 @@ import OrdList ( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
snocOL, consOL, concatOL )
import AbsCUtils ( magicIdPrimRep )
import ForeignCall ( CCallConv(..) )
import CLabel ( isAsmTemp, CLabel, labelDynamic )
import Maybes ( maybeToBool, expectJust )
import CLabel ( CLabel, labelDynamic )
import Maybes ( maybeToBool )
import PrimRep ( isFloatingRep, PrimRep(..) )
import PrimOp ( PrimOp(..) )
import Stix ( getNatLabelNCG, StixTree(..),
......
......@@ -15,13 +15,13 @@ module StixInfo (
#include "../includes/config.h"
#include "NCG.h"
import AbsCSyn ( AbstractC(..), Liveness(..) )
import AbsCSyn ( AbstractC(..), Liveness(..), C_SRT(..), needsSRT )
import CLabel ( CLabel )
import StgSyn ( SRT(..) )
import ClosureInfo ( closurePtrsSize,
closureNonHdrSize, closureSMRep,
infoTableLabelFromCI,
infoTblNeedsSRT, getSRTInfo, closureSemiTag
closureSRT, closureSemiTag
)
import PrimRep ( PrimRep(..) )
import SMRep ( getSMRepClosureTypeInt )
......@@ -50,7 +50,6 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
where
info_lbl = infoTableLabelFromCI cl_info
needs_srt = infoTblNeedsSRT cl_info
table | needs_srt = srt_label : rest_of_table
| otherwise = rest_of_table
......@@ -72,18 +71,16 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
type_info = (fromInt closure_type) .|.
(fromInt srt_len `shiftL` 16)
#endif
srt = getSRTInfo cl_info
srt = closureSRT cl_info
needs_srt = needsSRT srt
(srt_label,srt_len)
| is_constr
= (StInt 0, tag)
| needs_srt
= case srt of
(lbl, SRT off len) ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
| otherwise
= (StInt 0, 0)
= case srt of
NoC_SRT -> (StInt 0, 0)
C_SRT lbl off len -> (StIndex DataPtrRep (StCLbl lbl) (StInt (toInteger off)), len)
maybe_tag = closureSemiTag cl_info
is_constr = maybeToBool maybe_tag
......@@ -107,7 +104,7 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
genBitmapInfoTable
:: Liveness
-> (CLabel, SRT)
-> C_SRT
-> Int
-> Bool -- must include SRT field (i.e. it's a vector)
-> UniqSM StixTreeList
......@@ -146,8 +143,8 @@ genBitmapInfoTable liveness srt closure_type include_srt
(srt_label,srt_len) =
case srt of
(lbl, NoSRT) -> (StInt 0, 0)
(lbl, SRT off len) ->
NoC_SRT -> (StInt 0, 0)
C_SRT lbl off len ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment