---------------------------------------------------------------------- -- FILE: ExecutionUnit.hs -- DATE: 2/6/2001 -- PROJECT: 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 ---------------------------------------------------------------------- module ExecutionUnit where ---------------------------------------------------------------------- -- Standard libraries. ---------------------------------------------------------------------- import Bits import Int import IOExts import Word ---------------------------------------------------------------------- -- Local libraries. ---------------------------------------------------------------------- import Bits import CPU import Decoder import Format import Instruction import Loader import Memory import MemoryManager import Operand import Program import Register import RegisterName import Swi ---------------------------------------------------------------------- -- Evaluate a single instruction. -- The number of cycles needed by the instruction is returned -- by this function. ---------------------------------------------------------------------- eval :: CPU -> Instruction -> IO Int -- 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) return 1 eval cpu (Add (Reg reg1) (Reg reg2) (Con con1)) = do let regs = registers cpu r2 <- getReg regs reg2 setReg regs reg1 (r2 + con1) return 1 -- 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) return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) setReg regs R15 pc'' return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) z <- cpsrGetZ regs if z == 1 then setReg regs R15 pc'' else return () return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) c <- cpsrGetC regs if c == 1 then setReg regs R15 pc'' else return () return 1 -- 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)) return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) setReg regs R14 pc setReg regs R15 pc'' return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) n <- cpsrGetN regs if n == 1 then setReg regs R15 pc'' else return () return 1 -- 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' - (intToWord32 (-offset)) else pc' + (intToWord32 offset) z <- cpsrGetZ regs if z == 0 then setReg regs R15 pc'' else return () return 1 -- compare two values eval cpu (Cmp (Reg reg1) op2) = do let regs = registers cpu r1 <- getReg regs reg1 let val1 = word32ToInt r1 val2 <- case op2 of Con c -> return (word32ToInt c) Reg r -> do r' <- getReg regs r return (word32ToInt r') cpsrSetN 0 regs cpsrSetZ 0 regs cpsrSetC 0 regs if val1 < val2 then cpsrSetN 1 regs else if val1 == val2 then cpsrSetZ 1 regs else do cpsrSetC 1 regs return 1 -- 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) return 1 -- load multiple registers, empty ascending eval cpu (Ldmea op1 (Mrg regList)) = do let regs = registers cpu let mm = memman 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 <- mmRead mm addr setReg regs r val loadRegs (addr - 4) rs addr' <- loadRegs (addr - 4) (reverse regList) if writeBack then setReg regs reg addr' else return () return (length regList) -- load register eval cpu (Ldr (Reg reg1) op2) = do let regs = registers cpu let mm = memman cpu val <- case op2 of Ind reg2 -> do addr <- getReg regs reg2 mmRead mm addr Bas reg2 offset -> do addr <- getReg regs reg2 mmRead mm (addr + offset) Aut (Bas reg2 offset) -> do addr <- getReg regs reg2 setReg regs reg2 (addr + offset) -- write the address back into reg2 mmRead mm (addr + offset) Pos (Ind reg2) offset -> do addr <- getReg regs reg2 setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 mmRead mm addr setReg regs reg1 val return 1 -- load register, unsigned byte eval cpu (Ldrb (Reg reg1) op2) = do let regs = registers cpu let mm = memman 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 <- mmRead mm addr let byteOffset = word32ToInt (addr .&. 3) let byte = 0xFF .&. (val `shiftR` (byteOffset * 8)) setReg regs reg1 byte return 1 -- move constant into register eval cpu (Mov (Reg reg) (Con con)) = do setReg (registers cpu) reg con return 1 eval cpu (Mrs (Reg reg) (Reg CPSR)) = do let regs = registers cpu cpsr <- getReg regs CPSR setReg regs reg cpsr return 1 eval cpu (Msr (Reg CPSR) (Reg reg)) = do let regs = registers cpu val <- getReg regs reg setReg regs CPSR val return 1 -- move register into register eval cpu (Mov (Reg reg1) (Reg reg2)) = do let regs = registers cpu val <- getReg regs reg2 setReg regs reg1 val return 1 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 return 1 -- 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) return 1 -- load multiple registers, empty ascending eval cpu (Stmea op1 (Mrg regList)) = do let regs = registers cpu let mm = memman 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 mmWrite mm addr val storeRegs (addr + 4) rs addr' <- storeRegs addr regList if writeBack then setReg regs reg addr' else return () return (length regList) -- store register eval cpu (Str (Reg reg1) op2) = do let regs = registers cpu let mm = memman cpu val <- getReg regs reg1 case op2 of Ind reg2 -> do addr <- getReg regs reg2 mmWrite mm addr val Aut (Bas reg2 offset) -> do addr <- getReg regs reg2 let addr' = addr + offset mmWrite mm addr' val setReg regs reg2 addr' -- write the address back into reg2 Bas reg2 offset -> do addr <- getReg regs reg2 mmWrite mm (addr + offset) val Pos (Ind reg2) offset -> do addr <- getReg regs reg2 mmWrite mm addr val setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 return 1 -- store register, unsigned byte eval cpu (Strb (Reg reg1) op2) = do let regs = registers cpu let mm = memman cpu val <- getReg regs reg1 let val' = val .&. 0xFF case op2 of Ind reg2 -> do addr <- getReg regs reg2 wrd <- mmRead mm addr let byteOffset = word32ToInt (addr .&. 3) let val'' = val' `shiftL` (byteOffset * 8) let mask = complement (0xFF `shiftL` (byteOffset * 8)) mmWrite mm addr ((wrd .&. mask) .|. val'') Aut (Bas reg2 offset) -> do addr <- getReg regs reg2 let addr' = addr + offset wrd <- mmRead mm addr' let byteOffset = word32ToInt (addr' .&. 3) let val'' = val' `shiftL` (byteOffset * 8) let mask = complement (0xFF `shiftL` (byteOffset * 8)) mmWrite mm 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 <- mmRead mm addr' let byteOffset = word32ToInt (addr' .&. 3) let val'' = val' `shiftL` (byteOffset * 8) let mask = complement (0xFF `shiftL` (byteOffset * 8)) mmWrite mm addr' ((wrd .&. mask) .|. val'') Pos (Ind reg2) offset -> do addr <- getReg regs reg2 wrd <- mmRead mm addr let byteOffset = word32ToInt (addr .&. 3) let val'' = val' `shiftL` (byteOffset * 8) let mask = complement (0xFF `shiftL` (byteOffset * 8)) mmWrite mm addr ((wrd .&. mask) .|. val'') setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 return 1 -- 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) return 1 -- software interrupt eval cpu (Swi (Con isn)) = do dbg <- readIORef (debug cpu) swi cpu isn dbg return 1 ---------------------------------------------------------------------- -- 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 mm = memman cpu pc <- getReg regs R15 opcode <- mmRead mm 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) cycles <- eval cpu instr' sequence (take cycles (repeat (mmStep (memman cpu) (registers cpu)))) return () ---------------------------------------------------------------------- -- Run a program. ---------------------------------------------------------------------- run :: Program -> IO () run program = do let memSize = (memorySize program `div` 4) + 1 cpu <- mkCPU memSize loadProgram cpu program run' cpu ---------------------------------------------------------------------- -- eof ----------------------------------------------------------------------