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, VirtualHeapOffset(..) )
  38 import Id               ( dataConTag, dataConRawArgTys,
  39                           dataConArity, fIRST_TAG,
  40                           emptyIdSet,
  41                           GenId{-instance NamedThing-}
  42                         )
  43 import Name             ( getLocalName )
  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_ (getLocalName 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     con_arity       = dataConArity         data_con
 245     entry_label     = mkConEntryLabel      data_con
 246     closure_label   = mkStaticClosureLabel data_con
 247 \end{code}
 248
 249 The entry code for a constructor now loads the info ptr by indirecting
 250 node.  The alternative is to load the info ptr in the enter-via-node
 251 sequence.  There's is a trade-off here:
 252
 253         * If the architecture can perform an indirect jump through a
 254           register in one instruction, or if the info ptr is not a
 255           real register, then *not* loading the info ptr on an enter
 256           is a win.
 257
 258         * If the enter-via-node code is identical whether we load the
 259           info ptr or not, then doing it is a win (it means we don't
 260           have to do it here).
 261
 262 However, the gratuitous load here is miniscule compared to the
 263 gratuitous loads of the info ptr on each enter, so we go for the first
 264 option.
 265
 266 -- Simon M. (6/5/96)
 267
 268 \begin{code}
 269 mkConCodeAndInfo :: Id                  -- Data constructor
 270                  -> (ClosureInfo, Code) -- The info table
 271
 272 mkConCodeAndInfo con
 273   = case (dataReturnConvAlg con) of
 274
 275     ReturnInRegs regs ->
 276         let
 277             (closure_info, regs_w_offsets)
 278               = layOutDynCon con magicIdPrimRep regs
 279
 280             body_code
 281               = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
 282
 283                 performReturn (mkAbstractCs (load_infoptr : map move_to_reg regs_w_offsets))
 284                               (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 285                               emptyIdSet{-no live vars-}
 286         in
 287         (closure_info, body_code)
 288
 289     ReturnInHeap ->
 290         let
 291             arg_tys = dataConRawArgTys con
 292
 293             (closure_info, arg_things)
 294                 = layOutDynCon con typePrimRep arg_tys
 295
 296             body_code
 297                 = -- NB: We don't set CC when entering data (WDP 94/06)
 298                   profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
 299
 300                   performReturn (mkAbstractCs [load_infoptr])   -- Ptr to thing already in Node
 301                                 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 302                                 emptyIdSet{-no live vars-}
 303         in
 304         (closure_info, body_code)
 305
 306   where
 307     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
 308     move_to_reg (reg, offset)
 309       = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
 310
 311     load_infoptr
 312       = CAssign (CReg infoptr) (CMacroExpr DataPtrRep INFO_PTR [CReg node])
 313 \end{code}
 314
 315 %************************************************************************
 316 %*                                                                      *
 317 \subsection[CgConTbls-updates]{Generating update bits for constructors}
 318 %*                                                                      *
 319 %************************************************************************
 320
 321 Generate the "phantom" info table and update code, iff the constructor returns in regs
 322
 323 \begin{code}
 324
 325 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
 326
 327 genPhantomUpdInfo comp_info tycon data_con
 328   = case (dataReturnConvAlg data_con) of
 329
 330       ReturnInHeap -> AbsCNop   -- No need for a phantom update
 331
 332       ReturnInRegs regs ->
 333         let
 334             phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
 335                                 upd_code con_descr
 336                                 (dataConLiveness phantom_ci)
 337
 338             phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
 339
 340             con_descr = _UNPK_ (getLocalName data_con)
 341
 342             con_arity = dataConArity data_con
 343
 344             upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
 345             upd_label = mkConUpdCodePtrVecLabel tycon tag
 346             tag = dataConTag data_con
 347
 348             updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
 349
 350             perform_return = mkAbstractCs
 351               [
 352                 CMacroStmt POP_STD_UPD_FRAME [],
 353                 CReturn (CReg RetReg) return_info
 354               ]
 355
 356             return_info =
 357               case (ctrlReturnConvAlg tycon) of
 358                 UnvectoredReturn _ -> DirectReturn
 359                 VectoredReturn   _ -> StaticVectoredReturn (tag - fIRST_TAG)
 360
 361             -- Determine cost centre for the updated closures CC (and allocation)
 362             -- CCC for lexical (now your only choice)
 363             use_cc = CReg CurCostCentre -- what to put in the closure
 364             blame_cc = use_cc -- who to blame for allocation
 365
 366             do_move (reg, virt_offset) =
 367                 CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
 368
 369
 370             -- Code for building a new constructor in place over the updatee
 371             overwrite_code
 372               = profCtrC SLIT("UPD_CON_IN_PLACE")
 373                          [mkIntCLit (length regs_w_offsets)]    `thenC`
 374                 absC (mkAbstractCs
 375                   [
 376                     CAssign (CReg node) updatee,
 377
 378                     -- Tell the storage mgr that we intend to update in place
 379                     -- This may (in complicated mgrs eg generational) cause gc,
 380                     -- and it may modify Node to point to another place to
 381                     -- actually update into.
 382                     CMacroStmt upd_inplace_macro [liveness_mask],
 383
 384                     -- Initialise the closure pointed to by node
 385                     CInitHdr closure_info (NodeRel zeroOff) use_cc True,
 386                     mkAbstractCs (map do_move regs_w_offsets),
 387                     if con_arity /= 0 then
 388                         CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
 389                     else
 390                         AbsCNop
 391                   ])
 392
 393             upd_inplace_macro = if closurePtrsSize closure_info == 0
 394                                 then UPD_INPLACE_NOPTRS
 395                                 else UPD_INPLACE_PTRS
 396
 397             -- Code for allocating a new constructor in the heap
 398             alloc_code
 399               = let
 400                     amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
 401                 in
 402                     -- Allocate and build closure specifying upd_new_w_regs
 403                     allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 404                                                         `thenFC` \ hp_offset ->
 405                     getHpRelOffset hp_offset            `thenFC` \ hp_rel ->
 406                     let
 407                         amode = CAddr hp_rel
 408                     in
 409                     profCtrC SLIT("UPD_CON_IN_NEW")
 410                              [mkIntCLit (length amodes_w_offsets)] `thenC`
 411                     absC (mkAbstractCs
 412                       [ CMacroStmt UPD_IND [updatee, amode],
 413                         CAssign (CReg node) amode,
 414                         CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
 415                       ])
 416
 417             (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
 418             info_label = infoTableLabelFromCI closure_info
 419             liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
 420
 421             build_closure =
 422               if fitsMinUpdSize closure_info then
 423                 initC comp_info overwrite_code
 424               else
 425                 initC comp_info (heapCheck regs False alloc_code)
 426
 427         in CClosureUpdInfo phantom_itbl
 428
 429 \end{code}
 430