2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CgConTbls]{Info tables and update bits for constructors}
7 #include "HsVersions.h"
12 -- and to complete the interface...
13 TCE(..), UniqFM, CompilationInfo, AbstractC
16 import Pretty -- ToDo: rm (debugging)
22 import AbsUniType ( getTyConDataCons, kindFromType,
23 maybeIntLikeTyCon, mkSpecTyCon,
24 TyVarTemplate, TyCon, Class,
25 TauType(..), UniType, ThetaType(..)
26 IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpClass)
27 IF_ATTACK_PRAGMAS(COMMA cmpUniType)
29 import CgHeapery ( heapCheck, allocDynClosure )
30 import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
32 CtrlReturnConvention(..),
33 DataReturnConvention(..)
35 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
36 import CgUsages ( getHpRelOffset )
37 import CLabelInfo ( mkConEntryLabel, mkStaticConEntryLabel,
38 --UNUSED: mkInfoTableLabel,
39 mkClosureLabel, --UNUSED: mkConUpdCodePtrUnvecLabel,
40 mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel,
41 mkStdUpdVecTblLabel, CLabel
43 import ClosureInfo ( layOutStaticClosure, layOutDynCon,
44 closureSizeWithoutFixedHdr, closurePtrsSize,
45 fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
46 infoTableLabelFromCI, dataConLiveness
48 import CmdLineOpts ( GlobalSwitch(..) )
50 import Id ( getDataConTag, getDataConSig, getDataConTyCon,
52 getDataConArity, fIRST_TAG, ConTag(..),
55 import CgCompInfo ( uF_UPDATEE )
56 import Maybes ( maybeToBool, Maybe(..) )
57 import PrimKind ( getKindSize, retKindSize )
59 import UniqSet -- ( emptyUniqSet, UniqSet(..) )
60 import TCE ( rngTCE, TCE(..), UniqFM )
64 For every constructor we generate the following info tables:
65 A static info table, for static instances of the constructor,
67 For constructors which return in registers (and only them),
68 an "inregs" info table. This info table is rather emaciated;
69 it only contains update code and tag.
74 Info tbls & Macro & Kind of constructor \\
76 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
77 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
78 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
79 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
80 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
83 Possible info tables for constructor con:
87 Used for dynamically let(rec)-bound occurrences of
88 the constructor, and for updates. For constructors
89 which are int-like, char-like or nullary, when GC occurs,
90 the closure tries to get rid of itself.
92 \item[@con_inregs_info@:]
93 Used when returning a new constructor in registers.
94 Only for return-in-regs constructors.
95 Macro: @INREGS_INFO_TABLE@.
97 \item[@con_static_info@:]
98 Static occurrences of the constructor
99 macro: @STATIC_INFO_TABLE@.
102 For zero-arity constructors, \tr{con}, we also generate a static closure:
105 \item[@con_closure@:]
106 A single static copy of the (zero-arity) constructor itself.
109 For charlike and intlike closures there is a fixed array of static
110 closures predeclared.
113 genStaticConBits :: CompilationInfo -- global info about the compilation
114 -> [TyCon] -- tycons to generate
115 -> FiniteMap TyCon [(Bool, [Maybe UniType])]
116 -- tycon specialisation info
117 -> AbstractC -- output
119 genStaticConBits comp_info gen_tycons tycon_specs
120 = -- for each type constructor:
121 -- grab all its data constructors;
122 -- for each one, generate an info table
123 -- for each specialised type constructor
124 -- for each specialisation of the type constructor
125 -- grab data constructors, and generate info tables
127 -- ToDo: for tycons and specialisations which are not
128 -- declared in this module we must ensure that the
129 -- C labels are local to this module i.e. static
130 -- since they may be duplicated in other modules
132 mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
134 mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
135 | (imported_spec, spec) <- specs,
136 -- no code generated if spec is imported
139 | (tc, specs) <- fmToList tycon_specs ]
141 gen_for_tycon :: TyCon -> AbstractC
143 = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
147 data_cons = getTyConDataCons tycon
148 tycon_upd_label = mkStdUpdVecTblLabel tycon
151 case ctrlReturnConvAlg tycon of
152 UnvectoredReturn 1 -> CRetUnVector tycon_upd_label
153 (mk_upd_label tycon (head data_cons))
154 UnvectoredReturn _ -> AbsCNop
155 VectoredReturn _ -> CFlatRetVector tycon_upd_label
156 (map (mk_upd_label tycon) data_cons)
158 gen_for_spec_tycon :: TyCon -> [Maybe UniType] -> AbstractC
160 gen_for_spec_tycon tycon ty_maybes
161 = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
163 maybe_spec_tycon_vtbl
165 data_cons = getTyConDataCons tycon
167 spec_tycon = mkSpecTyCon tycon ty_maybes
168 spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
170 spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
172 maybe_spec_tycon_vtbl =
173 case ctrlReturnConvAlg spec_tycon of
174 UnvectoredReturn 1 -> CRetUnVector spec_tycon_upd_label
175 (mk_upd_label spec_tycon (head spec_data_cons))
176 UnvectoredReturn _ -> AbsCNop
177 VectoredReturn _ -> CFlatRetVector spec_tycon_upd_label
178 (map (mk_upd_label spec_tycon) spec_data_cons)
180 mk_upd_label tycon con
182 (case (dataReturnConvAlg isw_chkr con) of
183 ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
184 ReturnInHeap -> mkStdUpdCodePtrVecLabel tycon tag)
187 tag = getDataConTag con
190 (MkCompInfo sw_chkr isw_chkr _) = comp_info
193 %************************************************************************
195 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
197 %************************************************************************
199 Generate the entry code, info tables, and (for niladic constructor) the
200 static closure, for a constructor.
203 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
205 genConInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
212 -- Order of things is to reduce forward references
214 (closure_info, body_code) = mkConCodeAndInfo isw_chkr data_con
216 -- To allow the debuggers, interpreters, etc to cope with static
217 -- data structures (ie those built at compile time), we take care that
218 -- info-table contains the information we need.
219 (static_ci,_) = layOutStaticClosure data_con kindFromType arg_tys (mkConLFInfo data_con)
221 body = (initC comp_info (
222 profCtrC SLIT("ENT_CON") [CReg node] `thenC`
225 entry_addr = CLbl entry_label CodePtrKind
226 con_descr = _UNPK_ (getOccurrenceName data_con)
228 closure_code = CClosureInfoAndCode closure_info body Nothing
230 (dataConLiveness isw_chkr closure_info)
231 static_code = CClosureInfoAndCode static_ci body Nothing
233 (dataConLiveness isw_chkr static_ci)
235 inregs_upd_maybe = genPhantomUpdInfo comp_info tycon data_con
237 stdUpd = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrKind
239 tag = getDataConTag data_con
241 cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
243 -- For zero-arity data constructors, or, more accurately,
244 -- those which only have VoidKind args (or none):
245 -- We make the closure too (not just info tbl), so that we can share
246 -- one copy throughout.
247 closure_maybe = -- OLD: if con_arity /= 0 then
248 if not (all zero_size arg_tys) then
251 CStaticClosure closure_label -- Label for closure
252 static_ci -- Info table
254 [{-No args! A slight lie for constrs with VoidKind args-}]
256 zero_size arg_ty = getKindSize (kindFromType arg_ty) == 0
258 (_,_,arg_tys,_) = getDataConSig data_con
259 con_arity = getDataConArity data_con
260 entry_label = mkConEntryLabel data_con
261 closure_label = mkClosureLabel data_con
265 mkConCodeAndInfo :: IntSwitchChecker
266 -> Id -- Data constructor
267 -> (ClosureInfo, Code) -- The info table
269 mkConCodeAndInfo isw_chkr con
270 = case (dataReturnConvAlg isw_chkr con) of
274 (closure_info, regs_w_offsets)
275 = layOutDynCon con kindFromMagicId regs
278 = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
280 performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
281 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
282 emptyUniqSet{-no live vars-}
284 (closure_info, body_code)
288 (_, _, arg_tys, _) = getDataConSig con
290 (closure_info, arg_things)
291 = layOutDynCon con kindFromType arg_tys
294 = -- OLD: We don't set CC when entering data any more (WDP 94/06)
295 -- lexCostCentreC "ENTER_CC_DCL" [CReg node] `thenC`
296 profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
298 performReturn AbsCNop -- Ptr to thing already in Node
299 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
300 emptyUniqSet{-no live vars-}
302 (closure_info, body_code)
305 move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
306 move_to_reg (reg, offset)
307 = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
310 %************************************************************************
312 \subsection[CgConTbls-updates]{Generating update bits for constructors}
314 %************************************************************************
316 Generate the "phantom" info table and update code, iff the constructor returns in regs
320 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
322 genPhantomUpdInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
323 = case (dataReturnConvAlg isw_chkr data_con) of
325 ReturnInHeap -> --OLD: pprTrace "NoPhantom: " (ppr PprDebug data_con) $
326 AbsCNop -- No need for a phantom update
329 --OLD: pprTrace "YesPhantom! " (ppr PprDebug data_con) $
331 phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
333 (dataConLiveness isw_chkr phantom_ci)
335 phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
337 con_descr = _UNPK_ (getOccurrenceName data_con)
339 con_arity = getDataConArity data_con
341 upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
342 upd_label = mkConUpdCodePtrVecLabel tycon tag
343 tag = getDataConTag data_con
345 updatee = CVal (SpBRel 0 (-uF_UPDATEE)) PtrKind
347 perform_return = mkAbstractCs
349 CMacroStmt POP_STD_UPD_FRAME [],
350 CReturn (CReg RetReg) return_info
354 -- OLD: pprTrace "ctrlReturn6:" (ppr PprDebug tycon) (
355 case (ctrlReturnConvAlg tycon) of
356 UnvectoredReturn _ -> DirectReturn
357 VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
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
365 do_move (reg, virt_offset) =
366 CAssign (CVal (NodeRel virt_offset) (kindFromMagicId reg)) (CReg reg)
369 -- Code for building a new constructor in place over the updatee
371 = profCtrC SLIT("UPD_CON_IN_PLACE")
372 [mkIntCLit (length regs_w_offsets)] `thenC`
375 CAssign (CReg node) updatee,
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],
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 DataPtrKind)
392 upd_inplace_macro = if closurePtrsSize closure_info == 0
393 then UPD_INPLACE_NOPTRS
394 else UPD_INPLACE_PTRS
396 -- Code for allocating a new constructor in the heap
399 amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
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 ->
408 profCtrC SLIT("UPD_CON_IN_NEW")
409 [mkIntCLit (length amodes_w_offsets)] `thenC`
411 [ CMacroStmt UPD_IND [updatee, amode],
412 CAssign (CReg node) amode,
413 CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
416 (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
417 info_label = infoTableLabelFromCI closure_info
418 liveness_mask = mkIntCLit (mkLiveRegsBitMask (node:regs))
421 if fitsMinUpdSize closure_info then
422 initC comp_info overwrite_code
424 initC comp_info (heapCheck regs False alloc_code)
426 in CClosureUpdInfo phantom_itbl