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