d06b581f26d4c70c7a238fccc1bc384d1f7c613a
[ghc.git] / compiler / codeGen / StgCmmMonad.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Monad for Stg to C-- code generation
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 module StgCmmMonad (
10 FCode, -- type
11
12 initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
13 returnFC, fixC, fixC_, nopC, whenC,
14 newUnique, newUniqSupply,
15
16 emit, emitData, emitProc, emitProcWithConvention, emitSimpleProc,
17
18 getCmm, cgStmtsToBlocks,
19 getCodeR, getCode, getHeapUsage,
20
21 forkClosureBody, forkStatics, forkAlts, forkProc, codeOnly,
22
23 ConTagZ,
24
25 Sequel(..),
26 withSequel, getSequel,
27
28 setSRTLabel, getSRTLabel,
29 setTickyCtrLabel, getTickyCtrLabel,
30
31 withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,
32
33 HeapUsage(..), VirtualHpOffset, initHpUsage,
34 getHpUsage, setHpUsage, heapHWM,
35 setVirtHp, getVirtHp, setRealHp,
36
37 getModuleName,
38
39 -- ideally we wouldn't export these, but some other modules access internal state
40 getState, setState, getInfoDown, getDynFlags, getThisPackage,
41
42 -- more localised access to monad state
43 CgIdInfo(..), CgLoc(..),
44 getBinds, setBinds, getStaticBinds,
45
46 -- out of general friendliness, we also export ...
47 CgInfoDownwards(..), CgState(..) -- non-abstract
48 ) where
49
50 #include "HsVersions.h"
51
52 import StgCmmClosure
53 import DynFlags
54 import MkGraph
55 import BlockId
56 import CmmDecl
57 import CmmExpr
58 import CmmNode (UpdFrameOffset)
59 import CLabel
60 import TyCon ( PrimRep )
61 import SMRep
62 import Module
63 import Id
64 import VarEnv
65 import OrdList
66 import Unique
67 import UniqSupply
68 import FastString(sLit)
69 import Outputable
70
71 import Control.Monad
72 import Data.List
73 import Prelude hiding( sequence )
74 import qualified Prelude( sequence )
75
76 infixr 9 `thenC` -- Right-associative!
77 infixr 9 `thenFC`
78
79
80 --------------------------------------------------------
81 -- The FCode monad and its types
82 --------------------------------------------------------
83
84 newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
85
86 instance Monad FCode where
87 (>>=) = thenFC
88 return = returnFC
89
90 {-# INLINE thenC #-}
91 {-# INLINE thenFC #-}
92 {-# INLINE returnFC #-}
93
94 initC :: DynFlags -> Module -> FCode a -> IO a
95 initC dflags mod (FCode code)
96 = do { uniqs <- mkSplitUniqSupply 'c'
97 ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
98 (res, _) -> return res
99 }
100
101 returnFC :: a -> FCode a
102 returnFC val = FCode (\_info_down state -> (val, state))
103
104 thenC :: FCode () -> FCode a -> FCode a
105 thenC (FCode m) (FCode k) =
106 FCode (\info_down state -> let (_,new_state) = m info_down state in
107 k info_down new_state)
108
109 nopC :: FCode ()
110 nopC = return ()
111
112 whenC :: Bool -> FCode () -> FCode ()
113 whenC True code = code
114 whenC False _code = nopC
115
116 listCs :: [FCode ()] -> FCode ()
117 listCs [] = return ()
118 listCs (fc:fcs) = do
119 fc
120 listCs fcs
121
122 mapCs :: (a -> FCode ()) -> [a] -> FCode ()
123 mapCs = mapM_
124
125 thenFC :: FCode a -> (a -> FCode c) -> FCode c
126 thenFC (FCode m) k = FCode (
127 \info_down state ->
128 let
129 (m_result, new_state) = m info_down state
130 (FCode kcode) = k m_result
131 in
132 kcode info_down new_state
133 )
134
135 listFCs :: [FCode a] -> FCode [a]
136 listFCs = Prelude.sequence
137
138 mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
139 mapFCs = mapM
140
141 fixC :: (a -> FCode a) -> FCode a
142 fixC fcode = FCode (
143 \info_down state ->
144 let
145 FCode fc = fcode v
146 result@(v,_) = fc info_down state
147 -- ^--------^
148 in
149 result
150 )
151
152 fixC_ :: (a -> FCode a) -> FCode ()
153 fixC_ fcode = fixC fcode >> return ()
154
155 --------------------------------------------------------
156 -- The code generator environment
157 --------------------------------------------------------
158
159 -- This monadery has some information that it only passes
160 -- *downwards*, as well as some ``state'' which is modified
161 -- as we go along.
162
163 data CgInfoDownwards -- information only passed *downwards* by the monad
164 = MkCgInfoDown {
165 cgd_dflags :: DynFlags,
166 cgd_mod :: Module, -- Module being compiled
167 cgd_statics :: CgBindings, -- [Id -> info] : static environment
168 cgd_srt_lbl :: CLabel, -- Label of the current top-level SRT
169 cgd_updfr_off :: UpdFrameOffset, -- Size of current update frame
170 cgd_ticky :: CLabel, -- Current destination for ticky counts
171 cgd_sequel :: Sequel -- What to do at end of basic block
172 }
173
174 type CgBindings = IdEnv CgIdInfo
175
176 data CgIdInfo
177 = CgIdInfo
178 { cg_id :: Id -- Id that this is the info for
179 -- Can differ from the Id at occurrence sites by
180 -- virtue of being externalised, for splittable C
181 , cg_lf :: LambdaFormInfo
182 , cg_loc :: CgLoc -- CmmExpr for the *tagged* value
183 , cg_rep :: PrimRep -- Cache for (idPrimRep id)
184 , cg_tag :: {-# UNPACK #-} !DynTag -- Cache for (lfDynTag cg_lf)
185 }
186
187 data CgLoc
188 = CmmLoc CmmExpr -- A stable CmmExpr; that is, one not mentioning
189 -- Hp, so that it remains valid across calls
190
191 | LneLoc BlockId [LocalReg] -- A join point
192 -- A join point (= let-no-escape) should only
193 -- be tail-called, and in a saturated way.
194 -- To tail-call it, assign to these locals,
195 -- and branch to the block id
196
197 instance Outputable CgIdInfo where
198 ppr (CgIdInfo { cg_id = id, cg_loc = loc })
199 = ppr id <+> ptext (sLit "-->") <+> ppr loc
200
201 instance Outputable CgLoc where
202 ppr (CmmLoc e) = ptext (sLit "cmm") <+> ppr e
203 ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
204
205
206 -- Sequel tells what to do with the result of this expression
207 data Sequel
208 = Return Bool -- Return result(s) to continuation found on the stack
209 -- True <=> the continuation is update code (???)
210
211 | AssignTo
212 [LocalReg] -- Put result(s) in these regs and fall through
213 -- NB: no void arguments here
214 Bool -- Should we adjust the heap pointer back to recover
215 -- space that's unused on this path?
216 -- We need to do this only if the expression may
217 -- allocate (e.g. it's a foreign call or allocating primOp)
218 instance Show Sequel where
219 show (Return _) = "Sequel: Return"
220 show (AssignTo _ _) = "Sequel: Assign"
221
222 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
223 initCgInfoDown dflags mod
224 = MkCgInfoDown { cgd_dflags = dflags,
225 cgd_mod = mod,
226 cgd_statics = emptyVarEnv,
227 cgd_srt_lbl = error "initC: srt_lbl",
228 cgd_updfr_off = initUpdFrameOff,
229 cgd_ticky = mkTopTickyCtrLabel,
230 cgd_sequel = initSequel }
231
232 initSequel :: Sequel
233 initSequel = Return False
234
235 initUpdFrameOff :: UpdFrameOffset
236 initUpdFrameOff = widthInBytes wordWidth -- space for the RA
237
238
239 --------------------------------------------------------
240 -- The code generator state
241 --------------------------------------------------------
242
243 data CgState
244 = MkCgState {
245 cgs_stmts :: CmmAGraph, -- Current procedure
246
247 cgs_tops :: OrdList CmmTop,
248 -- Other procedures and data blocks in this compilation unit
249 -- Both are ordered only so that we can
250 -- reduce forward references, when it's easy to do so
251
252 cgs_binds :: CgBindings, -- [Id -> info] : *local* bindings environment
253 -- Bindings for top-level things are given in
254 -- the info-down part
255
256 cgs_hp_usg :: HeapUsage,
257
258 cgs_uniqs :: UniqSupply }
259
260 data HeapUsage =
261 HeapUsage {
262 virtHp :: VirtualHpOffset, -- Virtual offset of highest-allocated word
263 -- Incremented whenever we allocate
264 realHp :: VirtualHpOffset -- realHp: Virtual offset of real heap ptr
265 -- Used in instruction addressing modes
266 }
267
268 type VirtualHpOffset = WordOff
269
270 initCgState :: UniqSupply -> CgState
271 initCgState uniqs
272 = MkCgState { cgs_stmts = mkNop, cgs_tops = nilOL,
273 cgs_binds = emptyVarEnv,
274 cgs_hp_usg = initHpUsage,
275 cgs_uniqs = uniqs }
276
277 stateIncUsage :: CgState -> CgState -> CgState
278 -- stateIncUsage@ e1 e2 incorporates in e1
279 -- the heap high water mark found in e2.
280 stateIncUsage s1 s2@(MkCgState { cgs_hp_usg = hp_usg })
281 = s1 { cgs_hp_usg = cgs_hp_usg s1 `maxHpHw` virtHp hp_usg }
282 `addCodeBlocksFrom` s2
283
284 addCodeBlocksFrom :: CgState -> CgState -> CgState
285 -- Add code blocks from the latter to the former
286 -- (The cgs_stmts will often be empty, but not always; see codeOnly)
287 s1 `addCodeBlocksFrom` s2
288 = s1 { cgs_stmts = cgs_stmts s1 <*> cgs_stmts s2,
289 cgs_tops = cgs_tops s1 `appOL` cgs_tops s2 }
290
291
292 -- The heap high water mark is the larger of virtHp and hwHp. The latter is
293 -- only records the high water marks of forked-off branches, so to find the
294 -- heap high water mark you have to take the max of virtHp and hwHp. Remember,
295 -- virtHp never retreats!
296 --
297 -- Note Jan 04: ok, so why do we only look at the virtual Hp??
298
299 heapHWM :: HeapUsage -> VirtualHpOffset
300 heapHWM = virtHp
301
302 initHpUsage :: HeapUsage
303 initHpUsage = HeapUsage { virtHp = 0, realHp = 0 }
304
305 maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
306 hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
307
308
309 --------------------------------------------------------
310 -- Operators for getting and setting the state and "info_down".
311 --------------------------------------------------------
312
313 getState :: FCode CgState
314 getState = FCode $ \_info_down state -> (state,state)
315
316 setState :: CgState -> FCode ()
317 setState state = FCode $ \_info_down _ -> ((),state)
318
319 getHpUsage :: FCode HeapUsage
320 getHpUsage = do
321 state <- getState
322 return $ cgs_hp_usg state
323
324 setHpUsage :: HeapUsage -> FCode ()
325 setHpUsage new_hp_usg = do
326 state <- getState
327 setState $ state {cgs_hp_usg = new_hp_usg}
328
329 setVirtHp :: VirtualHpOffset -> FCode ()
330 setVirtHp new_virtHp
331 = do { hp_usage <- getHpUsage
332 ; setHpUsage (hp_usage {virtHp = new_virtHp}) }
333
334 getVirtHp :: FCode VirtualHpOffset
335 getVirtHp
336 = do { hp_usage <- getHpUsage
337 ; return (virtHp hp_usage) }
338
339 setRealHp :: VirtualHpOffset -> FCode ()
340 setRealHp new_realHp
341 = do { hp_usage <- getHpUsage
342 ; setHpUsage (hp_usage {realHp = new_realHp}) }
343
344 getBinds :: FCode CgBindings
345 getBinds = do
346 state <- getState
347 return $ cgs_binds state
348
349 setBinds :: CgBindings -> FCode ()
350 setBinds new_binds = do
351 state <- getState
352 setState $ state {cgs_binds = new_binds}
353
354 getStaticBinds :: FCode CgBindings
355 getStaticBinds = do
356 info <- getInfoDown
357 return (cgd_statics info)
358
359 withState :: FCode a -> CgState -> FCode (a,CgState)
360 withState (FCode fcode) newstate = FCode $ \info_down state ->
361 let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
362
363 newUniqSupply :: FCode UniqSupply
364 newUniqSupply = do
365 state <- getState
366 let (us1, us2) = splitUniqSupply (cgs_uniqs state)
367 setState $ state { cgs_uniqs = us1 }
368 return us2
369
370 newUnique :: FCode Unique
371 newUnique = do
372 us <- newUniqSupply
373 return (uniqFromSupply us)
374
375 ------------------
376 getInfoDown :: FCode CgInfoDownwards
377 getInfoDown = FCode $ \info_down state -> (info_down,state)
378
379 getDynFlags :: FCode DynFlags
380 getDynFlags = liftM cgd_dflags getInfoDown
381
382 getThisPackage :: FCode PackageId
383 getThisPackage = liftM thisPackage getDynFlags
384
385 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
386 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
387
388 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
389 doFCode (FCode fcode) info_down state = fcode info_down state
390
391
392 -- ----------------------------------------------------------------------------
393 -- Get the current module name
394
395 getModuleName :: FCode Module
396 getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
397
398 -- ----------------------------------------------------------------------------
399 -- Get/set the end-of-block info
400
401 withSequel :: Sequel -> FCode () -> FCode ()
402 withSequel sequel code
403 = do { info <- getInfoDown
404 ; withInfoDown code (info {cgd_sequel = sequel }) }
405
406 getSequel :: FCode Sequel
407 getSequel = do { info <- getInfoDown
408 ; return (cgd_sequel info) }
409
410 -- ----------------------------------------------------------------------------
411 -- Get/set the current SRT label
412
413 -- There is just one SRT for each top level binding; all the nested
414 -- bindings use sub-sections of this SRT. The label is passed down to
415 -- the nested bindings via the monad.
416
417 getSRTLabel :: FCode CLabel -- Used only by cgPanic
418 getSRTLabel = do info <- getInfoDown
419 return (cgd_srt_lbl info)
420
421 setSRTLabel :: CLabel -> FCode a -> FCode a
422 setSRTLabel srt_lbl code
423 = do info <- getInfoDown
424 withInfoDown code (info { cgd_srt_lbl = srt_lbl})
425
426 -- ----------------------------------------------------------------------------
427 -- Get/set the size of the update frame
428
429 -- We keep track of the size of the update frame so that we
430 -- can set the stack pointer to the proper address on return
431 -- (or tail call) from the closure.
432 -- There should be at most one update frame for each closure.
433 -- Note: I'm including the size of the original return address
434 -- in the size of the update frame -- hence the default case on `get'.
435
436 withUpdFrameOff :: UpdFrameOffset -> FCode () -> FCode ()
437 withUpdFrameOff size code
438 = do { info <- getInfoDown
439 ; withInfoDown code (info {cgd_updfr_off = size }) }
440
441 getUpdFrameOff :: FCode UpdFrameOffset
442 getUpdFrameOff
443 = do { info <- getInfoDown
444 ; return $ cgd_updfr_off info }
445
446 -- ----------------------------------------------------------------------------
447 -- Get/set the current ticky counter label
448
449 getTickyCtrLabel :: FCode CLabel
450 getTickyCtrLabel = do
451 info <- getInfoDown
452 return (cgd_ticky info)
453
454 setTickyCtrLabel :: CLabel -> FCode () -> FCode ()
455 setTickyCtrLabel ticky code = do
456 info <- getInfoDown
457 withInfoDown code (info {cgd_ticky = ticky})
458
459
460 --------------------------------------------------------
461 -- Forking
462 --------------------------------------------------------
463
464 forkClosureBody :: FCode () -> FCode ()
465 -- forkClosureBody takes a code, $c$, and compiles it in a
466 -- fresh environment, except that:
467 -- - compilation info and statics are passed in unchanged.
468 -- - local bindings are passed in unchanged
469 -- (it's up to the enclosed code to re-bind the
470 -- free variables to a field of the closure)
471 --
472 -- The current state is passed on completely unaltered, except that
473 -- C-- from the fork is incorporated.
474
475 forkClosureBody body_code
476 = do { info <- getInfoDown
477 ; us <- newUniqSupply
478 ; state <- getState
479 ; let body_info_down = info { cgd_sequel = initSequel
480 , cgd_updfr_off = initUpdFrameOff }
481 fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
482 ((),fork_state_out)
483 = doFCode body_code body_info_down fork_state_in
484 ; setState $ state `addCodeBlocksFrom` fork_state_out }
485
486 forkStatics :: FCode a -> FCode a
487 -- @forkStatics@ $fc$ compiles $fc$ in an environment whose *statics* come
488 -- from the current *local bindings*, but which is otherwise freshly initialised.
489 -- The Abstract~C returned is attached to the current state, but the
490 -- bindings and usage information is otherwise unchanged.
491 forkStatics body_code
492 = do { info <- getInfoDown
493 ; us <- newUniqSupply
494 ; state <- getState
495 ; let rhs_info_down = info { cgd_statics = cgs_binds state
496 , cgd_sequel = initSequel
497 , cgd_updfr_off = initUpdFrameOff }
498 (result, fork_state_out) = doFCode body_code rhs_info_down
499 (initCgState us)
500 ; setState (state `addCodeBlocksFrom` fork_state_out)
501 ; return result }
502
503 forkProc :: FCode a -> FCode a
504 -- 'forkProc' takes a code and compiles it in the *current* environment,
505 -- returning the graph thus constructed.
506 --
507 -- The current environment is passed on completely unchanged to
508 -- the successor. In particular, any heap usage from the enclosed
509 -- code is discarded; it should deal with its own heap consumption
510 forkProc body_code
511 = do { info_down <- getInfoDown
512 ; us <- newUniqSupply
513 ; state <- getState
514 ; let info_down' = info_down -- { cgd_sequel = initSequel }
515 fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
516 (result, fork_state_out) = doFCode body_code info_down' fork_state_in
517 ; setState $ state `addCodeBlocksFrom` fork_state_out
518 ; return result }
519
520 codeOnly :: FCode () -> FCode ()
521 -- Emit any code from the inner thing into the outer thing
522 -- Do not affect anything else in the outer state
523 -- Used in almost-circular code to prevent false loop dependencies
524 codeOnly body_code
525 = do { info_down <- getInfoDown
526 ; us <- newUniqSupply
527 ; state <- getState
528 ; let fork_state_in = (initCgState us) { cgs_binds = cgs_binds state,
529 cgs_hp_usg = cgs_hp_usg state }
530 ((), fork_state_out) = doFCode body_code info_down fork_state_in
531 ; setState $ state `addCodeBlocksFrom` fork_state_out }
532
533 forkAlts :: [FCode a] -> FCode [a]
534 -- (forkAlts' bs d) takes fcodes 'bs' for the branches of a 'case', and
535 -- an fcode for the default case 'd', and compiles each in the current
536 -- environment. The current environment is passed on unmodified, except
537 -- that the virtual Hp is moved on to the worst virtual Hp for the branches
538
539 forkAlts branch_fcodes
540 = do { info_down <- getInfoDown
541 ; us <- newUniqSupply
542 ; state <- getState
543 ; let compile us branch
544 = (us2, doFCode branch info_down branch_state)
545 where
546 (us1,us2) = splitUniqSupply us
547 branch_state = (initCgState us1) {
548 cgs_binds = cgs_binds state,
549 cgs_hp_usg = cgs_hp_usg state }
550
551 (_us, results) = mapAccumL compile us branch_fcodes
552 (branch_results, branch_out_states) = unzip results
553 ; setState $ foldl stateIncUsage state branch_out_states
554 -- NB foldl. state is the *left* argument to stateIncUsage
555 ; return branch_results }
556
557 -- collect the code emitted by an FCode computation
558 getCodeR :: FCode a -> FCode (a, CmmAGraph)
559 getCodeR fcode
560 = do { state1 <- getState
561 ; (a, state2) <- withState fcode (state1 { cgs_stmts = mkNop })
562 ; setState $ state2 { cgs_stmts = cgs_stmts state1 }
563 ; return (a, cgs_stmts state2) }
564
565 getCode :: FCode a -> FCode CmmAGraph
566 getCode fcode = do { (_,stmts) <- getCodeR fcode; return stmts }
567
568 -- 'getHeapUsage' applies a function to the amount of heap that it uses.
569 -- It initialises the heap usage to zeros, and passes on an unchanged
570 -- heap usage.
571 --
572 -- It is usually a prelude to performing a GC check, so everything must
573 -- be in a tidy and consistent state.
574 --
575 -- Note the slightly subtle fixed point behaviour needed here
576
577 getHeapUsage :: (VirtualHpOffset -> FCode a) -> FCode a
578 getHeapUsage fcode
579 = do { info_down <- getInfoDown
580 ; state <- getState
581 ; let fstate_in = state { cgs_hp_usg = initHpUsage }
582 (r, fstate_out) = doFCode (fcode hp_hw) info_down fstate_in
583 hp_hw = heapHWM (cgs_hp_usg fstate_out) -- Loop here!
584
585 ; setState $ fstate_out { cgs_hp_usg = cgs_hp_usg state }
586 ; return r }
587
588 -- ----------------------------------------------------------------------------
589 -- Combinators for emitting code
590
591 emit :: CmmAGraph -> FCode ()
592 emit ag
593 = do { state <- getState
594 ; setState $ state { cgs_stmts = cgs_stmts state <*> ag } }
595
596 emitData :: Section -> CmmStatics -> FCode ()
597 emitData sect lits
598 = do { state <- getState
599 ; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
600 where
601 data_block = CmmData sect lits
602
603 emitProcWithConvention :: Convention -> CmmInfoTable -> CLabel -> [CmmFormal] ->
604 CmmAGraph -> FCode ()
605 emitProcWithConvention conv info lbl args blocks
606 = do { us <- newUniqSupply
607 ; let (offset, entry) = mkCallEntry conv args
608 blks = initUs_ us $ lgraphOfAGraph $ entry <*> blocks
609 ; let sinfo = StackInfo {arg_space = offset, updfr_space = Just initUpdFrameOff}
610 proc_block = CmmProc (TopInfo {info_tbl=info, stack_info=sinfo}) lbl blks
611 ; state <- getState
612 ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
613
614 emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> CmmAGraph -> FCode ()
615 emitProc = emitProcWithConvention NativeNodeCall
616
617 emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
618 emitSimpleProc lbl code =
619 emitProc CmmNonInfoTable lbl [] code
620
621 getCmm :: FCode () -> FCode Cmm
622 -- Get all the CmmTops (there should be no stmts)
623 -- Return a single Cmm which may be split from other Cmms by
624 -- object splitting (at a later stage)
625 getCmm code
626 = do { state1 <- getState
627 ; ((), state2) <- withState code (state1 { cgs_tops = nilOL })
628 ; setState $ state2 { cgs_tops = cgs_tops state1 }
629 ; return (Cmm (fromOL (cgs_tops state2))) }
630
631 -- ----------------------------------------------------------------------------
632 -- CgStmts
633
634 -- These functions deal in terms of CgStmts, which is an abstract type
635 -- representing the code in the current proc.
636
637 -- turn CgStmts into [CmmBasicBlock], for making a new proc.
638 cgStmtsToBlocks :: CmmAGraph -> FCode CmmGraph
639 cgStmtsToBlocks stmts
640 = do { us <- newUniqSupply
641 ; return (initUs_ us (lgraphOfAGraph stmts)) }
642