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

   1 module DLX_Cell where
   2
   3 import Cell
   4 import Register
   5 import Words
   6
   7 data Value a = NotKnown
   8              | Inv
   9              | Val a
  10         deriving (Eq,Show)
  11
  12 data DLX_Cell r w = Reg r (Value w)
  13                   | Loc w
  14                   | Imm w
  15         deriving (Eq,Show)
  16
  17 instance Cell DLX_Cell where
  18   pcNothing = Reg pc NotKnown
  19   loc = Loc
  20
  21   getReg (Reg r _)              = r
  22
  23   getVal (Reg _ (Val val))              = val
  24   getVal (Imm val)                      = val
  25   getVal cell                           = error ("No data for getData: " ++
  26                                                  show cell)
  27
  28   putVal cell Nothing                 = invalidate     cell
  29   putVal reg@(Reg r x) (Just v)
  30            | readOnly r = reg
  31            | otherwise = Reg r (Val v)
  32
  33   putVal valCell@(Imm _ ) _
  34     = error ("Can't put data into a value cell: " ++ show valCell)
  35
  36
  37   invalidate     reg@(Reg r _ )
  38     | readOnly r = reg
  39     | otherwise     = Reg r Inv
  40   invalidate     imm@(Imm _ )           = imm
  41
  42
  43   isReg (Reg _ _ )      = True
  44   isReg _                       = False
  45
  46   isPC (Reg x _)        = ispc x
  47   isPC _                        = False
  48
  49   isSpecPC (Reg x  _)= isspecpc x
  50   isSpecPC _            = False
  51
  52   isLoc (Loc _) = True
  53   isLoc _                       = False
  54
  55   isVal (Imm _ )        = True
  56   isVal _                       = False
  57
  58   isInv (Reg _ Inv)     = True
  59   isInv _                       = False
  60
  61   isAss (Reg _ (Val _ ))        = True
  62   isAss (Imm _ )                = True
  63   isAss _                               = False
  64
  65   isComputed (Reg _ NotKnown) = False
  66   isComputed _                     = True
  67
  68
  69 -- Do the two cells name the same Loc (Reg or PC?)
  70   sameLoc (Reg reg1 _ ) (Reg reg2 _ ) = reg1 == reg2
  71   sameLoc _ _           = False
  72
  73
  74   cellHazard (Reg precReg pRegVal ) (Reg followReg fRegVal )
  75     | readOnly precReg          = False
  76     | precReg == followReg      = pRegVal /= Inv && fRegVal /= Inv
  77     | True                      = False
  78   cellHazard _ _                        = False
  79
  80
  81
  82
  83
  84
  85
  86