module Asm.Aarch64.CF ( mkControlFlow , expand , udd ) where import Asm.Aarch64 import Asm.BB import Asm.CF import Asm.M import CF import Class.E as E import Data.Functor (void, ($>)) import qualified Data.IntSet as IS mkControlFlow :: (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> [BB AArch64 reg freg f2reg () ControlAnn] mkControlFlow :: forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> [BB AArch64 reg freg f2reg () ControlAnn] mkControlFlow [BB AArch64 reg freg f2reg () ()] instrs = FreshM [BB AArch64 reg freg f2reg () ControlAnn] -> [BB AArch64 reg freg f2reg () ControlAnn] forall a. FreshM a -> a runFreshM ([BB AArch64 reg freg f2reg () ()] -> FreshM () forall reg freg f2reg a. [BB AArch64 reg freg f2reg a ()] -> FreshM () broadcasts [BB AArch64 reg freg f2reg () ()] instrs FreshM () -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] forall a b. StateT (N, Map Label N, Map Label [N]) Identity a -> StateT (N, Map Label N, Map Label [N]) Identity b -> StateT (N, Map Label N, Map Label [N]) Identity b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] addControlFlow [BB AArch64 reg freg f2reg () ()] instrs) expand :: (E reg, E freg, E f2reg) => BB AArch64 reg freg f2reg () Liveness -> [AArch64 reg freg f2reg Liveness] expand :: forall reg freg f2reg. (E reg, E freg, E f2reg) => BB AArch64 reg freg f2reg () Liveness -> [AArch64 reg freg f2reg Liveness] expand (BB asms :: [AArch64 reg freg f2reg ()] asms@(AArch64 reg freg f2reg () _:[AArch64 reg freg f2reg ()] _) Liveness li) = (AArch64 reg freg f2reg () -> AArch64 reg freg f2reg Liveness -> AArch64 reg freg f2reg Liveness) -> AArch64 reg freg f2reg Liveness -> [AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg Liveness] forall a b. (a -> b -> b) -> b -> [a] -> [b] scanr (\AArch64 reg freg f2reg () n AArch64 reg freg f2reg Liveness p -> AArch64 reg freg f2reg () -> Liveness -> AArch64 reg freg f2reg Liveness forall {freg} {f2reg} {reg} {a}. (E freg, E f2reg, E reg) => AArch64 reg freg f2reg a -> Liveness -> AArch64 reg freg f2reg Liveness lN AArch64 reg freg f2reg () n (AArch64 reg freg f2reg Liveness -> Liveness forall reg freg f2 a. AArch64 reg freg f2 a -> a ann AArch64 reg freg f2reg Liveness p)) AArch64 reg freg f2reg Liveness lS [AArch64 reg freg f2reg ()] iasms where lN :: AArch64 reg freg f2reg a -> Liveness -> AArch64 reg freg f2reg Liveness lN AArch64 reg freg f2reg a a Liveness s = let ai :: IntSet ai=AArch64 reg freg f2reg a -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet uses AArch64 reg freg f2reg a a IntSet -> IntSet -> IntSet forall a. Semigroup a => a -> a -> a <> (IntSet ao IntSet -> IntSet -> IntSet IS.\\ AArch64 reg freg f2reg a -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs AArch64 reg freg f2reg a a) ao :: IntSet ao=Liveness -> IntSet ins Liveness s aif :: IntSet aif=AArch64 reg freg f2reg a -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet usesF AArch64 reg freg f2reg a a IntSet -> IntSet -> IntSet forall a. Semigroup a => a -> a -> a <> (IntSet aof IntSet -> IntSet -> IntSet IS.\\ AArch64 reg freg f2reg a -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF AArch64 reg freg f2reg a a) aof :: IntSet aof=Liveness -> IntSet fins Liveness s in AArch64 reg freg f2reg a a AArch64 reg freg f2reg a -> Liveness -> AArch64 reg freg f2reg Liveness forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> IntSet -> IntSet -> IntSet -> IntSet -> Liveness Liveness IntSet ai IntSet ao IntSet aif IntSet aof lS :: AArch64 reg freg f2reg Liveness lS = let ao :: IntSet ao=Liveness -> IntSet out Liveness li aof :: IntSet aof=Liveness -> IntSet fout Liveness li in AArch64 reg freg f2reg () asm AArch64 reg freg f2reg () -> Liveness -> AArch64 reg freg f2reg Liveness forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> IntSet -> IntSet -> IntSet -> IntSet -> Liveness Liveness (AArch64 reg freg f2reg () -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet uses AArch64 reg freg f2reg () asm IntSet -> IntSet -> IntSet `IS.union` (IntSet ao IntSet -> IntSet -> IntSet `IS.difference` AArch64 reg freg f2reg () -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs AArch64 reg freg f2reg () asm)) IntSet ao (AArch64 reg freg f2reg () -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet usesF AArch64 reg freg f2reg () asm IntSet -> IntSet -> IntSet `IS.union` (IntSet aof IntSet -> IntSet -> IntSet `IS.difference` AArch64 reg freg f2reg () -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF AArch64 reg freg f2reg () asm)) IntSet aof ([AArch64 reg freg f2reg ()] iasms, AArch64 reg freg f2reg () asm) = ([AArch64 reg freg f2reg ()] -> [AArch64 reg freg f2reg ()] forall a. HasCallStack => [a] -> [a] init [AArch64 reg freg f2reg ()] asms, [AArch64 reg freg f2reg ()] -> AArch64 reg freg f2reg () forall a. HasCallStack => [a] -> a last [AArch64 reg freg f2reg ()] asms) expand BB AArch64 reg freg f2reg () Liveness _ = [] addControlFlow :: (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] addControlFlow :: forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] addControlFlow [] = [BB AArch64 reg freg f2reg () ControlAnn] -> StateT (N, Map Label N, Map Label [N]) Identity [BB AArch64 reg freg f2reg () ControlAnn] forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure [] addControlFlow (BB [] () _:[BB AArch64 reg freg f2reg () ()] bbs) = [BB AArch64 reg freg f2reg () ()] -> StateT (N, Map Label N, Map Label [N]) Identity [BB AArch64 reg freg f2reg () ControlAnn] forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] addControlFlow [BB AArch64 reg freg f2reg () ()] bbs addControlFlow (BB [AArch64 reg freg f2reg ()] asms () _:[BB AArch64 reg freg f2reg () ()] bbs) = do { i <- case [AArch64 reg freg f2reg ()] asms of (Label () _ Label l:[AArch64 reg freg f2reg ()] _) -> Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label l [AArch64 reg freg f2reg ()] _ -> StateT (N, Map Label N, Map Label [N]) Identity N getFresh ; (f, bbs') <- next bbs ; acc <- case last asms of B () _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure [l_i]} Bc () _ Cond _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure (f [l_i])} Tbnz () _ reg _ Word8 _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure $ f [l_i]} Tbz () _ reg _ Word8 _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure $ f [l_i]} Cbnz () _ reg _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure $ f [l_i]} C () _ Label lϵ -> do {l_i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N lookupLabel Label lϵ; pure $ f [l_i]} RetL () _ Label lϵ -> Label -> StateT (N, Map Label N, Map Label [N]) Identity [N] lC Label lϵ AArch64 reg freg f2reg () _ -> [N] -> StateT (N, Map Label N, Map Label [N]) Identity [N] forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure ([N] -> [N] f []) ; pure (BB asms (ControlAnn i acc (udb asms)) : bbs') } uA :: E reg => Addr reg -> IS.IntSet uA :: forall reg. E reg => Addr reg -> IntSet uA (R reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uA (RP reg r Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uA (BI reg b reg i Shift _) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg b, reg i] udb :: [AArch64 reg freg f2reg a] -> UD udb [AArch64 reg freg f2reg a] asms = IntSet -> IntSet -> IntSet -> IntSet -> UD UD ([AArch64 reg freg f2reg a] -> IntSet forall reg freg f2reg a. E reg => [AArch64 reg freg f2reg a] -> IntSet uBB [AArch64 reg freg f2reg a] asms) ([AArch64 reg freg f2reg a] -> IntSet forall freg f2reg reg a. (E freg, E f2reg) => [AArch64 reg freg f2reg a] -> IntSet uBBF [AArch64 reg freg f2reg a] asms) ([AArch64 reg freg f2reg a] -> IntSet forall reg freg f2reg a. E reg => [AArch64 reg freg f2reg a] -> IntSet dBB [AArch64 reg freg f2reg a] asms) ([AArch64 reg freg f2reg a] -> IntSet forall freg f2reg reg a. (E freg, E f2reg) => [AArch64 reg freg f2reg a] -> IntSet dBBF [AArch64 reg freg f2reg a] asms) udd :: AArch64 reg freg f2reg ann -> UD udd AArch64 reg freg f2reg ann asm = IntSet -> IntSet -> IntSet -> IntSet -> UD UD (AArch64 reg freg f2reg ann -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet uses AArch64 reg freg f2reg ann asm) (AArch64 reg freg f2reg ann -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet usesF AArch64 reg freg f2reg ann asm) (AArch64 reg freg f2reg ann -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs AArch64 reg freg f2reg ann asm) (AArch64 reg freg f2reg ann -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF AArch64 reg freg f2reg ann asm) uBB, dBB :: E reg => [AArch64 reg freg f2reg a] -> IS.IntSet uBB :: forall reg freg f2reg a. E reg => [AArch64 reg freg f2reg a] -> IntSet uBB = (AArch64 reg freg f2reg a -> IntSet -> IntSet) -> IntSet -> [AArch64 reg freg f2reg a] -> IntSet forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\AArch64 reg freg f2reg a p IntSet n -> AArch64 reg freg f2reg a -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet uses AArch64 reg freg f2reg a p IntSet -> IntSet -> IntSet `IS.union` (IntSet n IntSet -> IntSet -> IntSet IS.\\ AArch64 reg freg f2reg a -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs AArch64 reg freg f2reg a p)) IntSet IS.empty dBB :: forall reg freg f2reg a. E reg => [AArch64 reg freg f2reg a] -> IntSet dBB = (AArch64 reg freg f2reg a -> IntSet) -> [AArch64 reg freg f2reg a] -> IntSet forall m a. Monoid m => (a -> m) -> [a] -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap AArch64 reg freg f2reg a -> IntSet forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs uBBF, dBBF :: (E freg, E f2reg) => [AArch64 reg freg f2reg a] -> IS.IntSet uBBF :: forall freg f2reg reg a. (E freg, E f2reg) => [AArch64 reg freg f2reg a] -> IntSet uBBF = (AArch64 reg freg f2reg a -> IntSet -> IntSet) -> IntSet -> [AArch64 reg freg f2reg a] -> IntSet forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\AArch64 reg freg f2reg a p IntSet n -> AArch64 reg freg f2reg a -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet usesF AArch64 reg freg f2reg a p IntSet -> IntSet -> IntSet `IS.union` (IntSet n IntSet -> IntSet -> IntSet IS.\\ AArch64 reg freg f2reg a -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF AArch64 reg freg f2reg a p)) IntSet IS.empty dBBF :: forall freg f2reg reg a. (E freg, E f2reg) => [AArch64 reg freg f2reg a] -> IntSet dBBF = (AArch64 reg freg f2reg a -> IntSet) -> [AArch64 reg freg f2reg a] -> IntSet forall m a. Monoid m => (a -> m) -> [a] -> m forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap AArch64 reg freg f2reg a -> IntSet forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF defs, uses :: E reg => AArch64 reg freg f2reg a -> IS.IntSet uses :: forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet uses (MovRR a _ reg _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses MovRC{} = IntSet IS.empty uses FMovXX{} = IntSet IS.empty uses (Ldr a _ reg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (LdrB a _ reg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (Str a _ reg r Addr reg a) = N -> IntSet -> IntSet IS.insert (reg -> N forall a. E a => a -> N E.toInt reg r) (IntSet -> IntSet) -> IntSet -> IntSet forall a b. (a -> b) -> a -> b $ Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (StrB a _ reg r Addr reg a) = N -> IntSet -> IntSet IS.insert (reg -> N forall a. E a => a -> N E.toInt reg r) (IntSet -> IntSet) -> IntSet -> IntSet forall a b. (a -> b) -> a -> b $ Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (Ldp a _ reg _ reg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (Stp a _ reg r0 reg r1 Addr reg a) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] IntSet -> IntSet -> IntSet forall a. Semigroup a => a -> a -> a <> Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (LdrD a _ freg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (SubRR a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (AddRR a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (AddRRS a _ reg _ reg r0 reg r1 Word8 _) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (AndRR a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (OrRR a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (Eor a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (EorI a _ reg _ reg r0 BM _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r0 uses ZeroR{} = IntSet IS.empty uses (Mvn a _ reg _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (AddRC a _ reg _ reg r Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (SubRC a _ reg _ reg r Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Lsl a _ reg _ reg r Word8 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Asr a _ reg _ reg r Word8 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (CmpRR a _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (CmpRC a _ reg r Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Neg a _ reg _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses Fmul{} = IntSet IS.empty uses Fadd{} = IntSet IS.empty uses Fsub{} = IntSet IS.empty uses FcmpZ{} = IntSet IS.empty uses (StrD a _ freg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (MulRR a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses (Madd a _ reg _ reg r0 reg r1 reg r2) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1, reg r2] uses (Msub a _ reg _ reg r0 reg r1 reg r2) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1, reg r2] uses (Sdiv a _ reg _ reg r0 reg r1) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] uses Fdiv{} = IntSet IS.empty uses (Scvtf a _ freg _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses Fcvtms{} = IntSet IS.empty uses Fcvtas{} = IntSet IS.empty uses (FMovDR a _ freg _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (MovK a _ reg r Word16 _ N _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses MovZ{} = IntSet IS.empty uses Fcmp{} = IntSet IS.empty uses (StpD a _ freg _ freg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (Stp2 a _ f2reg _ f2reg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (LdpD a _ freg _ freg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses (Ldp2 a _ f2reg _ f2reg _ Addr reg a) = Addr reg -> IntSet forall reg. E reg => Addr reg -> IntSet uA Addr reg a uses Fmadd{} = IntSet IS.empty uses Fmsub{} = IntSet IS.empty uses Fsqrt{} = IntSet IS.empty uses Fneg{} = IntSet IS.empty uses Frintm{} = IntSet IS.empty uses MrsR{} = IntSet IS.empty uses (MovRCf a _ reg _ CFunc Free) = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg CArg0 uses (MovRCf a _ reg _ CFunc Malloc) = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg CArg0 uses MovRCf{} = IntSet IS.empty uses LdrRL{} = IntSet IS.empty uses (Blr a _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses Fmax{} = IntSet IS.empty uses Fmin{} = IntSet IS.empty uses Fabs{} = IntSet IS.empty uses (Csel a _ reg _ reg r1 reg r2 Cond _) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r1, reg r2] uses Fcsel{} = IntSet IS.empty uses (TstI a _ reg r BM _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses Label{} = IntSet IS.empty uses Bc{} = IntSet IS.empty uses B{} = IntSet IS.empty uses (Cbnz a _ reg r Label _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Cbz a _ reg r Label _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Tbnz a _ reg r Word8 _ Label _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses (Tbz a _ reg r Word8 _ Label _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r uses Ret{} = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg CArg0 uses Cset{} = IntSet IS.empty uses Bl{} = IntSet IS.empty uses C{} = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg ASP uses RetL{} = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg LR defs :: forall reg freg f2reg a. E reg => AArch64 reg freg f2reg a -> IntSet defs FMovXX{} = IntSet IS.empty defs (MovRC a _ reg r Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (MovRR a _ reg r reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Ldr a _ reg r Addr reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (LdrB a _ reg r Addr reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Str{} = IntSet IS.empty defs StrB{} = IntSet IS.empty defs LdrD{} = IntSet IS.empty defs LdpD{} = IntSet IS.empty defs Stp{} = IntSet IS.empty defs StpD{} = IntSet IS.empty defs Stp2{} = IntSet IS.empty defs Ldp2{} = IntSet IS.empty defs (Ldp a _ reg r0 reg r1 Addr reg _) = [reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [reg r0, reg r1] defs (SubRR a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (AddRR a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (AddRRS a _ reg r reg _ reg _ Word8 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (AndRR a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (OrRR a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Eor a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (EorI a _ reg r reg _ BM _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (ZeroR a _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Mvn a _ reg r reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (AddRC a _ reg r reg _ Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (SubRC a _ reg r reg _ Word16 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Lsl a _ reg r reg _ Word8 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Asr a _ reg r reg _ Word8 _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs CmpRC{} = IntSet IS.empty defs CmpRR{} = IntSet IS.empty defs (Neg a _ reg r reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Fmul{} = IntSet IS.empty defs Fadd{} = IntSet IS.empty defs Fsub{} = IntSet IS.empty defs FcmpZ{} = IntSet IS.empty defs StrD{} = IntSet IS.empty defs (MulRR a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Madd a _ reg r reg _ reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Msub a _ reg r reg _ reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Sdiv a _ reg r reg _ reg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Fdiv{} = IntSet IS.empty defs Scvtf{} = IntSet IS.empty defs (Fcvtms a _ reg r freg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (Fcvtas a _ reg r freg _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs FMovDR{} = IntSet IS.empty defs (MovK a _ reg r Word16 _ N _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs (MovZ a _ reg r Word16 _ N _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Fcmp{} = IntSet IS.empty defs Fmadd{} = IntSet IS.empty defs Fmsub{} = IntSet IS.empty defs Fsqrt{} = IntSet IS.empty defs Fneg{} = IntSet IS.empty defs Frintm{} = IntSet IS.empty defs (MrsR a _ reg r) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Blr{} = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg LR defs (MovRCf a _ reg r CFunc Malloc) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r IntSet -> IntSet -> IntSet forall a. Semigroup a => a -> a -> a <> AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg CArg0 defs (LdrRL a _ reg r N _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs MovRCf{} = IntSet IS.empty defs Fmax{} = IntSet IS.empty defs Fmin{} = IntSet IS.empty defs Fabs{} = IntSet IS.empty defs (Csel a _ reg r reg _ reg _ Cond _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Fcsel{} = IntSet IS.empty defs TstI{} = IntSet IS.empty defs Label{} = IntSet IS.empty defs Bc{} = IntSet IS.empty defs B{} = IntSet IS.empty defs Cbnz{} = IntSet IS.empty defs Cbz{} = IntSet IS.empty defs Tbnz{} = IntSet IS.empty defs Tbz{} = IntSet IS.empty defs Ret{} = IntSet IS.empty defs (Cset a _ reg r Cond _) = reg -> IntSet forall reg. E reg => reg -> IntSet singleton reg r defs Bl{} = AbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton AbsReg LR defs C{} = [AbsReg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [AbsReg LR, AbsReg FP] defs RetL{} = IntSet IS.empty defsF, usesF :: (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IS.IntSet defsF :: forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet defsF (FMovXX ann _ freg r freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF MovRR{} = IntSet IS.empty defsF MovRC{} = IntSet IS.empty defsF Ldr{} = IntSet IS.empty defsF LdrB{} = IntSet IS.empty defsF Str{} = IntSet IS.empty defsF StrB{} = IntSet IS.empty defsF (LdrD ann _ freg r Addr reg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF (Ldp2 ann _ f2reg q0 f2reg q1 Addr reg _) = [f2reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [f2reg q0, f2reg q1] defsF AddRR{} = IntSet IS.empty defsF AddRRS{} = IntSet IS.empty defsF SubRR{} = IntSet IS.empty defsF AndRR{} = IntSet IS.empty defsF OrRR{} = IntSet IS.empty defsF Eor{} = IntSet IS.empty defsF EorI{} = IntSet IS.empty defsF ZeroR{} = IntSet IS.empty defsF Mvn{} = IntSet IS.empty defsF AddRC{} = IntSet IS.empty defsF SubRC{} = IntSet IS.empty defsF Lsl{} = IntSet IS.empty defsF Asr{} = IntSet IS.empty defsF CmpRR{} = IntSet IS.empty defsF CmpRC{} = IntSet IS.empty defsF Neg{} = IntSet IS.empty defsF (Fmul ann _ freg r freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF (Fadd ann _ freg r freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF (Fsub ann _ freg r freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF FcmpZ{} = IntSet IS.empty defsF (Fdiv ann _ freg d freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF StrD{} = IntSet IS.empty defsF MulRR{} = IntSet IS.empty defsF Madd{} = IntSet IS.empty defsF Msub{} = IntSet IS.empty defsF Sdiv{} = IntSet IS.empty defsF (Scvtf ann _ freg r reg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF Fcvtms{} = IntSet IS.empty defsF Fcvtas{} = IntSet IS.empty defsF (FMovDR ann _ freg r reg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r defsF MovK{} = IntSet IS.empty defsF MovZ{} = IntSet IS.empty defsF Fcmp{} = IntSet IS.empty defsF (LdpD ann _ freg r0 freg r1 Addr reg _) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] defsF Ldp{} = IntSet IS.empty defsF Stp{} = IntSet IS.empty defsF StpD{} = IntSet IS.empty defsF Stp2{} = IntSet IS.empty defsF (Fmadd ann _ freg d0 freg _ freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d0 defsF (Fmsub ann _ freg d0 freg _ freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d0 defsF (Fsqrt ann _ freg d freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF (Fneg ann _ freg d freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF (Frintm ann _ freg d freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF MrsR{} = IntSet IS.empty defsF Blr{} = IntSet IS.empty defsF (MovRCf ann _ reg _ CFunc Exp) = FAbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton FAbsReg FArg0 defsF (MovRCf ann _ reg _ CFunc Log) = FAbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton FAbsReg FArg0 defsF (MovRCf ann _ reg _ CFunc Pow) = FAbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton FAbsReg FArg0 defsF MovRCf{} = IntSet IS.empty defsF LdrRL{} = IntSet IS.empty defsF (Fmax ann _ freg d freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF (Fmin ann _ freg d freg _ freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF (Fabs ann _ freg d freg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d defsF Csel{} = IntSet IS.empty defsF TstI{} = IntSet IS.empty defsF (Fcsel ann _ freg d0 freg _ freg _ Cond _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d0 defsF Label{} = IntSet IS.empty defsF Bc{} = IntSet IS.empty defsF B{} = IntSet IS.empty defsF Cbnz{} = IntSet IS.empty defsF Cbz{} = IntSet IS.empty defsF Tbnz{} = IntSet IS.empty defsF Tbz{} = IntSet IS.empty defsF Ret{} = IntSet IS.empty defsF RetL{} = IntSet IS.empty defsF Cset{} = IntSet IS.empty defsF Bl{} = IntSet IS.empty defsF C{} = IntSet IS.empty usesF :: forall freg f2reg reg ann. (E freg, E f2reg) => AArch64 reg freg f2reg ann -> IntSet usesF (FMovXX ann _ freg _ freg r) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r usesF MovRR{} = IntSet IS.empty usesF MovRC{} = IntSet IS.empty usesF Ldr{} = IntSet IS.empty usesF LdrB{} = IntSet IS.empty usesF LdrD{} = IntSet IS.empty usesF Str{} = IntSet IS.empty usesF StrB{} = IntSet IS.empty usesF AddRR{} = IntSet IS.empty usesF AddRRS{} = IntSet IS.empty usesF SubRR{} = IntSet IS.empty usesF ZeroR{} = IntSet IS.empty usesF Mvn{} = IntSet IS.empty usesF AndRR{} = IntSet IS.empty usesF OrRR{} = IntSet IS.empty usesF Eor{} = IntSet IS.empty usesF EorI{} = IntSet IS.empty usesF AddRC{} = IntSet IS.empty usesF SubRC{} = IntSet IS.empty usesF Lsl{} = IntSet IS.empty usesF Asr{} = IntSet IS.empty usesF CmpRR{} = IntSet IS.empty usesF CmpRC{} = IntSet IS.empty usesF Neg{} = IntSet IS.empty usesF (Fadd ann _ freg _ freg r0 freg r1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (Fsub ann _ freg _ freg r0 freg r1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (Fmul ann _ freg _ freg r0 freg r1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (FcmpZ ann _ freg r) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r usesF (Fdiv ann _ freg _ freg r0 freg r1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (StrD ann _ freg r Addr reg _) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r usesF MulRR{} = IntSet IS.empty usesF Madd{} = IntSet IS.empty usesF Msub{} = IntSet IS.empty usesF Sdiv{} = IntSet IS.empty usesF Scvtf{} = IntSet IS.empty usesF (Fcvtms ann _ reg _ freg r) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r usesF (Fcvtas ann _ reg _ freg r) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg r usesF MovK{} = IntSet IS.empty usesF MovZ{} = IntSet IS.empty usesF FMovDR{} = IntSet IS.empty usesF (Fcmp ann _ freg r0 freg r1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (StpD ann _ freg r0 freg r1 Addr reg _) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg r0, freg r1] usesF (Stp2 ann _ f2reg q0 f2reg q1 Addr reg _) = [f2reg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [f2reg q0, f2reg q1] usesF Ldp2{} = IntSet IS.empty usesF Stp{} = IntSet IS.empty usesF Ldp{} = IntSet IS.empty usesF LdpD{} = IntSet IS.empty usesF (Fmadd ann _ freg _ freg d0 freg d1 freg d2) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg d0, freg d1, freg d2] usesF (Fmsub ann _ freg _ freg d0 freg d1 freg d2) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg d0, freg d1, freg d2] usesF (Fsqrt ann _ freg _ freg d) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d usesF (Fneg ann _ freg _ freg d) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d usesF (Frintm ann _ freg _ freg d) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d usesF MrsR{} = IntSet IS.empty usesF Blr{} = IntSet IS.empty usesF (MovRCf ann _ reg _ CFunc Exp) = FAbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton FAbsReg FArg0 usesF (MovRCf ann _ reg _ CFunc Log) = FAbsReg -> IntSet forall reg. E reg => reg -> IntSet singleton FAbsReg FArg0 usesF (MovRCf ann _ reg _ CFunc Pow) = [FAbsReg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [FAbsReg FArg0, FAbsReg FArg1] usesF MovRCf{} = IntSet IS.empty usesF LdrRL{} = IntSet IS.empty usesF (Fmax ann _ freg _ freg d0 freg d1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg d0, freg d1] usesF (Fmin ann _ freg _ freg d0 freg d1) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg d0, freg d1] usesF (Fabs ann _ freg _ freg d) = freg -> IntSet forall reg. E reg => reg -> IntSet singleton freg d usesF Csel{} = IntSet IS.empty usesF TstI{} = IntSet IS.empty usesF (Fcsel ann _ freg _ freg d0 freg d1 Cond _) = [freg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [freg d0, freg d1] usesF Label{} = IntSet IS.empty usesF Bc{} = IntSet IS.empty usesF B{} = IntSet IS.empty usesF Cbnz{} = IntSet IS.empty usesF Cbz{} = IntSet IS.empty usesF Tbnz{} = IntSet IS.empty usesF Tbz{} = IntSet IS.empty usesF Ret{} = [FAbsReg] -> IntSet forall reg. E reg => [reg] -> IntSet fromList [FAbsReg FArg0, FAbsReg FArg1] usesF Cset{} = IntSet IS.empty usesF Bl{} = IntSet IS.empty usesF C{} = IntSet IS.empty usesF RetL{} = IntSet IS.empty next :: (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) next :: forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) next [BB AArch64 reg freg f2reg () ()] bbs = do nextBs <- [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] forall reg freg f2reg. (E reg, E freg, E f2reg) => [BB AArch64 reg freg f2reg () ()] -> FreshM [BB AArch64 reg freg f2reg () ControlAnn] addControlFlow [BB AArch64 reg freg f2reg () ()] bbs case nextBs of [] -> ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) -> StateT (N, Map Label N, Map Label [N]) Identity ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure ([N] -> [N] forall a. a -> a id, []) (BB AArch64 reg freg f2reg () ControlAnn b:[BB AArch64 reg freg f2reg () ControlAnn] _) -> ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) -> StateT (N, Map Label N, Map Label [N]) Identity ([N] -> [N], [BB AArch64 reg freg f2reg () ControlAnn]) forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure ((ControlAnn -> N node (BB AArch64 reg freg f2reg () ControlAnn -> ControlAnn forall (arch :: * -> * -> * -> * -> *) reg freg f2reg a b. BB arch reg freg f2reg a b -> b caBB BB AArch64 reg freg f2reg () ControlAnn b) N -> [N] -> [N] forall a. a -> [a] -> [a] :), [BB AArch64 reg freg f2reg () ControlAnn] nextBs) broadcasts :: [BB AArch64 reg freg f2reg a ()] -> FreshM () broadcasts :: forall reg freg f2reg a. [BB AArch64 reg freg f2reg a ()] -> FreshM () broadcasts [] = () -> FreshM () forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure () broadcasts ((BB asms :: [AArch64 reg freg f2reg a] asms@(AArch64 reg freg f2reg a asm:[AArch64 reg freg f2reg a] _) () _):bbs :: [BB AArch64 reg freg f2reg a ()] bbs@((BB (Label a _ Label retL:[AArch64 reg freg f2reg a] _) () _):[BB AArch64 reg freg f2reg a ()] _)) | C a _ Label l <- [AArch64 reg freg f2reg a] -> AArch64 reg freg f2reg a forall a. HasCallStack => [a] -> a last [AArch64 reg freg f2reg a] asms = do { i <- Label -> StateT (N, Map Label N, Map Label [N]) Identity N fm Label retL; b3 i l ; case asm of {Label a _ Label lϵ -> StateT (N, Map Label N, Map Label [N]) Identity N -> FreshM () forall (f :: * -> *) a. Functor f => f a -> f () void (StateT (N, Map Label N, Map Label [N]) Identity N -> FreshM ()) -> StateT (N, Map Label N, Map Label [N]) Identity N -> FreshM () forall a b. (a -> b) -> a -> b $ Label -> StateT (N, Map Label N, Map Label [N]) Identity N fm Label lϵ; AArch64 reg freg f2reg a _ -> () -> FreshM () forall a. a -> StateT (N, Map Label N, Map Label [N]) Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure ()} ; broadcasts bbs } broadcasts ((BB (Label a _ Label l:[AArch64 reg freg f2reg a] _) () _):[BB AArch64 reg freg f2reg a ()] asms) = Label -> StateT (N, Map Label N, Map Label [N]) Identity N fm Label l StateT (N, Map Label N, Map Label [N]) Identity N -> FreshM () -> FreshM () forall a b. StateT (N, Map Label N, Map Label [N]) Identity a -> StateT (N, Map Label N, Map Label [N]) Identity b -> StateT (N, Map Label N, Map Label [N]) Identity b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> [BB AArch64 reg freg f2reg a ()] -> FreshM () forall reg freg f2reg a. [BB AArch64 reg freg f2reg a ()] -> FreshM () broadcasts [BB AArch64 reg freg f2reg a ()] asms broadcasts (BB AArch64 reg freg f2reg a () _:[BB AArch64 reg freg f2reg a ()] asms) = [BB AArch64 reg freg f2reg a ()] -> FreshM () forall reg freg f2reg a. [BB AArch64 reg freg f2reg a ()] -> FreshM () broadcasts [BB AArch64 reg freg f2reg a ()] asms