Lambdaya 0.1.1.0 → 0.2.0.0

raw patch · 5 files changed

+472/−276 lines, 5 filesdep +binarydep +networkdep +pipesPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, network, pipes, pipes-binary, pipes-network, pipes-parse

API changes (from Hackage documentation)

Files

• Lambdaya.cabal +17/−4
• src/System/RedPitaya/Arm.hs +120/−0
• src/System/RedPitaya/Fpga.hs +115/−179
• src/System/RedPitaya/Tcp.hs +193/−0
• src/System/RedPitaya/Tutorial.hs +27/−93

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.0+version:             0.2.0.0  -- A short (one-line) description of the package. synopsis: Library for RedPitaya         @@ -53,7 +53,10 @@  library   -- Modules exported by the library.-  exposed-modules: System.RedPitaya.Fpga, System.RedPitaya.Tutorial+  exposed-modules: System.RedPitaya.Fpga, +                   System.RedPitaya.Arm,+                   System.RedPitaya.Tcp,+                   System.RedPitaya.Tutorial      -- Modules included in this library but not exported.   -- other-modules:  @@ -64,8 +67,18 @@   -- Other library packages from which modules are imported.   build-depends:         base >= 3 && < 5, -    mtl >= 2 && < 3, -    unix >= 2 && < 3+    mtl >= 2 && < 3,+    network >= 2 && < 3,+    binary >=0 && <1,+    pipes >=4 && <5,+    pipes-network >=0 && <1,+    pipes-binary >= 0 && <1,+    pipes-parse >= 3 && <4+  +  if arch(arm) {+    build-depends: unix >= 2 && < 3+  }+      -- Directories containing source files.   hs-source-dirs:      src

@@ -0,0 +1,120 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}++-- | +-- <http://redpitaya.com/ Red Pitaya> library for accessing FPGA from arm.+-- This code can be executed only natively on RedPitay Zinq proc using  arm ghc compiler  +--+-- check <https://github.com/ra1u/Lambdaya/blob/master/doc/build.md  doc/build.md>+-- for notes on how to compile crosscompiler  ++module System.RedPitaya.Arm (+    FpgaArm,+    withOpenFpga,+)  where+++#ifdef arm_HOST_ARCH++import Foreign.C.Types+import Foreign.Marshal.Array+import System.Posix.IO+import Foreign.Storable++#endif++import System.RedPitaya.Fpga+import Control.Monad.Reader +import Foreign.Ptr+++type FpgaPtr = Ptr ()++-- | FpgaSetGet get for running on Arm+type FpgaArm = ReaderT FpgaPtr IO+++#ifdef arm_HOST_ARCH++runArm :: FpgaArm a -> FpgaPtr -> IO a+runArm  = runReaderT+++instance FpgaSetGet FpgaArm where +    fpgaGet o = do+        p <- getPtr+        liftIO $ peek $ plusPtr p o+    fpgaSet o reg = do+        p <- getPtr+        liftIO $ poke (plusPtr p o) reg+    fpgaGetArray o len = do+        p <- getPtr+        liftIO $ peekArray len (plusPtr p o)+    fpgaSetArray o xs = do+        p <- getPtr+        liftIO $ pokeArray (plusPtr p o) xs++getPtr :: FpgaArm FpgaPtr+getPtr = ask++-- | This function handles initialising Fpga memory mapping and+-- evaluates 'Fpga' action.+withOpenFpga :: FpgaArm () -> IO ()+withOpenFpga act = do+    fd <- openFd  "/dev/mem" ReadWrite Nothing defaultFileFlags+    setFdOption fd SynchronousWrites True+    p <- mmap nullPtr fpgaMapSize (c'PROT_READ + c'PROT_WRITE ) c'MAP_SHARED (fromIntegral fd) addrAms+    runArm act p+    munmap p fpgaMapSize+    return ()+++-- | get raw pointer on fpga registry calculated from page, offset +-- and internal state that holds memory mapped pointer+-- getOffsetPtr :: Page -> Offset -> FpgaArm (Ptr Registry)+getOffsetPtr page offset = +    -- offset on getPtr +    (\memmap -> plusPtr memmap (page * fpgaPageSize + offset)) <$> getPtr++++++fpgaMapSize = 0x100000 * 8+addrAms = 0x40000000+++---------- mmap bindings++foreign import ccall "mmap" mmap+  :: Ptr () -> CSize -> CInt -> CInt-> CInt-> CInt -> IO (Ptr ())++foreign import ccall "munmap" munmap+  :: Ptr () -> CSize -> IO CInt++c'PROT_EXEC = 4+c'PROT_NONE = 0+c'PROT_READ = 1+c'PROT_WRITE = 2+c'MAP_FIXED = 16+c'MAP_PRIVATE = 2+c'MAP_SHARED = 1+c'MAP_FAILED = wordPtrToPtr 4294967295+#else+++-- | This function handles initialising Fpga memory mapping and+-- evaluates 'Fpga' action.+withOpenFpga :: FpgaArm () -> IO ()+withOpenFpga act = undefined++instance FpgaSetGet FpgaArm where +    fpgaGet = undefined+    fpgaSet = undefined++#endif+++

@@ -1,13 +1,12 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}  -- | --- <http://redpitaya.com/ Red Pitaya> native library for accessing Fpga+-- <http://redpitaya.com/ Red Pitaya> library for accessing Fpga  module System.RedPitaya.Fpga (-    Fpga,     Registry,     Channel(..),-    withOpenFpga,+    FpgaSetGet(..),+     -- * Housekeeping     -- | various housekeeping and Gpio functions     fpgaId,@@ -81,123 +80,84 @@     getAsgBurstDelay,     setAsgBurstDelay,     -- * Plumbing-    -- | low level functions for direct Fpga access, used to extend interface+    -- | low level helper functions, used to extend interface     Page,     Offset,     fpgaRead,     fpgaWrite,     fpgaFmap,-    pokeFpgaArray,-    peekFpgaArray+    writeFpgaArray,+    readFpgaArray,+    fpgaPageSize )    where -import Foreign.C.Types-import Foreign.Ptr-import Foreign.Marshal.Array-import System.Posix.IO import Data.Int import Data.Word import Data.Bits-import Foreign.Storable + import Control.Monad import Control.Applicative-import Control.Monad.State  -+import  Data.Traversable as DT  -fpgaPageSize = 0x100000-fpgaMapSize = 0x100000 * 8-addrAms = 0x40000000--type FpgaPtr = Ptr ()-type FpgaState = FpgaPtr- -- | type representing fpga memory offset from page type Offset = Int -- | type representing fpga memory page type Page = Int -- | type representing fpga registry type Registry = Word32--- | Fpga monad is hidden behind this type-type StateMonad a = StateT FpgaState IO  a --- | Environment where one can read and write Fpga registries-newtype Fpga a = Fpga (StateMonad a) -    deriving (Functor,Applicative, Monad,MonadIO, MonadFix, MonadPlus, Alternative) --- | Redpitaya Channel A or B.-data Channel = A | B--getStateType :: Fpga a -> StateMonad a-getStateType (Fpga s) = s ---- Constructor-fpgaState a = Fpga ( StateT a )--runFpga :: Fpga a -> FpgaState -> IO (a,FpgaState) -runFpga (Fpga s) = runStateT s--store ::  FpgaState -> Fpga ()-store v = fpgaState $ \x -> ( return ((),v) )--getState :: Fpga FpgaState-getState = fpgaState $  \x -> ( return  (x,x) )+-- | size of Fpga page+fpgaPageSize = 0x100000 :: Offset -getPtr :: Fpga FpgaPtr-getPtr = getState+-- | FpgaSetGet is typeclass for acesssing Fpga+class (Monad m) => FpgaSetGet m where+    fpgaGet ::  Offset -> m Registry+    fpgaSet ::  Offset -> Registry -> m ()+    fpgaGetArray :: Offset -> Int -> m [Registry]+    fpgaSetArray :: Offset -> [Registry] -> m ()+    -- default implemetations of each others so +    -- user can provide only one set and one get if requred+    fpgaGet off = fmap head $ fpgaGetArray off 1+    fpgaSet off v = fpgaSetArray off [v]+    fpgaGetArray off len = sequence $ map fpgaGet [off, off+4 .. (off + (4*len))]+    fpgaSetArray off d = sequence_ $ zipWith fpgaSet [off, off+4 .. ] d  --- | This function handles initialising Fpga memory mapping and--- evaluates 'Fpga' action.-withOpenFpga :: Fpga a -> IO a-withOpenFpga act = do-    fd <- openFd  "/dev/mem" ReadWrite Nothing defaultFileFlags-    setFdOption fd SynchronousWrites True-    p <- mmap nullPtr fpgaMapSize (c'PROT_READ + c'PROT_WRITE ) c'MAP_SHARED (fromIntegral fd) addrAms-    (r,s) <- runFpga act p-    munmap p fpgaMapSize-    return r+-- | Redpitaya Channel A or B.+data Channel = A | B  --- | get raw pointer on fpga registry calculated from page, offset --- and internal state that holds memory mapped pointer-getOffsetPtr :: Page -> Offset -> Fpga (Ptr Registry)-getOffsetPtr page offset = -    -- offset on getPtr -    (\memmap -> plusPtr memmap (page * fpgaPageSize + offset)) <$> getPtr+getTotalOffset :: Page -> Offset -> Offset+getTotalOffset page offset = page * fpgaPageSize + offset   -- | direct read from fpga registry-fpgaRead :: Page -> Offset -> Fpga Registry-fpgaRead page offset = do-    p <- getOffsetPtr page offset-    liftIO $ peek p+--fpgaRead :: Page -> Offset -> Fpga FpgaMmapM Registry+fpgaRead :: (FpgaSetGet m) => Page -> Offset -> m Registry+fpgaRead page offset = fpgaGet $ getTotalOffset page offset   -- | direct write in fpga registry-fpgaWrite :: Page ->  Offset -> Registry -> Fpga ()-fpgaWrite page offset reg = do-    p <- getOffsetPtr page offset-    liftIO $ poke p reg+fpgaWrite :: (FpgaSetGet m) => Page ->  Offset -> Registry -> m ()+fpgaWrite page offset reg = fpgaSet (getTotalOffset page offset) reg  -- | apply transformation on fpga registry value -fpgaFmap :: Page ->  Offset -> (Registry -> Registry) -> Fpga ()+fpgaFmap :: (FpgaSetGet m) => Page ->  Offset -> (Registry -> Registry) -> m () fpgaFmap page offset f = do     reg <- fpgaRead page offset     fpgaWrite page offset (f reg)  -- | write array in fpga memory-pokeFpgaArray :: Page -> Offset -> [Registry] -> Fpga ()-pokeFpgaArray page offset xs =  do-    p <- getOffsetPtr page offset-    liftIO $ pokeArray p xs+writeFpgaArray :: (FpgaSetGet m) => Page -> Offset -> [Registry] -> m ()+writeFpgaArray page offset  =  fpgaSetArray $ getTotalOffset page offset  + -- | read array from fpga memory, passing page, offset and length-peekFpgaArray :: Page -> Offset -> Int -> Fpga [Registry]-peekFpgaArray page offset len = do-    p <- getOffsetPtr page offset-    liftIO $ peekArray len p+readFpgaArray :: (FpgaSetGet a) =>  Page -> Offset -> Int -> a [Registry]+readFpgaArray page offset = fpgaGetArray ( getTotalOffset page offset )   @@ -205,11 +165,11 @@ -- * Housekeeping memory map  -- | get ID ,  0 prototype , 1 release-fpgaId :: Fpga Registry+fpgaId :: (FpgaSetGet a) => a Registry fpgaId = fpgaRead 0 0  -- | get DNA-dna :: Fpga Integer+dna :: (FpgaSetGet a) => a Integer dna = do     dna1 <- fromIntegral <$> fpgaRead 0 4     dna2 <- fromIntegral <$> fpgaRead 0 8@@ -218,49 +178,49 @@ -- | set expansion connector direction P registry -- -- 1 out , 0 in  -setExpDirP :: Registry -> Fpga ()+setExpDirP :: (FpgaSetGet a) => Registry -> a () setExpDirP = fpgaWrite 0 0x10  -- | get expansion connector direction P registry -- -- 1 out , 0 in -getExpDirP :: Fpga Registry+getExpDirP :: (FpgaSetGet a) => a Registry getExpDirP = fpgaRead 0 0x10  -- | set expansion connector direction N registry -- -- 1 out , 0 in -setExpDirN :: Registry -> Fpga ()+setExpDirN :: (FpgaSetGet a) => Registry -> a () setExpDirN = fpgaWrite 0 0x14  -- | get expansion connector direction N registry -- -- 1 out , 0 in -getExpDirN :: Fpga Registry+getExpDirN :: (FpgaSetGet a) => a Registry getExpDirN = fpgaRead 0 0x14  -- | expansion connector  P output registry value-setExpOutP :: Registry -> Fpga ()+setExpOutP :: (FpgaSetGet a) => Registry -> a () setExpOutP = fpgaWrite 0 0x18  -- | expansion connector  P output registry value-getExpOutP :: Fpga Registry+getExpOutP :: (FpgaSetGet a) => a Registry getExpOutP = fpgaRead 0 0x18  -- | expansion connector  N output registry value-setExpOutN :: Registry -> Fpga ()+setExpOutN :: (FpgaSetGet a) => Registry -> a () setExpOutN = fpgaWrite 0 0x1C  -- | expansion connector  N output registry value-getExpOutN :: Fpga Registry+getExpOutN :: (FpgaSetGet a) => a Registry getExpOutN = fpgaRead 0 0x1C  -- | expansion connector  P input registry value-getExpInP :: Fpga Registry-getExpInP =  fpgaRead 0 0x20+getExpInP :: (FpgaSetGet a) => a Registry+getExpInP = fpgaRead 0 0x20  -- | expansion connector  N input registry value-getExpInN :: Fpga Registry+getExpInN :: (FpgaSetGet a) => a Registry getExpInN =  fpgaRead 0 0x24  -- | type of gpio can be either P on N@@ -294,7 +254,6 @@ type PinNum = Int  -- | Sets direction of pin-setExpDir :: GpioType -> GpioDirection -> PinNum ->  Fpga () setExpDir N d p = setBitValue d p <$> getExpDirN  >>= setExpDirN setExpDir P d p = setBitValue d p <$> getExpDirP  >>= setExpDirP @@ -310,7 +269,6 @@     toBool Hi = True  -- | Sets outout value of pin-setExpOut :: GpioType -> GpioValue -> PinNum ->  Fpga () -- read using getExpOutN , fmap over setBitValue and bind in setExpOutX setExpOut N v p = setBitValue v p <$> getExpOutN  >>= setExpOutN setExpOut P v p = setBitValue v p <$> getExpOutP  >>= setExpOutP@@ -321,34 +279,37 @@ toGpioValue False = Low  -- | Sets output value of single pin-getExpOut :: GpioType  -> PinNum ->  Fpga GpioValue getExpOut N p = (\x -> toGpioValue ( testBit x p )) <$> getExpOutN getExpOut P p = (\x -> toGpioValue ( testBit x p )) <$> getExpOutP  -- | write in led registry-setLed :: Registry -> Fpga ()+setLed :: (FpgaSetGet f) => Registry -> f () setLed = fpgaWrite 0 0x30  -- | read in led registry-getLed :: Fpga Registry-getLed = fpgaRead 0 0x30+getLed :: (FpgaSetGet f) => f Registry+getLed = fpgaRead 0 0x30  ++ --------------------------------------- -- * Oscilloscope -osciloscpeFpgaPage :: Int osciloscpeFpgaPage = 1 +fpgaWriteOsc :: FpgaSetGet a => Offset -> Registry -> a () fpgaWriteOsc = fpgaWrite osciloscpeFpgaPage++fpgaReadOsc :: FpgaSetGet a => Offset -> a Registry fpgaReadOsc = fpgaRead osciloscpeFpgaPage   -- | reset write state machine for oscilloscope-resetWriteSM :: Fpga ()+resetWriteSM :: FpgaSetGet a => a () resetWriteSM = fpgaWriteOsc 0 2  -- | start writing data into memory (ARM trigger).-triggerNow :: Fpga ()+triggerNow :: FpgaSetGet a => a () triggerNow = fpgaWriteOsc 0 1  -- | oscilloscope trigger selection@@ -374,7 +335,6 @@     deriving (Show)  -- | set oscilloscope trigger-setOscTrigger :: TriggerSource -> Fpga () setOscTrigger Immediately     = setOscTriggerHelper 1 setOscTrigger ChAPositiveEdge = setOscTriggerHelper 2 setOscTrigger ChANegativeEdge = setOscTriggerHelper 3@@ -385,40 +345,37 @@ setOscTrigger AWGPositiveEdge = setOscTriggerHelper 8 setOscTrigger AWGNegativeEdge = setOscTriggerHelper 9 --setOscTriggerHelper :: Registry -> Fpga ()+setOscTriggerHelper :: FpgaSetGet a => Registry -> a () setOscTriggerHelper = fpgaWriteOsc 0x4   -- | when trigger delay is value becomes 'True'-triggerDelayEnded :: Fpga Bool+triggerDelayEnded :: (FpgaSetGet a) => a Bool triggerDelayEnded = (==0) <$> fpgaReadOsc 0x4  -- | Ch x threshold, makes trigger when ADC value cross this value-setTreshold :: Channel -> Registry -> Fpga () setTreshold A = fpgaWriteOsc 0x8 setTreshold B = fpgaWriteOsc 0xc  -- | gets ch x threshold-getTreshold :: Channel -> Fpga Registry getTreshold A = fpgaReadOsc 0x8 getTreshold B = fpgaReadOsc 0xc  -- | Number of decimated data after trigger written into memory-setDelayAfterTrigger :: Registry -> Fpga ()+setDelayAfterTrigger :: FpgaSetGet a => Registry -> a () setDelayAfterTrigger = fpgaWriteOsc 0x10  -- | gets delay after trigger value-getDelayAfterTrigger :: Fpga Registry+getDelayAfterTrigger :: (FpgaSetGet a) =>  a Registry getDelayAfterTrigger = fpgaReadOsc 0x10  -- | sets oscilloscope decimation registry, allows only -- 1,8, 64,1024,8192,65536. If other value is written data will NOT be correct.-setOscDecimationRaw :: Registry -> Fpga ()+setOscDecimationRaw :: (FpgaSetGet a) =>  Registry -> a () setOscDecimationRaw =  fpgaWriteOsc 0x14  -- | oscilloscope decimation registry value-getOscDecimationRaw :: Fpga Registry+getOscDecimationRaw :: (FpgaSetGet a) =>  a Registry getOscDecimationRaw =  fpgaReadOsc 0x14  -- | oscilloscope decimation@@ -432,7 +389,7 @@     deriving (Show)  -- | set oscilloscope decimation-setOscDecimation :: OscDecimation -> Fpga ()+setOscDecimation :: (FpgaSetGet a) => OscDecimation -> a () setOscDecimation OscDec1 = setOscDecimationRaw 1 setOscDecimation OscDec8 = setOscDecimationRaw 8 setOscDecimation OscDec64 = setOscDecimationRaw 64@@ -441,91 +398,90 @@ setOscDecimation OscDec65536 = setOscDecimationRaw 65536  -- | write pointer - current-getOscWpCurrent:: Fpga Registry-getOscWpCurrent = fpgaReadOsc 0x18+getOscWpCurrent :: (FpgaSetGet a) =>  a Registry+getOscWpCurrent = fpgaReadOsc 0x18   -- | write pointer - trigger-getOscWpTrigger :: Fpga Registry+getOscWpTrigger :: (FpgaSetGet a) =>  a Registry getOscWpTrigger = fpgaReadOsc 0x1C  -- | ch x hysteresis-getOscHysteresis :: Channel -> Fpga Registry+getOscHysteresis :: (FpgaSetGet a) => Channel -> a Registry getOscHysteresis A = fpgaReadOsc 0x20 getOscHysteresis B = fpgaReadOsc 0x24  -- | set ch x hysteresis-setOscHysteresis :: Channel -> Registry -> Fpga ()+setOscHysteresis :: (FpgaSetGet a) => Channel -> Registry -> a () setOscHysteresis A = fpgaWriteOsc 0x20 setOscHysteresis B = fpgaWriteOsc 0x24  -- | Enable signal average at decimation True enables, False disables-enableOscDecimationAvarage :: Bool -> Fpga ()+enableOscDecimationAvarage :: (FpgaSetGet a) => Bool -> a () enableOscDecimationAvarage True = fpgaWriteOsc 0x28 1 enableOscDecimationAvarage False = fpgaWriteOsc 0x28 0  -- | set ch A equalization filter, takes array with coefficients [AA,BB,KK,PP]-setEqualFilter :: Channel -> [Registry] -> Fpga ()-setEqualFilter A = pokeFpgaArray osciloscpeFpgaPage 0x30 . take 4-setEqualFilter B = pokeFpgaArray osciloscpeFpgaPage 0x40 . take 4+setEqualFilter :: (FpgaSetGet a) => Channel -> [Registry] -> a ()+setEqualFilter A = writeFpgaArray osciloscpeFpgaPage 0x30 . take 4+setEqualFilter B = writeFpgaArray osciloscpeFpgaPage 0x40 . take 4  -- | get ch x equalization filter, return array with coefficients [AA,BB,KK,PP]-getEqualFilter :: Channel -> Fpga [Registry]-getEqualFilter A = peekFpgaArray osciloscpeFpgaPage 0x30 4-getEqualFilter B = peekFpgaArray osciloscpeFpgaPage 0x40 4-+getEqualFilter :: (FpgaSetGet a) =>  Channel  -> a [Registry]+getEqualFilter A = readFpgaArray osciloscpeFpgaPage 0x30 4+getEqualFilter B = readFpgaArray osciloscpeFpgaPage 0x40 4 -setAxiGeneric' :: Offset -> Channel -> Registry -> Fpga ()+setAxiGeneric' :: (FpgaSetGet a) => Offset -> Channel ->  Registry -> a () setAxiGeneric' offest A = fpgaWriteOsc offest setAxiGeneric' offest B = fpgaWriteOsc (offest+0x20) -getAxiGeneric' :: Offset -> Channel -> Fpga Registry+getAxiGeneric' :: (FpgaSetGet a) => Offset -> Channel  -> a Registry getAxiGeneric' offest A = fpgaReadOsc offest getAxiGeneric' offest B = fpgaReadOsc (offest+0x20)   -- | starting writing address ch x - CH x AXI lower address-setAxiLowerAddress :: Channel -> Registry -> Fpga ()+setAxiLowerAddress :: (FpgaSetGet a) => Channel ->  Registry -> a () setAxiLowerAddress = setAxiGeneric' 0x50  -- | read - starting writing address ch x - CH x AXI lower address-getAxiLowerAddress :: Channel ->  Fpga Registry+getAxiLowerAddress :: (FpgaSetGet a) => Channel  -> a Registry getAxiLowerAddress = getAxiGeneric' 0x50  -- | starting writing address ch x - CH x AXI lower address-setAxiUpperAddress :: Channel ->  Registry -> Fpga ()+setAxiUpperAddress :: (FpgaSetGet a) => Channel ->  Registry -> a () setAxiUpperAddress = setAxiGeneric' 0x54  -- | read - starting writing address ch x - CH x AXI lower address-getAxiUpperAddress :: Channel ->  Fpga Registry+getAxiUpperAddress :: (FpgaSetGet a) => Channel  -> a Registry getAxiUpperAddress = getAxiGeneric' 0x54  -- | read - Number of decimated data after trigger written into memory-getAxiDelayAfterTrigger :: Channel -> Fpga Registry+getAxiDelayAfterTrigger :: (FpgaSetGet a) => Channel  -> a Registry getAxiDelayAfterTrigger = getAxiGeneric' 0x58  -- | set umber of decimated data after trigger written into memory-setAxiDelayAfterTrigger :: Channel -> Registry -> Fpga ()+setAxiDelayAfterTrigger :: (FpgaSetGet a) => Channel ->  Registry -> a () setAxiDelayAfterTrigger = setAxiGeneric' 0x58  -- | Enable AXI master-enableAxiMaster :: Channel -> Bool -> Fpga ()+enableAxiMaster :: (FpgaSetGet a) =>  Channel -> Bool -> a () enableAxiMaster ch True = setAxiGeneric' 0x5c ch 1 enableAxiMaster ch False = setAxiGeneric' 0x5c ch 0  -- | Write pointer for ch x at time when trigger arrived-getAxiWritePtrTrigger :: Channel -> Fpga Registry+getAxiWritePtrTrigger ::  FpgaSetGet a => Channel -> a Registry getAxiWritePtrTrigger = getAxiGeneric' 0x60  -- | current write pointer for ch x-getAxiWritePtrCurrent :: Channel -> Fpga Registry+getAxiWritePtrCurrent :: FpgaSetGet a => Channel -> a Registry getAxiWritePtrCurrent = getAxiGeneric' 0x64   -- | reads oscilloscope buffer for channel x from Fpga passing offset and length.  -- buffer should fit within 16k sampling range. -- Returns  less than requested data if trying to read over the bounds.-getOscBuffer :: Channel -> Offset -> Int -> Fpga [Registry]-getOscBuffer chan off len = peekFpgaArray osciloscpeFpgaPage (off' + (chOff chan)) len'+getOscBuffer :: FpgaSetGet a => Channel -> Offset -> Int -> a [Registry]+getOscBuffer chan off len = readFpgaArray osciloscpeFpgaPage (off' + (chOff chan)) len'                           where                             off' = max 0 off                             len' = min (0x10000 - off) len@@ -534,10 +490,10 @@  -------------------------------------------------------------------- + -- ASG -- | Set registry with value passed as tuple of bit offests -- | setBits (fromBit,toBit) value rin = ..-setBits :: (Int,Int) -> Registry -> Registry -> Registry setBits (fromBit,toBit) value rin = valueShift .|. hole     where          ones = complement 0 :: Registry@@ -546,7 +502,6 @@         valueShift = ( shiftL value fromBit ) .&. maskShift  -- | read bits  range from registy-getBits :: (Int,Int) -> Registry -> Registry getBits (fromBit,toBit) value = shiftR andV fromBit     where         ones = complement 0 :: Registry@@ -554,51 +509,46 @@         andV = maskShift .&. value  -type FpgaSet = Registry -> Fpga ()-type FpgaGet = Fpga Registry  -asgFpgaPage = 2 +asgFpgaPage = 2 -fpgaWriteAsg :: Offset -> Registry -> Fpga ()+fpgaWriteAsg :: (FpgaSetGet a) => Offset -> Registry -> a () fpgaWriteAsg = fpgaWrite asgFpgaPage -fpgaReadAsg :: Offset -> Fpga Registry+fpgaReadAsg :: (FpgaSetGet a) => Offset -> a Registry fpgaReadAsg = fpgaRead asgFpgaPage -fpgaFmapAsg :: Offset -> (Registry -> Registry) -> Fpga ()+fpgaFmapAsg :: (FpgaSetGet a) => Offset -> (Registry -> Registry) -> a () fpgaFmapAsg = fpgaFmap asgFpgaPage -fpgaWriteAsgChannel :: Offset -> Channel -> Registry -> Fpga () fpgaWriteAsgChannel offset A = fpgaWriteAsg   offset fpgaWriteAsgChannel offset B = fpgaWriteAsg ( offset + 0x20) -fpgaReadAsgChannel :: Offset -> Channel -> Fpga Registry fpgaReadAsgChannel offset A = fpgaReadAsg   offset fpgaReadAsgChannel offset B = fpgaReadAsg ( offset + 0x20) -fpgaFmapAsgChannel :: Offset -> (Registry -> Registry) -> Channel -> Fpga () fpgaFmapAsgChannel offset f A = fpgaFmapAsg   offset f fpgaFmapAsgChannel offset f B = fpgaFmapAsg ( offset + 0x20) f   -- | get ASGoption registry-getAsgOption :: Fpga Registry+getAsgOption :: FpgaSetGet a => a Registry getAsgOption = fpgaReadAsg 0x0  -- | set ASG option registry-setAsgOption :: Registry -> Fpga ()+setAsgOption :: FpgaSetGet a => Registry -> a () setAsgOption = fpgaWriteAsg 0x0   -- | ch B external gated repetitions,  -- registry can be either 0x0 or 0x1-setAsgOptionBExtGatRep :: Registry -> Fpga ()-setAsgOptionBExtGatRep reg = fpgaFmapAsg 0 ( setBits (24,24) reg)+setAsgOptionBExtGatRep :: FpgaSetGet a => Registry -> a ()+setAsgOptionBExtGatRep  = fpgaFmapAsg 0 . setBits (24,24)  -- | get ch B external gated repetitions,  -- registry can be either 0x0 or 0x1-getAsgOptionBExtGatRep :: Fpga Registry+getAsgOptionBExtGatRep :: FpgaSetGet a => a Registry getAsgOptionBExtGatRep =  getBits (24,24) <$> getAsgOption  -- | TODO others@@ -606,75 +556,61 @@ -- | todo other registries  -- | Ch x amplitude scale (14 bist) - out = (data*scale)/0x2000 + offset-setAsgAmplitudeScale :: Channel -> Registry -> Fpga () setAsgAmplitudeScale ch reg = fpgaFmapAsgChannel 0x4 ( setBits (16,29) reg ) ch  -- | Ch x amplitude offset (14 bits) - out  = (data*scale)/0x2000 + offset -setAsgAmplitudeOffset :: Channel -> Registry -> Fpga () setAsgAmplitudeOffset ch reg = fpgaFmapAsgChannel 0x4 ( setBits (0,13) reg ) ch  -- | Ch x counter wrap - Value where counter wraps around. Depends on SM wrap setting.  -- If it is 1 new value is  get by wrap, if value is 0 counter goes to offset value. -- 16 bits for decimals.-setAsgCounterWrap :: Channel -> Registry -> Fpga ()+setAsgCounterWrap :: FpgaSetGet a => Channel -> Registry -> a () setAsgCounterWrap = fpgaWriteAsgChannel  0x8   -- | Ch x Counter start offset. Start offset when trigger arrives. 16 bits for decimals.-setAsgCounterStartOffset :: Channel -> Registry -> Fpga ()+setAsgCounterStartOffset :: FpgaSetGet a => Channel -> Registry -> a () setAsgCounterStartOffset = fpgaWriteAsgChannel 0xc  -- | Ch x counter step. 16 bits for decimals.-setAsgCounterStep :: Channel -> Registry -> Fpga ()+setAsgCounterStep :: FpgaSetGet a => Channel -> Registry -> a () setAsgCounterStep = fpgaWriteAsgChannel 0x10  -- | get ch x buffer current read pointer-getAsgCounterReadPtr :: Channel -> Fpga Registry+getAsgCounterReadPtr :: FpgaSetGet a => Channel -> a Registry getAsgCounterReadPtr = fpgaReadAsgChannel 0x14  -- | set ch x buffer current read pointer-setAsgCounterReadPtr :: Channel -> Registry -> Fpga ()+setAsgCounterReadPtr :: FpgaSetGet a => Channel -> Registry -> a () setAsgCounterReadPtr = fpgaWriteAsgChannel 0x14  -- | get ch x number of read cycles in one burst-getAsgNumReadCycles :: Channel -> Fpga Registry+getAsgNumReadCycles :: FpgaSetGet a => Channel -> a Registry getAsgNumReadCycles = fpgaReadAsgChannel 0x18  -- | set ch x number of read cycles in one burst-setAsgNumReadCycles :: Channel -> Registry -> Fpga ()+setAsgNumReadCycles :: FpgaSetGet a => Channel -> Registry -> a () setAsgNumReadCycles = fpgaWriteAsgChannel 0x18  -- | get ch x number of read cycles in one burst-getAsgNumRepetitions :: Channel -> Fpga Registry+getAsgNumRepetitions :: FpgaSetGet a => Channel -> a Registry getAsgNumRepetitions = fpgaReadAsgChannel  0x1a  -- | set ch x number of read cycles in one burst-setAsgNumRepetitions :: Channel -> Registry -> Fpga ()+setAsgNumRepetitions :: FpgaSetGet a => Channel -> Registry -> a () setAsgNumRepetitions = fpgaWriteAsgChannel 0x1a  -- | get ch x delay between burst repetitions, granularity=1us-getAsgBurstDelay :: Channel -> Fpga Registry+getAsgBurstDelay :: FpgaSetGet a => Channel -> a Registry getAsgBurstDelay = fpgaReadAsgChannel 0x20  -- | set ch x delay between burst repetitions, granularity=1us-setAsgBurstDelay :: Channel -> Registry -> Fpga ()+setAsgBurstDelay :: FpgaSetGet a => Channel -> Registry -> a () setAsgBurstDelay = fpgaWriteAsgChannel 0x20 ----------- mmap bindings -foreign import ccall "mmap" mmap-  :: Ptr () -> CSize -> CInt -> CInt-> CInt-> CInt -> IO (Ptr ()) -foreign import ccall "munmap" munmap-  :: Ptr () -> CSize -> IO CInt -c'PROT_EXEC = 4-c'PROT_NONE = 0-c'PROT_READ = 1-c'PROT_WRITE = 2-c'MAP_FIXED = 16-c'MAP_PRIVATE = 2-c'MAP_SHARED = 1-c'MAP_FAILED = wordPtrToPtr 4294967295+          

@@ -0,0 +1,193 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+++-- | Implemention of both client and server for contolling fpga over tcp+module System.RedPitaya.Tcp (+   NetworkFpgaSetGet(..),+   runRemoteRp ,+   runRpServer+) where++import System.RedPitaya.Fpga+import System.RedPitaya.Arm++import Network.Socket as NS+import Control.Concurrent (forkIO)+import Data.Word++import Pipes as P+import qualified Pipes.Prelude as PP+import Pipes.Parse++import Pipes.Binary +import Data.Binary.Get+import Data.Binary.Put+import Pipes.Network.TCP+++type Len = Word32+type Addr = Word32+type Reg = Word32+data SimpleProt = WriteSingle Addr Reg +                | WriteArray Len Addr [Reg] +                | ReadSingle Addr+                | ReadArray Len Addr+                | RespSingle Reg+                | RespArray Len [Reg]+                | Error deriving (Show,Eq)++++toint (WriteSingle _ a) = fromIntegral a+single w = WriteSingle 1 w++cWriteSingle = 1+cWriteArray = 2+cReadSingle = 3+cReadArray = 4+cRespSingle = 5+cRespArray = 6+cError = 7++instance Binary SimpleProt where+  put ( WriteSingle a r) =  putWord32be cWriteSingle+                            >> putWord32be a+                            >> putWord32be r++  put ( WriteArray len a xs) = putWord32be cWriteArray+                              >> putWord32be len+                              >> putWord32be a+                              >> mapM_ putWord32be xs++  put (ReadSingle a) = putWord32be cReadSingle+                       >> putWord32be a++  put (ReadArray len addr) = putWord32be cReadArray +                             >> putWord32be addr++  put (RespSingle reg) = putWord32be cRespSingle >> putWord32be reg++  put (RespArray len arr) = putWord32be cRespArray+                            >> putWord32be len+                            >> mapM_ putWord32be arr++  put Error = putWord32be cError++  get = do+    ty <- getWord32be+    case () +      of _+           | ty == cWriteSingle -> WriteSingle <$> getWord32be <*> getWord32be+           | ty == cWriteArray  -> do+                                    len <- getWord32be+                                    WriteArray len <$> getWord32be <*> parseArray len +           | ty == cReadSingle  -> ReadSingle <$> getWord32be+           | ty == cReadArray   -> ReadArray <$> getWord32be <*> getWord32be+           | ty == cRespSingle  -> RespSingle <$> getWord32be+           | ty == cRespArray   -> do +                                      len <- getWord32be+                                      RespArray len <$> parseArray len +           | otherwise -> return Error++parseArray len = sequenceA ( replicate ( fromIntegral len) getWord32be )++-- | This can be used to implement run server on RedPitaya+runRpServer:: PortNumber -> IO ()+runRpServer port = do +    sock <- socket AF_INET Stream 0+    setSocketOption sock ReuseAddr 1+    bindSocket sock (SockAddrInet port iNADDR_ANY)+    NS.listen sock 2+    mainLoop sock++mainLoop :: Socket -> IO ()+mainLoop s =  go where+    go = do+        (sock, addr) <- NS.accept s+        setSocketOption sock NoDelay 1+        let rx = fromSocket sock (4*1024)+        let tx = toSocket sock+        forkIO $ runConn (rx,tx)+        go++runConn (rx,tx) = withOpenFpga $ runEffect $ +                    runStream rx  >-> P.for cat processPacket >-> PP.takeWhile (/= Error) >-> P.for cat encode  >-> tx++frInt :: (Integral a, Num b) => a -> b+frInt = fromIntegral++processPacket =  handle+  where +    handle (WriteSingle addr reg) = lift $ ( fpgaSet (frInt addr) reg )+    handle (WriteArray len addr arr) = lift $ fpgaSetArray (frInt addr) arr+    handle (ReadSingle addr ) =   lift (fpgaGet (frInt addr)) >>= (yield . RespSingle )+    handle (ReadArray len addr ) =  lift (fpgaGetArray (frInt len)  (frInt addr) ) +                                             >>= yield . RespArray len+    handle _ = yield Error+++main :: IO ()+main = do+    sock <- socket AF_INET Stream 0+    setSocketOption sock ReuseAddr 1+    bindSocket sock (SockAddrInet 4242 iNADDR_ANY)+    NS.listen sock 2+    mainLoop sock+ ++runStream :: (Monad m, Binary b) =>+     Producer ByteString (Proxy x x' () b m) r+     -> Proxy x x' () b m ()+++runStream producer = go producer where +    go producer = do+      evalStateT parser producer where +        parser = do+          v <- decode+          either stop repeat v where+            stop _ = return ()+            repeat a = do+                lift $ yield a+                parser++++--- Pc side+type FpgaProtocol = SimpleProt++-- | Type that implements FpgaSetGet over network+type NetworkFpgaSetGet = Pipe FpgaProtocol FpgaProtocol IO++-- | This evaluates FpgaSetGet action that sends commands on RedPitaya+runRemoteRp :: HostName -> PortNumber -> NetworkFpgaSetGet () -> IO ()+runRemoteRp addr port act = do+    sock <- socket AF_INET Stream 0+    host <- inet_addr addr+    NS.connect sock $ SockAddrInet port host+    setSocketOption sock NoDelay 1+    runEffect $ runStream (fromSocket sock (4*1024)) >-> act >-> P.for cat encode >-> toSocket sock+    close sock+    return ()++instance FpgaSetGet NetworkFpgaSetGet where +    fpgaGet offset = do+        yield (ReadSingle $ frInt offset)+        await >>= respsing+          where+           respsing (RespSingle reg) = return reg+           respsing _ = yield Error >> return 0++    fpgaSet off reg = yield  $ WriteSingle (frInt off) reg++    fpgaGetArray offset len = do +        yield $ ReadArray ( frInt len) (frInt offset)+        await >>= resparray+          where+            resparray (RespArray _ xs) = return xs+            resparray _ = yield Error >> return []++    fpgaSetArray offset xs = yield $ WriteArray ( frInt (length xs)) (frInt offset) xs++

@@ -6,123 +6,57 @@ == tutorial for System.Readpitaya Libraray #tutorial-for-system.readpitaya-libraray# -System.Readpitaya is native haskell library for-<http://redpitaya.com/ redpitaya> that enables direct bindings on+System.Readpitaya native haskell library for+<http://redpitaya.com/ redpitaya> that enables bindings on <https://github.com/RedPitaya/RedPitaya/blob/master/fpga/doc/RedPitaya_HDL_memory_map.odt?raw=true FPGA>.-This library is aimed to run on redpitaya and is inteded for use with-crosscompiler.--To build and run code and examples you need cross-ghc compiler for armel-processor.+It also supports remote redpitaya contolling trough same inteface over+TCP\/IP. -Here it is simpel an minimal example to use library+Here it is simple an minimal example to use library  > import System.RedPitaya.Fpga+> import System.RedPitaya.Tcp >-> main = withOpenFpga (setLed 0x55) --withOpenFpga is function, that takes Fpga operation and executes it. It-handels opening and closing of FPGA resources so it is advisable that-that all operation are executed inside and @withOpenFpga@ gets called-only once.--If you take look of prototype setLed you can see that it has protype-@setLed :: Registry -> Fpga ()@ And that can be understand that it takes-@Registy@ (that is 32 bit unsigned integer) and returns @Fpga ()@.-@Fpga a@ is type that can run in @withOpenFpga@ function. @()@ is empty-or void value that is retured after @setLed@ gets called. What @setLed@-does it takes writes registry value at apropriate addres in fpga-registry map described in document FPGA metioned in first section.--In our next example we will build program that displays value that is-written in this registry using function @getLed@--> import System.RedPitaya.Fpga-> import Numeric (showHex)+> rpIp = "10.42.0.219"+> rpPort = 4242 >-> main = do->     reg <- withOpenFpga getLed->     putStrLn ( show reg)--here @reg@ is value can get \"get\" from @withOpenFpga@. Function-@withOpenFpga@ has prototype of \'Fpga a -> IO a\'. That mean that-returns same value as it is returned from executing last command-executed in block. In our case that is just function @getLed@. Since-@getLed :: Fpga Registry@ that mean that ir returns @Fpga Registry@-type.--@IO Registry@ (@a@ in definition of @withOpenFpga@ becomes @Registry@).-We haven\'t mentioned @IO a@ before but that is type one can execute-commands like @putStrLn@ with.+> main = runRemoteRp rpIp rpPort (setLed 0x55)  -> import System.RedPitaya.Fpga-> import Numeric (showHex)->-> main = do->     reg <- withOpenFpga ( do->                             setLed 0x44->                             r <- getLed->                             return r->                         )->     putStrLn ( show reg )+@runRemoteRp@ is function that execute @FpgaSetGet@ over network. If you+dont have arm-ghc compiler available, you can use compiled binaries+[bin\/server]((https:\/\/github.com\/RedPitaya\/RedPitaya\/blob\/master\/bin\/server)+and run them on RedPitaya. -This code runs two @do@ blocks. One handles IO type where types @IO a@-are running and other do block with type \'Fpga a\'. If one needs to run-IO types inside Fpga block he\/she needs to change IO type to Fpga type-using function liftIO.+Lambdaya libraray also enables execution of same code natively trough+@withOpenFpga@ from Arm module using same @FpgaSetGet@ action.  > import System.RedPitaya.Fpga-> import Numeric (showHex)-> import Control.Monad.IO.Class (liftIO)+> import System.RedPitaya.Arm >-> main = do->     withOpenFpga $ do->             setLed 0x44->             reg <- getLed ->             liftIO $ putStrLn $ show reg->     putStrLn "done"--In this example we also use build in operator @$@ that works as a-brackets to to the end.--> liftIO $ putStrLn $ showHex reg "" -> -- is same as-> liftIO ( putStrLn ( showHex reg "" ))--If you like to know more about operator @$@ or any other standard-functions used, you can use invaluable search engine-<https://www.haskell.org/hoogle/?hoogle=%24 Hoogle> where is link on-haddock manuals with description and link to source code. Similar search-engines are also availabe at <http://hayoo.fh-wedel.de/ Hayoo!> and-<https://www.stackage.org/ Stackage>.+> main = withOpenFpga (setLed 0x55)  -Lets do some more tricks with diodes and using standard+Inspiration for last example is technology from 1970s+https:\/\/www.youtube.com\/watch?v=Hm3AFz4wrw4  > import System.RedPitaya.Fpga+> import System.RedPitaya.Tcp > import Control.Concurrent (threadDelay) > import Data.Bits > import Control.Monad.IO.Class (liftIO) > > knightRider n = do->     let ledn = 1 + abs ((mod n 12) - 6) -- 6,5,4,3,2,1,2,3,4,5,6,7,6,5,4,3,2,1,2,3,4,5,6,7,6,5...+>     let ledn = 1 + abs ((mod n 12) - 6) >     setLed ( shiftL 1 ledn ) >     liftIO ( threadDelay (30000) ) >     knightRider (n + 1) >-> main = withOpenFpga (knightRider 0)--@knightRider@ is function that gets caled each time with next-integer.@ledn@ in generated in way that provides numbering in apropriate-order. shiftL function . Next @threadDelay@ delays execution, by 30000-microseconds and since @nightRider@ runs inside @withOpenFpga@ we have-to use @liftIO@ just to make type compatible. Finaly we call-@nightRider@ with next number and whole procees repeats.+> rpIp = "10.42.0.219"+> rpPort = 4242+>+> main = runRemoteRp rpIp rpPort (knightRider 0) -So far we covered lot if of stuff on how to use this library. Even-though all examples were reading and writing to led registry you can be-sure that all function provided by library that has type signature-@Registry -> Fpga ()@ works and can be used just like @setLed@ and all-functions with type signature @Fpga Registry@ works like getLed.+For full interface and fuctions available for contolling and acessing+registries, check Fpga module.  -}  )