aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Instructions.hs34
-rw-r--r--src/Machine.hs41
-rw-r--r--src/Utils.hs27
3 files changed, 74 insertions, 28 deletions
diff --git a/src/Instructions.hs b/src/Instructions.hs
index fb9695b..ccd12f6 100644
--- a/src/Instructions.hs
+++ b/src/Instructions.hs
@@ -68,6 +68,11 @@ doMOVE size dst_reg dst_mode src_mode src_reg = do
(dst_get, dst_set) <- getOp dst_mode dst_reg (getMoveSize size)
src_val <- src_get
dst_set src_val
+ sv <- isSupervisor
+ setNegative (checkNegative src_val (getMoveSize size))
+ setZero (checkZero src_val)
+ setOverflow False
+ setCarry False
doSRMOVE :: Int -> Int -> Emulator ()
doSRMOVE _ _ = error "SRMOVE"
@@ -197,7 +202,34 @@ doBSR :: Int -> Emulator ()
doBSR _ = error "BSR"
doBcc :: Int -> Int -> Emulator ()
-doBcc _ _ = error "Bcc"
+-- NE
+doBcc 6 0 = do
+ incPC
+ pc <- readPC
+ zf <- isZero
+ disp <- getMemory pc 2
+ let real_disp = if not zf then disp else 2
+ writePC (pc + (fromIntegral real_disp))
+doBcc 6 disp = do
+ incPC
+ pc <- readPC
+ zf <- isZero
+ let real_disp = if not zf then disp else 0
+ writePC (pc + (fromIntegral real_disp))
+-- EQ
+doBcc 7 0 = do
+ incPC
+ pc <- readPC
+ zf <- isZero
+ disp <- getMemory pc 2
+ let real_disp = if zf then disp else 2
+ writePC (pc + (fromIntegral real_disp))
+doBcc 7 disp = do
+ incPC
+ pc <- readPC
+ zf <- isZero
+ let real_disp = if zf then disp else 0
+ writePC (pc + (fromIntegral real_disp))
doMOVEQ :: Int -> Int -> Emulator ()
doMOVEQ _ _ = error "MOVEQ"
diff --git a/src/Machine.hs b/src/Machine.hs
index b254f7e..1f0b6e5 100644
--- a/src/Machine.hs
+++ b/src/Machine.hs
@@ -199,12 +199,12 @@ readSR = with sr $ \sr -> do
isTracing :: Emulator Bool
isTracing = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 0
+ return $ testBit sr 15
isSupervisor :: Emulator Bool
isSupervisor = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 2
+ return $ testBit sr 13
interruptLevel :: Emulator Int
interruptLevel = with sr $ \sr -> do
@@ -214,65 +214,65 @@ interruptLevel = with sr $ \sr -> do
isExtend :: Emulator Bool
isExtend = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 11
+ return $ testBit sr 4
isNegative :: Emulator Bool
isNegative = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 12
+ return $ testBit sr 3
isZero :: Emulator Bool
isZero = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 13
+ return $ testBit sr 2
isOverflow :: Emulator Bool
isOverflow = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 14
+ return $ testBit sr 1
isCarry :: Emulator Bool
isCarry = with sr $ \sr -> do
sr <- readIORef sr
- return $ testBit sr 15
+ return $ testBit sr 0
setTracing :: Bool -> Emulator ()
setTracing b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 0
+ writeIORef sr $ (if b then setBit else clearBit) srval 15
setSupervisor :: Bool -> Emulator ()
setSupervisor b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 2
+ writeIORef sr $ (if b then setBit else clearBit) srval 13
-- setInterruptLevel :: Int -> Emulator ()
setExtend :: Bool -> Emulator ()
setExtend b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 11
+ writeIORef sr $ (if b then setBit else clearBit) srval 4
setNegative :: Bool -> Emulator ()
setNegative b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 12
+ writeIORef sr $ (if b then setBit else clearBit) srval 3
setZero :: Bool -> Emulator ()
setZero b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 13
+ writeIORef sr $ (if b then setBit else clearBit) srval 2
setOverflow :: Bool -> Emulator ()
setOverflow b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 14
+ writeIORef sr $ (if b then setBit else clearBit) srval 1
setCarry :: Bool -> Emulator ()
setCarry b = with sr $ \sr -> do
srval <- readIORef sr
- writeIORef sr $ (if b then setBit else clearBit) srval 15
+ writeIORef sr $ (if b then setBit else clearBit) srval 0
-------------------------------------------------------------------------------
@@ -417,16 +417,3 @@ getOp 7 4 s = do
skipOp s
let naddr = addr + if s == 1 then 1 else 0
return (getMemory naddr s, setMemory naddr s)
-
--------------------------------------------------------------------------------
--- Size converter
-
-getSize :: Int -> Int
-getSize 0 = 1
-getSize 1 = 2
-getSize 2 = 4
-
-getMoveSize :: Int -> Int
-getMoveSize 1 = 1
-getMoveSize 3 = 2
-getMoveSize 2 = 4
diff --git a/src/Utils.hs b/src/Utils.hs
index 1d908e1..ee1cd7a 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -37,3 +37,30 @@ combineLong update base 2 = base .&. 0xFFFF0000 .|. (convertLong update 2)
combineLong update _ 4 = update
combineLong _ _ s = error $
"Wrong size (" ++ show s ++ ") of combineLong"
+
+-------------------------------------------------------------------------------
+-- Size Casting
+
+getSize :: Int -> Int
+getSize 0 = 1
+getSize 1 = 2
+getSize 2 = 4
+
+getMoveSize :: Int -> Int
+getMoveSize 1 = 1
+getMoveSize 3 = 2
+getMoveSize 2 = 4
+
+-------------------------------------------------------------------------------
+-- Flag checker
+
+checkNegative :: Word32 -> Int -> Bool
+checkNegative x 1 = x >= 0x80
+checkNegative x 2 = x >= 0x8000
+checkNegative x 4 = x >= 0x80000000
+
+checkZero :: Word32 -> Bool
+checkZero 0 = True
+checkZero _ = False
+
+-- TODO: carry & overflow checkers