home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1991 January
/
1991-01.d64
/
lincatb
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
5KB
|
140 lines
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