X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=191bf273500c20d21d5114171bebc7db3093596e;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hp=2c07016a4f1fee1d0f8e1cc45a9c66cdd6a01d18;hpb=6103e1e2daf6aceb1a827723a1a2379ec655e946;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 2c07016..191bf27 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_GHC -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/WorkingConventions#Warnings +-- for details + module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where #include "HsVersions.h" @@ -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 ) @@ -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 @@ -784,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 @@ -807,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 @@ -1727,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, @@ -2216,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 @@ -3072,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) @@ -3183,18 +3207,19 @@ 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 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 -- 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 @@ -3289,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) @@ -3443,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 @@ -3539,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 @@ -3639,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 @@ -3794,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 @@ -3854,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 @@ -3908,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 @@ -4749,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 [