ghc/compiler/codeGen/CgMonad.lhs

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