{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

-- NOTE: http://wpage.unina.it/rcanonic/didattica/ce1/docs/68000.pdf

module Wrench.Isa.M68k (
    M68kIsa (..),
    Argument (..),
    Mode (..),
    M68kSt (..),
    IndexRegister (..),
    DataReg (..),
    dataRegisters,
    AddrReg (..),
) where

import Data.Bits (bit, complement, finiteBitSize, shiftL, shiftR, testBit, (.&.), (.|.))
import Data.Default (Default, def)
import Relude
import Relude.Extra
import Relude.Unsafe qualified as Unsafe
import Text.Megaparsec (choice, getOffset, notFollowedBy, oneOf, setOffset, try)
import Text.Megaparsec.Char (alphaNumChar, char, hspace, hspace1, string)
import Wrench.Machine.Memory
import Wrench.Machine.Types
import Wrench.Machine.Word
import Wrench.Report
import Wrench.Report.View (Format (..), format, lit, mkView)
import Wrench.Translator.Parser.Misc
import Wrench.Translator.Parser.Types
import Wrench.Translator.Types

data Mode
    = Long
    | Byte
    deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> [Char]
(Int -> Mode -> ShowS)
-> (Mode -> [Char]) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> [Char]
show :: Mode -> [Char]
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show)

longMode :: ParsecT Void [Char] Identity Mode
longMode = ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
".l") ParsecT Void [Char] Identity ()
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mode -> ParsecT Void [Char] Identity Mode
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Mode
Long

byteMode :: ParsecT Void [Char] Identity Mode
byteMode = ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
".b") ParsecT Void [Char] Identity ()
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mode -> ParsecT Void [Char] Identity Mode
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Mode
Byte

data DataReg = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7
    deriving (DataReg -> DataReg -> Bool
(DataReg -> DataReg -> Bool)
-> (DataReg -> DataReg -> Bool) -> Eq DataReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataReg -> DataReg -> Bool
== :: DataReg -> DataReg -> Bool
$c/= :: DataReg -> DataReg -> Bool
/= :: DataReg -> DataReg -> Bool
Eq, (forall x. DataReg -> Rep DataReg x)
-> (forall x. Rep DataReg x -> DataReg) -> Generic DataReg
forall x. Rep DataReg x -> DataReg
forall x. DataReg -> Rep DataReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataReg -> Rep DataReg x
from :: forall x. DataReg -> Rep DataReg x
$cto :: forall x. Rep DataReg x -> DataReg
to :: forall x. Rep DataReg x -> DataReg
Generic, ReadPrec [DataReg]
ReadPrec DataReg
Int -> ReadS DataReg
ReadS [DataReg]
(Int -> ReadS DataReg)
-> ReadS [DataReg]
-> ReadPrec DataReg
-> ReadPrec [DataReg]
-> Read DataReg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DataReg
readsPrec :: Int -> ReadS DataReg
$creadList :: ReadS [DataReg]
readList :: ReadS [DataReg]
$creadPrec :: ReadPrec DataReg
readPrec :: ReadPrec DataReg
$creadListPrec :: ReadPrec [DataReg]
readListPrec :: ReadPrec [DataReg]
Read, Int -> DataReg -> ShowS
[DataReg] -> ShowS
DataReg -> [Char]
(Int -> DataReg -> ShowS)
-> (DataReg -> [Char]) -> ([DataReg] -> ShowS) -> Show DataReg
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataReg -> ShowS
showsPrec :: Int -> DataReg -> ShowS
$cshow :: DataReg -> [Char]
show :: DataReg -> [Char]
$cshowList :: [DataReg] -> ShowS
showList :: [DataReg] -> ShowS
Show)

instance Hashable DataReg

dataRegisters :: [DataReg]
dataRegisters :: [DataReg]
dataRegisters = [DataReg
D0, DataReg
D1, DataReg
D2, DataReg
D3, DataReg
D4, DataReg
D5, DataReg
D6, DataReg
D7]

instance (Default w) => Default (HashMap DataReg w) where
    def :: HashMap DataReg w
def = [Item (HashMap DataReg w)] -> HashMap DataReg w
forall l. IsList l => [Item l] -> l
fromList ([Item (HashMap DataReg w)] -> HashMap DataReg w)
-> [Item (HashMap DataReg w)] -> HashMap DataReg w
forall a b. (a -> b) -> a -> b
$ (DataReg -> (DataReg, w)) -> [DataReg] -> [(DataReg, w)]
forall a b. (a -> b) -> [a] -> [b]
map (,w
forall a. Default a => a
def) [DataReg]
dataRegisters

data AddrReg = A0 | A1 | A2 | A3 | A4 | A5 | A6 | A7
    deriving (AddrReg -> AddrReg -> Bool
(AddrReg -> AddrReg -> Bool)
-> (AddrReg -> AddrReg -> Bool) -> Eq AddrReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrReg -> AddrReg -> Bool
== :: AddrReg -> AddrReg -> Bool
$c/= :: AddrReg -> AddrReg -> Bool
/= :: AddrReg -> AddrReg -> Bool
Eq, (forall x. AddrReg -> Rep AddrReg x)
-> (forall x. Rep AddrReg x -> AddrReg) -> Generic AddrReg
forall x. Rep AddrReg x -> AddrReg
forall x. AddrReg -> Rep AddrReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddrReg -> Rep AddrReg x
from :: forall x. AddrReg -> Rep AddrReg x
$cto :: forall x. Rep AddrReg x -> AddrReg
to :: forall x. Rep AddrReg x -> AddrReg
Generic, ReadPrec [AddrReg]
ReadPrec AddrReg
Int -> ReadS AddrReg
ReadS [AddrReg]
(Int -> ReadS AddrReg)
-> ReadS [AddrReg]
-> ReadPrec AddrReg
-> ReadPrec [AddrReg]
-> Read AddrReg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AddrReg
readsPrec :: Int -> ReadS AddrReg
$creadList :: ReadS [AddrReg]
readList :: ReadS [AddrReg]
$creadPrec :: ReadPrec AddrReg
readPrec :: ReadPrec AddrReg
$creadListPrec :: ReadPrec [AddrReg]
readListPrec :: ReadPrec [AddrReg]
Read, Int -> AddrReg -> ShowS
[AddrReg] -> ShowS
AddrReg -> [Char]
(Int -> AddrReg -> ShowS)
-> (AddrReg -> [Char]) -> ([AddrReg] -> ShowS) -> Show AddrReg
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrReg -> ShowS
showsPrec :: Int -> AddrReg -> ShowS
$cshow :: AddrReg -> [Char]
show :: AddrReg -> [Char]
$cshowList :: [AddrReg] -> ShowS
showList :: [AddrReg] -> ShowS
Show)

instance Hashable AddrReg

addrRegisters :: [AddrReg]
addrRegisters :: [AddrReg]
addrRegisters = [AddrReg
A0, AddrReg
A1, AddrReg
A2, AddrReg
A3, AddrReg
A4, AddrReg
A5, AddrReg
A6, AddrReg
A7]

instance (Default w) => Default (HashMap AddrReg w) where
    def :: HashMap AddrReg w
def = [Item (HashMap AddrReg w)] -> HashMap AddrReg w
forall l. IsList l => [Item l] -> l
fromList ([Item (HashMap AddrReg w)] -> HashMap AddrReg w)
-> [Item (HashMap AddrReg w)] -> HashMap AddrReg w
forall a b. (a -> b) -> a -> b
$ (AddrReg -> (AddrReg, w)) -> [AddrReg] -> [(AddrReg, w)]
forall a b. (a -> b) -> [a] -> [b]
map (,w
forall a. Default a => a
def) [AddrReg]
addrRegisters

data IndexRegister = AddrIndex AddrReg | DataIndex DataReg
    deriving (IndexRegister -> IndexRegister -> Bool
(IndexRegister -> IndexRegister -> Bool)
-> (IndexRegister -> IndexRegister -> Bool) -> Eq IndexRegister
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexRegister -> IndexRegister -> Bool
== :: IndexRegister -> IndexRegister -> Bool
$c/= :: IndexRegister -> IndexRegister -> Bool
/= :: IndexRegister -> IndexRegister -> Bool
Eq, Int -> IndexRegister -> ShowS
[IndexRegister] -> ShowS
IndexRegister -> [Char]
(Int -> IndexRegister -> ShowS)
-> (IndexRegister -> [Char])
-> ([IndexRegister] -> ShowS)
-> Show IndexRegister
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexRegister -> ShowS
showsPrec :: Int -> IndexRegister -> ShowS
$cshow :: IndexRegister -> [Char]
show :: IndexRegister -> [Char]
$cshowList :: [IndexRegister] -> ShowS
showList :: [IndexRegister] -> ShowS
Show)

-- | Note that for (A0)+ and −(A0), the actual increment or decrement value is dependent on the operand size: a byte access adjusts the address register by 1, a word by 2, and a long by 4.
data Argument w l
    = DirectDataReg DataReg
    | DirectAddrReg AddrReg
    | -- | Address with a 16-bit signed offset, e.g. 16(A0)
      -- TODO: Register indirect with index register & 8-bit signed offset e.g. 8(A0,D0) or 8(A0,A1)
      IndirectAddrReg Int AddrReg (Maybe IndexRegister)
    | -- | Address with pre-decrement, e.g. −(A0)
      IndirectAddrRegPreDecrement AddrReg
    | -- | Address with post-increment, e.g. (A0)+
      IndirectAddrRegPostIncrement AddrReg
    | Immediate l
    deriving (Argument w l -> Argument w l -> Bool
(Argument w l -> Argument w l -> Bool)
-> (Argument w l -> Argument w l -> Bool) -> Eq (Argument w l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w l. Eq l => Argument w l -> Argument w l -> Bool
$c== :: forall w l. Eq l => Argument w l -> Argument w l -> Bool
== :: Argument w l -> Argument w l -> Bool
$c/= :: forall w l. Eq l => Argument w l -> Argument w l -> Bool
/= :: Argument w l -> Argument w l -> Bool
Eq, Int -> Argument w l -> ShowS
[Argument w l] -> ShowS
Argument w l -> [Char]
(Int -> Argument w l -> ShowS)
-> (Argument w l -> [Char])
-> ([Argument w l] -> ShowS)
-> Show (Argument w l)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall w l. Show l => Int -> Argument w l -> ShowS
forall w l. Show l => [Argument w l] -> ShowS
forall w l. Show l => Argument w l -> [Char]
$cshowsPrec :: forall w l. Show l => Int -> Argument w l -> ShowS
showsPrec :: Int -> Argument w l -> ShowS
$cshow :: forall w l. Show l => Argument w l -> [Char]
show :: Argument w l -> [Char]
$cshowList :: forall w l. Show l => [Argument w l] -> ShowS
showList :: [Argument w l] -> ShowS
Show)

-- | The 'M68kIsa' type represents the instruction set architecture for the M68k machine.
-- Each constructor corresponds to a specific instruction.
data M68kIsa w l
    = Move {forall w l. M68kIsa w l -> Mode
mode :: Mode, forall w l. M68kIsa w l -> Argument w l
src, forall w l. M68kIsa w l -> Argument w l
dst :: Argument w l}
    | MoveA {mode :: Mode, src, dst :: Argument w l}
    | Not {mode :: Mode, dst :: Argument w l}
    | Neg {mode :: Mode, dst :: Argument w l}
    | Clr {mode :: Mode, dst :: Argument w l}
    | And {mode :: Mode, src, dst :: Argument w l}
    | Or {mode :: Mode, src, dst :: Argument w l}
    | Xor {mode :: Mode, src, dst :: Argument w l}
    | Add {mode :: Mode, src, dst :: Argument w l}
    | Sub {mode :: Mode, src, dst :: Argument w l}
    | Mul {mode :: Mode, src, dst :: Argument w l}
    | Div {mode :: Mode, src, dst :: Argument w l}
    | Cmp {mode :: Mode, src, dst :: Argument w l}
    | Asl {mode :: Mode, src, dst :: Argument w l}
    | Asr {mode :: Mode, src, dst :: Argument w l}
    | Lsl {mode :: Mode, src, dst :: Argument w l}
    | Lsr {mode :: Mode, src, dst :: Argument w l}
    | Jmp {forall w l. M68kIsa w l -> l
ref :: l}
    | Bcc {ref :: l}
    | Bcs {ref :: l}
    | Beq {ref :: l}
    | Bne {ref :: l}
    | Blt {ref :: l}
    | Bgt {ref :: l}
    | Ble {ref :: l}
    | Bge {ref :: l}
    | Bmi {ref :: l}
    | Bpl {ref :: l}
    | Bvc {ref :: l}
    | Bvs {ref :: l}
    | Jsr {ref :: l}
    | Rts
    | Link {forall w l. M68kIsa w l -> AddrReg
addrReg :: AddrReg, forall w l. M68kIsa w l -> Int
offset :: Int}
    | Unlk {addrReg :: AddrReg}
    | Halt
    deriving (M68kIsa w l -> M68kIsa w l -> Bool
(M68kIsa w l -> M68kIsa w l -> Bool)
-> (M68kIsa w l -> M68kIsa w l -> Bool) -> Eq (M68kIsa w l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w l. Eq l => M68kIsa w l -> M68kIsa w l -> Bool
$c== :: forall w l. Eq l => M68kIsa w l -> M68kIsa w l -> Bool
== :: M68kIsa w l -> M68kIsa w l -> Bool
$c/= :: forall w l. Eq l => M68kIsa w l -> M68kIsa w l -> Bool
/= :: M68kIsa w l -> M68kIsa w l -> Bool
Eq, Int -> M68kIsa w l -> ShowS
[M68kIsa w l] -> ShowS
M68kIsa w l -> [Char]
(Int -> M68kIsa w l -> ShowS)
-> (M68kIsa w l -> [Char])
-> ([M68kIsa w l] -> ShowS)
-> Show (M68kIsa w l)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall w l. Show l => Int -> M68kIsa w l -> ShowS
forall w l. Show l => [M68kIsa w l] -> ShowS
forall w l. Show l => M68kIsa w l -> [Char]
$cshowsPrec :: forall w l. Show l => Int -> M68kIsa w l -> ShowS
showsPrec :: Int -> M68kIsa w l -> ShowS
$cshow :: forall w l. Show l => M68kIsa w l -> [Char]
show :: M68kIsa w l -> [Char]
$cshowList :: forall w l. Show l => [M68kIsa w l] -> ShowS
showList :: [M68kIsa w l] -> ShowS
Show)

instance CommentStart (M68kIsa w l) where
    commentStart :: [Char]
commentStart = [Char]
";"

instance (IsWord w) => MnemonicParser (M68kIsa w (Ref w)) where
    mnemonic :: Parser (M68kIsa w (Ref w))
mnemonic =
        [Parser (M68kIsa w (Ref w))] -> Parser (M68kIsa w (Ref w))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"move" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Move (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"movea" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
MoveA ParsecT Void [Char] Identity Mode
longMode Parser (Argument w (Ref w))
srcMovea Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
addrRegister
            , [Char]
-> (Mode -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a w.
[Char]
-> (Mode -> a -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser (M68kIsa w (Ref w))
cmd1args [Char]
"not" Mode -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> M68kIsa w l
Not (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a w.
[Char]
-> (Mode -> a -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser (M68kIsa w (Ref w))
cmd1args [Char]
"neg" Mode -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> M68kIsa w l
Neg (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a w.
[Char]
-> (Mode -> a -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser (M68kIsa w (Ref w))
cmd1args [Char]
"clr" Mode -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> M68kIsa w l
Clr (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"and" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
And (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"or" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Or (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"xor" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Xor (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"add" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Add (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"sub" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Sub (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"mul" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Mul (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"div" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Div (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"cmp" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Cmp (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
src Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"asl" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Asl (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
shiftCount Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"asr" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Asr (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
shiftCount Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"lsl" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Lsl (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
shiftCount Parser (Argument w (Ref w))
dst
            , [Char]
-> (Mode
    -> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w))
-> Parser (M68kIsa w (Ref w))
forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
"lsr" Mode
-> Argument w (Ref w) -> Argument w (Ref w) -> M68kIsa w (Ref w)
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Lsr (ParsecT Void [Char] Identity Mode
longMode ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity Mode
byteMode) Parser (Argument w (Ref w))
shiftCount Parser (Argument w (Ref w))
dst
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"jmp" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Jmp ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bcc" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bcc ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bcs" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bcs ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"beq" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Beq ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bne" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bne ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"blt" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Blt ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bgt" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bgt ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"ble" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Ble ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bge" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bge ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bmi" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bmi ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bpl" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bpl ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bvc" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bvc ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"bvs" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Bvs ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char]
-> (Ref w -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (M68kIsa w (Ref w))
forall {t} {b}.
[Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd [Char]
"jsr" Ref w -> M68kIsa w (Ref w)
forall w l. l -> M68kIsa w l
Jsr ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char] -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
forall w. [Char] -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
cmd0args [Char]
"rts" M68kIsa w (Ref w)
forall w l. M68kIsa w l
Rts
            , do
                addrReg <- ParsecT Void [Char] Identity AddrReg
-> ParsecT Void [Char] Identity AddrReg
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity AddrReg
 -> ParsecT Void [Char] Identity AddrReg)
-> ParsecT Void [Char] Identity AddrReg
-> ParsecT Void [Char] Identity AddrReg
forall a b. (a -> b) -> a -> b
$ do
                    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"link"
                    ParsecT Void [Char] Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
                    ParsecT Void [Char] Identity AddrReg
addrRegister'
                hspace >> comma >> hspace
                operandPos <- getOffset
                offset <- optional intLiteral
                displacement <- maybe (return 0) (requireDisplacement displacementBits operandPos) offset
                eol' ";"
                return $ Link addrReg displacement
            , Parser (M68kIsa w (Ref w)) -> Parser (M68kIsa w (Ref w))
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (M68kIsa w (Ref w)) -> Parser (M68kIsa w (Ref w)))
-> Parser (M68kIsa w (Ref w)) -> Parser (M68kIsa w (Ref w))
forall a b. (a -> b) -> a -> b
$ do
                ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"unlk"
                ParsecT Void [Char] Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
                addrReg <- ParsecT Void [Char] Identity AddrReg
addrRegister'
                eol' ";"
                return $ Unlk addrReg
            , [Char] -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
forall w. [Char] -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
cmd0args [Char]
"halt" M68kIsa w (Ref w)
forall w l. M68kIsa w l
Halt
            ]
        where
            -- Generic source for instructions where Address Register Direct
            -- is *not* a valid mode (move, add, sub, cmp, mul, div, logical
            -- ops, shifts). @immidiate@ refuses register-shaped tokens, so
            -- @move.l A2, D0@ produces a clean parse error instead of
            -- silently consuming @A2@ as a label (issue #143).
            src :: Parser (Argument w (Ref w))
src = Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
dataRegister Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
allIndirectAddr Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall w. IsWord w => Parser (Argument w (Ref w))
immidiate
            -- @movea@ is the one instruction that legitimately takes An as
            -- source (e.g. @movea.l A2, A0@), so it gets a wider source.
            srcMovea :: Parser (Argument w (Ref w))
srcMovea = Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
dataRegister Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
addrRegister Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
allIndirectAddr Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall w. IsWord w => Parser (Argument w (Ref w))
immidiate
            dst :: Parser (Argument w (Ref w))
dst = Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
dataRegister Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
allIndirectAddr
            shiftCount :: Parser (Argument w (Ref w))
shiftCount = Parser (Argument w (Ref w))
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
dataRegister Parser (Argument w (Ref w))
-> Parser (Argument w (Ref w)) -> Parser (Argument w (Ref w))
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Ref w -> Argument w (Ref w)
forall w l. l -> Argument w l
Immediate (Ref w -> Argument w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Argument w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
constantRef)

cmd0args :: String -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
cmd0args :: forall w. [Char] -> M68kIsa w (Ref w) -> Parser (M68kIsa w (Ref w))
cmd0args [Char]
mnemonic M68kIsa w (Ref w)
constructor = ParsecT Void [Char] Identity (M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity (M68kIsa w (Ref w))
 -> ParsecT Void [Char] Identity (M68kIsa w (Ref w)))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
mnemonic
    [Char] -> ParsecT Void [Char] Identity ()
eol' [Char]
";"
    M68kIsa w (Ref w)
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return M68kIsa w (Ref w)
constructor

cmd1args ::
    String
    -> (Mode -> a -> M68kIsa w (Ref w))
    -> Parser Mode
    -> Parser a
    -> Parser (M68kIsa w (Ref w))
cmd1args :: forall a w.
[Char]
-> (Mode -> a -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser (M68kIsa w (Ref w))
cmd1args [Char]
mnemonic Mode -> a -> M68kIsa w (Ref w)
constructor ParsecT Void [Char] Identity Mode
modeP Parser a
dstP = ParsecT Void [Char] Identity (M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity (M68kIsa w (Ref w))
 -> ParsecT Void [Char] Identity (M68kIsa w (Ref w)))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity (M68kIsa w (Ref w))
forall a b. (a -> b) -> a -> b
$ do
    m <- do
        ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
mnemonic
        m <- ParsecT Void [Char] Identity Mode
modeP
        hspace1
        return m
    a <- dstP
    eol' ";"
    return $ constructor m a

cmd2args ::
    String
    -> (Mode -> a -> b -> M68kIsa w (Ref w))
    -> Parser Mode
    -> Parser a
    -> Parser b
    -> Parser (M68kIsa w (Ref w))
cmd2args :: forall a b w.
[Char]
-> (Mode -> a -> b -> M68kIsa w (Ref w))
-> ParsecT Void [Char] Identity Mode
-> Parser a
-> Parser b
-> Parser (M68kIsa w (Ref w))
cmd2args [Char]
mnemonic Mode -> a -> b -> M68kIsa w (Ref w)
constructor ParsecT Void [Char] Identity Mode
modeP Parser a
srcP Parser b
dstP = do
    m <- ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity Mode
 -> ParsecT Void [Char] Identity Mode)
-> ParsecT Void [Char] Identity Mode
-> ParsecT Void [Char] Identity Mode
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
mnemonic
        m <- ParsecT Void [Char] Identity Mode
modeP
        hspace1
        return m
    a <- srcP
    comma
    b <- dstP
    eol' ";"
    return $ constructor m a b

branchCmd :: Tokens [Char]
-> (t -> b)
-> ParsecT Void [Char] Identity t
-> ParsecT Void [Char] Identity b
branchCmd Tokens [Char]
mnemonic t -> b
constructor ParsecT Void [Char] Identity t
ref = do
    ParsecT Void [Char] Identity () -> ParsecT Void [Char] Identity ()
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity ()
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity ()
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
mnemonic
        ParsecT Void [Char] Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
    a <- ParsecT Void [Char] Identity t
ref
    eol' ";"
    return $ constructor a

dataRegister' :: ParsecT Void [Char] Identity DataReg
dataRegister' = ParsecT Void [Char] Identity DataReg
-> ParsecT Void [Char] Identity DataReg
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity DataReg
 -> ParsecT Void [Char] Identity DataReg)
-> ParsecT Void [Char] Identity DataReg
-> ParsecT Void [Char] Identity DataReg
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"D")
    n <- [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'7']
    return $ Unsafe.read ['D', n]

dataRegister :: ParsecT Void [Char] Identity (Argument w l)
dataRegister = DataReg -> Argument w l
forall w l. DataReg -> Argument w l
DirectDataReg (DataReg -> Argument w l)
-> ParsecT Void [Char] Identity DataReg
-> ParsecT Void [Char] Identity (Argument w l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity DataReg
dataRegister'

addrRegister' :: ParsecT Void [Char] Identity AddrReg
addrRegister' = ParsecT Void [Char] Identity AddrReg
-> ParsecT Void [Char] Identity AddrReg
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity AddrReg
 -> ParsecT Void [Char] Identity AddrReg)
-> ParsecT Void [Char] Identity AddrReg
-> ParsecT Void [Char] Identity AddrReg
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"A")
    n <- [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'7']
    return $ Unsafe.read ['A', n]

addrRegister :: ParsecT Void [Char] Identity (Argument w l)
addrRegister = AddrReg -> Argument w l
forall w l. AddrReg -> Argument w l
DirectAddrReg (AddrReg -> Argument w l)
-> ParsecT Void [Char] Identity AddrReg
-> ParsecT Void [Char] Identity (Argument w l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity AddrReg
addrRegister'

-- | @d(An)@ and @link@ have a whole extension word for the displacement.
displacementBits :: Int
displacementBits :: Int
displacementBits = Int
16

-- | @d(An, Xn)@ shares a brief extension word with its index register, which
-- leaves the displacement a byte -- see the note on 'Argument'.
indexedDisplacementBits :: Int
indexedDisplacementBits :: Int
indexedDisplacementBits = Int
8

requireDisplacement :: Int -> Int -> Int -> Parser Int
requireDisplacement :: Int -> Int -> Int -> ParsecT Void [Char] Identity Int
requireDisplacement Int
fieldBits Int
operandPos Int
value
    | Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
value Bool -> Bool -> Bool
&& Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi = Int -> ParsecT Void [Char] Identity Int
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
value
    | Bool
otherwise = do
        Int -> ParsecT Void [Char] Identity ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
operandPos
        [Char] -> ParsecT Void [Char] Identity Int
forall a. [Char] -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> ParsecT Void [Char] Identity Int)
-> [Char] -> ParsecT Void [Char] Identity Int
forall a b. (a -> b) -> a -> b
$
            [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"displacement "
                , Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
value
                , [Char]
" doesn't fit the "
                , Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
fieldBits
                , [Char]
"-bit signed field of an extension word, expected "
                , Integer -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Integer
lo
                , [Char]
".."
                , Integer -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Integer
hi
                ]
    where
        hi :: Integer
hi = Int -> Integer
forall a. Bits a => Int -> a
bit (Int
fieldBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 :: Integer
        lo :: Integer
lo = Integer -> Integer
forall a. Num a => a -> a
negate (Int -> Integer
forall a. Bits a => Int -> a
bit (Int
fieldBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) :: Integer

indirectAddrRegister :: ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegister = do
    (operandPos, offset, n, index) <- ParsecT
  Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister)
-> ParsecT
     Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister)
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT
   Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister)
 -> ParsecT
      Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister))
-> ParsecT
     Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister)
-> ParsecT
     Void [Char] Identity (Int, Maybe Int, Char, Maybe IndexRegister)
forall a b. (a -> b) -> a -> b
$ do
        operandPos <- ParsecT Void [Char] Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
        offset <- optional intLiteral
        void (string "(")
        hspace
        void (string "A")
        n <- oneOf ['0' .. '7']
        hspace
        index <- optional $ do
            void (string ",")
            hspace
            choice [DataIndex <$> dataRegister', AddrIndex <$> addrRegister']
        void (string ")")
        return (operandPos, offset, n, index)
    displacement <- case (offset, index) of
        (Maybe Int
Nothing, Maybe IndexRegister
_) -> Int -> ParsecT Void [Char] Identity Int
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        (Just Int
value, Maybe IndexRegister
Nothing) -> Int -> Int -> Int -> ParsecT Void [Char] Identity Int
requireDisplacement Int
displacementBits Int
operandPos Int
value
        (Just Int
value, Just IndexRegister
_) -> Int -> Int -> Int -> ParsecT Void [Char] Identity Int
requireDisplacement Int
indexedDisplacementBits Int
operandPos Int
value
    return $ IndirectAddrReg displacement (Unsafe.read ['A', n]) index

indirectAddrRegPreDecrement :: ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegPreDecrement = ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity (Argument w l)
 -> ParsecT Void [Char] Identity (Argument w l))
-> ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"-(")
    ParsecT Void [Char] Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"A")
    n <- [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'7']
    hspace
    void (string ")")
    return $ IndirectAddrRegPreDecrement $ Unsafe.read ['A', n]

indirectAddrRegPostIncrement :: ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegPostIncrement = ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity (Argument w l)
 -> ParsecT Void [Char] Identity (Argument w l))
-> ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"(")
    ParsecT Void [Char] Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
    ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens [Char]
"A")
    n <- [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'7']
    hspace
    void (string ")+")
    return $ IndirectAddrRegPostIncrement $ Unsafe.read ['A', n]

allIndirectAddr :: ParsecT Void [Char] Identity (Argument w l)
allIndirectAddr = ParsecT Void [Char] Identity (Argument w l)
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegPreDecrement ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity (Argument w l)
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegPostIncrement ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
-> ParsecT Void [Char] Identity (Argument w l)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity (Argument w l)
forall {w} {l}. ParsecT Void [Char] Identity (Argument w l)
indirectAddrRegister

-- | A bare register name (e.g. @A2@, @D3@) at the start of the input.
--   Used as a negative guard so @immidiate@ refuses to consume register
--   names as labels.
registerLikeName :: Parser ()
registerLikeName :: ParsecT Void [Char] Identity ()
registerLikeName = ParsecT Void [Char] Identity () -> ParsecT Void [Char] Identity ()
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity ()
 -> ParsecT Void [Char] Identity ())
-> ParsecT Void [Char] Identity ()
-> ParsecT Void [Char] Identity ()
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void [Char] Identity (Token [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'A', Char
'D'])
    ParsecT Void [Char] Identity (Token [Char])
-> ParsecT Void [Char] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'7'])
    ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity ()
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'_')

immidiate :: (IsWord w) => Parser (Argument w (Ref w))
immidiate :: forall w. IsWord w => Parser (Argument w (Ref w))
immidiate = do
    ParsecT Void [Char] Identity () -> ParsecT Void [Char] Identity ()
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void [Char] Identity ()
registerLikeName
    Ref w -> Argument w (Ref w)
forall w l. l -> Argument w l
Immediate (Ref w -> Argument w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Argument w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference

instance (IsWord w) => DerefMnemonic (M68kIsa w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> M68kIsa w (Ref w) -> M68kIsa w w
derefMnemonic Text -> Maybe w
f w
_offset M68kIsa w (Ref w)
i =
        let modeSuffix :: Mode -> a
modeSuffix Mode
Long = a
".l"
            modeSuffix Mode
Byte = a
".b"
            shiftCountErr :: a -> a -> a
shiftCountErr a
mnemonic a
x = a
mnemonic a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": shift count " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" is not in 0..31"
            byteImmErr :: a -> a -> a
byteImmErr a
mnemonic a
x = a
mnemonic a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".b: immediate " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" is not in -128..255"
            -- A byte-mode operation reads one byte of its immediate, so a wider
            -- value has nowhere to go.
            derefSrc :: Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
mnemonic Mode
Byte (Immediate Ref w
l) = w -> Argument w w
forall w l. l -> Argument w l
Immediate (w -> Argument w w) -> w -> Argument w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
b8 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
byteImmErr Text
mnemonic)) Text -> Maybe w
f Ref w
l
            derefSrc Text
_ Mode
_ Argument w (Ref w)
arg = Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
arg
            derefShiftCount :: Text -> Mode -> Argument w (Ref w) -> Argument w w
derefShiftCount Text
mnemonic Mode
mode (Immediate Ref w
l) =
                w -> Argument w w
forall w l. l -> Argument w l
Immediate (w -> Argument w w) -> w -> Argument w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u5 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
shiftCountErr (Text
mnemonic Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Mode -> Text
forall {a}. IsString a => Mode -> a
modeSuffix Mode
mode))) Text -> Maybe w
f Ref w
l
            derefShiftCount Text
_ Mode
_ Argument w (Ref w)
arg = Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
arg
            derefArg :: Argument w (Ref w) -> Argument w w
derefArg (DirectDataReg DataReg
r) = DataReg -> Argument w w
forall w l. DataReg -> Argument w l
DirectDataReg DataReg
r
            derefArg (DirectAddrReg AddrReg
r) = AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
DirectAddrReg AddrReg
r
            derefArg (IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index) = Int -> AddrReg -> Maybe IndexRegister -> Argument w w
forall w l. Int -> AddrReg -> Maybe IndexRegister -> Argument w l
IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index
            derefArg (IndirectAddrRegPreDecrement AddrReg
r) = AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
IndirectAddrRegPreDecrement AddrReg
r
            derefArg (IndirectAddrRegPostIncrement AddrReg
r) = AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
IndirectAddrRegPostIncrement AddrReg
r
            derefArg (Immediate Ref w
l) = w -> Argument w w
forall w l. l -> Argument w l
Immediate (w -> Argument w w) -> w -> Argument w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
l
         in case M68kIsa w (Ref w)
i of
                Move{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Move Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"move" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                MoveA{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
MoveA Mode
mode (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Not{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> M68kIsa w l
Not Mode
mode (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Neg{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> M68kIsa w l
Neg Mode
mode (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Clr{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> M68kIsa w l
Clr Mode
mode (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                And{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
And Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"and" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Or{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Or Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"or" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Xor{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Xor Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"xor" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Add{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Add Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"add" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Sub{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Sub Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"sub" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Mul{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Mul Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"mul" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Div{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Div Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"div" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Cmp{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Cmp Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefSrc Text
"cmp" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Asl{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Asl Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefShiftCount Text
"asl" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Asr{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Asr Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefShiftCount Text
"asr" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Lsl{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Lsl Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefShiftCount Text
"lsl" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Lsr{Mode
mode :: forall w l. M68kIsa w l -> Mode
mode :: Mode
mode, Argument w (Ref w)
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w (Ref w)
src, Argument w (Ref w)
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w (Ref w)
dst} -> Mode -> Argument w w -> Argument w w -> M68kIsa w w
forall w l. Mode -> Argument w l -> Argument w l -> M68kIsa w l
Lsr Mode
mode (Text -> Mode -> Argument w (Ref w) -> Argument w w
derefShiftCount Text
"lsr" Mode
mode Argument w (Ref w)
src) (Argument w (Ref w) -> Argument w w
derefArg Argument w (Ref w)
dst)
                Jmp{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Jmp ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bcc{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bcc ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bcs{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bcs ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Beq{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Beq ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bne{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bne ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Blt{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Blt ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bgt{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bgt ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Ble{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Ble ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bge{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bge ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bmi{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bmi ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bpl{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bpl ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bvc{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bvc ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Bvs{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Bvs ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                Jsr{Ref w
ref :: forall w l. M68kIsa w l -> l
ref :: Ref w
ref} -> w -> M68kIsa w w
forall w l. l -> M68kIsa w l
Jsr ((w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef w -> Either Text w
forall a b. b -> Either a b
Right Text -> Maybe w
f Ref w
ref)
                M68kIsa w (Ref w)
Rts -> M68kIsa w w
forall w l. M68kIsa w l
Rts
                Link{AddrReg
addrReg :: forall w l. M68kIsa w l -> AddrReg
addrReg :: AddrReg
addrReg, Int
offset :: forall w l. M68kIsa w l -> Int
offset :: Int
offset} -> AddrReg -> Int -> M68kIsa w w
forall w l. AddrReg -> Int -> M68kIsa w l
Link AddrReg
addrReg Int
offset
                Unlk{AddrReg
addrReg :: forall w l. M68kIsa w l -> AddrReg
addrReg :: AddrReg
addrReg} -> AddrReg -> M68kIsa w w
forall w l. AddrReg -> M68kIsa w l
Unlk AddrReg
addrReg
                M68kIsa w (Ref w)
Halt -> M68kIsa w w
forall w l. M68kIsa w l
Halt

instance (ByteSizeT w) => ByteSize (Argument w l) where
    byteSize :: Argument w l -> Int
byteSize (DirectDataReg DataReg
_) = Int
0
    byteSize (DirectAddrReg AddrReg
_) = Int
0
    byteSize (IndirectAddrReg{}) = Int
2
    byteSize (IndirectAddrRegPreDecrement AddrReg
_) = Int
0
    byteSize (IndirectAddrRegPostIncrement AddrReg
_) = Int
0
    byteSize (Immediate l
_) = forall t. ByteSizeT t => Int
byteSizeT @w

instance (ByteSizeT w) => ByteSize (M68kIsa w l) where
    byteSize :: M68kIsa w l -> Int
byteSize (Move Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (MoveA Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Not Mode
_mode Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Neg Mode
_mode Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Clr Mode
_mode Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (And Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Or Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Xor Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Add Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Sub Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Mul Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Div Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Cmp Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Asl Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Asr Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Lsl Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Lsr Mode
_mode Argument w l
src Argument w l
dst) = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Argument w l -> Int
forall t. ByteSize t => t -> Int
byteSize Argument w l
dst
    byteSize (Jmp l
_) = Int
6
    byteSize (Bcc l
_) = Int
6
    byteSize (Bcs l
_) = Int
6
    byteSize (Beq l
_) = Int
6
    byteSize (Bne l
_) = Int
6
    byteSize (Blt l
_) = Int
6
    byteSize (Bgt l
_) = Int
6
    byteSize (Ble l
_) = Int
6
    byteSize (Bge l
_) = Int
6
    byteSize (Bmi l
_) = Int
6
    byteSize (Bpl l
_) = Int
6
    byteSize (Bvc l
_) = Int
6
    byteSize (Bvs l
_) = Int
6
    byteSize (Jsr l
_) = Int
6
    byteSize M68kIsa w l
Rts = Int
2
    byteSize Link{} = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    byteSize Unlk{} = Int
2
    byteSize M68kIsa w l
Halt = Int
2

data M68kSt w = M68kSt
    { forall w. M68kSt w -> Int
pc :: Int
    , forall w. M68kSt w -> HashMap DataReg w
dataRegs :: HashMap DataReg w
    , forall w. M68kSt w -> HashMap AddrReg w
addrRegs :: HashMap AddrReg w
    , forall w. M68kSt w -> IoMem (M68kIsa w w) w
mem :: IoMem (M68kIsa w w) w
    , forall w. M68kSt w -> Bool
stopped :: Bool
    , forall w. M68kSt w -> Maybe Text
internalError :: Maybe Text
    , forall w. M68kSt w -> Bool
nFlag, forall w. M68kSt w -> Bool
zFlag, forall w. M68kSt w -> Bool
vFlag, forall w. M68kSt w -> Bool
cFlag :: Bool
    }
    deriving (Int -> M68kSt w -> ShowS
[M68kSt w] -> ShowS
M68kSt w -> [Char]
(Int -> M68kSt w -> ShowS)
-> (M68kSt w -> [Char]) -> ([M68kSt w] -> ShowS) -> Show (M68kSt w)
forall w. Show w => Int -> M68kSt w -> ShowS
forall w. Show w => [M68kSt w] -> ShowS
forall w. Show w => M68kSt w -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall w. Show w => Int -> M68kSt w -> ShowS
showsPrec :: Int -> M68kSt w -> ShowS
$cshow :: forall w. Show w => M68kSt w -> [Char]
show :: M68kSt w -> [Char]
$cshowList :: forall w. Show w => [M68kSt w] -> ShowS
showList :: [M68kSt w] -> ShowS
Show)

setPc :: forall w. Int -> State (M68kSt w) ()
setPc :: forall w. Int -> State (M68kSt w) ()
setPc Int
addr = (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ())
-> (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{pc = addr}

getPc :: State (M68kSt w) Int
getPc :: forall w. State (M68kSt w) Int
getPc = StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> StateT (M68kSt w) Identity Int)
-> StateT (M68kSt w) Identity Int
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \M68kSt w
st -> Int -> StateT (M68kSt w) Identity Int
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> StateT (M68kSt w) Identity Int)
-> Int -> StateT (M68kSt w) Identity Int
forall a b. (a -> b) -> a -> b
$ M68kSt w -> Int
forall w. M68kSt w -> Int
pc M68kSt w
st

raiseInternalError :: Text -> State (M68kSt w) ()
raiseInternalError :: forall w. Text -> State (M68kSt w) ()
raiseInternalError Text
msg = (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ())
-> (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{internalError = Just msg}

type instance MemOf (M68kSt w) = IoMem (M68kIsa w w) w

instance (IsWord w) => InitState (M68kSt w) where
    initState :: Int -> MemOf (M68kSt w) -> StdGen -> M68kSt w
initState Int
pc MemOf (M68kSt w)
dump StdGen
_randomGen =
        M68kSt
            { Int
pc :: Int
pc :: Int
pc
            , dataRegs :: HashMap DataReg w
dataRegs = HashMap DataReg w
forall a. Default a => a
def
            , addrRegs :: HashMap AddrReg w
addrRegs = HashMap AddrReg w
forall a. Default a => a
def
            , mem :: IoMem (M68kIsa w w) w
mem = IoMem (M68kIsa w w) w
MemOf (M68kSt w)
dump
            , stopped :: Bool
stopped = Bool
False
            , internalError :: Maybe Text
internalError = Maybe Text
forall a. Maybe a
Nothing
            , nFlag :: Bool
nFlag = Bool
False
            , zFlag :: Bool
zFlag = Bool
True
            , vFlag :: Bool
vFlag = Bool
False
            , cFlag :: Bool
cFlag = Bool
False
            }

instance (IsWord w) => Inspectable (M68kSt w) where
    type WordOf (M68kSt w) = w
    type IsaOf (M68kSt w) = M68kIsa w w

    programCounter :: M68kSt w -> Int
programCounter M68kSt{Int
pc :: forall w. M68kSt w -> Int
pc :: Int
pc} = Int
pc
    memoryDump :: M68kSt w -> MemOf (M68kSt w)
memoryDump M68kSt{IoMem (M68kIsa w w) w
mem :: forall w. M68kSt w -> IoMem (M68kIsa w w) w
mem :: IoMem (M68kIsa w w) w
mem} = IoMem (M68kIsa w w) w
MemOf (M68kSt w)
mem
    ioStreams :: M68kSt w -> IntMap ([WordOf (M68kSt w)], [WordOf (M68kSt w)])
ioStreams M68kSt{mem :: forall w. M68kSt w -> IoMem (M68kIsa w w) w
mem = IoMem{IntMap ([w], [w])
mIoStreams :: IntMap ([w], [w])
mIoStreams :: forall isa w. IoMem isa w -> IntMap ([w], [w])
mIoStreams}} = IntMap ([w], [w])
IntMap ([WordOf (M68kSt w)], [WordOf (M68kSt w)])
mIoStreams
    isHalted :: M68kSt w -> Bool
isHalted M68kSt{Bool
stopped :: forall w. M68kSt w -> Bool
stopped :: Bool
stopped} = Bool
stopped
    views :: [View (StateEnv (M68kSt w))]
views =
        Spec Format
-> Text
-> (StateEnv (M68kSt w) -> Format -> Text)
-> View (StateEnv (M68kSt w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView
            (Text -> Spec ()
lit Text
"SR" Spec () -> Spec Format -> Spec Format
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Format] -> Format -> Spec Format
format [Format
Bin] Format
Bin)
            Text
"Status register flags `NZVC` as bits."
            (\StateEnv{M68kSt w
seState :: M68kSt w
seState :: forall st. StateEnv st -> st
seState} Format
_ -> M68kSt w -> Text
forall {m} {w}. (Monoid m, IsString m) => M68kSt w -> m
statusBits M68kSt w
seState)
            View (StateEnv (M68kSt w))
-> [View (StateEnv (M68kSt w))] -> [View (StateEnv (M68kSt w))]
forall a. a -> [a] -> [a]
: [ Text
-> Text -> (StateEnv (M68kSt w) -> w) -> View (StateEnv (M68kSt w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView (DataReg -> Text
forall b a. (Show a, IsString b) => a -> b
show DataReg
r) (Text
"Data register `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataReg -> Text
forall b a. (Show a, IsString b) => a -> b
show DataReg
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`.") (w -> Maybe w -> w
forall a. a -> Maybe a -> a
fromMaybe w
0 (Maybe w -> w)
-> (StateEnv (M68kSt w) -> Maybe w) -> StateEnv (M68kSt w) -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap DataReg w
-> Key (HashMap DataReg w) -> Maybe (Val (HashMap DataReg w))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap DataReg w)
DataReg
r) (HashMap DataReg w -> Maybe w)
-> (StateEnv (M68kSt w) -> HashMap DataReg w)
-> StateEnv (M68kSt w)
-> Maybe w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> HashMap DataReg w
forall w. M68kSt w -> HashMap DataReg w
dataRegs (M68kSt w -> HashMap DataReg w)
-> (StateEnv (M68kSt w) -> M68kSt w)
-> StateEnv (M68kSt w)
-> HashMap DataReg w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (M68kSt w) -> M68kSt w
forall st. StateEnv st -> st
seState)
              | DataReg
r <- [DataReg]
dataRegisters
              ]
                [View (StateEnv (M68kSt w))]
-> [View (StateEnv (M68kSt w))] -> [View (StateEnv (M68kSt w))]
forall a. Semigroup a => a -> a -> a
<> [ Text
-> Text -> (StateEnv (M68kSt w) -> w) -> View (StateEnv (M68kSt w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView (AddrReg -> Text
forall b a. (Show a, IsString b) => a -> b
show AddrReg
r) (Text
"Address register `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddrReg -> Text
forall b a. (Show a, IsString b) => a -> b
show AddrReg
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`.") (w -> Maybe w -> w
forall a. a -> Maybe a -> a
fromMaybe w
0 (Maybe w -> w)
-> (StateEnv (M68kSt w) -> Maybe w) -> StateEnv (M68kSt w) -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap AddrReg w
-> Key (HashMap AddrReg w) -> Maybe (Val (HashMap AddrReg w))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap AddrReg w)
AddrReg
r) (HashMap AddrReg w -> Maybe w)
-> (StateEnv (M68kSt w) -> HashMap AddrReg w)
-> StateEnv (M68kSt w)
-> Maybe w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> HashMap AddrReg w
forall w. M68kSt w -> HashMap AddrReg w
addrRegs (M68kSt w -> HashMap AddrReg w)
-> (StateEnv (M68kSt w) -> M68kSt w)
-> StateEnv (M68kSt w)
-> HashMap AddrReg w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (M68kSt w) -> M68kSt w
forall st. StateEnv st -> st
seState)
                   | AddrReg
r <- [AddrReg]
addrRegisters
                   ]
        where
            statusBits :: M68kSt w -> m
statusBits M68kSt{Bool
nFlag :: forall w. M68kSt w -> Bool
nFlag :: Bool
nFlag, Bool
zFlag :: forall w. M68kSt w -> Bool
zFlag :: Bool
zFlag, Bool
vFlag :: forall w. M68kSt w -> Bool
vFlag :: Bool
vFlag, Bool
cFlag :: forall w. M68kSt w -> Bool
cFlag :: Bool
cFlag} = (Bool -> m) -> [Bool] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Bool
f -> if Bool
f then m
"1" else m
"0") [Bool
nFlag, Bool
zFlag, Bool
vFlag, Bool
cFlag]

indirectAddr :: (Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr Int -> Int
f AddrReg
r Maybe IndexRegister
index = do
    M68kSt{addrRegs, dataRegs} <- m (M68kSt a)
forall s (m :: * -> *). MonadState s m => m s
get
    let offset = a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ case Maybe IndexRegister
index of
            Just (DataIndex DataReg
r) -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"invalid register: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataReg -> Text
forall b a. (Show a, IsString b) => a -> b
show DataReg
r) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ HashMap DataReg a
dataRegs HashMap DataReg a
-> Key (HashMap DataReg a) -> Maybe (Val (HashMap DataReg a))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap DataReg a)
DataReg
r
            Just (AddrIndex AddrReg
r) -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"invalid register: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddrReg -> Text
forall b a. (Show a, IsString b) => a -> b
show AddrReg
r) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ HashMap AddrReg a
addrRegs HashMap AddrReg a
-> Key (HashMap AddrReg a) -> Maybe (Val (HashMap AddrReg a))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap AddrReg a)
AddrReg
r
            Maybe IndexRegister
Nothing -> a
0
    case addrRegs !? r of
        Just Val (HashMap AddrReg a)
addr -> Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
f (a -> Int
forall a. Enum a => a -> Int
fromEnum a
Val (HashMap AddrReg a)
addr)
        Maybe (Val (HashMap AddrReg a))
Nothing -> Text -> m Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> m Int) -> Text -> m Int
forall a b. (a -> b) -> a -> b
$ Text
"Invalid register: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddrReg -> Text
forall b a. (Show a, IsString b) => a -> b
show AddrReg
r

readMemoryWord :: Int -> StateT (M68kSt b) Identity b
readMemoryWord Int
addr = do
    st@M68kSt{mem} <- StateT (M68kSt b) Identity (M68kSt b)
forall s (m :: * -> *). MonadState s m => m s
get
    case readWord mem addr of
        Right (IoMem (M68kIsa b b) b
mem', b
w) -> do
            M68kSt b -> StateT (M68kSt b) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put M68kSt b
st{mem = mem'}
            b -> StateT (M68kSt b) Identity b
forall a. a -> StateT (M68kSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
w
        Left Text
err -> do
            Text -> StateT (M68kSt b) Identity ()
forall w. Text -> State (M68kSt w) ()
raiseInternalError (Text -> StateT (M68kSt b) Identity ())
-> Text -> StateT (M68kSt b) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            b -> StateT (M68kSt b) Identity b
forall a. a -> StateT (M68kSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def

writeMemoryWord :: Int -> w -> StateT (M68kSt w) Identity ()
writeMemoryWord Int
addr w
w = do
    st@M68kSt{mem} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case writeWord mem addr w of
        Right IoMem (M68kIsa w w) w
mem' -> do
            M68kSt w -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put M68kSt w
st{mem = mem'}
        Left Text
err -> Text -> StateT (M68kSt w) Identity ()
forall w. Text -> State (M68kSt w) ()
raiseInternalError (Text -> StateT (M68kSt w) Identity ())
-> Text -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err

fetchWord :: (IsWord w) => Argument w w -> State (M68kSt w) w
fetchWord :: forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord (DirectDataReg DataReg
r) = do
    M68kSt{dataRegs} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    return $ fromMaybe (error $ "invalid register: " <> show r) (dataRegs !? r)
fetchWord (DirectAddrReg AddrReg
r) = do
    M68kSt{addrRegs} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    return $ fromMaybe (error $ "invalid register: " <> show r) (addrRegs !? r)
fetchWord (IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) AddrReg
r Maybe IndexRegister
index
    readMemoryWord addr
fetchWord (IndirectAddrRegPreDecrement AddrReg
r) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (\Int
a -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum addr
    readMemoryWord addr
fetchWord (IndirectAddrRegPostIncrement AddrReg
r) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr Int -> Int
forall a. a -> a
id AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    w <- readMemoryWord addr
    storeWord (DirectAddrReg r) $ toEnum (addr + 4)
    return w
fetchWord (Immediate w
v) = w -> StateT (M68kSt w) Identity w
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return w
v

storeWord :: (IsWord w) => Argument w w -> w -> State (M68kSt w) ()
storeWord :: forall w. IsWord w => Argument w w -> w -> State (M68kSt w) ()
storeWord (DirectDataReg DataReg
r) w
v = (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ())
-> (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \st :: M68kSt w
st@M68kSt{HashMap DataReg w
dataRegs :: forall w. M68kSt w -> HashMap DataReg w
dataRegs :: HashMap DataReg w
dataRegs} -> M68kSt w
st{dataRegs = insert r v dataRegs}
storeWord (DirectAddrReg AddrReg
r) w
v = (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ())
-> (M68kSt w -> M68kSt w) -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \st :: M68kSt w
st@M68kSt{HashMap AddrReg w
addrRegs :: forall w. M68kSt w -> HashMap AddrReg w
addrRegs :: HashMap AddrReg w
addrRegs} -> M68kSt w
st{addrRegs = insert r v addrRegs}
storeWord (IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index) w
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) AddrReg
r Maybe IndexRegister
index
    writeMemoryWord addr v
storeWord (IndirectAddrRegPreDecrement AddrReg
r) w
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (\Int
a -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum addr
    writeMemoryWord addr v
storeWord (IndirectAddrRegPostIncrement AddrReg
r) w
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr Int -> Int
forall a. a -> a
id AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum (addr + 4)
    writeMemoryWord addr v
storeWord Argument w w
arg w
_ = Text -> StateT (M68kSt w) Identity ()
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> StateT (M68kSt w) Identity ())
-> Text -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"can not store word: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Argument w w -> Text
forall b a. (Show a, IsString b) => a -> b
show Argument w w
arg

readMemoryByte :: Int -> StateT (M68kSt w) Identity b
readMemoryByte Int
addr = do
    st@M68kSt{mem} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case readByte mem addr of
        Right (IoMem (M68kIsa w w) w
mem', Word8
b) -> do
            M68kSt w -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put M68kSt w
st{mem = mem'}
            b -> StateT (M68kSt w) Identity b
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> StateT (M68kSt w) Identity b)
-> b -> StateT (M68kSt w) Identity b
forall a b. (a -> b) -> a -> b
$ Unsign b -> b
forall w. FromSign w => Unsign w -> w
toSign Word8
Unsign b
b
        Left Text
err -> do
            Text -> StateT (M68kSt w) Identity ()
forall w. Text -> State (M68kSt w) ()
raiseInternalError (Text -> StateT (M68kSt w) Identity ())
-> Text -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            b -> StateT (M68kSt w) Identity b
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def

writeMemoryByte :: Int -> w -> StateT (M68kSt w) Identity ()
writeMemoryByte Int
addr w
b = do
    st@M68kSt{mem} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case writeByte mem addr (fromSign b) of
        Right IoMem (M68kIsa w w) w
mem' -> do
            M68kSt w -> StateT (M68kSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put M68kSt w
st{mem = mem'}
        Left Text
err -> Text -> StateT (M68kSt w) Identity ()
forall w. Text -> State (M68kSt w) ()
raiseInternalError (Text -> StateT (M68kSt w) Identity ())
-> Text -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err

fetchByte :: (IsWord w) => Argument w w -> State (M68kSt w) Int8
fetchByte :: forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte (DirectDataReg DataReg
r) = do
    M68kSt{dataRegs} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    return $ maybe (error $ "invalid register: " <> show r) (fromInteger . toInteger) (dataRegs !? r)
fetchByte (IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) AddrReg
r Maybe IndexRegister
index
    readMemoryByte addr
fetchByte (IndirectAddrRegPreDecrement AddrReg
r) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum addr
    readMemoryByte addr
fetchByte (IndirectAddrRegPostIncrement AddrReg
r) = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr Int -> Int
forall a. a -> a
id AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    b <- readMemoryByte addr
    storeWord (DirectAddrReg r) $ toEnum (addr + 1)
    return b
fetchByte (Immediate w
v) = Int8 -> StateT (M68kSt w) Identity Int8
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> StateT (M68kSt w) Identity Int8)
-> Int8 -> StateT (M68kSt w) Identity Int8
forall a b. (a -> b) -> a -> b
$ Integer -> Int8
forall a. Num a => Integer -> a
fromInteger (Integer -> Int8) -> Integer -> Int8
forall a b. (a -> b) -> a -> b
$ w -> Integer
forall a. Integral a => a -> Integer
toInteger w
v
fetchByte Argument w w
arg = Text -> StateT (M68kSt w) Identity Int8
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> StateT (M68kSt w) Identity Int8)
-> Text -> StateT (M68kSt w) Identity Int8
forall a b. (a -> b) -> a -> b
$ Text
"can not fetch byte: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Argument w w -> Text
forall b a. (Show a, IsString b) => a -> b
show Argument w w
arg

storeByte :: forall w. (IsWord w) => Argument w w -> Int8 -> State (M68kSt w) ()
storeByte :: forall w. IsWord w => Argument w w -> Int8 -> State (M68kSt w) ()
storeByte (DirectDataReg DataReg
r) Int8
v = do
    st@M68kSt{dataRegs} <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    let w = w -> Maybe w -> w
forall a. a -> Maybe a -> a
fromMaybe (Text -> w
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> w) -> Text -> w
forall a b. (a -> b) -> a -> b
$ Text
"invalid register: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataReg -> Text
forall b a. (Show a, IsString b) => a -> b
show DataReg
r) (Maybe w -> w) -> Maybe w -> w
forall a b. (a -> b) -> a -> b
$ HashMap DataReg w
dataRegs HashMap DataReg w
-> Key (HashMap DataReg w) -> Maybe (Val (HashMap DataReg w))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap DataReg w)
DataReg
r
        w' = (w
w w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
0xFFFFFF00) w -> w -> w
forall a. Bits a => a -> a -> a
.|. Integer -> w
forall a. Num a => Integer -> a
fromInteger (Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger Int8
v)
    put st{dataRegs = insert r w' dataRegs}
storeByte (IndirectAddrReg Int
offset AddrReg
r Maybe IndexRegister
index) Int8
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) AddrReg
r Maybe IndexRegister
index
    writeMemoryByte addr v
storeByte (IndirectAddrRegPreDecrement AddrReg
r) Int8
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum addr
    writeMemoryByte addr v
storeByte (IndirectAddrRegPostIncrement AddrReg
r) Int8
v = do
    addr <- (Int -> Int)
-> AddrReg -> Maybe IndexRegister -> StateT (M68kSt w) Identity Int
forall {a} {m :: * -> *}.
(Num a, Enum a, MonadState (M68kSt a) m) =>
(Int -> Int) -> AddrReg -> Maybe IndexRegister -> m Int
indirectAddr Int -> Int
forall a. a -> a
id AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
    storeWord (DirectAddrReg r) $ toEnum (addr + 1)
    writeMemoryByte addr v
storeByte (Immediate w
_) Int8
_ = Text -> StateT (M68kSt w) Identity ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"impossible to store into immediate destination"
storeByte Argument w w
arg Int8
_ = Text -> StateT (M68kSt w) Identity ()
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> StateT (M68kSt w) Identity ())
-> Text -> StateT (M68kSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"can not store byte: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Argument w w -> Text
forall b a. (Show a, IsString b) => a -> b
show Argument w w
arg

-- | A destination that is read and then written is read through 'rmwRead'
-- and written through 'rmwWrite', so both reach the same address and the
-- address register moves once: @-(An)@ on the read, @(An)+@ on the write.
rmwRead :: Argument w l -> Argument w l
rmwRead :: forall w l. Argument w l -> Argument w l
rmwRead (IndirectAddrRegPostIncrement AddrReg
r) = Int -> AddrReg -> Maybe IndexRegister -> Argument w l
forall w l. Int -> AddrReg -> Maybe IndexRegister -> Argument w l
IndirectAddrReg Int
0 AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
rmwRead Argument w l
arg = Argument w l
arg

rmwWrite :: Argument w l -> Argument w l
rmwWrite :: forall w l. Argument w l -> Argument w l
rmwWrite (IndirectAddrRegPreDecrement AddrReg
r) = Int -> AddrReg -> Maybe IndexRegister -> Argument w l
forall w l. Int -> AddrReg -> Maybe IndexRegister -> Argument w l
IndirectAddrReg Int
0 AddrReg
r Maybe IndexRegister
forall a. Maybe a
Nothing
rmwWrite Argument w l
arg = Argument w l
arg

instance (IsWord w) => Machine (M68kSt w) (M68kIsa w w) w where
    instructionFetch :: State (M68kSt w) (Either Text (Int, M68kIsa w w))
instructionFetch = do
        st <- StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get
        case st of
            M68kSt{stopped :: forall w. M68kSt w -> Bool
stopped = Bool
True} -> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, M68kIsa w w)
 -> State (M68kSt w) (Either Text (Int, M68kIsa w w)))
-> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, M68kIsa w w)
forall a b. a -> Either a b
Left Text
halted
            M68kSt{internalError :: forall w. M68kSt w -> Maybe Text
internalError = Just Text
err} -> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, M68kIsa w w)
 -> State (M68kSt w) (Either Text (Int, M68kIsa w w)))
-> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, M68kIsa w w)
forall a b. a -> Either a b
Left Text
err
            M68kSt{Int
pc :: forall w. M68kSt w -> Int
pc :: Int
pc, IoMem (M68kIsa w w) w
mem :: forall w. M68kSt w -> IoMem (M68kIsa w w) w
mem :: IoMem (M68kIsa w w) w
mem} ->
                case IoMem (M68kIsa w w) w
-> Int -> Either Text (IoMem (M68kIsa w w) w, M68kIsa w w)
forall m isa w. Memory m isa w => m -> Int -> Either Text (m, isa)
readInstruction IoMem (M68kIsa w w) w
mem Int
pc of
                    Left Text
err -> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, M68kIsa w w)
 -> State (M68kSt w) (Either Text (Int, M68kIsa w w)))
-> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, M68kIsa w w)
forall a b. a -> Either a b
Left Text
err
                    Right (IoMem (M68kIsa w w) w
mem', M68kIsa w w
instruction) -> do
                        M68kSt w -> State (M68kSt w) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put M68kSt w
st{mem = mem'}
                        Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a. a -> StateT (M68kSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, M68kIsa w w)
 -> State (M68kSt w) (Either Text (Int, M68kIsa w w)))
-> Either Text (Int, M68kIsa w w)
-> State (M68kSt w) (Either Text (Int, M68kIsa w w))
forall a b. (a -> b) -> a -> b
$ (Int, M68kIsa w w) -> Either Text (Int, M68kIsa w w)
forall a b. b -> Either a b
Right (Int
pc, M68kIsa w w
instruction)

    instructionExecute :: Int -> M68kIsa w w -> State (M68kSt w) ()
instructionExecute Int
pc M68kIsa w w
instruction = do
        case M68kIsa w w
instruction of
            Move{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w -> Argument w w -> (w -> w) -> State (M68kSt w) ()
wordCmd1 Argument w w
src Argument w w
dst w -> w
forall a. a -> a
id
            Move{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (Int8 -> Int8) -> State (M68kSt w) ()
byteCmd1 Argument w w
src Argument w w
dst Int8 -> Int8
forall a. a -> a
id
            MoveA{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src State (M68kSt w) w
-> (w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Argument w w -> w -> State (M68kSt w) ()
forall w. IsWord w => Argument w w -> w -> State (M68kSt w) ()
storeWord Argument w w
dst
                State (M68kSt w) ()
clearVC
                State (M68kSt w) ()
nextPc
            MoveA{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte} -> Text -> State (M68kSt w) ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"not implemented"
            Not{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w -> Argument w w -> (w -> w) -> State (M68kSt w) ()
wordCmd1 (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwRead Argument w w
dst) (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwWrite Argument w w
dst) w -> w
forall a. Bits a => a -> a
complement
            Not{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (Int8 -> Int8) -> State (M68kSt w) ()
byteCmd1 (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwRead Argument w w
dst) (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwWrite Argument w w
dst) Int8 -> Int8
forall a. Bits a => a -> a
complement
            Clr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                Argument w w -> w -> State (M68kSt w) ()
forall w. IsWord w => Argument w w -> w -> State (M68kSt w) ()
storeWord Argument w w
dst w
0
                (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> State (M68kSt w) ())
-> (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{nFlag = False, zFlag = True, vFlag = False, cFlag = False}
                State (M68kSt w) ()
nextPc
            Clr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                Argument w w -> Int8 -> State (M68kSt w) ()
forall w. IsWord w => Argument w w -> Int8 -> State (M68kSt w) ()
storeByte Argument w w
dst Int8
0
                (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> State (M68kSt w) ())
-> (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{nFlag = False, zFlag = True, vFlag = False, cFlag = False}
                State (M68kSt w) ()
nextPc
            Neg{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                a <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwRead Argument w w
dst)
                let Ext{value, carry, overflow} = subExt 0 a
                storeWord (rmwWrite dst) value
                modify $ \M68kSt w
st -> M68kSt w
st{nFlag = value < 0, zFlag = value == 0, vFlag = overflow, cFlag = carry}
                nextPc
            Neg{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                a <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte (Argument w w -> Argument w w
forall w l. Argument w l -> Argument w l
rmwRead Argument w w
dst)
                let Ext{value, carry, overflow} = subExt 0 a
                storeByte (rmwWrite dst) value
                modify $ \M68kSt w
st -> M68kSt w
st{nFlag = value < 0, zFlag = value == 0, vFlag = overflow, cFlag = carry}
                nextPc
            And{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> w) -> State (M68kSt w) ()
wordCmd2 Argument w w
src Argument w w
dst w -> w -> w
forall a. Bits a => a -> a -> a
(.&.)
            And{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (Int8 -> Int8 -> Int8) -> State (M68kSt w) ()
byteCmd2 Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
forall a. Bits a => a -> a -> a
(.&.)
            Or{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> w) -> State (M68kSt w) ()
wordCmd2 Argument w w
src Argument w w
dst w -> w -> w
forall a. Bits a => a -> a -> a
(.|.)
            Or{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (Int8 -> Int8 -> Int8) -> State (M68kSt w) ()
byteCmd2 Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
forall a. Bits a => a -> a -> a
(.|.)
            Xor{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> w) -> State (M68kSt w) ()
wordCmd2 Argument w w
src Argument w w
dst w -> w -> w
forall a. Bits a => a -> a -> a
xor
            Xor{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (Int8 -> Int8 -> Int8) -> State (M68kSt w) ()
byteCmd2 Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
forall a. Bits a => a -> a -> a
xor
            Add{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> Ext w) -> State (M68kSt w) ()
wordCmd2Ext Argument w w
src Argument w w
dst w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
addExt
            Add{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Ext Int8)
-> State (M68kSt w) ()
byteCmd2Ext Argument w w
src Argument w w
dst Int8 -> Int8 -> Ext Int8
forall w. IsWord w => w -> w -> Ext w
addExt
            Sub{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> Ext w) -> State (M68kSt w) ()
wordCmd2Ext Argument w w
src Argument w w
dst w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
subExt
            Sub{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Ext Int8)
-> State (M68kSt w) ()
byteCmd2Ext Argument w w
src Argument w w
dst Int8 -> Int8 -> Ext Int8
forall w. IsWord w => w -> w -> Ext w
subExt
            Mul{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w -> (w -> w -> Ext w) -> State (M68kSt w) ()
wordCmd2Ext Argument w w
src Argument w w
dst w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
mulExt
            Mul{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Ext Int8)
-> State (M68kSt w) ()
byteCmd2Ext Argument w w
src Argument w w
dst Int8 -> Int8 -> Ext Int8
forall w. IsWord w => w -> w -> Ext w
mulExt
            Div{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                b <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src
                if b == 0
                    then raiseInternalError "division by zero"
                    else wordCmd2 (Immediate b) dst div
            Div{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                b <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
src
                if b == 0
                    then raiseInternalError "division by zero"
                    else byteCmd2 (Immediate $ fromIntegral b) dst div
            Cmp{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                a <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
dst
                b <- fetchWord src
                let Ext{value, overflow, carry} = subExt a b
                modify $ \M68kSt w
st ->
                    M68kSt w
st
                        { nFlag = value < 0
                        , zFlag = value == 0
                        , vFlag = overflow
                        , cFlag = carry
                        }
                nextPc
            Cmp{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> do
                a <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
dst
                b <- fetchByte src
                let Ext{value, overflow, carry} = subExt a b
                modify $ \M68kSt w
st ->
                    M68kSt w
st
                        { nFlag = value < 0
                        , zFlag = value == 0
                        , vFlag = overflow
                        , cFlag = carry
                        }
                nextPc
            Asl{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (w -> w -> w)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
wordShift Argument w w
src Argument w w
dst (\w
d w
s -> w -> Int -> w
forall a. Bits a => a -> Int -> a
shiftL w
d (w -> Int
forall a. Enum a => a -> Int
fromEnum w
s)) Int -> Int -> Int
forall a. Num a => a -> a -> a
lastBitOutLeft
            Asl{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Int8)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
byteShift Argument w w
src Argument w w
dst (\Int8
d Int8
s -> Int8 -> Int -> Int8
forall a. Bits a => a -> Int -> a
shiftL Int8
d (Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
s)) Int -> Int -> Int
forall a. Num a => a -> a -> a
lastBitOutLeft
            Asr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (w -> w -> w)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
wordShift Argument w w
src Argument w w
dst (\w
d w
s -> w -> Int -> w
forall a. Bits a => a -> Int -> a
shiftR w
d (w -> Int
forall a. Enum a => a -> Int
fromEnum w
s)) Int -> Int -> Int
forall {a} {p}. Num a => p -> a -> a
lastBitOutRight
            Asr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Int8)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
byteShift Argument w w
src Argument w w
dst (\Int8
d Int8
s -> Int8 -> Int -> Int8
forall a. Bits a => a -> Int -> a
shiftR Int8
d (Int8 -> Int
forall a. Enum a => a -> Int
fromEnum Int8
s)) Int -> Int -> Int
forall {a} {p}. Num a => p -> a -> a
lastBitOutRight
            Lsl{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (w -> w -> w)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
wordShift Argument w w
src Argument w w
dst w -> w -> w
forall w. IsWord w => w -> w -> w
lShiftL Int -> Int -> Int
forall a. Num a => a -> a -> a
lastBitOutLeft
            Lsl{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Int8)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
byteShift Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
forall w. IsWord w => w -> w -> w
lShiftL Int -> Int -> Int
forall a. Num a => a -> a -> a
lastBitOutLeft
            Lsr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Long, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (w -> w -> w)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
wordShift Argument w w
src Argument w w
dst w -> w -> w
forall w. IsWord w => w -> w -> w
lShiftR Int -> Int -> Int
forall {a} {p}. Num a => p -> a -> a
lastBitOutRight
            Lsr{mode :: forall w l. M68kIsa w l -> Mode
mode = Mode
Byte, Argument w w
src :: forall w l. M68kIsa w l -> Argument w l
src :: Argument w w
src, Argument w w
dst :: forall w l. M68kIsa w l -> Argument w l
dst :: Argument w w
dst} -> Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Int8)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
byteShift Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
forall w. IsWord w => w -> w -> w
lShiftR Int -> Int -> Int
forall {a} {p}. Num a => p -> a -> a
lastBitOutRight
            Jmp{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> w -> Bool -> State (M68kSt w) ()
branch w
ref Bool
True
            Bcc{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (M68kSt w -> Bool) -> M68kSt w -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
cFlag
            Bcs{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
cFlag
            Beq{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
zFlag
            Bne{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (M68kSt w -> Bool) -> M68kSt w -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
zFlag
            Blt{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\M68kSt w
st -> M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag M68kSt w
st Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag M68kSt w
st)
            Bgt{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\M68kSt w
st -> Bool -> Bool
not (M68kSt w -> Bool
forall w. M68kSt w -> Bool
zFlag M68kSt w
st) Bool -> Bool -> Bool
&& (M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag M68kSt w
st Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag M68kSt w
st))
            Ble{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\M68kSt w
st -> M68kSt w -> Bool
forall w. M68kSt w -> Bool
zFlag M68kSt w
st Bool -> Bool -> Bool
|| (M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag M68kSt w
st Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag M68kSt w
st))
            Bge{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\M68kSt w
st -> M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag M68kSt w
st Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag M68kSt w
st)
            Bmi{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag
            Bpl{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (M68kSt w -> Bool) -> M68kSt w -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
nFlag
            Bvc{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (M68kSt w -> Bool) -> M68kSt w -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag
            Bvs{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> StateT (M68kSt w) Identity (M68kSt w)
forall s (m :: * -> *). MonadState s m => m s
get StateT (M68kSt w) Identity (M68kSt w)
-> (M68kSt w -> State (M68kSt w) ()) -> State (M68kSt w) ()
forall a b.
StateT (M68kSt w) Identity a
-> (a -> StateT (M68kSt w) Identity b)
-> StateT (M68kSt w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> Bool -> State (M68kSt w) ()
branch w
ref (Bool -> State (M68kSt w) ())
-> (M68kSt w -> Bool) -> M68kSt w -> State (M68kSt w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M68kSt w -> Bool
forall w. M68kSt w -> Bool
vFlag
            Jsr{w
ref :: forall w l. M68kIsa w l -> l
ref :: w
ref} -> do
                State (M68kSt w) ()
nextPc
                pc <- State (M68kSt w) Int
forall w. State (M68kSt w) Int
getPc
                storeWord (IndirectAddrRegPreDecrement A7) $ toEnum pc
                setPc $ fromEnum ref
            M68kIsa w w
Rts -> do
                pc <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord (AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
IndirectAddrRegPostIncrement AddrReg
A7)
                setPc $ fromEnum pc
            Link{AddrReg
addrReg :: forall w l. M68kIsa w l -> AddrReg
addrReg :: AddrReg
addrReg, Int
offset :: forall w l. M68kIsa w l -> Int
offset :: Int
offset} -> do
                fp <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord (AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
DirectAddrReg AddrReg
addrReg)
                storeWord (IndirectAddrRegPreDecrement A7) fp

                sp <- fetchWord (DirectAddrReg A7)
                storeWord (DirectAddrReg addrReg) sp
                storeWord (DirectAddrReg A7) (sp + toEnum offset)

                nextPc
            Unlk{AddrReg
addrReg :: forall w l. M68kIsa w l -> AddrReg
addrReg :: AddrReg
addrReg} -> do
                sp <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord (AddrReg -> Argument w w
forall w l. AddrReg -> Argument w l
DirectAddrReg AddrReg
addrReg)
                storeWord (DirectAddrReg A7) sp

                fp <- fetchWord (IndirectAddrRegPostIncrement A7)
                storeWord (DirectAddrReg addrReg) fp

                nextPc
            M68kIsa w w
Halt -> (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> State (M68kSt w) ())
-> (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{stopped = True}
        where
            nextPc :: State (M68kSt w) ()
nextPc = Int -> State (M68kSt w) ()
forall w. Int -> State (M68kSt w) ()
setPc (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ M68kIsa w w -> Int
forall t. ByteSize t => t -> Int
byteSize M68kIsa w w
instruction)
            branch :: w -> Bool -> State (M68kSt w) ()
branch w
addr Bool
True = Int -> State (M68kSt w) ()
forall w. Int -> State (M68kSt w) ()
setPc (Int -> State (M68kSt w) ()) -> Int -> State (M68kSt w) ()
forall a b. (a -> b) -> a -> b
$ w -> Int
forall a. Enum a => a -> Int
fromEnum w
addr
            branch w
_addr Bool
False = State (M68kSt w) ()
nextPc
            clearVC :: State (M68kSt w) ()
clearVC = (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> State (M68kSt w) ())
-> (M68kSt w -> M68kSt w) -> State (M68kSt w) ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{vFlag = False, cFlag = False}
            logicFlags :: a -> m ()
logicFlags a
result = (M68kSt w -> M68kSt w) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((M68kSt w -> M68kSt w) -> m ()) -> (M68kSt w -> M68kSt w) -> m ()
forall a b. (a -> b) -> a -> b
$ \M68kSt w
st -> M68kSt w
st{nFlag = result < 0, zFlag = result == 0, vFlag = False, cFlag = False}
            wordCmd1 :: Argument w w -> Argument w w -> (w -> w) -> State (M68kSt w) ()
wordCmd1 Argument w w
src Argument w w
dst w -> w
f = do
                a <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src
                let result = w -> w
f w
a
                storeWord dst result
                logicFlags result
                nextPc
            wordCmd2 :: Argument w w
-> Argument w w -> (w -> w -> w) -> State (M68kSt w) ()
wordCmd2 Argument w w
src Argument w w
dst w -> w -> w
f = do
                b <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src
                a <- fetchWord (rmwRead dst)
                let result = w -> w -> w
f w
a w
b
                storeWord (rmwWrite dst) result
                logicFlags result
                nextPc
            wordCmd2Ext :: Argument w w
-> Argument w w -> (w -> w -> Ext w) -> State (M68kSt w) ()
wordCmd2Ext Argument w w
src Argument w w
dst w -> w -> Ext w
f = do
                b <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src
                a <- fetchWord (rmwRead dst)
                let Ext{value, carry, overflow} = f a b
                storeWord (rmwWrite dst) value
                modify $ \M68kSt w
st ->
                    M68kSt w
st
                        { nFlag = value < 0
                        , zFlag = value == 0
                        , vFlag = overflow
                        , cFlag = carry
                        }
                nextPc
            byteCmd1 :: Argument w w
-> Argument w w -> (Int8 -> Int8) -> State (M68kSt w) ()
byteCmd1 Argument w w
src Argument w w
dst Int8 -> Int8
f = do
                a <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
src
                let result = Int8 -> Int8
f Int8
a
                storeByte dst result
                logicFlags result
                nextPc
            byteCmd2 :: Argument w w
-> Argument w w -> (Int8 -> Int8 -> Int8) -> State (M68kSt w) ()
byteCmd2 Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
f = do
                b <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
src
                a <- fetchByte (rmwRead dst)
                let result = Int8 -> Int8 -> Int8
f Int8
a Int8
b
                storeByte (rmwWrite dst) result
                logicFlags result
                nextPc
            wordShift :: Argument w w
-> Argument w w
-> (w -> w -> w)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
wordShift Argument w w
src Argument w w
dst w -> w -> w
f Int -> Int -> Int
carryBit = do
                b <- Argument w w -> State (M68kSt w) w
forall w. IsWord w => Argument w w -> State (M68kSt w) w
fetchWord Argument w w
src
                a <- fetchWord (rmwRead dst)
                let width = w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
a
                    requested = w -> Int
forall a. Enum a => a -> Int
fromEnum (w
b w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
0x3F)
                    shiftBy = w -> w -> w
forall a. Ord a => a -> a -> a
min (Int -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (w
b w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
0x3F)
                    result = w -> w -> w
f w
a w
shiftBy
                storeWord (rmwWrite dst) result
                modify $ \M68kSt w
st -> M68kSt w
st{nFlag = result < 0, zFlag = result == 0, vFlag = False, cFlag = shiftCarry carryBit a width requested}
                nextPc
            byteShift :: Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Int8)
-> (Int -> Int -> Int)
-> State (M68kSt w) ()
byteShift Argument w w
src Argument w w
dst Int8 -> Int8 -> Int8
f Int -> Int -> Int
carryBit = do
                b <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
src
                a <- fetchByte (rmwRead dst)
                let width = Int8 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int8
a
                    requested = Int8 -> Int
forall a. Enum a => a -> Int
fromEnum (Int8
b Int8 -> Int8 -> Int8
forall a. Bits a => a -> a -> a
.&. Int8
0x3F)
                    shiftBy = Int8 -> Int8 -> Int8
forall a. Ord a => a -> a -> a
min (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int8
b Int8 -> Int8 -> Int8
forall a. Bits a => a -> a -> a
.&. Int8
0x3F)
                    result = Int8 -> Int8 -> Int8
f Int8
a Int8
shiftBy
                storeByte (rmwWrite dst) result
                modify $ \M68kSt w
st -> M68kSt w
st{nFlag = result < 0, zFlag = result == 0, vFlag = False, cFlag = shiftCarry carryBit a width requested}
                nextPc
            byteCmd2Ext :: Argument w w
-> Argument w w
-> (Int8 -> Int8 -> Ext Int8)
-> State (M68kSt w) ()
byteCmd2Ext Argument w w
src Argument w w
dst Int8 -> Int8 -> Ext Int8
f = do
                b <- Argument w w -> State (M68kSt w) Int8
forall w. IsWord w => Argument w w -> State (M68kSt w) Int8
fetchByte Argument w w
src
                a <- fetchByte (rmwRead dst)
                let Ext{value, carry, overflow} = f a b
                storeByte (rmwWrite dst) value
                modify $ \M68kSt w
st ->
                    M68kSt w
st
                        { nFlag = value < 0
                        , zFlag = value == 0
                        , vFlag = overflow
                        , cFlag = carry
                        }
                nextPc
            lastBitOutLeft :: a -> a -> a
lastBitOutLeft a
width a
count = a
width a -> a -> a
forall a. Num a => a -> a -> a
- a
count
            lastBitOutRight :: p -> a -> a
lastBitOutRight p
_width a
count = a
count a -> a -> a
forall a. Num a => a -> a -> a
- a
1

            shiftCarry :: (t -> t -> Int) -> a -> t -> t -> Bool
shiftCarry t -> t -> Int
lastBitOut a
a t
width t
count
                | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 Bool -> Bool -> Bool
|| t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
width = Bool
False
                | Bool
otherwise = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
a (t -> t -> Int
lastBitOut t
width t
count)