module SPARC.Imm (
        -- immediate values
        Imm(..),
        strImmLit,
        litToImm
)

where

import GhcPrelude

import Cmm
import CLabel

import Outputable

-- | An immediate value.
--      Not all of these are directly representable by the machine.
--      Things like ImmLit are slurped out and put in a data segment instead.
--
data Imm
        = ImmInt        Int

        -- Sigh.
        | ImmInteger    Integer

        -- AbstractC Label (with baggage)
        | ImmCLbl       CLabel

        -- Simple string
        | ImmLit        SDoc
        | ImmIndex      CLabel Int
        | ImmFloat      Rational
        | ImmDouble     Rational

        | ImmConstantSum  Imm Imm
        | ImmConstantDiff Imm Imm

        | LO    Imm
        | HI    Imm


-- | Create a ImmLit containing this string.
strImmLit :: String -> Imm
strImmLit :: String -> Imm
strImmLit s :: String
s = SDoc -> Imm
ImmLit (String -> SDoc
text String
s)


-- | Convert a CmmLit to an Imm.
--      Narrow to the width: a CmmInt might be out of
--      range, but we assume that ImmInteger only contains
--      in-range values.  A signed value should be fine here.
--
litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm lit :: CmmLit
lit
 = case CmmLit
lit of
        CmmInt i :: Integer
i w :: Width
w              -> Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowS Width
w Integer
i)
        CmmFloat f :: Rational
f W32          -> Rational -> Imm
ImmFloat Rational
f
        CmmFloat f :: Rational
f W64          -> Rational -> Imm
ImmDouble Rational
f
        CmmLabel l :: CLabel
l              -> CLabel -> Imm
ImmCLbl CLabel
l
        CmmLabelOff l :: CLabel
l off :: Int
off       -> CLabel -> Int -> Imm
ImmIndex CLabel
l Int
off

        CmmLabelDiffOff l1 :: CLabel
l1 l2 :: CLabel
l2 off :: Int
off _
         -> Imm -> Imm -> Imm
ImmConstantSum
                (Imm -> Imm -> Imm
ImmConstantDiff (CLabel -> Imm
ImmCLbl CLabel
l1) (CLabel -> Imm
ImmCLbl CLabel
l2))
                (Int -> Imm
ImmInt Int
off)

        _               -> String -> Imm
forall a. String -> a
panic "SPARC.Regs.litToImm: no match"