-
- where
- move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
- move_to_reg (reg, offset)
- = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
-
- load_infoptr
- = CAssign (CReg infoptr) (CMacroExpr DataPtrRep INFO_PTR [CReg node])
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgConTbls-updates]{Generating update bits for constructors}
-%* *
-%************************************************************************
-
-Generate the "phantom" info table and update code, iff the constructor returns in regs
-
-\begin{code}
-
-genPhantomUpdInfo :: CompilationInfo -> TyCon -> Id{-data con-} -> AbstractC
-
-genPhantomUpdInfo comp_info tycon data_con
- = case (dataReturnConvAlg data_con) of
-
- ReturnInHeap -> AbsCNop -- No need for a phantom update
-
- ReturnInRegs regs ->
- let
- phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
- upd_code con_descr
- (dataConLiveness phantom_ci)
-
- phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
-
- con_descr = _UNPK_ (nameOf (origName "con_descr2" data_con))
-
- con_arity = dataConNumFields data_con
-
- upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
- upd_label = mkConUpdCodePtrVecLabel tycon tag
- tag = dataConTag data_con
-
- updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
-
- perform_return = mkAbstractCs
- [
- CMacroStmt POP_STD_UPD_FRAME [],
- CReturn (CReg RetReg) return_info
- ]
-
- return_info =
- case (ctrlReturnConvAlg tycon) of
- UnvectoredReturn _ -> DirectReturn
- VectoredReturn _ -> StaticVectoredReturn (tag - fIRST_TAG)
-
- -- Determine cost centre for the updated closures CC (and allocation)
- -- CCC for lexical (now your only choice)
- use_cc = CReg CurCostCentre -- what to put in the closure
- blame_cc = use_cc -- who to blame for allocation
-
- do_move (reg, virt_offset) =
- CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
-
-
- -- Code for building a new constructor in place over the updatee
- overwrite_code
- = profCtrC SLIT("UPD_CON_IN_PLACE")
- [mkIntCLit (length regs_w_offsets)] `thenC`
- absC (mkAbstractCs
- [
- CAssign (CReg node) updatee,
-
- -- Tell the storage mgr that we intend to update in place
- -- This may (in complicated mgrs eg generational) cause gc,
- -- and it may modify Node to point to another place to
- -- actually update into.
- CMacroStmt upd_inplace_macro [liveness_mask],
-
- -- Initialise the closure pointed to by node
- CInitHdr closure_info (NodeRel zeroOff) use_cc True,
- mkAbstractCs (map do_move regs_w_offsets),
- if con_arity /= 0 then
- CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
- else
- AbsCNop
- ])
-
- upd_inplace_macro = if closurePtrsSize closure_info == 0
- then UPD_INPLACE_NOPTRS
- else UPD_INPLACE_PTRS
-
- -- Code for allocating a new constructor in the heap
- alloc_code
- = let
- amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
- in
- -- Allocate and build closure specifying upd_new_w_regs
- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
- `thenFC` \ hp_offset ->
- getHpRelOffset hp_offset `thenFC` \ hp_rel ->
- let
- amode = CAddr hp_rel
- in
- profCtrC SLIT("UPD_CON_IN_NEW")
- [mkIntCLit (length amodes_w_offsets)] `thenC`
- absC (mkAbstractCs
- [ CMacroStmt UPD_IND [updatee, amode],
- CAssign (CReg node) amode,
- CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
- ])
-
- (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
- info_label = infoTableLabelFromCI closure_info
- liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
-
- build_closure =
- if fitsMinUpdSize closure_info then
- initC comp_info overwrite_code
- else
- initC comp_info (heapCheck regs False alloc_code)
-
- in CClosureUpdInfo phantom_itbl
-