costCentreFrom,
curCCS, curCCSAddr,
emitCostCentreDecl, emitCostCentreStackDecl,
- emitRegisterCC, emitRegisterCCS,
- emitSetCCC, emitCCS,
+ emitSetCCC, emitCCS,
-- Lag/drag/void stuff
ldvEnter, ldvEnterClosure, ldvRecordCreate
) where
#include "HsVersions.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
-- For WORD_SIZE_IN_BITS only.
-#include "../includes/Constants.h"
+#include "../includes/rts/Constants.h"
-- For LDV_CREATE_MASK, LDV_STATE_USE
-- which are StgWords
#include "../includes/DerivedConstants.h"
import CgMonad
import SMRep
-import Cmm
-import CmmUtils
+import OldCmm
+import OldCmmUtils
import CLabel
import Id
import StgSyn
import StaticFlags
import FastString
+import Module
import Constants -- Lots of field offsets
import Outputable
-- Address of current CCS variable, for storing into
curCCSAddr :: CmmExpr
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
mkCCostCentre :: CostCentre -> CmmLit
mkCCostCentre cc = CmmLabel (mkCCLabel cc)
stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
enter_ccs_fun :: CmmExpr -> Code
-enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmHinted stack AddrHint] False
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
-- ToDo: vols
enter_ccs_fsub :: Code
-- entering via a PAP.
enteringPAP :: Integer -> Code
enteringPAP n
- = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (sLit "entering_PAP"))))
+ = stmtC (CmmStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
(CmmLit (CmmInt n cIntWidth)))
ifProfiling :: Code -> Code
(ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
-- ---------------------------------------------------------------------------
--- Registering CCs and CCSs
-
--- (cc)->link = CC_LIST;
--- CC_LIST = (cc);
--- (cc)->ccID = CC_ID++;
-
-emitRegisterCC :: CostCentre -> Code
-emitRegisterCC cc = do
- { tmp <- newTemp cInt
- ; stmtsC [
- CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
- (CmmLoad cC_LIST bWord),
- CmmStore cC_LIST cc_lit,
- CmmAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
- CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
- CmmStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
- ]
- }
- where
- cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-
--- (ccs)->prevStack = CCS_LIST;
--- CCS_LIST = (ccs);
--- (ccs)->ccsID = CCS_ID++;
-
-emitRegisterCCS :: CostCentreStack -> Code
-emitRegisterCCS ccs = do
- { tmp <- newTemp cInt
- ; stmtsC [
- CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack)
- (CmmLoad cCS_LIST bWord),
- CmmStore cCS_LIST ccs_lit,
- CmmAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
- CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
- CmmStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
- ]
- }
- where
- ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
-
-
-cC_LIST, cC_ID :: CmmExpr
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_LIST")))
-cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_ID")))
-
-cCS_LIST, cCS_ID :: CmmExpr
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST")))
-cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID")))
-
--- ---------------------------------------------------------------------------
-- Set the current cost centre stack
emitSetCCC :: CostCentre -> Code
pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
pushCostCentre result ccs cc
= emitRtsCallWithResult result AddrHint
- (sLit "PushCostCentre") [CmmHinted ccs AddrHint,
+ rtsPackageId
+ (fsLit "PushCostCentre") [CmmHinted ccs AddrHint,
CmmHinted (CmmLit (mkCCostCentre cc)) AddrHint]
False
loadEra :: CmmExpr
loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
- [CmmLoad (mkLblExpr (mkRtsDataLabel $ sLit("era"))) cInt]
+ [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId $ fsLit("era"))) cInt]
ldvWord :: CmmExpr -> CmmExpr
-- Takes the address of a closure, and returns