---------------------------------------------------------------------- -- 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 ----------------------------------------------------------------------