module CgUtils (
addIdReps,
cgLit,
- emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
+ emitDataLits, mkDataLits,
+ emitRODataLits, mkRODataLits,
+ emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
assignNonPtrTemp, newNonPtrTemp,
assignPtrTemp, newPtrTemp,
; labelC join_id
}
-emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Code
-emitRtsCall fun args = emitRtsCall' [] fun args Nothing
+emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Bool -> Code
+emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Code
-emitRtsCallWithVols fun args vols
- = emitRtsCall' [] fun args (Just vols)
+emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols fun args vols safe
+ = emitRtsCall' [] fun args (Just vols) safe
emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
- -> [(CmmExpr,MachHint)] -> Code
-emitRtsCallWithResult res hint fun args
- = emitRtsCall' [(res,hint)] fun args Nothing
+ -> [(CmmExpr,MachHint)] -> Bool -> Code
+emitRtsCallWithResult res hint fun args safe
+ = emitRtsCall' [(res,hint)] fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
-> LitString
-> [(CmmExpr,MachHint)]
-> Maybe [GlobalReg]
+ -> Bool -- True <=> CmmSafe call
-> Code
-emitRtsCall' res fun args vols = do
- srt <- getSRTInfo
- stmtsC caller_save
- stmtC (CmmCall target res args srt)
- stmtsC caller_load
+emitRtsCall' res fun args vols safe = do
+ safety <- if safe
+ then getSRTInfo >>= (return . CmmSafe)
+ else return CmmUnsafe
+ stmtsC caller_save
+ stmtC (CmmCall target res args safety)
+ stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
target = CmmForeignCall fun_expr CCallConv
emitDataLits lbl lits
= emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+-- Emit a data-segment data block
+mkDataLits lbl lits
+ = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+
emitRODataLits :: CLabel -> [CmmLit] -> Code
-- Emit a read-only data block
emitRODataLits lbl lits
needsRelocation (CmmLabelOff _ _) = True
needsRelocation _ = False
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits lbl lits
+ = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
+ where section | any needsRelocation lits = RelocatableReadOnlyData
+ | otherwise = ReadOnlyData
+ needsRelocation (CmmLabel _) = True
+ needsRelocation (CmmLabelOff _ _) = True
+ needsRelocation _ = False
+
mkStringCLit :: String -> FCode CmmLit
-- Make a global definition for the string,
-- and return its label