X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=c4943107a6a33681988b7bddc9411359d78e5e9c;hb=dbc0a8f9177695592f960cc6dbd00c5e6f061e3f;hp=4d96bb0a2f30e9d1e1ec57442bb33061c22ba03e;hpb=52f600c8ea0bf0d9b4c01570e80d70bfa65c43ba;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 4d96bb0..c494310 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -32,6 +32,7 @@ import PositionIndependentCode import RegAllocInfo ( mkBranchInstr ) -- Our intermediate code: +import BlockId import PprCmm ( pprExpr ) import Cmm import MachOp @@ -131,6 +132,8 @@ stmtToInstrs stmt = case stmt of CmmCondBranch arg id -> genCondJump id arg CmmSwitch arg ids -> genSwitch arg ids CmmJump arg params -> genJump arg + CmmReturn params -> + panic "stmtToInstrs: return statement should have been cps'd away" -- ----------------------------------------------------------------------------- -- General things for putting together code sequences @@ -1200,13 +1203,13 @@ getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps -------------------- add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register add_code rep x (CmmLit (CmmInt y _)) - | not (is64BitInteger y) = add_int rep x y + | is32BitInteger y = add_int rep x y add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y -------------------- sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register sub_code rep x (CmmLit (CmmInt y _)) - | not (is64BitInteger (-y)) = add_int rep x (-y) + | is32BitInteger (-y) = add_int rep x (-y) sub_code rep x y = trivialCode rep (SUB rep) Nothing x y -- our three-operand add instruction: @@ -1304,7 +1307,7 @@ getRegister (CmmLit lit) where isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff isBigLit _ = False - -- note1: not the same as is64BitLit, because that checks for + -- note1: not the same as (not.is32BitLit), because that checks for -- signed literals that fit in 32 bits, but we want unsigned -- literals here. -- note2: all labels are small, because we're assuming the @@ -1846,14 +1849,14 @@ getAmode (CmmMachOp (MO_Add I64) [CmmReg (CmmGlobal PicBaseReg), -- This is all just ridiculous, since it carefully undoes -- what mangleIndexTree has just done. getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)]) - | not (is64BitLit lit) + | is32BitLit lit -- ASSERT(rep == I32)??? = do (x_reg, x_code) <- getSomeReg x 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 _)]) - | not (is64BitLit lit) + | is32BitLit lit -- ASSERT(rep == I32)??? = do (x_reg, x_code) <- getSomeReg x let off = ImmInt (fromInteger i) @@ -1875,13 +1878,13 @@ getAmode (CmmMachOp (MO_Add rep) [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]]) | shift == 0 || shift == 1 || shift == 2 || shift == 3 - && not (is64BitInteger offset) + && is32BitInteger offset = x86_complex_amode x y shift offset getAmode (CmmMachOp (MO_Add rep) [x,y]) = x86_complex_amode x y 0 0 -getAmode (CmmLit lit) | not (is64BitLit lit) +getAmode (CmmLit lit) | is32BitLit lit = return (Amode (ImmAddr (litToImm lit) 0) nilOL) getAmode expr = do @@ -2016,7 +2019,7 @@ getNonClobberedOperand (CmmLit lit) return (OpAddr (ripRel (ImmCLbl lbl)), code) #endif getNonClobberedOperand (CmmLit lit) - | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = + | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) = return (OpImm (litToImm lit), nilOL) getNonClobberedOperand (CmmLoad mem pk) | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do @@ -2052,7 +2055,7 @@ getOperand (CmmLit lit) return (OpAddr (ripRel (ImmCLbl lbl)), code) #endif getOperand (CmmLit lit) - | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do + | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) = do return (OpImm (litToImm lit), nilOL) getOperand (CmmLoad mem pk) | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do @@ -2064,7 +2067,7 @@ getOperand e = do isOperand :: CmmExpr -> Bool isOperand (CmmLoad _ _) = True -isOperand (CmmLit lit) = not (is64BitLit lit) +isOperand (CmmLit lit) = is32BitLit lit || isSuitableFloatingPointLit lit isOperand _ = False @@ -2085,15 +2088,15 @@ getRegOrMem e = do return (OpReg reg, code) #if x86_64_TARGET_ARCH -is64BitLit (CmmInt i I64) = is64BitInteger i +is32BitLit (CmmInt i I64) = is32BitInteger i -- assume that labels are in the range 0-2^31-1: this assumes the -- small memory model (see gcc docs, -mcmodel=small). #endif -is64BitLit x = False +is32BitLit x = False #endif -is64BitInteger :: Integer -> Bool -is64BitInteger i = i64 > 0x7fffffff || i64 < -0x80000000 +is32BitInteger :: Integer -> Bool +is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 where i64 = fromIntegral i :: Int64 -- a CmmInt is intended to be truncated to the appropriate -- number of bits, so here we truncate it to Int64. This is @@ -2214,7 +2217,7 @@ condFltCode = panic "MachCode.condFltCode: not on Alphas" #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -- memory vs immediate -condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do +condIntCode cond (CmmLoad x pk) (CmmLit lit) | is32BitLit lit = do Amode x_addr x_code <- getAmode x let imm = litToImm lit @@ -2438,7 +2441,7 @@ assignIntCode pk dst src -- address. assignMem_IntCode pk addr (CmmMachOp op [CmmLoad addr2 _, CmmLit (CmmInt i _)]) - | addr == addr2, pk /= I64 || not (is64BitInteger i), + | addr == addr2, pk /= I64 || is32BitInteger i, Just instr <- check op = do Amode amode code_addr <- getAmode addr let code = code_addr `snocOL` @@ -2466,7 +2469,7 @@ assignMem_IntCode pk addr src = do return code where get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator - get_op_RI (CmmLit lit) | not (is64BitLit lit) + get_op_RI (CmmLit lit) | is32BitLit lit = return (nilOL, OpImm (litToImm lit)) get_op_RI op = do (reg,code) <- getNonClobberedReg op @@ -3049,30 +3052,32 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- we keep it this long in order to prevent earlier optimisations. -- we only cope with a single result for foreign calls -genCCall (CmmPrim op) [CmmHinted r _] args = do +genCCall (CmmPrim op) [CmmKinded r _] args = do + l1 <- getNewLabelNat + l2 <- getNewLabelNat case op of MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args - MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32) args - MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64) args + MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32 l1 l2) args + MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64 l1 l2) args - MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32) args - MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64) args + MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32 l1 l2) args + MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64 l1 l2) args - MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args - MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args + MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32 l1 l2) args + MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64 l1 l2) args other_op -> outOfLineFloatOp op r args where - actuallyInlineFloatOp rep instr [CmmHinted x _] + actuallyInlineFloatOp rep instr [CmmKinded x _] = do res <- trivialUFCode rep instr x any <- anyReg res return (any (getRegisterReg (CmmLocal r))) genCCall target dest_regs args = do let - sizes = map (arg_size . cmmExprRep . hintlessCmm) (reverse args) + sizes = map (arg_size . cmmExprRep . kindlessCmm) (reverse args) #if !darwin_TARGET_OS tot_arg_size = sum sizes #else @@ -3124,7 +3129,7 @@ genCCall target dest_regs args = do let -- assign the results, if necessary assign_code [] = nilOL - assign_code [CmmHinted dest _hint] = + assign_code [CmmKinded dest _hint] = case rep of I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest), MOV I32 (OpReg edx) (OpReg r_dest_hi)] @@ -3151,10 +3156,10 @@ genCCall target dest_regs args = do | otherwise = x + a - (x `mod` a) - push_arg :: (CmmHinted CmmExpr){-current argument-} + push_arg :: (CmmKinded CmmExpr){-current argument-} -> NatM InstrBlock -- code - push_arg (CmmHinted arg _hint) -- we don't need the hints on x86 + push_arg (CmmKinded arg _hint) -- we don't need the hints on x86 | arg_rep == I64 = do ChildCode64 code r_lo <- iselExpr64 arg delta <- getDeltaNat @@ -3208,13 +3213,13 @@ outOfLineFloatOp mop res args if localRegRep res == F64 then - stmtToInstrs (CmmCall target [CmmHinted res FloatHint] args CmmUnsafe CmmMayReturn) + stmtToInstrs (CmmCall target [CmmKinded res FloatHint] args CmmUnsafe CmmMayReturn) else do uq <- getUniqueNat let tmp = LocalReg uq F64 GCKindNonPtr -- in - code1 <- stmtToInstrs (CmmCall target [CmmHinted tmp FloatHint] args CmmUnsafe CmmMayReturn) + code1 <- stmtToInstrs (CmmCall target [CmmKinded tmp FloatHint] args CmmUnsafe CmmMayReturn) code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where @@ -3264,7 +3269,7 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genCCall (CmmPrim op) [CmmHinted r _] args = +genCCall (CmmPrim op) [CmmKinded r _] args = outOfLineFloatOp op r args genCCall target dest_regs args = do @@ -3344,7 +3349,7 @@ genCCall target dest_regs args = do let -- assign the results, if necessary assign_code [] = nilOL - assign_code [CmmHinted dest _hint] = + assign_code [CmmKinded dest _hint] = case rep of F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest)) F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest)) @@ -3364,16 +3369,16 @@ genCCall target dest_regs args = do where arg_size = 8 -- always, at the mo - load_args :: [CmmHinted CmmExpr] + load_args :: [CmmKinded CmmExpr] -> [Reg] -- int regs avail for args -> [Reg] -- FP regs avail for args -> InstrBlock - -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock) + -> NatM ([CmmKinded CmmExpr],[Reg],[Reg],InstrBlock) load_args args [] [] code = return (args, [], [], code) -- no more regs to use load_args [] aregs fregs code = return ([], aregs, fregs, code) -- no more args to push - load_args ((CmmHinted arg hint) : rest) aregs fregs code + load_args ((CmmKinded arg hint) : rest) aregs fregs code | isFloatingRep arg_rep = case fregs of [] -> push_this_arg @@ -3391,10 +3396,10 @@ genCCall target dest_regs args = do push_this_arg = do (args',ars,frs,code') <- load_args rest aregs fregs code - return ((CmmHinted arg hint):args', ars, frs, code') + return ((CmmKinded arg hint):args', ars, frs, code') push_args [] code = return code - push_args ((CmmHinted arg hint):rest) code + push_args ((CmmKinded arg hint):rest) code | isFloatingRep arg_rep = do (arg_reg, arg_code) <- getSomeReg arg delta <- getDeltaNat @@ -3455,7 +3460,7 @@ genCCall target dest_regs args = do genCCall target dest_regs argsAndHints = do let - args = map hintlessCmm argsAndHints + args = map kindlessCmm argsAndHints argcode_and_vregs <- mapM arg_to_int_vregs args let (argcodes, vregss) = unzip argcode_and_vregs @@ -3690,7 +3695,7 @@ genCCall target dest_regs argsAndHints initialStackOffset = 8 stackDelta finalStack = roundTo 16 finalStack #endif - args = map hintlessCmm argsAndHints + args = map kindlessCmm argsAndHints argReps = map cmmExprRep args roundTo a x | x `mod` a == 0 = x @@ -3805,7 +3810,7 @@ genCCall target dest_regs argsAndHints moveResult reduceToF32 = case dest_regs of [] -> nilOL - [CmmHinted dest _hint] + [CmmKinded dest _hint] | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1) | rep == F32 || rep == F64 -> unitOL (MR r_dest f1) | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3, @@ -4406,7 +4411,7 @@ SDM's version of The Rules: -} trivialCode rep instr (Just revinstr) (CmmLit lit_a) b - | not (is64BitLit lit_a) = do + | is32BitLit lit_a = do b_code <- getAnyReg b let code dst