Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: zhensydow/zdcpu16
base: 17b9582db2
...
head fork: zhensydow/zdcpu16
compare: 05fc2cf9f3
  • 2 commits
  • 9 files changed
  • 0 commit comments
  • 1 contributor
View
2  src/ZDCpu16/ConState.hs
@@ -43,6 +43,6 @@ writeVRAM dir w cs
| dir >= 0 && dir < vramSize = cs{ csVRAM = newVRAM }
| otherwise = cs
where
- newVRAM = (csVRAM cs) // [(dir,w)]
+ newVRAM = csVRAM cs // [(dir,w)]
-- -----------------------------------------------------------------------------
View
18 src/ZDCpu16/DebugRender.hs
@@ -34,7 +34,7 @@ import ZDCpu16.Render(
import ZDCpu16.Disasm( disasm', showDIns )
import ZDCpu16.EmuState( EmuState(..) )
import ZDCpu16.Hardware(
- DCPU_16(..), reg_A, reg_B, reg_C, reg_X, reg_Y, reg_Z, reg_I, reg_J, dumps )
+ DCPU_16(..), regA, regB, regC, regX, regY, regZ, regI, regJ, dumps )
import ZDCpu16.Util( showWord )
import Paths_zdcpu16( version, getDataFileName )
@@ -54,14 +54,14 @@ renderEmuState :: EmuState -> Render ()
renderEmuState st = do
let vrs = showVersion version
renderText (TextSpan 10 10 (255,255,0) (pack $ "Zhen DCPU-16 " ++ vrs))
- let valA = reg_A . emuCpu $ st
- valB = reg_B . emuCpu $ st
- valC = reg_C . emuCpu $ st
- valX = reg_X . emuCpu $ st
- valY = reg_Y . emuCpu $ st
- valZ = reg_Z . emuCpu $ st
- valI = reg_I . emuCpu $ st
- valJ = reg_J . emuCpu $ st
+ let valA = regA . emuCpu $ st
+ valB = regB . emuCpu $ st
+ valC = regC . emuCpu $ st
+ valX = regX . emuCpu $ st
+ valY = regY . emuCpu $ st
+ valZ = regZ . emuCpu $ st
+ valI = regI . emuCpu $ st
+ valJ = regJ . emuCpu $ st
renderText (TextSpan 500 30 white (pack $ "A: 0x" ++ showWord valA))
renderText (TextSpan 500 40 white (pack $ "B: 0x" ++ showWord valB))
renderText (TextSpan 500 50 white (pack $ "C: 0x" ++ showWord valC))
View
4 src/ZDCpu16/Disasm.hs
@@ -43,13 +43,13 @@ disasm = map snd . disasm' . zip [0 :: Int ..]
-- -----------------------------------------------------------------------------
extractA :: Word16 -> [(a,Word16)] -> Maybe (OpVal, [(a,Word16)])
-extractA v xs = extractVal (opval $ nonbasicA v) xs
+extractA = extractVal . opval . nonbasicA
extractAB :: Word16 -> [(a,Word16)] -> Maybe (OpVal, OpVal, [(a,Word16)])
extractAB v xs = do
resta <- extractVal (opval $ basicA v) xs
restb <- extractVal (opval $ basicB v) (snd resta)
- return $ (fst resta, fst restb, snd restb)
+ return (fst resta, fst restb, snd restb)
extractVal :: OpVal -> [(a,Word16)] -> Maybe (OpVal, [(a,Word16)])
extractVal v xs = case v of
View
5 src/ZDCpu16/EmuState.hs
@@ -19,7 +19,6 @@ along with this program. If not, see <http://www.gnu.org/licenses/>.
module ZDCpu16.EmuState( EmuState(..), mkEmuState ) where
-- -----------------------------------------------------------------------------
-import Network.MessagePackRpc.Client( Connection )
import ZDCpu16.Hardware( DCPU_16(..), initialDCPU )
-- -----------------------------------------------------------------------------
@@ -28,7 +27,7 @@ data EmuState = EmuState
, totalCycles :: ! Integer
, lastCycles :: ! Int
, runMode :: ! Bool
- , conComm :: ! Connection }
+ , writeVRAM :: Int -> Int -> IO () }
-- -----------------------------------------------------------------------------
instance Show EmuState where
@@ -39,7 +38,7 @@ instance Show EmuState where
++ " } "
-- -----------------------------------------------------------------------------
-mkEmuState :: Connection -> EmuState
+mkEmuState :: (Int -> Int -> IO ()) -> EmuState
mkEmuState = EmuState initialDCPU 0 0 False
-- -----------------------------------------------------------------------------
View
40 src/ZDCpu16/Hardware.hs
@@ -20,7 +20,7 @@ module ZDCpu16.Hardware(
DCPU_16(..),
-- * Functions
initialDCPU,
- reg_A, reg_B, reg_C, reg_X, reg_Y, reg_Z, reg_I, reg_J, showReg, load, loads,
+ regA, regB, regC, regX, regY, regZ, regI, regJ, showReg, load, loads,
dumps
) where
@@ -55,34 +55,34 @@ initialDCPU :: DCPU_16
initialDCPU = DCPU_16 initialRAM initialRegisters 0 0 0
-- -----------------------------------------------------------------------------
-reg_A :: DCPU_16 -> Word16
-reg_A = (!0) . registers
+regA :: DCPU_16 -> Word16
+regA = (!0) . registers
-reg_B :: DCPU_16 -> Word16
-reg_B = (!1) . registers
+regB :: DCPU_16 -> Word16
+regB = (!1) . registers
-reg_C :: DCPU_16 -> Word16
-reg_C = (!2) . registers
+regC :: DCPU_16 -> Word16
+regC = (!2) . registers
-reg_X :: DCPU_16 -> Word16
-reg_X = (!3) . registers
+regX :: DCPU_16 -> Word16
+regX = (!3) . registers
-reg_Y :: DCPU_16 -> Word16
-reg_Y = (!4) . registers
+regY :: DCPU_16 -> Word16
+regY = (!4) . registers
-reg_Z :: DCPU_16 -> Word16
-reg_Z = (!5) . registers
+regZ :: DCPU_16 -> Word16
+regZ = (!5) . registers
-reg_I :: DCPU_16 -> Word16
-reg_I = (!6) . registers
+regI :: DCPU_16 -> Word16
+regI = (!6) . registers
-reg_J :: DCPU_16 -> Word16
-reg_J = (!7) . registers
+regJ :: DCPU_16 -> Word16
+regJ = (!7) . registers
-- -----------------------------------------------------------------------------
showReg :: Word16 -> String
showReg r
- | idx >= 0 && idx < (length table) = table !! idx
+ | idx >= 0 && idx < length table = table !! idx
| otherwise = "?"
where
idx = fromIntegral r
@@ -92,13 +92,13 @@ showReg r
load :: Int -> Word16 -> DCPU_16 -> DCPU_16
load dir val dcpu = dcpu{ ram = newram }
where
- newram = (ram dcpu) // [(dir,val)]
+ newram = ram dcpu // [(dir,val)]
-- -----------------------------------------------------------------------------
loads :: Int -> [Word16] -> DCPU_16 -> DCPU_16
loads dir vals dcpu = dcpu{ ram = newram }
where
- newram = (ram dcpu) // zip [dir..] vals
+ newram = ram dcpu // zip [dir..] vals
-- -----------------------------------------------------------------------------
dumps :: Int -> DCPU_16 -> [Word16]
View
8 src/ZDCpu16/Inst.hs
@@ -168,19 +168,19 @@ addOverflow :: Word16 -> Word16 -> (Word16, Word16)
addOverflow a b = (fromIntegral sum32, overf)
where
overf = if sum32 > 0xffff then 0x0001 else 0x0
- sum32 = (fromIntegral a + fromIntegral b) :: Word32
+ sum32 = fromIntegral a + fromIntegral b :: Word32
-- -----------------------------------------------------------------------------
subUnderflow :: Word16 -> Word16 -> (Word16, Word16)
subUnderflow a b = (fromIntegral subInt, overf)
where
overf = if subInt < 0 then 0xffff else 0x0
- subInt = (fromIntegral a - fromIntegral b) :: Int
+ subInt = fromIntegral a - fromIntegral b :: Int
mulOverflow :: Word16 -> Word16 -> (Word16, Word16)
mulOverflow a b = (fromIntegral val32, fromIntegral overf)
where
- val32 = (fromIntegral a * fromIntegral b) :: Word32
+ val32 = fromIntegral a * fromIntegral b :: Word32
overf = (val32 `shiftR` 16) .&. 0xffff
-- -----------------------------------------------------------------------------
@@ -199,7 +199,7 @@ shlOverflow :: Word16 -> Word16 -> (Word16, Word16)
shlOverflow a b = (fromIntegral val32, fromIntegral overf)
where
overf = (val32 `shiftR` 16) .&. 0xffff
- val32 = (fromIntegral a `shiftL` fromIntegral b) :: Word32
+ val32 = fromIntegral a `shiftL` fromIntegral b :: Word32
-- -----------------------------------------------------------------------------
shrUnderflow :: Word16 -> Word16 -> (Word16, Word16)
View
2  src/ZDCpu16/Render.hs
@@ -91,7 +91,7 @@ getMainBuffer = io SDL.getVideoSurface
-- -----------------------------------------------------------------------------
getMainFont :: Render (SDLTTF.Font)
-getMainFont = fmap renderFont $ get
+getMainFont = fmap renderFont get
-- -----------------------------------------------------------------------------
clearScreen :: Render ()
View
37 src/ZDCpu16/ZDCpu16.hs
@@ -21,6 +21,7 @@ module ZDCpu16.ZDCpu16(
where
-- -----------------------------------------------------------------------------
+import Control.Monad( when )
import Control.Monad.IO.Class( MonadIO, liftIO )
import Control.Monad.State( StateT, MonadState(..), runStateT, modify )
import Data.Array.Unboxed( (!), (//) )
@@ -32,7 +33,6 @@ import ZDCpu16.Inst(
instructionLength, addOverflow, subUnderflow, mulOverflow, divUnderflow,
modChecked, shlOverflow, shrUnderflow )
import ZDCpu16.EmuState( EmuState(..) )
-import ZDCpu16.ConRPC( clWriteVRAM )
-- -----------------------------------------------------------------------------
newtype Emulator a = Emulator
@@ -41,14 +41,12 @@ newtype Emulator a = Emulator
-- -----------------------------------------------------------------------------
runEmulator :: Emulator a -> EmuState -> IO (a, EmuState)
-runEmulator emulator st = runStateT (runEmul emulator) st
+runEmulator = runStateT . runEmul
-- -----------------------------------------------------------------------------
incCycles :: Int -> Emulator ()
-incCycles d = do
- st <- get
- put st{ totalCycles = (totalCycles st) + (fromIntegral d)
- , lastCycles = (lastCycles st) + d }
+incCycles d = modify $ \st -> st{ totalCycles = totalCycles st + fromIntegral d
+ , lastCycles = lastCycles st + d }
-- -----------------------------------------------------------------------------
resetLastCycles :: Emulator ()
@@ -56,7 +54,7 @@ resetLastCycles = modify $ \st -> st{ lastCycles = 0 }
-- -----------------------------------------------------------------------------
getRegister :: Word16 -> Emulator Word16
-getRegister v = get >>= return . (! (fromIntegral v)) . registers . emuCpu
+getRegister v = fmap ((! (fromIntegral v)) . registers . emuCpu) get
setRegister :: Int -> Word16 -> Emulator ()
setRegister v val = do
@@ -67,7 +65,7 @@ setRegister v val = do
-- -----------------------------------------------------------------------------
getPC :: Emulator Word16
-getPC = get >>= return . programCounter . emuCpu
+getPC = fmap (programCounter . emuCpu) get
setPC :: Word16 -> Emulator ()
setPC val = do
@@ -83,7 +81,7 @@ incPC = do
-- -----------------------------------------------------------------------------
getSP :: Emulator Word16
-getSP = get >>= return . stackPointer . emuCpu
+getSP = fmap (stackPointer . emuCpu) get
setSP :: Word16 -> Emulator ()
setSP val = do
@@ -104,7 +102,7 @@ decSP = do
-- -----------------------------------------------------------------------------
getOverflow :: Emulator Word16
-getOverflow = get >>= return . overflow . emuCpu
+getOverflow = fmap (overflow . emuCpu) get
setOverflow :: Word16 -> Emulator ()
setOverflow val = do
@@ -114,7 +112,7 @@ setOverflow val = do
-- -----------------------------------------------------------------------------
getMem :: Word16 -> Emulator Word16
-getMem dir = get >>= return . (! (fromIntegral dir)) . ram . emuCpu
+getMem dir = fmap ((! (fromIntegral dir)) . ram . emuCpu) get
setMem :: Word16 -> Word16 -> Emulator ()
setMem dir val = do
@@ -122,9 +120,8 @@ setMem dir val = do
let newcpu = emuCpu st
oldram = ram newcpu
put st{ emuCpu = newcpu{ ram = oldram // [(fromIntegral dir,val)] } }
- if dir >= 0x8000
- then liftIO $ clWriteVRAM (conComm st) (fromIntegral (dir - 0x8000)) (fromIntegral val)
- else return ()
+ when (dir >= 0x8000)
+ $ liftIO $ writeVRAM st (fromIntegral (dir - 0x8000)) (fromIntegral val)
-- -----------------------------------------------------------------------------
data LVal = LRegister ! Int
@@ -185,7 +182,7 @@ getLValRef v = case opval v of
-- register (A, B, C, X, Y, Z, I or J, in that order)
VReg r -> return $! LRegister (fromIntegral r)
-- [register]
- VMemReg r -> getRegister r >>= return . LMem
+ VMemReg r -> fmap LMem (getRegister r)
-- [next word + register]
VMemWordReg r _ -> do
incCycles 1
@@ -200,9 +197,9 @@ getLValRef v = case opval v of
incSP
return $ LMem sp
-- PEEK / [SP]
- VPeek -> getSP >>= return . LMem
+ VPeek -> fmap LMem getSP
-- PUSH / [--SP]
- VPush -> decSP >> getSP >>= return . LMem
+ VPush -> fmap LMem (decSP >> getSP)
-- SP
VSP -> return LSP
-- PC
@@ -221,7 +218,7 @@ getLValRef v = case opval v of
incCycles 1
pc <- getPC
incPC
- getMem pc >>= return . LLiteral
+ fmap LLiteral (getMem pc)
-- literal value 0x00-0x1f (literal)
VLiteral l -> return . LLiteral $ l
@@ -240,7 +237,7 @@ getLVal (LMem dir) = getMem dir
getLVal LSP = getSP
getLVal LPC = getPC
getLVal LO = getOverflow
-getLVal (LLiteral v) = return $ v
+getLVal (LLiteral v) = return v
-- -----------------------------------------------------------------------------
stepEmulator :: Emulator ()
@@ -259,7 +256,7 @@ stepNCycles d n
| otherwise = do
stepEmulator
st <- get
- stepNCycles (d + (lastCycles st)) n
+ stepNCycles (d + lastCycles st) n
-- -----------------------------------------------------------------------------
execInstruction :: Word16 -> Emulator ()
View
4 src/zddcpu16_emu_main.hs
@@ -27,7 +27,7 @@ import ZDCpu16.DebugRender(
RenderState, runRender, mkRenderState, clearScreen, renderEmuState )
import ZDCpu16.EmuState( EmuState(..), mkEmuState )
import ZDCpu16.Hardware( loads )
-import ZDCpu16.ConRPC( startConsole, clQuit )
+import ZDCpu16.ConRPC( startConsole, clQuit, clWriteVRAM )
import ZDCpu16.Util( byteStringToWord16 )
import ZDCpu16.ZDCpu16( runEmulator, stepEmulator )
@@ -82,7 +82,7 @@ main = do
program <- fmap byteStringToWord16 . BS.readFile $ filename
conn <- startConsole
rst <- mkRenderState
- let emptyState = mkEmuState conn
+ let emptyState = mkEmuState (clWriteVRAM conn)
initialEmuState = emptyState {
emuCpu = loads 0 program $ emuCpu emptyState }
mainLoop rst initialEmuState

No commit comments for this range

Something went wrong with that request. Please try again.