From f621a0f1491bd05113aced3a3905318e54681d0b Mon Sep 17 00:00:00 2001
From: Aleksey Veresov <aleksey@veresov.pro>
Date: Mon, 12 Apr 2021 09:59:12 +0300
Subject: Interrupts for Devices added!
Non-blocking check is not done yet.
---
src/Device.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----
src/Machine.hs | 5 ++++-
src/Suem.hs | 1 +
3 files changed, 59 insertions(+), 5 deletions(-)
diff --git a/src/Device.hs b/src/Device.hs
index 71e6943..1c4e313 100644
--- a/src/Device.hs
+++ b/src/Device.hs
@@ -91,7 +91,14 @@ readOk h = do
else if line == fromString device_bad
then error "Device sent BAD signal."
else if line == fromString device_interrupt
- then readOk h -- doInterrupt
+ then do
+ m <- ask
+ interruptLevel <- getFnInterruptLevel m
+ if interruptLevel == 0
+ then do
+ getFnDoInterrupt m
+ readOk h
+ else readOk h
else error "Unknown Device Protocol Line."
readOkWord :: Handle -> Emulator Word
@@ -103,7 +110,33 @@ readOkWord h = do
else if line == fromString device_bad
then error "Device sent BAD signal."
else if line == fromString device_interrupt
- then readOkWord h -- doInterrupt
+ then do
+ m <- ask
+ interruptLevel <- getFnInterruptLevel m
+ if interruptLevel == 0
+ then do
+ getFnDoInterrupt m
+ readOkWord h
+ else readOkWord h
+ else error "Unknown Device Protocol Line."
+
+readOkByte :: Handle -> Emulator Byte
+readOkByte h = do
+ line <- liftIO $ Data.ByteString.hGetLine h
+ if fromString device_ok `Data.ByteString.isPrefixOf` line
+ then let (_:ltail) = Prelude.drop (Prelude.length device_ok) (toStr line)
+ in return $ fromIntegral $ fromHex ltail 2 (fromIntegral 0)
+ else if line == fromString device_bad
+ then error "Device sent BAD signal."
+ else if line == fromString device_interrupt
+ then do
+ m <- ask
+ interruptLevel <- getFnInterruptLevel m
+ if interruptLevel == 0
+ then do
+ getFnDoInterrupt m
+ readOkByte h
+ else readOkByte h
else error "Unknown Device Protocol Line."
@@ -111,8 +144,25 @@ readOkWord h = do
-- Memory
deviceGetByte :: Long -> Emulator Byte
-deviceGetByte a | a `mod` 2 == 0 = return 0xFF
- | otherwise = return 0xFF
+deviceGetByte a
+ | a `mod` 2 == 0 = do
+ handle <- getSock a
+ if handle == Nothing
+ then return 0xff
+ else do
+ let (Just h) = handle
+ liftIO $ hPut h $ fromString $
+ device_get_high_byte ++ " " ++ toHex a 5 ++"\n"
+ readOkByte h
+ | otherwise = do
+ handle <- getSock a
+ if handle == Nothing
+ then return 0xff
+ else do
+ let (Just h) = handle
+ liftIO $ hPut h $ fromString $
+ device_get_low_byte ++ " " ++ toHex a 5 ++"\n"
+ readOkByte h
deviceGetWord :: Long -> Emulator Word
deviceGetWord a = do
diff --git a/src/Machine.hs b/src/Machine.hs
index 75ad877..60f9a41 100644
--- a/src/Machine.hs
+++ b/src/Machine.hs
@@ -44,7 +44,10 @@ data Machine = Machine {
c4 :: IORef (Maybe Handle),
c5 :: IORef (Maybe Handle),
c6 :: IORef (Maybe Handle),
- c7 :: IORef (Maybe Handle)
+ c7 :: IORef (Maybe Handle),
+ -- Deps for Devices
+ getFnInterruptLevel :: Emulator Int,
+ getFnDoInterrupt :: Emulator ()
}
-- Emulator is a monad which contains Machine and allows easy change of it.
diff --git a/src/Suem.hs b/src/Suem.hs
index 7f55891..ac15990 100644
--- a/src/Suem.hs
+++ b/src/Suem.hs
@@ -483,6 +483,7 @@ makeMachine ramData romData s0 s1 s2 s3 s4 s5 s6 s7 = do
return $ Machine pc sr drs ars usp ssp ramData romData
ms0 ms1 ms2 ms3 ms4 ms5 ms6 ms7
mc0 mc1 mc2 mc3 mc4 mc5 mc6 mc7
+ interruptLevel doInterrupt
where pcval = (fromIntegral $ romData V.! 4) * 256 * 256 * 256 +
(fromIntegral $ romData V.! 5) * 256 * 256 +
(fromIntegral $ romData V.! 6) * 256 +
--
cgit v1.2.3