{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- | Formats on this architecture
--      A Format is a combination of width and class
--
--      TODO:   Signed vs unsigned?
--
--      TODO:   This module is currently shared by all architectures because
--              NCGMonad need to know about it to make a VReg. It would be better
--              to have architecture specific formats, and do the overloading
--              properly. eg SPARC doesn't care about FF80.
--
module GHC.CmmToAsm.Format (
    Format(.., IntegerFormat),
    ScalarFormat(..),
    intFormat,
    floatFormat,
    isIntFormat,
    isIntScalarFormat,
    intScalarFormat,
    isFloatFormat,
    vecFormat,
    isVecFormat,
    cmmTypeFormat,
    formatToWidth,
    scalarWidth,
    formatInBytes,
    isFloatScalarFormat,
    isFloatOrFloatVecFormat,
    floatScalarFormat,
    scalarFormatFormat,
    VirtualRegWithFormat(..),
    RegWithFormat(..),
    takeVirtualRegs,
    takeRealRegs,
)

where

import GHC.Prelude

import GHC.Cmm
import GHC.Platform.Reg ( Reg(..), RealReg, VirtualReg )
import GHC.Types.Unique ( Uniquable(..) )
import GHC.Types.Unique.Set
import GHC.Utils.Outputable
import GHC.Utils.Panic

{- Note [GHC's data format representations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has severals types that represent various aspects of data format.
These include:

 * 'CmmType.CmmType': The data classification used throughout the C--
   pipeline. This is a pair of a CmmCat and a Width.

 * 'CmmType.CmmCat': What the bits in a C-- value mean (e.g. a pointer, integer, or floating-point value)

 * 'CmmType.Width': The width of a C-- value.

 * 'CmmType.Length': The width (measured in number of scalars) of a vector value.

 * 'Format.Format': The data format representation used by much of the backend.

 * 'Format.ScalarFormat': The format of a 'Format.VecFormat'\'s scalar.

 * 'RegClass.RegClass': Whether a register is an integer or a floating point/vector register.
-}

-- It looks very like the old MachRep, but it's now of purely local
-- significance, here in the native code generator.  You can change it
-- without global consequences.
--
-- A major use is as an opcode qualifier; thus the opcode
--      mov.l a b
-- might be encoded
--      MOV II32 a b
-- where the Format field encodes the ".l" part.

-- 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 Format could usefully be replaced by Width

data Format
        = II8
        | II16
        | II32
        | II64
        | FF32
        | FF64
        | VecFormat !Length       -- ^ number of elements (always at least 2)
                    !ScalarFormat -- ^ format of each element
        deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord)

pattern IntegerFormat :: Format
pattern $mIntegerFormat :: forall {r}. Format -> ((# #) -> r) -> ((# #) -> r) -> r
IntegerFormat <- ( isIntegerFormat -> True )
{-# COMPLETE IntegerFormat, FF32, FF64, VecFormat #-}

isIntegerFormat :: Format -> Bool
isIntegerFormat :: Format -> Bool
isIntegerFormat = \case
  Format
II8  -> Bool
True
  Format
II16 -> Bool
True
  Format
II32 -> Bool
True
  Format
II64 -> Bool
True
  Format
_    -> Bool
False


instance Outputable Format where
  ppr :: Format -> SDoc
ppr Format
fmt = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Format -> String
forall a. Show a => a -> String
show Format
fmt)

data ScalarFormat
  = FmtInt8
  | FmtInt16
  | FmtInt32
  | FmtInt64
  | FmtFloat
  | FmtDouble
  deriving (Int -> ScalarFormat -> ShowS
[ScalarFormat] -> ShowS
ScalarFormat -> String
(Int -> ScalarFormat -> ShowS)
-> (ScalarFormat -> String)
-> ([ScalarFormat] -> ShowS)
-> Show ScalarFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarFormat -> ShowS
showsPrec :: Int -> ScalarFormat -> ShowS
$cshow :: ScalarFormat -> String
show :: ScalarFormat -> String
$cshowList :: [ScalarFormat] -> ShowS
showList :: [ScalarFormat] -> ShowS
Show, ScalarFormat -> ScalarFormat -> Bool
(ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool) -> Eq ScalarFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarFormat -> ScalarFormat -> Bool
== :: ScalarFormat -> ScalarFormat -> Bool
$c/= :: ScalarFormat -> ScalarFormat -> Bool
/= :: ScalarFormat -> ScalarFormat -> Bool
Eq, Eq ScalarFormat
Eq ScalarFormat =>
(ScalarFormat -> ScalarFormat -> Ordering)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> Bool)
-> (ScalarFormat -> ScalarFormat -> ScalarFormat)
-> (ScalarFormat -> ScalarFormat -> ScalarFormat)
-> Ord ScalarFormat
ScalarFormat -> ScalarFormat -> Bool
ScalarFormat -> ScalarFormat -> Ordering
ScalarFormat -> ScalarFormat -> ScalarFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScalarFormat -> ScalarFormat -> Ordering
compare :: ScalarFormat -> ScalarFormat -> Ordering
$c< :: ScalarFormat -> ScalarFormat -> Bool
< :: ScalarFormat -> ScalarFormat -> Bool
$c<= :: ScalarFormat -> ScalarFormat -> Bool
<= :: ScalarFormat -> ScalarFormat -> Bool
$c> :: ScalarFormat -> ScalarFormat -> Bool
> :: ScalarFormat -> ScalarFormat -> Bool
$c>= :: ScalarFormat -> ScalarFormat -> Bool
>= :: ScalarFormat -> ScalarFormat -> Bool
$cmax :: ScalarFormat -> ScalarFormat -> ScalarFormat
max :: ScalarFormat -> ScalarFormat -> ScalarFormat
$cmin :: ScalarFormat -> ScalarFormat -> ScalarFormat
min :: ScalarFormat -> ScalarFormat -> ScalarFormat
Ord)

scalarFormatFormat :: ScalarFormat -> Format
scalarFormatFormat :: ScalarFormat -> Format
scalarFormatFormat = \case
  ScalarFormat
FmtInt8 -> Format
II8
  ScalarFormat
FmtInt16 -> Format
II16
  ScalarFormat
FmtInt32 -> Format
II32
  ScalarFormat
FmtInt64 -> Format
II64
  ScalarFormat
FmtFloat -> Format
FF32
  ScalarFormat
FmtDouble -> Format
FF64

isFloatScalarFormat :: ScalarFormat -> Bool
isFloatScalarFormat :: ScalarFormat -> Bool
isFloatScalarFormat = \case
  ScalarFormat
FmtFloat -> Bool
True
  ScalarFormat
FmtDouble -> Bool
True
  ScalarFormat
_ -> Bool
False

isFloatOrFloatVecFormat :: Format -> Bool
isFloatOrFloatVecFormat :: Format -> Bool
isFloatOrFloatVecFormat = \case
  VecFormat Int
_ ScalarFormat
sFmt -> ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
  Format
fmt -> Format -> Bool
isFloatFormat Format
fmt

floatScalarFormat :: Width -> ScalarFormat
floatScalarFormat :: Width -> ScalarFormat
floatScalarFormat Width
W32 = ScalarFormat
FmtFloat
floatScalarFormat Width
W64 = ScalarFormat
FmtDouble
floatScalarFormat Width
w = String -> SDoc -> ScalarFormat
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"floatScalarFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

isIntScalarFormat :: ScalarFormat -> Bool
isIntScalarFormat :: ScalarFormat -> Bool
isIntScalarFormat = Bool -> Bool
not (Bool -> Bool) -> (ScalarFormat -> Bool) -> ScalarFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarFormat -> Bool
isFloatScalarFormat

intScalarFormat :: Width -> ScalarFormat
intScalarFormat :: Width -> ScalarFormat
intScalarFormat = \case
  Width
W8  -> ScalarFormat
FmtInt8
  Width
W16 -> ScalarFormat
FmtInt16
  Width
W32 -> ScalarFormat
FmtInt32
  Width
W64 -> ScalarFormat
FmtInt64
  Width
w   -> String -> SDoc -> ScalarFormat
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"intScalarFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

-- | Get the integer format of this width.
intFormat :: Width -> Format
intFormat :: Width -> Format
intFormat Width
width
 = case Width
width of
        Width
W8      -> Format
II8
        Width
W16     -> Format
II16
        Width
W32     -> Format
II32
        Width
W64     -> Format
II64
        Width
other   -> String -> Format
forall a. HasCallStack => String -> a
sorry (String -> Format) -> String -> Format
forall a b. (a -> b) -> a -> b
$ String
"The native code generator cannot " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String
"produce code for Format.intFormat " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
other
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\tConsider using the llvm backend with -fllvm"

-- | Check if a format represent an integer value.
isIntFormat :: Format -> Bool
isIntFormat :: Format -> Bool
isIntFormat Format
format =
  case Format
format of
    Format
II8  -> Bool
True
    Format
II16 -> Bool
True
    Format
II32 -> Bool
True
    Format
II64 -> Bool
True
    Format
_    -> Bool
False

-- | Get the float format of this width.
floatFormat :: Width -> Format
floatFormat :: Width -> Format
floatFormat Width
width
 = case Width
width of
        Width
W32     -> Format
FF32
        Width
W64     -> Format
FF64
        Width
other   -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Format.floatFormat" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
other)

-- | Check if a format represents a floating point value.
isFloatFormat :: Format -> Bool
isFloatFormat :: Format -> Bool
isFloatFormat Format
format
 = case Format
format of
        Format
FF32    -> Bool
True
        Format
FF64    -> Bool
True
        Format
_       -> Bool
False

vecFormat :: CmmType -> Format
vecFormat :: CmmType -> Format
vecFormat CmmType
ty =
  let l :: Int
l      = CmmType -> Int
vecLength CmmType
ty
      elemTy :: CmmType
elemTy = CmmType -> CmmType
vecElemType CmmType
ty
   in if CmmType -> Bool
isFloatType CmmType
elemTy
      then case CmmType -> Width
typeWidth CmmType
elemTy of
             Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
             Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble
             Width
_   -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Incorrect vector element width" (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
elemTy)
      else case CmmType -> Width
typeWidth CmmType
elemTy of
             Width
W8  -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8
             Width
W16 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16
             Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32
             Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64
             Width
_   -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Incorrect vector element width" (CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
elemTy)

-- | Check if a format represents a vector
isVecFormat :: Format -> Bool
isVecFormat :: Format -> Bool
isVecFormat (VecFormat {}) = Bool
True
isVecFormat Format
_              = Bool
False


-- | Convert a Cmm type to a Format.
cmmTypeFormat :: CmmType -> Format
cmmTypeFormat :: CmmType -> Format
cmmTypeFormat CmmType
ty
        | CmmType -> Bool
isFloatType CmmType
ty        = Width -> Format
floatFormat (CmmType -> Width
typeWidth CmmType
ty)
        | CmmType -> Bool
isVecType CmmType
ty          = CmmType -> Format
vecFormat CmmType
ty
        | Bool
otherwise             = Width -> Format
intFormat (CmmType -> Width
typeWidth CmmType
ty)


-- | Get the Width of a Format.
formatToWidth :: Format -> Width
formatToWidth :: Format -> Width
formatToWidth Format
format
 = case Format
format of
        Format
II8  -> Width
W8
        Format
II16 -> Width
W16
        Format
II32 -> Width
W32
        Format
II64 -> Width
W64
        Format
FF32 -> Width
W32
        Format
FF64 -> Width
W64
        VecFormat Int
l ScalarFormat
s ->
          Int -> Width
widthFromBytes (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBytes (ScalarFormat -> Width
scalarWidth ScalarFormat
s))

scalarWidth :: ScalarFormat -> Width
scalarWidth :: ScalarFormat -> Width
scalarWidth = \case
  ScalarFormat
FmtInt8   -> Width
W8
  ScalarFormat
FmtInt16  -> Width
W16
  ScalarFormat
FmtInt32  -> Width
W32
  ScalarFormat
FmtInt64  -> Width
W64
  ScalarFormat
FmtFloat  -> Width
W32
  ScalarFormat
FmtDouble -> Width
W64

formatInBytes :: Format -> Int
formatInBytes :: Format -> Int
formatInBytes = Width -> Int
widthInBytes (Width -> Int) -> (Format -> Width) -> Format -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Width
formatToWidth

--------------------------------------------------------------------------------

-- | A typed virtual register: a virtual register, together with the specific
-- format we are using it at.
data VirtualRegWithFormat
    = VirtualRegWithFormat
    { VirtualRegWithFormat -> VirtualReg
virtualRegWithFormat_reg :: {-# UNPACK #-} !VirtualReg
    , VirtualRegWithFormat -> Format
virtualRegWithFormat_format :: !Format
    }

-- | A typed register: a register, together with the specific format we
-- are using it at.
data RegWithFormat
    = RegWithFormat
    { RegWithFormat -> Reg
regWithFormat_reg :: {-# UNPACK #-} !Reg
    , RegWithFormat -> Format
regWithFormat_format :: !Format
    }

instance Show RegWithFormat where
  show :: RegWithFormat -> String
show (RegWithFormat Reg
reg Format
fmt) = Reg -> String
forall a. Show a => a -> String
show Reg
reg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
fmt

instance Uniquable RegWithFormat where
  getUnique :: RegWithFormat -> Unique
getUnique = Reg -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Reg -> Unique)
-> (RegWithFormat -> Reg) -> RegWithFormat -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg

instance Outputable VirtualRegWithFormat where
  ppr :: VirtualRegWithFormat -> SDoc
ppr (VirtualRegWithFormat VirtualReg
reg Format
fmt) = VirtualReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr VirtualReg
reg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt

instance Outputable RegWithFormat where
  ppr :: RegWithFormat -> SDoc
ppr (RegWithFormat Reg
reg Format
fmt) = Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt

-- | Take all the virtual registers from this set.
takeVirtualRegs :: UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs :: UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs = (RegWithFormat -> Maybe VirtualReg)
-> UniqSet RegWithFormat -> UniqSet VirtualReg
forall a b. (a -> Maybe b) -> UniqSet a -> UniqSet b
mapMaybeUniqSet_sameUnique ((RegWithFormat -> Maybe VirtualReg)
 -> UniqSet RegWithFormat -> UniqSet VirtualReg)
-> (RegWithFormat -> Maybe VirtualReg)
-> UniqSet RegWithFormat
-> UniqSet VirtualReg
forall a b. (a -> b) -> a -> b
$
  \ case { RegWithFormat { regWithFormat_reg :: RegWithFormat -> Reg
regWithFormat_reg = RegVirtual VirtualReg
vr } -> VirtualReg -> Maybe VirtualReg
forall a. a -> Maybe a
Just VirtualReg
vr; RegWithFormat
_ -> Maybe VirtualReg
forall a. Maybe a
Nothing }
  -- See Note [Unique Determinism and code generation]

-- | Take all the real registers from this set.
takeRealRegs :: UniqSet RegWithFormat -> UniqSet RealReg
takeRealRegs :: UniqSet RegWithFormat -> UniqSet RealReg
takeRealRegs = (RegWithFormat -> Maybe RealReg)
-> UniqSet RegWithFormat -> UniqSet RealReg
forall a b. (a -> Maybe b) -> UniqSet a -> UniqSet b
mapMaybeUniqSet_sameUnique ((RegWithFormat -> Maybe RealReg)
 -> UniqSet RegWithFormat -> UniqSet RealReg)
-> (RegWithFormat -> Maybe RealReg)
-> UniqSet RegWithFormat
-> UniqSet RealReg
forall a b. (a -> b) -> a -> b
$
  \ case { RegWithFormat { regWithFormat_reg :: RegWithFormat -> Reg
regWithFormat_reg = RegReal RealReg
rr } -> RealReg -> Maybe RealReg
forall a. a -> Maybe a
Just RealReg
rr; RegWithFormat
_ -> Maybe RealReg
forall a. Maybe a
Nothing }
  -- See Note [Unique Determinism and code generation]