Commit dc7d7a2f authored by sof's avatar sof
Browse files

[project @ 1999-03-02 14:34:33 by sof]

- import list tweaks
- moved the code that decides that a StgCon really shouldn't
  be mapped to a static constructor but an updateable thunk
  if it contains lit-lits from the codegen into the CoreToStg
  translation.

  Added an extra case to this code to deal with StgCon's that contain
  references to values that reside in a DLL, where we also have to
  opt for an updateable thunk instead of a static constructor. Only
  applies when compiling on/for Win32 platforms.
parent 0554dc08
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.23 1999/01/21 10:31:55 simonm Exp $
% $Id: CgClosure.lhs,v 1.24 1999/03/02 14:34:36 sof Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -47,7 +47,8 @@ import ClosureInfo -- lots and lots of stuff
import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn )
import CostCentre
import Id ( Id, idName, idType, idPrimRep )
import Name ( Name, Module, pprModule )
import Name ( Name )
import Module ( Module, pprModule )
import ListSetOps ( minusList )
import PrimRep ( PrimRep(..) )
import PprType ( showTypeCategory )
......
......@@ -45,12 +45,14 @@ import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
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 Util
import Panic ( assertPanic )
import Panic ( assertPanic, trace )
\end{code}
%************************************************************************
......@@ -65,69 +67,9 @@ cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> [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 ->
......@@ -152,6 +94,30 @@ cgTopRhsCon id con args all_zero_size_args
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}
%************************************************************************
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgMonad.lhs,v 1.17 1999/01/06 11:35:27 simonm Exp $
% $Id: CgMonad.lhs,v 1.18 1999/03/02 14:34:38 sof Exp $
%
\section[CgMonad]{The code generation monad}
......@@ -50,7 +50,7 @@ import AbsCSyn
import AbsCUtils ( mkAbsCStmts )
import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling )
import CLabel ( CLabel, mkUpdEntryLabel )
import OccName ( Module )
import Module ( Module )
import DataCon ( ConTag )
import Id ( Id )
import VarEnv
......
......@@ -36,7 +36,7 @@ import CmdLineOpts ( opt_SccProfilingOn, opt_EnsureSplittableC,
import CostCentre ( CostCentre, CostCentreStack )
import FiniteMap ( FiniteMap )
import Id ( Id, idName )
import Name ( Module, moduleString )
import Module ( Module, moduleString )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import Type ( Type )
import TyCon ( TyCon )
......
......@@ -15,7 +15,8 @@ import Id ( mkUserId, idType, setIdArity, Id )
import VarSet
import VarEnv
import IdInfo ( exactArity )
import Name ( Module, mkTopName )
import Module ( Module )
import Name ( mkTopName )
import Type ( splitForAllTys, mkForAllTys, mkFunTys, Type )
import UniqSupply ( uniqFromSupply, splitUniqSupply, UniqSupply )
import Util ( zipEqual )
......
......@@ -10,7 +10,8 @@ bindings have no CAF references, and record the fact in their IdInfo.
module SRT where
import Id ( Id, setIdCafInfo, getIdCafInfo, externallyVisibleId,
idAppIsBottom )
idAppIsBottom
)
import IdInfo ( CafInfo(..) )
import StgSyn
......@@ -126,7 +127,7 @@ srtTopBind rho (StgNonRec binder rhs) =
-- don't output an SRT for the constructor, but just remember
-- whether it had any caf references or not.
StgRhsCon _ _ _ -> (StgNonRec binder' rhs, [], rho')
StgRhsCon _ _ _ -> (StgNonRec binder' rhs, [], rho')
srtTopBind rho (StgRec bs) =
......@@ -391,9 +392,10 @@ mk_caf_info (StgRhsClosure _ _ _ free_vars upd args body) srt
| null srt = NoCafRefs -- function w/ no static references
| otherwise = MayHaveCafRefs -- function w/ some static references
mk_caf_info (StgRhsCon cc con args) srt
| null srt = NoCafRefs -- constructor w/ no static references
| otherwise = MayHaveCafRefs -- otherwise, treat as a CAF
mk_caf_info rcon@(StgRhsCon cc con args) srt
| null srt = NoCafRefs -- constructor w/ no static references
| otherwise = MayHaveCafRefs -- otherwise, treat as a CAF
isBottomingExpr (StgLet bind expr) = isBottomingExpr expr
isBottomingExpr (StgApp f args) = idAppIsBottom f (length args)
......
......@@ -25,7 +25,7 @@ import CmdLineOpts ( opt_SccGroup,
StgToDo(..)
)
import Id ( Id )
import OccName ( Module, moduleString )
import Module ( Module, moduleString )
import VarEnv
import ErrUtils ( doIfSet )
import UniqSupply ( splitUniqSupply, UniqSupply )
......
......@@ -21,8 +21,12 @@ import CoreUtils ( coreExprType )
import SimplUtils ( findDefault )
import CostCentre ( noCCS )
import Id ( Id, mkSysLocal, idType,
externallyVisibleId, setIdUnique
externallyVisibleId, setIdUnique, idName
)
import DataCon ( DataCon, dataConName, dataConId )
import Name ( Name, nameModule, isLocallyDefinedName )
import Module ( isDynamicModule )
import Const ( Con(..), Literal, isLitLitLit )
import VarEnv
import Const ( Con(..), isWHNFCon, Literal(..) )
import PrimOp ( PrimOp(..) )
......@@ -146,17 +150,75 @@ exprToRhs (StgLet (StgNonRec var1 rhs) (StgApp var2 []))
-- incoming rhs. Why? Because trivial bindings might conceal
-- what the rhs is actually like.
exprToRhs (StgCon (DataCon con) args _) = StgRhsCon noCCS con args
{-
We reject the following candidates for 'static constructor'dom:
- any dcon that takes a lit-lit as an arg.
- [Win32 DLLs only]: any dcon that is (or takes as arg)
that's living in a DLL.
These constraints are necessary to ensure that the code
generated in the end for the static constructors, which
live in the data segment, remain valid - i.e., it has to
be constant. For obvious reasons, that's hard to guarantee
with lit-lits. The second case of a constructor referring
to static closures hiding out in some DLL is an artifact
of the way Win32 DLLs handle global DLL variables. A (data)
symbol exported from a DLL has to be accessed through a
level of indirection at the site of use, so whereas
extern StgClosure y_closure;
extern StgClosure z_closure;
x = { ..., &y_closure, &z_closure };
is legal when the symbols are in scope at link-time, it is
not when y_closure is in a DLL. So, any potential static
closures that refers to stuff that's residing in a DLL
will be put in an (updateable) thunk instead.
An alternative strategy is to support the generation of
constructors (ala C++ static class constructors) which will
then be run at load time to fix up static closures.
-}
exprToRhs (StgCon (DataCon con) args _)
| not is_dynamic &&
all (not.is_lit_lit) args = StgRhsCon noCCS con args
where
is_dynamic = isDynCon con || any (isDynArg) args
is_lit_lit (StgVarArg _) = False
is_lit_lit (StgConArg x) =
case x of
Literal l -> isLitLitLit l
_ -> False
exprToRhs expr
= StgRhsClosure noCCS -- No cost centre (ToDo?)
stgArgOcc -- safe
noSRT -- figure out later
bOGUS_FVs
Updatable -- Be pessimistic
[]
expr
isDynCon :: DataCon -> Bool
isDynCon con = isDynName (dataConName con)
isDynArg :: StgArg -> Bool
isDynArg (StgVarArg v) = isDynName (idName v)
isDynArg (StgConArg con) =
case con of
DataCon dc -> isDynCon dc
Literal l -> isLitLitLit l
_ -> False
isDynName :: Name -> Bool
isDynName nm =
not (isLocallyDefinedName nm) &&
isDynamicModule (nameModule nm)
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment