module Arm.ExecutionUnit
where
import Data.Bits
import Data.Int
import Data.IORef
import Data.Word
import Data.Bits
import Arm.CPU
import Arm.Decoder
import Arm.Format
import Arm.Instruction
import Arm.Loader
import Arm.Memory
import Arm.Operand
import Arm.Program
import Arm.Register
import Arm.RegisterName
import Arm.Swi
eval
:: CPU
-> Instruction
-> IO ()
eval cpu (Add (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 + r3)
eval cpu (Add (Reg reg1) (Reg reg2) (Con con1))
= do let regs = registers cpu
r2 <- getReg regs reg2
setReg regs reg1 (r2 + con1)
eval cpu (And (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 .&. r3)
eval cpu (B (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
setReg regs R15 pc''
eval cpu (Beq (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
z <- cpsrGetZ regs
if z == 1
then setReg regs R15 pc''
else return ()
eval cpu (Bgt (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
c <- cpsrGetC regs
if c == 1
then setReg regs R15 pc''
else return ()
eval cpu (Bic (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 .&. (complement r3))
eval cpu (Bl (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
setReg regs R14 pc
setReg regs R15 pc''
eval cpu (Blt (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
n <- cpsrGetN regs
if n == 1
then setReg regs R15 pc''
else return ()
eval cpu (Bne (Rel offset))
= do let regs = registers cpu
pc <- getReg regs R15
let pc' = pc 4
let pc'' = if offset < 0
then pc' (fromIntegral (offset))
else pc' + (fromIntegral offset)
z <- cpsrGetZ regs
if z == 0
then setReg regs R15 pc''
else return ()
eval cpu (Cmp (Reg reg1) op2)
= do let regs = registers cpu
r1 <- getReg regs reg1
let val1 = fromIntegral r1
val2 <- case op2 of
Con c -> return (fromIntegral c)
Reg r -> do r' <- getReg regs r
return (fromIntegral r')
setReg regs CPSR 0
if val1 < val2
then cpsrSetN regs
else if val1 == val2
then cpsrSetZ regs
else cpsrSetC regs
eval cpu (Eor (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 `xor` r3)
eval cpu (Ldmea op1 (Mrg regList))
= do let regs = registers cpu
let mem = memory cpu
let (reg, writeBack) = case op1 of { Aut (Reg r) -> (r, True); Reg r -> (r, False) }
addr <- getReg regs reg
let loadRegs addr []
= return (addr + 4)
loadRegs addr (r : rs)
= do val <- readMem mem addr
setReg regs r val
loadRegs (addr 4) rs
addr' <- loadRegs (addr 4) (reverse regList)
if writeBack
then setReg regs reg addr'
else return ()
eval cpu (Ldr (Reg reg1) op2)
= do let regs = registers cpu
let mem = memory cpu
val <- case op2 of
Ind reg2
-> do addr <- getReg regs reg2
readMem mem addr
Bas reg2 offset
-> do addr <- getReg regs reg2
readMem mem (addr + offset)
Aut (Bas reg2 offset)
-> do addr <- getReg regs reg2
setReg regs reg2 (addr + offset)
readMem mem (addr + offset)
Pos (Ind reg2) offset
-> do addr <- getReg regs reg2
setReg regs reg2 (addr + offset)
readMem mem addr
setReg regs reg1 val
eval cpu (Ldrb (Reg reg1) op2)
= do let regs = registers cpu
let mem = memory cpu
addr
<- case op2 of
Ind reg2
-> do addr <- getReg regs reg2
return addr
Bas reg2 offset
-> do addr <- getReg regs reg2
return (addr + offset)
Aut (Bas reg2 offset)
-> do addr <- getReg regs reg2
setReg regs reg2 (addr + offset)
return (addr + offset)
Pos (Ind reg2) offset
-> do addr <- getReg regs reg2
setReg regs reg2 (addr + offset)
return addr
val <- readMem mem addr
let byteOffset = fromIntegral (addr .&. 3)
let byte = 0xFF .&. (val `shiftR` (byteOffset * 8))
setReg regs reg1 byte
eval cpu (Mov (Reg reg) (Con con))
= setReg (registers cpu) reg con
eval cpu (Mov (Reg reg1) (Reg reg2))
= do let regs = registers cpu
val <- getReg regs reg2
setReg regs reg1 val
eval cpu (Mul (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
let prod = (r2 * r3) .&. 0x7FFFFFFF
setReg regs reg1 prod
eval cpu (Orr (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 .|. r3)
eval cpu (Stmea op1 (Mrg regList))
= do let regs = registers cpu
let mem = memory cpu
let (reg, writeBack) = case op1 of { Aut (Reg r) -> (r, True); Reg r -> (r, False) }
addr <- getReg regs reg
let storeRegs addr []
= return addr
storeRegs addr (r : rs)
= do val <- getReg regs r
writeMem mem addr val
storeRegs (addr + 4) rs
addr' <- storeRegs addr regList
if writeBack
then setReg regs reg addr'
else return ()
eval cpu (Str (Reg reg1) op2)
= do let regs = registers cpu
let mem = memory cpu
val <- getReg regs reg1
case op2 of
Ind reg2
-> do addr <- getReg regs reg2
writeMem mem addr val
Aut (Bas reg2 offset)
-> do addr <- getReg regs reg2
let addr' = addr + offset
writeMem mem addr' val
setReg regs reg2 addr'
Bas reg2 offset
-> do addr <- getReg regs reg2
writeMem mem (addr + offset) val
Pos (Ind reg2) offset
-> do addr <- getReg regs reg2
writeMem mem addr val
setReg regs reg2 (addr + offset)
eval cpu (Strb (Reg reg1) op2)
= do let regs = registers cpu
let mem = memory cpu
val <- getReg regs reg1
let val' = val .&. 0xFF
case op2 of
Ind reg2
-> do addr <- getReg regs reg2
wrd <- readMem mem addr
let byteOffset = fromIntegral (addr .&. 3)
let val'' = val' `shiftL` (byteOffset * 8)
let mask = complement (0xFF `shiftL` (byteOffset * 8))
writeMem mem addr ((wrd .&. mask) .|. val'')
Aut (Bas reg2 offset)
-> do addr <- getReg regs reg2
let addr' = addr + offset
wrd <- readMem mem addr'
let byteOffset = fromIntegral (addr' .&. 3)
let val'' = val' `shiftL` (byteOffset * 8)
let mask = complement (0xFF `shiftL` (byteOffset * 8))
writeMem mem addr' ((wrd .&. mask) .|. val'')
setReg regs reg2 addr'
Bas reg2 offset
-> do addr <- getReg regs reg2
let addr' = addr + offset
wrd <- readMem mem addr'
let byteOffset = fromIntegral (addr' .&. 3)
let val'' = val' `shiftL` (byteOffset * 8)
let mask = complement (0xFF `shiftL` (byteOffset * 8))
writeMem mem addr' ((wrd .&. mask) .|. val'')
Pos (Ind reg2) offset
-> do addr <- getReg regs reg2
wrd <- readMem mem addr
let byteOffset = fromIntegral (addr .&. 3)
let val'' = val' `shiftL` (byteOffset * 8)
let mask = complement (0xFF `shiftL` (byteOffset * 8))
writeMem mem addr ((wrd .&. mask) .|. val'')
setReg regs reg2 (addr + offset)
eval cpu (Sub (Reg reg1) (Reg reg2) (Reg reg3))
= do let regs = registers cpu
r2 <- getReg regs reg2
r3 <- getReg regs reg3
setReg regs reg1 (r2 r3)
eval cpu (Swi (Con isn))
= do dbg <- readIORef (debug cpu)
swi cpu isn dbg
run'
:: CPU
-> IO ()
run' cpu
= do isRunning <- readIORef (running cpu)
if isRunning
then do singleStep cpu
run' cpu
else return ()
singleStep
:: CPU
-> IO ()
singleStep cpu
= do let regs = registers cpu
let mem = memory cpu
pc <- getReg regs R15
opcode <- readMem mem pc
let instr = decode opcode
case instr of
Nothing
-> do putStrLn ("ERROR: can't decode instruction " ++ (formatHex 8 '0' "" opcode)
++ " at adddress " ++ show pc ++ " (dec)")
let runFlag = running cpu
writeIORef runFlag False
Just instr'
-> do setReg regs R15 (pc + 4)
eval cpu instr'
run
:: Program
-> IO ()
run program
= do let memSize = (memorySize program `div` 4) + 1
cpu <- emptyCPU memSize
loadProgram cpu program
run' cpu