Commit 309f64a0 authored by dias@eecs.harvard.edu's avatar dias@eecs.harvard.edu

Don't adjust hp up when the case scrutinee won't allocate

If the case scrutinee can't allocate, we don't need to do a heap
check in the case alternatives. (A previous patch got that right.)
In that case, we had better not adjust the heap pointer to recover
unused stack space before evaluating the scrutinee -- because we
aren't going to reallocate for the case alternative.
parent 93d047a1
......@@ -273,15 +273,15 @@ cgCase scrut bndr srt alt_type alts
; let ret_bndrs = chooseReturnBndrs bndr alt_type alts
alt_regs = map idToReg ret_bndrs
simple_scrut = isSimpleScrut scrut alt_type
gc_plan | not simple_scrut = GcInAlts alt_regs srt
| isSingleton alts = NoGcInAlts
| up_hp_usg > 0 = NoGcInAlts
| otherwise = GcInAlts alt_regs srt
gcInAlts | not simple_scrut = True
| isSingleton alts = False
| up_hp_usg > 0 = False
| otherwise = True
gc_plan = if gcInAlts then GcInAlts alt_regs srt else NoGcInAlts
; mb_cc <- maybeSaveCostCentre simple_scrut
; c_srt <- getSRTInfo srt
; withSequel (AssignTo alt_regs c_srt)
(cgExpr scrut)
; withSequel (AssignTo alt_regs gcInAlts) (cgExpr scrut)
; restoreCurrentCostCentre mb_cc
; bindArgsToRegs ret_bndrs
......
......@@ -77,14 +77,18 @@ emitReturn :: [CmmExpr] -> FCode ()
-- return (x,y)
-- If the sequel is AssignTo [p,q]
-- p=x; q=y;
emitReturn results
= do { adjustHpBackwards
; sequel <- getSequel;
; updfr_off <- getUpdFrameOff
; case sequel of
Return _ -> emit (mkReturnSimple results updfr_off)
AssignTo regs _ -> emit (mkMultiAssign regs results)
}
emitReturn results
= do { sequel <- getSequel;
; updfr_off <- getUpdFrameOff
; emit $ mkComment $ mkFastString "emitReturn"
; case sequel of
Return _ ->
do { adjustHpBackwards
; emit (mkReturnSimple results updfr_off) }
AssignTo regs adjust ->
do { if adjust then adjustHpBackwards else return ()
; emit (mkMultiAssign regs results) }
}
emitCall :: Convention -> CmmExpr -> [CmmExpr] -> FCode ()
-- (cgCall fun args) makes a call to the entry-code of 'fun',
......@@ -93,10 +97,10 @@ emitCall conv fun args
= do { adjustHpBackwards
; sequel <- getSequel
; updfr_off <- getUpdFrameOff
; emit $ mkComment $ mkFastString "emitcall"
; emit $ mkComment $ mkFastString "emitCall"
; case sequel of
Return _ -> emit (mkForeignJump conv fun args updfr_off)
AssignTo res_regs srt -> emit (mkCall fun conv res_regs args updfr_off)
Return _ -> emit (mkForeignJump conv fun args updfr_off)
AssignTo res_regs _ -> emit (mkCall fun conv res_regs args updfr_off)
}
adjustHpBackwards :: FCode ()
......@@ -165,7 +169,7 @@ direct_call caller lbl arity args reps
; let srt = pprTrace "Urk! SRT for over-sat call"
(ppr lbl) NoC_SRT
-- XXX: what if rest_args contains static refs?
; withSequel (AssignTo [pap_id] srt)
; withSequel (AssignTo [pap_id] True)
(emitCall Native target fast_args)
; slow_call (CmmReg (CmmLocal pap_id))
rest_args rest_reps }
......
......@@ -209,12 +209,10 @@ data Sequel
| AssignTo
[LocalReg] -- Put result(s) in these regs and fall through
-- NB: no void arguments here
C_SRT -- Here are the statics live in the continuation
-- E.g. case (case x# of 0# -> a; DEFAULT -> b) of {
-- r -> <blah>
-- When compiling the nested case, remember to put the
-- result in r, and fall through
Bool -- Should we adjust the heap pointer back to recover
-- space that's unused on this path?
-- We need to do this only if the expression may
-- allocate (e.g. it's a foreign call or allocating primOp)
initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
initCgInfoDown dflags mod
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment