Listing of file='CONVRT.BAS;01' on disk='vmedia/chip_22-sector.ccvf'
9 REM Set colors. 10 PLOT 6,6 18 19 REM Regular character height. Flag bit off. Scroll mode. Erase screen. 20 PLOT 15,29,27,11,12 29 30 PRINT "BASE ARITHMETIC "; 39 40 PLOT 23:PRINT "BY DAVID B. SUITS "; 41 REM General Studies 42 REM Rochester Institute of Technology 43 REM Rochester, NY 14623 44 50 PLOT 19:PRINT "(JULY, 12 A.L.)" 59 60 REM 61 REM NS( )...Number Stack. Each time a number is found in 62 REM input string, it is pushed onto this stack. 63 REM NP......Number stack Pointer. Points to most recent 64 REM entry to Number Stack. 65 REM OS$( )..Operator Stack. Operators from input 66 REM string are pushed onto this stack. 67 REM OP......Operator stack Pointer. 68 REM S( )....Strengths of operators, where the indices are 69 REM determined by subtracting 40 from the ASCII 70 REM values of the operators. Thus: 71 REM 72 REM OPERATOR ASCII S(i) STRENGTH 73 REM ( 40 0 0 74 REM xxx xxx 1 xxx 75 REM * 42 2 3 76 REM + 43 3 1 77 REM xxx xxx 4 xxx 78 REM - 45 5 2 79 REM xxx xxx 6 xxx 80 REM / 47 7 4 81 REM 82 REM BP......Buffer Pointer. Points to position in input 83 REM string of character being scanned. 84 REM C$......Present Character being scanned. 85 REM U$......Unary operator (+ or -). If there is no 86 REM unary operator to apply, then U$="!". 87 REM E.......Error flag (see subroutine at 1400) in case 88 REM a numerical expression contains an invalid 89 REM character. 90 REM B.......Base 2, 8, 10 or 16 of a number in the input 91 REM expression. 92 REM BASE....BASE 2, 8, 10 or 16 of the final, evaluated 93 REM expression. 94 REM L.......Length of input string. 95 REM 96 99 REM Clear some string space 100 CLEAR 100 108 109 REM Limit of 64 operators and 64 numbers. Surely that's sufficient! 110 DIM OS$(64),NS(64) 118 119 REM Set strengths of operators 120 FOR J= 0TO 7:READ S(J):NEXT :DATA 0,0,3,1,0,2,0,4 127 128 REM String of zeros for pretty-printing the output. 129 REM Hexadecimal string used when changing bases. 130 Z$= "0000000":HX$= "0123456789ABCDEF" 137 138 139 140 PRINT :PRINT "INSTRUCTIONS:":PRINT 149 150 PRINT " SPECIFY THE BASE FOR THE FINAL, EVALUATED EXPRESSION." 160 PRINT " FOLLOW THAT WITH A SEMICOLON ';'." 170 PRINT " USE (, ), +, -, * AND / AS USUAL, BUT PRECEDE EACH" 180 PRINT " NUMBER WITH ITS BASE CODE SYMBOL (DEFAULT=DECIMAL). E.G.:" 190 PRINT 200 PRINT " H; 3 + (B110 * H-D)" 210 PRINT 220 PRINT " WILL YIELD THE HEX EQUIVALENT OF DECIMAL 3 PLUS THE" 230 PRINT " PRODUCT OF BINARY 110 TIMES NEGATIVE HEX D." 240 PRINT 250 PRINT " IF THERE IS NOTHING AFTER THE SEMICOLON, THE RESULTS OF" 260 PRINT " THE PREVIOUS INPUT WILL BE CONVERTED TO THE DESIRED BASE." 270 PRINT :PRINT " INTEGERS ONLY, PLEASE." 279 280 PRINT :PLOT 18:PRINT "BASE CODE SYMBOLS:":PRINT 289 290 PRINT "B = BINARY O OR Q = OCTAL D = DECIMAL (DEFAULT) H = HEX" 297 298 REM Each input starts here. 299 REM Zero the Buffer & stack Pointers. Set Error flag=0. 300 BP= 0:NP= 0:OP= 0:U$= "!":E= 0 309 310 PRINT :PLOT 21:PRINT ">";:PLOT 18:INPUT "";I$:L= LEN (I$) 320 GOSUB 1300:IF C$= ";"THEN BASE= 10:GOTO 420 330 IF C$= "H"THEN BASE= 16:GOTO 400 340 IF C$= "D"THEN BASE= 10:GOTO 400 350 IF C$= "O"OR C$= "Q"THEN BASE= 8:GOTO 400 360 IF C$= "B"THEN BASE= 2:GOTO 400 368 369 REM No base code symbol found & not default, so Error. 370 GOTO 1700 397 398 REM If end of input has been reached at this point, 399 REM then there's an Error. 400 IF BP= LTHEN BP= BP+ 1:GOTO 1710 409 410 GOSUB 1300:IF C$< > ";"THEN 1710 417 418 REM If end of input string has been reached after the ';' 419 REM then give results of last evaluation but in new base 420 IF BP= LTHEN NP= 1:GOTO 800 427 428 REM Now that we have the output base code symbol (or 429 REM default to decimal), parse the rest of the expression. 430 IF BP= LTHEN 800:REM All done! 438 439 REM Check for Unary operator + or - for default=decimal. 440 GOSUB 1300:IF C$= "+"OR C$= "-"THEN U$= C$:B= 10:GOTO 550 448 449 REM If no base code symbol, then assume decimal. 450 IF C$= > "0"AND C$< = "9"THEN B= 10:GOTO 550 458 459 REM There must be either "(" or base code symbol. 460 IF C$= "B"THEN B= 2:GOTO 520 470 IF C$= "O"OR C$= "Q"THEN B= 8:GOTO 520 480 IF C$= "D"THEN B= 10:GOTO 520 490 IF C$= "H"THEN B= 16:GOTO 520 500 IF C$= "("THEN OP= OP+ 1:OS$(OP)= C$:GOTO 430:REM Push "(" onto stack. 508 509 REM Error! 510 GOTO 1700 517 518 REM If end of expression is reached then user did not 519 REM enter a number. 520 IF BP= LTHEN BP= BP+ 1:GOTO 1720 528 529 REM Check for Unary operator. 530 GOSUB 1300:IF C$= "+"OR C$= "-"THEN U$= C$:GOTO 520 538 539 REM Check for invalid character. 540 IF C$< "0"OR (C$> "9"AND (C$< "A"OR C$> "F"))THEN 1720 548 549 REM Get the number one character at a time & store as N$ 550 N$= "" 560 N$= N$+ C$:IF BP= LTHEN GOSUB 1400:GOTO 800 570 GOSUB 1300:IF C$= > "0"AND (C$< = "9"OR (C$= > "A"AND C$< = "F"))THEN 560 577 578 REM Convert the number (now held as N$) into decimal and 579 REM push it onto the Number Stack. 580 GOSUB 1400:IF ETHEN 1740:REM E<>0 if there's an Error. 590 IF C$< > ")"THEN 640 597 598 REM ")" is scanned, so until Operator Stack is empty 599 REM or has "(", apply last operator to top 2 numbers. 600 IF OP> 0AND OS$(OP)< > "("THEN GOSUB 1600:GOTO 600 608 609 REM If top of Operator Stack has "(", then pop it off. 610 IF OS$(OP)= "("THEN OP= OP- 1 620 IF BP= LTHEN 800 630 GOSUB 1300:GOTO 590 637 638 REM Now we're expecting an operator. 640 IF C$< > "/"AND C$< > "*"AND C$< > "+"AND C$< > "-"THEN 1730 650 IF OP= 0THEN 690 658 659 REM Get strength of operator on top of Stack. 660 S1= S(ASC (OS$(OP))- 40) 668 669 REM Get strength of operator being scanned. 670 S2= S(ASC (C$)- 40) 676 677 REM If strength of S1 => strength of S2 then apply 678 REM operator on Stack to top 2 numbers on Number Stack 679 REM before pushing new operator onto Operator Stack. 680 IF S1= > S2THEN GOSUB 1600:GOTO 650 690 OP= OP+ 1:OS$(OP)= C$ 698 699 REM Now go back for another number. 700 GOTO 430 797 798 REM Print out the final expression. 799 REM First check for Errors. 800 IF ETHEN 1740:REM E<>0 if there's an Error. 808 809 REM Pop any "(" off Operator Stack. 810 IF OS$(OP)= "("THEN OP= OP- 1:GOTO 810 820 IF NP= 0THEN BP= BP+ 1:GOTO 1720 827 828 REM If there's still an operator but only one number, 829 REM then there's an Error. 830 IF NP= 1AND OP= 1THEN BP= BP+ 1:GOTO 1720 837 838 REM While there are operators left, apply them in turn 839 REM to the top 2 numbers on the Number Stack 840 IF OP> 0THEN GOSUB 1600:GOTO 800 847 848 REM Get the absolute value of the number on the Number 849 REM Stack. Use the STR$ function to avoid round-off errors. 850 N= VAL (STR$ (ABS (NS(1)))) 858 859 REM Now convert the number to desired output base. 860 R$= "" 870 A= INT (N/ BASE) 880 R= N- A* BASE:R$= MID$ (HX$,R+ 1,1)+ R$:IF A> 0THEN N= A:GOTO 870 908 909 REM Format and print out the result. 910 PLOT 22:ON INT (BASE/ 5)+ 1GOSUB 960,1000,1040,1050 920 IF NS(1)< 0THEN R$= "- "+ R$ 930 PLOT 19:PRINT R$ 937 938 REM If ABS(number) > 65535, it will not format 939 REM correctly, so give overflow error. 940 IF ABS (NS(1))> 65535THEN 1760 950 GOTO 300 959 960 PRINT "BINARY: "; 970 IF LEN (R$)< 9THEN R$= RIGHT$ (Z$+ R$,8):GOTO 990 980 R$= RIGHT$ (Z$+ R$,16):R$= LEFT$ (R$,8)+ " "+ RIGHT$ (R$,8) 990 RETURN 999 1000 PRINT "OCTAL: "; 1010 IF LEN (R$)< 4THEN R$= RIGHT$ (Z$+ R$,3):GOTO 1030 1020 R$= RIGHT$ (Z$+ R$,6):R$= LEFT$ (R$,3)+ " "+ RIGHT$ (R$,3) 1030 RETURN 1039 1040 PRINT "DECIMAL: ";:RETURN 1049 1050 PRINT "HEXADECIMAL: "; 1060 R$= RIGHT$ (Z$+ R$,4):RETURN 1298 1299 REM Subroutine to bump Buffer Pointer & get next Character. 1300 BP= BP+ 1:C$= MID$ (I$,BP,1):IF C$= " "THEN 1300 1310 RETURN 1398 1399 REM Subroutine to convert number in input string to decimal. 1400 LN= LEN (N$):N= 0 1409 1410 FOR J= 1TO LN 1420 ON INT (B/ 5)+ 1GOSUB 1460,1480,1500,1520 1430 NEXT :IF ETHEN RETURN :REM E<>0 if there's an error. 1438 1439 REM Check for Unary operator 1440 IF U$< > "!"THEN N= VAL (U$+ STR$ (N)):U$= "!" 1448 1449 REM Push Number onto Number Stack 1450 NP= NP+ 1:NS(NP)= N:RETURN 1457 1458 REM Check for invalid characters 1459 REM Binary 1460 IF MID$ (N$,J,1)> "1"THEN E= J:J= LN:RETURN 1470 GOTO 1530 1478 1479 REM Octal 1480 IF MID$ (N$,J,1)> "7"THEN E= J:J= LN:RETURN 1490 GOTO 1530 1498 1499 REM Decimal 1500 IF MID$ (N$,J,1)> "9"THEN E= J:J= LN:RETURN 1510 GOTO 1530 1518 1519 REM Hex 1520 IF MID$ (N$,J,1)= > "A"THEN V= ASC (MID$ (N$,J,1))- 55:GOTO 1540 1529 1530 V= VAL (MID$ (N$,J,1)) 1540 N= VAL (STR$ (N+ V* B^ (LN- J))):RETURN 1597 1598 REM Apply latest operator to top 2 numbers on Number Stack. 1599 REM Get the 2 numbers. 1600 N1= NS(NP- 1):N2= NS(NP) 1608 1609 REM Apply the operator. 1610 O= ASC (OS$(OP))- 40 1620 ON OGOSUB 1680,1640,1650,1680,1660,1680,1670 1628 1629 REM Pop operator & 2 numbers. Push new number onto stack. 1630 OP= OP- 1:NP= NP- 1:NS(NP)= N:RETURN 1639 1640 N= N1* N2:RETURN 1650 N= N1+ N2:RETURN 1660 N= N1- N2:RETURN 1670 N= VAL (STR$ (INT (N1/ N2))):RETURN 1678 1679 REM Error message used during debugging 1680 PLOT 17:PRINT "ERROR AT O="O:END 1698 1699 REM Error messages 1700 GOSUB 1770:PRINT "BASE CODE SYMBOL":GOTO 300 1709 1710 GOSUB 1770:PRINT "SEMICOLON":GOTO 300 1719 1720 GOSUB 1770:PRINT "NUMERICAL EXPRESSION":GOTO 300 1729 1730 GOSUB 1770:PRINT "OPERATOR":GOTO 300 1739 1740 PLOT 17:PRINT TAB( (BP)- (LN- E- (BP< L)))"^" 1750 PRINT "ERROR! INVALID CHARACTER FOR BASE"B:GOTO 300 1759 1760 PLOT 17:PRINT :PRINT "OVERFLOW IN EVALUATED EXPRESSION":GOTO 300 1769 1770 PLOT 17:PRINT TAB( BP)"^":PRINT "ERROR! EXPECTING ";:RETURN