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