module Asm.Aarch64.Fr ( frameC ) where

import           Asm.Aarch64
import           Asm.M
import           CF
import           Data.Copointed
import           Data.Functor   (void)
import qualified Data.IntSet    as IS
import           Data.Maybe     (mapMaybe)

frameC :: [AArch64 AReg FAReg F2Reg Live] -> [AArch64 AReg FAReg F2Reg ()]
frameC :: [AArch64 AReg FAReg F2Reg Live] -> [AArch64 AReg FAReg F2Reg ()]
frameC = [[AArch64 AReg FAReg F2Reg ()]] -> [AArch64 AReg FAReg F2Reg ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([[AArch64 AReg FAReg F2Reg ()]] -> [AArch64 AReg FAReg F2Reg ()])
-> ([AArch64 AReg FAReg F2Reg Live]
    -> [[AArch64 AReg FAReg F2Reg ()]])
-> [AArch64 AReg FAReg F2Reg Live]
-> [AArch64 AReg FAReg F2Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IntSet
-> IntSet
-> [AArch64 AReg FAReg F2Reg Live]
-> [[AArch64 AReg FAReg F2Reg ()]]
forall {f2}.
IntSet
-> IntSet
-> [AArch64 AReg FAReg f2 Live]
-> [[AArch64 AReg FAReg f2 ()]]
go IntSet
IS.empty IntSet
IS.empty
    where go :: IntSet
-> IntSet
-> [AArch64 AReg FAReg f2 Live]
-> [[AArch64 AReg FAReg f2 ()]]
go IntSet
_ IntSet
_ [] = []
          go IntSet
_ IntSet
_ [AArch64 AReg FAReg f2 Live
isn] = [[AArch64 AReg FAReg f2 Live -> AArch64 AReg FAReg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AArch64 AReg FAReg f2 Live
isn]]
          go IntSet
s IntSet
fs (isn0 :: AArch64 AReg FAReg f2 Live
isn0@(MovRCf Live
_ AReg
_ CFunc
cf):isn1 :: AArch64 AReg FAReg f2 Live
isn1@Blr{}:[AArch64 AReg FAReg f2 Live]
isns) =
            let i0 :: Live
i0 = AArch64 AReg FAReg f2 Live -> Live
forall a. AArch64 AReg FAReg f2 a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint AArch64 AReg FAReg f2 Live
isn0; i1 :: Live
i1=AArch64 AReg FAReg f2 Live -> Live
forall a. AArch64 AReg FAReg f2 a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint AArch64 AReg FAReg f2 Live
isn1
                s' :: IntSet
s' = IntSet
s IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
new Live
i0 IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
done Live
i0
                s'' :: IntSet
s'' = IntSet
s' IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
new Live
i1 IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
done Live
i1
                fs' :: IntSet
fs' = IntSet
fs IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
fnew Live
i0 IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
fdone Live
i0
                fs'' :: IntSet
fs'' = IntSet
fs' IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
fnew Live
i1 IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
fdone Live
i1
                cs :: [AReg]
cs = CFunc -> [AReg] -> [AReg]
handleX0 CFunc
cf ([AReg] -> [AReg]) -> [AReg] -> [AReg]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe AReg) -> [Int] -> [AReg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe AReg
fromInt (IntSet -> [Int]
IS.toList IntSet
s)
                ds :: [FAReg]
ds = CFunc -> [FAReg] -> [FAReg]
handleD0 CFunc
cf ([FAReg] -> [FAReg]) -> [FAReg] -> [FAReg]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe FAReg) -> [Int] -> [FAReg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe FAReg
fInt (IntSet -> [Int]
IS.toList IntSet
fs)
                save :: [AArch64 AReg freg f2reg ()]
save = [AReg] -> [AArch64 AReg freg f2reg ()]
forall freg f2reg. [AReg] -> [AArch64 AReg freg f2reg ()]
pus [AReg]
cs; restore :: [AArch64 AReg freg f2reg ()]
restore = [AReg] -> [AArch64 AReg freg f2reg ()]
forall freg f2reg. [AReg] -> [AArch64 AReg freg f2reg ()]
pos [AReg]
cs
                saved :: [AArch64 AReg FAReg f2reg ()]
saved = [FAReg] -> [AArch64 AReg FAReg f2reg ()]
forall freg f2reg. [freg] -> [AArch64 AReg freg f2reg ()]
puds [FAReg]
ds; restored :: [AArch64 AReg FAReg f2reg ()]
restored = [FAReg] -> [AArch64 AReg FAReg f2reg ()]
forall freg f2reg. [freg] -> [AArch64 AReg freg f2reg ()]
pods [FAReg]
ds
            in ([AArch64 AReg FAReg f2 ()]
forall {freg} {f2reg}. [AArch64 AReg freg f2reg ()]
save [AArch64 AReg FAReg f2 ()]
-> [AArch64 AReg FAReg f2 ()] -> [AArch64 AReg FAReg f2 ()]
forall a. [a] -> [a] -> [a]
++ [AArch64 AReg FAReg f2 ()]
forall {f2reg}. [AArch64 AReg FAReg f2reg ()]
saved [AArch64 AReg FAReg f2 ()]
-> [AArch64 AReg FAReg f2 ()] -> [AArch64 AReg FAReg f2 ()]
forall a. [a] -> [a] -> [a]
++ AArch64 AReg FAReg f2 Live -> AArch64 AReg FAReg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AArch64 AReg FAReg f2 Live
isn0AArch64 AReg FAReg f2 ()
-> [AArch64 AReg FAReg f2 ()] -> [AArch64 AReg FAReg f2 ()]
forall a. a -> [a] -> [a]
:AArch64 AReg FAReg f2 Live -> AArch64 AReg FAReg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AArch64 AReg FAReg f2 Live
isn1AArch64 AReg FAReg f2 ()
-> [AArch64 AReg FAReg f2 ()] -> [AArch64 AReg FAReg f2 ()]
forall a. a -> [a] -> [a]
:[AArch64 AReg FAReg f2 ()]
forall {f2reg}. [AArch64 AReg FAReg f2reg ()]
restored [AArch64 AReg FAReg f2 ()]
-> [AArch64 AReg FAReg f2 ()] -> [AArch64 AReg FAReg f2 ()]
forall a. [a] -> [a] -> [a]
++ [AArch64 AReg FAReg f2 ()]
forall {freg} {f2reg}. [AArch64 AReg freg f2reg ()]
restore) [AArch64 AReg FAReg f2 ()]
-> [[AArch64 AReg FAReg f2 ()]] -> [[AArch64 AReg FAReg f2 ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet
-> [AArch64 AReg FAReg f2 Live]
-> [[AArch64 AReg FAReg f2 ()]]
go IntSet
s'' IntSet
fs'' [AArch64 AReg FAReg f2 Live]
isns
          go IntSet
s IntSet
fs (AArch64 AReg FAReg f2 Live
isn:[AArch64 AReg FAReg f2 Live]
isns) =
            let i :: Live
i = AArch64 AReg FAReg f2 Live -> Live
forall a. AArch64 AReg FAReg f2 a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint AArch64 AReg FAReg f2 Live
isn
                s' :: IntSet
s' = IntSet
s IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
new Live
i IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
done Live
i
                fs' :: IntSet
fs' = IntSet
fs IntSet -> IntSet -> IntSet
`IS.union` Live -> IntSet
fnew Live
i IntSet -> IntSet -> IntSet
`IS.difference` Live -> IntSet
fdone Live
i
            in [AArch64 AReg FAReg f2 Live -> AArch64 AReg FAReg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AArch64 AReg FAReg f2 Live
isn] [AArch64 AReg FAReg f2 ()]
-> [[AArch64 AReg FAReg f2 ()]] -> [[AArch64 AReg FAReg f2 ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet
-> [AArch64 AReg FAReg f2 Live]
-> [[AArch64 AReg FAReg f2 ()]]
go IntSet
s' IntSet
fs' [AArch64 AReg FAReg f2 Live]
isns
          handleX0 :: CFunc -> [AReg] -> [AReg]
handleX0 CFunc
Malloc=(AReg -> Bool) -> [AReg] -> [AReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (AReg -> AReg -> Bool
forall a. Eq a => a -> a -> Bool
/=AReg
X0); handleX0 CFunc
Free=[AReg] -> [AReg]
forall a. a -> a
id; handleX0 CFunc
Exp=[AReg] -> [AReg]
forall a. a -> a
id; handleX0 CFunc
Log=[AReg] -> [AReg]
forall a. a -> a
id; handleX0 CFunc
Pow=[AReg] -> [AReg]
forall a. a -> a
id; handleX0 CFunc
DR=[AReg] -> [AReg]
forall a. a -> a
id; handleX0 CFunc
JR=(AReg -> Bool) -> [AReg] -> [AReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (AReg -> AReg -> Bool
forall a. Eq a => a -> a -> Bool
/=AReg
X0)
          handleD0 :: CFunc -> [FAReg] -> [FAReg]
handleD0 CFunc
Exp=(FAReg -> Bool) -> [FAReg] -> [FAReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (FAReg -> FAReg -> Bool
forall a. Eq a => a -> a -> Bool
/=FAReg
D0); handleD0 CFunc
Log=(FAReg -> Bool) -> [FAReg] -> [FAReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (FAReg -> FAReg -> Bool
forall a. Eq a => a -> a -> Bool
/=FAReg
D0);handleD0 CFunc
Malloc=[FAReg] -> [FAReg]
forall a. a -> a
id;handleD0 CFunc
Free=[FAReg] -> [FAReg]
forall a. a -> a
id; handleD0 CFunc
Pow=(FAReg -> Bool) -> [FAReg] -> [FAReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FAReg
d->FAReg
dFAReg -> FAReg -> Bool
forall a. Eq a => a -> a -> Bool
/=FAReg
D0 Bool -> Bool -> Bool
&& FAReg
dFAReg -> FAReg -> Bool
forall a. Eq a => a -> a -> Bool
/=FAReg
D1); handleD0 CFunc
DR=(FAReg -> Bool) -> [FAReg] -> [FAReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (FAReg -> FAReg -> Bool
forall a. Eq a => a -> a -> Bool
/=FAReg
D0); handleD0 CFunc
JR=[FAReg] -> [FAReg]
forall a. a -> a
id

-- https://developer.arm.com/documentation/102374/0101/Procedure-Call-Standard
fromInt :: Int -> Maybe AReg
fromInt :: Int -> Maybe AReg
fromInt Int
0     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X0
fromInt Int
1     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X1
fromInt Int
2     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X2
fromInt Int
3     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X3
fromInt Int
4     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X4
fromInt Int
5     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X5
fromInt Int
6     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X6
fromInt Int
7     = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X7
fromInt (-1)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X8
fromInt (-2)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X9
fromInt (-3)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X10
fromInt (-4)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X11
fromInt (-5)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X12
fromInt (-6)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X13
fromInt (-7)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X14
fromInt (-8)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X15
fromInt (-9)  = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X16
fromInt (-10) = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X17
fromInt (-11) = AReg -> Maybe AReg
forall a. a -> Maybe a
Just AReg
X18
fromInt Int
_     = Maybe AReg
forall a. Maybe a
Nothing

-- https://learn.microsoft.com/en-us/cpp/build/arm64-windows-abi-conventions?view=msvc-170#floating-pointsimd-registers
fInt :: Int -> Maybe FAReg
fInt :: Int -> Maybe FAReg
fInt Int
10    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D0
fInt Int
11    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D1
fInt Int
12    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D2
fInt Int
13    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D3
fInt Int
14    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D4
fInt Int
15    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D5
fInt Int
16    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D6
fInt Int
17    = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D7
fInt (-31) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D16
fInt (-32) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D17
fInt (-33) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D18
fInt (-34) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D19
fInt (-35) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D20
fInt (-36) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D21
fInt (-37) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D22
fInt (-38) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D23
fInt (-39) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D24
fInt (-40) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D25
fInt (-41) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D26
fInt (-42) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D27
fInt (-43) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D28
fInt (-44) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D29
fInt (-45) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D30
fInt (-46) = FAReg -> Maybe FAReg
forall a. a -> Maybe a
Just FAReg
D31
fInt Int
_     = Maybe FAReg
forall a. Maybe a
Nothing