From 59404aef0c1d2a3de1525d316a2e108efd43a75d Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Sun, 31 Oct 2010 00:30:05 +0200 Subject: [PATCH] 3a_asm: playing around --- 3a_asm/.gitignore | 3 +++ 3a_asm/{PPC64.hs => DT.hs} | 40 +++++++++++++++----------------------- 3a_asm/Main.hs | 39 +++++++++++++------------------------ 3a_asm/Makefile | 3 +++ 3a_asm/notes | 17 ++++++++++++++++ 5 files changed, 52 insertions(+), 50 deletions(-) create mode 100644 3a_asm/.gitignore rename 3a_asm/{PPC64.hs => DT.hs} (89%) create mode 100644 3a_asm/Makefile create mode 100644 3a_asm/notes diff --git a/3a_asm/.gitignore b/3a_asm/.gitignore new file mode 100644 index 0000000..46a244a --- /dev/null +++ b/3a_asm/.gitignore @@ -0,0 +1,3 @@ +*.o +*.hi +dtas diff --git a/3a_asm/PPC64.hs b/3a_asm/DT.hs similarity index 89% rename from 3a_asm/PPC64.hs rename to 3a_asm/DT.hs index 897605c..a5aa64e 100644 --- a/3a_asm/PPC64.hs +++ b/3a_asm/DT.hs @@ -12,13 +12,14 @@ -- ----------------------------------------------------------------------------- -module PPC64 (instruction,parseInstructions) where +module DT where import Prelude hiding (and,or) import Data.Bits hiding (xor) import qualified Data.Map as Map import Data.Word +import Text.Printf import Text.Parsec import Text.Parsec.String import Text.Parsec.Combinator @@ -27,33 +28,18 @@ import Control.Applicative hiding ((<|>)) parseInstructions = many1 instruction +testins :: String -> IO () +testins input = + case (parse instruction "" (input++"\n")) of + Left err -> do { putStr "fail :/"; print err} + Right x -> do { printf "0x%08X\n" x } + -- parsing -- instruction :: Parser Word32 instruction = foldl1 (<|>) (fmap try instructions) <* char '\n' instructions = [ - b,ba,b,bla,bc,bca,bcl,bcla,bclr ,bclrl ,bcctr ,bcctrl , - sc , - crand ,cror ,crxor ,crnand ,crnor ,creqv ,crandc ,crorc , - mcrf , - lbz,lbzx,lbzu,lbzux,lhz,lhzx,lhzu,lhzux,lha,lhax,lhau,lhaux,lwz,lwzx,lwzu,lwzux,lwa,lwax,lwaux,ld,ldx,ldu,ldux, - stb ,stbx ,stbu ,stbux ,sth ,sthx ,sthu ,sthux ,stw ,stwx ,stwu ,stwux ,std ,stdx ,stdu ,stdux , - lhbrx ,lwbrx ,sthbrx ,stwbrx , - lmw,stmw, - lswi ,lswx ,stswi ,stswx , - addi,addis,add,add_,addo,addo_,subf,subf_,subfo,subfo_,addic,addic_,subfic,addc,addc_,addco,addco_,subfc,subfc_,subfco, - subfco_,adde,adde_,addeo,addeo_,subfe,subfe_,subfeo,subfeo_,addme,addme_,addmeo,addmeo_,subfme,subfme_, - subfmeo,subfmeo_,addze,addze_,addzeo,addzeo_,subfze,subfze_,subfzeo,subfzeo_,neg,neg_,nego,nego_,mulli,mulld, - mulld_,mulldo,mulldo_,mullw,mullw_,mullwo,mullwo_,mulhd,mulhd_,mulhw,mulhw_,mulhdu,mulhdu_,mulhwu, - mulhwu_,divd,divd_,divdo,divdo_,divw,divw_,divwo,divwo_,divdu,divdu_,divduo,divduo_,divwu,divwu_,divwuo,divwuo_, - cmpi,cmp,cmpli,cmpl, - tdi,twi,td,tw, - andi_ ,andis_ ,ori ,oris ,xori ,xors ,and ,and_ ,or ,or_ ,xor ,xor_ ,nand ,nand_ ,nor ,nor_ ,eqv ,eqv_ ,andc ,andc_ ,orc ,orc_ ,extsb ,extsb_ ,extsh ,extsh_ ,extsw ,extsw_ ,cntlzd ,cntlzd_ ,popcntb ,cntlzw ,cntlzw_ , - rldicl ,rldicl_ ,rldicr ,rldicr_ ,rldic ,rldic_ ,rlwinm ,rlwinm_ ,rldcl ,rldcl_ ,rldcr ,rldcr_ ,rlwnm ,rlwnm_ ,rldimi ,rldimi_ ,rlwimi ,rlwimi_ , - sld ,sld_ ,slw ,slw_ ,srd ,srd_ ,srw ,srw_ ,sradi ,sradi_ ,srawi ,srawi_ ,srad ,srad_ ,sraw ,sraw_ , - mtspr ,mfspr ,mtcrf , - lfs - ] + add, addi] comma = char ',' mnem m = string m >> space @@ -61,6 +47,12 @@ mnem m = string m >> space iLit :: Parser Word32 iLit = liftM read (many1 digit) +imm5 :: Parser String +imm5 = do {a <- digit; b <- digit; return [a,b]} + +reg :: Parser Word32 +reg = do {string "r"; liftM read (imm5)} + (<.>) p n = p<*comma<*>n (<@>) p n = p<*char '('<*>n<*char ')' infixl 1 <.> @@ -367,7 +359,7 @@ lfs = ins "lfs" csv3 $ dform'a 48 ins m form e = mnem m>>form e v1 f = f<$>iLit csv2 f =f<$>iLit<.>iLit -csv3 f = f<$>iLit<.>iLit<.>iLit +csv3 f = f<$>reg<.>reg<.>iLit csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit diff --git a/3a_asm/Main.hs b/3a_asm/Main.hs index a9b3f64..25b46bb 100644 --- a/3a_asm/Main.hs +++ b/3a_asm/Main.hs @@ -1,43 +1,30 @@ ------------------------------------------------------------------------------ --- --- Module : Main --- Copyright : (c) Jeff Douglas --- License : BSD3 --- --- Maintainer : Jeff Douglas --- Stability : experimental --- Portability : portable --- --- | --- +-- as for deep thoughts ISA ----------------------------------------------------------------------------- module Main where -import PPC64 +import DT import Control.Applicative hiding ((<|>),many) import System.IO import System.Environment +import Text.Printf import Text.Parsec import Text.Parsec.String import qualified Data.Map as M import Data.List import qualified Data.ByteString.Lazy as BL -import Data.Binary.Put +-- import Data.Binary.Put main :: IO () main = do - args <- getArgs - let arch = head args - src <- getContents - assembler src arch - -assembler src isa = do - case isa of - "ppc64" -> case runParser PPC64.parseInstructions () "stdin" src of - Left err -> print err - Right val -> do - let s = runPut (putWord32be $ head val) - BL.writeFile "out.bin" $ s + args <- getArgs + src <- getContents + print args + case runParser DT.parseInstructions () "stdin" src of + Left err -> print err + Right val -> do + -- TODO: nicht nur das erste element :/ + sequence_ [printf "0x%08X\n" x | x <- val] + -- mapM (printf "0x%08X\n") val diff --git a/3a_asm/Makefile b/3a_asm/Makefile new file mode 100644 index 0000000..c98157a --- /dev/null +++ b/3a_asm/Makefile @@ -0,0 +1,3 @@ +all: + @ghc --make Main.hs + @mv Main dtas diff --git a/3a_asm/notes b/3a_asm/notes new file mode 100644 index 0000000..595fe05 --- /dev/null +++ b/3a_asm/notes @@ -0,0 +1,17 @@ +zwei durchlaeufe: + +(1) zeilen in das programmer format umwandeln, d.h. +bis auf value werden eigentlich schon alle saplten aufgeloest. gleichzeitig wird +eine tabelle mit labels und deren adresse aufgebaut (zwei tabellen fuer +instr und data mem noetig) + +ausserdem: +- auf .data und .text achten +- .include +- .org +- .fill aufloesen +- .define tabelle + +@hi und @lo behandeln? + +(2) value das noch als string vorhanden ist, wird als instruction geparst. -- 2.25.1