diff options
| -rw-r--r-- | src/Device.hs | 58 | ||||
| -rw-r--r-- | src/Machine.hs | 5 | ||||
| -rw-r--r-- | 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 + |