X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=3a_asm%2FMain.hs;h=40be8f0f7546a6048c28ee2031aa32e1dd51ec3d;hb=b3f109c2f4edf52bc4071f9f8d71d868fb117c00;hp=17ffc864871add022ce59ba8c4df954df600e823;hpb=203259b0ae275054da47075be18cfe25d7d7ed7a;p=calu.git diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs index 17ffc86..40be8f0 100644 --- a/3a_asm/Main.hs +++ b/3a_asm/Main.hs @@ -1,10 +1,8 @@ -- as for deep thoughts ISA ----------------------------------------------------------------------------- - -module Main where - -import DT +import DT hiding (not) import DTFormat +import Expr_eval import Control.Applicative hiding ((<|>),many) @@ -16,77 +14,266 @@ import Text.Parsec.String import Text.Parsec.Combinator import qualified Data.Map as M import Data.List +import Data.Char import Data.Word +import Data.Bits import qualified Data.ByteString.Lazy as BL --- import Data.Binary.Put +import Control.Monad + main :: IO () main = do args <- getArgs content <- getContents let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content))) - let (dict,formatedsrc) = convertDTF src 0x00 0x00 init_labels - print args - print formatedsrc + let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 [("start_",0x00)] + if (not $ null args) && ("-d" `elem` args) + then do + printf "\nlabels:\n" + sequence_ [printf "%20s @ 0x%08x\n" l a | (l,a) <- (reverse dict)] + printf "\nparsed asm:\n" + sequence_ [printf "%s" (show x) | x <- formatedsrc] + printf "\nafter parsing the instructions:\n" + else do + printf "" + let base = if "-b" `elem` args then 2 else 16 + let parsed = parseInstr (reverse $ sort dict) formatedsrc + sequence_ [printf "%s" (showsDTFBase x base "") | x <- parsed] + + +parseInstr :: [DictElem] -> [DTF] -> [DTF] +parseInstr _ [] = [] +parseInstr dict ((DTF_InstrToParse a instr c l s lno):xs) = + (DTF_Instr a bytecode c l s):(parseInstr dict xs) + where + bytecode = case (parse (instruction lno (a,dict)) "" (instr++"\n")) of + Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err) + Right x -> x +parseInstr dict (x:xs) = x:(parseInstr dict xs) -{- - case runParser DT.parseInstructions () "stdin" src of - Left err -> print err - Right val -> do - sequence_ [printf "0x%08X\n" x | x <- val] --} type Counter = Word32 inc :: Counter -> Counter inc = ((+) 4) -setabsolute :: Counter -> Counter -setabsolute x = x +convertDTF :: [(LineNo,String)] -> DT_State -> Counter -> Counter -> [DictElem] -> ([DictElem], [DTF]) +convertDTF [] _ _ _ d = (d,[]) +convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf)) + where + actlist (DTF_Org _) = next + actlist (DTF_State _) = next + actlist (DTF_Define _ _ _) = next + actlist (DTF_Fill rep val code l c) = if state == InData then + (DTF_Data datacnt val code l c):[(DTF_Data dc val "" "" "") | i<-[2..repi], let dc = [(datacnt+0x4),(datacnt+0x8)..]!!(i-2)] ++ next + else + (DTF_Instr instrcnt val code l c):[(DTF_Instr ic val "" "" "") | i<-[2..repi], let ic = [(instrcnt+0x4),(instrcnt+0x8)..]!!(i-2)] ++ next + where + repi :: Int + repi = fromInteger (toInteger rep) + actlist (DTF_Ascii str lab code comment) = + (DTF_Data datacnt (strval!!0) code lab comment): + [(DTF_Data ic (strval!!i) code lab comment) + | i<-[1..len] + , let ic = [datacnt,(datacnt+0x4)..]!!i + ] + ++ next + where + len = ((length str)`div`4) + strval :: [Word32] + strval = pf $ map (\x -> fromIntegral $ ord x :: Word8) str + pf :: [Word8] -> [Word32] + pf [] = [] + pf xs@(_:[]) = pf (xs ++ [0,0,0]) + pf xs@(_:_:[]) = pf (xs ++ [0,0]) + pf xs@(_:_:_:[]) = pf (xs ++ [0]) + pf (a:b:c:d:xs) = (foldl' accum 0 [d,c,b,a]):(pf xs) + where + accum x o = (x `shiftL` 8) .|. fromIntegral o + actlist y = y:next -type DictLabel = (String -> Word32) + (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf) -init_labels :: DictLabel -init_labels _ = 0xffffffff + ndatacnt (DTF_Org adr) + | state == InData = adr + | otherwise = datacnt + ndatacnt (DTF_Fill rep _ _ _ _) + | state == InData = datacnt + (4*rep) + | otherwise = datacnt + ndatacnt (DTF_Ascii str _ _ _) + | state == InData = datacnt + (4*len) + where len = fromIntegral $ ((length str)`div`4)+1 + ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt + ndatacnt _ = datacnt -add_label :: DictLabel -> (String,Word32) -> DictLabel -add_label dic (s,w) - | dic s /= 0xffffffff = error ("Label " ++ s ++ " already exists") - | otherwise = newdict - where - newdict str - | str == s = w - | otherwise = dic str + ninstrcnt (DTF_Org adr) + | state == InText = adr + | otherwise = instrcnt + ninstrcnt (DTF_Fill rep _ _ _ _) + | state == InText = instrcnt + (4*rep) + | otherwise = instrcnt + ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt + ninstrcnt (DTF_InstrToParse _ _ _ _ _ _) = inc instrcnt + ninstrcnt _ = instrcnt + nstate (DTF_State s) = s + nstate _ = state -convertDTF :: [(Int,String)] -> Counter -> Counter -> DictLabel -> (DictLabel, [DTF]) -convertDTF [] _ _ d = (d,[]) -convertDTF ((lno,str):xs) datacnt instrcnt dict = - (newdict, (DTF_Comment str):next) - where - (newdict,next) = convertDTF xs (inc datacnt) (inc instrcnt) dict + ndict (DTF_Label l _ a) = dict `add_elem` (l,a) + ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a) + ndict (DTF_InstrToParse a _ _ l _ _) = dict `add_elem` (l,a) + ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a) + ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a) + ndict (DTF_Define l v _) = dict `add_elem` (l,v) + ndict (DTF_Fill _ _ _ l _) + | state == InText = dict `add_elem` (l,instrcnt) + | state == InData = dict `add_elem` (l,datacnt) + ndict (DTF_Ascii _ l c _) + | state == InData = dict `add_elem` (l,datacnt) + | otherwise = error $ "don't use .ascii in .text here: " ++ c + ndict _ = dict + + newdtf = case (parse (parseDTFLine lno dict) "" (str++"\n")) of + Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err)) + Right (DTF_SectionToDet _ v c l s) -> + case state of + NoState -> error "missing .data or .text" + InData -> (DTF_Data datacnt v c l s) + InText -> (DTF_Instr instrcnt v c l s) + Right (DTF_InstrToParse _ v c l s ln) -> + (DTF_InstrToParse instrcnt v c l s ln) + Right y@(DTF_Org _) -> + case state of + NoState -> error "missing .data or .text" + _ -> y + Right (DTF_Label l c _) -> + case state of + NoState -> error "missing .data or .text" + InData -> (DTF_Label l c datacnt) + InText -> (DTF_Label l c instrcnt) + Right z -> z -- DTF_Comment, DTF_State, DTF_Define, DTF_Fill, DTF_Ascii testDTF :: String -> IO () testDTF input = - case (parse parseDTFLine "" (input++"\n")) of - Left err -> do { putStr "failz"; print err} + case (parse (parseDTFLine 0 dict) "" (input++"\n")) of + Left err -> do { putStr "failz ;(\n"; print err} Right x -> do { print x } + where + dict = [("lolz", 0x1337), ("rofl", 0xaaaa)] + +parseDTFLine :: LineNo -> [DictElem] -> Parser DTF +parseDTFLine lno dict = foldl1 (<|>) (fmap (\x -> try (x lno dict)) lineFormats) <* char '\n' -parseDTFLine :: Parser DTF -parseDTFLine = foldl1 (<|>) (fmap try lineFormats) <* char '\n' +lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_ifill, lf_ascii, lf_comment, lf_toparse, lf_label, lf_nothing] -lineFormats = [lf_data, lf_comment, lf_label, lf_toparse, lf_org] +-- helper +parseIdent :: Parser String +parseIdent = do + ident <- letter + idents <- many $ (letter <|> digit <|> char '_') + return $ (ident:idents) -lf_data = do string "data"; return $ DTF_Comment "lolz0" +parseLabel :: Parser String +parseLabel = do + l <- parseIdent + char ':' + return $ l -lf_comment = do +parseComment :: Parser String +parseComment = do skipMany space char ';' - comment <- many $ noneOf ['\n'] - newline + comment <- many $ noneOf "\n" + return $ comment + +parseConst :: [DictElem] -> Parser Word32 +parseConst d = expr d + +-- teh pars0rs +lf_data _ d = do + l <- try (parseLabel) <|> string "" + skipMany space + fill <- string ".fill " + repeat <- try (do {size <- many1 $ noneOf "\n;,"; char ','; return $ size}) <|> return "1" + -- TODO: atm 32bit imm only + code <- many1 $ noneOf "\n;" + let val = case parse (parseConst d) "" code of + Right v -> v + Left err -> error $ show err + let r = case parse (parseConst d) "" repeat of + Right v -> v + Left err -> error $ show err + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_Fill r val (fill ++ (if repeat == "1" then "" else repeat) ++ code) l comment + +lf_ifill lno d = do + l <- try (parseLabel) <|> string "" + skipMany space + fill <- string ".ifill " + code <- many1 $ noneOf "\n;" + let val = case parse (instruction lno (0,d)) "" (code++"\n") of + Right v -> v + Left err -> error $ show err + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_Fill 1 val (fill ++ code) l comment + +lf_ascii _ _ = do + l <- try (parseLabel) <|> string "" + skipMany space + ascii <- string ".ascii " + char '"' + str <- many1 $ noneOf "\""; + char '"' + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_Ascii str (ascii ++ "\"" ++ str ++ "\"") l comment + +lf_comment _ _ = do + comment <- parseComment return $ DTF_Comment comment -lf_label = do string "label"; return $ DTF_Comment "lolz1" -lf_toparse = do string "toparse"; return $ DTF_Comment "lolz2" -lf_org = do string "org"; return $ DTF_Comment "lolz3" +lf_nothing _ _ = do + wtf <- parseMySpaces + return $ DTF_Comment wtf + +lf_label _ _ = do + l <- parseLabel + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_Label l comment 0 + +lf_toparse lno _ = do + l <- try(parseLabel) <|> string "" + skipMany space + code <- many1 $ noneOf "\n;" + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_InstrToParse 0 code code l comment lno + +lf_org _ d = do + skipMany space + string ".org" + val <- parseConst d + parseMySpaces + return $ DTF_Org val + +lf_sdata _ _ = do + skipMany space + string ".data" + parseMySpaces + return $ DTF_State InData + +lf_stext _ _ = do + skipMany space + string ".text" + parseMySpaces + return $ DTF_State InText + +lf_define _ d = do + skipMany space + string ".define" + parseMySpaces + id <- parseIdent + char ',' + -- TODO: expressions with (expr) do not work ;( + ret <- parseConst d + comment <- try(parseComment) <|> parseMySpaces + return $ DTF_Define id ret comment