home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 1.ddi / BITS.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  7.7 KB  |  232 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.   ' Functions
  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.   ' **  Name:          Bin2BinStr$                **
  62.   ' **  Type:          Function                   **
  63.   ' **  Module:        BITS.BAS                   **
  64.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  65.   ' ************************************************
  66.   '
  67.   ' Returns a string of sixteen "0" and "1" characters
  68.   ' that represent the binary value of b%.
  69.   '
  70.   ' EXAMPLE OF USE:  PRINT Bin2BinStr$(b%)
  71.   ' PARAMETERS:      b%         Integer number
  72.   ' VARIABLES:       t$         Working string space for forming binary string
  73.   '                  b%         Integer number
  74.   '                  mask%      Bit isolation mask
  75.   '                  i%         Looping index
  76.   ' MODULE LEVEL
  77.   '   DECLARATIONS:  DECLARE FUNCTION Bin2BinStr$ (b%)
  78.   '
  79.     FUNCTION Bin2BinStr$ (b%) STATIC
  80.         t$ = STRING$(16, "0")
  81.         IF b% THEN
  82.             IF b% < 0 THEN
  83.                 MID$(t$, 1, 1) = "1"
  84.             END IF
  85.             mask% = &H4000
  86.             FOR i% = 2 TO 16
  87.                 IF b% AND mask% THEN
  88.                     MID$(t$, i%, 1) = "1"
  89.                 END IF
  90.                 mask% = mask% \ 2
  91.             NEXT i%
  92.         END IF
  93.         Bin2BinStr$ = t$
  94.     END FUNCTION
  95.  
  96.   ' ************************************************
  97.   ' **  Name:          BinStr2Bin%                **
  98.   ' **  Type:          Function                   **
  99.   ' **  Module:        BITS.BAS                   **
  100.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  101.   ' ************************************************
  102.   '
  103.   ' Returns the integer represented by a string of up
  104.   ' to 16 "0" and "1" characters.
  105.   '
  106.   ' EXAMPLE OF USE:  PRINT BinStr2Bin%(b$)
  107.   ' PARAMETERS:      b$         Binary representation string
  108.   ' VARIABLES:       bin%       Working variable for finding value
  109.   '                  t$         Working copy of b$
  110.   '                  mask%      Bit mask for forming value
  111.   '                  i%         Looping index
  112.   ' MODULE LEVEL
  113.   '   DECLARATIONS:  DECLARE FUNCTION BinStr2Bin% (b$)
  114.   '
  115.     FUNCTION BinStr2Bin% (b$) STATIC
  116.         bin% = 0
  117.         t$ = RIGHT$(STRING$(16, "0") + b$, 16)
  118.         IF LEFT$(t$, 1) = "1" THEN
  119.             bin% = &H8000
  120.         END IF
  121.         mask% = &H4000
  122.         FOR i% = 2 TO 16
  123.             IF MID$(t$, i%, 1) = "1" THEN
  124.                 bin% = bin% OR mask%
  125.             END IF
  126.             mask% = mask% \ 2
  127.         NEXT i%
  128.         BinStr2Bin% = bin%
  129.     END FUNCTION
  130.  
  131.   ' ************************************************
  132.   ' **  Name:          BitGet                     **
  133.   ' **  Type:          Subprogram                 **
  134.   ' **  Module:        BITS.BAS                   **
  135.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  136.   ' ************************************************
  137.   '
  138.   ' Extracts the bit at bitIndex% into a$ and returns
  139.   ' either 0 or 1 in bit%.  The value of bitIndex%
  140.   ' can range from 1 to 8 * LEN(a$).
  141.   '
  142.   ' EXAMPLE OF USE:  BitGet a$, bitIndex%, bit%
  143.   ' PARAMETERS:      a$         String where bit is stored
  144.   '                  bitIndex%  Bit position in string
  145.   '                  bit%       Extracted bit value, 0 or 1
  146.   ' VARIABLES:       byte%      Byte location in string of the bit
  147.   '                  mask%      Bit isolation mask for given bit
  148.   ' MODULE LEVEL
  149.   '   DECLARATIONS:  DECLARE SUB BitGet (a$, bitIndex%, bit%)
  150.   '
  151.     SUB BitGet (a$, bitIndex%, bit%) STATIC
  152.         byte% = (bitIndex% - 1) \ 8 + 1
  153.         SELECT CASE bitIndex% MOD 8
  154.         CASE 1
  155.             mask% = 128
  156.         CASE 2
  157.             mask% = 64
  158.         CASE 3
  159.             mask% = 32
  160.         CASE 4
  161.             mask% = 16
  162.         CASE 5
  163.             mask% = 8
  164.         CASE 6
  165.             mask% = 4
  166.         CASE 7
  167.             mask% = 2
  168.         CASE 0
  169.             mask% = 1
  170.         END SELECT
  171.         IF ASC(MID$(a$, byte%, 1)) AND mask% THEN
  172.             bit% = 1
  173.         ELSE
  174.             bit% = 0
  175.         END IF
  176.     END SUB
  177.  
  178.   ' ************************************************
  179.   ' **  Name:          BitPut                     **
  180.   ' **  Type:          Subprogram                 **
  181.   ' **  Module:        BITS.BAS                   **
  182.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  183.   ' ************************************************
  184.   '
  185.   ' If bit% is non-zero, then the bit at bitIndex% into
  186.   ' a$ is set to 1; otherwise, it's set to 0. The value
  187.   ' of bitIndex% can range from 1 to 8 * LEN(a$).
  188.   '
  189.   ' EXAMPLE OF USE:  BitPut a$, bitIndex%, bit%
  190.   ' PARAMETERS:      a$         String containing the bits
  191.   '                  bitIndex%  Index to the bit of concern
  192.   '                  bit%       Value of bit (1 to set, 0 to clear)
  193.   ' VARIABLES:       bytePtr%   Pointer to the byte position in the string
  194.   '                  mask%      Bit isolation mask
  195.   '                  byteNow%   Current numeric value of string byte
  196.   ' MODULE LEVEL
  197.   '   DECLARATIONS:  DECLARE SUB BitPut (b$, bitIndex%, bit%)
  198.   '
  199.     SUB BitPut (a$, bitIndex%, bit%) STATIC
  200.         bytePtr% = bitIndex% \ 8 + 1
  201.         SELECT CASE bitIndex% MOD 8
  202.         CASE 1
  203.             mask% = 128
  204.         CASE 2
  205.             mask% = 64
  206.         CASE 3
  207.             mask% = 32
  208.         CASE 4
  209.             mask% = 16
  210.         CASE 5
  211.             mask% = 8
  212.         CASE 6
  213.             mask% = 4
  214.         CASE 7
  215.             mask% = 2
  216.         CASE 0
  217.             mask% = 1
  218.             bytePtr% = bytePtr% - 1
  219.         END SELECT
  220.         byteNow% = ASC(MID$(a$, bytePtr%, 1))
  221.         IF byteNow% AND mask% THEN
  222.             IF bit% = 0 THEN
  223.                 MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
  224.             END IF
  225.         ELSE
  226.             IF bit% THEN
  227.                 MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
  228.             END IF
  229.         END IF
  230.     END SUB
  231.  
  232.