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 y = y:next
  62
  63         (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
  64
  65         ndatacnt (DTF_Org adr)
  66                 | state == InData = adr
  67                 | otherwise = datacnt
  68         ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
  69         ndatacnt _ = datacnt
  70
  71         ninstrcnt (DTF_Org adr)
  72                 | state == InText = adr
  73                 | otherwise = instrcnt
  74         ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
  75         ninstrcnt (DTF_InstrToParse _ _ _ _ _) = inc instrcnt
  76         ninstrcnt _ = instrcnt
  77
  78         nstate (DTF_State s) = s
  79         nstate _ = state
  80
  81         ndict (DTF_Label l _ a) = dict `add_elem` (l,a)
  82         ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a)
  83         ndict (DTF_InstrToParse a _ _ l _) = dict `add_elem` (l,a)
  84         ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a)
  85         ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a)
  86         ndict (DTF_Define l v _) = dict `add_elem` (l,v)
  87         ndict _ = dict
  88
  89         newdtf = case (parse (parseDTFLine dict) "" (str++"\n")) of
  90                 Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err))
  91                 Right (DTF_SectionToDet _ v c l s) ->
  92                         case state of
  93                                 NoState -> error "missing .data or .text"
  94                                 InData -> (DTF_Data datacnt v c l s)
  95                                 InText -> (DTF_Instr instrcnt v c l s)
  96                 Right (DTF_InstrToParse _ v c l s) ->
  97                         (DTF_InstrToParse instrcnt v c l s)
  98                 Right y@(DTF_Org _) ->
  99                         case state of
 100                                 NoState -> error "missing .data or .text"
 101                                 _ -> y
 102                 Right (DTF_Label l c _) ->
 103                         case state of
 104                                 NoState -> error "missing .data or .text"
 105                                 InData -> (DTF_Label l c datacnt)
 106                                 InText -> (DTF_Label l c instrcnt)
 107                 Right z -> z -- DTF_Comment, DTF_State, DTF_Define
 108
 109
 110
 111 testDTF :: String -> IO ()
 112 testDTF input =
 113         case (parse (parseDTFLine dict) "" (input++"\n")) of
 114                 Left err -> do { putStr "failz ;(\n"; print err}
 115                 Right x -> do { print x }
 116         where
 117         dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]
 118
 119 parseDTFLine :: [DictElem] -> Parser DTF
 120 parseDTFLine dict = foldl1 (<|>) (fmap (\x -> try (x dict)) lineFormats) <* char '\n'
 121
 122 lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]
 123
 124 -- helper
 125 parseIdent :: Parser String
 126 parseIdent = do
 127         ident <- letter
 128         idents <- many $ (letter <|> digit <|> char '_')
 129         return $ (ident:idents)
 130
 131 parseLabel :: Parser String
 132 parseLabel = do
 133         l <- parseIdent
 134         char ':'
 135         return $ l
 136
 137 parseComment :: Parser String
 138 parseComment = do
 139         skipMany space
 140         char ';'
 141         comment <- many $ noneOf "\n"
 142         return $ comment
 143
 144 parseConst :: [DictElem] -> Parser Word32
 145 parseConst d = expr d
 146
 147 -- teh pars0rs
 148 lf_data d = do
 149         l <- try (parseLabel) <|> string ""
 150         skipMany space
 151         fill <- string ".fill "
 152         -- TODO: atm 32bit imm only
 153         code <- many1 $ noneOf "\n;"
 154         -- TODO: this is quite ugly here :/
 155         let (Right val) = parse (parseConst d) "" code
 156         comment <- try(parseComment) <|> parseMySpaces
 157         return $ DTF_SectionToDet 0 val (fill ++ code) l comment
 158
 159 lf_comment _ = do
 160         comment <- parseComment
 161         return $ DTF_Comment comment
 162
 163 lf_label _ = do
 164         l <- parseLabel
 165         comment <- try(parseComment) <|> parseMySpaces
 166         return $ DTF_Label l comment 0
 167
 168 lf_toparse _ = do
 169         l <- try(parseLabel) <|> string ""
 170         skipMany space
 171         code <- many1 $ noneOf "\n;"
 172         comment <- try(parseComment) <|> parseMySpaces
 173         return $ DTF_InstrToParse 0 code code l comment
 174
 175 lf_org d = do
 176         skipMany space
 177         string ".org"
 178         val <- parseConst d
 179         parseMySpaces
 180         return $ DTF_Org val
 181
 182 lf_sdata _ = do
 183         skipMany space
 184         string ".data"
 185         parseMySpaces
 186         return $ DTF_State InData
 187
 188 lf_stext _ = do
 189         skipMany space
 190         string ".text"
 191         parseMySpaces
 192         return $ DTF_State InText
 193
 194 lf_define d = do
 195         skipMany space
 196         string ".define"
 197         parseMySpaces
 198         id <- parseIdent
 199         char ','
 200         -- TODO: expressions with (expr) do not work ;(
 201         ret <- parseConst d
 202         comment <- try(parseComment) <|> parseMySpaces
 203         return $ DTF_Define id ret comment