diff options
| -rw-r--r-- | src/Instructions.hs | 34 | ||||
| -rw-r--r-- | src/Machine.hs | 41 | ||||
| -rw-r--r-- | src/Utils.hs | 27 |
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 |