3a_asm/Main.hs

   1 {-   `Deep Thought', a softcore CPU implemented on a FPGA
   2
   3     Copyright (C) 2010 Markus Hofstaetter <markus.manrow@gmx.at>
   4     Copyright (C) 2010 Martin Perner <e0725782@student.tuwien.ac.at>
   5     Copyright (C) 2010 Stefan Rebernig <stefan.rebernig@gmail.com>
   6     Copyright (C) 2010 Manfred Schwarz <e0725898@student.tuwien.ac.at>
   7     Copyright (C) 2010 Bernhard Urban <lewurm@gmail.com>
   8
   9     This program is free software: you can redistribute it and/or modify
  10     it under the terms of the GNU General Public License as published by
  11     the Free Software Foundation, either version 3 of the License, or
  12     (at your option) any later version.
  13
  14     This program is distributed in the hope that it will be useful,
  15     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17     GNU General Public License for more details.
  18
  19     You should have received a copy of the GNU General Public License
  20     along with this program.  If not, see <http://www.gnu.org/licenses/>. -}
  21
  22 import DT hiding (not)
  23 import DTFormat
  24 import Expr_eval
  25
  26 import Control.Applicative hiding ((<|>),many)
  27
  28 import System.IO
  29 import System.Environment
  30 import Text.Printf
  31 import Text.Parsec
  32 import Text.Parsec.String
  33 import Text.Parsec.Combinator
  34 import qualified Data.Map as M
  35 import Data.List
  36 import Data.Char
  37 import Data.Word
  38 import Data.Bits
  39 import qualified Data.ByteString.Lazy as BL
  40 import Control.Monad
  41
  42
  43 main :: IO ()
  44 main = do
  45         args <- getArgs
  46         content <- getContents
  47         let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
  48         let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 [("start_",0x00)]
  49         if (not $ null args) && ("-d" `elem` args)
  50                 then do
  51                         printf "\nlabels:\n"
  52                         sequence_ [printf "%20s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
  53                         printf "\nparsed asm:\n"
  54                         sequence_ [printf "%s" (show x) | x <- formatedsrc]
  55                         printf "\nafter parsing the instructions:\n"
  56                 else do
  57                         printf ""
  58         let base = if "-b" `elem` args then 2 else 16
  59         let parsed = parseInstr (reverse $ sort dict) formatedsrc
  60         sequence_ [printf "%s" (showsDTFBase x base "") | x <- parsed]
  61
  62
  63 parseInstr :: [DictElem] -> [DTF] -> [DTF]
  64 parseInstr _ [] = []
  65 parseInstr dict ((DTF_InstrToParse a instr c l s lno):xs) =
  66         (DTF_Instr a bytecode c l s):(parseInstr dict xs)
  67         where
  68         bytecode = case (parse (instruction lno (a,dict)) "" (instr++"\n")) of
  69                 Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err)
  70                 Right x -> x
  71 parseInstr dict (x:xs) = x:(parseInstr dict xs)
  72
  73
  74 type Counter = Word32
  75
  76 inc :: Counter -> Counter
  77 inc = ((+) 4)
  78
  79
  80 convertDTF :: [(LineNo,String)] -> DT_State -> Counter -> Counter -> [DictElem] -> ([DictElem], [DTF])
  81 convertDTF [] _ _ _ d = (d,[])
  82 convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf))
  83         where
  84         actlist (DTF_Org _) = next
  85         actlist (DTF_State _) = next
  86         actlist (DTF_Define _ _ _) = next
  87         actlist (DTF_Fill rep val code l c) = if state == InData then
  88                 (DTF_Data datacnt val code l c):[(DTF_Data dc val "" "" "") | i<-[2..repi], let dc = [(datacnt+0x4),(datacnt+0x8)..]!!(i-2)] ++ next
  89                 else
  90                 (DTF_Instr instrcnt val code l c):[(DTF_Instr ic val "" "" "") | i<-[2..repi], let ic = [(instrcnt+0x4),(instrcnt+0x8)..]!!(i-2)] ++ next
  91                 where
  92                 repi :: Int
  93                 repi = fromInteger (toInteger rep)
  94         actlist (DTF_Ascii str lab code comment) =
  95                 (DTF_Data datacnt (strval!!0) code lab comment):
  96                 [(DTF_Data ic (strval!!i) code lab comment)
  97                 | i<-[1..len]
  98                 , let ic = [datacnt,(datacnt+0x4)..]!!i
  99                 ]
 100                 ++ next
 101                 where
 102                 len = ((length str)`div`4)
 103                 strval :: [Word32]
 104                 strval = pf $ map (\x -> fromIntegral $ ord x :: Word8) str
 105                 pf :: [Word8] -> [Word32]
 106                 pf [] = []
 107                 pf xs@(_:[]) = pf (xs ++ [0,0,0])
 108                 pf xs@(_:_:[]) = pf (xs ++ [0,0])
 109                 pf xs@(_:_:_:[]) = pf (xs ++ [0])
 110                 pf (a:b:c:d:xs) = (foldl' accum 0 [d,c,b,a]):(pf xs)
 111                         where
 112                         accum x o = (x `shiftL` 8) .|. fromIntegral o
 113         actlist y = y:next
 114
 115         (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)
 116
 117         ndatacnt (DTF_Org adr)
 118                 | state == InData = adr
 119                 | otherwise = datacnt
 120         ndatacnt (DTF_Fill rep _ _ _ _)
 121                 | state == InData = datacnt + (4*rep)
 122                 | otherwise = datacnt
 123         ndatacnt (DTF_Ascii str _ _ _)
 124                 | state == InData = datacnt + (4*len)
 125                 where len = fromIntegral $ ((length str)`div`4)+1
 126         ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
 127         ndatacnt _ = datacnt
 128
 129         ninstrcnt (DTF_Org adr)
 130                 | state == InText = adr
 131                 | otherwise = instrcnt
 132         ninstrcnt (DTF_Fill rep _ _ _ _)
 133                 | state == InText = instrcnt + (4*rep)
 134                 | otherwise = instrcnt
 135         ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
 136         ninstrcnt (DTF_InstrToParse _ _ _ _ _ _) = inc instrcnt
 137         ninstrcnt _ = instrcnt
 138
 139         nstate (DTF_State s) = s
 140         nstate _ = state
 141
 142         ndict (DTF_Label l _ a) = dict `add_elem` (l,a)
 143         ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a)
 144         ndict (DTF_InstrToParse a _ _ l _ _) = dict `add_elem` (l,a)
 145         ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a)
 146         ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a)
 147         ndict (DTF_Define l v _) = dict `add_elem` (l,v)
 148         ndict (DTF_Fill _ _ _ l _)
 149                 | state == InText = dict `add_elem` (l,instrcnt)
 150                 | state == InData = dict `add_elem` (l,datacnt)
 151         ndict (DTF_Ascii _ l c _)
 152                 | state == InData = dict `add_elem` (l,datacnt)
 153                 | otherwise = error $ "don't use .ascii in .text here: " ++ c
 154         ndict _ = dict
 155
 156         newdtf = case (parse (parseDTFLine lno dict) "" (str++"\n")) of
 157                 Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err))
 158                 Right (DTF_SectionToDet _ v c l s) ->
 159                         case state of
 160                                 NoState -> error "missing .data or .text"
 161                                 InData -> (DTF_Data datacnt v c l s)
 162                                 InText -> (DTF_Instr instrcnt v c l s)
 163                 Right (DTF_InstrToParse _ v c l s ln) ->
 164                         (DTF_InstrToParse instrcnt v c l s ln)
 165                 Right y@(DTF_Org _) ->
 166                         case state of
 167                                 NoState -> error "missing .data or .text"
 168                                 _ -> y
 169                 Right (DTF_Label l c _) ->
 170                         case state of
 171                                 NoState -> error "missing .data or .text"
 172                                 InData -> (DTF_Label l c datacnt)
 173                                 InText -> (DTF_Label l c instrcnt)
 174                 Right z -> z -- DTF_Comment, DTF_State, DTF_Define, DTF_Fill, DTF_Ascii
 175
 176 testDTF :: String -> IO ()
 177 testDTF input =
 178         case (parse (parseDTFLine 0 dict) "" (input++"\n")) of
 179                 Left err -> do { putStr "failz ;(\n"; print err}
 180                 Right x -> do { print x }
 181         where
 182         dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]
 183
 184 parseDTFLine :: LineNo -> [DictElem] -> Parser DTF
 185 parseDTFLine lno dict = foldl1 (<|>) (fmap (\x -> try (x lno dict)) lineFormats) <* char '\n'
 186
 187 lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_ifill, lf_ascii, lf_comment, lf_toparse, lf_label, lf_nothing]
 188
 189 -- helper
 190 parseIdent :: Parser String
 191 parseIdent = do
 192         ident <- letter
 193         idents <- many $ (letter <|> digit <|> char '_')
 194         return $ (ident:idents)
 195
 196 parseLabel :: Parser String
 197 parseLabel = do
 198         l <- parseIdent
 199         char ':'
 200         return $ l
 201
 202 parseComment :: Parser String
 203 parseComment = do
 204         skipMany space
 205         char ';'
 206         comment <- many $ noneOf "\n"
 207         return $ comment
 208
 209 parseConst :: [DictElem] -> Parser Word32
 210 parseConst d = expr d
 211
 212 -- teh pars0rs
 213 lf_data _ d = do
 214         l <- try (parseLabel) <|> string ""
 215         skipMany space
 216         fill <- string ".fill "
 217         repeat <- try (do {size <- many1 $ noneOf "\n;,"; char ','; return $ size}) <|> return "1"
 218         -- TODO: atm 32bit imm only
 219         code <- many1 $ noneOf "\n;"
 220         let val = case parse (parseConst d) "" code of
 221                 Right v -> v
 222                 Left err -> error $ show err
 223         let r = case parse (parseConst d) "" repeat of
 224                 Right v -> v
 225                 Left err -> error $ show err
 226         comment <- try(parseComment) <|> parseMySpaces
 227         return $ DTF_Fill r val (fill ++ (if repeat == "1" then "" else repeat) ++ code) l comment
 228
 229 lf_ifill lno d = do
 230         l <- try (parseLabel) <|> string ""
 231         skipMany space
 232         fill <- string ".ifill "
 233         code <- many1 $ noneOf "\n;"
 234         let val = case parse (instruction lno (0,d)) "" (code++"\n") of
 235                 Right v -> v
 236                 Left err -> error $ show err
 237         comment <- try(parseComment) <|> parseMySpaces
 238         return $ DTF_Fill 1 val (fill ++ code) l comment
 239
 240 lf_ascii _ _ = do
 241         l <- try (parseLabel) <|> string ""
 242         skipMany space
 243         ascii <- string ".ascii "
 244         char '"'
 245         str <- many1 $ noneOf "\"";
 246         char '"'
 247         comment <- try(parseComment) <|> parseMySpaces
 248         return $ DTF_Ascii str (ascii ++ "\"" ++ str ++ "\"") l comment
 249
 250 lf_comment _ _ = do
 251         comment <- parseComment
 252         return $ DTF_Comment comment
 253
 254 lf_nothing _ _ = do
 255         wtf <- parseMySpaces
 256         return $ DTF_Comment wtf
 257
 258 lf_label _ _ = do
 259         l <- parseLabel
 260         comment <- try(parseComment) <|> parseMySpaces
 261         return $ DTF_Label l comment 0
 262
 263 lf_toparse lno _ = do
 264         l <- try(parseLabel) <|> string ""
 265         skipMany space
 266         code <- many1 $ noneOf "\n;"
 267         comment <- try(parseComment) <|> parseMySpaces
 268         return $ DTF_InstrToParse 0 code code l comment lno
 269
 270 lf_org _ d = do
 271         skipMany space
 272         string ".org"
 273         val <- parseConst d
 274         parseMySpaces
 275         return $ DTF_Org val
 276
 277 lf_sdata _ _ = do
 278         skipMany space
 279         string ".data"
 280         parseMySpaces
 281         return $ DTF_State InData
 282
 283 lf_stext _ _ = do
 284         skipMany space
 285         string ".text"
 286         parseMySpaces
 287         return $ DTF_State InText
 288
 289 lf_define _ d = do
 290         skipMany space
 291         string ".define"
 292         parseMySpaces
 293         id <- parseIdent
 294         char ','
 295         -- TODO: expressions with (expr) do not work ;(
 296         ret <- parseConst d
 297         comment <- try(parseComment) <|> parseMySpaces
 298         return $ DTF_Define id ret comment