3a_asm/Main.hs

   1 -- as for deep thoughts ISA
   2 -----------------------------------------------------------------------------
   3 import DT
   4 import DTFormat
   5 import Expr_eval
   6
   7 import Control.Applicative hiding ((<|>),many)
   8
   9 import System.IO
  10 import System.Environment
  11 import Text.Printf
  12 import Text.Parsec
  13 import Text.Parsec.String
  14 import Text.Parsec.Combinator
  15 import qualified Data.Map as M
  16 import Data.List
  17 import Data.Word
  18 import qualified Data.ByteString.Lazy as BL
  19 import Control.Monad
  20
  21
  22 main :: IO ()
  23 main = do
  24         args <- getArgs
  25         content <- getContents
  26         let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
  27         let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 [("start_",0x00)]
  28         printf "\nlabels:\n"
  29         sequence_ [printf "%20s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
  30         printf "\nparsed asm:\n"
  31         sequence_ [printf "%s" (show x) | x <- formatedsrc]
  32         let parsed = parseInstr dict formatedsrc
  33         printf "\nafter parsing the instructions:\n"
  34         sequence_ [printf "%s" (show x) | x <- parsed]
  35
  36
  37 parseInstr :: [DictElem] -> [DTF] -> [DTF]
  38 parseInstr _ [] = []
  39 parseInstr dict ((DTF_InstrToParse a instr c l s):xs) =
  40         (DTF_Instr a bytecode c l s):(parseInstr dict xs)
  41         where
  42         bytecode = case (parse (instruction (a,dict)) "" (instr++"\n")) of
  43                 Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err)
  44                 Right x -> x
  45 parseInstr dict (x:xs) = x:(parseInstr dict xs)
  46
  47
  48 type Counter = Word32
  49
  50 inc :: Counter -> Counter
  51 inc = ((+) 4)
  52
  53
  54 convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> [DictElem] -> ([DictElem], [DTF])
  55 convertDTF [] _ _ _ d = (d,[])
  56 convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf))
  57         where
  58         actlist (DTF_Org _) = next
  59         actlist (DTF_State _) = next
  60         actlist (DTF_Define _ _ _) = next
  61         actlist (DTF_Fill rep val code l c) = if state == InData then
  62                 (DTF_Data datacnt val code l c):[(DTF_Data dc val "" "" "") | i<-[2..repi], let dc = [(datacnt+0x4),(datacnt+0x8)..]!!(i-2)] ++ next
  63                 else
  64                 (DTF_Instr instrcnt val code l c):[(DTF_Instr ic val "" "" "") | i<-[2..repi], let ic = [(instrcnt+0x4),(instrcnt+0x8)..]!!(i-2)] ++ next
  65                 where
  66                 repi :: Int
  67                 repi = fromInteger (toInteger rep)
  68         actlist y = y:next
  69
  70         (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
  71
  72         ndatacnt (DTF_Org adr)
  73                 | state == InData = adr
  74                 | otherwise = datacnt
  75         ndatacnt (DTF_Fill rep _ _ _ _)
  76                 | state == InData = datacnt + (4*rep)
  77                 | otherwise = datacnt
  78         ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
  79         ndatacnt _ = datacnt
  80
  81         ninstrcnt (DTF_Org adr)
  82                 | state == InText = adr
  83                 | otherwise = instrcnt
  84         ninstrcnt (DTF_Fill rep _ _ _ _)
  85                 | state == InText = instrcnt + (4*rep)
  86                 | otherwise = instrcnt
  87         ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
  88         ninstrcnt (DTF_InstrToParse _ _ _ _ _) = inc instrcnt
  89         ninstrcnt _ = instrcnt
  90
  91         nstate (DTF_State s) = s
  92         nstate _ = state
  93
  94         ndict (DTF_Label l _ a) = dict `add_elem` (l,a)
  95         ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a)
  96         ndict (DTF_InstrToParse a _ _ l _) = dict `add_elem` (l,a)
  97         ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a)
  98         ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a)
  99         ndict (DTF_Define l v _) = dict `add_elem` (l,v)
 100         ndict (DTF_Fill _ _ _ l _)
 101                 | state == InText = dict `add_elem` (l,instrcnt)
 102                 | state == InData = dict `add_elem` (l,datacnt)
 103         ndict _ = dict
 104
 105         newdtf = case (parse (parseDTFLine dict) "" (str++"\n")) of
 106                 Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err))
 107                 Right (DTF_SectionToDet _ v c l s) ->
 108                         case state of
 109                                 NoState -> error "missing .data or .text"
 110                                 InData -> (DTF_Data datacnt v c l s)
 111                                 InText -> (DTF_Instr instrcnt v c l s)
 112                 Right (DTF_InstrToParse _ v c l s) ->
 113                         (DTF_InstrToParse instrcnt v c l s)
 114                 Right y@(DTF_Org _) ->
 115                         case state of
 116                                 NoState -> error "missing .data or .text"
 117                                 _ -> y
 118                 Right (DTF_Label l c _) ->
 119                         case state of
 120                                 NoState -> error "missing .data or .text"
 121                                 InData -> (DTF_Label l c datacnt)
 122                                 InText -> (DTF_Label l c instrcnt)
 123                 Right z -> z -- DTF_Comment, DTF_State, DTF_Define, DTF_Fill
 124
 125
 126
 127 testDTF :: String -> IO ()
 128 testDTF input =
 129         case (parse (parseDTFLine dict) "" (input++"\n")) of
 130                 Left err -> do { putStr "failz ;(\n"; print err}
 131                 Right x -> do { print x }
 132         where
 133         dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]
 134
 135 parseDTFLine :: [DictElem] -> Parser DTF
 136 parseDTFLine dict = foldl1 (<|>) (fmap (\x -> try (x dict)) lineFormats) <* char '\n'
 137
 138 lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]
 139
 140 -- helper
 141 parseIdent :: Parser String
 142 parseIdent = do
 143         ident <- letter
 144         idents <- many $ (letter <|> digit <|> char '_')
 145         return $ (ident:idents)
 146
 147 parseLabel :: Parser String
 148 parseLabel = do
 149         l <- parseIdent
 150         char ':'
 151         return $ l
 152
 153 parseComment :: Parser String
 154 parseComment = do
 155         skipMany space
 156         char ';'
 157         comment <- many $ noneOf "\n"
 158         return $ comment
 159
 160 parseConst :: [DictElem] -> Parser Word32
 161 parseConst d = expr d
 162
 163 -- teh pars0rs
 164 lf_data d = do
 165         l <- try (parseLabel) <|> string ""
 166         skipMany space
 167         fill <- string ".fill "
 168         repeat <- try (do {size <- many1 $ noneOf "\n;,"; char ','; return $ size}) <|> return "1"
 169         -- TODO: atm 32bit imm only
 170         code <- many1 $ noneOf "\n;"
 171         -- TODO: this is quite ugly here :/
 172         let (Right val) = parse (parseConst d) "" code
 173         let (Right r) = parse (parseConst d) "" repeat
 174         comment <- try(parseComment) <|> parseMySpaces
 175         return $ DTF_Fill r val (fill ++ (if repeat == "1" then "" else repeat) ++ code) l comment
 176
 177 lf_comment _ = do
 178         comment <- parseComment
 179         return $ DTF_Comment comment
 180
 181 lf_label _ = do
 182         l <- parseLabel
 183         comment <- try(parseComment) <|> parseMySpaces
 184         return $ DTF_Label l comment 0
 185
 186 lf_toparse _ = do
 187         l <- try(parseLabel) <|> string ""
 188         skipMany space
 189         code <- many1 $ noneOf "\n;"
 190         comment <- try(parseComment) <|> parseMySpaces
 191         return $ DTF_InstrToParse 0 code code l comment
 192
 193 lf_org d = do
 194         skipMany space
 195         string ".org"
 196         val <- parseConst d
 197         parseMySpaces
 198         return $ DTF_Org val
 199
 200 lf_sdata _ = do
 201         skipMany space
 202         string ".data"
 203         parseMySpaces
 204         return $ DTF_State InData
 205
 206 lf_stext _ = do
 207         skipMany space
 208         string ".text"
 209         parseMySpaces
 210         return $ DTF_State InText
 211
 212 lf_define d = do
 213         skipMany space
 214         string ".define"
 215         parseMySpaces
 216         id <- parseIdent
 217         char ','
 218         -- TODO: expressions with (expr) do not work ;(
 219         ret <- parseConst d
 220         comment <- try(parseComment) <|> parseMySpaces
 221         return $ DTF_Define id ret comment