HARM 0.1.1 → 0.1.2
raw patch · 22 files changed
+3904/−3 lines, 22 files
Files
- Arm/Arm.hs +75/−0
- Arm/Assembler.hs +307/−0
- Arm/BinaryNumber.hs +216/−0
- Arm/CPU.hs +71/−0
- Arm/Debugger.hs +284/−0
- Arm/Decoder.hs +187/−0
- Arm/Encoder.hs +414/−0
- Arm/ExecutionUnit.hs +485/−0
- Arm/Format.hs +107/−0
- Arm/Instruction.hs +92/−0
- Arm/Loader.hs +220/−0
- Arm/Memory.hs +136/−0
- Arm/Operand.hs +70/−0
- Arm/ParseLib.hs +186/−0
- Arm/Parser.hs +512/−0
- Arm/Program.hs +84/−0
- Arm/Register.hs +131/−0
- Arm/RegisterName.hs +148/−0
- Arm/Swi.hs +171/−0
- HARM.cabal +6/−1
- dbgarm.hs +1/−1
- runarm.hs +1/−1
+ Arm/Arm.hs view
@@ -0,0 +1,75 @@+----------------------------------------------------------------------+-- FILE: Arm.hs+-- DESCRIPTION: Main file for running and debugging ARM+-- assembly source files.+-- DATE: 04/04/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.Arm+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Assembler+import qualified Arm.Debugger+import qualified Arm.ExecutionUnit+import Arm.Loader+import Arm.Program++++----------------------------------------------------------------------+-- Run a program.+----------------------------------------------------------------------+run+ :: String -- program's file name+ -> IO ()++run fileName+ = do progOrError <- asmFile fileName+ case progOrError of+ Left prog+ -> Arm.ExecutionUnit.run prog+ Right err+ -> putStrLn err++++----------------------------------------------------------------------+-- Debug a program.+----------------------------------------------------------------------+dbg+ :: String -- program's file name+ -> IO ()++dbg fileName+ = do progOrError <- asmFile fileName+ case progOrError of+ Left prog+ -> Arm.Debugger.dbg prog+ Right err+ -> putStrLn err++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Assembler.hs view
@@ -0,0 +1,307 @@+----------------------------------------------------------------------+-- FILE: Assembler.hs+-- DESCRIPTION: Assembler for ARM assembly programs.+-- DATE: 04/03/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+----------------------------------------------------------------------+++-- This module Arm.converts a list of parse elements into a+-- program data structure.++++module Arm.Assembler+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Prelude+import Data.Word+import Data.Char++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Instruction+import Arm.Operand+import Arm.ParseLib+import Arm.Parser+import Arm.Program+import Arm.RegisterName++++----------------------------------------------------------------------+-- Result data type.+----------------------------------------------------------------------+data AsmResult+ = Res Program+ | Err String+ deriving (Show)++++----------------------------------------------------------------------+-- Expand instruction macros. (currently there are none)+----------------------------------------------------------------------+expandMacros l = l++++----------------------------------------------------------------------+-- Resolve labels in a program.+----------------------------------------------------------------------+resolveSymbols+ :: Word32+ -> [ParseElement]+ -> [(String, Word32)]++resolveSymbols _ []+ = []++resolveSymbols addr (Origin org : rest)+ = resolveSymbols org rest++resolveSymbols addr (Symbol l : rest)+ = (l, addr) : resolveSymbols addr rest++resolveSymbols addr (Instruction _ : rest)+ = resolveSymbols (addr + 4) rest++resolveSymbols addr (Data [] ds : rest)+ = let dSize = constSize (List ds)+ in resolveSymbols (addr + dSize) rest++resolveSymbols addr (Data [Lab l] ds : rest)+ = let dSize = constSize (List ds)+ in (l, addr) : resolveSymbols (addr + dSize) rest++resolveSymbols addr (_ : rest)+ = resolveSymbols addr rest++++----------------------------------------------------------------------+-- Replace symbols with addresses.+----------------------------------------------------------------------+replaceSymbols+ :: [ParseElement] -- elements being parsed+ -> Int -- current line number in source file+ -> Word32 -- current address in memory+ -> [(String, Word32)] -- table of labels+ -> Word32 -- origin+ -> [(RegisterName, Word32)] -- initial register bindings+ -> [Instruction] -- instruction accumulator list+ -> [(Word32, Constant)] -- constant accumulator list+ -> Program++----------+replaceSymbols [] line addr _ origin regBindings iAccum cAccum+ = Program+ { memorySize = addr+ , origin = origin+ , regInit = reverse regBindings+ , instructions = reverse iAccum+ , constants = reverse cAccum+ }++----------+replaceSymbols (Origin org : rest) line addr lTab origin regBindings iAccum cAccum+ = replaceSymbols rest line org lTab org regBindings iAccum cAccum++----------+replaceSymbols (Instruction i : rest) line addr lTab origin regBindings iAccum cAccum+ = let i' = case i of+ B (Lab l) -> replaceBranch B lTab addr line l+ Beq (Lab l) -> replaceBranch Beq lTab addr line l+ Bgt (Lab l) -> replaceBranch Bgt lTab addr line l+ Bl (Lab l) -> replaceBranch Bl lTab addr line l+ Blt (Lab l) -> replaceBranch Blt lTab addr line l+ Bne (Lab l) -> replaceBranch Bne lTab addr line l+ _ -> i+ in replaceSymbols rest line (addr + 4) lTab origin regBindings (i' : iAccum) cAccum++----------+replaceSymbols (RegInit regName op : rest) line addr lTab origin regBindings iAccum cAccum+ = let val = case op of+ Lab label+ -> case lookup label lTab of+ Nothing+ -> error ("label " ++ label ++ " does not exist, line " ++ show line)+ Just label'+ -> label'+ in replaceSymbols rest line addr lTab origin ((regName, val) : regBindings) iAccum cAccum++----------+replaceSymbols (Newline : rest) line addr lTab origin regBindings iAccum cAccum+ = replaceSymbols rest (line + 1) addr lTab origin regBindings iAccum cAccum++----------+replaceSymbols (Data [] data' : rest) line addr lTab origin regBindings iAccum cAccum+ = let c = case data' of+ [c']+ -> c'+ _ -> List data'+ size = constSize c+ in replaceSymbols rest line (addr + size) lTab origin regBindings iAccum ((addr, c) : cAccum)++----------+replaceSymbols (Data [Lab label] data' : rest) line addr lTab origin regBindings iAccum cAccum+ = let c = case data' of+ [c']+ -> c'+ _ -> List data'+ size = constSize c+ addr' = case lookup label lTab of+ Nothing+ -> error ("label " ++ label ++ " does not exist, line " ++ show line)+ Just addr''+ -> addr''+ in replaceSymbols rest line (addr + size) lTab origin regBindings iAccum ((addr', c) : cAccum)++----------+replaceSymbols (_ : rest) line addr lTab origin regBindings iAccum cAccum+ = replaceSymbols rest line addr lTab origin regBindings iAccum cAccum++++----------------------------------------------------------------------+-- +----------------------------------------------------------------------+replaceBranch branchInstruction lTab addr line label+ = let a = lookup label lTab+ in case a of+ Nothing+ -> error ("label " ++ label ++ " not bound, line " ++ show line)+ Just addr'+ -> branchInstruction (Rel (fromIntegral addr' - fromIntegral addr))++++----------------------------------------------------------------------+-- Assemble a program text string into a program.+----------------------------------------------------------------------+asmString+ :: String+ -> Either Program String++asmString progString+ = let prog = papply pProgram progString+ in case prog of+ ((prog', "") : _)+ -> let lTab = resolveSymbols 0 prog'+ in Left (replaceSymbols prog' 1 0 lTab 0 [] [] [])+ ((prog', str) : _)+ -> Right (errorMessage prog' str)++++----------------------------------------------------------------------+-- Generate an error message.+----------------------------------------------------------------------+errorMessage prog' remainingInput+ = let lines = countLines prog' 1+ errLine = dropWhile isSpace (head (lines' remainingInput))+ in ("error, line " ++ show lines ++ ": " ++ errLine)+ where+ countLines [] accum+ = accum+ countLines (Newline : rest) accum+ = countLines rest (accum + 1)+ countLines (_ : rest) accum+ = countLines rest accum+++lines'+ :: String+ -> [String]++lines' ""+ = []+lines' s+ = let (l,s') = break (\x -> or [x == '\n', x == '\r']) s+ in l : case s' of+ []+ -> []+ (_:s'')+ -> lines' s''+++----------------------------------------------------------------------+-- Assemble a text file into a program.+----------------------------------------------------------------------+asmFile+ :: String+ -> IO (Either Program String)++asmFile fileName+ = do file <- readFile fileName+ let progOrError = asmString file+ return progOrError++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------+{-+p1 = " origin 16\n" +++ " reg r0 = DATA1\n" +++ "\n" +++ "TOP: mov r1, #100 ; this is the top of the loop\n" +++ "LOOP: add r1, r1, #4\n" +++ " cmp r1, #200\n" +++ " bne LOOP\n" +++ " swi #11\n" +++ "\n" +++ "DATA1 = 0,1,2\n" +++ " 3,4,5\n" +++ "\n" +++ "DATA2 = 100\n" +++ "\n" +++ "MSG1 = \"Hello, World!\"\n"+++p2 =+ ";---------------------------------------------------------------------\n" +++ ";- FILE: p1.arm\n" +++ ";- DESCRIPTION: \n" +++ ";- DATE: 04/04/2001\n" +++ ";- PROJECT: \n" +++ ";- LANGUAGE PLATFORM: VARM (Virtual ARM), for CSE240 Spring 2001\n" +++ ";- OS PLATFORM: RedHat Linux 6.2\n" +++ ";- AUTHOR: Jeffrey A. Meunier\n" +++ ";- EMAIL: jeffm@cse.uconn.edu\n" +++ ";---------------------------------------------------------------------\n" +++ "\n" +++ " origin 0\n" +++ " reg r0 = MSG\n" +++ " reg r9 = BUFFER\n" +++ "\n" +++ " swi #2\n" +++ " mov r0, r9\n" +++ " mov r1, #32\n" +++ " swi #4\n" +++ "\n" +++ " swi #11\n" +++ "\n" +++ "MSG = \"Enter your name: \"\n" +++ "BUFFER = array 32 0\n"+-}+++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/BinaryNumber.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+----------------------------------------------------------------------+-- FILE: BinaryNumber.hs+-- DATE: 11/10/2000+-- AUTHOR: Jeffrey A. Meunier+-- EMAIL: jeffm@cse.uconn.edu+----------------------------------------------------------------------+++-- This module Arm.represents binary numbers which are read and displayed+-- as a sequence of bits. A Binary32 number is semantically+-- equivalent to a Word32 number, so strictly speaking, all the extra+-- class information is not needed.++++module Arm.BinaryNumber+ ( Binary32+ , intToBinary32 -- :: Int -> Binary32+ , binary32ToInt -- :: Binary32 -> Int+ , binary32ToWord32 -- :: Binary32 -> Word32+ , word32ToBinary32 -- :: Word32 -> Binary32+ )+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Bits+import Data.Word+import Data.Array+import Data.Ratio++++----------------------------------------------------------------------+-- New type Binary32.+----------------------------------------------------------------------+newtype Binary32+ = B32 Word32+ deriving Num++instance Show Binary32 where+ showsPrec n (B32 wrd) = showString (biNumToString wrd "")+ where+ biNumToString 0 accum = ('0' : accum)+ biNumToString 1 accum = ('1' : accum)+ biNumToString n accum+ = if n `rem` 2 == 0+ then biNumToString (n `div` 2) ('0' : accum)+ else biNumToString (n `div` 2) ('1' : accum)++instance Read Binary32 where+ readsPrec n = (stringToBiNum 0)+ where+ stringToBiNum :: Word32 -> ReadS Binary32+ stringToBiNum acc "0" = [(B32 (acc * 2), "")]+ stringToBiNum acc "1" = [(B32 (acc * 2 + 1), "")]+ stringToBiNum acc (bit : bits)+ | bit == '0' = stringToBiNum (acc * 2) bits+ | bit == '1' = stringToBiNum (acc * 2 + 1) bits+++{-++This expression also converts a binary string into an integer, but it uses+4.3 times the number of reductions, and 4.8 times the number of cells:++s2b x = foldl (+) 0 (map (uncurry (*)) (zip (reverse (map ((flip (-)) (ord '0')) (map ord x))) [floor (2 ** x) | x <- [0..]]))++-}+++instance Eq Binary32 where+ (==) = binop (==)++instance Ord Binary32 where+ compare = binop compare++-- instance Num Binary32 where+-- x + y = to (binop (+) x y)+-- x - y = to (binop (-) x y)+-- negate = to . negate . from+-- x * y = to (binop (*) x y)+-- abs = absReal+-- signum = signumReal+-- fromInteger = to . primIntegerToWord+-- -- fromInt = intToBinary32++instance Bounded Binary32 where+ minBound = B32 0+ maxBound = B32 (maxBound :: Word32)++instance Real Binary32 where+ toRational x = toInteger x % 1++instance Integral Binary32 where+ x `div` y = to (binop div x y)+ x `quot` y = to (binop quot x y)+ x `rem` y = to (binop rem x y)+ x `mod` y = to (binop mod x y)+ x `quotRem` y = to2 (binop quotRem x y)+ divMod = quotRem+ -- even = even . from+ -- toInteger = toInteger . from+ -- toInt = binary32ToInt++instance Ix Binary32 where+ range (m,n) = [m..n]+ index b@(m,n) i+ | inRange b i = fromIntegral (from (i - m))+ | otherwise = error "index: Index out of range"+ inRange (m,n) i = m <= i && i <= n++instance Enum Binary32 where+ toEnum = to . fromIntegral+ fromEnum = fromIntegral . from+ enumFrom = numericEnumFrom+ enumFromTo = numericEnumFromTo+ enumFromThen = numericEnumFromThen+ enumFromThenTo = numericEnumFromThenTo++instance Bits Binary32 where+ x .&. y = to (binop (.&.) x y)+ x .|. y = to (binop (.|.) x y)+ x `xor` y = to (binop xor x y)+ complement = to . complement . from+ x `shift` i = to (from x `shift` i)+-- rotate + bit = to . bit+ setBit x i = to (setBit (from x) i)+ clearBit x i = to (clearBit (from x) i)+ complementBit x i = to (complementBit (from x) i)+ testBit x i = testBit (from x) i+ bitSize _ = 32+ isSigned _ = False++++----------------------------------------------------------------------+-- Conversion functions.+----------------------------------------------------------------------+intToBinary32 :: Int -> Binary32+intToBinary32 = (B32 . fromIntegral)++binary32ToInt :: Binary32 -> Int+binary32ToInt (B32 b) = fromIntegral b++binary32ToWord32 :: Binary32 -> Word32+binary32ToWord32 (B32 b) = b++word32ToBinary32 :: Word32 -> Binary32+word32ToBinary32 = B32++++-----------------------------------------------------------------------------+-- Enumeration code: copied from Prelude.+-----------------------------------------------------------------------------+numericEnumFrom :: Real a => a -> [a]+numericEnumFromThen :: Real a => a -> a -> [a]+numericEnumFromTo :: Real a => a -> a -> [a]+numericEnumFromThenTo :: Real a => a -> a -> a -> [a]+numericEnumFrom n = n : (numericEnumFrom $! (n+1))+numericEnumFromThen n m = iterate ((m-n)+) n+numericEnumFromTo n m = takeWhile (<= m) (numericEnumFrom n)+numericEnumFromThenTo n n' m = takeWhile (if n' >= n then (<= m) else (>= m))+ (numericEnumFromThen n n')++++-----------------------------------------------------------------------------+-- Coercions - used to make the instance declarations more uniform.+-----------------------------------------------------------------------------+class Coerce a where+ to :: Word32 -> a+ from :: a -> Word32++instance Coerce Binary32 where+ from = binary32ToWord32+ to = word32ToBinary32++binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)+binop op x y = from x `op` from y++to2 :: Coerce word => (Word32, Word32) -> (word, word)+to2 (x,y) = (to x, to y)++++-----------------------------------------------------------------------------+-- Primitives.+-----------------------------------------------------------------------------+-- primitive, primIntegerToWord :: Integer -> Word32++++-----------------------------------------------------------------------------+-- Code copied from the Prelude.+-----------------------------------------------------------------------------+absReal x+ | x >= 0 = x+ | otherwise = -x++signumReal x+ | x == 0 = 0+ | x > 0 = 1+ | otherwise = -1++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/CPU.hs view
@@ -0,0 +1,71 @@+----------------------------------------------------------------------+-- FILE: CPU.hs+-- DATE: 02/18/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.CPU+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.IORef++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Memory+import Arm.Register++++----------------------------------------------------------------------+-- CPU data type.+----------------------------------------------------------------------+data CPU+ = CPU+ { memory :: Memory+ , registers :: Registers+ , running :: IORef Bool+ , debug :: IORef Bool+ }++++----------------------------------------------------------------------+-- Create an empty CPU given a memory size.+----------------------------------------------------------------------+emptyCPU+ :: Address+ -> IO CPU++emptyCPU memSize+ = do mem <- emptyMem memSize+ regs <- emptyRegs+ run <- newIORef True+ dbg <- newIORef False+ return CPU+ { memory = mem+ , registers = regs+ , running = run+ , debug = dbg+ }++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Debugger.hs view
@@ -0,0 +1,284 @@+----------------------------------------------------------------------+-- FILE: Debugger.hs+-- DESCRIPTION: +-- DATE: 03/27/2001+-- PROJECT: +-- LANGUAGE PLATFORM: +-- OS PLATFORM: RedHat Linux 6.2+-- AUTHOR: Jeffrey A. Meunier+-- EMAIL: jeffm@cse.uconn.edu+-- MAINTAINER: Alex Mason+-- EMAIL: axman6@gmail.com+----------------------------------------------------------------------++++module Arm.Debugger+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.IORef+import Data.Array+import Data.Array.IO+import Data.List+import Arm.ParseLib+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.CPU+import Arm.Decoder+import Arm.ExecutionUnit+import Arm.Format+import Arm.Loader+import Arm.Memory+import Arm.Parser+import Arm.Program+import Arm.Register+import Arm.RegisterName++++----------------------------------------------------------------------+-- Debugger state data structure.+----------------------------------------------------------------------+data DebugState+ = Debug+ { bkpts :: [Address]+ , radix :: Radix+ }+ deriving (Show)++++----------------------------------------------------------------------+-- Debug a program, displaying the instruction at each step.+----------------------------------------------------------------------+dbg+ :: Program+ -> IO ()++dbg program+ = let loop cpu dbgs+ = do isRunning <- readIORef (running cpu)+ if not isRunning+ then return ()+ else do putStr "dbg: "+ cmd <- getChar+ putStrLn ""+ case cmd of+ 'm' -> do showMem (radix dbgs) cpu+ loop cpu dbgs+ 'r' -> do showRegs (radix dbgs) cpu+ loop cpu dbgs+ 'q' -> return ()+ 'n' -> do singleStep cpu+ showSurroundingInstructions (radix dbgs) cpu+ loop cpu dbgs+ '?' -> do showHelp+ loop cpu dbgs+ 'b' -> do dbgs <- addBreakpoint dbgs+ loop cpu dbgs+ 's' -> do showDebugState dbgs+ loop cpu dbgs+ 'g' -> do runToBreakpoint cpu dbgs+ loop cpu dbgs+ 'h' -> do putStrLn "hex"+ loop cpu dbgs { radix = Hex }+ 'd' -> do putStrLn "decimal"+ loop cpu dbgs { radix = Dec }+ x -> if and [x >= '1', x <= '9']+ then do stepTimes cpu ((fromEnum x) - (fromEnum '0'))+ showSurroundingInstructions (radix dbgs) cpu+ loop cpu dbgs+ else do showSurroundingInstructions (radix dbgs) cpu+ loop cpu dbgs+ memSize = (memorySize program `div` 4) + 1+ in do cpu <- emptyCPU memSize+ writeIORef (debug cpu) True+ loadProgram cpu program+ showSurroundingInstructions Hex cpu+ loop cpu (Debug [] Hex)++++----------------------------------------------------------------------+-- Run the cpu to a breakpoint, or until finished.+----------------------------------------------------------------------+runToBreakpoint cpu dbgs+ = let rad = radix dbgs+ bps = bkpts dbgs+ regs = registers cpu+ loop+ = do isRunning <- readIORef (running cpu)+ if (not isRunning)+ then return ()+ else do pc <- getReg regs R15+ case (elemIndex pc bps) of+ Nothing+ -> do singleStep cpu+ loop + Just _+ -> do showSurroundingInstructions rad cpu+ return ()+ in loop++++----------------------------------------------------------------------+-- +----------------------------------------------------------------------+stepTimes cpu n+ = if n == 0+ then return ()+ else do isRunning <- readIORef (running cpu)+ if not isRunning+ then return ()+ else do singleStep cpu+ stepTimes cpu (n-1)++++----------------------------------------------------------------------+-- Add a breakpoint to the breakpoint list.+----------------------------------------------------------------------+addBreakpoint+ :: DebugState+ -> IO DebugState++addBreakpoint dbgs+ = do putStr "break address: "+ addrStr <- getLine+ case papply pIntegral addrStr+ of [(addr, _)]+ -> return dbgs { bkpts = addr : (bkpts dbgs) }+ _ -> return dbgs++++----------------------------------------------------------------------+-- Show the current debug state.+----------------------------------------------------------------------+showDebugState dbgs+ = putStrLn (show dbgs)++++----------------------------------------------------------------------+-- Show help message.+----------------------------------------------------------------------+showHelp+ :: IO ()++showHelp+ = do putStrLn " b: add breakpoint"+ putStrLn " d: decimal"+ putStrLn " g: go (run to next breakpoint)"+ putStrLn " h: hexadecimal"+ putStrLn " m: dump memory"+ putStrLn " q: quit"+ putStrLn " r: show registers"+ putStrLn " s: show debug state"+ putStrLn " 1-9: step program 1-9 times"+ putStrLn " ?: this help message"++++----------------------------------------------------------------------+-- Show memory.+----------------------------------------------------------------------+showMem+ :: Radix+ -> CPU+ -> IO ()++showMem radix cpu+ = do let mem = memory cpu+ (lo, hi) <- getBounds mem -- :: IO (Int, Int)+ let hiByte = hi * 4+ let loop addr+ = do val <- readMem mem addr+ if addr >= hiByte+ then return ()+ else do putStrLn (" " ++ (formatNum radix addr) ++ ": " ++ (formatNum radix val))+ loop (addr + 4)+ loop lo++++----------------------------------------------------------------------+-- Show all registers.+----------------------------------------------------------------------+showRegs+ :: Radix+ -> CPU+ -> IO ()++showRegs radix cpu+ = let regs = registers cpu+ showReg regName+ = do regVal <- getReg regs regName+ putStr ((show regName) ++ "=" ++ (formatNum radix regVal))+ in do { putStr " "; showReg R0; putStr " "; showReg R4; putStr " "; showReg R8; putStr " "; showReg R12; putStrLn "";+ putStr " "; showReg R1; putStr " "; showReg R5; putStr " "; showReg R9; putStr " "; showReg R13; putStrLn "";+ putStr " "; showReg R2; putStr " "; showReg R6; putStr " "; showReg R10; putStr " "; showReg R14; putStrLn "";+ putStr " "; showReg R3; putStr " "; showReg R7; putStr " "; showReg R11; putStr " "; showReg R15; putStrLn "";+ showReg CPSR; putStr " ("; showCPSRFlags regs; putStrLn ")" }++++----------------------------------------------------------------------+-- Show instructions before and after current instruction.+----------------------------------------------------------------------+showSurroundingInstructions radix cpu+ = do let regs = registers cpu+ r15 <- getReg regs R15+ let pc = fromIntegral r15+ let mem = memory cpu+ -- let bounds = range mem+ bounds <- getBounds mem+ let hiBound = fromIntegral (snd bounds) * 4+ let addrsLo = dropWhile (< 0) [pc - 20, pc - 16 .. pc - 4]+ let shLo = map (showInstruction radix mem False) (map fromIntegral addrsLo)+ let addrsHi = takeWhile (< hiBound) [pc + 4, pc + 8 .. pc + 20]+ let shHi = map (showInstruction radix mem False) (map fromIntegral addrsHi)+ sequence shLo+ showInstruction radix mem True (fromIntegral pc)+ sequence shHi+ +++----------------------------------------------------------------------+-- Show current instruction (highlighted).+----------------------------------------------------------------------+showInstruction+ :: Radix+ -> Memory+ -> Bool+ -> Address+ -> IO ()++showInstruction radix mem highlight addr+ = do opcode <- readMem mem addr+ let instr = decode opcode+ let hexOp = formatHex 8 '0' "" opcode+ putStr ((if highlight then ">" else " ") ++ (formatNum radix addr) ++ ": "+ ++ (formatNum radix opcode) ++ " " ++ (if highlight then ">" else " "))+ case instr of+ Nothing+ -> putStrLn ""+ Just instr'+ -> putStrLn (show instr')++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Decoder.hs view
@@ -0,0 +1,187 @@+----------------------------------------------------------------------+-- FILE: Decoder.hs+-- DATE: 03/05/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.Decoder+ ( decode )+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Bits+import Data.Int+import Data.Maybe+import Debug.Trace+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Instruction+import Arm.Operand+import Arm.RegisterName++++----------------------------------------------------------------------+-- Decode a word into an instruction.+----------------------------------------------------------------------+decode+ :: Word32+ -> Maybe Instruction++decode word+ = let bits = splitWord word+ bit x = splitWord word (x, x)+ destReg = nthReg (bits (15, 12))+ firstOp = nthReg (bits (19, 16))+ op2 = case (bit 25) of+ 0x0 -- register+ -> Reg (nthReg (bits (3, 0)))+ 0x1 -- 8-bit immediate+ -> Con (bits (7, 0))+ in case bits (27, 24) of+ 0xF -> Just (Swi (Con (bits (23, 0))))+ _ -> case bits (27, 25) of+ 0x4 -> decodeMReg word firstOp -- multiple register transfer+ 0x5 -> decodeBranch word+ _ -> case (bits (27, 26)) of+ 0x0 -- multiplication or data processing instructions+ -> decodeMulOrDp word destReg firstOp op2+ 0x1 -- data transfer instructions+ -> decodeDataTrans word destReg+ _ -> Nothing++----------------------------------------+decodeMulOrDp word destReg firstOp op2+ = let bits = splitWord word+ bit x = splitWord word (x, x)+ in case (bits (27, 24), bit 7, bit 4) of+ (0, 1, 1)+ -> let rm = nthReg (bits (3, 0))+ rd = nthReg (bits (19, 16))+ rs = nthReg (bits (11, 8))+ in Just (Mul (Reg rd) (Reg rm) (Reg rs))+ _ -> decodeDataProc (bits (24, 21)) destReg firstOp op2++++----------------------------------------+decodeBranch word+ = let link = splitWord word (24, 24)+ offset = fromIntegral (splitWord word (23, 0))+ offset' = if offset > 32767+ then offset - 65536+ else offset+ -- if offset > 8388607 -- this is 2^23 - 1+ -- then offset - 16777216 -- this is 2^24+ -- else offset+ + + + + -- if offset > 32767+ -- then offset - 65536+ -- else offset+ + + + cond = splitWord word (31, 28)+ in case link of+ 0x0+ -> case cond of+ 0x0 -> Just (Beq (Rel offset'))+ 0x1 -> Just (Bne (Rel offset'))+ 0xB -> Just (Blt (Rel offset'))+ 0xC -> Just (Bgt (Rel offset'))+ 0xE -> Just (B (Rel offset'))+ _ -> Nothing+ 0x1+ -> case cond of+ 0xE -> Just (Bl (Rel offset'))+ _ -> Nothing++----------------------------------------+decodeDataProc opcode destReg firstOp op2+ = case opcode of+ 0x00 -> Just (And (Reg destReg) (Reg firstOp) op2)+ 0x01 -> Just (Eor (Reg destReg) (Reg firstOp) op2)+ 0x02 -> Just (Sub (Reg destReg) (Reg firstOp) op2)+ 0x04 -> Just (Add (Reg destReg) (Reg firstOp) op2)+ 0x0A -> Just (Cmp (Reg destReg) op2)+ 0x0C -> Just (Orr (Reg destReg) (Reg firstOp) op2)+ 0x0D -> Just (Mov (Reg destReg) op2)+ 0x0E -> Just (Bic (Reg destReg) (Reg firstOp) op2)+ _ -> Nothing++----------------------------------------+decodeMReg word firstOp+ = let bits = splitWord word+ bit x = splitWord word (x, x)+ instr = case (bit 20) of+ 0x0 -> Ldmea+ 0x1 -> Stmea+ rn = case (bit 21) of+ 0x0 -> Reg firstOp+ 0x1 -> (Aut (Reg firstOp))+ regList 0 _ = []+ regList n regNum+ | odd n = (nthReg regNum) : (regList (n `div` 2) (regNum + 1))+ | even n = regList (n `div` 2) (regNum + 1)+ regs = regList (fromIntegral (bits (15, 0))) 0+ in Just (instr rn (Mrg regs))+++----------------------------------------+decodeDataTrans word destReg+ = let bits = splitWord word+ bit x = splitWord word (x, x)+ instr = case (bit 22, bit 20) of+ (0, 0) -> Ldrb+ (0, 1) -> Strb+ (1, 0) -> Ldr+ (1, 1) -> Str+ baseReg = nthReg (bits (19, 16))+ offset = bits (11, 0)+ addrMode = (bit 21) * 2 + bit 24+ op2 = case addrMode of+ 0x0 -> if offset == 0+ then Just (Ind baseReg)+ else Just (Bas baseReg offset)+ 0x1 -> Nothing+ 0x2 -> Just (Aut (Bas baseReg offset))+ 0x3 -> Just (Pos (Ind baseReg) offset)+ in op2 >>= (\op2' -> Just (instr (Reg destReg) op2'))++----------------------------------------------------------------------+-- Split a word into fields.+----------------------------------------------------------------------+splitWord+ :: Word32+ -> (Int, Int)+ -> Word32++splitWord word (hi, lo)+ = let mask = (2 ^ (hi - lo + 1) - 1) `shiftL` lo+ in (word .&. mask) `shiftR` lo++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Encoder.hs view
@@ -0,0 +1,414 @@+----------------------------------------------------------------------+-- FILE: Encoder.hs+-- DATE: 03/04/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.Encoder+ ( encode )+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Bits+import Data.Int+import Data.Word+import Data.Array++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Instruction+import Arm.Operand+import Arm.RegisterName++++----------------------------------------------------------------------+-- Encoding shortcuts.+----------------------------------------------------------------------+condEq :: (Int, Int, Word32)+condNe :: (Int, Int, Word32)+condCs :: (Int, Int, Word32)+condHs :: (Int, Int, Word32)+condCc :: (Int, Int, Word32)+condLo :: (Int, Int, Word32)+condMi :: (Int, Int, Word32)+condPl :: (Int, Int, Word32)+condVs :: (Int, Int, Word32)+condVc :: (Int, Int, Word32)+condHi :: (Int, Int, Word32)+condLs :: (Int, Int, Word32)+condGe :: (Int, Int, Word32)+condLt :: (Int, Int, Word32)+condGt :: (Int, Int, Word32)+condLe :: (Int, Int, Word32)+condAl :: (Int, Int, Word32)+condNv :: (Int, Int, Word32)++condEq = (31, 28, 0x0)+condNe = (31, 28, 0x1)+condCs = (31, 28, 0x2)+condHs = (31, 28, 0x2)+condCc = (31, 28, 0x3)+condLo = (31, 28, 0x3)+condMi = (31, 28, 0x4)+condPl = (31, 28, 0x5)+condVs = (31, 28, 0x6)+condVc = (31, 28, 0x7)+condHi = (31, 28, 0x8)+condLs = (31, 28, 0x9)+condGe = (31, 28, 0xA)+condLt = (31, 28, 0xB)+condGt = (31, 28, 0xC)+condLe = (31, 28, 0xD)+condAl = (31, 28, 0xE)+condNv = (31, 28, 0xF)++++----------------------------------------------------------------------+-- Encode an instruction into a Word32.+----------------------------------------------------------------------+encode+ :: Instruction+ -> Word32++----------------------------------------+-- add three registers+encode (Add (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x04) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(25, 25, 0), (3, 0, regIndex r3)] -- second operand is register+ Con c1+ -> [(25, 25, 1), (7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- logical bit-wise and+encode (And (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x00) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(3, 0, regIndex r3)] -- second operand register+ Con c1+ -> [(7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- branch unconditionally+encode (B (Rel rel))+ = encodeBranch condAl rel++----------------------------------------+-- branch if equal+encode (Beq (Rel rel))+ = encodeBranch condEq rel++----------------------------------------+-- branch if greater than+encode (Bgt (Rel rel))+ = encodeBranch condGt rel++----------------------------------------+-- bit clear+encode (Bic (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x0E) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(3, 0, regIndex r3)] -- second operand register+ Con c1+ -> [(7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- branch and link+encode (Bl (Rel rel))+ = encodeBranch condAl rel .|. concatFields 0 [(24, 24, 1)]++----------------------------------------+-- branch if less than+encode (Blt (Rel rel))+ = encodeBranch condLt rel++----------------------------------------+-- branch if not equal+encode (Bne (Rel rel))+ = encodeBranch condNe rel++----------------------------------------+-- compare two operands+encode (Cmp (Reg r1) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x0A) -- opcode+ , (15, 12, regIndex r1) -- register 1+ ]+ w2 = encodeOp2 op2+ in w1 .|. w2++----------------------------------------+-- logical bit-wise exclusive or+encode (Eor (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x01) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(3, 0, regIndex r3)] -- second operand register+ Con c1+ -> [(7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- load multiple registers+encode (Ldmea op1 (Mrg regs))+ = encodeMReg 0x0 op1 regs++----------------------------------------+-- load register+encode (Ldr (Reg r1) op2)+ = encodeLdrStr 0x0 0x1 r1 op2++----------------------------------------+-- load register, unsigned byte+encode (Ldrb (Reg r1) op2)+ = encodeLdrStr 0x0 0x0 r1 op2++----------------------------------------+-- move register to register+encode (Mov (Reg r1) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x0D) -- opcode+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = encodeOp2 op2+ in w1 .|. w2++----------------------------------------+-- multiply+encode (Mul (Reg r1) (Reg r2) (Reg r3))+ = concatFields 0+ [ condAl+ , (19, 16, regIndex r1)+ , (11, 8, regIndex r3)+ , ( 7, 4, 0x09)+ , ( 3, 0, regIndex r2)+ ]++----------------------------------------+-- logical bit-wise or+encode (Orr (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x0C) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(3, 0, regIndex r3)] -- second operand register+ Con c1+ -> [(7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- load multiple registers+encode (Stmea op1 (Mrg regs))+ = encodeMReg 0x1 op1 regs++----------------------------------------+-- store register+encode (Str (Reg r1) op2)+ = encodeLdrStr 0x1 0x1 r1 op2++----------------------------------------+-- store register, unsigned byte+encode (Strb (Reg r1) op2)+ = encodeLdrStr 0x1 0x0 r1 op2++----------------------------------------+-- add three registers+encode (Sub (Reg r1) (Reg r2) op2)+ = let w1 = concatFields 0+ [ condAl -- condition+ , (24, 21, 0x02) -- opcode+ , (19, 16, regIndex r2) -- first operand register+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Reg r3+ -> [(3, 0, regIndex r3)] -- second operand register+ Con c1+ -> [(7, 0, c1)] -- 8-bit constant+ )+ in w1 .|. w2++----------------------------------------+-- software interrupt+encode (Swi (Con c))+ = concatFields 0 [ condAl+ , (27, 24, 0xF)+ ] .|. c++----------------------------------------------------------------------+-- helper functions++encodeBranch cond rel+ = concatFields 0 [ cond,+ (27, 25, 0x5)+ ] .|. (to16to32 rel)+++to16to32 n = (fromIntegral (fromIntegral n :: Word16) :: Word32)+++encodeOp2 op+ = concatFields 0+ (case op of+ Reg r2+ -> [(3, 0, regIndex r2)] -- first operand register+ Con c1+ -> [ (25, 25, 0x01) -- ``#'' field+ , (7, 0, c1) -- 8-bit immediate+ ])++-- encode a multiple register load or store+encodeMReg ls op1 regs+ = let w1 = concatFields 0+ [ condAl+ , (27, 25, 0x04) -- opcode+ --, (24, 24, 0x00) -- post-increment or decrement+ , (23, 23, 0x01) -- increment or decrement+ , (20, 20, ls) -- load+ ]+ w2 = concatFields 0+ (case op1 of+ Aut (Reg reg)+ -> [ (21, 21, 0x01) -- write-back+ , (19, 16, regIndex reg)+ ]+ Reg reg+ -> [ (19, 16, regIndex reg)+ ]+ )+ w3 = concatFields 0+ (map (\reg -> let i = fromIntegral (regIndex reg) in (i, i, 1)) regs)+ in w1 .|. w2 .|. w3++-- encode a load or store+encodeLdrStr ls bw r1 op2+ = let w1 = concatFields 0+ [ condAl -- condition+ , (27, 26, 0x01) -- constant field+ --, (25, 25, 0x00) -- ``#'' field+ --, (23, 23, 0x00) -- up/down+ , (22, 22, bw) -- unsigned byte/word+ , (20, 20, ls) -- load/store+ , (15, 12, regIndex r1) -- destination register+ ]+ w2 = concatFields 0+ (case op2 of+ Ind r2+ -> [ --(24, 24, 0x00) -- pre/post index+ --, (21, 21, 0x00) -- write-back (auto-index)+ (19, 16, regIndex r2) -- base register+ ]+ Bas r2 offset+ -> [ --(24, 24, 0x00) -- pre/post index+ --, (21, 21, 0x00) -- write-back (auto-index)+ (19, 16, regIndex r2) -- base register+ , (11, 0, offset) -- offset+ ]+ Aut (Bas r2 offset)+ -> [ --(24, 24, 0x00) -- pre/post index+ (21, 21, 0x01) -- write-back (auto-index)+ , (19, 16, regIndex r2) -- base register+ , (11, 0, offset) -- offset+ ]+ Pos (Ind r2) const+ -> [ (24, 24, 0x01) -- pre/post index+ , (21, 21, 0x01) -- write-back (auto-index)+ , (19, 16, regIndex r2) -- base register+ , (11, 0, const) -- offset+ ]+ )+ in w1 .|. w2+++++----------------------------------------------------------------------+-- Concatenate bit fields into one word.+----------------------------------------------------------------------+concatFields+ :: Word32+ -> [(Int, Int, Word32)]+ -> Word32++concatFields word [] = word+concatFields word ((hi, lo, val) : fields)+ = let mask = fromIntegral (2 ^ (hi - lo + 1) - 1)+ val' = val .&. mask+ in concatFields (word .|. (val' `shiftL` lo)) fields++++----------------------------------------------------------------------+-- Convert a register name into a word32.+----------------------------------------------------------------------+regIndex+ :: RegisterName+ -> Word32++regIndex = fromIntegral . (index (R0, CPSR))++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/ExecutionUnit.hs view
@@ -0,0 +1,485 @@+----------------------------------------------------------------------+-- 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+----------------------------------------------------------------------
+ Arm/Format.hs view
@@ -0,0 +1,107 @@+----------------------------------------------------------------------+-- FILE: Format.hs+-- DATE: 03/30/2001+-- PROJECT: +-- LANGUAGE PLATFORM: +-- OS PLATFORM: RedHat Linux 6.2+-- AUTHOR: Jeffrey A. Meunier+-- EMAIL: jeffm@cse.uconn.edu+-- MAINTAINER: Alex Mason+-- EMAIL: axman6@gmail.com+----------------------------------------------------------------------++++module Arm.Format+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Array+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------++++----------------------------------------------------------------------+-- Number base data type.+----------------------------------------------------------------------+data Radix+ = Dec+ | Hex+ deriving (Show)++++----------------------------------------------------------------------+-- Format a number in a specific number base.+----------------------------------------------------------------------+formatNum base+ = case base of+ Dec -> formatDec 10 '0'+ Hex -> formatHex 8 '0' ""++++----------------------------------------------------------------------+-- Convert a number to a hex string.+----------------------------------------------------------------------+formatHex+ :: Int+ -> Char+ -> String+ -> Word32+ -> String++formatHex places fillChar accum n+ = if places == 0+ then accum+ else let digIndex = n `mod` 16+ dig = if n == 0+ then fillChar+ else hexChars ! digIndex+ in formatHex (places - 1) fillChar (dig : accum) (n `div` 16)++++----------------------------------------------------------------------+-- Array of hex characters.+----------------------------------------------------------------------+hexChars+ :: Array Word32 Char++hexChars+ = listArray (0, 15) "0123456789ABCDEF"++++----------------------------------------------------------------------+-- Format a decimal integer+----------------------------------------------------------------------+formatDec+ :: Int+ -> Char+ -> Word32+ -> String++formatDec places fillChar n+ = let s = show n+ pad = places - (length s)+ in (take pad (repeat fillChar)) ++ s+++++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Instruction.hs view
@@ -0,0 +1,92 @@+----------------------------------------------------------------------+-- FILE: Instruction.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.Instruction+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Operand+import Arm.RegisterName++++----------------------------------------------------------------------+-- Instruciton data type.+----------------------------------------------------------------------+data Instruction+ = Add Operand Operand Operand+ | And Operand Operand Operand+ | B Operand+ | Beq Operand+ | Bgt Operand+ | Bic Operand Operand Operand+ | Bl Operand+ | Blt Operand+ | Bne Operand+ | Cmp Operand Operand+ | Eor Operand Operand Operand+ | Ldmea Operand Operand+ | Ldr Operand Operand+ | Ldrb Operand Operand+ | Mov Operand Operand+ | Mul Operand Operand Operand+ | Orr Operand Operand Operand+ | Stmea Operand Operand+ | Str Operand Operand+ | Strb Operand Operand+ | Sub Operand Operand Operand+ | Swi Operand+-- deriving Show+++instance Show Instruction where+ show (Add op1 op2 op3) = "add " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (And op1 op2 op3) = "and " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (B op1) = "b " ++ show op1+ show (Beq op1) = "beq " ++ show op1+ show (Bgt op1) = "bgt " ++ show op1+ show (Bic op1 op2 op3) = "bic " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (Bl op1) = "bl " ++ show op1+ show (Blt op1) = "blt " ++ show op1+ show (Bne op1) = "bne " ++ show op1+ show (Cmp op1 op2) = "cmp " ++ show op1 ++ ", " ++ show op2+ show (Eor op1 op2 op3) = "eor " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (Ldmea op1 op2) = "ldmea " ++ show op1 ++ ", " ++ show op2+ show (Ldr op1 op2) = "ldr " ++ show op1 ++ ", " ++ show op2+ show (Ldrb op1 op2) = "ldrb " ++ show op1 ++ ", " ++ show op2+ show (Mov op1 op2) = "mov " ++ show op1 ++ ", " ++ show op2+ show (Mul op1 op2 op3) = "mul " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (Orr op1 op2 op3) = "orr " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (Stmea op1 op2) = "stmea " ++ show op1 ++ ", " ++ show op2+ show (Str op1 op2) = "str " ++ show op1 ++ ", " ++ show op2+ show (Strb op1 op2) = "strb " ++ show op1 ++ ", " ++ show op2+ show (Sub op1 op2 op3) = "sub " ++ show op1 ++ ", " ++ show op2 ++ ", " ++ show op3+ show (Swi op1) = "swi " ++ show op1++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Loader.hs view
@@ -0,0 +1,220 @@+----------------------------------------------------------------------+-- FILE: Loader.hs+-- DATE: 03/07/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.Loader+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Bits+import Data.Word+import Data.Char++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.CPU+import Arm.Encoder+import Arm.Format+import Arm.Instruction+import Arm.Memory+import Arm.Program+import Arm.Register+import Arm.RegisterName++++----------------------------------------------------------------------+-- Load a program into a CPU.+----------------------------------------------------------------------+loadProgram+ :: CPU+ -> Program+ -> IO ()++loadProgram cpu program+ = let mem = memory cpu+ regs = registers cpu+ org = origin program+ instrs = instructions program+ consts = constants program+ in do loadRegisters regs (regInit program)+ setReg regs R15 org+ loadInstructions mem org instrs+ loadConstants mem consts++++----------------------------------------------------------------------+-- Load register pre-load values.+----------------------------------------------------------------------+loadRegisters+ :: Registers+ -> [(RegisterName, Word32)]+ -> IO ()++loadRegisters regs []+ = return ()++loadRegisters regs ((regName, val) : rest)+ = do setReg regs regName val+ loadRegisters regs rest++++----------------------------------------------------------------------+-- Load a list of instructions into memory.+----------------------------------------------------------------------+loadInstructions+ :: Memory+ -> Address+ -> [Instruction]+ -> IO ()++loadInstructions mem _ []+ = return ()++loadInstructions mem addr (ins : inss)+ = do let opcode = encode ins+ writeMem mem addr opcode+ loadInstructions mem (addr + 4) inss++++----------------------------------------------------------------------+-- Load a list of constant tuples into memory.+----------------------------------------------------------------------+loadConstants+ :: Memory+ -> [(Address, Constant)]+ -> IO ()++loadConstants mem []+ = return ()++loadConstants mem ((addr, const) : consts)+ = do loadConstant mem addr const+ loadConstants mem consts++++----------------------------------------------------------------------+-- Load an arbitrary constant into memory.+----------------------------------------------------------------------+loadConstant+ :: Memory+ -> Address+ -> Constant+ -> IO ()++loadConstant mem addr (Array count value)+ = loadArray mem addr count value++loadConstant mem addr (Int i)+ = writeMem mem addr (fromIntegral i)++loadConstant mem addr (List l)+ = loadList mem addr l++loadConstant mem addr (String s)+ = loadString mem addr (s ++ [chr 0])++loadConstant mem addr (Word w)+ = writeMem mem addr w++++----------------------------------------------------------------------+-- Load an array of constants into memory.+----------------------------------------------------------------------+loadArray+ :: Memory+ -> Address+ -> Word32+ -> Constant+ -> IO ()++loadArray mem addr 0 const+ = return ()++loadArray mem addr count const+ = do loadConstant mem addr const+ loadArray mem (addr + constSize const) (count - 1) const++++----------------------------------------------------------------------+-- Load a list of constants into memory.+----------------------------------------------------------------------+loadList+ :: Memory+ -> Address+ -> [Constant]+ -> IO ()++loadList mem addr []+ = return ()++loadList mem addr (const : consts)+ = do loadConstant mem addr const+ let addr' = constSize const + addr+ loadList mem addr' consts++++----------------------------------------------------------------------+-- Load a string into memory; null terminate the string.+----------------------------------------------------------------------+loadString+ :: Memory+ -> Address+ -> String+ -> IO ()++loadString mem addr []+ = return ()++loadString mem addr [c1]+ = let w = fromIntegral (ord c1)+ in writeMem mem addr w++loadString mem addr [c1, c2]+ = let w = (fromIntegral (ord c2) `shiftL` 8)+ .|. (fromIntegral (ord c1))+ in writeMem mem addr w++loadString mem addr [c1, c2, c3]+ = let w = (fromIntegral (ord c3) `shiftL` 16)+ .|. (fromIntegral (ord c2) `shift` 8)+ .|. (fromIntegral (ord c1))+ in writeMem mem addr w++loadString mem addr (c1 : c2 : c3 : c4 : cs)+ = let w = (fromIntegral (ord c4) `shiftL` 24)+ .|. (fromIntegral (ord c3) `shiftL` 16)+ .|. (fromIntegral (ord c2) `shiftL` 8)+ .|. (fromIntegral (ord c1))+ in do writeMem mem addr w+ loadString mem (addr + 4) cs++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Memory.hs view
@@ -0,0 +1,136 @@+----------------------------------------------------------------------+-- FILE: Memory.hs+-- DATE: 02/17/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.Memory+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+-- import IOExts+import Data.Array.IO+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------++++----------------------------------------------------------------------+-- Memory is an array of Word32 indexed by an Address.+----------------------------------------------------------------------+type Memory+ = IOArray Address Word32++type Address+ = Word32++type WordAddress+ = Address++type ByteAddress+ = Address++++----------------------------------------------------------------------+-- Create a new memory array.+----------------------------------------------------------------------+emptyMem+ :: Address+ -> IO Memory++emptyMem size+ = newArray (0, size-1) 0+-- = listArray (0, size-1) (repeat 0)++++----------------------------------------------------------------------+-- Return the word_32 address of a byte address.+-- This can be read as ``the word address of the nth byte in memory''.+----------------------------------------------------------------------+wordAddress+ :: ByteAddress+ -> WordAddress++wordAddress addr+ = addr `div` 4++++----------------------------------------------------------------------+-- Get the value at a memory location.+----------------------------------------------------------------------+getMemWord+ :: Memory+ -> WordAddress+ -> IO Word32++getMemWord mem addr+ = readArray mem addr+-- = mem ! addr+++ +----------------------------------------------------------------------+-- Set the value at a memory location.+----------------------------------------------------------------------+setMemWord+ :: Memory+ -> WordAddress+ -> Word32+ -> IO ()++setMemWord mem addr val+ = writeArray mem addr val+-- = mem // [(addr, val)]++++----------------------------------------------------------------------+-- Read memory. The byte address of the memory location is given.+----------------------------------------------------------------------+readMem+ :: Memory+ -> Address+ -> IO Word32++readMem mem byteAddr+ = getMemWord mem (wordAddress byteAddr)++++----------------------------------------------------------------------+-- Write memory. The byte address of the memory location is given.+----------------------------------------------------------------------+writeMem+ :: Memory+ -> Address+ -> Word32+ -> IO ()++writeMem mem byteAddr val+ = setMemWord mem (wordAddress byteAddr) val++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Operand.hs view
@@ -0,0 +1,70 @@+----------------------------------------------------------------------+-- FILE: Operand.hs+-- DATE: 02/17/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.Operand+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.RegisterName++++----------------------------------------------------------------------+-- Operand data type.+----------------------------------------------------------------------+data Operand+ = Aut Operand -- auto-increment+ | Bas RegisterName Word32 -- base + offset+ | Con Word32 -- constant+ | Ind RegisterName -- indirect+ | Mrg [RegisterName] -- multiple register+ | Pos Operand Word32 -- post-indexed+ | Reg RegisterName -- register+ | Rel Int -- relative address+ | Lab String -- for parsing branches+-- deriving Show+++instance Show Operand where+ show (Aut op) = show op ++ "!"+ show (Bas reg off) = "[" ++ show reg ++ ", #" ++ show off ++ "]"+ show (Con wrd) = "#" ++ show wrd+ show (Ind reg) = "[" ++ show reg ++ "]"+ show (Lab lab) = lab+ show (Mrg regs) = "{" ++ showMrg regs ++ "}"+ show (Pos op off) = show op ++ ", #" ++ show off+ show (Reg reg) = show reg+ show (Rel rel) = show rel+++showMrg [] = ""+showMrg [r] = show r+showMrg (r : rs) = show r ++ "," ++ showMrg rs++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/ParseLib.hs view
@@ -0,0 +1,186 @@+{-----------------------------------------------------------------------------++ A LIBRARY OF MONADIC PARSER COMBINATORS++ 29th July 1996+ Revised, October 1996+ Revised again, November 1998++ Graham Hutton Erik Meijer+ University of Nottingham University of Utrecht++This Haskell 98 script defines a library of parser combinators, and is taken+from sections 1-6 of our article "Monadic Parser Combinators". Some changes+to the library have been made in the move from Gofer to Haskell:++ * Do notation is used in place of monad comprehension notation;++ * The parser datatype is defined using "newtype", to avoid the overhead+ of tagging and untagging parsers with the P constructor.++-----------------------------------------------------------------------------}++module Arm.ParseLib+ (Parser, item, papply, (+++), sat, many, many1, sepby, sepby1, chainl,+ chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,+ letter, alphanum, string, ident, nat, int, spaces, comment, junk,+ parse, token, natural, integer, symbol, identifier) where++import Data.Char+import Control.Monad++infixr 5 +++++--- The parser monad ---------------------------------------------------------++newtype Parser a = P (String -> [(a,String)])++instance Functor Parser where+ -- map :: (a -> b) -> (Parser a -> Parser b)+ fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])++instance Monad Parser where+ -- return :: a -> Parser a+ return v = P (\inp -> [(v,inp)])++ -- >>= :: Parser a -> (a -> Parser b) -> Parser b+ (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])++instance MonadPlus Parser where+ -- mzero :: Parser a+ mzero = P (\inp -> [])++ -- mplus :: Parser a -> Parser a -> Parser a+ (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))++--- Other primitive parser combinators ---------------------------------------++item :: Parser Char+item = P (\inp -> case inp of+ [] -> []+ (x:xs) -> [(x,xs)])++force :: Parser a -> Parser a+force (P p) = P (\inp -> let x = p inp in+ (fst (head x), snd (head x)) : tail x)++first :: Parser a -> Parser a+first (P p) = P (\inp -> case p inp of+ [] -> []+ (x:xs) -> [x])++papply :: Parser a -> String -> [(a,String)]+papply (P p) inp = p inp++--- Derived combinators ------------------------------------------------------++(+++) :: Parser a -> Parser a -> Parser a+p +++ q = first (p `mplus` q)++sat :: (Char -> Bool) -> Parser Char+sat p = do {x <- item; if p x then return x else mzero}++many :: Parser a -> Parser [a]+many p = force (many1 p +++ return [])++many1 :: Parser a -> Parser [a]+many1 p = do {x <- p; xs <- many p; return (x:xs)}++sepby :: Parser a -> Parser b -> Parser [a]+p `sepby` sep = (p `sepby1` sep) +++ return []++sepby1 :: Parser a -> Parser b -> Parser [a]+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}++chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainl p op v = (p `chainl1` op) +++ return v++chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a+p `chainl1` op = do {x <- p; rest x}+ where+ rest x = do {f <- op; y <- p; rest (f x y)}+ +++ return x++chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainr p op v = (p `chainr1` op) +++ return v++chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a+p `chainr1` op = do {x <- p; rest x}+ where+ rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}+ +++ return x++ops :: [(Parser a, b)] -> Parser b+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]++bracket :: Parser a -> Parser b -> Parser c -> Parser b+bracket open p close = do {open; x <- p; close; return x}++--- Useful parsers -----------------------------------------------------------++char :: Char -> Parser Char+char x = sat (\y -> x == y)++digit :: Parser Char+digit = sat isDigit++lower :: Parser Char+lower = sat isLower++upper :: Parser Char+upper = sat isUpper++letter :: Parser Char+letter = sat isAlpha++alphanum :: Parser Char+alphanum = sat isAlphaNum++string :: String -> Parser String+string "" = return ""+string (x:xs) = do {char x; string xs; return (x:xs)}++ident :: Parser String+ident = do {x <- lower; xs <- many alphanum; return (x:xs)}++nat :: Parser Int+nat = do {x <- digit; return (digitToInt x)} `chainl1` return op+ where+ m `op` n = 10*m + n++int :: Parser Int+int = do {char '-'; n <- nat; return (-n)} +++ nat++--- Lexical combinators ------------------------------------------------------++spaces :: Parser ()+spaces = do {many1 (sat isSpace); return ()}++comment :: Parser ()+comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}++junk :: Parser ()+junk = do {many (spaces +++ comment); return ()}++parse :: Parser a -> Parser a+parse p = do {junk; p}++token :: Parser a -> Parser a+token p = do {v <- p; junk; return v}++--- Token parsers ------------------------------------------------------------++natural :: Parser Int+natural = token nat++integer :: Parser Int+integer = token int++symbol :: String -> Parser String+symbol xs = token (string xs)++identifier :: [String] -> Parser String+identifier ks = token (do {x <- ident; if not (elem x ks) then return x+ else mzero})++------------------------------------------------------------------------------
+ Arm/Parser.hs view
@@ -0,0 +1,512 @@+----------------------------------------------------------------------+-- FILE: Parser.hs+-- DESCRIPTION: Parser for ARM assembly programs.+-- DATE: 04/01/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.Parser+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Arm.ParseLib+import Data.Word+import Data.Char+import Control.Monad++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.BinaryNumber+import Arm.Instruction+import Arm.Memory+import Arm.Operand+import Arm.Program+import Arm.RegisterName++++----------------------------------------------------------------------+-- Type aliases.+----------------------------------------------------------------------+type Symbol = String++++----------------------------------------------------------------------+-- Parse element data type.+----------------------------------------------------------------------+data ParseElement+ = Data [Operand] [Constant]+ | Instruction Instruction+ | Symbol Symbol+ | Address Address+ | Origin Address+ | RegInit RegisterName Operand+ | Comment+ | Newline+ deriving (Show)++++----------------------------------------------------------------------+-- This parses any number of spaces or tabs. (``spaces'' parses at+-- least 1 space, and includes all white space characters including \n)+----------------------------------------------------------------------+spaces'+ = many (char ' ' +++ char '\t')++++----------------------------------------------------------------------+-- Parse a comma which separates two values. It can have any number+-- of spaces surrounding it.+----------------------------------------------------------------------+csep+ = do spaces'+ char ','+ spaces'+ return ()++sep c+ = do spaces'+ char c+ spaces'+ return ()++++----------------------------------------------------------------------+-- Parse a 32-bit decimal word.+----------------------------------------------------------------------+pWord :: Parser Word32+pWord+ = do { x <- digit; return (fromIntegral (digitToInt x)) }+ `chainl1` return op+ where+ op :: Word32 -> Word32 -> Word32+ m `op` n = 10*m + n++++----------------------------------------------------------------------+-- Parse a 32-bit hexadecimal word.+----------------------------------------------------------------------+hexDigit + = sat isHexDigit++-- isHexDigit = (`elem` "0123456789abcdefABCDEF")++hexValue '0' = 0+hexValue '1' = 1+hexValue '2' = 2+hexValue '3' = 3+hexValue '4' = 4+hexValue '5' = 5+hexValue '6' = 6+hexValue '7' = 7+hexValue '8' = 8+hexValue '9' = 9+hexValue 'a' = 10+hexValue 'b' = 11+hexValue 'c' = 12+hexValue 'd' = 13+hexValue 'e' = 14+hexValue 'f' = 15+hexValue 'A' = 10+hexValue 'B' = 11+hexValue 'C' = 12+hexValue 'D' = 13+hexValue 'E' = 14+hexValue 'F' = 15++pHex'+ = do { x <- hexDigit; return (hexValue x) }+ `chainl1` return op+ where+ op :: Word32 -> Word32 -> Word32+ m `op` n = 16*m + n++pHex+ = do string "0x"+ pHex'++++----------------------------------------------------------------------+-- Parse a binary word.+----------------------------------------------------------------------+pBinary+ :: Parser Word32++pBinary+ = do string "0b"+ bits <- many (char '0' +++ char '1')+ let bn = read bits+ return (binary32ToWord32 bn)++++----------------------------------------------------------------------+-- Parse an integer, either hex or decimal.+----------------------------------------------------------------------+pIntegral+ = pHex +++ pBinary +++ pWord++++----------------------------------------------------------------------+-- Parse a newline.+----------------------------------------------------------------------+pNl+ = do spaces'+ optional (char '\r') -- Windows puts a \r before the \n+ char '\n'+ return Newline++++-- ====================================================================+-- Header parsers+-- ====================================================================++----------------------------------------------------------------------+-- Parse origin.+----------------------------------------------------------------------+pOrigin+ = do string "origin"+ spaces'+ w <- pIntegral+ return (Origin w)++++----------------------------------------------------------------------+-- Parse register initializer.+----------------------------------------------------------------------+pRegInit+ = do spaces'+ string "reg"+ spaces'+ Reg regName <- pReg+ spaces'+ char '='+ spaces'+ o <- pOperand+ spaces'+ return (RegInit regName o)++++----------------------------------------------------------------------+-- Parse program header.+----------------------------------------------------------------------+pHeader+ = do o <- pOrigin+ regs <- many pRegInit+ return (o, regs)++++----------------------------------------------------------------------+-- Operand parsers.+----------------------------------------------------------------------++-- auto-indexed+pAut :: Parser Operand+pAut+ = do { b <- pBas; char '!'; return (Aut b) }+ +++ do { b <- pReg; char '!'; return (Aut b) }++-- base + offset+pBas :: Parser Operand+pBas+ = do { char '['; (Reg r) <- pReg; csep; Con c <- pCon; char ']'; return (Bas r c) }++-- constant+pCon :: Parser Operand+pCon+ = char '#' >> pIntegral >>= \w -> return (Con w)++-- indirect+pInd :: Parser Operand+pInd+ = do { char '['; Reg r <- pReg; char ']'; return (Ind r) }++-- multiple register+pMrg+ = do char '{'+ regs <- pMrg'+ regs' <- many (do { spaces'; char ','; spaces'; pMrg' })+ char '}'+ return (Mrg (foldl (++) [] (regs : regs')))+ where+ pMrg'+ = pRegRange+ +++ (do Reg r <- pReg+ return [r])+ pRegRange+ = do Reg r1 <- pReg+ char '-'+ Reg r2 <- pReg+ return (enumFromTo r1 r2)++-- post-indexed+pPos :: Parser Operand+pPos+ = do { char '['; Reg r <- pReg; char ']'; csep; Con c <- pCon; return (Pos (Ind r) c) }++-- register+pReg :: Parser Operand+pReg+ = do char 'r'+ i <- nat+ if or [i < 0, i > 15]+ then mzero+ else return (Reg (nthReg (fromIntegral i)))++-- relative offset+pRel+ = do { i <- int; return (Rel i) }++-- parse an operand+pOperand :: Parser Operand+pOperand+ = pAut +++ pBas +++ pCon +++ pPos +++ pInd+ +++ pReg +++ pRel +++ pMrg +++ pBranchLabel++++----------------------------------------------------------------------+-- Parse two operands.+----------------------------------------------------------------------+p2Ops+ = do { op1 <- pOperand; csep; op2 <- pOperand; return (op1, op2) }++++----------------------------------------------------------------------+-- Parse three operands.+----------------------------------------------------------------------+p3Ops+ = do { op1 <- pOperand; csep; op2 <- pOperand; csep; op3 <- pOperand; return (op1, op2, op3) }++++----------------------------------------------------------------------+-- Instruction parsers.+----------------------------------------------------------------------+pAdd = ops3 "add" Add+pAnd = ops3 "and" And+pB = ops1 "b" B+pBeq = ops1 "beq" Beq+pBgt = ops1 "bgt" Bgt+pBic = ops3 "bic" Bic+pBl = ops1 "bl" Bl+pBlt = ops1 "blt" Blt+pBne = ops1 "bne" Bne+pCmp = ops2 "cmp" Cmp+pEor = ops3 "eor" Eor+pLdmea = ops2 "ldmea" Ldmea+pLdr = ops2 "ldr" Ldr+pLdrb = ops2 "ldrb" Ldrb+pMov = ops2 "mov" Mov+pMul = ops3 "mul" Mul+pOrr = ops3 "orr" Orr+pStmea = ops2 "stmea" Stmea+pStr = ops2 "str" Str+pStrb = ops2 "strb" Strb+pSub = ops3 "sub" Sub+pSwi = ops1 "swi" Swi++++----------------------------------------------------------------------+-- Instruction meta-parsers.+----------------------------------------------------------------------+-- instruction with one operand+ops1 name instr+ = do { string name; spaces; op1 <- pOperand; return (Instruction (instr op1)) }++-- instruction with two operands+ops2 name instr+ = do { string name; spaces; (op1, op2) <- p2Ops; return (Instruction (instr op1 op2)) }++-- instruction with three operands+ops3 name instr+ = do { string name; spaces; (op1, op2, op3) <- p3Ops; return (Instruction (instr op1 op2 op3)) }++++----------------------------------------------------------------------+-- Parse an instruction.+----------------------------------------------------------------------+pInstr+ = pAdd +++ pAnd +++ pB +++ pBeq +++ pBgt +++ pBic +++ pBl +++ pBlt+ +++ pBne +++ pCmp +++ pEor +++ pLdmea +++ pLdr +++ pLdrb +++ pMov+ +++ pMul +++ pOrr +++ pStmea +++ pStr +++ pStrb +++ pSub +++ pSwi+ +++ pLabel++++----------------------------------------------------------------------+-- Parse a label.+----------------------------------------------------------------------+pLabel+ = do l <- pLabel'+ char ':'+ return (Symbol l)++pBranchLabel+ = do l <- pLabel'+ return (Lab l)++pLabel'+ = do { xs <- many1 alphanum; return xs }++++----------------------------------------------------------------------+-- Parse a comment.+----------------------------------------------------------------------+pComment+ = do { char ';'; many (sat (\x -> x /= '\n')); return Comment }++++----------------------------------------------------------------------+-- Return a parsed token in the list monad (optionally ``[]'')+----------------------------------------------------------------------+optional p+ = (do x <- p+ return [x])+ +++ return []++++----------------------------------------------------------------------+-- Parse a line of the code segment in a text file.+----------------------------------------------------------------------+pCode+ = (do spaces'+ l <- pLabel+ return l)+ +++ (do spaces'+ i <- pInstr+ return i)+ +++ (do spaces'+ pComment+ return Comment)+ +++ (do char '\n'+ return Newline)++++----------------------------------------------------------------------+-- Parse various constants for the data segment.+----------------------------------------------------------------------+pInt+ = int >>= (return . Int)++pChar+ = do char '\''+ c <- sat (\_ -> True)+ char '\''+ return (Int (fromEnum c))++pString+ = do char '"'+ s <- many (sat (\c -> c /= '"'))+ char '"'+ return (String s)++pArray+ = do string "array"+ spaces'+ n <- int+ spaces'+ c <- pData+ return (Array (fromIntegral n) c)++++----------------------------------------------------------------------+-- Parse a single constant.+----------------------------------------------------------------------+pData+ = (do w <- pIntegral+ return (Word w))+ +++ pInt+ +++ pChar+ +++ pString+ +++ pArray++++----------------------------------------------------------------------+-- Parse a list of constants+----------------------------------------------------------------------+pDataList+ = (do c <- pData+ csep+ cs <- pDataList+ return (c : cs))+ +++ (do c <- pData+ return [c])+++----------------------------------------------------------------------+-- Parse a line of the constant segment in a text file.+----------------------------------------------------------------------+pDataLine+ = do label <- optional (do l <- pBranchLabel+ spaces'+ char '='+ return l)+ _ <- spaces'+ cs <- pDataList+ _ <- optional pComment+ return (Data label cs)++++----------------------------------------------------------------------+-- Parse a single program file element.+----------------------------------------------------------------------+pProgElem+ = do spaces'+ elem <- (pNl+ +++ pOrigin+ +++ pRegInit+ +++ pInstr+ +++ pLabel+ +++ pComment+ +++ pDataLine)+ return elem++++----------------------------------------------------------------------+-- Parse an entire program.+----------------------------------------------------------------------+pProgram+ = do { elems <- many pProgElem; return elems }+++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Program.hs view
@@ -0,0 +1,84 @@+----------------------------------------------------------------------+-- FILE: Program.hs+-- DATE: 03/07/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.Program+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.Instruction+import Arm.Memory+import Arm.RegisterName++++----------------------------------------------------------------------+-- Constant data type. This allows us to represent constant+-- data values in our program (although when the program runs, the+-- values can potentially change, so they are not really constants).+----------------------------------------------------------------------+data Constant+ = Array Word32 Constant+ | Int Int+ | List [Constant]+ | String String+ | Word Word32+ deriving Show++++----------------------------------------------------------------------+-- Get the size of a constant.+----------------------------------------------------------------------+constSize+ :: Constant+ -> Word32++constSize (Array i c) = i * constSize c+constSize (Int _) = 4+constSize (List l) = foldl (+) 0 (map constSize l)+constSize (String s) = fromIntegral ((length s `div` 4 + 1) * 4)+constSize (Word _) = 4++++----------------------------------------------------------------------+-- Program data type. A program has an origin, a list of instructions,+-- and a list of constants.+----------------------------------------------------------------------+data Program+ = Program+ { memorySize :: Address -- required number of bytes+ , origin :: Address -- program origin+ , regInit :: [(RegisterName, Word32)] -- initial register values+ , instructions :: [Instruction] -- list of instructions+ , constants :: [(Address, Constant)] -- list of constants+ }+ deriving Show++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Register.hs view
@@ -0,0 +1,131 @@+----------------------------------------------------------------------+-- FILE: Register.hs+-- DATE: 1/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.Register+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+-- import IOExts+import Data.Bits+import Data.Word+import Data.Array.IO++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.RegisterName++++----------------------------------------------------------------------+-- This is the register set type.+----------------------------------------------------------------------+type Registers+ = IOArray RegisterName Word32++++----------------------------------------------------------------------+-- Create a new set of empty registers.+----------------------------------------------------------------------+emptyRegs+ :: IO Registers++emptyRegs+ = newArray (R0, CPSR) 0++++----------------------------------------------------------------------+-- Get the value in a register.+----------------------------------------------------------------------+getReg+ :: Registers+ -> RegisterName+ -> IO Word32++getReg regs regName+ = readArray regs regName++++----------------------------------------------------------------------+-- Set a register with a new value.+----------------------------------------------------------------------+setReg+ :: Registers+ -> RegisterName+ -> Word32+ -> IO ()++setReg regs regName regVal+ = writeArray regs regName regVal++++----------------------------------------------------------------------+-- CPSR functions.+----------------------------------------------------------------------++showCPSRFlags regs+ = do n <- cpsrGetN regs+ z <- cpsrGetZ regs+ c <- cpsrGetC regs+ v <- cpsrGetV regs+ putStr ("N=" ++ show n ++ " Z=" ++ show z ++ " C=" ++ show c ++ " V=" ++ show v)++cpsrGetN = cpsrGet 31+cpsrSetN = cpsrSet 31++cpsrGetZ = cpsrGet 30+cpsrSetZ = cpsrSet 30++cpsrGetC = cpsrGet 29+cpsrSetC = cpsrSet 29++cpsrGetV = cpsrGet 28+cpsrSetV = cpsrSet 28++cpsrGet+ :: Int+ -> Registers+ -> IO Word32++cpsrGet bit regs+ = do cpsr <- getReg regs CPSR+ if cpsr `testBit` bit+ then return 1+ else return 0++cpsrSet+ :: Int+ -> Registers+ -> IO ()++cpsrSet bit regs+ = do cpsr <- getReg regs CPSR+ let cpsr' = cpsr `setBit` bit+ setReg regs CPSR cpsr'++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/RegisterName.hs view
@@ -0,0 +1,148 @@+----------------------------------------------------------------------+-- FILE: RegisterName.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.RegisterName+ ( RegisterName(..)+ , nthReg+ )+where+++import Data.Word+import Data.Array+++----------------------------------------------------------------------+-- Data type for register names.+----------------------------------------------------------------------+data RegisterName+ = R0+ | R1+ | R2+ | R3+ | R4+ | R5+ | R6+ | R7+ | R8+ | R9+ | R10+ | R11+ | R12+ | R13+ | R14+ | R15+ | CPSR+ deriving (Enum, Eq, Ix, Ord, Read)++instance Show RegisterName where+ show r = show' r++++----------------------------------------------------------------------+----------------------------------------------------------------------+nthReg :: Word32 -> RegisterName+nthReg 0 = R0+nthReg 1 = R1+nthReg 2 = R2+nthReg 3 = R3+nthReg 4 = R4+nthReg 5 = R5+nthReg 6 = R6+nthReg 7 = R7+nthReg 8 = R8+nthReg 9 = R9+nthReg 10 = R10+nthReg 11 = R11+nthReg 12 = R12+nthReg 13 = R13+nthReg 14 = R14+nthReg 15 = R15++++----------------------------------------------------------------------+-- Convert a register name to a string.+----------------------------------------------------------------------+show' R0 = "r0"+show' R1 = "r1"+show' R2 = "r2"+show' R3 = "r3"+show' R4 = "r4"+show' R5 = "r5"+show' R6 = "r6"+show' R7 = "r7"+show' R8 = "r8"+show' R9 = "r9"+show' R10 = "r10"+show' R11 = "r11"+show' R12 = "r12"+show' R13 = "r13"+show' R14 = "r14"+show' R15 = "r15"+show' CPSR = "cpsr"++++----------------------------------------------------------------------+-- Convert a string to a register name.+----------------------------------------------------------------------+read' "r0" = R0+read' "r1" = R1+read' "r2" = R2+read' "r3" = R3+read' "r4" = R4+read' "r5" = R5+read' "r6" = R6+read' "r7" = R7+read' "r8" = R8+read' "r9" = R9+read' "r10" = R10+read' "r11" = R11+read' "r12" = R12+read' "r13" = R13+read' "r14" = R14+read' "r15" = R15+read' "cpsr" = CPSR++++----------------------------------------------------------------------+-- Convert register name to index (will be used to index register array).+----------------------------------------------------------------------+{-+index' R0 = 0+index' R1 = 1+index' R2 = 2+index' R3 = 3+index' R4 = 4+index' R5 = 5+index' R6 = 6+index' R7 = 7+index' R8 = 8+index' R9 = 9+index' R10 = 10+index' R11 = 11+index' R12 = 12+index' R13 = 13+index' R14 = 14+index' R15 = 15+index' CPSR = 16+-}+++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
+ Arm/Swi.hs view
@@ -0,0 +1,171 @@+----------------------------------------------------------------------+-- FILE: Swi.hs+-- DESCRIPTION: +-- DATE: 03/22/2001+-- PROJECT: +-- LANGUAGE PLATFORM: +-- OS PLATFORM: RedHat Linux 6.2+-- AUTHOR: Jeffrey A. Meunier+-- EMAIL: jeffm@cse.uconn.edu+-- MAINTAINER: Alex Mason+-- EMAIL: axman6@gmail.com+----------------------------------------------------------------------++++module Arm.Swi+where++++----------------------------------------------------------------------+-- Standard libraries.+----------------------------------------------------------------------+import Data.Bits+import Data.Char+import Data.IORef+import Data.Word++++----------------------------------------------------------------------+-- Local libraries.+----------------------------------------------------------------------+import Arm.CPU+import Arm.Loader+import Arm.Memory+import Arm.Register+import Arm.RegisterName++++line = "----------------------------------------"++----------------------------------------------------------------------+-- Software interrupt services.+----------------------------------------------------------------------+swi+ :: CPU+ -> Word32+ -> Bool+ -> IO ()++-- display character in R0+swi cpu 0 debug+ = do let regs = registers cpu+ r0 <- getReg regs R0+ let c = fromIntegral r0+ if debug+ then do putStrLn line+ putStrLn ("CHR: [" ++ [chr c] ++ "]")+ putStrLn line+ else putStr [chr c]++-- display integer in R0+swi cpu 1 debug+ = do let regs = registers cpu+ r0 <- getReg regs R0+ let r0i = fromIntegral r0+ if debug+ then do putStrLn line+ putStrLn ("INT: [" ++ show r0i ++ "]")+ putStrLn line+ else putStr (show r0i)++-- display string starting in location contained in R0+swi cpu 2 debug+ = do let regs = registers cpu+ r0 <- getReg regs R0+ str <- fetchString (memory cpu) r0+ if debug+ then do putStrLn line+ putStrLn ("STR: [" ++ str ++ "]")+ putStrLn line+ else putStr str++-- read a number from the keyboard, place in R0+swi cpu 3 debug+ = do if debug+ then do putStrLn line+ putStr "INPUT INT: "+ else return ()+ i <- readLn+ if debug+ then putStrLn line+ else return ()+ let w = fromIntegral i+ let regs = registers cpu+ setReg regs R0 w++-- read a string from the keyboard, place in buffer that+-- r0 points to, with maximum length in r1 (this service+-- will not store more than r1 - 1 characters in the+-- buffer, the string will automatically be null-terminated)+swi cpu 4 debug+ = do if debug+ then do putStrLn line+ putStr "INPUT STRING: "+ else return ()+ s <- getLine+ if debug+ then putStrLn s+ else return ()+ let regs = registers cpu+ addr <- getReg regs R0+ r1 <- getReg regs R1+ let len = fromIntegral r1+ let s' = take (len - 1) s+ let mem = memory cpu+ loadString mem addr (s' ++ ['\NUL'])++-- display newline+swi cpu 10 debug+ = do if debug+ then do putStrLn line+ putStrLn "NEWLINE"+ putStrLn line+ else putStrLn ""++-- exit+swi cpu 11 debug+ = do if debug+ then do putStrLn line+ putStrLn "NORMAL EXIT"+ putStrLn line+ else return ()+ let runFlag = running cpu+ writeIORef runFlag False++swi cpu a debug = error $ "unknown SWI: " ++ show a ++ " " ++ show debug++----------------------------------------------------------------------+-- Fetch a string from memory.+----------------------------------------------------------------------+fetchString+ :: Memory+ -> Address+ -> IO String++fetchString mem addr+ = do word <- readMem mem addr+ let c4 = fromIntegral ((word .&. 0xFF000000) `shift` (-24))+ let c3 = fromIntegral ((word .&. 0xFF0000) `shift` (-16))+ let c2 = fromIntegral ((word .&. 0xFF00) `shift` (-8))+ let c1 = fromIntegral (word .&. 0xFF)+ if c1 == 0+ then return ""+ else if c2 == 0+ then return [chr c1]+ else if c3 == 0+ then return [chr c1, chr c2]+ else if c4 == 0+ then return [chr c1, chr c2, chr c3]+ else do s <- fetchString mem (addr + 4)+ return ([chr c1, chr c2, chr c3, chr c4] ++ s)+++++----------------------------------------------------------------------+-- eof+----------------------------------------------------------------------
HARM.cabal view
@@ -1,5 +1,5 @@ Name: HARM-Version: 0.1.1+Version: 0.1.2 Cabal-Version: >= 1.2 License: OtherLicense License-File: LICENSE.txt@@ -19,3 +19,8 @@ Executable dbgarm Main-Is: dbgarm.hs Build-Depends: base, array++Library+ Build-Depends: base, array+ Exposed-modules:+ Arm.Arm, Arm.Assembler, Arm.BinaryNumber, Arm.CPU, Arm.Debugger, Arm.Decoder, Arm.Encoder, Arm.ExecutionUnit, Arm.Format, Arm.Instruction, Arm.Loader, Arm.Memory, Arm.Operand, Arm.ParseLib, Arm.Parser, Arm.Program, Arm.Register, Arm.RegisterName, Arm.Swi
dbgarm.hs view
@@ -1,7 +1,7 @@ module Main where import System.Environment import System.IO-import Arm+import Arm.Arm main = do
runarm.hs view
@@ -1,5 +1,5 @@ module Main where-import Arm+import Arm.Arm import System.Environment import System.IO