-cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
-
-cgReturnDataCon con amodes all_zero_size_args live_vars
- = ASSERT(isDataCon con)
- getIntSwitchChkrC `thenFC` \ isw_chkr ->
- getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
-
- case sequel of
-
- CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
- | not (getDataConTag con `is_elem` map fst alts)
- ->
- -- Special case! We're returning a constructor to the default case
- -- of an enclosing case. For example:
- --
- -- case (case e of (a,b) -> C a b) of
- -- D x -> ...
- -- y -> ...<returning here!>...
- --
- -- In this case,
- -- if the default is a non-bind-default (ie does not use y),
- -- then we should simply jump to the default join point;
- --
- -- if the default is a bind-default (ie does use y), we
- -- should return the constructor IN THE HEAP, pointed to by Node,
- -- **regardless** of the return convention of the constructor C.
-
- case maybe_deflt_binder of
- Just binder ->
- buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
- `thenFC` \ idinfo ->
- idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
- performReturn (move_to_reg amode node) jump_to_join_point live_vars
-
- Nothing ->
- performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
- where
- is_elem = isIn "cgReturnDataCon"
- jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
- -- Ignore the sequel: we've already looked at it above
-
- other_sequel -> -- The usual case
- case (dataReturnConvAlg isw_chkr con) of
-
- ReturnInHeap ->
- -- BUILD THE OBJECT IN THE HEAP
- -- The first "con" says that the name bound to this
- -- closure is "con", which is a bit of a fudge, but it only
- -- affects profiling (ToDo?)
- buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
- `thenFC` \ idinfo ->
- idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
-
- -- MAKE NODE POINT TO IT
- let reg_assts = move_to_reg amode node
- info_lbl = mkInfoTableLabel con
- in
-
- -- RETURN
- profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
-
- performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
-
- ReturnInRegs regs ->
- let
- reg_assts = mkAbstractCs (zipWithEqual move_to_reg amodes regs)
- info_lbl = mkPhantomInfoTableLabel con
- in
- profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
-
- performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
+cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
+
+cgReturnDataCon con amodes
+ = ASSERT( amodes `lengthIs` dataConRepArity con )
+ do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
+ ; case sequel of
+ CaseAlts _ (Just (alts, deflt_lbl)) bndr _
+ -> -- Ho! We know the constructor so we can
+ -- go straight to the right alternative
+ case assocMaybe alts (dataConTagZ con) of {
+ Just join_lbl -> build_it_then (jump_to join_lbl);
+ Nothing
+ -- Special case! We're returning a constructor to the default case
+ -- of an enclosing case. For example:
+ --
+ -- case (case e of (a,b) -> C a b) of
+ -- D x -> ...
+ -- y -> ...<returning here!>...
+ --
+ -- In this case,
+ -- if the default is a non-bind-default (ie does not use y),
+ -- then we should simply jump to the default join point;
+
+ | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
+ | otherwise -> build_it_then (jump_to deflt_lbl) }
+
+ other_sequel -- The usual case
+ | isUnboxedTupleCon con -> returnUnboxedTuple amodes
+ | otherwise -> build_it_then (emitKnownConReturnCode con)
+ }
+ where
+ jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
+ build_it_then return_code
+ = do { -- BUILD THE OBJECT IN THE HEAP
+ -- The first "con" says that the name bound to this
+ -- closure is "con", which is a bit of a fudge, but it only
+ -- affects profiling
+
+ -- This Id is also used to get a unique for a
+ -- temporary variable, if the closure is a CHARLIKE.
+ -- funnily enough, this makes the unique always come
+ -- out as '54' :-)
+ tickyReturnNewCon (length amodes)
+ ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
+ ; amode <- idInfoToAmode idinfo
+ ; checkedAbsC (CmmAssign nodeReg amode)
+ ; performReturn return_code }
+\end{code}
+
+
+%************************************************************************
+%* *
+ Generating static stuff for algebraic data types
+%* *
+%************************************************************************
+
+ [These comments are rather out of date]
+
+\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[@_static_info@:]
+Static occurrences of the constructor
+macro: @STATIC_INFO_TABLE@.
+\end{description}
+
+For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
+it's place is taken by the top level defn of the constructor.
+
+For charlike and intlike closures there is a fixed array of static
+closures predeclared.
+
+\begin{code}
+cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
+cgTyCon tycon
+ = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
+
+ -- Generate a table of static closures for an enumeration type
+ -- Put the table after the data constructor decls, because the
+ -- datatype closure table (for enumeration types)
+ -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
+ ; extra <-
+ if isEnumerationTyCon tycon then do
+ tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
+ (tyConName tycon))
+ [ CmmLabel (mkLocalClosureLabel (dataConName con))
+ | con <- tyConDataCons tycon])
+ return [tbl]
+ else
+ return []
+
+ ; return (extra ++ constrs)
+ }
+\end{code}
+
+Generate the entry code, info tables, and (for niladic constructor) the
+static closure, for a constructor.
+
+\begin{code}
+cgDataCon :: DataCon -> Code
+cgDataCon data_con
+ = do { -- Don't need any dynamic closure code for zero-arity constructors
+ hmods <- getHomeModules
+
+ ; let
+ -- 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.
+ (static_cl_info, _) =
+ layOutStaticConstr hmods data_con arg_reps
+
+ (dyn_cl_info, arg_things) =
+ layOutDynConstr hmods data_con arg_reps
+
+ emit_info cl_info ticky_code
+ = do { code_blks <- getCgStmts the_code
+ ; emitClosureCodeAndInfoTable cl_info [] code_blks }
+ where
+ the_code = do { ticky_code
+ ; ldvEnter (CmmReg nodeReg)
+ ; body_code }
+
+ arg_reps :: [(CgRep, Type)]
+ arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
+
+ body_code = do {
+ -- NB: We don't set CC when entering data (WDP 94/06)
+ tickyReturnOldCon (length arg_things)
+ ; performReturn (emitKnownConReturnCode data_con) }
+ -- noStmts: Ptr to thing already in Node
+
+ ; whenC (not (isNullaryRepDataCon data_con))
+ (emit_info dyn_cl_info tickyEnterDynCon)
+
+ -- Dynamic-Closure first, to reduce forward references
+ ; emit_info static_cl_info tickyEnterStaticCon }
+