diff options
| -rw-r--r-- | ghc/compiler/codeGen/CgBindery.hi-boot | 5 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgBindery.hi-boot-4 | 5 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgBindery.hi-boot-5 | 5 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgBindery.lhs | 65 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgExpr.lhs | 5 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgMonad.lhs | 77 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CodeGen.lhs | 2 |
7 files changed, 83 insertions, 81 deletions
diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot b/ghc/compiler/codeGen/CgBindery.hi-boot index 2cc7a1c20b..f80decba35 100644 --- a/ghc/compiler/codeGen/CgBindery.hi-boot +++ b/ghc/compiler/codeGen/CgBindery.hi-boot @@ -1,10 +1,9 @@ _interface_ CgBindery 1 _exports_ -CgBindery CgBindings CgIdInfo(MkCgIdInfo) VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc; +CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds; _declarations_ 1 type CgBindings = VarEnv.IdEnv CgIdInfo; -1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo; +1 data CgIdInfo; 1 data VolatileLoc; 1 data StableLoc; 1 nukeVolatileBinds _:_ CgBindings -> CgBindings ;; -1 maybeStkLoc _:_ StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ;; diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-4 b/ghc/compiler/codeGen/CgBindery.hi-boot-4 index 441dace2fd..9a4ba58313 100644 --- a/ghc/compiler/codeGen/CgBindery.hi-boot-4 +++ b/ghc/compiler/codeGen/CgBindery.hi-boot-4 @@ -1,10 +1,9 @@ _interface_ CgBindery 1 0 _exports_ -CgBindery CgBindings CgIdInfo{MkCgIdInfo} VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc; +CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds; _declarations_ 1 type CgBindings = VarEnv.IdEnv CgIdInfo; -1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo; +1 data CgIdInfo; 1 data VolatileLoc; 1 data StableLoc; 1 nukeVolatileBinds _:_ CgBindings -> CgBindings ;; -1 maybeStkLoc _:_ StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ;; diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-5 b/ghc/compiler/codeGen/CgBindery.hi-boot-5 index 5486201937..f375fcc6e1 100644 --- a/ghc/compiler/codeGen/CgBindery.hi-boot-5 +++ b/ghc/compiler/codeGen/CgBindery.hi-boot-5 @@ -1,8 +1,7 @@ __interface CgBindery 1 0 where -__export CgBindery CgBindings CgIdInfo{MkCgIdInfo} VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc; +__export CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds; 1 type CgBindings = VarEnv.IdEnv CgIdInfo; -1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo; +1 data CgIdInfo; 1 data VolatileLoc; 1 data StableLoc; 1 nukeVolatileBinds :: CgBindings -> CgBindings ; -1 maybeStkLoc :: StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ; diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index 8fe334e985..3481feadab 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -5,14 +5,14 @@ \begin{code} module CgBindery ( - CgBindings, CgIdInfo(..){-dubiously concrete-}, + CgBindings, CgIdInfo, StableLoc, VolatileLoc, - maybeStkLoc, - stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo, letNoEscapeIdInfo, idInfoToAmode, + addBindC, addBindsC, + nukeVolatileBinds, nukeDeadBindings, @@ -34,7 +34,7 @@ import CgMonad import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp ) import CgStackery ( freeStackSlots, addFreeSlots ) import CLabel ( mkStaticClosureLabel, mkClosureLabel, - mkBitmapLabel ) + mkBitmapLabel, pprCLabel ) import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo ) import BitSet ( mkBS, emptyBS ) import PrimRep ( isFollowableRep, getPrimRepSize ) @@ -165,6 +165,63 @@ idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: %************************************************************************ %* * +\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@} +%* * +%************************************************************************ + +There are three basic routines, for adding (@addBindC@), modifying +(@modifyBindC@) and looking up (@lookupBindC@) bindings. + +A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple. +The name should not already be bound. (nice ASSERT, eh?) + +\begin{code} +addBindC :: Id -> CgIdInfo -> Code +addBindC name stuff_to_bind info_down (MkCgState absC binds usage) + = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage + +addBindsC :: [(Id, CgIdInfo)] -> Code +addBindsC new_bindings info_down (MkCgState absC binds usage) + = MkCgState absC new_binds usage + where + new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info) + binds + new_bindings + +modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code +modifyBindC name mangle_fn info_down (MkCgState absC binds usage) + = MkCgState absC (modifyVarEnv mangle_fn binds name) usage + +lookupBindC :: Id -> FCode CgIdInfo +lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _) + state@(MkCgState absC local_binds usage) + = (val, state) + where + val = case (lookupVarEnv local_binds name) of + Nothing -> try_static + Just this -> this + + try_static = + case (lookupVarEnv static_binds name) of + Just this -> this + Nothing + -> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state + +cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a +cgPanic doc info_down@(MkCgInfoDown _ static_binds srt _) + state@(MkCgState absC local_binds usage) + = pprPanic "cgPanic" + (vcat [doc, + ptext SLIT("static binds for:"), + vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ], + ptext SLIT("local binds for:"), + vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ], + ptext SLIT("SRT label") <+> pprCLabel srt + ]) +\end{code} + +%************************************************************************ +%* * \subsection[Bindery-nuke-volatile]{Nuking volatile bindings} %* * %************************************************************************ diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index a57ee94f42..fc96eb32da 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgExpr.lhs,v 1.26 1999/06/08 15:56:47 simonmar Exp $ +% $Id: CgExpr.lhs,v 1.27 1999/06/09 14:28:38 simonmar Exp $ % %******************************************************** %* * @@ -22,7 +22,8 @@ import AbsCUtils ( mkAbstractCs ) import CLabel ( mkClosureTblLabel ) import SMRep ( fixedHdrSize ) -import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo, nukeDeadBindings) +import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo, + nukeDeadBindings, addBindC, addBindsC ) import CgCase ( cgCase, saveVolatileVarsAndRegs, restoreCurrentCostCentre ) import CgClosure ( cgRhsClosure, cgStdRhsClosure ) diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs index df41f44dba..d649bc24ab 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.21 1999/06/08 15:56:47 simonmar Exp $ +% $Id: CgMonad.lhs,v 1.22 1999/06/09 14:28:38 simonmar Exp $ % \section[CgMonad]{The code generation monad} @@ -20,8 +20,6 @@ module CgMonad ( forkEvalHelp, forkAbsC, SemiTaggingStuff, - addBindC, addBindsC, modifyBindC, lookupBindC, - EndOfBlockInfo(..), setEndOfBlockInfo, getEndOfBlockInfo, @@ -29,7 +27,7 @@ module CgMonad ( StackUsage, Slot(..), HeapUsage, - profCtrC, cgPanic, + profCtrC, costCentresC, moduleName, @@ -43,13 +41,13 @@ module CgMonad ( #include "HsVersions.h" -import {-# SOURCE #-} CgBindery ( CgIdInfo(..), CgBindings, maybeStkLoc, nukeVolatileBinds ) +import {-# SOURCE #-} CgBindery ( CgIdInfo, CgBindings, nukeVolatileBinds ) import {-# SOURCE #-} CgUsages ( getSpRelOffset ) import AbsCSyn import AbsCUtils ( mkAbsCStmts ) import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling ) -import CLabel ( CLabel, mkUpdInfoLabel, pprCLabel ) +import CLabel ( CLabel, mkUpdInfoLabel ) import Module ( Module ) import DataCon ( ConTag ) import Id ( Id ) @@ -177,12 +175,18 @@ sequelToAmode (OnStack virt_sp_offset) sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep) sequelToAmode (CaseAlts amode _) = returnFC amode -sequelToAmode (SeqFrame _ _) = cgPanic (text "sequelToAmode: SeqFrame") +sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame" type CgStksAndHeapUsage -- stacks and heap usage information = (StackUsage, HeapUsage) -data Slot = Free | NonPointer deriving (Eq,Show) +data Slot = Free | NonPointer + deriving +#ifdef DEBUG + (Eq,Show) +#else + Eq +#endif type StackUsage = (Int, -- virtSp: Virtual offset of topmost allocated slot @@ -564,60 +568,3 @@ setSRTLabel :: CLabel -> Code -> Code setSRTLabel srt code (MkCgInfoDown c_info statics _ eob_info) state = code (MkCgInfoDown c_info statics srt eob_info) state \end{code} - -%************************************************************************ -%* * -\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@} -%* * -%************************************************************************ - -There are three basic routines, for adding (@addBindC@), modifying -(@modifyBindC@) and looking up (@lookupBindC@) bindings. - -A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple. -The name should not already be bound. (nice ASSERT, eh?) - -\begin{code} -addBindC :: Id -> CgIdInfo -> Code -addBindC name stuff_to_bind info_down (MkCgState absC binds usage) - = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage - -addBindsC :: [(Id, CgIdInfo)] -> Code -addBindsC new_bindings info_down (MkCgState absC binds usage) - = MkCgState absC new_binds usage - where - new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info) - binds - new_bindings - -modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code -modifyBindC name mangle_fn info_down (MkCgState absC binds usage) - = MkCgState absC (modifyVarEnv mangle_fn binds name) usage - -lookupBindC :: Id -> FCode CgIdInfo -lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _) - state@(MkCgState absC local_binds usage) - = (val, state) - where - val = case (lookupVarEnv local_binds name) of - Nothing -> try_static - Just this -> this - - try_static = - case (lookupVarEnv static_binds name) of - Just this -> this - Nothing - -> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state - -cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a -cgPanic doc info_down@(MkCgInfoDown _ static_binds srt _) - state@(MkCgState absC local_binds usage) - = pprPanic "cgPanic" - (vcat [doc, - ptext SLIT("static binds for:"), - vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ], - ptext SLIT("local binds for:"), - vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ], - ptext SLIT("SRT label") <+> pprCLabel srt - ]) -\end{code} diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 35e18cb659..95926aa602 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -26,7 +26,7 @@ import CLabel ( CLabel, mkSRTLabel, mkClosureLabel ) import PprAbsC ( dumpRealC ) import AbsCUtils ( mkAbstractCs, mkAbsCStmts, flattenAbsC ) -import CgBindery ( CgIdInfo ) +import CgBindery ( CgIdInfo, addBindC, addBindsC ) import CgClosure ( cgTopRhsClosure ) import CgCon ( cgTopRhsCon ) import CgConTbls ( genStaticConBits ) |