compiler/codeGen/StgCmm.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Stg to C-- code generation
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module StgCmm ( codeGen ) where
  10
  11 #define FAST_STRING_NOT_NEEDED
  12 #include "HsVersions.h"
  13
  14 import StgCmmProf
  15 import StgCmmMonad
  16 import StgCmmEnv
  17 import StgCmmBind
  18 import StgCmmCon
  19 import StgCmmLayout
  20 import StgCmmHeap
  21 import StgCmmUtils
  22 import StgCmmClosure
  23 import StgCmmHpc
  24 import StgCmmTicky
  25
  26 import MkGraph
  27 import CmmExpr
  28 import CmmDecl
  29 import CLabel
  30 import PprCmm
  31
  32 import StgSyn
  33 import DynFlags
  34
  35 import HscTypes
  36 import CostCentre
  37 import Id
  38 import IdInfo
  39 import Type
  40 import DataCon
  41 import Name
  42 import TyCon
  43 import Module
  44 import ErrUtils
  45 import Outputable
  46
  47 codeGen :: DynFlags
  48          -> Module
  49          -> [TyCon]
  50          -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
  51          -> [(StgBinding,[(Id,[Id])])]  -- Bindings to convert, with SRTs
  52          -> HpcInfo
  53          -> IO [Cmm]            -- Output
  54
  55 codeGen dflags this_mod data_tycons
  56         cost_centre_info stg_binds hpc_info
  57   = do  { showPass dflags "New CodeGen"
  58
  59 -- Why?
  60 --   ; mapM_ (\x -> seq x (return ())) data_tycons
  61
  62         ; code_stuff <- initC dflags this_mod $ do
  63                 { cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
  64                 ; cmm_tycons <- mapM cgTyCon data_tycons
  65                 ; cmm_init   <- getCmm (mkModuleInit cost_centre_info
  66                                              this_mod hpc_info)
  67                 ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
  68                 }
  69                 -- Put datatype_stuff after code_stuff, because the
  70                 -- datatype closure table (for enumeration types) to
  71                 -- (say) PrelBase_True_closure, which is defined in
  72                 -- code_stuff
  73
  74                 -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
  75                 -- possible for object splitting to split up the
  76                 -- pieces later.
  77
  78                 -- Note [codegen-split-init] the cmm_init block must
  79                 -- come FIRST.  This is because when -split-objs is on
  80                 -- we need to combine this block with its
  81                 -- initialisation routines; see Note
  82                 -- [pipeline-split-init].
  83
  84         ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" (pprCmms code_stuff)
  85
  86         ; return code_stuff }
  87
  88
  89 ---------------------------------------------------------------
  90 --      Top-level bindings
  91 ---------------------------------------------------------------
  92
  93 {- 'cgTopBinding' is only used for top-level bindings, since they need
  94 to be allocated statically (not in the heap) and need to be labelled.
  95 No unboxed bindings can happen at top level.
  96
  97 In the code below, the static bindings are accumulated in the
  98 @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
  99 This is so that we can write the top level processing in a compositional
 100 style, with the increasing static environment being plumbed as a state
 101 variable. -}
 102
 103 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
 104 cgTopBinding dflags (StgNonRec id rhs, _srts)
 105   = do  { id' <- maybeExternaliseId dflags id
 106         ; info <- cgTopRhs id' rhs
 107         ; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
 108                                      -- so we find it when we look up occurrences
 109         }
 110
 111 cgTopBinding dflags (StgRec pairs, _srts)
 112   = do  { let (bndrs, rhss) = unzip pairs
 113         ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 114         ; let pairs' = zip bndrs' rhss
 115         ; fixC_(\ new_binds -> do
 116                 { addBindsC new_binds
 117                 ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 118         ; return () }
 119
 120 -- Urgh!  I tried moving the forkStatics call from the rhss of cgTopRhs
 121 -- to enclose the listFCs in cgTopBinding, but that tickled the
 122 -- statics "error" call in initC.  I DON'T UNDERSTAND WHY!
 123
 124 cgTopRhs :: Id -> StgRhs -> FCode CgIdInfo
 125         -- The Id is passed along for setting up a binding...
 126         -- It's already been externalised if necessary
 127
 128 cgTopRhs bndr (StgRhsCon _cc con args)
 129   = forkStatics (cgTopRhsCon bndr con args)
 130
 131 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
 132   = ASSERT(null fvs)    -- There should be no free variables
 133     setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
 134     forkStatics (cgTopRhsClosure bndr cc bi upd_flag srt args body)
 135
 136
 137 ---------------------------------------------------------------
 138 --      Module initialisation code
 139 ---------------------------------------------------------------
 140
 141 {- The module initialisation code looks like this, roughly:
 142
 143         FN(__stginit_Foo) {
 144           JMP_(__stginit_Foo_1_p)
 145         }
 146
 147         FN(__stginit_Foo_1_p) {
 148         ...
 149         }
 150
 151    We have one version of the init code with a module version and the
 152    'way' attached to it.  The version number helps to catch cases
 153    where modules are not compiled in dependency order before being
 154    linked: if a module has been compiled since any modules which depend on
 155    it, then the latter modules will refer to a different version in their
 156    init blocks and a link error will ensue.
 157
 158    The 'way' suffix helps to catch cases where modules compiled in different
 159    ways are linked together (eg. profiled and non-profiled).
 160
 161    We provide a plain, unadorned, version of the module init code
 162    which just jumps to the version with the label and way attached.  The
 163    reason for this is that when using foreign exports, the caller of
 164    startupHaskell() must supply the name of the init function for the "top"
 165    module in the program, and we don't want to require that this name
 166    has the version and way info appended to it.
 167
 168 We initialise the module tree by keeping a work-stack,
 169         * pointed to by Sp
 170         * that grows downward
 171         * Sp points to the last occupied slot
 172 -}
 173
 174 mkModuleInit
 175         :: CollectedCCs         -- cost centre info
 176         -> Module
 177         -> HpcInfo
 178         -> FCode ()
 179
 180 mkModuleInit cost_centre_info this_mod hpc_info
 181   = do  { initHpc this_mod hpc_info
 182         ; initCostCentres cost_centre_info
 183             -- For backwards compatibility: user code may refer to this
 184             -- label for calling hs_add_root().
 185         ; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
 186         }
 187
 188 ---------------------------------------------------------------
 189 --      Generating static stuff for algebraic data types
 190 ---------------------------------------------------------------
 191
 192 {-      [These comments are rather out of date]
 193
 194 Macro                        Kind of constructor
 195 CONST_INFO_TABLE@       Zero arity (no info -- compiler uses static closure)
 196 CHARLIKE_INFO_TABLE     Charlike   (no info -- compiler indexes fixed array)
 197 INTLIKE_INFO_TABLE      Intlike; the one macro generates both info tbls
 198 SPEC_INFO_TABLE         SPECish, and bigger than or equal to MIN_UPD_SIZE
 199 GEN_INFO_TABLE          GENish (hence bigger than or equal to MIN_UPD_SIZE@)
 200
 201 Possible info tables for constructor con:
 202
 203 * _con_info:
 204   Used for dynamically let(rec)-bound occurrences of
 205   the constructor, and for updates.  For constructors
 206   which are int-like, char-like or nullary, when GC occurs,
 207   the closure tries to get rid of itself.
 208
 209 * _static_info:
 210   Static occurrences of the constructor macro: STATIC_INFO_TABLE.
 211
 212 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
 213 it's place is taken by the top level defn of the constructor.
 214
 215 For charlike and intlike closures there is a fixed array of static
 216 closures predeclared.
 217 -}
 218
 219 cgTyCon :: TyCon -> FCode [Cmm]  -- All constructors merged together
 220 cgTyCon tycon
 221   = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 222
 223             -- Generate a table of static closures for an enumeration type
 224             -- Put the table after the data constructor decls, because the
 225             -- datatype closure table (for enumeration types)
 226             -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
 227             -- Note that the closure pointers are tagged.
 228
 229             -- N.B. comment says to put table after constructor decls, but
 230             -- code puts it before --- NR 16 Aug 2007
 231         ; extra <- cgEnumerationTyCon tycon
 232
 233         ; return (extra ++ constrs)
 234         }
 235
 236 cgEnumerationTyCon :: TyCon -> FCode [Cmm]
 237 cgEnumerationTyCon tycon
 238   | isEnumerationTyCon tycon
 239   = do  { tbl <- getCmm $
 240                  emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
 241                    [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)
 242                                  (tagForCon con)
 243                    | con <- tyConDataCons tycon]
 244         ; return [tbl] }
 245   | otherwise
 246   = return []
 247
 248 cgDataCon :: DataCon -> FCode ()
 249 -- Generate the entry code, info tables, and (for niladic constructor)
 250 -- the static closure, for a constructor.
 251 cgDataCon data_con
 252   = do  { let
 253             -- To allow the debuggers, interpreters, etc to cope with
 254             -- static data structures (ie those built at compile
 255             -- time), we take care that info-table contains the
 256             -- information we need.
 257             (static_cl_info, _) = layOutStaticConstr data_con arg_reps
 258             (dyn_cl_info, arg_things) = layOutDynConstr data_con arg_reps
 259
 260             emit_info cl_info ticky_code
 261                 = emitClosureAndInfoTable cl_info NativeDirectCall []
 262                                         $ mk_code ticky_code
 263
 264             mk_code ticky_code
 265               =         -- NB: We don't set CC when entering data (WDP 94/06)
 266                 do { _ <- ticky_code
 267                    ; ldvEnter (CmmReg nodeReg)
 268                    ; tickyReturnOldCon (length arg_things)
 269                    ; emitReturn [cmmOffsetB (CmmReg nodeReg)
 270                                             (tagForCon data_con)] }
 271                         -- The case continuation code expects a tagged pointer
 272
 273             arg_reps :: [(PrimRep, Type)]
 274             arg_reps = [(typePrimRep ty, ty) | ty <- dataConRepArgTys data_con]
 275
 276             -- Dynamic closure code for non-nullary constructors only
 277         ; whenC (not (isNullaryRepDataCon data_con))
 278                 (emit_info dyn_cl_info tickyEnterDynCon)
 279
 280                 -- Dynamic-Closure first, to reduce forward references
 281         ; emit_info static_cl_info tickyEnterStaticCon }
 282
 283
 284 ---------------------------------------------------------------
 285 --      Stuff to support splitting
 286 ---------------------------------------------------------------
 287
 288 -- If we're splitting the object, we need to externalise all the
 289 -- top-level names (and then make sure we only use the externalised
 290 -- one in any C label we use which refers to this name).
 291
 292 maybeExternaliseId :: DynFlags -> Id -> FCode Id
 293 maybeExternaliseId dflags id
 294   | dopt Opt_SplitObjs dflags,  -- Externalise the name for -split-objs
 295     isInternalName name = do { mod <- getModuleName
 296                              ; returnFC (setIdName id (externalise mod)) }
 297   | otherwise           = returnFC id
 298   where
 299     externalise mod = mkExternalName uniq mod new_occ loc
 300     name    = idName id
 301     uniq    = nameUnique name
 302     new_occ = mkLocalOcc uniq (nameOccName name)
 303     loc     = nameSrcSpan name
 304         -- We want to conjure up a name that can't clash with any
 305         -- existing name.  So we generate
 306         --      Mod_$L243foo
 307         -- where 243 is the unique.