' ' June 2023 Edition ' ' This is a QBASIC LIBRARY which can perform various calculations ' with 64-bit integers (quad words). These are 8-byte strings ' that are stored in binary format and can range in value ' from 0 to 18,446,744,073,709,551,615. Several quads can be ' joined together into a string of quads, which can be sorted. ' ' The only limitation is memory. QBasic 1.1 in DOS mode can only ' use about 32KB of memory for strings. So, that limits us to ' having only 4000 quads in a row at a time. If you need to work ' with more quad words, you'll have to rewrite the code OR try ' a different programming language such as JavaScript or Perl. ' ' Written by Zsolt N. Perry (zsnp@juno.com). ' DEFINT A-Z DECLARE SUB WELCOME () ' Shows welcome message DECLARE SUB QDEMO () ' Demonstrats the use of qword library DECLARE SUB CPRINT (S$) ' Prints a line of text (may use color) DECLARE SUB DISPLAY (LABEL$) ' Displays program comments on the screen DECLARE SUB WAITKEY (KK$) ' Waits until the user presses KK$ DECLARE SUB CENTER (ROW, S$) ' Prints something in the center of the screen DECLARE SUB ALIGNR (ROW, S$) ' Prints something to the right side of screen DECLARE SUB PAUSE () ' Waits for user to press enter DECLARE SUB PAUSESP () ' Waits for user to press space DECLARE SUB GOODBYE () ' Terminates the program DECLARE SUB SORT (S$()) ' Sort an array of strings DECLARE SUB REPCHR (S$, CC$) ' Replaces characters in a string DECLARE FUNCTION HEX2BIN$ (X$) ' Converts hexadecimal numbers to binary DECLARE FUNCTION RANDOM$ (L) ' Generates a string of random bytes DECLARE FUNCTION KNAPSACK$ (GOAL&, L$) DECLARE FUNCTION KOMB$ (KS$, L$) ' Converts indexes to number list. DECLARE FUNCTION NTH$ (N) ' Adds st, nd, rd or th to the end of a number DECLARE FUNCTION COMMIFY$ (N$) ' Converts number 54672000 -> 54,672,000 DECLARE FUNCTION STRCMP (A$, B$) ' Compares two strings DECLARE FUNCTION STRREV$ (S$) ' Reverses a string ABC -> CBA DECLARE FUNCTION VECL& (S$, N) ' Returns the Nth long from a string DECLARE FUNCTION HQ& (Q$, N) ' Returns the high 32-bits of a quad word DECLARE FUNCTION LQ& (Q$, N) ' Returns the low 32-bits of a quad word DECLARE FUNCTION STR2BIN$ (S$) ' Converts a string to a series of ones and zeros DECLARE FUNCTION STR2HEX$ (S$) ' Converts a string to hexadecimal numbers DECLARE FUNCTION HEX2STR$ (H$) ' Converts hexadecimal numbers to a string DECLARE FUNCTION RNDLIST$ (N, MIN&, MAX&) DECLARE FUNCTION SCI$ (N$) ' Converts a number to scientific notation DECLARE FUNCTION COUNT (L$, Z) ' Get number of words/dwords/qwords in a string DECLARE FUNCTION NICENUM$ (N$, ALIGN, PREC) ' Aligns a number and adds commas DECLARE FUNCTION GETW (L$, N) ' Get word from a string DECLARE FUNCTION VEC (S$, N) ' Get ASCII code from a string like ASC() DECLARE FUNCTION NULL$ (N) ' Returns N number of null characters DECLARE SUB BINFMT (A$, L) ' Formats a binary number of any size DECLARE SUB BINAND (A$, B$) ' Performs bitwise AND on a binary number DECLARE FUNCTION BINCMP (A$, B$) ' Compares two binary numbers of any size DECLARE FUNCTION BINADD$ (A$, B$) ' Adds two binary numbers of any size DECLARE FUNCTION BINDIFF$ (A$, B$) 'Returns the difference between two binary numbers DECLARE FUNCTION BINMUL$ (A$, B$) ' Multiplies two binary numbers DECLARE FUNCTION BINTEST (A$) ' Counts number of 1s and 0s in a binary number DECLARE FUNCTION BINCOUNT (A$) ' Counts number of 1s in a binary number DECLARE FUNCTION BINDIV$ (DVND$, DVSR$) ' Divides a binary number of any size DECLARE SUB WEC (LIST$, N, DATA$) ' Overwrites a string like MID$() DECLARE SUB SETQ (LIST$, N, Q$) ' Overwrites the Nth quad word in a string DECLARE SUB FIXQ (Q$) ' Fixes corrupted quad word DECLARE SUB FIXQL (L$) ' Makes sure that a qword string has the right length DECLARE SUB QSORT (Q$) ' Sorts a list of quad words DECLARE SUB QQQQ (A$, B$, N, OP) ' Performs various operations on quad words DECLARE SUB SWAPQ (Q$, N, X) ' Swaps the Nth and Xth quad words in a string DECLARE SUB PRINTQL (L$) ' Prints a list of quad words DECLARE FUNCTION QCOUNT (L$) ' Returns the number of quad words in a string DECLARE FUNCTION RANDQ$ (P) ' Returns a random quad word in base N DECLARE FUNCTION MAXQ$ (N) ' Returns the maximum value of a quad word in base N DECLARE FUNCTION GETQ$ (S$, N) ' Returns the Nth quad word from a list DECLARE FUNCTION POPQ$ (L$) ' Returns and removes the last quad word from a list DECLARE FUNCTION QCMP (A$, B$) ' Compares two quad words DECLARE FUNCTION FINDMINQ$ (Q$) ' Find smallest quad word in a list DECLARE FUNCTION FINDMAXQ$ (Q$) ' Find largest quad word in a list DECLARE FUNCTION HEX2QUAD$ (X$) ' Converts a hex. number to a quad word DECLARE FUNCTION BIN2QUAD$ (B$) ' Converts a binary number to a quad word DECLARE FUNCTION DEC2QUAD$ (N$) ' Converts a decimal number to a quad word DECLARE FUNCTION QUAD2HEX$ (Q$) ' Converts a quad word to hex. number DECLARE FUNCTION QUAD2BIN$ (Q$) ' Converts a quad word to binary number DECLARE FUNCTION QUAD2DEC$ (Q$) ' Converts a quad word to a decimal number DECLARE FUNCTION LNGQ$ (N&) ' Converts a long to a quad word DECLARE FUNCTION INTQ$ (N) ' Converts an integer to a quad word DECLARE FUNCTION RORQ$ (Q$, N) ' Rotates a quad word to the right by N bits DECLARE FUNCTION ROLQ$ (Q$, N) ' Rotates a quad word to the left by N bits DECLARE FUNCTION SHRQ$ (Q$, N) ' Shifts a quad word to the right by N bits DECLARE FUNCTION SHLQ$ (Q$, N) ' Shifts a quad word to the left by N bits DECLARE FUNCTION NOTQ$ (Q$) ' Performs Bitwise NOT on a quad word DECLARE FUNCTION XORQ$ (A$, B$) ' Performs Bitwise XOR with two quad words DECLARE FUNCTION ADDQ$ (A$, B$) ' Adds two quad words DECLARE FUNCTION DIVQ$ (A$, B$) ' Divides a quad word DECLARE FUNCTION QMUL$ (A$, B$) DECLARE FUNCTION DIFFQ$ (A$, B$) ' Subtracts a quad word DECLARE FUNCTION CMPINT (A$, B$) ' Compares two large dec/hex/bin integers DECLARE FUNCTION ADDINT$ (A$, B$) ' Adds two very large integers DECLARE FUNCTION SUBINT$ (A$, B$) ' Subtracts a large integer DECLARE FUNCTION LBIN2DEC$ (B$) ' Converts a very large binary number to decimal DECLARE FUNCTION LBIN2BIGS$ (B$) ' Converts a very large binary number to Big-endian string WELCOME QDEMO ''[KNAPSACK DEMO] ' ' [0EThe Knapsack Problem ' Let's say you have 100 random numbers ranging from 0 to 500. ' These are all integers. The same number may be repeated. ' The numbers may be all the same or may all be different. ' ' Your job is to find a combination of these numbers whose sum is 500 ' or a little under 500. The sum of the numbers you choose may not ' exceed 500. But you must come as close to 500 as possible. ' ' This QBasic program can solve this problem utilizing the quad word library. ' The [0DKNAPSACK$()] function does this. ' ' Let's watch it in action! ' ' ' ' ' ' [70 ] [70 ] '- '' DISPLAY "KNAPSACK DEMO" PRINT PRINT " Generating 80 random integers ranging from 0 to 500." PRINT L$ = RNDLIST$(80, 0, 500) ' Create 80 random numbers (0-500) FOR I = 1 TO LEN(L$) STEP 4 N& = CVL(MID$(L$, I, 4)) PRINT N&, NEXT I SOLVED$ = KNAPSACK$(500, L$) ' Solve knapsack problem PRINT PRINT " Solution: "; KOMB$(SOLVED$, L$) ' Print result PAUSE CLS CENTER 12, "Now, we will repeat this 250 times." PAUSE CLS FOR I = 1 TO 250 L$ = RNDLIST$(80, 0, 500) SOLVED$ = KNAPSACK$(500, L$) ' Solve knapsack problem PRINT KOMB$(SOLVED$, L$) ' Print result NEXT I END '''''''''''''''''''''''''''''''''''''''''''''''''' ' TODO: ' 'DELQ L$, N, L 'INSQ A$, N, B$ 'SHIFTQ$(L$) 'UNSHIFTQ L$, Q$ ' Multiplies two quad words and returns two quad words. 'FUNCTION MULQ$ (A$, B$) ' AA$ = QUAD2BIN$(A$) ' BB$ = QUAD2BIN$(B$) ' RESULT$ = BINMUL$(AA$, BB$) ' BINFMT RESULT$, 0 ' IF LEN(RESULT$) < 65 THEN ' MULQ$ = BIN2QUAD$(RESULT$) ' EXIT FUNCTION ' END IF ' BINFMT RESULT$, 128 ' AA$ = MID$(RESULT$, 1, 64) ' BB$ = MID$(RESULT$, 65, 64) ' MULQ$ = BIN2QUAD$(AA$) + BIN2QUAD$(BB$) 'END FUNCTION ' This function adds two very large positive integers in base 10. ' The integers can be hundreds of digits long. ' Returns the result as a string. FUNCTION ADDINT$ (A$, B$) LA = LEN(A$) LB = LEN(B$) IF LA > LB THEN TOP = LA ELSE TOP = LB FOR I = 1 TO TOP IF LA < 1 THEN AX = 0 ELSE AX = ASC(MID$(A$, LA, 1)) - 48: LA = LA - 1 IF LB < 1 THEN BX = 0 ELSE BX = ASC(MID$(B$, LB, 1)) - 48: LB = LB - 1 S = AX + BX + C IF S < 10 THEN C = 0 ELSE C = 1: S = S - 10 X$ = CHR$(S + 48) + X$ NEXT I IF C = 1 THEN X$ = "1" + X$ ADDINT$ = X$ END FUNCTION ' This function adds two quad words and returns the result. FUNCTION ADDQ$ (A$, B$) Q$ = "" C = 0 FOR I = 8 TO 1 STEP -1 C = C + VEC(A$, I) + VEC(B$, I) Q$ = CHR$(C AND 255) + Q$ IF C > 255 THEN C = 1 ELSE C = 0 NEXT I ADDQ$ = Q$ END FUNCTION ' This function prints something on the right side of the screen. SUB ALIGNR (ROW, S$) T$ = RTRIM$(LTRIM$(MID$(S$, 1, 78))) LOCATE ROW, 78 - LEN(T$): PRINT T$; END SUB ' Converts a string that contains a series of ones and zeros ' to a quad word string. This function ALWAYS returns an 8-byte string. FUNCTION BIN2QUAD$ (B$) Q$ = "" PWR = 1 byte = 0 FOR I = LEN(B$) TO 1 STEP -1 C = ASC(MID$(B$, I, 1)) IF C < 48 OR C > 49 THEN C = -1 ' Ignore anything that is not 1 or 0 IF C > 0 THEN IF C = 49 THEN byte = byte + PWR IF PWR < 128 THEN PWR = PWR + PWR ELSE Q$ = CHR$(byte) + Q$ ' Store byte byte = 0 PWR = 1 END IF END IF NEXT I IF PWR > 1 THEN Q$ = CHR$(byte) + Q$ ' Save remaining bits DO WHILE LEN(Q$) < 8 Q$ = CHR$(0) + Q$ LOOP BIN2QUAD$ = Q$ END FUNCTION ' This function adds two binary numbers of any size. FUNCTION BINADD$ (A$, B$) CC = 0 LA = LEN(A$) LB = LEN(B$) LL = (((LA > LB) AND LA) OR LB) + 1 SUM$ = STRING$(LL, 48) FOR I = LL TO 1 STEP -1 IF LA > 0 THEN CA = ASC(MID$(A$, LA, 1)) ELSE CA = 0 IF LB > 0 THEN CB = ASC(MID$(B$, LB, 1)) ELSE CB = 0 IF CA = 49 THEN CA = 1 ELSE CA = 0 IF CB = 49 THEN CB = 1 ELSE CB = 0 CC = CA + CB + FIX(CC / 2) MID$(SUM$, I, 1) = CHR$(48 + (CC AND 1)) LA = LA - 1 LB = LB - 1 NEXT I BINADD$ = SUM$ END FUNCTION ' This function performs bitwise AND with two binary numbers. ' The result will be stored in A$. SUB BINAND (A$, B$) BINFMT A$, 0 BINFMT B$, 0 LA = LEN(A$) LB = LEN(B$) LL = (((LA > LB) AND LA) OR LB) + 1 N$ = STRING$(LL, 48) WHILE LL > 0 IF LA > 0 THEN CA = ASC(MID$(A$, LA, 1)) ELSE CA = 0 IF LB > 0 THEN CB = ASC(MID$(B$, LB, 1)) ELSE CB = 0 IF CA = 49 THEN CA = 1 ELSE CA = 0 IF CB = 49 THEN CB = 1 ELSE CB = 0 IF CA AND CB THEN MID$(N$, LL, 1) = "1" LL = LL - 1 LA = LA - 1 LB = LB - 1 WEND A$ = N$ BINFMT A$, 0 END SUB ' This function compares two binary numbers of any size. FUNCTION BINCMP (A$, B$) BINFMT A$, 0 BINFMT B$, 0 LA = LEN(A$) LB = LEN(B$) IF LA > LB THEN BINCMP = 1: EXIT FUNCTION IF LA < LB THEN BINCMP = -1: EXIT FUNCTION FOR I = 1 TO LA DIFF = ASC(MID$(A$, I, 1)) - ASC(MID$(B$, I, 1)) IF DIFF THEN BINCMP = DIFF: EXIT FUNCTION NEXT I BINCMP = 0 END FUNCTION ' This function counts the number of 1s in a binary number. FUNCTION BINCOUNT (A$) X = 0 FOR I = 1 TO LEN(A$) IF ASC(MID$(A$, I, 1)) = 49 THEN X = X + 1 NEXT I BINCOUNT = X END FUNCTION ' This function calculates the difference between two binary numbers. FUNCTION BINDIFF$ (A$, B$) E = BINCMP(A$, B$) IF E = 0 THEN BINDIFF$ = "0": EXIT FUNCTION IF E < 0 THEN SWAP A$, B$ CC = 0 LA = LEN(A$) LB = LEN(B$) DIFF$ = "" WHILE LA > 0 OR LB > 0 CA = 0: IF LA > 0 THEN IF ASC(MID$(A$, LA, 1)) = 49 THEN CA = 1 CB = 0: IF LB > 0 THEN IF ASC(MID$(B$, LB, 1)) = 49 THEN CB = 1 CA = CA - CB - CC CC = (CA < 0) AND 1 DIFF$ = CHR$((CA AND 1) + 48) + DIFF$ LA = LA - 1 LB = LB - 1 WEND IF E < 0 THEN SWAP A$, B$ BINDIFF$ = DIFF$ END FUNCTION ' This function divides a binary number of any size. ' Returns the quotient and the remainder separated by "|" FUNCTION BINDIV$ (N$, D$) BINFMT N$, 0 BINFMT D$, 0 NX = BINTEST(N$) DX = BINTEST(D$) ' Divide by zero? IF DX = 0 THEN BINDIV$ = "|": EXIT FUNCTION ' Divide zero? IF NX = 0 THEN BINDIV$ = "0|0": EXIT FUNCTION ' The dividend and the divisor are equal? DIFF = BINCMP(N$, D$) IF DIFF = 0 THEN BINDIV$ = "1|0" EXIT FUNCTION END IF ' The dividend is smaller than the divisor? IF DIFF < 0 THEN BINDIV$ = "0|" + N$ EXIT FUNCTION END IF ' Divide by 1, 2, 4, 8, 16, etc? IF DX > 0 THEN IF DX > LEN(N$) THEN BINDIV$ = "0|" + N$ EXIT FUNCTION END IF RESULT$ = MID$(N$, 1, LEN(N$) - DX + 1) BINDIV$ = RESULT$ + "|" + MID$(N$, LEN(RESULT$) + 1) EXIT FUNCTION END IF ' Perform division. ' Calculate result one bit at a time. Q$ = "" R$ = N$ L = LEN(N$) - LEN(D$) WHILE L >= 0 DD$ = D$ + STRING$(L, 48) DIFF = BINCMP(R$, DD$) IF DIFF < 0 THEN Q$ = Q$ + "0" ELSE Q$ = Q$ + "1" R$ = BINDIFF$(R$, DD$) END IF L = L - 1 WEND BINFMT Q$, 0 BINFMT R$, 0 BINDIV$ = Q$ + "|" + R$ END FUNCTION ' This function formats a binary number by removing non-zero characters. ' If the second number is zero, it will trim zeros in front of a number. ' If the second number is any positive integer, it will return a binary ' number that is made up of exactly that many digits. If the number is ' bigger, the extra digits will be chopped off from the left. If the ' number is smaller, then zero digits will be added to the left. SUB BINFMT (A$, L) ' Find first '1' in the number. ' P = Start Pointer P = INSTR(A$, "1") IF P < 1 THEN ' Not found? They are all zeros then. IF L > 1 THEN A$ = STRING$(L, 48) ELSE A$ = "0" EXIT SUB END IF X = 0 ' Digit Pointer U = (P > 1) ' Input string contains non-digits or preceding zeros? FOR I = P TO LEN(A$) C = ASC(MID$(A$, I, 1)) IF C = 48 OR C = 49 THEN X = X + 1 IF U THEN MID$(A$, X, 1) = CHR$(C) ELSE U = 1 END IF NEXT I IF U THEN A$ = MID$(A$, 1, X) IF L > 0 THEN DIFF = L - LEN(A$) IF DIFF > 0 THEN A$ = STRING$(DIFF, 48) + A$ IF DIFF < 0 THEN A$ = MID$(A$, ABS(DIFF) + 1) END IF END SUB ' ' This function multiplies two unsigned binary integers. ' FUNCTION BINMUL$ (A$, B$) BINFMT A$, 0 BINFMT B$, 0 E1 = BINTEST(A$) E2 = BINTEST(B$) ' Multiply by zero? IF E1 = 0 OR E2 = 0 THEN BINMUL$ = "0": EXIT FUNCTION ' Multiply by 1, 2, 4, 8, 16, etc? IF E1 > 0 THEN BINMUL$ = B$ + STRING$(E1 - 1, 48): EXIT FUNCTION IF E2 > 0 THEN BINMUL$ = A$ + STRING$(E2 - 1, 48): EXIT FUNCTION LDIFF = BINCOUNT(A$) - BINCOUNT(B$) IF LDIFF > 0 THEN SWAP A$, B$ Z = 0 X$ = "0" LA = LEN(A$) LB = LEN(B$) WHILE LA > 0 C = ASC(MID$(A$, LA, 1)) IF C = 49 THEN X$ = BINADD(X$, B$ + STRING$(Z, 48)) Z = Z + 1 ELSEIF C = 48 THEN Z = Z + 1 END IF LA = LA - 1 WEND IF LDIFF > 0 THEN SWAP A$, B$ BINMUL$ = X$ END FUNCTION ' ' This function tests the value of a binary number. If it's zero, then ' it returns zero. If it's non-zero, then it returns a non-zero value. ' ' The function actually counts the number of 1s in the number, and ' if there is only one '1' digit in the number and all the rest of ' the digits are zero, then it returns the number of zeros that follow ' the number plus one. For example, "00100000" would return 6, ' because the digit '1' is followed by 5 zeros. ' ' If the number contains more than one '1' digit in it, then this ' function will return a negative count. For example, "10111100" would ' return -3, because the number ends with two '0' digits. ' FUNCTION BINTEST (A$) N = 0 ' Count number of ones in the number Z = 1 ' Count number of zeros at the end of the number + 1 FOR I = 1 TO LEN(A$) C = ASC(MID$(A$, I, 1)) IF C = 48 THEN Z = Z + 1 IF C = 49 THEN N = N + 1: Z = 1 NEXT I IF N > 1 THEN N = -Z ' The number is made up of more than one 1s. IF N = 1 THEN N = Z ' Return the number of zeros at the end + 1. BINTEST = N ' If the number is zero, then we return zero. END FUNCTION ' This function prints something in the center of the screen. SUB CENTER (ROW, S$) T$ = RTRIM$(LTRIM$(MID$(S$, 1, 80))) COL = 40 - LEN(T$) / 2 LOCATE ROW, COL: PRINT T$; END SUB ' This function compares two very large integers A$ and B$. ' Works on decimal, hexadecimal, and binary numbers! ' Returns zero if A = B ' Returns positive number if A > B ' Returns negative number if A < B FUNCTION CMPINT (A$, B$) LA = LEN(A$) LB = LEN(B$) X = LA - LB IF X = 0 THEN FOR I = 1 TO LA AX = ASC(MID$(A$, I, 1)) BX = ASC(MID$(B$, I, 1)) X = AX - BX IF X THEN EXIT FOR NEXT I END IF CMPINT = X END FUNCTION ' This function is just a shortcut for NICENUM$() which ' formats a number and is able to align a number and set precision. ' We don't do any alignment here, just insert commas, and that's all. FUNCTION COMMIFY$ (N$) COMMIFY$ = NICENUM$(N$, 0, 0) END FUNCTION ' This function counts how many bytes, words, double words or quad words ' are stored in a string. Z specifies the chunk size. So, for example, ' if you want to find how many quad words are in a string, then Z would ' have to be 8, because a quad word is made up of 8 bytes. So, you're ' looking for how many 8-byte chunks are found in the string. If a string ' contains 17 bytes, then that's 2 whole quad words plus an extra byte, ' which is counted as a whole quad word. So, this function will return 3. FUNCTION COUNT (L$, Z) L = LEN(L$) IF Z < 1 OR L = 0 THEN COUNT = 0: EXIT FUNCTION IF L > Z THEN COUNT = FIX((L + Z - 1) / Z) ELSE COUNT = 1 END FUNCTION ' This function can print some text in color. SUB CPRINT (S$) IF MID$(S$, 2, 1) = "-" THEN WAITKEY CHR$(13): CLS : EXIT SUB L = 1 PRINT " "; COLORS$ = "70" COLOR 7, 0 FOR I = 3 TO LEN(S$) C = ASC(MID$(S$, I, 1)) IF SKIP > 0 THEN COLORS$ = CHR$(C) + COLORS$ IF C = 91 THEN SKIP = 3 ' Control character IF C = 93 THEN SKIP = 1: IF LEN(COLORS$) > 2 THEN COLORS$ = MID$(COLORS$, 3) IF SKIP > 0 THEN SKIP = SKIP - 1 ELSE L = L + 1: PRINT CHR$(C); IF LEN(COLORS$) >= 2 THEN FG = INSTR("0123456789ABCDEF", MID$(COLORS$, 1, 1)) - 1 BG = INSTR("0123456789ABCDEF", MID$(COLORS$, 2, 1)) - 1 IF FG < 0 THEN FG = 7 IF BG < 0 THEN BG = 0 COLOR FG, BG END IF IF L > 77 THEN EXIT FOR NEXT I IF CSRLIN < 24 THEN PRINT END SUB FUNCTION DEC2QUAD$ (N$) ' Maybe the input is an empty string? IF LEN(N$) = 0 THEN DEC2QUAD$ = NULL$(8) ' Return a zero quad word EXIT FUNCTION END IF R$ = SCI$(N$) ' Convert this number to scientific notation. E = INSTR(R$, "E") N$ = MID$(R$, 1, E - 1) ' Extract the number E = VAL(MID$(R$, E + 1)) ' Extract the exponent ' If this is a fraction like 0.123, then we can't do it. IF E < 0 THEN DEC2QUAD$ = NULL$(8): EXIT FUNCTION ' Get rid of fractional part IF E < LEN(N$) - 2 THEN N$ = MID$(N$, 1, 2) + MID$(N$, 4, E) ' Add missing zeros IF E > LEN(N$) - 2 THEN N$ = MID$(N$, 1, 2) + MID$(N$, 4) + STRING$(E + 3 - LEN(N$), "0") ' Remember if it's a negative number NEG = ASC(MID$(N$, 1, 1)) - 43 N$ = MID$(N$, 2) IF CMPINT(N$, "18446744073709551615") > 0 THEN ' Number too big? DEC2QUAD$ = MAXQ$(256) EXIT FUNCTION END IF IF CMPINT(N$, "2147483648") < 0 THEN Q$ = LNGQ$(VAL(N$)) IF NEG > 0 THEN Q$ = NOTQ$(Q$): Q$ = ADDQ$(Q$, INTQ$(1)) DEC2QUAD$ = Q$ EXIT FUNCTION END IF PWR$ = "9223372036854775808 4611686018427387904 2305843009213693952 1152921504606846976 576460752303423488 288230376151711744 144115188075855872 72057594037927936 36028797018963968 18014398509481984 9007199254740992 4503599627370496 2251799813685248 1125899906842624 562949953421312 281474976710656 140737488355328 70368744177664 35184372088832 17592186044416 " PWR$ = PWR$ + "8796093022208 4398046511104 2199023255552 1099511627776 549755813888 274877906944 137438953472 68719476736 34359738368 17179869184 8589934592 4294967296 2147483648 1073741824 536870912 268435456 134217728 67108864 33554432 16777216 8388608 4194304 2097152 1048576 524288 262144 131072 65536 32768 16384 8192 4096 2048 1024 512 256 128 64 32 16 8 4 2 1 " B$ = "" START = 1 FOR I = 1 TO 64 PREV = START START = INSTR(START + 1, PWR$, " ") + 1 P$ = MID$(PWR$, PREV, START - PREV - 1) IF CMPINT(N$, P$) >= 0 THEN B$ = B$ + "1" N$ = SUBINT$(N$, P$) ELSE B$ = B$ + "0" END IF NEXT I Q$ = BIN2QUAD$(B$) IF MID$(B$, 1, 1) = "0" AND NEG > 0 THEN Q$ = NOTQ$(Q$): Q$ = ADDQ$(Q$, INTQ$(1)) DEC2QUAD$ = Q$ END FUNCTION ' This function subtracts quad word B$ from quad word A$ ' and returns the difference. FUNCTION DIFFQ$ (A$, B$) Q$ = "" C = 0 FOR I = 8 TO 1 STEP -1 C = (C < 0) + VEC(A$, I) - VEC(B$, I) Q$ = CHR$(C AND 255) + Q$ NEXT I DIFFQ$ = Q$ END FUNCTION ' This function will display one of the comment sections from this file. SUB DISPLAY (LABEL$) CLS LOCATE 1, 1, 0 SHOW = 0 FIND$ = "''[" + LABEL$ + "]" F = LEN(FIND$) OPEN "QLIB.BAS" FOR INPUT AS #1 DO WHILE NOT EOF(1) LINE INPUT #1, L$ IF L$ = "''" THEN SHOW = 0 IF SHOW = 1 THEN CPRINT L$ IF MID$(L$, 1, F) = FIND$ THEN SHOW = 1 LOOP CLOSE 1 END SUB ' Divides a quad word. ' Returns the quotient and the remainder separated by "|" FUNCTION DIVQ$ (A$, B$) DIVIDEND$ = QUAD2BIN$(A$) DIVISOR$ = QUAD2BIN$(B$) RESULT$ = BINDIV$(DIVIDEND$, DIVISOR$) P = INSTR(RESULT$, "|") Q$ = MID$(RESULT$, 1, P) R$ = MID$(RESULT$, P + 1) DIVQ$ = BIN2QUAD(Q$) + "|" + BIN2QUAD(R$) END FUNCTION ' This function expects a string which contains a set of 64-bit unsigned ' integers (each number taking up 8 bytes exactly) and returns ' the largest of those integers as a string. FUNCTION FINDMAXQ$ (L$) MAX$ = NULL$(8) ' Set this to the smallest value TOP = QCOUNT(L$) FOR I = 1 TO TOP N$ = GETQ$(L$, I) IF QCMP(MAX$, N$) = 2 THEN MAX$ = N$ NEXT I FINDMAXQ$ = MAX$ END FUNCTION ' This function expects a string which contains a set of 64-bit unsigned ' integers (each number taking up 8 bytes exactly) and returns ' the smallest of those integers as a string. FUNCTION FINDMINQ$ (L$) MIN$ = STRING$(8, CHR$(255)) ' Set this to the maximum value TOP = QCOUNT(L$) FOR I = 1 TO TOP N$ = GETQ$(L$, I) IF QCMP(MIN$, N$) = 1 THEN MIN$ = N$ NEXT I FINDMINQ$ = MIN$ END FUNCTION ' This function makes sure that a quad word's length is exactly 8 bytes long. SUB FIXQ (Q$) L = LEN(Q$) IF L > 8 THEN Q$ = MID$(Q$, 1, 8) ELSEIF L < 8 THEN Q$ = STRING$(8 - L, CHR$(0)) + Q$ END IF END SUB ' A string can contain a number of quad words. Each qword must ' be 8 bytes long, so the length of the list must be divisible by 8. ' If it's not, then this function fixes that. SUB FIXQL (L$) Z = LEN(L$) IF (Z AND 7) > 0 THEN W = Z AND 32760 ' Round length of list to the last whole qword. L$ = MID$(L$, 1, W) + STRING$(8 - (Z AND 7), CHR$(0)) + MID$(L$, W + 1) END IF END SUB ' This function returns the Nth qword from a string. ' A byte is 8 bits. A word is 2 bytes. A double word (dword) is ' 4 bytes, and a quad word (qword or quad) is 8 bytes. ' This function ALWAYS returns 8 bytes. FUNCTION GETQ$ (S$, N) Q$ = "" IF N > 0 THEN P = N * 8 - 7 IF LEN(S$) >= P THEN Q$ = MID$(S$, P, 8) END IF DO WHILE LEN(Q$) < 8 Q$ = Q$ + CHR$(0) LOOP GETQ$ = Q$ END FUNCTION ' This function returns the Nth word from a string. ' A byte is 8 bits. A word is 2 bytes (aka integer). ' If the pointer is out of range, then we return 0. FUNCTION GETW (L$, N) P = N * 2 - 1 IF LEN(L$) < P THEN GETW = 0 ELSE GETW = CVI(MID$(L$, P, 2) + CHR$(0)) END FUNCTION ' This function terminates the program. SUB GOODBYE SCREEN 0 WIDTH 80, 25 COLOR 7, 0 CLS LOCATE 2, 3, 1, 12, 13 PRINT "Thank you for trying this demo. Have a nice day!" SYSTEM END SUB ' Converts a series of hexadecimal numbers to binary format. FUNCTION HEX2BIN$ (X$) B$ = "" FOR I = 1 TO LEN(X$) C = INSTR("0123456789ABCDEF", UCASE$((MID$(X$, I, 1)))) IF C THEN B$ = B$ + MID$("0000000100100011010001010110011110001001101010111100110111101111", (C - 1) * 4 + 1, 4) NEXT I HEX2BIN$ = B$ END FUNCTION ' This function converts a string that contains a hexadecimal number ' to a quad word string. This function ALWAYS returns an 8-byte string. FUNCTION HEX2QUAD$ (X$) Q$ = "" PREV = -1 ' This means the first nibble comes next. FOR I = LEN(X$) TO 1 STEP -1 C = ASC(MID$(X$, I, 1)) IF C >= 48 AND C <= 57 THEN ' Digits 0-9 ? C = C - 48 ELSE C = C OR 32 IF C >= 97 AND C <= 102 THEN C = C - 87 ELSE C = -1 END IF IF C >= 0 THEN ' We ignore any non-hex digits. IF PREV < 0 THEN PREV = C ' Save low nibble. ELSE Q$ = CHR$(PREV + C * 16) + Q$ ' Store byte PREV = -1 END IF END IF NEXT I IF PREV > 0 THEN Q$ = CHR$(PREV) + Q$ ' Save last nibble DO WHILE LEN(Q$) < 8 Q$ = CHR$(0) + Q$ LOOP HEX2QUAD$ = Q$ END FUNCTION ' This function converts a series of hexadecimal numbers to a string. FUNCTION HEX2STR$ (X$) S$ = "" PREV = -1 FOR I = 1 TO LEN(X$) C = ASC(MID$(X$, I, 1)) IF C >= 48 AND C <= 57 THEN ' Digits 0-9 ? C = C - 48 ELSE C = C OR 32 IF C >= 97 AND C <= 102 THEN C = C - 87 ELSE C = -1 END IF IF C >= 0 THEN ' We ignore any non-hex digits. IF PREV < 0 THEN PREV = C ' Save high nibble. ELSE S$ = S$ + CHR$(C + PREV * 16) ' Store byte PREV = -1 END IF END IF NEXT I IF PREV >= 0 THEN S$ = S$ + CHR$(PREV * 16) HEX2STR$ = S$ END FUNCTION ' This function removes any non-hexadecimal digits from a string. SUB HEXFILTER (S$) J = 1 FOR I = 1 TO LEN(S$) C$ = MID$(S$, I, 1) N = INSTR("0123456789ABCDEFabcdef", C$) IF N > 0 THEN ' We don't copy or move any bytes unless ' we find characters that need to be removed! IF I > J THEN MID$(S$, J, 1) = C$ J = J + 1 END IF NEXT I IF I > J THEN S$ = MID$(S$, 1, J - 1) END SUB ' This function returns the high 4-bytes of the Nth quad word from a list. FUNCTION HQ& (Q$, N) IF N < 1 THEN HQ& = 0: EXIT FUNCTION L = LEN(Q$) P = (N - 1) * 8 + 1 IF P > L THEN HQ& = 0: EXIT FUNCTION HI$ = MID$(Q$, P, 4) DO WHILE LEN(HI$) < 4 HI$ = HI$ + CHR$(0) LOOP HQ& = VAL("&H" + STR2HEX$(HI$)) END FUNCTION ' This function loads an integer into a quad word string ' and returns the 8-byte string. FUNCTION INTQ$ (N) IF N < 0 THEN FILL = 255 ELSE FILL = 0 S$ = MKI$(N) Q$ = STRING$(6, CHR$(FILL)) + MID$(S$, 2, 1) + MID$(S$, 1, 1) INTQ$ = Q$ END FUNCTION ' This function takes a list of 4-byte longs packed into a string and tries ' to come up with the best combination of these integers that adds up to ' TOTAL or a number closest to TOTAL. ' This function returns a list of 4-byte integers packed into a string. ' The first of these integer will hold the highest total sum that ' we were able to reach. The rest of the integers will be indexes ' that point to the numbers in L$ which when added together ' will equal the first integer in the returned list. ' FUNCTION KNAPSACK$ (GOAL&, L$) ' First we create a copy of the input list ' and we discard values which are either too small or too large. ' We also determine the MIN and MAX values in the list. Q$ = "" ' This string will hold a list of quad words ' We will pack the numbers in the high 32 bits of the quad words, ' and we will pack the index of each number into the lower 32 bits. ' So, when we sort the quad words, each numbers will ' stay linked to its index. MIN& = &H7FFFFFFF MAX& = &H80000000 MAXPTR = 0 I = 1 ' Note: BYTEPTR will always equal: (I - 1) * 4 + 1 FOR BYTEPTR = 1 TO LEN(L$) STEP 4 N& = CVL(MID$(L$, BYTEPTR, 4)) IF N& = GOAL& THEN ' Did we find the total already? KNAPSACK$ = MKL$(GOAL&) + MKL$(I) EXIT FUNCTION END IF IF N& > 0 AND N& <= GOAL& THEN IF N& < MIN& THEN MIN& = N& IF N& > MAX& THEN MAX& = N&: MAXPTR = I ' We store the index along with the number, ' so they stay together when sorted: NUM$ = MID$(LNGQ$(N&), 5, 4) IDX$ = MID$(INTQ$(I), 5, 4) Q$ = Q$ + NUM$ + IDX$ END IF I = I + 1 NEXT BYTEPTR ALLSAME = 0 IF MIN& = MAX& THEN ' Are all the numbers the same? ALLSAME = 1 ELSE QSORT Q$ ' Sort quad words END IF ' Now Q$ holds a subset of the original numbers list in ' sorted order + their indexes. ' First we will add up all the numbers starting from the ' least to the greatest. ' X$ will hold the combination index list and the best sum so far. ' The first 4-byte LONG in X$ will be the sum we have reached so far ' by adding up various numbers. The following 4-byte chunks will ' hold the indexes to the numbers that we have added together. X$ = NULL$(4) ' Output: Combination index list XS = 0 ' Index size SUM# = 0 ' Sum of best combinations so far ALLTOTAL# = 0 ' Total of all the numbers TOP = COUNT(Q$, 8) ' How many numbers we have? FOR I = 1 TO TOP N& = HQ&(Q$, I) ' Extract number from quad word X& = LQ&(Q$, I) ' Extract index from quad word ALLTOTAL# = ALLTOTAL# + N& IF ALLTOTAL# <= GOAL& THEN SUM# = ALLTOTAL# MID$(X$, 1, 4) = MKL$(SUM#) X$ = X$ + MKL$(X&) XS = XS + 1 IF SUM# = GOAL& THEN KNAPSACK$ = X$ EXIT FUNCTION END IF END IF NEXT I ' Stop here if we were able to add up all the numbers ' OR if all the numbers are the same. IF XS = TOP OR ALLSAME THEN KNAPSACK$ = X$: EXIT FUNCTION XS = 0 ' We won't use this anymore. ' Any combination of numbers will have to get us closer to our goal. ' If not, then we fall back to what's in X$, because X$ always ' holds the best combination we have found so far. ' If the maximum value is the best so far, then save the max value. IF MAX& > SUM# THEN X$ = MKL$(MAX&) + MKL$(MAXPTR) KNAPSACK$ = X$ ' Now we will add up pairs of numbers starting with the largest first. FOR I = TOP TO 1 STEP -1 XX$ = NULL$(4) ' This will hold the combinations we come up with A& = HQ&(Q$, I) ' Extract number A from quad word AX& = LQ&(Q$, I) ' Extract A's index from quad word B& = HQ&(Q$, I - 1) ' Extract number B from quad word BX& = LQ&(Q$, I - 1) ' Extract B's index from quad word SUM# = A& + B& ' Add up the largest + the next largest number ' If SUM is still smaller than our GOAL, then we try to add as many ' consecutive large values as possible. If the sum of two large ' numbers is higher than our GOAL, then we move down ' the list and try to add smaller numbers. IF SUM# <= GOAL& THEN MID$(XX$, 1, 4) = MKL$(SUM#) XX$ = XX$ + MKL$(AX&) + MKL$(BX&) IF SUM# = GOAL& THEN KNAPSACK$ = XX$: EXIT FUNCTION ' Add up all big numbers from here on until we find one that is too big. FOR J = I - 2 TO 1 STEP -1 N& = HQ&(Q$, J) ' Grab next number NX& = LQ&(Q$, J) ' Grab number's index SUM# = SUM# + N& IF SUM# <= GOAL& THEN MID$(XX$, 1, 4) = MKL$(SUM#) XX$ = XX$ + MKL$(NX&) IF SUM# = GOAL& THEN KNAPSACK$ = XX$: EXIT FUNCTION ELSE ' Adding up as many of the biggest numbers has led us here, but now ' we can't add anymore big numbers, so let's start adding from the ' smallest ones. See, if there's anything we can still fit in here. SUM# = CVL(MID$(XX$, 1, 4)) FOR K = 1 TO J - 1 N& = HQ&(Q$, K) ' Grab next number NX& = LQ&(Q$, K) ' Grab number's index SUM# = SUM# + N& IF SUM# <= GOAL& THEN MID$(XX$, 1, 4) = MKL$(SUM#) XX$ = XX$ + MKL$(NX&) IF SUM# = GOAL& THEN KNAPSACK$ = XX$: EXIT FUNCTION ELSE SUM# = CVL(MID$(XX$, 1, 4)) EXIT FOR END IF NEXT K EXIT FOR END IF NEXT J ' If we break the record, then save the new record. BEST& = CVL(MID$(X$, 1, 4)) IF SUM# > BEST& THEN X$ = XX$ END IF NEXT I KNAPSACK$ = X$ END FUNCTION ' This function converts the return value of the ' KNAPSACK$() function to a list of additions. ' KS$ should be the solution returned by KNAPSACK$() ' and L$ should be the original list of numbers. FUNCTION KOMB$ (KS$, L$) TOP = COUNT(KS$, 4) SUM& = VECL&(KS$, 1) OUTPUT$ = LTRIM$(STR$(SUM&)) + " = " FOR I = 2 TO TOP P = VECL&(KS$, I) N& = VECL&(L$, P) OUTPUT$ = OUTPUT$ + LTRIM$(STR$(N&)) + "+" SUM& = SUM& - N& ' Verify result NEXT I OUTPUT$ = MID$(OUTPUT$, 1, LEN(OUTPUT$) - 1) 'IF TOP = 2 THEN OUTPUT$ = OUTPUT$ + " (MAXVALUE) - " + NTH$(P) + " in the list" IF SUM& THEN OUTPUT$ = OUTPUT$ + " ERROR!" KOMB$ = OUTPUT$ END FUNCTION FUNCTION LBIN2BIGS$ (B$) P = 1 C = 1 FOR I = LEN(B$) TO 1 STEP -1 C = C + 1 B = ASC(MID$(B$, I, 1)) - 48 IF B = 1 THEN S = S + P P = P + P IF C > 8 THEN X$ = CHR$(S) + X$ S = 0 C = 1 P = 1 END IF NEXT I IF C > 1 THEN X$ = CHR$(S) + X$ LBIN2BIGS$ = X$ END FUNCTION FUNCTION LBIN2DEC$ (B$) S$ = "0" ' SUM R$ = "1" ' POWERS OF TWO FOR I = LEN(B$) TO 1 STEP -1 C = ASC(MID$(B$, I, 1)) - 48 IF C = 1 THEN S$ = ADDINT$(S$, R$) R$ = ADDINT$(R$, R$) NEXT I LBIN2DEC$ = S$ END FUNCTION ' This function loads a long value into a quad word string ' and returns the 8-byte string. (The least significant bits ' will be stored at the end of the string.) FUNCTION LNGQ$ (N&) IF N& < 0 THEN FILL = 255 ELSE FILL = 0 S$ = MKL$(N&) Q$ = STRING$(4, CHR$(FILL)) + MID$(S$, 4, 1) + MID$(S$, 3, 1) + MID$(S$, 2, 1) + MID$(S$, 1, 1) LNGQ$ = Q$ END FUNCTION FUNCTION LQ& (Q$, N) IF N < 1 THEN LQ& = 0: EXIT FUNCTION L = LEN(Q$) P = (N - 1) * 8 + 5 IF P > L THEN LQ& = 0: EXIT FUNCTION LO$ = MID$(Q$, P, 4) DO WHILE LEN(LO$) < 4 LO$ = LO$ + CHR$(0) LOOP LQ& = VAL("&H" + STR2HEX$(LO$)) END FUNCTION ' This function returns the maximum value of a ' quad word in base 2, 8, 10, 16 or 256. FUNCTION MAXQ$ (N) IF N = 256 THEN MAXQ$ = STRING$(8, CHR$(255)) IF N = 16 THEN MAXQ$ = STRING$(16, "F") IF N = 10 THEN MAXQ$ = "18446744073709551615" IF N = 8 THEN MAXQ$ = "1" + STRING$(21, "7") IF N = 2 THEN MAXQ$ = STRING$(64, "1") END FUNCTION ' This function formats a decimal number for printing, ' inserting a comma after every 3rd group of numbers and ' aligning the decimal points. If several numbers are ' printed in a column, the decimal points will line up. ' ALIGN tells how many spaces to insert in front of the ' number in case it's too small. And PREC specifies how ' many digits should follow after the decimal point. FUNCTION NICENUM$ (N$, ALIGN, PREC) X$ = "" ' Copy the number into X$ (digits only) NEG = 0 ' Is it a negative number? DEC = -1 ' Remember the position of the decimal point FOR I = 1 TO LEN(N$) C = VEC(N$, I) IF DEC > 0 AND LEN(X$) - DEC > PREC THEN EXIT FOR IF C = 46 THEN IF PREC = 0 THEN EXIT FOR IF DEC < 0 THEN DEC = LEN(X$) IF DEC = 0 THEN X$ = "0." ELSE X$ = X$ + "." END IF ELSEIF C = 48 AND LEN(X$) = 0 THEN ' Skip the first zero ELSEIF C > 47 AND C < 58 THEN X$ = X$ + CHR$(C) ELSEIF C = 45 AND LEN(X$) = 0 THEN NEG = 1 END IF NEXT I IF LEN(X$) = 0 THEN X$ = "0" ' Now let's make sure that we have the right number ' of digits after the decimal point IF DEC < 0 THEN ' Was there no decimal point? DEC = LEN(X$) IF PREC > 1 THEN X$ = X$ + "." + STRING$(PREC, "0") ELSE PREC = PREC - (LEN(X$) - DEC) + 1 IF PREC > 1 THEN X$ = X$ + STRING$(PREC, "0") END IF ' Insert commas to the left of the decimal point IF DEC > 3 THEN FOR I = DEC - 3 TO 1 STEP -3 X$ = MID$(X$, 1, I) + "," + MID$(X$, I + 1) NEXT I END IF ' And finally, let's add some spaces in front of the number. IF NEG THEN X$ = "-" + X$ IF ALIGN > LEN(X$) THEN X$ = SPACE$(ALIGN - LEN(X$)) + X$ NICENUM$ = X$ END FUNCTION ' This function performs a bitwise NOT operation on a quad word ' and returns the result. FUNCTION NOTQ$ (Q$) N$ = "" FOR I = 1 TO 8 N$ = N$ + CHR$(255 - VEC(Q$, I)) NEXT I NOTQ$ = N$ END FUNCTION ' This function adds "th" ending to a number and returns a new number ' Some numbers such as 103 will get an "rd" suffix... FUNCTION NTH$ (N) NUM$ = LTRIM$(STR$(N)) IF LEN(NUM$) = 0 THEN NTH$ = "": EXIT FUNCTION LAST$ = RIGHT$(NUM$, 1) P = 7 IF LAST$ = "1" THEN P = 1 IF LAST$ = "2" THEN P = 3 IF LAST$ = "3" THEN P = 5 NTH$ = NUM$ + MID$("stndrdth", P, 2) END FUNCTION ' This function returns N number of null characters. FUNCTION NULL$ (N) NULL$ = STRING$(N, CHR$(0)) END FUNCTION SUB PAUSE COLOR 3 CENTER 23, "<<< PRESS ENTER TO CONTINUE >>>" LOCATE , , 1, 12, 13 COLOR 7 WAITKEY CHR$(13) LOCATE , , 0 CLS END SUB SUB PAUSESP COLOR 15, 4 CENTER 23, "<< Press the SPACEBAR key to continue >>" WAITKEY " " COLOR 7, 0 CLS END SUB ' This function returns the last quad word from a list ' and removes that from the list. FUNCTION POPQ$ (L$) L = LEN(L$) P = L AND &H7FF8 ' Set pointer to 8-byte boundary IF (L AND 7) > 0 THEN Q$ = MID$(L$, P + 1) L$ = MID$(L$, 1, P) Q$ = STRING$(8 - LEN(Q$), CHR$(0)) + Q$ ELSE Q$ = MID$(L$, P - 7, 8) L$ = MID$(L$, 1, P - 8) END IF POPQ$ = Q$ END FUNCTION ' This function prints a list of quad word values on the screen. ' The values are printed in hexadecimal format and decimal format. SUB PRINTQL (L$) PRINT " Quad No. Hexadecimal value"; SPACE$(9); "Unsigned integer value in base 10" PRINT STRING$(78, "-") FOR I = 1 TO QCOUNT(L$) C$ = STR$(I) IF LEN(C$) < 6 THEN C$ = SPACE$(6 - LEN(C$)) + C$ Q$ = GETQ(L$, I) PRINT C$; ". "; QUAD2HEX$(Q$); NICENUM$(QUAD2DEC$(Q$), 40, 0) NEXT I PRINT PRINT "String length ="; LEN(L$) END SUB ' Adds two quad words and stores the result in A. SUB QADD (A$, B$) QQQQ A$, B$, 8, 6 END SUB ' Performs bitwise AND on two quad words and saves the result in A$. SUB QAND (A$, B$) QQQQ A$, B$, 8, 4 END SUB ' This function clears the first quad word in a list of ' quad words and sets its value to zero. SUB QCLR (Q$) QQQQ Q$, "", 8, 0 END SUB ' This function compares two 64-bit unsigned integers and ' returns: 0 if A = B, 1 if A is greater or 2 if B is greater. FUNCTION QCMP (A$, B$) FOR I = 1 TO 8 DIFF = VEC(A$, I) - VEC(B$, I) IF DIFF > 0 THEN QCMP = 1: EXIT FUNCTION IF DIFF < 0 THEN QCMP = 2: EXIT FUNCTION NEXT I QCMP = 0 END FUNCTION ' Copies the first quad word from B$ over the first quad word of A$. SUB QCOPY (A$, B$) QQQQ A$, B$, 8, 8 END SUB ' This function counts how many quad words are stored ' in list L$ and returns an integer. FUNCTION QCOUNT (L$) QCOUNT = FIX((LEN(L$) + 7) / 8) END FUNCTION ' Decrements quad word Q$ SUB QDEC (Q$) QQQQ Q$, "", 8, 12 END SUB SUB QDEMO CLS ''[QINTRO] ' [0FHOW MUCH IS A QUINTILLION? [091,000,000] x [091,000,000] x [091,000,000 ' One million times million is a trillion, times million is a quintillion. ' When writing QBasic programs, we usually work with very limited resources, ' and numbers in the quintillion range are not something we need a lot. ' One byte is 8 bits. A word is 2 bytes, and a double word is 4 bytes. ' And usually, that's all we need. Four bytes is often what's used ' to store a file's size, memory pointers and even dates. ' However, most modern processors now work with quad words. A quad word is ' 8 bytes. A quad word can hold a value between zero and 18 quintillion. ' That's a huge number. Google Earth uses roughly 70 terabytes of data to ' store imagery. That's "just" [0E70,000,000,000,000] bytes. In contrast, the ' largest quad word is [0C18,446,744,073,709,551,615] !!! ' In QBasic 1.1, there is no builtin support for quad words, but this library ' allows you to do some basic operations with such large numbers. We store ' quad words in strings. There's nothing special about a quad word string. ' It's just a string, but its length must be 8 bytes! ' [70 ] [70 ] '- ' So, how does a number like [0F18,446,744,073,709,551,615] fit into just 8 bytes? ' As you know, a byte is 8 bits and can hold a value between 0 and 255. ' That's a total of 256 values if we count zero as the first value. ' With 16 bits, you can represent 65536 numbers. ' Each additional bit expands a number's capacity to ' 0000000[0A1] = [0A1] store values by double. And every time we add ' 000000[0A10] = [0A2] another byte, we have to multiply by 256. ' 00000011 = 3 ' 00000[0A100] = [0A4] 256 x 256 = 65536 ' 00000101 = 5 256 x 256 x 256 = 16777216 ' 00000110 = 6 256 x 256 x 256 x 256 = 4294967296 ' 00000111 = 7 ... ' 0000[0A1000] = [0A8] ' 256 x 256 x 256 x 256 x 256 x 256 x 256 x 256 = 18 quintillion ' 1 2 3 4 5 6 7 8 ' [70 ] [70 ] '- ' ' There are several ways we can store a number in memory. The simplest way ' is to save it in decimal format which is easy to read: ' Of course, we could save this number "1956" (4 bytes) ' in hexadecimal format as well, and ' then it would look like this ----------------> "7A4" (3 bytes) ' As a binary number, it would look like this --> "11110100100" (11 bytes) ' However, when a processor saves this number ' in memory, it will look like this -----------> [0D".I"] (2 bytes) ' This is because [0Dprocessors store numbers in raw binary format]. That little ' dot is character code 7, and the letter "I" next to is character code 164. ' As you can see, this raw format requires the least amount of memory to ' store the number. ' Here's how we get 1956 from characters #7 and #164: ' 164 + (7 x 256) = 1956 ' [70 ] [70 ] '- ' [0EIntel and AMD processors store the numbers in memory backwards, ' [0Eand this is called LITTLE ENDIAN FORMAT.] The opposite of that is ' called BIG ENDIAN FORMAT. Motorola processors use big endian format. ' So, what's the difference? ' Well, if a number fits into a single byte, then there's no difference. ' But see what happens if we have a big number such as 7851044: ' ' When a Motorola processor saves this forwards ' number in memory, it will look like this: "wE$" (big endian format) ' When an Intel processor saves this It's backwards! ' number in memory, it will look like this: "$Ew" (little endian format) ' ' If a number has been saved one way, and you try to read it the other way, ' you get a totally different number! 1234 and 4321 are not the same. ' [0AThis QBasic library stores quad words in [1F BIG ENDIAN ] format. So, if you ' [0Ahave a number such as 52091687, then the least significant digit (7) will ' [0Abe stored in the last byte of the quad word unlike how your Intel or AMD ' [0Aprocessor would normally store it! ' [70 ] [70 ] '- ' ' [0FLet's see what you can do with this library.] ' ' This function stores a hexadecimal value in a quad word: ' ' Q$ = [0DHEX2QUAD("03C828745CAF1FF0")] <- That's a pretty big number! ;-) ' ' R$ = [0DRANDQ$(0)] ' This creates a quad word with a random value ' X$ = [0DMAXQ$(0)] ' This creates a quad word that has max value ' Z$ = [0DNULL$(8)] ' This creates a quad word that holds zero ' Q$ = [0DADDQ$(Q$, R$)] ' This adds two quad words ' Q$ = [0DSHLQ$(Q$, 2)] ' This shifts a quad word to the Left by 2 bits ' Q$ = [0DROLQ$(Q$, 2)] ' This rotates a quad word to the Left by 2 bits ' Q$ = [0DXORQ$(Q$, R$)] ' Performs bitwise XOR on two quad words ' [0DIF QCMP(Q$, Z$) = 0 THEN] ' Compares two quad words ' ' PRINT QUAD2DEC$(Q$) <- This will print the quad word in decimal format ' PRINT QUAD2BIN$(Q$) <- This will print it in binary format ' PRINT QUAD2HEX$(Q$) <- This will print it in hexadecimal format ' PRINT Q$ <- This will print 8 binary characters ' [70 ] [70 ] '- ' ' Quad words can be joined together to form an array of quad words. ' For example, right now, we generate 10 quad words and list them using ' the [0DPRINTQL] function: ' '' DISPLAY "QINTRO" R$ = "" FOR I = 1 TO 10 R$ = R$ + RANDQ$(0) NEXT I PRINTQL R$ COLOR 14 CENTER 21, "Ok! Next, we're going to sort this list using the QSORT function." PAUSE QSORT R$ COLOR 10 CENTER 3, "The list has been sorted!!" LOCATE 5 COLOR 7 PRINTQL R$ PAUSE COLOR 14 LOCATE 2, 3: PRINT "To add a new number to the end of the list, all you have to do is write:" COLOR 13 LOCATE 3, 3: PRINT "L$ = L$ + Q$"; COLOR 14 PRINT " where L$ is the list of quad words and Q$ is the new qword." R$ = R$ + MAXQ$(256) COLOR 7 LOCATE 6 PRINTQL R$ PAUSE FOR I = 1 TO 6 COLOR 14 CENTER 2, "To return and remove the last element of a quad word list, use the" COLOR 13 LOCATE 3, 33: PRINT "POPQ$(L$)"; COLOR 14 PRINT " function." Q$ = POPQ$(R$) COLOR 7 LOCATE 6 PRINTQL R$ COLOR 12 CENTER 20, "Removed item: " + QUAD2HEX$(Q$) PAUSE NEXT I COLOR 14 CENTER 2, "To overwrite the Nth quad word in the list, use the SETQ$() function." COLOR 13 CENTER 4, "Example: SETQ$ L$, 4, HEX2QUAD$(" + CHR$(34) + "CCCCCC1111333333" + CHR$(34) + ")" COLOR 14 SETQ R$, 4, HEX2QUAD$("CCCCCC1111333333") COLOR 7 LOCATE 6, 1 PRINTQL R$ PAUSESP FOR I = 1 TO 6 COLOR 14 CENTER 2, "To swap two quad words in a list, use the SWAPQ function." COLOR 13 CENTER 4, "Example: SWAPQ L$, 1, 3" COLOR 14 SWAPQ R$, 1, 3 COLOR 7 LOCATE 6, 1 PRINTQL R$ PAUSE NEXT I COLOR 13 CENTER 2, "Let's say you want to grab the 1st quad word's high 4-bytes and display" CENTER 3, "it in scientific notation. So, you would use the HQ and SCI functions." COLOR 7 LOCATE 6, 1 PRINTQL R$ N& = HQ&(R$, 1) CENTER 15, "The hex number we grabbed is : " + HEX$(N&) CENTER 17, "In decimal format : " + COMMIFY$(STR$(N&)) + " <-- COMMIFY$() function does this" COLOR 12 CENTER 19, SCI$(STR$(N&)) + " <-- SCI$() function does this" COLOR 7 CENTER 21, "There are more functions, but this concludes our quad word demo." PAUSESP END SUB ' Increments quad word Q$ SUB QINC (Q$) QQQQ Q$, "", 8, 11 END SUB ' This function multiplies two quad words (A and B) ' and returns a 16-byte octa word result. FUNCTION QMUL$ (A$, B$) FIXQ A$ FIXQ B$ RESULT$ = NULL$(16) ' 128-BIT VALUE FOR I = 8 TO 1 STEP -1 ' MULTIPLICATION: CARRY = 0 R$ = NULL$(16 - I) FOR J = 8 TO 1 STEP -1 R& = VEC(A$, I) * VEC(B$, J) + CARRY MID$(R$, J, 1) = CHR$(R& AND 255) CARRY = FIX(R& / 256) NEXT J R$ = CHR$(CARRY) + R$ ' ADDITION: C = 0 P = LEN(RESULT$) FOR J = LEN(R$) TO 1 STEP -1 C = C + VEC(RESULT$, P) + VEC(R$, J) MID$(RESULT$, P, 1) = CHR$(C AND 255) IF C > 255 THEN C = 1 ELSE C = 0 IF P > 1 THEN P = P - 1 ELSE EXIT FOR NEXT J NEXT I QMUL$ = RESULT$ END FUNCTION ' Performs bitwise NOT. ' This function takes the first quad word in a list ' and flips each of its bits in the opposite direction. SUB QNOT (Q$) QQQQ Q$, "", 8, 5 END SUB ' Performs bitwise OR on quad words A$ and B$ and stores the result in A$. SUB QOR (A$, B$) QQQQ A$, B$, 8, 2 END SUB ' ' This function can perform various bitwise operations ' and addition and subtraction on two raw binary numbers ' of any length which are stored in big endian format. ' Since these operations involve lots of repeated lines ' of code and only differ slightly, I have decided to ' combine them into one function. So, secondary functions ' such as QADD() and QXOR() will simply call THIS function ' to perform the actual operation that's needed. ' ' How does this function work? ' ' Unless stated otherwise, this function reads input ' from A$ and B$, and stores the output value in A$. ' The first N bytes of A$ will be overwritten EVERY TIME! ' ' If A$ is shorter than N bytes, first it is expanded ' to N bytes length by adding zeros to the left side. This ' does not change the value stored in the variable, because ' it is stored in big endian format. ' ' If A$ or B$ contains a list of values and are longer than N bytes, ' the operation is only performed on the first N bytes, and the result ' is stored in the first N bytes of A$. THE REST OF BYTES REMAIN UNCHANGED! ' ' The OP argument specifies the type of operation to be performed: ' 0 = Set the value of A to zero (Example: 0000000000000000) ' 1 = Set A to the maximum value possible (Example: FFFFFFFFFFFFFFFF) ' 2 = Performs bitwise OR A = A OR B ' 3 = Performs bitwise XOR A = A XOR B ' 4 = Performs bitwise AND A = A AND B ' 5 = Performs bitwise NOT A = NOT A ' 6 = Performs addition A = A + B ' 7 = Performs subtraction A = A - B ' 8 = Simply copies the first value of B over the first value of A. ' 9 = Reverses the byte order of variable B and stores it in A ' 10 = Writes a random value into A ' 11 = Calculates A = A + 1 ' 12 = Calculates A = A - 1 ' 13 = Shifts A to the right by one bit ' 14 = Shifts A to the left by one bit ' SUB QQQQ (A$, B$, N, OP) ' Make sure that A$ is at least N bytes long. LA = LEN(A$) IF LA < N THEN A$ = STRING$(N - LA, CHR$(0)) + A$ R = 0 ' Reverse counter (only used when reversing bytes) C = 0 ' This will act both as a byte container and a carry flag IF OP = 11 THEN C = 256 IF OP = 12 THEN C = -1 FOR I = N TO 1 STEP -1 SELECT CASE OP CASE 0: C = 0 ' A = 00 CASE 1: C = 255 ' A = FF CASE 2: C = VEC(A$, I) OR VEC(B$, I) ' A = A OR B CASE 3: C = VEC(A$, I) XOR VEC(B$, I) ' A = A XOR B CASE 4: C = VEC(A$, I) AND VEC(B$, I) ' A = A AND B CASE 5: C = 255 - VEC(A$, I) ' A = NOT A CASE 6: C = VEC(A$, I) + VEC(B$, I) - (C > 255) ' A = A + B CASE 7: C = VEC(A$, I) - VEC(B$, I) + (C < 0) ' A = A - B CASE 8: C = VEC(B$, I) ' A = B CASE 9: R = R + 1: C = VEC(B$, R) ' Reverses bytes of B CASE 10: C = RND * 256 ' A = random value CASE 11: C = VEC(A$, I) - (C > 255) ' A = A + 1 CASE 12: C = VEC(A$, I) + (C < 0) ' A = A - 1 CASE 13: C = 128 * (VEC(B$, I - 1) AND 1) + FIX(VEC(B$, I) / 2) ' A = B >> 1 CASE 14: C = 2 * VEC(B$, I) - (C > 255) ' A = B << 1 END SELECT MID$(A$, I, 1) = CHR$(C AND 255) NEXT I END SUB ' This function reverses all the bits in a quad word. ' NOTE: This function does not only reverse the ' byte order but also reverses the bits!! SUB QREVBITS (Q$) R$ = STRREV$(QUAD2BIN$(Q$)) Q$ = BIN2QUAD$(R$) + MID$(Q$, 9) END SUB ' Reverses the byte order of the first quad word of Q$ ' from big endian to little endian or vice versa. SUB QREVBYTES (Q$) COPY$ = MID$(Q$, 1, 8) QQQQ Q$, COPY$, 8, 9 END SUB ' This function sorts a list of quad words using the QuickSort algorithm. ' This algorithm is originally from QSORT.BAS written by Ethan Winer. ' I modified his code so it would work with quad words. SUB QSORT (Q$) FIXQL Q$ ' Make sure the quad word set is complete. F = 1 ' FIRST L = LEN(Q$) / 8 ' LAST REDIM S((L - 2) \ 5 + 10) DO DO I = F: J = L T$ = GETQ$(Q$, (F + L) / 2) ' Copy quad word DO WHILE QCMP(GETQ$(Q$, I), T$) = 2: I = I + 1: WEND WHILE QCMP(GETQ$(Q$, J), T$) = 1: J = J - 1: WEND IF I > J THEN EXIT DO IF I < J THEN SWAPQ Q$, I, J I = I + 1 J = J - 1 LOOP WHILE I <= J IF I < L THEN S(SP) = I: S(SP + 1) = L: SP = SP + 2 L = J LOOP WHILE F < L IF SP = 0 THEN EXIT DO SP = SP - 2: F = S(SP): L = S(SP + 1) LOOP ERASE S END SUB ' Subtracts quad word B - A and stores the result in A. SUB QSUB (A$, B$) QQQQ A$, B$, 8, 7 END SUB ' Swaps the Nth and Xth quad words in a list of quad words Q$. ' The length of Q$ must be divisible by 8. SUB QSWAP (Q$, N, X) T$ = GETQ$(Q$, X) SETQ Q$, X, GETQ$(Q$, N) SETQ Q$, N, T$ END SUB ' This function converts a quad word to a 64-digit binary number. ' This function ALWAYS returns a string that is exactly 64 bytes long. FUNCTION QUAD2BIN$ (Q$) B$ = "" M$ = "0000000100100011010001010110011110001001101010111100110111101111" FOR I = 1 TO 8 N = VEC(Q$, I) B$ = B$ + MID$(M$, 1 + ((N AND 240) / 4), 4) B$ = B$ + MID$(M$, 1 + (N AND 15) * 4, 4) 'IF I < 8 THEN B$ = B$ + " " NEXT I QUAD2BIN$ = B$ END FUNCTION FUNCTION QUAD2DEC$ (Q$) ' Convert the first 6 bytes. (up to 0x1000000000000) D# = 0 PWR# = 1 FOR I = 8 TO 3 STEP -1 D# = D# + VEC(Q$, I) * PWR# PWR# = PWR# * 256 NEXT I D$ = MID$(STR$(D#), 2) 'PRINT D$ ' Convert the top 2 bytes. POWERS$ = "281474976710656 562949953421312 1125899906842624 2251799813685248 4503599627370496 9007199254740992 18014398509481984 36028797018963968 72057594037927936 144115188075855872 288230376151711744 576460752303423488 1152921504606846976 2305843009213693952 4611686018427387904 9223372036854775808" PWPTR = 1 FOR I = 2 TO 1 STEP -1 C = VEC(Q$, I) P = 1 FOR B = 1 TO 8 IF C AND P THEN D$ = ADDINT$(D$, RTRIM$(MID$(POWERS$, PWPTR, 20))) PWPTR = PWPTR + 20 P = P + P NEXT B NEXT I QUAD2DEC$ = D$ END FUNCTION ' This function converts a quad word to 16-digit hexadecimal number ' separated by 3 spaces. This function will ALWAYS return ' a string that is exactly 16 bytes long. FUNCTION QUAD2HEX$ (Q$) X$ = "" FOR I = 1 TO 8 N = VEC(Q$, I) IF N < 16 THEN X$ = X$ + "0" X$ = X$ + HEX$(N) 'IF (I AND 1) = 0 THEN X$ = X$ + " " NEXT I QUAD2HEX$ = X$ END FUNCTION ' Performs bitwise XOR on quad words A$ and B$ and stores the result in A$. SUB QXOR (A$, B$) QQQQ A$, B$, 8, 3 END SUB ' Returns N number of random letters. ' Use RANDOMIZE TIMER before calling this function. FUNCTION RANDOM$ (L) R$ = SPACE$(L) FOR I = 1 TO L MID$(R$, I) = CHR$(RND * 25 + 65) NEXT I RANDOM$ = R$ END FUNCTION ' Returns a random quad word in base N. FUNCTION RANDQ$ (N) R$ = "" MV = 333 FOR I = 1 TO 8 V = INT(RND * MV) IF V > 255 THEN V = 0 R$ = R$ + CHR$(V) MV = MV - 10 NEXT I IF N = 2 THEN R$ = QUAD2BIN$(R$) IF N = 10 THEN R$ = QUAD2DEC$(R$) IF N = 16 THEN R$ = QUAD2HEX$(R$) RANDQ$ = R$ END FUNCTION ' This function replaces every occurrance of a certain character with ' a different character. For example, you can replace every space ' in a text with an underscore by doing: REPCHR MYTEXT$, " _" SUB REPCHR (S$, CC$) IF LEN(CC$) < 2 THEN EXIT SUB FIND$ = MID$(CC$, 1, 1) REPL$ = MID$(CC$, 2, 1) FOR I = 1 TO LEN(S$) I = INSTR(S$, FIND$) IF I = 0 THEN EXIT SUB MID$(S$, I, 1) = REPL$ NEXT I END SUB ' This function generates a list of random integers and returns them in ' a string encoded in binary format (4 bytes per integer). ' N tells us how many numbers we should generate. ' The random numbers will range from MIN to MAX. FUNCTION RNDLIST$ (N, MIN&, MAX&) RANDOMIZE TIMER L$ = "" FOR I = 1 TO N R& = FIX(RND * (MAX& - MIN&)) + MIN& WEC L$, I, MKL$(R&) NEXT I RNDLIST$ = L$ END FUNCTION ' This function performs a binary operation--rotates a quad word ' to the left by N bits. Returns the new quad word. ' (Rotates to the right when N is a negative number.) FUNCTION ROLQ$ (Q$, N) N = N MOD 64 IF N = 0 THEN ROLQ$ = Q$: EXIT FUNCTION IF N < 0 THEN N = 64 + N B$ = QUAD2BIN$(Q$) ROLQ$ = BIN2QUAD$(MID$(B$, N + 1) + MID$(B$, 1, N)) END FUNCTION ' This function performs a binary operation--rotates a quad word ' to the right by N bits. Returns the new quad word. ' (Rotates to the left when N is a negative number.) FUNCTION RORQ$ (Q$, N) N = N MOD 64 IF N = 0 THEN RORQ$ = Q$: EXIT FUNCTION IF N < 0 THEN N = 64 + N B$ = QUAD2BIN$(Q$) RORQ$ = BIN2QUAD$(MID$(B$, LEN(B$) - N + 1) + MID$(B$, 1, LEN(B$) - N)) END FUNCTION ' This function converts a number to standard scientific notation. ' This function expects to receive a decimal number, ' and it returns a number in scientific notation. ' Both the input and output numbers are packaged as a string. ' If the input string had any spaces, commas or any other illegal ' characters, those are removed from the number. ' ' Example: ' ' Input: "" Output: "+0E+0" ' Input: "-20.35" Output: "-2.035E+1" ' Input: "0.000333E-12" Output: "+3.33E-16" ' Input: "000.00001000" Output: "+1E-5" ' Input: "$ 75,800.99 " Output: "+7.580099E+4" ' Input: " (12.49) abc" Output: "-1.249E+1" ' Input: " 2008300" Output: "+2.0083E+6" ' Input: ".225E+76" Output: "+2.25E+75" ' Input: "10,000,000,000,000,000,000,000,000,000,000,000,000,000" ' Output: "+1E+40" ' FUNCTION SCI$ (N$) M$ = "" ' Mantissa will be stored here E$ = "" ' Exponent will be stored here SIGN = 43 ' Is this a negative number? (43=pos 45=neg) DEC = -1 ' Remember the position of the decimal point EX = 0 ' Exponent (0=no_exp 1=exp_found 43=pos_exp 45=neg_exp) Z = -1 ' Start position of the last zero N = -1 ' Position of the first non-zero digit FOR I = 1 TO LEN(N$) C = ASC(MID$(N$, I, 1)) IF EX > 0 THEN ' PROCESS EXPONENT IF (C = 43 OR C = 45) AND EX = 1 THEN EX = C ELSEIF C > 47 AND C < 58 THEN E$ = E$ + CHR$(C) ELSEIF LEN(E$) > 0 THEN EXIT FOR ' What comes after the exponent? Nothing! END IF ELSE ' PROCESS MANTISSA IF C > 47 AND C < 58 THEN ' Digits 0-9 IF C = 48 THEN IF LEN(M$) > 0 THEN M$ = M$ + "0" ' Save '0' digit only if there are other digits in front of it IF Z < 0 THEN Z = LEN(M$) ' Remember last insignificant zero ELSE M$ = M$ + CHR$(C) ' Save digits other than zero IF N < 0 THEN N = LEN(M$) Z = -1 END IF ELSEIF C = 68 OR C = 69 OR C = 100 OR C = 101 THEN ' D/d/E/e IF LEN(M$) > 0 THEN EX = 1 ' Exponent marker found! ELSEIF C = 46 THEN IF DEC < 0 THEN IF LEN(M$) = 0 THEN M$ = "0" DEC = LEN(M$) ' Decimal point found! ELSE EXIT FOR ' Second decimal point??? END IF ELSEIF (C = 45 OR C = 40) AND LEN(M$) = 0 THEN SIGN = 45 ' It's a negative number END IF END IF NEXT I IF LEN(M$) = 0 THEN SCI$ = "+0E+0": EXIT FUNCTION ' Convert Exponent to a number for now IF EX = 0 THEN EX = 0 ELSE IF EX = 45 THEN EX = -VAL(E$) ELSE EX = VAL(E$) END IF ' Adjust exponent IF LEN(M$) > 1 THEN IF DEC = -1 THEN EX = EX + LEN(M$) - 1 ' No decimal point IF DEC >= 2 THEN EX = EX + DEC - 1 ' Yes decimal point END IF ' Remove trailing zeros IF Z > 0 THEN M$ = MID$(M$, 1, Z - 1) ' Add decimal point if possible. IF N > 1 THEN IF LEN(M$) > N THEN M$ = MID$(M$, N, 1) + "." + MID$(M$, N + 1) ELSEIF LEN(M$) = N THEN M$ = MID$(M$, N, 1) END IF EX = EX - N + 1 ELSE IF LEN(M$) > 1 THEN M$ = MID$(M$, 1, 1) + "." + MID$(M$, 2) END IF ' Convert exponent back to string E$ = MID$(STR$(EX), 2) IF EX < 0 THEN EX = 45 ELSE EX = 43 SCI$ = CHR$(SIGN) + M$ + "E" + CHR$(EX) + E$ END FUNCTION ' This function changes the Nth quad word in LIST$, ' overwriting it with the first quad word of Q$. ' If N is too big, then LIST$ will be expanded as needed. SUB SETQ (LIST$, N, Q$) IF N < 1 THEN EXIT SUB X = N * 8 L = X - LEN(LIST$) IF L > 0 THEN LIST$ = LIST$ + STRING$(L, CHR$(0)) MID$(LIST$, X - 7, 8) = MID$(Q$, 1, 8) END SUB ' This function performs a binary operation--shifts a quad word ' to the left by N bits. Returns the new quad word. ' (Shifts to the right when N is a negative number.) FUNCTION SHLQ$ (Q$, N) IF N = 0 THEN SHLQ$ = Q$: EXIT FUNCTION IF ABS(N) >= 64 THEN SHLQ$ = STRING$(8, CHR$(0)) EXIT FUNCTION END IF IF N < 0 THEN SHLQ$ = SHRQ$(Q$, ABS(N)) EXIT FUNCTION END IF B$ = QUAD2BIN$(Q$) B$ = MID$(B$, N + 1) + STRING$(N, "0") SHLQ$ = BIN2QUAD$(B$) END FUNCTION ' This function performs a binary operation--shifts a quad word ' to the right by N bits. Returns the new quad word. ' (Shifts to the left when N is a negative number.) FUNCTION SHRQ$ (Q$, N) IF N = 0 THEN SHRQ$ = Q$: EXIT FUNCTION IF ABS(N) >= 64 THEN SHRQ$ = STRING$(8, CHR$(0)) EXIT FUNCTION END IF IF N < 0 THEN SHRQ$ = SHLQ$(Q$, ABS(N)) EXIT FUNCTION END IF B$ = QUAD2BIN$(Q$) B$ = STRING$(N, "0") + MID$(B$, 1, LEN(B$) - N) SHRQ$ = BIN2QUAD$(B$) END FUNCTION ' Sorts an array of strings using the bubble sort algorithm. SUB SORT (A$()) TOP = UBOUND(A$) FOR I = TOP TO LBOUND(A$) STEP -1 FOR J = TOP TO I STEP -1 IF STRCMP(A$(I), A$(J)) > 0 THEN SWAP A$(I), A$(J) NEXT J NEXT I END SUB ' This function converts a string to a series of ones and zeros. ' Example: PRINT STR2BIN$("123") ' Outputs: 001100010011001000110011 FUNCTION STR2BIN$ (S$) B$ = STRING$(LEN(S$) * 8, "0") ' Reserve all the memory first. P = 0 FOR I = 1 TO LEN(S$) C = ASC(MID$(S$, I, 1)) M = 1 FOR J = 8 TO 1 STEP -1 IF C AND M THEN MID$(B$, P + J, 1) = "1" M = M + M NEXT J P = P + 8 NEXT I STR2BIN$ = B$ END FUNCTION ' This function converts a string to a series of hexadecimal numbers. ' Example: PRINT STR2HEX$("ABC") ' Outputs: 414243 FUNCTION STR2HEX$ (S$) X$ = STRING$(LEN(S$) * 2, "0") ' Reserve all the memory first. P = 3 FOR I = 1 TO LEN(S$) H$ = HEX$(ASC(MID$(S$, I, 1))) MID$(X$, P - LEN(H$)) = H$ P = P + 2 NEXT I STR2HEX$ = X$ END FUNCTION ' Compares string A to string B. (not case sensitive) ' Return value = 0 if A = B ' Return value > 0 if A > B ' Return value < 0 if A < B FUNCTION STRCMP (A$, B$) FOR I = 1 TO LEN(A$) + 1 IF I > LEN(A$) THEN CA = -1 ELSE CA = ASC(MID$(A$, I, 1)) IF I > LEN(B$) THEN CB = -1 ELSE CB = ASC(MID$(B$, I, 1)) IF CA < 0 AND CB >= 0 THEN STRCMP = -1: EXIT FUNCTION IF CB < 0 AND CA >= 0 THEN STRCMP = 1: EXIT FUNCTION IF CA > 64 AND CA < 91 THEN CA = CA OR 32 ' Convert to uppercase IF CB > 64 AND CB < 91 THEN CB = CB OR 32 ' Convert to uppercase DIFF = CA - CB IF DIFF THEN EXIT FOR NEXT I STRCMP = DIFF END FUNCTION ' This function reverses a string "abc" -> "cba" FUNCTION STRREV$ (S$) FOR I = 1 TO LEN(S$) X$ = MID$(S$, I, 1) + X$ NEXT I STRREV$ = X$ END FUNCTION ' Calculates the difference between two very big integers. FUNCTION SUBINT$ (A$, B$) E = CMPINT(A$, B$) IF E = 0 THEN SUBINT$ = "0": EXIT FUNCTION IF E < 0 THEN SWAP A$, B$ LA = LEN(A$) LB = LEN(B$) IF LA > LB THEN TOP = LA ELSE TOP = LB FOR I = 1 TO TOP IF LA < 1 THEN AX = 0 ELSE AX = ASC(MID$(A$, LA, 1)) - 48: LA = LA - 1 IF LB < 1 THEN BX = 0 ELSE BX = ASC(MID$(B$, LB, 1)) - 48: LB = LB - 1 S = AX - BX + C IF S < 0 THEN C = -1: S = S + 10 ELSE C = 0 X$ = CHR$(S + 48) + X$ NEXT I FOR I = 1 TO LEN(X$) IF ASC(MID$(X$, I, 1)) > 48 THEN X$ = MID$(X$, I): EXIT FOR NEXT I SUBINT$ = X$ END FUNCTION ' Swaps the Nth and Xth quad words in a list of quad words Q$. ' The length of Q$ must be divisible by 8. SUB SWAPQ (Q$, N, X) T$ = GETQ$(Q$, X) SETQ Q$, X, GETQ$(Q$, N) SETQ Q$, N, T$ END SUB ' This function grabs the Nth byte of a string and returns ' its numeric value. Returns zero if N is out of range. FUNCTION VEC (S$, N) IF LEN(S$) < N THEN VEC = 0 ELSE VEC = ASC(MID$(S$, N, 1)) END FUNCTION ' This function grabs the Nth LONG in a string and returns ' its numeric value. Returns zero if N is out of range. ' A LONG is a 32-bit integer. FUNCTION VECL& (S$, N) IF N < 1 THEN VECL& = 0: EXIT FUNCTION P = (N - 1) * 4 + 1 E = P + 3 IF LEN(S$) < P THEN VECLNG& = 0: EXIT FUNCTION IF LEN(S$) < P + 3 THEN V$ = MID$(S$, P) ELSE V$ = MID$(S$, P, 4) END IF VECL& = CVL(V$) END FUNCTION ' Wait until the KK$ key is pressed. SUB WAITKEY (KK$) K$ = "" DO UNTIL K$ = KK$ K$ = INKEY$ ' Stop program if user presses ALT+X, ALT+F4, ESC or CTRL+C. IF K$ = CHR$(27) OR K$ = CHR$(3) OR K$ = CHR$(0) + "k" OR K$ = CHR$(0) + "-" THEN GOODBYE LOOP END SUB ' This function overwrites the Nth unit in LIST$. A unit can be a byte, ' word, dword, quad word etc. The exact length of a "unit" is defined by ' the length of the DATA$ string. Here is an example: ' ' WEC LIST$, 3, "ABCD" ' ' In this case, since "ABCD" is 4 bytes long, this function overwrites ' the 3rd long in LIST$. If LIST$ was empty, then it fills up the ' first 8 bytes with null characters and copies "ABCD" after that. ' SUB WEC (LIST$, N, DATA$) L = LEN(DATA$) IF N < 1 OR L = 0 THEN EXIT SUB P = (N - 1) * L E = P + L - LEN(LIST$) IF E > 0 THEN LIST$ = LIST$ + STRING$(E, CHR$(0)) MID$(LIST$, P + 1, L) = DATA$ END SUB SUB WELCOME SCREEN 0 WIDTH 80, 25 COLOR 7, 0 CLS ALIGNR 2, "June 2023 Edition" COLOR 14 CENTER 5, "W E L C O M E" COLOR 15 CENTER 8, "This is a QBasic Library demo. This library contains some math functions," CENTER 10, "string functions, converters and a KnapSack solution finder." CENTER 12, "Written by Zsolt N. Perry . This program is FREEWARE." CENTER 14, "Feel free to copy it (or parts of it) and use it in your program." PAUSE END SUB ' This function XORs two quad words and returns the result. FUNCTION XORQ$ (A$, B$) X$ = "" FOR I = 1 TO 8 X$ = X$ + CHR$(VEC(A$, I) XOR VEC(B$, I)) NEXT I XORQ$ = X$ END FUNCTION