10 REM       LINCATB              260390
20 REM.
30 PRINT"[147]PROGRAM LINCATB":PRINT
40 PRINT"TAKES T/S ARRAYS[146] FILE AND CREATES"
50 PRINT"FILELIST[146] WITH NEW DIRECTORY DATA":PRINT
60 REM USES THE OUTPUT FILE CREATED BY  "LINKCATA" PROGRAM.
70 INPUT"WHICH DISK DRIVE # (8/9/10/11)";U
80 PRINT"PUT THE WORK DISK WITH THE"
90 PRINT"'T/S ARRAYS' FILE INTO THE DRIVE.":PRINT
100 INPUT "PRESS RETURN[146] WHEN DISK IS READY. OK";Z$
110 OPEN15,U,15:REM OPEN CONTROL CHANNEL
120 GOSUB1210
130 OPEN2,U,2,"T/S ARRAYS,S,R"
140 GOSUB1210:IF A<>0 THENPRINT"FILE PROBLEM WITH 'T/S ARRAYS'":GOTO1230:REM EXI
150 D$="":FOR I=1TO4:GET#2,E$:D$=D$+E$:NEXT I
160 PRINT"THIS IS FOR A ";D$;"[146] DISK."
170 PRINT"IS DRIVE ";U;"[146]SET TO A ";D$;"[146] (Y/N)";
180 INPUT Y$:IF Y$<>"Y" THEN CLOSE1:CLOSE15:STOP
190 IF D$="1571"THEN PRINT#15,"U0>M1":REM SET A 1571 TO 1571 MODE
200 GET#2,A$:GET#2,B$
210 REM READ THE # TRACKS AND SECTORS WRITTEN
220 TSIZ=ASC(A$+CHR$(0)):SSIZ=ASC(B$+CHR$(0))
230 PRINT"READING T/S ARRAYS[146] FILE."
240 PRINT"FILE CONTAINS DATA FROM ";TSIZ;" TRACKS"
250 PRINT"EACH OF UP TO           ";SSIZ;" SECTORS"
260 REM CHECK FOR VALID T/S FILE HEADER:DTRK=DIRECTORY TRACK #
270 IF D$="1541" AND TSIZ=35 AND SSIZ=20 THEN DTRK=18: GOTO310 
280 IF D$="1571" AND TSIZ=70 AND SSIZ=20 THEN DTRK=18: GOTO310 
290 IF D$="1581" AND TSIZ=80 AND SSIZ=39 THEN DTRK=40: GOTO310 
300 :PRINT"INVALID FILE":CLOSE2:GOTO1230:REM ERROR EXIT
310 REM IF WE GET HERE, DRIVE TYPE AND T/S COUNTS MATCH.
320 DIM T%(TSIZ,SSIZ),S%(TSIZ,SSIZ),STAT%(TSIZ,SSIZ)
330 DIM TBACK%(TSIZ,SSIZ),SBACK%(TSIZ,SSIZ)
340 DIM TMULT%(100),SMULT%(100),TREF%(100),SREF%(100)
350 DIM SSIZ%(TSIZ):REM ACTUAL # SECTORS ON EACH TRACK
360 REM READ # SECTORS IN EACH OF TSIZ TRACKS
370 FOR T=1 TO TSIZ:GET#2,A$:T2=0:IFA$<>""THEN T2=ASC(A$):SSIZ%(T)=T2:NEXTT
380 REM READ T/S DATA FOR EACH TRACK
390 NM=0
400 FOR T=1 TO TSIZ:PRINT"  T/S  TRACK ";T
410 FOR S=0 TO SSIZ%(T)
420 :GET#2,A$:GET#2,B$
430 :T2=0:IF A$<>"" THEN T2=ASC(A$)
440 :S2=0:IF B$<>"" THEN S2=ASC(B$)
450 :T%(T,S)=T2
460 :S%(T,S)=S2
470 :IF T2<1OR T2>TSIZ THEN GOTO640
480 :IF S2>SSIZ%(T2) THEN GOTO640:REM INVALID T/S,OR EOF
490 : IF T2=T AND S2=S THEN GOTO 640:REM CAN'T REFERENCE ITSELF, SO INVALID
500 :REM SET STATUS AND BACKWARDS REF ENTRIES
510 :STAT%(T2,S2)=STAT%(T2,S2)+1
520 :IF STAT%(T2,S2)<2 THEN GOTO620 
530 : PRINT"MULTIPLE REFERENCES TO T/S";T2;S2
540 : PRINT "AT BLOCKS";TBACK%(T2,S2);SBACK%(T2,S2);"/";T;S
550 : NM=NM+1
560 : TMULT%(NM)=T2:SMULT%(NM)=S2
570 : TREF%(NM)=TBACK%(T2,S2):SREF%(NM)=SBACK%(T2,S2)
580 : NM=NM+1
590 : TMULT%(NM)=TMULT%(NM-1):SMULT%(NM)=SMULT%(NM-1)
600 : TREF%(NM)=T:SREF%(NM)=S
610 : REM STORE MULTIPLE BLOCK REFERENCES
620 :TBACK%(T2,S2)=T
630 :SBACK%(T2,S2)=S
640 NEXT:NEXT
650 GET#2,A$:GET#2,B$
660 CLOSE2
670 IF A$<>CHR$(255)OR B$<>CHR$(255)THEN PRINT"INVALID END OF FILE":CLOSE15:STOP
680 REM ::
690 REM SEARCH FOR START T/S OF FILES
700 PRINT"[147]LOOKING FOR STARTING BLOCKS OF FILES"
710 OPEN3,U,2,"FILELIST,S,R":INPUT#15,A,B$,C,D:IF A=62 THEN CLOSE3:GOTO770
720 :REM MAKE SURE FILE IS NOT ALREADY  THERE;A=62 MEANS 'FILE NOT FOUND'
730 :PRINT" 'FILELIST[146]' ALREADY EXISTS."
740 :INPUT "O.K. TO DELETE OLD VERSION (Y/N)";Z$
750 :IF Z$<>"Y" THEN PRINT"ABORT PROGRAM":GOTO1230:REM TERMINATE AND EXIT
760 :CLOSE3:PRINT#15,"S0:FILELIST":GOSUB1210:REM DELETE OLD VERSION
770 OPEN3,U,2,"FILELIST,S,W":GOSUB1210
780 PRINT#3,D$:REM DISK TYPE
790 INPUT"LIST TO PRINTER OR SCREEN (P/S)";Z$
800 OUT=3:IF Z$="P" THEN OUT=4:REM 3 FOR SCREEN,4 FOR PRINTER
810 OPEN4,OUT
820 NFILES=0:BSUM=0:MS=0:C$=","
830 FOR T=1 TO TSIZ:PRINT#4,"TRACK ";T
840 :IF T=DTRK THEN GOTO1070:REM SKIP DIRECTORY TRACK
850 :FOR S=0 TO SSIZ%(T)
860 ::REM SEARCH FOR "STATUS 0" T/S
870 ::IF STAT%(T,S)<2 THEN GOTO890
880 :::MS=MS+1:PRINT#4,"MULTIPLE REFERENCE ";STAT%(T,S);" AT ";T;S
890 ::IF STAT%(T,S)<>0 THEN GOTO1060
900 ::IF T%(T,S)=0 AND S%(T,S)=0 THEN GOTO1060
910 ::REM IF BOTH T/S ARE 0 IN THIS BLOCK, IT'S PROBABLY NEVER BEEN USED.
920 ::IF T%(T,S)>TSIZ THEN GOTO 1060
930 ::IF T%(T,S) > 0 AND S%(T,S) > SSIZ%(T%(T,S)) THEN GOTO 1060
940 ::REM IF INVALID T/S, CAN'T BE A FILE
950 ::NB=1:NFILES=NFILES+1:I=NFILES:GOSUB1250
960 ::PRINT#4,"FILE ";T$;" STARTING TRACK/SECTOR";T;S;
970 ::T5=T:S5=S
980 ::T4=T%(T5,S5):S4=S%(T5,S5)
990 :: IF T4=T5 AND S4=S5 THEN GOTO 1020:REM AVOID REGRESSION:BLOCK REFS ITSELF
1000 ::IF T4<=0 OR T4>TSIZ THEN GOTO 1020
1010 ::IF S4<=SSIZ%(T4)THEN T5=T4:S5=S4:NB=NB+1:GOTO980
1020 ::REM IF WE GET HERE, IT'S END OF FILE
1030 ::PRINT#4,"    ENDS ";T5;S5;": ";NB;"[146] BLOCKS"
1040 ::BSUM=BSUM+NB
1050 ::PRINT#3,T$;C$;T;C$;S;C$;NB
1060 :NEXT S
1070 NEXT T
1080 PRINT#3,"END";C$;0;C$;0;C$;0
1090 PRINT#4,"FOUND ";NFILES;" FILES"
1100 PRINT#4,BSUM;"BLOCKS ACCOUNTED FOR"
1110 PRINT#4,MS;"CRITICAL MULTIPLE BLOCK REFERENCES"
1120 REM LIST MULTIPLE BLOCK REFERENCE INFO
1130 FOR M=1 TO NM
1140 :PRINT#4,"BLOCK AT";TMULT%(M);SMULT%(M)
1150 :TX=TREF%(M):SX=SREF%(M):GOSUB1300
1160 NEXT
1170 PRINT#4:CLOSE4
1180 CLOSE3:GOSUB1210
1190 GOTO1230: REM FINAL EXIT
1200 REM ::
1210 PRINT"";:FORK=1TO24:PRINT:NEXT:INPUT#15,A,B$,C,D:PRINT A;B$;C;D:RETURN
1220 REM ::
1230 GOSUB1210:CLOSE2:CLOSE3:CLOSE4:CLOSE15:END:REM FINAL EXIT
1240 REM ::
1250 REM TO CREATE A STRING NUMBER WITH LEADING ZEROS
1260 REM 'I' IS CONVERTED INTO A 3-CHARACTER ASCII STRING T$
1270 S$=STR$(I):L=LEN(S$)
1280 T$="F"+LEFT$("0000",4-L)+RIGHT$(S$,L-1)
1290 RETURN
1300 REM ::
1310 REM SUBROUTINE TO SEARCH BACK TO FIND START OF FILE, GIVEN ARBITRARY T/S.
1320 REM GIVEN TX,SX RETURNS STARTING BLOCK IN TX,SX
1330 PRINT#4,"REFERENCED IN:";TX;SX;
1340 TB=TBACK%(TX,SX):SB=SBACK%(TX,SX)
1350 :IF TB<1 OR TB>TSIZ THEN GOTO1380
1360 :IF SB>SSIZ%(TB) THEN GOTO1380:REM FOUND START
1370 : TX=TB:SX=SB:GOTO 1340: REM TRY NEXT BLOCK BACK
1380 PRINT#4,"STARTING FROM:";TX;SX
1390 RETURN