s3e: fix build break
[calu.git] / 3a_asm / DT.hs
index 582d1812b55805d76ac03eefba4c95300f7ab26f..da18fa7b302e120390f3219af60234dcaf132f74 100644 (file)
@@ -1,6 +1,30 @@
+{-   `Deep Thought', a softcore CPU implemented on a FPGA
+
+    Copyright (C) 2010 Markus Hofstaetter <markus.manrow@gmx.at>
+    Copyright (C) 2010 Martin Perner <e0725782@student.tuwien.ac.at>
+    Copyright (C) 2010 Stefan Rebernig <stefan.rebernig@gmail.com>
+    Copyright (C) 2010 Manfred Schwarz <e0725898@student.tuwien.ac.at>
+    Copyright (C) 2010 Bernhard Urban <lewurm@gmail.com>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>. -}
+
 module DT where
 
-import Prelude hiding (and,or)
+import DTFormat
+import Expr_eval
+
+import Prelude hiding (not,and,or)
 
 import Data.Bits hiding (xor)
 import qualified Data.Map as Map
@@ -12,25 +36,44 @@ import Text.Parsec.Combinator
 import Control.Monad
 import Control.Applicative hiding ((<|>))
 
-parseInstructions = many1 instruction
+
+-- parsing --
+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 "" (input++"\n")) of
-               Left err -> do { putStr "fail :/"; print err}
+       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 = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)])
 
--- parsing --
-instruction :: Parser Word32
-instruction = foldl1 (<|>) (fmap try instructions) <* char '\n'
-
-instructions = [add]
 
 comma = char ','
 mnem m = string m
 
-iLit :: Parser Word32
-iLit = liftM read (many1 digit)
+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}
+
+
+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
@@ -41,7 +84,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
@@ -49,58 +92,146 @@ 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}
+
+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}
+
+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}
+
+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 <@>
 
-{-
-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  = do {mnem m; form e}
+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 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
 
+instructions = [add, addi, mov, sub, subi,
+       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
+       ]
 
----
-ins m form e  = mnem m>>form e
-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
+-- arithmetic
+add _ = ins "add" csv3_cd $ aform 0x00
+addi dict = ins "addi" (csv2i_scd dict) $ aformi 0x02
+mov _ = ins "mov" csv2_scd $ aformi' 0x02
+sub _ = ins "sub" csv3_cd $ aform 0x01
+subi dict = ins "subi" (csv2i_scd dict) $ aformi 0x03
+-- logic
+and _ = ins "and" csv3_d $ aform 0x04 0
+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
+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
+-- 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 :: 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
-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)]
-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)]
+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 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 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