ghc/tests/programs/jeff-bug/DLX.hs

   1 module DLX
   2   (
   3       Instr(..)
   4      ,BranchFunc(..)
   5      ,ImmOpcode(..)
   6      ,RegOpcode(..)
   7      ,JmpOpcode(..)
   8      ,DLXReg(..)
   9      ,SrcReg
  10      ,DstReg
  11      ,DLX_Trans
  12      ,DLXCell
  13      ,DLX_Word
  14      ,DLX_Instr
  15      ,DLX_InstrMem
  16      ,dlx2trans
  17      ,VDLXTrans
  18      ,VReg
  19      ,VTrans
  20      ,module DLX_Cell
  21      ,module DLX_Reg
  22      ,module DLX_Op
  23   ) where
  24
  25
  26 import Ix
  27 import Hawk
  28 import Word
  29 import Trans
  30 import DLX_Cell
  31 import DLX_Reg
  32 import DLX_Op
  33
  34 type DLX_Word = Word32
  35 type VDLXTrans = VTrans DLXReg DLX_Word
  36 type VReg a = Virtual a Int
  37 type VTrans r w = Trans DLX_Op (VReg r)
  38
  39 fillIn x= fillInCells x
  40
  41
  42 data Instr reg i
  43            = ImmIns     ImmOpcode reg reg i |
  44              RegReg     RegOpcode AluOp reg reg reg |
  45              Jmp        JmpOpcode Int |
  46              Nop
  47              deriving (Eq,Show, Read)
  48
  49
  50 data BranchFunc = Never | Always | IfEqZero | IfNeqZero
  51             deriving (Eq,Show, Read)
  52
  53 data ImmOpcode = LoadStoreImm LoadStoreOp |
  54            ALUImm AluOp |
  55            BEQZ | BNEZ |
  56            JR |
  57            JALR
  58            deriving (Eq,Show, Read)
  59
  60 data RegOpcode = MOVI2S | MOVS2I |
  61            ALU
  62            deriving (Eq,Show, Read)
  63
  64 data JmpOpcode = J |
  65            JAL |
  66            TRAP |
  67            RFE
  68            deriving (Eq,Show, Read)
  69
  70
  71
  72 instance Register DLXReg where
  73      readOnly R0 = True
  74      readOnly Dummy = True
  75      readOnly _  = False
  76      pc = PC
  77      specpc = SpecPC
  78 --     specpc = PC
  79 --  bug fix?  Thu Nov 19 18:12:24 PST 1998
  80      ispc x = PC == x
  81      isspecpc x = SpecPC == x
  82
  83 type DLXCell a = DLX_Cell DLXReg a
  84 type DLX_Trans a = Trans DLX_Op (DLXCell a)
  85 type DLX_Instr a = Instr DLXReg a
  86
  87 type DLX_InstrMem a = InstrMemoryState DLX_Word (DLX_Instr a)
  88
  89
  90 type SrcReg = DLXReg     -- Source register
  91 type DstReg = DLXReg     -- Destination register
  92
  93
  94
  95 regNothing R0 = Reg R0 (Val 0)
  96 regNothing reg = Reg reg NotKnown
  97
  98 dlx2trans :: Word2 i a => Instr DLXReg i -> DLX_Trans a
  99
 100 dlx2trans (ImmIns (LoadStoreImm loadOp@(Load _ _ )) dest src offset)
 101   = Trans [regNothing dest] (MemOp loadOp)
 102           [regNothing src,Imm (toWord offset)] []
 103  --         [regNothing src,Imm (toWord offset),regNothing Dummy] []
 104
 105 {-
 106 dlx2trans (ImmIns (LoadStoreImm storeOp@(Store _ )) writeAddr writeReg offset)
 107   = Trans [regNothing Dummy] (MemOp storeOp) [regNothing writeAddr,
 108                               Imm (toWord offset),
 109                               regNothing writeReg] []
 110
 111 dlx2trans (ImmIns (ALUImm SetHi) dest _ imm)
 112   = Trans [destCell] (ExecOp SetHi) [Imm (toWord imm)] []
 113     where
 114       destCell = regNothing dest
 115
 116 dlx2trans (ImmIns (ALUImm aluFunc) dest src imm)
 117   = Trans [destCell] (ExecOp aluFunc) [srcCell,Imm (toWord imm)] []
 118     where
 119       destCell = regNothing dest
 120       srcCell = regNothing src
 121
 122 dlx2trans (ImmIns BEQZ _ src pcOffset)
 123   = Trans [pcNothing'] (CondExecOp (Add Signed) Input1) [regNothing src,
 124                                                             pcNothing',
 125                                                             Imm (toWord pcOffset)]
 126           []
 127
 128 dlx2trans (ImmIns BNEZ _ src pcOffset)
 129   = Trans [pcNothing'] (CondExecOp Input1 (Add Signed)) [regNothing src,
 130                                                             pcNothing',
 131                                                             Imm (toWord pcOffset)]
 132     []
 133
 134 dlx2trans (ImmIns JR _ src _ )
 135   = Trans [pcNothing'] (ExecOp Input1) [regNothing src] []
 136
 137
 138 dlx2trans (RegReg ALU aluFunc dest src1 src2)
 139   = Trans [regNothing dest] (ExecOp aluFunc) [regNothing src1, regNothing src2] []
 140
 141 dlx2trans (RegReg unknownOp _ _ _ _ )
 142   = error ("Can't translate " ++ show unknownOp)
 143
 144 dlx2trans (Jmp J offset)
 145   = Trans [pcNothing'] (ExecOp (Add Signed)) [pcNothing', Imm (toWord offset)] []
 146
 147 dlx2trans (ImmIns JALR _ src _ )
 148   = Trans [pcNothing',regNothing R31]
 149           (ParExecOp Input1 Input2)
 150           [regNothing src, pcNothing'] []
 151
 152 dlx2trans (Jmp JAL offset)
 153   = Trans [pcNothing',regNothing R31]
 154           (ParExecOp (Add Signed) Input2)
 155           [Imm (toWord offset),pcNothing']
 156           []
 157
 158
 159 dlx2trans (Jmp TRAP offset )
 160   = Trans [pcNothing',regNothing IAR]
 161           (ParExecOp Input1 Input2)
 162           [Imm (toWord offset),pcNothing']
 163           []
 164
 165
 166 dlx2trans (Jmp RFE _ )
 167   = Trans [pcNothing'] (ExecOp Input1) [regNothing IAR] []
 168
 169 dlx2trans Nop
 170 --  = Trans [Reg Dummy (Val 0)] (NoOp "dlx2trans") [] []
 171     = Trans [] (NoOp "dlx2trans") [] []
 172
 173 -}
 174
 175 pcNothing' = Reg PC NotKnown
 176
 177
 178 instance Show a => Probe (DLXCell a)
 179 instance Probe DLXReg
 180
 181 instance Probe DLX_Op where
 182   outp (ExecOp (Add _ ))   = "+"
 183   outp (ExecOp (Sub _ ))   = "-"
 184   outp (ExecOp (Div _ ))   = "/"
 185   outp (ExecOp (Mult _ ))  = "*"
 186   outp (ExecOp op)         = show op
 187   outp (MemOp (Load _ _))  = "Load"
 188   outp (MemOp (Store _))   = "Store"
 189   outp (ParExecOp op1 op2) = "PAR("++outp op1++","++outp op2 ++ ")"
 190   outp x                   = show x
 191
 192
 193 instance Show a => Probe (DLX_Trans a) where
 194    outp (Trans [] op [] i) = outp op ++  outInfo i
 195    outp (Trans [x] (CondExecOp op1 op2) [c,y,z] i)
 196        = outp x ++ " <- " ++ "(if0 " ++ outp c ++ " ("
 197             ++ outp op1 ++ "," ++ outp op2 ++ ")) "
 198             ++ outp y  ++ " " ++ outp z
 199             ++ outInfo i
 200    outp (Trans dummy (MemOp (Store x)) [c,y,z] i)
 201        = outp (MemOp (Store x)) ++" "++ outp c ++"("++ outp y ++") <- "
 202          ++  outp z ++ outInfo i
 203    outp (Trans [o] op [x,y] i)
 204        = outp o ++ " <- " ++ outp x ++ " " ++ outp op ++ " " ++ outp y
 205                           ++ outInfo i
 206    outp (Trans [] op l i) = outp op ++" "++ outList l ++ outInfo i
 207    outp (Trans [o] op l i)
 208        = outp o ++ " <- " ++ outp op ++" "++ outList l ++ outInfo i
 209    outp (Trans l1 op l2 i)
 210        = outList l1 ++" <- "++ outp op ++" "++ outList l2 ++ outInfo i
 211
 212 outInfo [] = ""
 213 outInfo l = "  {" ++ foldr1 (\x y -> x ++ "," ++ y) (map outp l) ++ "}"
 214
 215 outList [] = ""
 216 outList [x] = outp x
 217 outList l = "[" ++ foldr1 (\x y -> x ++ "," ++ y) (map outp l) ++ "]"
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227