summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoakim Sindholt <opensource@zhasha.com>2012-02-04 12:00:52 +0100
committerJoakim Sindholt <opensource@zhasha.com>2012-02-04 12:27:46 +0100
commite9e49ca5485ee53e85702854012bf817c0a80807 (patch)
tree3902502ff1d234aee57b886b1f065b7c8be15b00
Initial commit
-rw-r--r--.gitignore4
-rw-r--r--Assembler.hs195
-rw-r--r--Compiler.hs87
-rw-r--r--Error.hs47
-rw-r--r--Lexer.hs166
-rw-r--r--Makefile14
-rw-r--r--PWFASM.hs48
-rw-r--r--README68
-rw-r--r--test.s17
9 files changed, 646 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..3fce068
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+pwfasm
+*.o
+*.hi
+*~
diff --git a/Assembler.hs b/Assembler.hs
new file mode 100644
index 0000000..0b58482
--- /dev/null
+++ b/Assembler.hs
@@ -0,0 +1,195 @@
+module Assembler
+ ( Argument
+ , Instruction
+ , processInstructions
+ , assemble
+ ) where
+
+import Error
+import Data.Char
+import Data.Bits
+import GHC.Word
+import Numeric
+import qualified Lexer as L
+
+data Argument = Register Integer
+ | Immediate Integer
+ deriving (Show)
+
+data Instruction = MOVA Argument Argument
+ | INC Argument Argument
+ | ADD Argument Argument Argument
+ | SUB Argument Argument Argument
+ | DEC Argument Argument
+ | AND Argument Argument Argument
+ | OR Argument Argument Argument
+ | XOR Argument Argument Argument
+ | NOT Argument Argument
+ | MOVB Argument Argument
+ | LD Argument Argument
+ | ST Argument Argument
+ | LDI Argument Argument
+ | ADI Argument Argument Argument
+ | BRZ Argument Argument
+ | BRN Argument Argument
+ | JMP Argument
+ | LRI Argument Argument
+ | SRM Argument Argument Argument
+ | SRL Argument Argument Argument
+ | DB Argument
+ deriving (Show)
+
+-- Resolves lables into immediates and their corresponding segments. The rest
+-- is simple conversion from lexemes to IR
+resolve :: Integer -> [L.Lexeme] -> [(Argument, Segment)]
+resolve _ [] = []
+resolve line ((L.Label seg n):xs) = (Immediate $ n-line, seg) : resolve line xs
+resolve line ((L.Immediate seg n):xs) = (Immediate n, seg) : resolve line xs
+resolve line ((L.Register seg n):xs) = (Register n, seg) : resolve line xs
+
+data Requirement = ImmRange Integer Integer
+ | RegRoof Integer
+
+-- Imposes requirements on argument lists
+require :: Segment -> [(Argument, Segment)] -> [Requirement] -> Either Error [Argument]
+require _ [] [] = return []
+require _ ((a, seg):_) [] = Left $ Error [ErrorLine seg "Too many arguments supplied to instruction."]
+require iseg [] (r:rs) = Left $ Error [ErrorLine iseg "Too few arguments supplied to instruction."]
+require iseg ((a, seg):as) ((ImmRange l h):rs) = do
+ rest <- require iseg as rs
+ case a of
+ Immediate i -> if i >= l && i <= h
+ then return $ a : rest
+ else Left $ Error [ErrorLine seg $ "Immediate value is out of range " ++ range ++
+ ". If the offending value is a label, the " ++
+ "address is too far away from the branch"]
+ where range = '[' : show l ++ ';' : show h ++ "]"
+ _ -> Left $ Error [ErrorLine seg "Expected immediate or label."]
+require iseg ((a, seg):as) ((RegRoof h):rs) = do
+ rest <- require iseg as rs
+ case a of
+ Register i -> if i >= 0 && i <= h
+ then return $ a : rest
+ else Left $ Error [ErrorLine seg $ "Register number is out of range " ++ range]
+ where range = "[0;" ++ show h ++ "]"
+ _ -> Left $ Error [ErrorLine seg "Expected register."]
+
+-- Declaration of various requirements for the different instructions
+reg = RegRoof 7
+imm = ImmRange 0 7
+brch = ImmRange (-32) 31
+req :: String -> [Requirement]
+req "MOVA" = [reg, reg]
+req "INC" = [reg, reg]
+req "ADD" = [reg, reg, reg]
+req "SUB" = [reg, reg, reg]
+req "DEC" = [reg, reg]
+req "AND" = [reg, reg, reg]
+req "OR" = [reg, reg, reg]
+req "XOR" = [reg, reg, reg]
+req "NOT" = [reg, reg]
+req "MOVB" = [reg, reg]
+req "LD" = [reg, reg]
+req "ST" = [reg, reg]
+req "LDI" = [reg, imm]
+req "ADI" = [reg, reg, imm]
+req "BRZ" = [reg, brch]
+req "BRN" = [reg, brch]
+req "JMP" = [reg]
+req "LRI" = [reg, reg]
+req "SRM" = [reg, reg, imm]
+req "SRL" = [reg, reg, imm]
+req "DB" = [ImmRange (-128) 255]
+req _ = []
+
+-- TODO: check if there's a better way to do this
+-- Takes a text instruction and converts it to IR
+process :: String -> [Argument] -> Instruction
+process "MOVA" (a:b:[]) = MOVA a b
+process "INC" (a:b:[]) = INC a b
+process "ADD" (a:b:c:[]) = ADD a b c
+process "SUB" (a:b:c:[]) = SUB a b c
+process "DEC" (a:b:[]) = DEC a b
+process "AND" (a:b:c:[]) = AND a b c
+process "OR" (a:b:c:[]) = OR a b c
+process "XOR" (a:b:c:[]) = XOR a b c
+process "NOT" (a:b:[]) = NOT a b
+process "MOVB" (a:b:[]) = MOVB a b
+process "LD" (a:b:[]) = LD a b
+process "ST" (a:b:[]) = ST a b
+process "LDI" (a:b:[]) = LDI a b
+process "ADI" (a:b:c:[]) = ADI a b c
+process "BRZ" (a:b:[]) = BRZ a b
+process "BRN" (a:b:[]) = BRN a b
+process "JMP" (a:[]) = JMP a
+process "LRI" (a:b:[]) = LRI a b
+process "SRM" (a:b:c:[]) = SRM a b c
+process "SRL" (a:b:c:[]) = SRL a b c
+process "DB" (a:[]) = DB a
+
+-- Create an IR instruction from a text instruction
+mkInstruction :: Integer -> L.Lexeme -> [L.Lexeme] -> Either Error Instruction
+mkInstruction l (L.Instruction seg) as =
+ if null reqs
+ then Left $ Error [ErrorLine seg "Unknown instruction."]
+ else do
+ args <- require seg (resolve l as) reqs
+ return $ process inst args
+ where inst = map toUpper $ getSegment seg
+ reqs = req inst
+
+-- Convert a list of text instructions to IR
+processInstructions :: [(L.Lexeme, [L.Lexeme])] -> Either Error [Instruction]
+processInstructions is = mapM (\((i, as), l) -> mkInstruction l i as) (zip is [0..])
+
+-- Helper for bit mangling regular instructions
+mkWord :: Word16 -> Word16 -> Word16 -> Word16 -> Word16
+mkWord inst dr sa sb = ((inst .&. 0x7F) `shift` 9)
+ .|. ((dr .&. 0x7) `shift` 6)
+ .|. ((sa .&. 0x7) `shift` 3)
+ .|. ((sb .&. 0x7))
+
+-- Helper for bit mangling instructions using the sign extender
+mkWordSE :: Word16 -> Word16 -> Word16 -> Word16
+mkWordSE inst dr sa = ((inst .&. 0x7F) `shift` 9)
+ .|. ((dr .&. 0x38) `shift` 6)
+ .|. ((sa .&. 0x7) `shift` 3)
+ .|. ((dr .&. 0x7))
+
+-- Convert argument to Word16
+argToWord :: Argument -> Word16
+argToWord (Register i) = fromIntegral i
+argToWord (Immediate i) = fromIntegral i
+
+-- Argument placement because of lack of consistency
+asm :: Instruction -> Word16
+asm (MOVA dr sa) = mkWord 0x00 (argToWord dr) (argToWord sa) 0
+asm (INC dr sa) = mkWord 0x01 (argToWord dr) (argToWord sa) 0
+asm (ADD dr sa sb) = mkWord 0x02 (argToWord dr) (argToWord sa) (argToWord sb)
+asm (SUB dr sa sb) = mkWord 0x05 (argToWord dr) (argToWord sa) (argToWord sb)
+asm (DEC dr sa) = mkWord 0x06 (argToWord dr) (argToWord sa) 0
+asm (AND dr sa sb) = mkWord 0x08 (argToWord dr) (argToWord sa) (argToWord sb)
+asm (OR dr sa sb) = mkWord 0x09 (argToWord dr) (argToWord sa) (argToWord sb)
+asm (XOR dr sa sb) = mkWord 0x0A (argToWord dr) (argToWord sa) (argToWord sb)
+asm (NOT dr sa) = mkWord 0x0B (argToWord dr) (argToWord sa) 0
+asm (MOVB dr sb) = mkWord 0x0C (argToWord dr) 0 (argToWord sb)
+asm (LD dr sa) = mkWord 0x10 (argToWord dr) (argToWord sa) 0
+asm (ST sa sb) = mkWord 0x20 0 (argToWord sa) (argToWord sb)
+asm (LDI dr sb) = mkWord 0x4C (argToWord dr) 0 (argToWord sb)
+asm (ADI dr sa sb) = mkWord 0x42 (argToWord dr) (argToWord sa) (argToWord sb)
+asm (BRZ dr sa) = mkWordSE 0x60 (argToWord dr) (argToWord sa)
+asm (BRN dr sa) = mkWordSE 0x61 (argToWord dr) (argToWord sa)
+asm (JMP sa) = mkWord 0x70 0 (argToWord sa) 0
+asm (LRI dr sa) = mkWord 0x11 (argToWord dr) (argToWord sa) 0
+asm (SRM dr sa sb) = mkWord 0x0D (argToWord dr) (argToWord sa) (argToWord sb)
+asm (SRL dr sa sb) = mkWord 0x0E (argToWord dr) (argToWord sa) (argToWord sb)
+asm (DB imm) = (argToWord imm) .&. 0xFF
+
+-- Zero pad the numbers to 4c boundary
+zeroPad :: String -> String
+zeroPad xs = replicate (if n < 4 then n else 0) '0' ++ xs
+ where n = (4 - (length xs `rem` 4))
+
+-- Assemble IR into string
+assemble :: [Instruction] -> String
+assemble is = foldl (\x y -> zeroPad $ showHex (asm y) x) "" is
diff --git a/Compiler.hs b/Compiler.hs
new file mode 100644
index 0000000..6eb8be5
--- /dev/null
+++ b/Compiler.hs
@@ -0,0 +1,87 @@
+module Compiler
+ ( compile
+ ) where
+
+import Lexer
+import Error
+import Assembler
+import Text.Printf
+import qualified Data.Map as M
+import qualified Control.Monad.Error as E
+
+-- Extract a list of label declarations from lexemes and find their absolute
+-- position
+getLabels :: [([Lexeme], Maybe Lexeme, [Lexeme])] -> [Lexeme]
+getLabels xs = concat $ map (\(ls, _, _, n) -> map (g n) ls) numbered
+ where numbered = scanl f ([], Nothing, [], 0) xs
+ f (_, pi, _, n) (ls, i, as) = (ls, i, as, n+(inc pi))
+ inc pi = maybe 0 (\_ -> 1) pi
+ g n (Label seg _) = Label seg n
+
+-- Ensure uniqueness of a label lexeme list
+getUniqueLabels :: [Lexeme] -> Either Error (M.Map String Lexeme)
+getUniqueLabels [] = Right M.empty
+getUniqueLabels ((Label seg n):xs) = do
+ rest <- getUniqueLabels xs
+ case M.lookup key rest of
+ Nothing -> return $ M.insert key (Label seg n) rest
+ Just (Label seg' n') -> Left $ Error [ErrorLine seg' "Multiple declarations of label:"
+ ,ErrorLine seg "Previous declaration was here:"]
+ where key = getSegment seg
+
+-- Extract instructions from lexemes
+getInstructions :: [([Lexeme], Maybe Lexeme, [Lexeme])] -> [(Lexeme, [Lexeme])]
+getInstructions [] = []
+getInstructions ((_, Just i, as):xs) = (i, as) : getInstructions xs
+getInstructions ((_, Nothing, _):xs) = getInstructions xs
+
+-- Resolve labels used in arguments to their absolute position
+resolveLabels :: M.Map String Lexeme -> [Lexeme] -> Either Error [Lexeme]
+resolveLabels _ [] = return []
+resolveLabels m ((Label seg _):xs) = do
+ rest <- resolveLabels m xs
+ case M.lookup key m of
+ Nothing -> Left $ Error [ErrorLine seg "Undeclared label."]
+ Just (Label _ n') -> return $ (Label seg n') : rest
+ where key = getSegment seg
+resolveLabels m (x:xs) = do
+ rest <- resolveLabels m xs
+ return $ x : rest
+
+-- Lex a list of files and accompanying data
+lexFiles :: [(FilePath, String)] -> Either Error [([Lexeme], Maybe Lexeme, [Lexeme])]
+lexFiles xs = mapM (\((f, l), o) -> lexLine f o l) (zip expanded [1..])
+ where expanded = concat $ map (\(f, l) -> zip (repeat f) (lines l)) xs
+
+-- Split a list into n-sized sublists
+chunk :: Int -> [a] -> [[a]]
+chunk _ [] = []
+chunk n xs = y1 : chunk n y2
+ where (y1, y2) = splitAt n xs
+
+-- Format assembled string into code that's easily pasted into RAM block
+formatRAM :: String -> Either Error [String]
+formatRAM s = if (length chunks) <= 16
+ then return $ map f ss
+ else Left $ Error [ErrorLine (Segment "*" 0 0 0 "Maximum amount of instructions can't exceed RAM size.") "Code is too long."]
+ where chunks = map reverse $ chunk 64 (reverse s)
+ lls = zip (chunks ++ repeat "") ([0..15] :: [Int])
+ ss = map (\(h, l) -> ((if length h < 64
+ then replicate (64 - length h) '0'
+ else "") ++ h, l)) lls
+ delim l = if l < 15 then ',' else ')'
+ f (h, l) = printf "INIT_%02X => \"" l ++ h ++ '\"':delim l:[]
+
+-- Compile a list of files and accompanying data to a string list
+compile :: Bool -> [(FilePath, String)] -> Either Error [String]
+compile ppo [] = return []
+compile ppo xs = do
+ lexed <- lexFiles xs
+ ls <- getUniqueLabels $ getLabels lexed
+ is <- mapM (\(i, as) -> do
+ as' <- resolveLabels ls as
+ return (i, as')) (getInstructions lexed)
+ ir <- processInstructions is
+ if ppo
+ then return $ map show ir
+ else formatRAM $ assemble ir
diff --git a/Error.hs b/Error.hs
new file mode 100644
index 0000000..8ffff44
--- /dev/null
+++ b/Error.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
+
+module Error
+ ( Segment (Segment)
+ , ErrorLine (ErrorLine)
+ , Error (Error)
+ , getSegment
+ ) where
+
+import Data.Char
+
+data Segment = Segment { file :: FilePath
+ , line :: Integer
+ , offset :: Integer
+ , len :: Integer
+ , sline :: String }
+ deriving (Show)
+
+instance Eq Segment where
+ a == b = (getSegment a) == (getSegment b)
+ a /= b = (getSegment a) /= (getSegment b)
+
+-- Prints a segment with underline
+showSegment :: Segment -> String
+showSegment Segment {..} = unlines [sline, ws ++ underline]
+ where ws = dupWhitespace offset sline
+ underline = replicate (fromIntegral len) '^'
+
+-- Extracts the value of a segment from the string stored in the segment
+getSegment :: Segment -> String
+getSegment Segment {..} = take (fromIntegral len) $ drop (fromIntegral offset) sline
+
+data ErrorLine = ErrorLine Segment String
+
+data Error = Error [ErrorLine]
+
+instance Show ErrorLine where
+ show (ErrorLine seg desc) = unlines $ (pp ++ desc) : (lines $ showSegment seg)
+ where pp = file seg ++ (':' : (show (line seg) ++ ": "))
+
+instance Show Error where
+ show (Error es) = concat $ map show es
+
+-- Duplicates whitespace so underlines fit under the string it underlines
+dupWhitespace :: Integer -> String -> String
+dupWhitespace 0 _ = []
+dupWhitespace n (x:xs) = (if isSpace x then x else ' ') : dupWhitespace (n-1) xs
diff --git a/Lexer.hs b/Lexer.hs
new file mode 100644
index 0000000..d690080
--- /dev/null
+++ b/Lexer.hs
@@ -0,0 +1,166 @@
+module Lexer
+ ( Lexeme (Label, Instruction, Immediate, Register)
+ , lexLine
+ ) where
+
+import Error
+import Data.Char
+import qualified Control.Monad.Error as E
+
+data Lexeme = Label Segment Integer
+ | Instruction Segment
+ | Immediate Segment Integer
+ | Register Segment Integer
+ deriving (Show)
+
+data Token = Name String Integer Integer
+ | Separator Char Integer
+ deriving (Show, Eq)
+
+data ParserState = BeginState | ArgumentState deriving (Eq)
+
+sepArgument = ','
+sepLabel = ':'
+separators = [sepArgument, sepLabel]
+
+sepComment = ';'
+
+removeComment :: String -> String
+removeComment [] = []
+removeComment (x:xs)
+ | x == sepComment = []
+ | otherwise = x:removeComment xs
+
+-- Get next token in a string
+getToken :: String -> Integer -> (Token, String)
+getToken [] p = (Name [] p' p', []) where p' = p-1
+getToken (x:xs) p
+ | x `elem` separators = (Separator x p, xs)
+ | isSpace x = (Separator ' ' p, xs)
+ | otherwise = case getToken xs (p+1) of
+ (Name x' _ p', xs') -> (Name (x:x') p p', xs')
+ (Separator _ p', xs') -> (Name [x] p (p'-1), xs)
+
+-- Find all tokens in a string
+tokenize :: String -> Integer -> [Token]
+tokenize [] _ = []
+tokenize xs pos = let (t, r) = getToken xs pos
+ in t:(tokenize r $ case t of
+ (Name _ _ e) -> e+1
+ (Separator _ p) -> p+1)
+
+-- Remove intermittent whitespace separators in token list
+sanitize :: [Token] -> [Token]
+sanitize [] = []
+sanitize (Separator x p:Separator ' ' _:ys) = sanitize (Separator x p:ys)
+sanitize (Separator ' ' _:Separator y p:ys) = sanitize (Separator y p:ys)
+sanitize (x:xs) = x:sanitize xs
+
+isSpaceSeparator :: Token -> Bool
+isSpaceSeparator (Separator ' ' _) = True
+isSpaceSeparator _ = False
+
+-- Trim whitespace separators from start/end of token list
+trimFront :: [Token] -> [Token]
+trimFront [] = []
+trimFront (x:xs)
+ | isSpaceSeparator x = xs
+ | otherwise = x:xs
+
+trimBack :: [Token] -> [Token]
+trimBack [] = []
+trimBack (x:[])
+ | isSpaceSeparator x = []
+ | otherwise = [x]
+trimBack (x:xs) = x:trimBack xs
+
+trim :: [Token] -> [Token]
+trim = trimBack . trimFront
+
+-- Number parsing (0x = hex, 0b = bin, 0 = oct, everything else = dec)
+numberBase :: String -> (Integer, String)
+numberBase ('0':x:xs)
+ | toLower x == 'b' = (2, xs)
+ | toLower x == 'x' = (16, xs)
+ | otherwise = (8, x:xs)
+numberBase xs = (10, xs)
+
+isNumber'' :: Integer -> String -> Bool
+isNumber'' _ [] = False
+isNumber'' b (x:[])
+ | isHexDigit x = (toInteger $ digitToInt x) < b
+ | otherwise = False
+isNumber'' b (x:y:zs)
+ | isHexDigit x = ((toInteger $ digitToInt x) < b) && (isNumber'' b (y:zs))
+ | otherwise = False
+
+isNumber' :: String -> Bool
+isNumber' ('-':xs) = isNumber'' b s where (b, s) = numberBase xs
+isNumber' xs = isNumber'' b s where (b, s) = numberBase xs
+
+parseNumber :: String -> Integer
+parseNumber ('-':xs) = -(parseNumber xs)
+parseNumber xs = foldl (\n k -> n * b + (toInteger $ digitToInt k)) 0 s
+ where (b, s) = numberBase xs
+
+-- Register parsing
+isRegister :: String -> Bool
+isRegister [] = False
+isRegister (x:xs) = if toLower x == 'r' then isNumber'' 10 xs else False
+
+parseRegister :: String -> Integer
+parseRegister (x:xs) = parseNumber xs
+
+-- Convert token to (incomplete) segment
+tokToSeg :: FilePath -> Integer -> String -> Token -> Segment
+tokToSeg f o l (Name _ b e) = Segment f o b (e-b+1) l
+tokToSeg f o l (Separator _ p) = Segment f o p 1 l
+
+-- Convert argument to lexeme
+parseArgument :: FilePath -> Integer -> String -> Token -> Lexeme
+parseArgument f o l (Name xs b e)
+ | isNumber' xs = Immediate seg (parseNumber xs)
+ | isRegister xs = Register seg (parseRegister xs)
+ | otherwise = Label seg 0
+ where seg = tokToSeg f o l (Name xs b e)
+
+-- XXX: Remove this state shit
+parseTokens :: FilePath -> Integer -> String -> ParserState -> [Token] -> Either Error [Lexeme]
+parseTokens _ _ _ _ [] = return []
+parseTokens f o l _ (Separator sep p:xs) = Left $ Error [ErrorLine segp "Expected name before separator."]
+ where segp = tokToSeg f o l (Separator sep p)
+parseTokens f o l BeginState (Name str b e:[]) = Right [Instruction seg]
+ where seg = tokToSeg f o l (Name str b e)
+parseTokens f o l BeginState (Name str b e:Separator sep p:xs)
+ | sep == sepLabel = do ls <- parseTokens f o l BeginState xs
+ return (Label seg 0 : ls)
+ | sep == ' ' =
+ if null xs
+ then Left $ Error [ErrorLine segp "Expected argument list after separator."]
+ else do ls <- parseTokens f o l ArgumentState xs
+ return (Instruction seg : ls)
+ | otherwise = Left $ Error [ErrorLine seg "Expected label or instruction."]
+ where seg = tokToSeg f o l (Name str b e)
+ segp = tokToSeg f o l (Separator sep p)
+parseTokens f o l ArgumentState (Name str b e:[]) = Right [parseArgument f o l (Name str b e)]
+parseTokens f o l ArgumentState (Name str b e:Separator sep p:xs)
+ | sep == sepArgument =
+ if null xs
+ then Left $ Error [ErrorLine segp "Illegal separator at end of argument list."]
+ else do ls <- parseTokens f o l ArgumentState xs
+ return (parseArgument f o l (Name str b e) : ls)
+ | otherwise = Left $ Error [ErrorLine seg "Expected instruction argument."]
+ where seg = tokToSeg f o l (Name str b e)
+ segp = tokToSeg f o l (Separator sep p)
+
+-- Split Lexeme array into (labels, instruction, arguments)
+split :: Lexeme -> ([Lexeme], Maybe Lexeme, [Lexeme]) -> ([Lexeme], Maybe Lexeme, [Lexeme])
+split (Instruction s) (ls, Nothing, []) = ([], Just (Instruction s), ls)
+split l (ls, Nothing, []) = (l:ls, Nothing, [])
+split l (ls, Just i, as) = (l:ls, Just i, as)
+
+lexLine :: FilePath -> Integer -> String -> Either Error ([Lexeme], Maybe Lexeme, [Lexeme])
+lexLine file offset line = do
+ ls <- parseTokens file offset line BeginState tokens
+ return (foldr split ([], Nothing, []) ls)
+ where tokens = trim $ sanitize $ tokenize (removeComment line) 0
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..95a0779
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,14 @@
+HASK=ghc
+HFLAGS=
+PROGRAM=pwfasm
+
+SOURCES=Assembler.hs Compiler.hs Error.hs Lexer.hs PWFASM.hs
+OBJ=$(SOURCES:.hs=.hi) $(SOURCES:.hs=.o)
+
+$(PROGRAM): $(SOURCES)
+ $(HASK) $(HFLAGS) -o $(PROGRAM) $(SOURCES)
+ strip --strip-unneeded $(PROGRAM)
+
+clean:
+ rm $(OBJ)
+ rm $(PROGRAM)
diff --git a/PWFASM.hs b/PWFASM.hs
new file mode 100644
index 0000000..f3a08d4
--- /dev/null
+++ b/PWFASM.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
+
+module Main where
+import System.Console.CmdArgs
+import System.IO
+import Compiler
+
+data PWFASM = PWFASM { output :: Maybe FilePath
+ , preprocess_only :: Bool
+ , files :: [FilePath]
+ } deriving (Show, Data, Typeable)
+
+pwfasm = PWFASM { output = def &= name "o" &= typFile &= help "Output to a file"
+ , preprocess_only = def &= name "p" &= help "Show only the preprocessed output and exit"
+ , files = def &= args &= typ "FILES"
+ } &=
+ help "Compile Project Work F assembly files" &=
+ summary "PWFASM v0.0.1, (c) Joakim Sindholt" &=
+ details ["PWFASM will assemble code written for DTU course 30090"
+ ,""
+ ,"To compile file.asm and output to stdout type:"
+ ," pwfasm file.asm"]
+
+openOutput :: Maybe FilePath -> IO Handle
+openOutput Nothing = return stdout
+openOutput (Just f) = openFile f WriteMode
+
+closeOutput :: Handle -> IO ()
+closeOutput h
+ | h == stdout = return ()
+ | otherwise = hClose h
+
+writeOutput :: Handle -> [String] -> IO ()
+writeOutput h ls = do
+ hPutStr h (unlines ls)
+
+readInput :: [FilePath] -> IO [String]
+readInput [] = do
+ c <- getContents
+ return [c]
+readInput fs = mapM readFile fs
+
+main = do
+ PWFASM {..} <- cmdArgs pwfasm
+ cs <- readInput files
+ h <- openOutput output
+ either (putStr . show) (writeOutput h) $ compile preprocess_only (zip files cs)
+ closeOutput h
diff --git a/README b/README
new file mode 100644
index 0000000..49a8fda
--- /dev/null
+++ b/README
@@ -0,0 +1,68 @@
+pwfasm (C) 2012 Joakim Sindholt
+
+Assembler aimed at DTU 30090 Digital Systems class. Proper error reporting and
+simple ASM syntax is among the goals.
+
+Syntax:
+[label:]* [instruction [operand 1] [,operand 2] [,operand 3]] [; comment]
+
+Instructions are:
+ * <> = register
+ * [] = number
+ MOVA <dest> <src> <dest> = <src>
+ INC <dest> <src> <dest> = <src> + 1
+ ADD <dest> <a> <b> <dest> = <a> + <b>
+ SUB <dest> <a> <b> <dest> = <a> - <b>
+ DEC <dest> <src> <dest> = <src> - 1
+ AND <dest> <a> <b> <dest> = <a> & <b>
+ OR <dest> <a> <b> <dest> = <a> | <b>
+ XOR <dest> <a> <b> <dest> = <a> ^ <b>
+ NOT <dest> <src> <dest> = ~<src>
+ MOVB <dest> <src> <dest> = <src>
+ LD <dest> <src> <dest> = M[<src>]
+ ST <dest> <src> M[<dest>] = <src>
+ LDI <dest> [src] <dest> = [src]
+ ADI <dest> <a> [b] <dest> = <a> + [b]
+ BRZ [raddr] <src> if (<src> == 0) { goto [raddr] }
+ BRN [raddr] <src> if (<src> < 0) { goto [raddr] }
+ JMP <src> goto M[<src>]
+ LRI <dest> <src> uh
+ SRM <dest> <a> [b] yeah
+ SRL <dest> <a> [b] look it up
+ DB [a] Explicitly define the byte located exactly here
+
+Operands can be:
+ * Registers:
+ - In the form of R#, where # is any decimal number
+ * Numbers:
+ - In the form of # (decimal), 0x# (hexadecimal), 0b# (binary), and 0# (octal)
+ where # is any number of the given base. Ranges vary depending on the
+ instruction. Some numbers may also be declared negative by prepending a -.
+ * Labels:
+ - Can be anything, as long as it doesn't conflict with number parsing or
+ separators. Wherever a number is used as an argument, a label can be
+ substituted.
+
+If you're unsure of which instructions take which number ranges, try it and the
+assembler will tell you exactly what's allowed.
+
+A line is terminated definitively by the ; character, and anything after it
+will be treated as a comment.
+
+Everything except labels is case insensitive.
+
+Example:
+ldi R0, 0x7 ; R0 = 7 -> 0x9807
+add R1, R0, R0 ; R1 = 14 -> 0x0440
+add R0, R1, R1 ; R0 = 28 -> 0x0409
+add R1, R0, R0 ; R1 = 56 -> 0x0440
+add R0, R1, R1 ; R0 = 112 -> 0x0409
+add R1, R0, R0 ; R1 = 224 -> 0x0440
+adi R0, R1, 0x7 ; R0 = 231 -> 0x840F
+adi R1, R0, 0x7 ; R1 = 238 -> 0x8447
+adi R0, R1, 0x7 ; R0 = 245 -> 0x840F
+adi R1, R0, 0x3 ; R1 = 248 -> 0x8443
+st R1, R0 ; M[248] <- 245 -> 0x4008
+
+TODO:
+ Make the code a bit prettier
diff --git a/test.s b/test.s
new file mode 100644
index 0000000..fb4d330
--- /dev/null
+++ b/test.s
@@ -0,0 +1,17 @@
+; This sample application outputs the letters AB to the 7-segment display
+
+; jump over a few byte decls
+ldi R0, 0x0 ; R0 <- 0 -> 9800
+brz R0, immdecl ; if R0 == 0 then goto immdecl -> c018
+
+; byte decls
+db 248 ; address of 7 seg MMIO reg -> 00f8
+db 0xAB ; what will be printed on 7 seg -> 00ab
+
+; actual code
+immdecl:
+ ldi R0, 2 ; R0 <- 2 -> 9802
+ ld R1, R0 ; R1 <- M[R0] = M[2] = 248 -> 2040
+ ldi R0, 3 ; R0 <- 3 -> 9803
+ ld R2, R0 ; R2 <- M[R0] = M[3] = 0xAB -> 2080
+ st R1, R2 ; R1 <- R2 = 0xAB -> 400a