2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgMonad.lhs,v 1.22 1999/06/09 14:28:38 simonmar Exp $
6 \section[CgMonad]{The code generation monad}
8 See the beginning of the top-level @CodeGen@ module, to see how this
9 monadic stuff fits into the Big Picture.
16 initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
17 returnFC, fixC, absC, nopC, getAbsC,
19 forkClosureBody, forkStatics, forkAlts, forkEval,
20 forkEvalHelp, forkAbsC,
24 setEndOfBlockInfo, getEndOfBlockInfo,
26 setSRTLabel, getSRTLabel,
28 StackUsage, Slot(..), HeapUsage,
32 costCentresC, moduleName,
34 Sequel(..), -- ToDo: unabstract?
37 -- out of general friendliness, we also export ...
38 CgInfoDownwards(..), CgState(..), -- non-abstract
42 #include "HsVersions.h"
44 import {-# SOURCE #-} CgBindery ( CgIdInfo, CgBindings, nukeVolatileBinds )
45 import {-# SOURCE #-} CgUsages ( getSpRelOffset )
48 import AbsCUtils ( mkAbsCStmts )
49 import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling )
50 import CLabel ( CLabel, mkUpdInfoLabel )
51 import Module ( Module )
52 import DataCon ( ConTag )
55 import PrimRep ( PrimRep(..) )
56 import StgSyn ( StgLiveVars )
59 infixr 9 `thenC` -- Right-associative!
63 %************************************************************************
65 \subsection[CgMonad-environment]{Stuff for manipulating environments}
67 %************************************************************************
69 This monadery has some information that it only passes {\em
70 downwards}, as well as some ``state'' which is modified as we go
74 data CgInfoDownwards -- information only passed *downwards* by the monad
76 CompilationInfo -- COMPLETELY STATIC info about this compilation
77 -- (e.g., what flags were passed to the compiler)
79 CgBindings -- [Id -> info] : static environment
81 CLabel -- label of the current SRT
83 EndOfBlockInfo -- Info for stuff to do at end of basic block:
88 Module -- the module name
92 AbstractC -- code accumulated so far
93 CgBindings -- [Id -> info] : *local* bindings environment
94 -- Bindings for top-level things are given in the info-down part
98 @EndOfBlockInfo@ tells what to do at the end of this block of code or,
99 if the expression is a @case@, what to do at the end of each
105 VirtualSpOffset -- Args Sp: trim the stack to this point at a
106 -- return; push arguments starting just
107 -- above this point on a tail call.
109 -- This is therefore the stk ptr as seen
110 -- by a case alternative.
113 initEobInfo = EndOfBlockInfo 0 (OnStack 0)
116 Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
117 that it must survive stack pointer adjustments at the end of the
123 VirtualSpOffset -- Continuation is on the stack, at the
124 -- specified location
129 CAddrMode -- Jump to this; if the continuation is for a vectored
130 -- case this might be the label of a return
131 -- vector Guaranteed to be a non-volatile
132 -- addressing mode (I think)
135 | SeqFrame -- like CaseAlts but push a seq frame too.
139 type SemiTaggingStuff
140 = Maybe -- Maybe[1] we don't have any semi-tagging stuff...
141 ([(ConTag, JoinDetails)], -- Alternatives
142 Maybe (Maybe Id, JoinDetails) -- Default (but Maybe[2] we don't have one)
143 -- Maybe[3] the default is a
144 -- bind-default (Just b); that is,
145 -- it expects a ptr to the thing
146 -- in Node, bound to b
150 = (AbstractC, CLabel) -- Code to load regs from heap object + profiling macros,
151 -- and join point label
153 -- The abstract C is executed only from a successful semitagging
154 -- venture, when a case has looked at a variable, found that it's
155 -- evaluated, and wants to load up the contents and go to the join
159 -- The OnStack case of sequelToAmode delivers an Amode which is only
160 -- valid just before the final control transfer, because it assumes
161 -- that Sp is pointing to the top word of the return address. This
162 -- seems unclean but there you go.
164 -- sequelToAmode returns an amode which refers to an info table. The info
165 -- table will always be of the RET(_VEC)?_(BIG|SMALL) kind. We're careful
166 -- not to handle real code pointers, just in case we're compiling for
167 -- an unregisterised/untailcallish architecture, where info pointers and
168 -- code pointers aren't the same.
170 sequelToAmode :: Sequel -> FCode CAddrMode
172 sequelToAmode (OnStack virt_sp_offset)
173 = getSpRelOffset virt_sp_offset `thenFC` \ sp_rel ->
174 returnFC (CVal sp_rel RetRep)
176 sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep)
177 sequelToAmode (CaseAlts amode _) = returnFC amode
178 sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame"
180 type CgStksAndHeapUsage -- stacks and heap usage information
181 = (StackUsage, HeapUsage)
183 data Slot = Free | NonPointer
192 (Int, -- virtSp: Virtual offset of topmost allocated slot
193 [(Int,Slot)], -- free: List of free slots, in increasing order
194 Int, -- realSp: Virtual offset of real stack pointer
195 Int) -- hwSp: Highest value ever taken by virtSp
198 (HeapOffset, -- virtHp: Virtual offset of highest-allocated word
199 HeapOffset) -- realHp: Virtual offset of real heap ptr
202 NB: absolutely every one of the above Ints is really
203 a VirtualOffset of some description (the code generator
204 works entirely in terms of VirtualOffsets).
209 initialStateC = MkCgState AbsCNop emptyVarEnv initUsage
211 initUsage :: CgStksAndHeapUsage
212 initUsage = ((0,[],0,0), (0,0))
215 "envInitForAlternatives" initialises the environment for a case alternative,
216 assuming that the alternative is entered after an evaluation.
219 - zapping any volatile bindings, which aren't valid.
221 - zapping the heap usage. It should be restored by a heap check.
223 - setting the virtual AND real stack pointer fields to the given
224 virtual stack offsets. this doesn't represent any {\em code}; it is a
225 prediction of where the real stack pointer will be when we come back
226 from the case analysis.
228 - BUT LEAVING the rest of the stack-usage info because it is all
229 valid. In particular, we leave the tail stack pointers unchanged,
230 becuase the alternative has to de-allocate the original @case@
231 expression's stack. \end{itemize}
233 @stateIncUsage@$~e_1~e_2$ incorporates in $e_1$ the stack and heap high water
234 marks found in $e_2$.
237 stateIncUsage :: CgState -> CgState -> CgState
239 stateIncUsage (MkCgState abs_c bs ((v,f,r,h1),(vH1,rH1)))
240 (MkCgState _ _ ((_,_,_,h2),(vH2, _)))
243 ((v,f,r,h1 `max` h2),
244 (vH1 `max` vH2, rH1))
247 %************************************************************************
249 \subsection[CgMonad-basics]{Basic code-generation monad magic}
251 %************************************************************************
254 type FCode a = CgInfoDownwards -> CgState -> (a, CgState)
255 type Code = CgInfoDownwards -> CgState -> CgState
258 {-# INLINE thenFC #-}
259 {-# INLINE returnFC #-}
261 The Abstract~C is not in the environment so as to improve strictness.
264 initC :: CompilationInfo -> Code -> AbstractC
267 = case (code (MkCgInfoDown
269 (error "initC: statics")
273 MkCgState abc _ _ -> abc
275 returnFC :: a -> FCode a
277 returnFC val info_down state = (val, state)
282 -> (CgInfoDownwards -> CgState -> a)
283 -> CgInfoDownwards -> CgState -> a
285 -- thenC has both of the following types:
286 -- thenC :: Code -> Code -> Code
287 -- thenC :: Code -> FCode a -> FCode a
289 thenC m k info_down state
290 = k info_down new_state
292 new_state = m info_down state
294 listCs :: [Code] -> Code
296 listCs [] info_down state = state
297 listCs (c:cs) info_down state = stateN
299 state1 = c info_down state
300 stateN = listCs cs info_down state1
302 mapCs :: (a -> Code) -> [a] -> Code
304 mapCs f [] info_down state = state
305 mapCs f (c:cs) info_down state = stateN
307 state1 = (f c) info_down state
308 stateN = mapCs f cs info_down state1
313 -> (a -> CgInfoDownwards -> CgState -> c)
314 -> CgInfoDownwards -> CgState -> c
316 -- thenFC :: FCode a -> (a -> FCode b) -> FCode b
317 -- thenFC :: FCode a -> (a -> Code) -> Code
319 thenFC m k info_down state
320 = k m_result info_down new_state
322 (m_result, new_state) = m info_down state
324 listFCs :: [FCode a] -> FCode [a]
326 listFCs [] info_down state = ([], state)
327 listFCs (fc:fcs) info_down state = (thing : things, stateN)
329 (thing, state1) = fc info_down state
330 (things, stateN) = listFCs fcs info_down state1
332 mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
334 mapFCs f [] info_down state = ([], state)
335 mapFCs f (fc:fcs) info_down state = (thing : things, stateN)
337 (thing, state1) = (f fc) info_down state
338 (things, stateN) = mapFCs f fcs info_down state1
341 And the knot-tying combinator:
343 fixC :: (a -> FCode a) -> FCode a
344 fixC fcode info_down state = result
346 result@(v, _) = fcode v info_down state
350 @forkClosureBody@ takes a code, $c$, and compiles it in a completely
351 fresh environment, except that:
352 - compilation info and statics are passed in unchanged.
353 The current environment is passed on completely unaltered, except that
354 abstract C from the fork is incorporated.
356 @forkAbsC@ takes a code and compiles it in the current environment,
357 returning the abstract C thus constructed. The current environment
358 is passed on completely unchanged. It is pretty similar to @getAbsC@,
359 except that the latter does affect the environment. ToDo: combine?
361 @forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
362 from the current bindings, but which is otherwise freshly initialised.
363 The Abstract~C returned is attached to the current state, but the
364 bindings and usage information is otherwise unchanged.
367 forkClosureBody :: Code -> Code
370 (MkCgInfoDown cg_info statics srt _)
371 (MkCgState absC_in binds un_usage)
372 = MkCgState (AbsCStmts absC_in absC_fork) binds un_usage
374 fork_state = code body_info_down initialStateC
375 MkCgState absC_fork _ _ = fork_state
376 body_info_down = MkCgInfoDown cg_info statics srt initEobInfo
378 forkStatics :: FCode a -> FCode a
380 forkStatics fcode (MkCgInfoDown cg_info _ srt _)
381 (MkCgState absC_in statics un_usage)
382 = (result, MkCgState (AbsCStmts absC_in absC_fork) statics un_usage)
384 (result, state) = fcode rhs_info_down initialStateC
385 MkCgState absC_fork _ _ = state -- Don't merge these this line with the one
386 -- above or it becomes too strict!
387 rhs_info_down = MkCgInfoDown cg_info statics srt initEobInfo
389 forkAbsC :: Code -> FCode AbstractC
390 forkAbsC code info_down (MkCgState absC1 bs usage)
393 MkCgState absC2 _ ((_, _, _,h2), _) =
394 code info_down (MkCgState AbsCNop bs usage)
395 ((v, f, r, h1), heap_usage) = usage
397 new_usage = ((v, f, r, h1 `max` h2), heap_usage)
398 new_state = MkCgState absC1 bs new_usage
401 @forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
402 an fcode for the default case $d$, and compiles each in the current
403 environment. The current environment is passed on unmodified, except
405 - the worst stack high-water mark is incorporated
406 - the virtual Hp is moved on to the worst virtual Hp for the branches
409 forkAlts :: [FCode a] -> FCode b -> FCode ([a],b)
411 forkAlts branch_fcodes deflt_fcode info_down in_state
412 = ((branch_results , deflt_result), out_state)
414 compile fc = fc info_down in_state
416 (branch_results, branch_out_states) = unzip (map compile branch_fcodes)
418 (deflt_result, deflt_out_state) = deflt_fcode info_down in_state
420 out_state = foldl stateIncUsage in_state (deflt_out_state:branch_out_states)
421 -- NB foldl. in_state is the *left* argument to stateIncUsage
424 @forkEval@ takes two blocks of code.
426 - The first meddles with the environment to set it up as expected by
427 the alternatives of a @case@ which does an eval (or gc-possible primop).
428 - The second block is the code for the alternatives.
429 (plus info for semi-tagging purposes)
431 @forkEval@ picks up the virtual stack pointer and returns a suitable
432 @EndOfBlockInfo@ for the caller to use, together with whatever value
433 is returned by the second block.
435 It uses @initEnvForAlternatives@ to initialise the environment, and
436 @stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
440 forkEval :: EndOfBlockInfo -- For the body
441 -> Code -- Code to set environment
442 -> FCode Sequel -- Semi-tagging info to store
443 -> FCode EndOfBlockInfo -- The new end of block info
445 forkEval body_eob_info env_code body_code
446 = forkEvalHelp body_eob_info env_code body_code `thenFC` \ (v, sequel) ->
447 returnFC (EndOfBlockInfo v sequel)
449 forkEvalHelp :: EndOfBlockInfo -- For the body
450 -> Code -- Code to set environment
451 -> FCode a -- The code to do after the eval
453 a) -- Result of the FCode
455 forkEvalHelp body_eob_info env_code body_code
456 info_down@(MkCgInfoDown cg_info statics srt _) state
457 = ((v,value_returned), state `stateIncUsageEval` state_at_end_return)
459 info_down_for_body = MkCgInfoDown cg_info statics srt body_eob_info
461 (MkCgState _ binds ((v,f,_,_), _)) = env_code info_down_for_body state
462 -- These v and f things are now set up as the body code expects them
464 (value_returned, state_at_end_return)
465 = body_code info_down_for_body state_for_body
467 state_for_body = MkCgState AbsCNop
468 (nukeVolatileBinds binds)
472 stateIncUsageEval :: CgState -> CgState -> CgState
473 stateIncUsageEval (MkCgState absC1 bs ((v,f,r,h1),heap_usage))
474 (MkCgState absC2 _ ((_,_,_,h2), _))
475 = MkCgState (absC1 `AbsCStmts` absC2)
476 -- The AbsC coming back should consist only of nested declarations,
477 -- notably of the return vector!
479 ((v,f,r,h1 `max` h2), heap_usage)
480 -- We don't max the heap high-watermark because stateIncUsageEval is
481 -- used only in forkEval, which in turn is only used for blocks of code
482 -- which do their own heap-check.
485 %************************************************************************
487 \subsection[CgMonad-spitting-AbstractC]{Spitting out @AbstractC@}
489 %************************************************************************
491 @nopC@ is the no-op for the @Code@ monad; it adds no Abstract~C to the
492 environment; @absC@ glues @ab_C@ onto the Abstract~C collected so far.
495 nopC info_down state = state
497 absC :: AbstractC -> Code
498 absC more_absC info_down state@(MkCgState absC binds usage)
499 = MkCgState (mkAbsCStmts absC more_absC) binds usage
502 These two are just like @absC@, except they examine the compilation
503 info (whether SCC profiling or profiling-ctrs going) and possibly emit
507 costCentresC :: FAST_STRING -> [CAddrMode] -> Code
509 costCentresC macro args _ state@(MkCgState absC binds usage)
510 = if opt_SccProfilingOn
511 then MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
514 profCtrC :: FAST_STRING -> [CAddrMode] -> Code
516 profCtrC macro args _ state@(MkCgState absC binds usage)
517 = if not opt_DoTickyProfiling
519 else MkCgState (mkAbsCStmts absC (CCallProfCtrMacro macro args)) binds usage
521 {- Try to avoid adding too many special compilation strategies here.
522 It's better to modify the header files as necessary for particular
523 targets, so that we can get away with as few variants of .hc files
528 @getAbsC@ compiles the code in the current environment, and returns
529 the abstract C thus constructed (leaving the abstract C being carried
530 around in the state untouched). @getAbsC@ does not generate any
531 in-line Abstract~C itself, but the environment it returns is that
532 obtained from the compilation.
535 getAbsC :: Code -> FCode AbstractC
537 getAbsC code info_down (MkCgState absC binds usage)
538 = (absC2, MkCgState absC binds2 usage2)
540 (MkCgState absC2 binds2 usage2)
541 = code info_down (MkCgState AbsCNop binds usage)
546 moduleName :: FCode Module
547 moduleName (MkCgInfoDown (MkCompInfo mod_name) _ _ _) state
553 setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
554 setEndOfBlockInfo eob_info code (MkCgInfoDown c_info statics srt _) state
555 = code (MkCgInfoDown c_info statics srt eob_info) state
557 getEndOfBlockInfo :: FCode EndOfBlockInfo
558 getEndOfBlockInfo (MkCgInfoDown c_info statics _ eob_info) state
563 getSRTLabel :: FCode CLabel
564 getSRTLabel (MkCgInfoDown _ _ srt _) state
567 setSRTLabel :: CLabel -> Code -> Code
568 setSRTLabel srt code (MkCgInfoDown c_info statics _ eob_info) state
569 = code (MkCgInfoDown c_info statics srt eob_info) state