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 =
  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
 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       curr_stack = stack_frame_size curr_format
 417
 418       continuationToProc' :: BrokenBlock -> CmmBasicBlock
 419       continuationToProc' (BrokenBlock ident entry stmts _ exit) =
 420           BasicBlock ident (prefix++stmts++postfix)
 421           where
 422             prefix = case entry of
 423                        ControlEntry -> []
 424                        FunctionEntry (CmmInfo _ (Just gc_block) _ _) _ formals ->
 425                            gc_stack_check gc_block (max_stack - curr_stack) ++
 426                            function_entry formals curr_format
 427                        FunctionEntry (CmmInfo _ Nothing _ _) _ formals ->
 428                            panic "continuationToProc: missing GC block"
 429                        FunctionEntry (CmmNonInfo (Just gc_block)) _ formals ->
 430                            gc_stack_check gc_block (max_stack - curr_stack) ++
 431                            function_entry formals curr_format
 432                        FunctionEntry (CmmNonInfo Nothing) _ formals ->
 433                            panic "continuationToProc: missing non-info GC block"
 434                        ContinuationEntry formals _ ->
 435                            function_entry formals curr_format
 436             postfix = case exit of
 437                         FinalBranch next -> [CmmBranch next]
 438                         FinalSwitch expr targets -> [CmmSwitch expr targets]
 439                         FinalReturn arguments ->
 440                             tail_call curr_stack
 441                                 (CmmLoad (CmmReg spReg) wordRep)
 442                                 arguments
 443                         FinalJump target arguments ->
 444                             tail_call curr_stack target arguments
 445                         FinalCall next (CmmForeignCall target CmmCallConv)
 446                             results arguments ->
 447                                 pack_continuation curr_format cont_format ++
 448                                 tail_call (curr_stack - cont_stack)
 449                                               target arguments
 450                             where
 451                               cont_format = maybe unknown_block id $
 452                                             lookup (mkReturnPtLabel $ getUnique next) formats
 453                               cont_stack = stack_frame_size cont_format
 454                         FinalCall next _ results arguments -> panic "unimplemented CmmCall"
 455
 456 -----------------------------------------------------------------------------
 457 -- Functions that generate CmmStmt sequences
 458 -- for packing/unpacking continuations
 459 -- and entering/exiting functions
 460
 461 tail_call :: WordOff -> CmmExpr -> CmmActuals -> [CmmStmt]
 462 tail_call spRel target arguments
 463   = store_arguments ++ adjust_spReg ++ jump where
 464     store_arguments =
 465         [stack_put spRel expr offset
 466          | ((expr, _), StackParam offset) <- argument_formats] ++
 467         [global_put expr global
 468          | ((expr, _), RegisterParam global) <- argument_formats]
 469     adjust_spReg =
 470         if spRel == 0
 471         then []
 472         else [CmmAssign spReg (CmmRegOff spReg (spRel*wORD_SIZE))]
 473     jump = [CmmJump target arguments]
 474
 475     argument_formats = assignArguments (cmmExprRep . fst) arguments
 476
 477 gc_stack_check :: BlockId -> WordOff -> [CmmStmt]
 478 gc_stack_check gc_block max_frame_size
 479   = check_stack_limit where
 480     check_stack_limit = [
 481      CmmCondBranch
 482      (CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
 483                     [CmmRegOff spReg (-max_frame_size*wORD_SIZE),
 484                      CmmReg spLimReg])
 485      gc_block]
 486
 487 -- TODO: fix branches to proc point
 488 -- (we have to insert a new block to marshel the continuation)
 489 pack_continuation :: StackFormat -> StackFormat -> [CmmStmt]
 490 pack_continuation (StackFormat curr_id curr_frame_size _)
 491                        (StackFormat cont_id cont_frame_size live_regs)
 492   = store_live_values ++ set_stack_header where
 493     -- TODO: only save variables when actually needed
 494     -- (may be handled by latter pass)
 495     store_live_values =
 496         [stack_put spRel (CmmReg (CmmLocal reg)) offset
 497          | (reg, offset) <- cont_offsets]
 498     set_stack_header =
 499         if needs_header_set
 500         then [stack_put spRel continuation_function 0]
 501         else []
 502
 503     -- TODO: factor with function_entry and CmmInfo.hs(?)
 504     cont_offsets = mkOffsets label_size live_regs
 505
 506     label_size = 1 :: WordOff
 507
 508     mkOffsets size [] = []
 509     mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
 510     mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
 511         where
 512           width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
 513           -- TODO: it would be better if we had a machRepWordWidth
 514
 515     spRel = curr_frame_size - cont_frame_size
 516     continuation_function = CmmLit $ CmmLabel $ fromJust cont_id
 517     needs_header_set =
 518         case (curr_id, cont_id) of
 519           (Just x, Just y) -> x /= y
 520           _ -> isJust cont_id
 521
 522 -- Lazy adjustment of stack headers assumes all blocks
 523 -- that could branch to eachother (i.e. control blocks)
 524 -- have the same stack format (this causes a problem
 525 -- only for proc-point).
 526 function_entry :: CmmFormals -> StackFormat -> [CmmStmt]
 527 function_entry formals (StackFormat _ _ live_regs)
 528   = load_live_values ++ load_args where
 529     -- TODO: only save variables when actually needed
 530     -- (may be handled by latter pass)
 531     load_live_values =
 532         [stack_get 0 reg offset
 533          | (reg, offset) <- curr_offsets]
 534     load_args =
 535         [stack_get 0 reg offset
 536          | (reg, StackParam offset) <- argument_formats] ++
 537         [global_get reg global
 538          | (reg, RegisterParam global) <- argument_formats]
 539
 540     argument_formats = assignArguments (localRegRep) formals
 541
 542     -- TODO: eliminate copy/paste with pack_continuation
 543     curr_offsets = mkOffsets label_size live_regs
 544
 545     label_size = 1 :: WordOff
 546
 547     mkOffsets size [] = []
 548     mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
 549     mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
 550         where
 551           width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
 552           -- TODO: it would be better if we had a machRepWordWidth
 553
 554 -----------------------------------------------------------------------------
 555 -- Section: Stack and argument register puts and gets
 556 -----------------------------------------------------------------------------
 557 -- TODO: document
 558
 559 -- |Construct a 'CmmStmt' that will save a value on the stack
 560 stack_put :: WordOff            -- ^ Offset from the real 'Sp' that 'offset'
 561                                 -- is relative to (added to offset)
 562           -> CmmExpr            -- ^ What to store onto the stack
 563           -> WordOff            -- ^ Where on the stack to store it
 564                                 -- (positive <=> higher addresses)
 565           -> CmmStmt
 566 stack_put spRel expr offset =
 567     CmmStore (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) expr
 568
 569 --------------------------------
 570 -- |Construct a
 571 stack_get :: WordOff
 572           -> LocalReg
 573           -> WordOff
 574           -> CmmStmt
 575 stack_get spRel reg offset =
 576     CmmAssign (CmmLocal reg)
 577               (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset)))
 578                        (localRegRep reg))
 579 global_put :: CmmExpr -> GlobalReg -> CmmStmt
 580 global_put expr global = CmmAssign (CmmGlobal global) expr
 581 global_get :: LocalReg -> GlobalReg -> CmmStmt
 582 global_get reg global = CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal global))
 583