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