From 6eca79af925f3c735fcab6879d4e52c0bfd06fb0 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Mon, 1 Nov 2010 00:40:41 +0100 Subject: [PATCH] 3a_asm: 'sum.s' is parseable now :) --- 3a_asm/DT.hs | 110 ++++++++++++++++++++++++++++++++++----------- 3a_asm/DTFormat.hs | 25 +++++++++++ 3a_asm/Main.hs | 37 +++++++-------- 3 files changed, 124 insertions(+), 48 deletions(-) diff --git a/3a_asm/DT.hs b/3a_asm/DT.hs index 61f12f5..caf8f0f 100644 --- a/3a_asm/DT.hs +++ b/3a_asm/DT.hs @@ -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)] diff --git a/3a_asm/DTFormat.hs b/3a_asm/DTFormat.hs index 7c3681e..8c3d495 100644 --- a/3a_asm/DTFormat.hs +++ b/3a_asm/DTFormat.hs @@ -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 diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs index df442a4..2515674 100644 --- a/3a_asm/Main.hs +++ b/3a_asm/Main.hs @@ -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 + -- 2.25.1