{-# LANGUAGE CPP #-}moduleCmmInfo(mkEmptyContInfoTable ,cmmToRawCmm ,mkInfoTable ,srtEscape ,-- info table accessorsclosureInfoPtr ,entryCode ,getConstrTag ,cmmGetClosureType ,infoTable ,infoTableConstrTag ,infoTableSrtBitmap ,infoTableClosureType ,infoTablePtrs ,infoTableNonPtrs ,funInfoTable ,funInfoArity ,-- info table sizes and offsetsstdInfoTableSizeW ,fixedInfoTableSizeW ,profInfoTableSizeW ,maxStdInfoTableSizeW ,maxRetInfoTableSizeW ,stdInfoTableSizeB ,conInfoTableSizeB ,stdSrtBitmapOffset ,stdClosureTypeOffset ,stdPtrsOffset ,stdNonPtrsOffset ,)where#include "HsVersions.h"
importGhcPreludeimportCmm importCmmUtils importCLabel importSMRep importBitmap importStream (Stream )importqualifiedStream importHoopl.Collections importPlatformimportMaybesimportDynFlagsimportPanicimportUniqSupplyimportMonadUtilsimportUtilimportOutputableimportData.ByteString(ByteString)importData.Bits-- When we split at proc points, we need an empty info table.mkEmptyContInfoTable::CLabel ->CmmInfoTable mkEmptyContInfoTable info_lbl =CmmInfoTable {cit_lbl=info_lbl ,cit_rep=mkStackRep [],cit_prof=NoProfilingInfo ,cit_srt=Nothing,cit_clo=Nothing}cmmToRawCmm::DynFlags->Stream IOCmmGroup ()->IO(Stream IORawCmmGroup ())cmmToRawCmm dflags cmms =do{uniqs <-mkSplitUniqSupply'i';letdo_one uniqs cmm =docaseinitUsuniqs $concatMapM(mkInfoTable dflags )cmm of(b ,uniqs' )->return(uniqs' ,b )-- NB. strictness fixes a space leak. DO NOT REMOVE.;return(Stream.mapAccumL do_one uniqs cmms >>return())}-- Make a concrete info table, represented as a list of CmmStatic-- (it can't be simply a list of Word, because the SRT field is-- represented by a label+offset expression).---- With tablesNextToCode, the layout is-- <reversed variable part>-- <normal forward StgInfoTable, but without-- an entry point at the front>-- <code>---- Without tablesNextToCode, the layout of an info table is-- <entry label>-- <normal forward rest of StgInfoTable>-- <forward variable part>---- See includes/rts/storage/InfoTables.h---- For return-points these are as follows---- Tables next to code:---- <srt slot>-- <standard info table>-- ret-addr --> <entry code (if any)>---- Not tables-next-to-code:---- ret-addr --> <ptr to entry code>-- <standard info table>-- <srt slot>---- * The SRT slot is only there if there is SRT info to recordmkInfoTable::DynFlags->CmmDecl ->UniqSM[RawCmmDecl ]mkInfoTable _(CmmData sec dat )=return[CmmData sec dat ]mkInfoTabledflags proc @(CmmProc infos entry_lbl live blocks )---- in the non-tables-next-to-code case, procs can have at most a-- single info table associated with the entry label of the proc.--|not(tablesNextToCodedflags )=casetopInfoTable proc of-- must be at most one-- no info tableNothing->return[CmmProc mapEmpty entry_lbl live blocks ]Justinfo @CmmInfoTable {cit_lbl=info_lbl }->do(top_decls ,(std_info ,extra_bits ))<-mkInfoTableContents dflags info Nothingletrel_std_info =map(makeRelativeRefTo dflags info_lbl )std_info rel_extra_bits =map(makeRelativeRefTo dflags info_lbl )extra_bits ---- Separately emit info table (with the function entry-- point as first entry) and the entry code--return(top_decls ++[CmmProc mapEmpty entry_lbl live blocks ,mkRODataLits info_lbl (CmmLabel entry_lbl :rel_std_info ++rel_extra_bits )])---- With tables-next-to-code, we can have many info tables,-- associated with some of the BlockIds of the proc. For each info-- table we need to turn it into CmmStatics, and collect any new-- CmmDecls that arise from doing so.--|otherwise=do(top_declss ,raw_infos )<-unzip`fmap`mapMdo_one_info (mapToList (info_tblsinfos ))return(concattop_declss ++[CmmProc (mapFromList raw_infos )entry_lbl live blocks ])wheredo_one_info (lbl ,itbl )=do(top_decls ,(std_info ,extra_bits ))<-mkInfoTableContents dflags itbl Nothingletinfo_lbl =cit_lblitbl rel_std_info =map(makeRelativeRefTo dflags info_lbl )std_info rel_extra_bits =map(makeRelativeRefTo dflags info_lbl )extra_bits --return(top_decls ,(lbl ,Statics info_lbl $mapCmmStaticLit $reverserel_extra_bits ++rel_std_info ))-----------------------------------------------------typeInfoTableContents =([CmmLit ]-- The standard part,[CmmLit ])-- The "extra bits"-- These Lits have *not* had mkRelativeTo applied to themmkInfoTableContents::DynFlags->CmmInfoTable ->MaybeInt-- Override default RTS type tag?->UniqSM([RawCmmDecl ],-- Auxiliary top declsInfoTableContents )-- Info tbl + extra bitsmkInfoTableContents dflags info @(CmmInfoTable {cit_lbl=info_lbl ,cit_rep=smrep ,cit_prof=prof ,cit_srt=srt })mb_rts_tag |RTSRep rts_tag rep <-smrep =mkInfoTableContents dflags info {cit_rep=rep }(Justrts_tag )-- Completely override the rts_tag that mkInfoTableContents would-- otherwise compute, with the rts_tag stored in the RTSRep-- (which in turn came from a handwritten .cmm file)|StackRep frame <-smrep =do{(prof_lits ,prof_data )<-mkProfLits dflags prof ;let(srt_label ,srt_bitmap )=mkSRTLit dflags info_lbl srt ;(liveness_lit ,liveness_data )<-mkLivenessBits dflags frame ;letstd_info =mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit rts_tag |Justtag <-mb_rts_tag =tag |nullliveness_data =rET_SMALL -- Fits in extra_bits|otherwise=rET_BIG -- Does not; extra_bits is-- a label;return(prof_data ++liveness_data ,(std_info ,srt_label ))}|HeapRep _ptrs nonptrs closure_type <-smrep =do{letlayout =packIntsCLit dflags ptrs nonptrs ;(prof_lits ,prof_data )<-mkProfLits dflags prof ;let(srt_label ,srt_bitmap )=mkSRTLit dflags info_lbl srt ;(mb_srt_field ,mb_layout ,extra_bits ,ct_data )<-mk_pieces closure_type srt_label ;letstd_info =mkStdInfoTable dflags prof_lits (mb_rts_tag `orElse`rtsClosureType smrep )(mb_srt_field `orElse`srt_bitmap )(mb_layout `orElse`layout );return(prof_data ++ct_data ,(std_info ,extra_bits ))}wheremk_pieces::ClosureTypeInfo ->[CmmLit ]->UniqSM(MaybeCmmLit -- Override the SRT field with this,MaybeCmmLit -- Override the layout field with this,[CmmLit ]-- "Extra bits" for info table,[RawCmmDecl ])-- Auxiliary data declsmk_pieces (Constr con_tag con_descr )_no_srt -- A data constructor=do{(descr_lit ,decl )<-newStringLit con_descr ;return(Just(CmmInt (fromIntegralcon_tag )(halfWordWidthdflags )),Nothing,[descr_lit ],[decl ])}mk_piecesThunk srt_label =return(Nothing,Nothing,srt_label ,[])mk_pieces(ThunkSelector offset )_no_srt =return(Just(CmmInt 0(halfWordWidthdflags )),Just(mkWordCLit dflags (fromIntegraloffset )),[],[])-- Layout known (one free var); we use the layout field for offsetmk_pieces(Fun arity (ArgSpec fun_type ))srt_label =do{letextra_bits =packIntsCLit dflags fun_type arity :srt_label ;return(Nothing,Nothing,extra_bits ,[])}mk_pieces(Fun arity (ArgGen arg_bits ))srt_label =do{(liveness_lit ,liveness_data )<-mkLivenessBits dflags arg_bits ;letfun_type |nullliveness_data =aRG_GEN |otherwise=aRG_GEN_BIG extra_bits =[packIntsCLit dflags fun_type arity ]++(ifinlineSRT dflags then[]else[srt_lit ])++[liveness_lit ,slow_entry ];return(Nothing,Nothing,extra_bits ,liveness_data )}whereslow_entry =CmmLabel (toSlowEntryLbl info_lbl )srt_lit =casesrt_label of[]->mkIntCLit dflags 0(lit :_rest )->ASSERT(null_rest)litmk_piecesother _=pprPanic"mk_pieces"(pprother )mkInfoTableContents___=panic"mkInfoTableContents"-- NonInfoTable dealt with earlierpackIntsCLit::DynFlags->Int->Int->CmmLit packIntsCLit dflags a b =packHalfWordsCLit dflags (toStgHalfWord dflags (fromIntegrala ))(toStgHalfWord dflags (fromIntegralb ))mkSRTLit::DynFlags->CLabel ->MaybeCLabel ->([CmmLit ],-- srt_label, if anyCmmLit )-- srt_bitmapmkSRTLit dflags info_lbl (Justlbl )|inlineSRT dflags =([],CmmLabelDiffOff lbl info_lbl 0(halfWordWidthdflags ))mkSRTLitdflags _Nothing=([],CmmInt 0(halfWordWidthdflags ))mkSRTLitdflags _(Justlbl )=([CmmLabel lbl ],CmmInt 1(halfWordWidthdflags ))-- | Is the SRT offset field inline in the info table on this platform?---- See the section "Referring to an SRT from the info table" in-- Note [SRTs] in CmmBuildInfoTables.hsinlineSRT::DynFlags->BoolinlineSRT dflags =platformArch(targetPlatformdflags )==ArchX86_64&&tablesNextToCodedflags ----------------------------------------------------------------------------- Lay out the info table and handle relative offsets----------------------------------------------------------------------------- This function takes-- * the standard info table portion (StgInfoTable)-- * the "extra bits" (StgFunInfoExtraRev etc.)-- * the entry label-- * the code-- and lays them out in memory, producing a list of RawCmmDecl----------------------------------------------------------------------------- Position independent code----------------------------------------------------------------------------- In order to support position independent code, we mustn't put absolute-- references into read-only space. Info tables in the tablesNextToCode-- case must be in .text, which is read-only, so we doctor the CmmLits-- to use relative offsets instead.-- Note that this is done even when the -fPIC flag is not specified,-- as we want to keep binary compatibility between PIC and non-PIC.makeRelativeRefTo::DynFlags->CLabel ->CmmLit ->CmmLit makeRelativeRefTo dflags info_lbl (CmmLabel lbl )|tablesNextToCodedflags =CmmLabelDiffOff lbl info_lbl 0(wordWidthdflags )makeRelativeRefTodflags info_lbl (CmmLabelOff lbl off )|tablesNextToCodedflags =CmmLabelDiffOff lbl info_lbl off (wordWidthdflags )makeRelativeRefTo__lit =lit ----------------------------------------------------------------------------- Build a liveness mask for the stack layout----------------------------------------------------------------------------- There are four kinds of things on the stack:---- - pointer variables (bound in the environment)-- - non-pointer variables (bound in the environment)-- - free slots (recorded in the stack free list)-- - non-pointer data slots (recorded in the stack free list)---- The first two are represented with a 'Just' of a 'LocalReg'.-- The last two with one or more 'Nothing' constructors.-- Each 'Nothing' represents one used word.---- The head of the stack layout is the top of the stack and-- the least-significant bit.mkLivenessBits::DynFlags->Liveness ->UniqSM(CmmLit ,[RawCmmDecl ])-- ^ Returns:-- 1. The bitmap (literal value or label)-- 2. Large bitmap CmmData if neededmkLivenessBits dflags liveness |n_bits >mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word=do{uniq <-getUniqueM;letbitmap_lbl =mkBitmapLabel uniq ;return(CmmLabel bitmap_lbl ,[mkRODataLits bitmap_lbl lits ])}|otherwise-- Fits in one word=return(mkStgWordCLit dflags bitmap_word ,[])wheren_bits =lengthliveness bitmap::Bitmap bitmap =mkBitmap dflags liveness small_bitmap =casebitmap of[]->toStgWord dflags 0[b ]->b _->panic"mkLiveness"bitmap_word =toStgWord dflags (fromIntegraln_bits ).|.(small_bitmap `shiftL`bITMAP_BITS_SHIFTdflags )lits =mkWordCLit dflags (fromIntegraln_bits ):map(mkStgWordCLit dflags )bitmap -- The first word is the size. The structure must match-- StgLargeBitmap in includes/rts/storage/InfoTable.h----------------------------------------------------------------------------- Generating a standard info table----------------------------------------------------------------------------- The standard bits of an info table. This part of the info table-- corresponds to the StgInfoTable type defined in-- includes/rts/storage/InfoTables.h.---- Its shape varies with ticky/profiling/tables next to code etc-- so we can't use constant offsets from ConstantsmkStdInfoTable::DynFlags->(CmmLit ,CmmLit )-- Closure type descr and closure descr (profiling)->Int-- Closure RTS tag->CmmLit -- SRT length->CmmLit -- layout field->[CmmLit ]mkStdInfoTable dflags (type_descr ,closure_descr )cl_type srt layout_lit =-- Parallel revertible-black hole fieldprof_info -- Ticky info (none at present)-- Debug info (none at present)++[layout_lit ,tag ,srt ]whereprof_info |goptOpt_SccProfilingOndflags =[type_descr ,closure_descr ]|otherwise=[]tag =CmmInt (fromIntegralcl_type )(halfWordWidthdflags )----------------------------------------------------------------------------- Making string literals---------------------------------------------------------------------------mkProfLits::DynFlags->ProfilingInfo ->UniqSM((CmmLit ,CmmLit ),[RawCmmDecl ])mkProfLits dflags NoProfilingInfo =return((zeroCLit dflags ,zeroCLit dflags ),[])mkProfLits_(ProfilingInfo td cd )=do{(td_lit ,td_decl )<-newStringLit td ;(cd_lit ,cd_decl )<-newStringLit cd ;return((td_lit ,cd_lit ),[td_decl ,cd_decl ])}newStringLit::ByteString->UniqSM(CmmLit ,GenCmmDecl CmmStatics info stmt )newStringLit bytes =do{uniq <-getUniqueM;return(mkByteStringCLit (mkStringLitLabel uniq )bytes )}-- Misc utils-- | Value of the srt field of an info table when using an StgLargeSRTsrtEscape::DynFlags->StgHalfWord srtEscape dflags =toStgHalfWord dflags (-1)----------------------------------------------------------------------------- Accessing fields of an info table----------------------------------------------------------------------------- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is-- enabled.wordAligned::DynFlags->CmmExpr ->CmmExpr wordAligned dflags e |goptOpt_AlignmentSanitisationdflags =CmmMachOp (MO_AlignmentCheck (wORD_SIZEdflags )(wordWidthdflags ))[e ]|otherwise=e closureInfoPtr::DynFlags->CmmExpr ->CmmExpr -- Takes a closure pointer and returns the info table pointerclosureInfoPtr dflags e =CmmLoad (wordAligned dflags e )(bWorddflags )entryCode::DynFlags->CmmExpr ->CmmExpr -- Takes an info pointer (the first word of a closure)-- and returns its entry codeentryCode dflags e |tablesNextToCodedflags =e |otherwise=CmmLoad e (bWorddflags )getConstrTag::DynFlags->CmmExpr ->CmmExpr -- Takes a closure pointer, and return the *zero-indexed*-- constructor tag obtained from the info table-- This lives in the SRT field of the info table-- (constructors don't need SRTs).getConstrTag dflags closure_ptr =CmmMachOp (MO_UU_Conv (halfWordWidthdflags )(wordWidthdflags ))[infoTableConstrTag dflags info_table ]whereinfo_table =infoTable dflags (closureInfoPtr dflags closure_ptr )cmmGetClosureType::DynFlags->CmmExpr ->CmmExpr -- Takes a closure pointer, and return the closure type-- obtained from the info tablecmmGetClosureType dflags closure_ptr =CmmMachOp (MO_UU_Conv (halfWordWidthdflags )(wordWidthdflags ))[infoTableClosureType dflags info_table ]whereinfo_table =infoTable dflags (closureInfoPtr dflags closure_ptr )infoTable::DynFlags->CmmExpr ->CmmExpr -- Takes an info pointer (the first word of a closure)-- and returns a pointer to the first word of the standard-form-- info table, excluding the entry-code word (if present)infoTable dflags info_ptr |tablesNextToCodedflags =cmmOffsetB dflags info_ptr (-stdInfoTableSizeB dflags )|otherwise=cmmOffsetW dflags info_ptr 1-- Past the entry code pointerinfoTableConstrTag::DynFlags->CmmExpr ->CmmExpr -- Takes an info table pointer (from infoTable) and returns the constr tag-- field of the info table (same as the srt_bitmap field)infoTableConstrTag =infoTableSrtBitmap infoTableSrtBitmap::DynFlags->CmmExpr ->CmmExpr -- Takes an info table pointer (from infoTable) and returns the srt_bitmap-- field of the info tableinfoTableSrtBitmap dflags info_tbl =CmmLoad (cmmOffsetB dflags info_tbl (stdSrtBitmapOffset dflags ))(bHalfWorddflags )infoTableClosureType::DynFlags->CmmExpr ->CmmExpr -- Takes an info table pointer (from infoTable) and returns the closure type-- field of the info table.infoTableClosureType dflags info_tbl =CmmLoad (cmmOffsetB dflags info_tbl (stdClosureTypeOffset dflags ))(bHalfWorddflags )infoTablePtrs::DynFlags->CmmExpr ->CmmExpr infoTablePtrs dflags info_tbl =CmmLoad (cmmOffsetB dflags info_tbl (stdPtrsOffset dflags ))(bHalfWorddflags )infoTableNonPtrs::DynFlags->CmmExpr ->CmmExpr infoTableNonPtrs dflags info_tbl =CmmLoad (cmmOffsetB dflags info_tbl (stdNonPtrsOffset dflags ))(bHalfWorddflags )funInfoTable::DynFlags->CmmExpr ->CmmExpr -- Takes the info pointer of a function,-- and returns a pointer to the first word of the StgFunInfoExtra struct-- in the info table.funInfoTable dflags info_ptr |tablesNextToCodedflags =cmmOffsetB dflags info_ptr (-stdInfoTableSizeB dflags -sIZEOF_StgFunInfoExtraRevdflags )|otherwise=cmmOffsetW dflags info_ptr (1+stdInfoTableSizeW dflags )-- Past the entry code pointer-- Takes the info pointer of a function, returns the function's arityfunInfoArity::DynFlags->CmmExpr ->CmmExpr funInfoArity dflags iptr =cmmToWord dflags (cmmLoadIndex dflags rep fun_info (offset `div`rep_bytes ))wherefun_info =funInfoTable dflags iptr rep =cmmBits(widthFromBytesrep_bytes )(rep_bytes ,offset )|tablesNextToCodedflags =(pc_REP_StgFunInfoExtraRev_aritypc ,oFFSET_StgFunInfoExtraRev_aritydflags )|otherwise=(pc_REP_StgFunInfoExtraFwd_aritypc ,oFFSET_StgFunInfoExtraFwd_aritydflags )pc =sPlatformConstants(settingsdflags )--------------------------------------------------------------------------------- Info table sizes & offsets-------------------------------------------------------------------------------stdInfoTableSizeW::DynFlags->WordOff -- The size of a standard info table varies with profiling/ticky etc,-- so we can't get it from Constants-- It must vary in sync with mkStdInfoTablestdInfoTableSizeW dflags =fixedInfoTableSizeW +ifgoptOpt_SccProfilingOndflags thenprofInfoTableSizeW else0fixedInfoTableSizeW::WordOff fixedInfoTableSizeW =2-- layout, typeprofInfoTableSizeW::WordOff profInfoTableSizeW =2maxStdInfoTableSizeW::WordOff maxStdInfoTableSizeW =1{- entry, when !tablesNextToCode -}+fixedInfoTableSizeW +profInfoTableSizeW maxRetInfoTableSizeW::WordOff maxRetInfoTableSizeW =maxStdInfoTableSizeW +1{- srt label -}stdInfoTableSizeB::DynFlags->ByteOff stdInfoTableSizeB dflags =stdInfoTableSizeW dflags *wORD_SIZEdflags stdSrtBitmapOffset::DynFlags->ByteOff -- Byte offset of the SRT bitmap half-word which is-- in the *higher-addressed* part of the type_litstdSrtBitmapOffset dflags =stdInfoTableSizeB dflags -hALF_WORD_SIZE dflags stdClosureTypeOffset::DynFlags->ByteOff -- Byte offset of the closure type half-wordstdClosureTypeOffset dflags =stdInfoTableSizeB dflags -wORD_SIZEdflags stdPtrsOffset,stdNonPtrsOffset::DynFlags->ByteOff stdPtrsOffset dflags =stdInfoTableSizeB dflags -2*wORD_SIZEdflags stdNonPtrsOffset dflags =stdInfoTableSizeB dflags -2*wORD_SIZEdflags +hALF_WORD_SIZE dflags conInfoTableSizeB::DynFlags->IntconInfoTableSizeB dflags =stdInfoTableSizeB dflags +wORD_SIZEdflags