-- as for deep thoughts ISA
-----------------------------------------------------------------------------
-
-module Main where
-
-import DT
+import DT hiding (not)
import DTFormat
+import Expr_eval
import Control.Applicative hiding ((<|>),many)
import Text.Parsec.Combinator
import qualified Data.Map as M
import Data.List
+import Data.Char
import Data.Word
+import Data.Bits
import qualified Data.ByteString.Lazy as BL
--- import Data.Binary.Put
+import Control.Monad
+
main :: IO ()
main = do
args <- getArgs
content <- getContents
let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
- let (dict,formatedsrc) = convertDTF src 0x00 0x00 init_labels
- print args
- print formatedsrc
+ let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 [("start_",0x00)]
+ if (not $ null args) && ("-d" `elem` args)
+ then do
+ printf "\nlabels:\n"
+ sequence_ [printf "%20s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
+ printf "\nparsed asm:\n"
+ sequence_ [printf "%s" (show x) | x <- formatedsrc]
+ printf "\nafter parsing the instructions:\n"
+ else do
+ printf ""
+ let base = if "-b" `elem` args then 2 else 16
+ let parsed = parseInstr dict formatedsrc
+ sequence_ [printf "%s" (showsDTFBase x base "") | 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)
-{-
- case runParser DT.parseInstructions () "stdin" src of
- Left err -> print err
- Right val -> do
- sequence_ [printf "0x%08X\n" x | x <- val]
--}
type Counter = Word32
inc :: Counter -> Counter
inc = ((+) 4)
-setabsolute :: Counter -> Counter
-setabsolute x = x
+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 (DTF_Define _ _ _) = next
+ actlist (DTF_Fill rep val code l c) = if state == InData then
+ (DTF_Data datacnt val code l c):[(DTF_Data dc val "" "" "") | i<-[2..repi], let dc = [(datacnt+0x4),(datacnt+0x8)..]!!(i-2)] ++ next
+ else
+ (DTF_Instr instrcnt val code l c):[(DTF_Instr ic val "" "" "") | i<-[2..repi], let ic = [(instrcnt+0x4),(instrcnt+0x8)..]!!(i-2)] ++ next
+ where
+ repi :: Int
+ repi = fromInteger (toInteger rep)
+ actlist (DTF_Ascii str lab code comment) =
+ (DTF_Data datacnt (strval!!0) code lab comment):
+ [(DTF_Data ic (strval!!i) code lab comment)
+ | i<-[1..len]
+ , let ic = [datacnt,(datacnt+0x4)..]!!i
+ ]
+ ++ next
+ where
+ len = ((length str)`div`4)
+ strval :: [Word32]
+ strval = pf $ map (\x -> fromIntegral $ ord x :: Word8) str
+ pf :: [Word8] -> [Word32]
+ pf [] = []
+ pf xs@(_:[]) = pf (xs ++ [0,0,0])
+ pf xs@(_:_:[]) = pf (xs ++ [0,0])
+ pf xs@(_:_:_:[]) = pf (xs ++ [0])
+ pf (a:b:c:d:xs) = (foldl' accum 0 [d,c,b,a]):(pf xs)
+ where
+ accum x o = (x `shiftL` 8) .|. fromIntegral o
+ actlist y = y:next
-type DictLabel = (String -> Word32)
+ (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
-init_labels :: DictLabel
-init_labels _ = 0xffffffff
+ ndatacnt (DTF_Org adr)
+ | state == InData = adr
+ | otherwise = datacnt
+ ndatacnt (DTF_Fill rep _ _ _ _)
+ | state == InData = datacnt + (4*rep)
+ | otherwise = datacnt
+ ndatacnt (DTF_Ascii str _ _ _)
+ | state == InData = datacnt + (4*len)
+ where len = fromIntegral $ ((length str)`div`4)+1
+ ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
+ ndatacnt _ = datacnt
-add_label :: DictLabel -> (String,Word32) -> DictLabel
-add_label dic (s,w)
- | dic s /= 0xffffffff = error ("Label " ++ s ++ " already exists")
- | otherwise = newdict
- where
- newdict str
- | str == s = w
- | otherwise = dic str
+ ninstrcnt (DTF_Org adr)
+ | state == InText = adr
+ | otherwise = instrcnt
+ ninstrcnt (DTF_Fill rep _ _ _ _)
+ | state == InText = instrcnt + (4*rep)
+ | otherwise = instrcnt
+ ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
+ ninstrcnt (DTF_InstrToParse _ _ _ _ _) = inc instrcnt
+ ninstrcnt _ = instrcnt
+ nstate (DTF_State s) = s
+ nstate _ = state
-convertDTF :: [(Int,String)] -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF])
-convertDTF [] _ _ d = (d,[])
-convertDTF ((lno,str):xs) datacnt instrcnt dict =
- (newdict, (DTF_Comment str):next)
- where
- (newdict,next) = convertDTF xs (inc datacnt) (inc instrcnt) dict
+ 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 (DTF_Define l v _) = dict `add_elem` (l,v)
+ ndict (DTF_Fill _ _ _ l _)
+ | state == InText = dict `add_elem` (l,instrcnt)
+ | state == InData = dict `add_elem` (l,datacnt)
+ ndict (DTF_Ascii _ l c _)
+ | state == InData = dict `add_elem` (l,datacnt)
+ | otherwise = error $ "don't use .ascii in .text here: " ++ c
+ ndict _ = dict
+
+ newdtf = case (parse (parseDTFLine dict) "" (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, DTF_Define, DTF_Fill, DTF_Ascii
testDTF :: String -> IO ()
testDTF input =
- case (parse parseDTFLine "" (input++"\n")) of
- Left err -> do { putStr "failz"; print err}
+ case (parse (parseDTFLine dict) "" (input++"\n")) of
+ Left err -> do { putStr "failz ;(\n"; print err}
Right x -> do { print x }
+ where
+ dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]
+
+parseDTFLine :: [DictElem] -> Parser DTF
+parseDTFLine dict = foldl1 (<|>) (fmap (\x -> try (x dict)) lineFormats) <* char '\n'
-parseDTFLine :: Parser DTF
-parseDTFLine = foldl1 (<|>) (fmap try lineFormats) <* char '\n'
+lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_ifill, lf_ascii, lf_comment, lf_toparse, lf_label]
-lineFormats = [lf_data, lf_comment, lf_label, lf_toparse, lf_org]
+-- helper
+parseIdent :: Parser String
+parseIdent = do
+ ident <- letter
+ idents <- many $ (letter <|> digit <|> char '_')
+ return $ (ident:idents)
-lf_data = do string "data"; return $ DTF_Comment "lolz0"
+parseLabel :: Parser String
+parseLabel = do
+ l <- parseIdent
+ char ':'
+ return $ l
-lf_comment = do
+parseComment :: Parser String
+parseComment = do
skipMany space
char ';'
- comment <- many $ noneOf ['\n']
- newline
+ comment <- many $ noneOf "\n"
+ return $ comment
+
+parseConst :: [DictElem] -> Parser Word32
+parseConst d = expr d
+
+-- teh pars0rs
+lf_data d = do
+ l <- try (parseLabel) <|> string ""
+ skipMany space
+ fill <- string ".fill "
+ repeat <- try (do {size <- many1 $ noneOf "\n;,"; char ','; return $ size}) <|> return "1"
+ -- TODO: atm 32bit imm only
+ code <- many1 $ noneOf "\n;"
+ let val = case parse (parseConst d) "" code of
+ Right v -> v
+ Left err -> error $ show err
+ let r = case parse (parseConst d) "" repeat of
+ Right v -> v
+ Left err -> error $ show err
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_Fill r val (fill ++ (if repeat == "1" then "" else repeat) ++ code) l comment
+
+lf_ifill d = do
+ l <- try (parseLabel) <|> string ""
+ skipMany space
+ fill <- string ".ifill "
+ code <- many1 $ noneOf "\n;"
+ let val = case parse (instruction (0,d)) "" (code++"\n") of
+ Right v -> v
+ Left err -> error $ show err
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_Fill 1 val (fill ++ code) l comment
+
+lf_ascii _ = do
+ l <- try (parseLabel) <|> string ""
+ skipMany space
+ ascii <- string ".ascii "
+ char '"'
+ str <- many1 $ noneOf "\"";
+ char '"'
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_Ascii str (ascii ++ "\"" ++ str ++ "\"") 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 d = do
+ skipMany space
+ string ".org"
+ val <- parseConst d
+ 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
+
+lf_define d = do
+ skipMany space
+ string ".define"
+ parseMySpaces
+ id <- parseIdent
+ char ','
+ -- TODO: expressions with (expr) do not work ;(
+ ret <- parseConst d
+ comment <- try(parseComment) <|> parseMySpaces
+ return $ DTF_Define id ret comment
projects / calu.git / blobdiff