diff --git a/Arm/Arm.hs b/Arm/Arm.hs new file mode 100644 --- /dev/null +++ b/Arm/Arm.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Assembler.hs b/Arm/Assembler.hs new file mode 100644 --- /dev/null +++ b/Arm/Assembler.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/BinaryNumber.hs b/Arm/BinaryNumber.hs new file mode 100644 --- /dev/null +++ b/Arm/BinaryNumber.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/CPU.hs b/Arm/CPU.hs new file mode 100644 --- /dev/null +++ b/Arm/CPU.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Debugger.hs b/Arm/Debugger.hs new file mode 100644 --- /dev/null +++ b/Arm/Debugger.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Decoder.hs b/Arm/Decoder.hs new file mode 100644 --- /dev/null +++ b/Arm/Decoder.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Encoder.hs b/Arm/Encoder.hs new file mode 100644 --- /dev/null +++ b/Arm/Encoder.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/ExecutionUnit.hs b/Arm/ExecutionUnit.hs new file mode 100644 --- /dev/null +++ b/Arm/ExecutionUnit.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Format.hs b/Arm/Format.hs new file mode 100644 --- /dev/null +++ b/Arm/Format.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Instruction.hs b/Arm/Instruction.hs new file mode 100644 --- /dev/null +++ b/Arm/Instruction.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Loader.hs b/Arm/Loader.hs new file mode 100644 --- /dev/null +++ b/Arm/Loader.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Memory.hs b/Arm/Memory.hs new file mode 100644 --- /dev/null +++ b/Arm/Memory.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Operand.hs b/Arm/Operand.hs new file mode 100644 --- /dev/null +++ b/Arm/Operand.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/ParseLib.hs b/Arm/ParseLib.hs new file mode 100644 --- /dev/null +++ b/Arm/ParseLib.hs @@ -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}) + +------------------------------------------------------------------------------ diff --git a/Arm/Parser.hs b/Arm/Parser.hs new file mode 100644 --- /dev/null +++ b/Arm/Parser.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Program.hs b/Arm/Program.hs new file mode 100644 --- /dev/null +++ b/Arm/Program.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Register.hs b/Arm/Register.hs new file mode 100644 --- /dev/null +++ b/Arm/Register.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/RegisterName.hs b/Arm/RegisterName.hs new file mode 100644 --- /dev/null +++ b/Arm/RegisterName.hs @@ -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 +---------------------------------------------------------------------- diff --git a/Arm/Swi.hs b/Arm/Swi.hs new file mode 100644 --- /dev/null +++ b/Arm/Swi.hs @@ -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 +---------------------------------------------------------------------- diff --git a/HARM.cabal b/HARM.cabal --- a/HARM.cabal +++ b/HARM.cabal @@ -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 diff --git a/dbgarm.hs b/dbgarm.hs --- a/dbgarm.hs +++ b/dbgarm.hs @@ -1,7 +1,7 @@ module Main where import System.Environment import System.IO -import Arm +import Arm.Arm main = do diff --git a/runarm.hs b/runarm.hs --- a/runarm.hs +++ b/runarm.hs @@ -1,5 +1,5 @@ module Main where -import Arm +import Arm.Arm import System.Environment import System.IO