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 F2Abs ()] -> [AArch64 AReg FAReg F2Reg ()]
gallocFrame :: Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
gallocFrame Int
u = [AArch64 AReg FAReg F2Reg Live] -> [AArch64 AReg FAReg F2Reg ()]
frameC ([AArch64 AReg FAReg F2Reg Live] -> [AArch64 AReg FAReg F2Reg ()])
-> ([AArch64 AbsReg FAbsReg F2Abs ()]
    -> [AArch64 AReg FAReg F2Reg Live])
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg 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 ([AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg Live])
-> ([AArch64 AbsReg FAbsReg F2Abs ()]
    -> [AArch64 AReg FAReg F2Reg ()])
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg Live]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
galloc Int
u

galloc :: Int -> [AArch64 AbsReg FAbsReg F2Abs ()] -> [AArch64 AReg FAReg F2Reg ()]
galloc :: Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
galloc Int
u [AArch64 AbsReg FAbsReg F2Abs ()]
isns = Set AReg
-> [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
frame Set AReg
clob'd ((AArch64 AbsReg FAbsReg F2Abs () -> AArch64 AReg FAReg F2Reg ())
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AReg FAReg F2Reg ()]
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 F2Reg () -> AArch64 AReg FAReg F2Reg ()
forall areg reg afreg af2 a.
(areg -> reg)
-> AArch64 areg afreg af2 a -> AArch64 reg afreg af2 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 F2Reg () -> AArch64 AReg FAReg F2Reg ())
-> (AArch64 AbsReg FAbsReg F2Abs ()
    -> AArch64 AbsReg FAReg F2Reg ())
-> AArch64 AbsReg FAbsReg F2Abs ()
-> AArch64 AReg FAReg F2Reg ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FAbsReg -> FAReg)
-> AArch64 AbsReg FAbsReg F2Reg () -> AArch64 AbsReg FAReg F2Reg ()
forall afreg freg areg af2 a.
(afreg -> freg)
-> AArch64 areg afreg af2 a -> AArch64 areg freg af2 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 F2Reg () -> AArch64 AbsReg FAReg F2Reg ())
-> (AArch64 AbsReg FAbsReg F2Abs ()
    -> AArch64 AbsReg FAbsReg F2Reg ())
-> AArch64 AbsReg FAbsReg F2Abs ()
-> AArch64 AbsReg FAReg F2Reg ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(F2Abs -> F2Reg)
-> AArch64 AbsReg FAbsReg F2Abs ()
-> AArch64 AbsReg FAbsReg F2Reg ()
forall af2 f2 areg afreg a.
(af2 -> f2) -> AArch64 areg afreg af2 a -> AArch64 areg afreg f2 a
mapF2 (FAReg -> F2Reg
simd2(FAReg -> F2Reg) -> (F2Abs -> FAReg) -> F2Abs -> F2Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap FAReg
fregs IntMap FAReg -> Int -> FAReg
forall a. IntMap a -> Int -> a
IM.!)(Int -> FAReg) -> (F2Abs -> Int) -> F2Abs -> FAReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.F2Abs -> Int
f2ToInt)) [AArch64 AbsReg FAbsReg F2Abs ()]
isns')
    where (IntMap AReg
regs, IntMap FAReg
fregs, [AArch64 AbsReg FAbsReg F2Abs ()]
isns') = Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg F2Abs ()])
gallocOn Int
u ([AArch64 AbsReg FAbsReg F2Abs ()]
isns[AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> [AArch64 AbsReg FAbsReg F2Abs ()]
forall a. [a] -> [a] -> [a]
++[() -> AArch64 AbsReg FAbsReg F2Abs ()
forall reg freg f2 a. a -> AArch64 reg freg f2 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 F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
frame :: Set AReg
-> [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
frame Set AReg
clob [AArch64 AReg FAReg F2Reg ()]
asms = [AArch64 AReg FAReg F2Reg ()]
forall {freg} {f2reg}. [AArch64 AReg freg f2reg ()]
pre[AArch64 AReg FAReg F2Reg ()]
-> [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall a. [a] -> [a] -> [a]
++[AArch64 AReg FAReg F2Reg ()]
asms[AArch64 AReg FAReg F2Reg ()]
-> [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall a. [a] -> [a] -> [a]
++[AArch64 AReg FAReg F2Reg ()]
forall {freg} {f2reg}. [AArch64 AReg freg f2reg ()]
post[AArch64 AReg FAReg F2Reg ()]
-> [AArch64 AReg FAReg F2Reg ()] -> [AArch64 AReg FAReg F2Reg ()]
forall a. [a] -> [a] -> [a]
++[() -> AArch64 AReg FAReg F2Reg ()
forall reg freg f2 a. a -> AArch64 reg freg f2 a
Ret ()] where
    pre :: [AArch64 AReg freg f2reg ()]
pre=[AReg] -> [AArch64 AReg freg f2reg ()]
forall freg f2reg. [AReg] -> [AArch64 AReg freg f2reg ()]
pus [AReg]
clobs; post :: [AArch64 AReg freg f2reg ()]
post=[AReg] -> [AArch64 AReg freg f2reg ()]
forall freg f2reg. [AReg] -> [AArch64 AReg freg f2reg ()]
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 F2Abs ()] -> (IM.IntMap AReg, IM.IntMap FAReg, [AArch64 AbsReg FAbsReg F2Abs ()])
gallocOn :: Int
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg F2Abs ()])
gallocOn Int
u = Int
-> Integer
-> IntMap AReg
-> [AArch64 AbsReg FAbsReg F2Abs ()]
-> (IntMap AReg, IntMap FAReg, [AArch64 AbsReg FAbsReg F2Abs ()])
forall {reg} {freg} {arch :: * -> * -> * -> * -> *} {f2} {p} {p}.
(E reg, E freg, Arch arch reg freg f2,
 Copointed (arch reg freg f2)) =>
p
-> p
-> IntMap AReg
-> [arch reg freg f2 ()]
-> (IntMap AReg, IntMap FAReg, [arch reg freg f2 ()])
go Int
u Integer
0 IntMap AReg
pres
    where go :: p
-> p
-> IntMap AReg
-> [arch reg freg f2 ()]
-> (IntMap AReg, IntMap FAReg, [arch reg freg f2 ()])
go p
uϵ p
offs IntMap AReg
pres' [arch reg freg f2 ()]
isns = (IntMap AReg, IntMap FAReg, [arch reg freg f2 ()])
rmaps
              where rmaps :: (IntMap AReg, IntMap FAReg, [arch reg freg f2 ()])
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 f2 ()] -> [arch reg freg f2 ()]
forall a. HasCallStack => [a] -> [a]
init [arch reg freg f2 ()]
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 f2 (UD, Liveness, Maybe (Int, Int))]
-> [AReg] -> IntSet -> IntMap AReg -> Either IntSet (IntMap AReg)
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 [arch reg freg f2 (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 f2 (UD, Liveness, Maybe (Int, Int))]
-> [FAReg]
-> IntSet
-> IntMap FAReg
-> Either IntSet (IntMap FAReg)
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 [arch reg freg f2 (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 f2 (UD, Liveness, Maybe (Int, Int))]
aIsns, [arch reg freg f2 (UD, Liveness, Maybe (Int, Int))]
aFIsns) = [arch reg freg f2 ()]
-> ([arch reg freg f2 (UD, Liveness, Maybe (Int, Int))],
    [arch reg freg f2 (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 [arch reg freg f2 ()]
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)]