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 I2<F8 THEN 6160
6270  PRINT "*****OVERFLOW IN COMMAND OR VARIABLE FILE"
6280  RETURN 
6290  REM ***** VAR-COM INSERTION ROUTINE
6300  T4=2
6310  PRINT #2,1
6320  PRINT #3,1
6330  READ #I3,I1
6340  GOTO TYP(I3) OF 6370,6350,6540
6350  READ #I3;T$
6360  PRINT #T4;T$
6370  IF  END #I3 THEN 6540
6380  READ #I3;T1,T$
6390  IF T1=V1 THEN 6460
6400  IF T1>V1 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 T1<R1 THEN 7280
7300  IF T1>R2 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 P2<A9 THEN 8840
8810  PRINT "*****MISMATCHED '"
8820  S1=0
8830  RETURN 
8840  A$[P2]=A$[P2+1]
8850  A9=LEN(A$)
8860  P2=P2+1
8870  IF P2>A9 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 
