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