aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAleksey Veresov <aleksey@veresov.pro>2021-04-12 09:59:12 +0300
committerAleksey Veresov <aleksey@veresov.pro>2021-04-12 09:59:12 +0300
commitf621a0f1491bd05113aced3a3905318e54681d0b (patch)
tree30b11e5942c13659f33da28fe4d9e845db84beaa /src
parent21aa1d1f11c369323d8c3bf71648bd0a8321ca61 (diff)
downloadsuem-f621a0f1491bd05113aced3a3905318e54681d0b.tar
suem-f621a0f1491bd05113aced3a3905318e54681d0b.tar.xz
suem-f621a0f1491bd05113aced3a3905318e54681d0b.zip
Interrupts for Devices added!
Non-blocking check is not done yet.
Diffstat (limited to 'src')
-rw-r--r--src/Device.hs58
-rw-r--r--src/Machine.hs5
-rw-r--r--src/Suem.hs1
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 +