X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FCodeGen.hs;h=a6cc36fcb76743cec53f8f924a242f108943d37f;hb=5fb59c02d3829cdd88cb2180237aba4ea4a2f66a;hp=44311a418643c6a3fb815133089b01ca8dfb9d14;hpb=889c084e943779e76d19f2ef5e970ff655f511eb;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 44311a4..a6cc36f 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -20,6 +20,7 @@ module X86.CodeGen ( cmmTopCodeGen, + generateJumpTableForInstr, InstrBlock ) @@ -431,7 +432,7 @@ getRegister (CmmReg reg) size | not use_sse2 && isFloatSize sz = FF80 | otherwise = sz -- - return (Fixed sz (getRegisterReg use_sse2 reg) nilOL) + return (Fixed size (getRegisterReg use_sse2 reg) nilOL) getRegister tree@(CmmRegOff _ _) @@ -605,9 +606,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 @@ -1589,12 +1588,24 @@ genCCall target dest_regs args = do | otherwise #endif = concatOL push_codes + + -- Deallocate parameters after call for ccall; + -- but not for stdcall (callee does it) + -- + -- We have to pop any stack padding we added + -- on Darwin even if we are doing stdcall, though (#5052) + pop_size | cconv /= StdCallConv = tot_arg_size + | otherwise +#if darwin_TARGET_OS + = arg_pad_size +#else + = 0 +#endif + call = callinsns `appOL` toOL ( - -- Deallocate parameters after call for ccall; - -- but not for stdcall (callee does it) - (if cconv == StdCallConv || tot_arg_size==0 then [] else - [ADD II32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)]) + (if pop_size==0 then [] else + [ADD II32 (OpImm (ImmInt pop_size)) (OpReg esp)]) ++ [DELTA (delta + tot_arg_size)] ) @@ -1922,16 +1933,7 @@ genSwitch expr ids dflags <- getDynFlagsNat dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef - let - jumpTable = map jumpTableEntryRel ids - - jumpTableEntryRel Nothing - = CmmStaticLit (CmmInt 0 wordWidth) - jumpTableEntryRel (Just blockid) - = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) - where blockLabel = mkAsmTempLabel (getUnique blockid) - - op = OpAddr (AddrBaseIndex (EABaseReg tableReg) + let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0)) #if x86_64_TARGET_ARCH @@ -1944,8 +1946,7 @@ genSwitch expr ids code = e_code `appOL` t_code `appOL` toOL [ ADD (intSize wordWidth) op (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ], - LDATA Text (CmmDataLabel lbl : jumpTable) + JMP_TBL (OpReg tableReg) ids Text lbl ] #else -- HACK: On x86_64 binutils<2.17 is only able to generate PC32 @@ -1955,20 +1956,18 @@ genSwitch expr ids -- conjunction with the hack in PprMach.hs/pprDataItem once -- binutils 2.17 is standard. code = e_code `appOL` t_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), MOVSxL II32 (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0))) (OpReg reg), ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ] + JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] #endif #else code = e_code `appOL` t_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), ADD (intSize wordWidth) op (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ] + JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] #endif return code @@ -1977,15 +1976,28 @@ genSwitch expr ids (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat let - jumpTable = map jumpTableEntry ids op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) code = e_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), - JMP_TBL op [ id | Just id <- ids ] + JMP_TBL op ids ReadOnlyData lbl ] -- in return code +generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr) +generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl) +generateJumpTableForInstr _ = Nothing + +createJumpTable ids section lbl + = let jumpTable + | opt_PIC = + let jumpTableEntryRel Nothing + = CmmStaticLit (CmmInt 0 wordWidth) + jumpTableEntryRel (Just blockid) + = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) + where blockLabel = mkAsmTempLabel (getUnique blockid) + in map jumpTableEntryRel ids + | otherwise = map jumpTableEntry ids + in CmmData section (CmmDataLabel lbl : jumpTable) -- ----------------------------------------------------------------------------- -- 'condIntReg' and 'condFltReg': condition codes into registers @@ -2257,12 +2269,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) --------------------------------------------------------------------------------