X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=85fb4372e56a4ac280ac51bef21f124132790aba;hb=28c556a5e0ed5c2687f19ec6ef8853b79ad65518;hp=3bc927799f899d0f1027e42883212f85bb654238;hpb=c4597dfe0b0de808b6e024b7d7e898e5ae14de19;p=ghc-hetmet.git diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 3bc9277..85fb437 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -10,7 +10,7 @@ module AsmCodeGen ( nativeCodeGen ) where #include "HsVersions.h" -#include "NCG.h" +#include "nativeGen/NCG.h" import MachInstrs import MachRegs @@ -39,6 +39,7 @@ import CLabel ( pprCLabel ) import ErrUtils ( dumpIfSet_dyn ) import DynFlags ( DynFlags, DynFlag(..), dopt ) import StaticFlags ( opt_Static, opt_PIC ) +import Config ( cProjectVersion ) import Digraph import qualified Pretty @@ -52,10 +53,10 @@ import FastString import List ( intersperse ) #endif -import DATA_INT -import DATA_WORD -import DATA_BITS -import GLAEXTS +import Data.Int +import Data.Word +import Data.Bits +import GHC.Exts {- The native-code generator has machine-independent and @@ -140,6 +141,14 @@ nativeCodeGen dflags cmms us -- stack so add the note in: Pretty.$$ Pretty.text ".section .note.GNU-stack,\"\",@progbits" #endif +#if !defined(darwin_TARGET_OS) + -- And just because every other compiler does, lets stick in + -- an identifier directive: .ident "GHC x.y.z" + Pretty.$$ let compilerIdent = Pretty.text "GHC" Pretty.<+> + Pretty.text cProjectVersion + in Pretty.text ".ident" Pretty.<+> + Pretty.doubleQuotes compilerIdent +#endif ) } @@ -302,17 +311,17 @@ reorder id accum (b@(block,id',out) : rest) genMachCode :: CmmTop -> UniqSM ([NatCmmTop], [CLabel]) -genMachCode cmm_top initial_us - = let initial_st = mkNatM_State initial_us 0 - (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top) - final_us = natm_us final_st - final_delta = natm_delta final_st - final_imports = natm_imports final_st - in - if final_delta == 0 - then ((new_tops, final_imports), final_us) - else pprPanic "genMachCode: nonzero final delta" - (int final_delta) +genMachCode cmm_top + = do { initial_us <- getUs + ; let initial_st = mkNatM_State initial_us 0 + (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top) + final_us = natm_us final_st + final_delta = natm_delta final_st + final_imports = natm_imports final_st + ; if final_delta == 0 + then return (new_tops, final_imports) + else pprPanic "genMachCode: nonzero final delta" (int final_delta) + } -- ----------------------------------------------------------------------------- -- Fixup assignments to global registers so that they assign to @@ -435,33 +444,33 @@ cmmBlockConFold (BasicBlock id stmts) = do cmmStmtConFold stmt = case stmt of CmmAssign reg src - -> do src' <- cmmExprConFold False src + -> do src' <- cmmExprConFold DataReference src return $ case src' of CmmReg reg' | reg == reg' -> CmmNop new_src -> CmmAssign reg new_src CmmStore addr src - -> do addr' <- cmmExprConFold False addr - src' <- cmmExprConFold False src + -> do addr' <- cmmExprConFold DataReference addr + src' <- cmmExprConFold DataReference src return $ CmmStore addr' src' CmmJump addr regs - -> do addr' <- cmmExprConFold True addr + -> do addr' <- cmmExprConFold JumpReference addr return $ CmmJump addr' regs CmmCall target regs args vols -> do target' <- case target of CmmForeignCall e conv -> do - e' <- cmmExprConFold True e + e' <- cmmExprConFold CallReference e return $ CmmForeignCall e' conv other -> return other args' <- mapM (\(arg, hint) -> do - arg' <- cmmExprConFold False arg + arg' <- cmmExprConFold DataReference arg return (arg', hint)) args return $ CmmCall target' regs args' vols CmmCondBranch test dest - -> do test' <- cmmExprConFold False test + -> do test' <- cmmExprConFold DataReference test return $ case test' of CmmLit (CmmInt 0 _) -> CmmComment (mkFastString ("deleted: " ++ @@ -471,29 +480,29 @@ cmmStmtConFold stmt other -> CmmCondBranch test' dest CmmSwitch expr ids - -> do expr' <- cmmExprConFold False expr + -> do expr' <- cmmExprConFold DataReference expr return $ CmmSwitch expr' ids other -> return other -cmmExprConFold isJumpTarget expr +cmmExprConFold referenceKind expr = case expr of CmmLoad addr rep - -> do addr' <- cmmExprConFold False addr + -> do addr' <- cmmExprConFold DataReference addr return $ CmmLoad addr' rep CmmMachOp mop args -- For MachOps, we first optimize the children, and then we try -- our hand at some constant-folding. - -> do args' <- mapM (cmmExprConFold False) args + -> do args' <- mapM (cmmExprConFold DataReference) args return $ cmmMachOpFold mop args' CmmLit (CmmLabel lbl) - -> cmmMakeDynamicReference addImportCmmOpt isJumpTarget lbl + -> cmmMakeDynamicReference addImportCmmOpt referenceKind lbl CmmLit (CmmLabelOff lbl off) - -> do dynRef <- cmmMakeDynamicReference addImportCmmOpt isJumpTarget lbl + -> do dynRef <- cmmMakeDynamicReference addImportCmmOpt referenceKind lbl return $ cmmMachOpFold (MO_Add wordRep) [ dynRef, (CmmLit $ CmmInt (fromIntegral off) wordRep) @@ -505,11 +514,11 @@ cmmExprConFold isJumpTarget expr -- with the corresponding labels: CmmReg (CmmGlobal GCEnter1) | not opt_PIC - -> cmmExprConFold isJumpTarget $ + -> cmmExprConFold referenceKind $ CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) | not opt_PIC - -> cmmExprConFold isJumpTarget $ + -> cmmExprConFold referenceKind $ CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun"))) #endif @@ -524,12 +533,12 @@ cmmExprConFold isJumpTarget expr Left realreg -> return expr Right baseRegAddr -> case mid of - BaseReg -> cmmExprConFold False baseRegAddr - other -> cmmExprConFold False (CmmLoad baseRegAddr - (globalRegRep mid)) + BaseReg -> cmmExprConFold DataReference baseRegAddr + other -> cmmExprConFold DataReference + (CmmLoad baseRegAddr (globalRegRep mid)) -- eliminate zero offsets CmmRegOff reg 0 - -> cmmExprConFold False (CmmReg reg) + -> cmmExprConFold referenceKind (CmmReg reg) CmmRegOff (CmmGlobal mid) offset -- RegOf leaves are just a shorthand form. If the reg maps @@ -538,7 +547,7 @@ cmmExprConFold isJumpTarget expr -> case get_GlobalReg_reg_or_addr mid of Left realreg -> return expr Right baseRegAddr - -> cmmExprConFold False (CmmMachOp (MO_Add wordRep) [ + -> cmmExprConFold DataReference (CmmMachOp (MO_Add wordRep) [ CmmReg (CmmGlobal mid), CmmLit (CmmInt (fromIntegral offset) wordRep)])