       1 package BitVector;
       2 #
       3 # File: BitVector.pm
       4 # Author: Manish Sud <msud@san.rr.com>
       5 #
       6 # Copyright (C) 2018 Manish Sud. All rights reserved.
       7 #
       8 # This file is part of MayaChemTools.
       9 #
      10 # MayaChemTools is free software; you can redistribute it and/or modify it under
      11 # the terms of the GNU Lesser General Public License as published by the Free
      12 # Software Foundation; either version 3 of the License, or (at your option) any
      13 # later version.
      14 #
      15 # MayaChemTools is distributed in the hope that it will be useful, but without
      16 # any warranty; without even the implied warranty of merchantability of fitness
      17 # for a particular purpose.  See the GNU Lesser General Public License for more
      18 # details.
      19 #
      20 # You should have received a copy of the GNU Lesser General Public License
      21 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
      22 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
      23 # Boston, MA, 02111-1307, USA.
      24 #
      25
      26 use strict;
      27 use Carp;
      28 use Exporter;
      29 use Scalar::Util ();
      30 use TextUtil ();
      31 use ConversionsUtil ();
      32 use MathUtil;
      33
      34 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
      35
      36 @ISA = qw(Exporter);
      37 @EXPORT = qw(IsBitVector);
      38 @EXPORT_OK = qw(NewFromBinaryString NewFromDecimalString NewFromHexadecimalString NewFromOctalString NewFromRawBinaryString);
      39
      40 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
      41
      42 # Setup class variables...
      43 my($ClassName, $ValueFormat, $ValueBitOrder);
      44 _InitializeClass();
      45
      46 #
      47 # Overload bitwise and some logical operators...
      48 #
      49 # 'fallback' is set to 'false' to raise exception for all other operators.
      50 #
      51 use overload '""' => 'StringifyBitVector',
      52   '&' => '_BitVectorAndOperator',
      53   '|' => '_BitVectorOrOperator',
      54   '^' => '_BitVectorExclusiveOrOperator',
      55
      56   '~' => '_BitVectorNegationOperator',
      57
      58   '==' => '_BitVectorEqualOperator',
      59   '!=' => '_BitVectorNotEqualOperator',
      60
      61   'fallback' => undef;
      62
      63 # Class constructor...
      64 #
      65 sub new {
      66   my($Class, $Size) = @_;
      67
      68   # Initialize object...
      69   my $This = {};
      70   bless $This, ref($Class) || $Class;
      71   $This->_InitializeBitVector($Size);
      72
      73   return $This;
      74 }
      75
      76 # Initialize object data...
      77 #
      78 # Note:
      79 #  . Perl pack function used to initialize vector automatically sets its size to
      80 #    nearest power of 2 value.
      81 #
      82 sub _InitializeBitVector {
      83   my($This, $Size) = @_;
      84
      85   if (!defined $Size) {
      86     croak "Error: ${ClassName}->new: BitVector object instantiated without specifying its size ...";
      87   }
      88   if ($Size <=0) {
      89     croak "Error: ${ClassName}->new: Bit vector size, $Size, must be a positive integer...";
      90   }
      91
      92   # Initialize vector with zeros...
      93   $This->{BitValues} = pack("b*", "0" x $Size);
      94
      95   # Size to automatically set to nearest power of 2 by Perl pack function. So use the length
      96   # of packed vector to set size...
      97   $This->{Size} = length($This->GetBitsAsBinaryString());
      98
      99   return $This;
     100 }
     101
     102 # Initialize class ...
     103 sub _InitializeClass {
     104   #Class name...
     105   $ClassName = __PACKAGE__;
     106
     107   # Print format for bit vectore values...
     108   $ValueFormat = "Binary";
     109
     110   # Bit ordering for printing bit vector value strings. Default is to print lowest bit of each
     111   # byte on the left.
     112   #
     113   # Internally, bits are stored in ascending order using Perl vec function. Regardless
     114   # of machine order, big-endian or little-endian, vec function always considers first
     115   # string byte as the lowest byte and first bit within each byte as the lowest bit.
     116   #
     117   # Possible values: Ascending or Descending
     118   #
     119   $ValueBitOrder = 'Ascending';
     120 }
     121
     122 # Create a new bit vector using binary string. This functionality can be
     123 # either invoked as a class function or an object method.
     124 #
     125 # The size of bit vector is automatically set to reflect the string.
     126 #
     127 sub NewFromBinaryString ($;$) {
     128   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     129
     130   if (_IsBitVector($FirstParameter)) {
     131     return _NewBitVectorFromString('Binary', $SecondParameter, $ThirdParameter);
     132   }
     133   else {
     134     return _NewBitVectorFromString( 'Binary', $FirstParameter, $SecondParameter);
     135   }
     136 }
     137
     138 # Create a new bit vector using hexadecimal string. This functionality can be
     139 # either invoked as a class function or an object method.
     140 #
     141 # The size of bit vector is automatically set to reflect the string.
     142 #
     143 sub NewFromHexadecimalString ($;$) {
     144   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     145
     146   if (_IsBitVector($FirstParameter)) {
     147     return _NewBitVectorFromString('Hexadecimal', $SecondParameter, $ThirdParameter);
     148   }
     149   else {
     150     return _NewBitVectorFromString( 'Hexadecimal', $FirstParameter, $SecondParameter);
     151   }
     152 }
     153
     154 # Create a new bit vector using octal string. This functionality can be
     155 # either invoked as a class function or an object method.
     156 #
     157 # The size of bit vector is automatically set to reflect the string.
     158 #
     159 sub NewFromOctalString ($;$) {
     160   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     161
     162   if (_IsBitVector($FirstParameter)) {
     163     return _NewBitVectorFromString('Octal', $SecondParameter, $ThirdParameter);
     164   }
     165   else {
     166     return _NewBitVectorFromString( 'Octal', $FirstParameter, $SecondParameter);
     167   }
     168 }
     169
     170 # Create a new bit vector using decimal string. This functionality can be
     171 # either invoked as a class function or an object method.
     172 #
     173 # The size of bit vector is automatically set to reflect the string.
     174 #
     175 sub NewFromDecimalString ($;$) {
     176   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     177
     178   if (_IsBitVector($FirstParameter)) {
     179     return _NewBitVectorFromString('Decimal', $SecondParameter, $ThirdParameter);
     180   }
     181   else {
     182     return _NewBitVectorFromString( 'Decimal', $FirstParameter, $SecondParameter);
     183   }
     184 }
     185
     186 # Create a new bit vector using raw binary string. This functionality can be
     187 # either invoked as a class function or an object method.
     188 #
     189 # The size of bit vector is automatically set to reflect the string.
     190 #
     191 sub NewFromRawBinaryString ($;$) {
     192   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     193
     194   if (_IsBitVector($FirstParameter)) {
     195     return _NewBitVectorFromString('RawBinary', $SecondParameter, $ThirdParameter);
     196   }
     197   else {
     198     return _NewBitVectorFromString( 'RawBinary', $FirstParameter, $SecondParameter);
     199   }
     200 }
     201
     202 # Create a new bit vector from a string...
     203 #
     204 sub _NewBitVectorFromString ($$;$) {
     205   my($Format, $String, $BitOrder) = @_;
     206   my($Size, $BitVector);
     207
     208   $Size = _CalculateStringSizeInBits($Format, $String);
     209
     210   $BitVector = new BitVector($Size);
     211   $BitVector->_SetBitsAsString($Format, $String, $BitOrder);
     212
     213   return $BitVector;
     214 }
     215
     216 # Copy bit vector...
     217 sub Copy {
     218   my($This) = @_;
     219   my($BitVector);
     220
     221   # Make a new bit vector...
     222   $BitVector = (ref $This)->new($This->{Size});
     223
     224   # Copy bit values...
     225   $BitVector->{BitValues} = $This->{BitValues};
     226
     227   # Copy value format for stringification...
     228   if (exists $This->{ValueFormat}) {
     229     $BitVector->{ValueFormat} = $This->{ValueFormat};
     230   }
     231   # Copy value bit order for stringification...
     232   if (exists $This->{ValueBitOrder}) {
     233     $BitVector->{ValueBitOrder} = $This->{ValueBitOrder};
     234   }
     235   return $BitVector;
     236 }
     237
     238 # Reverse bit values in bit vector...
     239 sub Reverse {
     240   my($This) = @_;
     241   my($BitNum, $ReverseBitNum, $BitValue, $ReverseBitValue);
     242
     243   $BitNum = 0; $ReverseBitNum = $This->{Size} - 1;
     244
     245   while ($BitNum < $ReverseBitNum) {
     246     $BitValue = $This->_GetBitValue($BitNum);
     247     $ReverseBitValue = $This->_GetBitValue($ReverseBitNum);
     248
     249     $This->_SetBitValue($BitNum, $ReverseBitValue);
     250     $This->_SetBitValue($ReverseBitNum, $BitValue);
     251
     252     $BitNum++; $ReverseBitNum--;
     253   }
     254   return $This;
     255 }
     256
     257 # Is it a bit vector object?
     258 sub IsBitVector ($) {
     259   my($Object) = @_;
     260
     261   return _IsBitVector($Object);
     262 }
     263
     264 # Get size...
     265 sub GetSize {
     266   my($This) = @_;
     267
     268   return $This->{Size};
     269 }
     270
     271 # Set a bit...
     272 #
     273 sub SetBit {
     274   my($This, $BitNum, $SkipCheck) = @_;
     275
     276   # Just set it...
     277   if ($SkipCheck) {
     278     return $This->_SetBitValue($BitNum, 1);
     279   }
     280
     281   # Check and set...
     282   $This->_ValidateBitNumber("SetBit", $BitNum);
     283
     284   return $This->_SetBitValue($BitNum, 1);
     285 }
     286
     287 # Set arbitrary bits specified as a list of bit numbers...
     288 #
     289 sub SetBits {
     290   my($This, @BitNums) = @_;
     291   my($BitNum);
     292
     293   for $BitNum (@BitNums) {
     294     $This->SetBit($BitNum);
     295   }
     296   return $This;
     297 }
     298
     299 # Set bits in a specified range...
     300 #
     301 sub SetBitsRange {
     302   my($This, $MinBitNum, $MaxBitNum) = @_;
     303   my($BitNum);
     304
     305   $This->_ValidateBitNumber("SetBitsRange", $MinBitNum);
     306   $This->_ValidateBitNumber("SetBitsRange", $MaxBitNum);
     307
     308   for $BitNum ($MinBitNum .. $MaxBitNum) {
     309     $This->_SetBitValue($BitNum, 1);
     310   }
     311   return $This;
     312 }
     313
     314 # Set all bits...
     315 #
     316 sub SetAllBits {
     317   my($This) = @_;
     318
     319   $This->{BitValues} = pack("b*", "1" x $This->{Size});
     320 }
     321
     322 # Clear a bit...
     323 #
     324 sub ClearBit {
     325   my($This, $BitNum) = @_;
     326
     327   $This->_ValidateBitNumber("ClearBit", $BitNum);
     328
     329   return $This->_SetBitValue($BitNum, 0);
     330 }
     331
     332 # Clear arbitrary bits specified as a list of bit numbers...
     333 #
     334 sub ClearBits {
     335   my($This, @BitNums) = @_;
     336   my($BitNum);
     337
     338   for $BitNum (@BitNums) {
     339     $This->ClearBit($BitNum);
     340   }
     341   return $This;
     342 }
     343
     344 # Clear bits in a specified range...
     345 #
     346 sub ClearBitsRange {
     347   my($This, $MinBitNum, $MaxBitNum) = @_;
     348   my($BitNum);
     349
     350   $This->_ValidateBitNumber("ClearBitsRange", $MinBitNum);
     351   $This->_ValidateBitNumber("ClearBitsRange", $MaxBitNum);
     352
     353   for $BitNum ($MinBitNum .. $MaxBitNum) {
     354     $This->_SetBitValue($BitNum, 0);
     355   }
     356   return $This;
     357 }
     358
     359 # Clear all bits...
     360 #
     361 sub ClearAllBits {
     362   my($This) = @_;
     363
     364   $This->{BitValues} = pack("b*", "0" x $This->{Size});
     365
     366   return $This;
     367 }
     368
     369 # Set or clear bit...
     370 #
     371 sub SetBitValue {
     372   my($This, $BitNum, $BitValue) = @_;
     373
     374  BITVALUE: {
     375     if ($BitValue == 1) { return $This->SetBit($BitNum); last BITVALUE; }
     376     if ($BitValue == 0) { return $This->ClearBit($BitNum); last BITVALUE; }
     377     croak "Error: ${ClassName}->SetBit: Specified bit value, $BitValue, must be 0 or 1...";
     378   }
     379   return $This;
     380 }
     381
     382 # Flip bit value...
     383 #
     384 sub FlipBit {
     385   my($This, $BitNum) = @_;
     386
     387   $This->_ValidateBitNumber("FlipBit", $BitNum);
     388   return $This->_FlipBit($BitNum);
     389 }
     390
     391 # Flip arbitrary bits specified as a list of bit numbers...
     392 #
     393 sub FlipBits {
     394   my($This, @BitNums) = @_;
     395   my($BitNum);
     396
     397   for $BitNum (@BitNums) {
     398     $This->FlipBit();
     399   }
     400   return $This;
     401 }
     402
     403 # Flip bit value in a specified bit range...
     404 #
     405 sub FlipBitsRange {
     406   my($This, $MinBitNum, $MaxBitNum) = @_;
     407   my($BitNum);
     408
     409   $This->_ValidateBitNumber("FlipBitsRange", $MinBitNum);
     410   $This->_ValidateBitNumber("FlipBitsRange", $MaxBitNum);
     411
     412   for $BitNum ($MinBitNum .. $MaxBitNum) {
     413     $This->_FlipBit();
     414   }
     415   return $This;
     416 }
     417
     418 # Flip all bit valus...
     419 #
     420 sub FlipAllBits {
     421   my($This) = @_;
     422
     423   return $This->FlipBits(0, ($This->{Size} - 1));
     424 }
     425
     426 # Flip bit value...
     427 sub _FlipBit {
     428   my($This, $BitNum) = @_;
     429
     430   if ($This->_GetBitValue($BitNum)) {
     431     return $This->_SetBitValue($BitNum, 0);
     432   }
     433   else {
     434     return $This->_SetBitValue($BitNum, 1);
     435   }
     436 }
     437
     438 # Get bit value...
     439 #
     440 sub GetBit {
     441   my($This, $BitNum) = @_;
     442
     443   $This->_ValidateBitNumber("GetBit", $BitNum);
     444
     445   return $This->_GetBitValue($BitNum);
     446 }
     447
     448 # Is a specific bit set?
     449 #
     450 sub IsBitSet {
     451   my($This, $BitNum) = @_;
     452
     453   if (!(defined($BitNum) && ($BitNum >= 0) && ($BitNum < $This->{Size}))) {
     454     return undef;
     455   }
     456
     457   return $This->_GetBitValue($BitNum) ? 1 : 0;
     458 }
     459
     460 # Is a specific bit clear?
     461 #
     462 sub IsBitClear {
     463   my($This, $BitNum) = @_;
     464
     465   if (!(defined($BitNum) && ($BitNum >= 0) && ($BitNum < $This->{Size}))) {
     466     return undef;
     467   }
     468
     469   return $This->_GetBitValue($BitNum) ? 0 : 1;
     470 }
     471
     472 # Get number of set bits...
     473 #
     474 sub GetNumOfSetBits {
     475   my($This) = @_;
     476
     477   return unpack("%b*", $This->{BitValues});
     478 }
     479
     480 # Get number of clear bits...
     481 #
     482 sub GetNumOfClearBits {
     483   my($This) = @_;
     484
     485   return ($This->{Size} - $This->GetNumOfSetBits());
     486 }
     487
     488 # Get density of set bits...
     489 #
     490 sub GetDensityOfSetBits {
     491   my($This) = @_;
     492
     493   return $This->{Size} ? ($This->GetNumOfSetBits()/$This->{Size}) : 0;
     494 }
     495
     496 # Get density of clear bits...
     497 #
     498 sub GetDensityOfClearBits {
     499   my($This) = @_;
     500
     501   return $This->GetNumOfClearBits()/$This->{Size};
     502 }
     503
     504 # Convert internal bit values stored using Perl vec function with first string byte
     505 # as the lowest byte and first bit within each byte as the lowest bit into a binary
     506 # string with ascending or descending bit order within each byte. The internal
     507 # bit order corresponds to ascending bit order within each byte.
     508 #
     509 sub GetBitsAsBinaryString {
     510   my($This, $BitOrder) = @_;
     511
     512   return $This->_GetBitsAsString('Binary', $BitOrder);
     513 }
     514
     515 # Convert internal bit values stored using Perl vec function with first string byte
     516 # as the lowest byte and first bit within each byte as the lowest bit into a hexadecimal
     517 # string with ascending or descending bit order within each byte. The internal
     518 # bit order corresponds to ascending bit order within each byte.
     519 #
     520 #
     521 sub GetBitsAsHexadecimalString {
     522   my($This, $BitOrder) = @_;
     523
     524   return $This->_GetBitsAsString('Hexadecimal', $BitOrder);
     525 }
     526
     527 # Convert bit values into a octal string value...
     528 #
     529 sub GetBitsAsOctalString {
     530   my($This, $BitOrder) = @_;
     531
     532   return $This->_GetBitsAsString('Octal', $BitOrder);
     533 }
     534
     535 # Convert bit values into a decimal string value...
     536 #
     537 sub GetBitsAsDecimalString {
     538   my($This, $BitOrder) = @_;
     539
     540   return $This->_GetBitsAsString('Decimal', $BitOrder);
     541 }
     542
     543 # Return packed bit values which also contains nonprintable characters...
     544 #
     545 sub GetBitsAsRawBinaryString {
     546   my($This) = @_;
     547
     548   return $This->_GetBitsAsString('RawBinary');
     549 }
     550
     551 # Convert internal bit values stored using Perl vec function with first string byte
     552 # as the lowest byte and first bit within each byte as the lowest bit into a
     553 # string with ascending or descending bit order within each byte. The internal
     554 # bit order corresponds to ascending bit order within each byte.
     555 #
     556 #
     557 sub _GetBitsAsString {
     558   my($This, $Format, $BitOrder) = @_;
     559   my($BinaryTemplate, $HexadecimalTemplate);
     560
     561   ($BinaryTemplate, $HexadecimalTemplate) = $This->_SetupBitsPackUnpackTemplate($BitOrder);
     562
     563   FORMAT : {
     564     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { return unpack($HexadecimalTemplate, $This->{BitValues}); last FORMAT; }
     565     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { return ConversionsUtil::HexadecimalToOctal(unpack($HexadecimalTemplate, $This->{BitValues})); last FORMAT; }
     566     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { return ConversionsUtil::HexadecimalToDecimal(unpack($HexadecimalTemplate, $This->{BitValues})); last FORMAT; }
     567     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { return unpack($BinaryTemplate, $This->{BitValues}); last FORMAT; }
     568     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { return $This->{BitValues}; last FORMAT; }
     569     croak "Error: ${ClassName}->_GetBitsAsString: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     570   }
     571 }
     572
     573 # Setup templates to unpack bits...
     574 #
     575 sub _SetupBitsPackUnpackTemplate {
     576   my($This, $BitOrder) = @_;
     577   my($BinaryTemplate, $HexadecimalTemplate);
     578
     579   $BitOrder = (defined($BitOrder) && $BitOrder) ? $BitOrder : 'Ascending';
     580
     581   if ($BitOrder =~ /^Ascending$/i) {
     582     $BinaryTemplate = "b*";
     583     $HexadecimalTemplate = "h*";
     584   }
     585   elsif ($BitOrder =~ /^Descending$/i) {
     586     $BinaryTemplate = "B*";
     587     $HexadecimalTemplate = "H*";
     588   }
     589   else {
     590     croak "Warning: ${ClassName}::_SetupBitsPackUnpackTemplate: Specified bit order value, $BitOrder, is not supported. Supported values: Ascending, Descending...";
     591   }
     592   return ($BinaryTemplate, $HexadecimalTemplate);
     593 }
     594
     595 # Set bit values using hexadecimal string. The initial size of bit vector is not changed.
     596 #
     597 sub SetBitsAsHexadecimalString {
     598   my($This, $Hexadecimal, $BitOrder) = @_;
     599
     600   if ($Hexadecimal =~ /^0x/i) {
     601     $Hexadecimal =~ s/^0x//i;
     602   }
     603   return $This->_SetBitsAsString('Hexadecimal', $Hexadecimal, $BitOrder);
     604 }
     605
     606 # Set bit values using octal string. The initial size of bit vector is not changed.
     607 #
     608 sub SetBitsAsOctalString {
     609   my($This, $Octal, $BitOrder) = @_;
     610
     611   if ($Octal =~ /^0/i) {
     612     $Octal =~ s/^0//i;
     613   }
     614   return $This->_SetBitsAsString('Octal', $Octal, $BitOrder);
     615 }
     616
     617 # Set bit values using a decimal number. The initial size of bit vector is not changed.
     618 #
     619 sub SetBitsAsDecimalString {
     620   my($This, $Decimal, $BitOrder) = @_;
     621
     622   if (!TextUtil::IsPositiveInteger($Decimal)) {
     623     croak "Error: ${ClassName}->SetBitsAsDecimalString: Specified decimal value, $Decimal, must be a positive integer...";
     624   }
     625   if ($Decimal =~ /[+]/) {
     626     $Decimal =~ s/[+]//;
     627   }
     628   return $This->_SetBitsAsString('Decimal', $Decimal, $BitOrder);
     629 }
     630
     631 # Set bit values using hexadecimal string. The initial size of bit vector is not changed.
     632 #
     633 sub SetBitsAsBinaryString {
     634   my($This, $Binary, $BitOrder) = @_;
     635
     636   if ($Binary =~ /^0b/i) {
     637     $Binary =~ s/^0b//i;
     638   }
     639   return $This->_SetBitsAsString('Binary', $Binary, $BitOrder);
     640 }
     641
     642 # Set bit values using packed binary string. The size of bit vector is changed to reflect
     643 # the input raw string...
     644 #
     645 sub SetBitsAsRawBinaryString {
     646   my($This, $RawBinary) = @_;
     647
     648   return $This->_SetBitsAsString('RawBinary', $RawBinary);
     649 }
     650
     651 # Set bits using string in a specified format. This size of bit vector is not changed except for
     652 # RawBinary string type...
     653 #
     654 sub _SetBitsAsString {
     655   my($This, $Format, $String, $BitOrder) = @_;
     656   my($Size, $BinaryTemplate, $HexadecimalTemplate);
     657
     658   ($BinaryTemplate, $HexadecimalTemplate) = $This->_SetupBitsPackUnpackTemplate($BitOrder);
     659
     660   $Size = $This->{Size};
     661   FORMAT : {
     662     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $This->{BitValues} = pack($HexadecimalTemplate, $String); last FORMAT; }
     663     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { vec($This->{BitValues}, 0, $Size) = ConversionsUtil::OctalToDecimal($String); last FORMAT; }
     664     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { vec($This->{BitValues}, 0, $Size) = $String; last FORMAT; }
     665     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { $This->{BitValues} = pack($BinaryTemplate, $String); last FORMAT; }
     666     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $This->{BitValues} = $String; last FORMAT; }
     667     croak "Error: ${ClassName}->_SetBitsAsString: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     668   }
     669
     670   # Set size using packed string...
     671   $Size = length($This->GetBitsAsBinaryString());
     672   if ($Size <=0) {
     673     croak "Error: ${ClassName}->_SetBitsAsString: Bit vector size, $Size, must be a positive integer...";
     674   }
     675   $This->{Size} = $Size;
     676
     677   return $This;
     678 }
     679
     680 # Calculate string size in bits...
     681 #
     682 sub _CalculateStringSizeInBits ($$;$) {
     683   my($FirstParameter, $SecondParameter, $ThisParameter) = @_;
     684   my($This, $Format, $String, $Size);
     685
     686   if ((@_ == 3) && (_IsBitVector($FirstParameter))) {
     687     ($This, $Format, $String) = ($FirstParameter, $SecondParameter, $ThisParameter);
     688   }
     689   else {
     690     ($This, $Format, $String) = (undef, $FirstParameter, $SecondParameter);
     691   }
     692
     693   FORMAT : {
     694     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $Size = length($String) * 4; last FORMAT; }
     695     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { $Size = length($String) * 3; last FORMAT; }
     696     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { $Size = length(ConversionsUtil::DecimalToHexadecimal($String)) * 4; last FORMAT; }
     697     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { $Size = length($String); last FORMAT; }
     698     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $Size = length(unpack("B*", $String)); last FORMAT; }
     699     croak "Error: ${ClassName}::_CalculateStringSizeInBits: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     700   }
     701   return $Size;
     702 }
     703
     704 # Set bit value using Perl vec function with bit numbers going from left to right.
     705 # First bit number corresponds to 0.
     706 #
     707 sub _SetBitValue {
     708   my($This, $BitNum, $BitValue) = @_;
     709   my($Offset, $Width);
     710
     711   $Offset = $BitNum;
     712   $Width = 1;
     713
     714   vec($This->{BitValues}, $Offset, $Width) = $BitValue;
     715
     716   return $This;
     717 }
     718
     719 # Get bit value Perl vec function with bit numbers going from left to right.
     720 # First bit number corresponds to 0.
     721 #
     722 sub _GetBitValue {
     723   my($This, $BitNum) = @_;
     724   my($Offset, $Width, $BitValue);
     725
     726   $Offset = $BitNum;
     727   $Width = 1;
     728
     729   $BitValue = vec($This->{BitValues}, $Offset, $Width);
     730
     731   return $BitValue;
     732 }
     733
     734 # Check to make sure it's a valid bit number...
     735 #
     736 sub _ValidateBitNumber {
     737   my($This, $CallerName, $BitNum) = @_;
     738
     739   if (!defined $BitNum) {
     740     croak "Error: ${ClassName}->${CallerName}: Bit number is not defined...";
     741   }
     742   if ($BitNum < 0) {
     743     croak "Error: ${ClassName}->${CallerName}: Bit number value, $BitNum, must be >= 0 ...";
     744   }
     745   if ($BitNum >= $This->{Size}) {
     746     croak "Error: ${ClassName}->${CallerName}: Bit number number value, $BitNum, must be less than the size of bit vector, ", $This->{Size}, "...";
     747   }
     748
     749   return $This;
     750 }
     751
     752 # Set bit values print format for an individual object or the whole class...
     753 #
     754 sub SetBitValuePrintFormat ($;$) {
     755   my($FirstParameter, $SecondParameter) = @_;
     756
     757   if ((@_ == 2) && (_IsBitVector($FirstParameter))) {
     758     # Set bit values print format for the specific object...
     759     my($This, $ValuePrintFormat) = ($FirstParameter, $SecondParameter);
     760
     761     if (!_ValidateBitValuePrintFormat($ValuePrintFormat)) {
     762       return;
     763     }
     764
     765     $This->{ValueFormat} = $ValuePrintFormat;
     766   }
     767   else {
     768     # Set value print format for the class...
     769     my($ValuePrintFormat) = ($FirstParameter);
     770
     771     if (!_ValidateBitValuePrintFormat($ValuePrintFormat)) {
     772       return;
     773     }
     774
     775     $ValueFormat = $ValuePrintFormat;
     776   }
     777 }
     778
     779 # Set bit values bit order for an individual object or the whole class...
     780 #
     781 sub SetBitValueBitOrder ($;$) {
     782   my($FirstParameter, $SecondParameter) = @_;
     783
     784   if ((@_ == 2) && (_IsBitVector($FirstParameter))) {
     785     # Set bit value bit order for the specific object...
     786     my($This, $BitOrder) = ($FirstParameter, $SecondParameter);
     787
     788     if (!_ValidateBitValueBitOrder($BitOrder)) {
     789       return;
     790     }
     791
     792     $This->{ValueBitOrder} = $BitOrder;
     793   }
     794   else {
     795     # Set bit value bit order for the class...
     796     my($BitOrder) = ($FirstParameter);
     797
     798     if (!_ValidateBitValueBitOrder($BitOrder)) {
     799       return;
     800     }
     801
     802     $ValueBitOrder = $BitOrder;
     803   }
     804 }
     805
     806 # Validate print format for bit values...
     807 sub _ValidateBitValueBitOrder {
     808   my($BitOrder) = @_;
     809
     810   if ($BitOrder !~ /^(Ascending|Descending)$/i) {
     811     carp "Warning: ${ClassName}::_ValidateBitValueBitOrder: Specified bit order value, $BitOrder, is not supported. Supported values: Ascending, Descending...";
     812     return 0;
     813   }
     814   return 1;
     815 }
     816
     817 # Validate print format for bit values...
     818 sub _ValidateBitValuePrintFormat {
     819   my($ValuePrintFormat) = @_;
     820
     821   if ($ValuePrintFormat !~ /^(Binary|Bin||BinaryString|Hexadecimal|Hex||HexadecimalString|Decimal|Dec||DecimalString|Octal|Oct||OctalString|RawBinary|RawBin|RawBinaryString)$/i) {
     822     carp "Warning: ${ClassName}::_ValidateBitValuePrintFormat: Specified bit vector print format value, $ValuePrintFormat, is not supported. Supported values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     823     return 0;
     824   }
     825   return 1;
     826 }
     827
     828 # Bitwise AND operation for BitVectors...
     829 #
     830 sub _BitVectorAndOperator {
     831   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     832
     833   $ErrorMsg = "_BitVectorAndOperator: Bitwise AND oparation failed";
     834   $CheckBitVectorSizes = 1;
     835   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     836
     837   if (!$OtherIsBitVector) {
     838     if ($OrderFlipped) {
     839       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     840     }
     841   }
     842   my($BitVector);
     843   $BitVector = (ref $This)->new($This->{Size});
     844   $BitVector->{BitValues} = $This->{BitValues} & $Other->{BitValues};
     845
     846   return $BitVector;
     847 }
     848
     849 # Bitwise OR operation for BitVectors...
     850 #
     851 sub _BitVectorOrOperator {
     852   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     853
     854   $ErrorMsg = "_BitVectorAndOperator: Bitwise OR oparation failed";
     855   $CheckBitVectorSizes = 1;
     856   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     857
     858   if (!$OtherIsBitVector) {
     859     if ($OrderFlipped) {
     860       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     861     }
     862   }
     863   my($BitVector);
     864   $BitVector = (ref $This)->new($This->{Size});
     865   $BitVector->{BitValues} = $This->{BitValues} | $Other->{BitValues};
     866
     867   return $BitVector;
     868 }
     869
     870 # Bitwise XOR operation for BitVectors...
     871 #
     872 sub _BitVectorExclusiveOrOperator {
     873   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     874
     875   $ErrorMsg = "_BitVectorAndOperator: Bitwise XOR oparation failed";
     876   $CheckBitVectorSizes = 1;
     877   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     878
     879   if (!$OtherIsBitVector) {
     880     if ($OrderFlipped) {
     881       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     882     }
     883   }
     884   my($BitVector);
     885   $BitVector = (ref $This)->new($This->{Size});
     886   $BitVector->{BitValues} = $This->{BitValues} ^ $Other->{BitValues};
     887
     888   return $BitVector;
     889 }
     890
     891 # Bitwise negation operation for BitVectors...
     892 #
     893 sub _BitVectorNegationOperator {
     894   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     895
     896   $ErrorMsg = "_BitVectorAndOperator: Bitwise negation oparation failed";
     897   $CheckBitVectorSizes = 1;
     898   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     899
     900   my($BitVector);
     901   $BitVector = (ref $This)->new($This->{Size});
     902   $BitVector->{BitValues} = ~ $This->{BitValues};
     903
     904   return $BitVector;
     905 }
     906
     907 # Bit vector equla operator. Two bit vectors are considered equal assuming their size
     908 # is same and bits are on at the same positions...
     909 #
     910 sub _BitVectorEqualOperator {
     911   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     912
     913   $ErrorMsg = "_BitVectorEqualOperator: BitVector == oparation failed";
     914   $CheckBitVectorSizes = 0;
     915   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     916
     917   if (!$OtherIsBitVector) {
     918     if ($OrderFlipped) {
     919       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     920     }
     921   }
     922   if ($This->GetSize() != $Other->GetSize()) {
     923     return 0;
     924   }
     925   if ($This->GetNumOfSetBits() != $Other->GetNumOfSetBits()) {
     926     return 0;
     927   }
     928   # Check number of On bits only in This vector. It must be zero for vectors to be equal...
     929   my($BitVector);
     930   $BitVector = $This & ~$Other;
     931
     932   return $BitVector->GetNumOfSetBits() ? 0 : 1;
     933 }
     934
     935 # Bit vector not equal operator. Two bit vectors are considered not equal when their size
     936 # is different or bits are on at the same positions...
     937 #
     938 sub _BitVectorNotEqualOperator {
     939   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     940
     941   $ErrorMsg = "_BitVectorEqualOperator: BitVector != oparation failed";
     942   $CheckBitVectorSizes = 0;
     943   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     944
     945   if (!$OtherIsBitVector) {
     946     if ($OrderFlipped) {
     947       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     948     }
     949   }
     950   if ($This->GetSize() != $Other->GetSize()) {
     951     return 1;
     952   }
     953   if ($This->GetNumOfSetBits() != $Other->GetNumOfSetBits()) {
     954     return 1;
     955   }
     956   # Check number of On bits only in This vector. It must be zero for vectors to be equal...
     957   my($BitVector);
     958   $BitVector = $This & ~$Other;
     959
     960   return $BitVector->GetNumOfSetBits() ? 1 : 0;
     961 }
     962
     963 # Process parameters passed to overloaded operators...
     964 #
     965 # For uninary operators, $SecondParameter is not defined.
     966 sub _ProcessOverloadedOperatorParameters {
     967   my($ErrorMsg, $FirstParameter, $SecondParameter, $ParametersOrderStatus, $CheckBitVectorSizesStatus) = @_;
     968   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $CheckBitVectorSizes);
     969
     970   ($This, $Other) =  ($FirstParameter, $SecondParameter);
     971   $OrderFlipped = (defined($ParametersOrderStatus) && $ParametersOrderStatus) ? 1 : 0;
     972   $CheckBitVectorSizes = (defined $CheckBitVectorSizesStatus) ? $CheckBitVectorSizesStatus : 1;
     973
     974   _ValidateBitVector($ErrorMsg, $This);
     975
     976   $OtherIsBitVector = 0;
     977   if (defined($Other) && (ref $Other)) {
     978     # Make sure $Other is a vector...
     979     _ValidateBitVector($ErrorMsg, $Other);
     980     if ($CheckBitVectorSizes) {
     981       _ValidateBitVectorSizesAreEqual($ErrorMsg, $This, $Other);
     982     }
     983     $OtherIsBitVector = 1;
     984   }
     985   return ($This, $Other, $OrderFlipped, $OtherIsBitVector);
     986 }
     987
     988 # Is it a bit vector object?
     989 sub _IsBitVector {
     990   my($Object) = @_;
     991
     992   return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0;
     993 }
     994
     995 # Make sure it's a bit vector reference...
     996 sub _ValidateBitVector {
     997   my($ErrorMsg, $Vector) = @_;
     998
     999   if (!_IsBitVector($Vector)) {
    1000     croak "Error: ${ClassName}->${ErrorMsg}: Object must be a bit vector...";
    1001   }
    1002 }
    1003
    1004 # Make sure size of the two bit vectors are equal...
    1005 sub _ValidateBitVectorSizesAreEqual {
    1006   my($ErrorMsg, $BitVector1, $BitVector2) = @_;
    1007
    1008   if ($BitVector1->GetSize() != $BitVector2->GetSize()) {
    1009     croak "Error: ${ClassName}->${ErrorMsg}: Size of the bit vectors must be same...";
    1010   }
    1011 }
    1012
    1013 # Return a string containing vector values...
    1014 sub StringifyBitVector {
    1015   my($This) = @_;
    1016   my($BitVectorString, $PrintFormat, $BitOrder, $BitsValue);
    1017
    1018   $PrintFormat = (exists $This->{ValueFormat}) ? $This->{ValueFormat} : $ValueFormat;
    1019   $BitOrder = (exists $This->{ValueBitOrder}) ? $This->{ValueBitOrder} : $ValueBitOrder;
    1020   $BitVectorString = '';
    1021
    1022   FORMAT: {
    1023       if ($PrintFormat =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $BitsValue = $This->_GetBitsAsString('Hexadecimal', $BitOrder);  last FORMAT; }
    1024       if ($PrintFormat =~ /^(Octal|Oct|OctalString)$/i) { $BitsValue = $This->_GetBitsAsString('Octal', $BitOrder);  last FORMAT; }
    1025       if ($PrintFormat =~ /^(Decimal|Dec|DecimalString)$/i) { $BitsValue = $This->_GetBitsAsString('Decimal', $BitOrder);  last FORMAT; }
    1026       if ($PrintFormat =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $BitsValue = $This->_GetBitsAsString('RawBinary');  last FORMAT; }
    1027       # Default is bninary format...
    1028       $BitsValue = $This->_GetBitsAsString('Binary', $BitOrder);
    1029   }
    1030   $BitVectorString = "<Size: ". $This->GetSize() . ";BitOrder: $BitOrder; Value: " . $BitsValue . ">";
    1031
    1032   return $BitVectorString;
    1033 }
    1034