compiler/codeGen/StgCmmProf.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Code generation for profiling
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module StgCmmProf (
  10         initCostCentres, ccType, ccsType,
  11         mkCCostCentre, mkCCostCentreStack,
  12
  13         -- Cost-centre Profiling
  14         dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
  15         enterCostCentre, enterCostCentrePAP, enterCostCentreThunk,
  16         chooseDynCostCentres,
  17         costCentreFrom,
  18         curCCS, curCCSAddr,
  19         emitSetCCC, emitCCS,
  20
  21         saveCurrentCostCentre, restoreCurrentCostCentre,
  22
  23         -- Lag/drag/void stuff
  24         ldvEnter, ldvEnterClosure, ldvRecordCreate
  25   ) where
  26
  27 #include "HsVersions.h"
  28 #include "../includes/MachDeps.h"
  29  -- For WORD_SIZE_IN_BITS only.
  30 #include "../includes/rts/Constants.h"
  31         -- For LDV_CREATE_MASK, LDV_STATE_USE
  32         -- which are StgWords
  33 #include "../includes/DerivedConstants.h"
  34         -- For REP_xxx constants, which are MachReps
  35
  36 import StgCmmClosure
  37 import StgCmmUtils
  38 import StgCmmMonad
  39 import SMRep
  40
  41 import MkZipCfgCmm
  42 import Cmm
  43 import CmmUtils
  44 import CLabel
  45
  46 import Id
  47 import qualified Module
  48 import CostCentre
  49 import StgSyn
  50 import StaticFlags
  51 import FastString
  52 import Constants        -- Lots of field offsets
  53 import Outputable
  54
  55 import Data.Char
  56 import Control.Monad
  57
  58 -----------------------------------------------------------------------------
  59 --
  60 -- Cost-centre-stack Profiling
  61 --
  62 -----------------------------------------------------------------------------
  63
  64 -- Expression representing the current cost centre stack
  65 ccsType :: CmmType      -- Type of a cost-centre stack
  66 ccsType = bWord
  67
  68 ccType :: CmmType       -- Type of a cost centre
  69 ccType = bWord
  70
  71 curCCS :: CmmExpr
  72 curCCS = CmmLoad curCCSAddr ccsType
  73
  74 -- Address of current CCS variable, for storing into
  75 curCCSAddr :: CmmExpr
  76 curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS")))
  77
  78 mkCCostCentre :: CostCentre -> CmmLit
  79 mkCCostCentre cc = CmmLabel (mkCCLabel cc)
  80
  81 mkCCostCentreStack :: CostCentreStack -> CmmLit
  82 mkCCostCentreStack ccs = CmmLabel (mkCCSLabel ccs)
  83
  84 costCentreFrom :: CmmExpr       -- A closure pointer
  85                -> CmmExpr       -- The cost centre from that closure
  86 costCentreFrom cl = CmmLoad (cmmOffsetB cl oFFSET_StgHeader_ccs) ccsType
  87
  88 staticProfHdr :: CostCentreStack -> [CmmLit]
  89 -- The profiling header words in a static closure
  90 -- Was SET_STATIC_PROF_HDR
  91 staticProfHdr ccs = ifProfilingL [mkCCostCentreStack ccs,
  92                                   staticLdvInit]
  93
  94 dynProfHdr :: CmmExpr -> [CmmExpr]
  95 -- Profiling header words in a dynamic closure
  96 dynProfHdr ccs = ifProfilingL [ccs, dynLdvInit]
  97
  98 initUpdFrameProf :: CmmExpr -> FCode ()
  99 -- Initialise the profiling field of an update frame
 100 initUpdFrameProf frame_amode
 101   = ifProfiling $       -- frame->header.prof.ccs = CCCS
 102     emit (mkStore (cmmOffsetB frame_amode oFFSET_StgHeader_ccs) curCCS)
 103         -- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0)
 104         -- is unnecessary because it is not used anyhow.
 105
 106 ---------------------------------------------------------------------------
 107 --      Saving and restoring the current cost centre
 108 ---------------------------------------------------------------------------
 109
 110 {-      Note [Saving the current cost centre]
 111         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 112 The current cost centre is like a global register.  Like other
 113 global registers, it's a caller-saves one.  But consider
 114         case (f x) of (p,q) -> rhs
 115 Since 'f' may set the cost centre, we must restore it
 116 before resuming rhs.  So we want code like this:
 117         local_cc = CCC  -- save
 118         r = f( x )
 119         CCC = local_cc  -- restore
 120 That is, we explicitly "save" the current cost centre in
 121 a LocalReg, local_cc; and restore it after the call. The
 122 C-- infrastructure will arrange to save local_cc across the
 123 call.
 124
 125 The same goes for join points;
 126         let j x = join-stuff
 127         in blah-blah
 128 We want this kind of code:
 129         local_cc = CCC  -- save
 130         blah-blah
 131      J:
 132         CCC = local_cc  -- restore
 133 -}
 134
 135 saveCurrentCostCentre :: FCode (Maybe LocalReg)
 136         -- Returns Nothing if profiling is off
 137 saveCurrentCostCentre
 138   | not opt_SccProfilingOn
 139   = return Nothing
 140   | otherwise
 141   = do  { local_cc <- newTemp ccType
 142         ; emit (mkAssign (CmmLocal local_cc) curCCS)
 143         ; return (Just local_cc) }
 144
 145 restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
 146 restoreCurrentCostCentre Nothing
 147   = return ()
 148 restoreCurrentCostCentre (Just local_cc)
 149   = emit (mkStore curCCSAddr (CmmReg (CmmLocal local_cc)))
 150
 151
 152 -------------------------------------------------------------------------------
 153 -- Recording allocation in a cost centre
 154 -------------------------------------------------------------------------------
 155
 156 -- | Record the allocation of a closure.  The CmmExpr is the cost
 157 -- centre stack to which to attribute the allocation.
 158 profDynAlloc :: ClosureInfo -> CmmExpr -> FCode ()
 159 profDynAlloc cl_info ccs
 160   = ifProfiling $
 161     profAlloc (CmmLit (mkIntCLit (closureSize cl_info))) ccs
 162
 163 -- | Record the allocation of a closure (size is given by a CmmExpr)
 164 -- The size must be in words, because the allocation counter in a CCS counts
 165 -- in words.
 166 profAlloc :: CmmExpr -> CmmExpr -> FCode ()
 167 profAlloc words ccs
 168   = ifProfiling $
 169     emit (addToMemE alloc_rep
 170                 (cmmOffsetB ccs oFFSET_CostCentreStack_mem_alloc)
 171                 (CmmMachOp (MO_UU_Conv wordWidth (typeWidth alloc_rep)) $
 172                   [CmmMachOp mo_wordSub [words,
 173                                          CmmLit (mkIntCLit profHdrSize)]]))
 174                 -- subtract the "profiling overhead", which is the
 175                 -- profiling header in a closure.
 176  where
 177         alloc_rep =  REP_CostCentreStack_mem_alloc
 178
 179 -- ----------------------------------------------------------------------
 180 -- Setting the cost centre in a new closure
 181
 182 chooseDynCostCentres :: CostCentreStack
 183                      -> [Id]            -- Args
 184                      -> StgExpr         -- Body
 185                      -> FCode (CmmExpr, CmmExpr)
 186 -- Called when allocating a closure
 187 -- Tells which cost centre to put in the object, and which
 188 -- to blame the cost of allocation on
 189 chooseDynCostCentres ccs args body = do
 190   -- Cost-centre we record in the object
 191   use_ccs <- emitCCS ccs
 192
 193   -- Cost-centre on whom we blame the allocation
 194   let blame_ccs
 195         | null args && isBox body = CmmLit (mkCCostCentreStack overheadCCS)
 196         | otherwise               = use_ccs
 197
 198   return (use_ccs, blame_ccs)
 199
 200
 201 -- Some CostCentreStacks are a sequence of pushes on top of CCCS.
 202 -- These pushes must be performed before we can refer to the stack in
 203 -- an expression.
 204 emitCCS :: CostCentreStack -> FCode CmmExpr
 205 emitCCS ccs = push_em (ccsExpr ccs') (reverse cc's)
 206   where
 207         (cc's, ccs') = decomposeCCS ccs
 208
 209         push_em ccs [] = return ccs
 210         push_em ccs (cc:rest) = do
 211           tmp <- newTemp ccsType
 212           pushCostCentre tmp ccs cc
 213           push_em (CmmReg (CmmLocal tmp)) rest
 214
 215 ccsExpr :: CostCentreStack -> CmmExpr
 216 ccsExpr ccs
 217   | isCurrentCCS ccs = curCCS
 218   | otherwise        = CmmLit (mkCCostCentreStack ccs)
 219
 220
 221 isBox :: StgExpr -> Bool
 222 -- If it's an utterly trivial RHS, then it must be
 223 -- one introduced by boxHigherOrderArgs for profiling,
 224 -- so we charge it to "OVERHEAD".
 225 -- This looks like a GROSS HACK to me --SDM
 226 isBox (StgApp _ []) = True
 227 isBox _             = False
 228
 229
 230 -- -----------------------------------------------------------------------
 231 -- Setting the current cost centre on entry to a closure
 232
 233 -- For lexically scoped profiling we have to load the cost centre from
 234 -- the closure entered, if the costs are not supposed to be inherited.
 235 -- This is done immediately on entering the fast entry point.
 236
 237 -- Load current cost centre from closure, if not inherited.
 238 -- Node is guaranteed to point to it, if profiling and not inherited.
 239
 240 enterCostCentre
 241    :: ClosureInfo
 242    -> CostCentreStack
 243    -> StgExpr   -- The RHS of the closure
 244    -> FCode ()
 245
 246 -- We used to have a special case for bindings of form
 247 --      f = g True
 248 -- where g has arity 2.  The RHS is a thunk, but we don't
 249 -- need to update it; and we want to subsume costs.
 250 -- We don't have these sort of PAPs any more, so the special
 251 -- case has gone away.
 252
 253 enterCostCentre closure_info ccs body
 254   = ifProfiling $
 255     ASSERT2(not (noCCSAttached ccs), ppr (closureName closure_info) <+> ppr ccs)
 256     enter_cost_centre closure_info ccs body
 257
 258 enter_cost_centre :: ClosureInfo -> CostCentreStack -> StgExpr -> FCode ()
 259 enter_cost_centre closure_info ccs body
 260   | isSubsumedCCS ccs
 261   = ASSERT(isToplevClosure closure_info)
 262     ASSERT(re_entrant)
 263     enter_ccs_fsub
 264
 265   | isDerivedFromCurrentCCS ccs
 266   = do {
 267         if re_entrant && not is_box
 268           then
 269                 enter_ccs_fun node_ccs
 270           else
 271                 emit (mkStore curCCSAddr node_ccs)
 272
 273         -- don't forget to bump the scc count.  This closure might have been
 274         -- of the form   let x = _scc_ "x" e in ...x..., which the SCCfinal
 275         -- pass has turned into simply  let x = e in ...x... and attached
 276         -- the _scc_ as PushCostCentre(x,CCCS) on the x closure.  So that
 277         -- we don't lose the scc counter, bump it in the entry code for x.
 278         -- ToDo: for a multi-push we should really bump the counter for
 279         -- each of the intervening CCSs, not just the top one.
 280        ; when (not (isCurrentCCS ccs)) $
 281                 emit (bumpSccCount curCCS)
 282        }
 283
 284   | isCafCCS ccs
 285   = ASSERT(isToplevClosure closure_info)
 286     ASSERT(not re_entrant)
 287     do  {       -- This is just a special case of the isDerivedFromCurrentCCS
 288                 -- case above.  We could delete this, but it's a micro
 289                 -- optimisation and saves a bit of code.
 290           emit (mkStore curCCSAddr enc_ccs)
 291         ; emit (bumpSccCount node_ccs)
 292         }
 293
 294   | otherwise
 295   = panic "enterCostCentre"
 296   where
 297     enc_ccs    = CmmLit (mkCCostCentreStack ccs)
 298     re_entrant = closureReEntrant closure_info
 299     node_ccs   = costCentreFrom (cmmOffsetB (CmmReg nodeReg) (-node_tag))
 300     is_box     = isBox body
 301
 302     -- if this is a function, then node will be tagged; we must subract the tag
 303     node_tag = funTag closure_info
 304
 305 -- set the current CCS when entering a PAP
 306 enterCostCentrePAP :: CmmExpr -> FCode ()
 307 enterCostCentrePAP closure =
 308   ifProfiling $ do
 309     enter_ccs_fun (costCentreFrom closure)
 310     enteringPAP 1
 311
 312 enterCostCentreThunk :: CmmExpr -> FCode ()
 313 enterCostCentreThunk closure =
 314   ifProfiling $ do
 315     emit $ mkStore curCCSAddr (costCentreFrom closure)
 316
 317 enter_ccs_fun :: CmmExpr -> FCode ()
 318 enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [(stack,AddrHint)] False
 319                         -- ToDo: vols
 320
 321 enter_ccs_fsub :: FCode ()
 322 enter_ccs_fsub = enteringPAP 0
 323
 324 -- When entering a PAP, EnterFunCCS is called by both the PAP entry
 325 -- code and the function entry code; we don't want the function's
 326 -- entry code to also update CCCS in the event that it was called via
 327 -- a PAP, so we set the flag entering_PAP to indicate that we are
 328 -- entering via a PAP.
 329 enteringPAP :: Integer -> FCode ()
 330 enteringPAP n
 331   = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP"))))
 332                   (CmmLit (CmmInt n cIntWidth)))
 333
 334 ifProfiling :: FCode () -> FCode ()
 335 ifProfiling code
 336   | opt_SccProfilingOn = code
 337   | otherwise          = nopC
 338
 339 ifProfilingL :: [a] -> [a]
 340 ifProfilingL xs
 341   | opt_SccProfilingOn = xs
 342   | otherwise          = []
 343
 344
 345 ---------------------------------------------------------------
 346 --      Initialising Cost Centres & CCSs
 347 ---------------------------------------------------------------
 348
 349 initCostCentres :: CollectedCCs -> FCode CmmAGraph
 350 -- Emit the declarations, and return code to register them
 351 initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
 352   = getCode $ whenC opt_SccProfilingOn $
 353     do  { mapM_ emitCostCentreDecl local_CCs
 354         ; mapM_ emitCostCentreStackDecl  singleton_CCSs
 355         ; emit $ catAGraphs $ map mkRegisterCC local_CCs
 356         ; emit $ catAGraphs $ map mkRegisterCCS singleton_CCSs }
 357
 358
 359 emitCostCentreDecl :: CostCentre -> FCode ()
 360 emitCostCentreDecl cc = do
 361   { label <- mkStringCLit (costCentreUserName cc)
 362   ; modl  <- mkStringCLit (Module.moduleNameString
 363                                (Module.moduleName (cc_mod cc)))
 364                 -- All cost centres will be in the main package, since we
 365                 -- don't normally use -auto-all or add SCCs to other packages.
 366                 -- Hence don't emit the package name in the module here.
 367   ; let lits = [ zero,          -- StgInt ccID,
 368                  label, -- char *label,
 369                  modl,  -- char *module,
 370                  zero,  -- StgWord time_ticks
 371                  zero64,        -- StgWord64 mem_alloc
 372                  subsumed, -- StgInt is_caf
 373                  zero   -- struct _CostCentre *link
 374                ]
 375   ; emitDataLits (mkCCLabel cc) lits
 376   }
 377   where
 378         subsumed | isCafCC cc = mkIntCLit (ord 'c')  -- 'c' == is a CAF
 379                  | otherwise  = mkIntCLit (ord 'B')  -- 'B' == is boring
 380
 381 emitCostCentreStackDecl :: CostCentreStack -> FCode ()
 382 emitCostCentreStackDecl ccs
 383   = case maybeSingletonCCS ccs of
 384         Just cc -> emitDataLits (mkCCSLabel ccs) (mk_lits cc)
 385         Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
 386   where
 387      mk_lits cc = zero :
 388                   mkCCostCentre cc :
 389                   replicate (sizeof_ccs_words - 2) zero
 390         -- Note: to avoid making any assumptions about how the
 391         -- C compiler (that compiles the RTS, in particular) does
 392         -- layouts of structs containing long-longs, simply
 393         -- pad out the struct with zero words until we hit the
 394         -- size of the overall struct (which we get via DerivedConstants.h)
 395
 396 zero :: CmmLit
 397 zero = mkIntCLit 0
 398 zero64 :: CmmLit
 399 zero64 = CmmInt 0 W64
 400
 401 sizeof_ccs_words :: Int
 402 sizeof_ccs_words
 403     -- round up to the next word.
 404   | ms == 0   = ws
 405   | otherwise = ws + 1
 406   where
 407    (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
 408
 409 -- ---------------------------------------------------------------------------
 410 -- Registering CCs and CCSs
 411
 412 --   (cc)->link = CC_LIST;
 413 --   CC_LIST = (cc);
 414 --   (cc)->ccID = CC_ID++;
 415
 416 mkRegisterCC :: CostCentre -> CmmAGraph
 417 mkRegisterCC cc
 418   = withTemp cInt $ \tmp ->
 419     catAGraphs [
 420      mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
 421                  (CmmLoad cC_LIST bWord),
 422      mkStore cC_LIST cc_lit,
 423      mkAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
 424      mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
 425      mkStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
 426    ]
 427   where
 428         cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
 429
 430 --  (ccs)->prevStack = CCS_LIST;
 431 --  CCS_LIST = (ccs);
 432 --  (ccs)->ccsID = CCS_ID++;
 433
 434 mkRegisterCCS :: CostCentreStack -> CmmAGraph
 435 mkRegisterCCS ccs
 436   = withTemp cInt $ \ tmp ->
 437     catAGraphs [
 438      mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack)
 439                         (CmmLoad cCS_LIST bWord),
 440      mkStore cCS_LIST ccs_lit,
 441      mkAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
 442      mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
 443      mkStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
 444    ]
 445   where
 446     ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
 447
 448
 449 cC_LIST, cC_ID :: CmmExpr
 450 cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST")))
 451 cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID")))
 452
 453 cCS_LIST, cCS_ID :: CmmExpr
 454 cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST")))
 455 cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID")))
 456
 457 -- ---------------------------------------------------------------------------
 458 -- Set the current cost centre stack
 459
 460 emitSetCCC :: CostCentre -> FCode ()
 461 emitSetCCC cc
 462   | not opt_SccProfilingOn = nopC
 463   | otherwise = do
 464     tmp <- newTemp ccsType -- TODO FIXME NOW
 465     ASSERT( sccAbleCostCentre cc )
 466       pushCostCentre tmp curCCS cc
 467     emit (mkStore curCCSAddr (CmmReg (CmmLocal tmp)))
 468     when (isSccCountCostCentre cc) $
 469          emit (bumpSccCount curCCS)
 470
 471 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
 472 pushCostCentre result ccs cc
 473   = emitRtsCallWithResult result AddrHint
 474         (fsLit "PushCostCentre") [(ccs,AddrHint),
 475                                 (CmmLit (mkCCostCentre cc), AddrHint)]
 476         False
 477
 478 bumpSccCount :: CmmExpr -> CmmAGraph
 479 bumpSccCount ccs
 480   = addToMem REP_CostCentreStack_scc_count
 481          (cmmOffsetB ccs oFFSET_CostCentreStack_scc_count) 1
 482
 483 -----------------------------------------------------------------------------
 484 --
 485 --              Lag/drag/void stuff
 486 --
 487 -----------------------------------------------------------------------------
 488
 489 --
 490 -- Initial value for the LDV field in a static closure
 491 --
 492 staticLdvInit :: CmmLit
 493 staticLdvInit = zeroCLit
 494
 495 --
 496 -- Initial value of the LDV field in a dynamic closure
 497 --
 498 dynLdvInit :: CmmExpr
 499 dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
 500   CmmMachOp mo_wordOr [
 501       CmmMachOp mo_wordShl [loadEra, CmmLit (mkIntCLit lDV_SHIFT) ],
 502       CmmLit (mkWordCLit lDV_STATE_CREATE)
 503   ]
 504
 505 --
 506 -- Initialise the LDV word of a new closure
 507 --
 508 ldvRecordCreate :: CmmExpr -> FCode ()
 509 ldvRecordCreate closure = emit $ mkStore (ldvWord closure) dynLdvInit
 510
 511 --
 512 -- Called when a closure is entered, marks the closure as having been "used".
 513 -- The closure is not an 'inherently used' one.
 514 -- The closure is not IND or IND_OLDGEN because neither is considered for LDV
 515 -- profiling.
 516 --
 517 ldvEnterClosure :: ClosureInfo -> FCode ()
 518 ldvEnterClosure closure_info = ldvEnter (cmmOffsetB (CmmReg nodeReg) (-tag))
 519   where tag = funTag closure_info
 520         -- don't forget to substract node's tag
 521
 522 ldvEnter :: CmmExpr -> FCode ()
 523 -- Argument is a closure pointer
 524 ldvEnter cl_ptr
 525   = ifProfiling $
 526      -- if (era > 0) {
 527      --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
 528      --                era | LDV_STATE_USE }
 529     emit (mkCmmIfThenElse (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
 530                 (mkStore ldv_wd new_ldv_wd)
 531                 mkNop)
 532   where
 533         -- don't forget to substract node's tag
 534     ldv_wd = ldvWord cl_ptr
 535     new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd bWord)
 536                                        (CmmLit (mkWordCLit lDV_CREATE_MASK)))
 537                  (cmmOrWord loadEra (CmmLit (mkWordCLit lDV_STATE_USE)))
 538
 539 loadEra :: CmmExpr
 540 loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
 541           [CmmLoad (mkLblExpr (mkRtsDataLabel (fsLit "era"))) cInt]
 542
 543 ldvWord :: CmmExpr -> CmmExpr
 544 -- Takes the address of a closure, and returns
 545 -- the address of the LDV word in the closure
 546 ldvWord closure_ptr = cmmOffsetB closure_ptr oFFSET_StgHeader_ldvw
 547
 548 -- LDV constants, from ghc/includes/Constants.h
 549 lDV_SHIFT :: Int
 550 lDV_SHIFT = LDV_SHIFT
 551 --lDV_STATE_MASK :: StgWord
 552 --lDV_STATE_MASK   = LDV_STATE_MASK
 553 lDV_CREATE_MASK :: StgWord
 554 lDV_CREATE_MASK  = LDV_CREATE_MASK
 555 --lDV_LAST_MASK :: StgWord
 556 --lDV_LAST_MASK    = LDV_LAST_MASK
 557 lDV_STATE_CREATE :: StgWord
 558 lDV_STATE_CREATE = LDV_STATE_CREATE
 559 lDV_STATE_USE :: StgWord
 560 lDV_STATE_USE    = LDV_STATE_USE
 561