X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FCodeGen.hs;h=e606e2cf76e0149c4cc4e8c9f43a9e6e7a740e1c;hb=41147ad2a9ca84ebe66386b3b0043cb7b48ddcd8;hp=e9bbc0691b8eeca1567c4afe51ee1d4fe4ceaeb7;hpb=335b9f366ac440259318777c4c07e4fa42fbbec6;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index e9bbc06..e606e2c 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -47,7 +47,8 @@ import Platform import BasicTypes import BlockId import PprCmm ( pprExpr ) -import Cmm +import OldCmm +import OldPprCmm import CLabel import ClosureInfo ( C_SRT(..) ) @@ -58,6 +59,7 @@ import OrdList import Pretty import qualified Outputable as O import Outputable +import Unique import FastString import FastBool ( isFastTrue ) import Constants ( wORD_SIZE ) @@ -93,11 +95,10 @@ cmmTopCodeGen -> RawCmmTop -> NatM [NatCmmTop Instr] -cmmTopCodeGen dynflags - (CmmProc info lab params (ListGraph blocks)) = do +cmmTopCodeGen dynflags (CmmProc info lab (ListGraph blocks)) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks picBaseMb <- getPicBaseMaybeNat - let proc = CmmProc info lab params (ListGraph $ concat nat_blocks) + let proc = CmmProc info lab (ListGraph $ concat nat_blocks) tops = proc : concat statics os = platformOS $ targetPlatform dynflags @@ -226,12 +227,12 @@ getRegisterReg use_sse2 (CmmLocal (LocalReg u pk)) else RegVirtual (mkVirtualReg u sz) getRegisterReg _ (CmmGlobal mid) - = case get_GlobalReg_reg_or_addr mid of - Left reg -> RegReal $ reg - _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid) - -- By this stage, the only MagicIds remaining should be the - -- ones which map to a real machine register on this - -- platform. Hence ... + = case globalRegMaybe mid of + Just reg -> RegReal $ reg + Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid) + -- By this stage, the only MagicIds remaining should be the + -- ones which map to a real machine register on this + -- platform. Hence ... -- | Memory addressing modes passed up the tree. @@ -271,8 +272,8 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 -- | Convert a BlockId to some CmmStatic data jumpTableEntry :: Maybe BlockId -> CmmStatic jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth) -jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel) - where blockLabel = mkAsmTempLabel id +jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel) + where blockLabel = mkAsmTempLabel (getUnique blockid) -- ----------------------------------------------------------------------------- @@ -604,9 +605,7 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps | sse2 -> coerceFP2FP W64 x | otherwise -> conversionNop FF80 x - MO_FF_Conv W64 W32 - | sse2 -> coerceFP2FP W32 x - | otherwise -> conversionNop FF80 x + MO_FF_Conv W64 W32 -> coerceFP2FP W32 x MO_FS_Conv from to -> coerceFP2Int from to x MO_SF_Conv from to -> coerceInt2FP from to x @@ -991,11 +990,11 @@ getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)]) let off = ImmInt (-(fromInteger i)) return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) -getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)]) +getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit]) | is32BitLit lit -- ASSERT(rep == II32)??? = do (x_reg, x_code) <- getSomeReg x - let off = ImmInt (fromInteger i) + let off = litToImm lit return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be @@ -1575,7 +1574,7 @@ genCCall target dest_regs args = do return (unitOL (CALL (Left fn_imm) []), conv) where fn_imm = ImmCLbl lbl CmmCallee expr conv - -> do { (dyn_c, dyn_r) <- get_op expr + -> do { (dyn_r, dyn_c) <- getSomeReg expr ; ASSERT( isWord32 (cmmExprType expr) ) return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) } @@ -1655,13 +1654,11 @@ genCCall target dest_regs args = do DELTA (delta-8)] ) - | otherwise = do - (code, reg) <- get_op arg + | isFloatType arg_ty = do + (reg, code) <- getSomeReg arg delta <- getDeltaNat - let size = arg_size arg_ty -- Byte size setDeltaNat (delta-size) - if (isFloatType arg_ty) - then return (code `appOL` + return (code `appOL` toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp), DELTA (delta-size), let addr = AddrBaseIndex (EABaseReg esp) @@ -1674,18 +1671,18 @@ genCCall target dest_regs args = do else GST size reg addr ] ) - else return (code `snocOL` - PUSH II32 (OpReg reg) `snocOL` - DELTA (delta-size) - ) + + | otherwise = do + (operand, code) <- getOperand arg + delta <- getDeltaNat + setDeltaNat (delta-size) + return (code `snocOL` + PUSH II32 operand `snocOL` + DELTA (delta-size)) + where arg_ty = cmmExprType arg - - ------------ - get_op :: CmmExpr -> NatM (InstrBlock, Reg) -- code, reg - get_op op = do - (reg,code) <- getSomeReg op - return (code, reg) + size = arg_size arg_ty -- Byte size #elif x86_64_TARGET_ARCH @@ -1928,9 +1925,9 @@ genSwitch expr ids jumpTableEntryRel Nothing = CmmStaticLit (CmmInt 0 wordWidth) - jumpTableEntryRel (Just (BlockId id)) + jumpTableEntryRel (Just blockid) = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) - where blockLabel = mkAsmTempLabel id + where blockLabel = mkAsmTempLabel (getUnique blockid) op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0)) @@ -2258,12 +2255,14 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 -------------------------------------------------------------------------------- coerceFP2FP :: Width -> CmmExpr -> NatM Register coerceFP2FP to x = do + use_sse2 <- sse2Enabled (x_reg, x_code) <- getSomeReg x let - opc = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD + opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD + | otherwise = GDTOF code dst = x_code `snocOL` opc x_reg dst -- in - return (Any (floatSize to) code) + return (Any (if use_sse2 then floatSize to else FF80) code) --------------------------------------------------------------------------------