diff options
Diffstat (limited to 'compiler/codeGen/CgInfoTbls.hs')
| -rw-r--r-- | compiler/codeGen/CgInfoTbls.hs | 99 |
1 files changed, 51 insertions, 48 deletions
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index 7cdb1b6f7e..80b3b06ce3 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -45,6 +45,7 @@ import Unique import StaticFlags import Constants +import DynFlags import Util import Outputable @@ -68,13 +69,14 @@ emitClosureCodeAndInfoTable cl_info args body -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.) mkCmmInfo :: ClosureInfo -> FCode CmmInfoTable mkCmmInfo cl_info - = return (CmmInfoTable { cit_lbl = infoTableLabelFromCI cl_info, - cit_rep = closureSMRep cl_info, - cit_prof = prof, - cit_srt = closureSRT cl_info }) + = do dflags <- getDynFlags + return (CmmInfoTable { cit_lbl = infoTableLabelFromCI cl_info, + cit_rep = closureSMRep cl_info, + cit_prof = prof dflags, + cit_srt = closureSRT cl_info }) where - prof | not opt_SccProfilingOn = NoProfilingInfo - | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8 + prof dflags | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo + | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8 ty_descr_w8 = stringToWord8s (closureTypeDescr cl_info) val_descr_w8 = stringToWord8s (closureValDescr cl_info) @@ -218,10 +220,11 @@ emitAlgReturnTarget name branches mb_deflt fam_sz branches' = [(tag+1,branch)|(tag,branch)<-branches] emitSwitch tag_expr branches' mb_deflt 1 fam_sz else do -- no, get tag from info table + dflags <- getDynFlags let -- Note that ptr _always_ has tag 1 -- when the family size is big enough untagged_ptr = cmmRegOffB nodeReg (-1) - tag_expr = getConstrTag (untagged_ptr) + tag_expr = getConstrTag dflags untagged_ptr emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) ; lbl <- emitReturnTarget name blks ; return (lbl, Nothing) } @@ -240,32 +243,32 @@ emitReturnInstr live -- ----------------------------------------------------------------------------- -stdInfoTableSizeW :: WordOff +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 mkStdInfoTable -stdInfoTableSizeW +stdInfoTableSizeW dflags = size_fixed + size_prof where size_fixed = 2 -- layout, type - size_prof | opt_SccProfilingOn = 2 - | otherwise = 0 + size_prof | dopt Opt_SccProfilingOn dflags = 2 + | otherwise = 0 -stdInfoTableSizeB :: ByteOff -stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE +stdInfoTableSizeB :: DynFlags -> ByteOff +stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE -stdSrtBitmapOffset :: ByteOff +stdSrtBitmapOffset :: DynFlags -> ByteOff -- Byte offset of the SRT bitmap half-word which is -- in the *higher-addressed* part of the type_lit -stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE +stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE -stdClosureTypeOffset :: ByteOff +stdClosureTypeOffset :: DynFlags -> ByteOff -- Byte offset of the closure type half-word -stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE +stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE -stdPtrsOffset, stdNonPtrsOffset :: ByteOff -stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE -stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE +stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff +stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE +stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE ------------------------------------------------------------------------- -- @@ -283,66 +286,66 @@ entryCode :: CmmExpr -> CmmExpr entryCode e | tablesNextToCode = e | otherwise = CmmLoad e bWord -getConstrTag :: CmmExpr -> CmmExpr +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 closure_ptr - = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table] +getConstrTag dflags closure_ptr + = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag dflags info_table] where - info_table = infoTable (closureInfoPtr closure_ptr) + info_table = infoTable dflags (closureInfoPtr closure_ptr) -cmmGetClosureType :: CmmExpr -> CmmExpr +cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr -- Takes a closure pointer, and return the closure type -- obtained from the info table -cmmGetClosureType closure_ptr - = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table] +cmmGetClosureType dflags closure_ptr + = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType dflags info_table] where - info_table = infoTable (closureInfoPtr closure_ptr) + info_table = infoTable dflags (closureInfoPtr closure_ptr) -infoTable :: CmmExpr -> CmmExpr +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 info_ptr - | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB) +infoTable dflags info_ptr + | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags) | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer -infoTableConstrTag :: CmmExpr -> CmmExpr +infoTableConstrTag :: 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 :: CmmExpr -> CmmExpr +infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info table pointer (from infoTable) and returns the srt_bitmap -- field of the info table -infoTableSrtBitmap info_tbl - = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord +infoTableSrtBitmap dflags info_tbl + = CmmLoad (cmmOffsetB info_tbl (stdSrtBitmapOffset dflags)) bHalfWord -infoTableClosureType :: CmmExpr -> CmmExpr +infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr -- Takes an info table pointer (from infoTable) and returns the closure type -- field of the info table. -infoTableClosureType info_tbl - = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) bHalfWord +infoTableClosureType dflags info_tbl + = CmmLoad (cmmOffsetB info_tbl (stdClosureTypeOffset dflags)) bHalfWord -infoTablePtrs :: CmmExpr -> CmmExpr -infoTablePtrs info_tbl - = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord +infoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr +infoTablePtrs dflags info_tbl + = CmmLoad (cmmOffsetB info_tbl (stdPtrsOffset dflags)) bHalfWord -infoTableNonPtrs :: CmmExpr -> CmmExpr -infoTableNonPtrs info_tbl - = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord +infoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr +infoTableNonPtrs dflags info_tbl + = CmmLoad (cmmOffsetB info_tbl (stdNonPtrsOffset dflags)) bHalfWord -funInfoTable :: CmmExpr -> CmmExpr +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 info_ptr +funInfoTable dflags info_ptr | tablesNextToCode - = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev) + = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev) | otherwise - = cmmOffsetW info_ptr (1 + stdInfoTableSizeW) + = cmmOffsetW info_ptr (1 + stdInfoTableSizeW dflags) -- Past the entry code pointer ------------------------------------------------------------------------- |