2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CgConTbls]{Info tables and update bits for constructors}
7 #include "HsVersions.h"
9 module CgConTbls ( genStaticConBits ) where
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(..)
24 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
25 import CgUsages ( getHpRelOffset )
26 import CLabel ( mkConEntryLabel, mkClosureLabel,
27 mkConUpdCodePtrVecLabel,
28 mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel
30 import ClosureInfo ( layOutStaticClosure, layOutDynCon,
31 layOutPhantomClosure, closurePtrsSize,
32 fitsMinUpdSize, mkConLFInfo,
33 infoTableLabelFromCI, dataConLiveness
35 import CostCentre ( dontCareCostCentre )
36 import FiniteMap ( fmToList )
37 import HeapOffs ( zeroOff, VirtualHeapOffset(..) )
38 import Id ( dataConTag, dataConSig,
39 dataConArity, fIRST_TAG,
41 GenId{-instance NamedThing-}
43 import PrimRep ( getPrimRepSize, PrimRep(..) )
44 import TyCon ( tyConDataCons, mkSpecTyCon )
45 import Type ( typePrimRep )
48 maybeIntLikeTyCon = panic "CgConTbls.maybeIntLikeTyCon (ToDo)"
49 mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
52 For every constructor we generate the following info tables:
53 A static info table, for static instances of the constructor,
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.
62 Info tbls & Macro & Kind of constructor \\
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@)\\
71 Possible info tables for constructor con:
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.
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@.
85 \item[@con_static_info@:]
86 Static occurrences of the constructor
87 macro: @STATIC_INFO_TABLE@.
90 For zero-arity constructors, \tr{con}, we also generate a static closure:
94 A single static copy of the (zero-arity) constructor itself.
97 For charlike and intlike closures there is a fixed array of static
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
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
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
120 mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
122 mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
123 | (imported_spec, spec) <- specs,
124 -- no code generated if spec is imported
127 | (tc, specs) <- fmToList tycon_specs ]
129 gen_for_tycon :: TyCon -> AbstractC
131 = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
135 data_cons = tyConDataCons tycon
136 tycon_upd_label = mkStdUpdVecTblLabel tycon
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)
146 gen_for_spec_tycon :: TyCon -> [Maybe Type] -> AbstractC
148 gen_for_spec_tycon tycon ty_maybes
149 = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
151 maybe_spec_tycon_vtbl
153 data_cons = tyConDataCons tycon
155 spec_tycon = mkSpecTyCon tycon ty_maybes
156 spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
158 spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
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)
168 mk_upd_label tycon con
170 (case (dataReturnConvAlg con) of
171 ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
172 ReturnInHeap -> mkStdUpdCodePtrVecLabel tycon tag)
178 %************************************************************************
180 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
182 %************************************************************************
184 Generate the entry code, info tables, and (for niladic constructor) the
185 static closure, for a constructor.
188 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
190 genConInfo comp_info tycon data_con
197 -- Order of things is to reduce forward references
199 (closure_info, body_code) = mkConCodeAndInfo data_con
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)
206 body = (initC comp_info (
207 profCtrC SLIT("ENT_CON") [CReg node] `thenC`
210 entry_addr = CLbl entry_label CodePtrRep
211 con_descr = _UNPK_ (getOccurrenceName data_con)
213 closure_code = CClosureInfoAndCode closure_info body Nothing
215 (dataConLiveness closure_info)
216 static_code = CClosureInfoAndCode static_ci body Nothing
218 (dataConLiveness static_ci)
220 inregs_upd_maybe = genPhantomUpdInfo comp_info tycon data_con
222 stdUpd = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrRep
224 tag = dataConTag data_con
226 cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
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
235 CStaticClosure closure_label -- Label for closure
236 static_ci -- Info table
238 [{-No args! A slight lie for constrs with VoidRep args-}]
240 zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
242 (_,_,arg_tys,_) = dataConSig data_con
243 con_arity = dataConArity data_con
244 entry_label = mkConEntryLabel data_con
245 closure_label = mkClosureLabel data_con
249 mkConCodeAndInfo :: Id -- Data constructor
250 -> (ClosureInfo, Code) -- The info table
253 = case (dataReturnConvAlg con) of
257 (closure_info, regs_w_offsets)
258 = layOutDynCon con magicIdPrimRep regs
261 = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
263 performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
264 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
265 emptyIdSet{-no live vars-}
267 (closure_info, body_code)
271 (_, _, arg_tys, _) = dataConSig con
273 (closure_info, arg_things)
274 = layOutDynCon con typePrimRep arg_tys
277 = -- NB: We don't set CC when entering data (WDP 94/06)
278 profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
280 performReturn AbsCNop -- Ptr to thing already in Node
281 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
282 emptyIdSet{-no live vars-}
284 (closure_info, body_code)
287 move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
288 move_to_reg (reg, offset)
289 = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
292 %************************************************************************
294 \subsection[CgConTbls-updates]{Generating update bits for constructors}
296 %************************************************************************
298 Generate the "phantom" info table and update code, iff the constructor returns in regs
302 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
304 genPhantomUpdInfo comp_info tycon data_con
305 = case (dataReturnConvAlg data_con) of
307 ReturnInHeap -> AbsCNop -- No need for a phantom update
311 phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
313 (dataConLiveness phantom_ci)
315 phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
317 con_descr = _UNPK_ (getOccurrenceName data_con)
319 con_arity = dataConArity data_con
321 upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
322 upd_label = mkConUpdCodePtrVecLabel tycon tag
323 tag = dataConTag data_con
325 updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
327 perform_return = mkAbstractCs
329 CMacroStmt POP_STD_UPD_FRAME [],
330 CReturn (CReg RetReg) return_info
334 case (ctrlReturnConvAlg tycon) of
335 UnvectoredReturn _ -> DirectReturn
336 VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
338 -- Determine cost centre for the updated closures CC (and allocation)
339 -- CCC for lexical (now your only choice)
340 use_cc = CReg CurCostCentre -- what to put in the closure
341 blame_cc = use_cc -- who to blame for allocation
343 do_move (reg, virt_offset) =
344 CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
347 -- Code for building a new constructor in place over the updatee
349 = profCtrC SLIT("UPD_CON_IN_PLACE")
350 [mkIntCLit (length regs_w_offsets)] `thenC`
353 CAssign (CReg node) updatee,
355 -- Tell the storage mgr that we intend to update in place
356 -- This may (in complicated mgrs eg generational) cause gc,
357 -- and it may modify Node to point to another place to
358 -- actually update into.
359 CMacroStmt upd_inplace_macro [liveness_mask],
361 -- Initialise the closure pointed to by node
362 CInitHdr closure_info (NodeRel zeroOff) use_cc True,
363 mkAbstractCs (map do_move regs_w_offsets),
364 if con_arity /= 0 then
365 CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
370 upd_inplace_macro = if closurePtrsSize closure_info == 0
371 then UPD_INPLACE_NOPTRS
372 else UPD_INPLACE_PTRS
374 -- Code for allocating a new constructor in the heap
377 amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
379 -- Allocate and build closure specifying upd_new_w_regs
380 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
381 `thenFC` \ hp_offset ->
382 getHpRelOffset hp_offset `thenFC` \ hp_rel ->
386 profCtrC SLIT("UPD_CON_IN_NEW")
387 [mkIntCLit (length amodes_w_offsets)] `thenC`
389 [ CMacroStmt UPD_IND [updatee, amode],
390 CAssign (CReg node) amode,
391 CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
394 (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
395 info_label = infoTableLabelFromCI closure_info
396 liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
399 if fitsMinUpdSize closure_info then
400 initC comp_info overwrite_code
402 initC comp_info (heapCheck regs False alloc_code)
404 in CClosureUpdInfo phantom_itbl