module System.RedPitaya.Bus.ClientBind
(
writeCore,
readCore ,
callCore
)
where
import CLaSH.Prelude
import qualified Prelude as P
import System.RedPitaya.Bus.CoreBind
import System.RedPitaya.Fpga
writeCore :: forall rp a a1 a2 a3 a4 .
( BusBuildC a a1 a2 a3 a4, KnownNat a4
, FpgaSetGet rp)
=> Page -> Offset
-> (SNat a2 , SNat a3)
-> a -> rp ()
writeCore page off (snatA,snatC) inData = sendData where
splitp = snat :: SNat (a2 * 32)
(vL,vR) = splitAt splitp $ bv2v $ pack inData
vlM = unconcatI vL :: Vec a2 (Vec 32 Bit)
vRfill = def :: Vec a4 Bit
lstV = vR ++ vRfill :: Vec 32 Bit
arr = v2r <$> toList vlM :: [Registry]
v2i x = bitCoerce x :: Unsigned 32
v2r = fromInteger . toInteger . v2i :: Vec 32 Bit -> Registry
sendData = writeFpgaArray page off ( arr P.++ [v2r lstV])
readCore :: forall rp a a1 a2 a3 a4 .
( BusBuildC a a1 a2 a3 a4
, FpgaSetGet rp)
=> Page -> Offset
-> (SNat a2 , SNat a3)
-> rp a
readCore page off (snatA,snatC) = r where
snatAint = fromInteger ( snatToInteger snatA) :: Int
snatCint = fromInteger ( snatToInteger snatC) :: Int
r = fdata <$> readFpgaArray page off (snatAint+1) where
fdata rsp = unpack (arrB ++# lastB) where
arrV = fromInteger . toInteger <$> fromListI rsp :: Vec a2 (Unsigned 32)
arrB = pack arrV :: BitVector (a2 * 32)
lastVl = fromInteger $ toInteger $ P.last rsp :: Unsigned 32
lastB = pack $ truncateB $ lastVl `shiftR` (32 snatCint) :: BitVector a3
callCore :: ( BusBuildC a a1 a2 a3 a4
, BusBuildC b b1 b2 b3 b4
, KnownNat a4
, FpgaSetGet rp)
=> (SNat a2, SNat a3, SNat b2, SNat b3)
-> Page -> Offset
-> Page -> Offset
-> a -> rp b
callCore (sinA,sinC,soutA,soutC) pw ow pr or din =
writeCore pw ow (sinA,sinC) din >> readCore pw or (soutA,soutC)
fromListUnsafeU :: UNat n -> [a] -> Vec n a
fromListUnsafeU UZero _ = Nil
fromListUnsafeU (USucc s) (x:xs) = x :> fromListUnsafeU s xs
fromListUnsafe :: SNat n -> [a] -> Vec n a
fromListUnsafe n = fromListUnsafeU (toUNat n)
fromListI :: (Default a ,KnownNat n) => [a] -> Vec n a
fromListI xs = fromListUnsafe snat $ xs P.++ P.repeat def