home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1991 January / 1991-01.d64 / lincatb (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  140 lines
  1. 10 rem       lincatb              260390
  2. 20 rem.
  3. 30 print"[147]program lincatb":print
  4. 40 print"takes t/s arrays[146] file and creates"
  5. 50 print"filelist[146] with new directory data":print
  6. 60 rem uses the output file created by  "linkcata" program.
  7. 70 input"which disk drive # (8/9/10/11)";u
  8. 80 print"put the work disk with the"
  9. 90 print"'t/s arrays' file into the drive.":print
  10. 100 input "press return[146] when disk is ready. ok";z$
  11. 110 open15,u,15:rem open control channel
  12. 120 gosub1210
  13. 130 open2,u,2,"t/s arrays,s,r"
  14. 140 gosub1210:if a<>0 thenprint"file problem with 't/s arrays'":goto1230:rem exi
  15. 150 d$="":for i=1to4:get#2,e$:d$=d$+e$:next i
  16. 160 print"this is for a ";d$;"[146] disk."
  17. 170 print"is drive ";u;"[146]set to a ";d$;"[146] (y/n)";
  18. 180 input y$:if y$<>"y" then close1:close15:stop
  19. 190 if d$="1571"then print#15,"u0>m1":rem set a 1571 to 1571 mode
  20. 200 get#2,a$:get#2,b$
  21. 210 rem read the # tracks and sectors written
  22. 220 tsiz=asc(a$+chr$(0)):ssiz=asc(b$+chr$(0))
  23. 230 print"reading t/s arrays[146] file."
  24. 240 print"file contains data from ";tsiz;" tracks"
  25. 250 print"each of up to           ";ssiz;" sectors"
  26. 260 rem check for valid t/s file header:dtrk=directory track #
  27. 270 if d$="1541" and tsiz=35 and ssiz=20 then dtrk=18: goto310 
  28. 280 if d$="1571" and tsiz=70 and ssiz=20 then dtrk=18: goto310 
  29. 290 if d$="1581" and tsiz=80 and ssiz=39 then dtrk=40: goto310 
  30. 300 :print"invalid file":close2:goto1230:rem error exit
  31. 310 rem if we get here, drive type and t/s counts match.
  32. 320 dim t%(tsiz,ssiz),s%(tsiz,ssiz),stat%(tsiz,ssiz)
  33. 330 dim tback%(tsiz,ssiz),sback%(tsiz,ssiz)
  34. 340 dim tmult%(100),smult%(100),tref%(100),sref%(100)
  35. 350 dim ssiz%(tsiz):rem actual # sectors on each track
  36. 360 rem read # sectors in each of tsiz tracks
  37. 370 for t=1 to tsiz:get#2,a$:t2=0:ifa$<>""then t2=asc(a$):ssiz%(t)=t2:nextt
  38. 380 rem read t/s data for each track
  39. 390 nm=0
  40. 400 for t=1 to tsiz:print"  t/s  track ";t
  41. 410 for s=0 to ssiz%(t)
  42. 420 :get#2,a$:get#2,b$
  43. 430 :t2=0:if a$<>"" then t2=asc(a$)
  44. 440 :s2=0:if b$<>"" then s2=asc(b$)
  45. 450 :t%(t,s)=t2
  46. 460 :s%(t,s)=s2
  47. 470 :if t2<1or t2>tsiz then goto640
  48. 480 :if s2>ssiz%(t2) then goto640:rem invalid t/s,or eof
  49. 490 : if t2=t and s2=s then goto 640:rem can't reference itself, so invalid
  50. 500 :rem set status and backwards ref entries
  51. 510 :stat%(t2,s2)=stat%(t2,s2)+1
  52. 520 :if stat%(t2,s2)<2 then goto620 
  53. 530 : print"multiple references to t/s";t2;s2
  54. 540 : print "at blocks";tback%(t2,s2);sback%(t2,s2);"/";t;s
  55. 550 : nm=nm+1
  56. 560 : tmult%(nm)=t2:smult%(nm)=s2
  57. 570 : tref%(nm)=tback%(t2,s2):sref%(nm)=sback%(t2,s2)
  58. 580 : nm=nm+1
  59. 590 : tmult%(nm)=tmult%(nm-1):smult%(nm)=smult%(nm-1)
  60. 600 : tref%(nm)=t:sref%(nm)=s
  61. 610 : rem store multiple block references
  62. 620 :tback%(t2,s2)=t
  63. 630 :sback%(t2,s2)=s
  64. 640 next:next
  65. 650 get#2,a$:get#2,b$
  66. 660 close2
  67. 670 if a$<>chr$(255)or b$<>chr$(255)then print"invalid end of file":close15:stop
  68. 680 rem ::
  69. 690 rem search for start t/s of files
  70. 700 print"[147]looking for starting blocks of files"
  71. 710 open3,u,2,"filelist,s,r":input#15,a,b$,c,d:if a=62 then close3:goto770
  72. 720 :rem make sure file is not already  there;a=62 means 'file not found'
  73. 730 :print" 'filelist[146]' already exists."
  74. 740 :input "o.k. to delete old version (y/n)";z$
  75. 750 :if z$<>"y" then print"abort program":goto1230:rem terminate and exit
  76. 760 :close3:print#15,"s0:filelist":gosub1210:rem delete old version
  77. 770 open3,u,2,"filelist,s,w":gosub1210
  78. 780 print#3,d$:rem disk type
  79. 790 input"list to printer or screen (p/s)";z$
  80. 800 out=3:if z$="p" then out=4:rem 3 for screen,4 for printer
  81. 810 open4,out
  82. 820 nfiles=0:bsum=0:ms=0:c$=","
  83. 830 for t=1 to tsiz:print#4,"track ";t
  84. 840 :if t=dtrk then goto1070:rem skip directory track
  85. 850 :for s=0 to ssiz%(t)
  86. 860 ::rem search for "status 0" t/s
  87. 870 ::if stat%(t,s)<2 then goto890
  88. 880 :::ms=ms+1:print#4,"multiple reference ";stat%(t,s);" at ";t;s
  89. 890 ::if stat%(t,s)<>0 then goto1060
  90. 900 ::if t%(t,s)=0 and s%(t,s)=0 then goto1060
  91. 910 ::rem if both t/s are 0 in this block, it's probably never been used.
  92. 920 ::if t%(t,s)>tsiz then goto 1060
  93. 930 ::if t%(t,s) > 0 and s%(t,s) > ssiz%(t%(t,s)) then goto 1060
  94. 940 ::rem if invalid t/s, can't be a file
  95. 950 ::nb=1:nfiles=nfiles+1:i=nfiles:gosub1250
  96. 960 ::print#4,"file ";t$;" starting track/sector";t;s;
  97. 970 ::t5=t:s5=s
  98. 980 ::t4=t%(t5,s5):s4=s%(t5,s5)
  99. 990 :: if t4=t5 and s4=s5 then goto 1020:rem avoid regression:block refs itself
  100. 1000 ::if t4<=0 or t4>tsiz then goto 1020
  101. 1010 ::if s4<=ssiz%(t4)then t5=t4:s5=s4:nb=nb+1:goto980
  102. 1020 ::rem if we get here, it's end of file
  103. 1030 ::print#4,"    ends ";t5;s5;": ";nb;"[146] blocks"
  104. 1040 ::bsum=bsum+nb
  105. 1050 ::print#3,t$;c$;t;c$;s;c$;nb
  106. 1060 :next s
  107. 1070 next t
  108. 1080 print#3,"end";c$;0;c$;0;c$;0
  109. 1090 print#4,"found ";nfiles;" files"
  110. 1100 print#4,bsum;"blocks accounted for"
  111. 1110 print#4,ms;"critical multiple block references"
  112. 1120 rem list multiple block reference info
  113. 1130 for m=1 to nm
  114. 1140 :print#4,"block at";tmult%(m);smult%(m)
  115. 1150 :tx=tref%(m):sx=sref%(m):gosub1300
  116. 1160 next
  117. 1170 print#4:close4
  118. 1180 close3:gosub1210
  119. 1190 goto1230: rem final exit
  120. 1200 rem ::
  121. 1210 print"";:fork=1to24:print:next:input#15,a,b$,c,d:print a;b$;c;d:return
  122. 1220 rem ::
  123. 1230 gosub1210:close2:close3:close4:close15:end:rem final exit
  124. 1240 rem ::
  125. 1250 rem to create a string number with leading zeros
  126. 1260 rem 'i' is converted into a 3-character ascii string t$
  127. 1270 s$=str$(i):l=len(s$)
  128. 1280 t$="f"+left$("0000",4-l)+right$(s$,l-1)
  129. 1290 return
  130. 1300 rem ::
  131. 1310 rem subroutine to search back to find start of file, given arbitrary t/s.
  132. 1320 rem given tx,sx returns starting block in tx,sx
  133. 1330 print#4,"referenced in:";tx;sx;
  134. 1340 tb=tback%(tx,sx):sb=sback%(tx,sx)
  135. 1350 :if tb<1 or tb>tsiz then goto1380
  136. 1360 :if sb>ssiz%(tb) then goto1380:rem found start
  137. 1370 : tx=tb:sx=sb:goto 1340: rem try next block back
  138. 1380 print#4,"starting from:";tx;sx
  139. 1390 return
  140.