module MachMisc (
- sizeOf, primRepToSize,
+ primRepToSize,
eXTRA_STK_ARGS_HERE,
#if sparc_TARGET_ARCH
RI(..), riZero, fpRelEA, moveSp, fPair
#endif
+#if powerpc_TARGET_ARCH
+ , RI(..)
+ , condUnsigned, condToSigned
+#endif
) where
#include "HsVersions.h"
--- #include "config.h"
+#include "../includes/config.h"
import AbsCSyn ( MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
import CLabel ( CLabel, isAsmTemp )
import Literal ( mkMachInt, Literal(..) )
-import MachRegs ( stgReg, callerSaves, RegLoc(..),
- Imm(..), Reg(..),
- MachRegsAddr(..)
+import MachRegs ( callerSaves,
+ get_MagicId_addr, get_MagicId_reg_or_addr,
+ Imm(..), Reg(..), MachRegsAddr(..)
# if sparc_TARGET_ARCH
,fp, sp
# endif
)
import PrimRep ( PrimRep(..) )
-import Stix ( StixTree(..), StixReg(..), CodeSegment, DestInfo(..) )
+import Stix ( StixStmt(..), StixExpr(..), StixReg(..),
+ CodeSegment, DestInfo(..) )
import Panic ( panic )
-import GlaExts ( word2Int#, int2Word#, shiftRL#, and#, (/=#) )
-import Outputable ( pprPanic, ppr )
-import IOExts ( trace )
+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 assembler labels?
-
-#ifdef LEADING_UNDERSCORE
-underscorePrefix = True
-#else
-underscorePrefix = False
-#endif
+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-}
'.':'L':s
\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}
-
-% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-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; W -> 4; F -> 4; DF -> 8},)
- IF_ARCH_i386( {B -> 1; BU -> 1; 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]
+volatileSaves, volatileRestores :: [MagicId] -> [StixStmt]
+
+volatileSaves = volatileSavesOrRestores True
+volatileRestores = volatileSavesOrRestores False
-save_cands = [BaseReg,Sp,Su,SpLim,Hp,HpLim]
+save_cands = [BaseReg,Sp,SpLim,Hp,HpLim]
restore_cands = save_cands
-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"
+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}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Just (toInteger (iBox (pow2 x#)))
}
where
- shiftr x y = shiftRL# x y
-
pow2 x# | x# ==# 1# = 0#
- | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` 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
+-- | Wu -- : UNUSED
| L -- longword (4 bytes)
| Q -- quadword (8 bytes)
-- | FF -- VAX F-style floating pt: UNUSED
| TF -- IEEE double-precision floating pt
#endif
#if i386_TARGET_ARCH
- = B -- byte (signed, JRS:??lower??)
- | BU -- byte, unsigned
- | L -- word32
+ = 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)
- | W -- word, 4 bytes
+ | 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( L, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-
-primRepToSize Int8Rep = IF_ARCH_alpha( B, IF_ARCH_i386( B, IF_ARCH_sparc( B ,)))
-primRepToSize Word8Rep = IF_ARCH_alpha( B, IF_ARCH_i386( B, 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 PrimPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WeakPtrRep = 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 BCORep = 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 ThreadIdRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
--- SUP: Wrong!!! Only for testing the rest of the NCG
-primRepToSize Word64Rep = trace "primRepToSize: Word64Rep not handled" B
-primRepToSize Int64Rep = trace "primRepToSize: Int64Rep not handled" B
+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
= 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
| ADD Size Operand Operand
| SUB Size Operand Operand
- | IMUL 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])
-- Quotient and remainder. SEE comment above -- these are not
-- real x86 insns; instead they are expanded when printed
-- into a sequence of real insns.
- | IQUOT Size Operand Operand
- | IREM Size Operand 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.
| GLDZ Reg -- dst(fpreg)
| GLD1 Reg -- dst(fpreg)
- | GFTOD Reg Reg -- src(fpreg), dst(fpreg)
| GFTOI Reg Reg -- src(fpreg), dst(intreg)
-
- | GDTOF Reg Reg -- src(fpreg), dst(fpreg)
| GDTOI Reg Reg -- src(fpreg), dst(intreg)
| GITOF Reg Reg -- src(intreg), dst(fpreg)
| GSUB Size Reg Reg Reg -- src1, src2, dst
| GMUL Size Reg Reg Reg -- src1, src2, dst
- | GCMP Size Reg Reg -- src1, src2
+ -- 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
| JMP DestInfo Operand -- possible dests, target
| JXX Cond CLabel -- target
- | CALL Imm
+ | CALL (Either Imm Reg)
-- Other things.
= case instr of
GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True;
GLDZ _ -> True; GLD1 _ -> True;
- GFTOD _ _ -> True; GFTOI _ _ -> True;
- GDTOF _ _ -> True; GDTOI _ _ -> True;
+ GFTOI _ _ -> True; GDTOI _ _ -> True;
GITOF _ _ -> True; GITOD _ _ -> True;
GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
GFREE -> panic "is_G_instr: GFREE (!)"
other -> False
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
\end{code}
\begin{code}
| 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.
| BF Cond Bool Imm -- cond, annul?, target
| JMP DestInfo MachRegsAddr -- target
- | CALL Imm Int Bool -- target, args, terminal
+ | CALL (Either Imm Reg) Int Bool -- target, args, terminal
data RI = RIReg Reg
| RIImm Imm
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 -}
+#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