Haskell 位域和位级协议(protocol)

Question

我正在使用 Haskell 生成和解析现有的二进制格式(Xilinx FPGA 位文件)。目前我的数据结构和操作如下所示:

getCode = fromIntegral.fromEnum
getName = toEnum.fromIntegral

--          1 1 1 1 1 1
--          5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- MOD_REG  -------------------------------
--          0 0 0 0 0 0 0 0 0 N B B B 1 1 1 
--                            M M M M
--                              2 1 0

data NewMode = NoNewMode | NewMode deriving (Show, Eq, Enum)
data Bootmode = SerialM | SpiM | BpiUp | InternalM | ReservedMode 
                | Jtag  | ParallelS | SerialS 
                deriving (Show, Eq, Enum)
modeCode :: NewMode -> Bootmode -> Word16
modeCode newmode bootmode = (shiftL (getCode newmode) 6) .|. 
                            (shiftL (getCode bootmode) 3) .|. 0x7 
codeMode :: Word16 -> (NewMode, Bootmode)
codeMode w = (getName $ shiftR w 6 .&. 0x0001, 
              getName $ shiftR w 3 .&. 0x0007)

对于设备中存在的每个不同的配置寄存器字，我编写了一组非常相似的行(底部有更多示例)。只有移位量和 AND 掩码中的位数发生变化。我有一种感觉，应该可以以某种方式消除这种令人讨厌的重复输入和难以找到的错误的简单来源。

我的第一个直觉是添加一个类型类“位域”，位文件中的每个单独的寄存器字(或者更确切地说是表示一个的数据类型)将是一个实例，这将允许我只输入单词结构的表示从中我可以以某种方式拥有用于生成和解析的默认实现。我不知道如何改变标准的类系统来做到这一点，但是是否有一些类型系统扩展/泛型/存在/ghc-extras 的组合最终允许我将代码中的那些生成和解析函数替换为就像是

class Bitfield t where
  representation :: something
  toBits :: t -> Int
  fromBits :: Int -> t
  toBits = something (using representation)
  fromBits = something (using representation)


instance Bitfield ModReg where
  representation = something

然后在我的使用中只需要 toBits 和 fromBits 吗？不知何故，这看起来几乎与 Ghc.Generics 教程示例完全一样，其中将任意数据类型序列化为二进制。不过我还是没能把它应用到我的案例中。

下面是其他寄存器的生成和解析函数的更多示例，以显示我正在谈论的重复。在实际的完整代码中还有更多。还要了解位位置和字段长度如何嵌入到函数中并在每个函数中重复，从而使编译器无法捕获的出错机会增加一倍。

--          1 1 1 1 1 1
--          5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- CTL_REG  -------------------------------
--          0 0 0 0 0 0 0 0 E 0 S S P I 0 G 
--                          M   B B E C   T
--                              1 0 R P   S

data EnMboot = DisMboot | EnMboot deriving (Show, Eq, Enum)
data Sbits = ReadWrite | IcapOnly | CrcOnly deriving (Show, Eq, Enum)
data Persist = NoPersist | Persist deriving (Show, Eq, Enum)
data Icap = NoIcap | Icap deriving (Show, Eq, Enum)
data GtsUserB = IoHighZ | IoActive deriving (Show, Eq, Enum)
ctlCode :: EnMboot -> Sbits -> Persist -> Icap -> GtsUserB -> Word16
ctlCode enmboot sbits persist icap gtsuserb = 
  (shiftL (getCode enmboot) 7) .|.
  (shiftL (getCode sbits) 4) .|.
  (shiftL (getCode persist) 3) .|.
  (shiftL (getCode icap) 2) .|.
  (getCode gtsuserb)
codeCtl :: Word16 -> (EnMboot,Sbits,Persist,Icap,GtsUserB)
codeCtl w = 
  (getName $ shiftR w 7 .&. 0x0001,
   getName $ shiftR w 4 .&. 0x0003,
   getName $ shiftR w 3 .&. 0x0001,
   getName $ shiftR w 2 .&. 0x0001,
   getName $ w .&. 0x0001)


--          1 1 1 1 1 1
--          5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-- COR_REG1 -------------------------------
--          D 0 1 1 1 1 1 1 0 0 0 C D D S S 
--          A                     R P D C C      
--                                C     1 0   

data DriveAwake = OpenDrainAwake | DriveAwake deriving (Show, Eq, Enum)
data CrcBypass = CrcEnabled | CrcDisabled deriving (Show, Eq, Enum)
data DonePipe = NoDonePipe | DonePipe deriving (Show, Eq, Enum)
data DriveDone = OpenDrainDone | DriveDone  deriving (Show, Eq, Enum)
data SsClkSrc = Cclk | UserClk | JtagClk deriving (Show, Eq, Enum)
cor1Code :: DriveAwake -> CrcBypass -> DonePipe -> DriveDone -> 
            SsClkSrc -> Word16
cor1Code driveawake crcbypass donepipe drivedone ssclksrc =
  (shiftL (getCode driveawake) 15) .|.
  0x2F00 .|.
  (shiftL (getCode crcbypass) 4) .|.
  (shiftL (getCode donepipe) 3) .|.
  (shiftL (getCode drivedone) 2) .|.
  (getCode ssclksrc)
codeCor1 :: Word16 -> (DriveAwake,CrcBypass,DonePipe,DriveDone,SsClkSrc)
codeCor1 w = 
  (getName $ shiftR w 15 .&. 0x0001,
   getName $ shiftR w 4 .&. 0x0001,
   getName $ shiftR w 3 .&. 0x0001,
   getName $ shiftR w 2 .&. 0x0001,
   getName $ w .&. 0x0003)

Answer 1

我们将创建自己的库，用于读取和写入 Bits .它的结构很像二进制包或序列化泛型的示例代码。我们不会利用泛型，因为除了我们需要的类型之外还有太多额外的信息，以便了解如何读取和写入值。我们将通过 monadic 阅读器读取数据，我们将从 Free 免费获得该阅读器。单子(monad)。

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}

import Data.Word
import Data.Bits

import Control.Monad.Free
import Control.Applicative

import Data.Monoid

读

为了免费获得 monad，我们需要定义一个用于读取位的基本仿函数。 GetF是我们的基本仿函数。我们执行的唯一操作是 Get ing(读取)一些位。这将为我们提供一些值(value)，我们知道将同时拥有 Bits和 Integral实例，从中我们需要确定下一步要做什么。

data GetF next = Get Int (forall b. (Bits b, Integral b) => b -> next)
    deriving (Functor)

type Get = Free GetF

我们获得了 Get 所需的所有实例免费。

在继续之前，我们将采用从类型的最低有效位端读取和写入的约定。要读取的下一位总是位 0并且最后写入的位总是位 0 .

要运行 get 计算，我们需要以下小解释器。如果我们有一个 Pure结果我们退货了。当我们接到指示 Get要读取的位，我们屏蔽该位数并运行该函数以找出下一步要做什么。然后我们运行结果 Get有那么多位右移。

runGet :: (Bits b, Integral b) => b -> Get a -> a
runGet bits (Pure a) = a
runGet bits (Free (Get l f)) = runGet (shiftR bits l) $ f (bits .&. oneBits l)

oneBits用 1 填充指定数量的最低有效位s。

oneBits :: Bits b => Int -> b
oneBits n | n <= 0 = zeroBits
oneBits n          = let (q, r) = n `quotRem` 2
                         bq     = oneBits q
                     in bit 0 .|. shiftL (bq .|. shiftL bq q) r

写作

当我们放置(写入)位时，我们需要提供要写入的位数以及同时具有 Bits 的任何类型的位数。和 Integeral实例。

data Put = Put Int (forall b. (Bits b, Integral b) => b)

当我们偏执建立一个 Put ，我们将在构建时屏蔽这些位，以确保没有在长度之外放置额外的位。

mkPut :: Int -> (forall b. (Bits b, Integral b) => b) -> Put
mkPut l bits = Put l (bits .&. oneBits l)

我们需要的唯一实例 Put是 Monoid这样我们就可以一个接一个地写。

instance Monoid Put where
    mempty = Put 0 0
    Put l1 bits1 `mappend` Put l2 bits2 = Put (l1 + l2) (bits1 .|. shiftL bits2 l1)

helper

我们将编写一些用于构建的辅助函数 Get s 和 Put s。您正在编码或解码的大部分数据是 Enum s 的各种位长。 getEnum将构建 Get出发地 Integral Bits到 Enum .它本质上是您的 getName包括要获得多少位。 putEnum将这些位与它们的长度一起包裹起来。

getEnum :: Enum e => Int -> Get e
getEnum l = Free (Get l (Pure . toEnum . fromIntegral))

putEnum :: Enum e => Int -> e -> Put
putEnum l x = mkPut l (fromIntegral . fromEnum $ x)

在读取某些结构时，您还需要跳过位。 getSkip跳过位而不对它们做任何事情。 putSkip把相同数量的 0位； putSkip1把相同数量的 1位。

getSkip :: Int -> Get ()
getSkip l = Free (Get l (const (Pure ())))

putSkip :: Int -> Put
putSkip l = Put l 0

putSkip1 :: Int -> Put
putSkip1 l = Put l (oneBits l)

MOD_REG

一开始，我们选择读取和写入最低有效位。由于这种约定选择，我们将首先制作具有最不重要字段的数据类型。这是 ModReg ，代表一个 MOD_REG结构体。以较低有效位存储的引导模式是结构中的第一个字段。

data ModReg = ModReg {bootmode :: Bootmode, newMode :: NewMode} deriving (Show, Eq)
data Bootmode = SerialM | SpiM | BpiUp | InternalM | ReservedMode 
                | Jtag  | ParallelS | SerialS 
                deriving (Show, Eq, Enum)
data NewMode = NoNewMode | NewMode deriving (Show, Eq, Enum)

我将为可以写入或读取的内容添加一个类型类 Bits ，不是因为我们想使用类型类，而是因为我不需要为所有这些都想出一个名字。

class Encodeable a where
    put :: a -> Put
    get :: Get a

我们现在可以读写 ModReg首先构造最低有效位。 ModReg 的诀窍第二行中的构造函数是我将字段放在最低有效位第一顺序的原因。

instance Encodeable ModReg where
    put mr =           putSkip1 3 <>  putEnum 3 (bootmode mr) <>  putEnum 1 (newMode mr)
    get    = ModReg <$ getSkip  3 <*> getEnum 3               <*> getEnum 1

运行示例

对于一个完整的、正在运行的示例，能够漂亮地打印 Bits 中的位会很好。 .我们将首先用最重要的位打印它们。

import Data.List (intercalate)

showBitsN :: Bits b => Int -> b -> String
showBitsN n b = "[" ++ intercalate " " (map (\x -> if testBit b x then "1" else "0") [n,n-1..0]) ++ "]"

showBits :: FiniteBits b => b -> String
showBits b = showBitsN (finiteBitSize b) b

我们的示例将生成 ModReg与 Jtag旗 1 0 1在第 3 位到第 5 位和 NewMode 中旗 1在第 6 位。我们将其转换为 Word16然后再转换回来。

main = do 
    let mr = ModReg Jtag NewMode 
    print mr
    let x = runPut (put mr) :: Word16
    putStrLn $ showBits x
    let mr' = runGet x get :: ModReg
    print mr'

这导致预期的输出

ModReg {bootmode = Jtag, newMode = NewMode}
111
[0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1]
ModReg {bootmode = Jtag, newMode = NewMode}

如果我们改为放置两个 ModReg s 连续变成 Word32我们会得到一个小惊喜。

main = do 
    let (mr1, mr2) = (ModReg Jtag NewMode, ModReg BpiUp NoNewMode)
    let x = runPut (put mr1 <> put mr2) :: Word32
    print x
    putStrLn $ showBits x
    let mr' = runGet x (get >>= \a -> get >>= \b -> return (a, b)) :: (ModReg, ModReg)
    print mr'

而不是两个 Word16 s 彼此相邻，所有设置位都适合不到一半的空间。

3055
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1]
(ModReg {bootmode = Jtag, newMode = NewMode},ModReg {bootmode = BpiUp, newMode = NoNewMode})

如果我们想使用我们的 get和 put为 ModReg这样，我们需要添加 skip s 表示最高有效位。

instance Encodeable ModReg where
    put mr =           putSkip1 3 <>  putEnum 3 (bootmode mr) <>  putEnum 1 (newMode mr) <> putSkip 9
    get    = ModReg <$ getSkip  3 <*> getEnum 3               <*> getEnum 1              <* getSkip 9

现在是 ModReg写入 16 位宽。

1507439
[0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1]
(ModReg {bootmode = Jtag, newMode = NewMode},ModReg {bootmode = BpiUp, newMode = NoNewMode})