X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachMisc.lhs;h=70d7d06d49904923ec3b0e5cbd54ea89d762a242;hb=46732ee640c33bb2af8085d4785f511e9d89a95b;hp=9aba016c6d328fca1c61d6150d8e58c64e979f08;hpb=a23cc49e95af71181f3c56f165759d12c7d21eb7;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 9aba016..70d7d06 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -8,7 +8,7 @@ module MachMisc ( - sizeOf, primRepToSize, + primRepToSize, eXTRA_STK_ARGS_HERE, @@ -36,36 +36,37 @@ module MachMisc ( ) 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 Maybe ( catMaybes ) \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 @@ -94,20 +95,6 @@ eXTRA_STK_ARGS_HERE % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -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 },) -\end{code} - -% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Now the volatile saves and restores. We add the basic guys to the list of ``user'' registers provided. Note that there are more basic registers on the restore list, because some are reloaded from @@ -116,30 +103,47 @@ constants. (@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] 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 + = catMaybes (map 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} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -176,10 +180,8 @@ exactLog2 x 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} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -212,6 +214,8 @@ data Cond | NE | NEG | POS + | CARRY + | OFLO #endif #if sparc_TARGET_ARCH = ALWAYS -- What's really used? ToDo @@ -231,15 +235,16 @@ data Cond | VC | VS #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 @@ -249,49 +254,60 @@ data Size | 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 = 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( BU, IF_ARCH_i386( BU, 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, ))) +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 Int16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(W, IF_ARCH_sparc(H, ))) + where err = primRepToSize_fail "Int16Rep" +primRepToSize Int32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, ))) +primRepToSize Word8Rep = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, ))) +primRepToSize Word16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(Hu, ))) + where err = primRepToSize_fail "Word16Rep" +primRepToSize Word32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(Lu, IF_ARCH_sparc(W, ))) + +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 StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(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} %************************************************************************ @@ -305,7 +321,7 @@ mostly all of @Instr@ is machine-specific. \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 @@ -465,14 +481,19 @@ but we don't care, since it doesn't get used much. We hope. | 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. @@ -502,10 +523,7 @@ but we don't care, since it doesn't get used much. We hope. | 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) @@ -516,7 +534,11 @@ but we don't care, since it doesn't get used much. We hope. | 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 @@ -543,7 +565,7 @@ but we don't care, since it doesn't get used much. We hope. | JMP DestInfo Operand -- possible dests, target | JXX Cond CLabel -- target - | CALL Imm + | CALL (Either Imm Reg) -- Other things. @@ -581,8 +603,7 @@ is_G_instr instr = 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 @@ -609,6 +630,9 @@ is_G_instr instr | 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. @@ -646,7 +670,7 @@ is_G_instr instr | 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