ghc/compiler/codeGen/CgMonad.lhs

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