10
20 os%=FNfx(0,1)AND&FF:VDU10,8:A%=POS:VDU13:IFA%<50:MODE&87:IFHIMEM>&7C00:MODE&83:IFHIMEM>&4000:MODE&80
30 IFHIMEM<&FFFF:HIMEM=FNfx(132,0)
40 PROCinit:PRINT"CPMFiler v"ver$" by J.G.Harston"':ONERRORIFFNerr:END
50 REPEAT:X%=ctrl%:Y%=X%DIV256:IFPOS:PRINT
60 VDU8:wdt%=POS+1:PRINT
70 IFdrv$="":PRINTCHR$(D%+65);LEFT$(STR$user%,user%>-1);pmt$;ELSEPRINT"["drv$;LEFT$(":"+STR$user%,user%>-1)"] ";
80 INPUTLINE""A$:PROCdo(FNs(A$))
90 UNTILFALSE
100 DEFPROCinit:pmt$=">":ver$="1.31a":max%=&0FFF
110 DIMctrl% 31,name% 19,store% 255,data% max%:X%=ctrl%:Y%=X%DIV256
120 D%=0:drv$="":user%=-1:CPN%=FALSE:bsz%=0:IFos%=6:DIMdiskrec% 67
130 fs%=FNfs:d$=".":s$="/":IFos%AND-24:d$="/":s$=".":IFos%AND-32:d$="\"
140 cmd$=":MOUNT:USER:DIR:STAT:INFO:TYPE:DUMP:DISS:COPY:FREE:MAP:BLOCK:HELP:QUIT:"
150 hlp$=":<drive>|<imagefile>:<user>::(<file>):(<file>):<file> [CTRLS]:<file> [7BIT]:<file> (<addr>):<source> <dest> (<opts>):::<sector>:::"
160 ENDPROC
170 DEFFNerr:OSCLI"FX229":IFPOS:PRINT
180 REPORT:IFFNfs<>fs%:OSCLI"FX143,18,"+STR$fs%
190 PROCCloseAll:A%=ERR<>17ANDERR<>28:PRINTLEFT$(" at line "+STR$ERL,ERR<128ANDA%):=INKEY-1ANDA%
200 DEFPROCCloseAll
210 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
220 dsk%=dsk%:IFdsk%:A%=dsk%:dsk%=0:CLOSE#A%
230 ENDPROC
240 DEFPROCdo(A$):IFA$="?":A$="HELP"
250 IFLEFT$(A$,1)=";"ORA$="":ENDPROC
260 IFLEFT$(A$,1)="*":OSCLIMID$(A$,2):ENDPROC
270 IFLEFT$(A$,1)=".":A$="CAT "+MID$(A$,2)
280 A%=INSTR(A$+" "," "):B$=FNuc(LEFT$(A$,A%-1)):A$=FNs(MID$(A$,A%+1))
290 IFLENB$=2ANDRIGHT$(B$,1)=":"ANDB$<":":B$=CHR$(ASCB$+17)+":"
300 IFLENB$=2ANDRIGHT$(B$,1)=":"ANDB$>"@"ANDB$<"Q":D%=ASCB$-65:drv$="":bsz%=0:ENDPROC
310 A%=INSTR(cmd$,":"+B$+":"):IFA%=0:PRINT"Bad command":ENDPROC
320 A%=EVAL("FN_"+B$+"("""+A$+""")"):ENDPROC
330 DEFFNsyn(S$):IFA$="":PRINT"Syntax: "B$" "S$:=TRUEELSE=FALSE
340 DEFFN_QUIT(A$):PRINT"Quit"
350 ONERROREND
360 IFos%>5:*QUIT
370 END
380 DEFFN_HELP(A$):p%=2:q%=2:REPEAT
390 A%=INSTR(cmd$,":",p%):PRINT" "MID$(cmd$,p%,A%-p%);:p%=A%+1
400 A%=INSTR(hlp$,":",q%):PRINTTAB(8)MID$(hlp$,q%,A%-q%):q%=A%+1
410 UNTILp%>LENcmd$:=0
420 DEFFN_MOUNT(A$):bsz%=0:IFA$="":=0ELSEIFLENA$=1:PROCdo(A$+":"):=0ELSED%=-1:drv$=A$:=0
430 DEFFN_USER(A$):user%=VALA$OR(A$<"0"):=0
440 DEFFN_DIR(A$):PROCLstDir(1):=0
450 DEFFN_STAT(A$):PROCLstDir(3):=0
460 DEFFN_BLOCK(A$):IFFNsyn("<blocknum>"):=TRUE
470 sect%=EVAL("&"+FNuc(A$)):IFFNMount:=TRUE
480 ptr%=store%:!store%=sect%:store%!16=sect%:ln%=bsz%:PROCdump:=0
490 DEFFN_DUMP(A$):IFFNsyn("<file>"):=TRUE
500 IFFNlook:=TRUE
510 PROCdump:=0
520 DEFPROCfile0:ext%=0:M%=bsz%-1:ENDPROC
530 DEFPROCfile1:IF(P%ANDM%)=0:PROCReadData(P%DIVbsz%,ptr%):O%=data%
540 ENDPROC
550 DEFPROCfile2:IFCPN%=0:IFln%=bsz%*16:ext%=ext%+exm%+1:ptr%=FNfind(src$,ext%):IFptr%:ln%=FNlen(ptr%)ELSEln%=0
560 ENDPROC
570 DEFPROCdump:cols%=16:B%=0:IFwdt%<80:cols%=8
580 PROCfile0:REPEAT:FORQ%=0TOln%-1STEPcols%:B$="":PRINTFNh0(Q%+B%,6)" ";
590 FORP%=Q%TOQ%+cols%-1:PROCfile1:IFP%<ln%:PRINTFNh0(?O%,2)" ";ELSE?O%=32:PRINTSPC3;
600 A$=CHR$(?O%AND&7F):IFA$>=" "ANDA$<="~" B$=B$+A$ELSEB$=B$+"."
610 O%=O%+1:NEXT:PRINTB$:NEXT:B%=B%+ln%:PROCfile2:UNTILln%<1:ENDPROC
620 DEFFN_TYPE(A$):IFFNsyn("<file>"):=TRUE
630 msk%=INSTR(A$," [")<>0:msk%=(msk%AND&80)OR&7F:IFFNlook:=TRUE
640 PROCfile0:last%=0
650 REPEAT:FORP%=0TOln%-1:PROCfile1:Q%=?O%ANDmsk%:IF?O%=26:P%=ln%:Q%=0
660 IFmsk%=&FF:VDUQ%ELSEIFQ%>31ANDQ%<>127:VDUQ%:last%=Q%
670 IFmsk%=&7F:IFQ%=10ORQ%=13:IFlast%<>23-Q%:VDU10,13:last%=Q%
680 IFmsk%=&7F:IFQ%=9:PRINTSPC(8-(POSMOD8));:last%=Q%
690 O%=O%+1:NEXT:PROCfile2:UNTILln%<1:=0
700 DEFFN_DISS(A$):IFFNsyn("<file>"):=TRUE
710 A%=INSTR(A$," "):IFA%:addr%=EVAL("&"+FNuc(MID$(A$,A%+1))):A$=FNs(LEFT$(A$,A%-1))ELSEaddr%=&100
720 IFFNlook:=TRUE
730 A%=190:!X%=&502004:X%!4=0:CALL&FFF1:IFINSTR($(X%+4),"Z80")=0:PRINT"No Z80 DisAssem routine":=TRUE
740 PROCfile0:REPEAT:P%=0:REPEAT:PROCfile1:!X%=&50200C:X%!4=addr%:X%!8=!O%:A%=190:CALL&FFF1
750 PRINTFNh0(addr%,4)" ";:FORQ%=0TOX%?3-1:PRINTFNh0(O%?Q%,2)" ";:NEXT:PRINTSPC(12-3*X%?3);
760 FORQ%=0TOX%?3-1:VDUFNc(O%?Q%):NEXT:PRINTSPC(5-X%?3);$(X%+4):IF(X%?2AND64):PRINT
770 A%=O%-data%:IFA%+X%?3>M%:X%?3=M%-O%+1
780 addr%=addr%+X%?3:O%=O%+X%?3:P%=P%+X%?3:UNTILP%>ln%-1:PROCfile2:UNTILln%<1:=0
790 DEFFN_FREE(A$):IFFNMount:=TRUE
800 IFCPN%:PRINT"Not yet done.":=0
810 PROCmap(0):used%=0:FORA%=0TOdmx%:used%=used%-(FNtst(A%)<>0):NEXTA%
820 free%=dsize%DIVbsz%-used%:PRINT
830 PRINTFNh0(free%,4)" Blocks = "FNd(free%*bsz%,9)" bytes free"
840 PRINTFNh0(used%,4)" Blocks = "FNd(used%*bsz%,9)" bytes used"
850 =0
860 DEFFN_MAP(A$):IFFNMount:=TRUE
870 IFCPN%:PRINT"Not yet done.":=0
880 PROCmap(4):FORA%=0TOdmx%:IF(A%AND31)=0:PRINT'FNh0(A%,2*alz%);
890 VDU32:IFFNtst(A%):VDU35ELSEVDU46
900 NEXT:PRINT
910 =0
920 DEFPROCmap(A%)
930 PRINT"FREE SPACE"LEFT$(" MAP",A%)" ON "CHR$(D%+65)":";
940 FORA%=0TO255STEP4:store%!A%=0:NEXTA%
950 FORA%=0TO(drm%+1)/(blm%+1)/4-1:PROCset(A%):NEXTA%
960 IFdmx%DIV8>255:PRINT'"Buffer overflow":ENDPROC
970 FORp%=0TOdrm%:IF(p%AND15)=0:PROCRdDir(p%DIV16)
980 FORq%=(p%AND15)*32+16TO(p%AND15)*32+31STEPalz%
990 A%=data%!q%AND&FFFF:IFalz%=1:A%=A%AND&FF
1000 IFA%:PROCset(A%)
1010 NEXTq%:NEXTp%:ENDPROC
1020 DEFPROCset(A%):store%?(A%DIV8)=store%?(A%DIV8)OR(2^(A%AND7)):ENDPROC
1030 DEFFNtst(A%):=store%?(A%DIV8)AND(2^(A%AND7))
1040 DEFFN_INFO(A$):IFA$<>"":=FN_STAT(A$)
1050 IFFNMount:=TRUE
1060 PRINT"Disk Information:"
1070 PRINT"exm= "FNd(exm%,2)" stp="FNd(stp%,4)" drm="FNd(drm%,5)" alz="FNd(alz%,5)
1080 PRINT"bsh= "FNd(bsh%,2)" blm="FNd(blm%,4)" bsz="FNd(bsz%,5)" dmx="FNd(dmx%,5)
1090 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)
1100 PRINT"den= "FNd(den%,2)" sec0="FNd(sec0%,3)" psec="FNd(ssz%/ltp%,4)" lsec="FNd(ssz%,4)
1110 PRINT"skew="FNd(skew%,2)" flip="FNd(flip%,3)" trk= "MID$("INTSEQ",(seq%AND1)*3+1,3)" "type$'
1120 PRINT"Directory starts at &"FNh0(res%*ssz%/ltp%,6)
1130 PRINT"Directory entries:"SPC4;(drm%+1);" x ";stp%;" bytes"
1140 PRINT"Directory size:"SPC7;(drm%+1)*stp%
1150 PRINT"Data area starts at &"FNh0(res%*ssz%/ltp%+(drm%+1)*stp%,6)
1160 PRINT"Block size:"SPC10"&"FNh0(bsz%,4)
1170 PRINT"Disk size:"SPC12;dsize%" (";dsize%DIV1024;"K)"
1180 =0
1190 DEFFN_COPY(A$):IFFNsyn("<cpm source> <host dest> (<C>onfirm)"):=TRUE
1200 A%=INSTR(A$+" "," "):src$=LEFT$(A$,A%-1):dst$=FNs(MID$(A$,A%+1))
1210 cnf%=FNuc(RIGHT$(dst$,2))=" C":IFcnf%:dst$=FNs(LEFT$(dst$,LENdst$-2))
1220 IFos%<6:IFINSTR(dst$,"::")ORLEFT$(dst$,1)="-":PRINT"FS prefix unsupported":=TRUE
1230 IFsrc$="*"ORsrc$="*.*":PROCCopyDirectoryELSEPROCCopyOneFile(1)
1240 =0
1250 DEFPROCCopyDirectory
1260 IFFNMount:ENDPROC
1270 dest$=dst$:IFdest$<>"":A%=FNfile(dest$,8):dest$=dest$+d$
1280 m%=(stp%EOR48)-1:FORp%=0TOdrm%:PROCRdDir(p%DIV(m%+1))
1290 ptr%=data%+(p%ANDm%)*stp%+(CPN%AND4):A$="":A%=1:REPEAT
1300 IFptr%?A%<>32:A$=A$+CHR$(ptr%?A%):A%=A%+1ELSEA%=9
1310 UNTILA%>8:A$=A$+".":REPEAT:IFptr%?A%<>32:A$=A$+CHR$(ptr%?A%):A%=A%+1ELSEA%=12
1320 UNTILA%>11:IFuser%>=0:IF?ptr%<>user%:A$=""
1330 IFCPN%:ptr%=ptr%-4:IF!ptr%=0:A$=""
1340 IFCPN%=0:IFptr%?12AND(NOTexm%):A$=""
1350 IFCPN%=0:IF?ptr%>127:A$=""
1360 IFA$<>"":src$=A$:dst$=dest$+FNfn_undos(A$):PROCCopyObject
1370 NEXTp%:ENDPROC
1380 DEFPROCCopyObject
1390 IFcnf%:PRINT"Copy "src$;:cnf%=FNyna(cnf%):IFcnf%>0:PRINT:ENDPROCELSEVDU13
1400 ptr%=FNinfo:PROCCopyOneFile(0)
1410 ENDPROC
1420 DEFPROCCopyOneFile(one%)
1430 IFdst$="":PRINT"<dest> filename missing":ENDPROC
1440 PRINT"Copying "src$;SPC(12-LENsrc$)" to "dst$;
1450 IFone%:ptr%=FNfind(src$,0):IFptr%=0:PRINT" - not found":ENDPROC
1460 ln%=FNlen(ptr%):PROCopen:OSCLI"Save "+dst$+" "+STR$~PAGE+"+"+STR$~ln%+" 0 0":IFln%=0:ENDPROC
1470 out%=OPENOUT(dst$):IFout%=0:PRINT" - can't open dest":ENDPROC
1480 PROCfile0:PRINT" **%";:REPEAT:FORP%=0TOln%-1:PROCfile1
1490 IF(P%AND1023)=0:PRINTCHR$8;CHR$8;CHR$8;FNd(100*P%DIVln%,2);"%";
1500 BPUT#out%,?O%:O%=O%+1:NEXT:PROCfile2:UNTILln%<1
1510 CLOSE#out%:out%=0:PRINTCHR$127;CHR$127;CHR$127:ENDPROC
1520 DEFPROCLstDir(cflg%):IFFNMount:ENDPROC
1530 ptr%=0:IFA$<>"":ptr%=FNfind(A$,0):IFptr%=0:PRINT"'"A$"' not found":ENDPROC
1540 IF(cflg%AND3)=3:PRINT"D:";
1550 FORx%=1TO(wdt%DIV32)AND(CPN%<>0)
1560 IF(cflg%AND3)=3:PRINT"FILENAME.EXT U LENGTH RSA ";:IFCPN%=0:PRINT"EX <- -- -- -- -- -- ALLOCATION -- -- -- -- -- ->";
1570 IF(cflg%AND3)=3:IFCPN%:PRINT"Sect ";
1580 NEXTx%:x%=0:PRINTCHR$8:IFptr%:PROCPrInfo:ENDPROC
1590 m%=(stp%EOR48)-1:FORp%=0TOdrm%:IF(p%ANDm%)=0:PROCRdDir(p%DIV(m%+1))
1600 ptr%=data%+(p%ANDm%)*stp%:PROCPrInfo
1610 NEXTp%:IFPOS:PRINT
1620 ENDPROC
1630 DEFPROCPrInfo
1640 IFCPN%=0:IF?ptr%>127:ENDPROC
1650 IFCPN%:IF?ptr%+ptr%?1=0OR?ptr%+ptr%?1=510:ENDPROC
1660 IFuser%>=0:IFptr%?(CPN%AND4)<>user%:ENDPROC
1670 IFx%=0:PRINTCHR$(65+D%)":";
1680 PROCPrN(ptr%+(CPN%AND4)+1):x%=x%+1:IFx%>=wdt%DIV16:x%=0:PRINT:ENDPROC
1690 IF(cflg%AND2)=0:PRINT" : ";:ENDPROC
1700 PRINTFNd(ptr%?(CPN%AND4),3);FNd(FNlen(ptr%),7)" "FNattr(ptr%)" ";
1710 IFCPN%=0:PRINTFNh0(ptr%?12,2);:q%=ptr%+16:REPEATPRINT" "FNh0(!q%,2*alz%);:q%=q%+alz%:UNTIL?q%=0AND?(q%+alz%-1)=0ORq%>ptr%+31:IFq%>ptr%+31:VDU8
1720 IFCPN%:PRINTFNh0(!ptr%,4);SPC4;:IFx%<wdt%DIV32:ENDPROC
1730 x%=0:PRINT:ENDPROC
1740 DEFPROCPrN(ptr%):FORA%=ptr%TOptr%+10:VDUFNc(?A%):IFA%=ptr%+7:VDU46
1750 NEXT:ENDPROC
1760 DEFFNattr(ptr%)=MID$("-R",1-(ptr%?9>127),1)+MID$("-S",1-(ptr%?10>127),1)+MID$("-A",1-(ptr%?11>127),1)
1770 DEFFNc(A%):A%=A%AND127:IFA%>31:IFA%<127:=A%ELSE=46
1780 DEFFNlook:src$=A$:ptr%=FNfind(src$,0):IFptr%:ln%=FNlen(ptr%):PROCopen:=FALSE
1790 PRINT"'"src$"' not found":=TRUE
1800 DEFFNfind(A$,ext%):LOCALp%,ptr%
1810 IFMID$(A$,2,1)=":":D%=(ASCLEFT$(A$,1)AND15)-1:A$=MID$(A$,3)
1820 IFFNMount:=0
1830 A%=INSTR(A$+".","."):IFA%<9:A$=LEFT$(A$,A%-1)+STRING$(9-A%," ")+MID$(A$,A%)
1840 A%=INSTR(A$+".","."):A$=LEFT$(LEFT$(A$,8)+MID$(A$+" ",A%+1),11)
1850 $name%=CHR$user%+A$:FORA%=1TO11:IFname%?A%>95:name%?A%=name%?A%-32
1860 NEXTA%:m%=(stp%EOR48)-1:FORp%=0TOdrm%:IF(p%ANDm%)=0:PROCRdDir(p%DIV(m%+1))
1870 ptr%=data%+(p%ANDm%)*stp%+(CPN%AND4):IFuser%<0:?name%=?ptr%
1880 IF(ptr%!0AND&7F7F7F1F)=name%!0:IF(ptr%!4AND&7F7F7F7F)=name%!4:IF(ptr%!8AND&7F7F7F7F)=name%!8:IFCPN%OR(ptr%?12AND(NOTexm%))=ext%:p%=drm%+1ELSEptr%=0
1890 NEXTp%:IFptr%:ptr%=ptr%-(CPN%AND4):=FNinfo
1900 =0
1910 DEFFNlen(p%):IFCPN%:=(p%!2AND&FFFF)*128+128
1920 =16384*(p%?12ANDexm%)+128*p%?15+p%?13+128*(p%?13<>0)
1930 DEFFNinfo:FORA%=0TO31STEP4:store%!A%=ptr%!A%:NEXTA%:=store%
1940 DEFPROCopen:IFCPN%=0:ENDPROC
1950 link%=ptr%!0AND&FFFF
1960 IF(link%AND&C0)=&00
1970 IF(link%AND&C0)=&80
1980 PROCReadCPN(store%,FNcpn(link%),D%)
1990 ENDPROC
2000 DEFFNcpn(A%):A%=A%AND&3FFF:=(A%AND15)+10*(A%DIV16)
2010 DEFPROCRdDir(dir%):PROCReadBigSector(data%,dir%):ENDPROC
2020 DEFFNMount:IFbsz%:=0
2030 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
2040 dsz%=0:res%=FNdir:type$="":IFres%<0:=res%
2050 IFres%=&00:type$="AmstradDOS":bsh%=3:exm%=0:dmx%=&0B3:bps%=9:sec0%=&C1:spt%=036
2060 IFres%=&01:type$="HardDisk":bsh%=5:exm%=1:dmx%=2046:bps%=8:sec0%=0:spt%=256:drm%=8
2070 IFres%=&12:type$="Spectrum+3":bsh%=3:exm%=0:dmx%=&0AE:bps%=9:sec0%=1:spt%=036:hds%=2
2080 IFres%=&1A:type$="IBM":bsh%=3:exm%=0:dmx%=&000:bps%=7:sec0%=1:spt%=026
2090 IFres%=&1E:type$="AcornCPM":bsh%=4:exm%=1:dmx%=0195:bps%=8:sec0%=0:spt%=020:hds%=2:flip%=1:skew%=2:ltp%=2
2100 IFres%=&24:type$="AmstradSYS":bsh%=3:exm%=0:dmx%=&0AA:bps%=9:sec0%=&41:spt%=036
2110 IFres%=&28:type$="Einstein":bsh%=3:exm%=1:dmx%=0189:bps%=9:sec0%=1:spt%=040
2120 IFres%=&3C:type$="SloggerCPM":bsh%=5:exm%=3:dmx%=0195:bps%=9:sec0%=0:spt%=040:hds%=2:flip%=1:skew%=-2
2130 IFCPN%:type$="TorchCPN":bsh%=1:exm%=0:dmx%=1599:bps%=8:sec0%=0:spt%=020:hds%=2
2140 IFres%=0:IFdsz%>&FFFFF:type$="AcornCPMv2":bsh%=5:exm%=1:dmx%=512:bps%=8:sec0%=0:spt%=256:drm%=4
2150 IFtype$="":PROCpr(0):PRINT"Unrecognised disk &"FNh0(res%,2):=-5
2160 IFbps%<8ORbps%>9:PRINT"Can only do 256-byte and 512-byte sectors":=-6
2170 IFdmx%<256:alz%=1ELSEalz%=2
2180 IFres%=&28:PROCfdcRd(data%,D%,-&28,1):alz%=2-((data%?1AND2)DIV2):bsh%=2+alz%:drm%=3-alz%
2190 blm%=2^bsh%-1
2200 bsz%=2^(7+bsh%)
2210 drm%=bsz%*drm%/32-1
2220 ssz%=2^bps%*ltp%
2230 spt%=(spt%*128)DIV(2^bps%)DIVltp%
2240 IFCPN%:stp%=16ELSEstp%=32
2250 IFbps%<9:den%=1ELSEden%=2
2260 IFCPN%:drm%=159:seq%=1:PROCfdcRd(data%,D%,18,1):IF!data%=&D9D8D7D6:seq%=0
2270 res%=res%*256/(ssz%/ltp%)
2280 dsize%=(dmx%+1)*bsz%+res%*ssz%/ltp%
2290 =0
2300 DEFFNdir:PROCfdcRd(data%,D%,0,1):IFerr%:=err%OR-256
2310 data%!16=0:IFFNchk(data%+4):CPN%=TRUE:=0
2320 data%?8=13:IFFNuc($data%)="ACORN CP":=&1E
2330 IFFNuc($data%)="SLOGGER ":=&3C
2340 ptr%=-1:REPEAT
2350 ptr%=ptr%+1:PROCfdcRd(data%,D%,ptr%,1)
2360 IFerr%:den%=3-den%:bps%=bps%EOR1:ssz%=ssz%EOR&300:PROCfdcRd(data%,D%,ptr%,1)
2370 fnd%=FNchk(data%)
2380 UNTILfnd%ORptr%>&FE:IFerr%:=err%OR-256ELSE=ptr%
2390 DEFFNchk(p%):IFp%?0>&22:=FALSE
2400 IFp%!12AND&E080E0:=FALSE
2410 IFp%?15>128:=FALSE
2420 A%=1:REPEAT:fnd%=INSTR(""":=?*,.",CHR$FNc(p%?A%)):A%=A%+1:UNTILA%=12ORfnd%:=fnd%=0
2430 DEFPROCReadData(q%,ptr%)
2440 IFCPN%:PROCReadCPN(data%,FNcpn(store%!(q%*2)),D%):ENDPROC
2450 IFalz%=1:PROCReadCPM(data%,ptr%?(q%+16),D%):ENDPROC
2460 PROCReadCPM(data%,ptr%!(q%*2+16)AND&FFFF,D%):ENDPROC
2470 DEFPROCReadCPN(addr%,block%,drive%)
2480 IFseq%:Sc%=block%MOD10:Hd%=(block%DIV10)MOD2:Tk%=block%DIV20:sec%=Sc%+Tk%*10+Hd%*800
2490 IFseq%=0:Sc%=block%MOD10:Hd%=(block%DIV10)MOD2:Tk%=block%DIV20:sec%=Sc%+Tk%*40+Hd%*20
2500 PROCfdcRd(addr%,drive%,sec%,1)
2510 ENDPROC
2520 DEFPROCReadCPM(addr%,block%,drive%)
2530 FORS%=0TO(bsz%DIV512)-1:PROCReadBigSector(addr%+S%*512,block%*(bsz%DIV512)+S%)
2540 NEXT:ENDPROC
2550 DEFPROCReadBigSector(ad%,sec512%)
2560 PROCfdcRd(ad%,D%,sec512%*(512/ssz%),512/ssz%)
2570 ENDPROC
2580 DEFPROCfdcRd(addr%,drv%,sec%,num%)
2590 err%=0:sec%=sec%+res%/ltp%:REPEAT:PROCfdcRdOne:addr%=addr%+ssz%:sec%=sec%+1:num%=num%-1:UNTILnum%<1:ENDPROC
2600 DEFPROCfdcRdOne:s0%=sec%
2610 IFaddr%>data%+max%+1ORaddr%+ssz%>data%+max%+2:PRINT"Buffer overflow":ENDPROC
2620 FORA%=0TOssz%-1STEP4:addr%!A%=0:NEXT:IFdrv%>7:ENDPROC
2630 Tk%=sec%DIVspt%:Sc%=sec%MODspt%:IFflip%:IFTk%>79:Tk%=239-Tk%
2640 IFseq%=0:IFhds%>1:Hd%=Tk%AND1:Tk%=Tk%DIV2ELSEHd%=Tk%DIV80:Tk%=Tk%MOD80
2650 IFskew%>1:Sc%=Sc%*skew%MODspt%
2660 IFskew%<0:Sc%=(Sc%*-skew%MODspt%)-(Sc%>4)
2670 sec%=(Hd%*80+Tk%)*spt%+Sc%
2680 IFdrv$="":PROCfdcOp(1):ENDPROC
2690 dsk%=FNf_openin(drv$):IFdsk%=0:err%=-2:PROCpr(27):PRINT"image not found";:ENDPROC
2700 dsz%=EXT#dsk%:IFsec%*ssz%>dsz%:CLOSE#dsk%:dsk%=0:err%=-3:PROCpr(33):PRINT"past end of image"SPC4;:ENDPROC
2710 PROCf_gbpb(3,dsk%,addr%,ssz%,sec%*ssz%):CLOSE#dsk%:dsk%=0
2720 ENDPROC
2730 DEFPROCpr(A%):IFPOS<>A%:PRINT
2740 PRINTCHR$13;"Disk error: ";:ENDPROC
2750 DEFPROCfdcOp(op%):err%=-1
2760 IFos%=6:err%=FNfdcArc
2770 IFos%<6:err%=FNfdcBBC
2780 IFbsz%=0:ENDPROC
2790 IFerr%:IFPOS:PRINT
2800 IFerr%=-1:PRINT"Unsupported":ENDPROC
2810 IFerr%:PRINT"Disk error &"FNh0(err%,2)" at ";drv%":"FNh0(sec%,6)
2820 ENDPROC
2830 DEFPROCfdcInit(dskrec%,bps%,spt%,hds%,den%,trks%,sec0%):LOCALi%
2840 dskrec%?0=bps%:dskrec%?1=spt%*ltp%:dskrec%?2=hds%:dskrec%?3=den%
2850 FORi%=4TO59STEP4:dskrec%!i%=0:NEXT:dskrec%!64=&20000000
2860 dskrec%?8=sec0%:dskrec%!16=trks%*spt%*ltp%*(2^bps%)*hds%
2870 ENDPROC
2880 DEFFNfdcArc
2890 PROCfdcInit(diskrec%,bps%,spt%,1,den%,80,sec0%)
2900 Tk%=sec%DIVspt%:Hd%=Tk%DIV80:Tk%=Tk%MOD80:Sc%=(sec%MODspt%)*ltp%
2910 offset%=(((Hd%*80+Tk%)*spt%)+Sc%/ltp%)*ssz%
2920 SYS"XADFS_DiscOp",,op%+64+(diskrec%<<6),offset%+(drv%<<29),addr%,ssz%TOerr%
2930 =err%
2940 DEFFNfdcBBC
2950 IFden%=1:IFop%=1:=FNdisk(addr%,&53,drv%+2*(sec%DIV(40*spt%*ltp%)),(sec%DIVspt%)MOD80,sec0%+(sec%MODspt%)*ltp%,ltp%,den%)
2960 IFden%>1:IFop%=1:=FNscsi(addr%,&08,drv%,sec0%+sec%,1)
2970 =-1
2980 DEFFNfn_undos(A$):LOCALB%:IF(os%AND-32):=A$
2990 FORA%=1TOLENA$:B%=INSTR(".#$^&@%~",MID$(A$,A%,1)):IFB%:A$=LEFT$(A$,A%-1)+MID$("/?<>+=;\",B%,1)+MID$(A$,A%+1)
3000 NEXT:=A$
3010 DEFFNyna(A%):IFA%=0:=0
3020 PRINT"? (Y/N/A)";:REPEAT:A%=INSTR("YAN",CHR$(GETAND&DF)):UNTILA%
3030 PRINTSTRING$(7,CHR$127);MID$("YesAllNo ",A%*3-2,3);:=A%-2
3040 DEFFNdisk(addr%,cmd%,drv%,trk%,sec%,num%,den%):LOCALfs%,n%
3050 fs%=FNfs:IFfs%<>4:*FX143,18,4
3060 REPEAT:n%=num%:IFsec%+n%>10:n%=10-sec%
3070 REPEAT:X%?0=drv%+den%*24+8+2*(trk%DIV80):X%!1=addr%:X%?5=3-7*(cmd%>127)
3080 X%?6=cmd%:X%?7=trk%MOD80:X%?8=sec%:X%!9=n%OR&1E20:A%=127:CALL&FFF1
3090 A%=X%?(7+X%?5):UNTILA%<>&10:addr%=addr%+n%*256:num%=num%-n%:sec%=(sec%+n%)MOD10:trk%=trk%+1
3100 UNTILA%<>0ORnum%<1:IFfs%<>4:OSCLI"FX143,18,"+STR$fs%
3110 =A%
3120 DEFFNscsi(addr%,cmd%,drv%,sect%,num%):LOCALfs%
3130 fs%=FNfs:IFfs%<>8:*FADFS
3140 X%?0=0:X%!1=addr%:X%?5=cmd%:X%?6=drv%*32+((sect%AND&1F0000)DIV65536)
3150 X%?7=((sect%AND&FF00)DIV256):X%?8=sect%:X%!9=num%:X%!11=0
3160 A%=&72:CALL&FFF1:A%=?X%:IFfs%<>8:OSCLI"FX143,18,"+STR$fs%
3170 =A%
3180 DEFFNfx(A%,X%):LOCALY%:Y%=X%DIV256:=((USR&FFF4)AND&FFFF00)DIV256
3190 DEFFNh0(A%,N%):=RIGHT$("0000000"+STR$~A%,N%)
3200 DEFFNd(A%,N%):=RIGHT$(" "+STR$A%,N%)
3210 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
3220 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
3230 =A$
3240 DEFFNuc(A$):LOCALB$:IFA$="":=""
3250 REPEATB$=B$+CHR$(ASCA$AND((A$<"@")OR&DF)):A$=MID$(A$,2):UNTILA$="":=B$
3260 DEFFNc0(A%):IFA%>127:="|!"+FNc0(A%AND127)
3270 IFA%<32ORA%=127:="|"+CHR$(A%EOR64)ELSE=LEFT$("|",A%=34ORA%=124)+CHR$A%
3280 DEFFNfile(A$,A%):IFA%-8:IFPAGE<&FFFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF
3290 A$=FNf_name(A$):IFA%=255ORA%=5:X%!14=OPENIN(A$):IFX%!14:X%!10=EXT#X%!14:CLOSE#X%!14:X%!14=&33
3300 IFA%=255:IFX%?6=0:OSCLI"LOAD """+A$+""" "+STR$~X%!2:=1
3310 IFA%=5:IFX%!14:=1ELSEIFA%=5:=0
3320 IFA%=0:OSCLI"SAVE """+A$+""" "+STR$~X%!10+" "+STR$~X%!14:X%!10=X%!14-X%!10:=1
3330 IFA%=7:OSCLI"SAVE """+A$+""" "+STR$~PAGE+"+"+STR$~X%!10:X%!10=X%!14-X%!10:=1
3340 IFA%-8:=0
3350 IF(os%AND-24):A$="mkdir "+A$ELSEA$="cdir "+A$
3360 IFHIMEM>&FFFF:LOCALERROR:ONERRORLOCAL:=0
3370 OSCLIA$:=2
3380 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)
3390 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL&FFD1:ENDPROC
3400 IFA%=1ORA%=3:PTR#?X%=X%!9
3410 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1ELSEIFA%=3ORA%=4:?X%!1=BGET#?X%
3420 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X%ANDA%>2)ORX%!5<1:ENDPROC
3430 DEFFNfs:IF(os%AND-32)=0:LOCALA%,Y%,E%:=(USR&FFDA)AND&FF
3440 =29
3450 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))
3460 DEFFNf_name(A$):IFos%AND-32:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,"\",A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."
3470 =A$