X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=ce24fc52c94d3a83b59eeb8aabe5c06d85dd70f2;hp=79c8d69678cf94dbaf612c62e9fb10f4eabdd5e0;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=c83f6043834e171a0360bb8f456c5a57f875dc0e diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 79c8d69..ce24fc5 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -11,6 +11,13 @@ -- (c) the #if blah_TARGET_ARCH} things, the -- structure should not be too overwhelming. +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- for details + module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where #include "HsVersions.h" @@ -29,6 +36,7 @@ import PprCmm ( pprExpr ) import Cmm import MachOp import CLabel +import ClosureInfo ( C_SRT(..) ) -- The rest: import StaticFlags ( opt_PIC ) @@ -44,6 +52,7 @@ import Constants ( wORD_SIZE ) import Outputable ( assertPanic ) import Debug.Trace ( trace ) #endif +import Debug.Trace ( trace ) import Control.Monad ( mapAndUnzipM ) import Data.Maybe ( fromJust ) @@ -61,7 +70,7 @@ import Data.Int type InstrBlock = OrdList Instr -cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop] +cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop] cmmTopCodeGen (CmmProc info lab params blocks) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks picBaseMb <- getPicBaseMaybeNat @@ -119,8 +128,8 @@ stmtToInstrs stmt = case stmt of | otherwise -> assignMem_IntCode kind addr src where kind = cmmExprRep src - CmmCall target result_regs args vols - -> genCCall target result_regs args vols + CmmCall target result_regs args _ _ + -> genCCall target result_regs args CmmBranch id -> genBranch id CmmCondBranch arg id -> genCondJump id arg @@ -188,7 +197,7 @@ assignMem_I64Code addrTree valueTree = do return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) -assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do +assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree let r_dst_lo = mkVReg u_dst I32 @@ -230,7 +239,7 @@ iselExpr64 (CmmLoad addrTree I64) = do rlo ) -iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64))) +iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _))) = return (ChildCode64 nilOL (mkVReg vu I32)) -- we handle addition, but rather badly @@ -265,6 +274,17 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do -- in return (ChildCode64 code rlo) +iselExpr64 (CmmMachOp (MO_U_Conv _ I64) [expr]) = do + fn <- getAnyReg expr + r_dst_lo <- getNewRegNat I32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + code = fn r_dst_lo + return ( + ChildCode64 (code `snocOL` + MOV I32 (OpImm (ImmInt 0)) (OpReg r_dst_hi)) + r_dst_lo + ) + iselExpr64 expr = pprPanic "iselExpr64(i386)" (ppr expr) @@ -358,7 +378,7 @@ assignMem_I64Code addrTree valueTree = do -- in return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) -assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do +assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree let r_dst_lo = mkVReg u_dst I32 @@ -388,7 +408,7 @@ iselExpr64 (CmmLoad addrTree I64) = do return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rlo -iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64))) +iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _))) = return (ChildCode64 nilOL (mkVReg vu I32)) iselExpr64 (CmmLit (CmmInt i _)) = do @@ -422,6 +442,13 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do -- in return (ChildCode64 code rlo) +iselExpr64 (CmmMachOp (MO_U_Conv I32 I64) [expr]) = do + (expr_reg,expr_code) <- getSomeReg expr + (rlo, rhi) <- getNewRegPairNat I32 + let mov_hi = LI rhi (ImmInt 0) + mov_lo = MR rlo expr_reg + return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi) + rlo iselExpr64 expr = pprPanic "iselExpr64(powerpc)" (ppr expr) @@ -465,7 +492,7 @@ getSomeReg expr = do getRegisterReg :: CmmReg -> Reg -getRegisterReg (CmmLocal (LocalReg u pk)) +getRegisterReg (CmmLocal (LocalReg u pk _)) = mkVReg u pk getRegisterReg (CmmGlobal mid) @@ -766,7 +793,8 @@ getRegister leaf getRegister (CmmLit (CmmFloat f F32)) = do lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let code dst = LDATA ReadOnlyData @@ -789,7 +817,8 @@ getRegister (CmmLit (CmmFloat d F64)) | otherwise = do lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let code dst = LDATA ReadOnlyData @@ -1709,7 +1738,8 @@ getRegister (CmmLit (CmmInt i rep)) getRegister (CmmLit (CmmFloat f frep)) = do lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let code dst = LDATA ReadOnlyData [CmmDataLabel lbl, @@ -2198,6 +2228,18 @@ condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do -- return (CondCode False cond code) +-- anything vs zero, using a mask +-- TODO: Add some sanity checking!!!! +condIntCode cond (CmmMachOp (MO_And rep) [x,o2]) (CmmLit (CmmInt 0 pk)) + | (CmmLit (CmmInt mask pk2)) <- o2 + = do + (x_reg, x_code) <- getSomeReg x + let + code = x_code `snocOL` + TEST pk (OpImm (ImmInteger mask)) (OpReg x_reg) + -- + return (CondCode False cond code) + -- anything vs zero condIntCode cond x (CmmLit (CmmInt 0 pk)) = do (x_reg, x_code) <- getSomeReg x @@ -2927,9 +2969,8 @@ genCondJump id bool = do genCCall :: CmmCallTarget -- function to call - -> [(CmmReg,MachHint)] -- where to put the result - -> [(CmmExpr,MachHint)] -- arguments (of mixed type) - -> Maybe [GlobalReg] -- volatile regs to save + -> CmmHintFormals -- where to put the result + -> CmmActuals -- arguments (of mixed type) -> NatM InstrBlock -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -3008,12 +3049,12 @@ genCCall fn cconv result_regs args #if i386_TARGET_ARCH -genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL +genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- write barrier compiles to no code on x86/x86-64; -- we keep it this long in order to prevent earlier optimisations. -- we only cope with a single result for foreign calls -genCCall (CmmPrim op) [(r,_)] args vols = do +genCCall (CmmPrim op) [(r,_)] args = do case op of MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args @@ -3027,14 +3068,14 @@ genCCall (CmmPrim op) [(r,_)] args vols = do MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args - other_op -> outOfLineFloatOp op r args vols + other_op -> outOfLineFloatOp op r args where actuallyInlineFloatOp rep instr [(x,_)] = do res <- trivialUFCode rep instr x any <- anyReg res - return (any (getRegisterReg r)) + return (any (getRegisterReg (CmmLocal r))) -genCCall target dest_regs args vols = do +genCCall target dest_regs args = do let sizes = map (arg_size . cmmExprRep . fst) (reverse args) #if !darwin_TARGET_OS @@ -3055,11 +3096,11 @@ genCCall target dest_regs args vols = do (callinsns,cconv) <- case target of -- CmmPrim -> ... - CmmForeignCall (CmmLit (CmmLabel lbl)) conv + CmmCallee (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes return (unitOL (CALL (Left fn_imm) []), conv) where fn_imm = ImmCLbl lbl - CmmForeignCall expr conv + CmmCallee expr conv -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr ASSERT(dyn_rep == I32) return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) @@ -3097,8 +3138,8 @@ genCCall target dest_regs args vols = do rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest)) where r_dest_hi = getHiVRegFromLo r_dest - rep = cmmRegRep dest - r_dest = getRegisterReg dest + rep = localRegRep dest + r_dest = getRegisterReg (CmmLocal dest) assign_code many = panic "genCCall.assign_code many" return (push_code `appOL` @@ -3162,23 +3203,24 @@ genCCall target dest_regs args vols = do #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)] - -> Maybe [GlobalReg] -> NatM InstrBlock -outOfLineFloatOp mop res args vols +outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals + -> NatM InstrBlock +outOfLineFloatOp mop res args = do - targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl - let target = CmmForeignCall targetExpr CCallConv + dflags <- getDynFlagsNat + targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl + let target = CmmCallee targetExpr CCallConv - if cmmRegRep res == F64 + if localRegRep res == F64 then - stmtToInstrs (CmmCall target [(res,FloatHint)] args vols) + stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn) else do uq <- getUniqueNat let - tmp = CmmLocal (LocalReg uq F64) + tmp = LocalReg uq F64 KindNonPtr -- in - code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols) - code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp)) + code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn) + code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where lbl = mkForeignLabel fn Nothing False @@ -3222,14 +3264,14 @@ outOfLineFloatOp mop res args vols #if x86_64_TARGET_ARCH -genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL +genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- write barrier compiles to no code on x86/x86-64; -- we keep it this long in order to prevent earlier optimisations. -genCCall (CmmPrim op) [(r,_)] args vols = - outOfLineFloatOp op r args vols +genCCall (CmmPrim op) [(r,_)] args = + outOfLineFloatOp op r args -genCCall target dest_regs args vols = do +genCCall target dest_regs args = do -- load up the register arguments (stack_args, aregs, fregs, load_args_code) @@ -3272,11 +3314,11 @@ genCCall target dest_regs args vols = do (callinsns,cconv) <- case target of -- CmmPrim -> ... - CmmForeignCall (CmmLit (CmmLabel lbl)) conv + CmmCallee (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes return (unitOL (CALL (Left fn_imm) arg_regs), conv) where fn_imm = ImmCLbl lbl - CmmForeignCall expr conv + CmmCallee expr conv -> do (dyn_r, dyn_c) <- getSomeReg expr return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv) @@ -3312,8 +3354,8 @@ genCCall target dest_regs args vols = do F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest)) rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest)) where - rep = cmmRegRep dest - r_dest = getRegisterReg dest + rep = localRegRep dest + r_dest = getRegisterReg (CmmLocal dest) assign_code many = panic "genCCall.assign_code many" return (load_args_code `appOL` @@ -3415,7 +3457,7 @@ genCCall target dest_regs args vols = do stack only immediately prior to the call proper. Sigh. -} -genCCall target dest_regs argsAndHints vols = do +genCCall target dest_regs argsAndHints = do let args = map fst argsAndHints argcode_and_vregs <- mapM arg_to_int_vregs args @@ -3426,9 +3468,9 @@ genCCall target dest_regs argsAndHints vols = do vregs = concat vregss -- deal with static vs dynamic call targets callinsns <- (case target of - CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do + CmmCallee (CmmLit (CmmLabel lbl)) conv -> do return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False)) - CmmForeignCall expr conv -> do + CmmCallee expr conv -> do (dyn_c, [dyn_r]) <- arg_to_int_vregs expr return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False) CmmPrim mop -> do @@ -3522,7 +3564,8 @@ genCCall target dest_regs argsAndHints vols = do ) outOfLineFloatOp mop = do - mopExpr <- cmmMakeDynamicReference addImportNat CallReference $ + dflags <- getDynFlagsNat + mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $ mkForeignLabel functionName Nothing True let mopLabelOrExpr = case mopExpr of CmmLit (CmmLabel lbl) -> Left lbl @@ -3608,10 +3651,10 @@ outOfLineFloatOp mop = -} -genCCall (CmmPrim MO_WriteBarrier) _ _ _ +genCCall (CmmPrim MO_WriteBarrier) _ _ = return $ unitOL LWSYNC -genCCall target dest_regs argsAndHints vols +genCCall target dest_regs argsAndHints = ASSERT (not $ any (`elem` [I8,I16]) argReps) -- we rely on argument promotion in the codeGen do @@ -3622,8 +3665,8 @@ genCCall target dest_regs argsAndHints vols (toOL []) [] (labelOrExpr, reduceToF32) <- case target of - CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False) - CmmForeignCall expr conv -> return (Right expr, False) + CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False) + CmmCallee expr conv -> return (Right expr, False) CmmPrim mop -> outOfLineFloatOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode @@ -3772,12 +3815,13 @@ genCCall target dest_regs argsAndHints vols | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3, MR r_dest r4] | otherwise -> unitOL (MR r_dest r3) - where rep = cmmRegRep dest - r_dest = getRegisterReg dest + where rep = cmmRegRep (CmmLocal dest) + r_dest = getRegisterReg (CmmLocal dest) outOfLineFloatOp mop = do - mopExpr <- cmmMakeDynamicReference addImportNat CallReference $ + dflags <- getDynFlagsNat + mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $ mkForeignLabel functionName Nothing True let mopLabelOrExpr = case mopExpr of CmmLit (CmmLabel lbl) -> Left lbl @@ -3837,7 +3881,8 @@ genSwitch expr ids = do (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let jumpTable = map jumpTableEntryRel ids @@ -3891,7 +3936,8 @@ genSwitch expr ids (reg,e_code) <- getSomeReg expr tmp <- getNewRegNat I32 lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let jumpTable = map jumpTableEntryRel ids @@ -4732,7 +4778,8 @@ coerceInt2FP fromRep toRep x = do lbl <- getNewLabelNat itmp <- getNewRegNat I32 ftmp <- getNewRegNat F64 - dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl + dflags <- getDynFlagsNat + dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let code' dst = code `appOL` maybe_exts `appOL` toOL [