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

import           Asm.Aarch64
import           Asm.Aarch64.Fr
import           Asm.Ar.P
import           Asm.G
import           Asm.LI
import qualified Data.IntMap    as IM
import qualified Data.Set       as S

gallocFrame :: Int -- ^ int supply for spilling
            -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
gallocFrame :: Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
gallocFrame Int
u = [AArch64 AReg FAReg Live] -> [AArch64 AReg FAReg ()]
frameC ([AArch64 AReg FAReg Live] -> [AArch64 AReg FAReg ()])
-> ([AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg Live])
-> [AArch64 AbsReg FAbsReg ()]
-> [AArch64 AReg FAReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg Live]
forall (arch :: * -> * -> * -> *) reg freg.
(Arch arch reg freg, Copointed (arch reg freg)) =>
[arch reg freg ()] -> [arch reg freg Live]
mkIntervals ([AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg Live])
-> ([AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()])
-> [AArch64 AbsReg FAbsReg ()]
-> [AArch64 AReg FAReg Live]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
galloc Int
u

galloc :: Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
galloc :: Int -> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
galloc Int
u [AArch64 AbsReg FAbsReg ()]
isns = Set AReg -> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
frame Set AReg
clob'd ((AArch64 AbsReg FAbsReg () -> AArch64 AReg FAReg ())
-> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AReg FAReg ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbsReg -> AReg)
-> AArch64 AbsReg FAReg () -> AArch64 AReg FAReg ()
forall areg reg afreg a.
(areg -> reg) -> AArch64 areg afreg a -> AArch64 reg afreg a
mapR ((IntMap AReg
regs IntMap AReg -> Int -> AReg
forall a. IntMap a -> Int -> a
IM.!)(Int -> AReg) -> (AbsReg -> Int) -> AbsReg -> AReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AbsReg -> Int
toInt)(AArch64 AbsReg FAReg () -> AArch64 AReg FAReg ())
-> (AArch64 AbsReg FAbsReg () -> AArch64 AbsReg FAReg ())
-> AArch64 AbsReg FAbsReg ()
-> AArch64 AReg FAReg ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FAbsReg -> FAReg)
-> AArch64 AbsReg FAbsReg () -> AArch64 AbsReg FAReg ()
forall afreg freg areg a.
(afreg -> freg) -> AArch64 areg afreg a -> AArch64 areg freg a
mapFR ((IntMap FAReg
fregs IntMap FAReg -> Int -> FAReg
forall a. IntMap a -> Int -> a
IM.!)(Int -> FAReg) -> (FAbsReg -> Int) -> FAbsReg -> FAReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FAbsReg -> Int
fToInt)) [AArch64 AbsReg FAbsReg ()]
isns')
    where (IntMap AReg
regs, IntMap FAReg
fregs, [AArch64 AbsReg FAbsReg ()]
isns') = Int
-> [AArch64 AbsReg FAbsReg ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg ()])
gallocOn Int
u ([AArch64 AbsReg FAbsReg ()]
isns[AArch64 AbsReg FAbsReg ()]
-> [AArch64 AbsReg FAbsReg ()] -> [AArch64 AbsReg FAbsReg ()]
forall a. [a] -> [a] -> [a]
++[() -> AArch64 AbsReg FAbsReg ()
forall reg freg a. a -> AArch64 reg freg a
Ret ()])
          clob'd :: Set AReg
clob'd = [AReg] -> Set AReg
forall a. Ord a => [a] -> Set a
S.fromList ([AReg] -> Set AReg) -> [AReg] -> Set AReg
forall a b. (a -> b) -> a -> b
$ IntMap AReg -> [AReg]
forall a. IntMap a -> [a]
IM.elems IntMap AReg
regs

{-# SCC frame #-}
frame :: S.Set AReg -> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
frame :: Set AReg -> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
frame Set AReg
clob [AArch64 AReg FAReg ()]
asms = [AArch64 AReg FAReg ()]
forall {freg}. [AArch64 AReg freg ()]
pre[AArch64 AReg FAReg ()]
-> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
forall a. [a] -> [a] -> [a]
++[AArch64 AReg FAReg ()]
asms[AArch64 AReg FAReg ()]
-> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
forall a. [a] -> [a] -> [a]
++[AArch64 AReg FAReg ()]
forall {freg}. [AArch64 AReg freg ()]
post[AArch64 AReg FAReg ()]
-> [AArch64 AReg FAReg ()] -> [AArch64 AReg FAReg ()]
forall a. [a] -> [a] -> [a]
++[() -> AArch64 AReg FAReg ()
forall reg freg a. a -> AArch64 reg freg a
Ret ()] where
    pre :: [AArch64 AReg freg ()]
pre=[AReg] -> [AArch64 AReg freg ()]
forall freg. [AReg] -> [AArch64 AReg freg ()]
pus [AReg]
clobs; post :: [AArch64 AReg freg ()]
post=[AReg] -> [AArch64 AReg freg ()]
forall freg. [AReg] -> [AArch64 AReg freg ()]
pos [AReg]
clobs
    -- https://developer.arm.com/documentation/102374/0101/Procedure-Call-Standard
    clobs :: [AReg]
clobs = Set AReg -> [AReg]
forall a. Set a -> [a]
S.toList (Set AReg
clob Set AReg -> Set AReg -> Set AReg
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` [AReg] -> Set AReg
forall a. Ord a => [a] -> Set a
S.fromList [AReg
X18 .. AReg
X28])

gallocOn :: Int -> [AArch64 AbsReg FAbsReg ()] -> (IM.IntMap AReg, IM.IntMap FAReg, [AArch64 AbsReg FAbsReg ()])
gallocOn :: Int
-> [AArch64 AbsReg FAbsReg ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg ()])
gallocOn Int
u = Int
-> Integer
-> IntMap AReg
-> [AArch64 AbsReg FAbsReg ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg ()])
forall {reg} {freg} {arch :: * -> * -> * -> *} {p} {p}.
(E reg, E freg, Arch arch reg freg, Copointed (arch reg freg)) =>
p
-> p
-> IntMap AReg
-> [arch reg freg ()]
-> (IntMap AReg, IntMap FAReg, [arch reg freg ()])
go Int
u Integer
0 IntMap AReg
pres
    where go :: p
-> p
-> IntMap AReg
-> [arch reg freg ()]
-> (IntMap AReg, IntMap FAReg, [arch reg freg ()])
go p
uϵ p
offs IntMap AReg
pres' [arch reg freg ()]
isns = (IntMap AReg, IntMap FAReg, [arch reg freg ()])
rmaps
              where rmaps :: (IntMap AReg, IntMap FAReg, [arch reg freg ()])
rmaps = case (Either IntSet (IntMap AReg)
regsM, Either IntSet (IntMap FAReg)
fregsM) of
                        (Right IntMap AReg
regs, Right IntMap FAReg
fregs) -> (IntMap AReg
regs, IntMap FAReg
fregs, [arch reg freg ()] -> [arch reg freg ()]
forall a. HasCallStack => [a] -> [a]
init [arch reg freg ()]
isns)
                    -- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms#Respect-the-purpose-of-specific-CPU-registers
                    regsM :: Either IntSet (IntMap AReg)
regsM = [arch reg freg (UD, Liveness, Maybe (Int, Int))]
-> [AReg] -> IntSet -> IntMap AReg -> Either IntSet (IntMap AReg)
forall reg (arch :: * -> * -> * -> *) areg afreg.
(Ord reg, Arch arch areg afreg, Copointed (arch areg afreg)) =>
[arch areg afreg (UD, Liveness, Maybe (Int, Int))]
-> [reg] -> IntSet -> IntMap reg -> Either IntSet (IntMap reg)
alloc [arch reg freg (UD, Liveness, Maybe (Int, Int))]
aIsns ((AReg -> Bool) -> [AReg] -> [AReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (AReg -> AReg -> Bool
forall a. Eq a => a -> a -> Bool
/= AReg
X18) [AReg
X0 .. AReg
X28]) (IntMap AReg -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap AReg
pres') IntMap AReg
pres'
                    fregsM :: Either IntSet (IntMap FAReg)
fregsM = [arch reg freg (UD, Liveness, Maybe (Int, Int))]
-> [FAReg]
-> IntSet
-> IntMap FAReg
-> Either IntSet (IntMap FAReg)
forall reg (arch :: * -> * -> * -> *) areg afreg.
(Ord reg, Arch arch areg afreg, Copointed (arch areg afreg)) =>
[arch areg afreg (UD, Liveness, Maybe (Int, Int))]
-> [reg] -> IntSet -> IntMap reg -> Either IntSet (IntMap reg)
allocF [arch reg freg (UD, Liveness, Maybe (Int, Int))]
aFIsns [FAReg
D0 .. FAReg
D30] (IntMap FAReg -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap FAReg
preFs) IntMap FAReg
preFs
                    ([arch reg freg (UD, Liveness, Maybe (Int, Int))]
aIsns, [arch reg freg (UD, Liveness, Maybe (Int, Int))]
aFIsns) = [arch reg freg ()]
-> ([arch reg freg (UD, Liveness, Maybe (Int, Int))],
    [arch reg freg (UD, Liveness, Maybe (Int, Int))])
forall reg freg (arch :: * -> * -> * -> *).
(E reg, E freg, Copointed (arch reg freg), Arch arch reg freg) =>
[arch reg freg ()]
-> ([arch reg freg (UD, Liveness, Maybe (Int, Int))],
    [arch reg freg (UD, Liveness, Maybe (Int, Int))])
bundle [arch reg freg ()]
isns

pres :: IM.IntMap AReg
pres :: IntMap AReg
pres = [(Int, AReg)] -> IntMap AReg
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
0, AReg
X0), (Int
1, AReg
X1), (Int
2, AReg
X2), (Int
3, AReg
X3), (Int
4, AReg
X4), (Int
5, AReg
X5), (Int
6, AReg
X6), (Int
7, AReg
X7), (Int
8, AReg
X30), (Int
9, AReg
SP), (Int
18, AReg
X29)]

preFs :: IM.IntMap FAReg
preFs :: IntMap FAReg
preFs = [(Int, FAReg)] -> IntMap FAReg
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
10, FAReg
D0), (Int
11, FAReg
D1), (Int
12, FAReg
D2), (Int
13, FAReg
D3), (Int
14, FAReg
D4), (Int
15, FAReg
D5), (Int
16, FAReg
D6), (Int
17, FAReg
D7)]