1000 COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72] 1010 REM *** COFTAB - PROGRAM COFTA1 - 06/06/73 1012 REM *** ACCEPTS COMMANDS FROM THE KEYBOARD OR COMMAND FILE, 1013 REM *** CHECKS THE COMMAND FOR SYNTAX, AND SETS PARAMETERS FOR 1014 REM *** THE COMMAND ROUTINES. 1015 REM *** TRANSFERS CONTROL TO ONE OF COFTA2, COFTA3, COFTA5, 1016 REM *** COFTA8, OR COFTA9. 2000 FILES VARBLE,WORK1,WORK2 5000 DIM D$[20],T$[72],B$[72],S$[72],E$[1] 5010 DIM C$[72],U$[72],K$[72] 5020 DIM N$[72] 5030 D$=",;)(=NX 0123456789" 5040 K$="LISEDICLERUNVARCOMCOUXTARECPUNENDSTOOBSAPP" 5050 F7=128 5060 F4=1 5070 F5=F7/2-1 5080 F6=F5+1 5090 IF R1 >= 0 THEN 7190 5100 PRINT "**"; 5110 INPUT A$ 5120 P2=0 5130 B1=1 5140 GOSUB 8620 5150 IF S1=7 OR S1=8 THEN 5180 5160 PRINT "*****' ' OR 'CR' EXPECTED AFTER "A$[P1,P4] 5170 GOTO 5090 5180 T$=A$[P1,P1+2] 5190 I1=0 5200 FOR I=1 TO 42 STEP 3 5210 I1=I1+1 5220 IF T$#K$[I,I+2] THEN 5250 5230 GOTO I1 OF 6710,6710,6710,6980,5280,5410,7410,7500 5240 GOTO I1-8 OF 6820,6710,6750,6750,6770,6790 5250 NEXT I 5260 PRINT "*****"A$[P1,P4]" IS UNRECOGNIZABLE" 5270 GOTO 5090 5280 REM ***** VARIABLE DEFINITION PROCESSOR 5290 I1=F4 5300 F8=F5 5310 I3=1 5320 GOSUB 5500 5330 IF E1=0 THEN 5090 5340 U7=1 5350 GOSUB 5730 5360 IF E1=0 THEN 5390 5370 GOSUB 5860 5380 GOSUB 6120 5390 GOSUB 6290 5400 GOTO 5090 5410 REM ***** COMMAND DEFINITION PROCESSOR 5420 I1=F6 5430 F8=F7 5440 I3=1 5450 GOSUB 5500 5460 IF E1=0 THEN 5090 5470 GOSUB 6120 5480 GOSUB 6290 5490 GOTO 5090 5500 REM ***** ROUTINE FOR DETERMINING ST.NO. OF VAR AND COM 5510 B1=1 5520 GOSUB 8620 5530 IF S1=7 OR S1=8 THEN 5570 5540 PRINT "*****'CR' OR ' ' EXPECTED AFTER "A$[P1,P4] 5550 E1=0 5560 RETURN 5570 N$=A$[P1,P4] 5580 GOSUB 9430 5590 IF E1=0 THEN 5560 5600 V1=N1 5610 GOSUB 9100 5620 IF S1#7 THEN 5690 5630 C[1,1]=V1 5640 C[1,2]=V1 5650 T4=2 5660 N=1 5670 GOSUB 6850 5680 GOTO 5550 5690 A$=A$[P2] 5700 B$=A$ 5710 P2=0 5720 RETURN 5730 REM ***** ROUTINE FOR DECODING VAR STRING INTO VARIABLE LABEL 5740 B1=0 5750 GOSUB 8620 5760 IF S1=1 THEN 5810 5770 E1=0 5780 IF U7=2 THEN 5840 5790 PRINT "*****',' EXPECTED AFTER "A$[P1,P4] 5800 RETURN 5810 U$=A$[P1,P4] 5820 E1=1 5830 RETURN 5840 PRINT "*****SYNTAX ERROR IN "A$ 5850 RETURN 5860 REM ***** ROUTINE FOR UNPACKING COL.NOS. FROM VAR STRING 5870 B1=0 5880 GOSUB 8620 5890 IF S1#1 THEN 5790 5900 N$=A$[P1,P4] 5910 GOSUB 9430 5920 IF E1#0 THEN 5950 5930 IF U7=2 THEN 5840 5940 RETURN 5950 U1=N1 5960 B1=0 5970 GOSUB 8620 5980 IF S1=7 OR S1=1 THEN 6020 5990 IF U7=2 THEN 5840 6000 PRINT "*****'CR' OR ',' EXPECTED AFTER "A$[P1,P4] 6010 RETURN 6020 N$=A$[P1,P4] 6030 GOSUB 9430 6040 IF E1#0 THEN 6070 6050 IF U7=2 THEN 5840 6060 RETURN 6070 U2=N1 6080 C$="" 6090 IF P2 >= A9 THEN 6110 6100 C$=A$[P2+1] 6110 RETURN 6120 REM ***** SECTOR LOCATION ROUTINE 6130 I2=I1+1 6140 IF END #I3 THEN 6280 6150 READ #I3,I1;T1 6160 READ #I3,I2 6170 GOTO TYP(I3) OF 6190,6180,6280 6180 READ #I3;T$ 6190 READ #I3;T2 6200 IF T1 >= V1 THEN 6280 6210 IF T2>V1 THEN 6280 6220 T1=T2 6230 I1=I2 6240 I2=I2+1 6250 IF I3>3 THEN 6160 6260 IF I2V1 THEN 6430 6410 PRINT #T4;T1,T$ 6420 GOTO 6380 6430 PRINT #T4;V1,B$ 6440 PRINT #T4;T1,T$ 6450 GOTO 6470 6460 PRINT #T4;V1,B$ 6470 IF END #I3 THEN 6510 6480 READ #I3;T1,T$ 6490 PRINT #T4;T1,T$ 6500 GOTO 6480 6510 PRINT #T4; END 6520 GOSUB 6560 6530 RETURN 6540 PRINT #I3;V1,B$, END 6550 RETURN 6560 REM ***** ROUTINE FOR COPYING A FILE 6570 READ #T4,1 6580 FOR I=I1 TO F8 6590 PRINT #I3,I; END 6600 NEXT I 6610 PRINT #I3,I1 6620 IF END #T4 THEN 6690 6630 GOTO TYP(T4) OF 6660,6640 6640 READ #T4;T$ 6650 PRINT #I3;T$ 6660 READ #T4;T1,T$ 6670 PRINT #I3;T1,T$ 6680 GOTO 6660 6690 PRINT #I3; END 6700 RETURN 6710 REM ***** CHAINER 6720 A$=A$[P2] 6730 N=I1 6740 CHAIN "COFTA2" 6750 STOP 6760 REM ***** OBSERVATIONS PROCESSOR 6770 N=1 6780 CHAIN "COFTA9" 6790 REM ***** APPEND PROCESSOR 6800 N=2 6810 CHAIN "COFTA9" 6820 REM ***** RECODE PROCESSOR 6830 A$=A$[P4+1] 6840 CHAIN "COFTA8" 6850 REM ***** ROUTINE FOR CLEARING SPECIFED ST.NOS. 6860 PRINT #T4,1 6870 READ #I3,I1 6880 IF END #I3 THEN 6950 6890 READ #I3;T1,T$ 6900 FOR I=1 TO N 6910 IF T1 >= C[I,1] AND T1 <= C[I,2] THEN 6890 6920 NEXT I 6930 PRINT #T4;T1,T$ 6940 GOTO 6890 6950 PRINT #T4; END 6960 GOSUB 6560 6970 RETURN 6980 REM ***** RUN PROCESSOR 6990 R1=0 7000 R2=1.E+06 7010 R3=7 7020 IF S1=7 THEN 7190 7030 IF S1=8 THEN 7070 7040 PRINT "*****' ' OR 'CR' EXPECTED AFTER "A$[P1,P4] 7050 R1=-1 7060 GOTO 5090 7070 R$=A$ 7080 B1=0 7090 GOSUB 8620 7100 IF S1=7 THEN 7120 7110 IF S1#1 THEN 7040 7120 S$=A$[P1,P4] 7130 GOSUB 9170 7140 IF E1=0 THEN 5090 7150 R3=S1 7160 R1=S2 7170 R2=S3 7180 R4=P2 7190 I1=F6 7200 I3=1 7210 F8=F7 7220 V1=R1 7230 GOSUB 6120 7240 READ #I3,I1 7250 GOTO TYP(I3) OF 7270,7260,5090 7260 READ #I3;T$ 7270 IF END #I3 THEN 7350 7280 READ #I3;T1,T$ 7290 IF T1R2 THEN 7350 7310 R1=T1+1 7320 A$=T$ 7330 PRINT "!!?"T1;A$ 7340 GOTO 5120 7350 IF R3#7 THEN 7380 7360 R1=-1 7370 GOTO 5090 7380 A$=R$ 7390 P2=R4 7400 GOTO 7080 7410 REM ***** COUNT PROCESSOR 7420 L1=1 7430 B1=0 7440 GOSUB 8620 7450 IF S1=7 OR S1=8 OR S1=4 OR S1=1 THEN 7480 7460 PRINT "*****',' OR 'CR' EXPECTED AFTER "A$[P1,P4] 7470 GOTO 5090 7480 IF A$[P1,P4]="ALL" THEN 8240 7490 GOTO 7570 7500 REM ***** XTAB PROCESSOR 7510 L1=2 7520 B1=0 7530 GOSUB 8620 7540 IF S1=1 THEN 7580 7550 IF S1=7 THEN 7580 7560 IF S1#4 THEN 7460 7570 REM ***** ROUTINE FOR GETTING PARAMETERS FOR COUNT AND XTAB 7580 U7=2 7590 PRINT #3,1 7600 T$=A$[P1,P4] 7610 N=0 7620 T2=P2 7630 B$=A$ 7640 T4=S1 7650 IF END #1 THEN 8400 7660 READ #1,F4 7670 READ #1;T3,A$ 7680 P2=0 7690 GOSUB 5730 7700 IF E1=0 THEN 5090 7710 IF T$#U$ THEN 7670 7720 GOSUB 5860 7730 IF E1=0 THEN 5090 7740 N=N+1 7750 C[N,1]=U1 7760 C[N,2]=U2 7770 C[N,3]=0 7780 C[N,4]=T3 7790 IF T4=4 THEN 7930 7800 IF T4#7 THEN 7840 7810 GOTO L1 OF 7820,7830 7820 CHAIN "COFTA3" 7830 CHAIN "COFTA5" 7840 A$=B$ 7850 P2=T2 7860 B1=0 7870 GOSUB 8620 7880 IF S1=1 OR S1=4 OR S1=7 THEN 7910 7890 PRINT "*****',' OR '(' EXPECTED AFTER "A$[P1,P4] 7900 GOTO 5090 7910 T$=A$[P1,P4] 7920 GOTO 7620 7930 PRINT #2,1 7940 C1=0 7950 C[N,4]=-C[N,4] 7960 A$=B$ 7970 P2=T2 7980 B1=0 7990 GOSUB 8620 8000 IF S1=1 OR S1=3 THEN 8030 8010 PRINT "*****',' OR ')' EXPECTED AFTER "A$[P1,P4] 8020 GOTO 5090 8030 S$=A$[P1,P4] 8040 GOSUB 8420 8050 C1=C1+1 8060 PRINT #2;S$ 8070 IF S1=1 THEN 7980 8080 PRINT #2; END 8090 READ #2,1 8100 PRINT #3;C1 8110 IF END #2 THEN 8150 8120 READ #2;S$ 8130 PRINT #3;S$, END 8140 GOTO 8120 8150 B1=0 8160 GOSUB 8620 8170 IF S1#1 THEN 8220 8180 S$=A$[P1,P4] 8190 IF LEN(S$)=0 THEN 7860 8200 PRINT "*****',' OR 'CR' EXPECTED AFTER ')'" 8210 GOTO 5090 8220 IF S1#7 THEN 8200 8230 GOTO 7810 8240 N=0 8250 READ #1,F4 8260 U7=2 8270 IF END #1 THEN 7810 8280 READ #1;T3,A$ 8290 P2=0 8300 N=N+1 8310 GOSUB 5730 8320 IF E1=0 THEN 5090 8330 GOSUB 5860 8340 IF E1=0 THEN 5090 8350 C[N,1]=U1 8360 C[N,2]=U2 8370 C[N,3]=0 8380 C[N,4]=T3 8390 GOTO 8280 8400 PRINT "*****"T$" IS NOT DEFINED AS A VARIABLE" 8410 GOTO 5090 8420 REM ***** ROUTINE FOR DECODING CONSTANTS IN COUNT AND XTAB 8430 S9=LEN(S$) 8440 FOR I=1 TO S9 8450 IF S$[I,I]="-" THEN 8490 8460 NEXT I 8470 S$[S9+1]=S$ 8480 RETURN 8490 IF I=S9 THEN 8580 8500 IF I=1 THEN 8530 8510 S$[I]=S$[I+1] 8520 RETURN 8530 S$[S9]=S$[2] 8540 FOR I=1 TO S9-1 8550 S$[I,I]='7 8560 NEXT I 8570 RETURN 8580 FOR I=S9 TO S9+S9-2 8590 S$[I,I]="^" 8600 NEXT I 8610 RETURN 8620 REM ***** SCANNER 8630 A9=LEN(A$) 8640 P2=P1=P2+1 8650 IF P2 <= A9 THEN 8690 8660 P4=P2-1 8670 S1=7 8680 RETURN 8690 GOSUB 9100 8700 IF S1=7 THEN 8660 8710 A9=LEN(A$) 8720 IF A$[P2,P2]#" " THEN 8790 8730 GOTO B1+1 OF 8760,8740,8790 8740 S1=8 8750 GOTO 9080 8760 IF P2 >= A9 THEN 8660 8770 A$=A$[P2+1] 8780 GOTO 8710 8790 IF A$[P2,P2]#"'" THEN 8960 8800 IF P2A9 THEN 8810 8880 IF A$[P2,P2]#"'" THEN 8860 8890 IF P2 >= A9 THEN 8920 8900 A$[P2]=A$[P2+1] 8910 GOTO 8710 8920 P2=P2-1 8930 A$=A$[1,P2] 8940 P4=P2 8950 GOTO 8670 8960 E$=A$[P2,P2] 8970 IF B1#2 THEN 9010 8980 IF E$#D$[2,2] THEN 9040 8990 I=2 9000 GOTO 9070 9010 FOR I=1 TO 5 9020 IF E$=D$[I,I] THEN 9070 9030 NEXT I 9040 P2=P2+1 9050 IF P2>A9 THEN 8660 9060 GOTO 8710 9070 S1=I 9080 P4=P2-1 9090 RETURN 9100 REM ***** ROUTINE FOR SCANNING LEADING BLANKS 9110 S1=0 9120 IF A$[P2,P2]#" " THEN 9160 9130 P1=P2=P2+1 9140 IF P2 <= A9 THEN 9120 9150 S1=7 9160 RETURN 9170 REM*****SUBROUTINE FOR COMPUTING STATEMENT RANGES 9180 S9=LEN(S$) 9190 S2=0 9200 K1=1 9210 IF S$[1,1]="-" THEN 9350 9220 FOR K1=1 TO S9 9230 IF S$[K1,K1]="-" THEN 9270 9240 NEXT K1 9250 N$=S$ 9260 GOTO 9280 9270 N$=S$[1,K1-1] 9280 GOSUB 9430 9290 IF E1=0 THEN 9420 9300 S2=N1 9310 S3=N1 9320 IF K1>S9 THEN 9420 9330 S3=1.E+06 9340 IF K1=S9 THEN 9420 9350 N$=S$[K1+1] 9360 GOSUB 9430 9370 IF E1=0 THEN 9420 9380 S3=N1 9390 IF S3 >= S2 THEN 9420 9400 PRINT "*****FIRST STATEMENT NO. > SECOND STATEMENT NO." 9410 E1=0 9420 RETURN 9430 REM *****SUBROUTINE TO CONVERT STRING TO AN INTEGER (0-999) 9440 E1=1 9450 T1=LEN(N$) 9460 IF T1 <= 5 THEN 9500 9470 PRINT "*****"N$" IS AN ILLEGAL INTEGER" 9480 E1=0 9490 RETURN 9500 N1=0 9510 FOR I=T1 TO 1 STEP -1 9520 T$=N$[I,I] 9530 FOR J=11 TO 20 9540 IF T$=D$[J,J] THEN 9570 9550 NEXT J 9560 GOTO 9470 9570 N1=N1+(J-11)*10^(T1-I) 9580 NEXT I 9590 RETURN 9600 END