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 Outputable ( getLocalName )
44 import PrimRep ( getPrimRepSize, PrimRep(..) )
45 import TyCon ( tyConDataCons, mkSpecTyCon )
46 import Type ( typePrimRep )
49 maybeIntLikeTyCon = panic "CgConTbls.maybeIntLikeTyCon (ToDo)"
50 mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
53 For every constructor we generate the following info tables:
54 A static info table, for static instances of the constructor,
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.
63 Info tbls & Macro & Kind of constructor \\
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@)\\
72 Possible info tables for constructor con:
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.
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@.
86 \item[@con_static_info@:]
87 Static occurrences of the constructor
88 macro: @STATIC_INFO_TABLE@.
91 For zero-arity constructors, \tr{con}, we also generate a static closure:
95 A single static copy of the (zero-arity) constructor itself.
98 For charlike and intlike closures there is a fixed array of static
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
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
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
121 mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
123 mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
124 | (imported_spec, spec) <- specs,
125 -- no code generated if spec is imported
128 | (tc, specs) <- fmToList tycon_specs ]
130 gen_for_tycon :: TyCon -> AbstractC
132 = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
136 data_cons = tyConDataCons tycon
137 tycon_upd_label = mkStdUpdVecTblLabel tycon
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)
147 gen_for_spec_tycon :: TyCon -> [Maybe Type] -> AbstractC
149 gen_for_spec_tycon tycon ty_maybes
150 = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
152 maybe_spec_tycon_vtbl
154 data_cons = tyConDataCons tycon
156 spec_tycon = mkSpecTyCon tycon ty_maybes
157 spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
159 spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
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)
169 mk_upd_label tycon con
171 (case (dataReturnConvAlg con) of
172 ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
173 ReturnInHeap -> mkStdUpdCodePtrVecLabel tycon tag)
179 %************************************************************************
181 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
183 %************************************************************************
185 Generate the entry code, info tables, and (for niladic constructor) the
186 static closure, for a constructor.
189 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
191 genConInfo comp_info tycon data_con
198 -- Order of things is to reduce forward references
200 (closure_info, body_code) = mkConCodeAndInfo data_con
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)
207 body = (initC comp_info (
208 profCtrC SLIT("ENT_CON") [CReg node] `thenC`
211 entry_addr = CLbl entry_label CodePtrRep
212 con_descr = _UNPK_ (getLocalName data_con)
214 closure_code = CClosureInfoAndCode closure_info body Nothing
216 (dataConLiveness closure_info)
217 static_code = CClosureInfoAndCode static_ci body Nothing
219 (dataConLiveness static_ci)
221 inregs_upd_maybe = genPhantomUpdInfo comp_info tycon data_con
223 stdUpd = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrRep
225 tag = dataConTag data_con
227 cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
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
236 CStaticClosure closure_label -- Label for closure
237 static_ci -- Info table
239 [{-No args! A slight lie for constrs with VoidRep args-}]
241 zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
243 (_,_,arg_tys,_) = dataConSig data_con
244 con_arity = dataConArity data_con
245 entry_label = mkConEntryLabel data_con
246 closure_label = mkClosureLabel data_con
250 mkConCodeAndInfo :: Id -- Data constructor
251 -> (ClosureInfo, Code) -- The info table
254 = case (dataReturnConvAlg con) of
258 (closure_info, regs_w_offsets)
259 = layOutDynCon con magicIdPrimRep regs
262 = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
264 performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
265 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
266 emptyIdSet{-no live vars-}
268 (closure_info, body_code)
272 (_, _, arg_tys, _) = dataConSig con
274 (closure_info, arg_things)
275 = layOutDynCon con typePrimRep arg_tys
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`
281 performReturn AbsCNop -- Ptr to thing already in Node
282 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
283 emptyIdSet{-no live vars-}
285 (closure_info, body_code)
288 move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
289 move_to_reg (reg, offset)
290 = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
293 %************************************************************************
295 \subsection[CgConTbls-updates]{Generating update bits for constructors}
297 %************************************************************************
299 Generate the "phantom" info table and update code, iff the constructor returns in regs
303 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
305 genPhantomUpdInfo comp_info tycon data_con
306 = case (dataReturnConvAlg data_con) of
308 ReturnInHeap -> AbsCNop -- No need for a phantom update
312 phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
314 (dataConLiveness phantom_ci)
316 phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
318 con_descr = _UNPK_ (getLocalName data_con)
320 con_arity = dataConArity data_con
322 upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
323 upd_label = mkConUpdCodePtrVecLabel tycon tag
324 tag = dataConTag data_con
326 updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
328 perform_return = mkAbstractCs
330 CMacroStmt POP_STD_UPD_FRAME [],
331 CReturn (CReg RetReg) return_info
335 case (ctrlReturnConvAlg tycon) of
336 UnvectoredReturn _ -> DirectReturn
337 VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
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
344 do_move (reg, virt_offset) =
345 CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
348 -- Code for building a new constructor in place over the updatee
350 = profCtrC SLIT("UPD_CON_IN_PLACE")
351 [mkIntCLit (length regs_w_offsets)] `thenC`
354 CAssign (CReg node) updatee,
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],
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)
371 upd_inplace_macro = if closurePtrsSize closure_info == 0
372 then UPD_INPLACE_NOPTRS
373 else UPD_INPLACE_PTRS
375 -- Code for allocating a new constructor in the heap
378 amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
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 ->
387 profCtrC SLIT("UPD_CON_IN_NEW")
388 [mkIntCLit (length amodes_w_offsets)] `thenC`
390 [ CMacroStmt UPD_IND [updatee, amode],
391 CAssign (CReg node) amode,
392 CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
395 (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
396 info_label = infoTableLabelFromCI closure_info
397 liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
400 if fitsMinUpdSize closure_info then
401 initC comp_info overwrite_code
403 initC comp_info (heapCheck regs False alloc_code)
405 in CClosureUpdInfo phantom_itbl