X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=3a_asm%2FDT.hs;h=c80186ca399447d171e1eae70e7f17f99427f9ee;hb=c45536d352d3a45f6bbc7627c8bd5d0163ba054e;hp=caf8f0f3e447d65816dc57edfc9302db605281c1;hpb=6eca79af925f3c735fcab6879d4e52c0bfd06fb0;p=calu.git diff --git a/3a_asm/DT.hs b/3a_asm/DT.hs index caf8f0f..c80186c 100644 --- a/3a_asm/DT.hs +++ b/3a_asm/DT.hs @@ -1,8 +1,9 @@ module DT where import DTFormat +import Expr_eval -import Prelude hiding (and,or) +import Prelude hiding (not,and,or) import Data.Bits hiding (xor) import qualified Data.Map as Map @@ -16,34 +17,42 @@ import Control.Applicative hiding ((<|>)) -- parsing -- -instruction :: [DictLabel] -> Parser Word32 -instruction dict = foldl1 (<|>) (fmap (\x -> try (x dict)) instructions) <* char '\n' +instruction :: LineNo -> Dict -> Parser Word32 +instruction lno dict = foldl1 (<|>) (fmap (\x -> try (x dict)) instructions) <* char '\n' (". something at line " ++ show lno ++ " is wrong (ignore line 1 hint above, but pay attention for possible line offset due to #include).") testins :: String -> IO () testins input = - case (parse (instruction dict) "" (input++"\n")) of + case (parse (instruction 0 dict) "" (input++"\n")) of Left err -> do { putStr "fail :/\n"; print err} Right x -> do { printf "0x%08X\n" x } where - dict = [("lolz", 0x1337), ("rofl", 0xaaaa)] + dict = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)]) comma = char ',' mnem m = string m -iLabel :: [DictLabel] -> Parser Word32 -iLabel dict = do - s <- foldl1 (<|>) (fmap (try . string . fst) dict) - let (Just ret) = get_label s dict - return ret +iLabel :: Dict -> Parser Word32 +-- TODO: save msb (=sign) correctly... +iLabel d@(aktadr,_) = do {i <- (iLit d); return $ ((i - aktadr)`div`4) .&. 0xffff} + +iLit :: Dict -> Parser Word32 +iLit (_,d) = do + parseMySpaces + val <- expr d; + try (do { + string "@hi"; parseMySpaces; + return $ shiftR val 16 + }) <|> do { + string "@lo"; parseMySpaces; + return $ val .&. 0xffff + } <|> do {parseMySpaces; return val} -iLit :: Parser Word32 -iLit = do { parseMySpaces; ret <- liftM read (many1 digit); parseMySpaces; return ret} --- TODO: ... -iLit12 = iLit -iLit15 = iLit -iLit16 = iLit +iLit5 d = do i <- iLit d; return $ i .&. 0x001f +iLit12 d = do i <- iLit d; return $ i .&. 0x0fff +iLit15 d = do i <- iLit d; return $ i .&. 0x7fff +iLit16 d = do i <- iLit d; return $ i .&. 0xffff imm4 :: Parser String imm4 = do @@ -68,6 +77,9 @@ carry = do { char 'c'; return 1} <|> do {string ""; return 0} updateDisable :: Parser Word32 updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0} +highonly :: Parser Word32 +highonly = do { char 'h'; return 1} <|> do {string ""; return 0} + highlow :: Parser Word32 highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0} @@ -86,60 +98,94 @@ branchpred = do shiftArith :: Parser Word32 shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0} +parseBracketClose :: Parser Char +parseBracketClose = do { c <- char ')'; parseMySpaces; return c} + (<.>) p n = p<*comma<*>n (<%>) p n = p<*space<*>n -(<@>) p n = p<*char '('<*>n<*char ')' +(<@>) p n = p<*char '('<*>n<*parseBracketClose infixl 1 <.> infixl 1 <%> infixl 1 <@> ins m form e = do {mnem m; form e} -csv0i_sp dict f = f<$>sign<*>condition<*>branchpred<*>(iLabel dict) -csv0i_sp' f = f<$>sign<*>condition<*>branchpred +csv0i_p dict f = f<$>condition<*>branchpred<*>(iLabel dict) +csv0i_p' f = f<$>condition<*>branchpred +csv1 f = f<$>condition<%>reg +csv1' f = f<$>condition +csv1_p f = f<$>condition<%>reg +csv2 f = f<$>condition<%>reg<.>reg +csv2i dict f = f<$>condition<%>reg<.>(iLit16 dict) 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 +csv2m dict f = f<$>condition<%>reg<.>(iLit15 dict)<@>reg +csv2i_cd dict f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict) +csv2i_d dict f = f<$>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict) +csv2i_scd dict f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit12 dict) +csv2i_sl dict f = f<$>highonly<*>sign<*>condition<%>reg<.>(iLit16 dict) +csv2i_sl' dict f = f<$>sign<*>condition<%>reg<.>(iLit16 dict) +csv2i_lfd dict f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>(iLit16 dict) 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 -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 - -- brreg - -- cmp, cmpi + and, andx, or, orx, xor, xorx, not, + lls, lrs, ars, + pop, push, disc, fetch, + movpf, movsf, movpt, movst, + ldh, ldb, ldw, ldi, ldil, + stw, sth, stb, + ldx, stx, + br, ret, call, reti, + brr, callr, + cmp, cmpi ] -- arithmetic add _ = ins "add" csv3_cd $ aform 0x00 -addi _ = ins "addi" csv2i_scd $ aformi 0x02 +addi dict = ins "addi" (csv2i_scd dict) $ aformi 0x02 mov _ = ins "mov" csv2_scd $ aformi' 0x02 sub _ = ins "sub" csv3_cd $ aform 0x01 -subi _ = ins "subi" csv2i_scd $ aformi 0x03 +subi dict = ins "subi" (csv2i_scd dict) $ aformi 0x03 -- logic and _ = ins "and" csv3_d $ aform 0x04 0 -andx _ = ins "andx" csv2i_lfd $ lformi 0x05 +andx dict = ins "andx" (csv2i_lfd dict) $ lformi 0x05 +or _ = ins "or" csv3_d $ aform 0x06 0 +orx dict = ins "orx" (csv2i_lfd dict) $ lformi 0x07 +xor _ = ins "xor" csv3_d $ aform 0x08 0 +xorx dict = ins "xorx" (csv2i_lfd dict) $ lformi 0x09 +not _ = ins "not" csv1 $ lformi'not 0x09 +lls dict = ins "lls" (csv2i_cd dict) $ shiform 0x0a 0 0 +lrs dict = ins "lrs" (csv2i_cd dict) $ shiform 0x0a 1 0 +ars dict = ins "ars" (csv2i_d dict) $ shiform 0x0a 1 1 0 -- memory -ldw _ = ins "ldw" csv2m $ mformi 0x0e -ldi _ = ins "ldi" csv2i_sl $ lformi' 0x1a +pop _ = ins "pop" csv1 $ sform 0x0b 0x0 +disc _ = ins "disc" csv1' $ sform' 0x0b 0x1 0 +fetch _ = ins "fetch" csv1 $ sform 0x0b 0x2 +push _ = ins "push" csv1 $ sform 0x0b 0x3 +movpf _ = ins "movpf" csv1 $ sform 0x0c 0x2 +movsf _ = ins "movsf" csv1 $ sform 0x0c 0x0 +movpt _ = ins "movpt" csv1 $ sform 0x0d 0x2 +movst _ = ins "movst" csv1 $ sform 0x0d 0x0 +ldw dict = ins "ldw" (csv2m dict) $ mformi 0x0e +ldh dict = ins "ldh" (csv2m dict) $ mformi 0x10 +ldb dict = ins "ldb" (csv2m dict) $ mformi 0x12 +ldi dict = ins "ldi" (csv2i_sl dict) $ lformi' 0x1a +ldil dict = ins "ldil" (csv2i_sl' dict) $ lformi' 0x1a 0 +stw dict = ins "stw" (csv2m dict) $ mformi 0x0f +sth dict = ins "sth" (csv2m dict) $ mformi 0x11 +stb dict = ins "stb" (csv2m dict) $ mformi 0x13 +ldx dict = ins "ldx" (csv2m dict) $ mformi 0x14 +stx dict = ins "stx" (csv2m dict) $ mformi 0x15 -- misc -br dict = ins "br" (csv0i_sp dict) $ bform 0x16 0x0 -ret _ = ins "ret" csv0i_sp' $ bform' 0x16 0x2 +-- set signed by default! in very rare cases this can be an issue. +br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1 +call dict = ins "call" (csv0i_p dict) $ bform 0x16 0x1 1 +ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2 +reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3 +brr _ = ins "brr" csv1_p $ brrform 0x17 0 +callr _ = ins "callr" csv1_p $ brrform 0x17 1 +cmp _ = ins "cmp" csv2 $ mformi' 0x18 +cmpi dict = ins "cmpi" (csv2i dict) $ lformi 0x19 0 0 0 -- instruction formats 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)] @@ -149,37 +195,22 @@ aformi opcd s c d cond rd ra imm = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(im 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 +lformi' opcd hl s cond rd imm = lformi opcd s hl 0 cond rd imm +lformi'not opcd cond rd = lformi opcd 0 1 0 cond rd 0xffff mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)] +mformi' opcd cond rd = mformi opcd cond rd 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 s cond bp = bform opcd typ s cond bp 0 - --- ppc64 stuff (TODO: remove) -iform opcd aa lk li = pack [(opcd,6),(li,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)] -xform'a opcd rt ra rb xo = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(xo,31)] -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)] -xform'c opcd xo rs ra rb rc = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(xo,31),(rc,0)] -xform'd opcd xo rc rs ra = pack [(opcd,6),(rs,11),(ra,16),(0,21),(xo,31),(rc,0)] -xlform'a opcd xo bt ba bb = pack [(opcd,6),(bt,11),(ba,16),(bb,21),(xo,31)] -xlform'b opcd xo lk bo bi bh = pack [(opcd,6),(bo,11),(bi,16),(bh,21),(xo,31),(lk,0)] -xlform'c opcd xo bf bfa = pack [(opcd,6),(bf,9),(bfa,14),(xo,31)] -xfxform opcd xo rs spr = pack [(opcd,6),(rs,11),(spr,21),(xo,31)] -xfxform'b opcd h xo fxm rs = pack [(opcd,6),(rs,11),(h,12),(fxm,20),(xo,31)] ---xflform --- fix xsform -xsform opcd xo rc ra rs sh = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(xo,30),(sh,31),(rc,0)] -xoform' opcd xo oe rc rt ra = pack [(opcd,6),(rt,11),(ra,16),(0,21),(oe,22),(xo,31),(rc,0)] ---aform -mform opcd rc ra rs sh mb me = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,26),(me,31),(rc,0)] --- mdform needs to be fixed to handle sh correctly -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)] -mdsform opcd h rc ra rs rb mb = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(mb,27),(h,31),(rc,0)] +bform' opcd typ cond bp = bform opcd typ 0 cond bp 0 + +sform opcd typ cond rd = pack [(cond,28),(opcd,23),(rd,19),(typ,17)] +sform' opcd typ rd cond = sform opcd typ cond rd + +brrform opcd typ cond ra = pack [(cond,28),(opcd,23),(ra,19),(typ,2)] + +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)] -- bit-packing -- pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf