module DT where
+import DTFormat
+
import Prelude hiding (and,or)
import Data.Bits hiding (xor)
import Control.Monad
import Control.Applicative hiding ((<|>))
-parseInstructions = many1 instruction
+
+-- parsing --
+instruction :: Dict -> Parser Word32
+instruction dict = foldl1 (<|>) (fmap (\x -> try (x dict)) instructions) <* char '\n'
testins :: String -> IO ()
testins input =
- case (parse instruction "" (input++"\n")) of
- Left err -> do { putStr "fail :/"; print err}
+ case (parse (instruction dict) "" (input++"\n")) of
+ Left err -> do { putStr "fail :/\n"; print err}
Right x -> do { printf "0x%08X\n" x }
+ where
+ dict = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)])
--- parsing --
-instruction :: Parser Word32
-instruction = foldl1 (<|>) (fmap try instructions) <* char '\n'
-
-instructions = [add]
comma = char ','
mnem m = string m
+iLabel :: Dict -> Parser Word32
+iLabel (addr,dict) = do
+ s <- foldl1 (<|>) (fmap (try . string . fst) dict)
+ let lab = get_elem s dict
+ return $ ((lab - addr) .&. 0xefff)
+
iLit :: Parser Word32
-iLit = liftM read (many1 digit)
+iLit = do { parseMySpaces; ret <- liftM read (many1 digit); parseMySpaces; return ret}
+
+-- TODO: ...
+iLit12 = iLit
+iLit15 = iLit
+iLit16 = iLit
imm4 :: Parser String
imm4 = do
where erg = read s
reg :: Parser Word32
-reg = do {string "r"; liftM read4imm (imm4)}
+reg = do {parseMySpaces; string "r"; ret <- liftM read4imm (imm4); parseMySpaces; return ret}
condition :: Parser Word32
condition = do
let (Just ret) = lookup str conds
return $ ret
+carry :: Parser Word32
+carry = do { char 'c'; return 1} <|> do {string ""; return 0}
+
+updateDisable :: Parser Word32
+updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0}
+
+highlow :: Parser Word32
+highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0}
+
+fill :: Parser Word32
+fill = do { char 'f'; return 1} <|> do {string ""; return 0}
+
+sign :: Parser Word32
+sign = do { char 's'; return 1} <|> do {string ""; return 0}
+
+branchpred :: Parser Word32
+branchpred = do
+ x <- do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
+ parseMySpaces
+ return x
+
+shiftArith :: Parser Word32
+shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0}
+
(<.>) p n = p<*comma<*>n
(<%>) p n = p<*space<*>n
(<@>) p n = p<*char '('<*>n<*char ')'
infixl 1 <%>
infixl 1 <@>
-{-
-addi = ins "addi" csv3 $ aform
-dform'a opcd rt ra d = pack [(opcd,6),(rt,11),(ra,16),(d,0)]
--}
-
-add = ins "add" csv3 $ aform 0 0 0
-
-
----
-ins m form e = mnem m>>form e
+ins m form e = do {mnem m; form e}
+csv0i_p dict f = f<$>condition<*>branchpred<*>(iLabel dict)
+csv0i_p' f = f<$>condition<*>branchpred
+csv2_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg
+csv2m f = f<$>condition<%>reg<.>iLit15<@>reg
+csv2i_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>iLit12
+csv2i_sl f = f<$>sign<*>highlow<*>condition<%>reg<.>iLit16
+csv2i_lfd f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>iLit16
+csv3_cd f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
+csv3_d f = f<$>updateDisable<*>condition<%>reg<.>reg<.>reg
+
+-- ppc64 stuff (TODO: remove)
v1 f = f<$>iLit
-csv2 f =f<$>iLit<.>iLit
-csv3 f = f<$>condition<%>reg<.>reg<.>reg
csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit
csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit
+
+instructions = [add, addi, mov, sub, subi,
+ and, andx,
+ --, or, orx, xor, xorx,not]
+ -- pop, push, disc, fetch
+ -- movpf, movsf, movpt, movst
+ -- ldh, ldb
+ ldw, ldi,
+ -- stw, sth, stb
+ -- ldx, stx
+ -- call, reti
+ br, ret
+ -- brr, callr
+ -- cmp, cmpi
+ ]
+
+-- arithmetic
+add _ = ins "add" csv3_cd $ aform 0x00
+addi _ = ins "addi" csv2i_scd $ aformi 0x02
+mov _ = ins "mov" csv2_scd $ aformi' 0x02
+sub _ = ins "sub" csv3_cd $ aform 0x01
+subi _ = ins "subi" csv2i_scd $ aformi 0x03
+-- logic
+and _ = ins "and" csv3_d $ aform 0x04 0
+andx _ = ins "andx" csv2i_lfd $ lformi 0x05
+-- memory
+ldw _ = ins "ldw" csv2m $ mformi 0x0e
+ldi _ = ins "ldi" csv2i_sl $ lformi' 0x1a
+-- misc
+-- set signed by default! in very rare cases this can be an issue.
+br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1
+ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2
+reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3
+
-- instruction formats
-aform :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32
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)]
where free = 0
--- ppc64 stuff
+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)]
+aformi' opcd s c d cond rd ra = aformi opcd s c d cond rd ra 0
+
+lformi opcd hl f d cond rd imm = pack [(cond,28),(opcd,23),(rd,19),(imm,3),(hl,2),(f,1),(d,0)]
+lformi' opcd s hl cond rd imm = lformi opcd s hl 0 cond rd imm
+
+mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)]
+
+bform opcd typ s cond bp imm = pack [(cond,28),(opcd,23),(imm,7),(free,4),(typ,2),(bp,1),(s,0)]
+ where free = 0
+bform' opcd typ cond bp = bform opcd typ 0 cond bp 0
+
+-- ppc64 stuff (TODO: remove)
iform opcd aa lk li = pack [(opcd,6),(li,30),(aa,31),(lk,0)]
-bform opcd aa lk bo bi bd = pack [(opcd,6),(bo,11),(bi,16),(bd,30),(aa,31),(lk,0)]
scform opcd lev = pack [(opcd,6),(lev,27),(1,31)]
dform'b opcd bf l ra si = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(si,0)]
dsform opcd rt ra ds xo = pack [(opcd,6),(rt,11),(ra,16),(ds,30),(xo,0)]
projects / calu.git / blobdiff