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