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

module Wrench.Isa.Acc32 (
    Acc32Isa (..),
    Acc32St,
) where

import Data.Bits (Bits (..), complement, shiftL, shiftR, (.&.))
import Data.Default (def)
import Data.List (lookup)
import Relude
import Text.Megaparsec (choice, try)
import Text.Megaparsec.Char (hspace, hspace1, string)
import Wrench.Machine.Memory
import Wrench.Machine.Types
import Wrench.Machine.Word
import Wrench.Report
import Wrench.Translator.Parser.Misc
import Wrench.Translator.Parser.Types
import Wrench.Translator.Types

-- | The 'Acc32Isa' type represents the instruction set architecture for the Acc32 machine.
-- Each constructor corresponds to a specific instruction.
data Acc32Isa w l
    = -- | Syntax: @load_imm <address>@ Load an immediate value into the accumulator.
      LoadImm l
    | -- | Syntax: @load_addr <address>@ Load a value from a specific address into the accumulator.
      LoadAddr l
    | -- | Syntax: @load <address>@ Load a value from a nearby address into the accumulator, encoded as the offset @<address> - pc@.
      Load l
    | -- | Syntax: @load_acc@ Load a value from an address in acc into the accumulator.
      LoadAcc
    | -- | Syntax: @store_addr <address>@ Store the accumulator value into a specific address.
      StoreAddr l
    | -- | Syntax: @store <address>@ Store the accumulator value into a nearby address, encoded as the offset @<address> - pc@.
      Store l
    | -- | Syntax: @store_ind <address>@ Store the accumulator value into an indirect address.
      StoreInd l
    | -- | Syntax: @add <address>@ Add a value from a specific address to the accumulator.
      Add l
    | -- | Syntax: @sub <address>@ Subtract from the accumulator a value from a specific address.
      Sub l
    | -- | Syntax: @mul <address>@ Multiply the accumulator by a value from a specific address.
      Mul l
    | -- | Syntax: @div <address>@ Divide the accumulator by a value from a specific address.
      Div l
    | -- | Syntax: @rem <address>@ Compute the remainder of the accumulator divided by a value from a specific address.
      Rem l
    | -- | Syntax: @clv@ Clear overflow flag
      Clv
    | -- | Syntax: @clc@ Clear carry flag
      Clc
    | -- | Syntax: @shiftl <address>@ Shift the accumulator left by a number of bits from a specific address.
      ShiftL l
    | -- | Syntax: @shiftr <address>@ Shift the accumulator right by a number of bits from a specific address.
      ShiftR l
    | -- | Syntax: @and <address>@ Perform a bitwise AND on the accumulator with a value from a specific address.
      And l
    | -- | Syntax: @or <address>@ Perform a bitwise OR on the accumulator with a value from a specific address.
      Or l
    | -- | Syntax: @xor <address>@ Perform a bitwise XOR on the accumulator with a value from a specific address.
      Xor l
    | -- | Syntax: @not@ Perform a bitwise NOT on the accumulator.
      Not
    | -- | Syntax: @jmp <address>@ Jump to a specific address.
      Jmp l
    | -- | Syntax: @beqz <address>@ Jump to a specific address if the accumulator is zero.
      Beqz l
    | -- | Syntax: @bnez <address>@ Jump to a specific address if the accumulator is not zero.
      Bnez l
    | -- | Syntax: @bgtz <address>@ Jump to a specific address if the accumulator is greater than zero.
      Bgz l
    | -- | Syntax: @bltz <address>@ Jump to a specific address if the accumulator is less than zero.
      Blz l
    | -- | Syntax: @bgez <address>@ Jump to a specific address if the accumulator is greater than or equal to zero.
      Bgez l
    | Bvs l
    | Bvc l
    | Bcs l
    | Bcc l
    | -- | Syntax: @halt@ Halt the machine.
      Halt
    deriving (Int -> Acc32Isa w l -> ShowS
[Acc32Isa w l] -> ShowS
Acc32Isa w l -> [Char]
(Int -> Acc32Isa w l -> ShowS)
-> (Acc32Isa w l -> [Char])
-> ([Acc32Isa w l] -> ShowS)
-> Show (Acc32Isa w l)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall w l. Show l => Int -> Acc32Isa w l -> ShowS
forall w l. Show l => [Acc32Isa w l] -> ShowS
forall w l. Show l => Acc32Isa w l -> [Char]
$cshowsPrec :: forall w l. Show l => Int -> Acc32Isa w l -> ShowS
showsPrec :: Int -> Acc32Isa w l -> ShowS
$cshow :: forall w l. Show l => Acc32Isa w l -> [Char]
show :: Acc32Isa w l -> [Char]
$cshowList :: forall w l. Show l => [Acc32Isa w l] -> ShowS
showList :: [Acc32Isa w l] -> ShowS
Show)

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

instance (IsWord w) => MnemonicParser (Acc32Isa w (Ref w)) where
    mnemonic :: Parser (Acc32Isa w (Ref w))
mnemonic =
        [Parser (Acc32Isa w (Ref w))] -> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
LoadImm (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"load_imm" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
LoadAddr (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"load_addr" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char] -> Parser ()
cmdMnemonic0 [Char]
"load_acc" Parser ()
-> Parser (Acc32Isa w (Ref w)) -> Parser (Acc32Isa w (Ref w))
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
>> Acc32Isa w (Ref w) -> Parser (Acc32Isa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Acc32Isa w (Ref w)
forall w l. Acc32Isa w l
LoadAcc
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Load (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"load" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
StoreAddr (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"store_addr" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
StoreInd (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"store_ind" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Store (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"store" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Add (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"add" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Sub (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"sub" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Mul (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"mul" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Div (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"div" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Rem (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"rem" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char] -> Parser ()
cmdMnemonic0 [Char]
"clv" Parser ()
-> Parser (Acc32Isa w (Ref w)) -> Parser (Acc32Isa w (Ref w))
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
>> Acc32Isa w (Ref w) -> Parser (Acc32Isa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Acc32Isa w (Ref w)
forall w l. Acc32Isa w l
Clv
            , [Char] -> Parser ()
cmdMnemonic0 [Char]
"clc" Parser ()
-> Parser (Acc32Isa w (Ref w)) -> Parser (Acc32Isa w (Ref w))
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
>> Acc32Isa w (Ref w) -> Parser (Acc32Isa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Acc32Isa w (Ref w)
forall w l. Acc32Isa w l
Clc
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
ShiftL (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"shiftl" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
ShiftR (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"shiftr" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
And (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"and" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Or (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"or" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Xor (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"xor" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char] -> Parser ()
cmdMnemonic0 [Char]
"not" Parser ()
-> Parser (Acc32Isa w (Ref w)) -> Parser (Acc32Isa w (Ref w))
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
>> Acc32Isa w (Ref w) -> Parser (Acc32Isa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Acc32Isa w (Ref w)
forall w l. Acc32Isa w l
Not
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Jmp (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"jmp" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Beqz (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"beqz" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bnez (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bnez" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bgz (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bgtz" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bgez (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bgez" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Blz (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bltz" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bvs (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bvs" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bvc (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bvc" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bcs (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bcs" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , Ref w -> Acc32Isa w (Ref w)
forall w l. l -> Acc32Isa w l
Bcc (Ref w -> Acc32Isa w (Ref w))
-> ParsecT Void [Char] Identity (Ref w)
-> Parser (Acc32Isa w (Ref w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> ParsecT Void [Char] Identity (Ref w)
-> ParsecT Void [Char] Identity (Ref w)
forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
"bcc" ParsecT Void [Char] Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
            , [Char] -> Parser ()
cmdMnemonic0 [Char]
"halt" Parser ()
-> Parser (Acc32Isa w (Ref w)) -> Parser (Acc32Isa w (Ref w))
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
>> Acc32Isa w (Ref w) -> Parser (Acc32Isa w (Ref w))
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Acc32Isa w (Ref w)
forall w l. Acc32Isa w l
Halt
            ]

cmdMnemonic0 :: String -> Parser ()
cmdMnemonic0 :: [Char] -> Parser ()
cmdMnemonic0 [Char]
mnemonic = Parser () -> Parser ()
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 () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
    ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
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 [Char]
Tokens [Char]
mnemonic)
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 Parser () -> Parser () -> Parser ()
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
<|> [Char] -> Parser ()
eol' [Char]
"\\"

cmdMnemonic1 :: String -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 :: forall w. [Char] -> Parser (Ref w) -> Parser (Ref w)
cmdMnemonic1 [Char]
mnemonic Parser (Ref w)
refParser = Parser (Ref w) -> Parser (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 (Ref w) -> Parser (Ref w))
-> Parser (Ref w) -> Parser (Ref w)
forall a b. (a -> b) -> a -> b
$ do
    Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
    ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
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 [Char]
Tokens [Char]
mnemonic)
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
    ref <- Parser (Ref w)
refParser
    hspace1 <|> eol' "\\"
    return ref

instance (IsWord w) => DerefMnemonic (Acc32Isa w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> Acc32Isa w (Ref w) -> Acc32Isa w w
derefMnemonic Text -> Maybe w
f w
offset Acc32Isa w (Ref w)
i =
        let offsetErr :: a -> a -> a
offsetErr a
m a
x = a
m a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": relative offset " 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..127"
            addrErr :: a -> a -> a
addrErr a
m a
x = a
m a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": address " 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..65535"
         in case Acc32Isa w (Ref w)
i of
                LoadImm Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
LoadImm ((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)
                LoadAddr Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
LoadAddr ((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)
                Load Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Load ((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
i8 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
offsetErr Text
"load") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
l)
                Acc32Isa w (Ref w)
LoadAcc -> Acc32Isa w w
forall w l. Acc32Isa w l
LoadAcc
                StoreAddr Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
StoreAddr ((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)
                Store Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Store ((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
i8 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
offsetErr Text
"store") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
l)
                StoreInd Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
StoreInd ((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)
                Add Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Add ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"add")) Text -> Maybe w
f Ref w
l)
                Sub Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Sub ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"sub")) Text -> Maybe w
f Ref w
l)
                Mul Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Mul ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"mul")) Text -> Maybe w
f Ref w
l)
                Div Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Div ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"div")) Text -> Maybe w
f Ref w
l)
                Rem Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Rem ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"rem")) Text -> Maybe w
f Ref w
l)
                Acc32Isa w (Ref w)
Clv -> Acc32Isa w w
forall w l. Acc32Isa w l
Clv
                Acc32Isa w (Ref w)
Clc -> Acc32Isa w w
forall w l. Acc32Isa w l
Clc
                ShiftL Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
ShiftL ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"shiftl")) Text -> Maybe w
f Ref w
l)
                ShiftR Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
ShiftR ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"shiftr")) Text -> Maybe w
f Ref w
l)
                And Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
And ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"and")) Text -> Maybe w
f Ref w
l)
                Or Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Or ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"or")) Text -> Maybe w
f Ref w
l)
                Xor Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Xor ((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
u16 (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addrErr Text
"xor")) Text -> Maybe w
f Ref w
l)
                Acc32Isa w (Ref w)
Not -> Acc32Isa w w
forall w l. Acc32Isa w l
Not
                Beqz Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Beqz ((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)
                Bnez Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Bnez ((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)
                Bgz Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Bgz ((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)
                Bgez Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Bgez ((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)
                Blz Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa w l
Blz ((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)
                Bvs Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa 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
l)
                Bvc Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa 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
l)
                Bcs Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa 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
l)
                Bcc Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa 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
l)
                Jmp Ref w
l -> w -> Acc32Isa w w
forall w l. l -> Acc32Isa 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
l)
                Acc32Isa w (Ref w)
Halt -> Acc32Isa w w
forall w l. Acc32Isa w l
Halt

instance ByteSize (Acc32Isa w l) where
    byteSize :: Acc32Isa w l -> Int
byteSize LoadImm{} = Int
5
    byteSize LoadAddr{} = Int
5
    byteSize LoadAcc{} = Int
1
    byteSize Load{} = Int
2
    byteSize Store{} = Int
2
    byteSize StoreAddr{} = Int
5
    byteSize StoreInd{} = Int
5
    byteSize Beqz{} = Int
5
    byteSize Bnez{} = Int
5
    byteSize Bgz{} = Int
5
    byteSize Bgez{} = Int
5
    byteSize Blz{} = Int
5
    byteSize Bvs{} = Int
5
    byteSize Bvc{} = Int
5
    byteSize Bcs{} = Int
5
    byteSize Bcc{} = Int
5
    byteSize Jmp{} = Int
5
    byteSize Acc32Isa w l
Not = Int
1
    byteSize Acc32Isa w l
Clv = Int
1
    byteSize Acc32Isa w l
Clc = Int
1
    byteSize Acc32Isa w l
Halt = Int
1
    byteSize Acc32Isa w l
_ = Int
3

data Acc32St w = Acc32St
    { forall w. Acc32St w -> Int
pc :: Int
    , forall w. Acc32St w -> w
acc :: w
    , forall w. Acc32St w -> Bool
overflowFlag :: Bool
    , forall w. Acc32St w -> Bool
carryFlag :: Bool
    , forall w. Acc32St w -> IoMem (Acc32Isa w w) w
ram :: IoMem (Acc32Isa w w) w
    , forall w. Acc32St w -> [(Int, Acc32Isa w w)]
ir :: [(Int, Acc32Isa w w)]
    -- ^ Instruction register: the instructions of the last fetched words, by address.
    , forall w. Acc32St w -> Bool
stopped :: Bool
    , forall w. Acc32St w -> Maybe Text
internalError :: Maybe Text
    }
    deriving (Int -> Acc32St w -> ShowS
[Acc32St w] -> ShowS
Acc32St w -> [Char]
(Int -> Acc32St w -> ShowS)
-> (Acc32St w -> [Char])
-> ([Acc32St w] -> ShowS)
-> Show (Acc32St w)
forall w. Show w => Int -> Acc32St w -> ShowS
forall w. Show w => [Acc32St w] -> ShowS
forall w. Show w => Acc32St w -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall w. Show w => Int -> Acc32St w -> ShowS
showsPrec :: Int -> Acc32St w -> ShowS
$cshow :: forall w. Show w => Acc32St w -> [Char]
show :: Acc32St w -> [Char]
$cshowList :: forall w. Show w => [Acc32St w] -> ShowS
showList :: [Acc32St w] -> ShowS
Show)

type instance MemOf (Acc32St w) = IoMem (Acc32Isa w w) w

instance (IsWord w) => InitState (Acc32St w) where
    initState :: Int -> MemOf (Acc32St w) -> StdGen -> Acc32St w
initState Int
pc MemOf (Acc32St w)
dump StdGen
_randomGen =
        Acc32St
            { acc :: w
acc = w
0
            , overflowFlag :: Bool
overflowFlag = Bool
False
            , carryFlag :: Bool
carryFlag = Bool
False
            , ram :: IoMem (Acc32Isa w w) w
ram = IoMem (Acc32Isa w w) w
MemOf (Acc32St w)
dump
            , ir :: [(Int, Acc32Isa w w)]
ir = []
            , stopped :: Bool
stopped = Bool
False
            , pc :: Int
pc = Int
pc
            , internalError :: Maybe Text
internalError = Maybe Text
forall a. Maybe a
Nothing
            }

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

setOverflowFlag :: forall w. Bool -> State (Acc32St w) ()
setOverflowFlag :: forall w. Bool -> State (Acc32St w) ()
setOverflowFlag Bool
overflowFlag = (Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ())
-> (Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ()
forall a b. (a -> b) -> a -> b
$ \Acc32St w
st -> Acc32St w
st{overflowFlag}

setCarryFlag :: forall w. Bool -> State (Acc32St w) ()
setCarryFlag :: forall w. Bool -> State (Acc32St w) ()
setCarryFlag Bool
carryFlag = (Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ())
-> (Acc32St w -> Acc32St w) -> StateT (Acc32St w) Identity ()
forall a b. (a -> b) -> a -> b
$ \Acc32St w
st -> Acc32St w
st{carryFlag}

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

getWord :: Int -> StateT (Acc32St b) Identity b
getWord Int
addr = do
    st@Acc32St{ram} <- StateT (Acc32St b) Identity (Acc32St b)
forall s (m :: * -> *). MonadState s m => m s
get
    case readWord ram addr of
        Right (IoMem (Acc32Isa b b) b
ram', b
w) -> Acc32St b -> StateT (Acc32St b) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Acc32St b
st{ram = ram'} StateT (Acc32St b) Identity ()
-> StateT (Acc32St b) Identity b -> StateT (Acc32St b) Identity b
forall a b.
StateT (Acc32St b) Identity a
-> StateT (Acc32St b) Identity b -> StateT (Acc32St b) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> StateT (Acc32St b) Identity b
forall a. a -> StateT (Acc32St b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
w
        Left Text
err -> do
            Text -> StateT (Acc32St b) Identity ()
forall w. Text -> State (Acc32St w) ()
raiseInternalError (Text -> StateT (Acc32St b) Identity ())
-> Text -> StateT (Acc32St 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 (Acc32St b) Identity b
forall a. a -> StateT (Acc32St b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def

setWord :: Int -> w -> StateT (Acc32St w) Identity ()
setWord Int
addr w
w = do
    st@Acc32St{ram} <- StateT (Acc32St w) Identity (Acc32St w)
forall s (m :: * -> *). MonadState s m => m s
get
    case writeWord ram addr w of
        Right IoMem (Acc32Isa w w) w
ram' -> Acc32St w -> StateT (Acc32St w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Acc32St w
st{ram = ram'}
        Left Text
err -> Text -> StateT (Acc32St w) Identity ()
forall w. Text -> State (Acc32St w) ()
raiseInternalError (Text -> StateT (Acc32St w) Identity ())
-> Text -> StateT (Acc32St 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

setAcc :: w -> m ()
setAcc w
w = (Acc32St w -> Acc32St w) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Acc32St w -> Acc32St w) -> m ())
-> (Acc32St w -> Acc32St w) -> m ()
forall a b. (a -> b) -> a -> b
$ \Acc32St w
st -> Acc32St w
st{acc = w}

getAcc :: State (Acc32St w) w
getAcc :: forall w. State (Acc32St w) w
getAcc = Acc32St w -> w
forall w. Acc32St w -> w
acc (Acc32St w -> w)
-> StateT (Acc32St w) Identity (Acc32St w)
-> StateT (Acc32St w) Identity w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Acc32St w) Identity (Acc32St w)
forall s (m :: * -> *). MonadState s m => m s
get

getOverflowFlag :: State (Acc32St w) Bool
getOverflowFlag :: forall w. State (Acc32St w) Bool
getOverflowFlag = Acc32St w -> Bool
forall w. Acc32St w -> Bool
overflowFlag (Acc32St w -> Bool)
-> StateT (Acc32St w) Identity (Acc32St w)
-> StateT (Acc32St w) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Acc32St w) Identity (Acc32St w)
forall s (m :: * -> *). MonadState s m => m s
get

getCarryFlag :: State (Acc32St w) Bool
getCarryFlag :: forall w. State (Acc32St w) Bool
getCarryFlag = Acc32St w -> Bool
forall w. Acc32St w -> Bool
carryFlag (Acc32St w -> Bool)
-> StateT (Acc32St w) Identity (Acc32St w)
-> StateT (Acc32St w) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Acc32St w) Identity (Acc32St w)
forall s (m :: * -> *). MonadState s m => m s
get

instance (IsWord w) => Inspectable (Acc32St w) where
    type WordOf (Acc32St w) = w
    type IsaOf (Acc32St w) = Acc32Isa w w

    programCounter :: Acc32St w -> Int
programCounter Acc32St{Int
pc :: forall w. Acc32St w -> Int
pc :: Int
pc} = Int
pc
    memoryDump :: Acc32St w -> MemOf (Acc32St w)
memoryDump Acc32St{IoMem (Acc32Isa w w) w
ram :: forall w. Acc32St w -> IoMem (Acc32Isa w w) w
ram :: IoMem (Acc32Isa w w) w
ram} = IoMem (Acc32Isa w w) w
MemOf (Acc32St w)
ram
    ioStreams :: Acc32St w -> IntMap ([WordOf (Acc32St w)], [WordOf (Acc32St w)])
ioStreams Acc32St{ram :: forall w. Acc32St w -> IoMem (Acc32Isa w w) w
ram = IoMem{IntMap ([w], [w])
mIoStreams :: IntMap ([w], [w])
mIoStreams :: forall isa w. IoMem isa w -> IntMap ([w], [w])
mIoStreams}} = IntMap ([w], [w])
IntMap ([WordOf (Acc32St w)], [WordOf (Acc32St w)])
mIoStreams
    isHalted :: Acc32St w -> Bool
isHalted Acc32St{Bool
stopped :: forall w. Acc32St w -> Bool
stopped :: Bool
stopped} = Bool
stopped
    views :: [View (StateEnv (Acc32St w))]
views =
        [ Text
-> Text
-> (StateEnv (Acc32St w) -> w)
-> View (StateEnv (Acc32St w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"Acc" Text
"Accumulator." (Acc32St w -> w
forall w. Acc32St w -> w
acc (Acc32St w -> w)
-> (StateEnv (Acc32St w) -> Acc32St w) -> StateEnv (Acc32St w) -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Acc32St w) -> Acc32St w
forall st. StateEnv st -> st
seState)
        , Text
-> Text
-> (StateEnv (Acc32St w) -> Text)
-> View (StateEnv (Acc32St w))
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"V" Text
"Overflow flag, `1` or `0`." (Bool -> Text
forall {a}. IsString a => Bool -> a
bit (Bool -> Text)
-> (StateEnv (Acc32St w) -> Bool) -> StateEnv (Acc32St w) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc32St w -> Bool
forall w. Acc32St w -> Bool
overflowFlag (Acc32St w -> Bool)
-> (StateEnv (Acc32St w) -> Acc32St w)
-> StateEnv (Acc32St w)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Acc32St w) -> Acc32St w
forall st. StateEnv st -> st
seState)
        , Text
-> Text
-> (StateEnv (Acc32St w) -> Text)
-> View (StateEnv (Acc32St w))
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"C" Text
"Carry flag, `1` or `0`." (Bool -> Text
forall {a}. IsString a => Bool -> a
bit (Bool -> Text)
-> (StateEnv (Acc32St w) -> Bool) -> StateEnv (Acc32St w) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc32St w -> Bool
forall w. Acc32St w -> Bool
carryFlag (Acc32St w -> Bool)
-> (StateEnv (Acc32St w) -> Acc32St w)
-> StateEnv (Acc32St w)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Acc32St w) -> Acc32St w
forall st. StateEnv st -> st
seState)
        ]
        where
            bit :: Bool -> a
bit Bool
f = if Bool
f then a
"1" else a
"0"

instance (IsWord w) => Machine (Acc32St w) (Acc32Isa w w) w where
    instructionFetch :: State (Acc32St w) (Either Text (Int, Acc32Isa w w))
instructionFetch = do
        st <- StateT (Acc32St w) Identity (Acc32St w)
forall s (m :: * -> *). MonadState s m => m s
get
        case st of
            Acc32St{stopped :: forall w. Acc32St w -> Bool
stopped = Bool
True} -> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a. a -> StateT (Acc32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Acc32Isa w w)
 -> State (Acc32St w) (Either Text (Int, Acc32Isa w w)))
-> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Acc32Isa w w)
forall a b. a -> Either a b
Left Text
halted
            Acc32St{internalError :: forall w. Acc32St w -> Maybe Text
internalError = Just Text
err} -> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a. a -> StateT (Acc32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Acc32Isa w w)
 -> State (Acc32St w) (Either Text (Int, Acc32Isa w w)))
-> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Acc32Isa w w)
forall a b. a -> Either a b
Left Text
err
            Acc32St{Int
pc :: forall w. Acc32St w -> Int
pc :: Int
pc, [(Int, Acc32Isa w w)]
ir :: forall w. Acc32St w -> [(Int, Acc32Isa w w)]
ir :: [(Int, Acc32Isa w w)]
ir}
                | Just Acc32Isa w w
instruction <- Int -> [(Int, Acc32Isa w w)] -> Maybe (Acc32Isa w w)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
pc [(Int, Acc32Isa w w)]
ir -> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a. a -> StateT (Acc32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Acc32Isa w w)
 -> State (Acc32St w) (Either Text (Int, Acc32Isa w w)))
-> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a b. (a -> b) -> a -> b
$ (Int, Acc32Isa w w) -> Either Text (Int, Acc32Isa w w)
forall a b. b -> Either a b
Right (Int
pc, Acc32Isa w w
instruction)
            Acc32St{Int
pc :: forall w. Acc32St w -> Int
pc :: Int
pc, IoMem (Acc32Isa w w) w
ram :: forall w. Acc32St w -> IoMem (Acc32Isa w w) w
ram :: IoMem (Acc32Isa w w) w
ram} ->
                case IoMem (Acc32Isa w w) w
-> Int
-> Either
     Text (IoMem (Acc32Isa w w) w, NonEmpty (Int, Acc32Isa w w))
forall isa w.
(ByteSize isa, IsWord w, Memory (Mem isa w) isa w) =>
IoMem isa w
-> Int -> Either Text (IoMem isa w, NonEmpty (Int, isa))
readInstructions IoMem (Acc32Isa w w) w
ram Int
pc of
                    Left Text
err -> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a. a -> StateT (Acc32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Acc32Isa w w)
 -> State (Acc32St w) (Either Text (Int, Acc32Isa w w)))
-> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, Acc32Isa w w)
forall a b. a -> Either a b
Left Text
err
                    Right (IoMem (Acc32Isa w w) w
ram', fetched :: NonEmpty (Int, Acc32Isa w w)
fetched@((Int
_, Acc32Isa w w
instruction) :| [(Int, Acc32Isa w w)]
_)) -> do
                        Acc32St w -> State (Acc32St w) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Acc32St w
st{ram = ram', ir = toList fetched}
                        Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a. a -> StateT (Acc32St w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, Acc32Isa w w)
 -> State (Acc32St w) (Either Text (Int, Acc32Isa w w)))
-> Either Text (Int, Acc32Isa w w)
-> State (Acc32St w) (Either Text (Int, Acc32Isa w w))
forall a b. (a -> b) -> a -> b
$ (Int, Acc32Isa w w) -> Either Text (Int, Acc32Isa w w)
forall a b. b -> Either a b
Right (Int
pc, Acc32Isa w w
instruction)
    instructionExecute :: Int -> Acc32Isa w w -> State (Acc32St w) ()
instructionExecute Int
pc Acc32Isa w w
instruction =
        case Acc32Isa w w
instruction of
            LoadImm w
a -> w -> State (Acc32St w) ()
forall {w} {m :: * -> *}. MonadState (Acc32St w) m => w -> m ()
setAcc w
a State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            LoadAddr w
a -> do
                value <- Int -> StateT (Acc32St w) Identity w
forall {b}.
(FiniteBits b, ByteSize b, Default b, Hashable b, Read b,
 WordParts b, FromSign b, Bounded b, Integral b, Show b) =>
Int -> StateT (Acc32St b) Identity b
getWord (Int -> StateT (Acc32St w) Identity w)
-> Int -> StateT (Acc32St w) Identity w
forall a b. (a -> b) -> a -> b
$ w -> Int
forall a. Enum a => a -> Int
fromEnum w
a
                setAcc value
                nextPc
            Load w
a -> Int -> StateT (Acc32St w) Identity w
forall {b}.
(FiniteBits b, ByteSize b, Default b, Hashable b, Read b,
 WordParts b, FromSign b, Bounded b, Integral b, Show b) =>
Int -> StateT (Acc32St b) Identity b
getWord (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) StateT (Acc32St w) Identity w
-> (w -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> State (Acc32St w) ()
forall {w} {m :: * -> *}. MonadState (Acc32St w) m => w -> m ()
setAcc State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            Acc32Isa w w
LoadAcc -> StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc StateT (Acc32St w) Identity w
-> (w -> StateT (Acc32St w) Identity w)
-> StateT (Acc32St w) Identity w
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT (Acc32St w) Identity w
forall {b}.
(FiniteBits b, ByteSize b, Default b, Hashable b, Read b,
 WordParts b, FromSign b, Bounded b, Integral b, Show b) =>
Int -> StateT (Acc32St b) Identity b
getWord (Int -> StateT (Acc32St w) Identity w)
-> (w -> Int) -> w -> StateT (Acc32St w) Identity w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Int
forall a. Enum a => a -> Int
fromEnum StateT (Acc32St w) Identity w
-> (w -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> State (Acc32St w) ()
forall {w} {m :: * -> *}. MonadState (Acc32St w) m => w -> m ()
setAcc State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            StoreAddr w
a -> StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc StateT (Acc32St w) Identity w
-> (w -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> w -> State (Acc32St w) ()
forall {w}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral w, Show w) =>
Int -> w -> StateT (Acc32St w) Identity ()
setWord (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            StoreInd w
a -> do
                addr <- Int -> StateT (Acc32St w) Identity w
forall {b}.
(FiniteBits b, ByteSize b, Default b, Hashable b, Read b,
 WordParts b, FromSign b, Bounded b, Integral b, Show b) =>
Int -> StateT (Acc32St b) Identity b
getWord (Int -> StateT (Acc32St w) Identity w)
-> Int -> StateT (Acc32St w) Identity w
forall a b. (a -> b) -> a -> b
$ w -> Int
forall a. Enum a => a -> Int
fromEnum w
a
                acc <- getAcc
                setWord (fromEnum addr) acc
                nextPc
            Store w
a -> StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc StateT (Acc32St w) Identity w
-> (w -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> w -> State (Acc32St w) ()
forall {w}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral w, Show w) =>
Int -> w -> StateT (Acc32St w) Identity ()
setWord (Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ w -> Int
forall a. Enum a => a -> Int
fromEnum w
a)) State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            Add w
a -> (w -> w -> Ext w) -> w -> State (Acc32St w) ()
withExt w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
addExt w
a
            Sub w
a -> (w -> w -> Ext w) -> w -> State (Acc32St w) ()
withExt w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
subExt w
a
            Mul w
a -> (w -> w -> Ext w) -> w -> State (Acc32St w) ()
withExt w -> w -> Ext w
forall w. IsWord w => w -> w -> Ext w
mulExt w
a
            Div w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withDivisor w -> w -> w
forall a. Integral a => a -> a -> a
div w
a
            Rem w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withDivisor w -> w -> w
forall a. Integral a => a -> a -> a
rem w
a
            Acc32Isa w w
Clv -> Bool -> State (Acc32St w) ()
forall w. Bool -> State (Acc32St w) ()
setOverflowFlag Bool
False State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            Acc32Isa w w
Clc -> Bool -> State (Acc32St w) ()
forall w. Bool -> State (Acc32St w) ()
setCarryFlag Bool
False State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            ShiftL w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc (\w
x w
y -> w -> Int -> w
forall a. Bits a => a -> Int -> a
shiftL w
x (w -> Int
forall a. Enum a => a -> Int
fromEnum w
y)) w
a
            ShiftR w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc (\w
x w
y -> w -> Int -> w
forall a. Bits a => a -> Int -> a
shiftR w
x (w -> Int
forall a. Enum a => a -> Int
fromEnum w
y)) w
a
            And w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc w -> w -> w
forall a. Bits a => a -> a -> a
(.&.) w
a
            Or w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc w -> w -> w
forall a. Bits a => a -> a -> a
(.|.) w
a
            Xor w
a -> (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc w -> w -> w
forall a. Bits a => a -> a -> a
xor w
a
            Acc32Isa w w
Not -> StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc StateT (Acc32St w) Identity w
-> (w -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= w -> State (Acc32St w) ()
forall {w} {m :: * -> *}. MonadState (Acc32St w) m => w -> m ()
setAcc (w -> State (Acc32St w) ())
-> (w -> w) -> w -> State (Acc32St w) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w
forall a. Bits a => a -> a
complement State (Acc32St w) ()
-> State (Acc32St w) () -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> StateT (Acc32St w) Identity b -> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (Acc32St w) ()
nextPc
            Jmp w
a -> Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a)
            Beqz w
a -> (w -> Bool) -> w -> State (Acc32St w) ()
condJmp (w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
0) w
a
            Bnez w
a -> (w -> Bool) -> w -> State (Acc32St w) ()
condJmp (w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0) w
a
            Bgz w
a -> (w -> Bool) -> w -> State (Acc32St w) ()
condJmp (w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0) w
a
            Bgez w
a -> (w -> Bool) -> w -> State (Acc32St w) ()
condJmp (w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0) w
a
            Blz w
a -> (w -> Bool) -> w -> State (Acc32St w) ()
condJmp (w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0) w
a
            Bvs w
a -> State (Acc32St w) Bool
forall w. State (Acc32St w) Bool
getOverflowFlag State (Acc32St w) Bool
-> (Bool -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
overflow -> if Bool
overflow then Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) else State (Acc32St w) ()
nextPc
            Bvc w
a -> State (Acc32St w) Bool
forall w. State (Acc32St w) Bool
getOverflowFlag State (Acc32St w) Bool
-> (Bool -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
overflow -> if Bool -> Bool
not Bool
overflow then Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) else State (Acc32St w) ()
nextPc
            Bcs w
a -> State (Acc32St w) Bool
forall w. State (Acc32St w) Bool
getCarryFlag State (Acc32St w) Bool
-> (Bool -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
carry -> if Bool
carry then Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) else State (Acc32St w) ()
nextPc
            Bcc w
a -> State (Acc32St w) Bool
forall w. State (Acc32St w) Bool
getCarryFlag State (Acc32St w) Bool
-> (Bool -> State (Acc32St w) ()) -> State (Acc32St w) ()
forall a b.
StateT (Acc32St w) Identity a
-> (a -> StateT (Acc32St w) Identity b)
-> StateT (Acc32St w) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
carry -> if Bool -> Bool
not Bool
carry then Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (w -> Int
forall a. Enum a => a -> Int
fromEnum w
a) else State (Acc32St w) ()
nextPc
            Acc32Isa w w
Halt -> (Acc32St w -> Acc32St w) -> State (Acc32St w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Acc32St w -> Acc32St w) -> State (Acc32St w) ())
-> (Acc32St w -> Acc32St w) -> State (Acc32St w) ()
forall a b. (a -> b) -> a -> b
$ \Acc32St w
st -> Acc32St w
st{stopped = True}
        where
            nextPc :: State (Acc32St w) ()
nextPc = Int -> State (Acc32St w) ()
forall w. Int -> State (Acc32St w) ()
setPc (Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Acc32Isa w w -> Int
forall t. ByteSize t => t -> Int
byteSize Acc32Isa w w
instruction)
            withExt :: (w -> w -> Ext w) -> w -> State (Acc32St w) ()
withExt w -> w -> Ext w
f w
addr = do
                acc <- StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc
                value <- getWord $ fromEnum addr
                let Ext{value = result, overflow, carry} = f acc value
                setAcc result
                setOverflowFlag overflow
                setCarryFlag carry
                nextPc
            withAcc :: (w -> w -> w) -> w -> State (Acc32St w) ()
withAcc w -> w -> w
f w
addr = do
                acc <- StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc
                value <- getWord $ fromEnum addr
                setAcc $ f acc value
                nextPc
            withDivisor :: (w -> w -> w) -> w -> State (Acc32St w) ()
withDivisor w -> w -> w
f w
addr = do
                acc <- StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc
                value <- getWord $ fromEnum addr
                if value == 0
                    then raiseInternalError "division by zero"
                    else setAcc (f acc value) >> nextPc
            condJmp :: (w -> Bool) -> w -> State (Acc32St w) ()
condJmp w -> Bool
p w
a = do
                acc <- StateT (Acc32St w) Identity w
forall w. State (Acc32St w) w
getAcc
                if p acc
                    then setPc (fromEnum a)
                    else nextPc