Implements zero based bitsets of size up to huge(0_int32)
.
The current code uses 64 bit integers to store the bits and uses all 64 bits.
The code assumes two's complement integers, and treats negative integers as
having the sign bit set.
(Specification)
Public procedures
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
integer, | public, | parameter | :: | alloc_fault | = | 1 | Error flag indicating a memory allocation failure |
integer, | public, | parameter | :: | array_size_invalid_error | = | 2 | Error flag indicating an invalid bits value |
integer, | public, | parameter | :: | char_string_invalid_error | = | 3 | Error flag indicating an invalid character string |
integer, | public, | parameter | :: | char_string_too_large_error | = | 4 | Error flag indicating a too large character string |
integer, | public, | parameter | :: | char_string_too_small_error | = | 5 | Error flag indicating a too small character string |
integer, | public, | parameter | :: | eof_failure | = | 6 | Error flag indicating unexpected End-of-File on a READ |
integer, | public, | parameter | :: | index_invalid_error | = | 7 | Error flag indicating an invalid index |
integer, | public, | parameter | :: | integer_overflow_error | = | 8 | Error flag indicating integer overflow |
integer, | public, | parameter | :: | max_digits | = | 10 | |
integer(kind=bits_kind), | public, | parameter | :: | overflow_bits | = | 2_bits_kind**30/5 | |
integer, | public, | parameter | :: | read_failure | = | 9 | Error flag indicating failure of a READ statement |
integer, | public, | parameter | :: | success | = | 0 | Error flag indicating no errors |
integer, | public, | parameter | :: | write_failure | = | 10 | Error flag indicating a failure on a WRITE statement |
Sets the bits in set1
to the bitwise and
of the original bits in set1
and set2
. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(inout) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(inout) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Sets the bits in set1
to the bitwise and of the original bits in set1
with the bitwise negation of set2
. The sets must have the same
number of bits otherwise the result is undefined.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(inout) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(inout) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Used to define assignment for bitset_large
.
(Specification)
Used to define assignment for bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Used to define assignment from an array of type logical(int16)
to a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | self | |||
logical(kind=int16), | intent(in) | :: | logical_vector(:) |
Used to define assignment from an array of type logical(int32)
to a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | self | |||
logical(kind=int32), | intent(in) | :: | logical_vector(:) |
Used to define assignment from an array of type logical(int64)
to a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | self | |||
logical(kind=int64), | intent(in) | :: | logical_vector(:) |
Used to define assignment from an array of type logical(int8)
to a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | self | |||
logical(kind=int8), | intent(in) | :: | logical_vector(:) |
Used to define assignment to an array of type logical(int16)
from a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical(kind=int16), | intent(out), | allocatable | :: | logical_vector(:) | ||
type(bitset_large), | intent(in) | :: | set |
Used to define assignment to an array of type logical(int32)
from a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical(kind=int32), | intent(out), | allocatable | :: | logical_vector(:) | ||
type(bitset_large), | intent(in) | :: | set |
Used to define assignment to an array of type logical(int64)
from a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical(kind=int64), | intent(out), | allocatable | :: | logical_vector(:) | ||
type(bitset_large), | intent(in) | :: | set |
Used to define assignment to an array of type logical(int8)
from a
bitset_large
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical(kind=int8), | intent(out), | allocatable | :: | logical_vector(:) | ||
type(bitset_large), | intent(in) | :: | set |
Creates a new bitset, new
, from a range, start_pos
to stop_pos
, in
bitset old
. If start_pos
is greater than stop_pos
the new bitset is
empty. If start_pos
is less than zero or stop_pos
is greater than
bits(old)-1
then if status
is present it has the value
index_invalid_error
and new
is undefined, otherwise processing stops
with an informative message.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(out) | :: | new | |||
type(bitset_64), | intent(in) | :: | old | |||
integer(kind=bits_kind), | intent(in) | :: | start_pos | |||
integer(kind=bits_kind), | intent(in) | :: | stop_pos | |||
integer, | intent(out), | optional | :: | status |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(out) | :: | new | |||
type(bitset_large), | intent(in) | :: | old | |||
integer(kind=bits_kind), | intent(in) | :: | start_pos | |||
integer(kind=bits_kind), | intent(in) | :: | stop_pos | |||
integer, | intent(out), | optional | :: | status |
Returns .true.
if not all bits in set1
and set2
have the same value,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Returns .true.
if the bits in set1
and set2
differ and the
highest order different bit is set to 0 in set1
and to 1 in set2
,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Returns .true.
if the bits in set1
and set2
are the same or the
highest order different bit is set to 0 in set1
and to 1 in set2
,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Returns .true.
if all bits in set1
and set2
have the same value,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Returns .true.
if the bits in set1
and set2
differ and the
highest order different bit is set to 1 in set1
and to 0 in set2
,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Returns .true.
if the bits in set1
and set2
are the same or the
highest order different bit is set to 1 in set1
and to 0 in set2
,
.false.
otherwise. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(in) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(in) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Sets the bits in set1
to the bitwise or
of the original bits in set1
and set2
. The sets must have the same number of bits otherwise
the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(inout) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(inout) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Sets the bits in set1
to the bitwise xor
of the original bits in set1
and set2
. The sets must have the same number of bits
otherwise the result is undefined.
(Specification)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_64), | intent(inout) | :: | set1 | |||
type(bitset_64), | intent(in) | :: | set2 |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(bitset_large), | intent(inout) | :: | set1 | |||
type(bitset_large), | intent(in) | :: | set2 |
Type for bitsets with no more than 64 bits (Specification)
procedure, public, pass(self) :: all => all_64 | |
procedure, public, pass(self) :: any => any_64 | |
procedure, public, pass(self) :: bit_count => bit_count_64 | |
procedure, public, pass(self) :: bits | |
generic, public :: clear => clear_bit, clear_range | |
procedure, public, pass(self) :: clear_bit => clear_bit_64 | |
procedure, public, pass(self) :: clear_range => clear_range_64 | |
generic, public :: flip => flip_bit, flip_range | |
procedure, public, pass(self) :: flip_bit => flip_bit_64 | |
procedure, public, pass(self) :: flip_range => flip_range_64 | |
procedure, public, pass(self) :: from_string => from_string_64 | |
generic, public :: init => init_zero | |
procedure, public, pass(self) :: init_zero => init_zero_64 | |
procedure, public, pass(self) :: input => input_64 | |
procedure, public, pass(self) :: none => none_64 | |
procedure, public, pass(self) :: not => not_64 | |
procedure, public, pass(self) :: output => output_64 | |
generic, public :: read_bitset => read_bitset_string, read_bitset_unit | |
procedure, public, pass(self) :: read_bitset_string => read_bitset_string_64 | |
procedure, public, pass(self) :: read_bitset_unit => read_bitset_unit_64 | |
generic, public :: set => set_bit, set_range | |
procedure, public, pass(self) :: set_bit => set_bit_64 | |
procedure, public, pass(self) :: set_range => set_range_64 | |
procedure, public, pass(self) :: test => test_64 | |
procedure, public, pass(self) :: to_string => to_string_64 | |
procedure, public, pass(self) :: value => value_64 | |
generic, public :: write_bitset => write_bitset_string, write_bitset_unit | |
procedure, public, pass(self) :: write_bitset_string => write_bitset_string_64 | |
procedure, public, pass(self) :: write_bitset_unit => write_bitset_unit_64 |
Type for bitsets with more than 64 bits (Specification)
procedure, public, pass(self) :: all => all_large | |
procedure, public, pass(self) :: any => any_large | |
procedure, public, pass(self) :: bit_count => bit_count_large | |
procedure, public, pass(self) :: bits | |
generic, public :: clear => clear_bit, clear_range | |
procedure, public, pass(self) :: clear_bit => clear_bit_large | |
procedure, public, pass(self) :: clear_range => clear_range_large | |
generic, public :: flip => flip_bit, flip_range | |
procedure, public, pass(self) :: flip_bit => flip_bit_large | |
procedure, public, pass(self) :: flip_range => flip_range_large | |
procedure, public, pass(self) :: from_string => from_string_large | |
generic, public :: init => init_zero | |
procedure, public, pass(self) :: init_zero => init_zero_large | |
procedure, public, pass(self) :: input => input_large | |
procedure, public, pass(self) :: none => none_large | |
procedure, public, pass(self) :: not => not_large | |
procedure, public, pass(self) :: output => output_large | |
generic, public :: read_bitset => read_bitset_string, read_bitset_unit | |
procedure, public, pass(self) :: read_bitset_string => read_bitset_string_large | |
procedure, public, pass(self) :: read_bitset_unit => read_bitset_unit_large | |
generic, public :: set => set_bit, set_range | |
procedure, public, pass(self) :: set_bit => set_bit_large | |
procedure, public, pass(self) :: set_range => set_range_large | |
procedure, public, pass(self) :: test => test_large | |
procedure, public, pass(self) :: to_string => to_string_large | |
procedure, public, pass(self) :: value => value_large | |
generic, public :: write_bitset => write_bitset_string, write_bitset_unit | |
procedure, public, pass(self) :: write_bitset_string => write_bitset_string_large | |
procedure, public, pass(self) :: write_bitset_unit => write_bitset_unit_large |
Parent type for bitset_64 and bitset_large (Specification)
procedure(all_abstract), public, pass(self) :: all | |
procedure(any_abstract), public, pass(self) :: any | |
procedure(bit_count_abstract), public, pass(self) :: bit_count | |
procedure, public, pass(self) :: bits | |
generic, public :: clear => clear_bit, clear_range | |
procedure(clear_bit_abstract), public, pass(self) :: clear_bit | |
procedure(clear_range_abstract), public, pass(self) :: clear_range | |
generic, public :: flip => flip_bit, flip_range | |
procedure(flip_bit_abstract), public, pass(self) :: flip_bit | |
procedure(flip_range_abstract), public, pass(self) :: flip_range | |
procedure(from_string_abstract), public, pass(self) :: from_string | |
generic, public :: init => init_zero | |
procedure(init_zero_abstract), public, pass(self) :: init_zero | |
procedure(input_abstract), public, pass(self) :: input | |
procedure(none_abstract), public, pass(self) :: none | |
procedure(not_abstract), public, pass(self) :: not | |
procedure(output_abstract), public, pass(self) :: output | |
generic, public :: read_bitset => read_bitset_string, read_bitset_unit | |
procedure(read_bitset_string_abstract), public, pass(self) :: read_bitset_string | |
procedure(read_bitset_unit_abstract), public, pass(self) :: read_bitset_unit | |
generic, public :: set => set_bit, set_range | |
procedure(set_bit_abstract), public, pass(self) :: set_bit | |
procedure(set_range_abstract), public, pass(self) :: set_range | |
procedure(test_abstract), public, pass(self) :: test | |
procedure(to_string_abstract), public, pass(self) :: to_string | |
procedure(value_abstract), public, pass(self) :: value | |
generic, public :: write_bitset => write_bitset_string, write_bitset_unit | |
procedure(write_bitset_string_abstract), public, pass(self) :: write_bitset_string | |
procedure(write_bitset_unit_abstract), public, pass(self) :: write_bitset_unit |
Returns the number of bit positions in self
.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(bitset_type), | intent(in) | :: | self |
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character, | intent(in) | :: | message | |||
integer, | intent(in) | :: | error | |||
integer, | intent(out), | optional | :: | status | ||
character, | intent(in), | optional | :: | module | ||
character, | intent(in), | optional | :: | procedure |