CmmCPS.hs 24.3 KB
Newer Older
1
2
3
4
5
module CmmCPS (
  -- | Converts C-- with full proceedures and parameters
  -- to a CPS transformed C-- with the stack made manifest.
  cmmCPS
) where
6
7
8
9
10
11
12

#include "HsVersions.h"

import Cmm
import CmmLint
import PprCmm

13
import CmmLive
14
import CmmBrokenBlock
15
import CmmProcPoint
Michael D. Adams's avatar
Michael D. Adams committed
16
import CmmCallConv
17
18
import CmmInfo
import CmmUtils
19

20
21
import Bitmap
import ClosureInfo
22
23
24
import MachOp
import ForeignCall
import CLabel
25
26
import SMRep
import Constants
27
28
29
30
31

import DynFlags
import ErrUtils
import Maybes
import Outputable
32
33
34
35
import UniqSupply
import UniqFM
import UniqSet
import Unique
36
37
38

import Monad
import IO
39
import Data.List
40

41
42
43
44
-----------------------------------------------------------------------------
-- |Top level driver for the CPS pass
-----------------------------------------------------------------------------
cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
45
46
       -> [GenCmm CmmStatic CmmInfo CmmStmt]    -- ^ Input C-- with Proceedures
       -> IO [GenCmm CmmStatic [CmmStatic] CmmStmt] -- ^ Output CPS transformed C--
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
cmmCPS dflags abstractC = do
  when (dopt Opt_DoCmmLinting dflags) $
       do showPass dflags "CmmLint"
	  case firstJust $ map cmmLint abstractC of
	    Just err -> do printDump err
			   ghcExit dflags 1
	    Nothing  -> return ()
  showPass dflags "CPS"

  -- TODO: more lint checking
  --        check for use of branches to non-existant blocks
  --        check for use of Sp, SpLim, R1, R2, etc.

  uniqSupply <- mkSplitUniqSupply 'p'
  let supplies = listSplitUniqSupply uniqSupply
  let doCpsProc s (Cmm c) =
          Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
  let continuationC = zipWith doCpsProc supplies abstractC

  dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)

  -- TODO: add option to dump Cmm to file

  return continuationC

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
77
78
79
80
81
               CmmJump fun_expr actuals]
      stg_gc_gen_target =
          CmmForeignCall (CmmLit (CmmLabel stg_gc_gen)) CmmCallConv
      actuals = map (\x -> (CmmReg (CmmLocal x), NoHint)) formals
      fun_expr = CmmLit (CmmLabel fun_label)

82
force_gc_block old_info block_id fun_label formals =
83
84
85
86
87
    case old_info of
      CmmNonInfo (Just _) -> (old_info, [])
      CmmInfo _ (Just _) _ _ -> (old_info, [])
      CmmNonInfo Nothing
          -> (CmmNonInfo (Just block_id),
88
              [make_gc_block block_id fun_label formals (CmmSafe NoC_SRT)])
89
90
      CmmInfo prof Nothing type_tag type_info
        -> (CmmInfo prof (Just block_id) type_tag type_info,
91
            [make_gc_block block_id fun_label formals (CmmSafe srt)])
92
93
94
95
96
97
98
99
           where
             srt = case type_info of
                     ConstrInfo _ _ _ -> NoC_SRT
                     FunInfo _ srt' _ _ _ _ -> srt'
                     ThunkInfo _ srt' -> srt'
                     ThunkSelectorInfo _ srt' -> srt'
                     ContInfo _ srt' -> srt'    

100
101
102
103
104
105
-----------------------------------------------------------------------------
-- |CPS a single CmmTop (proceedure)
-- Only 'CmmProc' are transformed 'CmmData' will be left alone.
-----------------------------------------------------------------------------

cpsProc :: UniqSupply 
106
107
108
109
        -> GenCmmTop CmmStatic CmmInfo CmmStmt     -- ^Input proceedure
        -> [GenCmmTop CmmStatic [CmmStatic] CmmStmt]   -- ^Output proceedure and continuations
cpsProc uniqSupply (CmmData sec dat) = [CmmData sec dat]
cpsProc uniqSupply (CmmProc info ident params blocks) = info_procs
110
    where
111
112
      uniques :: [[Unique]]
      uniques = map uniqsFromSupply $ listSplitUniqSupply uniqSupply
113
114
115
116
      (gc_unique:info_uniques):block_uniques = uniques

      -- Ensure that 
      forced_gc :: (CmmInfo, [CmmBasicBlock])
117
      forced_gc = force_gc_block info (BlockId gc_unique) ident params
118
119
120
121
122
123

      forced_info = fst forced_gc
      forced_blocks = blocks ++ snd forced_gc
      forced_gc_id = case forced_info of
                       CmmNonInfo (Just x) -> x
                       CmmInfo _ (Just x) _ _ -> x
124
125
126
127
128

      -- Break the block at each function call.
      -- The part after the function call will have to become a continuation.
      broken_blocks :: [BrokenBlock]
      broken_blocks =
129
130
          concat $ zipWith3 breakBlock block_uniques forced_blocks
                     (FunctionEntry forced_info ident params:repeat ControlEntry)
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

      -- Calculate live variables for each broken block.
      --
      -- Nothing can be live on entry to the first block
      -- so we could take the tail, but for now we wont
      -- to help future proof the code.
      live :: BlockEntryLiveness
      live = cmmLiveness $ map cmmBlockFromBrokenBlock broken_blocks

      -- Calculate which blocks must be made into full fledged procedures.
      proc_points :: UniqSet BlockId
      proc_points = calculateProcPoints broken_blocks

      -- Construct a map so we can lookup a broken block by its 'BlockId'.
      block_env :: BlockEnv BrokenBlock
      block_env = blocksToBlockEnv broken_blocks

      -- Group the blocks into continuations based on the set of proc-points.
149
      continuations :: [Continuation (Either C_SRT CmmInfo)]
150
151
152
153
      continuations = zipWith
                        (gatherBlocksIntoContinuation proc_points block_env)
                        (uniqSetToList proc_points)
                        (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
159
      --
      -- This is an association list instead of a UniqFM because
      -- CLabel's don't have a 'Uniqueable' instance.
160
161
162
      formats :: [(CLabel,              -- key
                   (Maybe CLabel,       -- label in top slot
                    [Maybe LocalReg]))] -- slots
163
164
      formats = selectStackFormat live continuations

165
166
167
      -- Do a little meta-processing on the stack formats such as
      -- getting the individual frame sizes and the maximum frame size
      formats' :: (WordOff, [(CLabel, StackFormat)])
168
      formats' = processFormats formats continuations
169
170
171
172
173
174

      -- Update the info table data on the continuations with
      -- the selected stack formats.
      continuations' :: [Continuation CmmInfo]
      continuations' = map (applyStackFormat (snd formats')) continuations

175
176
      -- Do the actual CPS transform.
      cps_procs :: [CmmTop]
177
178
179
180
181
182
      cps_procs = map (continuationToProc formats') continuations'

      -- Convert the info tables from CmmInfo to [CmmStatic]
      -- We might want to put this in another pass eventually
      info_procs :: [RawCmmTop]
      info_procs = concat (zipWith mkInfoTable info_uniques cps_procs)
183

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
--------------------------------------------------------------------------------

-- The format for the call to a continuation
-- The fst is the arguments that must be passed to the continuation
-- by the continuation's caller.
-- The snd is the live values that must be saved on stack.
-- A Nothing indicates an ignored slot.
-- The head of each list is the stack top or the first parameter.

-- The format for live values for a particular continuation
-- All on stack for now.
-- Head element is the top of the stack (or just under the header).
-- Nothing means an empty slot.
-- Future possibilities include callee save registers (i.e. passing slots in register)
-- and heap memory (not sure if that's usefull at all though, but it may
-- be worth exploring the design space).

201
202
continuationLabel (Continuation _ l _ _) = l
data Continuation info =
203
  Continuation
204
     info              -- Left <=> Continuation created by the CPS
205
                       -- Right <=> Function or Proc point
206
207
     CLabel            -- Used to generate both info & entry labels
     CmmFormals        -- Argument locals live on entry (C-- procedure params)
208
     [BrokenBlock]     -- Code, may be empty.  The first block is
209
210
211
212
213
214
215
                       -- the entry point.  The order is otherwise initially 
                       -- unimportant, but at some point the code gen will
                       -- fix the order.

		       -- the BlockId of the first block does not give rise
		       -- to a label.  To jump to the first block in a Proc,
		       -- use the appropriate CLabel.
216
217

data StackFormat
218
219
220
    = StackFormat {
         stack_label :: Maybe CLabel,	-- The label occupying the top slot
         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
225
226
227

-- A block can be a continuation of a call
-- A block can be a continuation of another block (w/ or w/o joins)
-- A block can be an entry to a function

228
229
230
231
-----------------------------------------------------------------------------

collectNonProcPointTargets ::
    UniqSet BlockId -> BlockEnv BrokenBlock
232
233
    -> UniqSet BlockId -> [BlockId] -> UniqSet BlockId
collectNonProcPointTargets proc_points blocks current_targets new_blocks =
234
235
    if sizeUniqSet current_targets == sizeUniqSet new_targets
       then current_targets
236
237
238
239
       else foldl
                (collectNonProcPointTargets proc_points blocks)
                new_targets
                (map (:[]) targets)
240
    where
241
      blocks' = map (lookupWithDefaultUFM blocks (panic "TODO")) new_blocks
242
243
244
245
      targets =
        -- Note the subtlety that since the extra branch after a call
        -- will always be to a block that is a proc-point,
        -- this subtraction will always remove that case
246
247
        uniqSetToList $ (unionManyUniqSets $ map (mkUniqSet . brokenBlockTargets) blocks')
                          `minusUniqSet` proc_points
248
249
250
        -- TODO: remove redundant uniqSetToList
      new_targets = current_targets `unionUniqSets` (mkUniqSet targets)

251
252
253
254
255
256
-- TODO: insert proc point code here
--  * Branches and switches to proc points may cause new blocks to be created
--    (or proc points could leave behind phantom blocks that just jump to them)
--  * Proc points might get some live variables passed as arguments

gatherBlocksIntoContinuation ::
257
    UniqSet BlockId -> BlockEnv BrokenBlock
258
259
    -> BlockId -> Maybe BlockId -> Continuation (Either C_SRT CmmInfo)
gatherBlocksIntoContinuation proc_points blocks start gc =
260
  Continuation info_table clabel params body
261
    where
262
263
      start_and_gc = start : maybeToList gc
      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
270
271
272
273
274

      -- We can't properly annotate the continuation's stack parameters
      -- at this point because this is before stack selection
      -- but we want to keep the C_SRT around so we use 'Either'.
      info_table = case start_block_entry of
                     FunctionEntry info _ _ -> Right info
                     ContinuationEntry _ srt -> Left srt
275
                     ControlEntry -> Right (CmmNonInfo Nothing)
276

277
278
      start_block_entry = brokenBlockEntry start_block
      clabel = case start_block_entry of
279
                 FunctionEntry _ label _ -> label
280
281
                 _ -> mkReturnPtLabel $ getUnique start
      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
290
291
selectStackFormat :: BlockEnv CmmLive
                  -> [Continuation (Either C_SRT CmmInfo)]
                  -> [(CLabel, (Maybe CLabel, [Maybe LocalReg]))]
292
selectStackFormat live continuations =
293
294
    map (\c -> (continuationLabel c, selectStackFormat' c)) continuations
    where
295
296
297
298
299
      selectStackFormat' (Continuation
                          (Right (CmmInfo _ _ _ (ContInfo format srt)))
                          label _ _) = (Just label, format)
      selectStackFormat' (Continuation (Right _) _ _ _) = (Nothing, [])
      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
303
304
          in (Just label,
              map Just $ uniqSetToList $
              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
314
      max_size = maximum $
                 0 : map (continuationMaxStack formats') continuations
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
      formats' = map make_format formats
      make_format (label, format) =
          (label,
           StackFormat {
             stack_label = fst format,
             stack_frame_size = stack_size (snd format) +
                                if isJust (fst format)
                                then label_size
                                else 0,
             stack_live = snd format })

      -- TODO: get rid of "+ 1" etc.
      label_size = 1 :: WordOff

      stack_size [] = 0
      stack_size (Nothing:formats) = 1 + stack_size formats -- one dead word
      stack_size (Just reg:formats) = width + stack_size formats
          where
            width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
            -- TODO: it would be better if we had a machRepWordWidth
335

336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
continuationMaxStack :: [(CLabel, StackFormat)]
                     -> Continuation a
                     -> WordOff
continuationMaxStack formats (Continuation _ label _ blocks) =
    max_arg_size + stack_frame_size stack_format
    where
      stack_format = maybe unknown_format id $ lookup label formats
      unknown_format = panic "Unknown format in continuationMaxStack"

      max_arg_size = maximum $ 0 : map block_max_arg_size blocks

      block_max_arg_size block =
          maximum (final_arg_size (brokenBlockExit block) :
                   map stmt_arg_size (brokenBlockStmts block))

      final_arg_size (FinalReturn args) =
          argumentsSize (cmmExprRep . fst) args
      final_arg_size (FinalJump _ args) =
          argumentsSize (cmmExprRep . fst) args
      final_arg_size (FinalCall next _ _ args) =
          -- We have to account for the stack used when we build a frame
          -- for the *next* continuation from *this* continuation
          argumentsSize (cmmExprRep . fst) args +
          stack_frame_size next_format
          where 
            next_format = maybe unknown_format id $ lookup next' formats
            next' = mkReturnPtLabel $ getUnique next

      final_arg_size _ = 0

      stmt_arg_size (CmmJump _ args) =
          argumentsSize (cmmExprRep . fst) args
      stmt_arg_size (CmmCall _ _ _ (CmmSafe _)) =
          panic "Safe call in processFormats"
      stmt_arg_size (CmmReturn _) =
          panic "CmmReturn in processFormats"
      stmt_arg_size _ = 0

374
375
376
377
378
379
380
381
382
383
384
385
386
387
-----------------------------------------------------------------------------
applyStackFormat :: [(CLabel, StackFormat)]
                 -> Continuation (Either C_SRT CmmInfo)
                 -> Continuation CmmInfo

-- User written continuations
applyStackFormat formats (Continuation
                          (Right (CmmInfo prof gc tag (ContInfo _ srt)))
                          label formals blocks) =
    Continuation (CmmInfo prof gc tag (ContInfo format srt))
                 label formals blocks
    where
      format = stack_live $ maybe unknown_block id $ lookup label formats
      unknown_block = panic "unknown BlockId in applyStackFormat"
388

389
390
391
-- User written non-continuation code
applyStackFormat formats (Continuation (Right info) label formals blocks) =
    Continuation info label formals blocks
392

393
394
395
396
-- CPS generated continuations
applyStackFormat formats (Continuation (Left srt) label formals blocks) =
    Continuation (CmmInfo prof gc tag (ContInfo (stack_live $ format) srt))
                 label formals blocks
397
    where
398
399
400
401
      gc = Nothing -- Generated continuations never need a stack check
      -- TODO prof: this is the same as the current implementation
      -- but I think it could be improved
      prof = ProfilingInfo zeroCLit zeroCLit
402
      tag = rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
      format = maybe unknown_block id $ lookup label formats
      unknown_block = panic "unknown BlockId in applyStackFormat"

-----------------------------------------------------------------------------
continuationToProc :: (WordOff, [(CLabel, StackFormat)])
                   -> Continuation CmmInfo
                   -> CmmTop
continuationToProc (max_stack, formats)
                   (Continuation info label formals blocks) =
    CmmProc info label formals (map continuationToProc' blocks)
    where
      curr_format = maybe unknown_block id $ lookup label formats
      unknown_block = panic "unknown BlockId in continuationToProc"

      continuationToProc' :: BrokenBlock -> CmmBasicBlock
      continuationToProc' (BrokenBlock ident entry stmts _ exit) =
419
420
421
422
          BasicBlock ident (prefix++stmts++postfix)
          where
            prefix = case entry of
                       ControlEntry -> []
423
424
425
426
                       FunctionEntry (CmmInfo _ (Just gc_block) _ _) _ formals ->
                           gc_stack_check gc_block max_stack ++
                           function_entry formals curr_format
                       FunctionEntry (CmmInfo _ Nothing _ _) _ formals ->
427
428
429
                           panic "continuationToProc: missing GC block"
                       FunctionEntry (CmmNonInfo (Just gc_block)) _ formals ->
                           gc_stack_check gc_block max_stack ++
430
                           function_entry formals curr_format
431
432
                       FunctionEntry (CmmNonInfo Nothing) _ formals ->
                           panic "continuationToProc: missing non-info GC block"
433
                       ContinuationEntry formals _ ->
434
                           function_entry formals curr_format
435
436
437
438
            postfix = case exit of
                        FinalBranch next -> [CmmBranch next]
                        FinalSwitch expr targets -> [CmmSwitch expr targets]
                        FinalReturn arguments ->
439
                            tail_call (stack_frame_size curr_format)
440
441
442
                                (CmmLoad (CmmReg spReg) wordRep)
                                arguments
                        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
448
                                tail_call (stack_frame_size curr_format - stack_frame_size cont_format)
                                              target arguments
449
450
451
                            where
                              cont_format = maybe unknown_block id $
                                            lookup (mkReturnPtLabel $ getUnique next) formats
452
                        FinalCall next _ results arguments -> panic "unimplemented CmmCall"
453

454
-----------------------------------------------------------------------------
455
456
457
458
-- Functions that generate CmmStmt sequences
-- for packing/unpacking continuations
-- and entering/exiting functions

459
460
461
462
463
464
465
466
tail_call :: WordOff -> CmmExpr -> CmmActuals -> [CmmStmt]
tail_call spRel target arguments
  = store_arguments ++ adjust_spReg ++ jump where
    store_arguments =
        [stack_put spRel expr offset
         | ((expr, _), StackParam offset) <- argument_formats] ++
        [global_put expr global
         | ((expr, _), RegisterParam global) <- argument_formats]
467
    adjust_spReg =
468
        if spRel == 0
469
        then []
470
        else [CmmAssign spReg (CmmRegOff spReg (spRel*wORD_SIZE))]
471
472
    jump = [CmmJump target arguments]

473
474
    argument_formats = assignArguments (cmmExprRep . fst) arguments

475
476
gc_stack_check :: BlockId -> WordOff -> [CmmStmt]
gc_stack_check gc_block max_frame_size
477
478
479
480
  = check_stack_limit where
    check_stack_limit = [
     CmmCondBranch
     (CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
481
482
                    [CmmRegOff spReg (-max_frame_size*wORD_SIZE),
                     CmmReg spLimReg])
483
484
     gc_block]

485
486
-- TODO: fix branches to proc point
-- (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
492
    -- TODO: only save variables when actually needed
    -- (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
498
499
500
501
502
503
504
505
506
507
508
509
510
511
        if needs_header_set
        then [stack_put spRel continuation_function 0]
        else []

    -- TODO: factor with function_entry and CmmInfo.hs(?)
    cont_offsets = mkOffsets label_size live_regs

    label_size = 1 :: WordOff

    mkOffsets size [] = []
    mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
    mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
        where
          width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
          -- TODO: it would be better if we had a machRepWordWidth
512
513
514

    spRel = curr_frame_size - cont_frame_size
    continuation_function = CmmLit $ CmmLabel $ fromJust cont_id
515
    needs_header_set =
516
517
518
        case (curr_id, cont_id) of
          (Just x, Just y) -> x /= y
          _ -> isJust cont_id
519
520
521
522
523

-- Lazy adjustment of stack headers assumes all blocks
-- that could branch to eachother (i.e. control blocks)
-- have the same stack format (this causes a problem
-- 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
528
    -- TODO: only save variables when actually needed
    -- (may be handled by latter pass)
529
    load_live_values =
530
        [stack_get 0 reg offset
531
         | (reg, offset) <- curr_offsets]
532
533
    load_args =
        [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
541
542
543
544
545
546
547
548
549
550
551
    -- TODO: eliminate copy/paste with pack_continuation
    curr_offsets = mkOffsets label_size live_regs

    label_size = 1 :: WordOff

    mkOffsets size [] = []
    mkOffsets size (Nothing:regs) = mkOffsets (size+1) regs
    mkOffsets size (Just reg:regs) = (reg, size):mkOffsets (size + width) regs
        where
          width = machRepByteWidth (localRegRep reg) `quot` wORD_SIZE
          -- TODO: it would be better if we had a machRepWordWidth

552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
-----------------------------------------------------------------------------
-- Section: Stack and argument register puts and gets
-----------------------------------------------------------------------------
-- TODO: document

-- |Construct a 'CmmStmt' that will save a value on the stack
stack_put :: WordOff            -- ^ Offset from the real 'Sp' that 'offset'
                                -- is relative to (added to offset)
          -> CmmExpr            -- ^ What to store onto the stack
          -> WordOff            -- ^ Where on the stack to store it
                                -- (positive <=> higher addresses)
          -> CmmStmt
stack_put spRel expr offset =
    CmmStore (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) expr

--------------------------------
-- |Construct a 
stack_get :: WordOff
570
          -> LocalReg
571
572
573
          -> WordOff
          -> CmmStmt
stack_get spRel reg offset =
574
575
576
    CmmAssign (CmmLocal reg)
              (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset)))
                       (localRegRep reg))
577
578
global_put :: CmmExpr -> GlobalReg -> CmmStmt
global_put expr global = CmmAssign (CmmGlobal global) expr
579
580
global_get :: LocalReg -> GlobalReg -> CmmStmt
global_get reg global = CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal global))
581