ghc/compiler/codeGen/CgMonad.lhs

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