------------------------------------------------------------------------------
---
--- Module : Text.Assembler.PPC64
--- Copyright : (c) Jeff Douglas
--- License : BSD3
---
--- Maintainer : Jeff Douglas
--- Stability : experimental
--- Portability : portable
---
--- |
---
------------------------------------------------------------------------------
+{- `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
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, addi]
comma = char ','
-mnem m = string m >> space
+mnem m = string m
+
+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
+ try (do a <- digit; b <- digit; return $ [a,b]) <|> (do a <- digit; return $ [a])
+
+read4imm :: String -> Word32
+read4imm s = if erg > 15 then error "invalid register" else erg
+ where erg = read s
+
+reg :: Parser Word32
+reg = do {parseMySpaces; string "r"; ret <- liftM read4imm (imm4); parseMySpaces; return ret}
-iLit :: Parser Word32
-iLit = liftM read (many1 digit)
+condition :: Parser Word32
+condition = do
+ str <- foldl1 (<|>) (fmap (try . string . fst) conds)
+ let (Just ret) = lookup str conds
+ return $ ret
-imm5 :: Parser String
-imm5 = do {a <- digit; b <- digit; return [a,b]}
+carry :: Parser Word32
+carry = do { char 'c'; return 1} <|> do {string ""; return 0}
-reg :: Parser Word32
-reg = do {string "r"; liftM read (imm5)}
+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<*char '('<*>n<*char ')'
+(<%>) p n = p<*space<*>n
+(<@>) p n = p<*char '('<*>n<*parseBracketClose
infixl 1 <.>
+infixl 1 <%>
infixl 1 <@>
--- branch instructions
-b = ins "b" v1 $ iform 18 0 0
-ba = ins "ba" v1 $ iform 18 1 0
-bl = ins "bl" v1 $ iform 18 0 1
-bla = ins "bla" v1 $ iform 18 1 1
-
-bc = ins "bc" csv3 $ bform 16 0 0
-bca = ins "bca" csv3 $ bform 16 1 0
-bcl = ins "bcl" csv3 $ bform 16 0 1
-bcla = ins "bcla" csv3 $ bform 16 1 1
-
-bclr = ins "bclr" csv3 $ xlform'b 19 16 0
-bclrl = ins "bclrl" csv3 $ xlform'b 19 16 1
-
-bcctr = ins "bcctr" csv3 $ xlform'b 19 528 0
-bcctrl = ins "bcctrl" csv3 $ xlform'b 19 528 1
-
--- system call instruction
-sc = ins "sc" v1 $ scform 17
-
--- condition register logical instructions
-crand = ins "crand" csv3 $ xlform'a 19 257
-cror = ins "cror" csv3 $ xlform'a 19 449
-crxor = ins "cxor" csv3 $ xlform'a 19 193
-crnand = ins "crnand" csv3 $ xlform'a 19 225
-crnor = ins "crnor" csv3 $ xlform'a 19 33
-creqv = ins "creqv" csv3 $ xlform'a 19 289
-crandc = ins "crandc" csv3 $ xlform'a 19 129
-crorc = ins "crorc" csv3 $ xlform'a 19 417
-
--- condition register field instruction
-mcrf = ins "mcrf" csv2 $ xlform'c 19 0
-
--- fixed point load instructions
-lbz = ins "lbz" csv3 $ dform'a 34
-lbzx = ins "lbzx" csv3 $ xform'a 31 87
-lbzu = ins "lbzu" csv3 $ dform'a 35
-lbzux = ins "lbzux" csv3 $ xform'a 31 119
-lhz = ins "lhz" csv3 $ dform'a 40
-lhzx = ins "lhz" csv3 $ xform'a 31 279
-lhzu = ins "lhzu" csv3 $ dform'a 41
-lhzux = ins "lhzux" csv3 $ xform'a 31 311
-lha = ins "lha" csv3 $ dform'a 42
-lhax = ins "lhax" csv3 $ xform'a 31 343
-lhau = ins "lhau" csv3 $ dform'a 43
-lhaux = ins "lhaux" csv3 $ xform'a 31 375
-lwz = ins "lwz" csv3 $ dform'a 32
-lwzx = ins "lwzx" csv3 $ xform'a 31 23
-lwzu = ins "lwzu" csv3 $ dform'a 33
-lwzux = ins "lwzux" csv3 $ xform'a 31 55
-lwa = ins "lwa" csv3 $ dsform 58 2
-lwax = ins "lwax" csv3 $ xform'a 31 341
-lwaux = ins "lwaux" csv3 $ xform'a 31 373
-ld = ins "ld" csv3 $ dsform 58 151
-ldx = ins "ldx" csv3 $ xform'a 31 21
-ldu = ins "ldu" csv3 $ dsform 58 1
-ldux = ins "ldux" csv3 $ xform'a 31 53
-
--- fixed point store instructions
-stb = ins "stb" csv3 $ dform'a 38
-stbx = ins "stbx" csv3 $ xform'a 31 215
-stbu = ins "stbu" csv3 $ dform'a 39
-stbux = ins "stbux" csv3 $ xform'a 31 247
-sth = ins "sth" csv3 $ dform'a 44
-sthx = ins "sthx" csv3 $ xform'a 31 407
-sthu = ins "sthu" csv3 $ dform'a 45
-sthux = ins "sthux" csv3 $ xform'a 31 439
-stw = ins "stw" csv3 $ dform'a 36
-stwx = ins "stwx" csv3 $ xform'a 31 151
-stwu = ins "stwu" csv3 $ dform'a 37
-stwux = ins "stwux" csv3 $ xform'a 31 183
-std = ins "std" csv3 $ dsform 62 0
-stdx = ins "stdx" csv3 $ xform'a 31 149
-stdu = ins "stdu" csv3 $ dsform 37 1
-stdux = ins "stdux" csv3 $ xform'a 31 181
-
--- fixed-point load and store with byte reversal instructions
-lhbrx = ins "lhbrx" csv3 $ xform'a 31 790
-lwbrx = ins "lwbrx" csv3 $ xform'a 31 534
-sthbrx = ins "sthbrx" csv3 $ xform'a 31 918
-stwbrx = ins "stwbrx" csv3 $ xform'a 31 662
-
--- fixed point load and store multiple instructions
-lmw = ins "lmw" csv3 $ dform'a 46
-stmw = ins "stmw" csv3 $ dform'a 47
-
--- fixed point move assist instructions
-lswi = ins "lswi" csv3 $ xform'a 31 597
-lswx = ins "lswx" csv3 $ xform'a 31 533
-stswi = ins "stswi" csv3 $ xform'a 31 725
-stswx = ins "stswx" csv3 $ xform'a 31 661
-
---fixed point arithmetic instructions
-addi = ins "addi" csv3 $ dform'a 14
-addis = ins "addis" csv3 $ dform'a 15
-
-add = ins "add" csv3 $ xoform 31 266 0 0
-add_ = ins "add." csv3 $ xoform 31 266 0 1
-addo = ins "addo" csv3 $ xoform 31 266 1 0
-addo_ = ins "addo." csv3 $ xoform 31 266 1 1
-subf = ins "subf" csv3 $ xoform 31 40 0 0
-subf_ = ins "subf." csv3 $ xoform 31 40 0 1
-subfo = ins "subfo" csv3 $ xoform 31 40 1 0
-subfo_ = ins "subfo." csv3 $ xoform 31 40 1 1
-
-addic = ins "addic" csv3 $ dform'a 12
-addic_ = ins "addic." csv3 $ dform'a 13
-subfic = ins "subfic" csv3 $ dform'a 8
-
-addc = ins "addc" csv3 $ xoform 31 10 0 0
-addc_ = ins "addc." csv3 $ xoform 31 10 0 1
-addco = ins "addco" csv3 $ xoform 31 10 1 0
-addco_ = ins "addco." csv3 $ xoform 31 10 1 1
-
-subfc = ins "subfc" csv3 $ xoform 31 8 0 0
-subfc_ = ins "subfc." csv3 $ xoform 31 8 0 1
-subfco = ins "subfco" csv3 $ xoform 31 8 1 1
-subfco_ = ins "subfco." csv3 $ xoform 31 8 1 1
-
-adde = ins "adde" csv3 $ xoform 31 138 0 0
-adde_ = ins "adde." csv3 $ xoform 31 138 0 1
-addeo = ins "addeo" csv3 $ xoform 31 138 1 0
-addeo_ = ins "addeo." csv3 $ xoform 31 138 1 1
-
-subfe = ins "subfe" csv3 $ xoform 31 136 0 0
-subfe_ = ins "subfe." csv3 $ xoform 31 136 0 1
-subfeo = ins "subfeo" csv3 $ xoform 31 136 1 0
-subfeo_ = ins "subfeo." csv3 $ xoform 31 136 1 1
-
-addme = ins "addme" csv2 $ xoform' 31 234 0 0
-addme_ = ins "addme." csv2 $ xoform' 31 234 0 1
-addmeo = ins "addmeo" csv2 $ xoform' 31 234 1 0
-addmeo_ = ins "addmeo." csv2 $ xoform' 31 234 1 1
-
-subfme = ins "subfme" csv2 $ xoform' 31 232 0 0
-subfme_ = ins "subfme." csv2 $ xoform' 31 232 0 1
-subfmeo = ins "subfmeo" csv2 $ xoform' 31 232 1 0
-subfmeo_ = ins "subfmeo." csv2 $ xoform' 31 232 1 1
-
-addze = ins "addze" csv2 $ xoform' 31 202 0 0
-addze_ = ins "addze." csv2 $ xoform' 31 202 0 1
-addzeo = ins "addzeo" csv2 $ xoform' 31 202 1 0
-addzeo_ = ins "addzeo." csv2 $ xoform' 31 202 1 1
-
-subfze = ins "subfze" csv2 $ xoform' 31 202 0 0
-subfze_ = ins "subfze." csv2 $ xoform' 31 202 0 1
-subfzeo = ins "subfzeo" csv2 $ xoform' 31 202 1 0
-subfzeo_ = ins "subfzeo." csv2 $ xoform' 31 202 1 1
-
-neg = ins "neg" csv2 $ xoform' 31 104 0 0
-neg_ = ins "neg." csv2 $ xoform' 31 104 0 1
-nego = ins "nego" csv2 $ xoform' 31 104 1 0
-nego_ = ins "nego." csv2 $ xoform' 31 104 1 1
-
-mulli = ins "mulli" csv3 $ dform'a 7
-
-mulld = ins "mulld" csv3 $ xoform 31 233 0 0
-mulld_ = ins "mulld." csv3 $ xoform 31 233 0 1
-mulldo = ins "mulldo" csv3 $ xoform 31 233 1 0
-mulldo_ = ins "mulldo." csv3 $ xoform 31 233 1 1
-
-mullw = ins "mullw" csv3 $ xoform 31 235 0 0
-mullw_ = ins "mullw." csv3 $ xoform 31 235 0 1
-mullwo = ins "mullwo" csv3 $ xoform 31 235 1 0
-mullwo_ = ins "mullwo." csv3 $ xoform 31 235 1 1
-
-mulhd = ins "mulhd" csv3 $ xoform 31 73 0 0
-mulhd_ = ins "mulhd." csv3 $ xoform 31 73 0 1
-
-mulhw = ins "mulhw" csv3 $ xoform 31 75 0 0
-mulhw_ = ins "mulhw." csv3 $ xoform 31 75 0 1
-
-mulhdu = ins "mulhdu" csv3 $ xoform 31 9 0 0
-mulhdu_ = ins "mulhdu." csv3 $ xoform 31 9 0 1
-
-mulhwu = ins "mulhwu" csv3 $ xoform 31 11 0 0
-mulhwu_ = ins "mulhwu." csv3 $ xoform 31 11 0 1
-
-divd = ins "divd" csv3 $ xoform 31 489 0 0
-divd_ = ins "divd." csv3 $ xoform 31 489 0 1
-divdo = ins "divdo" csv3 $ xoform 31 489 1 0
-divdo_ = ins "divdo." csv3 $ xoform 31 489 1 1
-
-divw = ins "divw" csv3 $ xoform 31 491 0 0
-divw_ = ins "divw." csv3 $ xoform 31 491 0 1
-divwo = ins "divwo" csv3 $ xoform 31 491 1 0
-divwo_ = ins "divwo." csv3 $ xoform 31 491 1 1
-
-divdu = ins "divdu" csv3 $ xoform 31 457 0 0
-divdu_ = ins "divdu." csv3 $ xoform 31 457 0 1
-divduo = ins "divduo" csv3 $ xoform 31 457 1 0
-divduo_ = ins "divduo." csv3 $ xoform 31 457 1 1
-
-divwu = ins "divwu" csv3 $ xoform 31 459 0 0
-divwu_ = ins "divwu." csv3 $ xoform 31 459 0 1
-divwuo = ins "divdwo" csv3 $ xoform 31 459 1 0
-divwuo_ = ins "divdwo." csv3 $ xoform 31 459 1 1
-
--- fixed-point compare instructions
--- check out bit 9 in cmp
-cmpi = ins "cmpi" csv3 $ dform'b 11 0
--- check out bit 9 in cmp
-cmp = ins "cmp" csv3 $ xform'b 31 0 0
--- check out bit 9 in cmpli
-cmpli = ins "cmpli" csv3 $ dform'b 10 0
--- check out bit 9 in cmpl
-cmpl = ins "cmpl" csv3 $ xform'b 32 0 0
-
--- fixed-point trap instructions
-tdi = ins "tdi" csv3 $ dform'a 2
-twi = ins "twi" csv3 $ dform'a 3
-td = ins "td" csv3 $ xform'a 31 68
-tw = ins "tw" csv3 $ xform'a 31 4
-
--- fixed-point logical instructions
-andi_ = ins "andi." csv3 $ dform'a 28
-andis_ = ins "andis" csv3 $ dform'a 29
-ori = ins "ori" csv3 $ dform'a 24
-oris = ins "oris" csv3 $ dform'a 25
-xori = ins "ori" csv3 $ dform'a 26
-xors = ins "oris" csv3 $ dform'a 27
-and = ins "and" csv3 $ xform'c 31 28 0
-and_ = ins "and." csv3 $ xform'c 31 28 1
-or = ins "or" csv3 $ xform'c 31 444 0
-or_ = ins "or." csv3 $ xform'c 31 444 1
-xor = ins "xor" csv3 $ xform'c 31 316 0
-xor_ = ins "xor." csv3 $ xform'c 31 316 1
-nand = ins "nand" csv3 $ xform'c 31 476 0
-nand_ = ins "nand." csv3 $ xform'c 31 476 1
-nor = ins "nor" csv3 $ xform'c 31 124 0
-nor_ = ins "nor." csv3 $ xform'c 31 124 1
-eqv = ins "eqv" csv3 $ xform'c 31 284 0
-eqv_ = ins "eqv." csv3 $ xform'c 31 284 1
-andc = ins "andc" csv3 $ xform'c 31 60 0
-andc_ = ins "andc." csv3 $ xform'c 31 60 1
-orc = ins "orc" csv3 $ xform'c 31 412 0
-orc_ = ins "orc." csv3 $ xform'c 31 412 1
-extsb = ins "extsb" csv2 $ xform'd 31 954 0
-extsb_ = ins "extsb." csv2 $ xform'd 31 954 1
-extsh = ins "extsh" csv2 $ xform'd 31 922 0
-extsh_ = ins "extsh." csv2 $ xform'd 31 922 1
-extsw = ins "extsw" csv2 $ xform'd 31 986 0
-extsw_ = ins "extsw." csv2 $ xform'd 31 986 1
-cntlzd = ins "cntlzd" csv2 $ xform'd 31 58 0
-cntlzd_ = ins "cntlzd." csv2 $ xform'd 31 58 1
-popcntb = ins "popcntb" csv2 $ xform'd 31 122 0
-cntlzw = ins "cntlzw" csv2 $ xform'd 31 26 0
-cntlzw_ = ins "cntlzw." csv2 $ xform'd 31 26 1
-
--- fixed-point rotate and shift instructions
-rldicl = ins "rldicl" csv4 $ mdform 30 0 0
-rldicl_ = ins "rldicl." csv4 $ mdform 30 0 1
-rldicr = ins "rldicr" csv4 $ mdform 30 1 0
-rldicr_ = ins "rldicr." csv4 $ mdform 30 1 1
-rldic = ins "rldic" csv4 $ mdform 30 2 0
-rldic_ = ins "rldic." csv4 $ mdform 30 2 1
-rlwinm = ins "rlwinm" csv5 $ mform 21 0
-rlwinm_ = ins "rlwinm." csv5 $ mform 21 1
-rldcl = ins "rldcl" csv4 $ mdsform 30 8 0
-rldcl_ = ins "rldcl." csv4 $ mdsform 30 8 1
-rldcr = ins "rldcr" csv4 $ mdsform 30 9 0
-rldcr_ = ins "rldcr." csv4 $ mdsform 30 9 1
-rlwnm = ins "rlwnm" csv5 $ mform 23 0
-rlwnm_ = ins "rlwnm." csv5 $ mform 23 1
-rldimi = ins "rldimi" csv4 $ mdform 30 3 0
-rldimi_ = ins "rldimi." csv4 $ mdform 30 3 1
-rlwimi = ins "rlwimi" csv5 $ mform 20 0
-rlwimi_ = ins "rlwimi." csv5 $ mform 20 1
-
--- fixed-point shift instructions
-sld = ins "sld" csv3 $ xform'c 31 27 0
-sld_ = ins "sld." csv3 $ xform'c 31 27 1
-slw = ins "slw" csv3 $ xform'c 31 24 0
-slw_ = ins "slw." csv3 $ xform'c 31 24 1
-srd = ins "srd" csv3 $ xform'c 31 539 0
-srd_ = ins "srd." csv3 $ xform'c 31 539 1
-srw = ins "srw" csv3 $ xform'c 31 536 0
-srw_ = ins "srw." csv3 $ xform'c 31 536 1
-sradi = ins "sradi" csv3 $ xsform 31 413 0
-sradi_ = ins "sradi." csv3 $ xsform 31 413 1
-srawi = ins "srawi" csv3 $ xform'c 31 824 0
-srawi_ = ins "srawi." csv3 $ xform'c 31 824 1
-srad = ins "srad" csv3 $ xform'c 31 794 0
-srad_ = ins "srad." csv3 $ xform'c 31 794 1
-sraw = ins "sraw" csv3 $ xform'c 31 792 0
-sraw_ = ins "sraw." csv3 $ xform'c 31 792 1
-
--- move to/from system register instructions
-mtspr = ins "mtspr" csv2 $ xfxform 31 467
-mfspr = ins "mfspr" csv2 $ xfxform 31 339
-mtcrf = ins "mtcrf" csv2 $ xfxform'b 31 0 144
-
--- floating-point processor instructions --
--- floating-point load instructions
-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<$>reg<.>reg<.>iLit
-csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit
-csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit
-
--- instruction fomats
-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'a opcd rt ra d = pack [(opcd,6),(rt,11),(ra,16),(d,0)]
-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 rb = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(oe,22),(xo,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)]
+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
+ ]
+
+-- 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 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
+
+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 rotateR) bf
-
+pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
+
+-- condition table
+conds :: [(String,Word32)]
+conds = [
+ ("nq", 0x0), ("nz", 0x0),
+ ("eq", 0x1), ("zs", 0x1),
+ ("no", 0x2),
+ ("ov", 0x3),
+ ("nc", 0x4), ("ae", 0x4),
+ ("cs", 0x5), ("bl", 0x5),
+ ("ns", 0x6), ("nn", 0x6),
+ ("ss", 0x7), ("ns", 0x7),
+ ("ab", 0x8),
+ ("be", 0x9),
+ ("ge", 0xa),
+ ("lt", 0xb),
+ ("gt", 0xc),
+ ("le", 0xd),
+ ("nv", 0xf),
+ ("", 0xe) -- always
+ ]
projects / calu.git / blobdiff