Make the back-end world compile.
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,
import Class ( Class, classTyCon )
import BasicTypes ( TopLevelFlag(..) )
import UniqSupply ( mkSplitUniqSupply )
-import ErrUtils ( dumpIfSet )
+import ErrUtils ( dumpIfSet_dyn )
import Util
import Panic ( assertPanic )
\end{code}
\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
-> [(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
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
-> 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 ----------------
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 _ _ _ _ _ _) ->
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
%************************************************************************
\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)
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp )
+import UniqSupply ( UniqSupply )
\end{code}
%************************************************************************
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
prsInsts :: IfaceInsts,
- prsRules :: IfaceRules
+ prsRules :: IfaceRules,
+ prsNS :: UniqSupply
}
\end{code}
import Outputable
import Unique ( Unique, Uniquable(..), mkPseudoUnique3 )
import CLabel ( CLabel, pprCLabel )
+import FastTypes
import List ( mapAccumL, nub, sort )
import Array ( Array, array, (!), bounds )
= 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]
= 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]
= 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]
-- 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
import GlaExts ( word2Int#, int2Word#, shiftRL#, and#, (/=#) )
import Outputable ( pprPanic, ppr )
import IOExts ( trace )
+import FastTypes
\end{code}
\begin{code}
= 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
getUniqueNat, returnNat, thenNat, NatM )
import Unique ( mkPseudoUnique2, Uniquable(..), Unique )
import Outputable
+import FastTypes
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
\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
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)
-- 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)
-------------------------------
\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}
#endif
-#define FAST_REG_NO FAST_INT
-
#include "../includes/config.h"
#if 0
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}
import Outputable
import Constants ( rESERVED_C_STACK_BYTES )
import Unique ( Unique, Uniquable(..) )
+import FastTypes
+
\end{code}
%************************************************************************
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
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
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"
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
import CLabel ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
mkMAP_FROZEN_infoLabel, mkForeignLabel )
import Outputable
+import FastTypes
#include "NCG.h"
\end{code}
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)
= 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)
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 }
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...
[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) ->
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 )
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)
))
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
projects / ghc-hetmet.git / commitdiff