compiler/cmm/CmmCPSZ.hs

   1
   2 module CmmCPSZ (
   3   -- | Converts C-- with full proceedures and parameters
   4   -- to a CPS transformed C-- with the stack made manifest.
   5   -- Well, sort of.
   6   protoCmmCPSZ
   7 ) where
   8
   9 import Cmm
  10 import CmmContFlowOpt
  11 import CmmProcPointZ
  12 import CmmSpillReload
  13 import CmmTx
  14 import DFMonad
  15 import PprCmmZ()
  16 import ZipCfg hiding (zip, unzip)
  17 import ZipCfgCmmRep
  18 import ZipDataflow0
  19
  20 import DynFlags
  21 import ErrUtils
  22 import Outputable
  23 import UniqSupply
  24
  25 import Data.IORef
  26
  27 -----------------------------------------------------------------------------
  28 -- |Top level driver for the CPS pass
  29 -----------------------------------------------------------------------------
  30 protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
  31        -> CmmZ     -- ^ Input C-- with Proceedures
  32        -> IO CmmZ  -- ^ Output CPS transformed C--
  33 protoCmmCPSZ dflags (Cmm tops)
  34   = do  { showPass dflags "CPSZ"
  35         ; u <- mkSplitUniqSupply 'p'
  36         ; pass_ref <- newIORef "unoptimized program" -- XXX see [Note global fuel]
  37         ; fuel_ref <- newIORef (tankFilledTo maxBound) -- XXX see [Note global fuel]
  38         ; let txtops = initUs_ u $ mapM cpsTop tops
  39         ; tops <- runFuelIO pass_ref fuel_ref (sequence txtops)
  40         ; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr (Cmm tops))
  41         ; return $ Cmm tops
  42         }
  43
  44 {- [Note global fuel]
  45 ~~~~~~~~~~~~~~~~~~~~~
  46 In a correct world, the identity and the last pass would be stored in
  47 mutable reference cells associated with an 'HscEnv' and would be
  48 global to one compiler session.  Unfortunately the 'HscEnv' is not
  49 plumbed sufficiently close to this function; only the DynFlags are
  50 plumbed here.  One day the plumbing will be extended, in which case
  51 this pass will use the global 'pass_ref' and 'fuel_ref' instead of the
  52 bogus facsimiles in place here.
  53 -}
  54
  55 cpsTop :: CmmTopZ -> UniqSM (FuelMonad CmmTopZ)
  56 cpsTop p@(CmmData {}) = return (return p)
  57 cpsTop (CmmProc h l args g) =
  58     let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
  59         g' = addProcPointProtocols procPoints args g
  60         g'' = map_nodes id NotSpillOrReload id g'
  61     in do { u1 <- getUs; u2 <- getUs; u3 <- getUs
  62           ; entry <- getUniqueUs >>= return . BlockId
  63           ; return $
  64               do { g <- return g''
  65                  ; g <- dual_rewrite u1 dualLivenessWithInsertion g
  66                  ; g <- insertLateReloads' u2 (extend g)
  67                  ; g <- dual_rewrite u3 removeDeadAssignmentsAndReloads (trim entry g)
  68                  ; return $ CmmProc h l args $ map_nodes id spillAndReloadComments id g
  69                  }
  70           }
  71   where dual_rewrite u pass g = runDFM u dualLiveLattice $ b_rewrite pass g
  72         extend (LGraph eid blocks) = Graph (ZLast $ mkBranchNode eid) blocks
  73         trim _ (Graph (ZLast (LastOther (LastBranch id))) blocks) = LGraph id blocks
  74         trim e (Graph tail blocks) = LGraph e (insertBlock (Block e tail) blocks)