3a_asm: 'sum.s' is parseable now :)
authorBernhard Urban <lewurm@gmail.com>
Sun, 31 Oct 2010 23:40:41 +0000 (00:40 +0100)
committerBernhard Urban <lewurm@gmail.com>
Sun, 31 Oct 2010 23:40:41 +0000 (00:40 +0100)
3a_asm/DT.hs
3a_asm/DTFormat.hs
3a_asm/Main.hs

index 61f12f56a271b97aad27d812abb65f8ad05541b4..caf8f0f3e447d65816dc57edfc9302db605281c1 100644 (file)
@@ -1,5 +1,7 @@
 module DT where
 
+import DTFormat
+
 import Prelude hiding (and,or)
 
 import Data.Bits hiding (xor)
@@ -12,25 +14,36 @@ import Text.Parsec.Combinator
 import Control.Monad
 import Control.Applicative hiding ((<|>))
 
-parseInstructions = many1 instruction
+
+-- parsing --
+instruction :: [DictLabel] -> 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 = [("lolz", 0x1337), ("rofl", 0xaaaa)]
 
--- parsing --
-instruction :: Parser Word32
-instruction = foldl1 (<|>) (fmap try instructions) <* char '\n'
-
-instructions = [add]
 
 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
+
 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
@@ -41,7 +54,7 @@ read4imm s = if erg > 15 then error "invalid register" else erg
        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
@@ -65,7 +78,10 @@ sign :: Parser Word32
 sign = do { char 's'; return 1} <|> do {string ""; return 0}
 
 branchpred :: Parser Word32
-branchpred = do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
+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}
@@ -77,30 +93,72 @@ infixl 1 <.>
 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
-
-
----
-ins m form e  = mnem m>>form e
+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
+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<$>carry<*>updateDisable<*>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
+       -- brreg
+       -- 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
+br dict = ins "br" (csv0i_sp dict) $ bform 0x16 0x0
+ret _ = ins "ret" csv0i_sp' $ bform' 0x16 0x2
+
 -- 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 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)]
-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)]
index 7c3681e668d8df5dd155438537e38e52b50fa070..8c3d495655cce50852446804b29f849d00f13285 100644 (file)
@@ -2,6 +2,10 @@ module DTFormat where
 
 import Data.Word
 import Text.Printf
+import Text.Parsec
+import Text.Parsec.String
+import Text.Parsec.Combinator
+import Control.Monad
 
 data DT_State = NoState | InData | InText deriving (Show,Eq)
 
@@ -39,3 +43,24 @@ showsDTF (DTF_State s) = (++) (printf "sta;%s\n" (show s))
 datins :: String -> Address -> Value -> Code -> Label -> Comment -> String
 datins = printf "%s;%08x;%08x;%s;%s;%s\n"
 
+
+type DictLabel = (String,Word32)
+
+get_label :: String -> [DictLabel] -> Maybe Word32
+get_label = lookup
+
+add_label :: [DictLabel] -> (String,Word32) -> [DictLabel]
+add_label dic (s,w)
+       | s == "" = dic -- ignore empty string
+       | already_in =  error ("Label " ++ s ++ " already exists")
+       | otherwise = (s,w):dic
+       where
+       already_in = case (get_label s dic) of
+               Just _ -> True
+               Nothing -> False
+
+-- some common functions
+parseMySpaces :: Parser String
+parseMySpaces = do
+       ret <- many $ oneOf "\t "
+       return $ ret
index df442a41d523869416f7db400302bf85c058ee19..2515674cf1444255fe6604d116ff55cc0ea7aa09 100644 (file)
@@ -1,7 +1,6 @@
 -- as for deep thoughts ISA
 -----------------------------------------------------------------------------
 
-module Main where
 
 import DT
 import DTFormat
@@ -31,6 +30,20 @@ main = do
        sequence_ [printf "%10s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
        printf "\nparsed asm:\n"
        sequence_ [printf "%s" (show x) | x <- formatedsrc]
+       let parsed = parseInstr dict formatedsrc
+       printf "\nafter parsing the instructions:\n"
+       sequence_ [printf "%s" (show x) | x <- parsed]
+
+
+parseInstr :: [DictLabel] -> [DTF] -> [DTF]
+parseInstr _ [] = []
+parseInstr dict ((DTF_InstrToParse a instr c l s):xs) =
+       (DTF_Instr a bytecode c l s):(parseInstr dict xs)
+       where
+       bytecode = case (parse (instruction dict) "" (instr++"\n")) of
+               Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err)
+               Right x -> x
+parseInstr dict (x:xs) = x:(parseInstr dict xs)
 
 
 type Counter = Word32
@@ -39,22 +52,6 @@ inc :: Counter -> Counter
 inc = ((+) 4)
 
 
-type DictLabel = (String,Word32)
-
-get_label :: String -> [DictLabel] -> Maybe Word32
-get_label = lookup
-
-add_label :: [DictLabel] -> (String,Word32) -> [DictLabel]
-add_label dic (s,w)
-       | s == "" = dic -- ignore empty string
-       | already_in =  error ("Label " ++ s ++ " already exists")
-       | otherwise = (s,w):dic
-       where
-       already_in = case (get_label s dic) of
-               Just _ -> True
-               Nothing -> False
-
-
 convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> [DictLabel] -> ([DictLabel], [DTF])
 convertDTF [] _ _ _ d = (d,[])
 convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf))
@@ -145,11 +142,6 @@ parseConst = do
        let val = read str
        return $ val
 
-parseMySpaces :: Parser String
-parseMySpaces = do
-       ret <- many $ oneOf "\t "
-       return $ ret
-
 -- teh pars0rs
 lf_data = do
        l <- try (parseLabel) <|> string ""
@@ -196,3 +188,4 @@ lf_stext = do
        string ".text"
        parseMySpaces
        return $ DTF_State InText
+