Remove some old-codegen cruft
authorSimon Marlow <marlowsd@gmail.com>
Tue, 25 Sep 2012 15:03:36 +0000 (16:03 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 25 Sep 2012 15:13:17 +0000 (16:13 +0100)
compiler/cmm/CmmOpt.hs
compiler/codeGen/CodeGen.lhs [deleted file]
compiler/codeGen/StgCmm.hs
compiler/ghc.cabal.in
compiler/main/DynFlags.hs
compiler/main/HscMain.hs
compiler/nativeGen/AsmCodeGen.lhs
compiler/simplStg/SRT.lhs [deleted file]
compiler/simplStg/SimplStg.lhs
compiler/stgSyn/StgSyn.lhs

index 0df24a6..32afa1d 100644 (file)
@@ -7,8 +7,6 @@
 -----------------------------------------------------------------------------
 
 module CmmOpt (
-        cmmEliminateDeadBlocks,
-        cmmMiniInline,
         cmmMachOpFold,
         cmmMachOpFoldM,
         cmmLoopifyForC,
@@ -17,282 +15,15 @@ module CmmOpt (
 #include "HsVersions.h"
 
 import OldCmm
-import OldPprCmm
-import CmmNode (wrapRecExp)
-import CmmUtils
 import DynFlags
 import CLabel
 
-import UniqFM
-import Unique
-import Util
 import FastTypes
 import Outputable
 import Platform
-import BlockId
 
 import Data.Bits
 import Data.Maybe
-import Data.List
-
--- -----------------------------------------------------------------------------
--- Eliminates dead blocks
-
-{-
-We repeatedly expand the set of reachable blocks until we hit a
-fixpoint, and then prune any blocks that were not in this set.  This is
-actually a required optimization, as dead blocks can cause problems
-for invariants in the linear register allocator (and possibly other
-places.)
--}
-
--- Deep fold over statements could probably be abstracted out, but it
--- might not be worth the effort since OldCmm is moribund
-cmmEliminateDeadBlocks :: [CmmBasicBlock] -> [CmmBasicBlock]
-cmmEliminateDeadBlocks [] = []
-cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
-    let -- Calculate what's reachable from what block
-        reachableMap = foldl' f emptyUFM blocks -- lazy in values
-            where f m (BasicBlock block_id stmts) = addToUFM m block_id (reachableFrom stmts)
-        reachableFrom stmts = foldl stmt [] stmts
-            where
-                stmt m CmmNop = m
-                stmt m (CmmComment _) = m
-                stmt m (CmmAssign _ e) = expr m e
-                stmt m (CmmStore e1 e2) = expr (expr m e1) e2
-                stmt m (CmmCall c _ as _) = f (actuals m as) c
-                    where f m (CmmCallee e _) = expr m e
-                          f m (CmmPrim _ Nothing) = m
-                          f m (CmmPrim _ (Just stmts)) = foldl' stmt m stmts
-                stmt m (CmmBranch b) = b:m
-                stmt m (CmmCondBranch e b) = b:(expr m e)
-                stmt m (CmmSwitch e bs) = catMaybes bs ++ expr m e
-                stmt m (CmmJump e _) = expr m e
-                stmt m (CmmReturn) = m
-                actuals m as = foldl' (\m h -> expr m (hintlessCmm h)) m as
-                -- We have to do a deep fold into CmmExpr because
-                -- there may be a BlockId in the CmmBlock literal.
-                expr m (CmmLit l) = lit m l
-                expr m (CmmLoad e _) = expr m e
-                expr m (CmmReg _) = m
-                expr m (CmmMachOp _ es) = foldl' expr m es
-                expr m (CmmStackSlot _ _) = m
-                expr m (CmmRegOff _ _) = m
-                lit m (CmmBlock b) = b:m
-                lit m _ = m
-        -- go todo done
-        reachable = go [base_id] (setEmpty :: BlockSet)
-          where go []     m = m
-                go (x:xs) m
-                    | setMember x m = go xs m
-                    | otherwise     = go (add ++ xs) (setInsert x m)
-                        where add = fromMaybe (panic "cmmEliminateDeadBlocks: unknown block")
-                                              (lookupUFM reachableMap x)
-    in filter (\(BasicBlock block_id _) -> setMember block_id reachable) blocks
-
--- -----------------------------------------------------------------------------
--- The mini-inliner
-
-{-
-This pass inlines assignments to temporaries.  Temporaries that are
-only used once are unconditionally inlined.  Temporaries that are used
-two or more times are only inlined if they are assigned a literal.  It
-works as follows:
-
-  - count uses of each temporary
-  - for each temporary:
-        - attempt to push it forward to the statement that uses it
-        - only push forward past assignments to other temporaries
-          (assumes that temporaries are single-assignment)
-        - if we reach the statement that uses it, inline the rhs
-          and delete the original assignment.
-
-[N.B. In the Quick C-- compiler, this optimization is achieved by a
- combination of two dataflow passes: forward substitution (peephole
- optimization) and dead-assignment elimination.  ---NR]
-
-Possible generalisations: here is an example from factorial
-
-Fac_zdwfac_entry:
-    cmG:
-        _smi = R2;
-        if (_smi != 0) goto cmK;
-        R1 = R3;
-        jump I64[Sp];
-    cmK:
-        _smn = _smi * R3;
-        R2 = _smi + (-1);
-        R3 = _smn;
-        jump Fac_zdwfac_info;
-
-We want to inline _smi and _smn.  To inline _smn:
-
-   - we must be able to push forward past assignments to global regs.
-     We can do this if the rhs of the assignment we are pushing
-     forward doesn't refer to the global reg being assigned to; easy
-     to test.
-
-To inline _smi:
-
-   - It is a trivial replacement, reg for reg, but it occurs more than
-     once.
-   - We can inline trivial assignments even if the temporary occurs
-     more than once, as long as we don't eliminate the original assignment
-     (this doesn't help much on its own).
-   - We need to be able to propagate the assignment forward through jumps;
-     if we did this, we would find that it can be inlined safely in all
-     its occurrences.
--}
-
-countUses :: UserOfLocalRegs a => a -> UniqFM Int
-countUses a = foldRegsUsed (\m r -> addToUFM_C (+) m r 1) emptyUFM a
-
-cmmMiniInline :: DynFlags -> [CmmBasicBlock] -> [CmmBasicBlock]
-cmmMiniInline dflags blocks = map do_inline blocks
-  where do_inline (BasicBlock id stmts)
-          = BasicBlock id (cmmMiniInlineStmts dflags (countUses blocks) stmts)
-
-cmmMiniInlineStmts :: DynFlags -> UniqFM Int -> [CmmStmt] -> [CmmStmt]
-cmmMiniInlineStmts _      _    [] = []
-cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
-        -- not used: just discard this assignment
-  | 0 <- lookupWithDefaultUFM uses 0 u
-  = cmmMiniInlineStmts dflags uses stmts
-
-        -- used (foldable to small thing): try to inline at all the use sites
-  | Just n <- lookupUFM uses u,
-    e <- wrapRecExp foldExp expr,
-    isTiny e
-  =
-     ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
-     case lookForInlineMany u e stmts of
-         (m, stmts')
-             | n == m -> cmmMiniInlineStmts dflags (delFromUFM uses u) stmts'
-             | otherwise ->
-                 stmt : cmmMiniInlineStmts dflags (adjustUFM (\x -> x - m) uses u) stmts'
-
-        -- used once (non-literal): try to inline at the use site
-  | Just 1 <- lookupUFM uses u,
-    Just stmts' <- lookForInline u expr stmts
-  = 
-     ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
-     cmmMiniInlineStmts dflags uses stmts'
- where
-  isTiny (CmmLit _) = True
-  isTiny (CmmReg (CmmGlobal _)) = True
-         -- not CmmLocal: that might invalidate the usage analysis results
-  isTiny _ = False
-
-  foldExp (CmmMachOp op args) = cmmMachOpFold dflags op args
-  foldExp e = e
-
-  ncgDebugTrace str x = if ncgDebugIsOn then trace str x else x
-
-cmmMiniInlineStmts platform uses (stmt:stmts)
-  = stmt : cmmMiniInlineStmts platform uses stmts
-
--- | Takes a register, a 'CmmLit' expression assigned to that
--- register, and a list of statements.  Inlines the expression at all
--- use sites of the register.  Returns the number of substituations
--- made and the, possibly modified, list of statements.
-lookForInlineMany :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt])
-lookForInlineMany u expr stmts = lookForInlineMany' u expr regset stmts
-    where regset = foldRegsUsed extendRegSet emptyRegSet expr
-
-lookForInlineMany' :: Unique -> CmmExpr -> RegSet -> [CmmStmt] -> (Int, [CmmStmt])
-lookForInlineMany' _ _ _ [] = (0, [])
-lookForInlineMany' u expr regset stmts@(stmt : rest)
-  | Just n <- lookupUFM (countUses stmt) u, okToInline expr stmt
-  = let stmt' = inlineStmt u expr stmt in
-    if okToSkip stmt' u expr regset
-       then case lookForInlineMany' u expr regset rest of
-                       (m, stmts) -> let z = n + m
-                                     in z `seq` (z, stmt' : stmts)
-       else (n, stmt' : rest)
-
-  | okToSkip stmt u expr regset
-  = case lookForInlineMany' u expr regset rest of
-      (n, stmts) -> (n, stmt : stmts)
-
-  | otherwise
-  = (0, stmts)
-
-
-lookForInline :: Unique -> CmmExpr -> [CmmStmt] -> Maybe [CmmStmt]
-lookForInline u expr stmts = lookForInline' u expr regset stmts
-    where regset = foldRegsUsed extendRegSet emptyRegSet expr
-
-lookForInline' :: Unique -> CmmExpr -> RegSet -> [CmmStmt] -> Maybe [CmmStmt]
-lookForInline' _ _    _      [] = panic "lookForInline' []"
-lookForInline' u expr regset (stmt : rest)
-  | Just 1 <- lookupUFM (countUses stmt) u, okToInline expr stmt
-  = Just (inlineStmt u expr stmt : rest)
-
-  | okToSkip stmt u expr regset
-  = case lookForInline' u expr regset rest of
-           Nothing    -> Nothing
-           Just stmts -> Just (stmt:stmts)
-
-  | otherwise 
-  = Nothing
-
-
--- we don't inline into CmmCall if the expression refers to global
--- registers.  This is a HACK to avoid global registers clashing with
--- C argument-passing registers, really the back-end ought to be able
--- to handle it properly, but currently neither PprC nor the NCG can
--- do it.  See also CgForeignCall:load_args_into_temps.
-okToInline :: CmmExpr -> CmmStmt -> Bool
-okToInline expr CmmCall{} = hasNoGlobalRegs expr
-okToInline _ _ = True
-
--- Expressions aren't side-effecting.  Temporaries may or may not
--- be single-assignment depending on the source (the old code
--- generator creates single-assignment code, but hand-written Cmm
--- and Cmm from the new code generator is not single-assignment.)
--- So we do an extra check to make sure that the register being
--- changed is not one we were relying on.  I don't know how much of a
--- performance hit this is (we have to create a regset for every
--- instruction.) -- EZY
-okToSkip :: CmmStmt -> Unique -> CmmExpr -> RegSet -> Bool
-okToSkip stmt u expr regset
-   = case stmt of
-         CmmNop -> True
-         CmmComment{} -> True
-         CmmAssign (CmmLocal r@(LocalReg u' _)) _rhs | u' /= u && not (r `elemRegSet` regset) -> True
-         CmmAssign g@(CmmGlobal _) _rhs -> not (g `regUsedIn` expr)
-         CmmStore _ _ -> not_a_load expr
-         _other -> False
-  where
-    not_a_load (CmmMachOp _ args) = all not_a_load args
-    not_a_load (CmmLoad _ _) = False
-    not_a_load _ = True
-
-inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
-inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
-inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
-inlineStmt u a (CmmCall target regs es ret)
-   = CmmCall (infn target) regs es' ret
-   where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv
-         infn (CmmPrim p mStmts) = CmmPrim p (fmap (map (inlineStmt u a)) mStmts)
-         es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
-inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
-inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
-inlineStmt u a (CmmJump e live) = CmmJump (inlineExpr u a e) live
-inlineStmt _ _ other_stmt = other_stmt
-
-inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
-inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
-  | u == u' = a
-  | otherwise = e
-inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
-  | u == u' = CmmMachOp (MO_Add width) [a, CmmLit (CmmInt (fromIntegral off) width)]
-  | otherwise = e
-  where
-    width = typeWidth rep
-inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
-inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
-inlineExpr _ _ other_expr = other_expr
 
 -- -----------------------------------------------------------------------------
 -- MachOp constant folder
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
deleted file mode 100644 (file)
index 311f947..0000000
+++ /dev/null
@@ -1,234 +0,0 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-The Code Generator
-
-This module says how things get going at the top level.
-
-@codeGen@ is the interface to the outside world. The \tr{cgTop*}
-functions drive the mangling of top-level bindings.
-
-\begin{code}
-
-module CodeGen ( codeGen ) where
-
-#include "HsVersions.h"
-
--- Required so that CgExpr is reached via at least one non-SOURCE
--- import. Before, that wasn't the case, and CM therefore didn't
--- bother to compile it.
-import CgExpr ( {-NOTHING!-} ) -- DO NOT DELETE THIS IMPORT
-import CgProf
-import CgMonad
-import CgBindery
-import CgClosure
-import CgCon
-import CgUtils
-import CgHpc
-
-import CLabel
-import OldCmm
-import OldPprCmm ()
-
-import StgSyn
-import PrelNames
-import DynFlags
-
-import HscTypes
-import CostCentre
-import Id
-import Name
-import TyCon
-import Module
-import ErrUtils
-import Panic
-import Outputable
-import Util
-
-import OrdList
-import Stream (Stream, liftIO)
-import qualified Stream
-
-import Data.IORef
-
-codeGen :: DynFlags
-        -> Module                     -- Module we are compiling
-        -> [TyCon]                    -- Type constructors
-        -> CollectedCCs               -- (Local/global) cost-centres needing declaring/registering.
-        -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-        -> HpcInfo                    -- Profiling info
-        -> Stream IO CmmGroup ()
-              -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
-              -- possible for object splitting to split up the
-              -- pieces later.
-
-codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
-
-   = do { liftIO $ showPass dflags "CodeGen"
-
-        ; cgref <- liftIO $ newIORef =<< initC
-        ; let cg :: FCode CmmGroup -> Stream IO CmmGroup ()
-              cg fcode = do
-                cmm <- liftIO $ do
-                         st <- readIORef cgref
-                         let (a,st') = runC dflags this_mod st fcode
-
-                         dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" $ ppr a
-
-                         -- NB. stub-out cgs_tops and cgs_stmts.  This fixes
-                         -- a big space leak.  DO NOT REMOVE!
-                         writeIORef cgref $! st'{ cgs_tops = nilOL,
-                                                  cgs_stmts = nilOL }
-                         return a
-                Stream.yield cmm
-
-        ; cg (getCmm $ mkModuleInit dflags cost_centre_info this_mod hpc_info)
-
-        ; mapM_ (cg . getCmm . cgTopBinding dflags) stg_binds
-
-        ; mapM_ (cg . cgTyCon) data_tycons
-        }
-
-mkModuleInit
-        :: DynFlags
-        -> CollectedCCs         -- cost centre info
-        -> Module
-        -> HpcInfo
-        -> Code
-
-mkModuleInit dflags cost_centre_info this_mod hpc_info
-  = do  { -- Allocate the static boolean that records if this
-        ; whenC (dopt Opt_Hpc dflags) $
-              hpcTable this_mod hpc_info
-
-        ; whenC (dopt Opt_SccProfilingOn dflags) $ do
-            initCostCentres cost_centre_info
-
-            -- For backwards compatibility: user code may refer to this
-            -- label for calling hs_add_root().
-        ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) []))
-
-        ; whenC (this_mod == mainModIs dflags) $
-             emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
-    }
-\end{code}
-
-
-
-Cost-centre profiling: Besides the usual stuff, we must produce
-declarations for the cost-centres defined in this module;
-
-(The local cost-centres involved in this are passed into the
-code-generator.)
-
-\begin{code}
-initCostCentres :: CollectedCCs -> Code
--- Emit the declarations, and return code to register them
-initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
-  = do dflags <- getDynFlags
-       if not (dopt Opt_SccProfilingOn dflags)
-           then nopC
-           else do mapM_ emitCostCentreDecl      local_CCs
-                   mapM_ emitCostCentreStackDecl singleton_CCSs
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsection[codegen-top-bindings]{Converting top-level STG bindings}
-%*                                                                      *
-%************************************************************************
-
-@cgTopBinding@ is only used for top-level bindings, since they need
-to be allocated statically (not in the heap) and need to be labelled.
-No unboxed bindings can happen at top level.
-
-In the code below, the static bindings are accumulated in the
-@MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
-This is so that we can write the top level processing in a compositional
-style, with the increasing static environment being plumbed as a state
-variable.
-
-\begin{code}
-cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags (StgNonRec id rhs, srts)
-  = do  { id' <- maybeExternaliseId dflags id
-        ; mapM_ (mkSRT [id']) srts
-        ; (id,info) <- cgTopRhs id' rhs
-        ; addBindC id info      -- Add the *un-externalised* Id to the envt,
-                                -- so we find it when we look up occurrences
-        }
-
-cgTopBinding dflags (StgRec pairs, srts)
-  = do  { let (bndrs, rhss) = unzip pairs
-        ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
-        ; let pairs' = zip bndrs' rhss
-        ; mapM_ (mkSRT bndrs')  srts
-        ; _new_binds <- fixC (\ new_binds -> do
-                { addBindsC new_binds
-                ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
-        ; nopC }
-
-mkSRT :: [Id] -> (Id,[Id]) -> Code
-mkSRT _ (_,[])  = nopC
-mkSRT these (id,ids)
-  = do  { ids <- mapFCs remap ids
-        ; id  <- remap id
-        ; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id))
-               (map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids)
-        }
-  where
-        -- Sigh, better map all the ids against the environment in
-        -- case they've been externalised (see maybeExternaliseId below).
-    remap id = case filter (==id) these of
-                (id':_) -> returnFC id'
-                [] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) }
-
--- Urgh!  I tried moving the forkStatics call from the rhss of cgTopRhs
--- to enclose the listFCs in cgTopBinding, but that tickled the
--- statics "error" call in initC.  I DON'T UNDERSTAND WHY!
-
-cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-        -- The Id is passed along for setting up a binding...
-        -- It's already been externalised if necessary
-
-cgTopRhs bndr (StgRhsCon _cc con args)
-  = forkStatics (cgTopRhsCon bndr con args)
-
-cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = ASSERT(null fvs)    -- There should be no free variables
-    setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
-    setSRT srt $
-    forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
-\subsection{Stuff to support splitting}
-%*                                                                      *
-%************************************************************************
-
-If we're splitting the object, we need to externalise all the top-level names
-(and then make sure we only use the externalised one in any C label we use
-which refers to this name).
-
-\begin{code}
-maybeExternaliseId :: DynFlags -> Id -> FCode Id
-maybeExternaliseId dflags id
-  | dopt Opt_SplitObjs dflags,  -- Externalise the name for -split-objs
-    isInternalName name = do { mod <- getModuleName
-                             ; returnFC (setIdName id (externalise mod)) }
-  | otherwise           = returnFC id
-  where
-    externalise mod = mkExternalName uniq mod new_occ loc
-    name    = idName id
-    uniq    = nameUnique name
-    new_occ = mkLocalOcc uniq (nameOccName name)
-    loc     = nameSrcSpan name
-        -- We want to conjure up a name that can't clash with any
-        -- existing name.  So we generate
-        --      Mod_$L243foo
-        -- where 243 is the unique.
-\end{code}
index f1022e5..37ca5e0 100644 (file)
@@ -52,7 +52,7 @@ codeGen :: DynFlags
          -> Module
          -> [TyCon]
          -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
-         -> [(StgBinding,[(Id,[Id])])]  -- Bindings to convert, with SRTs
+         -> [StgBinding]                -- Bindings to convert
          -> HpcInfo
          -> Stream IO CmmGroup ()       -- Output as a stream, so codegen can
                                         -- be interleaved with output
@@ -114,8 +114,8 @@ This is so that we can write the top level processing in a compositional
 style, with the increasing static environment being plumbed as a state
 variable. -}
 
-cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
-cgTopBinding dflags (StgNonRec id rhs, _srts)
+cgTopBinding :: DynFlags -> StgBinding -> FCode ()
+cgTopBinding dflags (StgNonRec id rhs)
   = do  { id' <- maybeExternaliseId dflags id
         ; (info, fcode) <- cgTopRhs id' rhs
         ; fcode
@@ -123,7 +123,7 @@ cgTopBinding dflags (StgNonRec id rhs, _srts)
                                      -- so we find it when we look up occurrences
         }
 
-cgTopBinding dflags (StgRec pairs, _srts)
+cgTopBinding dflags (StgRec pairs)
   = do  { let (bndrs, rhss) = unzip pairs
         ; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs
         ; let pairs' = zip bndrs' rhss
index f07cccf..6d83150 100644 (file)
@@ -245,7 +245,6 @@ Library
         StgCmmTicky
         StgCmmUtils
         ClosureInfo
-        CodeGen
         SMRep
         CoreArity
         CoreFVs
@@ -364,7 +363,6 @@ Library
         SimplMonad
         SimplUtils
         Simplify
-        SRT
         SimplStg
         StgStats
         UnariseStg
index 080539a..ed273d9 100644 (file)
@@ -348,7 +348,6 @@ data DynFlag
    | Opt_RunCPSZ
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified
-   | Opt_TryNewCodeGen
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -2267,7 +2266,6 @@ fFlags = [
   ( "print-bind-contents",              Opt_PrintBindContents, nop ),
   ( "run-cps",                          Opt_RunCPS, nop ),
   ( "run-cpsz",                         Opt_RunCPSZ, nop ),
-  ( "new-codegen",                      Opt_TryNewCodeGen, nop ),
   ( "vectorise",                        Opt_Vectorise, nop ),
   ( "avoid-vect",                       Opt_AvoidVect, nop ),
   ( "regs-graph",                       Opt_RegsGraph, nop ),
@@ -2461,8 +2459,6 @@ defaultFlags platform
 
       Opt_SharedImplib,
 
-      Opt_TryNewCodeGen,
-
       Opt_GenManifest,
       Opt_EmbedManifest,
       Opt_PrintBindContents,
index 5c3fa0d..9a4935c 100644 (file)
@@ -90,7 +90,6 @@ import Panic
 import GHC.Exts
 #endif
 
-import Id
 import Module
 import Packages
 import RdrName
@@ -119,7 +118,6 @@ import ProfInit
 import TyCon
 import Name
 import SimplStg         ( stg2stg )
-import CodeGen          ( codeGen )
 import qualified OldCmm as Old
 import qualified Cmm as New
 import CmmParse         ( parseCmmFile )
@@ -1284,16 +1282,10 @@ hscGenHardCode cgguts mod_summary = do
 
         ------------------  Code generation ------------------
 
-        cmms <- if dopt Opt_TryNewCodeGen dflags
-                    then {-# SCC "NewCodeGen" #-}
+        cmms <- {-# SCC "NewCodeGen" #-}
                          tryNewCodeGen hsc_env this_mod data_tycons
                              cost_centre_info
                              stg_binds hpc_info
-                    else {-# SCC "CodeGen" #-}
-                         return (codeGen dflags this_mod data_tycons
-                               cost_centre_info
-                               stg_binds hpc_info)
-
 
         ------------------  Code output -----------------------
         rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
@@ -1369,7 +1361,7 @@ hscCompileCmmFile hsc_env filename = runHsc hsc_env $ do
 
 tryNewCodeGen   :: HscEnv -> Module -> [TyCon]
                 -> CollectedCCs
-                -> [(StgBinding,[(Id,[Id])])]
+                -> [StgBinding]
                 -> HpcInfo
                 -> IO (Stream IO Old.CmmGroup ())
          -- Note we produce a 'Stream' of CmmGroups, so that the
@@ -1437,7 +1429,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
 
 
 myCoreToStg :: DynFlags -> Module -> CoreProgram
-            -> IO ( [(StgBinding,[(Id,[Id])])] -- output program
+            -> IO ( [StgBinding] -- output program
                   , CollectedCCs) -- cost centre info (declared and used)
 myCoreToStg dflags this_mod prepd_binds = do
     stg_binds
index 870d285..47fd96c 100644 (file)
@@ -51,7 +51,7 @@ import NCGMonad
 import BlockId
 import CgUtils          ( fixStgRegisters )
 import OldCmm
-import CmmOpt           ( cmmEliminateDeadBlocks, cmmMiniInline, cmmMachOpFold )
+import CmmOpt           ( cmmMachOpFold )
 import OldPprCmm
 import CLabel
 
@@ -858,15 +858,13 @@ genMachCode dflags cmmTopCodeGen cmm_top
 Here we do:
 
   (a) Constant folding
-  (b) Simple inlining: a temporary which is assigned to and then
-      used, once, can be shorted.
   (c) Position independent code and dynamic linking
         (i)  introduce the appropriate indirections
              and position independent refs
         (ii) compile a list of imported symbols
   (d) Some arch-specific optimizations
 
-(a) and (b) will be moving to the new Hoopl pipeline, however, (c) and
+(a) will be moving to the new Hoopl pipeline, however, (c) and
 (d) are only needed by the native backend and will continue to live
 here.
 
@@ -881,14 +879,7 @@ Ideas for other things we could do (put these in Hoopl please!):
 cmmToCmm :: DynFlags -> RawCmmDecl -> (RawCmmDecl, [CLabel])
 cmmToCmm _ top@(CmmData _ _) = (top, [])
 cmmToCmm dflags (CmmProc info lbl (ListGraph blocks)) = runCmmOpt dflags $ do
-  let reachable_blocks | dopt Opt_TryNewCodeGen dflags = blocks
-                       | otherwise = cmmEliminateDeadBlocks blocks
-      -- The new codegen path has already eliminated unreachable blocks by now
-
-      inlined_blocks | dopt Opt_TryNewCodeGen dflags = reachable_blocks
-                     | otherwise = cmmMiniInline dflags reachable_blocks
-
-  blocks' <- mapM cmmBlockConFold inlined_blocks
+  blocks' <- mapM cmmBlockConFold blocks
   return $ CmmProc info lbl (ListGraph blocks')
 
 newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))
diff --git a/compiler/simplStg/SRT.lhs b/compiler/simplStg/SRT.lhs
deleted file mode 100644 (file)
index 92cfad3..0000000
+++ /dev/null
@@ -1,166 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-Run through the STG code and compute the Static Reference Table for
-each let-binding.  At the same time, we figure out which top-level
-bindings have no CAF references, and record the fact in their IdInfo.
-
-\begin{code}
-module SRT( computeSRTs ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-import Id               ( Id )
-import VarSet
-import VarEnv
-import Maybes           ( orElse, expectJust )
-import Bitmap
-
-import DynFlags
-import Outputable
-
-import Data.List
-\end{code}
-
-\begin{code}
-computeSRTs :: DynFlags -> [StgBinding] -> [(StgBinding,[(Id,[Id])])]
-  -- The incoming bindingd are filled with SRTEntries in their SRT slots
-  -- the outgoing ones have NoSRT/SRT values instead
-
-computeSRTs dflags binds = srtTopBinds dflags emptyVarEnv binds
-
--- --------------------------------------------------------------------------
--- Top-level Bindings
-
-srtTopBinds :: DynFlags -> IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
-
-srtTopBinds _ _   [] = []
-srtTopBinds dflags env (StgNonRec b rhs : binds) =
-  (StgNonRec b rhs', [(b,srt')]) : srtTopBinds dflags env' binds
-  where
-    (rhs', srt) = srtTopRhs dflags b rhs
-    env' = maybeExtendEnv env b rhs
-    srt' = applyEnvList env srt
-srtTopBinds dflags env (StgRec bs : binds) =
-  (StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds dflags env binds
-  where
-    (rhss, srts) = unzip [ srtTopRhs dflags b r | (b,r) <- bs ]
-    bndrs = map fst bs
-    srts' = map (applyEnvList env) srts
-
--- Shorting out indirections in SRTs:  if a binding has an SRT with a single
--- element in it, we just inline it with that element everywhere it occurs
--- in other SRTs.
---
--- This is in a way a generalisation of the CafInfo.  CafInfo says
--- whether a top-level binding has *zero* CAF references, allowing us
--- to omit it from SRTs.  Here, we pick up bindings with *one* CAF
--- reference, and inline its SRT everywhere it occurs.  We could pass
--- this information across module boundaries too, but we currently
--- don't.
-
-maybeExtendEnv ::IdEnv Id -> Id -> StgRhs -> IdEnv Id
-maybeExtendEnv env bndr (StgRhsClosure _ _ _ ReEntrant (SRTEntries cafs) _ _)
-  | [one] <- varSetElems cafs
-  = extendVarEnv env bndr (applyEnv env one)
-maybeExtendEnv env _ _ = env
-
-applyEnvList :: IdEnv Id -> [Id] -> [Id]
-applyEnvList env = map (applyEnv env)
-
-applyEnv :: IdEnv Id -> Id -> Id
-applyEnv env id = lookupVarEnv env id `orElse` id
-
--- ----  Top-level right hand sides:
-
-srtTopRhs :: DynFlags -> Id -> StgRhs -> (StgRhs, [Id])
-
-srtTopRhs _ _ rhs@(StgRhsCon _ _ _) = (rhs, [])
-srtTopRhs dflags _ rhs@(StgRhsClosure _ _ _ _  (SRTEntries cafs) _ _)
-  = (srtRhs dflags table rhs, elems)
-  where
-        elems = varSetElems cafs
-        table = mkVarEnv (zip elems [0..])
-srtTopRhs _ _ (StgRhsClosure _ _ _ _  NoSRT _ _) = panic "srtTopRhs NoSRT"
-srtTopRhs _ _ (StgRhsClosure _ _ _ _  (SRT _ _ _) _ _) = panic "srtTopRhs SRT"
-
--- ---- Binds:
-
-srtBind :: DynFlags -> IdEnv Int -> StgBinding -> StgBinding
-
-srtBind dflags table (StgNonRec binder rhs) = StgNonRec binder (srtRhs dflags table rhs)
-srtBind dflags table (StgRec pairs) = StgRec [ (b, srtRhs dflags table r) | (b,r) <- pairs ]
-
--- ---- Right Hand Sides:
-
-srtRhs :: DynFlags -> IdEnv Int -> StgRhs -> StgRhs
-
-srtRhs _      _     e@(StgRhsCon _ _ _) = e
-srtRhs dflags table (StgRhsClosure cc bi free_vars u srt args body)
-  = StgRhsClosure cc bi free_vars u (constructSRT dflags table srt) args
-        $! (srtExpr dflags table body)
-
--- ---------------------------------------------------------------------------
--- Expressions
-
-srtExpr :: DynFlags -> IdEnv Int -> StgExpr -> StgExpr
-
-srtExpr _ _ e@(StgApp _ _)       = e
-srtExpr _ _ e@(StgLit _)         = e
-srtExpr _ _ e@(StgConApp _ _)    = e
-srtExpr _ _ e@(StgOpApp _ _ _)   = e
-
-srtExpr dflags table (StgSCC cc tick push expr) = StgSCC cc tick push $! srtExpr dflags table expr
-
-srtExpr dflags table (StgTick m n expr) = StgTick m n $! srtExpr dflags table expr
-
-srtExpr dflags table (StgCase scrut live1 live2 uniq srt alt_type alts)
- = StgCase expr' live1 live2 uniq srt' alt_type alts'
- where
-   expr' = srtExpr dflags table scrut
-   srt'  = constructSRT dflags table srt
-   alts' = map (srtAlt dflags table) alts
-
-srtExpr dflags table (StgLet bind body)
-  = srtBind dflags table bind =: \ bind' ->
-    srtExpr dflags table body             =: \ body' ->
-    StgLet bind' body'
-
-srtExpr dflags table (StgLetNoEscape live1 live2 bind body)
-  = srtBind dflags table bind =: \ bind' ->
-    srtExpr dflags table body             =: \ body' ->
-    StgLetNoEscape live1 live2 bind' body'
-
-srtExpr _ _table expr = pprPanic "srtExpr" (ppr expr)
-
-srtAlt :: DynFlags -> IdEnv Int -> StgAlt -> StgAlt
-srtAlt dflags table (con,args,used,rhs)
-  = (,,,) con args used $! srtExpr dflags table rhs
-
------------------------------------------------------------------------------
--- Construct an SRT bitmap.
-
-constructSRT :: DynFlags -> IdEnv Int -> SRT -> SRT
-constructSRT dflags table (SRTEntries entries)
- | isEmptyVarSet entries = NoSRT
- | otherwise  = seqBitmap bitmap $ SRT offset len bitmap
-  where
-    ints = map (expectJust "constructSRT" . lookupVarEnv table)
-                (varSetElems entries)
-    sorted_ints = sort ints
-    offset = head sorted_ints
-    bitmap_entries = map (subtract offset) sorted_ints
-    len = last bitmap_entries + 1
-    bitmap = intsToBitmap dflags len bitmap_entries
-constructSRT _ _ NoSRT = panic "constructSRT NoSRT"
-constructSRT _ _ (SRT {}) = panic "constructSRT SRT"
-
--- ---------------------------------------------------------------------------
--- Misc stuff
-
-(=:) :: a -> (a -> b) -> b
-a =: k  = k a
-
-\end{code}
index 129d8c6..871a5f4 100644 (file)
@@ -22,12 +22,10 @@ import SCCfinal             ( stgMassageForProfiling )
 import StgLint         ( lintStgBindings )
 import StgStats                ( showStgStats )
 import UnariseStg       ( unarise )
-import SRT             ( computeSRTs )
 
 import DynFlags                ( DynFlags(..), DynFlag(..), dopt, StgToDo(..),
                          getStgToDo )
-import Id              ( Id )
-import Module          ( Module )
+import Module           ( Module )
 import ErrUtils
 import SrcLoc
 import UniqSupply      ( mkSplitUniqSupply, splitUniqSupply )
@@ -38,7 +36,7 @@ import Outputable
 stg2stg :: DynFlags                 -- includes spec of what stg-to-stg passes to do
        -> Module                    -- module name (profiling only)
        -> [StgBinding]              -- input...
-       -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program...
+        -> IO ( [StgBinding]  -- output program...
              , CollectedCCs)        -- cost centre information (declared and used)
 
 stg2stg dflags module_name binds
@@ -56,14 +54,11 @@ stg2stg dflags module_name binds
                <- foldl_mn do_stg_pass (binds', us0, ccs) (getStgToDo dflags)
 
         ; let un_binds = unarise us1 processed_binds
-        ; let srt_binds
-               | dopt Opt_TryNewCodeGen dflags = zip un_binds (repeat [])
-               | otherwise = computeSRTs dflags un_binds
 
        ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
-                       (pprStgBindingsWithSRTs srt_binds)
+                        (pprStgBindings un_binds)
 
-       ; return (srt_binds, cost_centres)
+        ; return (un_binds, cost_centres)
    }
 
   where
index e5c525e..8d00f94 100644 (file)
@@ -38,7 +38,7 @@ module StgSyn (
         isDllConApp,
         stgArgType,
 
-        pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs,
+        pprStgBinding, pprStgBindings,
         pprStgLVs
     ) where
 
@@ -651,16 +651,6 @@ pprStgBinding  bind  = pprGenStgBinding bind
 pprStgBindings :: [StgBinding] -> SDoc
 pprStgBindings binds = vcat (map pprGenStgBinding binds)
 
-pprGenStgBindingWithSRT :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
-                        => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
-pprGenStgBindingWithSRT (bind,srts)
-  = vcat $ pprGenStgBinding bind : map pprSRT srts
-  where pprSRT (id,srt) =
-           ptext (sLit "SRT") <> parens (ppr id) <> ptext (sLit ": ") <> ppr srt
-
-pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
-pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
-
 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
     ppr = pprStgArg