home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / qb / toolbox / disk1 / bits.bas < prev    next >
Encoding:
BASIC Source File  |  1988-04-29  |  7.6 KB  |  233 lines
  1.   ' ************************************************
  2.   ' **  Name:          BITS                       **
  3.   ' **  Type:          Toolbox                    **
  4.   ' **  Module:        BITS.BAS                   **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' Demonstrates the bit manipulation functions
  9.   ' and subprograms.
  10.   '
  11.   ' USAGE: No command line parameters
  12.   ' .MAK FILE:       (none)
  13.   ' PARAMETERS:      (none)
  14.   ' VARIABLES:       max%       Upper limit for the prime number generator
  15.   '                  b$         Bit string for finding prime numbers
  16.   '                  n%         Loop index for sieve of Eratosthenes
  17.   '                  bit%       Bit retrieved from b$
  18.   '                  i%         Bit loop index
  19.   '                  q$         The double quote character
  20.   
  21.   
  22.     DECLARE FUNCTION BinStr2Bin% (b$)
  23.     DECLARE FUNCTION Bin2BinStr$ (b%)
  24.   
  25.   ' Subprograms
  26.     DECLARE SUB BitGet (a$, bitIndex%, bit%)
  27.     DECLARE SUB BitPut (b$, bitIndex%, bit%)
  28.   
  29.   ' Prime numbers less than max%, using bit fields in B$
  30.     CLS
  31.     max% = 1000
  32.     PRINT "Primes up to"; max%; "using BitGet and BitPut for sieve..."
  33.     PRINT
  34.     PRINT 1; 2;
  35.     b$ = STRING$(max% \ 8 + 1, 0)
  36.     FOR n% = 3 TO max% STEP 2
  37.         BitGet b$, n%, bit%
  38.         IF bit% = 0 THEN
  39.             PRINT n%;
  40.             FOR i% = 3 * n% TO max% STEP n% + n%
  41.                 BitPut b$, i%, 1
  42.             NEXT i%
  43.         END IF
  44.     NEXT n%
  45.     PRINT
  46.   
  47.   ' Demonstration of the Bin2BinStr$ function
  48.     PRINT
  49.     PRINT "Bin2BinStr$(12345) = "; Bin2BinStr$(12345)
  50.   
  51.   ' Demonstration of the BinStr2Bin% function
  52.     PRINT
  53.     q$ = CHR$(34)
  54.     PRINT "BinStr2Bin%("; q$; "1001011"; q$; ") = ";
  55.     PRINT BinStr2Bin%("1001011")
  56.   
  57.   ' That's all
  58.     END
  59.   
  60.  
  61.   ' ************************************************
  62.   ' **  Name:          Bin2BinStr$                **
  63.   ' **  Type:          Function                   **
  64.   ' **  Module:        BITS.BAS                   **
  65.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  66.   ' ************************************************
  67.   '
  68.   ' Returns a string of sixteen "0" and "1" characters
  69.   ' that represent the binary value of b%.
  70.   '
  71.   ' EXAMPLE OF USE:  PRINT Bin2BinStr$(b%)
  72.   ' PARAMETERS:      b%         Integer number
  73.   ' VARIABLES:       t$         Working string space for forming binary string
  74.   '                  b%         Integer number
  75.   '                  mask%      Bit isolation mask
  76.   '                  i%         Looping index
  77.   ' MODULE LEVEL
  78.   '   DECLARATIONS:  DECLARE FUNCTION Bin2BinStr$ (b%)
  79.   '
  80.     FUNCTION Bin2BinStr$ (b%) STATIC
  81.         t$ = STRING$(16, "0")
  82.         IF b% THEN
  83.             IF b% < 0 THEN
  84.                 MID$(t$, 1, 1) = "1"
  85.             END IF
  86.             mask% = &H4000
  87.             FOR i% = 2 TO 16
  88.                 IF b% AND mask% THEN
  89.                     MID$(t$, i%, 1) = "1"
  90.                 END IF
  91.                 mask% = mask% \ 2
  92.             NEXT i%
  93.         END IF
  94.         Bin2BinStr$ = t$
  95.     END FUNCTION
  96.  
  97.   ' ************************************************
  98.   ' **  Name:          BinStr2Bin%                **
  99.   ' **  Type:          Function                   **
  100.   ' **  Module:        BITS.BAS                   **
  101.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  102.   ' ************************************************
  103.   '
  104.   ' Returns the integer represented by a string of up
  105.   ' to 16 "0" and "1" characters.
  106.   '
  107.   ' EXAMPLE OF USE:  PRINT BinStr2Bin%(b$)
  108.   ' PARAMETERS:      b$         Binary representation string
  109.   ' VARIABLES:       bin%       Working variable for finding value
  110.   '                  t$         Working copy of b$
  111.   '                  mask%      Bit mask for forming value
  112.   '                  i%         Looping index
  113.   ' MODULE LEVEL
  114.   '   DECLARATIONS:  DECLARE FUNCTION BinStr2Bin% (b$)
  115.   '
  116.     FUNCTION BinStr2Bin% (b$) STATIC
  117.         bin% = 0
  118.         t$ = RIGHT$(STRING$(16, "0") + b$, 16)
  119.         IF LEFT$(t$, 1) = "1" THEN
  120.             bin% = &H8000
  121.         END IF
  122.         mask% = &H4000
  123.         FOR i% = 2 TO 16
  124.             IF MID$(t$, i%, 1) = "1" THEN
  125.                 bin% = bin% OR mask%
  126.             END IF
  127.             mask% = mask% \ 2
  128.         NEXT i%
  129.         BinStr2Bin% = bin%
  130.     END FUNCTION
  131.  
  132.   ' ************************************************
  133.   ' **  Name:          BitGet                     **
  134.   ' **  Type:          Subprogram                 **
  135.   ' **  Module:        BITS.BAS                   **
  136.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  137.   ' ************************************************
  138.   '
  139.   ' Extracts the bit at bitIndex% into a$ and returns
  140.   ' either 0 or 1 in bit%.  The value of bitIndex%
  141.   ' can range from 1 to 8 * LEN(a$).
  142.   '
  143.   ' EXAMPLE OF USE:  BitGet a$, bitIndex%, bit%
  144.   ' PARAMETERS:      a$         String where bit is stored
  145.   '                  bitIndex%  Bit position in string
  146.   '                  bit%       Extracted bit value, 0 or 1
  147.   ' VARIABLES:       byte%      Byte location in string of the bit
  148.   '                  mask%      Bit isolation mask for given bit
  149.   ' MODULE LEVEL
  150.   '   DECLARATIONS:  DECLARE SUB BitGet (a$, bitIndex%, bit%)
  151.   '
  152.     SUB BitGet (a$, bitIndex%, bit%) STATIC
  153.         byte% = (bitIndex% - 1) \ 8 + 1
  154.         SELECT CASE bitIndex% MOD 8
  155.         CASE 1
  156.             mask% = 128
  157.         CASE 2
  158.             mask% = 64
  159.         CASE 3
  160.             mask% = 32
  161.         CASE 4
  162.             mask% = 16
  163.         CASE 5
  164.             mask% = 8
  165.         CASE 6
  166.             mask% = 4
  167.         CASE 7
  168.             mask% = 2
  169.         CASE 0
  170.             mask% = 1
  171.         END SELECT
  172.         IF ASC(MID$(a$, byte%, 1)) AND mask% THEN
  173.             bit% = 1
  174.         ELSE
  175.             bit% = 0
  176.         END IF
  177.     END SUB
  178.  
  179.   ' ************************************************
  180.   ' **  Name:          BitPut                     **
  181.   ' **  Type:          Subprogram                 **
  182.   ' **  Module:        BITS.BAS                   **
  183.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  184.   ' ************************************************
  185.   '
  186.   ' If bit% is non-zero, then the bit at bitIndex% into
  187.   ' a$ is set to 1; otherwise, it's set to 0. The value
  188.   ' of bitIndex% can range from 1 to 8 * LEN(a$).
  189.   '
  190.   ' EXAMPLE OF USE:  BitPut a$, bitIndex%, bit%
  191.   ' PARAMETERS:      a$         String containing the bits
  192.   '                  bitIndex%  Index to the bit of concern
  193.   '                  bit%       Value of bit (1 to set, 0 to clear)
  194.   ' VARIABLES:       bytePtr%   Pointer to the byte position in the string
  195.   '                  mask%      Bit isolation mask
  196.   '                  byteNow%   Current numeric value of string byte
  197.   ' MODULE LEVEL
  198.   '   DECLARATIONS:  DECLARE SUB BitPut (b$, bitIndex%, bit%)
  199.   '
  200.     SUB BitPut (a$, bitIndex%, bit%) STATIC
  201.         bytePtr% = bitIndex% \ 8 + 1
  202.         SELECT CASE bitIndex% MOD 8
  203.         CASE 1
  204.             mask% = 128
  205.         CASE 2
  206.             mask% = 64
  207.         CASE 3
  208.             mask% = 32
  209.         CASE 4
  210.             mask% = 16
  211.         CASE 5
  212.             mask% = 8
  213.         CASE 6
  214.             mask% = 4
  215.         CASE 7
  216.             mask% = 2
  217.         CASE 0
  218.             mask% = 1
  219.             bytePtr% = bytePtr% - 1
  220.         END SELECT
  221.         byteNow% = ASC(MID$(a$, bytePtr%, 1))
  222.         IF byteNow% AND mask% THEN
  223.             IF bit% = 0 THEN
  224.                 MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
  225.             END IF
  226.         ELSE
  227.             IF bit% THEN
  228.                 MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
  229.             END IF
  230.         END IF
  231.     END SUB
  232.  
  233.