idInfoToAmode, stableAmodeIdInfo,
heapIdInfo, CgIdInfo, bindNewToStack
)
-import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots )
-import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp )
+import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots,
+ updateFrameSize
+ )
+import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
+ getSpRelOffset )
import CgClosure ( cgTopRhsClosure )
import CgRetConv ( assignRegs )
-import Constants ( mAX_INTLIKE, mIN_INTLIKE )
-import CgHeapery ( allocDynClosure )
+import Constants ( mAX_INTLIKE, mIN_INTLIKE, mIN_UPD_SIZE )
+import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
mkUnboxedTupleReturnCode )
import CLabel ( mkClosureLabel, mkStaticClosureLabel )
import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
layOutDynCon, layOutDynClosure,
- layOutStaticClosure
+ layOutStaticClosure, closureSize
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
isUnboxedTupleCon )
import MkId ( mkDataConId )
import Id ( Id, idName, idType, idPrimRep )
-import Const ( Con(..), Literal(..) )
+import Name ( nameModule, isLocallyDefinedName )
+import Module ( isDynamicModule )
+import Const ( Con(..), Literal(..), isLitLitLit )
import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
-import PrimRep ( PrimRep(..) )
-import BasicTypes ( TopLevelFlag(..) )
+import PrimRep ( PrimRep(..), isFollowableRep )
+import Unique ( Uniquable(..) )
import Util
+import Panic ( assertPanic, trace )
\end{code}
%************************************************************************
-> [StgArg] -- Args
-> Bool -- All zero-size args (see buildDynCon)
-> FCode (Id, CgIdInfo)
-\end{code}
-
-Special Case: Constructors some of whose arguments are of \tr{Double#}
-type, {\em or} which are ``lit lits'' (which are given \tr{Addr#}
-type).
-
-These ones have to be compiled as re-entrant thunks rather than
-closures, because we can't figure out a way to persuade C to allow us
-to initialise a static closure with Doubles! Thus, for \tr{x = 2.0}
-(defaults to Double), we get:
-
-\begin{verbatim}
--- The STG syntax:
- Main.x = MkDouble [2.0##]
-
--- C Code:
-
--- closure:
- SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
- };
--- its *own* info table:
- STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
--- with its *own* entry code:
- STGFUN(Main_x_entry) {
- P_ u1701;
- RetDouble1=2.0;
- u1701=(P_)*SpB;
- SpB=SpB-1;
- JMP_(u1701[0]);
- }
-\end{verbatim}
-
-The above has the down side that each floating-point constant will end
-up with its own info table (rather than sharing the MkFloat/MkDouble
-ones). On the plus side, however, it does return a value (\tr{2.0})
-{\em straight away}.
-
-Here, then is the implementation: just pretend it's a non-updatable
-thunk. That is, instead of
-
- x = D# 3.455#
-
-pretend we've seen
-
- x = [] \n [] -> D# 3.455#
-
-\begin{code}
-top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
-
-cgTopRhsCon bndr con args all_zero_size_args
- | any isLitLitArg args
- = cgTopRhsClosure bndr dontCareCCS NoStgBinderInfo NoSRT [] body lf_info
- where
- body = StgCon (DataCon con) args rhs_ty
- lf_info = mkClosureLFInfo bndr TopLevel [] ReEntrant []
- rhs_ty = idType bndr
-\end{code}
-
-OK, so now we have the general case.
-
-\begin{code}
cgTopRhsCon id con args all_zero_size_args
- = (
+ = ASSERT(not (any_litlit_args || dynamic_con_or_args))
+ (
-- LAY IT OUT
getArgAmodes args `thenFC` \ amodes ->
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.
+ any_litlit_args = any isLitLitArg args
+ dynamic_con_or_args = dynamic_con || any (isDynamic) args
+
+ dynamic_con = isDynName (dataConName con)
+
+ isDynName nm =
+ not (isLocallyDefinedName nm) &&
+ isDynamicModule (nameModule nm)
+
+ {-
+ Do any of the arguments refer to something in a DLL?
+ -}
+ isDynamic (StgVarArg v) = isDynName (idName v)
+ isDynamic (StgConArg c) =
+ case c of
+ DataCon dc -> isDynName (dataConName dc)
+ Literal l -> isLitLitLit l -- all bets are off if it is.
+ _ -> False
+
+
\end{code}
%************************************************************************
case sequel of
- CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
+ CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
| not (dataConTag con `is_elem` map fst alts)
->
-- Special case! We're returning a constructor to the default case
-- 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.
-
- case maybe_deflt_binder of
- Just binder ->
- ASSERT(not (isUnboxedTupleCon con))
- buildDynCon binder currentCCS con amodes all_zero_size_args
- `thenFC` \ idinfo ->
- idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
- performReturn (move_to_reg amode node) jump_to_join_point
-
- Nothing ->
- performReturn AbsCNop {- No reg assts -} jump_to_join_point
+
+ case maybe_deflt of
+ Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
+ Just _ -> build_it_then jump_to_join_point
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
+ -- If the sequel is an update frame, we might be able to
+ -- do update in place...
+ UpdateCode
+ | not all_zero_size_args -- 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
+ -- don't know the real size of the
+ -- thunk, so assume mIN_UPD_SIZE
+
+ -> -- get a new temporary and make it point to the updatee
+ let
+ uniq = getUnique con
+ temp = CTemp uniq PtrRep
+ in
+ getSpRelOffset args_sp `thenFC` \ sp_rel ->
+ absC (CAssign temp
+ (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
+ `thenC`
+
+ -- stomp all over it with the new constructor
+ inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
+ `thenC`
+
+ -- don't forget to update Su from the update frame
+ absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
+
+ -- set Node to point to the closure being returned
+ -- (can't be done earlier: node might conflict with amodes)
+ absC (CAssign (CReg node) temp) `thenC`
+
+ -- pop the update frame off the stack, and do the proper
+ -- return.
+ let new_sp = args_sp - updateFrameSize in
+ setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
+ performReturn (AbsCNop) (mkStaticAlgReturnCode con)
+
+ where (closure_info, stuff)
+ = layOutDynClosure (dataConName con)
+ getAmodeRep amodes lf_info
+
+ lf_info = mkConLFInfo con
+
other_sequel -- The usual case
| isUnboxedTupleCon con ->
let (ret_regs, leftovers) =
assignRegs [] (map getAmodeRep amodes)
in
+ profCtrC SLIT("TICK_RET_UNBOXED_TUP")
+ [mkIntCLit (length amodes)] `thenC`
+
doTailCall amodes ret_regs
mkUnboxedTupleReturnCode
(length leftovers) {- fast args arity -}
False {-node doesn't point-}
| otherwise ->
- -- 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.
- -- funilly enough, this makes the unique always come
- -- out as '54' :-)
- buildDynCon (mkDataConId con) currentCCS
- con amodes all_zero_size_args
- `thenFC` \ idinfo ->
- idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
-
-
- -- RETURN
- profCtrC SLIT("TICK_RET_CON") [mkIntCLit (length amodes)] `thenC`
- -- could use doTailCall here.
- performReturn (move_to_reg amode node)
- (mkStaticAlgReturnCode con)
+ build_it_then (mkStaticAlgReturnCode con)
where
con_name = dataConName con
move_to_reg :: CAddrMode -> MagicId -> AbstractC
move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
+
+ build_it_then return =
+ -- 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.
+ -- funilly enough, this makes the unique always come
+ -- out as '54' :-)
+ buildDynCon (mkDataConId con) currentCCS
+ con amodes all_zero_size_args
+ `thenFC` \ idinfo ->
+ idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
+
+
+ -- RETURN
+ profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
+ -- could use doTailCall here.
+ performReturn (move_to_reg amode node) return
+
\end{code}
projects / ghc-hetmet.git / blobdiff