diff options
Diffstat (limited to 'ghc/compiler/codeGen')
| -rw-r--r-- | ghc/compiler/codeGen/CgClosure.lhs | 5 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgCon.lhs | 94 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgMonad.lhs | 4 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CodeGen.lhs | 2 |
4 files changed, 36 insertions, 69 deletions
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 6721172474..c1ddff2d3d 100644 --- a/ghc/compiler/codeGen/CgClosure.lhs +++ b/ghc/compiler/codeGen/CgClosure.lhs @@ -1,7 +1,7 @@ % % (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 ) diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs index 0a9a76dc7f..35dcdc2610 100644 --- a/ghc/compiler/codeGen/CgCon.lhs +++ b/ghc/compiler/codeGen/CgCon.lhs @@ -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} %************************************************************************ diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs index a9b6e41974..c3e029516a 100644 --- a/ghc/compiler/codeGen/CgMonad.lhs +++ b/ghc/compiler/codeGen/CgMonad.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 6bd024d70e..6d388277fb 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -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 ) |