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