---------------------------------------------------------------------- -- FILE: ExecutionUnit.hs -- DATE: 2/6/2001 -- PROJECT: HARM (was VARM (Virtual ARM)), for CSE240 Spring 2001 -- LANGUAGE PLATFORM: HUGS -- OS PLATFORM: RedHat Linux 6.2 -- AUTHOR: Jeffrey A. Meunier -- EMAIL: jeffm@cse.uconn.edu -- MAINTAINER: Alex Mason -- EMAIL: axman6@gmail.com ---------------------------------------------------------------------- module Arm.ExecutionUnit where ---------------------------------------------------------------------- -- Standard libraries. ---------------------------------------------------------------------- import Data.Bits import Data.Int import Data.IORef import Data.Word ---------------------------------------------------------------------- -- Local libraries. ---------------------------------------------------------------------- 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 ---------------------------------------------------------------------- -- Evaluate a single instruction. ---------------------------------------------------------------------- eval :: CPU -> Instruction -> IO () -- add two registers 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) -- logical bit-wise and 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) -- branch unconditionally 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'' -- branch if equal 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 () -- branch if greater than 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 () -- bit clear 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)) -- branch and link 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'' -- branch if less than 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 () -- branch if not equal 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 () -- compare two values 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 -- logical bit-wise exclusive or 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) -- load multiple registers, empty ascending 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 () {- -- load register, indirect eval cpu (Ldr (Reg reg1) (Ind reg2)) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 val <- readMem mem addr setReg regs reg1 val -- load register, base + offset eval cpu (Ldr (Reg reg1) (Bas reg2 offset)) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 val <- readMem mem (addr + offset) setReg regs reg1 val -- load register, auto-indexed eval cpu (Ldr (Reg reg1) (Aut (Bas reg2 offset))) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 val <- readMem mem (addr + offset) setReg regs reg2 (addr + offset) -- write the address back into reg2 setReg regs reg1 val -- load register, post-indexed eval cpu (Ldr (Reg reg1) (Pos (Ind reg2) offset)) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 val <- readMem mem addr setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 setReg regs reg1 val -} -- load register 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) -- write the address back into reg2 readMem mem (addr + offset) Pos (Ind reg2) offset -> do addr <- getReg regs reg2 setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 readMem mem addr setReg regs reg1 val -- load register, unsigned byte 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) -- write the address back into reg2 return (addr + offset) Pos (Ind reg2) offset -> do addr <- getReg regs reg2 setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 return addr val <- readMem mem addr let byteOffset = fromIntegral (addr .&. 3) let byte = 0xFF .&. (val `shiftR` (byteOffset * 8)) setReg regs reg1 byte -- move constant into register eval cpu (Mov (Reg reg) (Con con)) = setReg (registers cpu) reg con -- move register into register 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 -- logical bit-wise or 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) -- load multiple registers, empty ascending 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 () {- -- store register, indirect eval cpu (Str (Reg reg1) (Ind reg2)) = do let regs = registers cpu let mem = memory cpu val <- getReg regs reg1 addr <- getReg regs reg2 writeMem mem addr val -- store register, base + offset eval cpu (Str (Reg reg1) (Bas reg2 offset)) = do let regs = registers cpu let mem = memory cpu val <- getReg regs reg1 addr <- getReg regs reg2 writeMem mem (addr + offset) val -- store register, auto-indexed eval cpu (Str (Reg reg1) (Aut (Bas reg2 offset))) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 let addr' = addr + offset r1 <- getReg regs reg1 writeMem mem addr' r1 setReg regs reg2 addr' -- write the address back into reg2 -- store register, post-indexed eval cpu (Str (Reg reg1) (Pos (Ind reg2) offset)) = do let regs = registers cpu let mem = memory cpu addr <- getReg regs reg2 val <- getReg regs reg1 writeMem mem addr val setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 -} -- store register 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' -- write the address back into reg2 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) -- write addr + offset back into reg2 -- store register, unsigned byte 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' -- write the address back into reg2 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) -- write addr + offset back into reg2 -- subtract two registers 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) -- software interrupt eval cpu (Swi (Con isn)) = do dbg <- readIORef (debug cpu) swi cpu isn dbg ---------------------------------------------------------------------- -- Run a CPU until its running flag is set to False. ---------------------------------------------------------------------- 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 a program. ---------------------------------------------------------------------- run :: Program -> IO () run program = do let memSize = (memorySize program `div` 4) + 1 cpu <- emptyCPU memSize loadProgram cpu program run' cpu ---------------------------------------------------------------------- -- eof ----------------------------------------------------------------------