From: Bernhard Urban Date: Sat, 30 Oct 2010 22:30:10 +0000 (+0200) Subject: 3a_asm: parse even more :> X-Git-Tag: bootrom_v1~228 X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=calu.git;a=commitdiff_plain;h=1a5edb9509baec96133668773da0f7ad8de75e2a 3a_asm: parse even more :> --- diff --git a/3a_asm/DTFormat.hs b/3a_asm/DTFormat.hs index aad67e0..1c8d809 100644 --- a/3a_asm/DTFormat.hs +++ b/3a_asm/DTFormat.hs @@ -3,6 +3,8 @@ module DTFormat where import Data.Word import Text.Printf +data DT_State = NoState | InData | InText deriving (Show,Eq) + type Address = Word32 type Value = Word32 type ValueToParse = String @@ -14,10 +16,12 @@ data DTF = DTF_Data Address Value Code Label Comment | DTF_Instr Address Value Code Label Comment | DTF_Comment Comment | - DTF_Label Label | + DTF_Label Label Comment Address | -- types for intern processing - DTF_ToParse Address ValueToParse Code Label Comment | - DTF_Org Address + DTF_InstrToParse Address ValueToParse Code Label Comment | + DTF_SectionToDet Address Value Code Label Comment | + DTF_Org Address | + DTF_State DT_State instance Show (DTF) where showsPrec n = showsDTF @@ -26,9 +30,11 @@ showsDTF :: DTF -> ShowS showsDTF (DTF_Data a v c l s) = (++) (datins "0" a v c l s) showsDTF (DTF_Instr a v c l s) = (++) (datins "1" a v c l s) showsDTF (DTF_Comment c) = (++) (printf "2;%s\n" c) -showsDTF (DTF_Label l) = (++) (printf "3;%s\n" l) -showsDTF (DTF_ToParse a v c l s) = (++) (printf "lulz\n") - +showsDTF (DTF_Label l c _) = (++) (printf "3;%s;%s\n" l c) +showsDTF (DTF_InstrToParse a v c l s) = (++) (printf "itp;%08x;%s;%s;%s;%s\n" a v c l s) +showsDTF (DTF_SectionToDet a v c l s) = (++) (datins "std" a v c l s) +showsDTF (DTF_Org a) = (++) (printf "org;%08x\n" a) +showsDTF (DTF_State s) = (++) (printf "sta;%s\n" (show s)) datins :: String -> Address -> Value -> Code -> Label -> Comment -> String datins = printf "%s;%08x;%08x;%s;%s;%s\n" diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs index 17ffc86..5385b0e 100644 --- a/3a_asm/Main.hs +++ b/3a_asm/Main.hs @@ -18,6 +18,7 @@ import qualified Data.Map as M import Data.List import Data.Word import qualified Data.ByteString.Lazy as BL +import Control.Monad -- import Data.Binary.Put main :: IO () @@ -25,7 +26,7 @@ main = do args <- getArgs content <- getContents let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content))) - let (dict,formatedsrc) = convertDTF src 0x00 0x00 init_labels + let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 init_labels print args print formatedsrc @@ -41,9 +42,6 @@ type Counter = Word32 inc :: Counter -> Counter inc = ((+) 4) -setabsolute :: Counter -> Counter -setabsolute x = x - type DictLabel = (String -> Word32) @@ -52,6 +50,7 @@ init_labels _ = 0xffffffff add_label :: DictLabel -> (String,Word32) -> DictLabel add_label dic (s,w) + | s == "" = dic -- ignore empty string | dic s /= 0xffffffff = error ("Label " ++ s ++ " already exists") | otherwise = newdict where @@ -60,33 +59,136 @@ add_label dic (s,w) | otherwise = dic str -convertDTF :: [(Int,String)] -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF]) -convertDTF [] _ _ d = (d,[]) -convertDTF ((lno,str):xs) datacnt instrcnt dict = - (newdict, (DTF_Comment str):next) +convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF]) +convertDTF [] _ _ _ d = (d,[]) +convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, newdtf:next) where - (newdict,next) = convertDTF xs (inc datacnt) (inc instrcnt) dict + (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 + + ninstrcnt (DTF_Org adr) + | state == InText = adr + | otherwise = instrcnt + ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt + + nstate (DTF_State s) = s + nstate _ = state + + ndict (DTF_Label l _ a) = dict `add_label` (l,a) + ndict (DTF_SectionToDet a _ _ l _) = dict `add_label` (l,a) + ndict (DTF_InstrToParse a _ _ l _) = dict `add_label` (l,a) + ndict (DTF_Data a _ _ l _) = dict `add_label` (l,a) + ndict (DTF_Instr a _ _ l _) = dict `add_label` (l,a) + + 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"; print err} + 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_data, lf_comment, lf_label, lf_toparse, lf_org] +lineFormats = [lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label] -lf_data = do string "data"; return $ DTF_Comment "lolz0" +-- helper +parseLabel :: Parser String +parseLabel = do + label <- letter + labels <- many $ (letter <|> digit <|> char '_') + char ':' + return $ (label:labels) -lf_comment = do +parseComment :: Parser String +parseComment = do skipMany space char ';' - comment <- many $ noneOf ['\n'] - newline + 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: how to check to big values? + str <- try(do pref <- string "0x"; z <- many1 hexDigit; return $ (pref ++ z)) <|> (many1 digit) + let val = read str + return $ val + +parseMySpaces :: Parser String +parseMySpaces = do + ret <- many $ oneOf "\t " + return $ ret + +-- 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 string "label"; return $ DTF_Comment "lolz1" -lf_toparse = do string "toparse"; return $ DTF_Comment "lolz2" -lf_org = do string "org"; return $ DTF_Comment "lolz3" +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