CgConTbls.lhs 14.1 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
3 4 5 6 7 8
%
\section[CgConTbls]{Info tables and update bits for constructors}

\begin{code}
#include "HsVersions.h"

9
module CgConTbls ( genStaticConBits ) where
10

11
IMP_Ubiq(){-uitous-}
12 13 14 15

import AbsCSyn
import CgMonad

16 17
import AbsCUtils	( mkAbsCStmts, mkAbstractCs, magicIdPrimRep )
import CgCompInfo	( uF_UPDATEE )
18
import CgHeapery	( heapCheck, allocDynClosure )
19
import CgRetConv	( dataReturnConvAlg, ctrlReturnConvAlg,
20 21 22 23 24
			  CtrlReturnConvention(..),
			  DataReturnConvention(..)
			)
import CgTailCall	( performReturn, mkStaticAlgReturnCode )
import CgUsages		( getHpRelOffset )
25
import CLabel		( mkConEntryLabel, mkStaticClosureLabel,
26 27
			  mkConUpdCodePtrVecLabel,
			  mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel
28 29
			)
import ClosureInfo	( layOutStaticClosure, layOutDynCon,
30 31
			  layOutPhantomClosure, closurePtrsSize,
			  fitsMinUpdSize, mkConLFInfo,
32
			  infoTableLabelFromCI, dataConLiveness
33
			)
34
import CostCentre	( dontCareCostCentre )
35
import FiniteMap	( fmToList, FiniteMap )
36
import HeapOffs		( zeroOff, SYN_IE(VirtualHeapOffset) )
37
import Id		( dataConTag, dataConRawArgTys,
38
			  dataConNumFields, fIRST_TAG,
39 40
			  emptyIdSet,
			  GenId{-instance NamedThing-}
41
			)
42
import Name		( nameOf, origName )
43
import PrelInfo		( maybeIntLikeTyCon )
44 45 46 47 48 49
import PrimRep		( getPrimRepSize, PrimRep(..) )
import TyCon		( tyConDataCons, mkSpecTyCon )
import Type		( typePrimRep )
import Util		( panic )

mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
50 51 52
\end{code}

For every constructor we generate the following info tables:
53
	A static info table, for static instances of the constructor,
54

55
	For constructors which return in registers (and only them),
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
		an "inregs" info table.  This info table is rather emaciated;
		it only contains update code and tag.

	Plus:

\begin{tabular}{lll}
Info tbls &	 Macro  &     	     Kind of constructor \\
\hline
info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
\end{tabular}

Possible info tables for constructor con:

\begin{description}
\item[@con_info@:]
Used for dynamically let(rec)-bound occurrences of
the constructor, and for updates.  For constructors
which are int-like, char-like or nullary, when GC occurs,
the closure tries to get rid of itself.

\item[@con_inregs_info@:]
81
Used when returning a new constructor in registers.
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
Only for return-in-regs constructors.
Macro: @INREGS_INFO_TABLE@.

\item[@con_static_info@:]
Static occurrences of the constructor
macro: @STATIC_INFO_TABLE@.
\end{description}

For zero-arity constructors, \tr{con}, we also generate a static closure:

\begin{description}
\item[@con_closure@:]
A single static copy of the (zero-arity) constructor itself.
\end{description}

For charlike and intlike closures there is a fixed array of static
closures predeclared.

\begin{code}
genStaticConBits :: CompilationInfo 	-- global info about the compilation
		 -> [TyCon]		-- tycons to generate
103
	  	 -> FiniteMap TyCon [(Bool, [Maybe Type])]
104 105 106 107 108 109 110 111 112 113 114 115 116 117
					-- tycon specialisation info
		 -> AbstractC		-- output

genStaticConBits comp_info gen_tycons tycon_specs
  = -- for each type constructor:
    --	 grab all its data constructors;
    --	    for each one, generate an info table
    -- for each specialised type constructor
    --   for each specialisation of the type constructor
    --     grab data constructors, and generate info tables

    -- ToDo: for tycons and specialisations which are not
    --       declared in this module we must ensure that the
    --       C labels are local to this module i.e. static
118
    --	     since they may be duplicated in other modules
119 120 121

    mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
      `mkAbsCStmts`
122 123 124 125 126 127
    mkAbstractCs [ mkAbstractCs [ gen_for_spec_tycon tc spec
				| (imported_spec, spec) <- specs,
				  -- no code generated if spec is imported
				  not imported_spec
				]
		 | (tc, specs) <- fmToList tycon_specs ]
128 129 130 131
  where
    gen_for_tycon :: TyCon -> AbstractC
    gen_for_tycon tycon
      = mkAbstractCs (map (genConInfo comp_info tycon) data_cons)
132 133
	  `mkAbsCStmts`
	maybe_tycon_vtbl
134
      where
135
    	data_cons   	= tyConDataCons tycon
136 137 138 139 140 141 142
    	tycon_upd_label = mkStdUpdVecTblLabel tycon

    	maybe_tycon_vtbl =
	  case ctrlReturnConvAlg tycon of
    	    UnvectoredReturn 1 -> CRetUnVector tycon_upd_label
					(mk_upd_label tycon (head data_cons))
    	    UnvectoredReturn _ -> AbsCNop
143
    	    VectoredReturn   _ -> CFlatRetVector tycon_upd_label
144 145
    	    	    	    	    	(map (mk_upd_label tycon) data_cons)
    ------------------
146
    gen_for_spec_tycon :: TyCon -> [Maybe Type] -> AbstractC
147 148

    gen_for_spec_tycon tycon ty_maybes
149
      = mkAbstractCs (map (genConInfo comp_info spec_tycon) spec_data_cons)
150
	  `mkAbsCStmts`
151
	maybe_spec_tycon_vtbl
152
      where
153
	data_cons      = tyConDataCons tycon
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168

	spec_tycon     = mkSpecTyCon tycon ty_maybes
    	spec_data_cons = map (mkSameSpecCon ty_maybes) data_cons

    	spec_tycon_upd_label = mkStdUpdVecTblLabel spec_tycon

    	maybe_spec_tycon_vtbl =
	  case ctrlReturnConvAlg spec_tycon of
    	    UnvectoredReturn 1 -> CRetUnVector spec_tycon_upd_label
    	    	    	    	    	(mk_upd_label spec_tycon (head spec_data_cons))
    	    UnvectoredReturn _ -> AbsCNop
    	    VectoredReturn   _ -> CFlatRetVector spec_tycon_upd_label
					(map (mk_upd_label spec_tycon) spec_data_cons)
    ------------------
    mk_upd_label tycon con
169
      = CLbl
170
	(case (dataReturnConvAlg con) of
171 172
	  ReturnInRegs _ -> mkConUpdCodePtrVecLabel tycon tag
	  ReturnInHeap   -> mkStdUpdCodePtrVecLabel tycon tag)
173
	CodePtrRep
174
      where
175
	tag = dataConTag con
176 177 178 179 180 181 182 183 184 185 186 187 188 189
\end{code}

%************************************************************************
%*									*
\subsection[CgConTbls-info-tables]{Generating info tables for constructors}
%*									*
%************************************************************************

Generate the entry code, info tables, and (for niladic constructor) the
static closure, for a constructor.

\begin{code}
genConInfo :: CompilationInfo -> TyCon -> Id -> AbstractC

190
genConInfo comp_info tycon data_con
191 192 193 194 195 196 197 198
  = mkAbstractCs [
		  CSplitMarker,
		  inregs_upd_maybe,
		  closure_code,
    	    	  static_code,
		  closure_maybe]
	-- Order of things is to reduce forward references
  where
199
    (closure_info, body_code) = mkConCodeAndInfo data_con
200 201 202 203

    -- To allow the debuggers, interpreters, etc to cope with static
    -- data structures (ie those built at compile time), we take care that
    -- info-table contains the information we need.
204
    (static_ci,_) = layOutStaticClosure data_con typePrimRep arg_tys (mkConLFInfo data_con)
205 206 207 208 209

    body       = (initC comp_info (
	    	      profCtrC SLIT("ENT_CON") [CReg node] `thenC`
		      body_code))

210
    entry_addr = CLbl entry_label CodePtrRep
211
    con_descr  = _UNPK_ (nameOf (origName "con_descr" data_con))
212

213 214
    closure_code        = CClosureInfoAndCode closure_info body Nothing
					      stdUpd con_descr
215
					      (dataConLiveness closure_info)
216 217
    static_code         = CClosureInfoAndCode static_ci body Nothing
					      stdUpd con_descr
218
					      (dataConLiveness static_ci)
219 220 221

    inregs_upd_maybe    = genPhantomUpdInfo comp_info tycon data_con

222
    stdUpd  	    	= CLbl (mkStdUpdCodePtrVecLabel tycon tag) CodePtrRep
223

224
    tag	    	    	= dataConTag data_con
225 226 227 228

    cost_centre = mkCCostCentre dontCareCostCentre -- not worried about static data costs

    -- For zero-arity data constructors, or, more accurately,
229
    -- 	 those which only have VoidRep args (or none):
230 231
    -- 	We make the closure too (not just info tbl), so that we can share
    --  one copy throughout.
232
    closure_maybe = if not (all zero_size arg_tys) then
233
		    	AbsCNop
234
		    else
235 236 237
		    	CStaticClosure  closure_label		-- Label for closure
					static_ci		-- Info table
					cost_centre
238
					[{-No args!  A slight lie for constrs with VoidRep args-}]
239

240
    zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
241

242 243 244
    arg_tys	    = dataConRawArgTys 	   data_con
    entry_label     = mkConEntryLabel      data_con
    closure_label   = mkStaticClosureLabel data_con
245 246
\end{code}

247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
The entry code for a constructor now loads the info ptr by indirecting
node.  The alternative is to load the info ptr in the enter-via-node
sequence.  There's is a trade-off here:

	* If the architecture can perform an indirect jump through a
	  register in one instruction, or if the info ptr is not a
	  real register, then *not* loading the info ptr on an enter
	  is a win.

	* If the enter-via-node code is identical whether we load the
	  info ptr or not, then doing it is a win (it means we don't
	  have to do it here).

However, the gratuitous load here is miniscule compared to the
gratuitous loads of the info ptr on each enter, so we go for the first
option.

-- Simon M. (6/5/96)

266
\begin{code}
267
mkConCodeAndInfo :: Id 			-- Data constructor
268 269
		 -> (ClosureInfo, Code)	-- The info table

270 271
mkConCodeAndInfo con
  = case (dataReturnConvAlg con) of
272 273 274 275

    ReturnInRegs regs ->
	let
	    (closure_info, regs_w_offsets)
276
	      = layOutDynCon con magicIdPrimRep regs
277 278

	    body_code
279
	      = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
280

281
		performReturn (mkAbstractCs (load_infoptr : map move_to_reg regs_w_offsets))
282
			      (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
283
			      emptyIdSet{-no live vars-}
284 285
	in
	(closure_info, body_code)
286

287 288
    ReturnInHeap ->
	let
289
	    arg_tys = dataConRawArgTys con
290

291
	    (closure_info, arg_things)
292
		= layOutDynCon con typePrimRep arg_tys
293 294

	    body_code
295
		= -- NB: We don't set CC when entering data (WDP 94/06)
296
		  profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
297

298
		  performReturn (mkAbstractCs [load_infoptr])	-- Ptr to thing already in Node
299
				(mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
300
				emptyIdSet{-no live vars-}
301 302 303 304 305 306
	in
	(closure_info, body_code)

  where
    move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
    move_to_reg (reg, offset)
307
      = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
308 309 310

    load_infoptr 
      = CAssign (CReg infoptr) (CMacroExpr DataPtrRep INFO_PTR [CReg node])
311
\end{code}
312 313 314 315 316 317 318 319 320 321 322 323 324

%************************************************************************
%*									*
\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

325 326
genPhantomUpdInfo comp_info tycon data_con
  = case (dataReturnConvAlg data_con) of
327

328
      ReturnInHeap -> AbsCNop	-- No need for a phantom update
329

330 331 332
      ReturnInRegs regs ->
	let
	    phantom_itbl = CClosureInfoAndCode phantom_ci AbsCNop Nothing
333
				upd_code con_descr
334
				(dataConLiveness phantom_ci)
335

336 337
	    phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)

338
	    con_descr = _UNPK_ (nameOf (origName "con_descr2" data_con))
339

340
	    con_arity = dataConNumFields data_con
341

342
	    upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
343
    	    upd_label = mkConUpdCodePtrVecLabel tycon tag
344
	    tag = dataConTag data_con
345

346
	    updatee = CVal (SpBRel 0 (- uF_UPDATEE)) PtrRep
347

348 349 350 351 352
	    perform_return = mkAbstractCs
	      [
		CMacroStmt POP_STD_UPD_FRAME [],
		CReturn (CReg RetReg) return_info
	      ]
353

354
	    return_info =
355 356
    	      case (ctrlReturnConvAlg tycon) of
		UnvectoredReturn _ -> DirectReturn
357
		VectoredReturn   _ -> StaticVectoredReturn (tag - fIRST_TAG)
358 359 360 361 362 363

    	    -- 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

364
	    do_move (reg, virt_offset) =
365
    	    	CAssign (CVal (NodeRel virt_offset) (magicIdPrimRep reg)) (CReg reg)
366 367 368


    	    -- Code for building a new constructor in place over the updatee
369 370 371
       	    overwrite_code
	      = profCtrC SLIT("UPD_CON_IN_PLACE")
			 [mkIntCLit (length regs_w_offsets)]	`thenC`
372 373
	    	absC (mkAbstractCs
	    	  [
374 375 376 377 378 379 380 381 382 383 384 385
    	            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
386 387
    	    	        CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
		    else
388 389 390
    	    	        AbsCNop
	    	  ])

391
    	    upd_inplace_macro = if closurePtrsSize closure_info == 0
392 393 394 395
    	    	    	    	then UPD_INPLACE_NOPTRS
    	    	    	    	else UPD_INPLACE_PTRS

    	    -- Code for allocating a new constructor in the heap
396 397 398
    	    alloc_code
	      = let
		    amodes_w_offsets = [ (CReg r, o) | (r,o) <- regs_w_offsets ]
399 400 401 402
	    	in
		    -- Allocate and build closure specifying upd_new_w_regs
	    	    allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
						    	`thenFC` \ hp_offset ->
403
	    	    getHpRelOffset hp_offset		`thenFC` \ hp_rel ->
404 405 406
	    	    let
			amode = CAddr hp_rel
    	    	    in
407 408
		    profCtrC SLIT("UPD_CON_IN_NEW")
			     [mkIntCLit (length amodes_w_offsets)] `thenC`
409
		    absC (mkAbstractCs
410 411
		      [ CMacroStmt UPD_IND [updatee, amode],
			CAssign (CReg node) amode,
412
			CAssign (CReg infoptr) (CLbl info_label DataPtrRep)
413
		      ])
414

415
	    (closure_info, regs_w_offsets) = layOutDynCon data_con magicIdPrimRep regs
416
	    info_label = infoTableLabelFromCI closure_info
417
	    liveness_mask = mkIntCLit (mkLiveRegsMask (node:regs))
418

419
	    build_closure =
420
	      if fitsMinUpdSize closure_info then
421
		initC comp_info overwrite_code
422
	      else
423
		initC comp_info (heapCheck regs False alloc_code)
424

425
	in CClosureUpdInfo phantom_itbl
426 427 428

\end{code}