) where
#include "HsVersions.h"
-#include "MachRegs.h"
+#include "../includes/stg/MachRegs.h"
import StgCmmMonad
import StgCmmClosure
import BlockId
import Cmm
-import CmmExpr
import MkZipCfgCmm
-import ZipCfg hiding (last, unzip, zip)
import CLabel
import CmmUtils
import PprCmm ( {- instances -} )
--
-------------------------------------------------------------------------
-emitRtsCall :: LitString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
+emitRtsCall :: FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: LitString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
+emitRtsCallWithVols :: FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
emitRtsCallWithVols fun args vols safe
= emitRtsCall' [] fun args (Just vols) safe
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString
-> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCallWithResult res hint fun args safe
= emitRtsCall' [(res,hint)] fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
:: [(LocalReg,ForeignHint)]
- -> LitString
+ -> FastString
-> [(CmmExpr,ForeignHint)]
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
where
call updfr_off =
if safe then
- mkCall fun_expr Native res' args' updfr_off
+ mkCmmCall fun_expr res' args' updfr_off
else
mkUnsafeCall (ForeignTarget fun_expr
(ForeignConvention CCallConv arg_hints res_hints)) res' args'
mk_switch tag_expr' (sortLe le branches) mb_deflt
lo_tag hi_tag via_C
-- Sort the branches before calling mk_switch
- <*> mkLabel join_lbl emptyStackInfo
+ <*> mkLabel join_lbl
where
(t1,_) `le` (t2,_) = t1 <= t2
label_code join_lbl deflt $ \ deflt ->
label_branches join_lbl branches $ \ branches ->
mk_lit_switch scrut' deflt (sortLe le branches)
- <*> mkLabel join_lbl emptyStackInfo
+ <*> mkLabel join_lbl
where
le (t1,_) (t2,_) = t1 <= t2
-- [L: code; goto J] fun L
label_code join_lbl code thing_inside
= withFreshLabel "switch" $ \lbl ->
- outOfLine (mkLabel lbl emptyStackInfo <*> code <*> mkBranch join_lbl)
+ outOfLine (mkLabel lbl <*> code <*> mkBranch join_lbl)
<*> thing_inside lbl