nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
nativeCodeGen dflags cmms us
- = let ((ppr_cmms, insn_sdoc, imports), _) = initUs us $
+ = let (res, _) = initUs us $
cgCmm (concat (map add_split cmms))
cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
cgCmm tops =
lazyMapUs (cmmNativeGen dflags) tops `thenUs` \ results ->
- let (cmms,docs,imps) = unzip3 results in
+ case unzip3 results of { (cmms,docs,imps) ->
returnUs (Cmm cmms, my_vcat docs, concat imps)
- in do
+ }
+ in
+ case res of { (ppr_cmms, insn_sdoc, imports) -> do
dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms])
return (insn_sdoc Pretty.$$ dyld_stubs imports
#if HAVE_SUBSECTIONS_VIA_SYMBOLS
Pretty.$$ Pretty.text ".subsections_via_symbols"
#endif
)
+ }
where
fixAssign (CmmCall target results args vols)
= mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
- returnUs (CmmCall target results' args vols : concat stores)
+ returnUs (caller_save ++
+ CmmCall target results' args vols :
+ caller_restore ++
+ concat stores)
where
+ -- we also save/restore any caller-saves STG registers here
+ (caller_save, caller_restore) = callerSaveVolatileRegs vols
+
fixResult g@(CmmGlobal reg,hint) =
case get_GlobalReg_reg_or_addr reg of
Left realreg -> returnUs (g, [])
-- "from" type, in order to truncate to the correct size.
-- The final narrow/widen to the destination type
-- is implicit in the CmmLit.
- MO_S_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
+ MO_S_Conv from to
+ | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
+ | otherwise -> CmmLit (CmmInt (narrowS from x) to)
MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
- _ -> panic "cmmMachOpFold: unknown unary op"
+
+ _ -> panic "cmmMachOpFold: unknown unary op"
+
-- Eliminate conversion NOPs
cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
| otherwise ->
CmmMachOp conv_outer args
where
- isIntConversion (MO_U_Conv rep1 rep2) = Just (rep1,rep2,False)
- isIntConversion (MO_S_Conv rep1 rep2) = Just (rep1,rep2,True)
+ isIntConversion (MO_U_Conv rep1 rep2)
+ | not (isFloatingRep rep1) && not (isFloatingRep rep2)
+ = Just (rep1,rep2,False)
+ isIntConversion (MO_S_Conv rep1 rep2)
+ | not (isFloatingRep rep1) && not (isFloatingRep rep2)
+ = Just (rep1,rep2,True)
isIntConversion _ = Nothing
-
+
intconv True = MO_S_Conv
intconv False = MO_U_Conv