3a_asm/Main.hs

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