initial commit
[wavedrum/sharc-disassembler.git] / SHARC / Instruction.hs
1 {-
2 This file is part of shark-disassembler.
3
4 Copyright (C) 2014 Ricardo Wurmus
5
6 This program is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>.
18 -}
19
20 {-# LANGUAGE QuasiQuotes #-}
21
22 module SHARC.Instruction where
23
24 import SHARC.Types
25 import SHARC.Word48
26 import SHARC.ComputeField
27
28 import Language.Literals.Binary
29 import Data.Bits ((.&.), (.|.), xor, shift, shiftL, shiftR, testBit)
30 import Data.Word
31 import Data.List (intercalate)
32 import Text.Printf (printf)
33 import Data.Binary.Get
34
35 \f
36 data Instruction = Type1 Word48
37 | Type2 Cond ComputeField
38 | Type3
39 Cond
40 ComputeField
41 Ireg
42 Mreg
43 Ureg
44 AccessType
45 Memory
46 WordAccess
47 Update
48 | Type4
49 Cond
50 ComputeField
51 Word8 {-6 bit data-}
52 Dreg
53 Ireg
54 AccessType
55 Memory
56 Update
57 | Type5Transfer
58 Cond
59 ComputeField
60 Ureg {-source register, 7 bit-}
61 Ureg {-destination register, 7 bit-}
62 | Type5Swap
63 Cond
64 ComputeField
65 Dreg {-x, 4 bit-}
66 Dreg {-y, 4 bit-}
67 | Type6WithDataAccess -- with data access
68 Cond
69 ImmediateShift
70 Dreg
71 Ireg
72 Mreg
73 AccessType
74 Memory
75 | Type6WithoutDataAccess -- without data access
76 Cond
77 ImmediateShift
78 | Type7 Word48
79 | Type8
80 BranchType
81 Cond
82 Address24
83 Bool {-loop abort-}
84 Bool {-branch delayed or not-}
85 Bool {-clear interrupt-}
86 | Type9 Word48
87 | Type10 Word48
88 | Type11
89 ReturnSource {- subroutine or interrupt -}
90 Cond
91 Bool {-return delayed or not-}
92 Bool {-else clause used or not-}
93 Bool {-loop reentry modifier specified or not-}
94 ComputeField
95 | Type12Ureg Ureg Address24
96 | Type12Immediate Word16 Address24
97 | Type13 TermCond Address24
98 | Type14 AccessType Memory WordAccess Ureg Address32
99 | Type15 Word48
100 | Type16 Word48
101 | Type17 Ureg Word32
102 | Type18 BitOp Sreg Word32
103 | Type19 Word48
104 | Type20
105 ([String], [String]) {-list of pushes and pops-}
106 Bool {-cause a cash flush-}
107 | NOP -- Type 21
108 | IDLE -- Type 22
109 | Type25 Word48
110 | UndefinedInstruction Word48
111 | InvalidInstruction Word48
112
113 instance Show Instruction where
114 show NOP = "NOP"
115 show IDLE = "IDLE"
116 show (UndefinedInstruction w) = "!! UNDEFINED: " ++ show w
117 show (InvalidInstruction w) = "!! INVALID: " ++ show w
118 show t = let f = printf "%-46s; %s" in case t of
119 Type1 w -> f (showType1 w) "type 1"
120 Type2{} -> f (showType2 t) "type 2"
121 Type3{} -> f (showType3 t) "type 3"
122 Type4{} -> f (showType4 t) "type 4"
123 Type5Transfer{} -> f (showType5 t) "type 5 (transfer)"
124 Type5Swap{} -> f (showType5 t) "type 5 (swap)"
125 Type6WithDataAccess{} -> f (showType6 t) "type 6 (with data access)"
126 Type6WithoutDataAccess{} -> f (showType6 t) "type 6 (without data access)"
127 Type7 w -> f (showType7 w) "type 7"
128 Type8{} -> f (showType8 t) "type 8"
129 Type9 w -> f (showType9 w) "type 9"
130 Type10 w -> f (showType10 w) "type 10"
131 Type11{} -> f (showType11 t) "type 11"
132 Type12Immediate{} -> f (showType12 t) "type 12 (immediate)"
133 Type12Ureg{} -> f (showType12 t) "type 12 (from ureg)"
134 Type13{} -> f (showType13 t) "type 13"
135 Type14{} -> f (showType14 t) "type 14"
136 Type15 w -> f (showType15 w) "type 15"
137 Type16 w -> f (showType16 w) "type 16"
138 Type17{} -> f (showType17 t) "type 17"
139 Type18{} -> f (showType18 t) "type 18"
140 Type19 w -> f (showType19 w) "type 19"
141 Type20{} -> f (showType20 t) "type 20"
142 Type25 w -> f (showType25 w) "type 25"
143
144 \f
145 showType1 w = " TODO: " ++ show w
146
147 showType2 (Type2 cond cf) = show cond ++ show cf
148
149 showType3 (Type3 cond compute ireg mreg ureg rw mem wa up) =
150 show cond ++ show compute ++ assignment ++ flag
151 where
152 imOrder = case up of
153 PreModify -> [show mreg, show ireg]
154 PostModify -> [show ireg, show mreg]
155 pair = "(" ++ intercalate ", " imOrder ++ ")"
156 mem' = case mem of
157 Prog -> "PM" ++ pair
158 Data -> "DM" ++ pair
159 assignment = case rw of
160 Read -> show ureg ++ "=" ++ mem'
161 Write -> mem' ++ "=" ++ show ureg
162 flag = case wa of
163 LW -> " (LW)"
164 _ -> ""
165
166 showType4 (Type4 cond compute dat dreg ireg rw mem up) =
167 show cond ++ show compute ++ assignment
168 where
169 -- print 6 bit data as two's complement
170 dat' = if dat `testBit` 5
171 then '-' : show (dat `xor` 0x3F)
172 else show dat
173 order = case up of
174 PreModify -> [dat', show ireg]
175 PostModify -> [show ireg, dat']
176 pair = "(" ++ intercalate ", " order ++ ")"
177 mem' = case mem of
178 Prog -> "PM" ++ pair
179 Data -> "DM" ++ pair
180 assignment = case rw of
181 Read -> show dreg ++ "=" ++ mem'
182 Write -> mem' ++ "=" ++ show dreg
183
184 showType5 (Type5Transfer cond compute src dest) =
185 optional ++ sep ++ show dest ++ "=" ++ show src
186 where
187 optional = show cond ++ show compute
188 sep = if optional == "" then "" else ", "
189 showType5 (Type5Swap cond compute x y) =
190 optional ++ sep ++ show x ++ "<->" ++ show y
191 where
192 optional = show cond ++ show compute
193 sep = if optional == "" then "" else ", "
194
195 showType6 (Type6WithDataAccess cond shiftField dreg ireg mreg rw mem) =
196 show cond ++ show shiftField ++ assignment
197 where
198 pair = "(" ++ intercalate ", " [show ireg, show mreg] ++ ")"
199 mem' = case mem of
200 Prog -> "PM" ++ pair
201 Data -> "DM" ++ pair
202 assignment = case rw of
203 Read -> show dreg ++ "=" ++ mem'
204 Write -> mem' ++ "=" ++ show dreg
205
206 showType6 (Type6WithoutDataAccess cond shiftField) =
207 show cond ++ show shiftField
208
209 showType7 w = " TODO: " ++ show w
210
211 -- TODO: if Call, ignore LA and CI
212 -- TODO: flag handling is ugly
213 showType8 (Type8 t cond addr a d c) = show cond ++ t' ++ flags
214 where
215 t' = case t of
216 Jump -> "JUMP " ++ show addr
217 Call -> "CALL " ++ show addr
218 a' = if a then "LA" else ""
219 d' = if d then "DB" else ""
220 c' = if c then "CI" else ""
221 flags = if a || d || c
222 then " (" ++ intercalate ", " (filter (/= "") [a', d', c']) ++ ")"
223 else ""
224
225 showType9 w = " TODO: " ++ show w
226
227 showType10 w = " TODO: " ++ show w
228
229 showType11 (Type11 rs cond d e l cf) = show cond ++ rs' ++ flags ++ elseCompute
230 where
231 rs' = case rs of
232 Subroutine -> "RTS"
233 Interrupt -> "RTI"
234 -- TODO: this is ugly
235 d' = if d then "DB" else ""
236 l' = if l then "LR" else ""
237 flags = if d || l
238 then " (" ++ intercalate ", " (filter (/= "") [d', l']) ++ ")"
239 else ""
240 e' = if e then ", ELSE " else ", "
241 -- do not print at all if opcode in compute field is empty
242 -- TODO: can this be encoded in the type instead of doing an ugly string comparison?
243 elseCompute = if show cf == "" then "" else e' ++ show cf
244
245 showType12 (Type12Immediate dat reladdr) =
246 "LNCTR=" ++ show dat ++ ", DO " ++ show reladdr ++ " UNTIL LCE"
247 showType12 (Type12Ureg ureg reladdr) =
248 "LNCTR=" ++ show ureg ++ ", DO " ++ show reladdr ++ " UNTIL LCE"
249
250 showType13 (Type13 term reladdr) =
251 "DO " ++ show reladdr ++ " UNTIL " ++ show term
252
253 showType14 (Type14 rw mem wa ureg addr) = lhs ++ " = " ++ rhs ++ lwflag
254 where
255 lwflag = case wa of
256 LW -> " (LW)"
257 _ -> ""
258 memloc = case mem of
259 Data -> "DM(" ++ show addr ++ ")"
260 Prog -> "PM(" ++ show addr ++ ")"
261 lhs = case rw of
262 Write -> memloc
263 Read -> show ureg
264 rhs = case rw of
265 Write -> show ureg
266 Read -> memloc
267
268 showType15 w = " TODO: " ++ show w
269
270 showType16 w = " TODO: " ++ show w
271
272 showType17 (Type17 ureg dat) = show ureg ++ " = " ++ printf "0x%08X" dat
273
274 showType18 (Type18 bop sreg w) =
275 "BIT " ++ show bop ++ " " ++ show sreg ++ " " ++ printf "0x%08X" w
276
277 showType19 w = " TODO: " ++ show w
278
279 showType20 (Type20 (pushes,pops) fc) = intercalate ", " (pu ++ po ++ [flush])
280 where
281 pu = map (\x -> "PUSH " ++ x) pushes
282 po = map (\x -> "POP " ++ x) pops
283 flush = if fc then "FLUSH CACHE" else ""
284
285 showType25 w = " TODO: " ++ show w
286
287
288 \f
289 -- TODO
290 parseType1 = Type1
291
292 parseType2 w = Type2 cond (mkComputeField w)
293 where
294 cond = mkCond w
295
296 parseType3 w = Type3 cond compute ireg mreg ureg rw mem wa up
297 where
298 w64 = word48ToWord64 w
299 cond = mkCond w
300 compute = mkComputeField w
301 ireg = mkIreg $ w64 `cutMask` [b| 000 0 111 000 00000 000 0000000 0000000 00000000 00000000 |]
302 mreg = mkMreg $ w64 `cutMask` [b| 000 0 000 111 00000 000 0000000 0000000 00000000 00000000 |]
303 ureg = mkUreg $ w64 `cutMask` [b| 000 0 000 000 00000 000 1111111 0000000 00000000 00000000 |]
304 rw = if w64 `testBit` 31 then Read else Write
305 mem = if w64 `testBit` 32 then Data else Prog
306 wa = if w64 `testBit` 30 then LW else NW
307 up = if w64 `testBit` 44 then PostModify else PreModify
308
309 parseType4 w = Type4 cond compute dat dreg ireg rw mem up
310 where
311 w64 = word48ToWord64 w
312 cond = mkCond w
313 compute = mkComputeField w
314 dat = w64 `cutMask` 0x0001F8000000
315 dreg = mkDreg $ w64 `cutMask` 0x000007800000
316 ireg = mkIreg $ w64 `cutMask` [b| 000 0 111 000 00000 000 0000000 0000000 00000000 00000000 |]
317 rw = if w64 `testBit` 39 then Read else Write
318 mem = if w64 `testBit` 40 then Data else Prog
319 up = if w64 `testBit` 38 then PostModify else PreModify
320
321 parseType5 w = if w64 `testBit` 43
322 then let
323 x = mkDreg $ w64 `cutMask` 0x000007800000
324 y = mkDreg $ w64 `cutMask` 0x03C000000000
325 in Type5Swap cond compute x y
326 else let
327 src = mkUreg $ ((w64 `cutMask` 0x07C000000000) `shiftL` 2) .|. (w64 `cutMask` 0x000180000000)
328 dest = mkUreg $ w64 `cutMask` 0x00003F800000
329 in Type5Transfer cond compute src dest
330 where
331 w64 = word48ToWord64 w
332 cond = mkCond w
333 compute = mkComputeField w
334
335 parseType6 w = if w64 `testBit` 47
336 then let -- with data access
337 dreg = mkDreg $ w64 `cutMask` [b| 0000 000 000 00000 00 0000 1111 0 000000 00000000 0000 0000 |]
338 ireg = mkIreg $ w64 `cutMask` [b| 0000 111 000 00000 00 0000 0000 0 000000 00000000 0000 0000 |]
339 mreg = mkMreg $ w64 `cutMask` [b| 0000 000 111 00000 00 0000 0000 0 000000 00000000 0000 0000 |]
340 rw = if w64 `testBit` 31 then Read else Write
341 mem = if w64 `testBit` 32 then Data else Prog
342 in
343 Type6WithDataAccess cond shiftField dreg ireg mreg rw mem
344 else -- without data access
345 Type6WithoutDataAccess cond shiftField
346 where
347 w64 = word48ToWord64 w
348 cond = mkCond w
349 shiftField = ImmediateShift op dat rn rx
350 op = w64 `cutMask` 0x0000003F0000
351 dat = (w64 `cutMask` 0x000078000000) `shiftL` 8 .|. (w64 `cutMask` 0x00000000FF00)
352 rn = Dreg $ w64 `cutMask` 0xF0
353 rx = Dreg $ w64 `cutMask` 0x0F
354
355 -- TODO
356 parseType7 = Type7
357
358 parseType8 :: (Word32 -> Address24) -> Word48 -> Instruction
359 parseType8 addressConstr w = Type8 t cond addr a d c
360 where
361 w64 = word48ToWord64 w
362 t = if w64 `testBit` 39 then Jump else Call
363 cond = mkCond w
364 addr = addressConstr $ w64 `cutMask` 0x000000FFFFFF
365 a = w64 `testBit` 38 -- loop abort
366 d = w64 `testBit` 26 -- branch delayed or not
367 c = w64 `testBit` 24 -- clear interrupt
368
369 -- TODO
370 parseType9 = Type9
371
372 -- TODO
373 parseType10 = Type10
374
375 parseType11 rs w = Type11 rs cond d e l cf where
376 cond = mkCond w
377 w64 = word48ToWord64 w
378 d = w64 `testBit` 26 -- return delayed
379 e = w64 `testBit` 25 -- else clause
380 l = w64 `testBit` 24 -- loop reentry
381 cf = mkComputeField w
382
383 parseType12 w = if w64 `testBit` 40
384 then let -- loop counter load from a Ureg
385 ureg = mkUreg $ w64 `cutMask` 0x007F00000000
386 in Type12Ureg ureg reladdr
387 else let -- immediate loop counter load
388 dat = w64 `cutMask` 0x00FFFF000000
389 in Type12Immediate dat reladdr
390 where
391 w64 = word48ToWord64 w
392 reladdr = RelAddress24 $ w64 `cutMask` 0xFFFFFF -- lowest 24 bit
393
394 parseType13 w = Type13 term reladdr
395 where
396 w64 = word48ToWord64 w
397 term = mkTermCond w
398 reladdr = RelAddress24 $ w64 `cutMask` 0xFFFFFF -- lowest 24 bit
399
400 parseType14 w = Type14 rw mem wa ureg addr
401 where
402 w64 = word48ToWord64 w
403 rw = if w64 `testBit` 40 then Read else Write
404 mem = if w64 `testBit` 41 then Data else Prog
405 wa = if w64 `testBit` 39 then LW else NW
406 ureg = mkUreg $ w64 `cutMask` 0x00EF00000000
407 addr = Address32 $ w64 `cutMask` 0x0000FFFFFFFF
408
409 -- TODO
410 parseType15 = Type15
411 parseType16 = Type16
412
413 parseType17 w = Type17 ureg dat
414 where
415 w64 = word48ToWord64 w
416 dat = w64 `cutMask` 0x0000FFFFFFFF
417 ureg = mkUreg $ w64 `cutMask` 0x00EF00000000
418
419 parseType18 w = Type18 bop sreg dat
420 where
421 w64 = word48ToWord64 w
422 dat = w64 `cutMask` 0x0000FFFFFFFF
423 bop = [ SET, CLR, TGL, TST, XOR ] !! (w64 `cutMask` 0x00E000000000)
424 sreg = mkSreg $ w64 `cutMask` 0x00FF00000000
425
426 -- TODO
427 parseType19 = Type19
428
429 parseType20 w = Type20 (pushes, pops) fc
430 where
431 w64 = word48ToWord64 w
432 lpu = if w64 `testBit` 39 then "LOOP" else ""
433 lpo = if w64 `testBit` 38 then "LOOP" else ""
434 spu = if w64 `testBit` 37 then "STS" else ""
435 spo = if w64 `testBit` 36 then "STS" else ""
436 ppu = if w64 `testBit` 35 then "PCSTK" else ""
437 ppo = if w64 `testBit` 34 then "PCSTK" else ""
438 pushes = filter (/= "") [lpu, spu, ppu]
439 pops = filter (/= "") [lpo, spo, ppo]
440 fc = w64 `testBit` 33
441
442 -- TODO
443 parseType25 = Type25
444
445 \f
446 parseInstruction :: Word48 -> Instruction
447 parseInstruction word =
448 let
449 w64 = word48ToWord64 word
450 b1 = (w64 `cutMask` 0xFF0000000000) :: Word8
451 b2 = (w64 `cutMask` 0x00FF00000000) :: Word8
452 in case fromIntegral b1 of
453 [b| 0000 0000 |] -> if b2 `testBit` 7
454 then IDLE
455 else NOP
456 [b| 0000 0001 |] -> parseType2 word
457 [b| 0000 0010 |] -> parseType6 word
458 [b| 0000 0011 |] -> UndefinedInstruction word
459 [b| 0000 0100 |] -> parseType7 word
460 [b| 0000 0101 |] -> UndefinedInstruction word
461 [b| 0000 0110 |] -> parseType8 Address24 word
462 [b| 0000 0111 |] -> parseType8 RelAddress24 word
463 [b| 0000 1000 |] -> parseType9 word
464 [b| 0000 1001 |] -> parseType9 word
465 [b| 0000 1010 |] -> parseType11 Subroutine word
466 [b| 0000 1011 |] -> parseType11 Interrupt word
467 [b| 0000 1100 |] -> parseType12 word
468 [b| 0000 1101 |] -> parseType12 word
469 [b| 0000 1110 |] -> parseType13 word
470 [b| 0000 1111 |] -> parseType17 word
471
472 [b| 0001 0100 |] -> parseType18 word
473 [b| 0001 0101 |] -> UndefinedInstruction word
474 [b| 0001 0110 |] -> parseType19 word
475 [b| 0001 0111 |] -> parseType20 word
476 [b| 0001 1000 |] -> parseType25 word
477
478 -- check six bit prefix
479 _ -> case b1 .&. 0xFC of
480 [b| 0001 0000 |] -> parseType14 word
481 -- check four bit prefix
482 _ -> case b1 .&. 0xF0 of
483 [b| 0110 0000 |] -> parseType4 word
484 [b| 0111 0000 |] -> parseType5 word
485 [b| 1000 0000 |] -> parseType6 word
486 [b| 1001 0000 |] -> parseType16 word
487 -- check three bit prefix
488 _ -> case b1 .&. 0xE0 of
489 [b| 001 00000 |] -> parseType1 word
490 [b| 010 00000 |] -> parseType3 word
491 [b| 101 00000 |] -> parseType15 word
492 [b| 110 00000 |] -> parseType10 word
493 [b| 111 00000 |] -> parseType10 word
494 _ -> InvalidInstruction word
495
496 getInstruction :: Get Instruction
497 getInstruction = fmap parseInstruction getPackedWord48
498
499 printInstructionWithAddr :: (Word64, Instruction) -> IO ()
500 printInstructionWithAddr (addr, instr) = printf "0x%05X: %s\n" addr (show instr)