compiler/codeGen/CodeGen.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 The Code Generator
   7
   8 This module says how things get going at the top level.
   9
  10 @codeGen@ is the interface to the outside world.  The \tr{cgTop*}
  11 functions drive the mangling of top-level bindings.
  12
  13 \begin{code}
  14 module CodeGen ( codeGen ) where
  15
  16 #include "HsVersions.h"
  17
  18 -- Kludge (??) so that CgExpr is reached via at least one non-SOURCE
  19 -- import.  Before, that wasn't the case, and CM therefore didn't
  20 -- bother to compile it.
  21 import CgExpr           ( {-NOTHING!-} )        -- DO NOT DELETE THIS IMPORT
  22 import CgProf
  23 import CgMonad
  24 import CgBindery
  25 import CgClosure
  26 import CgCon
  27 import CgUtils
  28 import CgHpc
  29
  30 import CLabel
  31 import OldCmm
  32 import OldPprCmm
  33
  34 import StgSyn
  35 import PrelNames
  36 import DynFlags
  37 import StaticFlags
  38
  39 import HscTypes
  40 import CostCentre
  41 import Id
  42 import Name
  43 import TyCon
  44 import Module
  45 import ErrUtils
  46 import Panic
  47 \end{code}
  48
  49 \begin{code}
  50 codeGen :: DynFlags
  51         -> Module
  52         -> [TyCon]
  53         -> CollectedCCs         -- (Local/global) cost-centres needing declaring/registering.
  54         -> [(StgBinding,[(Id,[Id])])]   -- Bindings to convert, with SRTs
  55         -> HpcInfo
  56         -> IO [Cmm]             -- Output
  57
  58                 -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
  59                 -- possible for object splitting to split up the
  60                 -- pieces later.
  61
  62 codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
  63   = do
  64   { showPass dflags "CodeGen"
  65
  66 -- Why?
  67 --   ; mapM_ (\x -> seq x (return ())) data_tycons
  68
  69   ; code_stuff <- initC dflags this_mod $ do
  70                 { cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
  71                 ; cmm_tycons <- mapM cgTyCon data_tycons
  72                 ; cmm_init   <- getCmm (mkModuleInit dflags cost_centre_info
  73                                              this_mod hpc_info)
  74                 ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
  75                 }
  76                 -- Put datatype_stuff after code_stuff, because the
  77                 -- datatype closure table (for enumeration types) to
  78                 -- (say) PrelBase_True_closure, which is defined in
  79                 -- code_stuff
  80
  81                 -- Note [codegen-split-init] the cmm_init block must
  82                 -- come FIRST.  This is because when -split-objs is on
  83                 -- we need to combine this block with its
  84                 -- initialisation routines; see Note
  85                 -- [pipeline-split-init].
  86
  87   ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff)
  88
  89   ; return code_stuff }
  90
  91 mkModuleInit
  92         :: DynFlags
  93         -> CollectedCCs         -- cost centre info
  94         -> Module
  95         -> HpcInfo
  96         -> Code
  97
  98 mkModuleInit dflags cost_centre_info this_mod hpc_info
  99   = do  { -- Allocate the static boolean that records if this
 100         ; whenC (opt_Hpc) $
 101               hpcTable this_mod hpc_info
 102
 103         ; whenC (opt_SccProfilingOn) $ do
 104             initCostCentres cost_centre_info
 105
 106             -- For backwards compatibility: user code may refer to this
 107             -- label for calling hs_add_root().
 108         ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
 109
 110         ; whenC (this_mod == mainModIs dflags) $
 111              emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
 112     }
 113 \end{code}
 114
 115
 116
 117 Cost-centre profiling: Besides the usual stuff, we must produce
 118 declarations for the cost-centres defined in this module;
 119
 120 (The local cost-centres involved in this are passed into the
 121 code-generator.)
 122
 123 \begin{code}
 124 initCostCentres :: CollectedCCs -> Code
 125 -- Emit the declarations, and return code to register them
 126 initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
 127   | not opt_SccProfilingOn = nopC
 128   | otherwise
 129   = do  { mapM_ emitCostCentreDecl       local_CCs
 130         ; mapM_ emitCostCentreStackDecl  singleton_CCSs
 131         }
 132 \end{code}
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsection[codegen-top-bindings]{Converting top-level STG bindings}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 @cgTopBinding@ is only used for top-level bindings, since they need
 141 to be allocated statically (not in the heap) and need to be labelled.
 142 No unboxed bindings can happen at top level.
 143
 144 In the code below, the static bindings are accumulated in the
 145 @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
 146 This is so that we can write the top level processing in a compositional
 147 style, with the increasing static environment being plumbed as a state
 148 variable.
 149
 150 \begin{code}
 151 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
 152 cgTopBinding dflags (StgNonRec id rhs, srts)
 153   = do  { id' <- maybeExternaliseId dflags id
 154         ; mapM_ (mkSRT [id']) srts
 155         ; (id,info) <- cgTopRhs id' rhs
 156         ; addBindC id info      -- Add the *un-externalised* Id to the envt,
 157                                 -- so we find it when we look up occurrences
 158         }
 159
 160 cgTopBinding dflags (StgRec pairs, srts)
 161   = do  { let (bndrs, rhss) = unzip pairs
 162         ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 163         ; let pairs' = zip bndrs' rhss
 164         ; mapM_ (mkSRT bndrs')  srts
 165         ; _new_binds <- fixC (\ new_binds -> do
 166                 { addBindsC new_binds
 167                 ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 168         ; nopC }
 169
 170 mkSRT :: [Id] -> (Id,[Id]) -> Code
 171 mkSRT _ (_,[])  = nopC
 172 mkSRT these (id,ids)
 173   = do  { ids <- mapFCs remap ids
 174         ; id  <- remap id
 175         ; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id))
 176                (map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids)
 177         }
 178   where
 179         -- Sigh, better map all the ids against the environment in
 180         -- case they've been externalised (see maybeExternaliseId below).
 181     remap id = case filter (==id) these of
 182                 (id':_) -> returnFC id'
 183                 [] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) }
 184
 185 -- Urgh!  I tried moving the forkStatics call from the rhss of cgTopRhs
 186 -- to enclose the listFCs in cgTopBinding, but that tickled the
 187 -- statics "error" call in initC.  I DON'T UNDERSTAND WHY!
 188
 189 cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
 190         -- The Id is passed along for setting up a binding...
 191         -- It's already been externalised if necessary
 192
 193 cgTopRhs bndr (StgRhsCon _cc con args)
 194   = forkStatics (cgTopRhsCon bndr con args)
 195
 196 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
 197   = ASSERT(null fvs)    -- There should be no free variables
 198     setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
 199     setSRT srt $
 200     forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
 201 \end{code}
 202
 203
 204 %************************************************************************
 205 %*                                                                      *
 206 \subsection{Stuff to support splitting}
 207 %*                                                                      *
 208 %************************************************************************
 209
 210 If we're splitting the object, we need to externalise all the top-level names
 211 (and then make sure we only use the externalised one in any C label we use
 212 which refers to this name).
 213
 214 \begin{code}
 215 maybeExternaliseId :: DynFlags -> Id -> FCode Id
 216 maybeExternaliseId dflags id
 217   | dopt Opt_SplitObjs dflags,  -- Externalise the name for -split-objs
 218     isInternalName name = do { mod <- getModuleName
 219                              ; returnFC (setIdName id (externalise mod)) }
 220   | otherwise           = returnFC id
 221   where
 222     externalise mod = mkExternalName uniq mod new_occ loc
 223     name    = idName id
 224     uniq    = nameUnique name
 225     new_occ = mkLocalOcc uniq (nameOccName name)
 226     loc     = nameSrcSpan name
 227         -- We want to conjure up a name that can't clash with any
 228         -- existing name.  So we generate
 229         --      Mod_$L243foo
 230         -- where 243 is the unique.
 231 \end{code}