1 {- `Deep Thought', a softcore CPU implemented on a FPGA
3 Copyright (C) 2010 Markus Hofstaetter <markus.manrow@gmx.at>
4 Copyright (C) 2010 Martin Perner <e0725782@student.tuwien.ac.at>
5 Copyright (C) 2010 Stefan Rebernig <stefan.rebernig@gmail.com>
6 Copyright (C) 2010 Manfred Schwarz <e0725898@student.tuwien.ac.at>
7 Copyright (C) 2010 Bernhard Urban <lewurm@gmail.com>
9 This program is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. -}
27 import Prelude hiding (not,and,or)
29 import Data.Bits hiding (xor)
30 import qualified Data.Map as Map
34 import Text.Parsec.String
35 import Text.Parsec.Combinator
37 import Control.Applicative hiding ((<|>))
41 instruction :: LineNo -> Dict -> Parser Word32
42 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).")
44 testins :: String -> IO ()
46 case (parse (instruction 0 dict) "" (input++"\n")) of
47 Left err -> do { putStr "fail :/\n"; print err}
48 Right x -> do { printf "0x%08X\n" x }
50 dict = (0x8000,[("lolz", 0x1337), ("rofl", 0xaaaa)])
56 iLabel :: Dict -> Parser Word32
57 -- TODO: save msb (=sign) correctly...
58 iLabel d@(aktadr,_) = do {i <- (iLit d); return $ ((i - aktadr)`div`4) .&. 0xffff}
60 iLit :: Dict -> Parser Word32
65 string "@hi"; parseMySpaces;
66 return $ shiftR val 16
68 string "@lo"; parseMySpaces;
69 return $ val .&. 0xffff
70 } <|> do {parseMySpaces; return val}
73 iLit5 d = do i <- iLit d; return $ i .&. 0x001f
74 iLit12 d = do i <- iLit d; return $ i .&. 0x0fff
75 iLit15 d = do i <- iLit d; return $ i .&. 0x7fff
76 iLit16 d = do i <- iLit d; return $ i .&. 0xffff
80 try (do a <- digit; b <- digit; return $ [a,b]) <|> (do a <- digit; return $ [a])
82 read4imm :: String -> Word32
83 read4imm s = if erg > 15 then error "invalid register" else erg
87 reg = do {parseMySpaces; string "r"; ret <- liftM read4imm (imm4); parseMySpaces; return ret}
89 condition :: Parser Word32
91 str <- foldl1 (<|>) (fmap (try . string . fst) conds)
92 let (Just ret) = lookup str conds
95 carry :: Parser Word32
96 carry = do { char 'c'; return 1} <|> do {string ""; return 0}
98 updateDisable :: Parser Word32
99 updateDisable = do { char 'd'; return 1} <|> do {string ""; return 0}
101 highonly :: Parser Word32
102 highonly = do { char 'h'; return 1} <|> do {string ""; return 0}
104 highlow :: Parser Word32
105 highlow = do { char 'h'; return 1} <|> do {char 'l'; return 0} <|> do {string ""; return 0}
107 fill :: Parser Word32
108 fill = do { char 'f'; return 1} <|> do {string ""; return 0}
110 sign :: Parser Word32
111 sign = do { char 's'; return 1} <|> do {string ""; return 0}
113 branchpred :: Parser Word32
115 x <- do { char '+'; return 1} <|> do {char '-'; return 0} <|> do {string ""; return 0}
119 shiftArith :: Parser Word32
120 shiftArith = do { char 'a'; return 1} <|> do {string ""; return 0}
122 parseBracketClose :: Parser Char
123 parseBracketClose = do { c <- char ')'; parseMySpaces; return c}
125 (<.>) p n = p<*comma<*>n
126 (<%>) p n = p<*space<*>n
127 (<@>) p n = p<*char '('<*>n<*parseBracketClose
132 ins m form e = do {mnem m; form e}
133 csv0i_p dict f = f<$>condition<*>branchpred<*>(iLabel dict)
134 csv0i_p' f = f<$>condition<*>branchpred
135 csv1 f = f<$>condition<%>reg
136 csv1' f = f<$>condition
137 csv1_p f = f<$>condition<%>reg
138 csv2 f = f<$>condition<%>reg<.>reg
139 csv2i dict f = f<$>condition<%>reg<.>(iLit16 dict)
140 csv2_scd f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg
141 csv2m dict f = f<$>condition<%>reg<.>(iLit15 dict)<@>reg
142 csv2i_cd dict f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
143 csv2i_d dict f = f<$>updateDisable<*>condition<%>reg<.>reg<.>(iLit5 dict)
144 csv2i_scd dict f = f<$>sign<*>carry<*>updateDisable<*>condition<%>reg<.>reg<.>(iLit12 dict)
145 csv2i_sl dict f = f<$>highonly<*>sign<*>condition<%>reg<.>(iLit16 dict)
146 csv2i_sl' dict f = f<$>sign<*>condition<%>reg<.>(iLit16 dict)
147 csv2i_lfd dict f = f<$>highlow<*>fill<*>updateDisable<*>condition<%>reg<.>(iLit16 dict)
148 csv3_cd f = f<$>carry<*>updateDisable<*>condition<%>reg<.>reg<.>reg
149 csv3_d f = f<$>updateDisable<*>condition<%>reg<.>reg<.>reg
151 instructions = [add, addi, mov, sub, subi,
152 and, andx, or, orx, xor, xorx, not,
154 pop, push, disc, fetch,
155 movpf, movsf, movpt, movst,
156 ldh, ldb, ldw, ldi, ldil,
165 add _ = ins "add" csv3_cd $ aform 0x00
166 addi dict = ins "addi" (csv2i_scd dict) $ aformi 0x02
167 mov _ = ins "mov" csv2_scd $ aformi' 0x02
168 sub _ = ins "sub" csv3_cd $ aform 0x01
169 subi dict = ins "subi" (csv2i_scd dict) $ aformi 0x03
171 and _ = ins "and" csv3_d $ aform 0x04 0
172 andx dict = ins "andx" (csv2i_lfd dict) $ lformi 0x05
173 or _ = ins "or" csv3_d $ aform 0x06 0
174 orx dict = ins "orx" (csv2i_lfd dict) $ lformi 0x07
175 xor _ = ins "xor" csv3_d $ aform 0x08 0
176 xorx dict = ins "xorx" (csv2i_lfd dict) $ lformi 0x09
177 not _ = ins "not" csv1 $ lformi'not 0x09
178 lls dict = ins "lls" (csv2i_cd dict) $ shiform 0x0a 0 0
179 lrs dict = ins "lrs" (csv2i_cd dict) $ shiform 0x0a 1 0
180 ars dict = ins "ars" (csv2i_d dict) $ shiform 0x0a 1 1 0
182 pop _ = ins "pop" csv1 $ sform 0x0b 0x0
183 disc _ = ins "disc" csv1' $ sform' 0x0b 0x1 0
184 fetch _ = ins "fetch" csv1 $ sform 0x0b 0x2
185 push _ = ins "push" csv1 $ sform 0x0b 0x3
186 movpf _ = ins "movpf" csv1 $ sform 0x0c 0x2
187 movsf _ = ins "movsf" csv1 $ sform 0x0c 0x0
188 movpt _ = ins "movpt" csv1 $ sform 0x0d 0x2
189 movst _ = ins "movst" csv1 $ sform 0x0d 0x0
190 ldw dict = ins "ldw" (csv2m dict) $ mformi 0x0e
191 ldh dict = ins "ldh" (csv2m dict) $ mformi 0x10
192 ldb dict = ins "ldb" (csv2m dict) $ mformi 0x12
193 ldi dict = ins "ldi" (csv2i_sl dict) $ lformi' 0x1a
194 ldil dict = ins "ldil" (csv2i_sl' dict) $ lformi' 0x1a 0
195 stw dict = ins "stw" (csv2m dict) $ mformi 0x0f
196 sth dict = ins "sth" (csv2m dict) $ mformi 0x11
197 stb dict = ins "stb" (csv2m dict) $ mformi 0x13
198 ldx dict = ins "ldx" (csv2m dict) $ mformi 0x14
199 stx dict = ins "stx" (csv2m dict) $ mformi 0x15
201 -- set signed by default! in very rare cases this can be an issue.
202 br dict = ins "br" (csv0i_p dict) $ bform 0x16 0x0 1
203 call dict = ins "call" (csv0i_p dict) $ bform 0x16 0x1 1
204 ret _ = ins "ret" csv0i_p' $ bform' 0x16 0x2
205 reti _ = ins "reti" csv0i_p' $ bform' 0x16 0x3
206 brr _ = ins "brr" csv1_p $ brrform 0x17 0
207 callr _ = ins "callr" csv1_p $ brrform 0x17 1
208 cmp _ = ins "cmp" csv2 $ mformi' 0x18
209 cmpi dict = ins "cmpi" (csv2i dict) $ lformi 0x19 0 0 0
211 -- instruction formats
212 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)]
215 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)]
216 aformi' opcd s c d cond rd ra = aformi opcd s c d cond rd ra 0
218 lformi opcd hl f d cond rd imm = pack [(cond,28),(opcd,23),(rd,19),(imm,3),(hl,2),(f,1),(d,0)]
219 lformi' opcd hl s cond rd imm = lformi opcd s hl 0 cond rd imm
220 lformi'not opcd cond rd = lformi opcd 0 1 0 cond rd 0xffff
222 mformi opcd cond rd disp ra = pack [(cond,28),(opcd,23),(rd,19),(ra,15),(disp,0)]
223 mformi' opcd cond rd = mformi opcd cond rd 0
225 bform opcd typ s cond bp imm = pack [(cond,28),(opcd,23),(imm,7),(free,4),(typ,2),(bp,1),(s,0)]
227 bform' opcd typ cond bp = bform opcd typ 0 cond bp 0
229 sform opcd typ cond rd = pack [(cond,28),(opcd,23),(rd,19),(typ,17)]
230 sform' opcd typ rd cond = sform opcd typ cond rd
232 brrform opcd typ cond ra = pack [(cond,28),(opcd,23),(ra,19),(typ,2)]
234 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)]
237 pack bf = foldr1 (.|.) $ map (uncurry rotateL) bf
240 conds :: [(String,Word32)]
242 ("nq", 0x0), ("nz", 0x0),
243 ("eq", 0x1), ("zs", 0x1),
246 ("nc", 0x4), ("ae", 0x4),
247 ("cs", 0x5), ("bl", 0x5),
248 ("ns", 0x6), ("nn", 0x6),
249 ("ss", 0x7), ("ns", 0x7),