X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=3a_asm%2FDTFormat.hs;h=a9ad6057b8215adf6e104327fb3f3ed4e155b8c2;hb=HEAD;hp=aad67e01bab02379c123a573f9451e2942d1ceba;hpb=203259b0ae275054da47075be18cfe25d7d7ed7a;p=calu.git diff --git a/3a_asm/DTFormat.hs b/3a_asm/DTFormat.hs index aad67e0..a9ad605 100644 --- a/3a_asm/DTFormat.hs +++ b/3a_asm/DTFormat.hs @@ -1,23 +1,63 @@ +{- `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 . -} + module DTFormat where +import Numeric import Data.Word +import Data.Char import Text.Printf +import Text.Parsec +import Text.Parsec.String +import Text.Parsec.Combinator +import Text.Parsec.Expr +import Text.ParserCombinators.Parsec.Token +import Text.ParserCombinators.Parsec.Expr +import Control.Monad + +data DT_State = NoState | InData | InText deriving (Show,Eq) type Address = Word32 type Value = Word32 +type Repeat = Word32 type ValueToParse = String type Code = String type Label = String type Comment = String +type Ascii = String +type LineNo = Word32 data DTF = - DTF_Data Address Value Code Label Comment | - DTF_Instr Address Value Code Label Comment | - DTF_Comment Comment | - DTF_Label Label | + DTF_Data Address Value Code Label Comment | -- 0;... + DTF_Instr Address Value Code Label Comment | -- 1;... + DTF_Comment Comment | -- 2;... + DTF_Label Label Comment Address | -- 3;... -- types for intern processing - DTF_ToParse Address ValueToParse Code Label Comment | - DTF_Org Address + DTF_InstrToParse Address ValueToParse Code Label Comment LineNo | + DTF_SectionToDet Address Value Code Label Comment | + DTF_Org Address | + DTF_Define Label Value Comment | + DTF_Fill Repeat Value Label Code Comment | + DTF_Ascii String Label Code Comment | + DTF_State DT_State instance Show (DTF) where showsPrec n = showsDTF @@ -26,10 +66,50 @@ showsDTF :: DTF -> ShowS showsDTF (DTF_Data a v c l s) = (++) (datins "0" a v c l s) showsDTF (DTF_Instr a v c l s) = (++) (datins "1" a v c l s) showsDTF (DTF_Comment c) = (++) (printf "2;%s\n" c) -showsDTF (DTF_Label l) = (++) (printf "3;%s\n" l) -showsDTF (DTF_ToParse a v c l s) = (++) (printf "lulz\n") - +showsDTF (DTF_Label l c _) = (++) (printf "3;%s;%s\n" l c) +showsDTF (DTF_InstrToParse a v c l s lno) = (++) (printf "itp;%08x;%s;%s;%s;%s@%d\n" a v c l s lno) +showsDTF (DTF_SectionToDet a v c l s) = (++) (datins "std" a v c l s) +showsDTF (DTF_Org a) = (++) (printf "org;%08x\n" a) +showsDTF (DTF_Define l a c) = (++) (printf "def;%s;%08x;%s\n" l a c) +showsDTF (DTF_Fill r v code l c) = (++) (printf "fill;%08x;%08x;%s;%s;%s\n" r v code l c) +showsDTF (DTF_Ascii str l code c) = (++) (printf "ascii;%s;%s;%s;%s" str code l c) +showsDTF (DTF_State s) = (++) (printf "sta;%s\n" (show s)) datins :: String -> Address -> Value -> Code -> Label -> Comment -> String datins = printf "%s;%08x;%08x;%s;%s;%s\n" +tobin :: Value -> String +tobin v = reverse $ take 32 $ reverse $ (['0' | _<-[0..32]]) ++ (showIntAtBase 2 (chr. ((+)0x30)) v "") + +showsDTFBase :: DTF -> Int -> ShowS +showsDTFBase (DTF_Data a v c l s) 2 = (++) (datinsBin "0" a (tobin v) c l s) +showsDTFBase (DTF_Instr a v c l s) 2 = (++) (datinsBin "1" a (tobin v) c l s) +showsDTFBase d _ = showsDTF d + +datinsBin :: String -> Address -> String -> Code -> Label -> Comment -> String +datinsBin = printf "%s;%08x;%s;%s;%s;%s\n" + +-- datastructure for managing labels and defines +type Dict = (Address,[DictElem]) +type DictElem = (String,Word32) + +get_elem :: String -> [DictElem] -> Word32 +get_elem s dict = case (lookup s dict) of + Nothing -> error ("unknown label or define: \"" ++ s ++ "\"") + Just z -> z + +add_elem :: [DictElem] -> (String,Word32) -> [DictElem] +add_elem dic (s,w) + | s == "" = dic -- ignore empty string + | already_in = error ("Label or define \"" ++ s ++ "\" already exists") + | otherwise = (s,w):dic + where + already_in = case (lookup s dic) of + Just _ -> True + Nothing -> False + +-- some common functions +parseMySpaces :: Parser String +parseMySpaces = do + ret <- many $ oneOf "\t " + return $ ret