100 CLS:PRINT "Extended Precision Calculator" 
150 ' 
160 ' Compuserve 74415,1003 
170 ' 
180 ' Jan 3, 1984 
190 ' 
200 ' *** Initialize Variables 
210 DEFINT A-Z : I=0:J=0:K=0:L=0 
220 SIZE=100     ' SIZE = Maximum digits precision 
230 EDA=0:EDB=0:EDC=0:EDH=0  ' Digits to left of decimal point 
240 ELA=0:ELB=0:ELC=0:ELH=0  ' Number length 
250 DIM EA(SIZE),EB(SIZE),EC(SIZE),EH(SIZE) ' Registers EH is temp hold 
1000 ' *** Command Loop 
1010 PRINT 
1020 LINE INPUT "Enter Command: ",COMMAND$ 
1030 IF COMMAND$="END" THEN END 
1040 IF COMMAND$="ADD" THEN GOSUB 3000:GOTO 1000 
1050 IF COMMAND$="SUB" THEN GOSUB 4000:GOTO 1000 
1060 IF COMMAND$="MUL" THEN GOSUB 5000:GOTO 1000 
1070 IF COMMAND$="DIV" THEN GOSUB 6000:GOTO 1000 
1200 IF COMMAND$="DMP" THEN GOSUB 8000:GOTO 1000 
1210 IF COMMAND$="EA" THEN GOSUB 8100:GOTO 1000 
1220 IF COMMAND$="PA" THEN GOSUB 8200:GOTO 1000 
1230 IF COMMAND$="EB" THEN GOSUB 8300:GOTO 1000 
1240 IF COMMAND$="PB" THEN GOSUB 8400:GOTO 1000 
1250 IF COMMAND$="EC" THEN GOSUB 8500:GOTO 1000 
1260 IF COMMAND$="PC" THEN GOSUB 8600:GOTO 1000 
1270 IF COMMAND$="XAB" THEN GOSUB 8700:GOTO 1000 
1280 IF COMMAND$="XAC" THEN GOSUB 8800:GOTO 1000 
1290 IF COMMAND$="XBC" THEN GOSUB 8900:GOTO 1000 
1300 IF COMMAND$="ZAP" THEN GOSUB 9000:GOTO 1000 
1310 IF COMMAND$="MAB" THEN GOSUB 9100:GOTO 1000 
1320 IF COMMAND$="MAC" THEN GOSUB 9200:GOTO 1000 
1330 IF COMMAND$="CA" THEN GOSUB 9300:GOTO 1000 
1340 IF COMMAND$="MBA" THEN GOSUB 9400:GOTO 1000 
1350 IF COMMAND$="MBC" THEN GOSUB 9500:GOTO 1000 
1360 IF COMMAND$="CB" THEN GOSUB 9600:GOTO 1000 
1370 IF COMMAND$="MCA" THEN GOSUB 9700:GOTO 1000 
1380 IF COMMAND$="MCB" THEN GOSUB 9800:GOTO 1000 
1390 IF COMMAND$="CC" THEN GOSUB 9900:GOTO 1000 
1900 PRINT "INVALID COMMAND" 
1910 GOTO 1000 
3000 ' *** B = B + A 
3010 IF EDA9 THEN EB(I-1)=EB(I-1)+1:EB(I)=EB(I)-10 
3130 NEXT 
3140 GOSUB 7700 
3150 GOSUB 7800 
3160 GOSUB 8400 
3190 RETURN 
4000 ' *** B = B - A 
4010 IF EDA=SIZE THEN 5100 
5070     WHILE EC(K+1)>9 
5080       EC(K)=EC(K)+1:EC(K+1)=EC(K+1)-10 
5090     WEND 
5100   NEXT 
5110   FOR L=ELC TO 0 STEP -1 
5120     EC(L+1)=EC(L) 
5130   NEXT :EC(0)=0 
5140   ELC=ELC+1 
5150 NEXT 
5160 ELC=ELA+ELB:EDC=EDA+EDB 
5170 GOSUB 7900 
5180 GOSUB 8600 
5190 RETURN 
6000 ' *** B = B / A 
6010 IF ELA=0 THEN PRINT "DIVIDE BY ZERO":RETURN 
6020 GOSUB 9900 
6030 ELH=ELB:EDH=EDB:FOR I=0 TO ELB:EH(I)=EB(I):NEXT 
6040 IF EDB0 THEN ZF=0 
6530   EB(I-1)=EB(I) 
6540 NEXT 
6560 IF ELCEDA) AND (EA(ELA)=0):ELA=ELA-1:WEND 
7720 IF ELA=0 THEN EDA=0:GOTO 7790 
7730 IF EA(0)<>0 THEN SC=1:GOSUB 7200:GOTO 7790 
7740 I=1:WHILE (I1 THEN SC=I-1:GOSUB 7100 
7790 RETURN 
7800 ' *** Normalize B 
7810 WHILE (ELB>EDB) AND (EB(ELB)=0):ELB=ELB-1:WEND 
7820 IF ELB=0 THEN EDB=0:GOTO 7890 
7830 IF EB(0)<>0 THEN SC=1:GOSUB 7400:GOTO 7890 
7840 I=1:WHILE (I1 THEN SC=I-1:GOSUB 7300 
7890 RETURN 
7900 ' *** Normalize C 
7910 WHILE (ELC>EDC) AND (EC(ELC)=0):ELC=ELC-1:WEND 
7920 IF ELC=0 THEN EDC=0:GOTO 7990 
7930 IF EC(0)<>0 THEN SC=1:GOSUB 7600:GOTO 7990 
7940 I=1:WHILE (I1 THEN SC=I-1:GOSUB 7500 
7990 RETURN 
8000 ' *** Dump Registers 
8010 GOSUB 8200 
8020 GOSUB 8400 
8030 GOSUB 8600 
8090 RETURN 
8100 ' *** Extract EA from String 
8110 GOSUB 9300 :INPUT "Enter A: ",EN$ :EDA=LEN(EN$) 
8120 FOR I=1 TO LEN(EN$) 
8130   X$=MID$(EN$,I,1) 
8140   IF X$="." THEN EDA=ELA:GOTO 8180 
8150   IF X$<"0" OR X$>"9" THEN PRINT "ERROR IN A, CHAR:";I 
8160   ELA=ELA+1 
8170   EA(ELA)=VAL(X$) 
8180 NEXT :GOSUB 7700 
8190 RETURN 
8200 ' *** Print A 
8210 PRINT "A: "; :CC=3 
8220 IF EDA=0 THEN PRINT "0"; :CC=4 
8230 FOR I=1 TO ELA 
8240   IF I=EDA+1 THEN PRINT "."; :CC=CC+1 
8250   PRINT USING "#";EA(I); :CC=CC+1 
8260   IF I<>EDA THEN IF ABS(I-EDA)MOD 5=0 THEN PRINT " ";:CC=CC+1:IF CC>70 THEN PRINT:PRINT "   ";:CC=3:IF EDA=0 THEN PRINT "  ";:CC=4 
8270 NEXT:PRINT 
8290 RETURN 
8300 ' *** Extract EB from String 
8310 GOSUB 9600 :INPUT "Enter B: ",EN$ :EDB=LEN(EN$) 
8320 FOR I=1 TO LEN(EN$) 
8330   X$=MID$(EN$,I,1) 
8340   IF X$="." THEN EDB=ELB:GOTO 8380 
8350   IF X$<"0" OR X$>"9" THEN PRINT "ERROR IN B, CHAR:";I 
8360   ELB=ELB+1 
8370   EB(ELB)=VAL(X$) 
8380 NEXT :GOSUB 7800 
8390 RETURN 
8400 ' *** Print B 
8410 PRINT "B: "; :CC=3 
8420 IF EDB=0 THEN PRINT "0"; :CC=4 
8430 FOR I=1 TO ELB 
8440   IF I=EDB+1 THEN PRINT "."; :CC=CC+1 
8450   PRINT USING "#";EB(I); :CC=CC+1 
8460   IF I<>EDB THEN IF ABS(I-EDB)MOD 5=0 THEN PRINT " ";:CC=CC+1:IF CC>70 THEN PRINT:PRINT "   ";:CC=3:IF EDB=0 THEN PRINT "  ";:CC=4 
8470 NEXT:PRINT 
8490 RETURN 
8500 ' *** Extract EC from String 
8510 GOSUB 9900 :INPUT "Enter C: ",EN$ :EDC=LEN(EN$) 
8520 FOR I=1 TO LEN(EN$) 
8530   X$=MID$(EN$,I,1) 
8540   IF X$="." THEN EDC=ELC:GOTO 8580 
8550   IF X$<"0" OR X$>"9" THEN PRINT "ERROR CHAR";I 
8560   ELC=ELC+1 
8570   EC(ELC)=VAL(X$) 
8580 NEXT :GOSUB 7900 
8590 RETURN 
8600 ' *** Print C 
8610 PRINT "C: "; :CC=3 
8620 IF EDC=0 THEN PRINT "0"; :CC=4 
8630 FOR I=1 TO ELC 
8640   IF I=EDC+1 THEN PRINT "."; :CC=CC+1 
8650   PRINT USING "#";EC(I); :CC=CC+1 
8660   IF I<>EDC THEN IF ABS(I-EDC)MOD 5=0 THEN PRINT " ";:CC=CC+1:IF CC>70 THEN PRINT:PRINT "   ";:CC=3:IF EDC=0 THEN PRINT "  ";:CC=4 
8670 NEXT:PRINT 
8690 RETURN 
8700 ' *** Exchange A B 
8710 IF ELA>ELB THEN J=ELA ELSE J=ELB 
8720 FOR I=0 TO J:SWAP EA(I),EB(I):NEXT 
8730 SWAP ELA,ELB:SWAP EDA,EDB 
8790 RETURN 
8800 ' *** Exchange A C 
8810 IF ELA>ELC THEN J=ELA ELSE J=ELC 
8820 FOR I=0 TO J:SWAP EA(I),EC(I):NEXT 
8830 SWAP ELA,ELC:SWAP EDA,EDC 
8890 RETURN 
8900 ' *** Exchange B C 
8910 IF ELB>ELC THEN J=ELB ELSE J=ELC 
8920 FOR I=0 TO J:SWAP EB(I),EC(I):NEXT 
8930 SWAP ELB,ELC:SWAP EDB,EDC 
8990 RETURN 
9000 ' *** Clear All Regs 
9010 GOSUB 9300 
9020 GOSUB 9600 
9030 GOSUB 9900 
9090 RETURN 
9100 ' *** Move A B 
9110 IF ELA>ELB THEN J=ELA ELSE J=ELB 
9120 FOR I=0 TO J:EB(I)=EA(I):NEXT 
9130 ELB=ELA:EDB=EDA 
9190 RETURN 
9200 ' *** Move A C 
9210 IF ELA>ELC THEN J=ELA ELSE J=ELC 
9220 FOR I=0 TO J:EC(I)=EA(I):NEXT 
9230 ELC=ELA:EDC=EDA 
9290 RETURN 
9300 ' *** Clear A 
9320 FOR I=0 TO ELA:EA(I)=0:NEXT 
9330 ELA=0:EDA=0 
9390 RETURN 
9400 ' *** Move B A 
9410 IF ELA>ELB THEN J=ELA ELSE J=ELB 
9420 FOR I=0 TO J:EA(I)=EB(I):NEXT 
9430 ELA=ELB:EDA=EDB 
9490 RETURN 
9500 ' *** Move B C 
9510 IF ELB>ELC THEN J=ELB ELSE J=ELC 
9520 FOR I=0 TO J:EC(I)=EB(I):NEXT 
9530 ELC=ELB:EDC=EDB 
9590 RETURN 
9600 ' *** Clear B 
9620 FOR I=0 TO ELB:EB(I)=0:NEXT 
9630 ELB=0:EDB=0 
9690 RETURN 
9700 ' *** Move C A 
9710 IF ELA>ELC THEN J=ELA ELSE J=ELC 
9720 FOR I=0 TO J:EA(I)=EC(I):NEXT 
9730 ELA=ELC:EDA=EDC 
9790 RETURN 
9800 ' *** Move C B 
9810 IF ELB>ELC THEN J=ELB ELSE J=ELC 
9820 FOR I=0 TO J:EB(I)=EC(I):NEXT 
9830 ELB=ELC:EDB=EDC 
9890 RETURN 
9900 ' *** Clear C 
9920 FOR I=0 TO ELC:EC(I)=0:NEXT
9930 ELC=0:EDC=0
9990 RETURN