1000  COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72]
1010  REM *** COFTAB - PROGRAM COFTA8 - 06/06/73
1012  REM *** RECODES THE DATA.
1013  REM *** TRANSFERS CONTROL TO COFTA1.
2000  FILES VARBLE,WORK1,WORK2
3000  FILES F1,F2,F3,F4,F5,F6,F7,F8,F9,F10
5000  DIM B$[72],T$[72],S$[72],D$[20],E$[1],U$[72],V$[72]
5010  DIM N$[72]
5020  DIM C$[50]
5030  D$=",;)(=NX   0123456789"
5040  N=0
5050  PRINT #2,1
5060  P2=0
5070  B1=0
5080  GOSUB 7230
5090  IF S1=4 THEN 5120
5100  PRINT "*****'(' EXPECTED AFTER ";A$[P1,P4]
5110  CHAIN "COFTA1"
5120  T$=A$[P1,P4]
5130  B$=T$
5140  READ #1,1
5150  IF  END #1 THEN 6430
5160  V$=A$
5170  T2=P2
5180  READ #1;T1,A$
5190  P2=0
5200  GOSUB 6450
5210  IF U$#T$ THEN 5180
5220  GOSUB 6580
5230  A$=V$
5240  P2=T2
5250  N=N+1
5260  C[N,1]=U1
5270  C[N,2]=U2
5280  C[N,3]=0
5290  B1=0
5300  GOSUB 7230
5310  IF S1=5 THEN 5340
5320  PRINT "*****'=' EXPECTED AFTER "A$[P1,P4]
5330  GOTO 5110
5340  T$=A$[P1,P4]
5350  IF LEN(T$) <= C[N,2]-C[N,1]+1 THEN 5380
5360  PRINT "*****NEW FIELD LENGTH OF "B$" > OLD LENGTH"
5370  GOTO 5110
5380  C[N,3]=C[N,3]+1
5390  PRINT #2;T$
5400  PRINT #3,1
5410  C1=0
5420  GOSUB 6840
5430  C1=C1+1
5440  PRINT #3;S$
5450  GOTO S1 OF 5700,5460,5590
5460  GOSUB 5510
5470  GOSUB 7780
5480  IF S1#6 THEN 5300
5490  GOSUB 5740
5500  GOTO 5300
5510  READ #3,1
5520  PRINT #2;C1
5530  FOR I=1 TO C1
5540  READ #3;T$
5550  PRINT #2;T$
5560  NEXT I
5570  PRINT #2; END 
5580  RETURN 
5590  GOSUB 5510
5600  GOSUB 7780
5610  IF S1=6 THEN 5680
5620  B1=0
5630  GOSUB 7230
5640  IF S1=7 THEN 5780
5650  IF S1=1 THEN 5070
5660  PRINT "*****'CR' OR ',' OR '/' EXPECTED AFTER EQUATION FOR "B$
5670  GOTO 5110
5680  GOSUB 5740
5690  GOTO 5070
5700  GOSUB 7780
5710  IF S1#6 THEN 5420
5720  GOSUB 5740
5730  GOTO 5420
5740  PRINT "CONTINUE";
5750  INPUT A$
5760  P2=0
5770  RETURN 
5780  F=F1=4
5790  IF  END #4 THEN 6250
5800  GOTO 5820
5810  IF  END #F1 THEN 6170
5820  PRINT #3,1
5830  READ #F1,1
5840  READ #F1;A$
5850  READ #2,1
5860  IF A$[1,3]="EOT" THEN 6300
5870  FOR I=1 TO N
5880  FOR J=1 TO C[I,3]
5890  READ #2;T$,T1
5900  FOR K=1 TO T1
5910  READ #2;S$
5920  IF A$[C[I,1],C[I,2]]<S$[1,C[I,4]] THEN 6110
5930  IF A$[C[I,1],C[I,2]]>S$[C[I,4]+1] THEN 6110
5940  B$=""
5950  IF C[I,1]=1 THEN 5970
5960  B$=A$[1,C[I,1]-1]
5970  B$[LEN(B$)+1]=T$
5980  IF C[I,2]=LEN(A$) THEN 6000
5990  B$[LEN(B$)+1]=A$[C[I,2]+1]
6000  FOR K1=K+1 TO T1
6010  READ #2;S$
6020  NEXT K1
6030  FOR K1=J+1 TO C[I,3]
6040  READ #2;T$,T1
6050  FOR K2=1 TO T1
6060  READ #2;S$
6070  NEXT K2
6080  NEXT K1
6090  A$=B$
6100  GOTO 6140
6110  NEXT K
6120  NEXT J
6130  B$=A$
6140  NEXT I
6150  PRINT #3;B$, END 
6160  GOTO 5840
6170  IF  END #3 THEN 6230
6180  IF  END #F THEN 6270
6190  READ #3,1
6200  READ #3;A$
6210  PRINT #F;A$
6220  GOTO 6200
6230  F1=F1+1
6240  GOTO 5810
6250  PRINT #F,1
6260  GOTO 6170
6270  F=F+1
6280  PRINT #F,1
6290  GOTO 6210
6300  PRINT #3;A$
6310  PRINT #F1,1
6320  READ #3,1;A$
6330  IF  END #F THEN 6380
6340  PRINT #F;A$
6350  IF A$[1,3]="EOT" THEN 6400
6360  READ #3;A$
6370  GOTO 6340
6380  F=F+1
6390  GOTO 6340
6400  PRINT #F; END 
6420  GOTO 5110
6430  PRINT "*****"B$" IS NOT DEFINED AS A VARIABLE"
6440  GOTO 5110
6450  REM ***** ROUTINE FOR DECODING VAR STRING INTO VARIABLE LABEL
6460  B1=0
6470  GOSUB 7230
6480  IF S1=1 THEN 6530
6490  E1=0
6500  IF U7=2 THEN 6560
6510  PRINT "*****',' EXPECTED AFTER "A$[P1,P4]
6520  RETURN 
6530  U$=A$[P1,P4]
6540  E1=1
6550  RETURN 
6560  PRINT "*****SYNTAX ERROR IN "A$
6570  RETURN 
6580  REM ***** ROUTINE FOR UNPACKING COL.NOS. FROM VAR STRING
6590  B1=0
6600  GOSUB 7230
6610  IF S1#1 THEN 6510
6620  N$=A$[P1,P4]
6630  GOSUB 7870
6640  IF E1#0 THEN 6670
6650  IF U7=2 THEN 6560
6660  RETURN 
6670  U1=N1
6680  B1=0
6690  GOSUB 7230
6700  IF S1=7 OR S1=1 THEN 6740
6710  IF U7=2 THEN 6560
6720  PRINT "*****'CR' OR ',' EXPECTED AFTER "A$[P1,P4]
6730  RETURN 
6740  N$=A$[P1,P4]
6750  GOSUB 7870
6760  IF E1#0 THEN 6790
6770  IF U7=2 THEN 6560
6780  RETURN 
6790  U2=N1
6800  C$=""
6810  IF P2 >= A9 THEN 6830
6820  C$=A$[P2+1]
6830  RETURN 
6840  REM*****RECODING SPECS PROCESSOR
6850  GOSUB 7230
6860  IF S1>0 AND S1<4 THEN 6890
6870  PRINT "*****',' OR ';' OR ')' EXPECTED AFTER "A$[P1,P4]
6880  GOTO 5110
6890  T$=A$[P1,P4]
6900  T2=LEN(T$)
6910  FOR I=1 TO T2
6920  IF T$[I,I]="-" THEN 7000
6930  NEXT I
6940  S$=T$
6950  S$[LEN(S$)+1]=T$
6960  IF LEN(S$)/2 <= C[N,2]-C[N,1]+1 THEN 6980
6970  GOTO 5360
6980  C[N,4]=LEN(S$)/2
6990  RETURN 
7000  IF I#1 THEN 7080
7010  S$=""
7020  T$=T$[2]
7030  T1=LEN(T$)
7040  FOR I=1 TO T1
7050  S$[I,I]='7
7060  NEXT I
7070  GOTO 6950
7080  IF T2#I THEN 7160
7090  T$=T$[LEN(T$)-1]
7100  T1=LEN(T$)
7110  S$=T$
7120  FOR I=1 TO T1
7130  S$[T1+I]="^"
7140  NEXT I
7150  GOTO 6960
7160  S$=T$[1,I-1]
7170  T$=T$[I+1]
7180  IF LEN(T$)=LEN(S$) THEN 7210
7190  PRINT "*****"T$" AND "S$" NOT OF SAME LENGTHS"
7200  GOTO 5110
7210  S$[LEN(S$)+1]=T$
7220  GOTO 6960
7230  REM ***** SCANNER
7240  A9=LEN(A$)
7250  P2=P1=P2+1
7260  IF P2 <= A9 THEN 7300
7270  P4=P2-1
7280  S1=7
7290  RETURN 
7300  GOSUB 7710
7310  IF S1=7 THEN 7270
7320  A9=LEN(A$)
7330  IF A$[P2,P2]#" " THEN 7400
7340  GOTO B1+1 OF 7370,7350,7400
7350  S1=8
7360  GOTO 7690
7370  IF P2 >= A9 THEN 7270
7380  A$=A$[P2+1]
7390  GOTO 7320
7400  IF A$[P2,P2]#"'" THEN 7570
7410  IF P2<A9 THEN 7450
7420  PRINT "*****MISMATCHED '"
7430  S1=0
7440  RETURN 
7450  A$[P2]=A$[P2+1]
7460  A9=LEN(A$)
7470  P2=P2+1
7480  IF P2>A9 THEN 7420
7490  IF A$[P2,P2]#"'" THEN 7470
7500  IF P2 >= A9 THEN 7530
7510  A$[P2]=A$[P2+1]
7520  GOTO 7320
7530  P2=P2-1
7540  A$=A$[1,P2]
7550  P4=P2
7560  GOTO 7280
7570  E$=A$[P2,P2]
7580  IF B1#2 THEN 7620
7590  IF E$#D$[2,2] THEN 7650
7600  I2=2
7610  GOTO 7680
7620  FOR I2=1 TO 5
7630  IF E$=D$[I2,I2] THEN 7680
7640  NEXT I2
7650  P2=P2+1
7660  IF P2>A9 THEN 7270
7670  GOTO 7320
7680  S1=I2
7690  P4=P2-1
7700  RETURN 
7710  REM ***** ROUTINE FOR SCANNING LEADING BLANKS
7720  S1=0
7730  IF A$[P2,P2]#" " THEN 7770
7740  P1=P2=P2+1
7750  IF P2 <= A9 THEN 7730
7760  S1=7
7770  RETURN 
7780  REM ***** ROUTINE TO DETERMINE CONTINUATION OF RECODE
7790  T1=P1+1
7800  IF T1>A9 THEN 7860
7810  IF A$[T1,T1]="/" THEN 7850
7820  IF A$[T1,T1]#" " THEN 7860
7830  T1=T1+1
7840  GOTO 7800
7850  S1=6
7860  RETURN 
7870  REM *****SUBROUTINE TO CONVERT STRING TO AN INTEGER (0-999)
7880  E1=1
7890  T1=LEN(N$)
7900  IF T1 <= 5 THEN 7940
7910  PRINT "*****"N$" IS AN ILLEGAL INTEGER"
7920  E1=0
7930  RETURN 
7940  N1=0
7950  FOR I2=T1 TO 1 STEP -1
7960  E$=N$[I2,I2]
7970  FOR J2=11 TO 20
7980  IF E$=D$[J2,J2] THEN 8010
7990  NEXT J2
8000  GOTO 7910
8010  N1=N1+(J2-11)*10^(T1-I2)
8020  NEXT I2
8030  RETURN 
8040  END 
