10 REM for compilation only - not to be interpreted
20 'Display File Allocation Table and Directory
30 CLS :CLEAR ' by J.L. Aker - San Jose CA
40 DEFINT B,D,F,I,T,S,K,N,R :DEF SEG
50  C$=STRING$(28,"1") 'dummy string for code
60  BFR$=STRING$(512,"1")  'buffer for data
70 DIM SS(318),NA$(112) : CR$=CHR$(13)
80 INPUT"Drive, A or B";SG$
90 IF SG$="b" OR SG$="B" THEN DRV=1
100 INPUT"Screen or Printer, S or P";SG$
110 IF SG$="p" OR SG$="P" THEN DEV$="LPT1:" ELSE DEV$="SCRN:" : GOTO 140
120 INPUT"Condensed print, Y or N";SG$
130 IF SG$="n" OR SG$="N" THEN SG$="2"+CHR$(18) ELSE SG$="0"+CHR$(15)
140 INPUT"Skip Deleted Directory slots, Y or N";DS$
150 OPEN DEV$ FOR OUTPUT AS 1
160 IF DEV$="LPT1:" THEN LPRINT CHR$(27);SG$;
170 DATA 16,BA,00,00,B9,04,00,B8
180 DATA 79,0E,8B,D8,B8,01,02,CD
190 DATA 13,B7,00,8A,DC,9A,07,00
200 DATA 00,F6,17,CB
210 OFS=VARPTR(C$) 'string descriptor
220 OFC=PEEK(OFS+3)*256+PEEK(OFS+2) 'address of code
230 DEF USR0=OFC 'point to code and move in code bytes
240 FOR I = 0 TO LEN(C$)-1
250  READ S$
260  POKE OFC+I,VAL("&h"+S$)
270 NEXT I
280 OT=OFC+6 : OS=OFC+5 : OH=OFC+3
290 SPTR=VARPTR(BFR$)
300 SOFS=PEEK(SPTR+3)*256+PEEK(SPTR+2)
310 POKE OFC+8,SOFS AND &HFF : POKE OFC+9,SOFS\256
320 'get fat sector
330 POKE OT,0 :POKE OS,2 :POKE OFC+2,DRV
340 GOSUB 1110 ' read sector
350 N=0 'Get the data bytes in array SS; SS(0)=4095 => 320kb format
360 FOR I = 0 TO 474 STEP 3
370  B1=PEEK(I+SOFS)
380  B2=PEEK(I+1+SOFS)
390  B3=PEEK(I+2+SOFS)
400  SS(N)=B1+(B2 AND &HF)*256
410  SS(N+1)=(B2 AND &HF0)\16+B3*16
420  N=N+2
430 NEXT I
440 IF SS(0)=4095 THEN DSD=-1 ELSE DSD=0
450 PRINT #1, "File Allocation Table:";CR$;"   ";
460 FOR I=0 TO 15 :PRINT #1, USING"\  \";" --"+HEX$(I); :NEXT I
470 PRINT #1, SPC(3);"Tracks"
480 PRINT #1, "00- "; :T=0
490 FOR I=0 TO 314-DSD*2 STEP 16
500  FOR K=0 TO 15
510 IF SS(I+K)=0 THEN FSEC=FSEC+1
520   PRINT #1, USING "\  \";RIGHT$("00"+HEX$(SS(I+K)),3);
530   IF I+K=314-DSD*2 THEN 570
540  NEXT K
550  PRINT #1, USING "###";T;T+1;T+2
560  PRINT #1, RIGHT$("0"+HEX$((I+16)\16),2)"- "; :T=T+2
570 NEXT I
580 PRINT #1, SPC(20+DSD*8);
590 PRINT #1, USING "###";T;T+1  :PRINT #1," ";SPC(1-DSD);
600 IF DSD THEN 630
610 FOR I=5 TO 20 : PRINT#1,RIGHT$("  "+STR$((I MOD 8)+1),4); :NEXT I
620 PRINT #1," << Sectors" :GOTO 700
630 FOR H=.9 TO 4 STEP .2
640 FOR S=7 TO 14 STEP 2
650 PRINT#1,STR$(INT(H) MOD 2);":";RIGHT$(STR$(S MOD 8),1);
660 H=H+.2
670 NEXT S,H
680 PRINT#1," << Hd:Sec"
690 PRINT#1,"  ";
700 ' Get the Directory
710 HD$="Name     Ext MM/DD/YY HH:MM S/C Length"
720 FOR S=3 TO 6-3*DSD
730 IF S>7 THEN POKE OH,1
740  POKE OS,(S MOD 8)+1
750  GOSUB 1110 ' read sector
760  FOR I=0 TO 15
770   N$=""
780   FOR X=0 TO 31
790    N$=N$+CHR$(PEEK(I*32+X+SOFS))
800   NEXT X
810   NA$((S-3)*16+I)=N$
820  NEXT I
830 NEXT S
840 CNT#=512#*(1-DSD)*FSEC
850 PRINT #1, FSEC;"Free S/C,";CNT#;"Bytes free"
860 PRINT #1,"Directory:";CR$;HD$;"  ";HD$
870 FOR I=0 TO 63-DSD*48
880 IF LEFT$(NA$(I),1)<>CHR$(&HE5) THEN 910
890 IF MID$(NA$(I),2,1)=CHR$(&HF6) THEN I=64-DSD*48 : GOTO 1040
900 IF DS$="n" OR DS$="N" THEN MID$(NA$(I),1,1)="*" ELSE 1050
910 PRINT #1, LEFT$(NA$(I),8);" ";MID$(NA$(I),9,3);
920 B1=ASC(MID$(NA$(I),25,1)) : B2=ASC(MID$(NA$(I),26,1))
930 B3=ASC(MID$(NA$(I),28,1)) : B4=ASC(MID$(NA$(I),27,1))
940 B5!=ASC(MID$(NA$(I),32,1)) : B6!=ASC(MID$(NA$(I),31,1))
950 B7!=ASC(MID$(NA$(I),30,1)) : B8!=ASC(MID$(NA$(I),29,1))
960 B9=ASC(MID$(NA$(I),23,1)) : BA=ASC(MID$(NA$(I),24,1))
970 PRINT #1," ";RIGHT$(STR$(100+(B1 AND &HE0)\32+(B2 AND 1)*8),2);
980 PRINT #1,"-";RIGHT$(STR$(100+(B1 AND &H1F)),2);
990 PRINT #1,"-";RIGHT$(STR$((B2 AND &HFE)\2+80),2);
1000 PRINT #1," ";RIGHT$(STR$(100+BA\8),2);
1010 PRINT #1,":";RIGHT$(STR$(100+B9\32+(BA AND &H7)*8),2);
1020 PRINT #1, USING "\  \";" "+RIGHT$("00"+HEX$(B3*256+B4),3);
1030 PRINT #1, USING "#######";(B5!*256+B6!)*65536!+B7!*256+B8!;
1040 IF POS(0)>72 THEN PRINT #1,  ELSE PRINT #1, "  ";
1050 NEXT I
1060 IF DEV$="LPT1:" THEN LPRINT CR$;DATE$,TIME$;CHR$(27)"2";CHR$(18);CHR$(12)
1070 CLOSE #1 : LOCATE 25,1
1080 INPUT "Run again, Y or N";Q$
1090 IF Q$="y" OR Q$="Y" THEN GOTO 30
1100 cls:END
1110 RET=USR0(0)
1120 IF RET<>0 THEN RET=USR0(0) 'do a retry on error
1130 IF RET<>0 THEN PRINT"Disk error status: ";RIGHT$("0"+HEX$(RET),2) :END
1140 RETURN