import Data.Word
import Text.Printf
+data DT_State = NoState | InData | InText deriving (Show,Eq)
+
type Address = Word32
type Value = Word32
type ValueToParse = String
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
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"
import Data.List
import Data.Word
import qualified Data.ByteString.Lazy as BL
+import Control.Monad
-- import Data.Binary.Put
main :: IO ()
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
inc :: Counter -> Counter
inc = ((+) 4)
-setabsolute :: Counter -> Counter
-setabsolute x = x
-
type DictLabel = (String -> Word32)
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
| 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
projects / calu.git / commitdiff