projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1999-02-17 15:57:20 by simonm]
[ghc-hetmet.git]
/
ghc
/
compiler
/
nativeGen
/
RegAllocInfo.lhs
diff --git
a/ghc/compiler/nativeGen/RegAllocInfo.lhs
b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index
93cda5c
..
50d5709
100644
(file)
--- a/
ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/
ghc/compiler/nativeGen/RegAllocInfo.lhs
@@
-1,12
+1,11
@@
%
%
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
%
\section[RegAllocInfo]{Machine-specific info used for register allocation}
The (machine-independent) allocator itself is in @AsmRegAlloc@.
\begin{code}
%
\section[RegAllocInfo]{Machine-specific info used for register allocation}
The (machine-independent) allocator itself is in @AsmRegAlloc@.
\begin{code}
-#include "HsVersions.h"
#include "nativeGen/NCG.h"
module RegAllocInfo (
#include "nativeGen/NCG.h"
module RegAllocInfo (
@@
-24,8
+23,8
@@
module RegAllocInfo (
regUsage,
FutureLive(..),
regUsage,
FutureLive(..),
- RegAssignment(..),
- RegConflicts(..),
+ RegAssignment,
+ RegConflicts,
RegFuture(..),
RegHistory(..),
RegInfo(..),
RegFuture(..),
RegHistory(..),
RegInfo(..),
@@
-37,7
+36,7
@@
module RegAllocInfo (
regLiveness,
spillReg,
regLiveness,
spillReg,
- RegSet(..),
+ RegSet,
elementOfRegSet,
emptyRegSet,
isEmptyRegSet,
elementOfRegSet,
emptyRegSet,
isEmptyRegSet,
@@
-51,20
+50,20
@@
module RegAllocInfo (
freeRegSet
) where
freeRegSet
) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
+import List ( partition )
import MachMisc
import MachRegs
import MachMisc
import MachRegs
-import MachCode ( InstrList(..) )
+import MachCode ( InstrList )
import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
import CLabel ( pprCLabel_asm, CLabel{-instance Ord-} )
import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
import CLabel ( pprCLabel_asm, CLabel{-instance Ord-} )
-import FiniteMap ( addToFM, lookupFM )
-import OrdList ( mkUnitList, OrdList )
+import FiniteMap ( addToFM, lookupFM, FiniteMap )
+import OrdList ( mkUnitList )
import PrimRep ( PrimRep(..) )
import PrimRep ( PrimRep(..) )
-import Stix ( StixTree, CodeSegment )
import UniqSet -- quite a bit of it
import UniqSet -- quite a bit of it
-import Unpretty ( uppShow )
+import Outputable
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-367,9
+366,9
@@
regUsage instr = case instr of
XOR sz src dst -> usage2 src dst
NOT sz op -> usage1 op
NEGI sz op -> usage1 op
XOR sz src dst -> usage2 src dst
NOT sz op -> usage1 op
NEGI sz op -> usage1 op
- SHL sz imm dst -> usage1 dst -- imm has to be an Imm
- SAR sz imm dst -> usage1 dst -- imm has to be an Imm
- SHR sz imm dst -> usage1 dst -- imm has to be an Imm
+ SHL sz dst len -> usage2 dst len -- len is either an Imm or ecx.
+ SAR sz dst len -> usage2 dst len -- len is either an Imm or ecx.
+ SHR sz len dst -> usage2 dst len -- len is either an Imm or ecx.
PUSH sz op -> usage (opToReg op) []
POP sz op -> usage [] (opToReg op)
TEST sz src dst -> usage (opToReg src ++ opToReg dst) []
PUSH sz op -> usage (opToReg op) []
POP sz op -> usage [] (opToReg op)
TEST sz src dst -> usage (opToReg src ++ opToReg dst) []
@@
-418,7
+417,7
@@
regUsage instr = case instr of
FISUBR sz asrc -> usage (addrToRegs asrc) [st0]
FTST -> usage [st0] []
FCOMP sz op -> usage (st0:opToReg op) [st0] -- allFPRegs
FISUBR sz asrc -> usage (addrToRegs asrc) [st0]
FTST -> usage [st0] []
FCOMP sz op -> usage (st0:opToReg op) [st0] -- allFPRegs
- FUCOMPP -> usage [st0, st1] [] -- allFPRegs
+ FUCOMPP -> usage [st0, st1] [st0, st1] -- allFPRegs
FXCH -> usage [st0, st1] [st0, st1]
FNSTSW -> usage [] [eax]
_ -> noUsage
FXCH -> usage [st0, st1] [st0, st1]
FNSTSW -> usage [] [eax]
_ -> noUsage
@@
-441,7
+440,7
@@
regUsage instr = case instr of
opToReg (OpImm imm) = []
opToReg (OpAddr ea) = addrToRegs ea
opToReg (OpImm imm) = []
opToReg (OpAddr ea) = addrToRegs ea
- addrToRegs (Addr base index _) = baseToReg base ++ indexToReg index
+ addrToRegs (AddrBaseIndex base index _) = baseToReg base ++ indexToReg index
where baseToReg Nothing = []
baseToReg (Just r) = [r]
indexToReg Nothing = []
where baseToReg Nothing = []
baseToReg (Just r) = [r]
indexToReg Nothing = []
@@
-531,8
+530,8
@@
regLiveness instr info@(RL live future@(FL all env))
lookup lbl
= case (lookupFM env lbl) of
Just rs -> rs
lookup lbl
= case (lookupFM env lbl) of
Just rs -> rs
- Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel_asm lbl)) ++
- " in future?") emptyRegSet
+ Nothing -> pprTrace "Missing" (pprCLabel_asm lbl <+> text "in future?")
+ emptyRegSet
in
case instr of -- the rest is machine-specific...
in
case instr of -- the rest is machine-specific...
@@
-664,9
+663,9
@@
patchRegs instr env = case instr of
XOR sz src dst -> patch2 (XOR sz) src dst
NOT sz op -> patch1 (NOT sz) op
NEGI sz op -> patch1 (NEGI sz) op
XOR sz src dst -> patch2 (XOR sz) src dst
NOT sz op -> patch1 (NOT sz) op
NEGI sz op -> patch1 (NEGI sz) op
- SHL sz imm dst -> patch1 (SHL sz imm) dst
- SAR sz imm dst -> patch1 (SAR sz imm) dst
- SHR sz imm dst -> patch1 (SHR sz imm) dst
+ SHL sz imm dst -> patch2 (SHL sz) imm dst
+ SAR sz imm dst -> patch2 (SAR sz) imm dst
+ SHR sz imm dst -> patch2 (SHR sz) imm dst
TEST sz src dst -> patch2 (TEST sz) src dst
CMP sz src dst -> patch2 (CMP sz) src dst
PUSH sz op -> patch1 (PUSH sz) op
TEST sz src dst -> patch2 (TEST sz) src dst
CMP sz src dst -> patch2 (CMP sz) src dst
PUSH sz op -> patch1 (PUSH sz) op
@@
-708,8
+707,8
@@
patchRegs instr env = case instr of
patchOp (OpAddr ea) = OpAddr (lookupAddr ea)
lookupAddr (ImmAddr imm off) = ImmAddr imm off
patchOp (OpAddr ea) = OpAddr (lookupAddr ea)
lookupAddr (ImmAddr imm off) = ImmAddr imm off
- lookupAddr (Addr base index disp)
- = Addr (lookupBase base) (lookupIndex index) disp
+ lookupAddr (AddrBaseIndex base index disp)
+ = AddrBaseIndex (lookupBase base) (lookupIndex index) disp
where
lookupBase Nothing = Nothing
lookupBase (Just r) = Just (env r)
where
lookupBase Nothing = Nothing
lookupBase (Just r) = Just (env r)