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