3a_asm/DT.hs

   1 module DT where
   2
   3 import DTFormat
   4 import Expr_eval
   5
   6 import Prelude hiding (not,and,or)
   7
   8 import Data.Bits hiding (xor)
   9 import qualified Data.Map as Map
  10 import Data.Word
  11 import Text.Printf
  12 import Text.Parsec
  13 import Text.Parsec.String
  14 import Text.Parsec.Combinator
  15 import Control.Monad
  16 import Control.Applicative hiding ((<|>))
  17
  18
  19 -- parsing --
  20 instruction :: Dict -> Parser Word32
  21 instruction dict = foldl1 (<|>) (fmap (\x -> try (x dict)) instructions) <* char '\n'
  22
  23 testins :: String -> IO ()
  24 testins input =
  25         case (parse (instruction dict) "" (input++"\n")) of
  26                 Left err -> do { putStr "fail :/\n"; print err}
  27                 Right x -> do { printf "0x%08X\n" x }
  28         where
  29         dict = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)])
  30
  31
  32 comma = char ','
  33 mnem m = string m
  34
  35 iLabel :: Dict -> Parser Word32
  36 -- TODO: save msb (=sign) correctly...
  37 iLabel d@(aktadr,_) = do {i <- (iLit d); return $ ((i - aktadr)`div`4) .&. 0xffff}
  38
  39 iLit :: Dict -> Parser Word32
  40 iLit (_,d) = do
  41         val <- expr d;
  42         try (do {
  43                 string "@hi"; parseMySpaces;
  44                 return $ shiftR val 16
  45         }) <|> do {
  46                 string "@lo"; parseMySpaces;
  47                 return $ val .&. 0xffff
  48         } <|> do {parseMySpaces; return val}
  49
  50
  51 iLit5  d = do i <- iLit d; return $ i .&. 0x001f
  52 iLit12 d = do i <- iLit d; return $ i .&. 0x0fff
  53 iLit15 d = do i <- iLit d; return $ i .&. 0x7fff
  54 iLit16 d = do i <- iLit d; return $ i .&. 0xffff
  55
  56 imm4 :: Parser String
  57 imm4 = do
  58         try (do a <- digit; b <- digit; return $ [a,b]) <|> (do a <- digit; return $ [a])
  59
  60 read4imm :: String -> Word32
  61 read4imm s = if erg > 15 then error "invalid register" else erg
  62         where erg = read s
  63
  64 reg :: Parser Word32
  65 reg = do {parseMySpaces; string "r"; ret <- liftM read4imm (imm4); parseMySpaces; return ret}
  66
  67 condition :: Parser Word32
  68 condition = do
  69         str <- foldl1 (<|>) (fmap (try . string . fst) conds)
  70         let (Just ret) = lookup str conds
  71         return $ ret
  72
  73 carry :: Parser Word32
  74 carry = do { char 'c'; return 1} <|> do {string ""; return 0}
  75
  76 updateDisable :: Parser Word32
  77 updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0}
  78
  79 highonly :: Parser Word32
  80 highonly = do { char 'h'; return 1} <|> do {string ""; return 0}
  81
  82 highlow :: Parser Word32
  83 highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0}
  84
  85 fill :: Parser Word32
  86 fill = do { char 'f'; return 1} <|> do {string ""; return 0}
  87
  88 sign :: Parser Word32
  89 sign = do { char 's'; return 1} <|> do {string ""; return 0}
  90
  91 branchpred :: Parser Word32
  92 branchpred = do
  93         x <- do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
  94         parseMySpaces
  95         return x
  96
  97 shiftArith :: Parser Word32
  98 shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0}
  99
 100 parseBracketClose :: Parser Char
 101 parseBracketClose = do { c <- char ')'; parseMySpaces; return c}
 102
 103 (<.>) p n = p<*comma<*>n
 104 (<%>) p n = p<*space<*>n
 105 (<@>) p n = p<*char '('<*>n<*parseBracketClose
 106 infixl 1 <.>
 107 infixl 1 <%>
 108 infixl 1 <@>
 109
 110 ins m form e  = do {mnem m; form e}
 111 csv0i_p dict f = f<$>condition<*>branchpred<*>(iLabel dict)
 112 csv0i_p' f = f<$>condition<*>branchpred
 113 csv1 f = f<$>condition<%>reg
 114 csv1_p f = f<$>condition<%>reg
 115 csv2 f = f<$>condition<%>reg<.>reg
 116 csv2i dict f = f<$>condition<%>reg<.>(iLit16 dict)
 117 csv2_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg
 118 csv2m dict f = f<$>condition<%>reg<.>(iLit15 dict)<@>reg
 119 csv2i_cd dict f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
 120 csv2i_d dict f = f<$>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
 121 csv2i_scd dict f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit12 dict)
 122 csv2i_sl dict f = f<$>highonly<*>sign<*>condition<%>reg<.>(iLit16 dict)
 123 csv2i_sl' dict f = f<$>sign<*>condition<%>reg<.>(iLit16 dict)
 124 csv2i_lfd dict f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>(iLit16 dict)
 125 csv3_cd f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
 126 csv3_d f = f<$>updateDisable<*>condition<%>reg<.>reg<.>reg
 127
 128 instructions = [add, addi, mov, sub, subi,
 129         and, andx, or, orx, xor, xorx, not,
 130         lls, lrs, ars,
 131         pop, push, disc, fetch,
 132         movpf, movsf, movpt, movst,
 133         ldh, ldb, ldw, ldi, ldil,
 134         stw, sth, stb,
 135         ldx, stx,
 136         br, ret, call, reti,
 137         brr, callr,
 138         cmp, cmpi
 139         ]
 140
 141 -- arithmetic
 142 add _ = ins "add" csv3_cd $ aform 0x00
 143 addi dict = ins "addi" (csv2i_scd dict) $ aformi 0x02
 144 mov _ = ins "mov" csv2_scd $ aformi' 0x02
 145 sub _ = ins "sub" csv3_cd $ aform 0x01
 146 subi dict = ins "subi" (csv2i_scd dict) $ aformi 0x03
 147 -- logic
 148 and _ = ins "and" csv3_d $ aform 0x04 0
 149 andx dict = ins "andx" (csv2i_lfd dict) $ lformi 0x05
 150 or _ = ins "or" csv3_d $ aform 0x06 0
 151 orx dict = ins "orx" (csv2i_lfd dict) $ lformi 0x07
 152 xor _ = ins "xor" csv3_d $ aform 0x08 0
 153 xorx dict = ins "xorx" (csv2i_lfd dict) $ lformi 0x09
 154 not _ = ins "not" csv1 $ lformi'not 0x09
 155 lls dict = ins "lls" (csv2i_cd dict) $ shiform 0x0a 0 0
 156 lrs dict = ins "lrs" (csv2i_cd dict) $ shiform 0x0a 1 0
 157 ars dict = ins "ars" (csv2i_d dict) $ shiform 0x0a 1 1 0
 158 -- memory
 159 pop _ = ins "pop" csv1 $ sform 0x0b 0x0
 160 disc _ = ins "disc" csv1 $ sform 0x0b 0x1
 161 fetch _ = ins "fetch" csv1 $ sform 0x0b 0x2
 162 push _ = ins "push" csv1 $ sform 0x0b 0x3
 163 movpf _ = ins "movpf" csv1 $ sform 0x0c 0x2
 164 movsf _ = ins "movsf" csv1 $ sform 0x0c 0x0
 165 movpt _ = ins "movpt" csv1 $ sform 0x0d 0x2
 166 movst _ = ins "movst" csv1 $ sform 0x0d 0x0
 167 ldw dict = ins "ldw" (csv2m dict) $ mformi 0x0e
 168 ldh dict = ins "ldh" (csv2m dict) $ mformi 0x10
 169 ldb dict = ins "ldb" (csv2m dict) $ mformi 0x12
 170 ldi dict = ins "ldi" (csv2i_sl dict) $ lformi' 0x1a
 171 ldil dict = ins "ldil" (csv2i_sl' dict) $ lformi' 0x1a 0
 172 stw dict = ins "stw" (csv2m dict) $ mformi 0x0f
 173 sth dict = ins "sth" (csv2m dict) $ mformi 0x11
 174 stb dict = ins "stb" (csv2m dict) $ mformi 0x13
 175 ldx dict = ins "ldx" (csv2m dict) $ mformi 0x14
 176 stx dict = ins "stx" (csv2m dict) $ mformi 0x15
 177 -- misc
 178 -- set signed by default! in very rare cases this can be an issue.
 179 br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1
 180 call dict = ins "call" (csv0i_p dict) $ bform 0x16 0x1 1
 181 ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2
 182 reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3
 183 brr _ = ins "brr" csv1_p $ brrform 0x17 0
 184 callr _ = ins "callr" csv1_p $ brrform 0x17 1
 185 cmp _ = ins "cmp" csv2 $ mformi' 0x18
 186 cmpi dict = ins "cmpi" (csv2i dict) $ lformi 0x19 0 0 0
 187
 188 -- instruction formats
 189 aform opcd c d cond rd ra rb = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(rb,11),(free,2),(c,1),(d,0)]
 190         where free = 0
 191
 192 aformi opcd s c d cond rd ra imm = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(imm,3),(s,2),(c,1),(d,0)]
 193 aformi' opcd s c d cond rd ra = aformi opcd s c d cond rd ra 0
 194
 195 lformi opcd hl f d cond rd imm = pack [(cond,28),(opcd,23),(rd,19),(imm,3),(hl,2),(f,1),(d,0)]
 196 lformi' opcd hl s cond rd imm = lformi opcd s hl 0 cond rd imm
 197 lformi'not opcd cond rd = lformi opcd 0 1 0 cond rd 0xffff
 198
 199 mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)]
 200 mformi' opcd cond rd = mformi opcd cond rd 0
 201
 202 bform opcd typ s cond bp imm = pack [(cond,28),(opcd,23),(imm,7),(free,4),(typ,2),(bp,1),(s,0)]
 203         where free = 0
 204 bform' opcd typ cond bp = bform opcd typ 0 cond bp 0
 205
 206 sform opcd typ cond rd = pack [(cond,28),(opcd,23),(rd,19),(typ,17)]
 207
 208 brrform opcd typ cond ra = pack [(cond,28),(opcd,23),(ra,19),(typ,2)]
 209
 210 shiform opcd lr a c d cond rd ra imm = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(imm,10),(lr,3),(a,2),(c,1),(d,0)]
 211
 212 -- bit-packing --
 213 pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
 214
 215 -- condition table
 216 conds :: [(String,Word32)]
 217 conds = [
 218         ("nq", 0x0), ("nz", 0x0),
 219         ("eq", 0x1), ("zs", 0x1),
 220         ("no", 0x2),
 221         ("ov", 0x3),
 222         ("nc", 0x4), ("ae", 0x4),
 223         ("cs", 0x5), ("bl", 0x5),
 224         ("ns", 0x6), ("nn", 0x6),
 225         ("ss", 0x7), ("ns", 0x7),
 226         ("ab", 0x8),
 227         ("be", 0x9),
 228         ("ge", 0xa),
 229         ("lt", 0xb),
 230         ("gt", 0xc),
 231         ("le", 0xd),
 232         ("nv", 0xf),
 233         ("", 0xe) -- always
 234         ]