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