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