Trace code behind TRACE macro

2024-05-16 19:10:42 -04:00 · 2018-01-25 08:00:10 -08:00 · 2018-01-25 08:00:10 -08:00 · e497e974bd
parent 150993a1d4
commit e497e974bd
9 changed files with 76 additions and 18 deletions
--- a/.stellarator-options
+++ b/.stellarator-options
@ -13,6 +13,7 @@ Options {
    gameQuit = "Q",
    gameSelect = "C",
    gameReset = "V",
+    tvType = "X",
    enterDebugger = "Escape",
    debugMode = "Backslash",
    writeRecord = "W"
--- a/Stellarator.cabal
+++ b/Stellarator.cabal
@ -18,6 +18,8 @@ cabal-version:       >=1.10
 library
  hs-source-dirs:      src
  ghc-options:         -O5 -Wall -fwarn-missing-signatures -ddump-simpl -ddump-asm
+  extensions: CPP
+  cpp-options: -DTRACE=0
  extensions:          
  exposed-modules:     TIAColors, Binary, Core, Disasm,
                       DebugCmd, Memory, Asm, DebugState, Atari2600, Debugger, Metrics, BitManips, Emulation, VideoOps, Display, Keys, Events
@ -40,8 +42,9 @@ library
 executable stellarator-exe
  hs-source-dirs:      app
  main-is:             Main.hs
-  extensions:         
  ghc-options:         -O5 -Wall -fwarn-missing-signatures -ddump-simpl -ddump-asm 
+  extensions: CPP
+  cpp-options: -DTRACE=0
  build-depends:       base
                     , sdl2
                     , bytestring
--- a/app/Main.hs
+++ b/app/Main.hs
@ -21,7 +21,9 @@ import Data.Array.IO
 import Data.Binary hiding (get)
 import Data.Bits hiding (bit)
 import Data.Int(Int64)
+#if TRACE
 import Data.Array.Storable
+#endif
 import Emulation
 import Memory
 import Metrics
@ -72,25 +74,35 @@ main = do

    romArray <- newArray (0, 0x3fff) 0 :: IO (IOUArray Int Word8)
    ramArray <- newArray (0, 0x7f) 0 :: IO (IOUArray Int Word8)
+#if TRACE
    recordArray <- newArray (0, 2^24-1) 0 :: IO (StorableArray Int Word8)
+#endif
    bankStyle <- readBinary romArray (file args') 0x0000
    let bankStyle' = case (bank args') of
                        "f8" -> ModeF8
+                        "f8sc" -> ModeF8SC
                        "f6" -> ModeF6
+                        "f6sc" -> ModeF6SC
                        "3f" -> Mode3F
                        _    -> bankStyle

    let initBankState = case bankStyle' of
                            UnBanked -> NoBank
                            ModeF8 -> BankF8 0x0000
+                            ModeF8SC -> BankF8SC 0x0000
                            ModeF6 -> BankF6 0x0000
+                            ModeF6SC -> BankF6SC 0x0000
                            Mode3F -> Bank3F 0x0000
    print $ "Initial bank state = " ++ show initBankState

    --let style = bank args
    state <- initState screenScaleX' screenScaleY'
                       (screenWidth*screenScaleX') (screenHeight*screenScaleY')
-                       ramArray recordArray initBankState romArray
+                       ramArray
+#if TRACE
+                       recordArray
+#endif
+                       initBankState romArray
                       0x0000 window prog attrib tex' textureData'

    let loop = do
--- a/src/Atari2600.hs
+++ b/src/Atari2600.hs
@ -18,8 +18,10 @@ module Atari2600(
                 useStellaClock,
                 bankState,
                 ram,
+#if TRACE
                 record,
                 recordPtr,
+#endif
                 rom,
                 useClock,
                 putStellaDebug,
@ -60,8 +62,10 @@ data Atari2600 = Atari2600 {
    _stellaDebug :: IORef DebugState,

    _ram :: IOUArray Int Word8,
+#if TRACE
    _record :: StorableArray Int Word8,
    _recordPtr :: IORef Int,
+#endif
    _rom :: IOUArray Int Word8,
    _boolArray :: Segment Bool,
    _intArray :: Segment Int,
--- a/src/Emulation.hs
+++ b/src/Emulation.hs
@ -64,7 +64,9 @@ startIntervalTimerN n v = do

 initState :: Int -> Int -> Int -> Int ->
             IOUArray Int Word8 ->
+#if TRACE
             StorableArray Int Word8 ->
+#endif
             BankState ->
             IOUArray Int Word8 ->
             Word16 ->
@ -74,13 +76,19 @@ initState :: Int -> Int -> Int -> Int ->
             GL.TextureObject ->
             Ptr Word8 ->
             IO Atari2600
-initState xscale' yscale' width height ram' record' initBankState rom' initialPC window prog attrib initTex initTextureData = do
+initState xscale' yscale' width height ram'
+#if TRACE
+            record'
+#endif
+            initBankState rom' initialPC window prog attrib initTex initTextureData = do
          stellaDebug' <- newIORef DebugState.start
          bankState' <- newIORef initBankState
          clock' <- newIORef 0
          -- debug' <- newIORef 8
          stellaClock' <- newIORef 0
+#if TRACE
          recordPtr' <- newIORef 0
+#endif
          boolArray' <- newArray (0, maxBool) False
          intArray' <- newArray (0, 127) 0      -- Overkill
          word64Array' <- newArray (0, maxWord64) 0
@ -93,8 +101,10 @@ initState xscale' yscale' width height ram' record' initBankState rom' initialPC
              _windowWidth = width,
              _windowHeight = height,
              _rom = rom',
+#if TRACE
              _record = record',
              _recordPtr = recordPtr',
+#endif
              _ram = ram',
              _stellaDebug = stellaDebug',
              _bankState = bankState',
@ -366,10 +376,12 @@ pureReadRom addr = do
    let bankStateRef = atari ^. bankState
    bankState' <- liftIO $ readIORef bankStateRef
    let bankedAddress = bankAddress bankState' addr
+--    when (bankWritable bankState' addr) $ do
+--        liftIO $ putStrLn $ "pureReadRom: Writing to bankAddress 0x" ++ showHex addr "" ++ " -> 0x" ++ showHex bankedAddress "" ++ " (" ++ show bankState' ++ ")"
    liftIO $ readArray m bankedAddress

 {-# INLINE pureWriteRom #-}
-- | pureReadRom sees address in full 6507 range 0x0000-0x1fff
+-- | pureWriteRom sees address in full 6507 range 0x0000-0x1fff
 -- You can write to Super Chip "ROM"
 pureWriteRom :: Word16 -> Word8 -> MonadAtari ()
 pureWriteRom addr v = do
@ -380,7 +392,7 @@ pureWriteRom addr v = do
    bankState' <- liftIO $ readIORef bankStateRef
    when (bankWritable bankState' addr) $ do
        let bankedAddress = bankAddress bankState' addr
-        -- liftIO $ putStrLn $ "readReadRom: Reading from bankAddress 0x" ++ showHex bankedAddress "" ++ " (" ++ show bankState' ++ ")"
+--        liftIO $ putStrLn $ "pureWriteRom: Writing to bankAddress 0x" ++ showHex addr "" ++ " -> 0x" ++ showHex bankedAddress "" ++ " (" ++ show bankState' ++ ")"
        liftIO $ writeArray m bankedAddress v

 {-# INLINE pureReadMemory #-}
@ -404,13 +416,17 @@ pureWriteMemory ROM  addr v = pureWriteRom addr v
 pureWriteMemory RAM  addr v = do
    atari <- ask
    let m = atari ^. ram
+#if TRACE
    let r = atari ^. record
    i <- liftIO $ readIORef (atari ^. recordPtr)
+#endif
    let realAddress = iz addr .&. 0x7f
    liftIO $ writeArray m realAddress v
+#if TRACE
    liftIO $ writeArray r i (i8 realAddress)
    liftIO $ writeArray r (i+1) v
    liftIO $ writeIORef (atari ^. recordPtr) (i+2)
+#endif

 instance Emu6502 MonadAtari where
    {-# INLINE readMemory #-}
--- a/src/Events.hs
+++ b/src/Events.hs
@ -69,6 +69,7 @@ handleKey atariKeys motion sym = do
                Joystick1Left    -> modify swcha $ bitAt 6 .~ not pressed
                Joystick1Right   -> modify swcha $ bitAt 7 .~ not pressed
                Joystick1Trigger -> trigger1Pressed pressed
+                TVType           -> modify swchb $ bitAt 3 .~ not pressed
                GameSelect       -> modify swchb $ bitAt 1 .~ not pressed
                GameReset        -> modify swchb $ bitAt 0 .~ not pressed
                DumpState        -> Emulation.dumpState
@ -79,6 +80,7 @@ handleKey atariKeys motion sym = do
                                        runDebugger
                                        liftIO $ killThread t
                DebugMode        -> when pressed $ modify debugColours not
+#if TRACE
                WriteRecord      -> when pressed $ do
                                        liftIO $ print "Write record!"
                                        atari <- ask
@ -88,4 +90,7 @@ handleKey atariKeys motion sym = do
                                            handle <- openBinaryFile "trace.record" WriteMode
                                            hPutBuf handle ptr endPtr
                                            hClose handle
+#else
+                WriteRecord     -> when pressed $ liftIO $ print "Trace not enabled at compilation"
+#endif

--- a/src/Keys.hs
+++ b/src/Keys.hs
@ -198,6 +198,7 @@ data Options = Options {
    gameQuit :: String,
    gameSelect :: String,
    gameReset :: String,
+    tvType :: String,
    enterDebugger :: String,
    debugMode :: String,
    writeRecord :: String
@ -219,13 +220,14 @@ defaultOptions = Options {
    gameQuit = "Q",
    gameSelect = "C",
    gameReset = "V",
+    tvType = "X",
    enterDebugger = "Escape",
    debugMode = "Backslash",
    writeRecord = "W"
 }

 data AtariKey = Joystick1Left | Joystick1Right | Joystick1Up | Joystick1Down | Joystick1Trigger
-              | GameSelect | GameReset
+              | GameSelect | GameReset | TVType
              | GameQuit | DumpState | EnterDebugger | DebugMode
              | WriteRecord
                deriving (Eq, Show)
@ -244,6 +246,7 @@ keysFromOptions options = do
                    gameQuit options,
                    gameSelect options,
                    gameReset options,
+                    tvType options,
                    enterDebugger options,
                    debugMode options,
                    writeRecord options
@ -258,6 +261,7 @@ keysFromOptions options = do
                    GameQuit,
                    GameSelect,
                    GameReset,
+                    TVType,
                    EnterDebugger,
                    DebugMode,
                    WriteRecord
--- a/src/Memory.hs
+++ b/src/Memory.hs
@ -60,15 +60,17 @@ isROM a = testBit a 12
 -- http://blog.kevtris.org/blogfiles/Atari%202600%20Mappers.txt

 data BankMode = UnBanked
-              | ModeF6
-              | ModeF6SC
-              | ModeF8
+              | ModeF6 -- 16K
+              | ModeF6SC -- 16K
+              | ModeF8 -- 8K
+              | ModeF8SC -- 8K
              | Mode3F deriving (Show, Data, Typeable)

 data BankState = NoBank
               | BankF6 !Word16
               | BankF6SC !Word16
               | BankF8 !Word16
+               | BankF8SC !Word16
               | Bank3F !Word16 deriving Show

 i16 :: Integral a => a -> Word16
@ -85,10 +87,16 @@ bankSwitch    _         _        NoBank           = NoBank

 bankSwitch    0x1ff8    _        (BankF8 _)       = BankF8 0x0000
 bankSwitch    0x1ff9    _        (BankF8 _)       = BankF8 0x1000
+bankSwitch    0x1ff8    _        (BankF8SC _)     = BankF8SC 0x0000
+bankSwitch    0x1ff9    _        (BankF8SC _)     = BankF8SC 0x1000
 bankSwitch    0x1ff6    _        (BankF6 _)       = BankF6 0x0000
 bankSwitch    0x1ff7    _        (BankF6 _)       = BankF6 0x1000
 bankSwitch    0x1ff8    _        (BankF6 _)       = BankF6 0x2000
 bankSwitch    0x1ff9    _        (BankF6 _)       = BankF6 0x3000
+bankSwitch    0x1ff6    _        (BankF6SC _)     = BankF6SC 0x0000
+bankSwitch    0x1ff7    _        (BankF6SC _)     = BankF6SC 0x1000
+bankSwitch    0x1ff8    _        (BankF6SC _)     = BankF6SC 0x2000
+bankSwitch    0x1ff9    _        (BankF6SC _)     = BankF6SC 0x3000

 -- My implementation of 3F doesn't fit the description at
 -- http://blog.kevtris.org/blogfiles/Atari%202600%20Mappers.txt
@ -104,17 +112,22 @@ bankSwitch    _         _        state            = state
 -- i.e. it is in range 0x0000-0x1fff
 -- though we only expect to see values in range 0x1000-0x1fff
 -- as we only reach this function if the 6507 is reading from ROM.
-bankAddress :: BankState ->    Word16 -> Int
-bankAddress    NoBank          addr = iz (addr .&. 0xfff)
-bankAddress    (BankF8 offset) addr = ((iz addr .&. 0xfff)+iz offset)
-bankAddress    (BankF6 offset) addr = ((iz addr .&. 0xfff)+iz offset)
-bankAddress    (Bank3F _)      addr | addr > 0x1800 = iz addr
-bankAddress    (Bank3F offset) addr = ((iz addr .&. 0x7ff)+iz offset)
+bankAddress :: BankState ->      Word16 -> Int
+bankAddress    NoBank            addr   = iz (addr .&. 0xfff)
+bankAddress    (BankF8 offset)   addr   = ((iz addr .&. 0xfff)+iz offset)
+bankAddress    (BankF8SC offset) addr   = let zaddr = iz addr .&. 0xfff
+                                          in if zaddr < 0x100 then (zaddr .&. 0x7f) else zaddr+iz offset
+bankAddress    (BankF6 offset)   addr   = ((iz addr .&. 0xfff)+iz offset)
+bankAddress    (BankF6SC offset) addr   = let zaddr = iz addr .&. 0xfff
+                                          in if zaddr < 0x100 then (zaddr .&. 0x7f) else zaddr+iz offset
+bankAddress    (Bank3F _)        addr   | addr > 0x1800 = iz addr
+bankAddress    (Bank3F offset)   addr   = ((iz addr .&. 0x7ff)+iz offset)

 {-# INLINE bankWritable #-}
 -- | bankAddress sees the full 6507 address
 -- i.e. it is in range 0x0000-0x1fff
 -- though we only expect to see values in range 0x1000-0x1fff
 -- as we only reach this function if the 6507 is reading from ROM.
-bankWritable :: BankState ->    Word16 -> Bool
-bankWritable    _          _ = False
+bankWritable :: BankState -> Word16 -> Bool
+bankWritable    (BankF6SC _) addr = (addr .&. 0xfff) < 0x100
+bankWritable    _            _    = False
--- a/trace.cpp
+++ b/trace.cpp
@ -105,7 +105,7 @@ int main() {

    cout << "Reading trace..." << endl;
    if (file.read(trace.data(), size)) {
-        const int vscale = 1;
+        const int vscale = 512;
        int end = size/2;
        //end = 10000;
        int vsize = (end+vscale-1)/vscale;