From 23566248abca58b2b4e17d67a9e0eb7202813fa1 Mon Sep 17 00:00:00 2001 From: Gautham Ganapathy Date: Sun, 22 Oct 2023 21:12:48 +0100 Subject: [PATCH] Completed refactoring --- examples/segment20176/segment20176.asm | 21 +++ examples/segment20176/segment20176.cfg | 8 + src/TIS100/Sim/Run.hs | 35 ++--- src/TIS100/Tiles/Base.hs | 4 +- src/TIS100/Tiles/ConnectedTile.hs | 14 +- src/TIS100/Tiles/Inactive.hs | 6 - src/TIS100/Tiles/T21.hs | 194 ++++++++++--------------- src/TIS100/Tiles/T30.hs | 7 - 8 files changed, 128 insertions(+), 161 deletions(-) create mode 100644 examples/segment20176/segment20176.asm create mode 100644 examples/segment20176/segment20176.cfg diff --git a/examples/segment20176/segment20176.asm b/examples/segment20176/segment20176.asm new file mode 100644 index 0000000..910618b --- /dev/null +++ b/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 \ No newline at end of file diff --git a/examples/segment20176/segment20176.cfg b/examples/segment20176/segment20176.cfg new file mode 100644 index 0000000..1fee361 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/TIS100/Sim/Run.hs b/src/TIS100/Sim/Run.hs index e21b863..6ce2afe 100644 --- a/src/TIS100/Sim/Run.hs +++ b/src/TIS100/Sim/Run.hs @@ -87,7 +87,8 @@ 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 @@ -105,18 +106,18 @@ 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 readable op otile - then do - let (otile', val) = readValueFrom op otile - let maybeTile' = writeValueTo p (fromJust val) tile + 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) - else return (tiles, ins, outs) - Tiles.WaitingOnWrite p -> do + Nothing -> return (tiles, ins, outs) + Tiles.WaitingOnWrite p pv -> do if r == rows - 1 && p == Tiles.DOWN then do let (tile', maybeV) = readValueFrom p tile @@ -131,18 +132,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 - print $ " Tile " ++ show o ++ " writable = " ++ show (writable op otile) - if writable op otile - then do - 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) - Nothing -> return (tiles, ins, outs) - else return (tiles, ins, outs) + 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) + Nothing -> return (tiles, ins, outs) _ -> return (tiles, ins, outs) getOtherTile :: Int -> Tiles.Port' -> Int diff --git a/src/TIS100/Tiles/Base.hs b/src/TIS100/Tiles/Base.hs index 36a41aa..5a3cd4d 100644 --- a/src/TIS100/Tiles/Base.hs +++ b/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 diff --git a/src/TIS100/Tiles/ConnectedTile.hs b/src/TIS100/Tiles/ConnectedTile.hs index 89a8886..45becc2 100644 --- a/src/TIS100/Tiles/ConnectedTile.hs +++ b/src/TIS100/Tiles/ConnectedTile.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE InstanceSigs #-} + module TIS100.Tiles.ConnectedTile where import TIS100.Tiles.Base (Port', Value) @@ -7,12 +9,6 @@ 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 -> Maybe t @@ -33,12 +29,6 @@ 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 diff --git a/src/TIS100/Tiles/Inactive.hs b/src/TIS100/Tiles/Inactive.hs index f4d9f76..16b03a7 100644 --- a/src/TIS100/Tiles/Inactive.hs +++ b/src/TIS100/Tiles/Inactive.hs @@ -10,12 +10,6 @@ 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 = Nothing diff --git a/src/TIS100/Tiles/T21.hs b/src/TIS100/Tiles/T21.hs index 5e23638..ccebdf0 100644 --- a/src/TIS100/Tiles/T21.hs +++ b/src/TIS100/Tiles/T21.hs @@ -40,10 +40,6 @@ type TileProgram = V.Vector Instruction data TileState = TileState { acc :: Value , bak :: Value - , left :: Maybe Value - , right :: Maybe Value - , up :: Maybe Value - , down :: Maybe Value , last :: Port' , pc :: Address , runState :: RunState @@ -63,10 +59,6 @@ createTileState program_ = TileState { acc = 0 , bak = 0 - , left = Nothing - , right = Nothing - , up = Nothing - , down = Nothing , last = UP , pc = 0 , runState = Ready @@ -80,89 +72,90 @@ getTileRunState = runState . tileState setTileRunState :: RunState -> T21 -> T21 setTileRunState rs tile = tile{tileState = (tileState tile){runState = rs}} --- getPortVal :: Port' -> T21 -> (T21, Maybe Value) --- getPortVal p t +-- getPortVal :: Bool -> Port' -> T21 -> (T21, Maybe Value) +-- getPortVal internalCall p t -- | p == ANY = error "Reads from ANY is not supported yet" -- | p == LAST = error "Reads from LAST is not supported yet" --- | p == LEFT = getPortVal' left t{tileState = (tileState t){left = Nothing, runState = rs}} --- | p == RIGHT = getPortVal' right t{tileState = (tileState t){right = Nothing, runState = rs}} --- | p == UP = getPortVal' up t{tileState = (tileState t){up = Nothing, runState = rs}} --- | p == DOWN = getPortVal' down t{tileState = (tileState t){down = Nothing, runState = rs}} +-- | p == LEFT = getPortVal' left t{tileState = (tileState t){left = Nothing}} +-- | p == RIGHT = getPortVal' right t{tileState = (tileState t){right = Nothing}} +-- | p == UP = getPortVal' up t{tileState = (tileState t){up = Nothing}} +-- | p == DOWN = getPortVal' down t{tileState = (tileState t){down = Nothing}} -- | otherwise = error "Should not reach this code" -- where --- getPortVal' f t' = case f $ tileState t of --- Just v -> (t', Just v) --- Nothing -> (t{tileState = (tileState t){runState = WaitingOnRead p}}, Nothing) --- rs = if (runState . tileState) t == WaitingOnWrite p then Ready else (runState . tileState) t - --- setPortVal :: Port' -> Value -> T21 -> Maybe T21 --- setPortVal p v t +-- getPortVal' = if internalCall then getPortValInt else getPortValExt +-- getPortValInt f t' = case (runState . tileState) t' of +-- WaitingOnWrite p' -> +-- if p' == p +-- then case (f . tileState) t of +-- Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) +-- Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) +-- else (t, Nothing) +-- WaitingOnRead p' -> (t, Nothing) +-- Ready -> case (f . tileState) t of +-- Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) +-- Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) +-- getPortValExt f t' = case (runState . tileState) t' of +-- WaitingOnWrite p' -> +-- if p' == p +-- then case (f . tileState) t of +-- Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) +-- Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) +-- else (t, Nothing) +-- WaitingOnRead p' -> (t, Nothing) +-- Ready -> case (f . tileState) t of +-- Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) +-- Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) + +-- setPortVal :: Bool -> Port' -> Value -> T21 -> Maybe T21 +-- setPortVal internalCall p v t -- | p == ANY = error "Writes to ANY is not supported yet" -- | p == LAST = error "Writes to LAST is not supported yet" --- | p == LEFT = t{tileState = (tileState t){left = Just v, runState = rs}} --- | p == RIGHT = t{tileState = (tileState t){right = Just v, runState = rs}} --- | p == UP = t{tileState = (tileState t){up = Just v, runState = rs}} --- | p == DOWN = t{tileState = (tileState t){down = Just v, runState = rs}} +-- | p == LEFT = setPortVal' t{tileState = (tileState t){left = Just v}} +-- | p == RIGHT = setPortVal' t{tileState = (tileState t){right = Just v}} +-- | p == UP = setPortVal' t{tileState = (tileState t){up = Just v}} +-- | p == DOWN = setPortVal' t{tileState = (tileState t){down = Just v}} -- | otherwise = error "Should not reach this code" -- where --- rs = case (runState . tileState) t of --- WaitingOnRead _ -> Ready --- WaitingOnWrite p' -> WaitingOnWrite p' --- Ready -> WaitingOnWrite p +-- setPortVal' = if internalCall then setPortValInt else setPortValExt +-- setPortValInt t' = case (runState . tileState) t of +-- WaitingOnRead p' -> if p' == p then Just $ t'{tileState = (tileState t'){runState = Ready}} else Nothing +-- WaitingOnWrite p' -> Nothing +-- Ready -> Just $ t'{tileState = (tileState t'){runState = WaitingOnWrite p}} +-- setPortValExt t' = case (runState . tileState) t of +-- WaitingOnRead p' -> if p' == p then Just $ t'{tileState = (tileState t'){runState = Ready}} else Nothing +-- WaitingOnWrite p' -> Nothing +-- Ready -> Just $ t'{tileState = (tileState t'){runState = WaitingOnWrite p}} getPortVal :: Bool -> Port' -> T21 -> (T21, Maybe Value) -getPortVal internalCall p t - | p == ANY = error "Reads from ANY is not supported yet" - | p == LAST = error "Reads from LAST is not supported yet" - | p == LEFT = getPortVal' left t{tileState = (tileState t){left = Nothing}} - | p == RIGHT = getPortVal' right t{tileState = (tileState t){right = Nothing}} - | p == UP = getPortVal' up t{tileState = (tileState t){up = Nothing}} - | p == DOWN = getPortVal' down t{tileState = (tileState t){down = Nothing}} - | otherwise = error "Should not reach this code" +getPortVal internalCall p t = if internalCall then getPortValInt else getPortValExt where - getPortVal' = if internalCall then getPortValInt else getPortValExt - getPortValInt f t' = case (runState . tileState) t' of - WaitingOnWrite p' -> - if p' == p - then case (f . tileState) t of - Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) - Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) - else (t, Nothing) - WaitingOnRead p' -> (t, Nothing) - Ready -> case (f . tileState) t of - Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) - Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) - getPortValExt f t' = case (runState . tileState) t' of - WaitingOnWrite p' -> - if p' == p - then case (f . tileState) t of - Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) - Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) + getPortValInt = case rs of + WaitingOnWrite p' v -> (t, Nothing) + WaitingOnRead p' Nothing -> (t, Nothing) + WaitingOnRead p' (Just v) -> + if p == p' + then (t{tileState = (tileState t){runState = Ready}}, Just v) else (t, Nothing) - WaitingOnRead p' -> (t, Nothing) - Ready -> case (f . tileState) t of - Just v -> (t'{tileState = (tileState t'){runState = Ready}}, Just v) - Nothing -> (t'{tileState = (tileState t'){runState = WaitingOnRead p}}, Nothing) + Ready -> (t{tileState = (tileState t){runState = WaitingOnRead p Nothing}}, Nothing) + + getPortValExt = case rs of + WaitingOnWrite p' v -> (t{tileState = (tileState t){runState = Ready}}, Just v) + _ -> (t, Nothing) + + rs = runState . tileState $ t setPortVal :: Bool -> Port' -> Value -> T21 -> Maybe T21 -setPortVal internalCall p v t - | p == ANY = error "Writes to ANY is not supported yet" - | p == LAST = error "Writes to LAST is not supported yet" - | p == LEFT = setPortVal' t{tileState = (tileState t){left = Just v}} - | p == RIGHT = setPortVal' t{tileState = (tileState t){right = Just v}} - | p == UP = setPortVal' t{tileState = (tileState t){up = Just v}} - | p == DOWN = setPortVal' t{tileState = (tileState t){down = Just v}} - | otherwise = error "Should not reach this code" +setPortVal internalCall p v t = if internalCall then setPortValInt else setPortValExt where - setPortVal' = if internalCall then setPortValInt else setPortValExt - setPortValInt t' = case (runState . tileState) t of - WaitingOnRead p' -> if p' == p then Just $ t'{tileState = (tileState t'){runState = Ready}} else Nothing - WaitingOnWrite p' -> Nothing - Ready -> Just $ t'{tileState = (tileState t'){runState = WaitingOnWrite p}} - setPortValExt t' = case (runState . tileState) t of - WaitingOnRead p' -> if p' == p then Just $ t'{tileState = (tileState t'){runState = Ready}} else Nothing - WaitingOnWrite p' -> Nothing - Ready -> Just $ t'{tileState = (tileState t'){runState = WaitingOnWrite p}} + setPortValInt = case rs of + Ready -> Just $ t{tileState = (tileState t){runState = WaitingOnWrite p v}} + _ -> Nothing + + setPortValExt = case rs of + WaitingOnRead p' Nothing -> if p == p' then Just $ t{tileState = (tileState t){runState = WaitingOnRead p' (Just v)}} else Nothing + _ -> Nothing + + rs = runState . tileState $ t getRegVal :: Register' -> T21 -> Value getRegVal r t = case r of @@ -183,7 +176,7 @@ getCurrentInstruction t = tileProgram t V.!? ix incPC :: T21 -> T21 incPC t = - if (runState $ tileState t) == Ready + if runState (tileState t) == Ready then t{tileState = (tileState t){pc = nextPC}} else t where @@ -201,47 +194,18 @@ instance IsConnectedTile T21 where getRunState = getTileRunState setRunState = setTileRunState - readable p t = case p of - ANY -> True - LAST -> True - LEFT -> isJust $ left $ tileState t - RIGHT -> isJust $ right $ tileState t - UP -> isJust $ up $ tileState t - DOWN -> isJust $ down $ tileState t - - writable p t = case p of - ANY -> True - LAST -> True - LEFT -> writable' left - RIGHT -> writable' right - UP -> writable' up - DOWN -> writable' down - where - writable' f = - let ts = tileState t - in runState ts == WaitingOnRead p && isNothing (f ts) - - isWaitingOnRead t = case getTileRunState t of - WaitingOnRead p -> Just p - _ -> Nothing - - isWaitingOnWrite t = case getTileRunState t of - WaitingOnWrite p -> Just p - _ -> Nothing - readValueFrom = getPortVal False -- External call writeValueTo = setPortVal False -- External call - step t_ = case (runState . tileState) t_ of - Ready -> stepReady t_ - WaitingOnRead p_ -> stepWaitingOnRead t_ p_ - WaitingOnWrite p_ -> stepWaitingOnWrite t_ p_ + step t = case (runState . tileState) t of + Ready -> stepReady + WaitingOnRead _ Nothing -> t + WaitingOnRead _ (Just _) -> stepReady + WaitingOnWrite _ _ -> t where - stepWaitingOnWrite t _ = t - - stepWaitingOnRead :: T21 -> Port' -> T21 - stepWaitingOnRead t p = case getCurrentInstruction t of + stepWaitingOnRead :: Port' -> Value -> T21 + stepWaitingOnRead p pv = case getCurrentInstruction t of Nothing -> t Just (MOV (Port p') dst) -> if p == p' @@ -251,8 +215,8 @@ instance IsConnectedTile T21 where else t _ -> t - stepReady :: T21 -> T21 - stepReady t = fromMaybe t stepReady' + stepReady :: T21 + stepReady = fromMaybe t stepReady' where stepReady' :: Maybe T21 stepReady' = case getCurrentInstruction t of diff --git a/src/TIS100/Tiles/T30.hs b/src/TIS100/Tiles/T30.hs index 16fee94..d231872 100644 --- a/src/TIS100/Tiles/T30.hs +++ b/src/TIS100/Tiles/T30.hs @@ -10,13 +10,6 @@ instance IsConnectedTile T30 where getRunState _ = Tiles.Ready setRunState _ t = t - readable _ (T30 []) = False - readable _ _ = True - writable _ _ = True - - isWaitingOnRead _ = Just Tiles.ANY - isWaitingOnWrite _ = Just Tiles.ANY - readValueFrom _ (T30 []) = (T30 [], Nothing) readValueFrom _ (T30 (v : vs)) = (T30 vs, Just v) writeValueTo _ v (T30 vs) = Just $ T30 (vs ++ [v])