module SynacorEngine where
-import Debug.Trace
+-- import Debug.Trace
-- import System.Environment
import Data.Bits
import Control.Lens
import Data.List
import Data.Char
-import Numeric
+-- import Numeric
import Control.Monad.State.Strict
import Control.Monad.Reader
-- returns (returnValue, finalMachine, outputs)
runMachine :: [Word16] -> Machine -> (ExecutionState, Machine, [Word16])
-runMachine inputs machine = runRWS runAll inputs machine
+runMachine inputs machine = runRWS (runAll (10 ^ 6)) inputs machine
makeMachine :: Memory -> Machine
-makeMachine memory = Machine
+makeMachine mem = Machine
{ _ip = 0
, _inputIndex = 0
, _registers = M.fromList [ (r, 0) | r <- [0..7] ]
- , _memory = memory
+ , _memory = mem
, _stack = []
, _tracing = False
}
-- ) x
-- return x'
-runAll :: ProgrammedMachine ExecutionState
-runAll = do cip <- gets _ip
- opcode <- getLocation cip
- traceMachine
- -- opcode' <- traceMachine opcode
- -- exState <- runStep opcode'
- exState <- runStep opcode
- case exState of
- Terminated -> return Terminated
- Blocked -> return Blocked
- _ -> runAll
+runAll :: Int -> ProgrammedMachine ExecutionState
+runAll executionLimit
+ | executionLimit == 0 = return Terminated
+ | otherwise =
+ do cip <- gets _ip
+ opcode <- getLocation cip
+ traceMachine
+ -- opcode' <- traceMachine opcode
+ -- exState <- runStep opcode'
+ exState <- runStep opcode
+ case exState of
+ Terminated -> return Terminated
+ Blocked -> return Blocked
+ _ -> runAll (executionLimit - 1)
runStep :: Word16 -> ProgrammedMachine ExecutionState
traceMachine = do
isTracing <- gets _tracing
when isTracing
- do cip <- gets _ip
+ do cip <- gets _ip
+ (l, _) <- dissembleInstruction cip
+ regs <- gets _registers
+ let regVals = intercalate "; " $ fmap show $ M.elems regs
+ stk <- gets _stack
+ let stackVals = intercalate "; " $ fmap show $ take 10 stk
+ tell $ fmap (fromIntegral . ord) (">> " ++ l ++ " : r> " ++ regVals ++ " : s> " ++ stackVals ++ "<<")
+
+runDissemble :: Word16 -> Int -> Machine -> [String]
+runDissemble startAt num machine =fst $ evalRWS (dissemble startAt num) [] machine
+
+
+dissemble :: Word16 -> Int -> ProgrammedMachine [String]
+dissemble startAt num = go startAt num []
+ where go _ 0 ls = return $ reverse ls
+ go here n ls =
+ do (line, step) <- dissembleInstruction here
+ go (here + step) (n - 1) (line : ls)
+
+dissembleInstruction :: Word16 -> ProgrammedMachine (String, Word16)
+dissembleInstruction cip =
+ do -- cip <- gets _ip
opcode <- getLocation cip
- a <- getLocation (cip + 1)
- b <- getLocation (cip + 2)
- c <- getLocation (cip + 3)
+ mem <- gets _memory
+ let a = mem ! (cip + 1)
+ let b = mem ! (cip + 2)
+ let c = mem ! (cip + 3)
let sa = show a
let sb = show b
let sc = show c
18 -> ["ret"]
19 -> ["out", sa, "*", sva]
20 -> ["in", sa, "*", sva]
- 21 -> ["noop", sa, sb, sc, "*", sva, svb, svc]
+ 21 -> ["noop"]
_ -> ["illegal", sa, sb, sc, "*", sva, svb, svc]
- tell $ fmap (fromIntegral . ord) (">> " ++ (show cip) ++ ": " ++ (intercalate " " traceText) ++ "<<")
+ let stepSize =
+ if | opcode `elem` [0, 18, 21] -> 1
+ | opcode `elem` [2, 3, 6, 17, 19, 20] -> 2
+ | opcode `elem` [1, 7, 8, 14, 15, 16] -> 3
+ | opcode `elem` [4, 5, 9, 10, 11, 12, 13] -> 4
+ | otherwise -> 1
+ return ( ((show cip) ++ ": " ++ (intercalate " " traceText))
+ , stepSize
+ )
getValue :: Word16 -> ProgrammedMachine Word16
getValue loc =