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