import AbsCUtils ( getAmodeRep )
import CgBindery ( getArgAmodes, bindNewToNode,
- bindArgsToRegs, newTempAmodeAndIdInfo,
+ bindArgsToRegs,
idInfoToAmode, stableAmodeIdInfo,
heapIdInfo, CgIdInfo, bindNewToStack
)
)
import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
getSpRelOffset )
-import CgClosure ( cgTopRhsClosure )
import CgRetConv ( assignRegs )
-import Constants ( mAX_INTLIKE, mIN_INTLIKE, mIN_UPD_SIZE )
+import Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
+ mIN_UPD_SIZE )
import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
mkUnboxedTupleReturnCode )
import CLabel ( mkClosureLabel )
-import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
+import ClosureInfo ( mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
layOutStaticClosure, closureSize
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
-import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
- isUnboxedTupleCon, isNullaryDataCon, dataConId, dataConWrapId
+import DataCon ( DataCon, dataConName, dataConTag,
+ isUnboxedTupleCon, isNullaryDataCon, dataConId,
+ dataConWrapId, dataConRepArity
)
-import Id ( Id, idName, idType, idPrimRep )
-import Name ( nameModule, isLocallyDefinedName )
+import Id ( Id, idName, idPrimRep )
import Literal ( Literal(..) )
import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Uniquable(..) )
import Util
-import Panic ( assertPanic, trace )
+import Outputable
\end{code}
%************************************************************************
-> [StgArg] -- Args
-> FCode (Id, CgIdInfo)
cgTopRhsCon id con args
- = ASSERT(not dynamic_con_or_args) -- checks for litlit args too
+ = ASSERT(not (isDllConApp con args)) -- checks for litlit args too
+ ASSERT(length args == dataConRepArity con)
+ let
+ name = idName id
+ closure_label = mkClosureLabel name
+ lf_info = mkConLFInfo con
+ cg_id_info = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
+ in
+
(
-- LAY IT OUT
getArgAmodes args `thenFC` \ amodes ->
absC (CStaticClosure
closure_label -- Labelled with the name on lhs of defn
closure_info -- Closure is static
- top_ccc
+ (mkCCostCentreStack dontCareCCS) -- because it's static data
(map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
) `thenC`
-- RETURN
returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
- where
- lf_info = mkConLFInfo con
- closure_label = mkClosureLabel name
- name = idName id
-
- top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
-
- -- stuff needed by the assert pred only.
- dynamic_con_or_args = isDllConApp con args
\end{code}
%************************************************************************
(mkConLFInfo con))
\end{code}
+The following three paragraphs about @Char@-like and @Int@-like
+closures are obsolete, but I don't understand the details well enough
+to properly word them, sorry. I've changed the treatment of @Char@s to
+be analogous to @Int@s: only a subset is preallocated, because @Char@
+has now 31 bits. Only literals are handled here. -- Qrczak
+
Now for @Char@-like closures. We generate an assignment of the
address of the closure to a temporary. It would be possible simply to
generate no code, and record the addressing mode in the environment,
\begin{code}
buildDynCon binder cc con [arg_amode]
-
- | maybeCharLikeCon con
- = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
- returnFC temp_id_info
-
| maybeIntLikeCon con && in_range_int_lit arg_amode
= returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
where
- (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
-
in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
- in_range_int_lit other_amode = False
+ in_range_int_lit _other_amode = False
+
+buildDynCon binder cc con [arg_amode]
+ | maybeCharLikeCon con && in_range_char_lit arg_amode
+ = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
+ where
+ in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
+ in_range_char_lit _other_amode = False
\end{code}
Now the general case.
cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
cgReturnDataCon con amodes
- = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
+ = ASSERT(length amodes == dataConRepArity con)
+ getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
case sequel of
-- do update in place...
UpdateCode
| not (isNullaryDataCon con) -- no nullary constructors, please
- && not (maybeCharLikeCon con) -- no chars please (these are all static)
&& not (any isFollowableRep (map getAmodeRep amodes))
-- no ptrs please (generational gc...)
&& closureSize closure_info <= mIN_UPD_SIZE