compiler/cmm/CmmCPS.hs

   1 module CmmCPS (
   2   -- | Converts C-- with full proceedures and parameters
   3   -- to a CPS transformed C-- with the stack made manifest.
   4   cmmCPS
   5 ) where
   6
   7 #include "HsVersions.h"
   8
   9 import Cmm
  10 import CmmLint
  11 import PprCmm
  12
  13 import CmmLive
  14 import CmmBrokenBlock
  15 import CmmProcPoint
  16 import CmmCallConv
  17 import CmmInfo
  18 import CmmUtils
  19
  20 import Bitmap
  21 import ClosureInfo
  22 import MachOp
  23 import ForeignCall
  24 import CLabel
  25 import SMRep
  26 import Constants
  27
  28 import DynFlags
  29 import ErrUtils
  30 import Maybes
  31 import Outputable
  32 import UniqSupply
  33 import UniqFM
  34 import UniqSet
  35 import Unique
  36
  37 import Monad
  38 import IO
  39 import Data.List
  40
  41 -----------------------------------------------------------------------------
  42 -- |Top level driver for the CPS pass
  43 -----------------------------------------------------------------------------
  44 cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
  45        -> [GenCmm CmmStatic CmmInfo CmmStmt]    -- ^ Input C-- with Proceedures
  46        -> IO [GenCmm CmmStatic [CmmStatic] CmmStmt] -- ^ Output CPS transformed C--
  47 cmmCPS dflags abstractC = do
  48   when (dopt Opt_DoCmmLinting dflags) $
  49        do showPass dflags "CmmLint"
  50           case firstJust $ map cmmLint abstractC of
  51             Just err -> do printDump err
  52                            ghcExit dflags 1
  53             Nothing  -> return ()
  54   showPass dflags "CPS"
  55
  56   -- TODO: more lint checking
  57   --        check for use of branches to non-existant blocks
  58   --        check for use of Sp, SpLim, R1, R2, etc.
  59
  60   uniqSupply <- mkSplitUniqSupply 'p'
  61   let supplies = listSplitUniqSupply uniqSupply
  62   let doCpsProc s (Cmm c) =
  63           Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
  64   let continuationC = zipWith doCpsProc supplies abstractC
  65
  66   dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
  67
  68   -- TODO: add option to dump Cmm to file
  69
  70   return continuationC
  71
  72 stg_gc_gen = mkRtsApFastLabel SLIT("gen_cg_TODO") --panic "Need the label for gc"
  73 make_gc_block block_id fun_label formals safety = BasicBlock block_id stmts
  74     where
  75       stmts = [CmmCall stg_gc_gen_target [] [] safety,
  76                CmmJump fun_expr actuals]
  77       stg_gc_gen_target =
  78           CmmForeignCall (CmmLit (CmmLabel stg_gc_gen)) CmmCallConv
  79       actuals = map (\x -> (CmmReg (CmmLocal x), NoHint)) formals
  80       fun_expr = CmmLit (CmmLabel fun_label)
  81
  82 force_gc_block old_info block_id fun_label formals blocks =
  83     case old_info of
  84       CmmNonInfo (Just _) -> (old_info, [])
  85       CmmInfo _ (Just _) _ _ -> (old_info, [])
  86       CmmNonInfo Nothing
  87           -> (CmmNonInfo (Just block_id),
  88               [make_gc_block block_id fun_label formals (CmmSafe NoC_SRT)])
  89       CmmInfo prof Nothing type_tag type_info
  90         -> (CmmInfo prof (Just block_id) type_tag type_info,
  91             [make_gc_block block_id fun_label formals (CmmSafe srt)])
  92            where
  93              srt = case type_info of
  94                      ConstrInfo _ _ _ -> NoC_SRT
  95                      FunInfo _ srt' _ _ _ _ -> srt'
  96                      ThunkInfo _ srt' -> srt'
  97                      ThunkSelectorInfo _ srt' -> srt'
  98                      ContInfo _ srt' -> srt'
  99
 100 -----------------------------------------------------------------------------
 101 -- |CPS a single CmmTop (proceedure)
 102 -- Only 'CmmProc' are transformed 'CmmData' will be left alone.
 103 -----------------------------------------------------------------------------
 104
 105 cpsProc :: UniqSupply
 106         -> GenCmmTop CmmStatic CmmInfo CmmStmt     -- ^Input proceedure
 107         -> [GenCmmTop CmmStatic [CmmStatic] CmmStmt]   -- ^Output proceedure and continuations
 108 cpsProc uniqSupply (CmmData sec dat) = [CmmData sec dat]
 109 cpsProc uniqSupply (CmmProc info ident params blocks) = info_procs
 110     where
 111       uniques :: [[Unique]]
 112       uniques = map uniqsFromSupply $ listSplitUniqSupply uniqSupply
 113       (gc_unique:info_uniques):block_uniques = uniques
 114
 115       -- Ensure that
 116       forced_gc :: (CmmInfo, [CmmBasicBlock])
 117       forced_gc = force_gc_block info (BlockId gc_unique) ident params blocks
 118
 119       forced_info = fst forced_gc
 120       forced_blocks = blocks ++ snd forced_gc
 121       forced_gc_id = case forced_info of
 122                        CmmNonInfo (Just x) -> x
 123                        CmmInfo _ (Just x) _ _ -> x
 124
 125       -- Break the block at each function call.
 126       -- The part after the function call will have to become a continuation.
 127       broken_blocks :: [BrokenBlock]
 128       broken_blocks =
 129           concat $ zipWith3 breakBlock block_uniques forced_blocks
 130                      (FunctionEntry forced_info ident params:repeat ControlEntry)
 131
 132       -- Calculate live variables for each broken block.
 133       --
 134       -- Nothing can be live on entry to the first block
 135       -- so we could take the tail, but for now we wont
 136       -- to help future proof the code.
 137       live :: BlockEntryLiveness
 138       live = cmmLiveness $ map cmmBlockFromBrokenBlock broken_blocks
 139
 140       -- Calculate which blocks must be made into full fledged procedures.
 141       proc_points :: UniqSet BlockId
 142       proc_points = calculateProcPoints broken_blocks
 143
 144       -- Construct a map so we can lookup a broken block by its 'BlockId'.
 145       block_env :: BlockEnv BrokenBlock
 146       block_env = blocksToBlockEnv broken_blocks
 147
 148       -- Group the blocks into continuations based on the set of proc-points.
 149       continuations :: [Continuation (Either C_SRT CmmInfo)]
 150       continuations = zipWith
 151                         (gatherBlocksIntoContinuation proc_points block_env)
 152                         (uniqSetToList proc_points)
 153                         (Just forced_gc_id : repeat Nothing)
 154
 155       -- Select the stack format on entry to each continuation.
 156       -- Return the max stack offset and an association list
 157       --
 158       -- This is an association list instead of a UniqFM because
 159       -- CLabel's don't have a 'Uniqueable' instance.
 160       formats :: [(CLabel,              -- key
 161                    (Maybe CLabel,       -- label in top slot
 162                     [Maybe LocalReg]))] -- slots
 163       formats = selectStackFormat live continuations
 164
 165       -- Do a little meta-processing on the stack formats such as
 166       -- getting the individual frame sizes and the maximum frame size
 167       formats' :: (WordOff, [(CLabel, StackFormat)])
 168       formats' = processFormats formats continuations
 169
 170       -- Update the info table data on the continuations with
 171       -- the selected stack formats.
 172       continuations' :: [Continuation CmmInfo]
 173       continuations' = map (applyStackFormat (snd formats')) continuations
 174
 175       -- Do the actual CPS transform.
 176       cps_procs :: [CmmTop]
 177       cps_procs = map (continuationToProc formats') continuations'
 178
 179       -- Convert the info tables from CmmInfo to [CmmStatic]
 180       -- We might want to put this in another pass eventually
 181       info_procs :: [RawCmmTop]
 182       info_procs = concat (zipWith mkInfoTable info_uniques cps_procs)
 183
 184 --------------------------------------------------------------------------------
 185
 186 -- The format for the call to a continuation
 187 -- The fst is the arguments that must be passed to the continuation
 188 -- by the continuation's caller.
 189 -- The snd is the live values that must be saved on stack.
 190 -- A Nothing indicates an ignored slot.
 191 -- The head of each list is the stack top or the first parameter.
 192
 193 -- The format for live values for a particular continuation
 194 -- All on stack for now.
 195 -- Head element is the top of the stack (or just under the header).
 196 -- Nothing means an empty slot.
 197 -- Future possibilities include callee save registers (i.e. passing slots in register)
 198 -- and heap memory (not sure if that's usefull at all though, but it may
 199 -- be worth exploring the design space).
 200
 201 continuationLabel (Continuation _ l _ _) = l
 202 data Continuation info =
 203   Continuation
 204      info              -- Left <=> Continuation created by the CPS
 205                        -- Right <=> Function or Proc point
 206      CLabel            -- Used to generate both info & entry labels
 207      CmmFormals        -- Argument locals live on entry (C-- procedure params)
 208      [BrokenBlock]     -- Code, may be empty.  The first block is
 209                        -- the entry point.  The order is otherwise initially
 210                        -- unimportant, but at some point the code gen will
 211                        -- fix the order.
 212
 213                        -- the BlockId of the first block does not give rise
 214                        -- to a label.  To jump to the first block in a Proc,
 215                        -- use the appropriate CLabel.
 216
 217 data StackFormat
 218     = StackFormat {
 219          stack_label :: Maybe CLabel,   -- The label occupying the top slot
 220          stack_frame_size :: WordOff,   -- Total frame size in words (not including arguments)
 221          stack_live :: [Maybe LocalReg] -- local reg offsets from stack top
 222       }
 223
 224 -- A block can be a continuation of a call
 225 -- A block can be a continuation of another block (w/ or w/o joins)
 226 -- A block can be an entry to a function
 227
 228 -----------------------------------------------------------------------------
 229
 230 collectNonProcPointTargets ::
 231     UniqSet BlockId -> BlockEnv BrokenBlock
 232     -> UniqSet BlockId -> [BlockId] -> UniqSet BlockId
 233 collectNonProcPointTargets proc_points blocks current_targets new_blocks =
 234     if sizeUniqSet current_targets == sizeUniqSet new_targets
 235        then current_targets
 236        else foldl
 237                 (collectNonProcPointTargets proc_points blocks)
 238                 new_targets
 239                 (map (:[]) targets)
 240     where
 241       blocks' = map (lookupWithDefaultUFM blocks (panic "TODO")) new_blocks
 242       targets =
 243         -- Note the subtlety that since the extra branch after a call
 244         -- will always be to a block that is a proc-point,
 245         -- this subtraction will always remove that case
 246         uniqSetToList $ (unionManyUniqSets $ map (mkUniqSet . brokenBlockTargets) blocks')
 247                           `minusUniqSet` proc_points
 248         -- TODO: remove redundant uniqSetToList
 249       new_targets = current_targets `unionUniqSets` (mkUniqSet targets)
 250
 251 -- TODO: insert proc point code here
 252 --  * Branches and switches to proc points may cause new blocks to be created
 253 --    (or proc points could leave behind phantom blocks that just jump to them)
 254 --  * Proc points might get some live variables passed as arguments
 255
 256 gatherBlocksIntoContinuation ::
 257     UniqSet BlockId -> BlockEnv BrokenBlock
 258     -> BlockId -> Maybe BlockId -> Continuation (Either C_SRT CmmInfo)
 259 gatherBlocksIntoContinuation proc_points blocks start gc =
 260   Continuation info_table clabel params body
 261     where
 262       start_and_gc = start : maybeToList gc
 263       children = (collectNonProcPointTargets proc_points blocks (mkUniqSet start_and_gc) start_and_gc) `minusUniqSet` (mkUniqSet start_and_gc)
 264       start_block = lookupWithDefaultUFM blocks (panic "TODO") start
 265       gc_block = map (lookupWithDefaultUFM blocks (panic "TODO)")) (maybeToList gc)
 266       children_blocks = map (lookupWithDefaultUFM blocks (panic "TODO")) (uniqSetToList children)
 267       body = start_block : gc_block ++ children_blocks
 268
 269       -- We can't properly annotate the continuation's stack parameters
 270       -- at this point because this is before stack selection
 271       -- but we want to keep the C_SRT around so we use 'Either'.
 272       info_table = case start_block_entry of
 273                      FunctionEntry info _ _ -> Right info
 274                      ContinuationEntry _ srt -> Left srt
 275                      ControlEntry -> Right (CmmNonInfo Nothing)
 276
 277       start_block_entry = brokenBlockEntry start_block
 278       clabel = case start_block_entry of
 279                  FunctionEntry _ label _ -> label
 280                  _ -> mkReturnPtLabel $ getUnique start
 281       params = case start_block_entry of
 282                  FunctionEntry _ _ args -> args
 283                  ContinuationEntry args _ -> args
 284                  ControlEntry -> [] -- TODO: it's a proc-point, we could pass lives in parameter registers
 285
 286 --------------------------------------------------------------------------------
 287 -- For now just select the continuation orders in the order they are in the set with no gaps
 288
 289 selectStackFormat :: BlockEnv CmmLive
 290                   -> [Continuation (Either C_SRT CmmInfo)]
 291                   -> [(CLabel, (Maybe CLabel, [Maybe LocalReg]))]
 292 selectStackFormat live continuations =
 293     map (\c -> (continuationLabel c, selectStackFormat' c)) continuations
 294     where
 295       selectStackFormat' (Continuation
 296                           (Right (CmmInfo _ _ _ (ContInfo format srt)))
 297                           label _ _) = (Just label, format)
 298       selectStackFormat' (Continuation (Right _) _ _ _) = (Nothing, [])
 299       selectStackFormat' (Continuation (Left srt) label _ blocks) =
 300           -- TODO: assumes the first block is the entry block
 301           let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this
 302           in (Just label,
 303               map Just $ uniqSetToList $
 304               lookupWithDefaultUFM live unknown_block ident)
 305
 306       unknown_block = panic "unknown BlockId in selectStackFormat"
 307
 308 processFormats :: [(CLabel, (Maybe CLabel, [Maybe LocalReg]))]
 309                -> [Continuation (Either C_SRT CmmInfo)]
 310                -> (WordOff, [(CLabel, StackFormat)])
 311 processFormats formats continuations = (max_size, formats')
 312     where
 313       max_size = maximum $
 314                  0 : map (continuationMaxStack formats') continuations
 315       formats' = map make_format formats
 316       make_format (label, format) =
 317           (label,
 318            StackFormat {
 319              stack_label = fst format,
 320              stack_frame_size = stack_size (snd format) +
 321                                 if isJust (fst format)
 322                                 then label_size
 323                                 else 0,
 324              stack_live = snd format })
 325
 326       -- TODO: get rid of "+ 1" etc.
 327       label_size = 1 :: WordOff
 328
 329       stack_size [] = 0
 330       stack_size (Nothing:formats) = 1 + stack_size formats -- one dead word
 331       stack_size (Just reg:formats) = width + stack_size formats
 332           where
 333             width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
 334             -- TODO: it would be better if we had a machRepWordWidth
 335
 336 continuationMaxStack :: [(CLabel, StackFormat)]
 337                      -> Continuation a
 338                      -> WordOff
 339 continuationMaxStack formats (Continuation _ label _ blocks) =
 340     max_arg_size + stack_frame_size stack_format
 341     where
 342       stack_format = maybe unknown_format id $ lookup label formats
 343       unknown_format = panic "Unknown format in continuationMaxStack"
 344
 345       max_arg_size = maximum $ 0 : map block_max_arg_size blocks
 346
 347       block_max_arg_size block =
 348           maximum (final_arg_size (brokenBlockExit block) :
 349                    map stmt_arg_size (brokenBlockStmts block))
 350
 351       final_arg_size (FinalReturn args) =
 352           argumentsSize (cmmExprRep . fst) args
 353       final_arg_size (FinalJump _ args) =
 354           argumentsSize (cmmExprRep . fst) args
 355       final_arg_size (FinalCall next _ _ args) =
 356           -- We have to account for the stack used when we build a frame
 357           -- for the *next* continuation from *this* continuation
 358           argumentsSize (cmmExprRep . fst) args +
 359           stack_frame_size next_format
 360           where
 361             next_format = maybe unknown_format id $ lookup next' formats
 362             next' = mkReturnPtLabel $ getUnique next
 363
 364       final_arg_size _ = 0
 365
 366       stmt_arg_size (CmmJump _ args) =
 367           argumentsSize (cmmExprRep . fst) args
 368       stmt_arg_size (CmmCall _ _ _ (CmmSafe _)) =
 369           panic "Safe call in processFormats"
 370       stmt_arg_size (CmmReturn _) =
 371           panic "CmmReturn in processFormats"
 372       stmt_arg_size _ = 0
 373
 374 -----------------------------------------------------------------------------
 375 applyStackFormat :: [(CLabel, StackFormat)]
 376                  -> Continuation (Either C_SRT CmmInfo)
 377                  -> Continuation CmmInfo
 378
 379 -- User written continuations
 380 applyStackFormat formats (Continuation
 381                           (Right (CmmInfo prof gc tag (ContInfo _ srt)))
 382                           label formals blocks) =
 383     Continuation (CmmInfo prof gc tag (ContInfo format srt))
 384                  label formals blocks
 385     where
 386       format = stack_live $ maybe unknown_block id $ lookup label formats
 387       unknown_block = panic "unknown BlockId in applyStackFormat"
 388
 389 -- User written non-continuation code
 390 applyStackFormat formats (Continuation (Right info) label formals blocks) =
 391     Continuation info label formals blocks
 392
 393 -- CPS generated continuations
 394 applyStackFormat formats (Continuation (Left srt) label formals blocks) =
 395     Continuation (CmmInfo prof gc tag (ContInfo (stack_live $ format) srt))
 396                  label formals blocks
 397     where
 398       gc = Nothing -- Generated continuations never need a stack check
 399       -- TODO prof: this is the same as the current implementation
 400       -- but I think it could be improved
 401       prof = ProfilingInfo zeroCLit zeroCLit
 402       tag = rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
 403       format = maybe unknown_block id $ lookup label formats
 404       unknown_block = panic "unknown BlockId in applyStackFormat"
 405
 406 -----------------------------------------------------------------------------
 407 continuationToProc :: (WordOff, [(CLabel, StackFormat)])
 408                    -> Continuation CmmInfo
 409                    -> CmmTop
 410 continuationToProc (max_stack, formats)
 411                    (Continuation info label formals blocks) =
 412     CmmProc info label formals (map continuationToProc' blocks)
 413     where
 414       curr_format = maybe unknown_block id $ lookup label formats
 415       unknown_block = panic "unknown BlockId in continuationToProc"
 416
 417       continuationToProc' :: BrokenBlock -> CmmBasicBlock
 418       continuationToProc' (BrokenBlock ident entry stmts _ exit) =
 419           BasicBlock ident (prefix++stmts++postfix)
 420           where
 421             prefix = case entry of
 422                        ControlEntry -> []
 423                        FunctionEntry (CmmInfo _ (Just gc_block) _ _) _ formals ->
 424                            gc_stack_check gc_block max_stack ++
 425                            function_entry formals curr_format
 426                        FunctionEntry (CmmInfo _ Nothing _ _) _ formals ->
 427                            panic "continuationToProc: missing GC block"
 428                        FunctionEntry (CmmNonInfo (Just gc_block)) _ formals ->
 429                            gc_stack_check gc_block max_stack ++
 430                            function_entry formals curr_format
 431                        FunctionEntry (CmmNonInfo Nothing) _ formals ->
 432                            panic "continuationToProc: missing non-info GC block"
 433                        ContinuationEntry formals _ ->
 434                            function_entry formals curr_format
 435             postfix = case exit of
 436                         FinalBranch next -> [CmmBranch next]
 437                         FinalSwitch expr targets -> [CmmSwitch expr targets]
 438                         FinalReturn arguments ->
 439                             tail_call (stack_frame_size curr_format)
 440                                 (CmmLoad (CmmReg spReg) wordRep)
 441                                 arguments
 442                         FinalJump target arguments ->
 443                             tail_call (stack_frame_size curr_format) target arguments
 444                         FinalCall next (CmmForeignCall target CmmCallConv)
 445                             results arguments ->
 446                                 pack_continuation curr_format cont_format ++
 447                                 tail_call (stack_frame_size curr_format - stack_frame_size cont_format)
 448                                               target arguments
 449                             where
 450                               cont_format = maybe unknown_block id $
 451                                             lookup (mkReturnPtLabel $ getUnique next) formats
 452                         FinalCall next _ results arguments -> panic "unimplemented CmmCall"
 453
 454 -----------------------------------------------------------------------------
 455 -- Functions that generate CmmStmt sequences
 456 -- for packing/unpacking continuations
 457 -- and entering/exiting functions
 458
 459 tail_call :: WordOff -> CmmExpr -> CmmActuals -> [CmmStmt]
 460 tail_call spRel target arguments
 461   = store_arguments ++ adjust_spReg ++ jump where
 462     store_arguments =
 463         [stack_put spRel expr offset
 464          | ((expr, _), StackParam offset) <- argument_formats] ++
 465         [global_put expr global
 466          | ((expr, _), RegisterParam global) <- argument_formats]
 467     adjust_spReg =
 468         if spRel == 0
 469         then []
 470         else [CmmAssign spReg (CmmRegOff spReg (spRel*wORD_SIZE))]
 471     jump = [CmmJump target arguments]
 472
 473     argument_formats = assignArguments (cmmExprRep . fst) arguments
 474
 475 gc_stack_check :: BlockId -> WordOff -> [CmmStmt]
 476 gc_stack_check gc_block max_frame_size
 477   = check_stack_limit where
 478     check_stack_limit = [
 479      CmmCondBranch
 480      (CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
 481                     [CmmRegOff spReg (-max_frame_size*wORD_SIZE),
 482                      CmmReg spLimReg])
 483      gc_block]
 484
 485 -- TODO: fix branches to proc point
 486 -- (we have to insert a new block to marshel the continuation)
 487 pack_continuation :: StackFormat -> StackFormat -> [CmmStmt]
 488 pack_continuation (StackFormat curr_id curr_frame_size _)
 489                        (StackFormat cont_id cont_frame_size live_regs)
 490   = store_live_values ++ set_stack_header where
 491     -- TODO: only save variables when actually needed
 492     -- (may be handled by latter pass)
 493     store_live_values =
 494         [stack_put spRel (CmmReg (CmmLocal reg)) offset
 495          | (reg, offset) <- cont_offsets]
 496     set_stack_header =
 497         if needs_header_set
 498         then [stack_put spRel continuation_function 0]
 499         else []
 500
 501     -- TODO: factor with function_entry and CmmInfo.hs(?)
 502     cont_offsets = mkOffsets label_size live_regs
 503
 504     label_size = 1 :: WordOff
 505
 506     mkOffsets size [] = []
 507     mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
 508     mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
 509         where
 510           width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
 511           -- TODO: it would be better if we had a machRepWordWidth
 512
 513     spRel = curr_frame_size - cont_frame_size
 514     continuation_function = CmmLit $ CmmLabel $ fromJust cont_id
 515     needs_header_set =
 516         case (curr_id, cont_id) of
 517           (Just x, Just y) -> x /= y
 518           _ -> isJust cont_id
 519
 520 -- Lazy adjustment of stack headers assumes all blocks
 521 -- that could branch to eachother (i.e. control blocks)
 522 -- have the same stack format (this causes a problem
 523 -- only for proc-point).
 524 function_entry :: CmmFormals -> StackFormat -> [CmmStmt]
 525 function_entry formals (StackFormat _ _ live_regs)
 526   = load_live_values ++ load_args where
 527     -- TODO: only save variables when actually needed
 528     -- (may be handled by latter pass)
 529     load_live_values =
 530         [stack_get 0 reg offset
 531          | (reg, offset) <- curr_offsets]
 532     load_args =
 533         [stack_get 0 reg offset
 534          | (reg, StackParam offset) <- argument_formats] ++
 535         [global_get reg global
 536          | (reg, RegisterParam global) <- argument_formats]
 537
 538     argument_formats = assignArguments (localRegRep) formals
 539
 540     -- TODO: eliminate copy/paste with pack_continuation
 541     curr_offsets = mkOffsets label_size live_regs
 542
 543     label_size = 1 :: WordOff
 544
 545     mkOffsets size [] = []
 546     mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
 547     mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
 548         where
 549           width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
 550           -- TODO: it would be better if we had a machRepWordWidth
 551
 552 -----------------------------------------------------------------------------
 553 -- Section: Stack and argument register puts and gets
 554 -----------------------------------------------------------------------------
 555 -- TODO: document
 556
 557 -- |Construct a 'CmmStmt' that will save a value on the stack
 558 stack_put :: WordOff            -- ^ Offset from the real 'Sp' that 'offset'
 559                                 -- is relative to (added to offset)
 560           -> CmmExpr            -- ^ What to store onto the stack
 561           -> WordOff            -- ^ Where on the stack to store it
 562                                 -- (positive <=> higher addresses)
 563           -> CmmStmt
 564 stack_put spRel expr offset =
 565     CmmStore (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) expr
 566
 567 --------------------------------
 568 -- |Construct a
 569 stack_get :: WordOff
 570           -> LocalReg
 571           -> WordOff
 572           -> CmmStmt
 573 stack_get spRel reg offset =
 574     CmmAssign (CmmLocal reg)
 575               (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset)))
 576                        (localRegRep reg))
 577 global_put :: CmmExpr -> GlobalReg -> CmmStmt
 578 global_put expr global = CmmAssign (CmmGlobal global) expr
 579 global_get :: LocalReg -> GlobalReg -> CmmStmt
 580 global_get reg global = CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal global))
 581