lambdaya-bus (empty) → 0.0.0.1
raw patch · 7 files changed
+658/−0 lines, 7 filesdep +Lambdayadep +basedep +clash-preludesetup-changed
Dependencies added: Lambdaya, base, clash-prelude, template-haskell
Files
- LICENSE +165/−0
- Setup.hs +2/−0
- lambdaya-bus.cabal +85/−0
- src/System/RedPitaya/Bus.hs +10/−0
- src/System/RedPitaya/Bus/ClientBind.hs +82/−0
- src/System/RedPitaya/Bus/CoreBind.hs +220/−0
- src/System/RedPitaya/Bus/RedPitayaSimple.hs +94/−0
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lambdaya-bus.cabal view
@@ -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
+ src/System/RedPitaya/Bus.hs view
@@ -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 +
+ src/System/RedPitaya/Bus/ClientBind.hs view
@@ -0,0 +1,82 @@+{-|+Copyright : Luka Rahne+License : LGPL-3 (see the file LICENSE)+Maintainer : Luka Rahne <luka.rahne@gmail.com>+-}++{-# 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
+ src/System/RedPitaya/Bus/CoreBind.hs view
@@ -0,0 +1,220 @@+{-|+Copyright : Luka Rahne+License : LGPL-3 (see the file LICENSE)+Maintainer : Luka Rahne <luka.rahne@gmail.com>+-}++{-# 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
+ src/System/RedPitaya/Bus/RedPitayaSimple.hs view
@@ -0,0 +1,94 @@+{-|+Copyright : Luka Rahne+License : LGPL-3 (see the file LICENSE)+Maintainer : Luka Rahne <luka.rahne@gmail.com>+-}++{-# 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 <https://github.com/ra1u/RedPitaya/blob/clash/fpga/rtl/red_pitaya_top.v>+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) +++