-- as for deep thoughts ISA
-----------------------------------------------------------------------------
-module Main where
import DT
+import DTFormat
import Control.Applicative hiding ((<|>),many)
import Text.Printf
import Text.Parsec
import Text.Parsec.String
+import Text.Parsec.Combinator
import qualified Data.Map as M
import Data.List
+import Data.Word
import qualified Data.ByteString.Lazy as BL
--- import Data.Binary.Put
+import Control.Monad
+
main :: IO ()
main = do
args <- getArgs
- src <- getContents
- print args
- case runParser DT.parseInstructions () "stdin" src of
- Left err -> print err
- Right val -> do
- -- TODO: nicht nur das erste element :/
- sequence_ [printf "0x%08X\n" x | x <- val]
- -- mapM (printf "0x%08X\n") val
+ content <- getContents
+ let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
+ let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 []
+ printf "\nlabels:\n"
+ sequence_ [printf "%10s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
+ printf "\nparsed asm:\n"
+ sequence_ [printf "%s" (show x) | x <- formatedsrc]
+ let parsed = parseInstr dict formatedsrc
+ printf "\nafter parsing the instructions:\n"
+ sequence_ [printf "%s" (show x) | x <- parsed]
+
+
+parseInstr :: [DictElem] -> [DTF] -> [DTF]
+parseInstr _ [] = []
+parseInstr dict ((DTF_InstrToParse a instr c l s):xs) =
+ (DTF_Instr a bytecode c l s):(parseInstr dict xs)
+ where
+ bytecode = case (parse (instruction (a,dict)) "" (instr++"\n")) of
+ Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err)
+ Right x -> x
+parseInstr dict (x:xs) = x:(parseInstr dict xs)
+
+
+type Counter = Word32
+
+inc :: Counter -> Counter
+inc = ((+) 4)
+
+
+convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> [DictElem] -> ([DictElem], [DTF])
+convertDTF [] _ _ _ d = (d,[])
+convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf))
+ where
+ actlist (DTF_Org _) = next
+ actlist (DTF_State _) = next
+ actlist y = y:next
+
+ (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
+
+ ndatacnt (DTF_Org adr)
+ | state == InData = adr
+ | otherwise = datacnt
+ ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
+ ndatacnt _ = datacnt
+
+ ninstrcnt (DTF_Org adr)
+ | state == InText = adr
+ | otherwise = instrcnt
+ ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
+ ninstrcnt (DTF_InstrToParse _ _ _ _ _) = inc instrcnt
+ ninstrcnt _ = instrcnt
+
+ nstate (DTF_State s) = s
+ nstate _ = state
+
+ ndict (DTF_Label l _ a) = dict `add_elem` (l,a)
+ ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a)
+ ndict (DTF_InstrToParse a _ _ l _) = dict `add_elem` (l,a)
+ ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a)
+ ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a)
+ ndict _ = dict
+
+ newdtf = case (parse parseDTFLine "" (str++"\n")) of
+ Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err))
+ Right (DTF_SectionToDet _ v c l s) ->
+ case state of
+ NoState -> error "missing .data or .text"
+ InData -> (DTF_Data datacnt v c l s)
+ InText -> (DTF_Instr instrcnt v c l s)
+ Right (DTF_InstrToParse _ v c l s) ->
+ (DTF_InstrToParse instrcnt v c l s)
+ Right y@(DTF_Org _) ->
+ case state of
+ NoState -> error "missing .data or .text"
+ _ -> y
+ Right (DTF_Label l c _) ->
+ case state of
+ NoState -> error "missing .data or .text"
+ InData -> (DTF_Label l c datacnt)
+ InText -> (DTF_Label l c instrcnt)
+ Right z -> z -- DTF_Comment, DTF_State
+
+
+
+testDTF :: String -> IO ()
+testDTF input =
+ case (parse parseDTFLine "" (input++"\n")) of
+ Left err -> do { putStr "failz ;(\n"; print err}
+ Right x -> do { print x }
+
+parseDTFLine :: Parser DTF
+parseDTFLine = foldl1 (<|>) (fmap try lineFormats) <* char '\n'
+
+lineFormats = [lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]
+
+-- helper
+parseLabel :: Parser String
+parseLabel = do
+ label <- letter
+ labels <- many $ (letter <|> digit <|> char '_')
+ char ':'
+ return $ (label:labels)
+
+parseComment :: Parser String
+parseComment = do
+ skipMany space
+ char ';'
+ comment <- many $ noneOf "\n"
+ return $ comment
+
+parseConst :: Parser Word32
+parseConst = do
+ skipMany space
+ -- TODO: only decimal and hex (since this is supported by read)
+ -- TODO: howto check too big values? atm they get truncated
+ str <- try(do pref <- string "0x"; z <- many1 hexDigit; return $ (pref ++ z)) <|> (many1 digit)
+ let val = read str
+ return $ val
+
+-- teh pars0rs
+lf_data = do
+ l <- try (parseLabel) <|> string ""
+ skipMany space
+ fill <- string ".fill "
+ -- TODO: atm 32bit imm only
+ code <- many1 $ noneOf "\n;"
+ -- TODO: this is quite ugly here :/
+ let (Right val) = parse parseConst "" code
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_SectionToDet 0 val (fill ++ code) l comment
+
+lf_comment = do
+ comment <- parseComment
+ return $ DTF_Comment comment
+
+lf_label = do
+ l <- parseLabel
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_Label l comment 0
+
+lf_toparse = do
+ l <- try(parseLabel) <|> string ""
+ skipMany space
+ code <- many1 $ noneOf "\n;"
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_InstrToParse 0 code code l comment
+
+lf_org = do
+ skipMany space
+ string ".org"
+ val <- parseConst
+ parseMySpaces
+ return $ DTF_Org val
+
+lf_sdata = do
+ skipMany space
+ string ".data"
+ parseMySpaces
+ return $ DTF_State InData
+
+lf_stext = do
+ skipMany space
+ string ".text"
+ parseMySpaces
+ return $ DTF_State InText
+