diff --git a/src/data/CCBitField.ml b/src/data/CCBitField.ml index 90112c28..e1727112 100644 --- a/src/data/CCBitField.ml +++ b/src/data/CCBitField.ml @@ -25,12 +25,35 @@ module type BITFIELD = sig (** Number of bits of the field *) val bool : unit -> bool field - (** New field of type bool *) + (** New field of type boo + @raise TooManyFields if there is no room *) val int2 : unit -> int field - (** New field of type 2-bits int *) + (** New field of type 2-bits int + @raise TooManyFields if there is no room *) + + val int3 : unit -> int field + (** New field for 3-bits int + @raise TooManyFields if there is no room *) + + val int : width:int -> int field + (** New field for [width] bits. + @raise TooManyFields if there is no room *) end +let rec all_bits_ acc w = + if w=0 then acc + else + let acc = acc lor (1 lsl w-1) in + all_bits_ acc (w-1) + +(*$T + all_bits_ 0 1 = 1 + all_bits_ 0 2 = 3 + all_bits_ 0 3 = 7 + all_bits_ 0 4 = 15 + *) + module Make(X : EMPTY) : BITFIELD = struct type t = int @@ -78,4 +101,37 @@ module Make(X : EMPTY) : BITFIELD = struct x lor (v lsl n) ) } + + let int3 () = + let n = !width_ in + width_ := n+3; + if !width_ > max_width then raise TooManyFields; + let mask = 7 lsl n in + { + start=n; + width=3; + get=(fun x -> (x land mask) lsr n); + set=(fun v x -> + assert (x >= 0 && x < 8); + let x = x land (lnot mask) in + x lor (v lsl n) + ) + } + + let int ~width:w = + let n = !width_ in + width_ := n+w; + if !width_ > max_width then raise TooManyFields; + let mask_unshifted = all_bits_ 0 w in + let mask = mask_unshifted lsl n in + { + start=n; + width=w; + get=(fun x -> (x land mask) lsr n); + set=(fun v x -> + assert (x >= 0 && x <= mask_unshifted); + let x = x land (lnot mask) in + x lor (v lsl n) + ) + } end diff --git a/src/data/CCBitField.mli b/src/data/CCBitField.mli index f593a968..e3b073bf 100644 --- a/src/data/CCBitField.mli +++ b/src/data/CCBitField.mli @@ -9,6 +9,9 @@ {b status: experimental} @since NEXT_RELEASE *) +exception TooManyFields +(** Raised when too many fields are packed into one bitfield *) + module type EMPTY = sig end (** {2 Bitfield Signature} *) @@ -29,10 +32,20 @@ module type BITFIELD = sig (** Number of bits of the field *) val bool : unit -> bool field - (** New field of type bool *) + (** New field of type boo + @raise TooManyFields if there is no room *) val int2 : unit -> int field - (** New field of type 2-bits int *) + (** New field of type 2-bits int + @raise TooManyFields if there is no room *) + + val int3 : unit -> int field + (** New field for 3-bits int + @raise TooManyFields if there is no room *) + + val int : width:int -> int field + (** New field for [width] bits. + @raise TooManyFields if there is no room *) end (** Create a new bitfield type *) @@ -44,8 +57,10 @@ module Make(X : EMPTY) : BITFIELD let x = B.bool () in let y = B.int2 () in let z = B.bool () in + let u = B.int 4 in assert_equal 2 (B.width y) ; + assert_equal 4 (B.width u) ; let f = B.empty |> B.set y 3 @@ -56,8 +71,22 @@ module Make(X : EMPTY) : BITFIELD assert_equal false (B.get x f) ; assert_equal 3 (B.get y f) ; - assert_equal (B.get z f); + assert_equal true (B.get z f); + + let f' = B.set u 13 f in + + assert_equal false (B.get x f') ; + assert_equal 3 (B.get y f') ; + assert_equal true (B.get z f'); + assert_equal 13 (B.get u f'); () *) + +(**/**) + +val all_bits_ : int -> int -> int +(** Undocumented, do not use. Exposed for testing purpose *) + +(**/**)