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