-- | Bits and pieces on the bottom of the module dependency tree.
--      Also import the required constants, so we know what we're using.
--
--      In the interests of cross-compilation, we want to free ourselves
--      from the autoconf generated modules like main/Constants

module SPARC.Base (
        wordLength,
        wordLengthInBits,
        spillAreaLength,
        spillSlotSize,
        extraStackArgsHere,
        fits13Bits,
        is32BitInteger,
        largeOffsetError
)

where

import GhcPrelude

import DynFlags
import Panic

import Data.Int


-- On 32 bit SPARC, pointers are 32 bits.
wordLength :: Int
wordLength :: Int
wordLength = 4

wordLengthInBits :: Int
wordLengthInBits :: Int
wordLengthInBits
        = Int
wordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8

-- Size of the available spill area
spillAreaLength :: DynFlags -> Int
spillAreaLength :: DynFlags -> Int
spillAreaLength
        = DynFlags -> Int
rESERVED_C_STACK_BYTES

-- | We need 8 bytes because our largest registers are 64 bit.
spillSlotSize :: Int
spillSlotSize :: Int
spillSlotSize = 8


-- | We (allegedly) put the first six C-call arguments in registers;
--      where do we start putting the rest of them?
extraStackArgsHere :: Int
extraStackArgsHere :: Int
extraStackArgsHere = 23


{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
-- | Check whether an offset is representable with 13 bits.
fits13Bits :: Integral a => a -> Bool
fits13Bits :: a -> Bool
fits13Bits x :: a
x = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -4096 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 4096

-- | Check whether an integer will fit in 32 bits.
--      A CmmInt is intended to be truncated to the appropriate
--      number of bits, so here we truncate it to Int64.  This is
--      important because e.g. -1 as a CmmInt might be either
--      -1 or 18446744073709551615.
--
is32BitInteger :: Integer -> Bool
is32BitInteger :: Integer -> Bool
is32BitInteger i :: Integer
i
        = Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x7fffffff Bool -> Bool -> Bool
&& Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= -0x80000000
        where i64 :: Int64
i64 = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64


-- | Sadness.
largeOffsetError :: (Show a) => a -> b
largeOffsetError :: a -> b
largeOffsetError i :: a
i
  = String -> b
forall a. String -> a
panic ("ERROR: SPARC native-code generator cannot handle large offset ("
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ ");\nprobably because of large constant data structures;" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "\nworkaround: use -fllvm on this module.\n")