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

   1 module Arithmetic
   2   (
   3          alu
   4         ,Immediate
   5         ,Sign(..)
   6         ,Comparison(..)
   7         ,AluOp(..)
   8         ,ImmediateSize(..)
   9   ) where
  10
  11 import Words
  12 import Word
  13 import Int
  14
  15 -- Begin Signature: Arithmetic ----------------------------------------------
  16 {-
  17
  18 The Arithmetic module defines the datatype "AluOp" to represent the
  19 various sorts of operations you might pass to an ALU like circuit.
  20 The "Instruction" class defines its methods to use AluOp as the
  21 least-common denomiator (no pun intended) of arithmetic-based instructions.
  22
  23 -}
  24
  25 type Immediate = Int
  26
  27 data Sign = Signed
  28           | Unsigned
  29       deriving (Eq,Show, Read)
  30
  31 data Comparison = LessThan
  32                 | LessEqual
  33                 | GreaterThan
  34                 | GreaterEqual
  35                 | Equal
  36                 | NotEqual
  37              deriving (Eq,Show, Read)
  38
  39 data AluOp        = Add Sign |
  40                   Sub Sign |
  41                   Mult Sign |
  42                   Div Sign |
  43                   And |
  44                   Not |
  45                   Or | Xor |
  46                   Sll | Srl | Sra |
  47                   S Comparison |
  48                   SetHi |               -- Set high 16 bits of value.
  49                   Input1 |              -- pass input1 through
  50                   Input2 |              -- pass input2 through
  51                   Invalidate            -- Invalidate the result of the
  52                                         --  ALU operation
  53                   deriving (Eq,Show, Read)
  54
  55
  56 data ImmediateSize = Imm16Bits | Imm26Bits
  57
  58 alu :: Word w => AluOp -> w -> w -> Maybe w
  59
  60 -- End Signature: Arithmetic ------------------------------------------------
  61
  62 -- If the ALUfunc is "Invalidate", this function returns Nothing,
  63 --  otherwise it performs the assiciated ALU operation.
  64 alu Invalidate _ _
  65   = Nothing
  66 alu aluFunc word1 word2
  67   = Just (exec_op aluFunc word1 word2)
  68
  69
  70 -- signExtend is only used inside combinational circuits.
  71 signExtend :: Word w => ImmediateSize -> Immediate -> w
  72 signExtend Imm16Bits = fromInt
  73 signExtend Imm26Bits = fromInt
  74
  75
  76 ------------------------ Integer ALU unit ---------------------------
  77
  78
  79 -- Performs integer addition and also returns whether overflow ocurred
  80 addOverflowCheck :: Word w =>  w -> w -> (w,Bool)
  81 addOverflowCheck a b
  82   = (out,overflow)
  83     where
  84       out = a + b
  85       overflow = out > maxBound || out < minBound
  86
  87 overflowErr :: Word w => AluOp -> w -> w -> a
  88 overflowErr op a b
  89   = error ("alu (" ++ show op ++ ") " ++ show a ++ " "
  90           ++ show b ++ "  <-- overflow")
  91
  92 {-
  93         NOTE: I'm not worrying about whether overflow
  94                 calculations are computed correctly, except
  95                 for signed addition and subtraction. In the
  96                 other cases, I'm letting the bits fall where
  97                 they may. Hopefully none of the benchmarks
  98                 cause overflows at all.
  99 -}
 100
 101
 102 -- This function performs the unsigned version of the normal signed
 103 --  integer operation
 104 unsignedWordOp :: Word w => (w->w->w) -> (w->w->w)
 105 unsignedWordOp f a b = sign $ unsign a `f` unsign b
 106
 107
 108 -- These functions convert between a Word and a vector of Bools.
 109
 110 bitValues :: Word w => [w]
 111 bitValues = map (2 ^) [31,30..0]
 112
 113 buildVec :: Word w => w -> [Bool]
 114 buildVec n
 115   = makeVec (unsign n) bitValues
 116     where
 117       makeVec :: Word w => w -> [w] -> [Bool]
 118       makeVec 0 [] = []
 119       makeVec _ [] = [] ---- should we catch this?
 120       makeVec n (b:bs)
 121         = if n >= b
 122             then True : makeVec (n-b) bs
 123             else False : makeVec n bs
 124
 125 buildWord :: Word w => [Bool] -> w
 126 buildWord bools
 127   = sign $ makeInteger bools bitValues
 128     where
 129       makeInteger [] []
 130         = 0
 131       makeInteger n []
 132         = error ("buildWord -- argument too large: " ++ show bools)
 133       makeInteger (b:bs) (n:ns)
 134         = if b
 135             then n + makeInteger bs ns
 136             else makeInteger bs ns
 137
 138 -- Performs an element-wise boolean operation on corresponding
 139 --  pairs of bits of the argument integers
 140 bitOp :: Word w =>  (Bool->Bool->Bool) -> (w->w->w)
 141 bitOp f a b
 142   = buildWord $ zipWith f (buildVec a) (buildVec b)
 143
 144
 145
 146 -- This function assumes the ALUfunc argument is not "Invalidate"
 147 exec_op :: Word w => AluOp -> w -> w -> w
 148
 149 exec_op op@(Add Signed) a b
 150   = if overflow
 151       then overflowErr op a b
 152       else out
 153     where
 154       (out,overflow) = addOverflowCheck a b
 155
 156 exec_op (Add Unsigned) a b
 157   = unsignedWordOp (+) a b
 158
 159 exec_op op@(Sub Signed) a b
 160   = if overflow
 161       then overflowErr op a b
 162       else out
 163     where
 164       (out,overflow) = addOverflowCheck a (-b)
 165
 166 exec_op (Sub Unsigned) a b
 167   = unsignedWordOp (-) a b
 168
 169 exec_op (Mult Signed) a b
 170   = sign $ a * b
 171
 172 exec_op (Mult Unsigned) a b
 173   = unsignedWordOp (*) a b
 174
 175 exec_op (Div Signed) a b
 176   = sign $ a `div` b
 177
 178 exec_op (Div Unsigned) a b
 179   = unsignedWordOp div a b
 180
 181 exec_op And a b = bitOp (&&) a b
 182
 183 exec_op Or a b = bitOp (||) a b
 184
 185 -- eh, this is kinda temporary.
 186 --exec_op Not a b = bitOp (\x y -> not x) a b
 187 exec_op Not a b = if a == 0 then 1 else 0
 188
 189 exec_op Xor a b = bitOp xor a b
 190                   where
 191                     xor False x = x
 192                     xor True  x = not x
 193
 194 exec_op Sll a b
 195   = buildWord $ drop shiftAmt (buildVec a) ++ replicate shiftAmt False
 196     where
 197       shiftAmt = toInt $ unsign b `mod` 32
 198
 199 exec_op Srl a b
 200   = buildWord $ replicate shiftAmt False ++ take (32 - shiftAmt) (buildVec a)
 201     where
 202       shiftAmt = toInt $ unsign b `mod` 32
 203
 204 exec_op Sra a b
 205   = buildWord $ replicate shiftAmt signBit ++ take (32 - shiftAmt) (buildVec a)
 206     where
 207       shiftAmt = toInt $ unsign b `mod` 32
 208       signBit = (a < 0)
 209
 210 exec_op (S relop) a b
 211   = if (a `relation` b) then 1 else 0
 212     where
 213       relation = case relop of
 214                    LessThan     -> (<)
 215                    LessEqual    -> (<=)
 216                    GreaterThan  -> (>)
 217                    GreaterEqual -> (>=)
 218                    Equal        -> (==)
 219                    NotEqual     -> (/=)
 220
 221 exec_op SetHi a _
 222   = a * num_half        -- a * 2^n
 223
 224 exec_op Input1 a b
 225   = a
 226
 227 exec_op Input2 a b
 228   = b
 229
 230