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' f = f<$>condition
 115 csv1_p f = f<$>condition<%>reg
 116 csv2 f = f<$>condition<%>reg<.>reg
 117 csv2i dict f = f<$>condition<%>reg<.>(iLit16 dict)
 118 csv2_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg
 119 csv2m dict f = f<$>condition<%>reg<.>(iLit15 dict)<@>reg
 120 csv2i_cd dict f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
 121 csv2i_d dict f = f<$>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
 122 csv2i_scd dict f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit12 dict)
 123 csv2i_sl dict f = f<$>highonly<*>sign<*>condition<%>reg<.>(iLit16 dict)
 124 csv2i_sl' dict f = f<$>sign<*>condition<%>reg<.>(iLit16 dict)
 125 csv2i_lfd dict f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>(iLit16 dict)
 126 csv3_cd f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
 127 csv3_d f = f<$>updateDisable<*>condition<%>reg<.>reg<.>reg
 128
 129 instructions = [add, addi, mov, sub, subi,
 130         and, andx, or, orx, xor, xorx, not,
 131         lls, lrs, ars,
 132         pop, push, disc, fetch,
 133         movpf, movsf, movpt, movst,
 134         ldh, ldb, ldw, ldi, ldil,
 135         stw, sth, stb,
 136         ldx, stx,
 137         br, ret, call, reti,
 138         brr, callr,
 139         cmp, cmpi
 140         ]
 141
 142 -- arithmetic
 143 add _ = ins "add" csv3_cd $ aform 0x00
 144 addi dict = ins "addi" (csv2i_scd dict) $ aformi 0x02
 145 mov _ = ins "mov" csv2_scd $ aformi' 0x02
 146 sub _ = ins "sub" csv3_cd $ aform 0x01
 147 subi dict = ins "subi" (csv2i_scd dict) $ aformi 0x03
 148 -- logic
 149 and _ = ins "and" csv3_d $ aform 0x04 0
 150 andx dict = ins "andx" (csv2i_lfd dict) $ lformi 0x05
 151 or _ = ins "or" csv3_d $ aform 0x06 0
 152 orx dict = ins "orx" (csv2i_lfd dict) $ lformi 0x07
 153 xor _ = ins "xor" csv3_d $ aform 0x08 0
 154 xorx dict = ins "xorx" (csv2i_lfd dict) $ lformi 0x09
 155 not _ = ins "not" csv1 $ lformi'not 0x09
 156 lls dict = ins "lls" (csv2i_cd dict) $ shiform 0x0a 0 0
 157 lrs dict = ins "lrs" (csv2i_cd dict) $ shiform 0x0a 1 0
 158 ars dict = ins "ars" (csv2i_d dict) $ shiform 0x0a 1 1 0
 159 -- memory
 160 pop _ = ins "pop" csv1 $ sform 0x0b 0x0
 161 disc _ = ins "disc" csv1' $ sform' 0x0b 0x1 0
 162 fetch _ = ins "fetch" csv1 $ sform 0x0b 0x2
 163 push _ = ins "push" csv1 $ sform 0x0b 0x3
 164 movpf _ = ins "movpf" csv1 $ sform 0x0c 0x2
 165 movsf _ = ins "movsf" csv1 $ sform 0x0c 0x0
 166 movpt _ = ins "movpt" csv1 $ sform 0x0d 0x2
 167 movst _ = ins "movst" csv1 $ sform 0x0d 0x0
 168 ldw dict = ins "ldw" (csv2m dict) $ mformi 0x0e
 169 ldh dict = ins "ldh" (csv2m dict) $ mformi 0x10
 170 ldb dict = ins "ldb" (csv2m dict) $ mformi 0x12
 171 ldi dict = ins "ldi" (csv2i_sl dict) $ lformi' 0x1a
 172 ldil dict = ins "ldil" (csv2i_sl' dict) $ lformi' 0x1a 0
 173 stw dict = ins "stw" (csv2m dict) $ mformi 0x0f
 174 sth dict = ins "sth" (csv2m dict) $ mformi 0x11
 175 stb dict = ins "stb" (csv2m dict) $ mformi 0x13
 176 ldx dict = ins "ldx" (csv2m dict) $ mformi 0x14
 177 stx dict = ins "stx" (csv2m dict) $ mformi 0x15
 178 -- misc
 179 -- set signed by default! in very rare cases this can be an issue.
 180 br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1
 181 call dict = ins "call" (csv0i_p dict) $ bform 0x16 0x1 1
 182 ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2
 183 reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3
 184 brr _ = ins "brr" csv1_p $ brrform 0x17 0
 185 callr _ = ins "callr" csv1_p $ brrform 0x17 1
 186 cmp _ = ins "cmp" csv2 $ mformi' 0x18
 187 cmpi dict = ins "cmpi" (csv2i dict) $ lformi 0x19 0 0 0
 188
 189 -- instruction formats
 190 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)]
 191         where free = 0
 192
 193 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)]
 194 aformi' opcd s c d cond rd ra = aformi opcd s c d cond rd ra 0
 195
 196 lformi opcd hl f d cond rd imm = pack [(cond,28),(opcd,23),(rd,19),(imm,3),(hl,2),(f,1),(d,0)]
 197 lformi' opcd hl s cond rd imm = lformi opcd s hl 0 cond rd imm
 198 lformi'not opcd cond rd = lformi opcd 0 1 0 cond rd 0xffff
 199
 200 mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)]
 201 mformi' opcd cond rd = mformi opcd cond rd 0
 202
 203 bform opcd typ s cond bp imm = pack [(cond,28),(opcd,23),(imm,7),(free,4),(typ,2),(bp,1),(s,0)]
 204         where free = 0
 205 bform' opcd typ cond bp = bform opcd typ 0 cond bp 0
 206
 207 sform opcd typ cond rd = pack [(cond,28),(opcd,23),(rd,19),(typ,17)]
 208 sform' opcd typ rd cond = sform opcd typ cond rd
 209
 210 brrform opcd typ cond ra = pack [(cond,28),(opcd,23),(ra,19),(typ,2)]
 211
 212 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)]
 213
 214 -- bit-packing --
 215 pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
 216
 217 -- condition table
 218 conds :: [(String,Word32)]
 219 conds = [
 220         ("nq", 0x0), ("nz", 0x0),
 221         ("eq", 0x1), ("zs", 0x1),
 222         ("no", 0x2),
 223         ("ov", 0x3),
 224         ("nc", 0x4), ("ae", 0x4),
 225         ("cs", 0x5), ("bl", 0x5),
 226         ("ns", 0x6), ("nn", 0x6),
 227         ("ss", 0x7), ("ns", 0x7),
 228         ("ab", 0x8),
 229         ("be", 0x9),
 230         ("ge", 0xa),
 231         ("lt", 0xb),
 232         ("gt", 0xc),
 233         ("le", 0xd),
 234         ("nv", 0xf),
 235         ("", 0xe) -- always
 236         ]