X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=3a_asm%2FMain.hs;h=835c6238c6faf62f129c4ff7912b478f50015207;hb=1968f329b10681b760faec9369aa893cd2af8d44;hp=a9b3f6455ccd42670fcb2d5ae59eb070c0611e77;hpb=49cb9e591235d3fc719c605c9d7706b4dbd984c4;p=calu.git diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs index a9b3f64..835c623 100644 --- a/3a_asm/Main.hs +++ b/3a_asm/Main.hs @@ -1,43 +1,298 @@ ------------------------------------------------------------------------------ --- --- Module : Main --- Copyright : (c) Jeff Douglas --- License : BSD3 --- --- Maintainer : Jeff Douglas --- Stability : experimental --- Portability : portable --- --- | --- ------------------------------------------------------------------------------ - -module Main where - -import PPC64 +{- `Deep Thought', a softcore CPU implemented on a FPGA + + Copyright (C) 2010 Markus Hofstaetter + Copyright (C) 2010 Martin Perner + Copyright (C) 2010 Stefan Rebernig + Copyright (C) 2010 Manfred Schwarz + Copyright (C) 2010 Bernhard Urban + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . -} + +import DT hiding (not) +import DTFormat +import Expr_eval import Control.Applicative hiding ((<|>),many) import System.IO import System.Environment +import Text.Printf import Text.Parsec 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 - let arch = head args - src <- getContents - assembler src arch - -assembler src isa = do - case isa of - "ppc64" -> case runParser PPC64.parseInstructions () "stdin" src of - Left err -> print err - Right val -> do - let s = runPut (putWord32be $ head val) - BL.writeFile "out.bin" $ s + args <- getArgs + content <- getContents + let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content))) + 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) + + +type Counter = Word32 + +inc :: Counter -> Counter +inc = ((+) 4) + + +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 + + (newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf) + + 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 + + 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 + + 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 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' + +lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_ifill, lf_ascii, lf_comment, lf_toparse, lf_label, lf_nothing] + +-- helper +parseIdent :: Parser String +parseIdent = do + ident <- letter + idents <- many $ (letter <|> digit <|> char '_') + return $ (ident:idents) + +parseLabel :: Parser String +parseLabel = do + l <- parseIdent + char ':' + return $ l + +parseComment :: Parser String +parseComment = do + skipMany space + char ';' + 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_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