modules --- the pleasure has been foregone.)
\begin{code}
-#include "HsVersions.h"
#include "nativeGen/NCG.h"
module MachRegs (
Reg(..),
Imm(..),
- Addr(..),
+ MachRegsAddr(..),
RegLoc(..),
- RegNo(..),
+ RegNo,
addrOffset,
argRegs,
, allArgRegs
, fits8Bits
, fReg
- , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zero
+ , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
#endif
#if i386_TARGET_ARCH
, eax, ebx, ecx, edx, esi, esp
#endif
) where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
-import Pretty ( ppStr, ppRational, ppShow )
+import CLabel ( CLabel )
import PrimOp ( PrimOp(..) )
import PrimRep ( PrimRep(..) )
import Stix ( sStLitLbl, StixTree(..), StixReg(..),
CodeSegment
)
import Unique ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
- Unique{-instance Ord3-}
+ Uniquable(..), Unique
)
-import UniqSupply ( getUnique, returnUs, thenUs, UniqSM(..) )
-import Unpretty ( uppStr, Unpretty(..) )
-import Util ( panic )
+import UniqSupply ( getUnique, returnUs, thenUs, UniqSM )
+import Outputable
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
= ImmInt Int
| ImmInteger Integer -- Sigh.
| ImmCLbl CLabel -- AbstractC Label (with baggage)
- | ImmLab Unpretty -- Simple string label (underscore-able)
- | ImmLit Unpretty -- Simple string
+ | ImmLab SDoc -- Simple string label (underscore-able)
+ | ImmLit SDoc -- Simple string
IF_ARCH_sparc(
| LO Imm -- Possible restrictions...
| HI Imm
,)
-
-strImmLit s = ImmLit (uppStr s)
+strImmLit s = ImmLit (text s)
dblImmLit r
= strImmLit (
IF_ARCH_alpha({-prepend nothing-}
,IF_ARCH_i386( '0' : 'd' :
,IF_ARCH_sparc('0' : 'r' :,)))
- ppShow 80 (ppRational r))
+ showSDoc (rational r))
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
\begin{code}
-data Addr
+data MachRegsAddr
#if alpha_TARGET_ARCH
= AddrImm Imm
| AddrReg Reg
#endif
#if i386_TARGET_ARCH
- = Addr Base Index Displacement
- | ImmAddr Imm Int
+ = AddrBaseIndex Base Index Displacement
+ | ImmAddr Imm Int
type Base = Maybe Reg
type Index = Maybe (Reg, Int) -- Int is 2, 4 or 8
| AddrRegImm Reg Imm
#endif
-addrOffset :: Addr -> Int -> Maybe Addr
+addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr
addrOffset addr off
= case addr of
#endif
#if i386_TARGET_ARCH
ImmAddr i off0 -> Just (ImmAddr i (off0 + off))
- Addr r i (ImmInt n) -> Just (Addr r i (ImmInt (n + off)))
- Addr r i (ImmInteger n)
- -> Just (Addr r i (ImmInt (fromInteger (n + toInteger off))))
+ AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
+ AddrBaseIndex r i (ImmInteger n)
+ -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
_ -> Nothing
#endif
#if sparc_TARGET_ARCH
BaseReg -> sStLitLbl SLIT("MainRegTable")
-- these Hp&HpLim cases perhaps should
-- not be here for i386 (???) WDP 96/03
+#ifndef i386_TARGET_ARCH
+ -- Yup, Hp&HpLim are not mapped into registers for x86's at the mo, so
+ -- fetching Hp off BaseReg is the sensible option, since that's
+ -- where gcc generated code stuffs/expects it (RTBL_Hp & RTBL_HpLim).
+ -- SOF 97/09
+ -- In fact, why use StorageMgrInfo at all?
Hp -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
HpLim -> StInd PtrRep (sStLitLbl
(_PK_ ("StorageMgrInfo+" ++ BYTES_PER_WORD_STR)))
+#endif
TagReg -> StInd IntRep (StPrim IntSubOp [infoptr,
StInt (1*BYTES_PER_WORD)])
where
\begin{code}
spRel :: Int -- desired stack offset in words, positive or negative
- -> Addr
+ -> MachRegsAddr
spRel n
#if i386_TARGET_ARCH
- = Addr (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
+ = AddrBaseIndex (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
#else
= AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
#endif
#if sparc_TARGET_ARCH
-fpRel :: Int -> Addr
+fpRel :: Int -> MachRegsAddr
-- Duznae work for offsets greater than 13 bits; we just hope for
-- the best
fpRel n
| UnmappedReg Unique PrimRep -- One of an infinite supply of registers,
-- always mapped to one of the earlier
-- two (?) before we're done.
-
mkReg :: Unique -> PrimRep -> Reg
mkReg = UnmappedReg
#ifdef DEBUG
instance Outputable Reg where
- ppr sty r = ppStr (show r)
+ ppr r = text (show r)
#endif
cmpReg (FixedReg i) (FixedReg i') = cmp_ihash i i'
cmpReg (MappedReg i) (MappedReg i') = cmp_ihash i i'
-cmpReg (MemoryReg i _) (MemoryReg i' _) = cmp_i i i'
-cmpReg (UnmappedReg u _) (UnmappedReg u' _) = cmp u u'
+cmpReg (MemoryReg i _) (MemoryReg i' _) = i `compare` i'
+cmpReg (UnmappedReg u _) (UnmappedReg u' _) = compare u u'
cmpReg r1 r2
= let tag1 = tagReg r1
tag2 = tagReg r2
in
- if tag1 _LT_ tag2 then LT_ else GT_
+ if tag1 _LT_ tag2 then LT else GT
where
tagReg (FixedReg _) = (ILIT(1) :: FAST_INT)
tagReg (MappedReg _) = ILIT(2)
tagReg (MemoryReg _ _) = ILIT(3)
tagReg (UnmappedReg _ _) = ILIT(4)
-cmp_i :: Int -> Int -> TAG_
-cmp_i a1 a2 = if a1 == a2 then EQ_ else if a1 < a2 then LT_ else GT_
-
-cmp_ihash :: FAST_INT -> FAST_INT -> TAG_
-cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ_ else if a1 _LT_ a2 then LT_ else GT_
-
-instance Ord3 Reg where
- cmp = cmpReg
+cmp_ihash :: FAST_INT -> FAST_INT -> Ordering
+cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ else if a1 _LT_ a2 then LT else GT
instance Eq Reg where
- a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
- a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+ a == b = case (a `compare` b) of { EQ -> True; _ -> False }
+ a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
instance Ord Reg where
- a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
- a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
- a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
- a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
- _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
+ a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
+ a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
+ a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
+ a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
+ compare a b = cmpReg a b
instance Uniquable Reg where
uniqueOf (UnmappedReg u _) = u
fReg :: Int -> Int
fReg x = (32 + x)
-v0, f0, ra, pv, gp, sp, zero :: Reg
-v0 = realReg 0
-f0 = realReg (fReg 0)
-ra = FixedReg ILIT(26)
-pv = t12
-gp = FixedReg ILIT(29)
-sp = FixedReg ILIT(30)
-zero = FixedReg ILIT(31)
+v0, f0, ra, pv, gp, sp, zeroh :: Reg
+v0 = realReg 0
+f0 = realReg (fReg 0)
+ra = FixedReg ILIT(26)
+pv = t12
+gp = FixedReg ILIT(29)
+sp = FixedReg ILIT(30)
+zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
t9, t10, t11, t12 :: Reg
t9 = realReg 23
freeReg ILIT(28) = _FALSE_ -- reserved for the assembler (at)
freeReg ILIT(29) = _FALSE_ -- global pointer (gp)
freeReg ILIT(30) = _FALSE_ -- stack pointer (sp)
-freeReg ILIT(31) = _FALSE_ -- always zero (zero)
+freeReg ILIT(31) = _FALSE_ -- always zero (zeroh)
freeReg ILIT(63) = _FALSE_ -- always zero (f31)
#endif
projects / ghc-hetmet.git / blobdiff