---------------------------------------------------------------------- -- 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 Word ---------------------------------------------------------------------- -- Local libraries. ---------------------------------------------------------------------- import CPU import Decoder import Format import Instruction import Loader import Memory import Operand import Program import Register import RegisterName import Swi ---------------------------------------------------------------------- -- Evaluate a single instruction. ---------------------------------------------------------------------- eval :: CPU -> Instruction -> Bool -> IO CPU -- add two registers eval cpu (Add (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) + (getReg regs reg3)) } eval cpu (Add (Reg reg1) (Reg reg2) (Con con1)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) + con1) } -- logical bit-wise and eval cpu (And (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) .&. (getReg regs reg3)) } -- branch unconditionally eval cpu (B (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in return cpu { registers = setReg regs R15 pc' } -- branch if equal eval cpu (Beq (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in if cpsrGetZ regs == 1 then return cpu { registers = setReg regs R15 pc' } else return cpu -- branch if greater than eval cpu (Bgt (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in if cpsrGetC regs == 1 then return cpu { registers = setReg regs R15 pc' } else return cpu -- bit clear eval cpu (Bic (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) .&. (complement (getReg regs reg3))) } -- branch and link eval cpu (Bl (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in return cpu { registers = setReg (setReg regs R14 (pc + 4)) R15 pc' } -- branch if less than eval cpu (Blt (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in if cpsrGetN regs == 1 then return cpu { registers = setReg regs R15 pc' } else return cpu -- branch if not equal eval cpu (Bne (Rel offset)) _ = let regs = registers cpu pc = getReg regs R15 - 4 pc' = if offset < 0 then pc - (intToWord32 (-offset)) else pc + (intToWord32 offset) in if cpsrGetZ regs == 0 then return cpu { registers = setReg regs R15 pc' } else return cpu -- compare two values eval cpu (Cmp (Reg r1) op2) _ = do let val1 = word32ToInt (getReg (registers cpu) r1) let val2 = case op2 of Con c -> word32ToInt c Reg r -> word32ToInt (getReg (registers cpu) r) let regs = setReg (registers cpu) CPSR 0 let regs' = if val1 < val2 then cpsrSetN regs else if val1 == val2 then cpsrSetZ regs else cpsrSetC regs return cpu { registers = regs' } -- logical bit-wise exclusive or eval cpu (Eor (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) `xor` (getReg regs reg3)) } -- load register, indirect eval cpu (Ldr (Reg reg1) (Ind reg2)) _ = let regs = registers cpu mem = memory cpu addr = getReg regs reg2 val = readMem mem addr in return cpu { registers = setReg regs reg1 val } -- load register, base + offset eval cpu (Ldr (Reg reg1) (Bas reg2 offset)) _ = let regs = registers cpu mem = memory cpu addr = (getReg regs reg2) + offset val = readMem mem addr in return cpu { registers = setReg regs reg1 val } -- load register, auto-indexed eval cpu (Ldr (Reg reg1) (Aut (Bas reg2 offset))) _ = let regs = registers cpu mem = memory cpu addr = (getReg regs reg2) + offset val = readMem mem addr regs' = setReg regs reg2 addr -- write the address back into reg2 in return cpu { registers = setReg regs' reg1 val } -- load register, post-indexed eval cpu (Ldr (Reg reg1) (Pos (Ind reg2) offset)) _ = let regs = registers cpu mem = memory cpu addr = getReg regs reg2 val = readMem mem addr regs' = setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 in return cpu { registers = setReg regs' reg1 val } -- move constant into register eval cpu (Mov (Reg reg) (Con con)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg con } -- move register into register eval cpu (Mov (Reg reg1) (Reg reg2)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 (getReg regs reg2) } -- logical bit-wise or eval cpu (Orr (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) .|. (getReg regs reg3)) } -- store register, indirect eval cpu (Str (Reg reg1) (Ind reg2)) _ = let regs = registers cpu mem = memory cpu val = getReg regs reg1 addr = getReg regs reg2 mem' = writeMem mem addr val in return cpu { memory = mem' } -- store register, base + offset eval cpu (Str (Reg reg1) (Bas reg2 offset)) _ = let regs = registers cpu mem = memory cpu val = getReg regs reg1 addr = getReg regs reg2 + offset mem' = writeMem mem addr val in return cpu { memory = mem' } -- store register, auto-indexed eval cpu (Str (Reg reg1) (Aut (Bas reg2 offset))) _ = let regs = registers cpu mem = memory cpu addr = getReg regs reg2 + offset mem' = writeMem mem addr (getReg regs reg1) regs' = setReg regs reg2 addr -- write the address back into reg2 in return cpu { memory = mem', registers = regs' } -- store register, post-indexed eval cpu (Str (Reg reg1) (Pos (Ind reg2) offset)) _ = let regs = registers cpu mem = memory cpu addr = getReg regs reg2 val = getReg regs reg1 mem' = writeMem mem addr val regs' = setReg regs reg2 (addr + offset) -- write addr + offset back into reg2 in return cpu { registers = regs', memory = mem' } -- subtract two registers eval cpu (Sub (Reg reg1) (Reg reg2) (Reg reg3)) _ = let regs = registers cpu in return cpu { registers = setReg regs reg1 ((getReg regs reg2) - (getReg regs reg3)) } -- software interrupt eval cpu (Swi (Con isn)) debug = swi cpu isn debug ---------------------------------------------------------------------- -- Run a list of instructions. ---------------------------------------------------------------------- runList :: CPU -> [Instruction] -> IO CPU runList cpu [] = return cpu runList cpu (instruction : instructions) = do cpu' <- eval cpu instruction False runList cpu' instructions ---------------------------------------------------------------------- -- Run a CPU until its running flag is set to False. ---------------------------------------------------------------------- run' :: CPU -> IO () run' cpu@(CPU { running = False }) = return () run' cpu = do cpu' <- singleStep cpu False run' cpu' ---------------------------------------------------------------------- -- ---------------------------------------------------------------------- singleStep :: CPU -> Bool -> IO CPU singleStep cpu debug = let regs = registers cpu mem = memory cpu pc = getReg regs R15 opcode = readMem mem pc instr = decode opcode in case instr of Nothing -> do putStrLn ("ERROR: can't decode instruction " ++ (formatHex opcode 8 '0' "") ++ " at adddress " ++ show pc ++ " (dec)") return cpu { running = False } Just instr' -> let regs' = setReg regs R15 (pc + 4) cpu' = cpu { registers = regs' } in do cpu'' <- eval cpu' instr' debug return cpu'' ---------------------------------------------------------------------- -- Run a program. ---------------------------------------------------------------------- run program = let memSize = (memorySize program `div` 4) + 1 cpu = loadProgram (emptyCPU memSize) program in run' cpu ---------------------------------------------------------------------- -- eof ----------------------------------------------------------------------