* Fix code output order when printing C so things are defined before
they are used.
* Generate _ret rather than _entry functions for INFO_TABLE_RET.
* Use "ASSIGN_BaseReg" rather than "BaseReg =".
mkHpcTicksLabel,
mkHpcModuleNameLabel,
mkHpcTicksLabel,
mkHpcModuleNameLabel,
- infoLblToEntryLbl, entryLblToInfoLbl,
+ infoLblToEntryLbl, entryLblToInfoLbl, infoLblToRetLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
CLabelType(..), labelType, labelDynamic,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
CLabelType(..), labelType, labelDynamic,
mkDeadStripPreventer lbl = DeadStripPreventer lbl
-- -----------------------------------------------------------------------------
mkDeadStripPreventer lbl = DeadStripPreventer lbl
-- -----------------------------------------------------------------------------
--- Converting info labels to entry labels.
+-- Converting between info labels and entry/ret labels.
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
+infoLblToRetLbl :: CLabel -> CLabel
+infoLblToRetLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsRet s)
+infoLblToRetLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl _ = panic "CLabel.infoLblToRetLbl"
+
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
import CmmUtils
import CmmCallConv
import CmmUtils
import CmmCallConv
-import CgProf (curCCS, curCCSAddr)
-import CgUtils (cmmOffsetW)
+import CgProf
+import CgUtils
+import CgInfoTbls
import SMRep
import ForeignCall
import SMRep
import ForeignCall
| otherwise -- Separately emit info table (with the function entry
= -- point as first entry) and the entry code
| otherwise -- Separately emit info table (with the function entry
= -- point as first entry) and the entry code
- [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
- CmmProc [] entry_lbl args blocks]
+ [CmmProc [] entry_lbl args blocks,
+ mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
mkSRTLit :: CLabel
-> C_SRT
mkSRTLit :: CLabel
-> C_SRT
cmmproc :: { ExtCode }
-- TODO: add real SRT/info tables to parsed Cmm
: info maybe_formals maybe_frame maybe_gc_block '{' body '}'
cmmproc :: { ExtCode }
-- TODO: add real SRT/info tables to parsed Cmm
: info maybe_formals maybe_frame maybe_gc_block '{' body '}'
- { do ((info_lbl, info, live, formals, frame, gc_block), stmts) <-
+ { do ((info_lbl, entry_ret_label, info, live, formals, frame, gc_block), stmts) <-
getCgStmtsEC' $ loopDecls $ do {
getCgStmtsEC' $ loopDecls $ do {
- (info_lbl, info, live) <- $1;
+ (info_lbl, entry_ret_label, info, live) <- $1;
formals <- sequence $2;
frame <- $3;
gc_block <- $4;
$6;
formals <- sequence $2;
frame <- $3;
gc_block <- $4;
$6;
- return (info_lbl, info, live, formals, frame, gc_block) }
+ return (info_lbl, entry_ret_label, info, live, formals, frame, gc_block) }
blks <- code (cgStmtsToBlocks stmts)
blks <- code (cgStmtsToBlocks stmts)
- code (emitInfoTableAndCode info_lbl (CmmInfo gc_block frame info) formals blks) }
+ code (emitInfoTableAndCode entry_ret_label (CmmInfo gc_block frame info) formals blks) }
- { do (info_lbl, info, live) <- $1;
+ { do (info_lbl, entry_ret_label, info, live) <- $1;
- code (emitInfoTableAndCode info_lbl (CmmInfo Nothing Nothing info) formals []) }
+ code (emitInfoTableAndCode entry_ret_label (CmmInfo Nothing Nothing info) formals []) }
| NAME maybe_formals maybe_frame maybe_gc_block '{' body '}'
{ do ((formals, frame, gc_block), stmts) <-
| NAME maybe_formals maybe_frame maybe_gc_block '{' body '}'
{ do ((formals, frame, gc_block), stmts) <-
blks <- code (cgStmtsToBlocks stmts)
code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabelFS $1) formals blks) }
blks <- code (cgStmtsToBlocks stmts)
code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabelFS $1) formals blks) }
-info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
+info :: { ExtFCode (CLabel, CLabel, CmmInfoTable, [Maybe LocalReg]) }
: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, closure type, description, type
{ do prof <- profilingInfo $11 $13
: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, closure type, description, type
{ do prof <- profilingInfo $11 $13
- return (mkRtsInfoLabelFS $3,
+ let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToEntryLbl infoLabel,
CmmInfoTable prof (fromIntegral $9)
(ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
[]) }
CmmInfoTable prof (fromIntegral $9)
(ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
[]) }
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
-- ptrs, nptrs, closure type, description, type, fun type
{ do prof <- profilingInfo $11 $13
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
-- ptrs, nptrs, closure type, description, type, fun type
{ do prof <- profilingInfo $11 $13
- return (mkRtsInfoLabelFS $3,
+ let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToEntryLbl infoLabel,
CmmInfoTable prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $15) 0
(ArgSpec 0)
CmmInfoTable prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $15) 0
(ArgSpec 0)
-- If profiling is on, this string gets duplicated,
-- but that's the way the old code did it we can fix it some other time.
desc_lit <- code $ mkStringCLit $13
-- If profiling is on, this string gets duplicated,
-- but that's the way the old code did it we can fix it some other time.
desc_lit <- code $ mkStringCLit $13
- return (mkRtsInfoLabelFS $3,
+ let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToEntryLbl infoLabel,
CmmInfoTable prof (fromIntegral $11)
(ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
[]) }
CmmInfoTable prof (fromIntegral $11)
(ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
[]) }
| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
-- selector, closure type, description, type
{ do prof <- profilingInfo $9 $11
| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
-- selector, closure type, description, type
{ do prof <- profilingInfo $9 $11
- return (mkRtsInfoLabelFS $3,
+ let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToEntryLbl infoLabel,
CmmInfoTable prof (fromIntegral $7)
(ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
-- closure type (no live regs)
CmmInfoTable prof (fromIntegral $7)
(ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
-- closure type (no live regs)
- { return (mkRtsInfoLabelFS $3,
+ { do let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToRetLbl infoLabel,
CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo [] NoC_SRT),
[]) }
CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo [] NoC_SRT),
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
-- closure type, live regs
{ do live <- sequence (map (liftM Just) $7)
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
-- closure type, live regs
{ do live <- sequence (map (liftM Just) $7)
- return (mkRtsInfoLabelFS $3,
+ let infoLabel = mkRtsInfoLabelFS $3
+ return (infoLabel, infoLblToRetLbl infoLabel,
CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo live NoC_SRT),
live) }
CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo live NoC_SRT),
live) }
-- We can't cast the lvalue, so we have to cast the rhs if necessary. Casting
-- the lvalue elicits a warning from new GCC versions (3.4+).
pprAssign r1 r2
-- We can't cast the lvalue, so we have to cast the rhs if necessary. Casting
-- the lvalue elicits a warning from new GCC versions (3.4+).
pprAssign r1 r2
- | isFixedPtrReg r1
- = pprReg r1 <> ptext SLIT(" = ") <> mkP_ <> pprExpr1 r2 <> semi
- | Just ty <- strangeRegType r1
- = pprReg r1 <> ptext SLIT(" = ") <> parens ty <> pprExpr1 r2 <> semi
- | otherwise
- = pprReg r1 <> ptext SLIT(" = ") <> pprExpr r2 <> semi
+ | isFixedPtrReg r1 = mkAssign (mkP_ <> pprExpr1 r2)
+ | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)
+ | otherwise = mkAssign (pprExpr r2)
+ where mkAssign x = if r1 == CmmGlobal BaseReg
+ then ptext SLIT("ASSIGN_BaseReg") <> parens x <> semi
+ else pprReg r1 <> ptext SLIT(" = ") <> x <> semi
-- ---------------------------------------------------------------------
-- Registers
-- ---------------------------------------------------------------------
-- Registers
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
- ; emitInfoTableAndCode info_lbl info args blks }
+ ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
where
info_lbl = infoTableLabelFromCI cl_info
where
info_lbl = infoTableLabelFromCI cl_info
(ProfilingInfo zeroCLit zeroCLit)
rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
(ContInfo frame srt_info))
(ProfilingInfo zeroCLit zeroCLit)
rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
(ContInfo frame srt_info))
- ; emitInfoTableAndCode info_lbl info args blks
+ ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
; return info_lbl }
where
args = {- trace "emitReturnTarget: missing args" -} []
; return info_lbl }
where
args = {- trace "emitReturnTarget: missing args" -} []
-- put the info table next to the code
emitInfoTableAndCode
-- put the info table next to the code
emitInfoTableAndCode
- :: CLabel -- Label of info table
+ :: CLabel -- Label of entry or ret
-> CmmInfo -- ...the info table
-> CmmFormals -- ...args
-> [CmmBasicBlock] -- ...and body
-> Code
-> CmmInfo -- ...the info table
-> CmmFormals -- ...args
-> [CmmBasicBlock] -- ...and body
-> Code
-emitInfoTableAndCode info_lbl info args blocks
- = emitProc info entry_lbl args blocks
- where
- entry_lbl = infoLblToEntryLbl info_lbl
+emitInfoTableAndCode entry_ret_lbl info args blocks
+ = emitProc info entry_ret_lbl args blocks
-------------------------------------------------------------------------
--
-------------------------------------------------------------------------
--