Fixes and cleanup

lisphacker · Oct 12, 2023 · 94b92f5 · 94b92f5
1 parent c75430f
commit 94b92f5
Show file tree

Hide file tree

Showing 7 changed files with 40 additions and 27 deletions.
diff --git a/examples/segment00150/segment00150.asm b/examples/segment00150/segment00150.asm
@@ -1,5 +1,4 @@
 @0
-ADD 10
 MOV UP, DOWN
 @4
 MOV UP, DOWN

diff --git a/sim/Main.hs b/sim/Main.hs
@@ -36,15 +36,19 @@ readAsm cmdLineOpts = do
 loopUntilNoChange :: Int -> Run.SimState -> IO Run.SimState
 loopUntilNoChange i s = do
   nextSimState <- Run.runStep s
-  print $ "Iteration " ++ show i
-  print $ "Before: "
-  print $ "  " ++ show (V.head . CPU.tiles . Run.cpu $ s)
-  print $ "  " ++ show (IM.lookup 0 $ Run.inputs s)
-  print $ "  " ++ show (IM.lookup 0 $ Run.outputs s)
-  print $ "After:  "
-  print $ "  " ++ show (V.head . CPU.tiles . Run.cpu $ nextSimState)
-  print $ "  " ++ show (IM.lookup 0 $ Run.inputs nextSimState)
-  print $ "  " ++ show (IM.lookup 0 $ Run.outputs nextSimState)
+  -- print $ "Iteration " ++ show i
+  -- print $ "Before: "
+  -- print $ "  " ++ show (V.head . CPU.tiles . Run.cpu $ s)
+  -- print $ "  " ++ show (((flip (V.!)) 4) . CPU.tiles . Run.cpu $ s)
+  -- print $ "  " ++ show (((flip (V.!)) 8) . CPU.tiles . Run.cpu $ s)
+  -- print $ "  IN:  " ++ show (IM.lookup 0 $ Run.inputs s)
+  -- print $ "  OUT: " ++ show (IM.lookup 0 $ Run.outputs s)
+  -- print $ "After:  "
+  -- print $ "  " ++ show (V.head . CPU.tiles . Run.cpu $ nextSimState)
+  -- print $ "  " ++ show (((flip (V.!)) 4) . CPU.tiles . Run.cpu $ nextSimState)
+  -- print $ "  " ++ show (((flip (V.!)) 8) . CPU.tiles . Run.cpu $ nextSimState)
+  -- print $ "  IN:  " ++ show (IM.lookup 0 $ Run.inputs nextSimState)
+  -- print $ "  OUT: " ++ show (IM.lookup 0 $ Run.outputs nextSimState)
   if nextSimState == s
     then return s
     else loopUntilNoChange (i + 1) nextSimState
@@ -67,4 +71,8 @@ main = do
   print ""
   print "Final state"
   print finalSimState
+  print "Ref Output"
+  print $ show $ refOutputs cfg
+  print "Test Output"
+  print $ show $ Run.outputs finalSimState
   return ()
diff --git a/src/TIS100/Parser/Config.hs b/src/TIS100/Parser/Config.hs
@@ -16,5 +16,6 @@ data Config = Config
   , tiles :: [[TileType]]
   , inputs :: IODef
   , outputs :: IODef
+  , refOutputs :: IODef
   }
   deriving (Eq, Show)
diff --git a/src/TIS100/Parser/ConfigParser.hs b/src/TIS100/Parser/ConfigParser.hs
@@ -8,8 +8,8 @@ import GHC.IO.Handle (hGetContents)
 import System.FilePath (takeDirectory, (</>))
 import System.IO (stdin)
 import TIS100.Errors (TISError (..), TISErrorCode (TISParseError), TISErrorOr)
-import TIS100.Parser.Config (Config (..), IODef, IOSource (..), TileType (..))
 import TIS100.Parser.Base (Parser, parseInt, parseToken)
+import TIS100.Parser.Config (Config (..), IODef, IOSource (..), TileType (..))
 import Text.Megaparsec (MonadParsec (eof, takeWhile1P, try), Parsec, anySingleBut, count, manyTill, oneOf, parse, some, (<|>))
 import Text.Megaparsec.Char (char, printChar, space, spaceChar, string)
 
@@ -80,8 +80,8 @@ cfgParser = do
     space
     return tilesRow
   space
-  (inputs, outputs) <- parseIODefs IM.empty IM.empty
-  return $ Config rows cols tiles inputs outputs
+  (inputs, refOutputs) <- parseIODefs IM.empty IM.empty
+  return $ Config rows cols tiles inputs IM.empty refOutputs
 
 parseConfig :: String -> TISErrorOr Config
 parseConfig cfgSrc = case parse cfgParser "tis100cfg" cfgSrc of
@@ -91,7 +91,8 @@ parseConfig cfgSrc = case parse cfgParser "tis100cfg" cfgSrc of
 readExternalInputs :: FilePath -> Config -> IO Config
 readExternalInputs cfgPath config = do
   inputs' <- mapM readExternalInput $ inputs config
-  return $ config{inputs = inputs'}
+  refOutputs' <- mapM readExternalInput $ refOutputs config
+  return $ config{inputs = inputs', refOutputs = refOutputs'}
  where
   readExternalInput :: IOSource -> IO IOSource
   readExternalInput (File path) = do

diff --git a/src/TIS100/Sim/Run.hs b/src/TIS100/Sim/Run.hs
@@ -1,6 +1,6 @@
 module TIS100.Sim.Run where
 
-import Control.Monad (foldM)
+import Control.Monad
 import Control.Monad.ST
 import Data.IntMap qualified as IM
 import Data.Maybe (fromJust, fromMaybe)
@@ -27,32 +27,35 @@ data SimState = SimState
 type RWTileVector = MV.MVector RealWorld CPU.PositionedTile
 
 runStep :: SimState -> IO SimState
-runStep = processComm >> stepTiles
+runStep = processComm >=> stepTiles
 
 readInputValue :: Int -> CFG.IODef -> IO (Maybe Int, CFG.IODef)
 readInputValue ti iodef = case IM.lookup ti iodef of
   Just (CFG.List (v : vs)) -> return (Just v, IM.insert ti (CFG.List vs) iodef)
   Just (CFG.List []) -> return (Nothing, iodef)
-  Just (CFG.File fp) -> return (Nothing, iodef)
-  Just (CFG.StdIO) -> return (Nothing, iodef)
+  Just (CFG.File fp) -> error "Tile I/O using files is not yet implemented"
+  Just CFG.StdIO -> error "Tile I/O using StdIO is not yet implemented"
   Nothing -> return (Nothing, iodef)
 
 writeOutputValue :: Int -> Int -> CFG.IODef -> IO CFG.IODef
 writeOutputValue ti v iodef = case IM.lookup ti iodef of
   Just (CFG.List vs) -> return $ IM.insert ti (CFG.List (vs ++ [v])) iodef
-  Just (CFG.File fp) -> return $ iodef
-  Just (CFG.StdIO) -> return $ iodef
-  Nothing -> return $ iodef
+  Just (CFG.File fp) -> error "Tile I/O using files is not yet implemented"
+  Just CFG.StdIO -> error "Tile I/O using StdIO is not yet implemented"
+  Nothing -> return $ IM.insert ti (CFG.List [v]) iodef
 
 processComm :: SimState -> IO SimState
 processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles) ins outs) = do
   mtiles <- V.thaw tiles
   let nTiles = rows * cols
-  print $ "nTiles: " ++ show nTiles
-  (mtiles', ins', outs') <- foldM processTileComm (mtiles, ins, outs) [0 .. nTiles - 1]
+  (mtiles', ins', outs') <- foldM processTileComm' (mtiles, ins, outs) [0 .. nTiles - 1]
   tiles' <- V.freeze mtiles'
   return $ SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles') ins' outs'
  where
+  processTileComm' :: (RWTileVector, IODef, IODef) -> Int -> IO (RWTileVector, IODef, IODef)
+  processTileComm' (tiles, ins, outs) i = do
+    (tiles', ins', outs') <- processTileComm (tiles, ins, outs) i
+    return (tiles', ins', outs')
   processTileComm :: (RWTileVector, IODef, IODef) -> Int -> IO (RWTileVector, IODef, IODef)
   processTileComm (tiles, ins, outs) i = do
     ptile <- MV.read tiles i
@@ -64,7 +67,6 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles) ins outs) =
         if r == 0 && p == Tiles.UP
           then do
             (maybeV, ins') <- readInputValue c ins
-            print $ "Tile " ++ show i ++ " waiting on read: " ++ show maybeV
             case maybeV of
               Just v -> do
                 let tile' = writeValueTo p (Tiles.Value v) tile
@@ -88,7 +90,6 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles) ins outs) =
         if r == rows - 1 && p == Tiles.DOWN
           then do
             let (tile', maybeV) = readValueFrom p tile
-            print $ "Tile " ++ show i ++ " waiting on write: " ++ show maybeV
             case maybeV of
               Just (Tiles.Value v) -> do
                 outs' <- writeOutputValue c v outs

diff --git a/src/TIS100/Tiles/Base.hs b/src/TIS100/Tiles/Base.hs
@@ -4,7 +4,7 @@ newtype Value = Value Int
   deriving (Eq, Ord)
 
 instance Show Value where
-  show (Value v) = show v
+  show (Value v) = "<" ++ show v ++ ">"
 
 clamp :: Int -> Int
 clamp = max (-999) . min 999

diff --git a/src/TIS100/Tiles/T21.hs b/src/TIS100/Tiles/T21.hs
@@ -102,7 +102,10 @@ setPortVal p v t
   | p == UP = t{tileState = (tileState t){up = Just v, runState = rs}}
   | p == DOWN = t{tileState = (tileState t){down = Just v, runState = rs}}
  where
-  rs = if (runState . tileState) t == WaitingOnRead p then Ready else (runState . tileState) t
+  rs = case (runState . tileState) t of
+    WaitingOnRead p -> Ready
+    WaitingOnWrite p -> WaitingOnWrite p
+    Ready -> WaitingOnWrite p
 
 clearPortVal :: Port' -> Value -> T21 -> T21
 clearPortVal LEFT v t = t{tileState = (tileState t){left = Nothing}}