%
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
%
\section[MachMisc]{Description of various machine-specific things}
\begin{code}
-#include "HsVersions.h"
#include "nativeGen/NCG.h"
module MachMisc (
- fixedHdrSizeInWords, varHdrSizeInWords,
- charLikeSize, intLikeSize, mutHS, dataHS,
- sizeOf, primRepToSize,
+ primRepToSize,
eXTRA_STK_ARGS_HERE,
volatileSaves, volatileRestores,
- storageMgrInfo, smCAFlist, smOldLim, smOldMutables,
- smStablePtrTable,
-
targetMaxDouble, targetMaxInt, targetMinDouble, targetMinInt,
underscorePrefix,
fmtAsmLbl,
- cvtLitLit,
exactLog2,
Instr(..), IF_ARCH_i386(Operand(..) COMMA,)
Cond(..),
- Size(..)
-
+ Size(..),
+ IF_ARCH_i386(i386_insert_ffrees COMMA,)
+
#if alpha_TARGET_ARCH
, RI(..)
#endif
#if i386_TARGET_ARCH
#endif
#if sparc_TARGET_ARCH
- , RI(..), riZero
+ RI(..), riZero, fpRelEA, moveSp, fPair
+#endif
+#if powerpc_TARGET_ARCH
+ , RI(..)
+ , condUnsigned, condToSigned
#endif
) where
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(AbsCLoop) ( fixedHdrSizeInWords, varHdrSizeInWords ) -- paranoia
-IMPORT_DELOOPER(NcgLoop) ( underscorePrefix, fmtAsmLbl ) -- paranoia
-IMPORT_1_3(Char(isDigit))
+#include "HsVersions.h"
+#include "../includes/config.h"
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
-import CmdLineOpts ( opt_SccProfilingOn )
+import CLabel ( CLabel, isAsmTemp )
import Literal ( mkMachInt, Literal(..) )
-import MachRegs ( stgReg, callerSaves, RegLoc(..),
- Imm(..), Reg(..), Addr
+import MachRegs ( callerSaves,
+ get_MagicId_addr, get_MagicId_reg_or_addr,
+ Imm(..), Reg(..), MachRegsAddr(..)
+# if sparc_TARGET_ARCH
+ ,fp, sp
+# endif
)
-import OrdList ( OrdList )
import PrimRep ( PrimRep(..) )
-import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
-import Stix ( StixTree(..), StixReg(..), sStLitLbl,
- CodeSegment
- )
-import Util ( panic )
+import Stix ( StixStmt(..), StixExpr(..), StixReg(..),
+ CodeSegment, DestInfo(..) )
+import Panic ( panic )
+import Outputable ( pprPanic, ppr, showSDoc )
+import Config ( cLeadingUnderscore )
+import FastTypes
+import FastString
+
+import GLAEXTS
+import TRACE ( trace )
+
+import Maybes ( mapCatMaybes )
\end{code}
\begin{code}
-underscorePrefix :: Bool -- leading underscore on labels?
-
-underscorePrefix
- = IF_ARCH_alpha(False
- ,{-else-} IF_ARCH_i386(
- IF_OS_linuxaout(True
- , IF_OS_freebsd(True
- , IF_OS_cygwin32(True
- , IF_OS_bsdi(True
- , {-otherwise-} False)))
- )
- ,{-else-}IF_ARCH_sparc(
- IF_OS_sunos4(True, {-otherwise-} False)
- ,)))
+underscorePrefix :: Bool -- leading underscore on assembler labels?
+underscorePrefix = (cLeadingUnderscore == "YES")
---------------------------
fmtAsmLbl :: String -> String -- for formatting labels
fmtAsmLbl s
- = IF_ARCH_alpha(
{- The alpha assembler likes temporary labels to look like $L123
instead of L123. (Don't toss the L, because then Lf28
turns into $f28.)
-}
+ = IF_ARCH_alpha(
'$' : s
,{-otherwise-}
- s
+ '.':'L':s
)
-
----------------------------
-cvtLitLit :: String -> String
-
---
--- Rather than relying on guessing, use FILE_SIZE to compute the
--- _iob offsets.
---
-cvtLitLit "stdin" = IF_ARCH_alpha("_iob+0" {-probably OK...-}
- ,IF_ARCH_i386("_IO_stdin_"
- ,IF_ARCH_sparc("__iob+0x0"{-probably OK...-}
- ,)))
-
-cvtLitLit "stdout" = IF_ARCH_alpha("_iob+"++show (``FILE_SIZE''::Int)
- ,IF_ARCH_i386("_IO_stdout_"
- ,IF_ARCH_sparc("__iob+"++show (``FILE_SIZE''::Int)
- ,)))
-cvtLitLit "stderr" = IF_ARCH_alpha("_iob+"++show (2*(``FILE_SIZE''::Int))
- ,IF_ARCH_i386("_IO_stderr_"
- ,IF_ARCH_sparc("__iob+"++show (2*(``FILE_SIZE''::Int))
- ,)))
-{-
-cvtLitLit "stdout" = IF_ARCH_alpha("_iob+56"{-dodgy *at best*...-}
- ,IF_ARCH_i386("_IO_stdout_"
- ,IF_ARCH_sparc("__iob+0x10"{-dodgy *at best*...-}
- ,)))
-cvtLitLit "stderr" = IF_ARCH_alpha("_iob+112"{-dodgy *at best*...-}
- ,IF_ARCH_i386("_IO_stderr_"
- ,IF_ARCH_sparc("__iob+0x20"{-dodgy *at best*...-}
- ,)))
--}
-cvtLitLit s
- | isHex s = s
- | otherwise = error ("Native code generator can't handle ``" ++ s ++ "''")
- where
- isHex ('0':'x':xs) = all isHexDigit xs
- isHex _ = False
- -- Now, where have I seen this before?
- isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f'
\end{code}
% ----------------------------------------------------------------
\begin{code}
eXTRA_STK_ARGS_HERE :: Int
eXTRA_STK_ARGS_HERE
- = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,???)))
-\end{code}
-
-% ----------------------------------------------------------------
-
-@fixedHdrSizeInWords@ and @varHdrSizeInWords@: these are not dependent
-on target architecture.
-\begin{code}
-fixedHdrSizeInWords :: Int
-
-fixedHdrSizeInWords
- = 1{-info ptr-} + profFHS + parFHS + tickyFHS
- -- obviously, we aren't taking non-sequential too seriously yet
- where
- profFHS = if opt_SccProfilingOn then 1 else 0
- parFHS = {-if PAR or GRAN then 1 else-} 0
- tickyFHS = {-if ticky ... then 1 else-} 0
-
-varHdrSizeInWords :: SMRep -> Int{-in words-}
-
-varHdrSizeInWords sm
- = case sm of
- StaticRep _ _ -> 0
- SpecialisedRep _ _ _ _ -> 0
- GenericRep _ _ _ -> 0
- BigTupleRep _ -> 1
- MuTupleRep _ -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
- DataRep _ -> 1
- DynamicRep -> 2
- BlackHoleRep -> 0
- PhantomRep -> panic "MachMisc.varHdrSizeInWords:phantom"
-\end{code}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-Static closure sizes:
-\begin{code}
-charLikeSize, intLikeSize :: Int
-
-charLikeSize = blahLikeSize CharLikeRep
-intLikeSize = blahLikeSize IntLikeRep
-
-blahLikeSize blah
- = fromInteger (sizeOf PtrRep)
- * (fixedHdrSizeInWords + varHdrSizeInWords blahLikeRep + 1)
- where
- blahLikeRep = SpecialisedRep blah 0 1 SMNormalForm
-
---------
-mutHS, dataHS :: StixTree
-
-mutHS = blah_hs (MuTupleRep 0)
-dataHS = blah_hs (DataRep 0)
-
-blah_hs blah
- = StInt (toInteger words)
- where
- words = fixedHdrSizeInWords + varHdrSizeInWords blah
-\end{code}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-Size of a @PrimRep@, in bytes.
-
-\begin{code}
-sizeOf :: PrimRep -> Integer{-in bytes-}
- -- the result is an Integer only because it's more convenient
-
-sizeOf pr = case (primRepToSize pr) of
- IF_ARCH_alpha({B -> 1; BU -> 1; {-W -> 2; WU -> 2; L -> 4; SF -> 4;-} _ -> 8},)
- IF_ARCH_sparc({B -> 1; BU -> 1; {-HW -> 2; HWU -> 2;-} W -> 4; {-D -> 8;-} F -> 4; DF -> 8},)
- IF_ARCH_i386( {B -> 1; {-S -> 2;-} L -> 4; F -> 4; DF -> 8 },)
+ = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,
+ IF_ARCH_powerpc( IF_OS_darwin(24,8{-SVR4 ABI: Linux-}), ???))))
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(@volatileRestores@ used only for wrapper-hungry PrimOps.)
\begin{code}
-volatileSaves, volatileRestores :: [MagicId] -> [StixTree]
-
-save_cands = [BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg]
-restore_cands = save_cands ++ [StkStubReg,StdUpdRetVecReg]
-
-volatileSaves vols
- = map save ((filter callerSaves) (save_cands ++ vols))
- where
- save x = StAssign (magicIdPrimRep x) loc reg
- where
- reg = StReg (StixMagicId x)
- loc = case stgReg x of
- Save loc -> loc
- Always _ -> panic "volatileSaves"
-
-volatileRestores vols
- = map restore ((filter callerSaves) (restore_cands ++ vols))
- where
- restore x = StAssign (magicIdPrimRep x) reg loc
- where
- reg = StReg (StixMagicId x)
- loc = case stgReg x of
- Save loc -> loc
- Always _ -> panic "volatileRestores"
+volatileSaves, volatileRestores :: [MagicId] -> [StixStmt]
+
+volatileSaves = volatileSavesOrRestores True
+volatileRestores = volatileSavesOrRestores False
+
+save_cands = [BaseReg,Sp,SpLim,Hp,HpLim]
+restore_cands = save_cands
+
+volatileSavesOrRestores do_saves vols
+ = mapCatMaybes mkCode vols
+ where
+ mkCode mid
+ | case mid of { BaseReg -> True; _ -> False }
+ = panic "volatileSavesOrRestores:BaseReg"
+ | not (callerSaves mid)
+ = Nothing
+ | otherwise -- must be callee-saves ...
+ = case get_MagicId_reg_or_addr mid of
+ -- If stored in BaseReg, we ain't interested
+ Right baseRegAddr
+ -> Nothing
+ Left (RealReg rrno)
+ -- OK, it's callee-saves, and in a real reg (rrno).
+ -- We have to cook up some transfer code.
+ {- Note that the use of (StixMagicId mid) here is a bit subtle.
+ Here, we only create those for MagicIds which are stored in
+ a real reg on this arch -- the preceding case on the result
+ of get_MagicId_reg_or_addr guarantees this. Later, when
+ selecting insns, that means these assignments are sure to turn
+ into real reg-to-mem or mem-to-reg moves, rather than being
+ pointless moves from some address in the reg-table
+ back to itself.-}
+ | do_saves
+ -> Just (StAssignMem rep addr
+ (StReg (StixMagicId mid)))
+ | otherwise
+ -> Just (StAssignReg rep (StixMagicId mid)
+ (StInd rep addr))
+ where
+ rep = magicIdPrimRep mid
+ addr = get_MagicId_addr mid
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
\begin{code}
targetMinDouble = MachDouble (-1.7976931348623157e+308)
targetMaxDouble = MachDouble (1.7976931348623157e+308)
-targetMinInt = mkMachInt (-2147483647)
+targetMinInt = mkMachInt (-2147483648)
targetMaxInt = mkMachInt 2147483647
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-Storage manager nonsense. Note that the indices are dependent on
-the definition of the smInfo structure in SMinterface.lh
-
-\begin{code}
-storageMgrInfo, smCAFlist, smOldMutables, smOldLim :: StixTree
-
-storageMgrInfo = sStLitLbl SLIT("StorageMgrInfo")
-smCAFlist = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_CAFLIST))
-smOldMutables = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDMUTABLES))
-smOldLim = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDLIM))
-smStablePtrTable = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_STABLEPOINTERTABLE))
-\end{code}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
This algorithm for determining the $\log_2$ of exact powers of 2 comes
from GCC. It requires bit manipulation primitives, and we use GHC
extensions. Tough.
\begin{code}
w2i x = word2Int# x
i2w x = int2Word# x
-i2w_s x = (x::Int#)
exactLog2 :: Integer -> Maybe Integer
exactLog2 x
= if (x <= 0 || x >= 2147483648) then
Nothing
else
- case (fromInteger x) of { I# x# ->
+ case iUnbox (fromInteger x) of { x# ->
if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
Nothing
else
- Just (toInteger (I# (pow2 x#)))
+ Just (toInteger (iBox (pow2 x#)))
}
where
- shiftr x y = shiftRA# x y
-
pow2 x# | x# ==# 1# = 0#
- | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#))
+ | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
| NE
| NEG
| POS
+ | CARRY
+ | OFLO
#endif
#if sparc_TARGET_ARCH
= ALWAYS -- What's really used? ToDo
| VC
| VS
#endif
+#if powerpc_TARGET_ARCH
+ = ALWAYS
+ | EQQ
+ | GE
+ | GEU
+ | GTT
+ | GU
+ | LE
+ | LEU
+ | LTT
+ | LU
+ | NE
+#endif
+ deriving Eq -- to make an assertion work
\end{code}
\begin{code}
data Size
#if alpha_TARGET_ARCH
= B -- byte
- | BU
+ | Bu
-- | W -- word (2 bytes): UNUSED
--- | WU -- : UNUSED
--- | L -- longword (4 bytes): UNUSED
+-- | Wu -- : UNUSED
+ | L -- longword (4 bytes)
| Q -- quadword (8 bytes)
-- | FF -- VAX F-style floating pt: UNUSED
-- | GF -- VAX G-style floating pt: UNUSED
| TF -- IEEE double-precision floating pt
#endif
#if i386_TARGET_ARCH
- = B -- byte (lower)
--- | HB -- higher byte **UNUSED**
--- | S -- : UNUSED
- | L
+ = B -- byte (signed)
+ | Bu -- byte (unsigned)
+ | W -- word (signed)
+ | Wu -- word (unsigned)
+ | L -- longword (signed)
+ | Lu -- longword (unsigned)
| F -- IEEE single-precision floating pt
| DF -- IEEE single-precision floating pt
+ | F80 -- Intel 80-bit internal FP format; only used for spilling
#endif
-#if sparc_TARGET_ARCH
+#if sparc_TARGET_ARCH || powerpc_TARGET_ARCH
= B -- byte (signed)
- | BU -- byte (unsigned)
--- | HW -- halfword, 2 bytes (signed): UNUSED
--- | HWU -- halfword, 2 bytes (unsigned): UNUSED
- | W -- word, 4 bytes
--- | D -- doubleword, 8 bytes: UNUSED
+ | Bu -- byte (unsigned)
+ | H -- halfword (signed, 2 bytes)
+ | Hu -- halfword (unsigned, 2 bytes)
+ | W -- word (4 bytes)
| F -- IEEE single-precision floating pt
| DF -- IEEE single-precision floating pt
#endif
primRepToSize :: PrimRep -> Size
-primRepToSize PtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CodePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize DataPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize RetRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CostCentreRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CharRep = IF_ARCH_alpha( BU, IF_ARCH_i386( L, IF_ARCH_sparc( BU,)))
-primRepToSize IntRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WordRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize AddrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize FloatRep = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc( F ,)))
-primRepToSize DoubleRep = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,)))
-primRepToSize ArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ByteArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize StablePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ForeignObjRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
+primRepToSize PtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize CodePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize DataPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize RetRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize CostCentreRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize CharRep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+
+primRepToSize Int8Rep = IF_ARCH_alpha(B, IF_ARCH_i386(B, IF_ARCH_sparc(B, IF_ARCH_powerpc(B, ))))
+primRepToSize Int16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(W, IF_ARCH_sparc(H, IF_ARCH_powerpc(H, ))))
+ where err = primRepToSize_fail "Int16Rep"
+primRepToSize Int32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize Word8Rep = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, IF_ARCH_powerpc(Bu, ))))
+primRepToSize Word16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(Hu, IF_ARCH_powerpc(Hu, ))))
+ where err = primRepToSize_fail "Word16Rep"
+primRepToSize Word32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(Lu, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+
+primRepToSize IntRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize WordRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize AddrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+primRepToSize FloatRep = IF_ARCH_alpha(TF, IF_ARCH_i386(F, IF_ARCH_sparc(F, IF_ARCH_powerpc(F, ))))
+primRepToSize DoubleRep = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, IF_ARCH_powerpc(DF, ))))
+primRepToSize StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, IF_ARCH_powerpc(W, ))))
+
+primRepToSize Word64Rep = primRepToSize_fail "Word64Rep"
+primRepToSize Int64Rep = primRepToSize_fail "Int64Rep"
+primRepToSize other = primRepToSize_fail (showSDoc (ppr other))
+
+primRepToSize_fail str
+ = error ("ERROR: MachMisc.primRepToSize: cannot handle `" ++ str ++ "'.\n\t"
+ ++ "Workaround: use -fvia-C.\n\t"
+ ++ "Perhaps you should report it as a GHC bug,\n\t"
+ ++ "to glasgow-haskell-bugs@haskell.org.")
\end{code}
%************************************************************************
\begin{code}
data Instr
- = COMMENT FAST_STRING -- comment pseudo-op
+ = COMMENT FastString -- comment pseudo-op
| SEGMENT CodeSegment -- {data,text} segment pseudo-op
| LABEL CLabel -- global label pseudo-op
| ASCII Bool -- True <=> needs backslash conversion
String -- the literal string
| DATA Size
[Imm]
+ | DELTA Int -- specify current stack offset for
+ -- benefit of subsequent passes
\end{code}
\begin{code}
-- Loads and stores.
- | LD Size Reg Addr -- size, dst, src
- | LDA Reg Addr -- dst, src
- | LDAH Reg Addr -- dst, src
- | LDGP Reg Addr -- dst, src
- | LDI Size Reg Imm -- size, dst, src
- | ST Size Reg Addr -- size, src, dst
+ | LD Size Reg MachRegsAddr -- size, dst, src
+ | LDA Reg MachRegsAddr -- dst, src
+ | LDAH Reg MachRegsAddr -- dst, src
+ | LDGP Reg MachRegsAddr -- dst, src
+ | LDI Size Reg Imm -- size, dst, src
+ | ST Size Reg MachRegsAddr -- size, src, dst
-- Int Arithmetic.
| BI Cond Reg Imm
| BF Cond Reg Imm
| BR Imm
- | JMP Reg Addr Int
+ | JMP Reg MachRegsAddr Int
| BSR Imm Int
- | JSR Reg Addr Int
+ | JSR Reg MachRegsAddr Int
-- Alpha-specific pseudo-ops.
= RIReg Reg
| RIImm Imm
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
\end{code}
+Intel, in their infinite wisdom, selected a stack model for floating
+point registers on x86. That might have made sense back in 1979 --
+nowadays we can see it for the nonsense it really is. A stack model
+fits poorly with the existing nativeGen infrastructure, which assumes
+flat integer and FP register sets. Prior to this commit, nativeGen
+could not generate correct x86 FP code -- to do so would have meant
+somehow working the register-stack paradigm into the register
+allocator and spiller, which sounds very difficult.
+
+We have decided to cheat, and go for a simple fix which requires no
+infrastructure modifications, at the expense of generating ropey but
+correct FP code. All notions of the x86 FP stack and its insns have
+been removed. Instead, we pretend (to the instruction selector and
+register allocator) that x86 has six floating point registers, %fake0
+.. %fake5, which can be used in the usual flat manner. We further
+claim that x86 has floating point instructions very similar to SPARC
+and Alpha, that is, a simple 3-operand register-register arrangement.
+Code generation and register allocation proceed on this basis.
+
+When we come to print out the final assembly, our convenient fiction
+is converted to dismal reality. Each fake instruction is
+independently converted to a series of real x86 instructions.
+%fake0 .. %fake5 are mapped to %st(0) .. %st(5). To do reg-reg
+arithmetic operations, the two operands are pushed onto the top of the
+FP stack, the operation done, and the result copied back into the
+relevant register. There are only six %fake registers because 2 are
+needed for the translation, and x86 has 8 in total.
+
+The translation is inefficient but is simple and it works. A cleverer
+translation would handle a sequence of insns, simulating the FP stack
+contents, would not impose a fixed mapping from %fake to %st regs, and
+hopefully could avoid most of the redundant reg-reg moves of the
+current translation.
+
+We might as well make use of whatever unique FP facilities Intel have
+chosen to bless us with (let's not be churlish, after all).
+Hence GLDZ and GLD1. Bwahahahahahahaha!
+
+LATER (10 Nov 2000): idiv gives problems with the register spiller,
+because the spiller is simpleminded and because idiv has fixed uses of
+%eax and %edx. Rather than make the spiller cleverer, we do away with
+idiv, and instead have iquot and irem fake (integer) insns, which have
+no operand register constraints -- ie, they behave like add, sub, mul.
+The printer-outer transforms them to a sequence of real insns which does
+the Right Thing (tm). As with the FP stuff, this gives ropey code,
+but we don't care, since it doesn't get used much. We hope.
+
\begin{code}
#if i386_TARGET_ARCH
-- Moves.
| MOV Size Operand Operand
- | MOVZX Size Operand Operand -- size is the size of operand 2
- | MOVSX Size Operand Operand -- size is the size of operand 2
+ | MOVZxL Size Operand Operand -- size is the size of operand 1
+ | MOVSxL Size Operand Operand -- size is the size of operand 1
-- Load effective address (also a very useful three-operand add instruction :-)
| ADD Size Operand Operand
| SUB Size Operand Operand
+ | IMUL Size Operand Operand -- signed int mul
+ | MUL Size Operand Operand -- unsigned int mul
+ | IMUL64 Reg Reg -- 32 x 32 -> 64 signed mul
+ -- operand1:operand2 := (operand1[31:0] *signed operand2[31:0])
--- Multiplication (signed and unsigned), Division (signed and unsigned),
--- result in %eax, %edx.
+-- Quotient and remainder. SEE comment above -- these are not
+-- real x86 insns; instead they are expanded when printed
+-- into a sequence of real insns.
- | IMUL Size Operand Operand
- | IDIV Size Operand
+ | IQUOT Size Operand Operand -- signed quotient
+ | IREM Size Operand Operand -- signed remainder
+ | QUOT Size Operand Operand -- unsigned quotient
+ | REM Size Operand Operand -- unsigned remainder
-- Simple bit-twiddling.
| XOR Size Operand Operand
| NOT Size Operand
| NEGI Size Operand -- NEG instruction (name clash with Cond)
- | SHL Size Operand Operand -- 1st operand must be an Imm
- | SAR Size Operand Operand -- 1st operand must be an Imm
- | SHR Size Operand Operand -- 1st operand must be an Imm
+ | SHL Size Imm Operand -- Only immediate shifts allowed
+ | SAR Size Imm Operand -- Only immediate shifts allowed
+ | SHR Size Imm Operand -- Only immediate shifts allowed
+ | BT Size Imm Operand
| NOP
--- Float Arithmetic. -- ToDo for 386
+-- Float Arithmetic.
--- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
--- right up until we spit them out.
+-- Note that we cheat by treating G{ABS,MOV,NEG} of doubles
+-- as single instructions right up until we spit them out.
+
+ -- all the 3-operand fake fp insns are src1 src2 dst
+ -- and furthermore are constrained to be fp regs only.
+ -- IMPORTANT: keep is_G_insn up to date with any changes here
+ | GMOV Reg Reg -- src(fpreg), dst(fpreg)
+ | GLD Size MachRegsAddr Reg -- src, dst(fpreg)
+ | GST Size Reg MachRegsAddr -- src(fpreg), dst
+
+ | GLDZ Reg -- dst(fpreg)
+ | GLD1 Reg -- dst(fpreg)
+
+ | GFTOI Reg Reg -- src(fpreg), dst(intreg)
+ | GDTOI Reg Reg -- src(fpreg), dst(intreg)
- | SAHF -- stores ah into flags
- | FABS
- | FADD Size Operand -- src
- | FADDP
- | FIADD Size Addr -- src
- | FCHS
- | FCOM Size Operand -- src
- | FCOS
- | FDIV Size Operand -- src
- | FDIVP
- | FIDIV Size Addr -- src
- | FDIVR Size Operand -- src
- | FDIVRP
- | FIDIVR Size Addr -- src
- | FICOM Size Addr -- src
- | FILD Size Addr Reg -- src, dst
- | FIST Size Addr -- dst
- | FLD Size Operand -- src
- | FLD1
- | FLDZ
- | FMUL Size Operand -- src
- | FMULP
- | FIMUL Size Addr -- src
- | FRNDINT
- | FSIN
- | FSQRT
- | FST Size Operand -- dst
- | FSTP Size Operand -- dst
- | FSUB Size Operand -- src
- | FSUBP
- | FISUB Size Addr -- src
- | FSUBR Size Operand -- src
- | FSUBRP
- | FISUBR Size Addr -- src
- | FTST
- | FCOMP Size Operand -- src
- | FUCOMPP
- | FXCH
- | FNSTSW
- | FNOP
+ | GITOF Reg Reg -- src(intreg), dst(fpreg)
+ | GITOD Reg Reg -- src(intreg), dst(fpreg)
+ | GADD Size Reg Reg Reg -- src1, src2, dst
+ | GDIV Size Reg Reg Reg -- src1, src2, dst
+ | GSUB Size Reg Reg Reg -- src1, src2, dst
+ | GMUL Size Reg Reg Reg -- src1, src2, dst
+
+ -- FP compare. Cond must be `elem` [EQQ, NE, LE, LTT, GE, GTT]
+ -- Compare src1 with src2; set the Zero flag iff the numbers are
+ -- comparable and the comparison is True. Subsequent code must
+ -- test the %eflags zero flag regardless of the supplied Cond.
+ | GCMP Cond Reg Reg -- src1, src2
+
+ | GABS Size Reg Reg -- src, dst
+ | GNEG Size Reg Reg -- src, dst
+ | GSQRT Size Reg Reg -- src, dst
+ | GSIN Size Reg Reg -- src, dst
+ | GCOS Size Reg Reg -- src, dst
+ | GTAN Size Reg Reg -- src, dst
+
+ | GFREE -- do ffree on all x86 regs; an ugly hack
-- Comparison
| TEST Size Operand Operand
| PUSH Size Operand
| POP Size Operand
+ | PUSHA
+ | POPA
-- Jumping around.
- | JMP Operand -- target
+ | JMP DestInfo Operand -- possible dests, target
| JXX Cond CLabel -- target
- | CALL Imm
+ | CALL (Either Imm Reg)
-- Other things.
| CLTD -- sign extend %eax into %edx:%eax
data Operand
- = OpReg Reg -- register
- | OpImm Imm -- immediate value
- | OpAddr Addr -- memory reference
-
-#endif {- i386_TARGET_ARCH -}
+ = OpReg Reg -- register
+ | OpImm Imm -- immediate value
+ | OpAddr MachRegsAddr -- memory reference
+
+
+i386_insert_ffrees :: [Instr] -> [Instr]
+i386_insert_ffrees insns
+ | any is_G_instr insns
+ = concatMap ffree_before_nonlocal_transfers insns
+ | otherwise
+ = insns
+
+ffree_before_nonlocal_transfers insn
+ = case insn of
+ CALL _ -> [GFREE, insn]
+ -- Jumps to immediate labels are local
+ JMP _ (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn]
+ -- If a jump mentions dests, it is a local jump thru
+ -- a case table.
+ JMP (DestInfo _) _ -> [insn]
+ JMP _ _ -> [GFREE, insn]
+ other -> [insn]
+
+
+-- if you ever add a new FP insn to the fake x86 FP insn set,
+-- you must update this too
+is_G_instr :: Instr -> Bool
+is_G_instr instr
+ = case instr of
+ GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True;
+ GLDZ _ -> True; GLD1 _ -> True;
+ GFTOI _ _ -> True; GDTOI _ _ -> True;
+ GITOF _ _ -> True; GITOD _ _ -> True;
+ GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
+ GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
+ GCMP _ _ _ -> True; GABS _ _ _ -> True
+ GNEG _ _ _ -> True; GSQRT _ _ _ -> True
+ GSIN _ _ _ -> True; GCOS _ _ _ -> True; GTAN _ _ _ -> True;
+ GFREE -> panic "is_G_instr: GFREE (!)"
+ other -> False
+
+#endif /* i386_TARGET_ARCH */
\end{code}
\begin{code}
-- Loads and stores.
- | LD Size Addr Reg -- size, src, dst
- | ST Size Reg Addr -- size, src, dst
+ | LD Size MachRegsAddr Reg -- size, src, dst
+ | ST Size Reg MachRegsAddr -- size, src, dst
-- Int Arithmetic.
| ADD Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
| SUB Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
+ | UMUL Bool Reg RI Reg -- cc?, src1, src2, dst
+ | SMUL Bool Reg RI Reg -- cc?, src1, src2, dst
+ | RDY Reg -- move contents of Y register to reg
-- Simple bit-twiddling.
| BI Cond Bool Imm -- cond, annul?, target
| BF Cond Bool Imm -- cond, annul?, target
- | JMP Addr -- target
- | CALL Imm Int Bool -- target, args, terminal
+ | JMP DestInfo MachRegsAddr -- target
+ | CALL (Either Imm Reg) Int Bool -- target, args, terminal
data RI = RIReg Reg
| RIImm Imm
riZero (RIImm (ImmInt 0)) = True
riZero (RIImm (ImmInteger 0)) = True
-riZero (RIReg (FixedReg ILIT(0))) = True
+riZero (RIReg (RealReg 0)) = True
riZero _ = False
-#endif {- sparc_TARGET_ARCH -}
+-- Calculate the effective address which would be used by the
+-- corresponding fpRel sequence. fpRel is in MachRegs.lhs,
+-- alas -- can't have fpRelEA here because of module dependencies.
+fpRelEA :: Int -> Reg -> Instr
+fpRelEA n dst
+ = ADD False False fp (RIImm (ImmInt (n * BYTES_PER_WORD))) dst
+
+-- Code to shift the stack pointer by n words.
+moveSp :: Int -> Instr
+moveSp n
+ = ADD False False sp (RIImm (ImmInt (n * BYTES_PER_WORD))) sp
+
+-- Produce the second-half-of-a-double register given the first half.
+fPair :: Reg -> Reg
+fPair (RealReg n) | n >= 32 && n `mod` 2 == 0 = RealReg (n+1)
+fPair other = pprPanic "fPair(sparc NCG)" (ppr other)
+#endif /* sparc_TARGET_ARCH */
\end{code}
+
+\begin{code}
+#ifdef powerpc_TARGET_ARCH
+-- data Instr continues...
+
+-- Loads and stores.
+
+ | LD Size Reg MachRegsAddr -- Load size, dst, src
+ | ST Size Reg MachRegsAddr -- Store size, src, dst
+ | STU Size Reg MachRegsAddr -- Store with Update size, src, dst
+ | LIS Reg Imm -- Load Immediate Shifted dst, src
+ | LI Reg Imm -- Load Immediate dst, src
+ | MR Reg Reg -- Move Register dst, src -- also for fmr
+
+ | CMP Size Reg RI --- size, src1, src2
+ | CMPL Size Reg RI --- size, src1, src2
+
+ | BCC Cond CLabel
+ | MTCTR Reg
+ | BCTR DestInfo
+ | BL Imm [Reg] -- with list of argument regs
+ | BCTRL [Reg]
+
+ | ADD Reg Reg RI -- dst, src1, src2
+ | SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1
+ | MULLW Reg Reg RI
+ | DIVW Reg Reg Reg
+ | DIVWU Reg Reg Reg
+
+ | AND Reg Reg RI -- dst, src1, src2
+ | OR Reg Reg RI -- dst, src1, src2
+ | XOR Reg Reg RI -- dst, src1, src2
+ | XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2
+
+ | NEG Reg Reg
+ | NOT Reg Reg
+
+ | SLW Reg Reg RI -- shift left word
+ | SRW Reg Reg RI -- shift right word
+ | SRAW Reg Reg RI -- shift right arithmetic word
+
+ | FADD Size Reg Reg Reg
+ | FSUB Size Reg Reg Reg
+ | FMUL Size Reg Reg Reg
+ | FDIV Size Reg Reg Reg
+ | FNEG Reg Reg -- negate is the same for single and double prec.
+
+ | FCMP Reg Reg
+
+ | FCTIWZ Reg Reg -- convert to integer word
+ -- (but destination is a FP register)
+
+data RI = RIReg Reg
+ | RIImm Imm
+
+condUnsigned GU = True
+condUnsigned LU = True
+condUnsigned GEU = True
+condUnsigned LEU = True
+condUnsigned _ = False
+
+condToSigned GU = GTT
+condToSigned LU = LTT
+condToSigned GEU = GE
+condToSigned LEU = LE
+condToSigned x = x
+#endif /* powerpc_TARGET_ARCH */
+\end{code}
+
projects / ghc-hetmet.git / blobdiff