AFSFiler.src

10 REM > AFSFiler/src v1.32 J.G.Harston

20 REM 19-Nov-2010 v0.14 Initial version based on SJFiler

30 REM 05-Aug-2012 v0.15 L3FS disks done, sequential and interleaved

40 REM 28-May-2017 v0.16 Checks JesMap for file allocation blocks, updated os%, FNfn_todos

50 REM 30-May-2018 v0.17 (C)onfirm option, OPT command, checks for outside image file

60 REM 08-Jun-2018 v0.18 Reads file lengths, buffers allocation map

70 REM 05-Apr-2018 v1.30 Bring all Filers to same version number

80 REM 19-Mar-2020 v1.30a Probe for FSOp before writing long info

90 REM 20-Mar-2020 v1.30b Multiple JesMaps, COPY $ works inside a subdirectory

100 REM 22-Mar-2020 v1.30c Forces ADFS for FNscsi disk access

110 REM 24-Mar-2020 v1.30d Follow multiple JesMaps to find file length

120 REM 25-Mar-2020 v1.30e SIN chaining JesMaps is 24-bit

130 REM 28-Mar-2020 v1.30f Testing and tweeking, COPY sets top dir metadata

140 REM 30-Mar-2020 v1.30g Tweeks and optimisations

150 REM 31-Mar-2020 v1.31 Updated version number

160 REM 27-Apr-2020 v1.31a Uses deeper REPEAT/UNTIL instead of FOR/NEXT in directory copy

170 REM 28-Apr-2020 v1.31b Fix for FileLen2 where sector is full but no link

180 REM 28-Apr-2021 v1.32 Better SEQ/INT detection, DIR ^ allowed

190 REM 06-May-2021 v1.32c DirSearch finds ^ entry

200 REM Caching allocation is killed by TYPE/DUMP, so disabled.

210 :

220 os%=FNfx(0,1)AND&FF:VDU10,8:A%=POS:VDU13:IFA%<50:MODE&87:IFHIMEM>&7C00:MODE&83:IFHIMEM>&4000:MODE&80

230 IFHIMEM<&FFFF:HIMEM=FNfx(132,0)

240 PROCinit:PROChdr:PRINT:ON ERROR IF FNerr:END

250 curr%=-1:inmem%=0:REPEAT:fs%=FNfs:X%=ctrl%:Y%=X%DIV256:IF POS:PRINT

260 VDU 8:wdt%=POS+1:PRINT

270 IFdrv$="":PRINTCHR$(D%+48)">"; ELSE PRINT"["drv$"]";

280 csd%=home%:INPUTLINE" "A$:PROCdo(FNs(A$))

290 UNTIL0

300 :

310 DEFPROCinit:ver$="1.32c"

320 DIM ctrl% 127,name% 255,data% 255,thisdir% &19FF,alloc% 511:diskrec%=0:IF os%=6:DIM diskrec% 255

330 D%=0:drv$="":path$="":title$="":csd%=0:home%=0:valid%=&30534641:map$="JesMap"

340 fsv%=0:opt%=0:fullinf%=TRUE:d$=".":s$="/":IFos%AND-24:d$="/":s$=".":IFos%AND-32:d$="\"

350 cmd$=":MOUNT:DIR:CAT:EX:INFO:TYPE:DUMP:COPY:BLOCK:INF:HELP:QUIT:"

360 hlp$=":<drive>|<image>:<dir>|&<blocknum>:::(<file>):<file> [CTRLS]:<file> [7BIT]:<source> <dest> (<opts>):<blocknum>:FULL|SHORT:::<opts>:"

370 ENDPROC

380 DEFPROChdr:PRINT"AFSFiler v"ver$" by J.G.Harston":ENDPROC

390 :

400 DEFFNerr:OSCLI"FX229":IF POS:PRINT

410 REPORT:IFFNfs<>fs%:OSCLI"FX143,18,"+STR$fs%

420 PROCCloseAll:A%=ERR<>17 AND ERR<>28:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND A%):=INKEY-1 AND A%

430 DEFPROCCloseAll:REM in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

440 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

450 dsk%=dsk%:IFdsk%:A%=dsk%:dsk%=0:CLOSE#A%

460 ENDPROC

470 :

480 DEFPROCdo(A$):IFA$="?":A$="HELP"

490 IF LEFT$(A$,1)=";" OR A$="":ENDPROC

500 IF LEFT$(A$,1)="*":OSCLIMID$(A$,2):ENDPROC

510 IF LEFT$(A$,1)=".":A$="CAT "+MID$(A$,2)

520 A%=INSTR(A$+" "," "):B$=FNuc(LEFT$(A$,A%-1)):A$=FNs(MID$(A$,A%+1))

530 IF LENB$=1 AND INSTR("01234567",B$):drv$="":D%=VALB$AND(((os%<6)OR3)AND7):home%=0:ENDPROC

540 A%=INSTR(cmd$,":"+B$+":"):IF A%=0:PRINT"Bad command":ENDPROC

550 A%=EVAL("FN_"+B$+"(A$)"):ENDPROC

560 :

570 DEFFNsyn(S$):IF A$="":PRINT "Syntax: "B$" "S$:=TRUE ELSE =FALSE

580 :

590 REM Commands

600 REM ========

610 ; FN_INFO, FN_COPY, FN_QUIT, FN_INF, FN_MOUNT, FN_OPT :REM Prevent crunching

620 ; FN_HELP, FN_TYPE, FN_DUMP, FN_CAT, FN_BLOCK, FN_DIR, FN_EX

630 :

640 DEFFN_QUIT(A$):PRINT"Quit"

650 ON ERROR END

660 IF os%>5:*QUIT

670 END

680 :

690 DEFFN_HELP(A$):PROChdr:p%=2:q%=2:REPEAT

700 A%=INSTR(cmd$,":",p%):PRINT SPC2MID$(cmd$,p%,A%-p%);:p%=A%+1

710 A%=INSTR(hlp$,":",q%):PRINT TAB(8)MID$(hlp$,q%,A%-q%):q%=A%+1

720 UNTIL p%>LENcmd$:=0

730 :

740 DEFFN_OPT(A$):REM IF A$="":PRINT"OPT=";opt%'"1:"'"2:"'"4:"'"8:":=0

750 fsv%=VAL(A$):=0

760 :

770 DEFFN_INF(A$):IFA$="":PRINT"Output "LEFT$("FULL",fullinf%);LEFT$("SHORT",NOTfullinf%)" .inf info":=0

780 fullinf%=FNuc(A$)="S":=0

790 :

800 DEFFN_MOUNT(A$):home%=0:IF LENA$<2:PROCdo(A$):=0 ELSE drv$=FNs(A$):D%=-1:=0

810 DEFFN_CAT(A$):PROCLstDir(0):=0

820 DEFFN_EX(A$):PROCLstDir(1):=0

830 :

840 DEFFN_DIR(A$):curr%=-1:IF FNsyn("<dir>|&<blocknum>"):=TRUE

850 IF LEFT$(A$,1)="&":A%=FNMount:home%=EVAL(FNuc(A$)):path$="&"+FNh0(home%,6):=0

860 IF A$="$":A%=FNMount:home%=root%:path$="$":=0

870 IF FNlook:=TRUE

880 IF(fptr%?&14 AND &20)=0:PRINT"'"src$"' not a directory":=TRUE

890 A%=fptr%?&C:fptr%?&C=13:path$=path$+"."+FNs($(fptr%+2)):fptr%?&C=A%

900 IF RIGHT$(path$,2)=".^":A%=LENpath$-1:REPEATA%=A%-1:UNTILMID$(path$,A%,1)="."ORA%<2:path$=LEFT$(path$,A%+(A%>1))

910 home%=fptr%!&17 AND &FFFFFF

920 =0

930 :

940 DEFFN_BLOCK(A$):IF FNsyn("<blocknum>"):=TRUE

950 blk%=EVAL("&"+FNuc(A$))AND&FFFFFF:PROCRdBlocks(data%,blk%,D%,1):S%=blk%*256:O%=data%:ln%=256:PROCdump

960 =0

970 :

980 DEFFN_DUMP(A$):IF FNsyn("<fsp>"):=TRUE

990 IF FNlook:=TRUE

1000 PROCFileInfo(fptr%,1):S%=0:REPEAT:PROCReadData:PROCdump:UNTILeof%

1010 =0

1020 :

1030 DEFPROCdump:cols%=16:IF wdt%<80:cols%=8

1040 FOR P%=0 TO ln%-1 STEP cols%:B$=""

1050 PRINT FNh0(P%+S%,8)" ";:FOR Q%=P% TO P%+cols%-1

1060 IF Q%<ln%:PRINT FNh0(?O%,2)" "; ELSE ?O%=32:PRINT SPC3;

1070 A$=CHR$(?O%AND&7F):IF A$>=" " AND A$<="~" B$=B$+A$ ELSE B$=B$+"."

1080 O%=O%+1:NEXT:PRINT B$:NEXT:S%=S%+ln%:ENDPROC

1090 :

1100 DEFFN_TYPE(A$):IF FNsyn("<fsp>"):=TRUE

1110 msk%=INSTR(A$," [")<>0:msk%=(msk%AND&80)OR&7F:A$=LEFT$(A$,INSTR(A$+" "," ")-1)

1120 IF FNlook:=TRUE

1130 PROCFileInfo(fptr%,1):S%=0:last%=0:REPEAT:PROCReadData

1140 FOR P%=0 TO ln%-1:Q%=?O%ANDmsk%:IFmsk%=255:VDUQ% ELSE IFQ%=10 OR Q%=13 OR Q%>31 VDUQ%

1150 IF(Q%=10 OR Q%=13) AND Q%<>last%:VDU23-Q%

1160 IFQ%=9:PRINTSPC(8-(POS MOD 8));

1170 last%=?O%:O%=O%+1:NEXT:S%=S%+ln%

1180 UNTIL eof%:IFPOS:PRINT

1190 =0

1200 :

1210 DEFFN_INFO(A$)

1220 IF A$<>"":IF FNlook:=TRUE

1230 IF A$<>"":x%=0:PROCListFile(1):=0

1240 IF FNMount:=TRUE

1250 PROCHdr:PRINTSPC(18-LENtitle$);MID$("SEQINTMUX",(fsv%AND3)*3+1,3)" DEN=";fsv%DIV4+1

1260 PRINT"Root: &"FNh0(root%,6)" CrDate: "FNdate(idate%)

1270 PRINT"MapA: &"FNh0(mapa%,6);MID$("* ",(mapa%=map%)+2,1)" ";

1280 PRINT"MapB: &"FNh0(mapb%,6);MID$("* ",(mapb%=map%)+2,1)" ";

1290 PRINT"MapSz: ";mapsz%'"Size: &"FNh0(dsize%,6)" ";dsize%DIV4;"K ";(dsize%AND-512)/4096;"M"

1300 =0

1310 :

1320 DEFFN_COPY(A$):IF FNsyn("<afs0 source> (inf:)<host dest> (<C>onfirm)"):=TRUE

1330 REM copy * path

1340 REM copy * inf:path

1350 A%=INSTR(A$+" "," "):src$=LEFT$(A$,A%-1):dst$=FNs(MID$(A$,A%+1))

1360 cnf%=FNuc(RIGHT$(dst$,2))=" C":IF cnf%:dst$=FNs(LEFT$(dst$,LENdst$-2))

1370 inf%=FNuc(LEFT$(dst$,4))="INF:":IFinf%:dst$=MID$(dst$,5)

1380 IFdst$="":PRINT"<dest> missing":=TRUE

1390 IFos%<6:IFINSTR(dst$,"::")ORLEFT$(dst$,1)="-":PRINT"FS prefix unsupported":=TRUE

1400 A$=src$:IF A$<>"$":IF FNlook:=TRUE

1410 IFsrc$="$":A%=FNMount:fptr%=data%:fptr%?&14=&20:fptr%!&17=root%:curr%=-1:IF A%<0:=TRUE

1420 IF((fptr%?&14)AND&20)=0:leaf$=src$:PROCCopyOneFile(src$,dst$):=0:REM copy single file

1430 :

1440 REM src=directory, copy all recursively

1450 A%=FNfile(dst$,8):dst$=dst$+d$:REM Create target directory

1460 oldcsd%=csd%:oldfptr%=fptr%:curr%=-1:csd%=fptr%!&17 AND &FFFFFF:PROCCopyDirectory(dst$)

1470 REM Set info on top directory

1480 A%=LENdst$:REPEATA%=A%-1:UNTIL MID$(dst$,A%,1)=d$ OR A%<1:leaf$=MID$(dst$,A%+1,LENdst$-A%-1):dst$=LEFT$(dst$,A%)

1490 IFsrc$="$":load%=0:exec%=0:length%=&200:attr%=8:mdate%=idate%:PROCSetInfo(dst$+leaf$):=0

1500 PROCSetDir:=0

1510 :

1520 :

1530 REM File copying code

1540 REM =================

1550 :

1560 DEFPROCCopyDirectory(dst$):LOCAL entry%,leaf$

1570 PROCRdDir:fptr%=thisdir%:IF thisdir%?15=0:ENDPROC

1580 REM FOR entry%=1 TO thisdir%?15

1590 REM fptr%=thisdir%+(!fptr% AND &FFFF):PROCCopyObject

1600 REM NEXT entry%

1610 entry%=1:REPEAT:fptr%=thisdir%+(!fptr% AND &FFFF):PROCCopyObject

1620 entry%=entry%+1:UNTIL entry%>thisdir%?15

1630 ENDPROC

1640 :

1650 DEFPROCCopyObject:LOCAL oldcsd%,oldfptr%

1660 PROCFileInfo(fptr%,1):IF fname$="":ENDPROC:REM Broken entry

1670 IFcnf%:PRINT"Copy "fname$;:cnf%=FNyna(cnf%):IFcnf%>0:PRINT:ENDPROC ELSE VDU13

1680 leaf$=fname$:fname$=FNfn_todos(fname$)

1690 IF((fptr%?&14)AND&20)=0:PROCCopyOneFile(fname$,dst$+fname$):ENDPROC

1700 :

1710 REM Descend into directory

1720 PRINT"Copying "fname$;SPC(10-LENfname$)" to "dst$+fname$

1730 oldcsd%=csd%:oldfptr%=fptr% :REM Save current directory

1740 curr%=-1:csd%=fptr%!&17 AND &FFFFFF :REM Select new directory

1750 A%=FNfile(dst$+fname$,8) :REM Create matching destination directory

1760 PROCCopyDirectory(dst$+fname$+d$) :REM Copy directory at cblk%

1770 PROCSetDir:ENDPROC

1780 :

1790 DEFPROCSetDir

1800 curr%=-1:csd%=oldcsd%:PROCRdDir:fptr%=oldfptr% :REM Restore previous

1810 PROCFileInfo(fptr%,1):PROCSetInfo(dst$+fname$) :REM Set directory's metadata

1820 ENDPROC

1830 :

1840 DEFPROCCopyOneFile(src$,dst$)

1850 PRINT"Copying "src$;SPC(10-LENsrc$)" to "dst$;SPC4;

1860 PROCFileInfo(fptr%,1):IFFNfile(dst$,5):X%!14=&33:A%=FNfile(dst$,4)

1870 X%!2=load%:X%!6=exec%:X%!10=0:X%!14=&4000:A%=FNfile(dst$,7)

1880 IFlength%:PROCCopyData:REM Copy if length<>0

1890 PROCSetInfo(dst$):PRINTSTRING$(3,CHR$127)

1900 ENDPROC

1910 :

1920 DEFPROCCopyData

1930 out%=FNf_openout(dst$):S%=0:REPEAT:PROCReadData:IF POS=0:PRINTSPC4;

1940 IF(S%AND1023)=0:PRINT STRING$(3,CHR$8)FNd0(100*S%DIVlength%,2)"%";

1950 IFln%:PROCgbpb(2,out%,data%,ln%,0):S%=S%+ln%

1960 UNTIL eof%:CLOSE#out%:out%=0:length%=S%

1970 ENDPROC

1980 :

1990 DEFPROCSetInfo(dst$):X%!2=load%:X%!6=exec%:X%!10=length%:X%!14=attr%:A%=FNfile(dst$,1)

2000 A$=leaf$+STRING$(11-LENleaf$," ")+FNh0(load%,8)+" "+FNh0(exec%,8)+" "+FNh0(length%,8)

2010 IFfullinf%:A$=A$+" "+FNh0(attr%AND255,2)+" "+FNh0(mdate%,4)

2020 A$=A$+CHR$13+CHR$10

2030 IFinf%:out%=OPENOUT(dst$+s$+"inf"):FOR p%=1 TO LEN A$:BPUT#out%,ASCMID$(A$,p%,1):NEXT:CLOSE#out%:out%=0

2040 IFfs%<>5:ENDPROC

2050 A%=FNNetFS_Op(19,CHR$4+CHR$access%+dst$) :REM Write access

2060 X%!8=mdate%:A%=FNNetFS_OpN(19,5,10,dst$) :REM Write create date from mdate

2070 IF FNNetFS_Op(18,CHR$64+dst$):ENDPROC :REM create&mod date&time don't exist

2080 X%!8=mdate%:X%!10=0:X%!13=mdate%:X%!15=0

2090 A%=FNNetFS_OpN(19,64,18,dst$) :REM Write create&mod date&time

2100 ENDPROC

2110 :

2120 :

2130 REM Object display routines

2140 REM =======================

2150 :

2160 DEFPROCHdr:PRINT"Disk: L";fsv%DIV4+2;"FS::"title$;:ENDPROC

2170 :

2180 DEFPROCLstDir(cflg%):x%=0:IF FNMount:PRINT"Not an AFS0 disk":ENDPROC

2190 REM cflg%=0 - CAT, cflg%=1 - EX

2200 PROCHdr:PRINT "."path$'

2210 PROCRdDir:fptr%=thisdir%:IF thisdir%?15=0:ENDPROC

2220 FOR entry%=1 TO thisdir%?15

2230 fptr%=thisdir%+(!fptr% AND &FFFF):PROCListFile(cflg%)

2240 NEXT entry%:IF POS:PRINT:REM IF(x%AND3):IF(cflg%AND1)=0:PRINT

2250 ENDPROC

2260 :

2270 DEFPROCListFile(cflg%)

2280 PROCFileInfo(fptr%,cflg%):PRINTfname$;SPC(11-LENfname$);

2290 IF(cflg%AND1):PRINTFNh0(load%,8)" "FNh0(exec%,8)" "FNh0(length%,6)" ";

2300 PRINTFNattr(access%);

2310 IF(cflg%AND1):PRINTFNdate(mdate%)" "FNh0(sin%,6):ENDPROC

2320 x%=x%+1:IF x%<(wdt%+1) DIV 20:PRINT " "; ELSE x%=0:PRINT

2330 ENDPROC

2340 :

2350 DEFFNattr(A%):A$=""

2360 IF(A%AND1):A$="r"+A$

2370 IF(A%AND2):A$="w"+A$

2380 A$="/"+A$

2390 IF(A%AND4):A$="R"+A$

2400 IF(A%AND8):A$="W"+A$

2410 IF(A%AND16):A$="L"+A$

2420 IF(A%AND32):A$="D"+A$

2430 IF(A%AND64):A$="P"+A$

2440 IF(A%AND128):A$="M"+A$

2450 =A$+STRING$(8-LENA$," ")

2460 :

2470 DEFFNdate(A%)=FNd0(A%AND31,2)+"/"+FNd0((A%DIV256)AND15,2)+"/"+FNd0(1981+(A%DIV4096)+((A%AND&E0)/2),4)

2480 :

2490 DEFFNtime(A%)=FNd0(A%AND255,2)+":"+FNd0(A%DIV256,2)

2500 :

2510 :

2520 REM Catalog manipulation routines

2530 REM =============================

2540 :

2550 DEFFNlook:src$=A$:fptr%=FNfind(src$):IFfptr%:=FALSE

2560 PRINT"'"src$"' not found":=TRUE

2570 :

2580 DEFFNfind(A$):match$=FNuc(LEFT$(A$,10)):match%=0:IFFNMount:=0

2590 PROCRdDir:IFmatch$="^":IFthisdir%!17=&FFFF:thisdir%!19=&D5E:thisdir%?37=32:=thisdir%+17

2600 fptr%=thisdir%:entry%=1:IFthisdir%?15=0:=0

2610 REPEAT:fptr%=thisdir%+(!fptr% AND &FFFF)

2620 A%=fptr%?&C:fptr%?&C=13:fname$=FNs($(fptr%+2)):fptr%?&C=A%

2630 match%=(FNuc(fname$)=match$):entry%=entry%+1

2640 UNTIL entry%>thisdir%?15 OR match%

2650 IF match%:=fptr% ELSE =0

2660 :

2670 DEFPROCFileInfo(f%,i%)

2680 A%=f%?&C:f%?&C=13:fname$=FNs($(f%+2)):f%?&C=A%

2690 FOR A%=1 TO LEN fname$:IF MID$(fname$,A%,1)<"!" OR MID$(fname$,A%,1)>"~":fname$=""

2700 NEXT A%

2710 load%=f%!&0C:exec%=f%!&10:access%=f%?&14:mdate%=f%!&15 AND &FFFF:sin%=f%!&17 AND &FFFFFF

2720 length%=0:attr%=(access%AND3)*16+(access%AND&C)/4+(access%AND16)/2+mdate%*256

2730 IF (i%AND1)=0 OR sin%=0:ENDPROC

2740 IF fsv%<4:PROCFileLen1:ENDPROC ELSE PROCFileLen2:ENDPROC

2750 :

2760 DEFPROCFileLen1

2770 offset%=sin%:REPEAT

2780 offset%=(offset%AND&FFF)*2+5 :REM Offset to allocation map entry

2790 PROCRdAlloc(map%+offset%DIV256,2) :REM Read sectors of allocation map allowing for overlap

2800 offset%=alloc%!(offset%AND255) AND &FFFF :REM Get next allocation map entry

2810 length%=length%+256:UNTIL offset% AND &4000

2820 A%=offset% AND 255:IF A%:length%=length%+A%-256:REM Low byte of length

2830 ENDPROC

2840 :

2850 DEFPROCFileLen2

2860 PROCRdAlloc(sin%,1):IFFNChkMap(alloc%):PRINT"Bad map":ENDPROC

2870 B%=alloc%?8:IF B%:length%=B%-256 :REM Low byte of length

2880 REPEAT

2890 A%=12:REPEAT:B%=alloc%!A% AND &FFFF00:length%=length%+B%:A%=A%+5:UNTIL B%=0 OR A%>&F9

2900 IF A%>&F9:B%=alloc%!250 AND &FFFFFF:IF B%:PROCRdAlloc(B%,1)

2910 UNTIL B%=0

2920 ENDPROC

2930 :

2940 DEFPROCRdDir:IFcurr%=csd%:ENDPROC

2950 IFfsv%<4:PROCRdDir1 ELSE PROCRdDir2

2960 curr%=csd%:ENDPROC

2970 :

2980 DEFPROCRdDir1

2990 addr%=thisdir%:fptr%=csd%:REPEAT

3000 PROCRdBlocks(addr%,fptr% AND &FFF,D%,1) :REM Read a directory sector

3010 offset%=(fptr%AND&FFF)*2+5 :REM Offset to allocation map entry

3020 PROCRdAlloc(map%+offset%DIV256,2) :REM Read sectors of allocation map

3030 fptr%=alloc%!(offset%AND255) AND &FFFF :REM Get next allocation map entry

3040 addr%=addr%+256:UNTIL (fptr% AND &4000)

3050 ENDPROC

3060 :

3070 DEFPROCRdDir2

3080 PROCRdAlloc(csd%,1):IF FNChkMap(alloc%):PRINT"Bad map":thisdir%?15=0:ENDPROC

3090 addr%=thisdir%:fptr%=alloc%+10:REPEAT

3100 PROCRdBlocks(addr%,!fptr% AND &FFFFFF,D%,fptr%!3 AND &FFFF)

3110 addr%=addr%+256*(fptr%!3 AND &FFFF):fptr%=fptr%+5

3120 UNTIL (!fptr% AND &FFFFFF)=0

3130 ENDPROC

3140 :

3150 :

3160 REM Disk access routines

3170 REM ====================

3180 REM Internal disk errors are:

3190 REM -1 Unsupported on this hardware

3200 REM -2 Disk/image not present

3210 REM -3 Past end of image

3220 REM -4

3230 REM -5 Not a recognised disk

3240 REM -6 Can only do subset of disk types

3250 :

3260 DEFFNMount:IFcsd%:=0

3270 curr%=-1:home%=0:inmem%=0:bps%=256:fsv%=8:REPEAT:fsv%=fsv%+((fsv%AND3)=0)-1:IFfsv%<4:spt%=10 ELSE spt%=16

3280 PROCfdcInit(diskrec%,8,spt%,2,fsv%DIV4+1,80,0):!data%=0:PROCRdBlocks(data%,0,D%,1)

3290 :

3300 REM L2FS, follow pointer from disk info block to root directory

3310 IF fsv%<4:root%=data%!22 AND &FFFFFF:IF !data%=valid%:dib%=0:PROCRdBlocks(data%,root%,D%,1):IF root%<spt%:fsv%=0:REM fetch root

3320 :

3330 REM L3FS, follow pointer from ADFS block to disk info block to root directory

3340 IF fsv%>3:!data%=-1:dib%=data%!&F6 AND &FFFFFF:PROCRdBlocks(data%,dib%,D%,1):REM fetch info block

3350 IF fsv%>3:!data%=-1:root%=data%!&1F AND &FFFFFF:PROCRdBlocks(data%,root%,D%,1):REM fetch root map

3360 IF fsv%>3:!data%=-1:PROCRdBlocks(data%,data%!&0A AND &FFFFFF,D%,1):REM fetch root dir

3370 :

3380 ?data%=-1:IF data%!3=&20202024:!data%=valid%

3390 UNTIL fsv%=0 OR !data%=valid%

3400 :

3410 IF!data%=0:IFdrv$<>"":err%=-2:REM Disk image not found

3420 IFerr%=-2:PRINT "Disk error: image file not found":=-2

3430 IF!data%<>valid%:=-5 :REM Not an AFS0 disk

3440 PROCRdBlocks(data%,dib%,D%,1):path$="$"

3450 A%=data%?20:data%?20=13:title$=FNs($(data%+4)):data%?20=A%

3460 :

3470 REM Level3FS:

3480 freec%=data%!36 AND &FFFF:idate%=data%!34 AND &FFFF:root%=data%!31 AND &FFFFFF:dnxt%=data%?29

3490 mapsz%=data%?28:nsec%=data%!26 AND &FFFF:ndsks%=data%?25:dsize%=data%!22 AND &FFFFFF

3500 ntrk%=data%!20 AND &FFFF:mapb%=0:mapa%=0:map%=0:home%=root%:csd%=home%

3510 IF fsv%>3:=0

3520 :

3530 REM Level2FS:

3540 mapsz%=data%?33:mapb%=data%!30 AND &FFFFFF:mapa%=data%!27 AND &FFFFFF

3550 idate%=data%!25 AND &FFFF:root%=data%!22 AND &FFFFFF:dsize%=(data%!20 AND &FFFF)*2

3560 map%=mapa%:home%=root%:csd%=home%

3570 PROCRdBlocks(data%,mapa%,D%,1):f%=?data%

3580 PROCRdBlocks(data%,mapb%,D%,1):IF((f%-?data%)AND255)=255:map%=mapb%

3590 =0

3600 :

3610 DEFPROCReadData

3620 IFsin%=0:ln%=0:eof%=TRUE:ENDPROC :REM length%=0 or past end of file

3630 IFfsv%<4:PROCReadData1 ELSE PROCReadData2

3640 O%=data%:ENDPROC

3650 :

3660 DEFPROCReadData1

3670 PROCRdBlocks(data%,sin% AND &FFF,D%,1) :REM Read a file sector

3680 offset%=(sin%AND&FFF)*2+5 :REM Offset to allocation map entry

3690 PROCRdAlloc(map%+offset%DIV256,2) :REM Read sectors of allocation map

3700 sin%=alloc%!(offset%AND255) AND &FFFF :REM Get next allocation map entry

3710 eof%=sin%AND&4000:ln%=256

3720 IFeof%:ln%=sin%AND255:IFln%=0:ln%=256 :REM Last sector

3730 ENDPROC

3740 :

3750 DEFPROCReadData2

3760 eof%=0:IFS%=0:aptr%=0

3770 IF aptr%=0:PROCRdAlloc(sin%,1):IF FNChkMap(alloc%):PRINT"Bad map":eof%=TRUE:ln%=0:ENDPROC

3780 ln%=alloc%?8:REPEAT:IF aptr%<10:aptr%=10

3790 sec%=alloc%!aptr% AND &FFFFFF :REM Get sector start

3800 num%=alloc%!(aptr%+3) AND &FFFF :REM Get number of sectors

3810 IF aptr%=250:PROCRdAlloc(sec%,1):alloc%?8=ln%:aptr%=0 :REM Chain to next allocation map

3820 UNTIL aptr%:PROCRdBlocks(data%,sec%,D%,1) :REM Read a file sector

3830 sec%=sec%+1:num%=num%-1:alloc%!aptr%=sec%

3840 alloc%?(aptr%+3)=num%:alloc%?(aptr%+4)=num%DIV256

3850 ln%=256:IFnum%=0:aptr%=aptr%+5:IFalloc%!aptr%=0:eof%=TRUE:ln%=alloc%?8:IFln%=0:ln%=256

3860 ENDPROC

3870 :

3880 DEFPROCRdAlloc(sin%,num%):IF sin%=inmem%:ENDPROC

3890 PROCRdBlocks(alloc%,sin%,D%,num%):inmemX%=sin%:ENDPROC

3900 :

3910 DEFFNChkMap(B%):A%=B%?6:B%?6=13:IF $B%=map$:B%?6=A%:=B%?6<>B%?255 ELSE B%?6=A%:=TRUE

3920 :

3930 DEFPROCRdBlocks(ad%,bl%,dv%,nm%):LOCAL p%

3940 err%=0:FOR p%=0 TO nm%-1:PROCfdcRd(ad%+p%*256,bl%+p%,dv%,1,fsv%DIV4+1)

3950 NEXT:ENDPROC

3960 :

3970 :

3980 REM FDC routines

3990 REM ============

4000 :

4010 DEFPROCfdcInit(dskrec%,bps%,spt%,hds%,den%,trks%,sec0%)

4020 LOCAL i%:IFos%<>6:ENDPROC

4030 dskrec%?0=bps%:dskrec%?1=spt%:dskrec%?2=hds%:dskrec%?3=den%:IFden%=1:dskrec%?2=1

4040 FOR i%=4 TO 59 STEP 4:dskrec%!i%=0:NEXT:dskrec%!60=&20000000:dskrec%!64=&20000000

4050 dskrec%?8=sec0%:dskrec%!16=trks%*spt%*(2^bps%)*hds%

4060 ENDPROC

4070 :

4080 DEFPROCfdcRd(addr%,sec%,drv%,num%,den%)

4090 FORA%=0TO255STEP4:addr%!A%=0:NEXT:IFdrv%>7:err%=-1:ENDPROC

4100 :

4110 REM fsv%=

4120 REM 0=L2FS SEQ

4130 REM 1=L2FS INT

4140 REM 2=L2FS MUX

4150 REM 4=L3FS SEQ

4160 REM 5=L3FS INT

4170 REM 6=L3FS MUX

4180 A%=sec%DIVspt%

4190 IFfsv%AND1:sec%=((A%MOD80)*2+(A%DIV80))*spt%+(sec%MODspt%)

4200 IFfsv%AND2:sec%=((A%MOD2)*80+(A%DIV2))*spt%+(sec%MODspt%)

4210 IFdrv$="":REPEAT:PROCfdcOp(1):addr%=addr%+256:sec%=sec%+1:num%=num%-1:UNTILnum%<1:ENDPROC

4220 dsk%=FNf_openin(drv$):IFdsk%=0:err%=-2:ENDPROC

4230 IFsec%*256>EXT#dsk%:CLOSE#dsk%:dsk%=0:err%=-3:PRINTLEFT$("Disk error: past end of image"+CHR$10+CHR$13,curr%<>-1);:ENDPROC

4240 PROCgbpb(3,dsk%,addr%,num%*256,sec%*256):CLOSE#dsk%:dsk%=0

4250 ENDPROC

4260 :

4270 DEFPROCfdcOp(op%)

4280 IFos%=6:SYS"XADFS_DiscOp",0,op%+64+(diskrec%<<6),sec%*bps%+((drv%AND3)<<29),addr%,bps% TO err%

4290 IFos%<6:IFden%=1:IFop%=1:err%=FNdisk(addr%,&53,(drv%AND3)+2*(sec%DIV800),(sec%DIV10)MOD80,sec%MOD10,1,den%)

4300 IFos%<6:IFden%>1:IFop%=1:err%=FNscsi(addr%,&08,drv%,sec%,1)

4310 IFcsd%=0:ENDPROC

4320 IFerr%:IFPOS:PRINT

4330 IFerr%=-1:PRINT"Unsupported":ENDPROC

4340 IFerr%:PRINT"Disk error &"FNh0(err%,2)" at ";drv%":"FNh0(sec%,6)

4350 ENDPROC

4360 :

4370 :

4380 REM Translate leafname if saving to DOS

4390 REM ===================================

4400 REM / ? < > + = ; \ = become . # $ ^ & @ % ~

4410 DEFFNfn_todos(A$):LOCAL B%:IF(os%AND-32)=0:=A$

4420 FORA%=1TOLENA$:B%=INSTR("/?<>+=;\",MID$(A$,A%,1)):IFB%:A$=LEFT$(A$,A%-1)+MID$(".#$^&@%~",B%,1)+MID$(A$,A%+1)

4430 NEXT:=A$

4440 :

4450 DEFFNyna(A%):IFA%=0:=0

4460 PRINT"? (Y/N/A)";:REPEAT:A%=INSTR("YAN",CHR$(GETAND&DF)):UNTILA%

4470 PRINTSTRING$(7,CHR$127);MID$("YesAllNo ",A%*3-2,3);:=A%-2

4480 :