ghc/compiler/codeGen/CgMonad.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgMonad.lhs,v 1.31 2001/10/15 16:03:04 simonpj Exp $
   5 %
   6 \section[CgMonad]{The code generation monad}
   7
   8 See the beginning of the top-level @CodeGen@ module, to see how this
   9 monadic stuff fits into the Big Picture.
  10
  11 \begin{code}
  12 module CgMonad (
  13         Code,   -- type
  14         FCode,  -- type
  15
  16         initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
  17         returnFC, fixC, absC, nopC, getAbsC,
  18
  19         forkClosureBody, forkStatics, forkAlts, forkEval,
  20         forkEvalHelp, forkAbsC,
  21         SemiTaggingStuff,
  22
  23         EndOfBlockInfo(..),
  24         setEndOfBlockInfo, getEndOfBlockInfo,
  25
  26         setSRTLabel, getSRTLabel, getSRTInfo,
  27         setTickyCtrLabel, getTickyCtrLabel,
  28
  29         StackUsage, Slot(..), HeapUsage,
  30
  31         profCtrC, profCtrAbsC,
  32
  33         costCentresC, moduleName,
  34
  35         Sequel(..), -- ToDo: unabstract?
  36         sequelToAmode,
  37
  38         -- ideally we wouldn't export these, but some other modules access internal state
  39         getState, setState, getInfoDown,
  40
  41         -- more localised access to monad state
  42         getUsage, setUsage,
  43         getBinds, setBinds, getStaticBinds,
  44
  45         -- out of general friendliness, we also export ...
  46         CgInfoDownwards(..), CgState(..),       -- non-abstract
  47         CompilationInfo(..)
  48     ) where
  49
  50 #include "HsVersions.h"
  51
  52 import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
  53 import {-# SOURCE #-} CgUsages  ( getSpRelOffset )
  54
  55 import AbsCSyn
  56 import StgSyn           ( SRT(..) )
  57 import AbsCUtils        ( mkAbsCStmts )
  58 import CmdLineOpts      ( opt_SccProfilingOn, opt_DoTickyProfiling )
  59 import CLabel           ( CLabel, mkUpdInfoLabel, mkTopTickyCtrLabel )
  60 import Module           ( Module )
  61 import DataCon          ( ConTag )
  62 import Id               ( Id )
  63 import VarEnv
  64 import PrimRep          ( PrimRep(..) )
  65 import Outputable
  66
  67 infixr 9 `thenC`        -- Right-associative!
  68 infixr 9 `thenFC`
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection[CgMonad-environment]{Stuff for manipulating environments}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 This monadery has some information that it only passes {\em
  78 downwards}, as well as some ``state'' which is modified as we go
  79 along.
  80
  81 \begin{code}
  82 data CgInfoDownwards    -- information only passed *downwards* by the monad
  83   = MkCgInfoDown
  84      CompilationInfo    -- COMPLETELY STATIC info about this compilation
  85                         --  (e.g., what flags were passed to the compiler)
  86
  87      CgBindings         -- [Id -> info] : static environment
  88
  89      CLabel             -- label of the current SRT
  90
  91      CLabel             -- current destination for ticky counts
  92
  93      EndOfBlockInfo     -- Info for stuff to do at end of basic block:
  94
  95
  96 data CompilationInfo
  97   = MkCompInfo
  98         Module          -- the module name
  99
 100 data CgState
 101   = MkCgState
 102         AbstractC       -- code accumulated so far
 103         CgBindings      -- [Id -> info] : *local* bindings environment
 104                         -- Bindings for top-level things are given in the info-down part
 105         CgStksAndHeapUsage
 106 \end{code}
 107
 108 @EndOfBlockInfo@ tells what to do at the end of this block of code or,
 109 if the expression is a @case@, what to do at the end of each
 110 alternative.
 111
 112 \begin{code}
 113 data EndOfBlockInfo
 114   = EndOfBlockInfo
 115         VirtualSpOffset   -- Args Sp: trim the stack to this point at a
 116                           -- return; push arguments starting just
 117                           -- above this point on a tail call.
 118
 119                           -- This is therefore the stk ptr as seen
 120                           -- by a case alternative.
 121         Sequel
 122
 123 initEobInfo = EndOfBlockInfo 0 (OnStack 0)
 124 \end{code}
 125
 126 Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
 127 that it must survive stack pointer adjustments at the end of the
 128 block.
 129
 130 \begin{code}
 131 data Sequel
 132   = OnStack
 133         VirtualSpOffset   -- Continuation is on the stack, at the
 134                           -- specified location
 135
 136   | UpdateCode
 137
 138   | CaseAlts
 139           CAddrMode   -- Jump to this; if the continuation is for a vectored
 140                       -- case this might be the label of a return
 141                       -- vector Guaranteed to be a non-volatile
 142                       -- addressing mode (I think)
 143           SemiTaggingStuff
 144
 145   | SeqFrame                    -- like CaseAlts but push a seq frame too.
 146           CAddrMode
 147           SemiTaggingStuff
 148
 149 type SemiTaggingStuff
 150   = Maybe                           -- Maybe[1] we don't have any semi-tagging stuff...
 151      ([(ConTag, JoinDetails)],      -- Alternatives
 152       Maybe (Maybe Id, JoinDetails) -- Default (but Maybe[2] we don't have one)
 153                                     -- Maybe[3] the default is a
 154                                     -- bind-default (Just b); that is,
 155                                     -- it expects a ptr to the thing
 156                                     -- in Node, bound to b
 157      )
 158
 159 type JoinDetails
 160   = (AbstractC, CLabel)         -- Code to load regs from heap object + profiling macros,
 161                                 -- and join point label
 162
 163 -- The abstract C is executed only from a successful semitagging
 164 -- venture, when a case has looked at a variable, found that it's
 165 -- evaluated, and wants to load up the contents and go to the join
 166 -- point.
 167
 168 -- DIRE WARNING.
 169 -- The OnStack case of sequelToAmode delivers an Amode which is only
 170 -- valid just before the final control transfer, because it assumes
 171 -- that Sp is pointing to the top word of the return address.  This
 172 -- seems unclean but there you go.
 173
 174 -- sequelToAmode returns an amode which refers to an info table.  The info
 175 -- table will always be of the RET(_VEC)?_(BIG|SMALL) kind.  We're careful
 176 -- not to handle real code pointers, just in case we're compiling for
 177 -- an unregisterised/untailcallish architecture, where info pointers and
 178 -- code pointers aren't the same.
 179
 180 sequelToAmode :: Sequel -> FCode CAddrMode
 181
 182 sequelToAmode (OnStack virt_sp_offset)
 183   = getSpRelOffset virt_sp_offset `thenFC` \ sp_rel ->
 184     returnFC (CVal sp_rel RetRep)
 185
 186 sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep)
 187 sequelToAmode (CaseAlts amode _) = returnFC amode
 188 sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame"
 189
 190 type CgStksAndHeapUsage         -- stacks and heap usage information
 191   = (StackUsage, HeapUsage)
 192
 193 data Slot = Free | NonPointer
 194   deriving
 195 #ifdef DEBUG
 196         (Eq,Show)
 197 #else
 198         Eq
 199 #endif
 200
 201 type StackUsage =
 202         (Int,              -- virtSp: Virtual offset of topmost allocated slot
 203          [(Int,Slot)],     -- free:   List of free slots, in increasing order
 204          Int,              -- realSp: Virtual offset of real stack pointer
 205          Int)              -- hwSp:   Highest value ever taken by virtSp
 206
 207 type HeapUsage =
 208         (HeapOffset,    -- virtHp: Virtual offset of highest-allocated word
 209          HeapOffset)    -- realHp: Virtual offset of real heap ptr
 210 \end{code}
 211
 212 NB: absolutely every one of the above Ints is really
 213 a VirtualOffset of some description (the code generator
 214 works entirely in terms of VirtualOffsets).
 215
 216 Initialisation.
 217
 218 \begin{code}
 219 initialStateC = MkCgState AbsCNop emptyVarEnv initUsage
 220
 221 initUsage :: CgStksAndHeapUsage
 222 initUsage  = ((0,[],0,0), (0,0))
 223 \end{code}
 224
 225 "envInitForAlternatives" initialises the environment for a case alternative,
 226 assuming that the alternative is entered after an evaluation.
 227 This involves:
 228
 229    - zapping any volatile bindings, which aren't valid.
 230
 231    - zapping the heap usage. It should be restored by a heap check.
 232
 233    - setting the virtual AND real stack pointer fields to the given
 234    virtual stack offsets.  this doesn't represent any {\em code}; it is a
 235    prediction of where the real stack pointer will be when we come back
 236    from the case analysis.
 237
 238    - BUT LEAVING the rest of the stack-usage info because it is all
 239    valid.  In particular, we leave the tail stack pointers unchanged,
 240    becuase the alternative has to de-allocate the original @case@
 241    expression's stack.  \end{itemize}
 242
 243 @stateIncUsage@$~e_1~e_2$ incorporates in $e_1$ the stack and heap high water
 244 marks found in $e_2$.
 245
 246 \begin{code}
 247 stateIncUsage :: CgState -> CgState -> CgState
 248
 249 stateIncUsage (MkCgState abs_c bs ((v,f,r,h1),(vH1,rH1)))
 250               (MkCgState _     _  ((_,_,_,h2),(vH2, _)))
 251      = MkCgState abs_c
 252                  bs
 253                  ((v,f,r,h1 `max` h2),
 254                   (vH1 `max` vH2, rH1))
 255 \end{code}
 256
 257 %************************************************************************
 258 %*                                                                      *
 259 \subsection[CgMonad-basics]{Basic code-generation monad magic}
 260 %*                                                                      *
 261 %************************************************************************
 262
 263 \begin{code}
 264 newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 265 type Code    = FCode ()
 266
 267 instance Monad FCode where
 268         (>>=) = thenFC
 269         return = returnFC
 270
 271 {-# INLINE thenC #-}
 272 {-# INLINE thenFC #-}
 273 {-# INLINE returnFC #-}
 274 \end{code}
 275 The Abstract~C is not in the environment so as to improve strictness.
 276
 277 \begin{code}
 278 initC :: CompilationInfo -> Code -> AbstractC
 279
 280 initC cg_info (FCode code)
 281   = case (code (MkCgInfoDown
 282                         cg_info
 283                         emptyVarEnv -- (error "initC: statics")
 284                         (error "initC: srt")
 285                         (mkTopTickyCtrLabel)
 286                         initEobInfo)
 287                initialStateC) of
 288       ((),MkCgState abc _ _) -> abc
 289
 290 returnFC :: a -> FCode a
 291 returnFC val = FCode (\info_down state -> (val, state))
 292 \end{code}
 293
 294 \begin{code}
 295 thenC :: Code -> FCode a -> FCode a
 296 thenC (FCode m) (FCode k) =
 297         FCode (\info_down state -> let (_,new_state) = m info_down state in
 298                 k info_down new_state)
 299
 300 listCs :: [Code] -> Code
 301 listCs [] = return ()
 302 listCs (fc:fcs) = do
 303         fc
 304         listCs fcs
 305
 306 mapCs :: (a -> Code) -> [a] -> Code
 307 mapCs = mapM_
 308 \end{code}
 309
 310 \begin{code}
 311 thenFC  :: FCode a -> (a -> FCode c) -> FCode c
 312 thenFC (FCode m) k = FCode (
 313         \info_down state ->
 314                 let
 315                         (m_result, new_state) = m info_down state
 316                         (FCode kcode) = k m_result
 317                 in
 318                         kcode info_down new_state
 319         )
 320
 321 listFCs :: [FCode a] -> FCode [a]
 322 listFCs = sequence
 323
 324 mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
 325 mapFCs = mapM
 326 \end{code}
 327
 328 And the knot-tying combinator:
 329 \begin{code}
 330 fixC :: (a -> FCode a) -> FCode a
 331 fixC fcode = FCode (
 332         \info_down state ->
 333                 let
 334                         FCode fc = fcode v
 335                         result@(v,_) = fc info_down state
 336                         --          ^--------^
 337                 in
 338                         result
 339         )
 340 \end{code}
 341
 342 Operators for getting and setting the state and "info_down".
 343 To maximise encapsulation, code should try to only get and set the
 344 state it actually uses.
 345
 346 \begin{code}
 347 getState :: FCode CgState
 348 getState = FCode $ \info_down state -> (state,state)
 349
 350 setState :: CgState -> FCode ()
 351 setState state = FCode $ \info_down _ -> ((),state)
 352
 353 getUsage :: FCode CgStksAndHeapUsage
 354 getUsage = do
 355         MkCgState absC binds usage <- getState
 356         return usage
 357
 358 setUsage :: CgStksAndHeapUsage -> FCode ()
 359 setUsage newusage = do
 360         MkCgState absC binds usage <- getState
 361         setState $ MkCgState absC binds newusage
 362
 363 getBinds :: FCode CgBindings
 364 getBinds = do
 365         MkCgState absC binds usage <- getState
 366         return binds
 367
 368 setBinds :: CgBindings -> FCode ()
 369 setBinds newbinds = do
 370         MkCgState absC binds usage <- getState
 371         setState $ MkCgState absC newbinds usage
 372
 373 getStaticBinds :: FCode CgBindings
 374 getStaticBinds = do
 375         (MkCgInfoDown _ static_binds _ _ _) <- getInfoDown
 376         return static_binds
 377
 378 withState :: FCode a -> CgState -> FCode (a,CgState)
 379 withState (FCode fcode) newstate = FCode $ \info_down state ->
 380         let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
 381
 382 getInfoDown :: FCode CgInfoDownwards
 383 getInfoDown = FCode $ \info_down state -> (info_down,state)
 384
 385 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
 386 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
 387
 388 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
 389 doFCode (FCode fcode) info_down state = fcode info_down state
 390 \end{code}
 391
 392
 393 @forkClosureBody@ takes a code, $c$, and compiles it in a completely
 394 fresh environment, except that:
 395         - compilation info and statics are passed in unchanged.
 396 The current environment is passed on completely unaltered, except that
 397 abstract C from the fork is incorporated.
 398
 399 @forkAbsC@ takes a code and compiles it in the current environment,
 400 returning the abstract C thus constructed.  The current environment
 401 is passed on completely unchanged.  It is pretty similar to @getAbsC@,
 402 except that the latter does affect the environment. ToDo: combine?
 403
 404 @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
 405 from the current bindings, but which is otherwise freshly initialised.
 406 The Abstract~C returned is attached to the current state, but the
 407 bindings and usage information is otherwise unchanged.
 408
 409 \begin{code}
 410 forkClosureBody :: Code -> Code
 411
 412 forkClosureBody (FCode code) = do
 413         (MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
 414         (MkCgState absC_in binds un_usage) <- getState
 415         let     body_info_down = MkCgInfoDown cg_info statics srt ticky initEobInfo
 416         let     ((),fork_state)             = code body_info_down initialStateC
 417         let     MkCgState absC_fork _ _ = fork_state
 418         setState $ MkCgState (AbsCStmts absC_in absC_fork) binds un_usage
 419
 420 forkStatics :: FCode a -> FCode a
 421
 422 forkStatics (FCode fcode) = FCode (
 423         \(MkCgInfoDown cg_info _ srt ticky _)
 424         (MkCgState absC_in statics un_usage)
 425   ->
 426         let
 427                 (result, state) = fcode rhs_info_down initialStateC
 428                 MkCgState absC_fork _ _ = state -- Don't merge these this line with the one
 429                                 -- above or it becomes too strict!
 430                 rhs_info_down = MkCgInfoDown cg_info statics srt ticky initEobInfo
 431         in
 432                 (result, MkCgState (AbsCStmts absC_in absC_fork) statics un_usage)
 433         )
 434
 435 forkAbsC :: Code -> FCode AbstractC
 436 forkAbsC (FCode code) =
 437         do
 438                 info_down <- getInfoDown
 439                 (MkCgState absC1 bs usage) <- getState
 440                 let ((),MkCgState absC2 _ ((_, _, _,h2), _)) = code info_down (MkCgState AbsCNop bs usage)
 441                 let ((v, f, r, h1), heap_usage) = usage
 442                 let new_usage = ((v, f, r, h1 `max` h2), heap_usage)
 443                 setState $ MkCgState absC1 bs new_usage
 444                 return absC2
 445 \end{code}
 446
 447 @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
 448 an fcode for the default case $d$, and compiles each in the current
 449 environment.  The current environment is passed on unmodified, except
 450 that
 451         - the worst stack high-water mark is incorporated
 452         - the virtual Hp is moved on to the worst virtual Hp for the branches
 453
 454 \begin{code}
 455 forkAlts :: [FCode a] -> FCode b -> FCode ([a],b)
 456
 457 forkAlts branch_fcodes (FCode deflt_fcode) =
 458         do
 459                 info_down <- getInfoDown
 460                 in_state <- getState
 461                 let compile (FCode fc) = fc info_down in_state
 462                 let (branch_results, branch_out_states) = unzip (map compile branch_fcodes)
 463                 let (deflt_result, deflt_out_state) = deflt_fcode info_down in_state
 464                 setState $ foldl stateIncUsage in_state (deflt_out_state:branch_out_states)
 465                                 -- NB foldl.  in_state is the *left* argument to stateIncUsage
 466                 return (branch_results, deflt_result)
 467
 468 \end{code}
 469
 470 @forkEval@ takes two blocks of code.
 471
 472    -  The first meddles with the environment to set it up as expected by
 473       the alternatives of a @case@ which does an eval (or gc-possible primop).
 474    -  The second block is the code for the alternatives.
 475       (plus info for semi-tagging purposes)
 476
 477 @forkEval@ picks up the virtual stack pointer and returns a suitable
 478 @EndOfBlockInfo@ for the caller to use, together with whatever value
 479 is returned by the second block.
 480
 481 It uses @initEnvForAlternatives@ to initialise the environment, and
 482 @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
 483 usage.
 484
 485 \begin{code}
 486 forkEval :: EndOfBlockInfo              -- For the body
 487          -> Code                        -- Code to set environment
 488          -> FCode Sequel                -- Semi-tagging info to store
 489          -> FCode EndOfBlockInfo        -- The new end of block info
 490
 491 forkEval body_eob_info env_code body_code
 492   = forkEvalHelp body_eob_info env_code body_code `thenFC` \ (v, sequel) ->
 493     returnFC (EndOfBlockInfo v sequel)
 494
 495 forkEvalHelp :: EndOfBlockInfo  -- For the body
 496              -> Code            -- Code to set environment
 497              -> FCode a         -- The code to do after the eval
 498              -> FCode (Int,     -- Sp
 499                        a)       -- Result of the FCode
 500
 501 forkEvalHelp body_eob_info env_code body_code =
 502         do
 503                 info_down@(MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
 504                 state <- getState
 505                 let info_down_for_body = MkCgInfoDown cg_info statics srt ticky body_eob_info
 506                 let (_,MkCgState _ binds ((v,f,_,_),_)) =
 507                         doFCode env_code info_down_for_body state
 508                 let state_for_body = MkCgState AbsCNop
 509                              (nukeVolatileBinds binds)
 510                              ((v,f,v,v), (0,0))
 511                 let (value_returned, state_at_end_return) =
 512                         doFCode body_code info_down_for_body state_for_body
 513                 setState $ state `stateIncUsageEval` state_at_end_return
 514                 return (v,value_returned)
 515
 516 stateIncUsageEval :: CgState -> CgState -> CgState
 517 stateIncUsageEval (MkCgState absC1 bs ((v,f,r,h1),heap_usage))
 518                   (MkCgState absC2 _  ((_,_,_,h2),         _))
 519      = MkCgState (absC1 `mkAbsCStmts` absC2)
 520                  -- The AbsC coming back should consist only of nested declarations,
 521                  -- notably of the return vector!
 522                  bs
 523                  ((v,f,r,h1 `max` h2), heap_usage)
 524         -- We don't max the heap high-watermark because stateIncUsageEval is
 525         -- used only in forkEval, which in turn is only used for blocks of code
 526         -- which do their own heap-check.
 527 \end{code}
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection[CgMonad-spitting-AbstractC]{Spitting out @AbstractC@}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 @nopC@ is the no-op for the @Code@ monad; it adds no Abstract~C to the
 536 environment; @absC@ glues @ab_C@ onto the Abstract~C collected so far.
 537 \begin{code}
 538 nopC :: Code
 539 nopC = return ()
 540
 541 absC :: AbstractC -> Code
 542 absC more_absC = do
 543         state@(MkCgState absC binds usage) <- getState
 544         setState $ MkCgState (mkAbsCStmts absC more_absC) binds usage
 545 \end{code}
 546
 547 These two are just like @absC@, except they examine the compilation
 548 info (whether SCC profiling or profiling-ctrs going) and possibly emit
 549 nothing.
 550
 551 \begin{code}
 552 costCentresC :: FAST_STRING -> [CAddrMode] -> Code
 553
 554 costCentresC macro args =
 555         if opt_SccProfilingOn then do
 556                 (MkCgState absC binds usage) <- getState
 557                 setState $ MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
 558         else
 559                 nopC
 560
 561 profCtrC :: FAST_STRING -> [CAddrMode] -> Code
 562
 563 profCtrC macro args =
 564         if not opt_DoTickyProfiling
 565     then nopC
 566         else do
 567                 (MkCgState absC binds usage) <- getState
 568                 setState $ MkCgState (mkAbsCStmts absC (CCallProfCtrMacro macro args)) binds usage
 569
 570 profCtrAbsC :: FAST_STRING -> [CAddrMode] -> AbstractC
 571
 572 profCtrAbsC macro args
 573   = if not opt_DoTickyProfiling
 574     then AbsCNop
 575     else CCallProfCtrMacro macro args
 576
 577 {- Try to avoid adding too many special compilation strategies here.
 578    It's better to modify the header files as necessary for particular
 579    targets, so that we can get away with as few variants of .hc files
 580    as possible.
 581 -}
 582 \end{code}
 583
 584 @getAbsC@ compiles the code in the current environment, and returns
 585 the abstract C thus constructed (leaving the abstract C being carried
 586 around in the state untouched).  @getAbsC@ does not generate any
 587 in-line Abstract~C itself, but the environment it returns is that
 588 obtained from the compilation.
 589
 590 \begin{code}
 591 getAbsC :: Code -> FCode AbstractC
 592 getAbsC code = do
 593         MkCgState absC binds usage <- getState
 594         ((),MkCgState absC2 binds2 usage2) <- withState code (MkCgState AbsCNop binds usage)
 595         setState $ MkCgState absC binds2 usage2
 596         return absC2
 597 \end{code}
 598
 599 \begin{code}
 600 moduleName :: FCode Module
 601 moduleName = do
 602         (MkCgInfoDown (MkCompInfo mod_name) _ _ _ _) <- getInfoDown
 603         return mod_name
 604 \end{code}
 605
 606 \begin{code}
 607 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
 608 setEndOfBlockInfo eob_info code = do
 609         (MkCgInfoDown c_info statics srt ticky _) <- getInfoDown
 610         withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
 611
 612 getEndOfBlockInfo :: FCode EndOfBlockInfo
 613 getEndOfBlockInfo = do
 614         (MkCgInfoDown c_info statics _ _ eob_info) <- getInfoDown
 615         return eob_info
 616 \end{code}
 617
 618 \begin{code}
 619 getSRTInfo :: SRT -> FCode C_SRT
 620 getSRTInfo NoSRT         = return NoC_SRT
 621 getSRTInfo (SRT off len) = do srt_lbl <- getSRTLabel
 622                               return (C_SRT srt_lbl off len)
 623
 624 getSRTLabel :: FCode CLabel     -- Used only by cgPanic
 625 getSRTLabel = do MkCgInfoDown _ _ srt_lbl _ _ <- getInfoDown
 626                  return srt_lbl
 627
 628 setSRTLabel :: CLabel -> Code -> Code
 629 setSRTLabel srt_lbl code
 630   = do  MkCgInfoDown c_info statics _ ticky eob_info <- getInfoDown
 631         withInfoDown code (MkCgInfoDown c_info statics srt_lbl ticky eob_info)
 632 \end{code}
 633
 634 \begin{code}
 635 getTickyCtrLabel :: FCode CLabel
 636 getTickyCtrLabel = do
 637         (MkCgInfoDown _ _ _ ticky _) <- getInfoDown
 638         return ticky
 639
 640 setTickyCtrLabel :: CLabel -> Code -> Code
 641 setTickyCtrLabel ticky code = do
 642         (MkCgInfoDown c_info statics srt _ eob_info) <- getInfoDown
 643         withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
 644 \end{code}