diff --git a/Lambdaya.cabal b/Lambdaya.cabal --- a/Lambdaya.cabal +++ b/Lambdaya.cabal @@ -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 diff --git a/src/System/RedPitaya/Arm.hs b/src/System/RedPitaya/Arm.hs new file mode 100644 --- /dev/null +++ b/src/System/RedPitaya/Arm.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} + +-- | +-- library for accessing FPGA from arm. +-- This code can be executed only natively on RedPitay Zinq proc using arm ghc compiler +-- +-- check +-- 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 + + + diff --git a/src/System/RedPitaya/Fpga.hs b/src/System/RedPitaya/Fpga.hs --- a/src/System/RedPitaya/Fpga.hs +++ b/src/System/RedPitaya/Fpga.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | --- native library for accessing Fpga +-- 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 + diff --git a/src/System/RedPitaya/Tcp.hs b/src/System/RedPitaya/Tcp.hs new file mode 100644 --- /dev/null +++ b/src/System/RedPitaya/Tcp.hs @@ -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 + + diff --git a/src/System/RedPitaya/Tutorial.hs b/src/System/RedPitaya/Tutorial.hs --- a/src/System/RedPitaya/Tutorial.hs +++ b/src/System/RedPitaya/Tutorial.hs @@ -6,123 +6,57 @@ == tutorial for System.Readpitaya Libraray #tutorial-for-system.readpitaya-libraray# -System.Readpitaya is native haskell library for - that enables direct bindings on +System.Readpitaya native haskell library for + that enables bindings on . -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 - where is link on -haddock manuals with description and link to source code. Similar search -engines are also availabe at and -. +> 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. -} )