'===========================================================================
' Subject: FAST BIT OPERATIONS                Date: 12-20-97 (10:24)       
'  Author: Rick Elbers                        Code: QB, QBasic, PDS        
'  Origin: authentic@tip.nl                 Packet: BINARY.ABC
'===========================================================================
DEFSTR A
DEFINT B-Z

'This librarie is offering really fast bitoperations for signed
'integers with the use of assembly language and 32 bit instructions.

'In general they are between 10 and 40 times faster as there
'QBASIC eguivalents..


DECLARE SUB DEMO ()
DECLARE FUNCTION BIT$ ()           'DECIMAL TO BINARY FOR LONGS
DECLARE FUNCTION BITREAD$ ()       'READS A BIT OF
DECLARE FUNCTION BITSET$ ()        'SETS A BIT OF
DECLARE FUNCTION BITUNSET$ ()      'UNSETS A BIT
DECLARE FUNCTION BITREVERSE$ ()    'REVERSE A BIT
DECLARE FUNCTION BSR$ ()           'RETURNS HIGHEST BIT SET
DECLARE FUNCTION BSF$ ()           'RETURNS LOWEST BIT SET
DECLARE FUNCTION BITSHIFTR$ ()     'SHIFT BITS TO THE RIGHT
DECLARE FUNCTION BITSHIFTL$ ()     'SHIFT BITS TO THE LEFT
DECLARE FUNCTION BITROTATER$ ()    'ROTATE BITS TO THE RIGHT
DECLARE FUNCTION BITROTATEL$ ()    'ROTATE BITS TO THE LEFT

'16 BIT COMPLEMENTS OF THE ABOVE 32 BIT FUNCTIONS WHICH ARE EVEN FASTER....!

DECLARE SUB DEMO16 ()
DECLARE FUNCTION BIT16$ ()         'DECIMAL TO BINARY FOR INTEGERS
DECLARE FUNCTION BITREAD16$ ()     'READS A BIT OF
DECLARE FUNCTION BITSET16$ ()      'SETS A BIT OF
DECLARE FUNCTION BITUNSET16$ ()    'UNSETS A BIT OF
DECLARE FUNCTION BITREVERSE16$ ()  'REVERSE A BIT OF
DECLARE FUNCTION BSF16$ ()         'RETURNS LOWEST BIT SET
DECLARE FUNCTION BSR16$ ()         'RETURNS HIGHEST BIT SET
DECLARE FUNCTION BITSHIFTL16$ ()   'SHIFT BITS TO THE LEFT
DECLARE FUNCTION BITSHIFTR16$ ()   'SHIFT BITS TO THE RIGHT
DECLARE FUNCTION BITROTATER16$ ()  'ROTATE BITS TO THE RIGHT
DECLARE FUNCTION BITROTATEL16$ ()  'ROTATE BITS TO THE LEFT
SCREEN 0, 3, 3: SCREEN 0, 2, 2: SCREEN 0, 1, 1: SCREEN 0, 0, 0

CALL DEMO
CALL DEMO16

END


END

DEFSTR B-Z
FUNCTION BIT
'-----------------------------------------------------------
'STACKPASSING : VALUE&,BITS$
'IN           : VALUE= LONG INTEGER VALUE TO REPRESENT
'OUT          : BITS$= BINARY STRING REPRESENTATION OF LONG
'-----------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
ASM = ASM + CHR$(&H6)                            'PUSH ES
'STRING TO ES[DI]
ASM = ASM + CHR$(&HE)                            'PUSH CS
ASM = ASM + CHR$(&H7)                            'POP ES
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&H7F) + CHR$(2)    'MOV DI,[BX+2]
'GET DWORD TO CHECK INTO EDX
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H17) 'MOV EDX,[BX]  GET DWORD
ASM = ASM + CHR$(&HB9) + MKI$(&H20)              'MOV CX,&H20 BITCOUNTER
ASM = ASM + CHR$(&HFC)                           'CLD
'BIT TEST:
ASM = ASM + CHR$(&H31) + CHR$(&HC0)              'XOR AX,AX BITSSTRING
ASM = ASM + CHR$(&H66) + CHR$(&HD1) + CHR$(&HE2) 'SHL EDX,1
ASM = ASM + CHR$(&H14) + CHR$(&H30)              'ADC AL,30
ASM = ASM + CHR$(&HAA)                           'STOSB
ASM = ASM + CHR$(&H49)                           'DEC CX   MORE TO TEST ?
ASM = ASM + CHR$(&H75) + CHR$(&HF5)              'JNZ BIT TEST
'RETURN TO QBASIC.
ASM = ASM + CHR$(&H7)                            'POP ES
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BIT = ASM

END FUNCTION

FUNCTION BIT16
'--------------------------------------------------------------
'STACKPASSING : VALUE%,BITS$
'IN           : VALUE= INTEGER VALUE TO REPRESENT
'OUT          : BITS$= BINARY STRING REPRESENTATION OF INTEGER
'--------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
ASM = ASM + CHR$(&H6)                            'PUSH ES
'STRING TO ES[DI]
ASM = ASM + CHR$(&HE)                            'PUSH CS
ASM = ASM + CHR$(&H7)                            'POP ES
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&H7F) + CHR$(2)    'MOV DI,[BX+2]
'GET WORD TO CHECK INTO DX
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H17)              'MOV DX,[BX]  GET WORD
ASM = ASM + CHR$(&HB9) + MKI$(&H10)              'MOV CX,&H10 BITCOUNTER
ASM = ASM + CHR$(&HFC)                           'CLD
'BIT TEST:
ASM = ASM + CHR$(&H31) + CHR$(&HC0)              'XOR AX,AX BITSSTRING
ASM = ASM + CHR$(&HD1) + CHR$(&HE2)              'SHL DX,1
ASM = ASM + CHR$(&H14) + CHR$(&H30)              'ADC AL,30
ASM = ASM + CHR$(&HAA)                           'STOSB
ASM = ASM + CHR$(&H49)                           'DEC CX   MORE TO TEST ?
ASM = ASM + CHR$(&H75) + CHR$(&HF5)              'JNZ BIT TEST
'RETURN TO QBASIC.
ASM = ASM + CHR$(&H7)                            'POP ES
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BIT16 = ASM

END FUNCTION

FUNCTION BITREAD
'--------------------------------------------------------
'STACKPASSING : VALUE&,BIT2READ%
'IN           : VALUE= LONG VALUE TO READ FROM
'             : BIT2READ= BIT TO READ
'OUT          : BIT2READ =1 FOR BIT SET
'             : BIT2READ= 0 FOR BIT NOT SET
'--------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get dword to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H5)  'MOV EAX,[DI]  GET DWORD
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE8) 'SHR EAX,CL
ASM = ASM + CHR$(&H25) + CHR$(&H1) + CHR$(&H0)   'AND AX,1  RETURN 1 FOR SET
'Return the bit
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITREAD = ASM

END FUNCTION

FUNCTION BITREAD16
'--------------------------------------------------------
'STACKPASSING : VALUE%,BIT2READ%
'IN           : VALUE= INTEGER TO READ FROM
'             : BIT2READ= BIT TO READ
'OUT          : BIT2READ =1 FOR BIT SET
'             : BIT2READ= 0 FOR BIT NOT SET
'16 BIT VERSION
'--------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Load word in ax
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H5)               'MOV AX,[DI] GET SWORD
'Read it
ASM = ASM + CHR$(&HD3) + CHR$(&HE8)              'SHR AX,CL
ASM = ASM + CHR$(&H25) + CHR$(&H1) + CHR$(&H0)   'AND AX,1  RETURN 1 FOR SET
'Return the bit
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITREAD16 = ASM

END FUNCTION

FUNCTION BITREVERSE
'---------------------------------------------------------------
'STACKPASSING : VALUE&,BIT2REVERSE%
'IN           : VALUE= LONG VALUE TO REVERSE BIT OFF
'             : BIT2REVERSE= BIT TO SET
'OUT          : VALUE WITH BIT REVERSED
'---------------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'GET DWORD IN EAX AND BITNR IN CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H5)  'MOV EAX,[DI] EAX=DWORD
'REVERSE THE BIT AND RETURN NEW VALUE
ASM = ASM + CHR$(&H66) + CHR$(&HBA) + MKL$(1)    'MOV EDX,1
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE2) 'SHL EDX,CL DX=VALUE BITSET
ASM = ASM + CHR$(&H66) + CHR$(&H33) + CHR$(&HC2) 'XOR EAX,EDX REVERSE BIT IN DWORD
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H5)  'MOV [DI],EAX
'AND RETURN TO QBASIC
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITREVERSE = ASM

END FUNCTION

FUNCTION BITREVERSE16
'--------------------------------------------------------
'STACKPASSING : VALUE%,BIT2REVERSE%
'IN           : VALUE= INTEGER TO REVERSE BIT OFF
'             : BIT2REVERSE= BIT TO REVERSE
'OUT          : VALUE WITH BIT REVERSED
'16 BIT VERSION
'--------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'GET WORD TO REVERSE IN AX AND BITNR IN CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] GET BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08] PTR TO LONG
ASM = ASM + CHR$(&H8B) + CHR$(&H5)               'MOV AX,[DI]GET WORD POINTED TO
'REVERSE THE BIT AND RETURN NEW VALUE
ASM = ASM + CHR$(&HBA) + MKI$(1)                 'MOV DX,1
ASM = ASM + CHR$(&HD3) + CHR$(&HE2)              'SHL DX,CL DX=WORD WITH BITSET
ASM = ASM + CHR$(&H31) + CHR$(&HD0)              'XOR AX,DX
ASM = ASM + CHR$(&H89) + CHR$(&H5)               'MOV [DI],AX
'RETURN TO QBASIC
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITREVERSE16 = ASM

END FUNCTION

FUNCTION BITROTATEL
'------------------------------------------------------------
'STACKPASSING : VALUE &,BITS2ROTATE%
'IN           : VALUE= LONG VALUE TO ROTATE
'             : BITS2ROTATE= NR OF BITS TO ROTATE TO THE LEFT
'OUT          : VALUE& =VALUE WITH BITS ROTATED TO THE LEFT
'Useful for unpacking data.
'Note: For reusability the rotate cl,n instruction is used.
'The rotate cl,immed instruction is cheaper.
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get dword to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX] GET Dword
'ROL and return the valuE
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HC0) 'ROL EAX,CL
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H7)  'MOV [BX],EAX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITROTATEL = ASM

END FUNCTION

FUNCTION BITROTATEL16
'------------------------------------------------------------
'STACKPASSING : VALUE%,BITS2ROTATE%
'IN           : VALUE= INTEGER VALUE TO ROTATE
'             : BITS2ROTATE= NR OF BITS TO ROTATE TO THE LEFT
'OUT          : VALUE% =VALUE WITH BITS ROTATED TO THE LEFT
'Useful for unpacking data.
'Note: For reusability the rotate cl,n instruction is used.
'The rotate cl,immed instruction is cheaper.
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get word to check into ax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H7)               'MOV AX,[BX] GET WORD
'ROL and return the valuE                  
ASM = ASM + CHR$(&HD3) + CHR$(&HC0)              'ROL AX,CL
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITROTATEL16 = ASM

END FUNCTION

FUNCTION BITROTATER
'------------------------------------------------------------
'STACKPASSING : VALUE &,BITS2ROTATE%
'IN           : VALUE= LONG VALUE TO ROTATE
'             : BITS2ROTATE= NR OF BITS TO ROTATE TO THE RIGHT
'OUT          : VALUE& =VALUE WITH BITS ROTATED TO THE RIGHT
'Useful for unpacking data.
'Note: For reusability the rotate cl,n instruction is used.
'The rotate cl,immed instruction is cheaper.
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get dword to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX] GET Dword
'ROR and return the valuE
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HC8) 'ROR EAX,CL
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H7)  'MOV [BX],EAX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITROTATER$ = ASM

END FUNCTION

FUNCTION BITROTATER16
'------------------------------------------------------------
'STACKPASSING : VALUE%,BITS2ROTATE%
'IN           : VALUE= INTEGER VALUE TO ROTATE
'             : BITS2ROTATE= NR OF BITS TO ROTATE TO THE RIGHT
'OUT          : VALUE% =VALUE WITH BITS ROTATED TO THE RIGHT
'Useful for unpacking data.
'Note: For reusability the rotate cl,n instruction is used.
'The rotate cl,immed instruction is cheaper.
'16 BITVERSION
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get word to check into ax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H7)               'MOV AX,[BX] GET WORD
'ROR and return the valuE
ASM = ASM + CHR$(&HD3) + CHR$(&HC8)              'ROR AX,CL
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITROTATER16 = ASM


END FUNCTION

FUNCTION BITSET
'--------------------------------------------------------
'STACKPASSING : VALUE&,BIT2SET%
'IN           : VALUE= LONG VALUE TO SET BIT OFF
'             : BIT2SET= BIT TO SET
'OUT          : VALUE = VALUE WITH BIT SET
'--------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'GET DWORD IN EAX AND BITNR IN CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H5)  'MOV EAX,[DI] EAX=DWORD
'SET THE BIT AND RETURN NEW VALUE
ASM = ASM + CHR$(&H66) + CHR$(&HBA) + MKL$(1)    'MOV EDX,1
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE2) 'SHL EDX,CL DX=VALUE BITSET
ASM = ASM + CHR$(&H66) + CHR$(&HB) + CHR$(&HC2)  'OR EAX,EDX SET BIT IN DWORD
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H5)  'MOV [DI],EAX
'RETURN TO QBASIC
ASM = ASM + CHR$(&H8B) + CHR$(&HE5)              'MOV SP,BP
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSET = ASM

END FUNCTION

FUNCTION BITSET16
'--------------------------------------------------------
'STACKPASSING : VALUE%,BIT2SET%
'IN           : VALUE= INTEGER TO SET BIT OFF
'             : BIT2READ= BIT TO SET
'OUT          : VALUE WITH BIT SET
'16 BIT VERSION
'--------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'GET WORD IN AX AND BITNR IN CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] GET BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08] PTR TO INTEGER
ASM = ASM + CHR$(&H8B) + CHR$(&H5)               'MOV AX,[DI]GET WORD POINTED TO
'SET THE BIT AND RETURN THE NEW VALUE
ASM = ASM + CHR$(&HBA) + MKI$(1)                 'MOV DX,1
ASM = ASM + CHR$(&HD3) + CHR$(&HE2)              'SHL DX,CL DX=WORD WITH BITSET
ASM = ASM + CHR$(&H9) + CHR$(&HD0)               'OR AX,DX
ASM = ASM + CHR$(&H89) + CHR$(&H5)               'MOV [DI],AX
'RETURN TO QBASIC
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSET16 = ASM

END FUNCTION

FUNCTION BITSHIFTL
'----------------------------------------------------------
'STACKPASSING : VALUE&,BITS2SHIFT%
'IN           : VALUE= LONG VALUE TO READ FROM
'             : BITS2SHIFT= NR OF BITS TO SHIFT TO THE LEFT
'OUT          : VALUE& =VALUE WITH BITS SHIFTED TO THE LEFT
'----------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get Dword to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX] GET Dword
'Shl and return the value
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE0) 'SHL EAX,CL
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H7)  'MOV [BX],EAX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSHIFTL$ = ASM

END FUNCTION

FUNCTION BITSHIFTL16
'----------------------------------------------------------
'STACKPASSING : VALUE%,BITS2SHIFT%
'IN           : VALUE= INTEGER TO SHIFT TO LEFT
'             : BITS2SHIFT= NR OF BITS TO SHIFT TO THE LEFT
'OUT          : VALUE% =VALUE WITH BITS SHIFTED TO THE LEFT
'----------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] BITCOUNTER
'Get word to check into ax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H7)               'MOV AX,[BX] GET WORD
'Shl and return the valuE
ASM = ASM + CHR$(&HD3) + CHR$(&HE0)              'SHL AX,CL
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSHIFTL16 = ASM

END FUNCTION

FUNCTION BITSHIFTR
'------------------------------------------------------------
'STACKPASSING : VALUE &,BITS2SHIFT%
'IN           : VALUE= LONG VALUE TO SHIFT
'             : BITS2SHIFT= NR OF BITS TO SHIFT TO THE RIGHT
'OUT          : VALUE& =VALUE WITH BITS SHIFTED TO THE RIGHT
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX]
'Get Dword to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX] GET Dword
'SHR and return the value
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE8) 'SHR EAX,CL
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H7)  'MOV [BX],EAX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSHIFTR = ASM

END FUNCTION

FUNCTION BITSHIFTR16
'------------------------------------------------------------
'STACKPASSING : VALUE%,BITS2SHIFT%
'IN           : VALUE= INTEGER TO SHIFT
'             : BITS2SHIFT= NR OF BITS TO SHIFT TO THE RIGHT
'OUT          : VALUE% =VALUE WITH BITS SHIFTED TO THE RIGHT
'------------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get bit to read into CL
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] GET BITCOUNTER
'Get word to check into ax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H7)               'MOV AX,[BX] GET WORD
'SHR and return the valuE
ASM = ASM + CHR$(&HD3) + CHR$(&HE8)              'SHR AX,CL
ASM = ASM + CHR$(&H89) + CHR$(&H7)               'MOV [BX],AX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITSHIFTR16 = ASM

END FUNCTION

FUNCTION BITUNSET
'------------------------------------------------------------
'STACKPASSING : VALUE&,BIT2UNSET%
'IN           : VALUE= LONG VALUE TO UNSET BIT OFF
'             : BIT2UNSET= BIT TO SET
'OUT          : VALUE WITH BIT UNSET
'------------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP

ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H5)  'MOV EAX,[DI] EAX=DWORD
ASM = ASM + CHR$(&H66) + CHR$(&HBA) + MKL$(1)    'MOV EDX,1
ASM = ASM + CHR$(&H66) + CHR$(&HD3) + CHR$(&HE2) 'SHL EDX,CL DX=VALUE BITSET
ASM = ASM + CHR$(&H66) + CHR$(&HF7) + CHR$(&HD2) 'NOT EDX   VALUE BIT UNSET
ASM = ASM + CHR$(&H66) + CHR$(&H23) + CHR$(&HC2) 'AND EAX,EDX UNSET BIT IN DWORD
ASM = ASM + CHR$(&H66) + CHR$(&H89) + CHR$(&H5)  'MOV [DI],EAX
'RETURN TO QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITUNSET = ASM

END FUNCTION

FUNCTION BITUNSET16
'--------------------------------------------------------
'STACKPASSING : VALUE%,BIT2UNSET%
'IN           : VALUE= INTEGER TO UNSET BIT OFF
'             : BIT2UNSET= BIT TO UNSET
'OUT          : VALUE WITH BIT UNSET
'16 BIT VERSION
'--------------------------------------------------------
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP

ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H8B) + CHR$(&HF)               'MOV CX,[BX] GET BIT2SET
ASM = ASM + CHR$(&H8B) + CHR$(&H7E) + CHR$(&H8)  'MOV DI,[BP+08] PTR TO LONG
ASM = ASM + CHR$(&H8B) + CHR$(&H5)               'MOV AX,[DI]GET WORD POINTED TO
'SET IT AND RETURN IT
ASM = ASM + CHR$(&HBA) + MKI$(1)                 'MOV DX,1
ASM = ASM + CHR$(&HD3) + CHR$(&HE2)              'SHL DX,CL   VALUE BIT SET
ASM = ASM + CHR$(&HF7) + CHR$(&HD2)              'NOT DX      VALUE BIT UNSET
ASM = ASM + CHR$(&H21) + CHR$(&HD0)              'AND AX,DX  WORD WITH BIT UNSET
ASM = ASM + CHR$(&H89) + CHR$(&H5)               'MOV [DI],AX
'RETURN TO QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BITUNSET16 = ASM

END FUNCTION

FUNCTION BSF
'--------------------------------------------------------
'STACKPASSING : VALUE&,LOWSET%
'IN           : VALUE= LONG VALUE TO READ FROM
'OUT          : LOWSET =LOWEST BIT SET OR 32(NO BIT SET)
'--------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get word to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX]  get Dword
ASM = ASM + CHR$(&HB9) + MKI$(&H20)              'MOV CX,&H20 BITCOUNTER
'BIT TEST:
ASM = ASM + CHR$(&H66) + CHR$(&HD1) + CHR$(&HE8) 'SHR EAX,1
ASM = ASM + CHR$(&H72) + CHR$(&H3)               'JC DONE  IS BIT SET ?
ASM = ASM + CHR$(&H49)                           'DEC CX   MORE TO TEST ?
ASM = ASM + CHR$(&H75) + CHR$(&HF8)              'JNZ BIT TEST
'Return the bitNR         
ASM = ASM + CHR$(&HF7) + CHR$(&HD1)              'NOT CX
ASM = ASM + CHR$(&H83) + CHR$(&HC1) + CHR$(&H21) 'ADD CX,&H21
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H89) + CHR$(&HF)               'MOV [BX],CX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BSF = ASM

END FUNCTION

FUNCTION BSF16
'--------------------------------------------------------
'STACKPASSING : VALUE%,LOWSET%
'IN           : VALUE= INTEGER TO READ FROM
'OUT          : LOWSET =LOWEST BIT SET OR 16(NO BIT SET)
'--------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get word to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV AX,[BX]  GET WORD
ASM = ASM + CHR$(&HB9) + MKI$(&H10)              'MOV CX,&H10 BITCOUNTER
'BIT TEST:
ASM = ASM + CHR$(&HD1) + CHR$(&HE8)              'SHR AX,1
ASM = ASM + CHR$(&H72) + CHR$(&H3)               'JC DONE  IS BIT SET ?
ASM = ASM + CHR$(&H49)                           'DEC CX   MORE TO TEST ?
ASM = ASM + CHR$(&H75) + CHR$(&HF9)              'JNZ BIT TEST
'Return the bitNR         
ASM = ASM + CHR$(&HF7) + CHR$(&HD1)              'NOT CX
ASM = ASM + CHR$(&H83) + CHR$(&HC1) + CHR$(&H11) 'ADD CX,&H11
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H89) + CHR$(&HF)               'MOV [BX],CX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BSF16 = ASM

END FUNCTION

FUNCTION BSR
'--------------------------------------------------------
'STACKPASSING : VALUE&,HIGHSET%
'IN           : VALUE= LONG VALUE TO READ FROM
'OUT          : HIGHSET =HIGHEST BIT SET OR -1(NO BIT SET)
'--------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get word to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H66) + CHR$(&H8B) + CHR$(&H7)  'MOV EAX,[BX]  GET Dword
ASM = ASM + CHR$(&HB9) + MKI$(&H1F)              'MOV CX,1F  BIT TO TEST
'BIT TEST:
ASM = ASM + CHR$(&H66) + CHR$(&HD1) + CHR$(&HE0) 'SHL EAX,1
ASM = ASM + CHR$(&H72) + CHR$(&H3)               'JC DONE  IS BIT SET ?
ASM = ASM + CHR$(&H49)                           'DEC CX   ANOTHER ONE ?
ASM = ASM + CHR$(&H79) + CHR$(&HF8)              'JNS NO ? NEXT BIT TEST
'Return the bitNR
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H89) + CHR$(&HF)               'MOV [BX],CX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BSR = ASM

END FUNCTION

FUNCTION BSR16
'--------------------------------------------------------
'STACKPASSING : VALUE%,HIGHSET%
'IN           : VALUE= INTEGER TO READ FROM
'OUT          : HIGHSET =HIGHEST BIT SET OR -1(NO BIT SET)
'--------------------------------------------------------
ASM = ""
ASM = ASM + CHR$(&H55)                           'PUSH BP
ASM = ASM + CHR$(&H89) + CHR$(&HE5)              'MOV BP,SP
'Get word to check into eax
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)  'MOV BX,[BP+08]
ASM = ASM + CHR$(&H8B) + CHR$(&H7)               'MOV AX,[BX]  GET WORD
ASM = ASM + CHR$(&HB9) + MKI$(&HF)               'MOV CX,F  BIT TO TEST
'BIT TEST:
ASM = ASM + CHR$(&HD1) + CHR$(&HE0)              'SHL AX,1
ASM = ASM + CHR$(&H72) + CHR$(&H3)               'JC DONE  IS BIT SET ?
ASM = ASM + CHR$(&H49)                           'DEC CX   ANOTHER ONE ?
ASM = ASM + CHR$(&H79) + CHR$(&HF9)              'JNS NO ? NEXT BIT TEST
'Return the bitNR
ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)  'MOV BX,[BP+06]
ASM = ASM + CHR$(&H89) + CHR$(&HF)               'MOV [BX],CX
'Return to QBASIC.
ASM = ASM + CHR$(&H5D)                           'POP BP
ASM = ASM + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)   'RETF 4

BSR16 = ASM

END FUNCTION

DEFINT B-Z
SUB DEMO
'All basic demonstration of bitoperations and in the process of PCOPY,
'processing of a chain of keypresses, and some 32 bit programming too.

'GET KEYBOARD EMPTY VALUE

DEF SEG = &H40: EMPTY% = PEEK(&H1A): DEF SEG

'INITIALIZE ALL BITFUNCTIONS

ABITSTRING = BIT$: ABITREAD = BITREAD$: ABITREVERSE = BITREVERSE:
ABITSET = BITSET$: ABITUNSET = BITUNSET$: ARSHIFT = BITSHIFTR$
ABITROR = BITROTATER$: ABITROL = BITROTATEL$
ALSHIFT = BITSHIFTL$: ABSR = BSR$: ABSF = BSF$: BITP$ = SPACE$(32)
STRINGSEG = VARSEG(ABSF): DEF SEG = STRINGSEG: CLS

'LETS DO SOMETHING:

PRINT "GIVE ME PLEASE A LONG VALUE TO OPERATE UPON( IN HEXADECIMAL) ";
COLOR 0, 7: DO UNTIL a$ <> "": INPUT a$: LOOP: COLOR 7, 0
TESTVALUE& = VAL("&H" + LEFT$(a$, 8)): VALUE& = TESTVALUE&
CLS : PRINT "DEMONSTRATION OF BITFUNCTIONS WITH VALUE(HEX) :"; : COLOR 0, 7:
PRINT HEX$(TESTVALUE&); : COLOR 7, 0:

PRINT "BINARY REPRESENTATION OF TESTVALUE :";
CALL absolute(TESTVALUE&, BITP$, SADD(ABITSTRING)):
COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT STRING$(80, "_")

'LETS DO SOMETHING INTERESTING ...
PCOPY 0, 2: PCOPY 3, 0:
COLOR 0, 7: PRINT "BELOW IS THE MENU FOR THIS DEMONSTRATION OF BITOPERATIONS... "
COLOR 7, 0: PRINT
COLOR O, 7: PRINT "F1   +NR"; : COLOR 7, 0: PRINT " READS BIT NR FROM VALUE"
COLOR O, 7: PRINT "F2   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR SET"
COLOR O, 7: PRINT "F3   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR UNSET"
COLOR O, 7: PRINT "F4   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR REVERSED"
COLOR O, 7: PRINT "F5   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR SHIFT TO THE LEFT"
COLOR O, 7: PRINT "F6   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR SHIFT TO THE RIGHT"
COLOR O, 7: PRINT "F7   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR ROTATED TO THE LEFT"
COLOR O, 7: PRINT "F8   +NR"; : COLOR 7, 0: PRINT " RETURNS VALUE WITH BIT NR ROTATED TO THE RIGHT"
COLOR O, 7: PRINT "F9      "; : COLOR 7, 0: PRINT " RETURNS THE HIGHEST BIT SET IN VALUE"
COLOR O, 7: PRINT "F10     "; : COLOR 7, 0: PRINT " RETURNS THE LOWEST BIT SET IN VALUE"
COLOR O, 7: PRINT "F11     "; : COLOR 7, 0: PRINT " RETURNS HEXADECIMAL REPRESENTATION OF VALUE"
COLOR O, 7: PRINT "F12     "; : COLOR 7, 0: PRINT " RESETS THE VALUE"
PRINT
COLOR O, 7: PRINT "1       "; : COLOR 7, 0: PRINT " DISPLAYS THIS MENU AGAIN"
COLOR O, 7: PRINT "ESC     "; : COLOR 7, 0: PRINT " ENDS DEMONSTRATION"
PRINT
PRINT "BITNUMBERS ARE GIVEN AS TWO DECIMAL NORMAL KEYBOARD NUMBERS LIKE '08' OR '30'"
PRINT "ONLY NUMBERS FROM THE NORMAL( NOT EXTENDED) KEYBOARD ARE PROCESSED.."
PRINT
PRINT "< Press a key for start of bitoperations demo..>"
SLEEP
PCOPY 0, 3                          'SAVE MENU TO PAGE 3
PCOPY 2, 0                          'RETURN EXECUTE SCREEN FROM PAGE 2
KEY ON
KEY 1, "READ": KEY 2, "SET": KEY 3, "UNSET": KEY 4, "REVERS": KEY 5, "SHL":
KEY 6, "SHR": KEY 7, "ROL": KEY 8, "ROR": KEY 9, "BSR": KEY 10, "BSF"

VIEW PRINT 4 TO 24

'KEYPROCESSING GOES HERE...
DEF SEG = &H40: POKE &H1C, EMPTY    'A GOOD START:EMPTY KEYBUFFER...

DO                                  'OUTER LOOP
  CLINE = CSRLIN                    'GETCURSORPOS (NOT CHEAP)
  SLEEP                             'GET FIRST KEYPRESS
  FIRSTKEY = INP(&H60) AND &H7F     'READ OUT SCANCODE FOR KEY
  DEF SEG = &H40: POKE &H1C, EMPTY  'EMPTY KEYBUFFER.
 
  DEF SEG = STRINGSEG               'SEGMENT OF OUR ASSEMBLY ROUTINES
  
  SELECT CASE FIRSTKEY
 
  CASE 2                            '1=MENU DISPLAY
  PCOPY 0, 2                        'SAVE EXECUTE SCREEN TO PAGE 2
  PCOPY 3, 0                        'RETURN MENU FROM PAGE 3
  SLEEP
  PCOPY 2, 0:                       'RETURN EXECUTE MENU FROM PAGE 2
  LOCATE CLINE, 1                   'AND RESET THE CURSOR
 
  CASE 67                           'F9=HIGHEST BIT SET
  CALL absolute(VALUE&, bitnumber, SADD(ABSR$))
  LOCATE CLINE, 1: PRINT "HIGHEST BIT SET WAS" + SPACE$(16) + ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT
 
  CASE 68                           'F10=LOWEST BIT SET
  CALL absolute(VALUE&, bitnumber, SADD(ABSF$))
  LOCATE CLINE, 1: PRINT "LOWEST BIT SET WAS" + SPACE$(17) + ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT
 
  CASE 87                           'F11=HEXADECIMAL REPRESENTATION
  LOCATE CLINE, 1: PRINT "HEXADECIMAL REPRESENTATION" + SPACE$(9) + ":";
  COLOR 0, 7: PRINT " " + HEX$(VALUE&) + " "; : COLOR 7, 0: PRINT :
 
  CASE 88                           'F12=RESET VALUE
  VALUE& = TESTVALUE&
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE RESETTED TO" + SPACE$(18) + ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 58 TO 66                     'F1..F8=NEED TWO MORE KEY'S .......
  KEYS$ = ""                        'NONE AT THE MOMENT
  PRINT "GIVE BITNUMBER: ..";
  SLEEP                             'GIVE ANOTHER KEY PLEASE..
  SECONDKEY = (INP(&H60) AND &H7F) - 1
  DEF SEG = &H40: POKE &H1C, EMPTY
  SECONDKEY = SECONDKEY MOD 10: KEYS$ = RIGHT$(STR$(SECONDKEY), 1)
  LOCATE CLINE, 17: COLOR 0, 7: PRINT KEYS$ + ".";
 
  bitnumber = 10 * SECONDKEY
  SLEEP                             'AND A THIRD KEY..
  THIRDKEY = (INP(&H60) AND &H7F) - 1
  THIRDKEY = THIRDKEY MOD 10
  bitnumber = (bitnumber + THIRDKEY) MOD 32
  KEYS$ = KEYS$ + RIGHT$(STR$(THIRDKEY), 1)
  DEF SEG = &H40: POKE &H1C, EMPTY: DEF SEG = STRINGSEG
  
  LOCATE CLINE, 17: PRINT KEYS$; : COLOR 7, 0
                 
  SELECT CASE FIRSTKEY
 
  CASE 59                           'F1=READ BIT
  CALL absolute(VALUE&, bitnumber, SADD(ABITREAD))
  LOCATE CLINE, 1: PRINT "READ BIT NUMBER " + SPACE$(17) + KEYS$; ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT :
 
  CASE 60                           'F2=SETBIT
  CALL absolute(VALUE&, bitnumber, SADD(ABITSET))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SET BIT NUMBER       "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :
 
  CASE 61                           'F3=UNSET BIT
  CALL absolute(VALUE&, bitnumber, SADD(ABITUNSET))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER UNSET BIT NUMBER     "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT

  CASE 62                           'F4=REVERSE BIT
  CALL absolute(VALUE&, bitnumber, SADD(ABITREVERSE))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER REVERSED BIT NUMBER  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 63                           'F5=SHIFT LEFT
  CALL absolute(VALUE&, bitnumber, SADD(ALSHIFT))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SHIFTED TO THE LEFT  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :
 
  CASE 64                           'F6=SHIFT RIGHT
  CALL absolute(VALUE&, bitnumber, SADD(ARSHIFT))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SHIFTED TO THE RIGHT "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :
 
  CASE 65                           'F7=ROTATE LEFT
  CALL absolute(VALUE&, bitnumber, SADD(ABITROL))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER ROTATED TO THE LEFT  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 66                           'F8=ROTATE RIGHT
  CALL absolute(VALUE&, bitnumber, SADD(ABITROR))
  CALL absolute(VALUE&, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER ROTATED TO THE RIGHT "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :
 
  END SELECT     'NO SECOND AND THIRDKEYS FOR BITNUMBERS ANYMORE

END SELECT       'NO FIRSTKEYS FOR BITFUNCTIONS ANYMORE..

LOOP UNTIL FIRSTKEY = 1     'NO DEMONSTRATIONS ANYMORE AFTER ESCAPISM...

VIEW PRINT: CLS :
PRINT "Press a key for Integer bitoperations demonstration": SLEEP

END SUB

SUB DEMO16

'All basic demonstration of bitoperations and in the process of PCOPY,
'processing of a chain of keypresses for integers

'GET KEYBOARD EMPTY VALUE AND EMPTY INPUT FROM BEFORE...

DEF SEG = &H40: EMPTY% = PEEK(&H1A): POKE &H1C, EMPTY%: DEF SEG

'INITIALIZE ALL BITFUNCTIONS

ABITSTRING = BIT16$: ABITREAD = BITREAD16$: ABITREVERSE = BITREVERSE16$:
ABITSET = BITSET16$: ABITUNSET = BITUNSET16$: ARSHIFT = BITSHIFTR16$
ABITROR = BITROTATER16$: ABITROL = BITROTATEL16$
ALSHIFT = BITSHIFTL16$: ABSR = BSR16$: ABSF = BSF16$: BITP$ = SPACE$(16)
STRINGSEG = VARSEG(ABSF16): DEF SEG = STRINGSEG: CLS :

'LETS DO SOMETHING:

PRINT "GIVE ME PLEASE AN INTEGER VALUE TO OPERATE UPON( IN HEXADECIMAL) ";
COLOR 0, 7: DO UNTIL a$ <> "": INPUT a$: LOOP: COLOR 7, 0
TESTVALUE% = VAL("&H" + LEFT$(a$, 4)): VALUE% = TESTVALUE%
CLS : PRINT "DEMONSTRATION OF BITFUNCTIONS WITH VALUE(HEX) :"; : COLOR 0, 7:
PRINT HEX$(TESTVALUE%); : COLOR 7, 0:

PRINT "BINARY REPRESENTATION OF TESTVALUE :";
CALL absolute(TESTVALUE%, BITP$, SADD(ABITSTRING)):
COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT STRING$(80, "_")

'LETS DO SOMETHING INTERESTING ...
CLINE = CSRLIN                    'GET CURSORLINE
PCOPY 0, 2                        'SAVE EXECUTE SCREEN TO PAGE 2
PCOPY 3, 0                        'RETURN MENU FROM PAGE 3
SLEEP
PCOPY 2, 0:                       'RETURN EXECUTE MENU FROM PAGE 2
LOCATE CLINE, 1                   'AND RESET THE CURSOR

KEY ON
KEY 1, "READ": KEY 2, "SET": KEY 3, "UNSET": KEY 4, "REVERS": KEY 5, "SHL":
KEY 6, "SHR": KEY 7, "ROL": KEY 8, "ROR": KEY 9, "BSR": KEY 10, "BSF"

VIEW PRINT 4 TO 24

'KEYPROCESSING GOES HERE...
DEF SEG = &H40: POKE &H1C, EMPTY    'A GOOD START:EMPTY KEYBUFFER...

DO                                  'OUTER LOOP
  CLINE = CSRLIN                    'GETCURSORPOS (NOT CHEAP)
  SLEEP                             'GET FIRST KEYPRESS
  FIRSTKEY = INP(&H60) AND &H7F     'READ OUT SCANCODE FOR KEY
  DEF SEG = &H40: POKE &H1C, EMPTY  'EMPTY KEYBUFFER.
 
  DEF SEG = STRINGSEG               'SEGMENT OF OUR ASSEMBLY ROUTINES
  
  SELECT CASE FIRSTKEY
 
  CASE 2                            '1=MENU DISPLAY
  PCOPY 0, 2                        'SAVE EXECUTE SCREEN TO PAGE 2
  PCOPY 3, 0                        'RETURN MENU FROM PAGE 3
  SLEEP
  PCOPY 2, 0:                       'RETURN EXECUTE MENU FROM PAGE 2
  LOCATE CLINE, 1                   'AND RESET THE CURSOR
 
  CASE 67                           'F9=HIGHEST BIT SET
  CALL absolute(VALUE, bitnumber, SADD(ABSR$))
  LOCATE CLINE, 1: PRINT "HIGHEST BIT SET WAS" + SPACE$(16) + ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT

  CASE 68                           'F10=LOWEST BIT SET
  CALL absolute(VALUE, bitnumber, SADD(ABSF$))
  LOCATE CLINE, 1: PRINT "LOWEST BIT SET WAS" + SPACE$(17) + ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT

  CASE 87                           'F11=HEXADECIMAL REPRESENTATION
  LOCATE CLINE, 1: PRINT "HEXADECIMAL REPRESENTATION" + SPACE$(9) + ":";
  COLOR 0, 7: PRINT " " + HEX$(VALUE) + " "; : COLOR 7, 0: PRINT :

  CASE 88                           'F12=RESET VALUE
  VALUE = TESTVALUE
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE RESETTED TO" + SPACE$(18) + ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 58 TO 66                     'F1..F8=NEED TWO MORE KEY'S .......
  KEYS$ = ""                        'NONE AT THE MOMENT
  PRINT "GIVE BITNUMBER: ..";
  SLEEP                             'GIVE ANOTHER KEY PLEASE..
  SECONDKEY = (INP(&H60) AND &H7F) - 1
  DEF SEG = &H40: POKE &H1C, EMPTY
  SECONDKEY = SECONDKEY MOD 10: KEYS$ = RIGHT$(STR$(SECONDKEY), 1)
  LOCATE CLINE, 17: COLOR 0, 7: PRINT KEYS$ + ".";
 
  bitnumber = 10 * SECONDKEY
  SLEEP                             'AND A THIRD KEY..
  THIRDKEY = (INP(&H60) AND &H7F) - 1
  THIRDKEY = THIRDKEY MOD 10
  bitnumber = (bitnumber + THIRDKEY) MOD 31
  KEYS$ = KEYS$ + RIGHT$(STR$(THIRDKEY), 1)
  DEF SEG = &H40: POKE &H1C, EMPTY: DEF SEG = STRINGSEG
  
  LOCATE CLINE, 17: PRINT KEYS$; : COLOR 7, 0
                 
  SELECT CASE FIRSTKEY
 
  CASE 59                           'F1=READ BIT
  CALL absolute(VALUE, bitnumber, SADD(ABITREAD))
  LOCATE CLINE, 1: PRINT "READ BIT NUMBER " + SPACE$(17) + KEYS$; ":";
  COLOR 0, 7: PRINT bitnumber; : COLOR 7, 0: PRINT :

  CASE 60                           'F2=SETBIT
  CALL absolute(VALUE, bitnumber, SADD(ABITSET))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SET BIT NUMBER       "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 61                           'F3=UNSET BIT
  CALL absolute(VALUE, bitnumber, SADD(ABITUNSET))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER UNSET BIT NUMBER     "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT

  CASE 62                           'F4=REVERSE BIT
  CALL absolute(VALUE, bitnumber, SADD(ABITREVERSE))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER REVERSED BIT NUMBER  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 63                           'F5=SHIFT LEFT
  CALL absolute(VALUE, bitnumber, SADD(ALSHIFT))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SHIFTED TO THE LEFT  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 64                           'F6=SHIFT RIGHT
  CALL absolute(VALUE, bitnumber, SADD(ARSHIFT))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER SHIFTED TO THE RIGHT "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 65                           'F7=ROTATE LEFT
  CALL absolute(VALUE, bitnumber, SADD(ABITROL))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER ROTATED TO THE LEFT  "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  CASE 66                           'F8=ROTATE RIGHT
  CALL absolute(VALUE, bitnumber, SADD(ABITROR))
  CALL absolute(VALUE, BITP$, SADD(ABITSTRING))
  LOCATE CLINE, 1: PRINT "VALUE AFTER ROTATED TO THE RIGHT "; KEYS$; ":";
  COLOR 0, 7: PRINT " " + BITP$ + " "; : COLOR 7, 0: PRINT :

  END SELECT     'NO SECOND AND THIRDKEYS FOR BITNUMBERS ANYMORE

END SELECT       'NO FIRSTKEYS FOR BITFUNCTIONS ANYMORE..

LOOP UNTIL FIRSTKEY = 1     'NO DEMONSTRATIONS ANYMORE AFTER ESCAPISM...

END SUB