ghc/compiler/codeGen/CgConTbls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[CgConTbls]{Info tables and update bits for constructors}
   5
   6 \begin{code}
   7 module CgConTbls ( genStaticConBits ) where
   8
   9 #include "HsVersions.h"
  10
  11 import AbsCSyn
  12 import CgMonad
  13
  14 import AbsCUtils        ( mkAbsCStmts, mkAbstractCs, magicIdPrimRep )
  15 import Constants        ( uF_UPDATEE )
  16 import CgHeapery        ( heapCheck, allocDynClosure )
  17 import CgRetConv        ( dataReturnConvAlg, ctrlReturnConvAlg,
  18                           CtrlReturnConvention(..),
  19                           DataReturnConvention(..)
  20                         )
  21 import CgTailCall       ( performReturn, mkStaticAlgReturnCode )
  22 import CgUsages         ( getHpRelOffset )
  23 import CLabel           ( mkConEntryLabel, mkStaticClosureLabel,
  24                           mkConUpdCodePtrVecLabel,
  25                           mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel
  26                         )
  27 import ClosureInfo      ( layOutStaticClosure, layOutDynCon,
  28                           layOutPhantomClosure, closurePtrsSize,
  29                           fitsMinUpdSize, mkConLFInfo,
  30                           infoTableLabelFromCI, dataConLiveness,
  31                           ClosureInfo
  32                         )
  33 import CostCentre       ( dontCareCostCentre, CostCentre )
  34 import FiniteMap        ( fmToList, FiniteMap )
  35 import HeapOffs         ( zeroOff, VirtualHeapOffset )
  36 import Id               ( dataConTag, dataConRawArgTys,
  37                           dataConNumFields, fIRST_TAG,
  38                           emptyIdSet,
  39                           GenId{-instance NamedThing-}, Id
  40                         )
  41 import Name             ( getOccString )
  42 import PrimRep          ( getPrimRepSize, PrimRep(..) )
  43 import TyCon            ( tyConDataCons, mkSpecTyCon, TyCon )
  44 import Type             ( typePrimRep, Type )
  45 import Util             ( panic )
  46
  47 mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
  48 \end{code}
  49
  50 For every constructor we generate the following info tables:
  51         A static info table, for static instances of the constructor,
  52
  53         For constructors which return in registers (and only them),
  54                 an "inregs" info table.  This info table is rather emaciated;
  55                 it only contains update code and tag.
  56
  57         Plus:
  58
  59 \begin{tabular}{lll}
  60 Info tbls &      Macro  &            Kind of constructor \\
  61 \hline
  62 info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
  63 info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
  64 info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
  65 info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
  66 info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
  67 \end{tabular}
  68
  69 Possible info tables for constructor con:
  70
  71 \begin{description}
  72 \item[@con_info@:]
  73 Used for dynamically let(rec)-bound occurrences of
  74 the constructor, and for updates.  For constructors
  75 which are int-like, char-like or nullary, when GC occurs,
  76 the closure tries to get rid of itself.
  77
  78 \item[@con_inregs_info@:]
  79 Used when returning a new constructor in registers.
  80 Only for return-in-regs constructors.
  81 Macro: @INREGS_INFO_TABLE@.
  82
  83 \item[@con_static_info@:]
  84 Static occurrences of the constructor
  85 macro: @STATIC_INFO_TABLE@.
  86 \end{description}
  87
  88 For zero-arity constructors, \tr{con}, we also generate a static closure:
  89
  90 \begin{description}
  91 \item[@con_closure@:]
  92 A single static copy of the (zero-arity) constructor itself.
  93 \end{description}
  94
  95 For charlike and intlike closures there is a fixed array of static
  96 closures predeclared.
  97
  98 \begin{code}
  99 genStaticConBits :: CompilationInfo     -- global info about the compilation
 100                  -> [TyCon]             -- tycons to generate
 101                  -> FiniteMap TyCon [(Bool, [Maybe Type])]
 102                                         -- tycon specialisation info
 103                  -> AbstractC           -- output
 104
 105 genStaticConBits comp_info gen_tycons tycon_specs
 106   = -- for each type constructor:
 107     --   grab all its data constructors;
 108     --      for each one, generate an info table
 109     -- for each specialised type constructor
 110     --   for each specialisation of the type constructor
 111     --     grab data constructors, and generate info tables
 112
 113     -- ToDo: for tycons and specialisations which are not
 114     --       declared in this module we must ensure that the
 115     --       C labels are local to this module i.e. static
 116     --       since they may be duplicated in other modules
 117
 118     mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
 119       `mkAbsCStmts`
 120     mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
 121                                 | (imported_spec, spec) <- specs,
 122                                   -- no code generated if spec is imported
 123                                   not imported_spec
 124                                 ]
 125                  | (tc, specs) <- fmToList tycon_specs ]
 126   where
 127     gen_for_tycon :: TyCon -> AbstractC
 128     gen_for_tycon tycon
 129       = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
 130           `mkAbsCStmts`
 131         maybe_tycon_vtbl
 132       where
 133         data_cons       = tyConDataCons tycon
 134         tycon_upd_label = mkStdUpdVecTblLabel tycon
 135
 136         maybe_tycon_vtbl =
 137           case ctrlReturnConvAlg tycon of
 138             UnvectoredReturn 1 -> CRetUnVector tycon_upd_label
 139                                         (mk_upd_label tycon (head data_cons))
 140             UnvectoredReturn _ -> AbsCNop
 141             VectoredReturn   _ -> CFlatRetVector tycon_upd_label
 142                                         (map (mk_upd_label tycon) data_cons)
 143     ------------------
 144     gen_for_spec_tycon :: TyCon -> [Maybe Type] -> AbstractC
 145
 146     gen_for_spec_tycon tycon ty_maybes
 147       = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
 148           `mkAbsCStmts`
 149         maybe_spec_tycon_vtbl
 150       where
 151         data_cons      = tyConDataCons tycon
 152
 153         spec_tycon     = mkSpecTyCon tycon ty_maybes
 154         spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
 155
 156         spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
 157
 158         maybe_spec_tycon_vtbl =
 159           case ctrlReturnConvAlg spec_tycon of
 160             UnvectoredReturn 1 -> CRetUnVector spec_tycon_upd_label
 161                                         (mk_upd_label spec_tycon (head spec_data_cons))
 162             UnvectoredReturn _ -> AbsCNop
 163             VectoredReturn   _ -> CFlatRetVector spec_tycon_upd_label
 164                                         (map (mk_upd_label spec_tycon) spec_data_cons)
 165     ------------------
 166     mk_upd_label tycon con
 167       = CLbl
 168         (case (dataReturnConvAlg con) of
 169           ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
 170           ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag)
 171         CodePtrRep
 172       where
 173         tag = dataConTag con
 174 \end{code}
 175
 176 %************************************************************************
 177 %*                                                                      *
 178 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
 179 %*                                                                      *
 180 %************************************************************************
 181
 182 Generate the entry code, info tables, and (for niladic constructor) the
 183 static closure, for a constructor.
 184
 185 \begin{code}
 186 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
 187
 188 genConInfo comp_info tycon data_con
 189   = mkAbstractCs [
 190                   CSplitMarker,
 191                   inregs_upd_maybe,
 192                   closure_code,
 193                   static_code,
 194                   closure_maybe]
 195         -- Order of things is to reduce forward references
 196   where
 197     (closure_info, body_code) = mkConCodeAndInfo data_con
 198
 199     -- To allow the debuggers, interpreters, etc to cope with static
 200     -- data structures (ie those built at compile time), we take care that
 201     -- info-table contains the information we need.
 202     (static_ci,_) = layOutStaticClosure data_con typePrimRep arg_tys (mkConLFInfo data_con)
 203
 204     body       = (initC comp_info (
 205                       profCtrC SLIT("ENT_CON") [CReg node] `thenC`
 206                       body_code))
 207
 208     entry_addr = CLbl entry_label CodePtrRep
 209     con_descr  = getOccString data_con
 210
 211     closure_code        = CClosureInfoAndCode closure_info body Nothing
 212                                               stdUpd con_descr
 213                                               (dataConLiveness closure_info)
 214     static_code         = CClosureInfoAndCode static_ci body Nothing
 215                                               stdUpd con_descr
 216                                               (dataConLiveness static_ci)
 217
 218     inregs_upd_maybe    = genPhantomUpdInfo comp_info tycon data_con
 219
 220     stdUpd              = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrRep
 221
 222     tag                 = dataConTag data_con
 223
 224     cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
 225
 226     -- For zero-arity data constructors, or, more accurately,
 227     --   those which only have VoidRep args (or none):
 228     --  We make the closure too (not just info tbl), so that we can share
 229     --  one copy throughout.
 230     closure_maybe = if not (all zero_size arg_tys) then
 231                         AbsCNop
 232                     else
 233                         CStaticClosure  closure_label           -- Label for closure
 234                                         static_ci               -- Info table
 235                                         cost_centre
 236                                         [{-No args!  A slight lie for constrs with VoidRep args-}]
 237
 238     zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
 239
 240     arg_tys         = dataConRawArgTys     data_con
 241     entry_label     = mkConEntryLabel      data_con
 242     closure_label   = mkStaticClosureLabel data_con
 243 \end{code}
 244
 245 The entry code for a constructor now loads the info ptr by indirecting
 246 node.  The alternative is to load the info ptr in the enter-via-node
 247 sequence.  There's is a trade-off here:
 248
 249         * If the architecture can perform an indirect jump through a
 250           register in one instruction, or if the info ptr is not a
 251           real register, then *not* loading the info ptr on an enter
 252           is a win.
 253
 254         * If the enter-via-node code is identical whether we load the
 255           info ptr or not, then doing it is a win (it means we don't
 256           have to do it here).
 257
 258 However, the gratuitous load here is miniscule compared to the
 259 gratuitous loads of the info ptr on each enter, so we go for the first
 260 option.
 261
 262 -- Simon M. (6/5/96)
 263
 264 \begin{code}
 265 mkConCodeAndInfo :: Id                  -- Data constructor
 266                  -> (ClosureInfo, Code) -- The info table
 267
 268 mkConCodeAndInfo con
 269   = case (dataReturnConvAlg con) of
 270
 271     ReturnInRegs regs ->
 272         let
 273             (closure_info, regs_w_offsets)
 274               = layOutDynCon con magicIdPrimRep regs
 275
 276             body_code
 277               = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
 278
 279                 performReturn (mkAbstractCs (load_infoptr : map move_to_reg regs_w_offsets))
 280                               (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 281                               emptyIdSet{-no live vars-}
 282         in
 283         (closure_info, body_code)
 284
 285     ReturnInHeap ->
 286         let
 287             arg_tys = dataConRawArgTys con
 288
 289             (closure_info, arg_things)
 290                 = layOutDynCon con typePrimRep arg_tys
 291
 292             body_code
 293                 = -- NB: We don't set CC when entering data (WDP 94/06)
 294                   profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
 295
 296                   performReturn (mkAbstractCs [load_infoptr])   -- Ptr to thing already in Node
 297                                 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 298                                 emptyIdSet{-no live vars-}
 299         in
 300         (closure_info, body_code)
 301
 302   where
 303     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
 304     move_to_reg (reg, offset)
 305       = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
 306
 307     load_infoptr
 308       = CAssign (CReg infoptr) (CMacroExpr DataPtrRep INFO_PTR [CReg node])
 309 \end{code}
 310
 311 %************************************************************************
 312 %*                                                                      *
 313 \subsection[CgConTbls-updates]{Generating update bits for constructors}
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 Generate the "phantom" info table and update code, iff the constructor returns in regs
 318
 319 \begin{code}
 320
 321 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
 322
 323 genPhantomUpdInfo comp_info tycon data_con
 324   = case (dataReturnConvAlg data_con) of
 325
 326       ReturnInHeap -> AbsCNop   -- No need for a phantom update
 327
 328       ReturnInRegs regs ->
 329         let
 330             phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
 331                                 upd_code con_descr
 332                                 (dataConLiveness phantom_ci)
 333
 334             phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
 335
 336             con_descr = getOccString data_con
 337
 338             con_arity = dataConNumFields data_con
 339
 340             upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
 341             upd_label = mkConUpdCodePtrVecLabel tycon tag
 342             tag = dataConTag data_con
 343
 344             updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
 345
 346             perform_return = mkAbstractCs
 347               [
 348                 CMacroStmt POP_STD_UPD_FRAME [],
 349                 CReturn (CReg RetReg) return_info
 350               ]
 351
 352             return_info =
 353               case (ctrlReturnConvAlg tycon) of
 354                 UnvectoredReturn _ -> DirectReturn
 355                 VectoredReturn   _ -> StaticVectoredReturn (tag - fIRST_TAG)
 356
 357             -- Determine cost centre for the updated closures CC (and allocation)
 358             -- CCC for lexical (now your only choice)
 359             use_cc = CReg CurCostCentre -- what to put in the closure
 360             blame_cc = use_cc -- who to blame for allocation
 361
 362             do_move (reg, virt_offset) =
 363                 CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
 364
 365
 366             -- Code for building a new constructor in place over the updatee
 367             overwrite_code
 368               = profCtrC SLIT("UPD_CON_IN_PLACE")
 369                          [mkIntCLit (length regs_w_offsets)]    `thenC`
 370                 absC (mkAbstractCs
 371                   [
 372                     CAssign (CReg node) updatee,
 373
 374                     -- Tell the storage mgr that we intend to update in place
 375                     -- This may (in complicated mgrs eg generational) cause gc,
 376                     -- and it may modify Node to point to another place to
 377                     -- actually update into.
 378                     CMacroStmt upd_inplace_macro [liveness_mask],
 379
 380                     -- Initialise the closure pointed to by node
 381                     CInitHdr closure_info (NodeRel zeroOff) use_cc True,
 382                     mkAbstractCs (map do_move regs_w_offsets),
 383                     if con_arity /= 0 then
 384                         CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
 385                     else
 386                         AbsCNop
 387                   ])
 388
 389             upd_inplace_macro = if closurePtrsSize closure_info == 0
 390                                 then UPD_INPLACE_NOPTRS
 391                                 else UPD_INPLACE_PTRS
 392
 393             -- Code for allocating a new constructor in the heap
 394             alloc_code
 395               = let
 396                     amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
 397                 in
 398                     -- Allocate and build closure specifying upd_new_w_regs
 399                     allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 400                                                         `thenFC` \ hp_offset ->
 401                     getHpRelOffset hp_offset            `thenFC` \ hp_rel ->
 402                     let
 403                         amode = CAddr hp_rel
 404                     in
 405                     profCtrC SLIT("UPD_CON_IN_NEW")
 406                              [mkIntCLit (length amodes_w_offsets)] `thenC`
 407                     absC (mkAbstractCs
 408                       [ CMacroStmt UPD_IND [updatee, amode],
 409                         CAssign (CReg node) amode,
 410                         CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
 411                       ])
 412
 413             (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
 414             info_label = infoTableLabelFromCI closure_info
 415             liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
 416
 417             build_closure =
 418               if fitsMinUpdSize closure_info then
 419                 initC comp_info overwrite_code
 420               else
 421                 initC comp_info (heapCheck regs False alloc_code)
 422
 423         in CClosureUpdInfo phantom_itbl
 424
 425 \end{code}
 426