Commit 31580e2c authored by markus's avatar markus Committed by Ben Gamari

Fix todo in compiler/nativeGen: Rename Size to Format

This commit renames the Size module in the native code generator to
Format, as proposed by a todo, as well as adjusting parameter names in
other modules that use it.

Test Plan: validate

Reviewers: austin, simonmar, bgamari

Reviewed By: simonmar, bgamari

Subscribers: bgamari, simonmar, thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D865
parent f753cf11
......@@ -506,7 +506,7 @@ Library
TargetReg
NCGMonad
Instruction
Size
Format
Reg
RegClass
PIC
......
-- | 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
......@@ -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
......
This diff is collapsed.
......@@ -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
......
......@@ -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 =
......
......@@ -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"
......
......@@ -36,7 +36,7 @@ import SPARC.AddrMode
import SPARC.Regs
import SPARC.Stack
import Instruction
import Size
import Format
import NCGMonad