10 REM > CPMFiler 1.31a
   20 REM 27-Nov-1998 v1.20 Selects DFS before OSWORD to reset FDC
   30 REM 04-Dec-1998 v1.21 Displays file attributes
   40 REM 27-Nov-1999 v1.22 Accesses disk images
   50 REM 28-Nov-1999 v1.23 FREE and MAP
   60 REM v1.24 AmsDOS, Einstein
   70 REM v1.25 Uppercase, long files
   80 REM v1.26 Try generalising, need to commands to specify disk shape
   90 REM v1.27 28-Apr-2007 Physical disk access on RISC OS, TYPE handles LF/CR/LFCR/CRLF
  100 REM v1.28 12-Aug-2007 Slogger DDCPM image and disk access
  110 REM v1.29 28-Mar-2019 Copy from CPN gets correct name, gets length from EX correctly
  120 REM                   DUMP tidier final line, tidied COPY, added (C)onfirm
  130 REM v1.29a 30-Mar-2019 Tidying up
  140 REM v1.29b 01-Apr-2019 Added ReadSector so can use smaller directory buffer
  150 REM Uses FNMount, changing FNRdDir to PROCRdDir(), new disk read code
  160 REM v1.29c 02-Apr-2019 Rewrote DirLst, checks user, added USER *, testing other images
  170 REM Now small enough to run on BBC again, tidied command list, uses common Syntax code
  180 REM v1.30 20-Mar-2020 Rewritten file access code to match new disk access code, reads
  190 REM multiple extents
  200 REM v1.30b Examine Einstein disk to find alz%,bsh%,drm%
  210 REM v1.30c Optimised search for directory, calculates geometry, Torch images fixed
  220 REM v1.31 31-Mar-2020 Updated version number
  230 REM v1.31a Added AcornCPMv2 hard disk images
  240 :
  250 REM test%=TRUE*0
  260 os%=FNfx(0,1)AND&FF:VDU10,8:A%=POS:VDU13:IFA%<50:MODE&87:IFHIMEM>&7C00:MODE&83:IFHIMEM>&4000:MODE&80
  270 IF HIMEM<&FFFF:HIMEM=FNfx(132,0)
  280 REM IF test%:MODE &80:HIMEM=PAGE+&6300
  290 PROCinit:PRINT"CPMFiler v"ver$" by J.G.Harston"':ON ERROR IF FNerr:END
  300 REPEAT:X%=ctrl%:Y%=X%DIV256:IF POS:PRINT
  310   VDU 8:wdt%=POS+1:PRINT
  320   REM IF test%:DIMA%-1:PRINT"freemem=";HIMEM-A%;" ";
  330   IF drv$="":PRINTCHR$(D%+65);LEFT$(STR$user%,user%>-1);pmt$; ELSE PRINT"["drv$;LEFT$(":"+STR$user%,user%>-1)"] ";
  340   INPUT LINE""A$:PROCdo(FNs(A$))
  350 UNTIL FALSE
  360 :
  370 DEFPROCinit:pmt$=">":ver$="1.31a":max%=&0FFF
  380 DIM ctrl% 31,name% 19,store% 255,data% max%:X%=ctrl%:Y%=X%DIV256
  390 D%=0:drv$="":user%=-1:CPN%=FALSE:bsz%=0:IFos%=6:DIM diskrec% 67
  400 fs%=FNfs:d$=".":s$="/":IFos%AND-24:d$="/":s$=".":IFos%AND-32:d$="\"
  410 cmd$=":MOUNT:USER:DIR:STAT:INFO:TYPE:DUMP:DISS:COPY:FREE:MAP:BLOCK:HELP:QUIT:"
  420 hlp$=":<drive>|<imagefile>:<user>::(<file>):(<file>):<file> [CTRLS]:<file> [7BIT]:<file> (<addr>):<source> <dest> (<opts>):::<sector>:::"
  430 :
  440 REM cmd$=":MOUNT:SET:USER:DIR:STAT:INFO:TYPE:DUMP:DISS:COPY:FREE:MAP:BLOCK:HELP:QUIT:"
  450 REM hlp$=":<drive>|<imagefile>:INT|SEQ:<user>::(<file>):(<file>):<file> [CTRLS]:<file> [7BIT]:<file> (<addr>):<source> <dest> (<opts>):::<sector>:::"
  460 :
  470 ENDPROC
  480 :
  490 DEFFNerr:OSCLI"FX229":IF POS:PRINT
  500 REPORT:IFFNfs<>fs%:OSCLI"FX143,18,"+STR$fs%
  510 PROCCloseAll:A%=ERR<>17 AND ERR<>28:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND A%):=INKEY-1 AND A%
  520 DEFPROCCloseAll:REM in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
  530 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
  540 dsk%=dsk%:IFdsk%:A%=dsk%:dsk%=0:CLOSE#A%
  550 ENDPROC
  560 :
  570 DEFPROCdo(A$):IF A$="?":A$="HELP"
  580 IF LEFT$(A$,1)=";" OR A$="":ENDPROC
  590 IF LEFT$(A$,1)="*":OSCLIMID$(A$,2):ENDPROC
  600 IF LEFT$(A$,1)=".":A$="CAT "+MID$(A$,2)
  610 A%=INSTR(A$+" "," "):B$=FNuc(LEFT$(A$,A%-1)):A$=FNs(MID$(A$,A%+1))
  620 IF LENB$=2 AND RIGHT$(B$,1)=":" AND B$<":":B$=CHR$(ASCB$+17)+":"
  630 IF LENB$=2 AND RIGHT$(B$,1)=":" AND B$>"@" AND B$<"Q":D%=ASCB$-65:drv$="":bsz%=0:ENDPROC
  640 A%=INSTR(cmd$,":"+B$+":"):IF A%=0:PRINT"Bad command":ENDPROC
  650 A%=EVAL("FN_"+B$+"("""+A$+""")"):ENDPROC
  660 :
  670 DEFFNsyn(S$):IF A$="":PRINT"Syntax: "B$" "S$:=TRUE ELSE =FALSE
  680 :
  690 REM Commands
  700 REM ========
  710 ; FN_INFO, FN_COPY, FN_QUIT, FN_FREE, FN_MAP, FN_USER, FN_BLOCK :REM Prevent crunching
  720 ; FN_HELP, FN_TYPE, FN_DUMP, FN_DISS, FN_DIR, FN_STAT, FN_MOUNT, FN_SET
  730 :
  740 DEFFN_QUIT(A$):PRINT"Quit"
  750 ON ERROR END
  760 IF os%>5:*QUIT
  770 END
  780 :
  790 DEFFN_HELP(A$):p%=2:q%=2:REPEAT
  800   A%=INSTR(cmd$,":",p%):PRINT "  "MID$(cmd$,p%,A%-p%);:p%=A%+1
  810   A%=INSTR(hlp$,":",q%):PRINT TAB(8)MID$(hlp$,q%,A%-q%):q%=A%+1
  820 UNTIL p%>LENcmd$:=0
  830 :
  840 DEFFN_MOUNT(A$):bsz%=0:IF A$="":=0 ELSE IF LENA$=1:PROCdo(A$+":"):=0 ELSE D%=-1:drv$=A$:=0
  850 DEFFN_USER(A$):user%=VALA$ OR (A$<"0"):=0
  860 DEFFN_DIR(A$):PROCLstDir(1):=0
  870 DEFFN_STAT(A$):PROCLstDir(3):=0
  880 REM DEFFN_SET(A$):A$=FNuc(A$)
  890 REM IF A$="INT":seq%=FALSE:=0
  900 REM IF A$="SEQ":seq%=TRUE:=0
  910 REM =0
  920 :
  930 DEFFN_BLOCK(A$):IF FNsyn("<blocknum>"):=TRUE
  940 sect%=EVAL("&"+FNuc(A$)):IF FNMount:=TRUE
  950 ptr%=store%:!store%=sect%:store%!16=sect%:ln%=bsz%:PROCdump:=0
  960 :
  970 DEFFN_DUMP(A$):IF FNsyn("<file>"):=TRUE
  980 IF FNlook:=TRUE
  990 PROCdump:=0
 1000 :
 1010 DEFPROCfile0:ext%=0:M%=bsz%-1:ENDPROC
 1020 DEFPROCfile1:IF (P% AND M%)=0:PROCReadData(P% DIV bsz%,ptr%):O%=data%
 1030 ENDPROC
 1040 DEFPROCfile2:IF CPN%=0:IF ln%=bsz%*16:ext%=ext%+exm%+1:ptr%=FNfind(src$,ext%):IF ptr%:ln%=FNlen(ptr%) ELSE ln%=0
 1050 ENDPROC
 1060 :
 1070 DEFPROCdump:cols%=16:B%=0:IFwdt%<80:cols%=8
 1080 PROCfile0:REPEAT:FOR Q%=0 TO ln%-1 STEP cols%:B$="":PRINT FNh0(Q%+B%,6)" ";
 1090     FOR P%=Q% TO Q%+cols%-1:PROCfile1:IF P%<ln%:PRINT FNh0(?O%,2)" "ELSE ?O%=32:PRINT SPC3;
 1100       A$=CHR$(?O% AND &7F):IF A$>=" " AND A$<="~" B$=B$+A$ ELSE B$=B$+"."
 1110 O%=O%+1:NEXT:PRINT B$:NEXT:B%=B%+ln%:PROCfile2:UNTIL ln%<1:ENDPROC
 1120 :
 1130 DEFFN_TYPE(A$):IF FNsyn("<file>"):=TRUE
 1140 msk%=INSTR(A$," [")<>0:msk%=(msk%AND&80) OR &7F:IF FNlook:=TRUE
 1150 PROCfile0:last%=0
 1160 REPEAT:FOR P%=0 TO ln%-1:PROCfile1:Q%=?O% AND msk%:IF ?O%=26:P%=ln%:Q%=0
 1170     IF msk%=&FF:VDU Q% ELSE IF Q%>31 AND Q%<>127:VDU Q%:last%=Q%
 1180     IF msk%=&7F:IF Q%=10 OR Q%=13:IF last%<>23-Q%:VDU 10,13:last%=Q%
 1190     IF msk%=&7F:IF Q%=9:PRINT SPC(8-(POS MOD 8));:last%=Q%
 1200 O%=O%+1:NEXT:PROCfile2:UNTIL ln%<1:=0
 1210 :
 1220 DEFFN_DISS(A$):IF FNsyn("<file>"):=TRUE
 1230 A%=INSTR(A$," "):IF A%:addr%=EVAL("&"+FNuc(MID$(A$,A%+1))):A$=FNs(LEFT$(A$,A%-1)) ELSE addr%=&100
 1240 IF FNlook:=TRUE
 1250 A%=190:!X%=&502004:X%!4=0:CALL &FFF1:IF INSTR($(X%+4),"Z80")=0:PRINT"No Z80 DisAssem routine":=TRUE
 1260 PROCfile0:REPEAT:P%=0:REPEAT:PROCfile1:!X%=&50200C:X%!4=addr%:X%!8=!O%:A%=190:CALL &FFF1
 1270     PRINT FNh0(addr%,4)" ";:FOR Q%=0 TO X%?3-1:PRINT FNh0(O%?Q%,2)" ";:NEXT:PRINT SPC(12-3*X%?3);
 1280     FOR Q%=0 TO X%?3-1:VDU FNc(O%?Q%):NEXT:PRINT SPC(5-X%?3);$(X%+4):IF (X%?2 AND 64):PRINT
 1290     A%=O%-data%:IF A%+X%?3>M%:X%?3=M%-O%+1
 1300 addr%=addr%+X%?3:O%=O%+X%?3:P%=P%+X%?3:UNTIL P%>ln%-1:PROCfile2:UNTIL ln%<1:=0
 1310 REM Misses bytes at end of block
 1320 :
 1330 DEFFN_FREE(A$):IF FNMount:=TRUE
 1340 IF CPN%:PRINT"Not yet done.":=0
 1350 PROCmap(0):used%=0:FOR A%=0 TO dmx%:used%=used%-(FNtst(A%)<>0):NEXT A%
 1360 free%=dsize%DIVbsz%-used%:PRINT
 1370 PRINTFNh0(free%,4)" Blocks = "FNd(free%*bsz%,9)" bytes free"
 1380 PRINTFNh0(used%,4)" Blocks = "FNd(used%*bsz%,9)" bytes used"
 1390 =0
 1400 :
 1410 DEFFN_MAP(A$):IF FNMount:=TRUE
 1420 IF CPN%:PRINT"Not yet done.":=0
 1430 PROCmap(4):FOR A%=0 TO dmx%:IF (A% AND 31)=0:PRINT'FNh0(A%,2*alz%);
 1440   VDU 32:IF FNtst(A%):VDU 35 ELSE VDU 46
 1450 NEXT:PRINT
 1460 =0
 1470 :
 1480 REM This needs speeding up
 1490 DEFPROCmap(A%)
 1500 PRINT"FREE SPACE"LEFT$(" MAP",A%)" ON "CHR$(D%+65)":";
 1510 FOR A%=0 TO 255 STEP 4:store%!A%=0:NEXT A%
 1520 FOR A%=0 TO (drm%+1)/(blm%+1)/4-1:PROCset(A%):NEXT A%
 1530 IF dmx% DIV 8>255:PRINT'"Buffer overflow":ENDPROC
 1540 FOR p%=0 TO drm%:IF (p% AND 15)=0:PROCRdDir(p% DIV 16)
 1550   FOR q%=(p% AND 15)*32+16 TO (p% AND 15)*32+31 STEP alz%
 1560     A%=data%!q% AND &FFFF:IF alz%=1:A%=A% AND &FF
 1570     IF A%:PROCset(A%)
 1580 NEXT q%:NEXT p%:ENDPROC
 1590 DEFPROCset(A%):store%?(A% DIV 8)=store%?(A% DIV 8) OR (2^(A% AND 7)):ENDPROC
 1600 DEFFNtst(A%):=store%?(A% DIV 8) AND (2^(A% AND 7))
 1610 :
 1620 DEFFN_INFO(A$):IF A$<>"":=FN_STAT(A$)
 1630 IF FNMount:=TRUE
 1640 PRINT"Disk Information:"
 1650 PRINT"exm= "FNd(exm%,2)"  stp="FNd(stp%,4)"  drm="FNd(drm%,5)"  alz="FNd(alz%,5)
 1660 PRINT"bsh= "FNd(bsh%,2)"  blm="FNd(blm%,4)"  bsz="FNd(bsz%,5)"  dmx="FNd(dmx%,5)
 1670 PRINT"res= "FNd(res%,2)"  spt="FNd(spt%*ltp%*(2^bps%)DIV128,4)"  hds="FNd(hds%,5)"  tks=";FNd(hds%/ltp%*INT(dsize%/hds%/spt%/ssz%+0.9),5)
 1680 PRINT"den= "FNd(den%,2)"  sec0="FNd(sec0%,3)"  psec="FNd(ssz%/ltp%,4)"  lsec="FNd(ssz%,4)
 1690 PRINT"skew="FNd(skew%,2)"  flip="FNd(flip%,3)"  trk=  "MID$("INTSEQ",(seq%AND1)*3+1,3)"  "type$'
 1700 PRINT"Directory starts at  &"FNh0(res%*ssz%/ltp%,6)
 1710 PRINT"Directory entries:"SPC4;(drm%+1);" x ";stp%;" bytes"
 1720 PRINT"Directory size:"SPC7;(drm%+1)*stp%
 1730 PRINT"Data area starts at  &"FNh0(res%*ssz%/ltp%+(drm%+1)*stp%,6)
 1740 PRINT"Block size:"SPC10"&"FNh0(bsz%,4)
 1750 PRINT"Disk size:"SPC12;dsize%" (";dsize%DIV1024;"K)"
 1760 =0
 1770 :
 1780 DEFFN_COPY(A$):IF FNsyn("<cpm source> <host dest> (<C>onfirm)"):=TRUE
 1790 A%=INSTR(A$+" "," "):src$=LEFT$(A$,A%-1):dst$=FNs(MID$(A$,A%+1))
 1800 cnf%=FNuc(RIGHT$(dst$,2))=" C":IF cnf%:dst$=FNs(LEFT$(dst$,LENdst$-2))
 1810 IF os%<6:IF INSTR(dst$,"::")ORLEFT$(dst$,1)="-":PRINT"FS prefix unsupported":=TRUE
 1820 IF src$="*" OR src$="*.*":PROCCopyDirectory ELSE PROCCopyOneFile(1)
 1830 =0
 1840 :
 1850 :
 1860 REM File copying code
 1870 REM =================
 1880 :
 1890 DEFPROCCopyDirectory
 1900 IF FNMount:ENDPROC
 1910 dest$=dst$:IF dest$<>"":A%=FNfile(dest$,8):dest$=dest$+d$
 1920 m%=(stp% EOR 48)-1:FOR p%=0 TO drm%:PROCRdDir(p% DIV (m%+1))
 1930   ptr%=data%+(p% AND m%)*stp%+(CPN% AND 4):A$="":A%=1:REPEAT
 1940     IF ptr%?A%<>32:A$=A$+CHR$(ptr%?A%):A%=A%+1 ELSE A%=9
 1950     UNTIL A%>8:A$=A$+".":REPEAT:IF ptr%?A%<>32:A$=A$+CHR$(ptr%?A%):A%=A%+1 ELSE A%=12
 1960   UNTIL A%>11:IF user%>=0:IF ?ptr%<>user%:A$=""
 1970   IF CPN%:ptr%=ptr%-4:IF !ptr%=0:A$=""
 1980   IF CPN%=0:IF ptr%?12 AND (NOT exm%):A$=""
 1990   IF CPN%=0:IF ?ptr%>127:A$=""
 2000   IF A$<>"":src$=A$:dst$=dest$+FNfn_undos(A$):PROCCopyObject
 2010 NEXT p%:ENDPROC
 2020 :
 2030 DEFPROCCopyObject
 2040 IF cnf%:PRINT "Copy "src$;:cnf%=FNyna(cnf%):IF cnf%>0:PRINT:ENDPROC ELSE VDU 13
 2050 ptr%=FNinfo:PROCCopyOneFile(0)
 2060 ENDPROC
 2070 :
 2080 DEFPROCCopyOneFile(one%)
 2090 IF dst$="":PRINT"<dest> filename missing":ENDPROC
 2100 PRINT "Copying "src$;SPC(12-LENsrc$)" to "dst$;
 2110 IF one%:ptr%=FNfind(src$,0):IF ptr%=0:PRINT" - not found":ENDPROC
 2120 ln%=FNlen(ptr%):PROCopen:OSCLI"Save "+dst$+" "+STR$~PAGE+"+"+STR$~ln%+" 0 0":IF ln%=0:ENDPROC
 2130 out%=OPENOUT(dst$):IF out%=0:PRINT" - can't open dest":ENDPROC
 2140 PROCfile0:PRINT" **%";:REPEAT:FOR P%=0 TO ln%-1:PROCfile1
 2150     IF (P% AND 1023)=0:PRINT CHR$8;CHR$8;CHR$8;FNd(100*P%DIVln%,2);"%";
 2160 BPUT#out%,?O%:O%=O%+1:NEXT:PROCfile2:UNTIL ln%<1
 2170 CLOSE#out%:out%=0:PRINTCHR$127;CHR$127;CHR$127:ENDPROC
 2180 :
 2190 :
 2200 REM Object display routines
 2210 REM =======================
 2220 :
 2230 DEFPROCLstDir(cflg%):IF FNMount:ENDPROC
 2240 ptr%=0:IF A$<>"":ptr%=FNfind(A$,0):IF ptr%=0:PRINT"'"A$"' not found":ENDPROC
 2250 IF (cflg%AND3)=3:PRINT"D:";
 2260 FOR x%=1 TO (wdt% DIV 32) AND (CPN%<>0)
 2270   IF (cflg%AND3)=3:PRINT"FILENAME.EXT  U LENGTH RSA ";:IF CPN%=0:PRINT"EX <- -- -- -- -- -- ALLOCATION  -- -- -- -- -- ->";
 2280   IF (cflg%AND3)=3:IF CPN%:PRINT"Sect    ";
 2290 NEXT x%:x%=0:PRINT CHR$8:IF ptr%:PROCPrInfo:ENDPROC  :REM Single file
 2300 m%=(stp% EOR 48)-1:FOR p%=0 TO drm%:IF (p% AND m%)=0:PROCRdDir(p% DIV (m%+1))
 2310   ptr%=data%+(p% AND m%)*stp%:PROCPrInfo
 2320 NEXT p%:IF POS:PRINT
 2330 ENDPROC
 2340 :
 2350 DEFPROCPrInfo
 2360 IF CPN%=0:IF ?ptr%>127:ENDPROC
 2370 IF CPN%:IF ?ptr%+ptr%?1=0 OR ?ptr%+ptr%?1=510:ENDPROC
 2380 IF user%>=0:IF ptr%?(CPN%AND4)<>user%:ENDPROC
 2390 IF x%=0:PRINTCHR$(65+D%)":";
 2400 PROCPrN(ptr%+(CPN%AND4)+1):x%=x%+1:IF x%>=wdt% DIV 16:x%=0:PRINT:ENDPROC
 2410 IF (cflg% AND 2)=0:PRINT" : ";:ENDPROC
 2420 PRINT FNd(ptr%?(CPN%AND4),3);FNd(FNlen(ptr%),7)" "FNattr(ptr%)" ";
 2430 IF CPN%=0:PRINT FNh0(ptr%?12,2);:q%=ptr%+16:REPEAT PRINT" "FNh0(!q%,2*alz%);:q%=q%+alz%:UNTIL ?q%=0 AND ?(q%+alz%-1)=0 OR q%>ptr%+31:IF q%>ptr%+31:VDU 8
 2440 IF CPN%:PRINT FNh0(!ptr%,4);SPC4;:IF x%<wdt% DIV 32:ENDPROC
 2450 x%=0:PRINT:ENDPROC
 2460 :
 2470 DEFPROCPrN(ptr%):FOR A%=ptr% TO ptr%+10:VDU FNc(?A%):IF A%=ptr%+7:VDU46
 2480 NEXT:ENDPROC
 2490 DEFFNattr(ptr%)=MID$("-R",1-(ptr%?9>127),1)+MID$("-S",1-(ptr%?10>127),1)+MID$("-A",1-(ptr%?11>127),1)
 2500 :
 2510 DEFFNc(A%):A%=A%AND127:IFA%>31:IFA%<127:=A% ELSE =46
 2520 :
 2530 :
 2540 REM Catalogue manipulation routines
 2550 REM ===============================
 2560 :
 2570 DEFFNlook:src$=A$:ptr%=FNfind(src$,0):IF ptr%:ln%=FNlen(ptr%):PROCopen:=FALSE
 2580 PRINT"'"src$"' not found":=TRUE
 2590 :
 2600 DEFFNfind(A$,ext%):LOCAL p%,ptr%
 2610 IF MID$(A$,2,1)=":":D%=(ASCLEFT$(A$,1)AND15)-1:A$=MID$(A$,3)
 2620 IF FNMount:=0
 2630 A%=INSTR(A$+".","."):IF A%<9:A$=LEFT$(A$,A%-1)+STRING$(9-A%," ")+MID$(A$,A%)
 2640 A%=INSTR(A$+".","."):A$=LEFT$(LEFT$(A$,8)+MID$(A$+"   ",A%+1),11)
 2650 $name%=CHR$user%+A$:FOR A%=1 TO 11:IF name%?A%>95:name%?A%=name%?A%-32
 2660   NEXT A%:m%=(stp% EOR 48)-1:FOR p%=0 TO drm%:IF (p% AND m%)=0:PROCRdDir(p% DIV (m%+1))
 2670   ptr%=data%+(p% AND m%)*stp%+(CPN% AND 4):IF user%<0:?name%=?ptr%
 2680   IF (ptr%!0 AND &7F7F7F1F)=name%!0:IF (ptr%!4 AND &7F7F7F7F)=name%!4:IF (ptr%!8 AND &7F7F7F7F)=name%!8:IF CPN% OR (ptr%?12 AND (NOT exm%))=ext%:p%=drm%+1 ELSE ptr%=0
 2690 NEXT p%:IF ptr%:ptr%=ptr%-(CPN% AND 4):=FNinfo
 2700 =0
 2710 :
 2720 DEFFNlen(p%):IF CPN%:=(p%!2 AND &FFFF)*128+128
 2730 =16384*(p%?12 AND exm%)+128*p%?15+p%?13+128*(p%?13<>0)
 2740 :
 2750 DEFFNinfo:FOR A%=0 TO 31 STEP 4:store%!A%=ptr%!A%:NEXT A%:=store%
 2760 :
 2770 DEFPROCopen:IF CPN%=0:ENDPROC
 2780 link%=ptr%!0 AND &FFFF
 2790 IF (link% AND &C0)=&00:REM L3 block sector number
 2800 IF (link% AND &C0)=&80:REM L2 block sector number
 2810 PROCReadCPN(store%,FNcpn(link%),D%)
 2820 ENDPROC
 2830 :
 2840 DEFFNcpn(A%):A%=A%AND&3FFF:=(A%AND15)+10*(A%DIV16)
 2850 :
 2860 REM Read 512 bytes of directory, dir%=512-byte offset from start of block 0
 2870 DEFPROCRdDir(dir%):PROCReadBigSector(data%,dir%):ENDPROC
 2880 :
 2890 :
 2900 REM Disk access routines
 2910 REM ====================
 2920 REM Internal disk errors are:
 2930 REM  -1 Unsupported on this hardware
 2940 REM  -2 Disk/image not present
 2950 REM  -3 Past end of image
 2960 REM  -4
 2970 REM  -5 Not a recognised disk
 2980 REM  -6 Can only do subset of disk types
 2990 :
 3000 DEFFNMount:IF bsz%:=0
 3010 bsz%=0:drm%=2:res%=0:sec0%=0:spt%=10:den%=1:ssz%=256:hds%=1:skew%=1:flip%=0:ltp%=1:seq%=1:CPN%=FALSE
 3020 dsz%=0:res%=FNdir:type$="":IF res%<0:=res%
 3030 IF res%=&00:type$="AmstradDOS":bsh%=3:exm%=0:dmx%=&0B3:bps%=9:sec0%=&C1:spt%=036
 3040 IF res%=&01:type$="HardDisk"  :bsh%=5:exm%=1:dmx%=2046:bps%=8:sec0%=0:::spt%=256:drm%=8
 3050 IF res%=&12:type$="Spectrum+3":bsh%=3:exm%=0:dmx%=&0AE:bps%=9:sec0%=1:::spt%=036:hds%=2
 3060 IF res%=&1A:type$="IBM"       :bsh%=3:exm%=0:dmx%=&000:bps%=7:sec0%=1:::spt%=026
 3070 IF res%=&1E:type$="AcornCPM"  :bsh%=4:exm%=1:dmx%=0195:bps%=8:sec0%=0:::spt%=020:hds%=2:flip%=1:skew%=2:ltp%=2
 3080 IF res%=&24:type$="AmstradSYS":bsh%=3:exm%=0:dmx%=&0AA:bps%=9:sec0%=&41:spt%=036
 3090 IF res%=&28:type$="Einstein"  :bsh%=3:exm%=1:dmx%=0189:bps%=9:sec0%=1:::spt%=040
 3100 IF res%=&3C:type$="SloggerCPM":bsh%=5:exm%=3:dmx%=0195:bps%=9:sec0%=0:::spt%=040:hds%=2:flip%=1:skew%=-2
 3110 IF CPN%    :type$="TorchCPN"  :bsh%=1:exm%=0:dmx%=1599:bps%=8:sec0%=0:::spt%=020:hds%=2
 3120 :
 3130 REM Additional checks for hard drive images
 3140 IF res%=0:IF dsz%>&FFFFF:type$="AcornCPMv2":bsh%=5:exm%=1:dmx%=512:bps%=8:sec0%=0:spt%=256:drm%=4
 3150 :
 3160 IF type$="":PROCpr(0):PRINT"Unrecognised disk &"FNh0(res%,2):=-5
 3170 IF bps%<8 OR bps%>9:PRINT"Can only do 256-byte and 512-byte sectors":=-6
 3180 :
 3190 IF dmx%<256:alz%=1 ELSE alz%=2                   :REM Allocation size
 3200 IF res%=&28:PROCfdcRd(data%,D%,-&28,1):alz%=2-((data%?1 AND 2) DIV 2):bsh%=2+alz%:drm%=3-alz%:REM Einstein
 3210 blm%=2^bsh%-1                                    :REM Block mask
 3220 bsz%=2^(7+bsh%)                                  :REM Block size
 3230 drm%=bsz%*drm%/32-1                              :REM Directory max
 3240 ssz%=2^bps%*ltp%                                 :REM Sector size
 3250 spt%=(spt%*128) DIV (2^bps%) DIV ltp%            :REM Convert to logical sectors per track
 3260 IF CPN%:stp%=16 ELSE stp%=32                     :REM Directory entry size
 3270 IF bps%<9:den%=1 ELSE den%=2                     :REM Disk density
 3280 IF CPN%:drm%=159:seq%=1:PROCfdcRd(data%,D%,18,1):IF !data%=&D9D8D7D6:seq%=0
 3290 res%=res%*256/(ssz%/ltp%)                        :REM Convert to physical sectors
 3300 dsize%=(dmx%+1)*bsz%+res%*ssz%/ltp%              :REM Disk size
 3310 =0
 3320 :
 3330 REM Search for a directory
 3340 DEFFNdir:PROCfdcRd(data%,D%,0,1):IF err%:=err%OR-256
 3350 data%!16=0:IF FNchk(data%+4):CPN%=TRUE:=0   :REM Specific Torch test
 3360 data%?8=13:IF FNuc($data%)="ACORN CP":=&1E  :REM Quick initial test
 3370 IF FNuc($data%)="SLOGGER ":=&3C             :REM Quick initial test
 3380 ptr%=-1:REPEAT
 3390   ptr%=ptr%+1:PROCfdcRd(data%,D%,ptr%,1)    :REM Try this density
 3400   IF err%:den%=3-den%:bps%=bps%EOR1:ssz%=ssz%EOR&300:PROCfdcRd(data%,D%,ptr%,1):REM Try swapping density
 3410   fnd%=FNchk(data%)                         :REM Is there a directory here
 3420 UNTIL fnd% OR ptr%>&FE:IF err%:=err%OR-256 ELSE =ptr%
 3430 :
 3440 REM Check possible directory entry
 3450 DEFFNchk(p%):IF p%?0>&22:=FALSE :REM User number must be &0x, &1x, &20-&22
 3460 IF p%!12 AND &E080E0:=FALSE
 3470 REM IF p%?12>31 :fnd%=FALSE     :REM ExtentLo must be 0-31
 3480 REM IF p%?13>127:fnd%=FALSE     :REM LC must be 0-127
 3490 REM IF p%?14>31 :fnd%=FALSE     :REM ExtentHi must be 0-31
 3500 IF p%?15>128:=FALSE             :REM RC must be 0-128
 3510 A%=1:REPEAT:fnd%=INSTR(""":=?*,.",CHR$FNc(p%?A%)):A%=A%+1:UNTIL A%=12 OR fnd%:=fnd%=0
 3520 :
 3530 REM ptr%->file info block (cpm only)
 3540 REM q%=(PTR within file) DIV bsz% - ie block offset to fetch
 3550 DEFPROCReadData(q%,ptr%)
 3560 IF CPN%:PROCReadCPN(data%,FNcpn(store%!(q%*2)),D%):ENDPROC
 3570 IF alz%=1:PROCReadCPM(data%,ptr%?(q%+16),D%):ENDPROC
 3580 PROCReadCPM(data%,ptr%!(q%*2+16) AND &FFFF,D%):ENDPROC
 3590 :
 3600 REM Read a block of &100 bytes -> 1xSmallSectors
 3610 REM sectors go: 0:0:0-0:0:9, 1:0:0-1:0:9, 0:1:0-0:1:9, 1:1:0-1:1:9...
 3620 DEFPROCReadCPN(addr%,block%,drive%)
 3630 IF seq%  :Sc%=block% MOD 10:Hd%=(block% DIV 10) MOD 2:Tk%=block% DIV 20:sec%=Sc%+Tk%*10+Hd%*800
 3640 IF seq%=0:Sc%=block% MOD 10:Hd%=(block% DIV 10) MOD 2:Tk%=block% DIV 20:sec%=Sc%+Tk%*40+Hd%*20
 3650 PROCfdcRd(addr%,drive%,sec%,1)
 3660 ENDPROC
 3670 :
 3680 REM Read a block of &0800 bytes -> 4xBigSectors -> 8xSmallSectors
 3690 REM Read a block of &1000 bytes -> 8xBigSectors -> 8xDDSectors
 3700 DEFPROCReadCPM(addr%,block%,drive%):REM Do each chunk of &200 bytes
 3710 FOR S%=0 TO (bsz% DIV 512)-1:PROCReadBigSector(addr%+S%*512,block%*(bsz% DIV 512)+S%)
 3720 NEXT:ENDPROC
 3730 :
 3740 DEFPROCReadBigSector(ad%,sec512%)
 3750 PROCfdcRd(ad%,D%,sec512%*(512/ssz%),512/ssz%)
 3760 ENDPROC
 3770 :
 3780 :
 3790 REM FDC routines
 3800 REM ============
 3810 :
 3820 DEFPROCfdcRd(addr%,drv%,sec%,num%)
 3830 err%=0:sec%=sec%+res%/ltp%:REPEAT:PROCfdcRdOne:addr%=addr%+ssz%:sec%=sec%+1:num%=num%-1:UNTILnum%<1:ENDPROC
 3840 DEFPROCfdcRdOne:s0%=sec%
 3850 IF addr%>data%+max%+1 OR addr%+ssz%>data%+max%+2:PRINT"Buffer overflow":ENDPROC
 3860 FOR A%=0 TO ssz%-1 STEP 4:addr%!A%=0:NEXT:IFdrv%>7:ENDPROC
 3870 Tk%=sec% DIV spt%:Sc%=sec% MOD spt%:IF flip%:IF Tk%>79:Tk%=239-Tk%:REM 159-Tk%
 3880 IF seq%=0:IF hds%>1:Hd%=Tk% AND 1:Tk%=Tk% DIV 2 ELSE Hd%=Tk% DIV 80:Tk%=Tk% MOD 80
 3890 IF skew%>1:Sc%=Sc%*skew% MOD spt%
 3900 IF skew%<0:Sc%=(Sc%*-skew% MOD spt%)-(Sc%>4):REM Slogger botch
 3910 sec%=(Hd%*80+Tk%)*spt%+Sc%
 3920 REM PRINT FNh0(s0%,4)" H:";Hd%;" T:";Tk%;" S:";Sc%;" D:";den%;" -> ";~sec%;" -> ";~sec%*ssz%:REM IFGET
 3930 IFdrv$="":PROCfdcOp(1):ENDPROC
 3940 dsk%=FNf_openin(drv$):IFdsk%=0:err%=-2:PROCpr(27):PRINT"image not found";:ENDPROC
 3950 dsz%=EXT#dsk%:IFsec%*ssz%>dsz%:CLOSE#dsk%:dsk%=0:err%=-3:PROCpr(33):PRINT"past end of image"SPC4;:ENDPROC
 3960 PROCf_gbpb(3,dsk%,addr%,ssz%,sec%*ssz%):CLOSE#dsk%:dsk%=0
 3970 ENDPROC
 3980 :
 3990 DEFPROCpr(A%):IFPOS<>A%:PRINT
 4000 PRINTCHR$13;"Disk error: ";:ENDPROC
 4010 :
 4020 DEFPROCfdcOp(op%):err%=-1
 4030 IF os%=6:err%=FNfdcArc
 4040 IF os%<6:err%=FNfdcBBC
 4050 IF bsz%=0:ENDPROC
 4060 REM err%=FNfdcErr(err%)
 4070 IF err%:IF POS:PRINT
 4080 IF err%=-1:PRINT"Unsupported":ENDPROC
 4090 IF err%:PRINT"Disk error &"FNh0(err%,2)" at ";drv%":"FNh0(sec%,6)
 4100 ENDPROC
 4110 :
 4120 REM DEFFNfdcErr(err%)
 4130 REM IF err%:IF POS:PRINT
 4140 REM IF err%=-1:P."Unsupported" ELSE IF err%:PRINT"Disk error &"FNh0(err%,2)" at ";drv%":";~sec%
 4150 REM =err%
 4160 :
 4170 DEFPROCfdcInit(dskrec%,bps%,spt%,hds%,den%,trks%,sec0%):LOCAL i%
 4180 dskrec%?0=bps%:dskrec%?1=spt%*ltp%:dskrec%?2=hds%:dskrec%?3=den%
 4190 FOR i%=4 TO 59 STEP 4:dskrec%!i%=0:NEXT:dskrec%!64=&20000000
 4200 dskrec%?8=sec0%:dskrec%!16=trks%*spt%*ltp%*(2^bps%)*hds%
 4210 ENDPROC
 4220 :
 4230 REM Doesn't work with AmsDOS disk
 4240 DEFFNfdcArc
 4250 PROCfdcInit(diskrec%,bps%,spt%,1,den%,80,sec0%)
 4260 Tk%=sec%DIVspt%:Hd%=Tk%DIV80:Tk%=Tk%MOD80:Sc%=(sec%MODspt%)*ltp%
 4270 offset%=(((Hd%*80+Tk%)*spt%)+Sc%/ltp%)*ssz%:REM /den%
 4280 REM PRINT FNh0(s0%,4)" H:";Hd%;" T:";Tk%;" S:";Sc%;" N:";ssz%;",";spt%*ltp%;" -> ";~offset%:IFGET
 4290 SYS"XADFS_DiscOp",,op%+64+(diskrec%<<6),offset%+(drv%<<29),addr%,ssz% TO err%
 4300 =err%
 4310 :
 4320 DEFFNfdcBBC
 4330 REM P."sec=";sec%
 4340 REM P."hd:";drv%+2*(sec%DIV(40*spt%*ltp%));" trk:";(sec%DIVspt%)MOD80;" sec:";sec0%+(sec%MODspt%)*ltp%
 4350 IFden%=1:IFop%=1:=FNdisk(addr%,&53,drv%+2*(sec%DIV(40*spt%*ltp%)),(sec%DIVspt%)MOD80,sec0%+(sec%MODspt%)*ltp%,ltp%,den%)
 4360 REM IFden%=1:IFop%=1:sec%=sec%*ltp%:=FNdisk(addr%,&53,drv%+2*(sec%DIV(80*spt%*ltp%)),(sec%DIV(spt%*ltp%))MOD80,sec0%+sec%MOD(spt%*ltp%),ltp%,den%)
 4370 IFden%>1:IFop%=1:=FNscsi(addr%,&08,drv%,sec0%+sec%,1):REM Needs fiddling for non-256-byte sectors
 4380 =-1
 4390 :
 4400 :
 4410 REM Translate leafname if not saving to DOS
 4420 REM =======================================
 4430 REM . # $ ^ & @ % ~ become / ? < > + = ; \
 4440 DEFFNfn_undos(A$):LOCALB%:IF(os%AND-32):=A$
 4450 FORA%=1TOLEN A$:B%=INSTR(".#$^&@%~",MID$(A$,A%,1)):IFB%:A$=LEFT$(A$,A%-1)+MID$("/?<>+=;\",B%,1)+MID$(A$,A%+1)
 4460 NEXT:=A$
 4470 :
 4480 DEFFNyna(A%):IFA%=0:=0
 4490 PRINT"? (Y/N/A)";:REPEAT:A%=INSTR("YAN",CHR$(GETAND&DF)):UNTILA%
 4500 PRINTSTRING$(7,CHR$127);MID$("YesAllNo ",A%*3-2,3);:=A%-2
 4510 :