compiler/codeGen/CgHeapery.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[CgHeapery]{Heap management functions}
   6
   7 \begin{code}
   8 module CgHeapery (
   9         initHeapUsage, getVirtHp, setVirtHp, setRealHp,
  10         getHpRelOffset, hpRel,
  11
  12         funEntryChecks, thunkEntryChecks,
  13         altHeapCheck, unbxTupleHeapCheck,
  14         hpChkGen, hpChkNodePointsAssignSp0,
  15         stkChkGen, stkChkNodePoints,
  16
  17         layOutDynConstr, layOutStaticConstr,
  18         mkVirtHeapOffsets, mkStaticClosureFields, mkStaticClosure,
  19
  20         allocDynClosure, emitSetDynHdr
  21     ) where
  22
  23 #include "HsVersions.h"
  24
  25 import StgSyn
  26 import CLabel
  27 import CgUtils
  28 import CgMonad
  29 import CgProf
  30 import CgTicky
  31 import CgParallel
  32 import CgStackery
  33 import CgCallConv
  34 import ClosureInfo
  35 import SMRep
  36
  37 import Cmm
  38 import MachOp
  39 import CmmUtils
  40 import Id
  41 import DataCon
  42 import TyCon
  43 import CostCentre
  44 import Util
  45 import Constants
  46 import PackageConfig
  47 import Outputable
  48
  49 import Data.List
  50 \end{code}
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55 \subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 The heap always grows upwards, so hpRel is easy
  60
  61 \begin{code}
  62 hpRel :: VirtualHpOffset        -- virtual offset of Hp
  63       -> VirtualHpOffset        -- virtual offset of The Thing
  64       -> WordOff                        -- integer word offset
  65 hpRel hp off = off - hp
  66 \end{code}
  67
  68 @initHeapUsage@ applies a function to the amount of heap that it uses.
  69 It initialises the heap usage to zeros, and passes on an unchanged
  70 heap usage.
  71
  72 It is usually a prelude to performing a GC check, so everything must
  73 be in a tidy and consistent state.
  74
  75 rje: Note the slightly suble fixed point behaviour needed here
  76
  77 \begin{code}
  78 initHeapUsage :: (VirtualHpOffset -> Code) -> Code
  79 initHeapUsage fcode
  80   = do  { orig_hp_usage <- getHpUsage
  81         ; setHpUsage initHpUsage
  82         ; fixC (\heap_usage2 -> do
  83                 { fcode (heapHWM heap_usage2)
  84                 ; getHpUsage })
  85         ; setHpUsage orig_hp_usage }
  86
  87 setVirtHp :: VirtualHpOffset -> Code
  88 setVirtHp new_virtHp
  89   = do  { hp_usage <- getHpUsage
  90         ; setHpUsage (hp_usage {virtHp = new_virtHp}) }
  91
  92 getVirtHp :: FCode VirtualHpOffset
  93 getVirtHp
  94   = do  { hp_usage <- getHpUsage
  95         ; return (virtHp hp_usage) }
  96
  97 setRealHp ::  VirtualHpOffset -> Code
  98 setRealHp new_realHp
  99   = do  { hp_usage <- getHpUsage
 100         ; setHpUsage (hp_usage {realHp = new_realHp}) }
 101
 102 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
 103 getHpRelOffset virtual_offset
 104   = do  { hp_usg <- getHpUsage
 105         ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
 106 \end{code}
 107
 108
 109 %************************************************************************
 110 %*                                                                      *
 111                 Layout of heap objects
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 layOutDynConstr, layOutStaticConstr
 117         :: PackageId
 118         -> DataCon
 119         -> [(CgRep,a)]
 120         -> (ClosureInfo,
 121             [(a,VirtualHpOffset)])
 122
 123 layOutDynConstr    = layOutConstr False
 124 layOutStaticConstr = layOutConstr True
 125
 126 layOutConstr  is_static this_pkg data_con args
 127    = (mkConInfo this_pkg is_static data_con tot_wds ptr_wds,
 128       things_w_offsets)
 129   where
 130     (tot_wds,            --  #ptr_wds + #nonptr_wds
 131      ptr_wds,            --  #ptr_wds
 132      things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
 133 \end{code}
 134
 135 @mkVirtHeapOffsets@ always returns boxed things with smaller offsets
 136 than the unboxed things, and furthermore, the offsets in the result
 137 list
 138
 139 \begin{code}
 140 mkVirtHeapOffsets
 141           :: Bool               -- True <=> is a thunk
 142           -> [(CgRep,a)]        -- Things to make offsets for
 143           -> (WordOff,          -- _Total_ number of words allocated
 144               WordOff,          -- Number of words allocated for *pointers*
 145               [(a, VirtualHpOffset)])
 146                                 -- Things with their offsets from start of
 147                                 --  object in order of increasing offset
 148
 149 -- First in list gets lowest offset, which is initial offset + 1.
 150
 151 mkVirtHeapOffsets is_thunk things
 152   = let non_void_things               = filterOut (isVoidArg . fst) things
 153         (ptrs, non_ptrs)              = separateByPtrFollowness non_void_things
 154         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
 155         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
 156     in
 157     (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
 158   where
 159     hdr_size    | is_thunk   = thunkHdrSize
 160                 | otherwise  = fixedHdrSize
 161
 162     computeOffset wds_so_far (rep, thing)
 163       = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far))
 164 \end{code}
 165
 166
 167 %************************************************************************
 168 %*                                                                      *
 169                 Lay out a static closure
 170 %*                                                                      *
 171 %************************************************************************
 172
 173 Make a static closure, adding on any extra padding needed for CAFs,
 174 and adding a static link field if necessary.
 175
 176 \begin{code}
 177 mkStaticClosureFields
 178         :: ClosureInfo
 179         -> CostCentreStack
 180         -> Bool                 -- Has CAF refs
 181         -> [CmmLit]             -- Payload
 182         -> [CmmLit]             -- The full closure
 183 mkStaticClosureFields cl_info ccs caf_refs payload
 184   = mkStaticClosure info_lbl ccs payload padding_wds
 185         static_link_field saved_info_field
 186   where
 187     info_lbl = infoTableLabelFromCI cl_info
 188
 189     -- CAFs must have consistent layout, regardless of whether they
 190     -- are actually updatable or not.  The layout of a CAF is:
 191     --
 192     --        3 saved_info
 193     --        2 static_link
 194     --        1 indirectee
 195     --        0 info ptr
 196     --
 197     -- the static_link and saved_info fields must always be in the same
 198     -- place.  So we use closureNeedsUpdSpace rather than
 199     -- closureUpdReqd here:
 200
 201     is_caf = closureNeedsUpdSpace cl_info
 202
 203     padding_wds
 204         | not is_caf = []
 205         | otherwise  = ASSERT(null payload) [mkIntCLit 0]
 206
 207     static_link_field
 208         | is_caf || staticClosureNeedsLink cl_info = [static_link_value]
 209         | otherwise                                = []
 210
 211     saved_info_field
 212         | is_caf     = [mkIntCLit 0]
 213         | otherwise  = []
 214
 215         -- for a static constructor which has NoCafRefs, we set the
 216         -- static link field to a non-zero value so the garbage
 217         -- collector will ignore it.
 218     static_link_value
 219         | caf_refs      = mkIntCLit 0
 220         | otherwise     = mkIntCLit 1
 221
 222
 223 mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
 224   -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
 225 mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
 226   =  [CmmLabel info_lbl]
 227   ++ variable_header_words
 228   ++ payload
 229   ++ padding_wds
 230   ++ static_link_field
 231   ++ saved_info_field
 232   where
 233     variable_header_words
 234         =  staticGranHdr
 235         ++ staticParHdr
 236         ++ staticProfHdr ccs
 237         ++ staticTickyHdr
 238 \end{code}
 239
 240 %************************************************************************
 241 %*                                                                      *
 242 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
 243 %*                                                                      *
 244 %************************************************************************
 245
 246 The new code  for heapChecks. For GrAnSim the code for doing a heap check
 247 and doing a context switch has been separated. Especially, the HEAP_CHK
 248 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
 249 doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
 250 beginning of every slow entry code in order to simulate the fetching of
 251 closures. If fetching is necessary (i.e. current closure is not local) then
 252 an automatic context switch is done.
 253
 254 --------------------------------------------------------------
 255 A heap/stack check at a function or thunk entry point.
 256
 257 \begin{code}
 258 funEntryChecks :: ClosureInfo -> CmmStmts -> Code -> Code
 259 funEntryChecks cl_info reg_save_code code
 260   = hpStkCheck cl_info True reg_save_code code
 261
 262 thunkEntryChecks :: ClosureInfo -> Code -> Code
 263 thunkEntryChecks cl_info code
 264   = hpStkCheck cl_info False noStmts code
 265
 266 hpStkCheck :: ClosureInfo       -- Function closure
 267            -> Bool              -- Is a function? (not a thunk)
 268            -> CmmStmts          -- Register saves
 269            -> Code
 270            -> Code
 271
 272 hpStkCheck cl_info is_fun reg_save_code code
 273   =  getFinalStackHW    $ \ spHw -> do
 274         { sp <- getRealSp
 275         ; let stk_words = spHw - sp
 276         ; initHeapUsage $ \ hpHw  -> do
 277             {   -- Emit heap checks, but be sure to do it lazily so
 278                 -- that the conditionals on hpHw don't cause a black hole
 279               codeOnly $ do
 280                 { do_checks stk_words hpHw full_save_code rts_label
 281                 ; tickyAllocHeap hpHw }
 282             ; setRealHp hpHw
 283             ; code }
 284         }
 285   where
 286     node_asst
 287         | nodeMustPointToIt (closureLFInfo cl_info)
 288         = noStmts
 289         | otherwise
 290         = oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl)))
 291         -- Strictly speaking, we should tag node here.  But if
 292         -- node doesn't point to the closure, the code for the closure
 293         -- cannot depend on the value of R1 anyway, so we're safe.
 294     closure_lbl = closureLabelFromCI cl_info
 295
 296     full_save_code = node_asst `plusStmts` reg_save_code
 297
 298     rts_label | is_fun    = CmmReg (CmmGlobal GCFun)
 299                                 -- Function entry point
 300               | otherwise = CmmReg (CmmGlobal GCEnter1)
 301                                 -- Thunk or case return
 302         -- In the thunk/case-return case, R1 points to a closure
 303         -- which should be (re)-entered after GC
 304 \end{code}
 305
 306 Heap checks in a case alternative are nice and easy, provided this is
 307 a bog-standard algebraic case.  We have in our hand:
 308
 309        * one return address, on the stack,
 310        * one return value, in Node.
 311
 312 the canned code for this heap check failure just pushes Node on the
 313 stack, saying 'EnterGHC' to return.  The scheduler will return by
 314 entering the top value on the stack, which in turn will return through
 315 the return address, getting us back to where we were.  This is
 316 therefore only valid if the return value is *lifted* (just being
 317 boxed isn't good enough).
 318
 319 For primitive returns, we have an unlifted value in some register
 320 (either R1 or FloatReg1 or DblReg1).  This means using specialised
 321 heap-check code for these cases.
 322
 323 \begin{code}
 324 altHeapCheck
 325     :: AltType  -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
 326                 --      (Unboxed tuples are dealt with by ubxTupleHeapCheck)
 327     -> Code     -- Continuation
 328     -> Code
 329 altHeapCheck alt_type code
 330   = initHeapUsage $ \ hpHw -> do
 331         { codeOnly $ do
 332              { do_checks 0 {- no stack chk -} hpHw
 333                          noStmts {- nothign to save -}
 334                          (rts_label alt_type)
 335              ; tickyAllocHeap hpHw }
 336         ; setRealHp hpHw
 337         ; code }
 338   where
 339     rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")))
 340         -- Do *not* enter R1 after a heap check in
 341         -- a polymorphic case.  It might be a function
 342         -- and the entry code for a function (currently)
 343         -- applies it
 344         --
 345         -- However R1 is guaranteed to be a pointer
 346
 347     rts_label (AlgAlt tc) = stg_gc_enter1
 348         -- Enter R1 after the heap check; it's a pointer
 349
 350     rts_label (PrimAlt tc)
 351       = CmmLit $ CmmLabel $
 352         case primRepToCgRep (tyConPrimRep tc) of
 353           VoidArg   -> mkRtsCodeLabel SLIT( "stg_gc_noregs")
 354           FloatArg  -> mkRtsCodeLabel SLIT( "stg_gc_f1")
 355           DoubleArg -> mkRtsCodeLabel SLIT( "stg_gc_d1")
 356           LongArg   -> mkRtsCodeLabel SLIT( "stg_gc_l1")
 357                                 -- R1 is boxed but unlifted:
 358           PtrArg    -> mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")
 359                                 -- R1 is unboxed:
 360           NonPtrArg -> mkRtsCodeLabel SLIT( "stg_gc_unbx_r1")
 361
 362     rts_label (UbxTupAlt _) = panic "altHeapCheck"
 363 \end{code}
 364
 365
 366 Unboxed tuple alternatives and let-no-escapes (the two most annoying
 367 constructs to generate code for!)  For unboxed tuple returns, there
 368 are an arbitrary number of possibly unboxed return values, some of
 369 which will be in registers, and the others will be on the stack.  We
 370 always organise the stack-resident fields into pointers &
 371 non-pointers, and pass the number of each to the heap check code.
 372
 373 \begin{code}
 374 unbxTupleHeapCheck
 375         :: [(Id, GlobalReg)]    -- Live registers
 376         -> WordOff      -- no. of stack slots containing ptrs
 377         -> WordOff      -- no. of stack slots containing nonptrs
 378         -> CmmStmts     -- code to insert in the failure path
 379         -> Code
 380         -> Code
 381
 382 unbxTupleHeapCheck regs ptrs nptrs fail_code code
 383   -- We can't manage more than 255 pointers/non-pointers
 384   -- in a generic heap check.
 385   | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
 386   | otherwise
 387   = initHeapUsage $ \ hpHw -> do
 388         { codeOnly $ do { do_checks 0 {- no stack check -} hpHw
 389                                     full_fail_code rts_label
 390                         ; tickyAllocHeap hpHw }
 391         ; setRealHp hpHw
 392         ; code }
 393   where
 394     full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
 395     assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9))      -- Ho ho ho!
 396                                 (CmmLit (mkWordCLit liveness))
 397     liveness        = mkRegLiveness regs ptrs nptrs
 398     rts_label       = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_ut")))
 399
 400 \end{code}
 401
 402
 403 %************************************************************************
 404 %*                                                                      *
 405                 Heap/Stack Checks.
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 When failing a check, we save a return address on the stack and
 410 jump to a pre-compiled code fragment that saves the live registers
 411 and returns to the scheduler.
 412
 413 The return address in most cases will be the beginning of the basic
 414 block in which the check resides, since we need to perform the check
 415 again on re-entry because someone else might have stolen the resource
 416 in the meantime.
 417
 418 \begin{code}
 419 do_checks :: WordOff    -- Stack headroom
 420           -> WordOff    -- Heap  headroom
 421           -> CmmStmts   -- Assignments to perform on failure
 422           -> CmmExpr    -- Rts address to jump to on failure
 423           -> Code
 424 do_checks 0 0 _ _   = nopC
 425 do_checks stk hp reg_save_code rts_lbl
 426   = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE)))
 427                (CmmLit (mkIntCLit (hp*wORD_SIZE)))
 428          (stk /= 0) (hp /= 0) reg_save_code rts_lbl
 429
 430 -- The offsets are now in *bytes*
 431 do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
 432   = do  { doGranAllocate hp_expr
 433
 434         -- Emit a block for the heap-check-failure code
 435         ; blk_id <- forkLabelledCode $ do
 436                         { whenC hp_nonzero $
 437                                 stmtC (CmmAssign (CmmGlobal HpAlloc) hp_expr)
 438                         ; emitStmts reg_save_code
 439                         ; stmtC (CmmJump rts_lbl []) }
 440
 441         -- Check for stack overflow *FIRST*; otherwise
 442         -- we might bumping Hp and then failing stack oflo
 443         ; whenC stk_nonzero
 444                 (stmtC (CmmCondBranch stk_oflo blk_id))
 445
 446         ; whenC hp_nonzero
 447                 (stmtsC [CmmAssign hpReg
 448                                 (cmmOffsetExprB (CmmReg hpReg) hp_expr),
 449                         CmmCondBranch hp_oflo blk_id])
 450                 -- Bump heap pointer, and test for heap exhaustion
 451                 -- Note that we don't move the heap pointer unless the
 452                 -- stack check succeeds.  Otherwise we might end up
 453                 -- with slop at the end of the current block, which can
 454                 -- confuse the LDV profiler.
 455     }
 456   where
 457         -- Stk overflow if (Sp - stk_bytes < SpLim)
 458     stk_oflo = CmmMachOp mo_wordULt
 459                   [CmmMachOp mo_wordSub [CmmReg spReg, stk_expr],
 460                    CmmReg (CmmGlobal SpLim)]
 461
 462         -- Hp overflow if (Hpp > HpLim)
 463         -- (Hp has been incremented by now)
 464         -- HpLim points to the LAST WORD of valid allocation space.
 465     hp_oflo = CmmMachOp mo_wordUGt
 466                   [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
 467 \end{code}
 468
 469 %************************************************************************
 470 %*                                                                      *
 471      Generic Heap/Stack Checks - used in the RTS
 472 %*                                                                      *
 473 %************************************************************************
 474
 475 \begin{code}
 476 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 477 hpChkGen bytes liveness reentry
 478   = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns stg_gc_gen
 479   where
 480     assigns = mkStmts [
 481                 CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
 482                 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
 483                 ]
 484
 485 -- a heap check where R1 points to the closure to enter on return, and
 486 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
 487 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
 488 hpChkNodePointsAssignSp0 bytes sp0
 489   = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign stg_gc_enter1
 490   where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
 491
 492 stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 493 stkChkGen bytes liveness reentry
 494   = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns stg_gc_gen
 495   where
 496     assigns = mkStmts [
 497                 CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
 498                 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
 499                 ]
 500
 501 stkChkNodePoints :: CmmExpr -> Code
 502 stkChkNodePoints bytes
 503   = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1
 504
 505 stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_gen")))
 506 stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1)
 507 \end{code}
 508
 509 %************************************************************************
 510 %*                                                                      *
 511 \subsection[initClosure]{Initialise a dynamic closure}
 512 %*                                                                      *
 513 %************************************************************************
 514
 515 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
 516 to account for this.
 517
 518 \begin{code}
 519 allocDynClosure
 520         :: ClosureInfo
 521         -> CmmExpr              -- Cost Centre to stick in the object
 522         -> CmmExpr              -- Cost Centre to blame for this alloc
 523                                 -- (usually the same; sometimes "OVERHEAD")
 524
 525         -> [(CmmExpr, VirtualHpOffset)] -- Offsets from start of the object
 526                                         -- ie Info ptr has offset zero.
 527         -> FCode VirtualHpOffset        -- Returns virt offset of object
 528
 529 allocDynClosure cl_info use_cc blame_cc amodes_with_offsets
 530   = do  { virt_hp <- getVirtHp
 531
 532         -- FIND THE OFFSET OF THE INFO-PTR WORD
 533         ; let   info_offset = virt_hp + 1
 534                 -- info_offset is the VirtualHpOffset of the first
 535                 -- word of the new object
 536                 -- Remember, virtHp points to last allocated word,
 537                 -- ie 1 *before* the info-ptr word of new object.
 538
 539                 info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
 540                 hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
 541
 542         -- SAY WHAT WE ARE ABOUT TO DO
 543         ; profDynAlloc cl_info use_cc
 544                 -- ToDo: This is almost certainly wrong
 545                 -- We're ignoring blame_cc. But until we've
 546                 -- fixed the boxing hack in chooseDynCostCentres etc,
 547                 -- we're worried about making things worse by "fixing"
 548                 -- this part to use blame_cc!
 549
 550         ; tickyDynAlloc cl_info
 551
 552         -- ALLOCATE THE OBJECT
 553         ; base <- getHpRelOffset info_offset
 554         ; hpStore base (hdr_w_offsets ++ amodes_with_offsets)
 555
 556         -- BUMP THE VIRTUAL HEAP POINTER
 557         ; setVirtHp (virt_hp + closureSize cl_info)
 558
 559         -- RETURN PTR TO START OF OBJECT
 560         ; returnFC info_offset }
 561
 562
 563 initDynHdr :: CmmExpr
 564            -> CmmExpr           -- Cost centre to put in object
 565            -> [CmmExpr]
 566 initDynHdr info_ptr cc
 567   =  [info_ptr]
 568         -- ToDo: Gransim stuff
 569         -- ToDo: Parallel stuff
 570   ++ dynProfHdr cc
 571         -- No ticky header
 572
 573 hpStore :: CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> Code
 574 -- Store the item (expr,off) in base[off]
 575 hpStore base es
 576   = stmtsC [ CmmStore (cmmOffsetW base off) val
 577            | (val, off) <- es ]
 578
 579 emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 580 emitSetDynHdr base info_ptr ccs
 581   = hpStore base (zip (initDynHdr info_ptr ccs) [0..])
 582 \end{code}