3a_asm/DT.hs

   1 module DT where
   2
   3 import Prelude hiding (and,or)
   4
   5 import Data.Bits hiding (xor)
   6 import qualified Data.Map as Map
   7 import Data.Word
   8 import Text.Printf
   9 import Text.Parsec
  10 import Text.Parsec.String
  11 import Text.Parsec.Combinator
  12 import Control.Monad
  13 import Control.Applicative hiding ((<|>))
  14
  15 parseInstructions = many1 instruction
  16
  17 testins :: String -> IO ()
  18 testins input =
  19         case (parse instruction "" (input++"\n")) of
  20                 Left err -> do { putStr "fail :/"; print err}
  21                 Right x -> do { printf "0x%08X\n" x }
  22
  23 -- parsing --
  24 instruction :: Parser Word32
  25 instruction = foldl1 (<|>) (fmap try instructions) <* char '\n'
  26
  27 instructions = [add]
  28
  29 comma = char ','
  30 mnem m = string m
  31
  32 iLit :: Parser Word32
  33 iLit = liftM read (many1 digit)
  34
  35 imm4 :: Parser String
  36 imm4 = do
  37         try (do a <- digit; b <- digit; return $ [a,b]) <|> (do a <- digit; return $ [a])
  38
  39 read4imm :: String -> Word32
  40 read4imm s = if erg > 15 then error "invalid register" else erg
  41         where erg = read s
  42
  43 reg :: Parser Word32
  44 reg = do {string "r"; liftM read4imm (imm4)}
  45
  46 condition :: Parser Word32
  47 condition = do
  48         str <- foldl1 (<|>) (fmap (try . string . fst) conds)
  49         let (Just ret) = lookup str conds
  50         return $ ret
  51
  52 carry :: Parser Word32
  53 carry = do { char 'c'; return 1} <|> do {string ""; return 0}
  54
  55 updateDisable :: Parser Word32
  56 updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0}
  57
  58 highlow :: Parser Word32
  59 highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0}
  60
  61 fill :: Parser Word32
  62 fill = do { char 'f'; return 1} <|> do {string ""; return 0}
  63
  64 sign :: Parser Word32
  65 sign = do { char 's'; return 1} <|> do {string ""; return 0}
  66
  67 branchpred :: Parser Word32
  68 branchpred = do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
  69
  70 shiftArith :: Parser Word32
  71 shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0}
  72
  73 (<.>) p n = p<*comma<*>n
  74 (<%>) p n = p<*space<*>n
  75 (<@>) p n = p<*char '('<*>n<*char ')'
  76 infixl 1 <.>
  77 infixl 1 <%>
  78 infixl 1 <@>
  79
  80 {-
  81 addi = ins "addi" csv3 $ aform
  82 dform'a opcd rt ra d = pack [(opcd,6),(rt,11),(ra,16),(d,0)]
  83 -}
  84
  85 add = ins "add" csv3 $ aform 0
  86
  87
  88 ---
  89 ins m form e  = mnem m>>form e
  90 v1 f = f<$>iLit
  91 csv2 f =f<$>iLit<.>iLit
  92 csv3 f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
  93 csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit
  94 csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit
  95
  96 -- instruction formats
  97 aform :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32
  98 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)]
  99         where free = 0
 100
 101 -- ppc64 stuff
 102 iform opcd aa lk li = pack [(opcd,6),(li,30),(aa,31),(lk,0)]
 103 bform opcd aa lk bo bi bd = pack [(opcd,6),(bo,11),(bi,16),(bd,30),(aa,31),(lk,0)]
 104 scform opcd lev = pack [(opcd,6),(lev,27),(1,31)]
 105 dform'b opcd bf l ra si = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(si,0)]
 106 dsform opcd rt ra ds xo = pack [(opcd,6),(rt,11),(ra,16),(ds,30),(xo,0)]
 107 xform'a opcd rt ra rb xo = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(xo,31)]
 108 xform'b opcd xo bf l ra rb = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(rb,21),(xo,31),(0,0)]
 109 xform'c opcd xo rs ra rb rc = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(xo,31),(rc,0)]
 110 xform'd opcd xo rc rs ra = pack [(opcd,6),(rs,11),(ra,16),(0,21),(xo,31),(rc,0)]
 111 xlform'a opcd xo bt ba bb = pack [(opcd,6),(bt,11),(ba,16),(bb,21),(xo,31)]
 112 xlform'b opcd xo lk bo bi bh = pack [(opcd,6),(bo,11),(bi,16),(bh,21),(xo,31),(lk,0)]
 113 xlform'c opcd xo bf bfa = pack [(opcd,6),(bf,9),(bfa,14),(xo,31)]
 114 xfxform opcd xo rs spr = pack [(opcd,6),(rs,11),(spr,21),(xo,31)]
 115 xfxform'b opcd h xo fxm rs = pack [(opcd,6),(rs,11),(h,12),(fxm,20),(xo,31)]
 116 --xflform
 117 -- fix xsform
 118 xsform opcd xo rc ra rs sh = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(xo,30),(sh,31),(rc,0)]
 119 xoform' opcd xo oe rc rt ra = pack [(opcd,6),(rt,11),(ra,16),(0,21),(oe,22),(xo,31),(rc,0)]
 120 --aform
 121 mform opcd rc ra rs sh mb me = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,26),(me,31),(rc,0)]
 122 -- mdform needs to be fixed to handle sh correctly
 123 mdform opcd h rc ra rs sh mb = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,27),(h,30),(sh,31),(rc,0)]
 124 mdsform opcd h rc ra rs rb mb = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(mb,27),(h,31),(rc,0)]
 125
 126 -- bit-packing --
 127 pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
 128
 129 -- condition table
 130 conds :: [(String,Word32)]
 131 conds = [
 132         ("nq", 0x0), ("nz", 0x0),
 133         ("eq", 0x1), ("zs", 0x1),
 134         ("no", 0x2),
 135         ("ov", 0x3),
 136         ("nc", 0x4), ("ae", 0x4),
 137         ("cs", 0x5), ("bl", 0x5),
 138         ("ns", 0x6), ("nn", 0x6),
 139         ("ss", 0x7), ("ns", 0x7),
 140         ("ab", 0x8),
 141         ("be", 0x9),
 142         ("ge", 0xa),
 143         ("lt", 0xb),
 144         ("gt", 0xc),
 145         ("le", 0xd),
 146         ("nv", 0xf),
 147         ("", 0xe) -- always
 148         ]