Skip to content
Snippets Groups Projects
Commit 3505f69a authored by Simon Marlow's avatar Simon Marlow
Browse files

[project @ 1999-06-09 14:28:37 by simonmar] 

Move some code around to reduce the linkage between CgMonad and CgBindery,
and make the .hi-boot-5 file compatible with both 4.02 and 4.03.
parent 2004d680
No related merge requests found
Hide whitespace changes
Inline Side-by-side
ghc/compiler/codeGen/CgBindery.hi-boot
+ 2
− 3
View file @ 3505f69a
_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 ;;
ghc/compiler/codeGen/CgBindery.hi-boot-4
+ 2
− 3
View file @ 3505f69a
_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 ;;
ghc/compiler/codeGen/CgBindery.hi-boot-5
+ 2
− 3
View file @ 3505f69a
__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 ;
ghc/compiler/codeGen/CgBindery.lhs
+ 61
− 4
View file @ 3505f69a
......@@ -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 )
......@@ -163,6 +163,63 @@ idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode:
#endif
\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}
%************************************************************************
%* *
\subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
......
ghc/compiler/codeGen/CgExpr.lhs
+ 3
− 2
View file @ 3505f69a
%
% (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 )
......
ghc/compiler/codeGen/CgMonad.lhs
+ 12
− 65
View file @ 3505f69a
%
% (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}
ghc/compiler/codeGen/CodeGen.lhs
+ 1
− 1
View file @ 3505f69a
......@@ -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 )
......
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