3a_asm/DTFormat.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 module DTFormat where
  23
  24 import Numeric
  25 import Data.Word
  26 import Data.Char
  27 import Text.Printf
  28 import Text.Parsec
  29 import Text.Parsec.String
  30 import Text.Parsec.Combinator
  31 import Text.Parsec.Expr
  32 import Text.ParserCombinators.Parsec.Token
  33 import Text.ParserCombinators.Parsec.Expr
  34 import Control.Monad
  35
  36 data DT_State = NoState | InData | InText deriving (Show,Eq)
  37
  38 type Address = Word32
  39 type Value = Word32
  40 type Repeat = Word32
  41 type ValueToParse = String
  42 type Code = String
  43 type Label = String
  44 type Comment = String
  45 type Ascii = String
  46 type LineNo = Word32
  47
  48 data DTF =
  49         DTF_Data Address Value Code Label Comment | -- 0;...
  50         DTF_Instr Address Value Code Label Comment | -- 1;...
  51         DTF_Comment Comment | -- 2;...
  52         DTF_Label Label Comment Address | -- 3;...
  53         -- types for intern processing
  54         DTF_InstrToParse Address ValueToParse Code Label Comment LineNo |
  55         DTF_SectionToDet Address Value Code Label Comment |
  56         DTF_Org Address |
  57         DTF_Define Label Value Comment |
  58         DTF_Fill Repeat Value Label Code Comment |
  59         DTF_Ascii String Label Code Comment |
  60         DTF_State DT_State
  61
  62 instance Show (DTF) where
  63         showsPrec n = showsDTF
  64
  65 showsDTF :: DTF -> ShowS
  66 showsDTF (DTF_Data a v c l s) = (++) (datins "0" a v c l s)
  67 showsDTF (DTF_Instr a v c l s) = (++) (datins "1" a v c l s)
  68 showsDTF (DTF_Comment c) = (++) (printf "2;%s\n" c)
  69 showsDTF (DTF_Label l c _) = (++) (printf "3;%s;%s\n" l c)
  70 showsDTF (DTF_InstrToParse a v c l s lno) = (++) (printf "itp;%08x;%s;%s;%s;%s@%d\n" a v c l s lno)
  71 showsDTF (DTF_SectionToDet a v c l s) = (++) (datins "std" a v c l s)
  72 showsDTF (DTF_Org a) = (++) (printf "org;%08x\n" a)
  73 showsDTF (DTF_Define l a c) = (++) (printf "def;%s;%08x;%s\n" l a c)
  74 showsDTF (DTF_Fill r v code l c) = (++) (printf "fill;%08x;%08x;%s;%s;%s\n" r v code l c)
  75 showsDTF (DTF_Ascii str l code c) = (++) (printf "ascii;%s;%s;%s;%s" str code l c)
  76 showsDTF (DTF_State s) = (++) (printf "sta;%s\n" (show s))
  77
  78 datins :: String -> Address -> Value -> Code -> Label -> Comment -> String
  79 datins = printf "%s;%08x;%08x;%s;%s;%s\n"
  80
  81 tobin :: Value -> String
  82 tobin v = reverse $ take 32 $ reverse $ (['0' | _<-[0..32]]) ++ (showIntAtBase 2 (chr. ((+)0x30)) v "")
  83
  84 showsDTFBase :: DTF -> Int -> ShowS
  85 showsDTFBase (DTF_Data a v c l s) 2 = (++) (datinsBin "0" a (tobin v) c l s)
  86 showsDTFBase (DTF_Instr a v c l s) 2 = (++) (datinsBin "1" a (tobin v) c l s)
  87 showsDTFBase d _ = showsDTF d
  88
  89 datinsBin :: String -> Address -> String -> Code -> Label -> Comment -> String
  90 datinsBin = printf "%s;%08x;%s;%s;%s;%s\n"
  91
  92 -- datastructure for managing labels and defines
  93 type Dict = (Address,[DictElem])
  94 type DictElem = (String,Word32)
  95
  96 get_elem :: String -> [DictElem] -> Word32
  97 get_elem s dict = case (lookup s dict) of
  98                 Nothing -> error ("unknown label or define: \"" ++ s ++ "\"")
  99                 Just z -> z
 100
 101 add_elem :: [DictElem] -> (String,Word32) -> [DictElem]
 102 add_elem dic (s,w)
 103         | s == "" = dic -- ignore empty string
 104         | already_in =  error ("Label or define \"" ++ s ++ "\" already exists")
 105         | otherwise = (s,w):dic
 106         where
 107         already_in = case (lookup s dic) of
 108                 Just _ -> True
 109                 Nothing -> False
 110
 111 -- some common functions
 112 parseMySpaces :: Parser String
 113 parseMySpaces = do
 114         ret <- many $ oneOf "\t "
 115         return $ ret