Simple little tests
This commit is contained in:
parent
6553bbd7e3
commit
18266f7806
49
app/Main.hs
49
app/Main.hs
|
@ -3,17 +3,54 @@ module Main where
|
||||||
import SixtyFiveOhTwo.Instruction
|
import SixtyFiveOhTwo.Instruction
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
import Data.Int
|
||||||
|
|
||||||
accumulatorLoadNStore :: Instruction
|
test1 :: Instruction
|
||||||
accumulatorLoadNStore = do
|
test1 = do
|
||||||
|
lda (Immediate 0xFF)
|
||||||
|
sta (ZeroPage 0x00)
|
||||||
|
lda (Immediate 0x00)
|
||||||
|
adc (Immediate 0x01)
|
||||||
|
cmp (ZeroPage 0x00)
|
||||||
|
bne (Relative (-0x03 :: Int8))
|
||||||
|
|
||||||
|
|
||||||
|
test2f :: Instruction
|
||||||
|
test2f = do
|
||||||
lda (Immediate 0x10)
|
lda (Immediate 0x10)
|
||||||
sta (Absolute 0x0200)
|
sta (Absolute 0x0200)
|
||||||
rts (Implied)
|
rts (Implied)
|
||||||
|
|
||||||
myProgram :: Instruction
|
test2 :: Instruction
|
||||||
myProgram = do
|
test2 = do
|
||||||
define "accumulatorLoadNStore" accumulatorLoadNStore
|
define "accumulatorLoadNStore" test2f
|
||||||
call "accumulatorLoadNStore"
|
call "accumulatorLoadNStore"
|
||||||
|
|
||||||
|
test3f2 :: Instruction
|
||||||
|
test3f2 = replicateM_ 10 (inc (Accumulator))
|
||||||
|
|
||||||
|
test3f1 :: Instruction
|
||||||
|
test3f1 = do
|
||||||
|
lda (Immediate 0x02)
|
||||||
|
define "addIt" test3f2
|
||||||
|
|
||||||
|
test3 :: Instruction
|
||||||
|
test3 = do
|
||||||
|
define "loadIt" test3f1
|
||||||
|
call "loadIt"
|
||||||
|
call "addIt"
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = B.putStr $ runInstructions myProgram
|
main = do
|
||||||
|
putStrLn "test one: simple program"
|
||||||
|
putStrLn "========================"
|
||||||
|
print $ execState test1 emptyState
|
||||||
|
putStrLn ""
|
||||||
|
putStrLn "test two: simple function"
|
||||||
|
putStrLn "========================="
|
||||||
|
print $ execState test2 emptyState
|
||||||
|
putStrLn ""
|
||||||
|
putStrLn "test two: nested function"
|
||||||
|
putStrLn "========================="
|
||||||
|
print $ execState test3 emptyState
|
||||||
|
putStrLn ""
|
||||||
|
|
|
@ -7,6 +7,7 @@ import qualified Data.ByteString as B
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Word
|
import Data.Word
|
||||||
|
import Data.Int
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
|
||||||
data InstructionState = InstructionState {
|
data InstructionState = InstructionState {
|
||||||
|
@ -30,8 +31,8 @@ data AddressingMode =
|
||||||
Implied |
|
Implied |
|
||||||
Accumulator |
|
Accumulator |
|
||||||
Immediate Word8 |
|
Immediate Word8 |
|
||||||
Relative Word8 | -- Signed
|
Relative Int8 | -- Signed
|
||||||
ZeroPageRelative Word8 | -- Signed
|
ZeroPageRelative Int8 | -- Signed
|
||||||
Absolute Word16 |
|
Absolute Word16 |
|
||||||
AbsoluteX Word16 |
|
AbsoluteX Word16 |
|
||||||
AbsoluteY Word16 |
|
AbsoluteY Word16 |
|
||||||
|
@ -63,8 +64,11 @@ genericNoByteOp :: Word8 -> Instruction
|
||||||
genericNoByteOp op = modify $ appendBytes [op]
|
genericNoByteOp op = modify $ appendBytes [op]
|
||||||
|
|
||||||
-- This function allows you to define an instruction opcode that takes a one byte argument
|
-- This function allows you to define an instruction opcode that takes a one byte argument
|
||||||
genericOp :: Word8 -> Word8 -> Instruction
|
-- This is polymorphic to support Int8 OR Word8
|
||||||
genericOp op arg = modify $ appendBytes [op, arg]
|
genericOp :: (FiniteBits a, Integral a) => Word8 -> a -> Instruction
|
||||||
|
-- fromIntegral from an IntN to a WordN does _not_ preserve value, only structure
|
||||||
|
-- Thus, this is valid code.
|
||||||
|
genericOp op arg = modify $ appendBytes [op, fromIntegral arg]
|
||||||
|
|
||||||
-- This function allows you to define an instruction opcode that takes a two byte argument
|
-- This function allows you to define an instruction opcode that takes a two byte argument
|
||||||
genericTwoByteOp :: Word8 -> Word16 -> Instruction
|
genericTwoByteOp :: Word8 -> Word16 -> Instruction
|
||||||
|
|
Loading…
Reference in New Issue