diff options
Diffstat (limited to 'compiler')
22 files changed, 945 insertions, 936 deletions
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 4934d18c5a..38e92f89d6 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -506,7 +506,7 @@ Library TargetReg NCGMonad Instruction - Size + Format Reg RegClass PIC diff --git a/compiler/nativeGen/Size.hs b/compiler/nativeGen/Format.hs index 8fe590f1e9..92a8ef86f1 100644 --- a/compiler/nativeGen/Size.hs +++ b/compiler/nativeGen/Format.hs @@ -1,8 +1,5 @@ --- | Sizes on this architecture --- A Size is a combination of width and class --- --- TODO: Rename this to "Format" instead of "Size" to reflect --- the fact that it represents floating point vs integer. +-- | Formats on this architecture +-- A Format is a combination of width and class -- -- TODO: Signed vs unsigned? -- @@ -11,14 +8,14 @@ -- to have architecture specific formats, and do the overloading -- properly. eg SPARC doesn't care about FF80. -- -module Size ( - Size(..), - intSize, - floatSize, - isFloatSize, - cmmTypeSize, - sizeToWidth, - sizeInBytes +module Format ( + Format(..), + intFormat, + floatFormat, + isFloatFormat, + cmmTypeFormat, + formatToWidth, + formatInBytes ) where @@ -34,14 +31,14 @@ import Outputable -- mov.l a b -- might be encoded -- MOV II32 a b --- where the Size field encodes the ".l" part. +-- where the Format field encodes the ".l" part. --- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes +-- ToDo: it's not clear to me that we need separate signed-vs-unsigned formats -- here. I've removed them from the x86 version, we'll see what happens --SDM --- ToDo: quite a few occurrences of Size could usefully be replaced by Width +-- ToDo: quite a few occurrences of Format could usefully be replaced by Width -data Size +data Format = II8 | II16 | II32 @@ -52,47 +49,47 @@ data Size deriving (Show, Eq) --- | Get the integer size of this width. -intSize :: Width -> Size -intSize width +-- | Get the integer format of this width. +intFormat :: Width -> Format +intFormat width = case width of W8 -> II8 W16 -> II16 W32 -> II32 W64 -> II64 - other -> pprPanic "Size.intSize" (ppr other) + other -> pprPanic "Format.intFormat" (ppr other) --- | Get the float size of this width. -floatSize :: Width -> Size -floatSize width +-- | Get the float format of this width. +floatFormat :: Width -> Format +floatFormat width = case width of W32 -> FF32 W64 -> FF64 - other -> pprPanic "Size.floatSize" (ppr other) + other -> pprPanic "Format.floatFormat" (ppr other) --- | Check if a size represents a floating point value. -isFloatSize :: Size -> Bool -isFloatSize size - = case size of +-- | Check if a format represents a floating point value. +isFloatFormat :: Format -> Bool +isFloatFormat format + = case format of FF32 -> True FF64 -> True FF80 -> True _ -> False --- | Convert a Cmm type to a Size. -cmmTypeSize :: CmmType -> Size -cmmTypeSize ty - | isFloatType ty = floatSize (typeWidth ty) - | otherwise = intSize (typeWidth ty) +-- | Convert a Cmm type to a Format. +cmmTypeFormat :: CmmType -> Format +cmmTypeFormat ty + | isFloatType ty = floatFormat (typeWidth ty) + | otherwise = intFormat (typeWidth ty) --- | Get the Width of a Size. -sizeToWidth :: Size -> Width -sizeToWidth size - = case size of +-- | Get the Width of a Format. +formatToWidth :: Format -> Width +formatToWidth format + = case format of II8 -> W8 II16 -> W16 II32 -> W32 @@ -101,5 +98,5 @@ sizeToWidth size FF64 -> W64 FF80 -> W80 -sizeInBytes :: Size -> Int -sizeInBytes = widthInBytes . sizeToWidth +formatInBytes :: Format -> Int +formatInBytes = widthInBytes . formatToWidth diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs index e312d274db..fcb7b90d0d 100644 --- a/compiler/nativeGen/NCGMonad.hs +++ b/compiler/nativeGen/NCGMonad.hs @@ -38,7 +38,7 @@ where #include "HsVersions.h" import Reg -import Size +import Format import TargetReg import BlockId @@ -159,14 +159,14 @@ getNewLabelNat return (mkAsmTempLabel u) -getNewRegNat :: Size -> NatM Reg +getNewRegNat :: Format -> NatM Reg getNewRegNat rep = do u <- getUniqueNat dflags <- getDynFlags return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep) -getNewRegPairNat :: Size -> NatM (Reg,Reg) +getNewRegPairNat :: Format -> NatM (Reg,Reg) getNewRegPairNat rep = do u <- getUniqueNat dflags <- getDynFlags @@ -181,7 +181,7 @@ getPicBaseMaybeNat = NatM (\state -> (natm_pic state, state)) -getPicBaseNat :: Size -> NatM Reg +getPicBaseNat :: Format -> NatM Reg getPicBaseNat rep = do mbPicBase <- getPicBaseMaybeNat case mbPicBase of diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 4e2da6cf82..6d09c78561 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -34,7 +34,7 @@ import CPrim import NCGMonad import Instruction import PIC -import Size +import Format import RegClass import Reg import TargetReg @@ -141,20 +141,20 @@ stmtToInstrs stmt = do CmmUnwind {} -> return nilOL CmmAssign reg src - | isFloatType ty -> assignReg_FltCode size reg src + | isFloatType ty -> assignReg_FltCode format reg src | target32Bit (targetPlatform dflags) && isWord64 ty -> assignReg_I64Code reg src - | otherwise -> assignReg_IntCode size reg src + | otherwise -> assignReg_IntCode format reg src where ty = cmmRegType dflags reg - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmStore addr src - | isFloatType ty -> assignMem_FltCode size addr src + | isFloatType ty -> assignMem_FltCode format addr src | target32Bit (targetPlatform dflags) && isWord64 ty -> assignMem_I64Code addr src - | otherwise -> assignMem_IntCode size addr src + | otherwise -> assignMem_IntCode format addr src where ty = cmmExprType dflags src - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmUnsafeForeignCall target result_regs args -> genCCall target result_regs args @@ -185,20 +185,20 @@ type InstrBlock -- register to put it in. -- data Register - = Fixed Size Reg InstrBlock - | Any Size (Reg -> InstrBlock) + = Fixed Format Reg InstrBlock + | Any Format (Reg -> InstrBlock) -swizzleRegisterRep :: Register -> Size -> Register -swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code -swizzleRegisterRep (Any _ codefn) size = Any size codefn +swizzleRegisterRep :: Register -> Format -> Register +swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code +swizzleRegisterRep (Any _ codefn) format = Any format codefn -- | Grab the Reg for a CmmReg getRegisterReg :: Platform -> CmmReg -> Reg getRegisterReg _ (CmmLocal (LocalReg u pk)) - = RegVirtual $ mkVirtualReg u (cmmTypeSize pk) + = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk) getRegisterReg platform (CmmGlobal mid) = case globalRegMaybe platform mid of @@ -382,13 +382,13 @@ getRegister' :: DynFlags -> CmmExpr -> NatM Register getRegister' dflags (CmmReg (CmmGlobal PicBaseReg)) | target32Bit (targetPlatform dflags) = do - reg <- getPicBaseNat $ archWordSize (target32Bit (targetPlatform dflags)) - return (Fixed (archWordSize (target32Bit (targetPlatform dflags))) + reg <- getPicBaseNat $ archWordFormat (target32Bit (targetPlatform dflags)) + return (Fixed (archWordFormat (target32Bit (targetPlatform dflags))) reg nilOL) | otherwise = return (Fixed II64 toc nilOL) getRegister' dflags (CmmReg reg) - = return (Fixed (cmmTypeSize (cmmRegType dflags reg)) + = return (Fixed (cmmTypeFormat (cmmRegType dflags reg)) (getRegisterReg (targetPlatform dflags) reg) nilOL) getRegister' dflags tree@(CmmRegOff _ _) @@ -424,14 +424,14 @@ getRegister' dflags (CmmLoad mem pk) let platform = targetPlatform dflags Amode addr addr_code <- getAmode D mem let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk) - addr_code `snocOL` LD size dst addr - return (Any size code) + addr_code `snocOL` LD format dst addr + return (Any format code) | not (target32Bit (targetPlatform dflags)) = do Amode addr addr_code <- getAmode DS mem let code dst = addr_code `snocOL` LD II64 dst addr return (Any II64 code) - where size = cmmTypeSize pk + where format = cmmTypeFormat pk -- catch simple cases of zero- or sign-extended load getRegister' _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do @@ -482,14 +482,14 @@ getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps MO_SF_Conv from to -> coerceInt2FP from to x MO_SS_Conv from to - | from == to -> conversionNop (intSize to) x + | from == to -> conversionNop (intFormat to) x -- narrowing is a nop: we treat the high bits as undefined MO_SS_Conv W64 to | arch32 -> panic "PPC.CodeGen.getRegister no 64 bit int register" - | otherwise -> conversionNop (intSize to) x + | otherwise -> conversionNop (intFormat to) x MO_SS_Conv W32 to - | arch32 -> conversionNop (intSize to) x + | arch32 -> conversionNop (intFormat to) x | otherwise -> case to of W64 -> triv_ucode_int to (EXTS II32) W16 -> conversionNop II16 x @@ -500,13 +500,13 @@ getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16) MO_UU_Conv from to - | from == to -> conversionNop (intSize to) x + | from == to -> conversionNop (intFormat to) x -- narrowing is a nop: we treat the high bits as undefined MO_UU_Conv W64 to | arch32 -> panic "PPC.CodeGen.getRegister no 64 bit target" - | otherwise -> conversionNop (intSize to) x + | otherwise -> conversionNop (intFormat to) x MO_UU_Conv W32 to - | arch32 -> conversionNop (intSize to) x + | arch32 -> conversionNop (intFormat to) x | otherwise -> case to of W64 -> trivialCode to False AND x (CmmLit (CmmInt 4294967295 W64)) @@ -519,12 +519,12 @@ getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps _ -> panic "PPC.CodeGen.getRegister: no match" where - triv_ucode_int width instr = trivialUCode (intSize width) instr x - triv_ucode_float width instr = trivialUCode (floatSize width) instr x + triv_ucode_int width instr = trivialUCode (intFormat width) instr x + triv_ucode_float width instr = trivialUCode (floatFormat width) instr x - conversionNop new_size expr + conversionNop new_format expr = do e_code <- getRegister' dflags expr - return (swizzleRegisterRep e_code new_size) + return (swizzleRegisterRep e_code new_format) arch32 = target32Bit $ targetPlatform dflags getRegister' dflags (CmmMachOp mop [x, y]) -- dyadic PrimOps @@ -586,7 +586,7 @@ getRegister' dflags (CmmMachOp mop [x, y]) -- dyadic PrimOps case y of -- subfi ('substract from' with immediate) doesn't exist CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm) -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep) - _ -> trivialCodeNoImm' (intSize rep) SUBF y x + _ -> trivialCodeNoImm' (intFormat rep) SUBF y x MO_Mul rep | arch32 -> trivialCode rep True MULLW x y @@ -599,14 +599,14 @@ getRegister' dflags (CmmMachOp mop [x, y]) -- dyadic PrimOps MO_U_MulMayOflo _ -> panic "U_MulMayOflo: not implemented" MO_S_Quot rep - | arch32 -> trivialCodeNoImm' (intSize rep) DIVW + | arch32 -> trivialCodeNoImm' (intFormat rep) DIVW (extendSExpr dflags rep x) (extendSExpr dflags rep y) - | otherwise -> trivialCodeNoImm' (intSize rep) DIVD + | otherwise -> trivialCodeNoImm' (intFormat rep) DIVD (extendSExpr dflags rep x) (extendSExpr dflags rep y) MO_U_Quot rep - | arch32 -> trivialCodeNoImm' (intSize rep) DIVWU + | arch32 -> trivialCodeNoImm' (intFormat rep) DIVWU (extendUExpr dflags rep x) (extendUExpr dflags rep y) - | otherwise -> trivialCodeNoImm' (intSize rep) DIVDU + | otherwise -> trivialCodeNoImm' (intFormat rep) DIVDU (extendUExpr dflags rep x) (extendUExpr dflags rep y) MO_S_Rem rep @@ -630,8 +630,8 @@ getRegister' dflags (CmmMachOp mop [x, y]) -- dyadic PrimOps _ -> panic "PPC.CodeGen.getRegister: no match" where - triv_float :: Width -> (Size -> Reg -> Reg -> Reg -> Instr) -> NatM Register - triv_float width instr = trivialCodeNoImm (floatSize width) instr x y + triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register + triv_float width instr = trivialCodeNoImm (floatFormat width) instr x y arch32 = target32Bit $ targetPlatform dflags @@ -640,19 +640,19 @@ getRegister' _ (CmmLit (CmmInt i rep)) = let code dst = unitOL (LI dst imm) in - return (Any (intSize rep) code) + return (Any (intFormat rep) code) getRegister' _ (CmmLit (CmmFloat f frep)) = do lbl <- getNewLabelNat dflags <- getDynFlags dynRef <- cmmMakeDynamicReference dflags DataReference lbl Amode addr addr_code <- getAmode D dynRef - let size = floatSize frep + let format = floatFormat frep code dst = LDATA ReadOnlyData (Statics lbl [CmmStaticLit (CmmFloat f frep)]) - `consOL` (addr_code `snocOL` LD size dst addr) - return (Any size code) + `consOL` (addr_code `snocOL` LD format dst addr) + return (Any format code) getRegister' dflags (CmmLit lit) | target32Bit (targetPlatform dflags) @@ -662,19 +662,19 @@ getRegister' dflags (CmmLit lit) LIS dst (HA imm), ADD dst dst (RIImm (LO imm)) ] - in return (Any (cmmTypeSize rep) code) + in return (Any (cmmTypeFormat rep) code) | otherwise = do lbl <- getNewLabelNat dflags <- getDynFlags dynRef <- cmmMakeDynamicReference dflags DataReference lbl Amode addr addr_code <- getAmode D dynRef let rep = cmmLitType dflags lit - size = cmmTypeSize rep + format = cmmTypeFormat rep code dst = LDATA ReadOnlyData (Statics lbl [CmmStaticLit lit]) - `consOL` (addr_code `snocOL` LD size dst addr) - return (Any size code) + `consOL` (addr_code `snocOL` LD format dst addr) + return (Any format code) getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other) @@ -908,18 +908,18 @@ condIntCode cond x (CmmLit (CmmInt y rep)) = do (src1, code) <- getSomeReg x dflags <- getDynFlags - let size = archWordSize $ target32Bit $ targetPlatform dflags + let format = archWordFormat $ target32Bit $ targetPlatform dflags code' = code `snocOL` - (if condUnsigned cond then CMPL else CMP) size src1 (RIImm src2) + (if condUnsigned cond then CMPL else CMP) format src1 (RIImm src2) return (CondCode False cond code') condIntCode cond x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y dflags <- getDynFlags - let size = archWordSize $ target32Bit $ targetPlatform dflags + let format = archWordFormat $ target32Bit $ targetPlatform dflags code' = code1 `appOL` code2 `snocOL` - (if condUnsigned cond then CMPL else CMP) size src1 (RIReg src2) + (if condUnsigned cond then CMPL else CMP) format src1 (RIReg src2) return (CondCode False cond code') condFltCode cond x y = do @@ -949,11 +949,11 @@ condFltCode cond x y = do -- fails when the right hand side is forced into a fixed register -- (e.g. the result of a call). -assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock -assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock assignMem_IntCode pk addr src = do (srcReg, code) <- getSomeReg src @@ -1142,7 +1142,7 @@ genCCall' _ _ (PrimTarget (MO_Prefetch_Data _)) _ _ = return $ nilOL genCCall' dflags gcp target dest_regs args - = ASSERT(not $ any (`elem` [II16]) $ map cmmTypeSize argReps) + = ASSERT(not $ any (`elem` [II16]) $ map cmmTypeFormat argReps) -- we rely on argument promotion in the codeGen do (finalStack,passArgumentsCode,usedRegs) <- passArguments @@ -1200,7 +1200,7 @@ genCCall' dflags gcp target dest_regs args -- See Note [implicit register in PPC PIC code] -- on why we claim to use PIC register here when (gopt Opt_PIC dflags && target32Bit platform) $ do - _ <- getPicBaseNat $ archWordSize True + _ <- getPicBaseNat $ archWordFormat True return () initialStackOffset = case gcp of @@ -1228,28 +1228,28 @@ genCCall' dflags gcp target dest_regs args roundTo a x | x `mod` a == 0 = x | otherwise = x + a - (x `mod` a) - spSize = if target32Bit platform then II32 else II64 + spFormat = if target32Bit platform then II32 else II64 move_sp_down finalStack | delta > 64 = - toOL [STU spSize sp (AddrRegImm sp (ImmInt (-delta))), + toOL [STU spFormat sp (AddrRegImm sp (ImmInt (-delta))), DELTA (-delta)] | otherwise = nilOL where delta = stackDelta finalStack toc_before = case gcp of - GCPLinux64ELF 1 -> unitOL $ ST spSize toc (AddrRegImm sp (ImmInt 40)) - GCPLinux64ELF 2 -> unitOL $ ST spSize toc (AddrRegImm sp (ImmInt 24)) + GCPLinux64ELF 1 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 40)) + GCPLinux64ELF 2 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 24)) _ -> nilOL toc_after labelOrExpr = case gcp of GCPLinux64ELF 1 -> case labelOrExpr of Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spSize toc + Right _ -> toOL [ LD spFormat toc (AddrRegImm sp (ImmInt 40)) ] GCPLinux64ELF 2 -> case labelOrExpr of Left _ -> toOL [ NOP ] - Right _ -> toOL [ LD spSize toc + Right _ -> toOL [ LD spFormat toc (AddrRegImm sp (ImmInt 24)) ] @@ -1331,7 +1331,7 @@ genCCall' dflags gcp target dest_regs args (drop nGprs gprs) (drop nFprs fprs) (stackOffset' + stackBytes) - (accumCode `appOL` code `snocOL` ST (cmmTypeSize rep) vr stackSlot) + (accumCode `appOL` code `snocOL` ST (cmmTypeFormat rep) vr stackSlot) accumUsed where stackOffset' = case gcp of @@ -1355,7 +1355,7 @@ genCCall' dflags gcp target dest_regs args (nGprs, nFprs, stackBytes, regs) = case gcp of GCPDarwin -> - case cmmTypeSize rep of + case cmmTypeFormat rep of II8 -> (1, 0, 4, gprs) II16 -> (1, 0, 4, gprs) II32 -> (1, 0, 4, gprs) @@ -1367,7 +1367,7 @@ genCCall' dflags gcp target dest_regs args II64 -> panic "genCCall' passArguments II64" FF80 -> panic "genCCall' passArguments FF80" GCPLinux -> - case cmmTypeSize rep of + case cmmTypeFormat rep of II8 -> (1, 0, 4, gprs) II16 -> (1, 0, 4, gprs) II32 -> (1, 0, 4, gprs) @@ -1377,7 +1377,7 @@ genCCall' dflags gcp target dest_regs args II64 -> panic "genCCall' passArguments II64" FF80 -> panic "genCCall' passArguments FF80" GCPLinux64ELF _ -> - case cmmTypeSize rep of + case cmmTypeFormat rep of II8 -> (1, 0, 8, gprs) II16 -> (1, 0, 8, gprs) II32 -> (1, 0, 8, gprs) @@ -1484,15 +1484,15 @@ genSwitch dflags expr targets | (gopt Opt_PIC dflags) || (not $ target32Bit $ targetPlatform dflags) = do (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) - let sz = archWordSize $ target32Bit $ targetPlatform dflags + let fmt = archWordFormat $ target32Bit $ targetPlatform dflags sha = if target32Bit $ targetPlatform dflags then 2 else 3 - tmp <- getNewRegNat sz + tmp <- getNewRegNat fmt lbl <- getNewLabelNat dynRef <- cmmMakeDynamicReference dflags DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let code = e_code `appOL` t_code `appOL` toOL [ - SL sz tmp reg (RIImm (ImmInt sha)), - LD sz tmp (AddrRegReg tableReg tmp), + SL fmt tmp reg (RIImm (ImmInt sha)), + LD fmt tmp (AddrRegReg tableReg tmp), ADD tmp tmp (RIReg tableReg), MTCTR tmp, BCTR ids (Just lbl) @@ -1501,14 +1501,14 @@ genSwitch dflags expr targets | otherwise = do (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) - let sz = archWordSize $ target32Bit $ targetPlatform dflags + let fmt = archWordFormat $ target32Bit $ targetPlatform dflags sha = if target32Bit $ targetPlatform dflags then 2 else 3 - tmp <- getNewRegNat sz + tmp <- getNewRegNat fmt lbl <- getNewLabelNat let code = e_code `appOL` toOL [ - SL sz tmp reg (RIImm (ImmInt sha)), + SL fmt tmp reg (RIImm (ImmInt sha)), ADDIS tmp tmp (HA (ImmCLbl lbl)), - LD sz tmp (AddrRegImm tmp (LO (ImmCLbl lbl))), + LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl))), MTCTR tmp, BCTR ids (Just lbl) ] @@ -1569,8 +1569,8 @@ condReg getCond = do GU -> (1, False) _ -> panic "PPC.CodeGen.codeReg: no match" - size = archWordSize $ target32Bit $ targetPlatform dflags - return (Any size code) + format = archWordFormat $ target32Bit $ targetPlatform dflags + return (Any format code) condIntReg cond x y = condReg (condIntCode cond x y) condFltReg cond x y = condReg (condFltCode cond x y) @@ -1631,17 +1631,17 @@ trivialCode rep signed instr x (CmmLit (CmmInt y _)) = do (src1, code1) <- getSomeReg x let code dst = code1 `snocOL` instr dst src1 (RIImm imm) - return (Any (intSize rep) code) + return (Any (intFormat rep) code) trivialCode rep _ instr x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2) - return (Any (intSize rep) code) + return (Any (intFormat rep) code) shiftCode :: Width - -> (Size-> Reg -> Reg -> RI -> Instr) + -> (Format-> Reg -> Reg -> RI -> Instr) -> CmmExpr -> CmmExpr -> NatM Register @@ -1649,32 +1649,32 @@ shiftCode width instr x (CmmLit (CmmInt y _)) | Just imm <- makeImmediate width False y = do (src1, code1) <- getSomeReg x - let size = intSize width - let code dst = code1 `snocOL` instr size dst src1 (RIImm imm) - return (Any size code) + let format = intFormat width + let code dst = code1 `snocOL` instr format dst src1 (RIImm imm) + return (Any format code) shiftCode width instr x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y - let size = intSize width - let code dst = code1 `appOL` code2 `snocOL` instr size dst src1 (RIReg src2) - return (Any size code) + let format = intFormat width + let code dst = code1 `appOL` code2 `snocOL` instr format dst src1 (RIReg src2) + return (Any format code) -trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr) +trivialCodeNoImm' :: Format -> (Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register -trivialCodeNoImm' size instr x y = do +trivialCodeNoImm' format instr x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2 - return (Any size code) + return (Any format code) -trivialCodeNoImm :: Size -> (Size -> Reg -> Reg -> Reg -> Instr) +trivialCodeNoImm :: Format -> (Format -> Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register -trivialCodeNoImm size instr x y = trivialCodeNoImm' size (instr size) x y +trivialCodeNoImm format instr x y = trivialCodeNoImm' format (instr format) x y trivialUCode - :: Size + :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register @@ -1700,7 +1700,7 @@ remainderCode rep div x y = do mull_instr dst dst (RIReg src2), SUBF dst dst src1 ] - return (Any (intSize rep) code) + return (Any (intFormat rep) code) coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register coerceInt2FP fromRep toRep x = do @@ -1744,7 +1744,7 @@ coerceInt2FP' ArchPPC fromRep toRep x = do W64 -> nilOL _ -> panic "PPC.CodeGen.coerceInt2FP: no match" - return (Any (floatSize toRep) code') + return (Any (floatFormat toRep) code') -- On an ELF v1 Linux we use the compiler doubleword in the stack frame -- this is the TOC pointer doubleword on ELF v2 Linux. The latter is only @@ -1773,7 +1773,7 @@ coerceInt2FP' (ArchPPC_64 _) fromRep toRep x = do W64 -> nilOL _ -> panic "PPC.CodeGen.coerceInt2FP: no match" - return (Any (floatSize toRep) code') + return (Any (floatFormat toRep) code') coerceInt2FP' _ _ _ _ = panic "PPC.CodeGen.coerceInt2FP: unknown arch" @@ -1798,7 +1798,7 @@ coerceFP2Int' ArchPPC _ toRep x = do ST FF64 tmp (spRel dflags 2), -- read low word of value (high word is undefined) LD II32 dst (spRel dflags 3)] - return (Any (intSize toRep) code') + return (Any (intFormat toRep) code') coerceFP2Int' (ArchPPC_64 _) _ toRep x = do dflags <- getDynFlags @@ -1812,7 +1812,7 @@ coerceFP2Int' (ArchPPC_64 _) _ toRep x = do -- store value (64bit) from FP to compiler word on stack ST FF64 tmp (spRel dflags 3), LD II64 dst (spRel dflags 3)] - return (Any (intSize toRep) code') + return (Any (intFormat toRep) code') coerceFP2Int' _ _ _ _ = panic "PPC.CodeGen.coerceFP2Int: unknown arch" diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index b251776866..80873b2847 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -12,7 +12,7 @@ #include "nativeGen/NCG.h" module PPC.Instr ( - archWordSize, + archWordFormat, RI(..), Instr(..), maxSpillSlots, @@ -25,7 +25,7 @@ where import PPC.Regs import PPC.Cond import Instruction -import Size +import Format import TargetReg import RegClass import Reg @@ -47,10 +47,10 @@ import Control.Monad (replicateM) import Data.Maybe (fromMaybe) -------------------------------------------------------------------------------- --- Size of a PPC memory address, in bytes. +-- Format of a PPC memory address. -- -archWordSize :: Bool -> Size -archWordSize is32Bit +archWordFormat :: Bool -> Format +archWordFormat is32Bit | is32Bit = II32 | otherwise = II64 @@ -186,16 +186,16 @@ data Instr | DELTA Int -- Loads and stores. - | LD Size Reg AddrMode -- Load size, dst, src - | LA Size Reg AddrMode -- Load arithmetic size, dst, src - | ST Size Reg AddrMode -- Store size, src, dst - | STU Size Reg AddrMode -- Store with Update size, src, dst + | LD Format Reg AddrMode -- Load format, dst, src + | LA Format Reg AddrMode -- Load arithmetic format, dst, src + | ST Format Reg AddrMode -- Store format, src, dst + | STU Format Reg AddrMode -- Store with Update format, 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 + | CMP Format Reg RI -- format, src1, src2 + | CMPL Format Reg RI -- format, src1, src2 | BCC Cond BlockId | BCCFAR Cond BlockId @@ -240,22 +240,22 @@ data Instr | XOR Reg Reg RI -- dst, src1, src2 | XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2 - | EXTS Size Reg Reg + | EXTS Format Reg Reg | NEG Reg Reg | NOT Reg Reg - | SL Size Reg Reg RI -- shift left - | SR Size Reg Reg RI -- shift right - | SRA Size Reg Reg RI -- shift right arithmetic + | SL Format Reg Reg RI -- shift left + | SR Format Reg Reg RI -- shift right + | SRA Format Reg Reg RI -- shift right arithmetic | RLWINM Reg Reg Int Int Int -- Rotate Left Word Immediate then AND with Mask - | 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. + | FADD Format Reg Reg Reg + | FSUB Format Reg Reg Reg + | FMUL Format Reg Reg Reg + | FDIV Format Reg Reg Reg + | FNEG Reg Reg -- negate is the same for single and double prec. | FCMP Reg Reg @@ -375,15 +375,15 @@ interesting _ (RegReal (RealRegPair{})) ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr ppc_patchRegsOfInstr instr env = case instr of - LD sz reg addr -> LD sz (env reg) (fixAddr addr) - LA sz reg addr -> LA sz (env reg) (fixAddr addr) - ST sz reg addr -> ST sz (env reg) (fixAddr addr) - STU sz reg addr -> STU sz (env reg) (fixAddr addr) + LD fmt reg addr -> LD fmt (env reg) (fixAddr addr) + LA fmt reg addr -> LA fmt (env reg) (fixAddr addr) + ST fmt reg addr -> ST fmt (env reg) (fixAddr addr) + STU fmt reg addr -> STU fmt (env reg) (fixAddr addr) LIS reg imm -> LIS (env reg) imm LI reg imm -> LI (env reg) imm MR reg1 reg2 -> MR (env reg1) (env reg2) - CMP sz reg ri -> CMP sz (env reg) (fixRI ri) - CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri) + CMP fmt reg ri -> CMP fmt (env reg) (fixRI ri) + CMPL fmt reg ri -> CMPL fmt (env reg) (fixRI ri) BCC cond lbl -> BCC cond lbl BCCFAR cond lbl -> BCCFAR cond lbl MTCTR reg -> MTCTR (env reg) @@ -413,18 +413,21 @@ ppc_patchRegsOfInstr instr env ORIS reg1 reg2 imm -> ORIS (env reg1) (env reg2) imm XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm - EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2) + EXTS fmt reg1 reg2 -> EXTS fmt (env reg1) (env reg2) NEG reg1 reg2 -> NEG (env reg1) (env reg2) NOT reg1 reg2 -> NOT (env reg1) (env reg2) - SL sz reg1 reg2 ri -> SL sz (env reg1) (env reg2) (fixRI ri) - SR sz reg1 reg2 ri -> SR sz (env reg1) (env reg2) (fixRI ri) - SRA sz reg1 reg2 ri -> SRA sz (env reg1) (env reg2) (fixRI ri) + SL fmt reg1 reg2 ri + -> SL fmt (env reg1) (env reg2) (fixRI ri) + SR fmt reg1 reg2 ri + -> SR fmt (env reg1) (env reg2) (fixRI ri) + SRA fmt reg1 reg2 ri + -> SRA fmt (env reg1) (env reg2) (fixRI ri) RLWINM reg1 reg2 sh mb me -> RLWINM (env reg1) (env reg2) sh mb me - FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) - FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3) - FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3) - FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3) + FADD fmt r1 r2 r3 -> FADD fmt (env r1) (env r2) (env r3) + FSUB fmt r1 r2 r3 -> FSUB fmt (env r1) (env r2) (env r3) + FMUL fmt r1 r2 r3 -> FMUL fmt (env r1) (env r2) (env r3) + FDIV fmt r1 r2 r3 -> FDIV fmt (env r1) (env r2) (env r3) FNEG r1 r2 -> FNEG (env r1) (env r2) FCMP r1 r2 -> FCMP (env r1) (env r2) FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) @@ -499,13 +502,13 @@ ppc_mkSpillInstr dflags reg delta slot off = spillSlotToOffset slot arch = platformArch platform in - let sz = case targetClassOfReg platform reg of + let fmt = case targetClassOfReg platform reg of RcInteger -> case arch of ArchPPC -> II32 _ -> II64 RcDouble -> FF64 _ -> panic "PPC.Instr.mkSpillInstr: no match" - in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) + in ST fmt reg (AddrRegImm sp (ImmInt (off-delta))) ppc_mkLoadInstr @@ -520,13 +523,13 @@ ppc_mkLoadInstr dflags reg delta slot off = spillSlotToOffset slot arch = platformArch platform in - let sz = case targetClassOfReg platform reg of + let fmt = case targetClassOfReg platform reg of RcInteger -> case arch of ArchPPC -> II32 _ -> II64 RcDouble -> FF64 _ -> panic "PPC.Instr.mkLoadInstr: no match" - in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) + in LD fmt reg (AddrRegImm sp (ImmInt (off-delta))) -- | The maximum number of bytes required to spill a register. PPC32 diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index c33fc3c05e..6b9150a2d1 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -13,7 +13,7 @@ module PPC.Ppr ( pprSectionHeader, pprData, pprInstr, - pprSize, + pprFormat, pprImm, pprDataItem, ) @@ -25,7 +25,7 @@ import PPC.Instr import PPC.Cond import PprBase import Instruction -import Size +import Format import Reg import RegClass import TargetReg @@ -236,8 +236,8 @@ pprReg r -pprSize :: Size -> SDoc -pprSize x +pprFormat :: Format -> SDoc +pprFormat x = ptext (case x of II8 -> sLit "b" II16 -> sLit "h" @@ -245,7 +245,7 @@ pprSize x II64 -> sLit "d" FF32 -> sLit "fs" FF64 -> sLit "fd" - _ -> panic "PPC.Ppr.pprSize: no match") + _ -> panic "PPC.Ppr.pprFormat: no match") pprCond :: Cond -> SDoc @@ -347,7 +347,7 @@ pprSectionHeader seg = pprDataItem :: CmmLit -> SDoc pprDataItem lit = sdocWithDynFlags $ \dflags -> - vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit dflags) + vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit dflags) where imm = litToImm lit archPPC_64 dflags = not $ target32Bit $ targetPlatform dflags @@ -418,10 +418,10 @@ pprInstr (RELOAD slot reg) pprReg reg] -} -pprInstr (LD sz reg addr) = hcat [ +pprInstr (LD fmt reg addr) = hcat [ char '\t', ptext (sLit "l"), - ptext (case sz of + ptext (case fmt of II8 -> sLit "bz" II16 -> sLit "hz" II32 -> sLit "wz" @@ -437,10 +437,10 @@ pprInstr (LD sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (LA sz reg addr) = hcat [ +pprInstr (LA fmt reg addr) = hcat [ char '\t', ptext (sLit "l"), - ptext (case sz of + ptext (case fmt of II8 -> sLit "ba" II16 -> sLit "ha" II32 -> sLit "wa" @@ -456,10 +456,10 @@ pprInstr (LA sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (ST sz reg addr) = hcat [ +pprInstr (ST fmt reg addr) = hcat [ char '\t', ptext (sLit "st"), - pprSize sz, + pprFormat fmt, case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', char '\t', @@ -467,10 +467,10 @@ pprInstr (ST sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (STU sz reg addr) = hcat [ +pprInstr (STU fmt reg addr) = hcat [ char '\t', ptext (sLit "st"), - pprSize sz, + pprFormat fmt, ptext (sLit "u\t"), case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', @@ -507,7 +507,7 @@ pprInstr (MR reg1 reg2) ptext (sLit ", "), pprReg reg2 ] -pprInstr (CMP sz reg ri) = hcat [ +pprInstr (CMP fmt reg ri) = hcat [ char '\t', op, char '\t', @@ -518,12 +518,12 @@ pprInstr (CMP sz reg ri) = hcat [ where op = hcat [ ptext (sLit "cmp"), - pprSize sz, + pprFormat fmt, case ri of RIReg _ -> empty RIImm _ -> char 'i' ] -pprInstr (CMPL sz reg ri) = hcat [ +pprInstr (CMPL fmt reg ri) = hcat [ char '\t', op, char '\t', @@ -534,7 +534,7 @@ pprInstr (CMPL sz reg ri) = hcat [ where op = hcat [ ptext (sLit "cmpl"), - pprSize sz, + pprFormat fmt, case ri of RIReg _ -> empty RIImm _ -> char 'i' @@ -680,10 +680,10 @@ pprInstr (XORIS reg1 reg2 imm) = hcat [ pprImm imm ] -pprInstr (EXTS sz reg1 reg2) = hcat [ +pprInstr (EXTS fmt reg1 reg2) = hcat [ char '\t', ptext (sLit "exts"), - pprSize sz, + pprFormat fmt, char '\t', pprReg reg1, ptext (sLit ", "), @@ -693,12 +693,12 @@ pprInstr (EXTS sz reg1 reg2) = hcat [ pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2 -pprInstr (SL sz reg1 reg2 ri) = - let op = case sz of +pprInstr (SL fmt reg1 reg2 ri) = + let op = case fmt of II32 -> "slw" II64 -> "sld" _ -> panic "PPC.Ppr.pprInstr: shift illegal size" - in pprLogic (sLit op) reg1 reg2 (limitShiftRI sz ri) + in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri) pprInstr (SR II32 reg1 reg2 (RIImm (ImmInt i))) | i > 31 || i < 0 = -- Handle the case where we are asked to shift a 32 bit register by @@ -706,19 +706,19 @@ pprInstr (SR II32 reg1 reg2 (RIImm (ImmInt i))) | i > 31 || i < 0 = -- of the destination register. -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/5900 pprInstr (XOR reg1 reg2 (RIReg reg2)) -pprInstr (SR sz reg1 reg2 ri) = - let op = case sz of +pprInstr (SR fmt reg1 reg2 ri) = + let op = case fmt of II32 -> "srw" II64 -> "srd" _ -> panic "PPC.Ppr.pprInstr: shift illegal size" - in pprLogic (sLit op) reg1 reg2 (limitShiftRI sz ri) + in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri) -pprInstr (SRA sz reg1 reg2 ri) = - let op = case sz of +pprInstr (SRA fmt reg1 reg2 ri) = + let op = case fmt of II32 -> "sraw" II64 -> "srad" _ -> panic "PPC.Ppr.pprInstr: shift illegal size" - in pprLogic (sLit op) reg1 reg2 (limitShiftRI sz ri) + in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri) pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ ptext (sLit "\trlwinm\t"), @@ -733,10 +733,10 @@ pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ int me ] -pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3 -pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3 -pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3 -pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3 +pprInstr (FADD fmt reg1 reg2 reg3) = pprBinaryF (sLit "fadd") fmt reg1 reg2 reg3 +pprInstr (FSUB fmt reg1 reg2 reg3) = pprBinaryF (sLit "fsub") fmt reg1 reg2 reg3 +pprInstr (FMUL fmt reg1 reg2 reg3) = pprBinaryF (sLit "fmul") fmt reg1 reg2 reg3 +pprInstr (FDIV fmt reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") fmt reg1 reg2 reg3 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2 pprInstr (FCMP reg1 reg2) = hcat [ @@ -829,11 +829,11 @@ pprUnary op reg1 reg2 = hcat [ ] -pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc -pprBinaryF op sz reg1 reg2 reg3 = hcat [ +pprBinaryF :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc +pprBinaryF op fmt reg1 reg2 reg3 = hcat [ char '\t', ptext op, - pprFSize sz, + pprFFormat fmt, char '\t', pprReg reg1, ptext (sLit ", "), @@ -847,14 +847,14 @@ pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprFSize :: Size -> SDoc -pprFSize FF64 = empty -pprFSize FF32 = char 's' -pprFSize _ = panic "PPC.Ppr.pprFSize: no match" +pprFFormat :: Format -> SDoc +pprFFormat FF64 = empty +pprFFormat FF32 = char 's' +pprFFormat _ = panic "PPC.Ppr.pprFFormat: no match" -- limit immediate argument for shift instruction to range 0..63 -- for 64 bit size and 0..32 otherwise -limitShiftRI :: Size -> RI -> RI +limitShiftRI :: Format -> RI -> RI limitShiftRI II64 (RIImm (ImmInt i)) | i > 63 || i < 0 = panic $ "PPC.Ppr: Shift by " ++ show i ++ " bits is not allowed." limitShiftRI II32 (RIImm (ImmInt i)) | i > 31 || i < 0 = diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs index ad1075cdd2..e9c825e83a 100644 --- a/compiler/nativeGen/PPC/Regs.hs +++ b/compiler/nativeGen/PPC/Regs.hs @@ -51,7 +51,7 @@ where import Reg import RegClass -import Size +import Format import Cmm import CLabel ( CLabel ) @@ -115,11 +115,11 @@ realRegSqueeze cls rr _other -> _ILIT(0) -mkVirtualReg :: Unique -> Size -> VirtualReg -mkVirtualReg u size - | not (isFloatSize size) = VirtualRegI u +mkVirtualReg :: Unique -> Format -> VirtualReg +mkVirtualReg u format + | not (isFloatFormat format) = VirtualRegI u | otherwise - = case size of + = case format of FF32 -> VirtualRegD u FF64 -> VirtualRegD u _ -> panic "mkVirtualReg" diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index 4792933366..b009ae33c0 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -36,7 +36,7 @@ import SPARC.AddrMode import SPARC.Regs import SPARC.Stack import Instruction -import Size +import Format import NCGMonad -- Our intermediate code: @@ -131,18 +131,18 @@ stmtToInstrs stmt = do CmmUnwind {} -> return nilOL CmmAssign reg src - | isFloatType ty -> assignReg_FltCode size reg src - | isWord64 ty -> assignReg_I64Code reg src - | otherwise -> assignReg_IntCode size reg src + | isFloatType ty -> assignReg_FltCode format reg src + | isWord64 ty -> assignReg_I64Code reg src + | otherwise -> assignReg_IntCode format reg src where ty = cmmRegType dflags reg - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmStore addr src - | isFloatType ty -> assignMem_FltCode size addr src + | isFloatType ty -> assignMem_FltCode format addr src | isWord64 ty -> assignMem_I64Code addr src - | otherwise -> assignMem_IntCode size addr src + | otherwise -> assignMem_IntCode format addr src where ty = cmmExprType dflags src - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmUnsafeForeignCall target result_regs args -> genCCall target result_regs args @@ -199,14 +199,14 @@ jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) -- fails when the right hand side is forced into a fixed register -- (e.g. the result of a call). -assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock assignMem_IntCode pk addr src = do (srcReg, code) <- getSomeReg src Amode dstAddr addr_code <- getAmode addr return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr -assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock assignReg_IntCode _ reg src = do dflags <- getDynFlags r <- getRegister src @@ -218,7 +218,7 @@ assignReg_IntCode _ reg src = do -- Floating point assignment to memory -assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock assignMem_FltCode pk addr src = do dflags <- getDynFlags Amode dst__2 code1 <- getAmode addr @@ -227,14 +227,14 @@ assignMem_FltCode pk addr src = do let pk__2 = cmmExprType dflags src code__2 = code1 `appOL` code2 `appOL` - if sizeToWidth pk == typeWidth pk__2 + if formatToWidth pk == typeWidth pk__2 then unitOL (ST pk src__2 dst__2) - else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1 + else toOL [ FxTOy (cmmTypeFormat pk__2) pk src__2 tmp1 , ST pk tmp1 dst__2] return code__2 -- Floating point assignment to a register/temporary -assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock assignReg_FltCode pk dstCmmReg srcCmmExpr = do dflags <- getDynFlags let platform = targetPlatform dflags @@ -477,7 +477,7 @@ arg_to_int_vregs' dflags arg = do (src, code) <- getSomeReg arg let pk = cmmExprType dflags arg - case cmmTypeSize pk of + case cmmTypeFormat pk of -- Load a 64 bit float return value into two integer regs. FF64 -> do diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs index 8d9a303f2f..a59287f171 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs @@ -12,7 +12,7 @@ import SPARC.Instr import SPARC.Regs import SPARC.Base import NCGMonad -import Size +import Format import Cmm diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs index 270fd699b0..27b533f46b 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Base.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs @@ -5,7 +5,7 @@ module SPARC.CodeGen.Base ( Amode(..), Register(..), - setSizeOfRegister, + setFormatOfRegister, getRegisterReg, mangleIndexTree @@ -17,7 +17,7 @@ import SPARC.Instr import SPARC.Cond import SPARC.AddrMode import SPARC.Regs -import Size +import Format import Reg import CodeGen.Platform @@ -76,18 +76,18 @@ data Amode -- Otherwise, the parent can decide which register to put it in. -- data Register - = Fixed Size Reg InstrBlock - | Any Size (Reg -> InstrBlock) + = Fixed Format Reg InstrBlock + | Any Format (Reg -> InstrBlock) --- | Change the size field in a Register. -setSizeOfRegister - :: Register -> Size -> Register +-- | Change the format field in a Register. +setFormatOfRegister + :: Register -> Format -> Register -setSizeOfRegister reg size +setFormatOfRegister reg format = case reg of - Fixed _ reg code -> Fixed size reg code - Any _ codefn -> Any size codefn + Fixed _ reg code -> Fixed format reg code + Any _ codefn -> Any format codefn -------------------------------------------------------------------------------- @@ -95,7 +95,7 @@ setSizeOfRegister reg size getRegisterReg :: Platform -> CmmReg -> Reg getRegisterReg _ (CmmLocal (LocalReg u pk)) - = RegVirtual $ mkVirtualReg u (cmmTypeSize pk) + = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk) getRegisterReg platform (CmmGlobal mid) = case globalRegMaybe platform mid of diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs index cb10830f46..e5fb82df4d 100644 --- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs +++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs @@ -14,7 +14,7 @@ import SPARC.Cond import SPARC.Imm import SPARC.Base import NCGMonad -import Size +import Format import Cmm @@ -98,7 +98,7 @@ condFltCode cond x y = do code__2 = if pk1 `cmmEqType` pk2 then code1 `appOL` code2 `snocOL` - FCMP True (cmmTypeSize pk1) src1 src2 + FCMP True (cmmTypeFormat pk1) src1 src2 else if typeWidth pk1 == W32 then code1 `snocOL` promote src1 `appOL` code2 `snocOL` FCMP True FF64 tmp src2 diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs index 1d4d1379a5..70cb0111c0 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs @@ -12,7 +12,7 @@ import SPARC.Regs import SPARC.Ppr () import Instruction import Reg -import Size +import Format import Cmm diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs index 90fb41870d..566cc337b7 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs @@ -18,7 +18,7 @@ import SPARC.Imm import SPARC.Regs import SPARC.Base import NCGMonad -import Size +import Format import Reg import Cmm @@ -49,7 +49,7 @@ getRegister :: CmmExpr -> NatM Register getRegister (CmmReg reg) = do dflags <- getDynFlags let platform = targetPlatform dflags - return (Fixed (cmmTypeSize (cmmRegType dflags reg)) + return (Fixed (cmmTypeFormat (cmmRegType dflags reg)) (getRegisterReg platform reg) nilOL) getRegister tree@(CmmRegOff _ _) @@ -115,8 +115,8 @@ getRegister (CmmMachOp mop [x]) -- Integer negation -------------------------------- - MO_S_Neg rep -> trivialUCode (intSize rep) (SUB False False g0) x - MO_Not rep -> trivialUCode (intSize rep) (XNOR False g0) x + MO_S_Neg rep -> trivialUCode (intFormat rep) (SUB False False g0) x + MO_Not rep -> trivialUCode (intFormat rep) (XNOR False g0) x -- Float word size conversion ---------------------- @@ -133,7 +133,7 @@ getRegister (CmmMachOp mop [x]) -- If it's the same size, then nothing needs to be done. MO_UU_Conv from to - | from == to -> conversionNop (intSize to) x + | from == to -> conversionNop (intFormat to) x -- To narrow an unsigned word, mask out the high bits to simulate what would -- happen if we copied the value into a smaller register. @@ -158,9 +158,9 @@ getRegister (CmmMachOp mop [x]) -- To widen an unsigned word we don't have to do anything. -- Just leave it in the same register and mark the result as the new size. - MO_UU_Conv W8 W16 -> conversionNop (intSize W16) x - MO_UU_Conv W8 W32 -> conversionNop (intSize W32) x - MO_UU_Conv W16 W32 -> conversionNop (intSize W32) x + MO_UU_Conv W8 W16 -> conversionNop (intFormat W16) x + MO_UU_Conv W8 W32 -> conversionNop (intFormat W32) x + MO_UU_Conv W16 W32 -> conversionNop (intFormat W32) x -- Signed integer word size conversions ------------ @@ -240,8 +240,8 @@ getRegister (CmmMachOp mop [x, y]) getRegister (CmmLoad mem pk) = do Amode src code <- getAmode mem let - code__2 dst = code `snocOL` LD (cmmTypeSize pk) src dst - return (Any (cmmTypeSize pk) code__2) + code__2 dst = code `snocOL` LD (cmmTypeFormat pk) src dst + return (Any (cmmTypeFormat pk) code__2) getRegister (CmmLit (CmmInt i _)) | fits13Bits i @@ -289,18 +289,18 @@ integerExtend from to expr -- arithmetic shift right to sign extend `snocOL` SRA tmp (RIImm (ImmInt bitCount)) dst - return (Any (intSize to) code) + return (Any (intFormat to) code) -- | For nop word format conversions we set the resulting value to have the -- required size, but don't need to generate any actual code. -- conversionNop - :: Size -> CmmExpr -> NatM Register + :: Format -> CmmExpr -> NatM Register conversionNop new_rep expr = do e_code <- getRegister expr - return (setSizeOfRegister e_code new_rep) + return (setFormatOfRegister e_code new_rep) @@ -477,7 +477,7 @@ trivialCode _ instr x y = do trivialFCode :: Width - -> (Size -> Reg -> Reg -> Reg -> Instr) + -> (Format -> Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register @@ -496,33 +496,33 @@ trivialFCode pk instr x y = do code__2 dst = if pk1 `cmmEqType` pk2 then code1 `appOL` code2 `snocOL` - instr (floatSize pk) src1 src2 dst + instr (floatFormat pk) src1 src2 dst else if typeWidth pk1 == W32 then code1 `snocOL` promote src1 `appOL` code2 `snocOL` instr FF64 tmp src2 dst else code1 `appOL` code2 `snocOL` promote src2 `snocOL` instr FF64 src1 tmp dst - return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64) + return (Any (cmmTypeFormat $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64) code__2) trivialUCode - :: Size + :: Format -> (RI -> Reg -> Instr) -> CmmExpr -> NatM Register -trivialUCode size instr x = do +trivialUCode format instr x = do (src, code) <- getSomeReg x let code__2 dst = code `snocOL` instr (RIReg src) dst - return (Any size code__2) + return (Any format code__2) trivialUFCode - :: Size + :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register @@ -544,10 +544,10 @@ coerceInt2FP width1 width2 x = do (src, code) <- getSomeReg x let code__2 dst = code `appOL` toOL [ - ST (intSize width1) src (spRel (-2)), - LD (intSize width1) (spRel (-2)) dst, - FxTOy (intSize width1) (floatSize width2) dst dst] - return (Any (floatSize $ width2) code__2) + ST (intFormat width1) src (spRel (-2)), + LD (intFormat width1) (spRel (-2)) dst, + FxTOy (intFormat width1) (floatFormat width2) dst dst] + return (Any (floatFormat $ width2) code__2) @@ -558,26 +558,26 @@ coerceInt2FP width1 width2 x = do -- coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register coerceFP2Int width1 width2 x - = do let fsize1 = floatSize width1 - fsize2 = floatSize width2 + = do let fformat1 = floatFormat width1 + fformat2 = floatFormat width2 - isize2 = intSize width2 + iformat2 = intFormat width2 (fsrc, code) <- getSomeReg x - fdst <- getNewRegNat fsize2 + fdst <- getNewRegNat fformat2 let code2 dst = code `appOL` toOL -- convert float to int format, leaving it in a float reg. - [ FxTOy fsize1 isize2 fsrc fdst + [ FxTOy fformat1 iformat2 fsrc fdst -- store the int into mem, then load it back to move -- it into an actual int reg. - , ST fsize2 fdst (spRel (-2)) - , LD isize2 (spRel (-2)) dst] + , ST fformat2 fdst (spRel (-2)) + , LD iformat2 (spRel (-2)) dst] - return (Any isize2 code2) + return (Any iformat2 code2) -- | Coerce a double precision floating point value to single precision. diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs index 438deba00a..1942891c77 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs @@ -17,7 +17,7 @@ import SPARC.Instr import SPARC.Ppr() import NCGMonad import Instruction -import Size +import Format import Reg import Cmm @@ -68,7 +68,7 @@ assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree let - r_dst_lo = RegVirtual $ mkVirtualReg u_dst (cmmTypeSize pk) + r_dst_lo = RegVirtual $ mkVirtualReg u_dst (cmmTypeFormat pk) r_dst_hi = getHiVRegFromLo r_dst_lo r_src_hi = getHiVRegFromLo r_src_lo mov_lo = mkMOV r_src_lo r_dst_lo diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index fb8cc0cadc..ab12a9d679 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -35,7 +35,7 @@ import TargetReg import Instruction import RegClass import Reg -import Size +import Format import CLabel import CodeGen.Platform @@ -129,8 +129,8 @@ data Instr -- real instrs ----------------------------------------------- -- Loads and stores. - | LD Size AddrMode Reg -- size, src, dst - | ST Size Reg AddrMode -- size, src, dst + | LD Format AddrMode Reg -- format, src, dst + | ST Format Reg AddrMode -- format, src, dst -- Int Arithmetic. -- x: add/sub with carry bit. @@ -180,16 +180,16 @@ data Instr -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single -- instructions right up until we spit them out. -- - | FABS Size Reg Reg -- src dst - | FADD Size Reg Reg Reg -- src1, src2, dst - | FCMP Bool Size Reg Reg -- exception?, src1, src2, dst - | FDIV Size Reg Reg Reg -- src1, src2, dst - | FMOV Size Reg Reg -- src, dst - | FMUL Size Reg Reg Reg -- src1, src2, dst - | FNEG Size Reg Reg -- src, dst - | FSQRT Size Reg Reg -- src, dst - | FSUB Size Reg Reg Reg -- src1, src2, dst - | FxTOy Size Size Reg Reg -- src, dst + | FABS Format Reg Reg -- src dst + | FADD Format Reg Reg Reg -- src1, src2, dst + | FCMP Bool Format Reg Reg -- exception?, src1, src2, dst + | FDIV Format Reg Reg Reg -- src1, src2, dst + | FMOV Format Reg Reg -- src, dst + | FMUL Format Reg Reg Reg -- src1, src2, dst + | FNEG Format Reg Reg -- src, dst + | FSQRT Format Reg Reg -- src, dst + | FSUB Format Reg Reg Reg -- src1, src2, dst + | FxTOy Format Format Reg Reg -- src, dst -- Jumping around. | BI Cond Bool BlockId -- cond, annul?, target @@ -287,8 +287,8 @@ interesting platform reg -- | Apply a given mapping to tall the register references in this instruction. sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr sparc_patchRegsOfInstr instr env = case instr of - LD sz addr reg -> LD sz (fixAddr addr) (env reg) - ST sz reg addr -> ST sz (env reg) (fixAddr addr) + LD fmt addr reg -> LD fmt (fixAddr addr) (env reg) + ST fmt reg addr -> ST fmt (env reg) (fixAddr addr) ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2) SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2) @@ -379,13 +379,13 @@ sparc_mkSpillInstr dflags reg _ slot = let platform = targetPlatform dflags off = spillSlotToOffset dflags slot off_w = 1 + (off `div` 4) - sz = case targetClassOfReg platform reg of + fmt = case targetClassOfReg platform reg of RcInteger -> II32 RcFloat -> FF32 RcDouble -> FF64 _ -> panic "sparc_mkSpillInstr" - in ST sz reg (fpRel (negate off_w)) + in ST fmt reg (fpRel (negate off_w)) -- | Make a spill reload instruction. @@ -399,14 +399,14 @@ sparc_mkLoadInstr sparc_mkLoadInstr dflags reg _ slot = let platform = targetPlatform dflags off = spillSlotToOffset dflags slot - off_w = 1 + (off `div` 4) - sz = case targetClassOfReg platform reg of + off_w = 1 + (off `div` 4) + fmt = case targetClassOfReg platform reg of RcInteger -> II32 RcFloat -> FF32 RcDouble -> FF64 _ -> panic "sparc_mkLoadInstr" - in LD sz (fpRel (- off_w)) reg + in LD fmt (fpRel (- off_w)) reg -------------------------------------------------------------------------------- diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index e9941b81ff..b9462dfa19 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -16,7 +16,7 @@ module SPARC.Ppr ( pprSectionHeader, pprData, pprInstr, - pprSize, + pprFormat, pprImm, pprDataItem ) @@ -34,7 +34,7 @@ import SPARC.AddrMode import SPARC.Base import Instruction import Reg -import Size +import Format import PprBase import Cmm hiding (topInfoTable) @@ -208,9 +208,9 @@ pprReg_ofRegNo i _ -> sLit "very naughty sparc register" }) --- | Pretty print a size for an instruction suffix. -pprSize :: Size -> SDoc -pprSize x +-- | Pretty print a format for an instruction suffix. +pprFormat :: Format -> SDoc +pprFormat x = ptext (case x of II8 -> sLit "ub" @@ -219,13 +219,13 @@ pprSize x II64 -> sLit "d" FF32 -> sLit "" FF64 -> sLit "d" - _ -> panic "SPARC.Ppr.pprSize: no match") + _ -> panic "SPARC.Ppr.pprFormat: no match") --- | Pretty print a size for an instruction suffix. +-- | Pretty print a format for an instruction suffix. -- eg LD is 32bit on sparc, but LDD is 64 bit. -pprStSize :: Size -> SDoc -pprStSize x +pprStFormat :: Format -> SDoc +pprStFormat x = ptext (case x of II8 -> sLit "b" @@ -234,7 +234,7 @@ pprStSize x II64 -> sLit "x" FF32 -> sLit "" FF64 -> sLit "d" - _ -> panic "SPARC.Ppr.pprSize: no match") + _ -> panic "SPARC.Ppr.pprFormat: no match") -- | Pretty print a condition code. @@ -336,7 +336,7 @@ pprSectionHeader seg = case seg of pprDataItem :: CmmLit -> SDoc pprDataItem lit = sdocWithDynFlags $ \dflags -> - vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit) + vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit) where imm = litToImm lit @@ -378,10 +378,10 @@ pprInstr (LD FF64 _ reg) | RegReal (RealRegSingle{}) <- reg = panic "SPARC.Ppr: not emitting potentially misaligned LD FF64 instr" -pprInstr (LD size addr reg) +pprInstr (LD format addr reg) = hcat [ ptext (sLit "\tld"), - pprSize size, + pprFormat format, char '\t', lbrack, pprAddr addr, @@ -396,11 +396,11 @@ pprInstr (ST FF64 reg _) -- no distinction is made between signed and unsigned bytes on stores for the -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF), --- so we call a special-purpose pprSize for ST.. -pprInstr (ST size reg addr) +-- so we call a special-purpose pprFormat for ST.. +pprInstr (ST format reg addr) = hcat [ ptext (sLit "\tst"), - pprStSize size, + pprStFormat format, char '\t', pprReg reg, pp_comma_lbracket, @@ -475,44 +475,45 @@ pprInstr (SETHI imm reg) pprInstr NOP = ptext (sLit "\tnop") -pprInstr (FABS size reg1 reg2) - = pprSizeRegReg (sLit "fabs") size reg1 reg2 +pprInstr (FABS format reg1 reg2) + = pprFormatRegReg (sLit "fabs") format reg1 reg2 -pprInstr (FADD size reg1 reg2 reg3) - = pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3 +pprInstr (FADD format reg1 reg2 reg3) + = pprFormatRegRegReg (sLit "fadd") format reg1 reg2 reg3 -pprInstr (FCMP e size reg1 reg2) - = pprSizeRegReg (if e then sLit "fcmpe" else sLit "fcmp") size reg1 reg2 +pprInstr (FCMP e format reg1 reg2) + = pprFormatRegReg (if e then sLit "fcmpe" else sLit "fcmp") + format reg1 reg2 -pprInstr (FDIV size reg1 reg2 reg3) - = pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3 +pprInstr (FDIV format reg1 reg2 reg3) + = pprFormatRegRegReg (sLit "fdiv") format reg1 reg2 reg3 -pprInstr (FMOV size reg1 reg2) - = pprSizeRegReg (sLit "fmov") size reg1 reg2 +pprInstr (FMOV format reg1 reg2) + = pprFormatRegReg (sLit "fmov") format reg1 reg2 -pprInstr (FMUL size reg1 reg2 reg3) - = pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3 +pprInstr (FMUL format reg1 reg2 reg3) + = pprFormatRegRegReg (sLit "fmul") format reg1 reg2 reg3 -pprInstr (FNEG size reg1 reg2) - = pprSizeRegReg (sLit "fneg") size reg1 reg2 +pprInstr (FNEG format reg1 reg2) + = pprFormatRegReg (sLit "fneg") format reg1 reg2 -pprInstr (FSQRT size reg1 reg2) - = pprSizeRegReg (sLit "fsqrt") size reg1 reg2 +pprInstr (FSQRT format reg1 reg2) + = pprFormatRegReg (sLit "fsqrt") format reg1 reg2 -pprInstr (FSUB size reg1 reg2 reg3) - = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3 +pprInstr (FSUB format reg1 reg2 reg3) + = pprFormatRegRegReg (sLit "fsub") format reg1 reg2 reg3 -pprInstr (FxTOy size1 size2 reg1 reg2) +pprInstr (FxTOy format1 format2 reg1 reg2) = hcat [ ptext (sLit "\tf"), ptext - (case size1 of + (case format1 of II32 -> sLit "ito" FF32 -> sLit "sto" FF64 -> sLit "dto" _ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"), ptext - (case size2 of + (case format2 of II32 -> sLit "i\t" II64 -> sLit "x\t" FF32 -> sLit "s\t" @@ -555,15 +556,15 @@ pprRI (RIImm r) = pprImm r -- | Pretty print a two reg instruction. -pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc -pprSizeRegReg name size reg1 reg2 +pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc +pprFormatRegReg name format reg1 reg2 = hcat [ char '\t', ptext name, - (case size of + (case format of FF32 -> ptext (sLit "s\t") FF64 -> ptext (sLit "d\t") - _ -> panic "SPARC.Ppr.pprSizeRegReg: no match"), + _ -> panic "SPARC.Ppr.pprFormatRegReg: no match"), pprReg reg1, comma, @@ -572,15 +573,15 @@ pprSizeRegReg name size reg1 reg2 -- | Pretty print a three reg instruction. -pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc -pprSizeRegRegReg name size reg1 reg2 reg3 +pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc +pprFormatRegRegReg name format reg1 reg2 reg3 = hcat [ char '\t', ptext name, - (case size of + (case format of FF32 -> ptext (sLit "s\t") FF64 -> ptext (sLit "d\t") - _ -> panic "SPARC.Ppr.pprSizeRegReg: no match"), + _ -> panic "SPARC.Ppr.pprFormatRegReg: no match"), pprReg reg1, comma, pprReg reg2, diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 394389c4bf..d02747da4f 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -35,7 +35,7 @@ where import CodeGen.Platform.SPARC import Reg import RegClass -import Size +import Format import Unique import Outputable @@ -245,14 +245,14 @@ callClobberedRegs --- | Make a virtual reg with this size. -mkVirtualReg :: Unique -> Size -> VirtualReg -mkVirtualReg u size - | not (isFloatSize size) +-- | Make a virtual reg with this format. +mkVirtualReg :: Unique -> Format -> VirtualReg +mkVirtualReg u format + | not (isFloatFormat format) = VirtualRegI u | otherwise - = case size of + = case format of FF32 -> VirtualRegF u FF64 -> VirtualRegD u _ -> panic "mkVReg" diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index 5ae53f9000..606e6f5d9e 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -23,7 +23,7 @@ where import Reg import RegClass -import Size +import Format import Outputable import Unique @@ -86,7 +86,7 @@ targetClassOfRealReg platform ArchJavaScript-> panic "targetClassOfRealReg ArchJavaScript" ArchUnknown -> panic "targetClassOfRealReg ArchUnknown" -targetMkVirtualReg :: Platform -> Unique -> Size -> VirtualReg +targetMkVirtualReg :: Platform -> Unique -> Format -> VirtualReg targetMkVirtualReg platform = case platformArch platform of ArchX86 -> X86.mkVirtualReg diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index a052fdacdf..47fc50a39e 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -35,7 +35,7 @@ import Debug ( DebugBlock(..) ) import Instruction import PIC import NCGMonad -import Size +import Format import Reg import Platform @@ -161,18 +161,18 @@ stmtToInstrs stmt = do CmmUnwind {} -> return nilOL CmmAssign reg src - | isFloatType ty -> assignReg_FltCode size reg src + | isFloatType ty -> assignReg_FltCode format reg src | is32Bit && isWord64 ty -> assignReg_I64Code reg src - | otherwise -> assignReg_IntCode size reg src + | otherwise -> assignReg_IntCode format reg src where ty = cmmRegType dflags reg - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmStore addr src - | isFloatType ty -> assignMem_FltCode size addr src + | isFloatType ty -> assignMem_FltCode format addr src | is32Bit && isWord64 ty -> assignMem_I64Code addr src - | otherwise -> assignMem_IntCode size addr src + | otherwise -> assignMem_IntCode format addr src where ty = cmmExprType dflags src - size = cmmTypeSize ty + format = cmmTypeFormat ty CmmUnsafeForeignCall target result_regs args -> genCCall dflags is32Bit target result_regs args @@ -229,23 +229,23 @@ data ChildCode64 -- register to put it in. -- data Register - = Fixed Size Reg InstrBlock - | Any Size (Reg -> InstrBlock) + = Fixed Format Reg InstrBlock + | Any Format (Reg -> InstrBlock) -swizzleRegisterRep :: Register -> Size -> Register -swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code -swizzleRegisterRep (Any _ codefn) size = Any size codefn +swizzleRegisterRep :: Register -> Format -> Register +swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code +swizzleRegisterRep (Any _ codefn) format = Any format codefn -- | Grab the Reg for a CmmReg getRegisterReg :: Platform -> Bool -> CmmReg -> Reg getRegisterReg _ use_sse2 (CmmLocal (LocalReg u pk)) - = let sz = cmmTypeSize pk in - if isFloatSize sz && not use_sse2 + = let fmt = cmmTypeFormat pk in + if isFloatFormat fmt && not use_sse2 then RegVirtual (mkVirtualReg u FF80) - else RegVirtual (mkVirtualReg u sz) + else RegVirtual (mkVirtualReg u fmt) getRegisterReg platform _ (CmmGlobal mid) = case globalRegMaybe platform mid of @@ -451,17 +451,19 @@ getRegister' dflags is32Bit (CmmReg reg) -- on x86_64, we have %rip for PicBaseReg, but it's not -- a full-featured register, it can only be used for -- rip-relative addressing. - do reg' <- getPicBaseNat (archWordSize is32Bit) - return (Fixed (archWordSize is32Bit) reg' nilOL) + do reg' <- getPicBaseNat (archWordFormat is32Bit) + return (Fixed (archWordFormat is32Bit) reg' nilOL) _ -> do use_sse2 <- sse2Enabled let - sz = cmmTypeSize (cmmRegType dflags reg) - size | not use_sse2 && isFloatSize sz = FF80 - | otherwise = sz + fmt = cmmTypeFormat (cmmRegType dflags reg) + format | not use_sse2 && isFloatFormat fmt = FF80 + | otherwise = fmt -- let platform = targetPlatform dflags - return (Fixed size (getRegisterReg platform use_sse2 reg) nilOL) + return (Fixed format + (getRegisterReg platform use_sse2 reg) + nilOL) getRegister' dflags is32Bit (CmmRegOff r n) @@ -498,11 +500,11 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = float_const_sse2 | f == 0.0 = do let - size = floatSize w - code dst = unitOL (XOR size (OpReg dst) (OpReg dst)) + format = floatFormat w + code dst = unitOL (XOR format (OpReg dst) (OpReg dst)) -- I don't know why there are xorpd, xorps, and pxor instructions. -- They all appear to do the same thing --SDM - return (Any size code) + return (Any format code) | otherwise = do Amode addr code <- memConstant (widthInBytes w) lit @@ -583,8 +585,8 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps | sse2 -> sse2NegCode w x | otherwise -> trivialUFCode FF80 (GNEG FF80) x - MO_S_Neg w -> triv_ucode NEGI (intSize w) - MO_Not w -> triv_ucode NOT (intSize w) + MO_S_Neg w -> triv_ucode NEGI (intFormat w) + MO_Not w -> triv_ucode NOT (intFormat w) -- Nop conversions MO_UU_Conv W32 W8 -> toI8Reg W32 x @@ -601,8 +603,8 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps MO_UU_Conv W64 W8 | not is32Bit -> toI8Reg W64 x MO_SS_Conv W64 W8 | not is32Bit -> toI8Reg W64 x - MO_UU_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intSize rep1) x - MO_SS_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intSize rep1) x + MO_UU_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x + MO_SS_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x -- widenings MO_UU_Conv W8 W32 -> integerExtend W8 W32 MOVZxL x @@ -653,12 +655,12 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps _other -> pprPanic "getRegister" (pprMachOp mop) where - triv_ucode :: (Size -> Operand -> Instr) -> Size -> NatM Register - triv_ucode instr size = trivialUCode size (instr size) x + triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register + triv_ucode instr format = trivialUCode format (instr format) x -- signed or unsigned extension. integerExtend :: Width -> Width - -> (Size -> Operand -> Operand -> Instr) + -> (Format -> Operand -> Operand -> Instr) -> CmmExpr -> NatM Register integerExtend from to instr expr = do (reg,e_code) <- if from == W8 then getByteReg expr @@ -666,13 +668,13 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps let code dst = e_code `snocOL` - instr (intSize from) (OpReg reg) (OpReg dst) - return (Any (intSize to) code) + instr (intFormat from) (OpReg reg) (OpReg dst) + return (Any (intFormat to) code) toI8Reg :: Width -> CmmExpr -> NatM Register toI8Reg new_rep expr = do codefn <- getAnyReg expr - return (Any (intSize new_rep) codefn) + return (Any (intFormat new_rep) codefn) -- HACK: use getAnyReg to get a byte-addressable register. -- If the source was a Fixed register, this will add the -- mov instruction to put it into the desired destination. @@ -682,10 +684,10 @@ getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps toI16Reg = toI8Reg -- for now - conversionNop :: Size -> CmmExpr -> NatM Register - conversionNop new_size expr + conversionNop :: Format -> CmmExpr -> NatM Register + conversionNop new_format expr = do e_code <- getRegister' dflags is32Bit expr - return (swizzleRegisterRep e_code new_size) + return (swizzleRegisterRep e_code new_format) getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps @@ -763,7 +765,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps where -------------------- triv_op width instr = trivialCode width op (Just op) x y - where op = instr (intSize width) + where op = instr (intFormat width) imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register imulMayOflo rep a b = do @@ -775,21 +777,21 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps W64 -> 63 _ -> panic "shift_amt" - size = intSize rep + format = intFormat rep code = a_code `appOL` b_code eax `appOL` toOL [ - IMUL2 size (OpReg a_reg), -- result in %edx:%eax - SAR size (OpImm (ImmInt shift_amt)) (OpReg eax), + IMUL2 format (OpReg a_reg), -- result in %edx:%eax + SAR format (OpImm (ImmInt shift_amt)) (OpReg eax), -- sign extend lower part - SUB size (OpReg edx) (OpReg eax) + SUB format (OpReg edx) (OpReg eax) -- compare against upper -- eax==0 if high part == sign extended low part ] - return (Fixed size eax code) + return (Fixed format eax code) -------------------- shift_code :: Width - -> (Size -> Operand -> Operand -> Instr) + -> (Format -> Operand -> Operand -> Instr) -> CmmExpr -> CmmExpr -> NatM Register @@ -798,11 +800,11 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps shift_code width instr x (CmmLit lit) = do x_code <- getAnyReg x let - size = intSize width + format = intFormat width code dst = x_code dst `snocOL` - instr size (OpImm (litToImm lit)) (OpReg dst) - return (Any size code) + instr format (OpImm (litToImm lit)) (OpReg dst) + return (Any format code) {- Case2: shift length is complex (non-immediate) * y must go in %ecx. @@ -820,21 +822,21 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps -} shift_code width instr x y{-amount-} = do x_code <- getAnyReg x - let size = intSize width - tmp <- getNewRegNat size + let format = intFormat width + tmp <- getNewRegNat format y_code <- getAnyReg y let code = x_code tmp `appOL` y_code ecx `snocOL` - instr size (OpReg ecx) (OpReg tmp) - return (Fixed size tmp code) + instr format (OpReg ecx) (OpReg tmp) + return (Fixed format tmp code) -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y = add_int rep x y - add_code rep x y = trivialCode rep (ADD size) (Just (ADD size)) x y - where size = intSize rep + add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y + where format = intFormat rep -- TODO: There are other interesting patterns we want to replace -- with a LEA, e.g. `(x + offset) + (y << shift)`. @@ -842,42 +844,42 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register sub_code rep x (CmmLit (CmmInt y _)) | is32BitInteger (-y) = add_int rep x (-y) - sub_code rep x y = trivialCode rep (SUB (intSize rep)) Nothing x y + sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: add_int width x y = do (x_reg, x_code) <- getSomeReg x let - size = intSize width + format = intFormat width imm = ImmInt (fromInteger y) code dst = x_code `snocOL` - LEA size + LEA format (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm)) (OpReg dst) -- - return (Any size code) + return (Any format code) ---------------------- div_code width signed quotient x y = do (y_op, y_code) <- getRegOrMem y -- cannot be clobbered x_code <- getAnyReg x let - size = intSize width - widen | signed = CLTD size - | otherwise = XOR size (OpReg edx) (OpReg edx) + format = intFormat width + widen | signed = CLTD format + | otherwise = XOR format (OpReg edx) (OpReg edx) instr | signed = IDIV | otherwise = DIV code = y_code `appOL` x_code eax `appOL` - toOL [widen, instr size y_op] + toOL [widen, instr format y_op] result | quotient = eax | otherwise = edx - return (Fixed size result code) + return (Fixed format result code) getRegister' _ _ (CmmLoad mem pk) @@ -891,13 +893,13 @@ getRegister' _ is32Bit (CmmLoad mem pk) | is32Bit && not (isWord64 pk) = do code <- intLoadCode instr mem - return (Any size code) + return (Any format code) where width = typeWidth pk - size = intSize width + format = intFormat width instr = case width of W8 -> MOVZxL II8 - _other -> MOV size + _other -> MOV format -- We always zero-extend 8-bit loads, if we -- can't think of anything better. This is because -- we can't guarantee access to an 8-bit variant of every register @@ -908,23 +910,23 @@ getRegister' _ is32Bit (CmmLoad mem pk) getRegister' _ is32Bit (CmmLoad mem pk) | not is32Bit = do - code <- intLoadCode (MOV size) mem - return (Any size code) - where size = intSize $ typeWidth pk + code <- intLoadCode (MOV format) mem + return (Any format code) + where format = intFormat $ typeWidth pk getRegister' _ is32Bit (CmmLit (CmmInt 0 width)) = let - size = intSize width + format = intFormat width -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits - size1 = if is32Bit then size - else case size of + format1 = if is32Bit then format + else case format of II64 -> II32 - _ -> size + _ -> format code dst - = unitOL (XOR size1 (OpReg dst) (OpReg dst)) + = unitOL (XOR format1 (OpReg dst) (OpReg dst)) in - return (Any size code) + return (Any format code) -- optimisation for loading small literals on x86_64: take advantage -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit @@ -946,10 +948,10 @@ getRegister' dflags is32Bit (CmmLit lit) -- small memory model (see gcc docs, -mcmodel=small). getRegister' dflags _ (CmmLit lit) - = do let size = cmmTypeSize (cmmLitType dflags lit) + = do let format = cmmTypeFormat (cmmLitType dflags lit) imm = litToImm lit - code dst = unitOL (MOV size (OpImm imm) (OpReg dst)) - return (Any size code) + code dst = unitOL (MOV format (OpImm imm) (OpReg dst)) + return (Any format code) getRegister' _ _ other | isVecExpr other = needLlvm @@ -1014,10 +1016,10 @@ getNonClobberedReg expr = do | otherwise -> return (reg, code) -reg2reg :: Size -> Reg -> Reg -> Instr -reg2reg size src dst - | size == FF80 = GMOV src dst - | otherwise = MOV size (OpReg src) (OpReg dst) +reg2reg :: Format -> Reg -> Reg -> Instr +reg2reg format src dst + | format == FF80 = GMOV src dst + | otherwise = MOV format (OpReg src) (OpReg dst) -------------------------------------------------------------------------------- @@ -1095,7 +1097,7 @@ getSimpleAmode :: DynFlags -> Bool -> CmmExpr -> NatM Amode getSimpleAmode dflags is32Bit addr | is32Bit = do addr_code <- getAnyReg addr - addr_r <- getNewRegNat (intSize (wordWidth dflags)) + addr_r <- getNewRegNat (intFormat (wordWidth dflags)) let amode = AddrBaseIndex (EABaseReg addr_r) EAIndexNone (ImmInt 0) return $! Amode amode (addr_code addr_r) | otherwise = getAmode addr @@ -1152,9 +1154,11 @@ getNonClobberedOperand (CmmLoad mem pk) = do (src',save_code) <- if (amodeCouldBeClobbered platform src) then do - tmp <- getNewRegNat (archWordSize is32Bit) + tmp <- getNewRegNat (archWordFormat is32Bit) return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0), - unitOL (LEA (archWordSize is32Bit) (OpAddr src) (OpReg tmp))) + unitOL (LEA (archWordFormat is32Bit) + (OpAddr src) + (OpReg tmp))) else return (src, nilOL) return (OpAddr src', mem_code `appOL` save_code) @@ -1237,12 +1241,12 @@ memConstant align lit = do loadFloatAmode :: Bool -> Width -> AddrMode -> InstrBlock -> NatM Register loadFloatAmode use_sse2 w addr addr_code = do - let size = floatSize w + let format = floatFormat w code dst = addr_code `snocOL` if use_sse2 - then MOV size (OpAddr addr) (OpReg dst) - else GLD size addr dst - return (Any (if use_sse2 then size else FF80) code) + then MOV format (OpAddr addr) (OpReg dst) + else GLD format addr dst + return (Any (if use_sse2 then format else FF80) code) -- if we want a floating-point literal as an operand, we can @@ -1337,7 +1341,7 @@ condIntCode' is32Bit cond (CmmLoad x pk) (CmmLit lit) let imm = litToImm lit code = x_code `snocOL` - CMP (cmmTypeSize pk) (OpImm imm) (OpAddr x_addr) + CMP (cmmTypeFormat pk) (OpImm imm) (OpAddr x_addr) -- return (CondCode False cond code) @@ -1349,7 +1353,7 @@ condIntCode' is32Bit cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 pk)) (x_reg, x_code) <- getSomeReg x let code = x_code `snocOL` - TEST (intSize pk) (OpImm (ImmInteger mask)) (OpReg x_reg) + TEST (intFormat pk) (OpImm (ImmInteger mask)) (OpReg x_reg) -- return (CondCode False cond code) @@ -1358,7 +1362,7 @@ condIntCode' _ cond x (CmmLit (CmmInt 0 pk)) = do (x_reg, x_code) <- getSomeReg x let code = x_code `snocOL` - TEST (intSize pk) (OpReg x_reg) (OpReg x_reg) + TEST (intFormat pk) (OpReg x_reg) (OpReg x_reg) -- return (CondCode False cond code) @@ -1370,7 +1374,7 @@ condIntCode' is32Bit cond x y (y_op, y_code) <- getOperand y let code = x_code `appOL` y_code `snocOL` - CMP (cmmTypeSize (cmmExprType dflags x)) y_op (OpReg x_reg) + CMP (cmmTypeFormat (cmmExprType dflags x)) y_op (OpReg x_reg) return (CondCode False cond code) -- operand vs. anything: invert the comparison so that we can use a -- single comparison instruction. @@ -1381,7 +1385,7 @@ condIntCode' is32Bit cond x y (x_op, x_code) <- getOperand x let code = y_code `appOL` x_code `snocOL` - CMP (cmmTypeSize (cmmExprType dflags x)) x_op (OpReg y_reg) + CMP (cmmTypeFormat (cmmExprType dflags x)) x_op (OpReg y_reg) return (CondCode False revcond code) -- anything vs anything @@ -1392,7 +1396,7 @@ condIntCode' _ cond x y = do let code = y_code `appOL` x_code `snocOL` - CMP (cmmTypeSize (cmmExprType dflags x)) (OpReg y_reg) x_op + CMP (cmmTypeFormat (cmmExprType dflags x)) (OpReg y_reg) x_op return (CondCode False cond code) @@ -1425,7 +1429,7 @@ condFltCode cond x y let code = x_code `appOL` y_code `snocOL` - CMP (floatSize $ cmmExprWidth dflags x) y_op (OpReg x_reg) + CMP (floatFormat $ cmmExprWidth dflags x) y_op (OpReg x_reg) -- NB(1): we need to use the unsigned comparison operators on the -- result of this comparison. return (CondCode True (condToUnsigned cond) code) @@ -1442,11 +1446,11 @@ condFltCode cond x y -- fails when the right hand side is forced into a fixed register -- (e.g. the result of a call). -assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_IntCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock -assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_FltCode :: Size -> CmmReg -> CmmExpr -> NatM InstrBlock +assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock -- integer assignment to memory @@ -1649,10 +1653,10 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _ [dst, src, CmmLit (CmmInt n _)] | fromInteger insns <= maxInlineMemcpyInsns dflags && align .&. 3 == 0 = do code_dst <- getAnyReg dst - dst_r <- getNewRegNat size + dst_r <- getNewRegNat format code_src <- getAnyReg src - src_r <- getNewRegNat size - tmp_r <- getNewRegNat size + src_r <- getNewRegNat format + tmp_r <- getNewRegNat format return $ code_dst dst_r `appOL` code_src src_r `appOL` go dst_r src_r tmp_r (fromInteger n) where @@ -1660,17 +1664,17 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _ -- instructions per move. insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes) - size = if align .&. 4 /= 0 then II32 else (archWordSize is32Bit) + format = if align .&. 4 /= 0 then II32 else (archWordFormat is32Bit) -- The size of each move, in bytes. sizeBytes :: Integer - sizeBytes = fromIntegral (sizeInBytes size) + sizeBytes = fromIntegral (formatInBytes format) go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr go dst src tmp i | i >= sizeBytes = - unitOL (MOV size (OpAddr src_addr) (OpReg tmp)) `appOL` - unitOL (MOV size (OpReg tmp) (OpAddr dst_addr)) `appOL` + unitOL (MOV format (OpAddr src_addr) (OpReg tmp)) `appOL` + unitOL (MOV format (OpReg tmp) (OpAddr dst_addr)) `appOL` go dst src tmp (i - sizeBytes) -- Deal with remaining bytes. | i >= 4 = -- Will never happen on 32-bit @@ -1698,10 +1702,10 @@ genCCall dflags _ (PrimTarget (MO_Memset align)) _ CmmLit (CmmInt n _)] | fromInteger insns <= maxInlineMemsetInsns dflags && align .&. 3 == 0 = do code_dst <- getAnyReg dst - dst_r <- getNewRegNat size + dst_r <- getNewRegNat format return $ code_dst dst_r `appOL` go dst_r (fromInteger n) where - (size, val) = case align .&. 3 of + (format, val) = case align .&. 3 of 2 -> (II16, c2) 0 -> (II32, c4) _ -> (II8, c) @@ -1714,13 +1718,13 @@ genCCall dflags _ (PrimTarget (MO_Memset align)) _ -- The size of each move, in bytes. sizeBytes :: Integer - sizeBytes = fromIntegral (sizeInBytes size) + sizeBytes = fromIntegral (formatInBytes format) go :: Reg -> Integer -> OrdList Instr go dst i -- TODO: Add movabs instruction and support 64-bit sets. | i >= sizeBytes = -- This might be smaller than the below sizes - unitOL (MOV size (OpImm (ImmInteger val)) (OpAddr dst_addr)) `appOL` + unitOL (MOV format (OpImm (ImmInteger val)) (OpAddr dst_addr)) `appOL` go dst (i - sizeBytes) | i >= 4 = -- Will never happen on 32-bit unitOL (MOV II32 (OpImm (ImmInteger c4)) (OpAddr dst_addr)) `appOL` @@ -1744,20 +1748,20 @@ genCCall _ _ (PrimTarget MO_Touch) _ _ = return nilOL genCCall _ is32bit (PrimTarget (MO_Prefetch_Data n )) _ [src] = case n of - 0 -> genPrefetch src $ PREFETCH NTA size - 1 -> genPrefetch src $ PREFETCH Lvl2 size - 2 -> genPrefetch src $ PREFETCH Lvl1 size - 3 -> genPrefetch src $ PREFETCH Lvl0 size + 0 -> genPrefetch src $ PREFETCH NTA format + 1 -> genPrefetch src $ PREFETCH Lvl2 format + 2 -> genPrefetch src $ PREFETCH Lvl1 format + 3 -> genPrefetch src $ PREFETCH Lvl0 format l -> panic $ "unexpected prefetch level in genCCall MO_Prefetch_Data: " ++ (show l) -- the c / llvm prefetch convention is 0, 1, 2, and 3 -- the x86 corresponding names are : NTA, 2 , 1, and 0 where - size = archWordSize is32bit + format = archWordFormat is32bit -- need to know what register width for pointers! genPrefetch inRegSrc prefetchCTor = do code_src <- getAnyReg inRegSrc - src_r <- getNewRegNat size + src_r <- getNewRegNat format return $ code_src src_r `appOL` (unitOL (prefetchCTor (OpAddr ((AddrBaseIndex (EABaseReg src_r ) EAIndexNone (ImmInt 0)))) )) @@ -1781,9 +1785,9 @@ genCCall dflags is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] = do unitOL (BSWAP II32 dst_r) `appOL` unitOL (SHR II32 (OpImm $ ImmInt 16) (OpReg dst_r)) _ -> do code_src <- getAnyReg src - return $ code_src dst_r `appOL` unitOL (BSWAP size dst_r) + return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r) where - size = intSize width + format = intFormat width genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] args@[src] = do @@ -1791,7 +1795,7 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] let platform = targetPlatform dflags if sse4_2 then do code_src <- getAnyReg src - src_r <- getNewRegNat size + src_r <- getNewRegNat format let dst_r = getRegisterReg platform False (CmmLocal dst) return $ code_src src_r `appOL` (if width == W8 then @@ -1799,7 +1803,7 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL` unitOL (POPCNT II16 (OpReg src_r) dst_r) else - unitOL (POPCNT size (OpReg src_r) dst_r)) `appOL` + unitOL (POPCNT format (OpReg src_r) dst_r)) `appOL` (if width == W8 || width == W16 then -- We used a 16-bit destination register above, -- so zero-extend @@ -1813,7 +1817,7 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] CmmMayReturn) genCCall dflags is32Bit target dest_regs args where - size = intSize width + format = intFormat width lbl = mkCmmCodeLabel primPackageKey (fsLit (popCntLabel width)) genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] @@ -1827,25 +1831,25 @@ genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] | otherwise = do code_src <- getAnyReg src - src_r <- getNewRegNat size - tmp_r <- getNewRegNat size + src_r <- getNewRegNat format + tmp_r <- getNewRegNat format let dst_r = getRegisterReg platform False (CmmLocal dst) -- The following insn sequence makes sure 'clz 0' has a defined value. -- starting with Haswell, one could use the LZCNT insn instead. return $ code_src src_r `appOL` toOL - ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ - [ BSR size (OpReg src_r) tmp_r - , MOV II32 (OpImm (ImmInt (2*bw-1))) (OpReg dst_r) - , CMOV NE size (OpReg tmp_r) dst_r - , XOR size (OpImm (ImmInt (bw-1))) (OpReg dst_r) + ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ + [ BSR format (OpReg src_r) tmp_r + , MOV II32 (OpImm (ImmInt (2*bw-1))) (OpReg dst_r) + , CMOV NE format (OpReg tmp_r) dst_r + , XOR format (OpImm (ImmInt (bw-1))) (OpReg dst_r) ]) -- NB: We don't need to zero-extend the result for the -- W8/W16 cases because the 'MOV' insn already -- took care of implicitly clearing the upper bits where bw = widthInBits width platform = targetPlatform dflags - size = if width == W8 then II16 else intSize width + format = if width == W8 then II16 else intFormat width lbl = mkCmmCodeLabel primPackageKey (fsLit (clzLabel width)) genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] @@ -1855,7 +1859,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] dst_r = getRegisterReg platform False (CmmLocal dst) lbl1 <- getBlockIdNat lbl2 <- getBlockIdNat - tmp_r <- getNewRegNat size + tmp_r <- getNewRegNat format -- The following instruction sequence corresponds to the pseudo-code -- @@ -1883,24 +1887,24 @@ genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] | otherwise = do code_src <- getAnyReg src - src_r <- getNewRegNat size - tmp_r <- getNewRegNat size + src_r <- getNewRegNat format + tmp_r <- getNewRegNat format let dst_r = getRegisterReg platform False (CmmLocal dst) -- The following insn sequence makes sure 'ctz 0' has a defined value. -- starting with Haswell, one could use the TZCNT insn instead. return $ code_src src_r `appOL` toOL - ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ - [ BSF size (OpReg src_r) tmp_r - , MOV II32 (OpImm (ImmInt bw)) (OpReg dst_r) - , CMOV NE size (OpReg tmp_r) dst_r + ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ + [ BSF format (OpReg src_r) tmp_r + , MOV II32 (OpImm (ImmInt bw)) (OpReg dst_r) + , CMOV NE format (OpReg tmp_r) dst_r ]) -- NB: We don't need to zero-extend the result for the -- W8/W16 cases because the 'MOV' insn already -- took care of implicitly clearing the upper bits where bw = widthInBits width platform = targetPlatform dflags - size = if width == W8 then II16 else intSize width + format = if width == W8 then II16 else intFormat width genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do targetExpr <- cmmMakeDynamicReference dflags @@ -1917,7 +1921,7 @@ genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = if amop `elem` [AMO_Add, AMO_Sub] then getAmode addr else getSimpleAmode dflags is32Bit addr -- See genCCall for MO_Cmpxchg - arg <- getNewRegNat size + arg <- getNewRegNat format arg_code <- getAnyReg n use_sse2 <- sse2Enabled let platform = targetPlatform dflags @@ -1934,19 +1938,19 @@ genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = -- In the common case where dst_r is a virtual register the -- final move should go away, because it's the last use of arg -- and the first use of dst_r. - AMO_Add -> return $ toOL [ LOCK (XADD size (OpReg arg) (OpAddr amode)) - , MOV size (OpReg arg) (OpReg dst_r) + AMO_Add -> return $ toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) ] - AMO_Sub -> return $ toOL [ NEGI size (OpReg arg) - , LOCK (XADD size (OpReg arg) (OpAddr amode)) - , MOV size (OpReg arg) (OpReg dst_r) + AMO_Sub -> return $ toOL [ NEGI format (OpReg arg) + , LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) ] - AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND size src dst) - AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND size src dst - , NOT size dst + AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst) + AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst + , NOT format dst ]) - AMO_Or -> cmpxchg_code (\ src dst -> unitOL $ OR size src dst) - AMO_Xor -> cmpxchg_code (\ src dst -> unitOL $ XOR size src dst) + AMO_Or -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst) + AMO_Xor -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst) where -- Simulate operation that lacks a dedicated instruction using -- cmpxchg. @@ -1954,30 +1958,30 @@ genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = -> NatM (OrdList Instr) cmpxchg_code instrs = do lbl <- getBlockIdNat - tmp <- getNewRegNat size + tmp <- getNewRegNat format return $ toOL - [ MOV size (OpAddr amode) (OpReg eax) + [ MOV format (OpAddr amode) (OpReg eax) , JXX ALWAYS lbl , NEWBLOCK lbl -- Keep old value so we can return it: - , MOV size (OpReg eax) (OpReg dst_r) - , MOV size (OpReg eax) (OpReg tmp) + , MOV format (OpReg eax) (OpReg dst_r) + , MOV format (OpReg eax) (OpReg tmp) ] `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL - [ LOCK (CMPXCHG size (OpReg tmp) (OpAddr amode)) + [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode)) , JXX NE lbl ] - size = intSize width + format = intFormat width genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] = do - load_code <- intLoadCode (MOV (intSize width)) addr + load_code <- intLoadCode (MOV (intFormat width)) addr let platform = targetPlatform dflags use_sse2 <- sse2Enabled return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst))) genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do - code <- assignMem_IntCode (intSize width) addr val + code <- assignMem_IntCode (intFormat width) addr val return $ code `snocOL` MFENCE genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = do @@ -1985,22 +1989,22 @@ genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = -- complicated addressing mode, so on that architecture we -- pre-compute the address first. Amode amode addr_code <- getSimpleAmode dflags is32Bit addr - newval <- getNewRegNat size + newval <- getNewRegNat format newval_code <- getAnyReg new - oldval <- getNewRegNat size + oldval <- getNewRegNat format oldval_code <- getAnyReg old use_sse2 <- sse2Enabled let platform = targetPlatform dflags dst_r = getRegisterReg platform use_sse2 (CmmLocal dst) code = toOL - [ MOV size (OpReg oldval) (OpReg eax) - , LOCK (CMPXCHG size (OpReg newval) (OpAddr amode)) - , MOV size (OpReg eax) (OpReg dst_r) + [ MOV format (OpReg oldval) (OpReg eax) + , LOCK (CMPXCHG format (OpReg newval) (OpAddr amode)) + , MOV format (OpReg eax) (OpReg dst_r) ] return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval `appOL` code where - size = intSize width + format = intFormat width genCCall _ is32Bit target dest_regs args = do dflags <- getDynFlags @@ -2035,8 +2039,8 @@ genCCall _ is32Bit target dest_regs args = do _other_op -> outOfLineCmmOp op (Just r) args where - actuallyInlineFloatOp instr size [x] - = do res <- trivialUFCode size (instr size) x + actuallyInlineFloatOp instr format [x] + = do res <- trivialUFCode format (instr format) x any <- anyReg res return (any (getRegisterReg platform False (CmmLocal r))) @@ -2051,14 +2055,14 @@ genCCall _ is32Bit target dest_regs args = do case args of [arg_x, arg_y] -> do hCode <- getAnyReg (CmmLit (CmmInt 0 width)) - let size = intSize width - lCode <- anyReg =<< trivialCode width (ADD_CC size) - (Just (ADD_CC size)) arg_x arg_y + let format = intFormat width + lCode <- anyReg =<< trivialCode width (ADD_CC format) + (Just (ADD_CC format)) arg_x arg_y let reg_l = getRegisterReg platform True (CmmLocal res_l) reg_h = getRegisterReg platform True (CmmLocal res_h) code = hCode reg_h `appOL` lCode reg_l `snocOL` - ADC size (OpImm (ImmInteger 0)) (OpReg reg_h) + ADC format (OpImm (ImmInteger 0)) (OpReg reg_h) return code _ -> panic "genCCall: Wrong number of arguments/results for add2" (PrimTarget (MO_AddIntC width), [res_r, res_c]) -> @@ -2070,14 +2074,14 @@ genCCall _ is32Bit target dest_regs args = do [arg_x, arg_y] -> do (y_reg, y_code) <- getRegOrMem arg_y x_code <- getAnyReg arg_x - let size = intSize width + let format = intFormat width reg_h = getRegisterReg platform True (CmmLocal res_h) reg_l = getRegisterReg platform True (CmmLocal res_l) code = y_code `appOL` x_code rax `appOL` - toOL [MUL2 size y_reg, - MOV size (OpReg rdx) (OpReg reg_h), - MOV size (OpReg rax) (OpReg reg_l)] + toOL [MUL2 format y_reg, + MOV format (OpReg rdx) (OpReg reg_h), + MOV format (OpReg rax) (OpReg reg_l)] return code _ -> panic "genCCall: Wrong number of arguments/results for add2" @@ -2095,11 +2099,11 @@ genCCall _ is32Bit target dest_regs args = do = panic "genCCall: Wrong number of arguments for divOp2" divOp platform signed width [res_q, res_r] m_arg_x_high arg_x_low arg_y - = do let size = intSize width + = do let format = intFormat width reg_q = getRegisterReg platform True (CmmLocal res_q) reg_r = getRegisterReg platform True (CmmLocal res_r) - widen | signed = CLTD size - | otherwise = XOR size (OpReg rdx) (OpReg rdx) + widen | signed = CLTD format + | otherwise = XOR format (OpReg rdx) (OpReg rdx) instr | signed = IDIV | otherwise = DIV (y_reg, y_code) <- getRegOrMem arg_y @@ -2112,16 +2116,16 @@ genCCall _ is32Bit target dest_regs args = do return $ y_code `appOL` x_low_code rax `appOL` x_high_code rdx `appOL` - toOL [instr size y_reg, - MOV size (OpReg rax) (OpReg reg_q), - MOV size (OpReg rdx) (OpReg reg_r)] + toOL [instr format y_reg, + MOV format (OpReg rax) (OpReg reg_q), + MOV format (OpReg rdx) (OpReg reg_r)] divOp _ _ _ _ _ _ _ = panic "genCCall: Wrong number of results for divOp" addSubIntC platform instr mrevinstr width res_r res_c [arg_x, arg_y] - = do let size = intSize width - rCode <- anyReg =<< trivialCode width (instr size) - (mrevinstr size) arg_x arg_y + = do let format = intFormat width + rCode <- anyReg =<< trivialCode width (instr format) + (mrevinstr format) arg_x arg_y reg_tmp <- getNewRegNat II8 let reg_c = getRegisterReg platform True (CmmLocal res_c) reg_r = getRegisterReg platform True (CmmLocal res_r) @@ -2209,17 +2213,19 @@ genCCall32' dflags target dest_regs args = do then let tmp_amode = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt 0) - sz = floatSize w + fmt = floatFormat w in toOL [ SUB II32 (OpImm (ImmInt b)) (OpReg esp), DELTA (delta0 - b), - GST sz fake0 tmp_amode, - MOV sz (OpAddr tmp_amode) (OpReg r_dest), + GST fmt fake0 tmp_amode, + MOV fmt (OpAddr tmp_amode) (OpReg r_dest), ADD II32 (OpImm (ImmInt b)) (OpReg esp), DELTA delta0] else unitOL (GMOV fake0 r_dest) | isWord64 ty = toOL [MOV II32 (OpReg eax) (OpReg r_dest), MOV II32 (OpReg edx) (OpReg r_dest_hi)] - | otherwise = unitOL (MOV (intSize w) (OpReg eax) (OpReg r_dest)) + | otherwise = unitOL (MOV (intFormat w) + (OpReg eax) + (OpReg r_dest)) where ty = localRegType dest w = typeWidth ty @@ -2265,11 +2271,11 @@ genCCall32' dflags target dest_regs args = do let addr = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt 0) - size = floatSize (typeWidth arg_ty) + format = floatFormat (typeWidth arg_ty) in if use_sse2 - then MOV size (OpReg reg) (OpAddr addr) - else GST size reg addr + then MOV format (OpReg reg) (OpAddr addr) + else GST format reg addr ] ) @@ -2368,7 +2374,7 @@ genCCall64' dflags target dest_regs args = do -- stdcall has callee do it, but is not supported on -- x86_64 target (see #3336) (if real_size==0 then [] else - [ADD (intSize (wordWidth dflags)) (OpImm (ImmInt real_size)) (OpReg esp)]) + [ADD (intFormat (wordWidth dflags)) (OpImm (ImmInt real_size)) (OpReg esp)]) ++ [DELTA (delta + real_size)] ) @@ -2379,9 +2385,13 @@ genCCall64' dflags target dest_regs args = do assign_code [] = nilOL assign_code [dest] = case typeWidth rep of - W32 | isFloatType rep -> unitOL (MOV (floatSize W32) (OpReg xmm0) (OpReg r_dest)) - W64 | isFloatType rep -> unitOL (MOV (floatSize W64) (OpReg xmm0) (OpReg r_dest)) - _ -> unitOL (MOV (cmmTypeSize rep) (OpReg rax) (OpReg r_dest)) + W32 | isFloatType rep -> unitOL (MOV (floatFormat W32) + (OpReg xmm0) + (OpReg r_dest)) + W64 | isFloatType rep -> unitOL (MOV (floatFormat W64) + (OpReg xmm0) + (OpReg r_dest)) + _ -> unitOL (MOV (cmmTypeFormat rep) (OpReg rax) (OpReg r_dest)) where rep = localRegType dest r_dest = getRegisterReg platform True (CmmLocal dest) @@ -2464,9 +2474,9 @@ genCCall64' dflags target dest_regs args = do delta <- getDeltaNat setDeltaNat (delta-arg_size) let code' = code `appOL` arg_code `appOL` toOL [ - SUB (intSize (wordWidth dflags)) (OpImm (ImmInt arg_size)) (OpReg rsp) , + SUB (intFormat (wordWidth dflags)) (OpImm (ImmInt arg_size)) (OpReg rsp), DELTA (delta-arg_size), - MOV (floatSize width) (OpReg arg_reg) (OpAddr (spRel dflags 0))] + MOV (floatFormat width) (OpReg arg_reg) (OpAddr (spRel dflags 0))] push_args rest code' | otherwise = do @@ -2591,7 +2601,7 @@ genSwitch dflags expr targets return $ if target32Bit (targetPlatform dflags) then e_code `appOL` t_code `appOL` toOL [ - ADD (intSize (wordWidth dflags)) op (OpReg tableReg), + ADD (intFormat (wordWidth dflags)) op (OpReg tableReg), JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] else case platformOS (targetPlatform dflags) of @@ -2604,7 +2614,7 @@ genSwitch dflags expr targets -- if L0 is not preceded by a non-anonymous -- label in its section. e_code `appOL` t_code `appOL` toOL [ - ADD (intSize (wordWidth dflags)) op (OpReg tableReg), + ADD (intFormat (wordWidth dflags)) op (OpReg tableReg), JMP_TBL (OpReg tableReg) ids Text lbl ] _ -> @@ -2618,7 +2628,7 @@ genSwitch dflags expr targets -- once binutils 2.17 is standard. e_code `appOL` t_code `appOL` toOL [ MOVSxL II32 op (OpReg reg), - ADD (intSize (wordWidth dflags)) (OpReg reg) (OpReg tableReg), + ADD (intFormat (wordWidth dflags)) (OpReg reg) (OpReg tableReg), JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] | otherwise @@ -2689,8 +2699,8 @@ condFltReg is32Bit cond x y = if_sse2 condFltReg_sse2 condFltReg_x87 condFltReg_sse2 = do CondCode _ cond cond_code <- condFltCode cond x y - tmp1 <- getNewRegNat (archWordSize is32Bit) - tmp2 <- getNewRegNat (archWordSize is32Bit) + tmp1 <- getNewRegNat (archWordFormat is32Bit) + tmp2 <- getNewRegNat (archWordFormat is32Bit) let -- We have to worry about unordered operands (eg. comparisons -- against NaN). If the operands are unordered, the comparison @@ -2808,13 +2818,13 @@ trivialCode' is32Bit width _ (Just revinstr) (CmmLit lit_a) b code dst = b_code dst `snocOL` revinstr (OpImm (litToImm lit_a)) (OpReg dst) - return (Any (intSize width) code) + return (Any (intFormat width) code) trivialCode' _ width instr _ a b - = genTrivialCode (intSize width) instr a b + = genTrivialCode (intFormat width) instr a b -- This is re-used for floating pt instructions too. -genTrivialCode :: Size -> (Operand -> Operand -> Instr) +genTrivialCode :: Format -> (Operand -> Operand -> Instr) -> CmmExpr -> CmmExpr -> NatM Register genTrivialCode rep instr a b = do (b_op, b_code) <- getNonClobberedOperand b @@ -2846,7 +2856,7 @@ _ `regClashesWithOp` _ = False ----------- -trivialUCode :: Size -> (Operand -> Instr) +trivialUCode :: Format -> (Operand -> Instr) -> CmmExpr -> NatM Register trivialUCode rep instr x = do x_code <- getAnyReg x @@ -2858,34 +2868,34 @@ trivialUCode rep instr x = do ----------- -trivialFCode_x87 :: (Size -> Reg -> Reg -> Reg -> Instr) +trivialFCode_x87 :: (Format -> Reg -> Reg -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register trivialFCode_x87 instr x y = do (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too (y_reg, y_code) <- getSomeReg y let - size = FF80 -- always, on x87 + format = FF80 -- always, on x87 code dst = x_code `appOL` y_code `snocOL` - instr size x_reg y_reg dst - return (Any size code) + instr format x_reg y_reg dst + return (Any format code) -trivialFCode_sse2 :: Width -> (Size -> Operand -> Operand -> Instr) +trivialFCode_sse2 :: Width -> (Format -> Operand -> Operand -> Instr) -> CmmExpr -> CmmExpr -> NatM Register trivialFCode_sse2 pk instr x y - = genTrivialCode size (instr size) x y - where size = floatSize pk + = genTrivialCode format (instr format) x y + where format = floatFormat pk -trivialUFCode :: Size -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register -trivialUFCode size instr x = do +trivialUFCode :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register +trivialUFCode format instr x = do (x_reg, x_code) <- getSomeReg x let code dst = x_code `snocOL` instr x_reg dst - return (Any size code) + return (Any format code) -------------------------------------------------------------------------------- @@ -2908,8 +2918,8 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 opc = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD n -> panic $ "coerceInt2FP.sse: unhandled width (" ++ show n ++ ")" - code dst = x_code `snocOL` opc (intSize from) x_op dst - return (Any (floatSize to) code) + code dst = x_code `snocOL` opc (intFormat from) x_op dst + return (Any (floatFormat to) code) -- works even if the destination rep is <II32 -------------------------------------------------------------------------------- @@ -2924,7 +2934,7 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 ++ show n ++ ")" code dst = x_code `snocOL` opc x_reg dst -- ToDo: works for non-II32 reps? - return (Any (intSize to) code) + return (Any (intFormat to) code) coerceFP2Int_sse2 = do (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand @@ -2932,8 +2942,8 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ; n -> panic $ "coerceFP2Init.sse: unhandled width (" ++ show n ++ ")" - code dst = x_code `snocOL` opc (intSize to) x_op dst - return (Any (intSize to) code) + code dst = x_code `snocOL` opc (intFormat to) x_op dst + return (Any (intFormat to) code) -- works even if the destination rep is <II32 @@ -2948,27 +2958,27 @@ coerceFP2FP to x = do ++ show n ++ ")" | otherwise = GDTOF code dst = x_code `snocOL` opc x_reg dst - return (Any (if use_sse2 then floatSize to else FF80) code) + return (Any (if use_sse2 then floatFormat to else FF80) code) -------------------------------------------------------------------------------- sse2NegCode :: Width -> CmmExpr -> NatM Register sse2NegCode w x = do - let sz = floatSize w + let fmt = floatFormat w x_code <- getAnyReg x -- This is how gcc does it, so it can't be that bad: let - const | FF32 <- sz = CmmInt 0x80000000 W32 - | otherwise = CmmInt 0x8000000000000000 W64 + const | FF32 <- fmt = CmmInt 0x80000000 W32 + | otherwise = CmmInt 0x8000000000000000 W64 Amode amode amode_code <- memConstant (widthInBytes w) const - tmp <- getNewRegNat sz + tmp <- getNewRegNat fmt let code dst = x_code dst `appOL` amode_code `appOL` toOL [ - MOV sz (OpAddr amode) (OpReg tmp), - XOR sz (OpReg tmp) (OpReg dst) + MOV fmt (OpAddr amode) (OpReg tmp), + XOR fmt (OpReg tmp) (OpReg dst) ] -- - return (Any sz code) + return (Any fmt code) isVecExpr :: CmmExpr -> Bool isVecExpr (CmmMachOp (MO_V_Insert {}) _) = True diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 8677badb02..0ab86a991d 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -11,7 +11,7 @@ module X86.Instr (Instr(..), Operand(..), PrefetchVariant(..), JumpDest, getJumpDestBlockId, canShortcut, shortcutStatics, shortcutJump, i386_insert_ffrees, allocMoreStack, - maxSpillSlots, archWordSize) + maxSpillSlots, archWordFormat) where #include "HsVersions.h" @@ -20,7 +20,7 @@ where import X86.Cond import X86.Regs import Instruction -import Size +import Format import RegClass import Reg import TargetReg @@ -43,10 +43,10 @@ import UniqSupply import Control.Monad import Data.Maybe (fromMaybe) --- Size of an x86/x86_64 memory address, in bytes. +-- Format of an x86/x86_64 memory address, in bytes. -- -archWordSize :: Bool -> Size -archWordSize is32Bit +archWordFormat :: Bool -> Format +archWordFormat is32Bit | is32Bit = II32 | otherwise = II64 @@ -184,52 +184,52 @@ data Instr | DELTA Int -- Moves. - | MOV Size Operand Operand - | CMOV Cond Size Operand Reg - | MOVZxL Size Operand Operand -- size is the size of operand 1 - | MOVSxL Size Operand Operand -- size is the size of operand 1 + | MOV Format Operand Operand + | CMOV Cond Format Operand Reg + | MOVZxL Format Operand Operand -- format is the size of operand 1 + | MOVSxL Format Operand Operand -- format is the size of operand 1 -- x86_64 note: plain mov into a 32-bit register always zero-extends -- into the 64-bit reg, in contrast to the 8 and 16-bit movs which -- don't affect the high bits of the register. -- Load effective address (also a very useful three-operand add instruction :-) - | LEA Size Operand Operand + | LEA Format Operand Operand -- Int Arithmetic. - | ADD Size Operand Operand - | ADC Size Operand Operand - | SUB Size Operand Operand - | SBB Size Operand Operand + | ADD Format Operand Operand + | ADC Format Operand Operand + | SUB Format Operand Operand + | SBB Format Operand Operand - | MUL Size Operand Operand - | MUL2 Size Operand -- %edx:%eax = operand * %rax - | IMUL Size Operand Operand -- signed int mul - | IMUL2 Size Operand -- %edx:%eax = operand * %eax + | MUL Format Operand Operand + | MUL2 Format Operand -- %edx:%eax = operand * %rax + | IMUL Format Operand Operand -- signed int mul + | IMUL2 Format Operand -- %edx:%eax = operand * %eax - | DIV Size Operand -- eax := eax:edx/op, edx := eax:edx%op - | IDIV Size Operand -- ditto, but signed + | DIV Format Operand -- eax := eax:edx/op, edx := eax:edx%op + | IDIV Format Operand -- ditto, but signed -- Int Arithmetic, where the effects on the condition register -- are important. Used in specialized sequences such as MO_Add2. -- Do not rewrite these instructions to "equivalent" ones that -- have different effect on the condition register! (See #9013.) - | ADD_CC Size Operand Operand - | SUB_CC Size Operand Operand + | ADD_CC Format Operand Operand + | SUB_CC Format Operand Operand -- Simple bit-twiddling. - | AND Size Operand Operand - | OR Size Operand Operand - | XOR Size Operand Operand - | NOT Size Operand - | NEGI Size Operand -- NEG instruction (name clash with Cond) - | BSWAP Size Reg + | AND Format Operand Operand + | OR Format Operand Operand + | XOR Format Operand Operand + | NOT Format Operand + | NEGI Format Operand -- NEG instruction (name clash with Cond) + | BSWAP Format Reg -- Shifts (amount may be immediate or %cl only) - | SHL Size Operand{-amount-} Operand - | SAR Size Operand{-amount-} Operand - | SHR Size Operand{-amount-} Operand + | SHL Format Operand{-amount-} Operand + | SAR Format Operand{-amount-} Operand + | SHR Format Operand{-amount-} Operand - | BT Size Imm Operand + | BT Format Imm Operand | NOP -- x86 Float Arithmetic. @@ -239,8 +239,8 @@ data Instr -- 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 AddrMode Reg -- src, dst(fpreg) - | GST Size Reg AddrMode -- src(fpreg), dst + | GLD Format AddrMode Reg -- src, dst(fpreg) + | GST Format Reg AddrMode -- src(fpreg), dst | GLDZ Reg -- dst(fpreg) | GLD1 Reg -- dst(fpreg) @@ -253,10 +253,10 @@ data Instr | GDTOF Reg Reg -- src(fpreg), 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 + | GADD Format Reg Reg Reg -- src1, src2, dst + | GDIV Format Reg Reg Reg -- src1, src2, dst + | GSUB Format Reg Reg Reg -- src1, src2, dst + | GMUL Format 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 @@ -264,12 +264,12 @@ data Instr -- 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 CLabel CLabel Reg Reg -- src, dst - | GCOS Size CLabel CLabel Reg Reg -- src, dst - | GTAN Size CLabel CLabel Reg Reg -- src, dst + | GABS Format Reg Reg -- src, dst + | GNEG Format Reg Reg -- src, dst + | GSQRT Format Reg Reg -- src, dst + | GSIN Format CLabel CLabel Reg Reg -- src, dst + | GCOS Format CLabel CLabel Reg Reg -- src, dst + | GTAN Format CLabel CLabel Reg Reg -- src, dst | GFREE -- do ffree on all x86 regs; an ugly hack @@ -277,33 +277,33 @@ data Instr -- SSE2 floating point: we use a restricted set of the available SSE2 -- instructions for floating-point. -- use MOV for moving (either movss or movsd (movlpd better?)) - | CVTSS2SD Reg Reg -- F32 to F64 - | CVTSD2SS Reg Reg -- F64 to F32 - | CVTTSS2SIQ Size Operand Reg -- F32 to I32/I64 (with truncation) - | CVTTSD2SIQ Size Operand Reg -- F64 to I32/I64 (with truncation) - | CVTSI2SS Size Operand Reg -- I32/I64 to F32 - | CVTSI2SD Size Operand Reg -- I32/I64 to F64 + | CVTSS2SD Reg Reg -- F32 to F64 + | CVTSD2SS Reg Reg -- F64 to F32 + | CVTTSS2SIQ Format Operand Reg -- F32 to I32/I64 (with truncation) + | CVTTSD2SIQ Format Operand Reg -- F64 to I32/I64 (with truncation) + | CVTSI2SS Format Operand Reg -- I32/I64 to F32 + | CVTSI2SD Format Operand Reg -- I32/I64 to F64 -- use ADD & SUB for arithmetic. In both cases, operands -- are Operand Reg. -- SSE2 floating-point division: - | FDIV Size Operand Operand -- divisor, dividend(dst) + | FDIV Format Operand Operand -- divisor, dividend(dst) -- use CMP for comparisons. ucomiss and ucomisd instructions -- compare single/double prec floating point respectively. - | SQRT Size Operand Reg -- src, dst + | SQRT Format Operand Reg -- src, dst -- Comparison - | TEST Size Operand Operand - | CMP Size Operand Operand + | TEST Format Operand Operand + | CMP Format Operand Operand | SETCC Cond Operand -- Stack Operations. - | PUSH Size Operand - | POP Size Operand + | PUSH Format Operand + | POP Format Operand -- both unused (SDM): -- | PUSHA -- | POPA @@ -320,7 +320,7 @@ data Instr | CALL (Either Imm Reg) [Reg] -- Other things. - | CLTD Size -- sign extend %eax into %edx:%eax + | CLTD Format -- sign extend %eax into %edx:%eax | FETCHGOT Reg -- pseudo-insn for ELF position-independent code -- pretty-prints as @@ -333,17 +333,17 @@ data Instr -- 1: popl %reg -- bit counting instructions - | POPCNT Size Operand Reg -- [SSE4.2] count number of bits set to 1 - | BSF Size Operand Reg -- bit scan forward - | BSR Size Operand Reg -- bit scan reverse + | POPCNT Format Operand Reg -- [SSE4.2] count number of bits set to 1 + | BSF Format Operand Reg -- bit scan forward + | BSR Format Operand Reg -- bit scan reverse -- prefetch - | PREFETCH PrefetchVariant Size Operand -- prefetch Variant, addr size, address to prefetch + | PREFETCH PrefetchVariant Format Operand -- prefetch Variant, addr size, address to prefetch -- variant can be NTA, Lvl0, Lvl1, or Lvl2 | LOCK Instr -- lock prefix - | XADD Size Operand Operand -- src (r), dst (r/m) - | CMPXCHG Size Operand Operand -- src (r), dst (r/m), eax implicit + | XADD Format Operand Operand -- src (r), dst (r/m) + | CMPXCHG Format Operand Operand -- src (r), dst (r/m), eax implicit | MFENCE data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2 @@ -541,44 +541,44 @@ interesting _ (RegReal (RealRegPair{})) = panic "X86.interesting: no re x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr x86_patchRegsOfInstr instr env = case instr of - MOV sz src dst -> patch2 (MOV sz) src dst - CMOV cc sz src dst -> CMOV cc sz (patchOp src) (env dst) - MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst - MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst - LEA sz src dst -> patch2 (LEA sz) src dst - ADD sz src dst -> patch2 (ADD sz) src dst - ADC sz src dst -> patch2 (ADC sz) src dst - SUB sz src dst -> patch2 (SUB sz) src dst - SBB sz src dst -> patch2 (SBB sz) src dst - IMUL sz src dst -> patch2 (IMUL sz) src dst - IMUL2 sz src -> patch1 (IMUL2 sz) src - MUL sz src dst -> patch2 (MUL sz) src dst - MUL2 sz src -> patch1 (MUL2 sz) src - IDIV sz op -> patch1 (IDIV sz) op - DIV sz op -> patch1 (DIV sz) op - ADD_CC sz src dst -> patch2 (ADD_CC sz) src dst - SUB_CC sz src dst -> patch2 (SUB_CC sz) src dst - AND sz src dst -> patch2 (AND sz) src dst - OR sz src dst -> patch2 (OR sz) src dst - XOR sz src dst -> patch2 (XOR sz) src dst - NOT sz op -> patch1 (NOT sz) op - BSWAP sz reg -> BSWAP sz (env reg) - 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 - BT sz imm src -> patch1 (BT sz imm) src - 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 - POP sz op -> patch1 (POP sz) op - SETCC cond op -> patch1 (SETCC cond) op - JMP op regs -> JMP (patchOp op) regs - JMP_TBL op ids s lbl-> JMP_TBL (patchOp op) ids s lbl - - GMOV src dst -> GMOV (env src) (env dst) - GLD sz src dst -> GLD sz (lookupAddr src) (env dst) - GST sz src dst -> GST sz (env src) (lookupAddr dst) + MOV fmt src dst -> patch2 (MOV fmt) src dst + CMOV cc fmt src dst -> CMOV cc fmt (patchOp src) (env dst) + MOVZxL fmt src dst -> patch2 (MOVZxL fmt) src dst + MOVSxL fmt src dst -> patch2 (MOVSxL fmt) src dst + LEA fmt src dst -> patch2 (LEA fmt) src dst + ADD fmt src dst -> patch2 (ADD fmt) src dst + ADC fmt src dst -> patch2 (ADC fmt) src dst + SUB fmt src dst -> patch2 (SUB fmt) src dst + SBB fmt src dst -> patch2 (SBB fmt) src dst + IMUL fmt src dst -> patch2 (IMUL fmt) src dst + IMUL2 fmt src -> patch1 (IMUL2 fmt) src + MUL fmt src dst -> patch2 (MUL fmt) src dst + MUL2 fmt src -> patch1 (MUL2 fmt) src + IDIV fmt op -> patch1 (IDIV fmt) op + DIV fmt op -> patch1 (DIV fmt) op + ADD_CC fmt src dst -> patch2 (ADD_CC fmt) src dst + SUB_CC fmt src dst -> patch2 (SUB_CC fmt) src dst + AND fmt src dst -> patch2 (AND fmt) src dst + OR fmt src dst -> patch2 (OR fmt) src dst + XOR fmt src dst -> patch2 (XOR fmt) src dst + NOT fmt op -> patch1 (NOT fmt) op + BSWAP fmt reg -> BSWAP fmt (env reg) + NEGI fmt op -> patch1 (NEGI fmt) op + SHL fmt imm dst -> patch1 (SHL fmt imm) dst + SAR fmt imm dst -> patch1 (SAR fmt imm) dst + SHR fmt imm dst -> patch1 (SHR fmt imm) dst + BT fmt imm src -> patch1 (BT fmt imm) src + TEST fmt src dst -> patch2 (TEST fmt) src dst + CMP fmt src dst -> patch2 (CMP fmt) src dst + PUSH fmt op -> patch1 (PUSH fmt) op + POP fmt op -> patch1 (POP fmt) op + SETCC cond op -> patch1 (SETCC cond) op + JMP op regs -> JMP (patchOp op) regs + JMP_TBL op ids s lbl -> JMP_TBL (patchOp op) ids s lbl + + GMOV src dst -> GMOV (env src) (env dst) + GLD fmt src dst -> GLD fmt (lookupAddr src) (env dst) + GST fmt src dst -> GST fmt (env src) (lookupAddr dst) GLDZ dst -> GLDZ (env dst) GLD1 dst -> GLD1 (env dst) @@ -591,26 +591,26 @@ x86_patchRegsOfInstr instr env GDTOF src dst -> GDTOF (env src) (env dst) - GADD sz s1 s2 dst -> GADD sz (env s1) (env s2) (env dst) - GSUB sz s1 s2 dst -> GSUB sz (env s1) (env s2) (env dst) - GMUL sz s1 s2 dst -> GMUL sz (env s1) (env s2) (env dst) - GDIV sz s1 s2 dst -> GDIV sz (env s1) (env s2) (env dst) + GADD fmt s1 s2 dst -> GADD fmt (env s1) (env s2) (env dst) + GSUB fmt s1 s2 dst -> GSUB fmt (env s1) (env s2) (env dst) + GMUL fmt s1 s2 dst -> GMUL fmt (env s1) (env s2) (env dst) + GDIV fmt s1 s2 dst -> GDIV fmt (env s1) (env s2) (env dst) - GCMP sz src1 src2 -> GCMP sz (env src1) (env src2) - GABS sz src dst -> GABS sz (env src) (env dst) - GNEG sz src dst -> GNEG sz (env src) (env dst) - GSQRT sz src dst -> GSQRT sz (env src) (env dst) - GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst) - GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst) - GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst) + GCMP fmt src1 src2 -> GCMP fmt (env src1) (env src2) + GABS fmt src dst -> GABS fmt (env src) (env dst) + GNEG fmt src dst -> GNEG fmt (env src) (env dst) + GSQRT fmt src dst -> GSQRT fmt (env src) (env dst) + GSIN fmt l1 l2 src dst -> GSIN fmt l1 l2 (env src) (env dst) + GCOS fmt l1 l2 src dst -> GCOS fmt l1 l2 (env src) (env dst) + GTAN fmt l1 l2 src dst -> GTAN fmt l1 l2 (env src) (env dst) CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) - CVTTSS2SIQ sz src dst -> CVTTSS2SIQ sz (patchOp src) (env dst) - CVTTSD2SIQ sz src dst -> CVTTSD2SIQ sz (patchOp src) (env dst) - CVTSI2SS sz src dst -> CVTSI2SS sz (patchOp src) (env dst) - CVTSI2SD sz src dst -> CVTSI2SD sz (patchOp src) (env dst) - FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) + CVTTSS2SIQ fmt src dst -> CVTTSS2SIQ fmt (patchOp src) (env dst) + CVTTSD2SIQ fmt src dst -> CVTTSD2SIQ fmt (patchOp src) (env dst) + CVTSI2SS fmt src dst -> CVTSI2SS fmt (patchOp src) (env dst) + CVTSI2SD fmt src dst -> CVTSI2SD fmt (patchOp src) (env dst) + FDIV fmt src dst -> FDIV fmt (patchOp src) (patchOp dst) CALL (Left _) _ -> instr CALL (Right reg) p -> CALL (Right (env reg)) p @@ -627,16 +627,16 @@ x86_patchRegsOfInstr instr env JXX_GBL _ _ -> instr CLTD _ -> instr - POPCNT sz src dst -> POPCNT sz (patchOp src) (env dst) - BSF sz src dst -> BSF sz (patchOp src) (env dst) - BSR sz src dst -> BSR sz (patchOp src) (env dst) + POPCNT fmt src dst -> POPCNT fmt (patchOp src) (env dst) + BSF fmt src dst -> BSF fmt (patchOp src) (env dst) + BSR fmt src dst -> BSR fmt (patchOp src) (env dst) - PREFETCH lvl size src -> PREFETCH lvl size (patchOp src) + PREFETCH lvl format src -> PREFETCH lvl format (patchOp src) - LOCK i -> LOCK (x86_patchRegsOfInstr i env) - XADD sz src dst -> patch2 (XADD sz) src dst - CMPXCHG sz src dst -> patch2 (CMPXCHG sz) src dst - MFENCE -> instr + LOCK i -> LOCK (x86_patchRegsOfInstr i env) + XADD fmt src dst -> patch2 (XADD fmt) src dst + CMPXCHG fmt src dst -> patch2 (CMPXCHG fmt) src dst + MFENCE -> instr _other -> panic "patchRegs: unrecognised instr" @@ -713,7 +713,7 @@ x86_mkSpillInstr dflags reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of - RcInteger -> MOV (archWordSize is32Bit) + RcInteger -> MOV (archWordFormat is32Bit) (OpReg reg) (OpAddr (spRel dflags off)) RcDouble -> GST FF80 reg (spRel dflags off) {- RcFloat/RcDouble -} RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel dflags off)) @@ -733,7 +733,7 @@ x86_mkLoadInstr dflags reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of - RcInteger -> MOV (archWordSize is32Bit) + RcInteger -> MOV (archWordFormat is32Bit) (OpAddr (spRel dflags off)) (OpReg reg) RcDouble -> GLD FF80 (spRel dflags off) reg {- RcFloat/RcDouble -} RcDoubleSSE -> MOV FF64 (OpAddr (spRel dflags off)) (OpReg reg) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 7022e59647..ce63caed6b 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -15,7 +15,7 @@ module X86.Ppr ( pprSectionHeader, pprData, pprInstr, - pprSize, + pprFormat, pprImm, pprDataItem, ) @@ -29,7 +29,7 @@ import X86.Regs import X86.Instr import X86.Cond import Instruction -import Size +import Format import Reg import PprBase @@ -186,13 +186,13 @@ instance Outputable Instr where ppr instr = pprInstr instr -pprReg :: Size -> Reg -> SDoc -pprReg s r +pprReg :: Format -> Reg -> SDoc +pprReg f r = case r of RegReal (RealRegSingle i) -> sdocWithPlatform $ \platform -> - if target32Bit platform then ppr32_reg_no s i - else ppr64_reg_no s i + if target32Bit platform then ppr32_reg_no f i + else ppr64_reg_no f i RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch" RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUnique u RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUnique u @@ -200,7 +200,7 @@ pprReg s r RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUnique u RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUnique u where - ppr32_reg_no :: Size -> Int -> SDoc + ppr32_reg_no :: Format -> Int -> SDoc ppr32_reg_no II8 = ppr32_reg_byte ppr32_reg_no II16 = ppr32_reg_word ppr32_reg_no _ = ppr32_reg_long @@ -230,7 +230,7 @@ pprReg s r _ -> ppr_reg_float i }) - ppr64_reg_no :: Size -> Int -> SDoc + ppr64_reg_no :: Format -> Int -> SDoc ppr64_reg_no II8 = ppr64_reg_byte ppr64_reg_no II16 = ppr64_reg_word ppr64_reg_no II32 = ppr64_reg_long @@ -303,8 +303,8 @@ ppr_reg_float i = case i of 38 -> sLit "%xmm14"; 39 -> sLit "%xmm15" _ -> sLit "very naughty x86 register" -pprSize :: Size -> SDoc -pprSize x +pprFormat :: Format -> SDoc +pprFormat x = ptext (case x of II8 -> sLit "b" II16 -> sLit "w" @@ -315,13 +315,13 @@ pprSize x FF80 -> sLit "t" ) -pprSize_x87 :: Size -> SDoc -pprSize_x87 x +pprFormat_x87 :: Format -> SDoc +pprFormat_x87 x = ptext $ case x of FF32 -> sLit "s" FF64 -> sLit "l" FF80 -> sLit "t" - _ -> panic "X86.Ppr.pprSize_x87" + _ -> panic "X86.Ppr.pprFormat_x87" pprCond :: Cond -> SDoc pprCond c @@ -369,7 +369,7 @@ pprAddr (AddrBaseIndex base index displacement) let pp_disp = ppr_disp displacement pp_off p = pp_disp <> char '(' <> p <> char ')' - pp_reg r = pprReg (archWordSize (target32Bit platform)) r + pp_reg r = pprReg (archWordFormat (target32Bit platform)) r in case (base, index) of (EABaseNone, EAIndexNone) -> pp_disp @@ -440,7 +440,7 @@ pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit pprDataItem' :: DynFlags -> CmmLit -> SDoc pprDataItem' dflags lit - = vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit) + = vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit) where platform = targetPlatform dflags imm = litToImm lit @@ -539,62 +539,63 @@ pprInstr (RELOAD slot reg) -- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper. -- The code generator catches most of these already, but not all. -pprInstr (MOV size (OpImm (ImmInt 0)) dst@(OpReg _)) - = pprInstr (XOR size' dst dst) - where size' = case size of +pprInstr (MOV format (OpImm (ImmInt 0)) dst@(OpReg _)) + = pprInstr (XOR format' dst dst) + where format' = case format of II64 -> II32 -- 32-bit version is equivalent, and smaller - _ -> size -pprInstr (MOV size src dst) - = pprSizeOpOp (sLit "mov") size src dst + _ -> format +pprInstr (MOV format src dst) + = pprFormatOpOp (sLit "mov") format src dst -pprInstr (CMOV cc size src dst) - = pprCondOpReg (sLit "cmov") size cc src dst +pprInstr (CMOV cc format src dst) + = pprCondOpReg (sLit "cmov") format cc src dst -pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst +pprInstr (MOVZxL II32 src dst) = pprFormatOpOp (sLit "mov") II32 src dst -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple -- movl. But we represent it as a MOVZxL instruction, because -- the reg alloc would tend to throw away a plain reg-to-reg -- move, and we still want it to do that. -pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst +pprInstr (MOVZxL formats src dst) + = pprFormatOpOpCoerce (sLit "movz") formats II32 src dst -- zero-extension only needs to extend to 32 bits: on x86_64, -- the remaining zero-extension to 64 bits is automatic, and the 32-bit -- instruction is shorter. -pprInstr (MOVSxL sizes src dst) +pprInstr (MOVSxL formats src dst) = sdocWithPlatform $ \platform -> - pprSizeOpOpCoerce (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst + pprFormatOpOpCoerce (sLit "movs") formats (archWordFormat (target32Bit platform)) src dst -- here we do some patching, since the physical registers are only set late -- in the code generation. -pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) | reg1 == reg3 - = pprSizeOpOp (sLit "add") size (OpReg reg2) dst + = pprFormatOpOp (sLit "add") format (OpReg reg2) dst -pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) | reg2 == reg3 - = pprSizeOpOp (sLit "add") size (OpReg reg1) dst + = pprFormatOpOp (sLit "add") format (OpReg reg1) dst -pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3)) +pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3)) | reg1 == reg3 - = pprInstr (ADD size (OpImm displ) dst) + = pprInstr (ADD format (OpImm displ) dst) -pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst +pprInstr (LEA format src dst) = pprFormatOpOp (sLit "lea") format src dst -pprInstr (ADD size (OpImm (ImmInt (-1))) dst) - = pprSizeOp (sLit "dec") size dst -pprInstr (ADD size (OpImm (ImmInt 1)) dst) - = pprSizeOp (sLit "inc") size dst -pprInstr (ADD size src dst) = pprSizeOpOp (sLit "add") size src dst -pprInstr (ADC size src dst) = pprSizeOpOp (sLit "adc") size src dst -pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst -pprInstr (SBB size src dst) = pprSizeOpOp (sLit "sbb") size src dst -pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2 +pprInstr (ADD format (OpImm (ImmInt (-1))) dst) + = pprFormatOp (sLit "dec") format dst +pprInstr (ADD format (OpImm (ImmInt 1)) dst) + = pprFormatOp (sLit "inc") format dst +pprInstr (ADD format src dst) = pprFormatOpOp (sLit "add") format src dst +pprInstr (ADC format src dst) = pprFormatOpOp (sLit "adc") format src dst +pprInstr (SUB format src dst) = pprFormatOpOp (sLit "sub") format src dst +pprInstr (SBB format src dst) = pprFormatOpOp (sLit "sbb") format src dst +pprInstr (IMUL format op1 op2) = pprFormatOpOp (sLit "imul") format op1 op2 -pprInstr (ADD_CC size src dst) - = pprSizeOpOp (sLit "add") size src dst -pprInstr (SUB_CC size src dst) - = pprSizeOpOp (sLit "sub") size src dst +pprInstr (ADD_CC format src dst) + = pprFormatOpOp (sLit "add") format src dst +pprInstr (SUB_CC format src dst) + = pprFormatOpOp (sLit "sub") format src dst {- A hack. The Intel documentation says that "The two and three operand forms [of IMUL] may also be used with unsigned operands @@ -611,44 +612,38 @@ pprInstr (SUB_CC size src dst) pprInstr (AND II64 src@(OpImm (ImmInteger mask)) dst) | 0 <= mask && mask < 0xffffffff = pprInstr (AND II32 src dst) -pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst -pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst +pprInstr (AND format src dst) = pprFormatOpOp (sLit "and") format src dst +pprInstr (OR format src dst) = pprFormatOpOp (sLit "or") format src dst pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst -pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst +pprInstr (XOR format src dst) = pprFormatOpOp (sLit "xor") format src dst -pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst) -pprInstr (BSF size src dst) = pprOpOp (sLit "bsf") size src (OpReg dst) -pprInstr (BSR size src dst) = pprOpOp (sLit "bsr") size src (OpReg dst) +pprInstr (POPCNT format src dst) = pprOpOp (sLit "popcnt") format src (OpReg dst) +pprInstr (BSF format src dst) = pprOpOp (sLit "bsf") format src (OpReg dst) +pprInstr (BSR format src dst) = pprOpOp (sLit "bsr") format src (OpReg dst) -pprInstr (PREFETCH NTA size src ) = pprSizeOp_ (sLit "prefetchnta") size src -pprInstr (PREFETCH Lvl0 size src) = pprSizeOp_ (sLit "prefetcht0") size src -pprInstr (PREFETCH Lvl1 size src) = pprSizeOp_ (sLit "prefetcht1") size src -pprInstr (PREFETCH Lvl2 size src) = pprSizeOp_ (sLit "prefetcht2") size src +pprInstr (PREFETCH NTA format src ) = pprFormatOp_ (sLit "prefetchnta") format src +pprInstr (PREFETCH Lvl0 format src) = pprFormatOp_ (sLit "prefetcht0") format src +pprInstr (PREFETCH Lvl1 format src) = pprFormatOp_ (sLit "prefetcht1") format src +pprInstr (PREFETCH Lvl2 format src) = pprFormatOp_ (sLit "prefetcht2") format src -pprInstr (NOT size op) = pprSizeOp (sLit "not") size op -pprInstr (BSWAP size op) = pprSizeOp (sLit "bswap") size (OpReg op) -pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op +pprInstr (NOT format op) = pprFormatOp (sLit "not") format op +pprInstr (BSWAP format op) = pprFormatOp (sLit "bswap") format (OpReg op) +pprInstr (NEGI format op) = pprFormatOp (sLit "neg") format op -pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst -pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst -pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst +pprInstr (SHL format src dst) = pprShift (sLit "shl") format src dst +pprInstr (SAR format src dst) = pprShift (sLit "sar") format src dst +pprInstr (SHR format src dst) = pprShift (sLit "shr") format src dst -pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src +pprInstr (BT format imm src) = pprFormatImmOp (sLit "bt") format imm src -pprInstr (CMP size src dst) - | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2 - | otherwise = pprSizeOpOp (sLit "cmp") size src dst - where - -- This predicate is needed here and nowhere else - is_float FF32 = True - is_float FF64 = True - is_float FF80 = True - is_float _ = False - -pprInstr (TEST size src dst) = sdocWithPlatform $ \platform -> - let size' = case (src,dst) of +pprInstr (CMP format src dst) + | isFloatFormat format = pprFormatOpOp (sLit "ucomi") format src dst -- SSE2 + | otherwise = pprFormatOpOp (sLit "cmp") format src dst + +pprInstr (TEST format src dst) = sdocWithPlatform $ \platform -> + let format' = case (src,dst) of -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'. -- We can replace them by equivalent, but smaller instructions -- by reducing the size of the immediate operand as far as possible. @@ -657,17 +652,17 @@ pprInstr (TEST size src dst) = sdocWithPlatform $ \platform -> -- and tag checks are by far the most common case.) (OpImm (ImmInteger mask), OpReg dstReg) | 0 <= mask && mask < 256 -> minSizeOfReg platform dstReg - _ -> size - in pprSizeOpOp (sLit "test") size' src dst + _ -> format + in pprFormatOpOp (sLit "test") format' src dst where minSizeOfReg platform (RegReal (RealRegSingle i)) | target32Bit platform && i <= 3 = II8 -- al, bl, cl, dl | target32Bit platform && i <= 7 = II16 -- si, di, bp, sp | not (target32Bit platform) && i <= 15 = II8 -- al .. r15b - minSizeOfReg _ _ = size -- other + minSizeOfReg _ _ = format -- other -pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op -pprInstr (POP size op) = pprSizeOp (sLit "pop") size op +pprInstr (PUSH format op) = pprFormatOp (sLit "push") format op +pprInstr (POP format op) = pprFormatOp (sLit "pop") format op -- both unused (SDM): -- pprInstr PUSHA = ptext (sLit "\tpushal") @@ -687,28 +682,30 @@ pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm) pprInstr (JMP (OpImm imm) _) = ptext (sLit "\tjmp ") <> pprImm imm pprInstr (JMP op _) = sdocWithPlatform $ \platform -> - ptext (sLit "\tjmp *") <> pprOperand (archWordSize (target32Bit platform)) op + ptext (sLit "\tjmp *") + <> pprOperand (archWordFormat (target32Bit platform)) op pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op []) pprInstr (CALL (Left imm) _) = ptext (sLit "\tcall ") <> pprImm imm pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform -> - ptext (sLit "\tcall *") <> pprReg (archWordSize (target32Bit platform)) reg + ptext (sLit "\tcall *") + <> pprReg (archWordFormat (target32Bit platform)) reg -pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op -pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op -pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op +pprInstr (IDIV fmt op) = pprFormatOp (sLit "idiv") fmt op +pprInstr (DIV fmt op) = pprFormatOp (sLit "div") fmt op +pprInstr (IMUL2 fmt op) = pprFormatOp (sLit "imul") fmt op -- x86_64 only -pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2 -pprInstr (MUL2 size op) = pprSizeOp (sLit "mul") size op +pprInstr (MUL format op1 op2) = pprFormatOpOp (sLit "mul") format op1 op2 +pprInstr (MUL2 format op) = pprFormatOp (sLit "mul") format op -pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2 +pprInstr (FDIV format op1 op2) = pprFormatOpOp (sLit "div") format op1 op2 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to -pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to -pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to -pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to -pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to +pprInstr (CVTTSS2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttss2si") FF32 fmt from to +pprInstr (CVTTSD2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttsd2si") FF64 fmt from to +pprInstr (CVTSI2SS fmt from to) = pprFormatOpReg (sLit "cvtsi2ss") fmt from to +pprInstr (CVTSI2SD fmt from to) = pprFormatOpReg (sLit "cvtsi2sd") fmt from to -- FETCHGOT for PIC on ELF platforms pprInstr (FETCHGOT reg) @@ -740,19 +737,19 @@ pprInstr g@(GMOV src dst) | otherwise = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1]) --- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1) -pprInstr g@(GLD sz addr dst) - = pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp, +-- GLD fmt addr dst ==> FLDsz addr ; FSTP (dst+1) +pprInstr g@(GLD fmt addr dst) + = pprG g (hcat [gtab, text "fld", pprFormat_x87 fmt, gsp, pprAddr addr, gsemi, gpop dst 1]) --- GST sz src addr ==> FLD dst ; FSTPsz addr -pprInstr g@(GST sz src addr) - | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist +-- GST fmt src addr ==> FLD dst ; FSTPsz addr +pprInstr g@(GST fmt src addr) + | src == fake0 && fmt /= FF80 -- fstt instruction doesn't exist = pprG g (hcat [gtab, - text "fst", pprSize_x87 sz, gsp, pprAddr addr]) + text "fst", pprFormat_x87 fmt, gsp, pprAddr addr]) | otherwise = pprG g (hcat [gtab, gpush src 0, gsemi, - text "fstp", pprSize_x87 sz, gsp, pprAddr addr]) + text "fstp", pprFormat_x87 fmt, gsp, pprAddr addr]) pprInstr g@(GLDZ dst) = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1]) @@ -865,18 +862,18 @@ pprInstr g@(GABS _ src dst) pprInstr g@(GNEG _ src dst) = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1]) -pprInstr g@(GSQRT sz src dst) +pprInstr g@(GSQRT fmt src dst) = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ - hcat [gtab, gcoerceto sz, gpop dst 1]) + hcat [gtab, gcoerceto fmt, gpop dst 1]) -pprInstr g@(GSIN sz l1 l2 src dst) - = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz) +pprInstr g@(GSIN fmt l1 l2 src dst) + = pprG g (pprTrigOp "fsin" False l1 l2 src dst fmt) -pprInstr g@(GCOS sz l1 l2 src dst) - = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz) +pprInstr g@(GCOS fmt l1 l2 src dst) + = pprG g (pprTrigOp "fcos" False l1 l2 src dst fmt) -pprInstr g@(GTAN sz l1 l2 src dst) - = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz) +pprInstr g@(GTAN fmt l1 l2 src dst) + = pprG g (pprTrigOp "fptan" True l1 l2 src dst fmt) -- In the translations for GADD, GMUL, GSUB and GDIV, -- the first two cases are mere optimisations. The otherwise clause @@ -953,20 +950,21 @@ pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i pprInstr MFENCE = ptext (sLit "\tmfence") -pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst +pprInstr (XADD format src dst) = pprFormatOpOp (sLit "xadd") format src dst -pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst +pprInstr (CMPXCHG format src dst) + = pprFormatOpOp (sLit "cmpxchg") format src dst pprInstr _ = panic "X86.Ppr.pprInstr: no match" pprTrigOp :: String -> Bool -> CLabel -> CLabel - -> Reg -> Reg -> Size -> SDoc + -> Reg -> Reg -> Format -> SDoc pprTrigOp op -- fsin, fcos or fptan isTan -- we need a couple of extra steps if we're doing tan l1 l2 -- internal labels for us to use - src dst sz + src dst fmt = -- We'll be needing %eax later on hcat [gtab, text "pushl %eax;"] $$ -- tan is going to use an extra space on the FP stack @@ -1002,12 +1000,12 @@ pprTrigOp op -- fsin, fcos or fptan -- Restore %eax hcat [gtab, text "popl %eax;"] $$ -- And finally make the result the right size - hcat [gtab, gcoerceto sz, gpop dst 1] + hcat [gtab, gcoerceto fmt, gpop dst 1] -------------------------- -- coerce %st(0) to the specified size -gcoerceto :: Size -> SDoc +gcoerceto :: Format -> SDoc gcoerceto FF64 = empty gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; " gcoerceto _ = panic "X86.Ppr.gcoerceto: no match" @@ -1043,32 +1041,32 @@ pprG fake actual pprGInstr :: Instr -> SDoc -pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst -pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst -pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst +pprGInstr (GMOV src dst) = pprFormatRegReg (sLit "gmov") FF64 src dst +pprGInstr (GLD fmt src dst) = pprFormatAddrReg (sLit "gld") fmt src dst +pprGInstr (GST fmt src dst) = pprFormatRegAddr (sLit "gst") fmt src dst -pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst -pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst +pprGInstr (GLDZ dst) = pprFormatReg (sLit "gldz") FF64 dst +pprGInstr (GLD1 dst) = pprFormatReg (sLit "gld1") FF64 dst -pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst -pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst +pprGInstr (GFTOI src dst) = pprFormatFormatRegReg (sLit "gftoi") FF32 II32 src dst +pprGInstr (GDTOI src dst) = pprFormatFormatRegReg (sLit "gdtoi") FF64 II32 src dst -pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst -pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst -pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst +pprGInstr (GITOF src dst) = pprFormatFormatRegReg (sLit "gitof") II32 FF32 src dst +pprGInstr (GITOD src dst) = pprFormatFormatRegReg (sLit "gitod") II32 FF64 src dst +pprGInstr (GDTOF src dst) = pprFormatFormatRegReg (sLit "gdtof") FF64 FF32 src dst pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst -pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst -pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst -pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst -pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst -pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst -pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst - -pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst -pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst -pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst -pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst +pprGInstr (GABS fmt src dst) = pprFormatRegReg (sLit "gabs") fmt src dst +pprGInstr (GNEG fmt src dst) = pprFormatRegReg (sLit "gneg") fmt src dst +pprGInstr (GSQRT fmt src dst) = pprFormatRegReg (sLit "gsqrt") fmt src dst +pprGInstr (GSIN fmt _ _ src dst) = pprFormatRegReg (sLit "gsin") fmt src dst +pprGInstr (GCOS fmt _ _ src dst) = pprFormatRegReg (sLit "gcos") fmt src dst +pprGInstr (GTAN fmt _ _ src dst) = pprFormatRegReg (sLit "gtan") fmt src dst + +pprGInstr (GADD fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gadd") fmt src1 src2 dst +pprGInstr (GSUB fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gsub") fmt src1 src2 dst +pprGInstr (GMUL fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gmul") fmt src1 src2 dst +pprGInstr (GDIV fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gdiv") fmt src1 src2 dst pprGInstr _ = panic "X86.Ppr.pprGInstr: no match" @@ -1076,8 +1074,8 @@ pprDollImm :: Imm -> SDoc pprDollImm i = ptext (sLit "$") <> pprImm i -pprOperand :: Size -> Operand -> SDoc -pprOperand s (OpReg r) = pprReg s r +pprOperand :: Format -> Operand -> SDoc +pprOperand f (OpReg r) = pprReg f r pprOperand _ (OpImm i) = pprDollImm i pprOperand _ (OpAddr ea) = pprAddr ea @@ -1087,72 +1085,72 @@ pprMnemonic_ name = char '\t' <> ptext name <> space -pprMnemonic :: LitString -> Size -> SDoc -pprMnemonic name size = - char '\t' <> ptext name <> pprSize size <> space +pprMnemonic :: LitString -> Format -> SDoc +pprMnemonic name format = + char '\t' <> ptext name <> pprFormat format <> space -pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> SDoc -pprSizeImmOp name size imm op1 +pprFormatImmOp :: LitString -> Format -> Imm -> Operand -> SDoc +pprFormatImmOp name format imm op1 = hcat [ - pprMnemonic name size, + pprMnemonic name format, char '$', pprImm imm, comma, - pprOperand size op1 + pprOperand format op1 ] -pprSizeOp_ :: LitString -> Size -> Operand -> SDoc -pprSizeOp_ name size op1 +pprFormatOp_ :: LitString -> Format -> Operand -> SDoc +pprFormatOp_ name format op1 = hcat [ pprMnemonic_ name , - pprOperand size op1 + pprOperand format op1 ] -pprSizeOp :: LitString -> Size -> Operand -> SDoc -pprSizeOp name size op1 +pprFormatOp :: LitString -> Format -> Operand -> SDoc +pprFormatOp name format op1 = hcat [ - pprMnemonic name size, - pprOperand size op1 + pprMnemonic name format, + pprOperand format op1 ] -pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> SDoc -pprSizeOpOp name size op1 op2 +pprFormatOpOp :: LitString -> Format -> Operand -> Operand -> SDoc +pprFormatOpOp name format op1 op2 = hcat [ - pprMnemonic name size, - pprOperand size op1, + pprMnemonic name format, + pprOperand format op1, comma, - pprOperand size op2 + pprOperand format op2 ] -pprOpOp :: LitString -> Size -> Operand -> Operand -> SDoc -pprOpOp name size op1 op2 +pprOpOp :: LitString -> Format -> Operand -> Operand -> SDoc +pprOpOp name format op1 op2 = hcat [ pprMnemonic_ name, - pprOperand size op1, + pprOperand format op1, comma, - pprOperand size op2 + pprOperand format op2 ] -pprSizeReg :: LitString -> Size -> Reg -> SDoc -pprSizeReg name size reg1 +pprFormatReg :: LitString -> Format -> Reg -> SDoc +pprFormatReg name format reg1 = hcat [ - pprMnemonic name size, - pprReg size reg1 + pprMnemonic name format, + pprReg format reg1 ] -pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc -pprSizeRegReg name size reg1 reg2 +pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc +pprFormatRegReg name format reg1 reg2 = hcat [ - pprMnemonic name size, - pprReg size reg1, + pprMnemonic name format, + pprReg format reg1, comma, - pprReg size reg2 + pprReg format reg2 ] @@ -1161,116 +1159,116 @@ pprRegReg name reg1 reg2 = sdocWithPlatform $ \platform -> hcat [ pprMnemonic_ name, - pprReg (archWordSize (target32Bit platform)) reg1, + pprReg (archWordFormat (target32Bit platform)) reg1, comma, - pprReg (archWordSize (target32Bit platform)) reg2 + pprReg (archWordFormat (target32Bit platform)) reg2 ] -pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> SDoc -pprSizeOpReg name size op1 reg2 +pprFormatOpReg :: LitString -> Format -> Operand -> Reg -> SDoc +pprFormatOpReg name format op1 reg2 = sdocWithPlatform $ \platform -> hcat [ - pprMnemonic name size, - pprOperand size op1, + pprMnemonic name format, + pprOperand format op1, comma, - pprReg (archWordSize (target32Bit platform)) reg2 + pprReg (archWordFormat (target32Bit platform)) reg2 ] -pprCondOpReg :: LitString -> Size -> Cond -> Operand -> Reg -> SDoc -pprCondOpReg name size cond op1 reg2 +pprCondOpReg :: LitString -> Format -> Cond -> Operand -> Reg -> SDoc +pprCondOpReg name format cond op1 reg2 = hcat [ char '\t', ptext name, pprCond cond, space, - pprOperand size op1, + pprOperand format op1, comma, - pprReg size reg2 + pprReg format reg2 ] -pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc -pprCondRegReg name size cond reg1 reg2 +pprCondRegReg :: LitString -> Format -> Cond -> Reg -> Reg -> SDoc +pprCondRegReg name format cond reg1 reg2 = hcat [ char '\t', ptext name, pprCond cond, space, - pprReg size reg1, + pprReg format reg1, comma, - pprReg size reg2 + pprReg format reg2 ] -pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> SDoc -pprSizeSizeRegReg name size1 size2 reg1 reg2 +pprFormatFormatRegReg :: LitString -> Format -> Format -> Reg -> Reg -> SDoc +pprFormatFormatRegReg name format1 format2 reg1 reg2 = hcat [ char '\t', ptext name, - pprSize size1, - pprSize size2, + pprFormat format1, + pprFormat format2, space, - pprReg size1 reg1, + pprReg format1 reg1, comma, - pprReg size2 reg2 + pprReg format2 reg2 ] -pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> SDoc -pprSizeSizeOpReg name size1 size2 op1 reg2 +pprFormatFormatOpReg :: LitString -> Format -> Format -> Operand -> Reg -> SDoc +pprFormatFormatOpReg name format1 format2 op1 reg2 = hcat [ - pprMnemonic name size2, - pprOperand size1 op1, + pprMnemonic name format2, + pprOperand format1 op1, comma, - pprReg size2 reg2 + pprReg format2 reg2 ] -pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc -pprSizeRegRegReg name size reg1 reg2 reg3 +pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc +pprFormatRegRegReg name format reg1 reg2 reg3 = hcat [ - pprMnemonic name size, - pprReg size reg1, + pprMnemonic name format, + pprReg format reg1, comma, - pprReg size reg2, + pprReg format reg2, comma, - pprReg size reg3 + pprReg format reg3 ] -pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> SDoc -pprSizeAddrReg name size op dst +pprFormatAddrReg :: LitString -> Format -> AddrMode -> Reg -> SDoc +pprFormatAddrReg name format op dst = hcat [ - pprMnemonic name size, + pprMnemonic name format, pprAddr op, comma, - pprReg size dst + pprReg format dst ] -pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> SDoc -pprSizeRegAddr name size src op +pprFormatRegAddr :: LitString -> Format -> Reg -> AddrMode -> SDoc +pprFormatRegAddr name format src op = hcat [ - pprMnemonic name size, - pprReg size src, + pprMnemonic name format, + pprReg format src, comma, pprAddr op ] -pprShift :: LitString -> Size -> Operand -> Operand -> SDoc -pprShift name size src dest +pprShift :: LitString -> Format -> Operand -> Operand -> SDoc +pprShift name format src dest = hcat [ - pprMnemonic name size, + pprMnemonic name format, pprOperand II8 src, -- src is 8-bit sized comma, - pprOperand size dest + pprOperand format dest ] -pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> SDoc -pprSizeOpOpCoerce name size1 size2 op1 op2 - = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space, - pprOperand size1 op1, +pprFormatOpOpCoerce :: LitString -> Format -> Format -> Operand -> Operand -> SDoc +pprFormatOpOpCoerce name format1 format2 op1 op2 + = hcat [ char '\t', ptext name, pprFormat format1, pprFormat format2, space, + pprOperand format1 op1, comma, - pprOperand size2 op2 + pprOperand format2 op2 ] diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index 39535634d7..4dfe0350d4 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -9,7 +9,7 @@ where #include "nativeGen/NCG.h" #include "HsVersions.h" -import Size +import Format import Reg import Outputable @@ -20,9 +20,9 @@ import UniqFM import X86.Regs -mkVirtualReg :: Unique -> Size -> VirtualReg -mkVirtualReg u size - = case size of +mkVirtualReg :: Unique -> Format -> VirtualReg +mkVirtualReg u format + = case format of FF32 -> VirtualRegSSE u FF64 -> VirtualRegSSE u FF80 -> VirtualRegD u |