ghc/compiler/codeGen/CodeGen.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[CodeGen]{@CodeGen@: main module of the code generator}
   5
   6 This module says how things get going at the top level.
   7
   8 @codeGen@ is the interface to the outside world.  The \tr{cgTop*}
   9 functions drive the mangling of top-level bindings.
  10
  11 %************************************************************************
  12 %*                                                                      *
  13 \subsection[codeGen-outside-interface]{The code generator's offering to the world}
  14 %*                                                                      *
  15 %************************************************************************
  16
  17 \begin{code}
  18 #include "HsVersions.h"
  19
  20 module CodeGen (
  21         codeGen,
  22
  23         -- and to make the interface self-sufficient...
  24         UniqFM, AbstractC, StgBinding, Id, FiniteMap
  25     ) where
  26
  27
  28 import StgSyn
  29 import CgMonad
  30 import AbsCSyn
  31
  32 import CLabelInfo       ( modnameToC )
  33 import CgClosure        ( cgTopRhsClosure )
  34 import CgCon            ( cgTopRhsCon )
  35 import CgConTbls        ( genStaticConBits, TCE(..), UniqFM )
  36 import ClosureInfo      ( LambdaFormInfo, mkClosureLFInfo )
  37 import CmdLineOpts      ( GlobalSwitch(..), switchIsOn, stringSwitchSet, SwitchResult )
  38 import FiniteMap        ( FiniteMap )
  39 import Maybes           ( Maybe(..) )
  40 import PrimKind         ( getKindSize )
  41 import Util
  42 \end{code}
  43
  44 \begin{code}
  45 codeGen :: FAST_STRING          -- module name
  46         -> ([CostCentre],       -- local cost-centres needing declaring/registering
  47             [CostCentre])       -- "extern" cost-centres needing declaring
  48         -> [FAST_STRING]        -- import names
  49         -> (GlobalSwitch -> SwitchResult)
  50                                 -- global switch lookup function
  51         -> [TyCon]              -- tycons with data constructors to convert
  52         -> FiniteMap TyCon [[Maybe UniType]]
  53                                 -- tycon specialisation info
  54         -> PlainStgProgram      -- bindings to convert
  55         -> AbstractC            -- output
  56
  57 codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
  58   = let
  59         switch_is_on      = switchIsOn sw_lookup_fn
  60         doing_profiling   = switch_is_on SccProfilingOn
  61         compiling_prelude = switch_is_on CompilingPrelude
  62         splitting         = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
  63     in
  64     if not doing_profiling then
  65         let
  66             cinfo = MkCompInfo switch_is_on mod_name
  67         in
  68         mkAbstractCs [
  69             genStaticConBits cinfo gen_tycons tycon_specs,
  70             initC cinfo (cgTopBindings splitting stg_pgm) ]
  71
  72     else -- yes, cost-centre profiling:
  73          -- Besides the usual stuff, we must produce:
  74          --
  75          -- * Declarations for the cost-centres defined in this module;
  76          -- * Code to participate in "registering" all the cost-centres
  77          --   in the program (done at startup time when the pgm is run).
  78          --
  79          -- (The local cost-centres involved in this are passed
  80          -- into the code-generator, as are the imported-modules' names.)
  81          --
  82          -- Note: we don't register/etc if compiling Prelude bits.
  83         let
  84             cinfo = MkCompInfo switch_is_on mod_name
  85         in
  86         mkAbstractCs [
  87                 if compiling_prelude
  88                 then AbsCNop
  89                 else mkAbstractCs [mkAbstractCs (map (CCostCentreDecl True)  local_CCs),
  90                                    mkAbstractCs (map (CCostCentreDecl False) extern_CCs),
  91                                    mkCcRegister local_CCs import_names],
  92
  93                 genStaticConBits cinfo gen_tycons tycon_specs,
  94                 initC cinfo (cgTopBindings splitting stg_pgm) ]
  95   where
  96     -----------------
  97     grp_name  = case (stringSwitchSet sw_lookup_fn SccGroup) of
  98                   Just xx -> _PK_ xx
  99                   Nothing -> mod_name   -- default: module name
 100
 101     -----------------
 102     mkCcRegister ccs import_names
 103       = let
 104             register_ccs     = mkAbstractCs (map mk_register ccs)
 105             register_imports = mkAbstractCs (map mk_import_register import_names)
 106         in
 107         mkAbstractCs [
 108             CCallProfCCMacro SLIT("START_REGISTER_CCS") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ mod_name)) AddrKind],
 109             register_ccs,
 110             register_imports,
 111             CCallProfCCMacro SLIT("END_REGISTER_CCS") []
 112         ]
 113       where
 114         mk_register cc
 115           = CCallProfCCMacro SLIT("REGISTER_CC") [mkCCostCentre cc]
 116
 117         mk_import_register import_name
 118           = CCallProfCCMacro SLIT("REGISTER_IMPORT") [CLitLit (modnameToC (SLIT("_reg") _APPEND_ import_name)) AddrKind]
 119 \end{code}
 120
 121 %************************************************************************
 122 %*                                                                      *
 123 \subsection[codegen-top-bindings]{Converting top-level STG bindings}
 124 %*                                                                      *
 125 %************************************************************************
 126
 127 @cgTopBindings@ is only used for top-level bindings, since they need
 128 to be allocated statically (not in the heap) and need to be labelled.
 129 No unboxed bindings can happen at top level.
 130
 131 In the code below, the static bindings are accumulated in the
 132 @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
 133 This is so that we can write the top level processing in a compositional
 134 style, with the increasing static environment being plumbed as a state
 135 variable.
 136
 137 \begin{code}
 138 cgTopBindings :: Bool -> PlainStgProgram -> Code
 139
 140 cgTopBindings splitting bindings = mapCs (cgTopBinding splitting) bindings
 141
 142 cgTopBinding :: Bool -> PlainStgBinding -> Code
 143
 144 cgTopBinding splitting (StgNonRec name rhs)
 145   = absC maybe_split    `thenC`
 146     cgTopRhs name rhs   `thenFC` \ (name, info) ->
 147     addBindC name info
 148   where
 149     maybe_split = if splitting then CSplitMarker else AbsCNop
 150
 151 cgTopBinding splitting (StgRec pairs)
 152   = absC maybe_split    `thenC`
 153     fixC (\ new_binds -> addBindsC new_binds    `thenC`
 154                          mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs
 155     )                   `thenFC` \ new_binds ->
 156     addBindsC new_binds
 157   where
 158     maybe_split = if splitting then CSplitMarker else AbsCNop
 159
 160 -- Urgh!  I tried moving the forkStatics call from the rhss of cgTopRhs
 161 -- to enclose the listFCs in cgTopBinding, but that tickled the
 162 -- statics "error" call in initC.  I DON'T UNDERSTAND WHY!
 163
 164 cgTopRhs :: Id -> PlainStgRhs -> FCode (Id, CgIdInfo)
 165         -- the Id is passed along for setting up a binding...
 166
 167 cgTopRhs name (StgRhsCon cc con args)
 168   = forkStatics (cgTopRhsCon name con args (all zero_size args))
 169   where
 170     zero_size atom = getKindSize (getAtomKind atom) == 0
 171
 172 cgTopRhs name (StgRhsClosure cc bi fvs upd_flag args body)
 173   = ASSERT(null fvs) -- There should be no free variables
 174     forkStatics (cgTopRhsClosure name cc bi args body lf_info)
 175   where
 176     lf_info = mkClosureLFInfo True{-top level-} [{-no fvs-}] upd_flag args body
 177 \end{code}