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 F2X86 Live] -> [X86 X86Reg FX86Reg F2X86 ()]
frameC :: [X86 X86Reg FX86Reg F2X86 Live] -> [X86 X86Reg FX86Reg F2X86 ()]
frameC = [[X86 X86Reg FX86Reg F2X86 ()]] -> [X86 X86Reg FX86Reg F2X86 ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[X86 X86Reg FX86Reg F2X86 ()]] -> [X86 X86Reg FX86Reg F2X86 ()])
-> ([X86 X86Reg FX86Reg F2X86 Live]
    -> [[X86 X86Reg FX86Reg F2X86 ()]])
-> [X86 X86Reg FX86Reg F2X86 Live]
-> [X86 X86Reg FX86Reg F2X86 ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet
-> IntSet
-> [X86 X86Reg FX86Reg F2X86 Live]
-> [[X86 X86Reg FX86Reg F2X86 ()]]
forall {f2}.
IntSet
-> IntSet
-> [X86 X86Reg FX86Reg f2 Live]
-> [[X86 X86Reg FX86Reg f2 ()]]
go IntSet
IS.empty IntSet
IS.empty
    where go :: IntSet
-> IntSet
-> [X86 X86Reg FX86Reg f2 Live]
-> [[X86 X86Reg FX86Reg f2 ()]]
go IntSet
_ IntSet
_ [] = []
          go IntSet
s IntSet
fs (X86 X86Reg FX86Reg f2 Live
isn:[X86 X86Reg FX86Reg f2 Live]
isns) =
            let i :: Live
i = X86 X86Reg FX86Reg f2 Live -> Live
forall a. X86 X86Reg FX86Reg f2 a -> a
forall (p :: * -> *) a. Copointed p => p a -> a
copoint X86 X86Reg FX86Reg 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 case X86 X86Reg FX86Reg f2 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 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)([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 ())
-> [X86Reg] -> [X86 X86Reg freg f2 ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> X86Reg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> X86 reg freg f2 a
Push ()) [X86Reg]
cs
                        restore :: [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)([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 ())
-> [X86Reg] -> [X86 X86Reg freg f2 ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> X86Reg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> X86 reg freg f2 a
Pop ()) ([X86Reg] -> [X86Reg]
forall a. [a] -> [a]
reverse [X86Reg]
cs)
                        savex :: [X86 X86Reg FX86Reg f2 ()]
savex = (FX86Reg -> [X86 X86Reg FX86Reg f2 ()])
-> [FX86Reg] -> [X86 X86Reg FX86Reg f2 ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FX86Reg -> [X86 X86Reg FX86Reg f2 ()]
forall {freg} {f2}. freg -> [X86 X86Reg freg f2 ()]
puxmm [FX86Reg]
xms
                        restorex :: [X86 X86Reg FX86Reg f2 ()]
restorex = (FX86Reg -> [X86 X86Reg FX86Reg f2 ()])
-> [FX86Reg] -> [X86 X86Reg FX86Reg f2 ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FX86Reg -> [X86 X86Reg FX86Reg f2 ()]
forall {freg} {f2}. freg -> [X86 X86Reg freg f2 ()]
poxmm ([FX86Reg] -> [FX86Reg]
forall a. [a] -> [a]
reverse [FX86Reg]
xms)
                    in ([X86 X86Reg FX86Reg f2 ()]
forall {freg} {f2}. [X86 X86Reg freg f2 ()]
save [X86 X86Reg FX86Reg f2 ()]
-> [X86 X86Reg FX86Reg f2 ()] -> [X86 X86Reg FX86Reg f2 ()]
forall a. [a] -> [a] -> [a]
++ [X86 X86Reg FX86Reg f2 ()]
forall {f2}. [X86 X86Reg FX86Reg f2 ()]
savex [X86 X86Reg FX86Reg f2 ()]
-> [X86 X86Reg FX86Reg f2 ()] -> [X86 X86Reg FX86Reg f2 ()]
forall a. [a] -> [a] -> [a]
++ X86 X86Reg FX86Reg f2 Live -> X86 X86Reg FX86Reg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void X86 X86Reg FX86Reg f2 Live
isn X86 X86Reg FX86Reg f2 ()
-> [X86 X86Reg FX86Reg f2 ()] -> [X86 X86Reg FX86Reg f2 ()]
forall a. a -> [a] -> [a]
: [X86 X86Reg FX86Reg f2 ()]
forall {f2}. [X86 X86Reg FX86Reg f2 ()]
restorex [X86 X86Reg FX86Reg f2 ()]
-> [X86 X86Reg FX86Reg f2 ()] -> [X86 X86Reg FX86Reg f2 ()]
forall a. [a] -> [a] -> [a]
++ [X86 X86Reg FX86Reg f2 ()]
forall {freg} {f2}. [X86 X86Reg freg f2 ()]
restore) [X86 X86Reg FX86Reg f2 ()]
-> [[X86 X86Reg FX86Reg f2 ()]] -> [[X86 X86Reg FX86Reg f2 ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet
-> [X86 X86Reg FX86Reg f2 Live]
-> [[X86 X86Reg FX86Reg f2 ()]]
go IntSet
s' IntSet
fs' [X86 X86Reg FX86Reg f2 Live]
isns
                X86 X86Reg FX86Reg f2 Live
_ -> [X86 X86Reg FX86Reg f2 Live -> X86 X86Reg FX86Reg f2 ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void X86 X86Reg FX86Reg f2 Live
isn] [X86 X86Reg FX86Reg f2 ()]
-> [[X86 X86Reg FX86Reg f2 ()]] -> [[X86 X86Reg FX86Reg f2 ()]]
forall a. a -> [a] -> [a]
: IntSet
-> IntSet
-> [X86 X86Reg FX86Reg f2 Live]
-> [[X86 X86Reg FX86Reg f2 ()]]
go IntSet
s' IntSet
fs' [X86 X86Reg FX86Reg f2 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 f2 ()]
puxmm freg
xr = [() -> X86Reg -> Int64 -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 a
ISubRI () X86Reg
Rsp Int64
8, () -> Addr X86Reg -> freg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> Addr reg -> freg -> X86 reg freg f2 a
MovqAX () (X86Reg -> Addr X86Reg
forall reg. reg -> Addr reg
R X86Reg
Rsp) freg
xr]
          poxmm :: freg -> [X86 X86Reg freg f2 ()]
poxmm freg
xr = [() -> freg -> Addr X86Reg -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> freg -> Addr reg -> X86 reg freg f2 a
MovqXA () freg
xr (X86Reg -> Addr X86Reg
forall reg. reg -> Addr reg
R X86Reg
Rsp), () -> X86Reg -> Int64 -> X86 X86Reg freg f2 ()
forall reg freg f2 a. a -> reg -> Int64 -> X86 reg freg f2 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