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 Type ( getTyConDataCons, primRepFromType,
23 maybeIntLikeTyCon, mkSpecTyCon,
24 TyVarTemplate, TyCon, Class,
25 TauType(..), Type, ThetaType(..)
27 import CgHeapery ( heapCheck, allocDynClosure )
28 import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
30 CtrlReturnConvention(..),
31 DataReturnConvention(..)
33 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
34 import CgUsages ( getHpRelOffset )
35 import CLabel ( mkConEntryLabel, mkStaticConEntryLabel,
37 mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel,
38 mkStdUpdVecTblLabel, CLabel
40 import ClosureInfo ( layOutStaticClosure, layOutDynCon,
41 closureSizeWithoutFixedHdr, closurePtrsSize,
42 fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
43 infoTableLabelFromCI, dataConLiveness
46 import Id ( getDataConTag, getDataConSig, getDataConTyCon,
48 getDataConArity, fIRST_TAG, ConTag(..),
51 import CgCompInfo ( uF_UPDATEE )
52 import Maybes ( maybeToBool, Maybe(..) )
53 import PrimRep ( getPrimRepSize, retPrimRepSize )
55 import UniqSet -- ( emptyUniqSet, UniqSet(..) )
59 For every constructor we generate the following info tables:
60 A static info table, for static instances of the constructor,
62 For constructors which return in registers (and only them),
63 an "inregs" info table. This info table is rather emaciated;
64 it only contains update code and tag.
69 Info tbls & Macro & Kind of constructor \\
71 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
72 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
73 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
74 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
75 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
78 Possible info tables for constructor con:
82 Used for dynamically let(rec)-bound occurrences of
83 the constructor, and for updates. For constructors
84 which are int-like, char-like or nullary, when GC occurs,
85 the closure tries to get rid of itself.
87 \item[@con_inregs_info@:]
88 Used when returning a new constructor in registers.
89 Only for return-in-regs constructors.
90 Macro: @INREGS_INFO_TABLE@.
92 \item[@con_static_info@:]
93 Static occurrences of the constructor
94 macro: @STATIC_INFO_TABLE@.
97 For zero-arity constructors, \tr{con}, we also generate a static closure:
100 \item[@con_closure@:]
101 A single static copy of the (zero-arity) constructor itself.
104 For charlike and intlike closures there is a fixed array of static
105 closures predeclared.
108 genStaticConBits :: CompilationInfo -- global info about the compilation
109 -> [TyCon] -- tycons to generate
110 -> FiniteMap TyCon [(Bool, [Maybe Type])]
111 -- tycon specialisation info
112 -> AbstractC -- output
114 genStaticConBits comp_info gen_tycons tycon_specs
115 = -- for each type constructor:
116 -- grab all its data constructors;
117 -- for each one, generate an info table
118 -- for each specialised type constructor
119 -- for each specialisation of the type constructor
120 -- grab data constructors, and generate info tables
122 -- ToDo: for tycons and specialisations which are not
123 -- declared in this module we must ensure that the
124 -- C labels are local to this module i.e. static
125 -- since they may be duplicated in other modules
127 mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
129 mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
130 | (imported_spec, spec) <- specs,
131 -- no code generated if spec is imported
134 | (tc, specs) <- fmToList tycon_specs ]
136 gen_for_tycon :: TyCon -> AbstractC
138 = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
142 data_cons = getTyConDataCons tycon
143 tycon_upd_label = mkStdUpdVecTblLabel tycon
146 case ctrlReturnConvAlg tycon of
147 UnvectoredReturn 1 -> CRetUnVector tycon_upd_label
148 (mk_upd_label tycon (head data_cons))
149 UnvectoredReturn _ -> AbsCNop
150 VectoredReturn _ -> CFlatRetVector tycon_upd_label
151 (map (mk_upd_label tycon) data_cons)
153 gen_for_spec_tycon :: TyCon -> [Maybe Type] -> AbstractC
155 gen_for_spec_tycon tycon ty_maybes
156 = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
158 maybe_spec_tycon_vtbl
160 data_cons = getTyConDataCons tycon
162 spec_tycon = mkSpecTyCon tycon ty_maybes
163 spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
165 spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
167 maybe_spec_tycon_vtbl =
168 case ctrlReturnConvAlg spec_tycon of
169 UnvectoredReturn 1 -> CRetUnVector spec_tycon_upd_label
170 (mk_upd_label spec_tycon (head spec_data_cons))
171 UnvectoredReturn _ -> AbsCNop
172 VectoredReturn _ -> CFlatRetVector spec_tycon_upd_label
173 (map (mk_upd_label spec_tycon) spec_data_cons)
175 mk_upd_label tycon con
177 (case (dataReturnConvAlg isw_chkr con) of
178 ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
179 ReturnInHeap -> mkStdUpdCodePtrVecLabel tycon tag)
182 tag = getDataConTag con
185 (MkCompInfo sw_chkr isw_chkr _) = comp_info
188 %************************************************************************
190 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
192 %************************************************************************
194 Generate the entry code, info tables, and (for niladic constructor) the
195 static closure, for a constructor.
198 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
200 genConInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
207 -- Order of things is to reduce forward references
209 (closure_info, body_code) = mkConCodeAndInfo isw_chkr data_con
211 -- To allow the debuggers, interpreters, etc to cope with static
212 -- data structures (ie those built at compile time), we take care that
213 -- info-table contains the information we need.
214 (static_ci,_) = layOutStaticClosure data_con primRepFromType arg_tys (mkConLFInfo data_con)
216 body = (initC comp_info (
217 profCtrC SLIT("ENT_CON") [CReg node] `thenC`
220 entry_addr = CLbl entry_label CodePtrRep
221 con_descr = _UNPK_ (getOccurrenceName data_con)
223 closure_code = CClosureInfoAndCode closure_info body Nothing
225 (dataConLiveness isw_chkr closure_info)
226 static_code = CClosureInfoAndCode static_ci body Nothing
228 (dataConLiveness isw_chkr static_ci)
230 inregs_upd_maybe = genPhantomUpdInfo comp_info tycon data_con
232 stdUpd = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrRep
234 tag = getDataConTag data_con
236 cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
238 -- For zero-arity data constructors, or, more accurately,
239 -- those which only have VoidRep args (or none):
240 -- We make the closure too (not just info tbl), so that we can share
241 -- one copy throughout.
242 closure_maybe = if not (all zero_size arg_tys) then
245 CStaticClosure closure_label -- Label for closure
246 static_ci -- Info table
248 [{-No args! A slight lie for constrs with VoidRep args-}]
250 zero_size arg_ty = getPrimRepSize (primRepFromType arg_ty) == 0
252 (_,_,arg_tys,_) = getDataConSig data_con
253 con_arity = getDataConArity data_con
254 entry_label = mkConEntryLabel data_con
255 closure_label = mkClosureLabel data_con
259 mkConCodeAndInfo :: IntSwitchChecker
260 -> Id -- Data constructor
261 -> (ClosureInfo, Code) -- The info table
263 mkConCodeAndInfo isw_chkr con
264 = case (dataReturnConvAlg isw_chkr con) of
268 (closure_info, regs_w_offsets)
269 = layOutDynCon con kindFromMagicId regs
272 = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
274 performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
275 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
276 emptyUniqSet{-no live vars-}
278 (closure_info, body_code)
282 (_, _, arg_tys, _) = getDataConSig con
284 (closure_info, arg_things)
285 = layOutDynCon con primRepFromType arg_tys
288 = -- NB: We don't set CC when entering data (WDP 94/06)
289 profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
291 performReturn AbsCNop -- Ptr to thing already in Node
292 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
293 emptyUniqSet{-no live vars-}
295 (closure_info, body_code)
298 move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
299 move_to_reg (reg, offset)
300 = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
303 %************************************************************************
305 \subsection[CgConTbls-updates]{Generating update bits for constructors}
307 %************************************************************************
309 Generate the "phantom" info table and update code, iff the constructor returns in regs
313 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
315 genPhantomUpdInfo comp_info@(MkCompInfo _ isw_chkr _) tycon data_con
316 = case (dataReturnConvAlg isw_chkr data_con) of
318 ReturnInHeap -> AbsCNop -- No need for a phantom update
322 phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
324 (dataConLiveness isw_chkr phantom_ci)
326 phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
328 con_descr = _UNPK_ (getOccurrenceName data_con)
330 con_arity = getDataConArity data_con
332 upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
333 upd_label = mkConUpdCodePtrVecLabel tycon tag
334 tag = getDataConTag data_con
336 updatee = CVal (SpBRel 0 (-uF_UPDATEE)) PtrRep
338 perform_return = mkAbstractCs
340 CMacroStmt POP_STD_UPD_FRAME [],
341 CReturn (CReg RetReg) return_info
345 case (ctrlReturnConvAlg tycon) of
346 UnvectoredReturn _ -> DirectReturn
347 VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
349 -- Determine cost centre for the updated closures CC (and allocation)
350 -- CCC for lexical (now your only choice)
351 use_cc = CReg CurCostCentre -- what to put in the closure
352 blame_cc = use_cc -- who to blame for allocation
354 do_move (reg, virt_offset) =
355 CAssign (CVal (NodeRel virt_offset) (kindFromMagicId reg)) (CReg reg)
358 -- Code for building a new constructor in place over the updatee
360 = profCtrC SLIT("UPD_CON_IN_PLACE")
361 [mkIntCLit (length regs_w_offsets)] `thenC`
364 CAssign (CReg node) updatee,
366 -- Tell the storage mgr that we intend to update in place
367 -- This may (in complicated mgrs eg generational) cause gc,
368 -- and it may modify Node to point to another place to
369 -- actually update into.
370 CMacroStmt upd_inplace_macro [liveness_mask],
372 -- Initialise the closure pointed to by node
373 CInitHdr closure_info (NodeRel zeroOff) use_cc True,
374 mkAbstractCs (map do_move regs_w_offsets),
375 if con_arity /= 0 then
376 CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
381 upd_inplace_macro = if closurePtrsSize closure_info == 0
382 then UPD_INPLACE_NOPTRS
383 else UPD_INPLACE_PTRS
385 -- Code for allocating a new constructor in the heap
388 amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
390 -- Allocate and build closure specifying upd_new_w_regs
391 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
392 `thenFC` \ hp_offset ->
393 getHpRelOffset hp_offset `thenFC` \ hp_rel ->
397 profCtrC SLIT("UPD_CON_IN_NEW")
398 [mkIntCLit (length amodes_w_offsets)] `thenC`
400 [ CMacroStmt UPD_IND [updatee, amode],
401 CAssign (CReg node) amode,
402 CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
405 (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
406 info_label = infoTableLabelFromCI closure_info
407 liveness_mask = mkIntCLit (mkLiveRegsBitMask (node:regs))
410 if fitsMinUpdSize closure_info then
411 initC comp_info overwrite_code
413 initC comp_info (heapCheck regs False alloc_code)
415 in CClosureUpdInfo phantom_itbl