X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=7108c480bfdb2b910fc10b75db3cb040833af6af;hb=97169c5dd31537b28f5f8ad08cd6cdf82c1ecefd;hp=b29b59e8bbc69fe167fbf1f81e9a324f32ce5f05;hpb=6e1e37433632160a73d30ad785476a1ef0ba14a8;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index b29b59e..7108c48 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -1,3 +1,10 @@ +{-# 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/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Generating machine code (instruction selection) @@ -42,8 +49,10 @@ import FastTypes ( isFastTrue ) import Constants ( wORD_SIZE ) #ifdef DEBUG +import Outputable ( assertPanic ) import Debug.Trace ( trace ) #endif +import Debug.Trace ( trace ) import Control.Monad ( mapAndUnzipM ) import Data.Maybe ( fromJust ) @@ -62,10 +71,10 @@ import Data.Int type InstrBlock = OrdList Instr cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop] -cmmTopCodeGen (CmmProc info lab params blocks) = do +cmmTopCodeGen (CmmProc info lab params (ListGraph blocks)) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks picBaseMb <- getPicBaseMaybeNat - let proc = CmmProc info lab params (concat nat_blocks) + let proc = CmmProc info lab params (ListGraph $ concat nat_blocks) tops = proc : concat statics case picBaseMb of Just picBase -> initializePicBase picBase tops @@ -119,7 +128,7 @@ stmtToInstrs stmt = case stmt of | otherwise -> assignMem_IntCode kind addr src where kind = cmmExprRep src - CmmCall target result_regs args _ + CmmCall target result_regs args _ _ -> genCCall target result_regs args CmmBranch id -> genBranch id @@ -433,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) @@ -777,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 @@ -800,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 @@ -1720,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, @@ -2209,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 @@ -2938,7 +2969,7 @@ genCondJump id bool = do genCCall :: CmmCallTarget -- function to call - -> CmmHintFormals -- where to put the result + -> CmmFormals -- where to put the result -> CmmActuals -- arguments (of mixed type) -> NatM InstrBlock @@ -3065,11 +3096,11 @@ genCCall target dest_regs args = 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) @@ -3172,22 +3203,23 @@ genCCall target dest_regs args = do #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals +outOfLineFloatOp :: CallishMachOp -> CmmFormalWithoutKind -> 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 localRegRep res == F64 then - stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe) + stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn) else do uq <- getUniqueNat let - tmp = LocalReg uq F64 KindNonPtr + tmp = LocalReg uq F64 GCKindNonPtr -- in - code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe) + code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn) code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where @@ -3282,11 +3314,11 @@ genCCall target dest_regs args = 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) @@ -3436,9 +3468,9 @@ genCCall target dest_regs argsAndHints = 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 @@ -3532,7 +3564,8 @@ genCCall target dest_regs argsAndHints = 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 @@ -3632,8 +3665,8 @@ genCCall target dest_regs argsAndHints (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 @@ -3787,7 +3820,8 @@ genCCall target dest_regs argsAndHints 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 @@ -3847,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 @@ -3861,7 +3896,8 @@ genSwitch expr ids op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0)) -#if x86_64_TARGET_ARCH && darwin_TARGET_OS +#if x86_64_TARGET_ARCH +#if darwin_TARGET_OS -- on Mac OS X/x86_64, put the jump table in the text section -- to work around a limitation of the linker. -- ld64 is unable to handle the relocations for @@ -3874,6 +3910,23 @@ genSwitch expr ids LDATA Text (CmmDataLabel lbl : jumpTable) ] #else + -- HACK: On x86_64 binutils<2.17 is only able to generate PC32 + -- relocations, hence we only get 32-bit offsets in the jump + -- table. As these offsets are always negative we need to properly + -- sign extend them to 64-bit. This hack should be removed in + -- 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 I32 + (OpAddr (AddrBaseIndex (EABaseReg tableReg) + (EAIndex reg wORD_SIZE) (ImmInt 0))) + (OpReg reg), + ADD wordRep (OpReg reg) (OpReg tableReg), + JMP_TBL (OpReg tableReg) [ id | Just id <- ids ] + ] +#endif +#else code = e_code `appOL` t_code `appOL` toOL [ LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), ADD wordRep op (OpReg tableReg), @@ -3901,7 +3954,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 @@ -4742,7 +4796,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 [