) where
#include "HsVersions.h"
-#include "../includes/MachRegs.h"
+#include "../includes/stg/MachRegs.h"
import BlockId
import CgMonad
import ForeignCall
import ClosureInfo
import StgSyn (SRT(..))
+import Module
import Literal
import Digraph
import ListSetOps
mkSimpleLit (MachWord64 i) = CmmInt i W64
mkSimpleLit (MachFloat r) = CmmFloat r W32
mkSimpleLit (MachDouble r) = CmmFloat r W64
-mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod)
- where
- is_dyn = False -- ToDo: fix me
+mkSimpleLit (MachLabel fs ms fod)
+ = CmmLabel (mkForeignLabel fs ms labelSrc fod)
+ where
+ -- TODO: Literal labels might not actually be in the current package...
+ labelSrc = ForeignLabelInThisPackage
mkLtOp :: Literal -> MachOp
-- On signed literals we must do a signed comparison
; labelC join_id
}
-emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
+
+-- | Emit code to call a Cmm function.
+emitRtsCall
+ :: PackageId -- ^ package the function is in
+ -> FastString -- ^ name of function
+ -> [CmmHinted CmmExpr] -- ^ function args
+ -> Bool -- ^ whether this is a safe call
+ -> Code -- ^ cmm code
+
+emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
-emitRtsCallWithVols fun args vols safe
- = emitRtsCall' [] fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols pkg fun args vols safe
+ = emitRtsCall' [] pkg fun args (Just vols) safe
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString
- -> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCallWithResult res hint fun args safe
- = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
+emitRtsCallWithResult
+ :: LocalReg -> ForeignHint
+ -> PackageId -> FastString
+ -> [CmmHinted CmmExpr] -> Bool -> Code
+emitRtsCallWithResult res hint pkg fun args safe
+ = emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
:: [CmmHinted LocalReg]
- -> LitString
+ -> PackageId
+ -> FastString
-> [CmmHinted CmmExpr]
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
-> Code
-emitRtsCall' res fun args vols safe = do
+emitRtsCall' res pkg fun args vols safe = do
safety <- if safe
then getSRTInfo >>= (return . CmmSafe)
else return CmmUnsafe
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
target = CmmCallee fun_expr CCallConv
- fun_expr = mkLblExpr (mkRtsCodeLabel fun)
+ fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
-----------------------------------------------------------------------------
--
anySrc p CmmNop = False
anySrc p other = True -- Conservative
-regUsedIn :: CmmReg -> CmmExpr -> Bool
-reg `regUsedIn` CmmLit _ = False
-reg `regUsedIn` CmmLoad e _ = reg `regUsedIn` e
-reg `regUsedIn` CmmReg reg' = reg == reg'
-reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
-reg `regUsedIn` CmmMachOp _ es = any (reg `regUsedIn`) es
-
locUsedIn :: CmmExpr -> CmmType -> CmmExpr -> Bool
-- (locUsedIn a r e) checks whether writing to r[a] could affect the value of
-- 'e'. Returns True if it's not sure.