diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lambdaya-bus.cabal b/lambdaya-bus.cabal
new file mode 100644
--- /dev/null
+++ b/lambdaya-bus.cabal
@@ -0,0 +1,85 @@
+-- Initial redpitaya.cabal generated by cabal init. For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name: lambdaya-bus
+
+-- The package version. See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+-- | | | | +- doc update
+version: 0.0.0.1
+
+-- A short (one-line) description of the package.
+synopsis: Fpga bus core and serialization for RedPitaya
+
+-- A longer description of the package.
+description: Bus library for RedPitaya that enables data serialization
+ between Fpga core and client running either on arm or remotely over network.
+ Type signature of Fpga core is used to define interface signature for client.
+
+-- The license under which the package is released.
+license: LGPL-3
+
+-- The file containing the license text.
+license-file: LICENSE
+
+-- The package author(s).
+author: Luka Rahne
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer: luka.rahne@gmail.com
+
+-- A copyright notice.
+-- copyright:
+
+category: System
+stability: Experimental
+
+build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+-- extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version: >=1.10
+
+source-repository head
+ type: git
+ location: https://github.com/ra1u/Lambdaya.git
+
+
+library
+ -- Modules exported by the library.
+ exposed-modules: System.RedPitaya.Bus
+ System.RedPitaya.Bus.CoreBind
+ System.RedPitaya.Bus.ClientBind,
+ System.RedPitaya.Bus.RedPitayaSimple
+
+ -- Modules included in this library but not exported.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+
+ -- Other library packages from which modules are imported.
+ build-depends:
+ base >= 3 && < 5,
+ clash-prelude >= 0.10,
+ Lambdaya >= 0.3 && < 1.0,
+ template-haskell >= 2.10
+
+ -- Directories containing source files.
+ hs-source-dirs: src
+
+ -- Base language which the package is written in.
+ default-language: Haskell2010
+
+ ghc-options: -Wall -fexpose-all-unfoldings
+
+ -- include-dirs: include
diff --git a/src/System/RedPitaya/Bus.hs b/src/System/RedPitaya/Bus.hs
new file mode 100644
--- /dev/null
+++ b/src/System/RedPitaya/Bus.hs
@@ -0,0 +1,10 @@
+module System.RedPitaya.Bus
+ ( module System.RedPitaya.Bus.CoreBind
+ , module System.RedPitaya.Bus.ClientBind
+ , module System.RedPitaya.Bus.RedPitayaSimple
+ ) where
+
+import System.RedPitaya.Bus.CoreBind
+import System.RedPitaya.Bus.ClientBind
+import System.RedPitaya.Bus.RedPitayaSimple
+
diff --git a/src/System/RedPitaya/Bus/ClientBind.hs b/src/System/RedPitaya/Bus/ClientBind.hs
new file mode 100644
--- /dev/null
+++ b/src/System/RedPitaya/Bus/ClientBind.hs
@@ -0,0 +1,82 @@
+{-|
+Copyright : Luka Rahne
+License : LGPL-3 (see the file LICENSE)
+Maintainer : Luka Rahne
+-}
+
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+
+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
diff --git a/src/System/RedPitaya/Bus/CoreBind.hs b/src/System/RedPitaya/Bus/CoreBind.hs
new file mode 100644
--- /dev/null
+++ b/src/System/RedPitaya/Bus/CoreBind.hs
@@ -0,0 +1,220 @@
+{-|
+Copyright : Luka Rahne
+License : LGPL-3 (see the file LICENSE)
+Maintainer : Luka Rahne
+-}
+
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module System.RedPitaya.Bus.CoreBind (
+ BuildThC(..),
+ BuildThModC(..),
+ BusBuildC(..),
+ busBuild,
+ bTQ,
+)
+where
+
+
+import CLaSH.Prelude
+import CLaSH.Sized.Vector ( concatBitVector# )
+import System.RedPitaya.Bus.RedPitayaSimple
+import Language.Haskell.TH
+import qualified Prelude
+
+-- | constraint for defining type being `BitPack`
+type BuildThC a b = ( KnownNat b, KnownNat (BitSize a), BitPack a, (BitSize a) ~ b )
+
+-- | constraint for a = (b * 32) + c and c <= 32
+type BuildThModC a b c d = ( KnownNat a, KnownNat b, KnownNat c, KnownNat (b * 32)
+ , ((b * 32) + c) ~ a, (c + d) ~ 32)
+
+-- | constraint `BuildThModC` and `BuildThC`
+type BusBuildC a a1 a2 a3 a4 = ( BuildThC a a1 , BuildThModC a1 a2 a3 a4 )
+
+---------------------------
+------- Bus -> Core
+---------------------------
+
+-- Produce vector of data from values consumed from bus
+coreBusReadVec :: (Num adr,Eq adr,KnownNat n)
+ => Signal (Maybe (adr,FullDataIn)) -- addr is single step ,data
+ -> Signal (Vec n FullDataIn) -- data
+coreBusReadVec = mealy mf def where
+ mf s Nothing = (s,s)
+ mf s (Just (inAdd,inData)) = (o,o) where
+ o = zipWith zf s (iterateI (+1) 0)
+ zf curData addrN = if (inAdd == addrN) then inData else curData
+
+
+-- Single value bus consumer same input/output size
+coreBusReadSingleGen :: forall a . (KnownNat a)
+ => Signal ( Maybe (BitVector a) )
+ -> Signal ( BitVector a )
+coreBusReadSingleGen = mealy mf def where
+ mf s Nothing = (s,s)
+ mf s (Just d) = (d,d)
+
+-- Single value bus consumer
+coreBusReadSingle :: forall a a' . (KnownNat a,(a + a') ~ 32)
+ => Signal ( Maybe FullDataIn )
+ -> Signal ( BitVector a )
+coreBusReadSingle s = coreBusReadSingleGen r where
+ r = (fmap (v2bv . takey . bv2v . pack) <$> s)
+ takey = takeI :: Vec (a+a') Bit -> Vec a Bit
+
+-- reads from bus genericaly, for now it can read at lest 33 bits or more.
+-- if user needs to read width with less data, than it can use coreBusReadSingle
+coreBusReadSimple :: forall a c c' adr .
+ (KnownNat a,KnownNat c,Num adr,Eq adr,(c + c') ~ 32)
+ => (SNat a,SNat c)
+ -> Signal ( Maybe (adr,FullDataIn) )
+ -> Signal ( BitVector ((a * 32) + c))
+coreBusReadSimple (sNatA,sNatC) sig = r where
+ -- join left of size a*32 and right of size c
+ -- left
+ lvec = coreBusReadVec sig :: Signal (Vec a FullDataIn)
+ lbvec = fmap concatBitVector# ( fmap (fmap pack ) lvec ) :: Signal ( BitVector (a * 32))
+ -- right
+ rval = coreBusReadSingle sigR :: Signal ( BitVector c)
+ where
+ sigR = fmap (>>= f) sig :: Signal ( Maybe FullDataIn )
+ addR = fromInteger $ snatToInteger $ sNatA
+ f (add,d)
+ | addR == add = Just d
+ | otherwise = Nothing
+ -- merge
+ r = (++#) <$> lbvec <*> rval :: Signal ( BitVector ((a * 32) + c))
+
+-- Ready any width (short or wide)
+coreBusReadGeneric :: forall a a1 a2 a3 a4 adr.
+ ( BusBuildC a a1 a2 a3 a4 , Eq adr, Num adr)
+ => ( SNat a2 , SNat a3 )
+ -> Signal ( Maybe (adr,ReadWrite,FullDataIn) )
+ -> Signal a
+coreBusReadGeneric (sinA,sinC) busIn = unpack <$> r where
+ fInWide (Just (addr,Write,d)) = Just (addr,d)
+ fInWide _ = Nothing
+ --
+ fInShort (Just (addr,Write,d)) = Just d
+ fInShort _ = Nothing
+ r = -- input is wide use coreBusReadSimple
+ if not (snatToInteger sinA == 0 ) then
+ coreBusReadSimple (sinA,sinC) $ fInWide <$> busIn
+ else -- use coreBusReadSingle (compiler does not know that sinA == 0)
+ let sInShort = coreBusReadSingle (fInShort <$> busIn) :: Signal (BitVector a3)
+ in (def ++#) <$> sInShort :: Signal (BitVector a1)
+
+---------------------------
+------- Core -> Bus
+---------------------------
+-- write vector on bus
+coreBusWriteVec :: (Eq a, Num a, KnownNat n )
+ => a
+ -> Vec n FullDataOut
+ -> Maybe FullDataOut
+coreBusWriteVec addr0 d = fold (<|>) v where
+ v = Nothing :> zipWith zf d (iterateI (+1) 0)
+ zf x y = if addr0 == y then Just x else Nothing
+
+-- write value on bus
+coreBusWriteSingle :: (KnownNat n, KnownNat n', (n + n') ~ 32)
+ => Bool -- same
+ -> BitVector n
+ -> Maybe FullDataOut
+coreBusWriteSingle same d
+ | same = Just $ unpack (d ++# def)
+ | otherwise = Nothing
+
+-- write for Bitsize >= 33
+coreBusWriteSimple :: forall ad a0 a c c' .
+ (Num ad, Eq ad, BuildThModC a0 a c c',KnownNat c')
+ => (SNat a,SNat c)
+ -> Maybe ad
+ -> BitVector ((a * 32) + c)
+ -> Maybe FullDataOut
+coreBusWriteSimple _ Nothing _ = Nothing
+coreBusWriteSimple (snatA,snatC) (Just addr) din = left <|> right where
+ vin = (unconcatI $ takei $ bv2v din) :: Vec a (Vec 32 Bit)
+ left = coreBusWriteVec addr $ unpack . v2bv <$> vin
+ rD = v2bv $ drop (mulSNat snatA d32) $ bv2v din :: BitVector c
+ right = coreBusWriteSingle (addr == (fromInteger $ snatToInteger $ lengthS vin)) rD
+ takei = takeI :: (Vec ((a * 32) + c) Bit) -> Vec (a * 32) Bit
+
+-- write wide and narrow values on bus
+coreBusWriteGeneric :: forall a a1 a2 a3 a4 adr.
+ ( BusBuildC a a1 a2 a3 a4 , KnownNat a4, Eq adr, Num adr)
+ => ( SNat a2 , SNat a3 )
+ -> Signal ( Maybe (adr,a) )
+ -> Signal ( Maybe FullDataOut )
+coreBusWriteGeneric (soutA,soutC) sigIn = fmap ( >>= readBus ) sigIn where
+ shrAdd (addr,d) = (aSh,pack d) :: (adr,BitVector a1) where
+ aSh = addr
+ rV (addr,d) =
+ if not (snatToInteger soutA == 0 ) then
+ coreBusWriteSimple (soutA,soutC) (Just addr) d
+ else
+ coreBusWriteSingle (addr == 0) (v2bv dFake) where
+ dFake = dropI (bv2v d) :: (Vec a3 Bit)
+ readBus = rV . shrAdd
+
+-----------------------------------
+----------convert core to bus
+-----------------------------------
+
+busBuild :: forall adr a a1 a2 a3 a4 b b1 b2 b3 b4.
+ ( BusBuildC a a1 a2 a3 a4
+ , BusBuildC b b1 b2 b3 b4
+ , KnownNat b4)
+ => (SNat a2 , SNat a3, SNat b2, SNat b3)
+ -> ( Signal a -> Signal b )
+ -> Signal BusIn
+ -> Signal BusOut
+busBuild types core busInput = sigOut
+ where
+ (sinA,sinC,soutA,soutC) = types
+ busIn = fmap f <$> busInput where
+ f (addr,dir,datum) = (addr `shiftR` 2 ,dir,datum)
+ -- bus to core
+ sigInWide = coreBusReadGeneric (sinA,sinC) busIn
+
+ -- core output back to bus
+ sigOutWide = core sigInWide :: Signal b
+ sigReadData :: Signal (Maybe (FullAddress,b))
+ sigReadData = f <$> busIn <*> sigOutWide where
+ f Nothing _ = Nothing
+ f (Just (_,Write,_)) _ = Nothing
+ f (Just (fullAddr,Read,_)) d = Just (fullAddr,d)
+
+ sigOutBus = coreBusWriteGeneric (soutA,soutC) sigReadData :: Signal (Maybe FullDataOut)
+
+ sigOut = (<|>) <$> sigOutBus <*> signal (Just 0) -- allways valid
+
+
+busE :: forall a a1 b b1.(BuildThC a a1, BuildThC b b1)
+ => (Signal a -> Signal b)
+ -> Exp
+busE f = TupE [snatT ap1,snatT ap2,snatT bp1,snatT bp2] where
+ snatT n = SigE (VarE 'snat )
+ (AppT (ConT ''SNat)
+ (LitT (NumTyLit n)))
+ fr n = (ra,rb) where
+ (a,b) = quotRem n 32
+ (ra,rb) | b == 0 = (a-1,32)
+ | otherwise = (a,b)
+ (ap1,ap2) = fr (snatToInteger (snat :: SNat a1))
+ (bp1,bp2) = fr (snatToInteger (snat :: SNat b1))
+
+
+-- | Template that helps deducing first argument of function 'busBuild'
+bTQ :: forall a a1 b b1.(BuildThC a a1, BuildThC b b1)
+ => (Signal a -> Signal b)
+ -> ExpQ
+bTQ = return . busE
diff --git a/src/System/RedPitaya/Bus/RedPitayaSimple.hs b/src/System/RedPitaya/Bus/RedPitayaSimple.hs
new file mode 100644
--- /dev/null
+++ b/src/System/RedPitaya/Bus/RedPitayaSimple.hs
@@ -0,0 +1,94 @@
+{-|
+Copyright : Luka Rahne
+License : LGPL-3 (see the file LICENSE)
+Maintainer : Luka Rahne
+-}
+
+{-# LANGUAGE DataKinds #-}
+
+
+module System.RedPitaya.Bus.RedPitayaSimple
+(
+ RpBusAddress,
+ FullAddress,
+ FullDataIn,
+ FullDataOut,
+ WriteByteSel,
+ RpBusSysIn(..),
+ RpBusSysOut(..),
+ ReadWrite(..),
+ BusIn,
+ BusOut,
+ defTopRedPitayaSimple,
+ rpSimpleBind,
+ addrLow
+)
+where
+import CLaSH.Prelude
+import qualified Prelude as P
+
+-- | this definition should be used to define bus that can be directly build
+-- with fpga core defined in redpitaya branch clash https://github.com/ra1u/RedPitaya/tree/clash
+defTopRedPitayaSimple = (defTop
+ { t_name = "red_pitaya_clash_bus"
+ , t_inputs = ["add_i","data_i","strobe_i","we_i","re_i"]
+ , t_outputs = ["data_o","ack_o","err_o"]
+ })
+
+
+type RpBusAddress = Unsigned 32
+type FullAddress = Unsigned 20
+type FullDataIn = Unsigned 32
+type FullDataOut = Unsigned 32
+
+type WriteByteSel = Unsigned 4
+
+data RpBusSysIn = RpBusSysIn {
+ addrRpBus :: RpBusAddress,
+ dataInRpBus :: FullDataIn,
+ strobeWidthRpBus :: WriteByteSel,
+ writeEnableRpBus :: Bool,
+ readEnableRpBus :: Bool
+} deriving(Show)
+
+data RpBusSysOut = RpBusSysOut {
+ dataOut :: FullDataOut,
+ ack :: Bool,
+ err :: Bool
+} deriving(Show)
+
+data ReadWrite = Read | Write
+
+type BusIn = Maybe (FullAddress,ReadWrite,FullDataIn)
+type BusOut = Maybe FullDataOut
+
+
+-- | provide redPitayaSimple interface ovet simplified bus
+-- where redPitayaSimple is bus as defined
+rpSimpleBind :: (Signal BusIn -> Signal BusOut)
+ -> Signal RpBusSysIn
+ -> Signal RpBusSysOut
+rpSimpleBind f sig = postProc <$> bundle (fin,fout)
+ where
+ fin = fmap preProc sig
+ fout = f fin
+ preProc din
+ | we == re = Nothing
+ | otherwise = Just (truncateB (addrRpBus din),getRw ,dataInRpBus din) :: BusIn
+ where
+ we = writeEnableRpBus din
+ re = readEnableRpBus din
+ getRw
+ | we = Write
+ | otherwise = Read
+ postProc (Just inp,Just out) = RpBusSysOut out True False
+ postProc _ = RpBusSysOut 0 False False
+
+
+-- | remove away MSB part of address with page info away
+addrLow :: Signal BusIn -> Signal BusIn
+addrLow sig = fmap ( fmap f ) sig where
+ f (addr,m,din) = (addr .&.0xFFFFF,m,din)
+
+
+