\ignore{
\begin{code}
module GCodeSysDeps 
    ( mStdThunks
    , typeSize, typeIsPtr, typeIsVoid
    , javaType, javaType_maybe
    , matchSlowPattern
    , sameLoc
    , regClass, allocRegs ) where

import GCode as G
import Brianweb.Java as J (Type(..),slots,isRef)

import TyCon
import Outputable
import Maybes
import FastString
import PrelNames

#include "HsVersions.h"
\end{code}
}

This file contains the ugly backend-specific details that are needed by higher
level gcode functions. I haven't come up with a good way of abstracting this
stuff away yet.

\begin{code}
mStdThunks :: Name
mStdThunks = FSLIT("org.haskell.ghc.rts.StdThunks")
\end{code}

\begin{code}
typeSize :: G.Type -> Int
typeSize = maybe 0 slots . javaType_maybe
\end{code}

\begin{code}
typeIsVoid :: G.Type -> Bool
typeIsVoid t
    | Just _ <- javaType_maybe t = False
    | otherwise = True
\end{code}

\begin{code}
typeIsPtr :: G.Type -> Bool
typeIsPtr t
    | Just t' <- javaType_maybe t, isRef t' = True
    | otherwise = False
\end{code}

The frontend doesn't actually need to know the java type, but the above
predicates do, so this is just a handy place to put it.

\begin{code}
javaType :: G.Type -> J.Type
javaType t = case javaType_maybe t of
    Just t' -> t'
    Nothing -> pprPanic "javaType" (ppr t)
\end{code}

\begin{code}
rtsType :: String -> J.Type
rtsType s = TClass ("org.haskell.ghc.rts." ++ s)

javaType_maybe :: G.Type -> Maybe J.Type
javaType_maybe LiftedTy = Just (rtsType "Closure")
javaType_maybe (ClosureTy (m,n)) = Just (TClass (unpackFS m ++ "$" ++ unpackFS n))
javaType_maybe (PrimTy tc args) 
    | Just ext_name <- isForeignTyCon_maybe tc = Just (TClass (unpackFS ext_name))
    | uniq == uArrayPrimTyConKey, [e] <- args = Just (TArray (javaType e))
    | uniq == mutableUArrayPrimTyConKey, [_,e] <- args = Just (TArray (javaType e))
    | uniq == arrayPrimTyConKey, [e] <- args = Just (TArray (javaType e))
    | uniq == mutableArrayPrimTyConKey, [_,e] <- args = Just (TArray (javaType e))
    | uniq == statePrimTyConKey      = Nothing
    | uniq == voidPrimTyConKey       = Nothing
    | uniq == boolPrimTyConKey       = Just TBool
    | uniq == int8PrimTyConKey       = Just TByte
    | uniq == word8PrimTyConKey      = Just TByte
    | uniq == int16PrimTyConKey      = Just TShort
    | uniq == word16PrimTyConKey     = Just TChar
    | uniq == intPrimTyConKey        = Just TInt
    | uniq == int32PrimTyConKey      = Just TInt
    | uniq == wordPrimTyConKey       = Just TInt
    | uniq == word32PrimTyConKey     = Just TInt
    | uniq == charPrimTyConKey       = Just TInt
    | uniq == int64PrimTyConKey      = Just TLong
    | uniq == word64PrimTyConKey     = Just TLong
    | uniq == floatPrimTyConKey      = Just TFloat
    | uniq == doublePrimTyConKey     = Just TDouble
    | uniq == mutVarPrimTyConKey     = Just (rtsType "MutVar")
    | uniq == mVarPrimTyConKey       = Just (rtsType "MVar")
    | uniq == tVarPrimTyConKey       = Just (rtsType "TVar")
    | uniq == weakPrimTyConKey       = Just (rtsType "Weak")
    | uniq == stableNamePrimTyConKey = Just (rtsType "StableName")
    | uniq == bcoPrimTyConKey        = Just (rtsType "BCO")
    | uniq == threadIdPrimTyConKey   = Just (TClass "java.lang.Thread")
    | uniq == stringPrimTyConKey     = Just (TClass "java.lang.String")
    | otherwise                      = ASSERT2(not (isUnLiftedTyCon tc),ppr tc) Just (rtsType "Closure")
    where
        uniq = getUnique tc
\end{code}

\begin{code}
-- Based on CgCallConv.matchSlowPattern

matchSlowPattern :: (a -> G.Type) -> [a] -> (Name,[a],[a])
matchSlowPattern f xs = (arg_pat,these,rest)
    where
        (arg_pat,n) = slowCallPattern (map (regClass.f) xs)
        (these,rest) = splitAt n xs
    
-- These cover 99.9% of slow calls (experimentally determined and in
-- agreement with the eval/apply paper)
slowCallPattern :: [RegClass] -> (FastString,Int)
slowCallPattern ('c':'c':'c':'c':'c':'c':_) = (FSLIT("stg_ap_cccccc"),6)
slowCallPattern ('c':'c':'c':'c':'c':_)     = (FSLIT("stg_ap_ccccc"),5)
slowCallPattern ('c':'c':'c':'c':_)         = (FSLIT("stg_ap_cccc"),4)
slowCallPattern ('c':'c':'c':'v':_)         = (FSLIT("stg_ap_cccv"),4)
slowCallPattern ('c':'c':'c':_)             = (FSLIT("stg_ap_ccc"),3)
slowCallPattern ('c':'c':'v':_)             = (FSLIT("stg_ap_ccv"),3)
slowCallPattern ('c':'c':'i':_)             = (FSLIT("stg_ap_cci"),3)
slowCallPattern ('c':'c':_)                 = (FSLIT("stg_ap_cc"),2)
slowCallPattern ('c':'v':_)                 = (FSLIT("stg_ap_cv"),2)
slowCallPattern ('c':'i':_)                 = (FSLIT("stg_ap_ci"),2)
slowCallPattern ('c':_)                     = (FSLIT("stg_ap_c"),1)
slowCallPattern ('v':_)                     = (FSLIT("stg_ap_v"),1)
slowCallPattern ('i':_)                     = (FSLIT("stg_ap_i"),1)
slowCallPattern ('l':_)                     = (FSLIT("stg_ap_l"),1)
slowCallPattern ('f':_)                     = (FSLIT("stg_ap_f"),1)
slowCallPattern ('d':_)                     = (FSLIT("stg_ap_d"),1)
slowCallPattern ('o':_)                     = (FSLIT("stg_ap_o"),1)
slowCallPattern _ = panic "slowCallPattern"
\end{code}

\begin{code}
regClass :: G.Type -> RegClass
regClass t@PrimTy{} = case javaType_maybe t of
    Just t' -> case t' of
        TLong -> 'l'
        TFloat -> 'f'
        TDouble -> 'd'
        TClass _ -> 'o'
        TArray _ -> 'o'
        _ -> 'i'
    Nothing -> 'v'
regClass _ = 'c' -- FEATURE: Go back to using 'o' for closures?
\end{code}

\begin{code}
allocRegs :: (a -> G.Type) -> [a] -> [(a,GenLoc b)]
allocRegs getType = go 0 0 0 0 0 0 0
    where
        go _ _ _ _ _ _ _ [] = []
        go i l f d c o v (x:xs) = case regClass t of
            'i' -> (x,Reg t i) : go (i+1) l f d c o v xs
            'l' -> (x,Reg t l) : go i (l+1) f d c o v xs
            'f' -> (x,Reg t f) : go i l (f+1) d c o v xs
            'd' -> (x,Reg t d) : go i l f (d+1) c o v xs
            'c' -> (x,Reg t c) : go i l f d (c+1) o v xs
            'o' -> (x,Reg t o) : go i l f d c (o+1) v xs
            'v' -> (x,Reg t v) : go i l f d c o (v+1) xs
            _ -> pprPanic "allocRegs" (ppr t)
            where
                t = getType x
\end{code}

\begin{code}
sameLoc :: Eq a => GenLoc a -> GenLoc a -> Bool
Var _ i1             `sameLoc` Var _ i2             = i1 == i2
Field l1 _ i1        `sameLoc` Field l2 _ i2        = i1 == i2 && l1 `sameLoc` l2
Reg t1 i1            `sameLoc` Reg t2 i2            = i1 == i2 && regClass t1 == regClass t2
Global _ qn1         `sameLoc` Global _ qn2         = qn1 == qn2
Literal l1           `sameLoc` Literal l2           = l1 == l2
_                    `sameLoc` _                    = False
\end{code}