{-| 
Module      : Lion.Alu
Description : Lion arithmetic logic unit
Copyright   : (c) David Cox, 2021
License     : BSD-3-Clause
Maintainer  : standardsemiconductor@gmail.com

Configurable alu, choose between soft and hard adders/subtractors
-}

module Lion.Alu where

import Clash.Prelude
import Data.Function ( on )
import Data.Proxy
import Ice40.Mac 
import Lion.Instruction

-- | ALU configuration
data AluConfig = Hard -- ^ use hard adder and subtractor from iCE40 SB_MAC16
               | Soft -- ^ use generic adder and subtractor: (+) and (-)
  deriving stock ((forall x. AluConfig -> Rep AluConfig x)
-> (forall x. Rep AluConfig x -> AluConfig) -> Generic AluConfig
forall x. Rep AluConfig x -> AluConfig
forall x. AluConfig -> Rep AluConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AluConfig x -> AluConfig
$cfrom :: forall x. AluConfig -> Rep AluConfig x
Generic, Int -> AluConfig -> ShowS
[AluConfig] -> ShowS
AluConfig -> String
(Int -> AluConfig -> ShowS)
-> (AluConfig -> String)
-> ([AluConfig] -> ShowS)
-> Show AluConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AluConfig] -> ShowS
$cshowList :: [AluConfig] -> ShowS
show :: AluConfig -> String
$cshow :: AluConfig -> String
showsPrec :: Int -> AluConfig -> ShowS
$cshowsPrec :: Int -> AluConfig -> ShowS
Show, AluConfig -> AluConfig -> Bool
(AluConfig -> AluConfig -> Bool)
-> (AluConfig -> AluConfig -> Bool) -> Eq AluConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AluConfig -> AluConfig -> Bool
$c/= :: AluConfig -> AluConfig -> Bool
== :: AluConfig -> AluConfig -> Bool
$c== :: AluConfig -> AluConfig -> Bool
Eq)

class Alu (config :: AluConfig) where
  alu :: HiddenClockResetEnable dom 
      => Proxy (config :: AluConfig)
      -> Signal dom Op
      -> Signal dom (BitVector 32)
      -> Signal dom (BitVector 32)
      -> Signal dom (BitVector 32)

instance Alu 'Soft where
  alu :: Proxy 'Soft
-> Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
alu Proxy 'Soft
_ Signal dom Op
op Signal dom (BitVector 32)
in1 = BitVector 32
-> Signal dom (BitVector 32) -> Signal dom (BitVector 32)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register BitVector 32
0 (Signal dom (BitVector 32) -> Signal dom (BitVector 32))
-> (Signal dom (BitVector 32) -> Signal dom (BitVector 32))
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op -> BitVector 32 -> BitVector 32 -> BitVector 32)
-> Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Op -> BitVector 32 -> BitVector 32 -> BitVector 32
aluFunc Signal dom Op
op Signal dom (BitVector 32)
in1 
    where
      aluFunc :: Op -> BitVector 32 -> BitVector 32 -> BitVector 32
aluFunc = \case 
        Op
Add  -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Num a => a -> a -> a
(+)
        Op
Sub  -> (-)
        Op
Sll  -> \BitVector 32
x BitVector 32
y -> BitVector 32
x BitVector 32 -> Int -> BitVector 32
forall a. Bits a => a -> Int -> a
`shiftL` BitVector 32 -> Int
shamt BitVector 32
y
        Op
Slt  -> Bool -> BitVector 32
forall (n :: Nat). KnownNat n => Bool -> BitVector (n + 1)
boolToBV (Bool -> BitVector 32)
-> (Signed 32 -> Signed 32 -> Bool)
-> Signed 32
-> Signed 32
-> BitVector 32
forall b c a a. (b -> c) -> (a -> a -> b) -> a -> a -> c
... Signed 32 -> Signed 32 -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Signed 32 -> Signed 32 -> BitVector 32)
-> (BitVector 32 -> Signed 32)
-> BitVector 32
-> BitVector 32
-> BitVector 32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BitVector 32 -> Signed 32
sign
        Op
Sltu -> Bool -> BitVector 32
forall (n :: Nat). KnownNat n => Bool -> BitVector (n + 1)
boolToBV (Bool -> BitVector 32)
-> (BitVector 32 -> BitVector 32 -> Bool)
-> BitVector 32
-> BitVector 32
-> BitVector 32
forall b c a a. (b -> c) -> (a -> a -> b) -> a -> a -> c
... BitVector 32 -> BitVector 32 -> Bool
forall a. Ord a => a -> a -> Bool
(<)
        Op
Xor  -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
xor
        Op
Srl  -> \BitVector 32
x BitVector 32
y -> BitVector 32
x BitVector 32 -> Int -> BitVector 32
forall a. Bits a => a -> Int -> a
`shiftR` BitVector 32 -> Int
shamt BitVector 32
y
        Op
Sra  -> \BitVector 32
x BitVector 32
y -> Signed 32 -> BitVector (BitSize (Signed 32))
forall a. BitPack a => a -> BitVector (BitSize a)
pack (Signed 32 -> BitVector (BitSize (Signed 32)))
-> Signed 32 -> BitVector (BitSize (Signed 32))
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> Signed 32
sign BitVector 32
x Signed 32 -> Int -> Signed 32
forall a. Bits a => a -> Int -> a
`shiftR` BitVector 32 -> Int
shamt BitVector 32
y
        Op
Or   -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
(.|.)
        Op
And  -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
(.&.)
        where
          shamt :: BitVector 32 -> Int
shamt = BitVector (BitSize Int) -> Int
forall a. BitPack a => BitVector (BitSize a) -> a
unpack (BitVector (BitSize Int) -> Int)
-> (BitVector 32 -> BitVector (BitSize Int)) -> BitVector 32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector 5 -> BitVector (BitSize Int)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f b
resize (BitVector 5 -> BitVector (BitSize Int))
-> (BitVector 32 -> BitVector 5)
-> BitVector 32
-> BitVector (BitSize Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SNat 4 -> SNat 0 -> BitVector 32 -> BitVector ((4 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 4
d4 SNat 0
d0
          sign :: BitVector 32 -> Signed 32
sign = BitVector 32 -> Signed 32
forall a. BitPack a => BitVector (BitSize a) -> a
unpack :: BitVector 32 -> Signed 32
          ... :: (b -> c) -> (a -> a -> b) -> a -> a -> c
(...) = ((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)(((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c)
-> ((b -> c) -> (a -> b) -> a -> c)
-> (b -> c)
-> (a -> a -> b)
-> a
-> a
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
      
instance Alu 'Hard where
  alu :: Proxy 'Hard
-> Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
alu Proxy 'Hard
_ Signal dom Op
op Signal dom (BitVector 32)
in1 Signal dom (BitVector 32)
in2 = Signal dom Bool
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
isAddSub Signal dom (BitVector 32)
adderSubtractor (Signal dom (BitVector 32) -> Signal dom (BitVector 32))
-> Signal dom (BitVector 32) -> Signal dom (BitVector 32)
forall a b. (a -> b) -> a -> b
$ BitVector 32
-> Signal dom (BitVector 32) -> Signal dom (BitVector 32)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register BitVector 32
0 (Signal dom (BitVector 32) -> Signal dom (BitVector 32))
-> Signal dom (BitVector 32) -> Signal dom (BitVector 32)
forall a b. (a -> b) -> a -> b
$ Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall (dom :: Domain).
Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
baseAlu Signal dom Op
op Signal dom (BitVector 32)
in1 Signal dom (BitVector 32)
in2
    where
      isAdd :: Signal dom Bool
isAdd = (Op
Add Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== ) (Op -> Bool) -> Signal dom Op -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Op
op
      isSub :: Signal dom Bool
isSub = (Op
Sub Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== ) (Op -> Bool) -> Signal dom Op -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Op
op
      isAddSub :: Signal dom Bool
isAddSub = Bool -> Signal dom Bool -> Signal dom Bool
forall (dom :: Domain) a.
(NFDataX a, HiddenClock dom, HiddenEnable dom) =>
a -> Signal dom a -> Signal dom a
delay Bool
False (Signal dom Bool -> Signal dom Bool)
-> Signal dom Bool -> Signal dom Bool
forall a b. (a -> b) -> a -> b
$ Signal dom Bool
isAdd Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type).
Applicative f =>
f Bool -> f Bool -> f Bool
.||. Signal dom Bool
isSub
      adderSubtractor :: Signal dom (BitVector 32)
adderSubtractor = Signal dom Bit
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall (dom :: Domain).
HiddenClock dom =>
Signal dom Bit
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
hardAddSub (Bool -> Bit
boolToBit (Bool -> Bit) -> Signal dom Bool -> Signal dom Bit
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
isSub) Signal dom (BitVector 32)
in1 Signal dom (BitVector 32)
in2
  
baseAlu
  :: Signal dom Op
  -> Signal dom (BitVector 32)
  -> Signal dom (BitVector 32)
  -> Signal dom (BitVector 32)
baseAlu :: Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
baseAlu = (Op -> BitVector 32 -> BitVector 32 -> BitVector 32)
-> Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 ((Op -> BitVector 32 -> BitVector 32 -> BitVector 32)
 -> Signal dom Op
 -> Signal dom (BitVector 32)
 -> Signal dom (BitVector 32)
 -> Signal dom (BitVector 32))
-> (Op -> BitVector 32 -> BitVector 32 -> BitVector 32)
-> Signal dom Op
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
forall a b. (a -> b) -> a -> b
$ \case 
  Op
Add  -> \BitVector 32
_ BitVector 32
_ -> BitVector 32
0
  Op
Sub  -> \BitVector 32
_ BitVector 32
_ -> BitVector 32
0
  Op
Sll  -> \BitVector 32
x BitVector 32
y -> BitVector 32
x BitVector 32 -> Int -> BitVector 32
forall a. Bits a => a -> Int -> a
`shiftL` BitVector 32 -> Int
shamt BitVector 32
y
  Op
Slt  -> Bool -> BitVector 32
forall (n :: Nat). KnownNat n => Bool -> BitVector (n + 1)
boolToBV (Bool -> BitVector 32)
-> (Signed 32 -> Signed 32 -> Bool)
-> Signed 32
-> Signed 32
-> BitVector 32
forall b c a a. (b -> c) -> (a -> a -> b) -> a -> a -> c
... Signed 32 -> Signed 32 -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Signed 32 -> Signed 32 -> BitVector 32)
-> (BitVector 32 -> Signed 32)
-> BitVector 32
-> BitVector 32
-> BitVector 32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BitVector 32 -> Signed 32
sign
  Op
Sltu -> Bool -> BitVector 32
forall (n :: Nat). KnownNat n => Bool -> BitVector (n + 1)
boolToBV (Bool -> BitVector 32)
-> (BitVector 32 -> BitVector 32 -> Bool)
-> BitVector 32
-> BitVector 32
-> BitVector 32
forall b c a a. (b -> c) -> (a -> a -> b) -> a -> a -> c
... BitVector 32 -> BitVector 32 -> Bool
forall a. Ord a => a -> a -> Bool
(<)
  Op
Xor  -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
xor
  Op
Srl  -> \BitVector 32
x BitVector 32
y -> BitVector 32
x BitVector 32 -> Int -> BitVector 32
forall a. Bits a => a -> Int -> a
`shiftR` BitVector 32 -> Int
shamt BitVector 32
y
  Op
Sra  -> \BitVector 32
x BitVector 32
y -> Signed 32 -> BitVector (BitSize (Signed 32))
forall a. BitPack a => a -> BitVector (BitSize a)
pack (Signed 32 -> BitVector (BitSize (Signed 32)))
-> Signed 32 -> BitVector (BitSize (Signed 32))
forall a b. (a -> b) -> a -> b
$ BitVector 32 -> Signed 32
sign BitVector 32
x Signed 32 -> Int -> Signed 32
forall a. Bits a => a -> Int -> a
`shiftR` BitVector 32 -> Int
shamt BitVector 32
y
  Op
Or   -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
(.|.)
  Op
And  -> BitVector 32 -> BitVector 32 -> BitVector 32
forall a. Bits a => a -> a -> a
(.&.)
  where
    shamt :: BitVector 32 -> Int
shamt = BitVector (BitSize Int) -> Int
forall a. BitPack a => BitVector (BitSize a) -> a
unpack (BitVector (BitSize Int) -> Int)
-> (BitVector 32 -> BitVector (BitSize Int)) -> BitVector 32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector 5 -> BitVector (BitSize Int)
forall (f :: Nat -> Type) (a :: Nat) (b :: Nat).
(Resize f, KnownNat a, KnownNat b) =>
f a -> f b
resize (BitVector 5 -> BitVector (BitSize Int))
-> (BitVector 32 -> BitVector 5)
-> BitVector 32
-> BitVector (BitSize Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SNat 4 -> SNat 0 -> BitVector 32 -> BitVector ((4 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 4
d4 SNat 0
d0
    sign :: BitVector 32 -> Signed 32
sign = BitVector 32 -> Signed 32
forall a. BitPack a => BitVector (BitSize a) -> a
unpack :: BitVector 32 -> Signed 32
    ... :: (b -> c) -> (a -> a -> b) -> a -> a -> c
(...) = ((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)(((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c)
-> ((b -> c) -> (a -> b) -> a -> c)
-> (b -> c)
-> (a -> a -> b)
-> a
-> a
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

-- | addSub32PipelinedUnsigned
hardAddSub
  :: HiddenClock dom
  => Signal dom Bit -- 0 = Add, 1 = Sub
  -> Signal dom (BitVector 32)
  -> Signal dom (BitVector 32)
  -> Signal dom (BitVector 32)
hardAddSub :: Signal dom Bit
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
-> Signal dom (BitVector 32)
hardAddSub Signal dom Bit
addSub Signal dom (BitVector 32)
x Signal dom (BitVector 32)
y = Signal dom (BitVector 32)
out
  where
    (Signal dom (BitVector 32)
out, Signal dom Bit
_, Signal dom Bit
_, Signal dom Bit
_) = Parameter
-> Input dom
-> (Signal dom (BitVector 32), Signal dom Bit, Signal dom Bit,
    Signal dom Bit)
forall (dom :: Domain).
HiddenClock dom =>
Parameter
-> Input dom
-> (Signal dom (BitVector 32), Signal dom Bit, Signal dom Bit,
    Signal dom Bit)
mac Parameter
parameter Input dom
input
    input :: Input dom
input = Input dom
forall (dom :: Domain). Input dom
defaultInput{ a :: Signal dom (BitVector 16)
a = SNat 31 -> SNat 16 -> BitVector 32 -> BitVector ((31 + 1) - 16)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 31
d31 SNat 16
d16 (BitVector 32 -> BitVector 16)
-> Signal dom (BitVector 32) -> Signal dom (BitVector 16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector 32)
y
                        , b :: Signal dom (BitVector 16)
b = SNat 15 -> SNat 0 -> BitVector 32 -> BitVector ((15 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 15
d15 SNat 0
d0  (BitVector 32 -> BitVector 16)
-> Signal dom (BitVector 32) -> Signal dom (BitVector 16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector 32)
y
                        , c :: Signal dom (BitVector 16)
c = SNat 31 -> SNat 16 -> BitVector 32 -> BitVector ((31 + 1) - 16)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 31
d31 SNat 16
d16 (BitVector 32 -> BitVector 16)
-> Signal dom (BitVector 32) -> Signal dom (BitVector 16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector 32)
x
                        , d :: Signal dom (BitVector 16)
d = SNat 15 -> SNat 0 -> BitVector 32 -> BitVector ((15 + 1) - 0)
forall a (m :: Nat) (i :: Nat) (n :: Nat).
(BitPack a, BitSize a ~ ((m + 1) + i)) =>
SNat m -> SNat n -> a -> BitVector ((m + 1) - n)
slice SNat 15
d15 SNat 0
d0  (BitVector 32 -> BitVector 16)
-> Signal dom (BitVector 32) -> Signal dom (BitVector 16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (BitVector 32)
x
                        , addsubtop :: Signal dom Bit
addsubtop = Signal dom Bit
addSub
                        , addsubbot :: Signal dom Bit
addsubbot = Signal dom Bit
addSub
                        }
    parameter :: Parameter
parameter = Parameter
defaultParameter{ topOutputSelect :: BitVector 2
topOutputSelect = BitVector 2
1
                                , topAddSubUpperInput :: Bit
topAddSubUpperInput = Bit
1
                                , topAddSubCarrySelect :: BitVector 2
topAddSubCarrySelect = BitVector 2
2
                                , botOutputSelect :: BitVector 2
botOutputSelect = BitVector 2
1
                                , botAddSubUpperInput :: Bit
botAddSubUpperInput = Bit
1
                                , mode8x8 :: Bit
mode8x8 = Bit
1
                                }