5 import Prelude hiding (and,or)
7 import Data.Bits hiding (xor)
8 import qualified Data.Map as Map
12 import Text.Parsec.String
13 import Text.Parsec.Combinator
15 import Control.Applicative hiding ((<|>))
19 instruction :: Dict -> Parser Word32
20 instruction dict = foldl1 (<|>) (fmap (\x -> try (x dict)) instructions) <* char '\n'
22 testins :: String -> IO ()
24 case (parse (instruction dict) "" (input++"\n")) of
25 Left err -> do { putStr "fail :/\n"; print err}
26 Right x -> do { printf "0x%08X\n" x }
28 dict = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)])
34 iLabel :: Dict -> Parser Word32
35 iLabel (addr,dict) = do
36 s <- foldl1 (<|>) (fmap (try . string . fst) dict)
37 let lab = get_elem s dict
38 return $ ((lab - addr) .&. 0xefff)
41 iLit = do { parseMySpaces; ret <- liftM read (many1 digit); parseMySpaces; return ret}
50 try (do a <- digit; b <- digit; return $ [a,b]) <|> (do a <- digit; return $ [a])
52 read4imm :: String -> Word32
53 read4imm s = if erg > 15 then error "invalid register" else erg
57 reg = do {parseMySpaces; string "r"; ret <- liftM read4imm (imm4); parseMySpaces; return ret}
59 condition :: Parser Word32
61 str <- foldl1 (<|>) (fmap (try . string . fst) conds)
62 let (Just ret) = lookup str conds
65 carry :: Parser Word32
66 carry = do { char 'c'; return 1} <|> do {string ""; return 0}
68 updateDisable :: Parser Word32
69 updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0}
71 highlow :: Parser Word32
72 highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0}
75 fill = do { char 'f'; return 1} <|> do {string ""; return 0}
78 sign = do { char 's'; return 1} <|> do {string ""; return 0}
80 branchpred :: Parser Word32
82 x <- do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
86 shiftArith :: Parser Word32
87 shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0}
89 (<.>) p n = p<*comma<*>n
90 (<%>) p n = p<*space<*>n
91 (<@>) p n = p<*char '('<*>n<*char ')'
96 ins m form e = do {mnem m; form e}
97 csv0i_p dict f = f<$>condition<*>branchpred<*>(iLabel dict)
98 csv0i_p' f = f<$>condition<*>branchpred
99 csv2_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg
100 csv2m f = f<$>condition<%>reg<.>iLit15<@>reg
101 csv2i_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>iLit12
102 csv2i_sl f = f<$>sign<*>highlow<*>condition<%>reg<.>iLit16
103 csv2i_lfd f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>iLit16
104 csv3_cd f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
105 csv3_d f = f<$>updateDisable<*>condition<%>reg<.>reg<.>reg
107 -- ppc64 stuff (TODO: remove)
109 csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit
110 csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit
113 instructions = [add, addi, mov, sub, subi,
115 --, or, orx, xor, xorx,not]
116 -- pop, push, disc, fetch
117 -- movpf, movsf, movpt, movst
129 add _ = ins "add" csv3_cd $ aform 0x00
130 addi _ = ins "addi" csv2i_scd $ aformi 0x02
131 mov _ = ins "mov" csv2_scd $ aformi' 0x02
132 sub _ = ins "sub" csv3_cd $ aform 0x01
133 subi _ = ins "subi" csv2i_scd $ aformi 0x03
135 and _ = ins "and" csv3_d $ aform 0x04 0
136 andx _ = ins "andx" csv2i_lfd $ lformi 0x05
138 ldw _ = ins "ldw" csv2m $ mformi 0x0e
139 ldi _ = ins "ldi" csv2i_sl $ lformi' 0x1a
141 -- set signed by default! in very rare cases this can be an issue.
142 br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1
143 ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2
144 reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3
146 -- instruction formats
147 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)]
150 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)]
151 aformi' opcd s c d cond rd ra = aformi opcd s c d cond rd ra 0
153 lformi opcd hl f d cond rd imm = pack [(cond,28),(opcd,23),(rd,19),(imm,3),(hl,2),(f,1),(d,0)]
154 lformi' opcd s hl cond rd imm = lformi opcd s hl 0 cond rd imm
156 mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)]
158 bform opcd typ s cond bp imm = pack [(cond,28),(opcd,23),(imm,7),(free,4),(typ,2),(bp,1),(s,0)]
160 bform' opcd typ cond bp = bform opcd typ 0 cond bp 0
162 -- ppc64 stuff (TODO: remove)
163 iform opcd aa lk li = pack [(opcd,6),(li,30),(aa,31),(lk,0)]
164 scform opcd lev = pack [(opcd,6),(lev,27),(1,31)]
165 dform'b opcd bf l ra si = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(si,0)]
166 dsform opcd rt ra ds xo = pack [(opcd,6),(rt,11),(ra,16),(ds,30),(xo,0)]
167 xform'a opcd rt ra rb xo = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(xo,31)]
168 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)]
169 xform'c opcd xo rs ra rb rc = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(xo,31),(rc,0)]
170 xform'd opcd xo rc rs ra = pack [(opcd,6),(rs,11),(ra,16),(0,21),(xo,31),(rc,0)]
171 xlform'a opcd xo bt ba bb = pack [(opcd,6),(bt,11),(ba,16),(bb,21),(xo,31)]
172 xlform'b opcd xo lk bo bi bh = pack [(opcd,6),(bo,11),(bi,16),(bh,21),(xo,31),(lk,0)]
173 xlform'c opcd xo bf bfa = pack [(opcd,6),(bf,9),(bfa,14),(xo,31)]
174 xfxform opcd xo rs spr = pack [(opcd,6),(rs,11),(spr,21),(xo,31)]
175 xfxform'b opcd h xo fxm rs = pack [(opcd,6),(rs,11),(h,12),(fxm,20),(xo,31)]
178 xsform opcd xo rc ra rs sh = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(xo,30),(sh,31),(rc,0)]
179 xoform' opcd xo oe rc rt ra = pack [(opcd,6),(rt,11),(ra,16),(0,21),(oe,22),(xo,31),(rc,0)]
181 mform opcd rc ra rs sh mb me = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,26),(me,31),(rc,0)]
182 -- mdform needs to be fixed to handle sh correctly
183 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)]
184 mdsform opcd h rc ra rs rb mb = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(mb,27),(h,31),(rc,0)]
187 pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
190 conds :: [(String,Word32)]
192 ("nq", 0x0), ("nz", 0x0),
193 ("eq", 0x1), ("zs", 0x1),
196 ("nc", 0x4), ("ae", 0x4),
197 ("cs", 0x5), ("bl", 0x5),
198 ("ns", 0x6), ("nn", 0x6),
199 ("ss", 0x7), ("ns", 0x7),