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