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,
24 mkSpecTyCon, isLocalSpecTyCon,
25 TyVarTemplate, TyCon, Class,
26 TauType(..), UniType, ThetaType(..)
27 IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpClass)
28 IF_ATTACK_PRAGMAS(COMMA cmpUniType)
30 import CgHeapery ( heapCheck, allocDynClosure )
31 import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
33 CtrlReturnConvention(..),
34 DataReturnConvention(..)
36 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
37 import CgUsages ( getHpRelOffset )
38 import CLabelInfo ( mkConEntryLabel, mkStaticConEntryLabel,
40 mkClosureLabel, --UNUSED: mkConUpdCodePtrUnvecLabel,
41 mkConUpdCodePtrVecLabel, mkStdUpdCodePtrVecLabel,
42 mkStdUpdVecTblLabel, CLabel
44 import ClosureInfo ( layOutStaticClosure, layOutDynCon,
45 closureSizeWithoutFixedHdr, closurePtrsSize,
46 fitsMinUpdSize, mkConLFInfo, layOutPhantomClosure,
49 import CmdLineOpts ( GlobalSwitch(..) )
51 import Id ( getDataConTag, getDataConSig, getDataConTyCon,
53 getDataConArity, fIRST_TAG, ConTag(..),
56 import CgCompInfo ( uF_UPDATEE )
57 import Maybes ( maybeToBool, Maybe(..) )
58 import PrimKind ( getKindSize, retKindSize )
60 import UniqSet -- ( emptyUniqSet, UniqSet(..) )
61 import TCE ( rngTCE, TCE(..), UniqFM )
65 For every constructor we generate the following info tables:
66 A static info table, for static instances of the constructor,
68 For constructors which return in registers (and only them),
69 an "inregs" info table. This info table is rather emaciated;
70 it only contains update code and tag.
75 Info tbls & Macro & Kind of constructor \\
77 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
78 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
79 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
80 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
81 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
84 Possible info tables for constructor con:
88 Used for dynamically let(rec)-bound occurrences of
89 the constructor, and for updates. For constructors
90 which are int-like, char-like or nullary, when GC occurs,
91 the closure tries to get rid of itself.
93 \item[@con_inregs_info@:]
94 Used when returning a new constructor in registers.
95 Only for return-in-regs constructors.
96 Macro: @INREGS_INFO_TABLE@.
98 \item[@con_static_info@:]
99 Static occurrences of the constructor
100 macro: @STATIC_INFO_TABLE@.
103 For zero-arity constructors, \tr{con}, we also generate a static closure:
106 \item[@con_closure@:]
107 A single static copy of the (zero-arity) constructor itself.
110 For charlike and intlike closures there is a fixed array of static
111 closures predeclared.
114 genStaticConBits :: CompilationInfo -- global info about the compilation
115 -> [TyCon] -- tycons to generate
116 -> FiniteMap TyCon [[Maybe UniType]]
117 -- tycon specialisation info
118 -> AbstractC -- output
120 genStaticConBits comp_info gen_tycons tycon_specs
121 = -- for each type constructor:
122 -- grab all its data constructors;
123 -- for each one, generate an info table
124 -- for each specialised type constructor
125 -- for each specialisation of the type constructor
126 -- grab data constructors, and generate info tables
128 -- ToDo: for tycons and specialisations which are not
129 -- declared in this module we must ensure that the
130 -- C labels are local to this module i.e. static
132 mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
134 mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
136 | (tc, specs) <- fmToList tycon_specs,
137 isLocalSpecTyCon (sw_chkr CompilingPrelude) tc
140 gen_for_tycon :: TyCon -> AbstractC
142 = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
143 `mkAbsCStmts` maybe_tycon_vtbl
146 data_cons = getTyConDataCons tycon
147 tycon_upd_label = mkStdUpdVecTblLabel tycon
150 case ctrlReturnConvAlg tycon of
151 UnvectoredReturn 1 -> CRetUnVector tycon_upd_label
152 (mk_upd_label tycon (head data_cons))
153 UnvectoredReturn _ -> AbsCNop
154 VectoredReturn _ -> CFlatRetVector tycon_upd_label
155 (map (mk_upd_label tycon) data_cons)
157 gen_for_spec_tycon :: TyCon -> [Maybe UniType] -> AbstractC
159 gen_for_spec_tycon tycon ty_maybes
160 = mkAbstractCs (map (genConInfo comp_info tycon) spec_data_cons)
162 maybe_spec_tycon_vtbl
164 data_cons = getTyConDataCons tycon
166 spec_tycon = mkSpecTyCon tycon ty_maybes
167 spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons
169 spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon
171 maybe_spec_tycon_vtbl =
172 case ctrlReturnConvAlg spec_tycon of
173 UnvectoredReturn 1 -> CRetUnVector spec_tycon_upd_label
174 (mk_upd_label spec_tycon (head spec_data_cons))
175 UnvectoredReturn _ -> AbsCNop
176 VectoredReturn _ -> CFlatRetVector spec_tycon_upd_label
177 (map (mk_upd_label spec_tycon) spec_data_cons)
179 mk_upd_label tycon con
180 = case dataReturnConvAlg con of
181 ReturnInRegs _ -> CLbl (mkConUpdCodePtrVecLabel tycon tag) CodePtrKind
182 ReturnInHeap -> CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrKind
184 tag = getDataConTag con
187 (MkCompInfo sw_chkr _) = comp_info
190 %************************************************************************
192 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
194 %************************************************************************
196 Generate the entry code, info tables, and (for niladic constructor) the
197 static closure, for a constructor.
200 genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC
202 genConInfo comp_info tycon data_con
213 #endif {- Data Parallel Haskell -}
215 -- Order of things is to reduce forward references
217 (closure_info, body_code) = mkConCodeAndInfo data_con
219 -- To allow the debuggers, interpreters, etc to cope with static
220 -- data structures (ie those built at compile time), we take care that
221 -- info-table contains the information we need.
222 (static_ci,_) = layOutStaticClosure data_con kindFromType arg_tys (mkConLFInfo data_con)
224 body = (initC comp_info (
225 profCtrC SLIT("ENT_CON") [CReg node] `thenC`
228 entry_addr = CLbl entry_label CodePtrKind
229 con_descr = _UNPK_ (getOccurrenceName data_con)
232 closure_code = CClosureInfoAndCode closure_info body Nothing stdUpd con_descr
233 static_code = CClosureInfoAndCode static_ci body Nothing stdUpd con_descr
235 inregs_upd_maybe = genPhantomUpdInfo comp_info tycon data_con
237 stdUpd = CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrKind
239 tag = getDataConTag data_con
243 = CNativeInfoTableAndCode closure_info con_descr entry_code
245 = CNativeInfoTableAndCode static_ci con_descr (CJump entry_addr)
246 #endif {- Data Parallel Haskell -}
248 cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs
250 -- For zero-arity data constructors, or, more accurately,
251 -- those which only have VoidKind args (or none):
252 -- We make the closure too (not just info tbl), so that we can share
253 -- one copy throughout.
254 closure_maybe = -- OLD: if con_arity /= 0 then
255 if not (all zero_size arg_tys) then
258 CStaticClosure closure_label -- Label for closure
259 static_ci -- Info table
261 [{-No args! A slight lie for constrs with VoidKind args-}]
263 zero_size arg_ty = getKindSize (kindFromType arg_ty) == 0
265 (_,_,arg_tys,_) = getDataConSig data_con
266 con_arity = getDataConArity data_con
267 entry_label = mkConEntryLabel data_con
268 closure_label = mkClosureLabel data_con
272 mkConCodeAndInfo :: Id -- Data constructor
273 -> (ClosureInfo, Code) -- The info table
276 = case (dataReturnConvAlg con) of
280 (closure_info, regs_w_offsets)
281 = layOutDynCon con kindFromMagicId regs
284 = -- OLD: We don't set CC when entering data any more (WDP 94/06)
285 -- lexCostCentreC "ENTER_CC_DCL" [CReg node] `thenC`
286 -- evalCostCentreC "SET_RetCC_CL" [CReg node] `thenC`
287 profCtrC SLIT("RET_OLD_IN_REGS") [] `thenC`
289 performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
290 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
291 emptyUniqSet{-no live vars-}
293 (closure_info, body_code)
297 (_, _, arg_tys, _) = getDataConSig con
300 = layOutDynCon con kindFromType arg_tys
303 = -- OLD: We don't set CC when entering data any more (WDP 94/06)
304 -- lexCostCentreC "ENTER_CC_DCL" [CReg node] `thenC`
305 profCtrC SLIT("RET_OLD_IN_HEAP") [] `thenC`
307 performReturn AbsCNop -- Ptr to thing already in Node
308 (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
309 emptyUniqSet{-no live vars-}
311 (closure_info, body_code)
314 move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
315 move_to_reg (reg, offset)
316 = CAssign (CReg reg) (CVal (NodeRel offset) (kindFromMagicId reg))
319 %************************************************************************
321 \subsection[CgConTbls-updates]{Generating update bits for constructors}
323 %************************************************************************
325 Generate the "phantom" info table and update code, iff the constructor returns in regs
329 genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
330 genPhantomUpdInfo comp_info tycon data_con
331 = case dataReturnConvAlg data_con of
333 ReturnInHeap -> AbsCNop -- No need for a phantom update
338 phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing upd_code con_descr
339 phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
341 con_descr = _UNPK_ (getOccurrenceName data_con)
343 con_arity = getDataConArity data_con
345 upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
346 upd_label = mkConUpdCodePtrVecLabel tycon tag
347 tag = getDataConTag data_con
349 updatee = CVal (SpBRel 0 (-uF_UPDATEE)) PtrKind
351 perform_return = mkAbstractCs
353 CMacroStmt POP_STD_UPD_FRAME [],
354 CReturn (CReg RetReg) return_info
358 -- OLD: pprTrace "ctrlReturn6:" (ppr PprDebug tycon) (
359 case (ctrlReturnConvAlg tycon) of
360 UnvectoredReturn _ -> DirectReturn
361 VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
364 -- Determine cost centre for the updated closures CC (and allocation)
365 -- CCC for lexical (now your only choice)
366 use_cc = CReg CurCostCentre -- what to put in the closure
367 blame_cc = use_cc -- who to blame for allocation
369 do_move (reg, virt_offset) =
370 CAssign (CVal (NodeRel virt_offset) (kindFromMagicId reg)) (CReg reg)
373 -- Code for building a new constructor in place over the updatee
374 overwrite_code = profCtrC SLIT("UPD_CON_IN_PLACE") [] `thenC`
377 CAssign (CReg node) updatee,
379 -- Tell the storage mgr that we intend to update in place
380 -- This may (in complicated mgrs eg generational) cause gc,
381 -- and it may modify Node to point to another place to
382 -- actually update into.
383 CMacroStmt upd_inplace_macro [liveness_mask],
385 -- Initialise the closure pointed to by node
386 CInitHdr closure_info (NodeRel zeroOff) use_cc True,
387 mkAbstractCs (map do_move regs_w_offsets),
388 if con_arity /= 0 then
389 CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
394 upd_inplace_macro = if closurePtrsSize closure_info == 0
395 then UPD_INPLACE_NOPTRS
396 else UPD_INPLACE_PTRS
398 -- Code for allocating a new constructor in the heap
400 let amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
402 -- Allocate and build closure specifying upd_new_w_regs
403 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
404 `thenFC` \ hp_offset ->
405 getHpRelOffset hp_offset `thenFC` \ hp_rel ->
409 profCtrC SLIT("UPD_CON_IN_NEW") [] `thenC`
412 CMacroStmt UPD_IND [updatee, amode],
413 CAssign (CReg node) amode,
414 CAssign (CReg infoptr) (CLbl info_label DataPtrKind)
417 (closure_info, regs_w_offsets) = layOutDynCon data_con kindFromMagicId regs
418 info_label = infoTableLabelFromCI closure_info
419 liveness_mask = mkIntCLit (mkLiveRegsBitMask (node:regs))
422 if fitsMinUpdSize closure_info then
423 initC comp_info overwrite_code
425 initC comp_info (heapCheck regs False alloc_code)
427 in CClosureUpdInfo phantom_itbl