summaryrefslogtreecommitdiff
path: root/SHARC/Instruction.hs
diff options
context:
space:
mode:
Diffstat (limited to 'SHARC/Instruction.hs')
-rw-r--r--SHARC/Instruction.hs500
1 files changed, 500 insertions, 0 deletions
diff --git a/SHARC/Instruction.hs b/SHARC/Instruction.hs
new file mode 100644
index 0000000..5c3b1bf
--- /dev/null
+++ b/SHARC/Instruction.hs
@@ -0,0 +1,500 @@
+{-
+ This file is part of shark-disassembler.
+
+ Copyright (C) 2014 Ricardo Wurmus
+
+ 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/>.
+-}
+
+{-# LANGUAGE QuasiQuotes #-}
+
+module SHARC.Instruction where
+
+import SHARC.Types
+import SHARC.Word48
+import SHARC.ComputeField
+
+import Language.Literals.Binary
+import Data.Bits ((.&.), (.|.), xor, shift, shiftL, shiftR, testBit)
+import Data.Word
+import Data.List (intercalate)
+import Text.Printf (printf)
+import Data.Binary.Get
+
+
+data Instruction = Type1 Word48
+ | Type2 Cond ComputeField
+ | Type3
+ Cond
+ ComputeField
+ Ireg
+ Mreg
+ Ureg
+ AccessType
+ Memory
+ WordAccess
+ Update
+ | Type4
+ Cond
+ ComputeField
+ Word8 {-6 bit data-}
+ Dreg
+ Ireg
+ AccessType
+ Memory
+ Update
+ | Type5Transfer
+ Cond
+ ComputeField
+ Ureg {-source register, 7 bit-}
+ Ureg {-destination register, 7 bit-}
+ | Type5Swap
+ Cond
+ ComputeField
+ Dreg {-x, 4 bit-}
+ Dreg {-y, 4 bit-}
+ | Type6WithDataAccess -- with data access
+ Cond
+ ImmediateShift
+ Dreg
+ Ireg
+ Mreg
+ AccessType
+ Memory
+ | Type6WithoutDataAccess -- without data access
+ Cond
+ ImmediateShift
+ | Type7 Word48
+ | Type8
+ BranchType
+ Cond
+ Address24
+ Bool {-loop abort-}
+ Bool {-branch delayed or not-}
+ Bool {-clear interrupt-}
+ | Type9 Word48
+ | Type10 Word48
+ | Type11
+ ReturnSource {- subroutine or interrupt -}
+ Cond
+ Bool {-return delayed or not-}
+ Bool {-else clause used or not-}
+ Bool {-loop reentry modifier specified or not-}
+ ComputeField
+ | Type12Ureg Ureg Address24
+ | Type12Immediate Word16 Address24
+ | Type13 TermCond Address24
+ | Type14 AccessType Memory WordAccess Ureg Address32
+ | Type15 Word48
+ | Type16 Word48
+ | Type17 Ureg Word32
+ | Type18 BitOp Sreg Word32
+ | Type19 Word48
+ | Type20
+ ([String], [String]) {-list of pushes and pops-}
+ Bool {-cause a cash flush-}
+ | NOP -- Type 21
+ | IDLE -- Type 22
+ | Type25 Word48
+ | UndefinedInstruction Word48
+ | InvalidInstruction Word48
+
+instance Show Instruction where
+ show NOP = "NOP"
+ show IDLE = "IDLE"
+ show (UndefinedInstruction w) = "!! UNDEFINED: " ++ show w
+ show (InvalidInstruction w) = "!! INVALID: " ++ show w
+ show t = let f = printf "%-46s; %s" in case t of
+ Type1 w -> f (showType1 w) "type 1"
+ Type2{} -> f (showType2 t) "type 2"
+ Type3{} -> f (showType3 t) "type 3"
+ Type4{} -> f (showType4 t) "type 4"
+ Type5Transfer{} -> f (showType5 t) "type 5 (transfer)"
+ Type5Swap{} -> f (showType5 t) "type 5 (swap)"
+ Type6WithDataAccess{} -> f (showType6 t) "type 6 (with data access)"
+ Type6WithoutDataAccess{} -> f (showType6 t) "type 6 (without data access)"
+ Type7 w -> f (showType7 w) "type 7"
+ Type8{} -> f (showType8 t) "type 8"
+ Type9 w -> f (showType9 w) "type 9"
+ Type10 w -> f (showType10 w) "type 10"
+ Type11{} -> f (showType11 t) "type 11"
+ Type12Immediate{} -> f (showType12 t) "type 12 (immediate)"
+ Type12Ureg{} -> f (showType12 t) "type 12 (from ureg)"
+ Type13{} -> f (showType13 t) "type 13"
+ Type14{} -> f (showType14 t) "type 14"
+ Type15 w -> f (showType15 w) "type 15"
+ Type16 w -> f (showType16 w) "type 16"
+ Type17{} -> f (showType17 t) "type 17"
+ Type18{} -> f (showType18 t) "type 18"
+ Type19 w -> f (showType19 w) "type 19"
+ Type20{} -> f (showType20 t) "type 20"
+ Type25 w -> f (showType25 w) "type 25"
+
+
+showType1 w = " TODO: " ++ show w
+
+showType2 (Type2 cond cf) = show cond ++ show cf
+
+showType3 (Type3 cond compute ireg mreg ureg rw mem wa up) =
+ show cond ++ show compute ++ assignment ++ flag
+ where
+ imOrder = case up of
+ PreModify -> [show mreg, show ireg]
+ PostModify -> [show ireg, show mreg]
+ pair = "(" ++ intercalate ", " imOrder ++ ")"
+ mem' = case mem of
+ Prog -> "PM" ++ pair
+ Data -> "DM" ++ pair
+ assignment = case rw of
+ Read -> show ureg ++ "=" ++ mem'
+ Write -> mem' ++ "=" ++ show ureg
+ flag = case wa of
+ LW -> " (LW)"
+ _ -> ""
+
+showType4 (Type4 cond compute dat dreg ireg rw mem up) =
+ show cond ++ show compute ++ assignment
+ where
+ -- print 6 bit data as two's complement
+ dat' = if dat `testBit` 5
+ then '-' : show (dat `xor` 0x3F)
+ else show dat
+ order = case up of
+ PreModify -> [dat', show ireg]
+ PostModify -> [show ireg, dat']
+ pair = "(" ++ intercalate ", " order ++ ")"
+ mem' = case mem of
+ Prog -> "PM" ++ pair
+ Data -> "DM" ++ pair
+ assignment = case rw of
+ Read -> show dreg ++ "=" ++ mem'
+ Write -> mem' ++ "=" ++ show dreg
+
+showType5 (Type5Transfer cond compute src dest) =
+ optional ++ sep ++ show dest ++ "=" ++ show src
+ where
+ optional = show cond ++ show compute
+ sep = if optional == "" then "" else ", "
+showType5 (Type5Swap cond compute x y) =
+ optional ++ sep ++ show x ++ "<->" ++ show y
+ where
+ optional = show cond ++ show compute
+ sep = if optional == "" then "" else ", "
+
+showType6 (Type6WithDataAccess cond shiftField dreg ireg mreg rw mem) =
+ show cond ++ show shiftField ++ assignment
+ where
+ pair = "(" ++ intercalate ", " [show ireg, show mreg] ++ ")"
+ mem' = case mem of
+ Prog -> "PM" ++ pair
+ Data -> "DM" ++ pair
+ assignment = case rw of
+ Read -> show dreg ++ "=" ++ mem'
+ Write -> mem' ++ "=" ++ show dreg
+
+showType6 (Type6WithoutDataAccess cond shiftField) =
+ show cond ++ show shiftField
+
+showType7 w = " TODO: " ++ show w
+
+-- TODO: if Call, ignore LA and CI
+-- TODO: flag handling is ugly
+showType8 (Type8 t cond addr a d c) = show cond ++ t' ++ flags
+ where
+ t' = case t of
+ Jump -> "JUMP " ++ show addr
+ Call -> "CALL " ++ show addr
+ a' = if a then "LA" else ""
+ d' = if d then "DB" else ""
+ c' = if c then "CI" else ""
+ flags = if a || d || c
+ then " (" ++ intercalate ", " (filter (/= "") [a', d', c']) ++ ")"
+ else ""
+
+showType9 w = " TODO: " ++ show w
+
+showType10 w = " TODO: " ++ show w
+
+showType11 (Type11 rs cond d e l cf) = show cond ++ rs' ++ flags ++ elseCompute
+ where
+ rs' = case rs of
+ Subroutine -> "RTS"
+ Interrupt -> "RTI"
+ -- TODO: this is ugly
+ d' = if d then "DB" else ""
+ l' = if l then "LR" else ""
+ flags = if d || l
+ then " (" ++ intercalate ", " (filter (/= "") [d', l']) ++ ")"
+ else ""
+ e' = if e then ", ELSE " else ", "
+ -- do not print at all if opcode in compute field is empty
+ -- TODO: can this be encoded in the type instead of doing an ugly string comparison?
+ elseCompute = if show cf == "" then "" else e' ++ show cf
+
+showType12 (Type12Immediate dat reladdr) =
+ "LNCTR=" ++ show dat ++ ", DO " ++ show reladdr ++ " UNTIL LCE"
+showType12 (Type12Ureg ureg reladdr) =
+ "LNCTR=" ++ show ureg ++ ", DO " ++ show reladdr ++ " UNTIL LCE"
+
+showType13 (Type13 term reladdr) =
+ "DO " ++ show reladdr ++ " UNTIL " ++ show term
+
+showType14 (Type14 rw mem wa ureg addr) = lhs ++ " = " ++ rhs ++ lwflag
+ where
+ lwflag = case wa of
+ LW -> " (LW)"
+ _ -> ""
+ memloc = case mem of
+ Data -> "DM(" ++ show addr ++ ")"
+ Prog -> "PM(" ++ show addr ++ ")"
+ lhs = case rw of
+ Write -> memloc
+ Read -> show ureg
+ rhs = case rw of
+ Write -> show ureg
+ Read -> memloc
+
+showType15 w = " TODO: " ++ show w
+
+showType16 w = " TODO: " ++ show w
+
+showType17 (Type17 ureg dat) = show ureg ++ " = " ++ printf "0x%08X" dat
+
+showType18 (Type18 bop sreg w) =
+ "BIT " ++ show bop ++ " " ++ show sreg ++ " " ++ printf "0x%08X" w
+
+showType19 w = " TODO: " ++ show w
+
+showType20 (Type20 (pushes,pops) fc) = intercalate ", " (pu ++ po ++ [flush])
+ where
+ pu = map (\x -> "PUSH " ++ x) pushes
+ po = map (\x -> "POP " ++ x) pops
+ flush = if fc then "FLUSH CACHE" else ""
+
+showType25 w = " TODO: " ++ show w
+
+
+
+-- TODO
+parseType1 = Type1
+
+parseType2 w = Type2 cond (mkComputeField w)
+ where
+ cond = mkCond w
+
+parseType3 w = Type3 cond compute ireg mreg ureg rw mem wa up
+ where
+ w64 = word48ToWord64 w
+ cond = mkCond w
+ compute = mkComputeField w
+ ireg = mkIreg $ w64 `cutMask` [b| 000 0 111 000 00000 000 0000000 0000000 00000000 00000000 |]
+ mreg = mkMreg $ w64 `cutMask` [b| 000 0 000 111 00000 000 0000000 0000000 00000000 00000000 |]
+ ureg = mkUreg $ w64 `cutMask` [b| 000 0 000 000 00000 000 1111111 0000000 00000000 00000000 |]
+ rw = if w64 `testBit` 31 then Read else Write
+ mem = if w64 `testBit` 32 then Data else Prog
+ wa = if w64 `testBit` 30 then LW else NW
+ up = if w64 `testBit` 44 then PostModify else PreModify
+
+parseType4 w = Type4 cond compute dat dreg ireg rw mem up
+ where
+ w64 = word48ToWord64 w
+ cond = mkCond w
+ compute = mkComputeField w
+ dat = w64 `cutMask` 0x0001F8000000
+ dreg = mkDreg $ w64 `cutMask` 0x000007800000
+ ireg = mkIreg $ w64 `cutMask` [b| 000 0 111 000 00000 000 0000000 0000000 00000000 00000000 |]
+ rw = if w64 `testBit` 39 then Read else Write
+ mem = if w64 `testBit` 40 then Data else Prog
+ up = if w64 `testBit` 38 then PostModify else PreModify
+
+parseType5 w = if w64 `testBit` 43
+ then let
+ x = mkDreg $ w64 `cutMask` 0x000007800000
+ y = mkDreg $ w64 `cutMask` 0x03C000000000
+ in Type5Swap cond compute x y
+ else let
+ src = mkUreg $ ((w64 `cutMask` 0x07C000000000) `shiftL` 2) .|. (w64 `cutMask` 0x000180000000)
+ dest = mkUreg $ w64 `cutMask` 0x00003F800000
+ in Type5Transfer cond compute src dest
+ where
+ w64 = word48ToWord64 w
+ cond = mkCond w
+ compute = mkComputeField w
+
+parseType6 w = if w64 `testBit` 47
+ then let -- with data access
+ dreg = mkDreg $ w64 `cutMask` [b| 0000 000 000 00000 00 0000 1111 0 000000 00000000 0000 0000 |]
+ ireg = mkIreg $ w64 `cutMask` [b| 0000 111 000 00000 00 0000 0000 0 000000 00000000 0000 0000 |]
+ mreg = mkMreg $ w64 `cutMask` [b| 0000 000 111 00000 00 0000 0000 0 000000 00000000 0000 0000 |]
+ rw = if w64 `testBit` 31 then Read else Write
+ mem = if w64 `testBit` 32 then Data else Prog
+ in
+ Type6WithDataAccess cond shiftField dreg ireg mreg rw mem
+ else -- without data access
+ Type6WithoutDataAccess cond shiftField
+ where
+ w64 = word48ToWord64 w
+ cond = mkCond w
+ shiftField = ImmediateShift op dat rn rx
+ op = w64 `cutMask` 0x0000003F0000
+ dat = (w64 `cutMask` 0x000078000000) `shiftL` 8 .|. (w64 `cutMask` 0x00000000FF00)
+ rn = Dreg $ w64 `cutMask` 0xF0
+ rx = Dreg $ w64 `cutMask` 0x0F
+
+-- TODO
+parseType7 = Type7
+
+parseType8 :: (Word32 -> Address24) -> Word48 -> Instruction
+parseType8 addressConstr w = Type8 t cond addr a d c
+ where
+ w64 = word48ToWord64 w
+ t = if w64 `testBit` 39 then Jump else Call
+ cond = mkCond w
+ addr = addressConstr $ w64 `cutMask` 0x000000FFFFFF
+ a = w64 `testBit` 38 -- loop abort
+ d = w64 `testBit` 26 -- branch delayed or not
+ c = w64 `testBit` 24 -- clear interrupt
+
+-- TODO
+parseType9 = Type9
+
+-- TODO
+parseType10 = Type10
+
+parseType11 rs w = Type11 rs cond d e l cf where
+ cond = mkCond w
+ w64 = word48ToWord64 w
+ d = w64 `testBit` 26 -- return delayed
+ e = w64 `testBit` 25 -- else clause
+ l = w64 `testBit` 24 -- loop reentry
+ cf = mkComputeField w
+
+parseType12 w = if w64 `testBit` 40
+ then let -- loop counter load from a Ureg
+ ureg = mkUreg $ w64 `cutMask` 0x007F00000000
+ in Type12Ureg ureg reladdr
+ else let -- immediate loop counter load
+ dat = w64 `cutMask` 0x00FFFF000000
+ in Type12Immediate dat reladdr
+ where
+ w64 = word48ToWord64 w
+ reladdr = RelAddress24 $ w64 `cutMask` 0xFFFFFF -- lowest 24 bit
+
+parseType13 w = Type13 term reladdr
+ where
+ w64 = word48ToWord64 w
+ term = mkTermCond w
+ reladdr = RelAddress24 $ w64 `cutMask` 0xFFFFFF -- lowest 24 bit
+
+parseType14 w = Type14 rw mem wa ureg addr
+ where
+ w64 = word48ToWord64 w
+ rw = if w64 `testBit` 40 then Read else Write
+ mem = if w64 `testBit` 41 then Data else Prog
+ wa = if w64 `testBit` 39 then LW else NW
+ ureg = mkUreg $ w64 `cutMask` 0x00EF00000000
+ addr = Address32 $ w64 `cutMask` 0x0000FFFFFFFF
+
+-- TODO
+parseType15 = Type15
+parseType16 = Type16
+
+parseType17 w = Type17 ureg dat
+ where
+ w64 = word48ToWord64 w
+ dat = w64 `cutMask` 0x0000FFFFFFFF
+ ureg = mkUreg $ w64 `cutMask` 0x00EF00000000
+
+parseType18 w = Type18 bop sreg dat
+ where
+ w64 = word48ToWord64 w
+ dat = w64 `cutMask` 0x0000FFFFFFFF
+ bop = [ SET, CLR, TGL, TST, XOR ] !! (w64 `cutMask` 0x00E000000000)
+ sreg = mkSreg $ w64 `cutMask` 0x00FF00000000
+
+-- TODO
+parseType19 = Type19
+
+parseType20 w = Type20 (pushes, pops) fc
+ where
+ w64 = word48ToWord64 w
+ lpu = if w64 `testBit` 39 then "LOOP" else ""
+ lpo = if w64 `testBit` 38 then "LOOP" else ""
+ spu = if w64 `testBit` 37 then "STS" else ""
+ spo = if w64 `testBit` 36 then "STS" else ""
+ ppu = if w64 `testBit` 35 then "PCSTK" else ""
+ ppo = if w64 `testBit` 34 then "PCSTK" else ""
+ pushes = filter (/= "") [lpu, spu, ppu]
+ pops = filter (/= "") [lpo, spo, ppo]
+ fc = w64 `testBit` 33
+
+-- TODO
+parseType25 = Type25
+
+
+parseInstruction :: Word48 -> Instruction
+parseInstruction word =
+ let
+ w64 = word48ToWord64 word
+ b1 = (w64 `cutMask` 0xFF0000000000) :: Word8
+ b2 = (w64 `cutMask` 0x00FF00000000) :: Word8
+ in case fromIntegral b1 of
+ [b| 0000 0000 |] -> if b2 `testBit` 7
+ then IDLE
+ else NOP
+ [b| 0000 0001 |] -> parseType2 word
+ [b| 0000 0010 |] -> parseType6 word
+ [b| 0000 0011 |] -> UndefinedInstruction word
+ [b| 0000 0100 |] -> parseType7 word
+ [b| 0000 0101 |] -> UndefinedInstruction word
+ [b| 0000 0110 |] -> parseType8 Address24 word
+ [b| 0000 0111 |] -> parseType8 RelAddress24 word
+ [b| 0000 1000 |] -> parseType9 word
+ [b| 0000 1001 |] -> parseType9 word
+ [b| 0000 1010 |] -> parseType11 Subroutine word
+ [b| 0000 1011 |] -> parseType11 Interrupt word
+ [b| 0000 1100 |] -> parseType12 word
+ [b| 0000 1101 |] -> parseType12 word
+ [b| 0000 1110 |] -> parseType13 word
+ [b| 0000 1111 |] -> parseType17 word
+
+ [b| 0001 0100 |] -> parseType18 word
+ [b| 0001 0101 |] -> UndefinedInstruction word
+ [b| 0001 0110 |] -> parseType19 word
+ [b| 0001 0111 |] -> parseType20 word
+ [b| 0001 1000 |] -> parseType25 word
+
+ -- check six bit prefix
+ _ -> case b1 .&. 0xFC of
+ [b| 0001 0000 |] -> parseType14 word
+ -- check four bit prefix
+ _ -> case b1 .&. 0xF0 of
+ [b| 0110 0000 |] -> parseType4 word
+ [b| 0111 0000 |] -> parseType5 word
+ [b| 1000 0000 |] -> parseType6 word
+ [b| 1001 0000 |] -> parseType16 word
+ -- check three bit prefix
+ _ -> case b1 .&. 0xE0 of
+ [b| 001 00000 |] -> parseType1 word
+ [b| 010 00000 |] -> parseType3 word
+ [b| 101 00000 |] -> parseType15 word
+ [b| 110 00000 |] -> parseType10 word
+ [b| 111 00000 |] -> parseType10 word
+ _ -> InvalidInstruction word
+
+getInstruction :: Get Instruction
+getInstruction = fmap parseInstruction getPackedWord48
+
+printInstructionWithAddr :: (Word64, Instruction) -> IO ()
+printInstructionWithAddr (addr, instr) = printf "0x%05X: %s\n" addr (show instr)
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-21 12:45:12 +0000