module Asm.X86.P ( gallocFrame, gallocOn ) where

import           Asm.Ar.P
import           Asm.G
import           Asm.LI
import           Asm.X86
import           Asm.X86.Frame
import           Asm.X86.Sp
import           Data.Int      (Int64)
import qualified Data.IntMap   as IM
import qualified Data.Set      as S

-- TODO: don't bother re-analyzing if no Calls
gallocFrame :: Int -- ^ int supply for spilling
            -> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
gallocFrame :: Int
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
gallocFrame Int
u = [X86 X86Reg FX86Reg F2X86 Live] -> [X86 X86Reg FX86Reg F2X86 ()]
frameC ([X86 X86Reg FX86Reg F2X86 Live] -> [X86 X86Reg FX86Reg F2X86 ()])
-> ([X86 AbsReg FAbsReg X2Abs ()]
    -> [X86 X86Reg FX86Reg F2X86 Live])
-> [X86 AbsReg FAbsReg X2Abs ()]
-> [X86 X86Reg FX86Reg F2X86 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 Live]
forall (arch :: * -> * -> * -> * -> *) reg freg f2.
(Arch arch reg freg f2, Copointed (arch reg freg f2)) =>
[arch reg freg f2 ()] -> [arch reg freg f2 Live]
mkIntervals ([X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 Live])
-> ([X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()])
-> [X86 AbsReg FAbsReg X2Abs ()]
-> [X86 X86Reg FX86Reg F2X86 Live]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
galloc Int
u

{-# SCC galloc #-}
galloc :: Int -> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
galloc :: Int
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
galloc Int
u [X86 AbsReg FAbsReg X2Abs ()]
isns = Set X86Reg
-> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
frame Set X86Reg
clob'd ((X86 AbsReg FAbsReg X2Abs () -> X86 X86Reg FX86Reg F2X86 ())
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 X86Reg FX86Reg F2X86 ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsReg -> X86Reg)
-> X86 AbsReg FX86Reg F2X86 () -> X86 X86Reg FX86Reg F2X86 ()
forall areg reg afreg af2 a.
(areg -> reg) -> X86 areg afreg af2 a -> X86 reg afreg af2 a
mapR ((IntMap X86Reg
regs IntMap X86Reg -> Int -> X86Reg
forall a. IntMap a -> Int -> a
IM.!)(Int -> X86Reg) -> (AbsReg -> Int) -> AbsReg -> X86Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AbsReg -> Int
toInt)(X86 AbsReg FX86Reg F2X86 () -> X86 X86Reg FX86Reg F2X86 ())
-> (X86 AbsReg FAbsReg X2Abs () -> X86 AbsReg FX86Reg F2X86 ())
-> X86 AbsReg FAbsReg X2Abs ()
-> X86 X86Reg FX86Reg F2X86 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FAbsReg -> FX86Reg)
-> X86 AbsReg FAbsReg F2X86 () -> X86 AbsReg FX86Reg F2X86 ()
forall afreg freg areg af2 a.
(afreg -> freg) -> X86 areg afreg af2 a -> X86 areg freg af2 a
mapFR ((IntMap FX86Reg
fregs IntMap FX86Reg -> Int -> FX86Reg
forall a. IntMap a -> Int -> a
IM.!)(Int -> FX86Reg) -> (FAbsReg -> Int) -> FAbsReg -> FX86Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FAbsReg -> Int
fToInt)(X86 AbsReg FAbsReg F2X86 () -> X86 AbsReg FX86Reg F2X86 ())
-> (X86 AbsReg FAbsReg X2Abs () -> X86 AbsReg FAbsReg F2X86 ())
-> X86 AbsReg FAbsReg X2Abs ()
-> X86 AbsReg FX86Reg F2X86 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(X2Abs -> F2X86)
-> X86 AbsReg FAbsReg X2Abs () -> X86 AbsReg FAbsReg F2X86 ()
forall af2 f2 areg afreg a.
(af2 -> f2) -> X86 areg afreg af2 a -> X86 areg afreg f2 a
mapF2 (FX86Reg -> F2X86
simd2(FX86Reg -> F2X86) -> (X2Abs -> FX86Reg) -> X2Abs -> F2X86
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap FX86Reg
fregs IntMap FX86Reg -> Int -> FX86Reg
forall a. IntMap a -> Int -> a
IM.!)(Int -> FX86Reg) -> (X2Abs -> Int) -> X2Abs -> FX86Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.X2Abs -> Int
f2ToInt)) [X86 AbsReg FAbsReg X2Abs ()]
isns')
    where (IntMap X86Reg
regs, IntMap FX86Reg
fregs, [X86 AbsReg FAbsReg X2Abs ()]
isns') = Int
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
gallocOn Int
u ([X86 AbsReg FAbsReg X2Abs ()]
isns [X86 AbsReg FAbsReg X2Abs ()]
-> [X86 AbsReg FAbsReg X2Abs ()] -> [X86 AbsReg FAbsReg X2Abs ()]
forall a. [a] -> [a] -> [a]
++ [() -> X86 AbsReg FAbsReg X2Abs ()
forall reg freg f2 a. a -> X86 reg freg f2 a
Ret()])
          clob'd :: Set X86Reg
clob'd = [X86Reg] -> Set X86Reg
forall a. Ord a => [a] -> Set a
S.fromList ([X86Reg] -> Set X86Reg) -> [X86Reg] -> Set X86Reg
forall a b. (a -> b) -> a -> b
$ IntMap X86Reg -> [X86Reg]
forall a. IntMap a -> [a]
IM.elems IntMap X86Reg
regs

{-# SCC frame #-}
frame :: S.Set X86Reg -> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
frame :: Set X86Reg
-> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
frame Set X86Reg
clob [X86 X86Reg FX86Reg F2X86 ()]
asms = [X86 X86Reg FX86Reg F2X86 ()]
forall {freg} {f2}. [X86 X86Reg freg f2 ()]
pre[X86 X86Reg FX86Reg F2X86 ()]
-> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
forall a. [a] -> [a] -> [a]
++[X86 X86Reg FX86Reg F2X86 ()]
asms[X86 X86Reg FX86Reg F2X86 ()]
-> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
forall a. [a] -> [a] -> [a]
++[X86 X86Reg FX86Reg F2X86 ()]
forall {freg} {f2}. [X86 X86Reg freg f2 ()]
post[X86 X86Reg FX86Reg F2X86 ()]
-> [X86 X86Reg FX86Reg F2X86 ()] -> [X86 X86Reg FX86Reg F2X86 ()]
forall a. [a] -> [a] -> [a]
++[() -> X86 X86Reg FX86Reg F2X86 ()
forall reg freg f2 a. a -> X86 reg freg f2 a
Ret()] where
    pre :: [X86 X86Reg freg f2 ()]
pre = [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall {freg} {f2}.
[X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
save([X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()])
-> [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a b. (a -> b) -> a -> b
$() -> X86Reg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> X86 reg freg f2 a
Push () (X86Reg -> X86 X86Reg freg f2 ())
-> [X86Reg] -> [X86 X86Reg freg f2 ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg]
clobs
    post :: [X86 X86Reg freg f2 ()]
post = [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall {freg} {f2}.
[X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
restore([X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()])
-> [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a b. (a -> b) -> a -> b
$() -> X86Reg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> X86 reg freg f2 a
Pop () (X86Reg -> X86 X86Reg freg f2 ())
-> [X86Reg] -> [X86 X86Reg freg f2 ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg] -> [X86Reg]
forall a. [a] -> [a]
reverse [X86Reg]
clobs
    clobs :: [X86Reg]
clobs = Set X86Reg -> [X86Reg]
forall a. Set a -> [a]
S.toList (Set X86Reg
clob Set X86Reg -> Set X86Reg -> Set X86Reg
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` [X86Reg] -> Set X86Reg
forall a. Ord a => [a] -> Set a
S.fromList (X86Reg
RbpX86Reg -> [X86Reg] -> [X86Reg]
forall a. a -> [a] -> [a]
:[X86Reg
R12 .. X86Reg
Rbx]))
    scratch :: Bool
scratch=Int -> Bool
forall a. Integral a => a -> Bool
even([X86Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [X86Reg]
clobs) Bool -> Bool -> Bool
&& [X86 X86Reg FX86Reg F2X86 ()] -> Bool
forall reg freg f2reg a. [X86 reg freg f2reg a] -> Bool
hasMa [X86 X86Reg FX86Reg F2X86 ()]
asms; save :: [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
save=if Bool
scratch then ([X86 X86Reg freg f2 ()]
-> [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a. [a] -> [a] -> [a]
++[() -> X86Reg -> Int64 -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
ISubRI () X86Reg
Rsp Int64
8]) else [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a. a -> a
id; restore :: [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
restore=if Bool
scratch then (() -> X86Reg -> Int64 -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
IAddRI () X86Reg
Rsp Int64
8X86 X86Reg freg f2 ()
-> [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a. a -> [a] -> [a]
:) else [X86 X86Reg freg f2 ()] -> [X86 X86Reg freg f2 ()]
forall a. a -> a
id
    -- TODO: https://eli.thegreenplace.net/2011/09/06/stack-frame-layout-on-x86-64/
    -- https://stackoverflow.com/questions/51523127/why-does-the-compiler-reserve-a-little-stack-space-but-not-the-whole-array-size

{-# INLINE gallocOn #-}
gallocOn :: Int -> [X86 AbsReg FAbsReg X2Abs ()] -> (IM.IntMap X86Reg, IM.IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
gallocOn :: Int
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
gallocOn Int
u = Int
-> Int
-> IntMap X86Reg
-> Bool
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
go Int
u Int
16 IntMap X86Reg
pres Bool
True
    where go :: Int
-> Int
-> IntMap X86Reg
-> Bool
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
go Int
uϵ Int
offs IntMap X86Reg
pres' Bool
i [X86 AbsReg FAbsReg X2Abs ()]
isns = (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
rmaps
              where rmaps :: (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
rmaps = case (Either IntSet (IntMap X86Reg)
regsM, Either IntSet (IntMap FX86Reg)
fregsM) of
                        (Right IntMap X86Reg
regs, Right IntMap FX86Reg
fregs) -> let saa :: Int64
saa = Int64 -> Int64
saI(Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offs; saaP :: [X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
saaP = if Bool
i then [X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
forall a. HasCallStack => [a] -> [a]
init else ([X86 AbsReg freg f2 ()]
-> [X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
forall a. [a] -> [a] -> [a]
++[() -> AbsReg -> Int64 -> X86 AbsReg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
IAddRI () AbsReg
SP Int64
saa])([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> ([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> [X86 AbsReg freg f2 ()]
-> [X86 AbsReg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
forall a. HasCallStack => [a] -> [a]
init([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> ([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> [X86 AbsReg freg f2 ()]
-> [X86 AbsReg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(() -> AbsReg -> Int64 -> X86 AbsReg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
ISubRI () AbsReg
SP Int64
saaX86 AbsReg freg f2 ()
-> [X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
forall a. a -> [a] -> [a]
:)([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> ([X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()])
-> [X86 AbsReg freg f2 ()]
-> [X86 AbsReg freg f2 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(() -> AbsReg -> Int64 -> X86 AbsReg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
ISubRI () AbsReg
BP Int64
saaX86 AbsReg freg f2 ()
-> [X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
forall a. a -> [a] -> [a]
:) in (IntMap X86Reg
regs, IntMap FX86Reg
fregs, [X86 AbsReg FAbsReg X2Abs ()] -> [X86 AbsReg FAbsReg X2Abs ()]
forall {freg} {f2}.
[X86 AbsReg freg f2 ()] -> [X86 AbsReg freg f2 ()]
saaP [X86 AbsReg FAbsReg X2Abs ()]
isns)
                        (Left IntSet
s, Right IntMap FX86Reg
fregs) ->
                            let (Int
uϵ', Int
offs', [X86 AbsReg FAbsReg X2Abs ()]
isns') = Int
-> Int
-> IntSet
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (Int, Int, [X86 AbsReg FAbsReg X2Abs ()])
forall a.
Int
-> Int
-> IntSet
-> [X86 AbsReg FAbsReg X2Abs a]
-> (Int, Int, [X86 AbsReg FAbsReg X2Abs ()])
spill Int
uϵ Int
offs IntSet
s [X86 AbsReg FAbsReg X2Abs ()]
isns
                            in Int
-> Int
-> IntMap X86Reg
-> Bool
-> [X86 AbsReg FAbsReg X2Abs ()]
-> (IntMap X86Reg, IntMap FX86Reg, [X86 AbsReg FAbsReg X2Abs ()])
go Int
uϵ' Int
offs' (Int -> X86Reg -> IntMap X86Reg -> IntMap X86Reg
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (-Int
16) X86Reg
Rbp IntMap X86Reg
pres') Bool
False [X86 AbsReg FAbsReg X2Abs ()]
isns'
                    regsM :: Either IntSet (IntMap X86Reg)
regsM = [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
-> [X86Reg]
-> IntSet
-> IntMap X86Reg
-> Either IntSet (IntMap X86Reg)
forall reg (arch :: * -> * -> * -> * -> *) areg afreg af2.
(Ord reg, Arch arch areg afreg af2,
 Copointed (arch areg afreg af2)) =>
[arch areg afreg af2 (UD, Liveness, Maybe (Int, Int))]
-> [reg] -> IntSet -> IntMap reg -> Either IntSet (IntMap reg)
alloc [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
aIsns ((if Bool
i then ([X86Reg] -> [X86Reg] -> [X86Reg]
forall a. [a] -> [a] -> [a]
++[X86Reg
Rbp]) else [X86Reg] -> [X86Reg]
forall a. a -> a
id) [X86Reg
Rcx .. X86Reg
Rax]) (IntMap X86Reg -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap X86Reg
pres') IntMap X86Reg
pres'
                    fregsM :: Either IntSet (IntMap FX86Reg)
fregsM = [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
-> [FX86Reg]
-> IntSet
-> IntMap FX86Reg
-> Either IntSet (IntMap FX86Reg)
forall reg (arch :: * -> * -> * -> * -> *) areg afreg af2.
(Ord reg, Arch arch areg afreg af2,
 Copointed (arch areg afreg af2)) =>
[arch areg afreg af2 (UD, Liveness, Maybe (Int, Int))]
-> [reg] -> IntSet -> IntMap reg -> Either IntSet (IntMap reg)
allocF [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
aFIsns [FX86Reg
XMM1 .. FX86Reg
XMM15] (IntMap FX86Reg -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap FX86Reg
preFs) IntMap FX86Reg
preFs
                    ([X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
aIsns, [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))]
aFIsns) = [X86 AbsReg FAbsReg X2Abs ()]
-> ([X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))],
    [X86 AbsReg FAbsReg X2Abs (UD, Liveness, Maybe (Int, Int))])
forall reg freg (arch :: * -> * -> * -> * -> *) f2.
(E reg, E freg, Copointed (arch reg freg f2),
 Arch arch reg freg f2) =>
[arch reg freg f2 ()]
-> ([arch reg freg f2 (UD, Liveness, Maybe (Int, Int))],
    [arch reg freg f2 (UD, Liveness, Maybe (Int, Int))])
bundle [X86 AbsReg FAbsReg X2Abs ()]
isns

saI :: Int64 -> Int64
saI :: Int64 -> Int64
saI Int64
i | Int64
iInt64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem`Int64
16 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Int64
i | Bool
otherwise = Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8

pres :: IM.IntMap X86Reg
pres :: IntMap X86Reg
pres = [(Int, X86Reg)] -> IntMap X86Reg
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
0, X86Reg
Rdi), (Int
1, X86Reg
Rsi), (Int
2, X86Reg
Rdx), (Int
3, X86Reg
Rcx), (Int
4, X86Reg
R8), (Int
5, X86Reg
R9), (Int
6, X86Reg
Rax), (Int
7, X86Reg
Rsp)]

preFs :: IM.IntMap FX86Reg
preFs :: IntMap FX86Reg
preFs = [(Int, FX86Reg)] -> IntMap FX86Reg
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
8, FX86Reg
XMM0), (Int
9, FX86Reg
XMM1), (Int
10, FX86Reg
XMM2), (Int
11, FX86Reg
XMM3), (Int
12, FX86Reg
XMM4), (Int
13, FX86Reg
XMM5), (Int
14, FX86Reg
XMM6), (Int
15, FX86Reg
XMM7)]