aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Commands.hs639
-rw-r--r--src/Suem.hs230
-rw-r--r--src/Utils.hs25
3 files changed, 351 insertions, 543 deletions
diff --git a/src/Commands.hs b/src/Commands.hs
index d940782..5c66584 100644
--- a/src/Commands.hs
+++ b/src/Commands.hs
@@ -6,205 +6,114 @@ import Machine
import Utils
import Data.IORef
--- ORICCR
+
doORICCR :: Emulator ()
-doORICCR = return ()
+doORICCR = return ()
--- ORISR
doORISR :: Emulator ()
doORISR = return ()
--- ORI
-_doORI :: Int -> Int -> Int -> Emulator ()
-_doORI _ _ _ = return ()
-doORI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doORI = args3 _doORI
+doORI :: Int -> Int -> Int -> Emulator ()
+doORI _ _ _ = return ()
--- ANDICCR
doANDICCR :: Emulator ()
doANDICCR = return ()
--- ANDISR
doANDISR :: Emulator ()
doANDISR = return ()
--- ANDI
-_doANDI :: Int -> Int -> Int -> Emulator ()
-_doANDI _ _ _ = return ()
-doANDI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doANDI = args3 _doANDI
-
--- SUBI
-_doSUBI :: Int -> Int -> Int -> Emulator ()
-_doSUBI _ _ _ = return ()
-doSUBI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doSUBI = args3 _doSUBI
-
--- ADDI
-_doADDI :: Int -> Int -> Int -> Emulator ()
-_doADDI _ _ _ = return ()
-doADDI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doADDI = args3 _doADDI
-
--- EORICCR
+doANDI :: Int -> Int -> Int -> Emulator ()
+doANDI _ _ _ = return ()
+
+doSUBI :: Int -> Int -> Int -> Emulator ()
+doSUBI _ _ _ = return ()
+
+doADDI :: Int -> Int -> Int -> Emulator ()
+doADDI _ _ _ = return ()
+
doEORICCR :: Emulator ()
doEORICCR = return ()
--- EORISR
doEORISR :: Emulator ()
doEORISR = return ()
--- EORI
-_doEORI :: Int -> Int -> Int -> Emulator ()
-_doEORI _ _ _ = return ()
-doEORI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doEORI = args3 _doEORI
-
--- CMPI
-_doCMPI :: Int -> Int -> Int -> Emulator ()
-_doCMPI _ _ _ = return ()
-doCMPI :: [Int] -> [Int] -> [Int] -> Emulator ()
-doCMPI = args3 _doCMPI
-
--- MOVEP
-_doMOVEP :: Int -> Int -> Int -> Int -> Emulator ()
-_doMOVEP _ _ _ _ = return ()
-doMOVEP :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doMOVEP = args4 _doMOVEP
-
--- BTST
-_doBTST :: Int -> Int -> Int -> Int -> Emulator ()
-_doBTST _ _ _ _ = return ()
-doBTST :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doBTST = args4 _doBTST
-
--- BCHG
-_doBCHG :: Int -> Int -> Int -> Int -> Emulator ()
-_doBCHG _ _ _ _ = return ()
-doBCHG :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doBCHG = args4 _doBCHG
-
--- BCLR
-_doBCLR :: Int -> Int -> Int -> Int -> Emulator ()
-_doBCLR _ _ _ _ = return ()
-doBCLR :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doBCLR = args4 _doBCLR
-
--- BSET
-_doBSET :: Int -> Int -> Int -> Int -> Emulator ()
-_doBSET _ _ _ _ = return ()
-doBSET :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doBSET = args4 _doBSET
-
--- MOVEA
-_doMOVEA :: Int -> Int -> Int -> Int -> Emulator ()
-_doMOVEA _ _ _ _ = return ()
-doMOVEA :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doMOVEA = args4 _doMOVEA
-
--- MOVE
-_doMOVE :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doMOVE _ _ _ _ _ = return ()
-doMOVE :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doMOVE = args5 _doMOVE
-
--- SRMOVE
-_doSRMOVE :: Int -> Int -> Emulator ()
-_doSRMOVE _ _ = return ()
-doSRMOVE :: [Int] -> [Int] -> Emulator ()
-doSRMOVE = args2 _doSRMOVE
-
--- MOVECCR
-_doMOVECCR :: Int -> Int -> Emulator ()
-_doMOVECCR _ _ = return ()
-doMOVECCR :: [Int] -> [Int] -> Emulator ()
-doMOVECCR = args2 _doMOVECCR
-
--- MOVESR
-_doMOVESR :: Int -> Int -> Emulator ()
-_doMOVESR _ _ = return ()
-doMOVESR :: [Int] -> [Int] -> Emulator ()
-doMOVESR = args2 _doMOVESR
-
--- NEGX
-_doNEGX :: Int -> Int -> Int -> Emulator ()
-_doNEGX _ _ _ = return ()
-doNEGX :: [Int] -> [Int] -> [Int] -> Emulator ()
-doNEGX = args3 _doNEGX
-
--- CLR
-_doCLR :: Int -> Int -> Int -> Emulator ()
-_doCLR _ _ _ = return ()
-doCLR :: [Int] -> [Int] -> [Int] -> Emulator ()
-doCLR = args3 _doCLR
-
--- NEG
-_doNEG :: Int -> Int -> Int -> Emulator ()
-_doNEG _ _ _ = return ()
-doNEG :: [Int] -> [Int] -> [Int] -> Emulator ()
-doNEG = args3 _doNEG
-
--- NOT
-_doNOT :: Int -> Int -> Int -> Emulator ()
-_doNOT _ _ _ = return ()
-doNOT :: [Int] -> [Int] -> [Int] -> Emulator ()
-doNOT = args3 _doNOT
-
--- EXT
-_doEXT :: Int -> Int -> Emulator ()
-_doEXT _ _ = return ()
-doEXT :: [Int] -> [Int] -> Emulator ()
-doEXT = args2 _doEXT
-
--- NBCD
-_doNBCD :: Int -> Int -> Emulator ()
-_doNBCD _ _ = return ()
-doNBCD :: [Int] -> [Int] -> Emulator ()
-doNBCD = args2 _doNBCD
-
--- SWAP
-_doSWAP :: Int -> Emulator ()
-_doSWAP _ = return ()
-doSWAP :: [Int] -> Emulator ()
-doSWAP = _doSWAP . fromBits
-
--- PEA
-_doPEA :: Int -> Int -> Emulator ()
-_doPEA _ _ = return ()
-doPEA :: [Int] -> [Int] -> Emulator ()
-doPEA = args2 _doPEA
-
--- ILLEGAL
+doEORI :: Int -> Int -> Int -> Emulator ()
+doEORI _ _ _ = return ()
+
+doCMPI :: Int -> Int -> Int -> Emulator ()
+doCMPI _ _ _ = return ()
+
+doMOVEP :: Int -> Int -> Int -> Int -> Emulator ()
+doMOVEP _ _ _ _ = return ()
+
+doBTST :: Int -> Int -> Int -> Int -> Emulator ()
+doBTST _ _ _ _ = return ()
+
+doBCHG :: Int -> Int -> Int -> Int -> Emulator ()
+doBCHG _ _ _ _ = return ()
+
+doBCLR :: Int -> Int -> Int -> Int -> Emulator ()
+doBCLR _ _ _ _ = return ()
+
+doBSET :: Int -> Int -> Int -> Int -> Emulator ()
+doBSET _ _ _ _ = return ()
+
+doMOVEA :: Int -> Int -> Int -> Int -> Emulator ()
+doMOVEA _ _ _ _ = return ()
+
+doMOVE :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doMOVE _ _ _ _ _ = return ()
+
+doSRMOVE :: Int -> Int -> Emulator ()
+doSRMOVE _ _ = return ()
+
+doMOVECCR :: Int -> Int -> Emulator ()
+doMOVECCR _ _ = return ()
+
+doMOVESR :: Int -> Int -> Emulator ()
+doMOVESR _ _ = return ()
+
+doNEGX :: Int -> Int -> Int -> Emulator ()
+doNEGX _ _ _ = return ()
+
+doCLR :: Int -> Int -> Int -> Emulator ()
+doCLR _ _ _ = return ()
+
+doNEG :: Int -> Int -> Int -> Emulator ()
+doNEG _ _ _ = return ()
+
+doNOT :: Int -> Int -> Int -> Emulator ()
+doNOT _ _ _ = return ()
+
+doEXT :: Int -> Int -> Emulator ()
+doEXT _ _ = return ()
+
+doNBCD :: Int -> Int -> Emulator ()
+doNBCD _ _ = return ()
+
+doSWAP :: Int -> Emulator ()
+doSWAP _ = return ()
+
+doPEA :: Int -> Int -> Emulator ()
+doPEA _ _ = return ()
+
doILLEGAL :: Emulator ()
doILLEGAL = return ()
--- TAS
-_doTAS :: Int -> Int -> Emulator ()
-_doTAS _ _ = return ()
-doTAS :: [Int] -> [Int] -> Emulator ()
-doTAS = args2 _doTAS
-
--- TST
-_doTST :: Int -> Int -> Int -> Emulator ()
-_doTST _ _ _ = return ()
-doTST :: [Int] -> [Int] -> [Int] -> Emulator ()
-doTST = args3 _doTST
-
--- TRAP
-_doTRAP :: Int -> Emulator ()
-_doTRAP _ = return ()
-doTRAP :: [Int] -> Emulator ()
-doTRAP = _doTRAP . fromBits
-
--- LINK
-_doLINK :: Int -> Emulator ()
-_doLINK _ = return ()
-doLINK :: [Int] -> Emulator ()
-doLINK = _doLINK . fromBits
-
--- UNLK
-_doUNLK :: Int -> Emulator ()
-_doUNLK a = do
+doTAS :: Int -> Int -> Emulator ()
+doTAS _ _ = return ()
+
+doTST :: Int -> Int -> Int -> Emulator ()
+doTST _ _ _ = return ()
+
+doTRAP :: Int -> Emulator ()
+doTRAP _ = return ()
+
+doLINK :: Int -> Emulator ()
+doLINK _ = return ()
+
+doUNLK :: Int -> Emulator ()
+doUNLK a = do
addr <- readA a
val <- getLong addr
with pc $ \pc -> do
@@ -215,281 +124,149 @@ _doUNLK a = do
writeIORef sp (val + 4)
else with usp $ \sp -> do
writeIORef sp (val + 4)
-doUNLK :: [Int] -> Emulator ()
-doUNLK = _doUNLK . fromBits
--- MOVEUSP
-_doMOVEUSP :: Int -> Int -> Emulator ()
-_doMOVEUSP _ _ = return ()
-doMOVEUSP :: [Int] -> [Int] -> Emulator ()
-doMOVEUSP = args2 _doMOVEUSP
+doMOVEUSP :: Int -> Int -> Emulator ()
+doMOVEUSP _ _ = return ()
--- RESET
doRESET :: Emulator ()
doRESET = return ()
--- NOP
doNOP :: Emulator ()
doNOP = with pc $ \pc -> do
pcval <- readIORef pc
writeIORef pc (pcval + 2)
--- STOP
doSTOP :: Emulator ()
doSTOP = return ()
--- RTE
doRTE :: Emulator ()
doRTE = return ()
--- RTS
doRTS :: Emulator ()
doRTS = return ()
--- TRAPV
doTRAPV :: Emulator ()
doTRAPV = return ()
--- RTR
doRTR :: Emulator ()
doRTR = return ()
--- JSR
-_doJSR :: Int -> Int -> Emulator ()
-_doJSR _ _ = return ()
-doJSR :: [Int] -> [Int] -> Emulator ()
-doJSR = args2 _doJSR
-
--- JMP
-_doJMP :: Int -> Int -> Emulator ()
-_doJMP _ _ = return ()
-doJMP :: [Int] -> [Int] -> Emulator ()
-doJMP = args2 _doJMP
-
--- MOVEM
-_doMOVEM :: Int -> Int -> Int -> Int -> Emulator ()
-_doMOVEM _ _ _ _ = return ()
-doMOVEM :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doMOVEM = args4 _doMOVEM
-
--- LEA
-_doLEA :: Int -> Int -> Int -> Emulator ()
-_doLEA _ _ _ = return ()
-doLEA :: [Int] -> [Int] -> [Int] -> Emulator ()
-doLEA = args3 _doLEA
-
--- CHK
-_doCHK :: Int -> Int -> Int -> Emulator ()
-_doCHK _ _ _ = return ()
-doCHK :: [Int] -> [Int] -> [Int] -> Emulator ()
-doCHK = args3 _doCHK
-
--- DBcc
-_doDBcc :: Int -> Int -> Emulator ()
-_doDBcc _ _ = return ()
-doDBcc :: [Int] -> [Int] -> Emulator ()
-doDBcc = args2 _doDBcc
-
--- Scc
-_doScc :: Int -> Int -> Int -> Emulator ()
-_doScc _ _ _ = return ()
-doScc :: [Int] -> [Int] -> [Int] -> Emulator ()
-doScc = args3 _doScc
-
--- ADDQ
-_doADDQ :: Int -> Int -> Int -> Int -> Emulator ()
-_doADDQ _ _ _ _ = return ()
-doADDQ :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doADDQ = args4 _doADDQ
-
--- SUBQ
-_doSUBQ :: Int -> Int -> Int -> Int -> Emulator ()
-_doSUBQ _ _ _ _ = return ()
-doSUBQ :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doSUBQ = args4 _doSUBQ
-
--- BRA
-_doBRA :: Int -> Emulator ()
-_doBRA _ = return ()
-doBRA :: [Int] -> Emulator ()
-doBRA = _doBRA . fromBits
-
--- BSR
-_doBSR :: Int -> Emulator ()
-_doBSR _ = return ()
-doBSR :: [Int] -> Emulator ()
-doBSR = _doBSR . fromBits
-
--- Bcc
-_doBcc :: Int -> Int -> Emulator ()
-_doBcc _ _ = return ()
-doBcc :: [Int] -> [Int] -> Emulator ()
-doBcc = args2 _doBcc
-
--- MOVEQ
-_doMOVEQ :: Int -> Int -> Emulator ()
-_doMOVEQ _ _ = return ()
-doMOVEQ :: [Int] -> [Int] -> Emulator ()
-doMOVEQ = args2 _doMOVEQ
-
--- DIVU
-_doDIVU :: Int -> Int -> Int -> Emulator ()
-_doDIVU _ _ _ = return ()
-doDIVU :: [Int] -> [Int] -> [Int] -> Emulator ()
-doDIVU = args3 _doDIVU
-
--- DIVS
-_doDIVS :: Int -> Int -> Int -> Emulator ()
-_doDIVS _ _ _ = return ()
-doDIVS :: [Int] -> [Int] -> [Int] -> Emulator ()
-doDIVS = args3 _doDIVS
-
--- SBCD
-_doSBCD :: Int -> Int -> Int -> Emulator ()
-_doSBCD _ _ _ = return ()
-doSBCD :: [Int] -> [Int] -> [Int] -> Emulator ()
-doSBCD = args3 _doSBCD
-
--- OR
-_doOR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doOR _ _ _ _ _ = return ()
-doOR :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doOR = args5 _doOR
-
--- SUBA
-_doSUBA :: Int -> Int -> Int -> Int -> Emulator ()
-_doSUBA _ _ _ _ = return ()
-doSUBA :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doSUBA = args4 _doSUBA
-
--- SUBX
-_doSUBX :: Int -> Int -> Int -> Int -> Emulator ()
-_doSUBX _ _ _ _ = return ()
-doSUBX :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doSUBX = args4 _doSUBX
-
--- SUB
-_doSUB :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doSUB _ _ _ _ _ = return ()
-doSUB :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doSUB = args5 _doSUB
-
--- CMPA
-_doCMPA :: Int -> Int -> Int -> Int -> Emulator ()
-_doCMPA _ _ _ _ = return ()
-doCMPA :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doCMPA = args4 _doCMPA
-
--- CMP
-_doCMP :: Int -> Int -> Int -> Int -> Emulator ()
-_doCMP _ _ _ _ = return ()
-doCMP :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doCMP = args4 _doCMP
-
--- CMPM
-_doCMPM :: Int -> Int -> Int -> Emulator ()
-_doCMPM _ _ _ = return ()
-doCMPM :: [Int] -> [Int] -> [Int] -> Emulator ()
-doCMPM = args3 _doCMPM
-
--- EOR
-_doEOR :: Int -> Int -> Int -> Int -> Emulator ()
-_doEOR _ _ _ _ = return ()
-doEOR :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doEOR = args4 _doEOR
-
--- MULU
-_doMULU :: Int -> Int -> Int -> Emulator ()
-_doMULU _ _ _ = return ()
-doMULU :: [Int] -> [Int] -> [Int] -> Emulator ()
-doMULU = args3 _doMULU
-
--- MULS
-_doMULS :: Int -> Int -> Int -> Emulator ()
-_doMULS _ _ _ = return ()
-doMULS :: [Int] -> [Int] -> [Int] -> Emulator ()
-doMULS = args3 _doMULS
-
--- ABCD
-_doABCD :: Int -> Int -> Int -> Emulator ()
-_doABCD _ _ _ = return ()
-doABCD :: [Int] -> [Int] -> [Int] -> Emulator ()
-doABCD = args3 _doABCD
-
--- EXG
-_doEXG :: Int -> Int -> Int -> Int -> Emulator ()
-_doEXG _ _ _ _ = return ()
-doEXG :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doEXG = args4 _doEXG
-
--- AND
-_doAND :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doAND _ _ _ _ _ = return ()
-doAND :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doAND = args5 _doAND
-
--- ADDA
-_doADDA :: Int -> Int -> Int -> Int -> Emulator ()
-_doADDA _ _ _ _ = return ()
-doADDA :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doADDA = args4 _doADDA
-
--- ADDX
-_doADDX :: Int -> Int -> Int -> Int -> Emulator ()
-_doADDX _ _ _ _ = return ()
-doADDX :: [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doADDX = args4 _doADDX
-
--- ADD
-_doADD :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doADD _ _ _ _ _ = return ()
-doADD :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doADD = args5 _doADD
-
--- ASD
-_doASD :: Int -> Int -> Int -> Emulator ()
-_doASD _ _ _ = return ()
-doASD :: [Int] -> [Int] -> [Int] -> Emulator ()
-doASD = args3 _doASD
-
--- LSD
-_doLSD :: Int -> Int -> Int -> Emulator ()
-_doLSD _ _ _ = return ()
-doLSD :: [Int] -> [Int] -> [Int] -> Emulator ()
-doLSD = args3 _doLSD
-
--- ROXd
-_doROXd :: Int -> Int -> Int -> Emulator ()
-_doROXd _ _ _ = return ()
-doROXd :: [Int] -> [Int] -> [Int] -> Emulator ()
-doROXd = args3 _doROXd
-
--- ROd
-_doROd :: Int -> Int -> Int -> Emulator ()
-_doROd _ _ _ = return ()
-doROd :: [Int] -> [Int] -> [Int] -> Emulator ()
-doROd = args3 _doROd
-
--- ADSR
-_doADSR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doADSR _ _ _ _ _ = return ()
-doADSR :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doADSR = args5 _doADSR
-
--- LSDR
-_doLSDR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doLSDR _ _ _ _ _ = return ()
-doLSDR :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doLSDR = args5 _doLSDR
-
--- ROXdR
-_doROXdR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doROXdR _ _ _ _ _ = return ()
-doROXdR :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doROXdR = args5 _doROXdR
-
--- ROdR
-_doROdR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
-_doROdR _ _ _ _ _ = return ()
-doROdR :: [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> Emulator ()
-doROdR = args5 _doROdR
+doJSR :: Int -> Int -> Emulator ()
+doJSR _ _ = return ()
+
+doJMP :: Int -> Int -> Emulator ()
+doJMP _ _ = return ()
+
+doMOVEM :: Int -> Int -> Int -> Int -> Emulator ()
+doMOVEM _ _ _ _ = return ()
+
+doLEA :: Int -> Int -> Int -> Emulator ()
+doLEA _ _ _ = return ()
+
+doCHK :: Int -> Int -> Int -> Emulator ()
+doCHK _ _ _ = return ()
+
+doDBcc :: Int -> Int -> Emulator ()
+doDBcc _ _ = return ()
+
+doScc :: Int -> Int -> Int -> Emulator ()
+doScc _ _ _ = return ()
+
+doADDQ :: Int -> Int -> Int -> Int -> Emulator ()
+doADDQ _ _ _ _ = return ()
+
+doSUBQ :: Int -> Int -> Int -> Int -> Emulator ()
+doSUBQ _ _ _ _ = return ()
+
+doBRA :: Int -> Emulator ()
+doBRA _ = return ()
+
+doBSR :: Int -> Emulator ()
+doBSR _ = return ()
+
+doBcc :: Int -> Int -> Emulator ()
+doBcc _ _ = return ()
+
+doMOVEQ :: Int -> Int -> Emulator ()
+doMOVEQ _ _ = return ()
+
+doDIVU :: Int -> Int -> Int -> Emulator ()
+doDIVU _ _ _ = return ()
+
+doDIVS :: Int -> Int -> Int -> Emulator ()
+doDIVS _ _ _ = return ()
+
+doSBCD :: Int -> Int -> Int -> Emulator ()
+doSBCD _ _ _ = return ()
+
+doOR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doOR _ _ _ _ _ = return ()
+
+doSUBA :: Int -> Int -> Int -> Int -> Emulator ()
+doSUBA _ _ _ _ = return ()
+
+doSUBX :: Int -> Int -> Int -> Int -> Emulator ()
+doSUBX _ _ _ _ = return ()
+
+doSUB :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doSUB _ _ _ _ _ = return ()
+
+doCMPA :: Int -> Int -> Int -> Int -> Emulator ()
+doCMPA _ _ _ _ = return ()
+
+doCMP :: Int -> Int -> Int -> Int -> Emulator ()
+doCMP _ _ _ _ = return ()
+
+doCMPM :: Int -> Int -> Int -> Emulator ()
+doCMPM _ _ _ = return ()
+
+doEOR :: Int -> Int -> Int -> Int -> Emulator ()
+doEOR _ _ _ _ = return ()
+
+doMULU :: Int -> Int -> Int -> Emulator ()
+doMULU _ _ _ = return ()
+
+doMULS :: Int -> Int -> Int -> Emulator ()
+doMULS _ _ _ = return ()
+
+doABCD :: Int -> Int -> Int -> Emulator ()
+doABCD _ _ _ = return ()
+
+doEXG :: Int -> Int -> Int -> Int -> Emulator ()
+doEXG _ _ _ _ = return ()
+
+doAND :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doAND _ _ _ _ _ = return ()
+
+doADDA :: Int -> Int -> Int -> Int -> Emulator ()
+doADDA _ _ _ _ = return ()
+
+doADDX :: Int -> Int -> Int -> Int -> Emulator ()
+doADDX _ _ _ _ = return ()
+
+doADD :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doADD _ _ _ _ _ = return ()
+
+doASD :: Int -> Int -> Int -> Emulator ()
+doASD _ _ _ = return ()
+
+doLSD :: Int -> Int -> Int -> Emulator ()
+doLSD _ _ _ = return ()
+
+doROXd :: Int -> Int -> Int -> Emulator ()
+doROXd _ _ _ = return ()
+
+doROd :: Int -> Int -> Int -> Emulator ()
+doROd _ _ _ = return ()
+
+doADSR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doADSR _ _ _ _ _ = return ()
+
+doLSDR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doLSDR _ _ _ _ _ = return ()
+
+doROXdR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doROXdR _ _ _ _ _ = return ()
+
+doROdR :: Int -> Int -> Int -> Int -> Int -> Emulator ()
+doROdR _ _ _ _ _ = return ()
diff --git a/src/Suem.hs b/src/Suem.hs
index 0a9c9ea..cbc8361 100644
--- a/src/Suem.hs
+++ b/src/Suem.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BinaryLiterals #-}
-- This module organizes Emulator execution.
module Suem (Config(..), ConfigSocket(..), suem) where
@@ -17,98 +18,153 @@ import Utils
-------------------------------------------------------------------------------
-- Main loop and command deciphering.
-doCommand :: [Int] -> Emulator ()
-doCommand [0,0,0,0,0,0,0,0, 0,0,1,1,1,1,0,0] = doORICCR
-doCommand [0,0,0,0,0,0,0,0, 0,1,1,1,1,1,0,0] = doORISR
-doCommand [0,0,0,0,0,0,0,0, i,j,a,b,c,x,y,z] = doORI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,0,0,1,0, 0,0,1,1,1,1,0,0] = doANDICCR
-doCommand [0,0,0,0,0,0,1,0, 0,1,1,1,1,1,0,0] = doANDISR
-doCommand [0,0,0,0,0,0,1,0, i,j,a,b,c,x,y,z] = doANDI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,0,1,0,0, i,j,a,b,c,x,y,z] = doSUBI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,0,1,1,0, i,j,a,b,c,x,y,z] = doADDI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,1,0,1,0, 0,0,1,1,1,1,0,0] = doEORICCR
-doCommand [0,0,0,0,1,0,1,0, 0,1,1,1,1,1,0,0] = doEORISR
-doCommand [0,0,0,0,1,0,1,0, i,j,a,b,c,x,y,z] = doEORI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,1,1,0,0, i,j,a,b,c,x,y,z] = doCMPI [i,j] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,u,v,w,1, t,i,0,0,1,x,y,z] = doMOVEP [u,v,w] [t] [i] [x,y,z]
-doCommand [0,0,0,0,u,v,w,t, 0,0,a,b,c,x,y,z] = doBTST [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,u,v,w,t, 0,1,a,b,c,x,y,z] = doBCHG [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,u,v,w,t, 1,0,a,b,c,x,y,z] = doBCLR [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [0,0,0,0,u,v,w,t, 1,1,a,b,c,x,y,z] = doBSET [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [0,0,i,j,u,v,w,0, 0,1,a,b,c,x,y,z] = doMOVEA [i,j] [u,v,w] [a,b,c] [x,y,z]
-doCommand [0,0,i,j,u,v,w,d, e,f,a,b,c,x,y,z] = doMOVE [i,j] [d,e,f] [u,v,w] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,0,0,0, 1,1,a,b,c,x,y,z] = doSRMOVE [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,1,0,0, 1,1,a,b,c,x,y,z] = doMOVECCR [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,1,1,0, 1,1,a,b,c,x,y,z] = doMOVESR [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,0,0,0, i,j,a,b,c,x,y,z] = doNEGX [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,0,1,0, i,j,a,b,c,x,y,z] = doCLR [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,1,0,0, i,j,a,b,c,x,y,z] = doNEG [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,0,1,1,0, i,j,a,b,c,x,y,z] = doNOT [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,0,0,0, 1,i,0,0,0,x,y,z] = doEXT [i] [x,y,z]
-doCommand [0,1,0,0,1,0,0,0, 0,0,a,b,c,x,y,z] = doNBCD [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,0,0,0, 0,1,0,0,0,x,y,z] = doSWAP [x,y,z]
-doCommand [0,1,0,0,1,0,0,0, 0,1,a,b,c,x,y,z] = doPEA [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,0,1,0, 1,1,1,1,1,1,0,0] = doILLEGAL
-doCommand [0,1,0,0,1,0,1,0, 1,1,a,b,c,x,y,z] = doTAS [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,0,1,0, i,j,a,b,c,x,y,z] = doTST [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,1,1,0, 0,1,0,0,a,b,c,d] = doTRAP [a,b,c,d]
-doCommand [0,1,0,0,1,1,1,0, 0,1,0,1,0,x,y,z] = doLINK [x,y,z]
-doCommand [0,1,0,0,1,1,1,0, 0,1,0,1,1,x,y,z] = doUNLK [x,y,z]
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,0,t,x,y,z] = doMOVEUSP [t] [x,y,z]
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,0,0,0] = doRESET
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,0,0,1] = doNOP
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,0,1,0] = doSTOP
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,0,1,1] = doRTE
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,1,0,1] = doRTS
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,1,1,0] = doTRAPV
-doCommand [0,1,0,0,1,1,1,0, 0,1,1,1,0,1,1,1] = doRTR
-doCommand [0,1,0,0,1,1,1,0, 1,0,a,b,c,x,y,z] = doJSR [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,1,1,0, 1,1,a,b,c,x,y,z] = doJMP [a,b,c] [x,y,z]
-doCommand [0,1,0,0,1,t,0,0, 1,i,a,b,c,x,y,z] = doMOVEM [t] [i] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doLEA [u,v,w] [a,b,c] [x,y,z]
-doCommand [0,1,0,0,u,v,w,1, 1,0,a,b,c,x,y,z] = doCHK [u,v,w] [a,b,c] [x,y,z]
-doCommand [0,1,0,1,u,v,w,t, 1,1,0,0,1,x,y,z] = doDBcc [u,v,w,t] [x,y,z]
-doCommand [0,1,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doScc [u,v,w,t] [a,b,c] [x,y,z]
-doCommand [0,1,0,1,u,v,w,0, i,j,a,b,c,x,y,z] = doADDQ [u,v,w] [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,0,1,u,v,w,1, i,j,a,b,c,x,y,z] = doSUBQ [u,v,w] [i,j] [a,b,c] [x,y,z]
-doCommand [0,1,1,0,0,0,0,0, a,b,c,d,e,f,g,h] = doBRA [a,b,c,d,e,f,g,h]
-doCommand [0,1,1,0,0,0,0,1, a,b,c,d,e,f,g,h] = doBSR [a,b,c,d,e,f,g,h]
-doCommand [0,1,1,0,u,v,w,t, a,b,c,d,e,f,g,h] = doBcc [u,v,w,t] [a,b,c,d,e,f,g,h]
-doCommand [0,1,1,1,u,v,w,0, a,b,c,d,e,f,g,h] = doMOVEQ [u,v,w] [a,b,c,d,e,f,g,h]
-doCommand [1,0,0,0,u,v,w,0, 1,1,a,b,c,x,y,z] = doDIVU [u,v,w] [a,b,c] [x,y,z]
-doCommand [1,0,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doDIVS [u,v,w] [a,b,c] [x,y,z]
-doCommand [1,0,0,0,u,v,w,1, 0,0,0,0,t,x,y,z] = doSBCD [u,v,w] [t] [x,y,z]
-doCommand [1,0,0,0,u,v,w,t, i,j,a,b,c,x,y,z] = doOR [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
-doCommand [1,0,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doSUBA [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [1,0,0,1,u,v,w,1, i,j,0,0,t,x,y,z] = doSUBX [u,v,w] [i,j] [t] [x,y,z]
-doCommand [1,0,0,1,u,v,w,t, i,j,a,b,c,x,y,z] = doSUB [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
-doCommand [1,0,1,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doCMPA [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [1,0,1,1,u,v,w,0, i,j,a,b,c,x,y,z] = doCMP [u,v,w] [i,j] [a,b,c] [x,y,z]
-doCommand [1,0,1,1,u,v,w,1, i,j,0,0,1,x,y,z] = doCMPM [u,v,w] [i,j] [x,y,z]
-doCommand [1,0,1,1,u,v,w,1, i,j,a,b,c,x,y,z] = doEOR [u,v,w] [i,j] [a,b,c] [x,y,z]
-doCommand [1,1,0,0,u,v,w,0, 1,1,a,b,c,x,y,z] = doMULU [u,v,w] [a,b,c] [x,y,z]
-doCommand [1,1,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doMULS [u,v,w] [a,b,c] [x,y,z]
-doCommand [1,1,0,0,u,v,w,1, 0,0,0,0,t,x,y,z] = doABCD [u,v,w] [t] [x,y,z]
-doCommand [1,1,0,0,u,v,w,1, i,j,0,0,t,x,y,z] = doEXG [u,v,w] [i,j] [t] [x,y,z]
-doCommand [1,1,0,0,u,v,w,t, i,j,a,b,c,x,y,z] = doAND [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
-doCommand [1,1,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doADDA [u,v,w] [t] [a,b,c] [x,y,z]
-doCommand [1,1,0,1,u,v,w,1, i,j,0,0,t,x,y,z] = doADDX [u,v,w] [i,j] [t] [x,y,z]
-doCommand [1,1,0,1,u,v,w,t, i,j,a,b,c,x,y,z] = doADD [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
-doCommand [1,1,1,0,0,0,0,t, 1,1,a,b,c,x,y,z] = doASD [t] [a,b,c] [x,y,z]
-doCommand [1,1,1,0,0,0,1,t, 1,1,a,b,c,x,y,z] = doLSD [t] [a,b,c] [x,y,z]
-doCommand [1,1,1,0,0,1,0,t, 1,1,a,b,c,x,y,z] = doROXd [t] [a,b,c] [x,y,z]
-doCommand [1,1,1,0,0,1,1,t, 1,1,a,b,c,x,y,z] = doROd [t] [a,b,c] [x,y,z]
-doCommand [1,1,1,0,u,v,w,t, i,j,a,0,0,x,y,z] = doADSR [u,v,w] [t] [i,j] [a] [x,y,z]
-doCommand [1,1,1,0,u,v,w,t, i,j,a,0,1,x,y,z] = doLSDR [u,v,w] [t] [i,j] [a] [x,y,z]
-doCommand [1,1,1,0,u,v,w,t, i,j,a,1,0,x,y,z] = doROXdR [u,v,w] [t] [i,j] [a] [x,y,z]
-doCommand [1,1,1,0,u,v,w,t, i,j,a,1,1,x,y,z] = doROdR [u,v,w] [t] [i,j] [a] [x,y,z]
-doCommand _ = error "Bad command."
+doCommand :: Word16 -> Emulator ()
+doCommand 0b0000000000111100 = doORICCR
+doCommand 0b0000000001111100 = doORISR
+doCommand 0b0000001000111100 = doANDICCR
+doCommand 0b0000001001111100 = doANDISR
+doCommand 0b0000101000111100 = doEORICCR
+doCommand 0b0000101001111100 = doEORISR
+doCommand 0b0100101011111100 = doILLEGAL
+doCommand 0b0100111001110000 = doRESET
+doCommand 0b0100111001110001 = doNOP
+doCommand 0b0100111001110010 = doSTOP
+doCommand 0b0100111001110011 = doRTE
+doCommand 0b0100111001110101 = doRTS
+doCommand 0b0100111001110110 = doTRAPV
+doCommand 0b0100111001110111 = doRTR
+doCommand cmd
+ | (extractBits cmd [0..7]) == 0b00000000 =
+ doORI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..7]) == 0b00000010 =
+ doANDI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..7]) == 0b00000100 =
+ doSUBI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..7]) == 0b00000110 =
+ doADDI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..7]) == 0b00001010 =
+ doEORI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..7]) == 0b00001100 =
+ doCMPI (extractBits cmd [8..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..3]) == 0b0000 &&
+ (extractBits cmd [7]) == 0b0 &&
+ (extractBits cmd [10..12]) == 0b001 =
+ doMOVEP (extractBits cmd [4..6])
+ (extractBits cmd [8])
+ (extractBits cmd [9])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..3]) == 0b0000 &&
+ (extractBits cmd [8..9]) == 0b00 =
+ doBTST (extractBits cmd [4..6])
+ (extractBits cmd [7])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..3]) == 0b0000 &&
+ (extractBits cmd [8..9]) == 0b01 =
+ doBCHG (extractBits cmd [4..6])
+ (extractBits cmd [7])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..3]) == 0b0000 &&
+ (extractBits cmd [8..9]) == 0b10 =
+ doBCLR (extractBits cmd [4..6])
+ (extractBits cmd [7])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..3]) == 0b0000 &&
+ (extractBits cmd [8..9]) == 0b11 =
+ doBSET (extractBits cmd [4..6])
+ (extractBits cmd [7])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..1]) == 0b00 &&
+ (extractBits cmd [7..9]) == 0b001 =
+ doMOVEA (extractBits cmd [2..3])
+ (extractBits cmd [4..6])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | (extractBits cmd [0..1]) == 0b00 =
+ doMOVE (extractBits cmd [2..3])
+ (extractBits cmd [4..6])
+ (extractBits cmd [7..9])
+ (extractBits cmd [10..12])
+ (extractBits cmd [13..15])
+ | otherwise = error "Bad command."
+-- doCommand [0,1,0,0,0,0,0,0, 1,1,a,b,c,x,y,z] = doSRMOVE [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,1,0,0, 1,1,a,b,c,x,y,z] = doMOVECCR [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,1,1,0, 1,1,a,b,c,x,y,z] = doMOVESR [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,0,0,0, i,j,a,b,c,x,y,z] = doNEGX [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,0,1,0, i,j,a,b,c,x,y,z] = doCLR [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,1,0,0, i,j,a,b,c,x,y,z] = doNEG [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,0,1,1,0, i,j,a,b,c,x,y,z] = doNOT [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,0,0,0, 1,i,0,0,0,x,y,z] = doEXT [i] [x,y,z]
+-- doCommand [0,1,0,0,1,0,0,0, 0,0,a,b,c,x,y,z] = doNBCD [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,0,0,0, 0,1,0,0,0,x,y,z] = doSWAP [x,y,z]
+-- doCommand [0,1,0,0,1,0,0,0, 0,1,a,b,c,x,y,z] = doPEA [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,0,1,0, 1,1,a,b,c,x,y,z] = doTAS [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,0,1,0, i,j,a,b,c,x,y,z] = doTST [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,1,1,0, 0,1,0,0,a,b,c,d] = doTRAP [a,b,c,d]
+-- doCommand [0,1,0,0,1,1,1,0, 0,1,0,1,0,x,y,z] = doLINK [x,y,z]
+-- doCommand [0,1,0,0,1,1,1,0, 0,1,0,1,1,x,y,z] = doUNLK [x,y,z]
+-- doCommand [0,1,0,0,1,1,1,0, 0,1,1,0,t,x,y,z] = doMOVEUSP [t] [x,y,z]
+-- doCommand [0,1,0,0,1,1,1,0, 1,0,a,b,c,x,y,z] = doJSR [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,1,1,0, 1,1,a,b,c,x,y,z] = doJMP [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,1,t,0,0, 1,i,a,b,c,x,y,z] = doMOVEM [t] [i] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doLEA [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,0,u,v,w,1, 1,0,a,b,c,x,y,z] = doCHK [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,1,u,v,w,t, 1,1,0,0,1,x,y,z] = doDBcc [u,v,w,t] [x,y,z]
+-- doCommand [0,1,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doScc [u,v,w,t] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,1,u,v,w,0, i,j,a,b,c,x,y,z] = doADDQ [u,v,w] [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,0,1,u,v,w,1, i,j,a,b,c,x,y,z] = doSUBQ [u,v,w] [i,j] [a,b,c] [x,y,z]
+-- doCommand [0,1,1,0,0,0,0,0, a,b,c,d,e,f,g,h] = doBRA [a,b,c,d,e,f,g,h]
+-- doCommand [0,1,1,0,0,0,0,1, a,b,c,d,e,f,g,h] = doBSR [a,b,c,d,e,f,g,h]
+-- doCommand [0,1,1,0,u,v,w,t, a,b,c,d,e,f,g,h] = doBcc [u,v,w,t] [a,b,c,d,e,f,g,h]
+-- doCommand [0,1,1,1,u,v,w,0, a,b,c,d,e,f,g,h] = doMOVEQ [u,v,w] [a,b,c,d,e,f,g,h]
+-- doCommand [1,0,0,0,u,v,w,0, 1,1,a,b,c,x,y,z] = doDIVU [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [1,0,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doDIVS [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [1,0,0,0,u,v,w,1, 0,0,0,0,t,x,y,z] = doSBCD [u,v,w] [t] [x,y,z]
+-- doCommand [1,0,0,0,u,v,w,t, i,j,a,b,c,x,y,z] = doOR [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,0,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doSUBA [u,v,w] [t] [a,b,c] [x,y,z]
+-- doCommand [1,0,0,1,u,v,w,1, i,j,0,0,t,x,y,z] = doSUBX [u,v,w] [i,j] [t] [x,y,z]
+-- doCommand [1,0,0,1,u,v,w,t, i,j,a,b,c,x,y,z] = doSUB [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,0,1,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doCMPA [u,v,w] [t] [a,b,c] [x,y,z]
+-- doCommand [1,0,1,1,u,v,w,0, i,j,a,b,c,x,y,z] = doCMP [u,v,w] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,0,1,1,u,v,w,1, i,j,0,0,1,x,y,z] = doCMPM [u,v,w] [i,j] [x,y,z]
+-- doCommand [1,0,1,1,u,v,w,1, i,j,a,b,c,x,y,z] = doEOR [u,v,w] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,1,0,0,u,v,w,0, 1,1,a,b,c,x,y,z] = doMULU [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [1,1,0,0,u,v,w,1, 1,1,a,b,c,x,y,z] = doMULS [u,v,w] [a,b,c] [x,y,z]
+-- doCommand [1,1,0,0,u,v,w,1, 0,0,0,0,t,x,y,z] = doABCD [u,v,w] [t] [x,y,z]
+-- doCommand [1,1,0,0,u,v,w,1, i,j,0,0,t,x,y,z] = doEXG [u,v,w] [i,j] [t] [x,y,z]
+-- doCommand [1,1,0,0,u,v,w,t, i,j,a,b,c,x,y,z] = doAND [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,1,0,1,u,v,w,t, 1,1,a,b,c,x,y,z] = doADDA [u,v,w] [t] [a,b,c] [x,y,z]
+-- doCommand [1,1,0,1,u,v,w,1, i,j,0,0,t,x,y,z] = doADDX [u,v,w] [i,j] [t] [x,y,z]
+-- doCommand [1,1,0,1,u,v,w,t, i,j,a,b,c,x,y,z] = doADD [u,v,w] [t] [i,j] [a,b,c] [x,y,z]
+-- doCommand [1,1,1,0,0,0,0,t, 1,1,a,b,c,x,y,z] = doASD [t] [a,b,c] [x,y,z]
+-- doCommand [1,1,1,0,0,0,1,t, 1,1,a,b,c,x,y,z] = doLSD [t] [a,b,c] [x,y,z]
+-- doCommand [1,1,1,0,0,1,0,t, 1,1,a,b,c,x,y,z] = doROXd [t] [a,b,c] [x,y,z]
+-- doCommand [1,1,1,0,0,1,1,t, 1,1,a,b,c,x,y,z] = doROd [t] [a,b,c] [x,y,z]
+-- doCommand [1,1,1,0,u,v,w,t, i,j,a,0,0,x,y,z] = doADSR [u,v,w] [t] [i,j] [a] [x,y,z]
+-- doCommand [1,1,1,0,u,v,w,t, i,j,a,0,1,x,y,z] = doLSDR [u,v,w] [t] [i,j] [a] [x,y,z]
+-- doCommand [1,1,1,0,u,v,w,t, i,j,a,1,0,x,y,z] = doROXdR [u,v,w] [t] [i,j] [a] [x,y,z]
+-- doCommand [1,1,1,0,u,v,w,t, i,j,a,1,1,x,y,z] = doROdR [u,v,w] [t] [i,j] [a] [x,y,z]
runMachine :: Emulator ()
runMachine = forM_ [0..] $ \_ -> do
pc <- with pc $ \pc -> readIORef pc
cmd <- getWord $ fromIntegral pc
- doCommand (toBitsWhole cmd)
+ doCommand cmd
-------------------------------------------------------------------------------
diff --git a/src/Utils.hs b/src/Utils.hs
index 475821a..03d6db3 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,7 +1,6 @@
-- This module describes utility functions.
module Utils where
-import Prelude hiding (Word)
import Data.Bits
@@ -15,32 +14,8 @@ toBit False = 0
toBits :: Bits a => a -> [Int] -> [Int]
toBits x r = map (toBit . testBit x) r
-toBitsWhole :: FiniteBits a => a -> [Int]
-toBitsWhole x = toBits x [0..(finiteBitSize x - 1)]
-
fromBits :: [Int] -> Int
fromBits = foldl (\a b -> 2 * a + b) 0 . reverse
extractBits :: Bits a => a -> [Int] -> Int
extractBits x r = fromBits $ toBits x r
-
-
--------------------------------------------------------------------------------
--- Transformers for commands arguments
-
-args2 :: (Int -> Int -> t) ->
- [Int] -> [Int] -> t
-args2 f a b = f (fromBits a) (fromBits b)
-
-args3 :: (Int -> Int -> Int -> t) ->
- [Int] -> [Int] -> [Int] -> t
-args3 f a b c = f (fromBits a) (fromBits b) (fromBits c)
-
-args4 :: (Int -> Int -> Int -> Int -> t) ->
- [Int] -> [Int] -> [Int] -> [Int] -> t
-args4 f a b c d = f (fromBits a) (fromBits b) (fromBits c) (fromBits d)
-
-args5 :: (Int -> Int -> Int -> Int -> Int -> t) ->
- [Int] -> [Int] -> [Int] -> [Int] -> [Int] -> t
-args5 f a b c d e = f (fromBits a) (fromBits b) (fromBits c)
- (fromBits d) (fromBits e)