From 6a3f5f6beed9cec42c4b3a1b7cabc1809c838562 Mon Sep 17 00:00:00 2001 From: sewardj Date: Tue, 24 Oct 2000 10:12:17 +0000 Subject: [PATCH] [project @ 2000-10-24 10:12:16 by sewardj] Make the back-end world compile. --- ghc/compiler/codeGen/CodeGen.lhs | 14 +-- ghc/compiler/main/HscMain.lhs | 42 +++++--- ghc/compiler/main/HscTypes.lhs | 4 +- ghc/compiler/nativeGen/AsmRegAlloc.lhs | 17 ++-- ghc/compiler/nativeGen/MachMisc.lhs | 5 +- ghc/compiler/nativeGen/MachRegs.lhs | 113 ++++++++++----------- ghc/compiler/nativeGen/NCG.h | 2 - ghc/compiler/nativeGen/PprMach.lhs | 162 +++++++++++++++---------------- ghc/compiler/nativeGen/RegAllocInfo.lhs | 4 +- ghc/compiler/nativeGen/Stix.lhs | 13 +-- ghc/compiler/nativeGen/StixPrim.lhs | 7 +- ghc/compiler/rename/RnMonad.lhs | 11 ++- ghc/compiler/simplStg/SimplStg.lhs | 19 ++-- ghc/compiler/stgSyn/StgInterp.lhs | 6 +- 14 files changed, 223 insertions(+), 196 deletions(-) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 0cbb76f..e707cb0 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -32,9 +32,8 @@ import CgClosure ( cgTopRhsClosure ) import CgCon ( cgTopRhsCon ) import CgConTbls ( genStaticConBits ) import ClosureInfo ( mkClosureLFInfo ) -import CmdLineOpts ( opt_SccProfilingOn, opt_EnsureSplittableC, - opt_D_dump_absC - ) +import CmdLineOpts ( DynFlags, DynFlag(..), + opt_SccProfilingOn, opt_EnsureSplittableC ) import CostCentre ( CostCentre, CostCentreStack ) import Id ( Id, idName ) import Module ( Module, moduleString, moduleName, @@ -45,7 +44,7 @@ import TyCon ( TyCon, isDataTyCon ) import Class ( Class, classTyCon ) import BasicTypes ( TopLevelFlag(..) ) import UniqSupply ( mkSplitUniqSupply ) -import ErrUtils ( dumpIfSet ) +import ErrUtils ( dumpIfSet_dyn ) import Util import Panic ( assertPanic ) \end{code} @@ -53,7 +52,8 @@ import Panic ( assertPanic ) \begin{code} -codeGen :: Module -- Module name +codeGen :: DynFlags + -> Module -- Module name -> [Module] -- Import names -> ([CostCentre], -- Local cost-centres needing declaring/registering [CostCentre], -- "extern" cost-centres needing declaring @@ -63,7 +63,7 @@ codeGen :: Module -- Module name -> [(StgBinding,[Id])] -- Bindings to convert, with SRTs -> IO AbstractC -- Output -codeGen mod_name imported_modules cost_centre_info fe_binders +codeGen dflags mod_name imported_modules cost_centre_info fe_binders tycons classes stg_binds = mkSplitUniqSupply 'f' >>= \ fl_uniqs -> -- absC flattener let @@ -82,7 +82,7 @@ codeGen mod_name imported_modules cost_centre_info fe_binders flat_abstractC = flattenAbsC fl_uniqs abstractC in - dumpIfSet opt_D_dump_absC "Abstract C" (dumpRealC abstractC) >> + dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC) >> return flat_abstractC where diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 2c1be78..ff02188 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -76,7 +76,7 @@ hscMain -> PersistentCompilerState -- IN: persistent compiler state -> IO HscResult -hscMain flags core_cmds stg_cmds summary maybe_old_iface +hscMain dflags core_cmds stg_cmds summary maybe_old_iface output_filename mod_details pcs1 = -------------------------- Reader ---------------- @@ -91,14 +91,14 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface buf <- hGetStringBuffer True{-expand tabs-} src_filename - let glaexts | opt_GlasgowExts = 1# - | otherwise = 0# + let glaexts | dopt Opt_GlasgowExts dflags = 1# + | otherwise = 0# case parse buf PState{ bol = 0#, atbol = 1#, context = [], glasgow_exts = glaexts, loc = mkSrcLoc src_filename 1 } of { - PFailed err -> return (CompErrs pcs err) + PFailed err -> return (HscErrs pcs (unitBag err) emptyBag) POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> @@ -118,7 +118,8 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface show_pass "Renamer" >> _scc_ "Renamer" - renameModule rn_uniqs rdr_module >>= \ maybe_rn_stuff -> + renameModule dflags finder pcs hst rdr_module + >>= \ (pcs_rn, maybe_rn_stuff) -> case maybe_rn_stuff of { Nothing -> -- Hurrah! Renamer reckons that there's no need to -- go any further @@ -250,23 +251,38 @@ hscMain flags core_cmds stg_cmds summary maybe_old_iface %************************************************************************ \begin{code} -initPersistentCompilerState :: PersistentCompilerState +initPersistentCompilerState :: IO PersistentCompilerState initPersistentCompilerState +<<<<<<< HscMain.lhs + = do prs <- initPersistentRenamerState + return ( + PCS { pcs_PST = initPackageDetails, + pcs_insts = emptyInstEnv, + pcs_rules = emptyRuleEnv, + pcs_PRS = initPersistentRenamerState + } + ) +======= = PCS { pcs_PST = initPackageDetails, pcs_insts = emptyInstEnv, pcs_rules = initRules, pcs_PRS = initPersistentRenamerState } +>>>>>>> 1.12 initPackageDetails :: PackageSymbolTable initPackageDetails = extendTypeEnv emptyModuleEnv wiredInThings -initPersistentRenamerState :: PersistentRenamerState - = PRS { prsOrig = Orig { origNames = initOrigNames, - origIParam = emptyFM }, - prsDecls = emptyNameEnv, - prsInsts = emptyBag, - prsRules = emptyBag - } +initPersistentRenamerState :: IO PersistentRenamerState + = do ns <- mkSplitUniqSupply 'r' + return ( + PRS { prsOrig = Orig { origNames = initOrigNames, + origIParam = emptyFM }, + prsDecls = emptyNameEnv, + prsInsts = emptyBag, + prsRules = emptyBag, + prsNS = ns + } + ) initOrigNames :: FiniteMap (ModuleName,OccName) Name initOrigNames = grab knownKeyNames `plusFM` grab (map getName wiredInThings) diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 3cdc200..5c8c685 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -73,6 +73,7 @@ import UniqFM ( UniqFM ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) import Util ( thenCmp ) +import UniqSupply ( UniqSupply ) \end{code} %************************************************************************ @@ -415,7 +416,8 @@ data PersistentRenamerState = PRS { prsOrig :: OrigNameEnv, prsDecls :: DeclsMap, prsInsts :: IfaceInsts, - prsRules :: IfaceRules + prsRules :: IfaceRules, + prsNS :: UniqSupply } \end{code} diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs index e6a80c4..d9e6cf2 100644 --- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs +++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs @@ -22,6 +22,7 @@ import OrdList ( unitOL, appOL, fromOL, concatOL ) import Outputable import Unique ( Unique, Uniquable(..), mkPseudoUnique3 ) import CLabel ( CLabel, pprCLabel ) +import FastTypes import List ( mapAccumL, nub, sort ) import Array ( Array, array, (!), bounds ) @@ -625,8 +626,8 @@ mk_initial_approx ino (i:is) succ_map ia_so_far = let wrs = case regUsage i of RU rrr www -> www new_fes - = [case ino of { I# inoh -> - case ino_succ of { I# ino_succh -> + = [case iUnbox ino of { inoh -> + case iUnbox ino_succ of { ino_succh -> MkFE inoh ino_succh }} | ino_succ <- succ_map ! ino] @@ -674,8 +675,8 @@ upd_liveness_info pred_map succ_map insn_array prev_approx = approx | otherwise = let fes_to_futures - = [case ino of { I# inoh -> - case future_ino of { I# future_inoh -> + = [case iUnbox ino of { inoh -> + case iUnbox future_ino of { future_inoh -> MkFE inoh future_inoh }} | future_ino <- succ_map ! ino] @@ -685,8 +686,8 @@ upd_liveness_info pred_map succ_map insn_array prev_approx = foldr unionRegSets emptyRegSet future_lives fes_from_histories - = [case history_ino of { I# history_inoh -> - case ino of { I# inoh -> + = [case iUnbox history_ino of { history_inoh -> + case iUnbox ino of { inoh -> MkFE history_inoh inoh }} | history_ino <- pred_map ! ino] @@ -869,12 +870,12 @@ find_flow_edges insns -- A data type for flow edges data FE - = MkFE Int# Int# deriving (Eq, Ord) + = MkFE FastInt FastInt deriving (Eq, Ord) -- deriving Show on types with unboxed fields doesn't work instance Show FE where showsPrec _ (MkFE s d) - = showString "MkFE" . shows (I# s) . shows ' ' . shows (I# d) + = showString "MkFE" . shows (iBox s) . shows ' ' . shows (iBox d) -- Blargh. Use ghc stuff soon! Or: perhaps that's not such a good -- idea. Most of these sets are either empty or very small, and it diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 00462da..a98eb16 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -55,6 +55,7 @@ import Panic ( panic ) import GlaExts ( word2Int#, int2Word#, shiftRL#, and#, (/=#) ) import Outputable ( pprPanic, ppr ) import IOExts ( trace ) +import FastTypes \end{code} \begin{code} @@ -168,11 +169,11 @@ exactLog2 x = if (x <= 0 || x >= 2147483648) then Nothing else - case (fromInteger x) of { I# x# -> + case iUnbox (fromInteger x) of { x# -> if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then Nothing else - Just (toInteger (I# (pow2 x#))) + Just (toInteger (iBox (pow2 x#))) } where shiftr x y = shiftRL# x y diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index 35dc741..f54401e 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -63,6 +63,7 @@ import Stix ( StixTree(..), StixReg(..), getUniqueNat, returnNat, thenNat, NatM ) import Unique ( mkPseudoUnique2, Uniquable(..), Unique ) import Outputable +import FastTypes \end{code} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -603,30 +604,30 @@ names in the header files. Gag me with a spoon, eh? \begin{code} baseRegOffset :: MagicId -> Int -baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1 -baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2 -baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3 -baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4 -baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5 -baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6 -baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7 -baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8 -baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9 -baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10 -baseRegOffset (FloatReg ILIT(1)) = OFFSET_F1 -baseRegOffset (FloatReg ILIT(2)) = OFFSET_F2 -baseRegOffset (FloatReg ILIT(3)) = OFFSET_F3 -baseRegOffset (FloatReg ILIT(4)) = OFFSET_F4 -baseRegOffset (DoubleReg ILIT(1)) = OFFSET_D1 -baseRegOffset (DoubleReg ILIT(2)) = OFFSET_D2 +baseRegOffset (VanillaReg _ 1#) = OFFSET_R1 +baseRegOffset (VanillaReg _ 2#) = OFFSET_R2 +baseRegOffset (VanillaReg _ 3#) = OFFSET_R3 +baseRegOffset (VanillaReg _ 4#) = OFFSET_R4 +baseRegOffset (VanillaReg _ 5#) = OFFSET_R5 +baseRegOffset (VanillaReg _ 6#) = OFFSET_R6 +baseRegOffset (VanillaReg _ 7#) = OFFSET_R7 +baseRegOffset (VanillaReg _ 8#) = OFFSET_R8 +baseRegOffset (VanillaReg _ 9#) = OFFSET_R9 +baseRegOffset (VanillaReg _ 10#) = OFFSET_R10 +baseRegOffset (FloatReg 1#) = OFFSET_F1 +baseRegOffset (FloatReg 2#) = OFFSET_F2 +baseRegOffset (FloatReg 3#) = OFFSET_F3 +baseRegOffset (FloatReg 4#) = OFFSET_F4 +baseRegOffset (DoubleReg 1#) = OFFSET_D1 +baseRegOffset (DoubleReg 2#) = OFFSET_D2 baseRegOffset Sp = OFFSET_Sp baseRegOffset Su = OFFSET_Su baseRegOffset SpLim = OFFSET_SpLim #ifdef OFFSET_Lng1 -baseRegOffset (LongReg _ ILIT(1)) = OFFSET_Lng1 +baseRegOffset (LongReg _ 1)) = OFFSET_Lng1 #endif #ifdef OFFSET_Lng2 -baseRegOffset (LongReg _ ILIT(2)) = OFFSET_Lng2 +baseRegOffset (LongReg _ 2)) = OFFSET_Lng2 #endif baseRegOffset Hp = OFFSET_Hp baseRegOffset HpLim = OFFSET_HpLim @@ -721,7 +722,7 @@ magicIdRegMaybe :: MagicId -> Maybe Reg magicIdRegMaybe BaseReg = Just (RealReg REG_Base) #endif #ifdef REG_R1 -magicIdRegMaybe (VanillaReg _ ILIT(1)) = Just (RealReg REG_R1) +magicIdRegMaybe (VanillaReg _ 1#) = Just (RealReg REG_R1) #endif #ifdef REG_R2 magicIdRegMaybe (VanillaReg _ ILIT(2)) = Just (RealReg REG_R2) @@ -814,7 +815,7 @@ allMachRegNos -- register allocator to attempt to map VRegs to. allocatableRegs :: [Reg] allocatableRegs - = let isFree (I# i) = _IS_TRUE_(freeReg i) + = let isFree i = _IS_TRUE_(freeReg i) in map RealReg (filter isFree allMachRegNos) ------------------------------- @@ -894,91 +895,91 @@ allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!" \end{code} \begin{code} -freeReg :: FastInt -> FastBool +freeReg :: Int -> FastBool #if alpha_TARGET_ARCH -freeReg ILIT(26) = fastBool False -- return address (ra) -freeReg ILIT(28) = fastBool False -- reserved for the assembler (at) -freeReg ILIT(29) = fastBool False -- global pointer (gp) -freeReg ILIT(30) = fastBool False -- stack pointer (sp) -freeReg ILIT(31) = fastBool False -- always zero (zeroh) -freeReg ILIT(63) = fastBool False -- always zero (f31) +freeReg 26 = fastBool False -- return address (ra) +freeReg 28 = fastBool False -- reserved for the assembler (at) +freeReg 29 = fastBool False -- global pointer (gp) +freeReg 30 = fastBool False -- stack pointer (sp) +freeReg 31 = fastBool False -- always zero (zeroh) +freeReg 63 = fastBool False -- always zero (f31) #endif #if i386_TARGET_ARCH -freeReg ILIT(esp) = fastBool False -- %esp is the C stack pointer +freeReg esp = fastBool False -- %esp is the C stack pointer #endif #if sparc_TARGET_ARCH -freeReg ILIT(g0) = fastBool False -- %g0 is always 0. -freeReg ILIT(g5) = fastBool False -- %g5 is reserved (ABI). -freeReg ILIT(g6) = fastBool False -- %g6 is reserved (ABI). -freeReg ILIT(g7) = fastBool False -- %g7 is reserved (ABI). -freeReg ILIT(i6) = fastBool False -- %i6 is our frame pointer. -freeReg ILIT(o6) = fastBool False -- %o6 is our stack pointer. -freeReg ILIT(f0) = fastBool False -- %f0/%f1 are the C fp return registers. -freeReg ILIT(f1) = fastBool False +freeReg g0 = fastBool False -- %g0 is always 0. +freeReg g5 = fastBool False -- %g5 is reserved (ABI). +freeReg g6 = fastBool False -- %g6 is reserved (ABI). +freeReg g7 = fastBool False -- %g7 is reserved (ABI). +freeReg i6 = fastBool False -- %i6 is our frame pointer. +freeReg o6 = fastBool False -- %o6 is our stack pointer. +freeReg f0 = fastBool False -- %f0/%f1 are the C fp return registers. +freeReg f1 = fastBool False #endif #ifdef REG_Base -freeReg ILIT(REG_Base) = fastBool False +freeReg REG_Base = fastBool False #endif #ifdef REG_R1 -freeReg ILIT(REG_R1) = fastBool False +freeReg REG_R1 = fastBool False #endif #ifdef REG_R2 -freeReg ILIT(REG_R2) = fastBool False +freeReg REG_R2 = fastBool False #endif #ifdef REG_R3 -freeReg ILIT(REG_R3) = fastBool False +freeReg REG_R3 = fastBool False #endif #ifdef REG_R4 -freeReg ILIT(REG_R4) = fastBool False +freeReg REG_R4 = fastBool False #endif #ifdef REG_R5 -freeReg ILIT(REG_R5) = fastBool False +freeReg REG_R5 = fastBool False #endif #ifdef REG_R6 -freeReg ILIT(REG_R6) = fastBool False +freeReg REG_R6 = fastBool False #endif #ifdef REG_R7 -freeReg ILIT(REG_R7) = fastBool False +freeReg REG_R7 = fastBool False #endif #ifdef REG_R8 -freeReg ILIT(REG_R8) = fastBool False +freeReg REG_R8 = fastBool False #endif #ifdef REG_F1 -freeReg ILIT(REG_F1) = fastBool False +freeReg REG_F1 = fastBool False #endif #ifdef REG_F2 -freeReg ILIT(REG_F2) = fastBool False +freeReg REG_F2 = fastBool False #endif #ifdef REG_F3 -freeReg ILIT(REG_F3) = fastBool False +freeReg REG_F3 = fastBool False #endif #ifdef REG_F4 -freeReg ILIT(REG_F4) = fastBool False +freeReg REG_F4 = fastBool False #endif #ifdef REG_D1 -freeReg ILIT(REG_D1) = fastBool False +freeReg REG_D1 = fastBool False #endif #ifdef REG_D2 -freeReg ILIT(REG_D2) = fastBool False +freeReg REG_D2 = fastBool False #endif #ifdef REG_Sp -freeReg ILIT(REG_Sp) = fastBool False +freeReg REG_Sp = fastBool False #endif #ifdef REG_Su -freeReg ILIT(REG_Su) = fastBool False +freeReg REG_Su = fastBool False #endif #ifdef REG_SpLim -freeReg ILIT(REG_SpLim) = fastBool False +freeReg REG_SpLim = fastBool False #endif #ifdef REG_Hp -freeReg ILIT(REG_Hp) = fastBool False +freeReg REG_Hp = fastBool False #endif #ifdef REG_HpLim -freeReg ILIT(REG_HpLim) = fastBool False +freeReg REG_HpLim = fastBool False #endif freeReg n = fastBool True \end{code} diff --git a/ghc/compiler/nativeGen/NCG.h b/ghc/compiler/nativeGen/NCG.h index e023463..9d11c21 100644 --- a/ghc/compiler/nativeGen/NCG.h +++ b/ghc/compiler/nativeGen/NCG.h @@ -23,8 +23,6 @@ you will screw up the layout where they are used in case expressions! #endif -#define FAST_REG_NO FAST_INT - #include "../includes/config.h" #if 0 diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 722128c..979207e 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -45,107 +45,107 @@ pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc pprReg IF_ARCH_i386(s,) r = case r of - RealReg (I# i) -> ppr_reg_no IF_ARCH_i386(s,) i + RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i VirtualRegI u -> text "%vI_" <> ppr u VirtualRegF u -> text "%vF_" <> ppr u where #if alpha_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> SDoc + ppr_reg_no :: Int -> SDoc ppr_reg_no i = ptext (case i of { - ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1"); - ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3"); - ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5"); - ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7"); - ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9"); - ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11"); - ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13"); - ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15"); - ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17"); - ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19"); - ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21"); - ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23"); - ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25"); - ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27"); - ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29"); - ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31"); - ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1"); - ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3"); - ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5"); - ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7"); - ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9"); - ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11"); - ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13"); - ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15"); - ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17"); - ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19"); - ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21"); - ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23"); - ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25"); - ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27"); - ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29"); - ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31"); - _ -> SLIT("very naughty alpha register") + 0 -> SLIT("$0"); 1 -> SLIT("$1"); + 2 -> SLIT("$2"); 3 -> SLIT("$3"); + 4 -> SLIT("$4"); 5 -> SLIT("$5"); + 6 -> SLIT("$6"); 7 -> SLIT("$7"); + 8 -> SLIT("$8"); 9 -> SLIT("$9"); + 10 -> SLIT("$10"); 11 -> SLIT("$11"); + 12 -> SLIT("$12"); 13 -> SLIT("$13"); + 14 -> SLIT("$14"); 15 -> SLIT("$15"); + 16 -> SLIT("$16"); 17 -> SLIT("$17"); + 18 -> SLIT("$18"); 19 -> SLIT("$19"); + 20 -> SLIT("$20"); 21 -> SLIT("$21"); + 22 -> SLIT("$22"); 23 -> SLIT("$23"); + 24 -> SLIT("$24"); 25 -> SLIT("$25"); + 26 -> SLIT("$26"); 27 -> SLIT("$27"); + 28 -> SLIT("$28"); 29 -> SLIT("$29"); + 30 -> SLIT("$30"); 31 -> SLIT("$31"); + 32 -> SLIT("$f0"); 33 -> SLIT("$f1"); + 34 -> SLIT("$f2"); 35 -> SLIT("$f3"); + 36 -> SLIT("$f4"); 37 -> SLIT("$f5"); + 38 -> SLIT("$f6"); 39 -> SLIT("$f7"); + 40 -> SLIT("$f8"); 41 -> SLIT("$f9"); + 42 -> SLIT("$f10"); 43 -> SLIT("$f11"); + 44 -> SLIT("$f12"); 45 -> SLIT("$f13"); + 46 -> SLIT("$f14"); 47 -> SLIT("$f15"); + 48 -> SLIT("$f16"); 49 -> SLIT("$f17"); + 50 -> SLIT("$f18"); 51 -> SLIT("$f19"); + 52 -> SLIT("$f20"); 53 -> SLIT("$f21"); + 54 -> SLIT("$f22"); 55 -> SLIT("$f23"); + 56 -> SLIT("$f24"); 57 -> SLIT("$f25"); + 58 -> SLIT("$f26"); 59 -> SLIT("$f27"); + 60 -> SLIT("$f28"); 61 -> SLIT("$f29"); + 62 -> SLIT("$f30"); 63 -> SLIT("$f31"); + _ -> SLIT("very naughty alpha register") }) #endif #if i386_TARGET_ARCH - ppr_reg_no :: Size -> FAST_REG_NO -> SDoc + ppr_reg_no :: Size -> Int -> SDoc ppr_reg_no B i= ptext (case i of { - ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl"); - ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl"); - _ -> SLIT("very naughty I386 byte register") + 0 -> SLIT("%al"); 1 -> SLIT("%bl"); + 2 -> SLIT("%cl"); 3 -> SLIT("%dl"); + _ -> SLIT("very naughty I386 byte register") }) ppr_reg_no _ i = ptext (case i of { - ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx"); - ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx"); - ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi"); - ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp"); - ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1"); - ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3"); - ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5"); - _ -> SLIT("very naughty I386 register") + 0 -> SLIT("%eax"); 1 -> SLIT("%ebx"); + 2 -> SLIT("%ecx"); 3 -> SLIT("%edx"); + 4 -> SLIT("%esi"); 5 -> SLIT("%edi"); + 6 -> SLIT("%ebp"); 7 -> SLIT("%esp"); + 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1"); + 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3"); + 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5"); + _ -> SLIT("very naughty I386 register") }) #endif #if sparc_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> SDoc + ppr_reg_no :: Int -> SDoc ppr_reg_no i = ptext (case i of { - ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1"); - ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3"); - ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5"); - ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7"); - ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1"); - ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3"); - ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5"); - ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7"); - ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1"); - ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3"); - ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5"); - ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7"); - ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1"); - ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3"); - ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5"); - ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7"); - ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1"); - ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3"); - ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5"); - ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7"); - ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9"); - ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11"); - ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13"); - ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15"); - ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17"); - ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19"); - ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21"); - ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23"); - ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25"); - ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27"); - ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29"); - ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31"); - _ -> SLIT("very naughty sparc register") + 0 -> SLIT("%g0"); 1 -> SLIT("%g1"); + 2 -> SLIT("%g2"); 3 -> SLIT("%g3"); + 4 -> SLIT("%g4"); 5 -> SLIT("%g5"); + 6 -> SLIT("%g6"); 7 -> SLIT("%g7"); + 8 -> SLIT("%o0"); 9 -> SLIT("%o1"); + 10 -> SLIT("%o2"); 11 -> SLIT("%o3"); + 12 -> SLIT("%o4"); 13 -> SLIT("%o5"); + 14 -> SLIT("%o6"); 15 -> SLIT("%o7"); + 16 -> SLIT("%l0"); 17 -> SLIT("%l1"); + 18 -> SLIT("%l2"); 19 -> SLIT("%l3"); + 20 -> SLIT("%l4"); 21 -> SLIT("%l5"); + 22 -> SLIT("%l6"); 23 -> SLIT("%l7"); + 24 -> SLIT("%i0"); 25 -> SLIT("%i1"); + 26 -> SLIT("%i2"); 27 -> SLIT("%i3"); + 28 -> SLIT("%i4"); 29 -> SLIT("%i5"); + 30 -> SLIT("%i6"); 31 -> SLIT("%i7"); + 32 -> SLIT("%f0"); 33 -> SLIT("%f1"); + 34 -> SLIT("%f2"); 35 -> SLIT("%f3"); + 36 -> SLIT("%f4"); 37 -> SLIT("%f5"); + 38 -> SLIT("%f6"); 39 -> SLIT("%f7"); + 40 -> SLIT("%f8"); 41 -> SLIT("%f9"); + 42 -> SLIT("%f10"); 43 -> SLIT("%f11"); + 44 -> SLIT("%f12"); 45 -> SLIT("%f13"); + 46 -> SLIT("%f14"); 47 -> SLIT("%f15"); + 48 -> SLIT("%f16"); 49 -> SLIT("%f17"); + 50 -> SLIT("%f18"); 51 -> SLIT("%f19"); + 52 -> SLIT("%f20"); 53 -> SLIT("%f21"); + 54 -> SLIT("%f22"); 55 -> SLIT("%f23"); + 56 -> SLIT("%f24"); 57 -> SLIT("%f25"); + 58 -> SLIT("%f26"); 59 -> SLIT("%f27"); + 60 -> SLIT("%f28"); 61 -> SLIT("%f29"); + 62 -> SLIT("%f30"); 63 -> SLIT("%f31"); + _ -> SLIT("very naughty sparc register") }) #endif \end{code} diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 2364f12..216046d 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -45,6 +45,8 @@ import FiniteMap ( addToFM, lookupFM, FiniteMap ) import Outputable import Constants ( rESERVED_C_STACK_BYTES ) import Unique ( Unique, Uniquable(..) ) +import FastTypes + \end{code} %************************************************************************ @@ -146,7 +148,7 @@ regUsage :: Instr -> RegUsage interesting (VirtualRegI _) = True interesting (VirtualRegF _) = True interesting (VirtualRegD _) = True -interesting (RealReg (I# i)) = _IS_TRUE_(freeReg i) +interesting (RealReg i) = _IS_TRUE_(freeReg i) #if alpha_TARGET_ARCH diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index 7dcca3e..1e04305 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -38,6 +38,7 @@ import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize ) import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, UniqSM, thenUs, returnUs, getUniqueUs ) import Outputable +import FastTypes \end{code} Here is the tag at the nodes of our @StixTree@. Notice its @@ -204,11 +205,11 @@ ppStixReg (StixTemp u pr) ppMId BaseReg = text "BaseReg" ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(", - int (I# n), char ')'] -ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')'] -ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')'] + int (iBox n), char ')'] +ppMId (FloatReg n) = hcat [text "FltReg(", int (iBox n), char ')'] +ppMId (DoubleReg n) = hcat [text "DblReg(", int (iBox n), char ')'] ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(", - int (I# n), char ')'] + int (iBox n), char ')'] ppMId Sp = text "Sp" ppMId Su = text "Su" ppMId SpLim = text "SpLim" @@ -244,8 +245,8 @@ stgHp = StReg (StixMagicId Hp) stgHpLim = StReg (StixMagicId HpLim) stgCurrentTSO = StReg (StixMagicId CurrentTSO) stgCurrentNursery = StReg (StixMagicId CurrentNursery) -stgR9 = StReg (StixMagicId (VanillaReg WordRep ILIT(9))) -stgR10 = StReg (StixMagicId (VanillaReg WordRep ILIT(10))) +stgR9 = StReg (StixMagicId (VanillaReg WordRep (_ILIT 9))) +stgR10 = StReg (StixMagicId (VanillaReg WordRep (_ILIT 10))) getNatLabelNCG :: NatM CLabel getNatLabelNCG diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 1f5fde1..8177892 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -23,6 +23,7 @@ import Constants ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE, import CLabel ( mkIntlikeClosureLabel, mkCharlikeClosureLabel, mkMAP_FROZEN_infoLabel, mkForeignLabel ) import Outputable +import FastTypes #include "NCG.h" \end{code} @@ -475,13 +476,13 @@ amodeToStix am@(CVal rr CharRep) amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr)) amodeToStix (CAddr (SpRel off)) - = StIndex PtrRep stgSp (StInt (toInteger IBOX(off))) + = StIndex PtrRep stgSp (StInt (toInteger (iBox off))) amodeToStix (CAddr (HpRel off)) - = StIndex IntRep stgHp (StInt (toInteger (- IBOX(off)))) + = StIndex IntRep stgHp (StInt (toInteger (- (iBox off)))) amodeToStix (CAddr (NodeRel off)) - = StIndex IntRep stgNode (StInt (toInteger IBOX(off))) + = StIndex IntRep stgNode (StInt (toInteger (iBox off))) amodeToStix (CAddr (CIndex base off pk)) = StIndex pk (amodeToStix base) (amodeToStix off) diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index 17c5c71..92f012d 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -299,8 +299,8 @@ initRn dflags finder hit hst pcs mod loc do_rn = do let prs = pcs_PRS pcs let pst = pcs_PST pcs + let uniqs = prsNS prs - uniqs <- mkSplitUniqSupply 'r' names_var <- newIORef (uniqs, origNames (prsOrig prs), origIParam (prsOrig prs)) errs_var <- newIORef (emptyBag,emptyBag) @@ -322,14 +322,15 @@ initRn dflags finder hit hst pcs mod loc do_rn res <- do_rn rn_down () -- Grab state and record it - (warns, errs) <- readIORef errs_var - new_ifaces <- readIORef iface_var - (_, new_origN, new_origIP) <- readIORef names_var + (warns, errs) <- readIORef errs_var + new_ifaces <- readIORef iface_var + (new_NS, new_origN, new_origIP) <- readIORef names_var let new_orig = Orig { origNames = new_origN, origIParam = new_origIP } let new_prs = prs { prsOrig = new_orig, prsDecls = iDecls new_ifaces, prsInsts = iInsts new_ifaces, - prsRules = iRules new_ifaces } + prsRules = iRules new_ifaces, + prsNS = new_NS } let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, pcs_PRS = new_prs } diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs index 466f7fa..a06915c 100644 --- a/ghc/compiler/simplStg/SimplStg.lhs +++ b/ghc/compiler/simplStg/SimplStg.lhs @@ -18,20 +18,21 @@ import StgStats ( showStgStats ) import StgVarInfo ( setStgVarInfo ) import SRT ( computeSRTs ) -import CmdLineOpts ( opt_StgDoLetNoEscapes, opt_D_verbose_stg2stg, - opt_DoStgLinting, opt_D_dump_stg, +import CmdLineOpts ( DynFlags, DynFlag(..), dopt, + opt_StgDoLetNoEscapes, StgToDo(..) ) import Id ( Id ) import Module ( Module, moduleString ) -import ErrUtils ( doIfSet, dumpIfSet ) +import ErrUtils ( doIfSet_dyn, dumpIfSet_dyn ) import UniqSupply ( splitUniqSupply, UniqSupply ) import IO ( hPutStr, stdout ) import Outputable \end{code} \begin{code} -stg2stg :: [StgToDo] -- spec of what stg-to-stg passes to do +stg2stg :: DynFlags + -> [StgToDo] -- spec of what stg-to-stg passes to do -> Module -- module name (profiling only) -> UniqSupply -- a name supply -> [StgBinding] -- input... @@ -41,10 +42,10 @@ stg2stg :: [StgToDo] -- spec of what stg-to-stg passes to do [CostCentre], -- "extern" cost-centres [CostCentreStack])) -- pre-defined "singleton" cost centre stacks -stg2stg stg_todos module_name us binds +stg2stg dflags stg_todos module_name us binds = case (splitUniqSupply us) of { (us4now, us4later) -> - doIfSet opt_D_verbose_stg2stg (printErrs (text "VERBOSE STG-TO-STG:")) >> + doIfSet_dyn dflags Opt_D_verbose_stg2stg (printErrs (text "VERBOSE STG-TO-STG:")) >> end_pass us4now "Core2Stg" ([],[],[]) binds >>= \ (binds', us, ccs) -> @@ -71,14 +72,14 @@ stg2stg stg_todos module_name us binds srt_binds = computeSRTs annotated_binds in - dumpIfSet opt_D_dump_stg "STG syntax:" + dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" (pprStgBindingsWithSRTs srt_binds) >> return (srt_binds, cost_centres) } where - stg_linter = if opt_DoStgLinting + stg_linter = if dopt Opt_DoStgLinting dflags then lintStgBindings else ( \ whodunnit binds -> binds ) @@ -112,7 +113,7 @@ stg2stg stg_todos module_name us binds end_pass us2 what ccs binds2 = -- report verbosely, if required - (if opt_D_verbose_stg2stg then + (if dopt Opt_D_verbose_stg2stg dflags then hPutStr stdout (showSDoc (text ("*** "++what++":") $$ vcat (map ppr binds2) )) diff --git a/ghc/compiler/stgSyn/StgInterp.lhs b/ghc/compiler/stgSyn/StgInterp.lhs index 1ccbb44..7c0eb6e 100644 --- a/ghc/compiler/stgSyn/StgInterp.lhs +++ b/ghc/compiler/stgSyn/StgInterp.lhs @@ -65,14 +65,16 @@ import GlaExts ( Int(..) ) import Module ( moduleNameFS ) #endif -import TyCon ( TyCon ) +import TyCon ( TyCon, isDataTyCon, tyConDataCons, tyConFamilySize ) import Class ( Class ) import InterpSyn import StgSyn import Addr -import RdrName ( RdrName ) +import RdrName ( RdrName, rdrNameModule, rdrNameOcc ) import FiniteMap import Panic ( panic ) +import OccName ( occNameString ) + -- --------------------------------------------------------------------------- -- Environments needed by the linker -- 1.7.10.4