segment20176. not working yet. needs refactoring first

build.sh

@@ -1,3 +1,3 @@
 #!/bin/bash
 
-stack build 2>&1 | tee build.log
+stack build --pedantic 2>&1 | tee build.log

examples/segment20176/segment20176.asm

@@ -0,0 +1,21 @@
+@1
+MOV UP, ACC
+SUB RIGHT
+MOV ACC, DOWN
+
+@2
+MOV UP, LEFT
+
+@5
+MOV UP, ACC
+MOV ACC, DOWN
+MOV ACC, DOWN
+
+@9
+MOV UP, RIGHT
+MOV UP, DOWN
+
+@10
+MOV LEFT, ACC
+NEG
+MOV ACC, DOWN

examples/segment20176/segment20176.cfg

@@ -0,0 +1,8 @@
+3 4
+CCCC
+CCCD
+CCCC
+I1 NUMERIC - 44 78 88 95
+I2 NUMERIC - 93 60 92 68
+O1 NUMERIC - -49 18 -4 27
+O2 NUMERIC - 49 -18 4 -27

run_tests.sh

@@ -1,4 +1,5 @@
 #!/bin/bash
 
 ./build.sh
-stack run tissim -- examples/segment00150/segment00150.asm -c examples/segment00150/segment00150.cfg 2>&1 | tee test.log
+# stack run tissim -- examples/segment00150/segment00150.asm -c examples/segment00150/segment00150.cfg 2>&1 | tee test.log
+stack run tissim -- examples/segment20176/segment20176.asm -c examples/segment20176/segment20176.cfg 2>&1 | tee test.log

src/TIS100/Parser/Base.hs

@@ -2,15 +2,18 @@ module TIS100.Parser.Base where
 
 import Control.Monad (void)
 import Data.Void (Void)
-import Text.Megaparsec (MonadParsec (eof), Parsec, manyTill, oneOf, some, (<|>))
-import Text.Megaparsec.Char (printChar, spaceChar)
+import Text.Megaparsec (MonadParsec (eof), Parsec, manyTill, oneOf, optional, some, (<|>))
+import Text.Megaparsec.Char (char, printChar, spaceChar)
 
 type Parser = Parsec Void String
 
 parseInt :: Parser Int
 parseInt = do
+  neg <- optional $ char '-'
   n <- some $ oneOf ['0' .. '9']
-  return $ read n
+  return $ case neg of
+    Just _ -> negate $ read n
+    Nothing -> read n
 
 parseToken :: Parser String
 parseToken = do

src/TIS100/Sim/CPU.hs

@@ -50,7 +50,7 @@ createInitialCPUState cfg asm =
 
   getTileAsm :: Int -> TISErrorOr T21.TileProgram
   getTileAsm i = case IM.lookup i asm of
-    Nothing -> Left $ TISError TISParseError $ "No tile asm forat index " ++ show i
+    Nothing -> Right $ V.singleton T21.NOP
     Just a -> resolveAsm a
 
 resolveAsm :: AP.TileAsmSource -> TISErrorOr T21.TileProgram

src/TIS100/Sim/Run.hs

@@ -22,32 +22,41 @@ data SimState = SimState
 
 type RWTileVector = MV.MVector RealWorld CPU.PositionedTile
 
+dumpSimState :: String -> SimState -> IO ()
+dumpSimState _ _ = return ()
+
+-- dumpSimState prefix s = do
+--   print $ prefix
+--   print $ "  T1:  " ++ show (flip (V.!) 1 . CPU.tiles . cpu $ s)
+--   print $ "  T2:  " ++ show (flip (V.!) 2 . CPU.tiles . cpu $ s)
+--   print $ "  T5:  " ++ show (flip (V.!) 5 . CPU.tiles . cpu $ s)
+--   print $ "  T9:  " ++ show (flip (V.!) 9 . CPU.tiles . cpu $ s)
+--   print $ "  T10: " ++ show (flip (V.!) 10 . CPU.tiles . cpu $ s)
+--   print $ "  IN1:  " ++ show (IM.lookup 1 $ inputs s)
+--   print $ "  IN2:  " ++ show (IM.lookup 2 $ inputs s)
+--   print $ "  OUT1:  " ++ show (IM.lookup 1 $ outputs s)
+--   print $ "  OUT2:  " ++ show (IM.lookup 2 $ outputs s)
+
 loopUntilNoChange :: Int -> SimState -> IO SimState
 loopUntilNoChange i s = do
+  dumpSimState "Before: " s
   nextSimState <- runStep s
-  -- 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)
+  dumpSimState "After: " nextSimState
   if nextSimState == s
     then return s
     else loopUntilNoChange (i + 1) nextSimState
 
 run :: SimState -> IO SimState
-run s = loopUntilNoChange 1 s
+run = loopUntilNoChange 1
 
 runStep :: SimState -> IO SimState
 runStep = processComm >=> stepTiles
 
+-- runStep s = do
+--   s' <- processComm s
+--   dumpSimState "After comm: " s'
+--   stepTiles s'
+
 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)
@@ -82,30 +91,37 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles_) ins_ outs_
     let (r, c) = CPU.position ptile
 
     case getRunState tile of
-      Tiles.WaitingOnRead p -> do
+      Tiles.WaitingOnRead _ (Just _) -> return (tiles, ins, outs)
+      Tiles.WaitingOnRead p Nothing -> do
         if r == 0 && p == Tiles.UP
           then do
             (maybeV, ins') <- readInputValue c ins
             case maybeV of
               Just v -> do
-                let tile' = writeValueTo p (Tiles.Value v) tile
-                MV.write tiles i $ ptile{CPU.tile = tile'}
-                return (tiles, ins', outs)
-              Nothing -> return (tiles, ins', outs)
+                let maybeTile' = writeValueTo p (Tiles.Value v) tile
+                case maybeTile' of
+                  Just tile' -> do
+                    MV.write tiles i $ ptile{CPU.tile = tile'}
+                    return (tiles, ins', outs)
+                  Nothing -> return (tiles, ins, outs)
+              Nothing -> return (tiles, ins, outs)
           else do
             let o = getOtherTile i p
             optile <- MV.read tiles o
             let otile = CPU.tile optile
             let op = Tiles.getOppositePort p
-            if readable op otile
-              then do
-                let (otile', val) = readValueFrom op otile
-                let tile' = writeValueTo p (fromJust val) tile
-                MV.write tiles i $ ptile{CPU.tile = tile'}
-                MV.write tiles o $ optile{CPU.tile = otile'}
-                return (tiles, ins, outs)
-              else return (tiles, ins, outs)
-      Tiles.WaitingOnWrite p -> do
+            let (otile', maybeVal) = readValueFrom op otile
+            case maybeVal of
+              Just val -> do
+                let maybeTile' = writeValueTo p val tile
+                case maybeTile' of
+                  Just tile' -> do
+                    MV.write tiles i $ ptile{CPU.tile = tile'}
+                    MV.write tiles o $ optile{CPU.tile = otile'}
+                    return (tiles, ins, outs)
+                  Nothing -> return (tiles, ins, outs)
+              Nothing -> return (tiles, ins, outs)
+      Tiles.WaitingOnWrite p _ -> do
         if r == rows - 1 && p == Tiles.DOWN
           then do
             let (tile', maybeV) = readValueFrom p tile
@@ -120,14 +136,14 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles_) ins_ outs_
             optile <- MV.read tiles o
             let otile = CPU.tile optile
             let op = Tiles.getOppositePort p
-            if writable op otile
-              then do
-                let (tile', val) = readValueFrom p tile
-                let otile' = writeValueTo op (fromJust val) otile
+            let (tile', val) = readValueFrom p tile
+            let maybeOtile' = writeValueTo op (fromJust val) otile
+            case maybeOtile' of
+              Just otile' -> do
                 MV.write tiles i $ ptile{CPU.tile = tile'}
                 MV.write tiles o $ optile{CPU.tile = otile'}
                 return (tiles, ins, outs)
-              else return (tiles, ins, outs)
+              Nothing -> return (tiles, ins, outs)
       _ -> return (tiles, ins, outs)
 
   getOtherTile :: Int -> Tiles.Port' -> Int

src/TIS100/Tiles/Base.hs

@@ -19,8 +19,8 @@ instance Num Value where
 
 data RunState
   = Ready
-  | WaitingOnRead Port'
-  | WaitingOnWrite Port'
+  | WaitingOnRead Port' (Maybe Value)
+  | WaitingOnWrite Port' Value
   deriving (Eq, Show)
 
 data Port' = ANY | LAST | LEFT | RIGHT | UP | DOWN

src/TIS100/Tiles/ConnectedTile.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE InstanceSigs #-}
+
 module TIS100.Tiles.ConnectedTile where
 
 import TIS100.Tiles.Base (Port', Value)
@@ -7,14 +9,8 @@ class (Show t) => IsConnectedTile t where
   getRunState :: t -> Tiles.RunState
   setRunState :: Tiles.RunState -> t -> t
 
-  readable :: Port' -> t -> Bool
-  writable :: Port' -> t -> Bool
-
-  isWaitingOnRead :: t -> Maybe Port'
-  isWaitingOnWrite :: t -> Maybe Port'
-
   readValueFrom :: Port' -> t -> (t, Maybe Value)
-  writeValueTo :: Port' -> Value -> t -> t
+  writeValueTo :: Port' -> Value -> t -> Maybe t
 
   step :: t -> t
 
@@ -33,13 +29,7 @@ instance IsConnectedTile ConnectedTile where
   getRunState (ConnectedTile t) = getRunState t
   setRunState rs (ConnectedTile t) = ConnectedTile $ setRunState rs t
 
-  readable p (ConnectedTile t) = readable p t
-  writable p (ConnectedTile t) = writable p t
-
-  isWaitingOnRead (ConnectedTile t) = isWaitingOnRead t
-  isWaitingOnWrite (ConnectedTile t) = isWaitingOnWrite t
-
   readValueFrom p (ConnectedTile t) = (ConnectedTile t', v) where (t', v) = readValueFrom p t
-  writeValueTo p v (ConnectedTile t) = ConnectedTile $ writeValueTo p v t
+  writeValueTo p v (ConnectedTile t) = ConnectedTile <$> writeValueTo p v t
 
   step (ConnectedTile t) = ConnectedTile $ step t

src/TIS100/Tiles/Inactive.hs

@@ -10,13 +10,7 @@ instance IsConnectedTile InactiveTile where
   getRunState _ = Tiles.Ready
   setRunState _ _ = InactiveTile
 
-  readable _ _ = False
-  writable _ _ = False
-
-  isWaitingOnRead _ = Just Tiles.ANY
-  isWaitingOnWrite _ = Just Tiles.ANY
-
   readValueFrom _ t = (t, Nothing)
-  writeValueTo _ _ t = t
+  writeValueTo _ _ _ = Nothing
 
   step = id