ghc/compiler/codeGen/CgMonad.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgMonad.lhs,v 1.36 2002/12/11 15:36:26 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 type HeapUsage =
 210         (HeapOffset,    -- virtHp: Virtual offset of highest-allocated word
 211          HeapOffset)    -- realHp: Virtual offset of real heap ptr
 212 \end{code}
 213
 214 NB: absolutely every one of the above Ints is really
 215 a VirtualOffset of some description (the code generator
 216 works entirely in terms of VirtualOffsets).
 217
 218 Initialisation.
 219
 220 \begin{code}
 221 initialStateC = MkCgState AbsCNop emptyVarEnv initUsage
 222
 223 initUsage :: CgStksAndHeapUsage
 224 initUsage  = ((0,0,[],0,0), (0,0))
 225 \end{code}
 226
 227 @stateIncUsage@$~e_1~e_2$ incorporates in $e_1$ the stack and heap high water
 228 marks found in $e_2$.
 229
 230 \begin{code}
 231 stateIncUsage :: CgState -> CgState -> CgState
 232
 233 stateIncUsage (MkCgState abs_c bs ((v,t,f,r,h1),(vH1,rH1)))
 234               (MkCgState _     _  ((_,_,_,_,h2),(vH2, _)))
 235      = MkCgState abs_c
 236                  bs
 237                  ((v,t,f,r,h1 `max` h2),
 238                   (vH1 `max` vH2, rH1))
 239 \end{code}
 240
 241 %************************************************************************
 242 %*                                                                      *
 243 \subsection[CgMonad-basics]{Basic code-generation monad magic}
 244 %*                                                                      *
 245 %************************************************************************
 246
 247 \begin{code}
 248 newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
 249 type Code    = FCode ()
 250
 251 instance Monad FCode where
 252         (>>=) = thenFC
 253         return = returnFC
 254
 255 {-# INLINE thenC #-}
 256 {-# INLINE thenFC #-}
 257 {-# INLINE returnFC #-}
 258 \end{code}
 259 The Abstract~C is not in the environment so as to improve strictness.
 260
 261 \begin{code}
 262 initC :: CompilationInfo -> Code -> AbstractC
 263
 264 initC cg_info (FCode code)
 265   = case (code (MkCgInfoDown
 266                         cg_info
 267                         emptyVarEnv -- (error "initC: statics")
 268                         (error "initC: srt")
 269                         (mkTopTickyCtrLabel)
 270                         initEobInfo)
 271                initialStateC) of
 272       ((),MkCgState abc _ _) -> abc
 273
 274 returnFC :: a -> FCode a
 275 returnFC val = FCode (\info_down state -> (val, state))
 276 \end{code}
 277
 278 \begin{code}
 279 thenC :: Code -> FCode a -> FCode a
 280 thenC (FCode m) (FCode k) =
 281         FCode (\info_down state -> let (_,new_state) = m info_down state in
 282                 k info_down new_state)
 283
 284 listCs :: [Code] -> Code
 285 listCs [] = return ()
 286 listCs (fc:fcs) = do
 287         fc
 288         listCs fcs
 289
 290 mapCs :: (a -> Code) -> [a] -> Code
 291 mapCs = mapM_
 292 \end{code}
 293
 294 \begin{code}
 295 thenFC  :: FCode a -> (a -> FCode c) -> FCode c
 296 thenFC (FCode m) k = FCode (
 297         \info_down state ->
 298                 let
 299                         (m_result, new_state) = m info_down state
 300                         (FCode kcode) = k m_result
 301                 in
 302                         kcode info_down new_state
 303         )
 304
 305 listFCs :: [FCode a] -> FCode [a]
 306 listFCs = sequence
 307
 308 mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
 309 mapFCs = mapM
 310 \end{code}
 311
 312 And the knot-tying combinator:
 313 \begin{code}
 314 fixC :: (a -> FCode a) -> FCode a
 315 fixC fcode = FCode (
 316         \info_down state ->
 317                 let
 318                         FCode fc = fcode v
 319                         result@(v,_) = fc info_down state
 320                         --          ^--------^
 321                 in
 322                         result
 323         )
 324 \end{code}
 325
 326 Operators for getting and setting the state and "info_down".
 327 To maximise encapsulation, code should try to only get and set the
 328 state it actually uses.
 329
 330 \begin{code}
 331 getState :: FCode CgState
 332 getState = FCode $ \info_down state -> (state,state)
 333
 334 setState :: CgState -> FCode ()
 335 setState state = FCode $ \info_down _ -> ((),state)
 336
 337 getUsage :: FCode CgStksAndHeapUsage
 338 getUsage = do
 339         MkCgState absC binds usage <- getState
 340         return usage
 341
 342 setUsage :: CgStksAndHeapUsage -> FCode ()
 343 setUsage newusage = do
 344         MkCgState absC binds usage <- getState
 345         setState $ MkCgState absC binds newusage
 346
 347 getBinds :: FCode CgBindings
 348 getBinds = do
 349         MkCgState absC binds usage <- getState
 350         return binds
 351
 352 setBinds :: CgBindings -> FCode ()
 353 setBinds newbinds = do
 354         MkCgState absC binds usage <- getState
 355         setState $ MkCgState absC newbinds usage
 356
 357 getStaticBinds :: FCode CgBindings
 358 getStaticBinds = do
 359         (MkCgInfoDown _ static_binds _ _ _) <- getInfoDown
 360         return static_binds
 361
 362 withState :: FCode a -> CgState -> FCode (a,CgState)
 363 withState (FCode fcode) newstate = FCode $ \info_down state ->
 364         let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
 365
 366 getInfoDown :: FCode CgInfoDownwards
 367 getInfoDown = FCode $ \info_down state -> (info_down,state)
 368
 369 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
 370 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
 371
 372 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
 373 doFCode (FCode fcode) info_down state = fcode info_down state
 374 \end{code}
 375
 376
 377 @forkClosureBody@ takes a code, $c$, and compiles it in a completely
 378 fresh environment, except that:
 379         - compilation info and statics are passed in unchanged.
 380 The current environment is passed on completely unaltered, except that
 381 abstract C from the fork is incorporated.
 382
 383 @forkAbsC@ takes a code and compiles it in the current environment,
 384 returning the abstract C thus constructed.  The current environment
 385 is passed on completely unchanged.  It is pretty similar to @getAbsC@,
 386 except that the latter does affect the environment. ToDo: combine?
 387
 388 @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
 389 from the current bindings, but which is otherwise freshly initialised.
 390 The Abstract~C returned is attached to the current state, but the
 391 bindings and usage information is otherwise unchanged.
 392
 393 \begin{code}
 394 forkClosureBody :: Code -> Code
 395
 396 forkClosureBody (FCode code) = do
 397         (MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
 398         (MkCgState absC_in binds un_usage) <- getState
 399         let     body_info_down = MkCgInfoDown cg_info statics srt ticky initEobInfo
 400         let     ((),fork_state)             = code body_info_down initialStateC
 401         let     MkCgState absC_fork _ _ = fork_state
 402         setState $ MkCgState (AbsCStmts absC_in absC_fork) binds un_usage
 403
 404 forkStatics :: FCode a -> FCode a
 405
 406 forkStatics (FCode fcode) = FCode (
 407         \(MkCgInfoDown cg_info _ srt ticky _)
 408         (MkCgState absC_in statics un_usage)
 409   ->
 410         let
 411                 (result, state) = fcode rhs_info_down initialStateC
 412                 MkCgState absC_fork _ _ = state -- Don't merge these this line with the one
 413                                 -- above or it becomes too strict!
 414                 rhs_info_down = MkCgInfoDown cg_info statics srt ticky initEobInfo
 415         in
 416                 (result, MkCgState (AbsCStmts absC_in absC_fork) statics un_usage)
 417         )
 418
 419 forkAbsC :: Code -> FCode AbstractC
 420 forkAbsC (FCode code) =
 421         do
 422                 info_down <- getInfoDown
 423                 (MkCgState absC1 bs usage) <- getState
 424                 let ((),MkCgState absC2 _ ((_, _, _, _,h2), _)) = code info_down (MkCgState AbsCNop bs usage)
 425                 let ((v, t, f, r, h1), heap_usage) = usage
 426                 let new_usage = ((v, t, f, r, h1 `max` h2), heap_usage)
 427                 setState $ MkCgState absC1 bs new_usage
 428                 return absC2
 429 \end{code}
 430
 431 @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
 432 an fcode for the default case $d$, and compiles each in the current
 433 environment.  The current environment is passed on unmodified, except
 434 that
 435         - the worst stack high-water mark is incorporated
 436         - the virtual Hp is moved on to the worst virtual Hp for the branches
 437
 438 \begin{code}
 439 forkAlts :: [FCode a] -> FCode b -> FCode ([a],b)
 440
 441 forkAlts branch_fcodes (FCode deflt_fcode) =
 442         do
 443                 info_down <- getInfoDown
 444                 in_state <- getState
 445                 let compile (FCode fc) = fc info_down in_state
 446                 let (branch_results, branch_out_states) = unzip (map compile branch_fcodes)
 447                 let (deflt_result, deflt_out_state) = deflt_fcode info_down in_state
 448                 setState $ foldl stateIncUsage in_state (deflt_out_state:branch_out_states)
 449                                 -- NB foldl.  in_state is the *left* argument to stateIncUsage
 450                 return (branch_results, deflt_result)
 451
 452 \end{code}
 453
 454 @forkEval@ takes two blocks of code.
 455
 456    -  The first meddles with the environment to set it up as expected by
 457       the alternatives of a @case@ which does an eval (or gc-possible primop).
 458    -  The second block is the code for the alternatives.
 459       (plus info for semi-tagging purposes)
 460
 461 @forkEval@ picks up the virtual stack pointer and returns a suitable
 462 @EndOfBlockInfo@ for the caller to use, together with whatever value
 463 is returned by the second block.
 464
 465 It uses @initEnvForAlternatives@ to initialise the environment, and
 466 @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
 467 usage.
 468
 469 \begin{code}
 470 forkEval :: EndOfBlockInfo              -- For the body
 471          -> Code                        -- Code to set environment
 472          -> FCode Sequel                -- Semi-tagging info to store
 473          -> FCode EndOfBlockInfo        -- The new end of block info
 474
 475 forkEval body_eob_info env_code body_code
 476   = forkEvalHelp body_eob_info env_code body_code `thenFC` \ (v, sequel) ->
 477     returnFC (EndOfBlockInfo v sequel)
 478
 479 forkEvalHelp :: EndOfBlockInfo  -- For the body
 480              -> Code            -- Code to set environment
 481              -> FCode a         -- The code to do after the eval
 482              -> FCode (Int,     -- Sp
 483                        a)       -- Result of the FCode
 484
 485 forkEvalHelp body_eob_info env_code body_code =
 486         do
 487                 info_down@(MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
 488                 state <- getState
 489                 let info_down_for_body = MkCgInfoDown cg_info statics srt ticky body_eob_info
 490                 let (_,MkCgState _ binds ((v,t,f,_,_),_)) =
 491                         doFCode env_code info_down_for_body state
 492                 let state_for_body = MkCgState AbsCNop
 493                              (nukeVolatileBinds binds)
 494                              ((v,t,f,v,v), (0,0))
 495                 let (value_returned, state_at_end_return) =
 496                         doFCode body_code info_down_for_body state_for_body
 497                 setState $ state `stateIncUsageEval` state_at_end_return
 498                 return (v,value_returned)
 499
 500 stateIncUsageEval :: CgState -> CgState -> CgState
 501 stateIncUsageEval (MkCgState absC1 bs ((v,t,f,r,h1),heap_usage))
 502                   (MkCgState absC2 _  ((_,_,_,_,h2),         _))
 503      = MkCgState (absC1 `mkAbsCStmts` absC2)
 504                  -- The AbsC coming back should consist only of nested declarations,
 505                  -- notably of the return vector!
 506                  bs
 507                  ((v,t,f,r,h1 `max` h2), heap_usage)
 508         -- We don't max the heap high-watermark because stateIncUsageEval is
 509         -- used only in forkEval, which in turn is only used for blocks of code
 510         -- which do their own heap-check.
 511 \end{code}
 512
 513 %************************************************************************
 514 %*                                                                      *
 515 \subsection[CgMonad-spitting-AbstractC]{Spitting out @AbstractC@}
 516 %*                                                                      *
 517 %************************************************************************
 518
 519 @nopC@ is the no-op for the @Code@ monad; it adds no Abstract~C to the
 520 environment; @absC@ glues @ab_C@ onto the Abstract~C collected so far.
 521 \begin{code}
 522 nopC :: Code
 523 nopC = return ()
 524
 525 absC :: AbstractC -> Code
 526 absC more_absC = do
 527         state@(MkCgState absC binds usage) <- getState
 528         setState $ MkCgState (mkAbsCStmts absC more_absC) binds usage
 529 \end{code}
 530
 531 These two are just like @absC@, except they examine the compilation
 532 info (whether SCC profiling or profiling-ctrs going) and possibly emit
 533 nothing.
 534
 535 \begin{code}
 536 costCentresC :: FastString -> [CAddrMode] -> Code
 537 costCentresC macro args
 538  | opt_SccProfilingOn  = absC (CCallProfCCMacro macro args)
 539  | otherwise           = nopC
 540
 541 profCtrC :: FastString -> [CAddrMode] -> Code
 542 profCtrC macro args
 543  | opt_DoTickyProfiling = absC (CCallProfCtrMacro macro args)
 544  | otherwise            = nopC
 545
 546 profCtrAbsC :: FastString -> [CAddrMode] -> AbstractC
 547 profCtrAbsC macro args
 548  | opt_DoTickyProfiling = CCallProfCtrMacro macro args
 549  | otherwise            = AbsCNop
 550
 551 ldvEnter :: Code
 552 ldvEnter = costCentresC FSLIT("LDV_ENTER") [CReg node]
 553
 554 {- Try to avoid adding too many special compilation strategies here.
 555    It's better to modify the header files as necessary for particular
 556    targets, so that we can get away with as few variants of .hc files
 557    as possible.
 558 -}
 559 \end{code}
 560
 561 @getAbsC@ compiles the code in the current environment, and returns
 562 the abstract C thus constructed (leaving the abstract C being carried
 563 around in the state untouched).  @getAbsC@ does not generate any
 564 in-line Abstract~C itself, but the environment it returns is that
 565 obtained from the compilation.
 566
 567 \begin{code}
 568 getAbsC :: Code -> FCode AbstractC
 569 getAbsC code = do
 570         MkCgState absC binds usage <- getState
 571         ((),MkCgState absC2 binds2 usage2) <- withState code (MkCgState AbsCNop binds usage)
 572         setState $ MkCgState absC binds2 usage2
 573         return absC2
 574 \end{code}
 575
 576 \begin{code}
 577 moduleName :: FCode Module
 578 moduleName = do
 579         (MkCgInfoDown (MkCompInfo mod_name) _ _ _ _) <- getInfoDown
 580         return mod_name
 581 \end{code}
 582
 583 \begin{code}
 584 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
 585 setEndOfBlockInfo eob_info code = do
 586         (MkCgInfoDown c_info statics srt ticky _) <- getInfoDown
 587         withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
 588
 589 getEndOfBlockInfo :: FCode EndOfBlockInfo
 590 getEndOfBlockInfo = do
 591         (MkCgInfoDown c_info statics _ _ eob_info) <- getInfoDown
 592         return eob_info
 593 \end{code}
 594
 595 There is just one SRT for each top level binding; all the nested
 596 bindings use sub-sections of this SRT.  The label is passed down to
 597 the nested bindings via the monad.
 598
 599 \begin{code}
 600 getSRTInfo :: SRT -> FCode C_SRT
 601 getSRTInfo NoSRT         = return NoC_SRT
 602 getSRTInfo (SRT off len) = do srt_lbl <- getSRTLabel
 603                               return (C_SRT srt_lbl off len)
 604
 605 getSRTLabel :: FCode CLabel     -- Used only by cgPanic
 606 getSRTLabel = do MkCgInfoDown _ _ srt_lbl _ _ <- getInfoDown
 607                  return srt_lbl
 608
 609 setSRTLabel :: CLabel -> Code -> Code
 610 setSRTLabel srt_lbl code
 611   = do  MkCgInfoDown c_info statics _ ticky eob_info <- getInfoDown
 612         withInfoDown code (MkCgInfoDown c_info statics srt_lbl ticky eob_info)
 613 \end{code}
 614
 615 \begin{code}
 616 getTickyCtrLabel :: FCode CLabel
 617 getTickyCtrLabel = do
 618         (MkCgInfoDown _ _ _ ticky _) <- getInfoDown
 619         return ticky
 620
 621 setTickyCtrLabel :: CLabel -> Code -> Code
 622 setTickyCtrLabel ticky code = do
 623         (MkCgInfoDown c_info statics srt _ eob_info) <- getInfoDown
 624         withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
 625 \end{code}