module System.RedPitaya.Fpga (
Registry,
Channel(..),
FpgaSetGet(..),
fpgaId,
dna,
setExpDirP,
getExpDirP,
setExpDirN,
getExpDirN,
setExpOutP,
setExpOutN,
getExpInP,
getExpInN,
GpioType(..),
GpioDirection(..),
PinNum,
setExpDir,
GpioValue(..),
setExpOut,
getExpOut,
setLed,
getLed,
resetWriteSM,
triggerNow,
TriggerSource(..),
setOscTrigger,
triggerDelayEnded,
setTreshold,
getTreshold,
setDelayAfterTrigger,
getDelayAfterTrigger,
setOscDecimationRaw,
getOscDecimationRaw,
OscDecimation(..),
setOscDecimation,
getOscWpCurrent,
getOscWpTrigger,
getOscHysteresis,
setOscHysteresis,
enableOscDecimationAvarage,
setEqualFilter,
getEqualFilter,
setAxiLowerAddress,
getAxiLowerAddress,
setAxiUpperAddress,
getAxiUpperAddress,
setAxiDelayAfterTrigger,
getAxiDelayAfterTrigger,
enableAxiMaster,
getAxiWritePtrTrigger,
getAxiWritePtrCurrent,
getOscBuffer,
getAsgOption,
setAsgOption,
setAsgOptionBExtGatRep,
getAsgOptionBExtGatRep,
setAsgAmplitudeScale,
setAsgAmplitudeOffset,
setAsgCounterWrap,
setAsgCounterStartOffset,
setAsgCounterStep,
getAsgCounterReadPtr,
setAsgCounterReadPtr,
getAsgNumReadCycles,
setAsgNumReadCycles,
getAsgNumRepetitions,
setAsgNumRepetitions,
getAsgBurstDelay,
setAsgBurstDelay,
Page,
Offset,
fpgaRead,
fpgaWrite,
fpgaFmap,
writeFpgaArray,
readFpgaArray,
fpgaPageSize
)
where
import Data.Int
import Data.Word
import Data.Bits
import Control.Monad
import Control.Applicative
import Data.Traversable as DT
type Offset = Int
type Page = Int
type Registry = Word32
fpgaPageSize = 0x100000 :: Offset
class (Monad m) => FpgaSetGet m where
fpgaGet :: Offset -> m Registry
fpgaSet :: Offset -> Registry -> m ()
fpgaGetArray :: Offset -> Int -> m [Registry]
fpgaSetArray :: Offset -> [Registry] -> m ()
fpgaGet off = fmap head $ fpgaGetArray off 1
fpgaSet off v = fpgaSetArray off [v]
fpgaGetArray off len = sequence $ map fpgaGet $ take len [off, off+4 .. ]
fpgaSetArray off d = sequence_ $ zipWith fpgaSet [off, off+4 .. ] d
data Channel = A | B
getTotalOffset :: Page -> Offset -> Offset
getTotalOffset page offset = page * fpgaPageSize + offset
fpgaRead :: (FpgaSetGet m) => Page -> Offset -> m Registry
fpgaRead page offset = fpgaGet $ getTotalOffset page offset
fpgaWrite :: (FpgaSetGet m) => Page -> Offset -> Registry -> m ()
fpgaWrite page offset reg = fpgaSet (getTotalOffset page offset) reg
fpgaFmap :: (FpgaSetGet m) => Page -> Offset -> (Registry -> Registry) -> m ()
fpgaFmap page offset f = do
reg <- fpgaRead page offset
fpgaWrite page offset (f reg)
writeFpgaArray :: (FpgaSetGet m) => Page -> Offset -> [Registry] -> m ()
writeFpgaArray page offset = fpgaSetArray $ getTotalOffset page offset
readFpgaArray :: (FpgaSetGet a) => Page -> Offset -> Int -> a [Registry]
readFpgaArray page offset = fpgaGetArray ( getTotalOffset page offset )
fpgaId :: (FpgaSetGet a) => a Registry
fpgaId = fpgaRead 0 0
dna :: (FpgaSetGet a) => a Integer
dna = do
dna1 <- fromIntegral <$> fpgaRead 0 4
dna2 <- fromIntegral <$> fpgaRead 0 8
return $ dna1 + (2^32)*dna2
setExpDirP :: (FpgaSetGet a) => Registry -> a ()
setExpDirP = fpgaWrite 0 0x10
getExpDirP :: (FpgaSetGet a) => a Registry
getExpDirP = fpgaRead 0 0x10
setExpDirN :: (FpgaSetGet a) => Registry -> a ()
setExpDirN = fpgaWrite 0 0x14
getExpDirN :: (FpgaSetGet a) => a Registry
getExpDirN = fpgaRead 0 0x14
setExpOutP :: (FpgaSetGet a) => Registry -> a ()
setExpOutP = fpgaWrite 0 0x18
getExpOutP :: (FpgaSetGet a) => a Registry
getExpOutP = fpgaRead 0 0x18
setExpOutN :: (FpgaSetGet a) => Registry -> a ()
setExpOutN = fpgaWrite 0 0x1C
getExpOutN :: (FpgaSetGet a) => a Registry
getExpOutN = fpgaRead 0 0x1C
getExpInP :: (FpgaSetGet a) => a Registry
getExpInP = fpgaRead 0 0x20
getExpInN :: (FpgaSetGet a) => a Registry
getExpInN = fpgaRead 0 0x24
data GpioType =
P |
N
deriving (Show)
class ToBool b where
toBool :: b -> Bool
setBitValue :: (Bits a,ToBool b) => b -> Int -> a -> a
setBitValue b
| toBool b = flip setBit
| otherwise = flip clearBit
data GpioDirection =
Input |
Output
deriving (Show)
instance ToBool GpioDirection where
toBool Input = True
toBool Output = False
type PinNum = Int
setExpDir N d p = setBitValue d p <$> getExpDirN >>= setExpDirN
setExpDir P d p = setBitValue d p <$> getExpDirP >>= setExpDirP
data GpioValue =
Low |
Hi
deriving (Show)
instance ToBool GpioValue where
toBool Low = False
toBool Hi = True
setExpOut N v p = setBitValue v p <$> getExpOutN >>= setExpOutN
setExpOut P v p = setBitValue v p <$> getExpOutP >>= setExpOutP
toGpioValue :: Bool -> GpioValue
toGpioValue True = Hi
toGpioValue False = Low
getExpOut N p = (\x -> toGpioValue ( testBit x p )) <$> getExpOutN
getExpOut P p = (\x -> toGpioValue ( testBit x p )) <$> getExpOutP
setLed :: (FpgaSetGet f) => Registry -> f ()
setLed = fpgaWrite 0 0x30
getLed :: (FpgaSetGet f) => f Registry
getLed = fpgaRead 0 0x30
osciloscpeFpgaPage = 1
fpgaWriteOsc :: FpgaSetGet a => Offset -> Registry -> a ()
fpgaWriteOsc = fpgaWrite osciloscpeFpgaPage
fpgaReadOsc :: FpgaSetGet a => Offset -> a Registry
fpgaReadOsc = fpgaRead osciloscpeFpgaPage
resetWriteSM :: FpgaSetGet a => a ()
resetWriteSM = fpgaWriteOsc 0 2
triggerNow :: FpgaSetGet a => a ()
triggerNow = fpgaWriteOsc 0 1
data TriggerSource =
Immediately
| ChAPositiveEdge
| ChANegativeEdge
| ChBPositiveEdge
| ChBNegativeEdge
| ExtPositiveEdge
| ExtNegaitveEdge
| AWGPositiveEdge
| AWGNegativeEdge
deriving (Show)
setOscTrigger Immediately = setOscTriggerHelper 1
setOscTrigger ChAPositiveEdge = setOscTriggerHelper 2
setOscTrigger ChANegativeEdge = setOscTriggerHelper 3
setOscTrigger ChBPositiveEdge = setOscTriggerHelper 4
setOscTrigger ChBNegativeEdge = setOscTriggerHelper 5
setOscTrigger ExtPositiveEdge = setOscTriggerHelper 6
setOscTrigger ExtNegaitveEdge = setOscTriggerHelper 7
setOscTrigger AWGPositiveEdge = setOscTriggerHelper 8
setOscTrigger AWGNegativeEdge = setOscTriggerHelper 9
setOscTriggerHelper :: FpgaSetGet a => Registry -> a ()
setOscTriggerHelper = fpgaWriteOsc 0x4
triggerDelayEnded :: (FpgaSetGet a) => a Bool
triggerDelayEnded = (==0) <$> fpgaReadOsc 0x4
setTreshold A = fpgaWriteOsc 0x8
setTreshold B = fpgaWriteOsc 0xc
getTreshold A = fpgaReadOsc 0x8
getTreshold B = fpgaReadOsc 0xc
setDelayAfterTrigger :: FpgaSetGet a => Registry -> a ()
setDelayAfterTrigger = fpgaWriteOsc 0x10
getDelayAfterTrigger :: (FpgaSetGet a) => a Registry
getDelayAfterTrigger = fpgaReadOsc 0x10
setOscDecimationRaw :: (FpgaSetGet a) => Registry -> a ()
setOscDecimationRaw = fpgaWriteOsc 0x14
getOscDecimationRaw :: (FpgaSetGet a) => a Registry
getOscDecimationRaw = fpgaReadOsc 0x14
data OscDecimation =
OscDec1
| OscDec8
| OscDec64
| OscDec1024
| OscDec8192
| OscDec65536
deriving (Show)
setOscDecimation :: (FpgaSetGet a) => OscDecimation -> a ()
setOscDecimation OscDec1 = setOscDecimationRaw 1
setOscDecimation OscDec8 = setOscDecimationRaw 8
setOscDecimation OscDec64 = setOscDecimationRaw 64
setOscDecimation OscDec1024 = setOscDecimationRaw 1024
setOscDecimation OscDec8192 = setOscDecimationRaw 8192
setOscDecimation OscDec65536 = setOscDecimationRaw 65536
getOscWpCurrent :: (FpgaSetGet a) => a Registry
getOscWpCurrent = fpgaReadOsc 0x18
getOscWpTrigger :: (FpgaSetGet a) => a Registry
getOscWpTrigger = fpgaReadOsc 0x1C
getOscHysteresis :: (FpgaSetGet a) => Channel -> a Registry
getOscHysteresis A = fpgaReadOsc 0x20
getOscHysteresis B = fpgaReadOsc 0x24
setOscHysteresis :: (FpgaSetGet a) => Channel -> Registry -> a ()
setOscHysteresis A = fpgaWriteOsc 0x20
setOscHysteresis B = fpgaWriteOsc 0x24
enableOscDecimationAvarage :: (FpgaSetGet a) => Bool -> a ()
enableOscDecimationAvarage True = fpgaWriteOsc 0x28 1
enableOscDecimationAvarage False = fpgaWriteOsc 0x28 0
setEqualFilter :: (FpgaSetGet a) => Channel -> [Registry] -> a ()
setEqualFilter A = writeFpgaArray osciloscpeFpgaPage 0x30 . take 4
setEqualFilter B = writeFpgaArray osciloscpeFpgaPage 0x40 . take 4
getEqualFilter :: (FpgaSetGet a) => Channel -> a [Registry]
getEqualFilter A = readFpgaArray osciloscpeFpgaPage 0x30 4
getEqualFilter B = readFpgaArray osciloscpeFpgaPage 0x40 4
setAxiGeneric' :: (FpgaSetGet a) => Offset -> Channel -> Registry -> a ()
setAxiGeneric' offest A = fpgaWriteOsc offest
setAxiGeneric' offest B = fpgaWriteOsc (offest+0x20)
getAxiGeneric' :: (FpgaSetGet a) => Offset -> Channel -> a Registry
getAxiGeneric' offest A = fpgaReadOsc offest
getAxiGeneric' offest B = fpgaReadOsc (offest+0x20)
setAxiLowerAddress :: (FpgaSetGet a) => Channel -> Registry -> a ()
setAxiLowerAddress = setAxiGeneric' 0x50
getAxiLowerAddress :: (FpgaSetGet a) => Channel -> a Registry
getAxiLowerAddress = getAxiGeneric' 0x50
setAxiUpperAddress :: (FpgaSetGet a) => Channel -> Registry -> a ()
setAxiUpperAddress = setAxiGeneric' 0x54
getAxiUpperAddress :: (FpgaSetGet a) => Channel -> a Registry
getAxiUpperAddress = getAxiGeneric' 0x54
getAxiDelayAfterTrigger :: (FpgaSetGet a) => Channel -> a Registry
getAxiDelayAfterTrigger = getAxiGeneric' 0x58
setAxiDelayAfterTrigger :: (FpgaSetGet a) => Channel -> Registry -> a ()
setAxiDelayAfterTrigger = setAxiGeneric' 0x58
enableAxiMaster :: (FpgaSetGet a) => Channel -> Bool -> a ()
enableAxiMaster ch True = setAxiGeneric' 0x5c ch 1
enableAxiMaster ch False = setAxiGeneric' 0x5c ch 0
getAxiWritePtrTrigger :: FpgaSetGet a => Channel -> a Registry
getAxiWritePtrTrigger = getAxiGeneric' 0x60
getAxiWritePtrCurrent :: FpgaSetGet a => Channel -> a Registry
getAxiWritePtrCurrent = getAxiGeneric' 0x64
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
chOff A = 0x10000
chOff B = 0x20000
setBits (fromBit,toBit) value rin = valueShift .|. hole
where
ones = complement 0 :: Registry
maskShift = xor (shiftL ones fromBit) (shiftL ones (toBit+1))
hole = complement maskShift .&. rin
valueShift = ( shiftL value fromBit ) .&. maskShift
getBits (fromBit,toBit) value = shiftR andV fromBit
where
ones = complement 0 :: Registry
maskShift = xor (shiftL ones fromBit) (shiftL ones (toBit+1))
andV = maskShift .&. value
asgFpgaPage = 2
fpgaWriteAsg :: (FpgaSetGet a) => Offset -> Registry -> a ()
fpgaWriteAsg = fpgaWrite asgFpgaPage
fpgaReadAsg :: (FpgaSetGet a) => Offset -> a Registry
fpgaReadAsg = fpgaRead asgFpgaPage
fpgaFmapAsg :: (FpgaSetGet a) => Offset -> (Registry -> Registry) -> a ()
fpgaFmapAsg = fpgaFmap asgFpgaPage
fpgaWriteAsgChannel offset A = fpgaWriteAsg offset
fpgaWriteAsgChannel offset B = fpgaWriteAsg ( offset + 0x20)
fpgaReadAsgChannel offset A = fpgaReadAsg offset
fpgaReadAsgChannel offset B = fpgaReadAsg ( offset + 0x20)
fpgaFmapAsgChannel offset f A = fpgaFmapAsg offset f
fpgaFmapAsgChannel offset f B = fpgaFmapAsg ( offset + 0x20) f
getAsgOption :: FpgaSetGet a => a Registry
getAsgOption = fpgaReadAsg 0x0
setAsgOption :: FpgaSetGet a => Registry -> a ()
setAsgOption = fpgaWriteAsg 0x0
setAsgOptionBExtGatRep :: FpgaSetGet a => Registry -> a ()
setAsgOptionBExtGatRep = fpgaFmapAsg 0 . setBits (24,24)
getAsgOptionBExtGatRep :: FpgaSetGet a => a Registry
getAsgOptionBExtGatRep = getBits (24,24) <$> getAsgOption
setAsgAmplitudeScale ch reg = fpgaFmapAsgChannel 0x4 ( setBits (16,29) reg ) ch
setAsgAmplitudeOffset ch reg = fpgaFmapAsgChannel 0x4 ( setBits (0,13) reg ) ch
setAsgCounterWrap :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgCounterWrap = fpgaWriteAsgChannel 0x8
setAsgCounterStartOffset :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgCounterStartOffset = fpgaWriteAsgChannel 0xc
setAsgCounterStep :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgCounterStep = fpgaWriteAsgChannel 0x10
getAsgCounterReadPtr :: FpgaSetGet a => Channel -> a Registry
getAsgCounterReadPtr = fpgaReadAsgChannel 0x14
setAsgCounterReadPtr :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgCounterReadPtr = fpgaWriteAsgChannel 0x14
getAsgNumReadCycles :: FpgaSetGet a => Channel -> a Registry
getAsgNumReadCycles = fpgaReadAsgChannel 0x18
setAsgNumReadCycles :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgNumReadCycles = fpgaWriteAsgChannel 0x18
getAsgNumRepetitions :: FpgaSetGet a => Channel -> a Registry
getAsgNumRepetitions = fpgaReadAsgChannel 0x1a
setAsgNumRepetitions :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgNumRepetitions = fpgaWriteAsgChannel 0x1a
getAsgBurstDelay :: FpgaSetGet a => Channel -> a Registry
getAsgBurstDelay = fpgaReadAsgChannel 0x20
setAsgBurstDelay :: FpgaSetGet a => Channel -> Registry -> a ()
setAsgBurstDelay = fpgaWriteAsgChannel 0x20