module Asm.X86.Frame ( frameC ) where

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

frameC :: [X86 X86Reg FX86Reg Live] -> [X86 X86Reg FX86Reg ()]
frameC :: [X86 X86Reg FX86Reg Live] -> [X86 X86Reg FX86Reg ()]
frameC = [[X86 X86Reg FX86Reg ()]] -> [X86 X86Reg FX86Reg ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[X86 X86Reg FX86Reg ()]] -> [X86 X86Reg FX86Reg ()])
-> ([X86 X86Reg FX86Reg Live] -> [[X86 X86Reg FX86Reg ()]])
-> [X86 X86Reg FX86Reg Live]
-> [X86 X86Reg FX86Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet
-> IntSet -> [X86 X86Reg FX86Reg Live] -> [[X86 X86Reg FX86Reg ()]]
go IntSet
IS.empty IntSet
IS.empty
    where go :: IntSet
-> IntSet -> [X86 X86Reg FX86Reg Live] -> [[X86 X86Reg FX86Reg ()]]
go IntSet
_ IntSet
_ [] = []
          go IntSet
s IntSet
fs (X86 X86Reg FX86Reg Live
isn:[X86 X86Reg FX86Reg Live]
isns) =
            let i :: Live
i = X86 X86Reg FX86Reg Live -> Live
forall a. X86 X86Reg FX86Reg a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint X86 X86Reg FX86Reg 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 case X86 X86Reg FX86Reg Live
isn of
                Call Live
_ CFunc
cf ->
                    let
                        cs :: [X86Reg]
cs = CFunc -> [X86Reg] -> [X86Reg]
handleRax CFunc
cf ([X86Reg] -> [X86Reg]) -> [X86Reg] -> [X86Reg]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe X86Reg) -> [Int] -> [X86Reg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe X86Reg
fromInt ([Int] -> [X86Reg]) -> [Int] -> [X86Reg]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IS.toList IntSet
s
                        xms :: [FX86Reg]
xms = CFunc -> [FX86Reg] -> [FX86Reg]
mx CFunc
cf ([FX86Reg] -> [FX86Reg]) -> [FX86Reg] -> [FX86Reg]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe FX86Reg) -> [Int] -> [FX86Reg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe FX86Reg
fInt ([Int] -> [FX86Reg]) -> [Int] -> [FX86Reg]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IS.toList IntSet
fs
                        scratch :: Bool
scratch = Int -> Bool
forall a. Integral a => a -> Bool
odd([X86Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [X86Reg]
csInt -> Int -> Int
forall a. Num a => a -> a -> a
+[FX86Reg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FX86Reg]
xms)
                        save :: [X86 X86Reg freg ()]
save = (if Bool
scratch then ([X86 X86Reg freg ()]
-> [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a. [a] -> [a] -> [a]
++[() -> X86Reg -> Int64 -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> Int64 -> X86 reg freg a
ISubRI () X86Reg
Rsp Int64
8]) else [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a. a -> a
id)([X86 X86Reg freg ()] -> [X86 X86Reg freg ()])
-> [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a b. (a -> b) -> a -> b
$(X86Reg -> X86 X86Reg freg ()) -> [X86Reg] -> [X86 X86Reg freg ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> X86Reg -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> X86 reg freg a
Push ()) [X86Reg]
cs
                        restore :: [X86 X86Reg freg ()]
restore = (if Bool
scratch then (() -> X86Reg -> Int64 -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> Int64 -> X86 reg freg a
IAddRI () X86Reg
Rsp Int64
8X86 X86Reg freg () -> [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a. a -> [a] -> [a]
:) else [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a. a -> a
id)([X86 X86Reg freg ()] -> [X86 X86Reg freg ()])
-> [X86 X86Reg freg ()] -> [X86 X86Reg freg ()]
forall a b. (a -> b) -> a -> b
$(X86Reg -> X86 X86Reg freg ()) -> [X86Reg] -> [X86 X86Reg freg ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> X86Reg -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> X86 reg freg a
Pop ()) ([X86Reg] -> [X86Reg]
forall a. [a] -> [a]
reverse [X86Reg]
cs)
                        savex :: [X86 X86Reg FX86Reg ()]
savex = (FX86Reg -> [X86 X86Reg FX86Reg ()])
-> [FX86Reg] -> [X86 X86Reg FX86Reg ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FX86Reg -> [X86 X86Reg FX86Reg ()]
forall {freg}. freg -> [X86 X86Reg freg ()]
puxmm [FX86Reg]
xms
                        restorex :: [X86 X86Reg FX86Reg ()]
restorex = (FX86Reg -> [X86 X86Reg FX86Reg ()])
-> [FX86Reg] -> [X86 X86Reg FX86Reg ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FX86Reg -> [X86 X86Reg FX86Reg ()]
forall {freg}. freg -> [X86 X86Reg freg ()]
poxmm ([FX86Reg] -> [FX86Reg]
forall a. [a] -> [a]
reverse [FX86Reg]
xms)
                    in ([X86 X86Reg FX86Reg ()]
forall {freg}. [X86 X86Reg freg ()]
save [X86 X86Reg FX86Reg ()]
-> [X86 X86Reg FX86Reg ()] -> [X86 X86Reg FX86Reg ()]
forall a. [a] -> [a] -> [a]
++ [X86 X86Reg FX86Reg ()]
savex [X86 X86Reg FX86Reg ()]
-> [X86 X86Reg FX86Reg ()] -> [X86 X86Reg FX86Reg ()]
forall a. [a] -> [a] -> [a]
++ X86 X86Reg FX86Reg Live -> X86 X86Reg FX86Reg ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void X86 X86Reg FX86Reg Live
isn X86 X86Reg FX86Reg ()
-> [X86 X86Reg FX86Reg ()] -> [X86 X86Reg FX86Reg ()]
forall a. a -> [a] -> [a]
: [X86 X86Reg FX86Reg ()]
restorex [X86 X86Reg FX86Reg ()]
-> [X86 X86Reg FX86Reg ()] -> [X86 X86Reg FX86Reg ()]
forall a. [a] -> [a] -> [a]
++ [X86 X86Reg FX86Reg ()]
forall {freg}. [X86 X86Reg freg ()]
restore) [X86 X86Reg FX86Reg ()]
-> [[X86 X86Reg FX86Reg ()]] -> [[X86 X86Reg FX86Reg ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet -> [X86 X86Reg FX86Reg Live] -> [[X86 X86Reg FX86Reg ()]]
go IntSet
s' IntSet
fs' [X86 X86Reg FX86Reg Live]
isns
                X86 X86Reg FX86Reg Live
_ -> [X86 X86Reg FX86Reg Live -> X86 X86Reg FX86Reg ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void X86 X86Reg FX86Reg Live
isn] [X86 X86Reg FX86Reg ()]
-> [[X86 X86Reg FX86Reg ()]] -> [[X86 X86Reg FX86Reg ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet -> [X86 X86Reg FX86Reg Live] -> [[X86 X86Reg FX86Reg ()]]
go IntSet
s' IntSet
fs' [X86 X86Reg FX86Reg Live]
isns
          handleRax :: CFunc -> [X86Reg] -> [X86Reg]
handleRax CFunc
Malloc = (X86Reg -> Bool) -> [X86Reg] -> [X86Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (X86Reg -> X86Reg -> Bool
forall a. Eq a => a -> a -> Bool
/=X86Reg
Rax)
          handleRax CFunc
Free   = [X86Reg] -> [X86Reg]
forall a. a -> a
id
          handleRax CFunc
DR     = [X86Reg] -> [X86Reg]
forall a. a -> a
id
          puxmm :: freg -> [X86 X86Reg freg ()]
puxmm freg
xr = [() -> X86Reg -> Int64 -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> Int64 -> X86 reg freg a
ISubRI () X86Reg
Rsp Int64
8, () -> Addr X86Reg -> freg -> X86 X86Reg freg ()
forall reg freg a. a -> Addr reg -> freg -> X86 reg freg a
MovqAX () (X86Reg -> Addr X86Reg
forall reg. reg -> Addr reg
R X86Reg
Rsp) freg
xr]
          poxmm :: freg -> [X86 X86Reg freg ()]
poxmm freg
xr = [() -> freg -> Addr X86Reg -> X86 X86Reg freg ()
forall reg freg a. a -> freg -> Addr reg -> X86 reg freg a
MovqXA () freg
xr (X86Reg -> Addr X86Reg
forall reg. reg -> Addr reg
R X86Reg
Rsp), () -> X86Reg -> Int64 -> X86 X86Reg freg ()
forall reg freg a. a -> reg -> Int64 -> X86 reg freg a
IAddRI () X86Reg
Rsp Int64
8]
          mx :: CFunc -> [FX86Reg] -> [FX86Reg]
mx CFunc
Free   = [FX86Reg] -> [FX86Reg] -> [FX86Reg]
forall a b. a -> b -> a
const []
          mx CFunc
Malloc = [FX86Reg] -> [FX86Reg]
forall a. a -> a
id
          mx CFunc
DR     = (FX86Reg -> Bool) -> [FX86Reg] -> [FX86Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (FX86Reg -> FX86Reg -> Bool
forall a. Eq a => a -> a -> Bool
/=FX86Reg
XMM0)

fromInt :: Int -> Maybe X86Reg
fromInt :: Int -> Maybe X86Reg
fromInt Int
1    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
Rsi
fromInt Int
2    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
Rdx
fromInt Int
3    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
Rcx
fromInt Int
4    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
R8
fromInt Int
5    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
R9
fromInt Int
6    = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
Rax
fromInt (-1) = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
R10
fromInt (-2) = X86Reg -> Maybe X86Reg
forall a. a -> Maybe a
Just X86Reg
R11
fromInt Int
_    = Maybe X86Reg
forall a. Maybe a
Nothing

fInt :: Int -> Maybe FX86Reg
fInt :: Int -> Maybe FX86Reg
fInt Int
8     = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM0
fInt Int
9     = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM1
fInt Int
10    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM2
fInt Int
11    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM3
fInt Int
12    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM4
fInt Int
13    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM5
fInt Int
14    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM6
fInt Int
15    = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM7
fInt (-5)  = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM8
fInt (-6)  = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM9
fInt (-7)  = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM10
fInt (-8)  = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM11
fInt (-9)  = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM12
fInt (-10) = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM13
fInt (-11) = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM14
fInt (-12) = FX86Reg -> Maybe FX86Reg
forall a. a -> Maybe a
Just FX86Reg
XMM15
fInt Int
_     = Maybe FX86Reg
forall a. Maybe a
Nothing