10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180
190
200
210
220
230
240 :
250
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
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
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
450
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:
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
700
710 ; FN_INFO, FN_COPY, FN_QUIT, FN_FREE, FN_MAP, FN_USER, FN_BLOCK :
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
890
900
910
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
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
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
1870
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
2210
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 :
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
2550
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:
2800 IF (link% AND &C0)=&80:
2810 PROCReadCPN(store%,FNcpn(link%),D%)
2820 ENDPROC
2830 :
2840 DEFFNcpn(A%):A%=A%AND&3FFF:=(A%AND15)+10*(A%DIV16)
2850 :
2860
2870 DEFPROCRdDir(dir%):PROCReadBigSector(data%,dir%):ENDPROC
2880 :
2890 :
2900
2910
2920
2930
2940
2950
2960
2970
2980
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
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 :
3200 IF res%=&28:PROCfdcRd(data%,D%,-&28,1):alz%=2-((data%?1 AND 2) DIV 2):bsh%=2+alz%:drm%=3-alz%:
3210 blm%=2^bsh%-1 :
3220 bsz%=2^(7+bsh%) :
3230 drm%=bsz%*drm%/32-1 :
3240 ssz%=2^bps%*ltp% :
3250 spt%=(spt%*128) DIV (2^bps%) DIV ltp% :
3260 IF CPN%:stp%=16 ELSE stp%=32 :
3270 IF bps%<9:den%=1 ELSE den%=2 :
3280 IF CPN%:drm%=159:seq%=1:PROCfdcRd(data%,D%,18,1):IF !data%=&D9D8D7D6:seq%=0
3290 res%=res%*256/(ssz%/ltp%) :
3300 dsize%=(dmx%+1)*bsz%+res%*ssz%/ltp% :
3310 =0
3320 :
3330
3340 DEFFNdir:PROCfdcRd(data%,D%,0,1):IF err%:=err%OR-256
3350 data%!16=0:IF FNchk(data%+4):CPN%=TRUE:=0 :
3360 data%?8=13:IF FNuc($data%)="ACORN CP":=&1E :
3370 IF FNuc($data%)="SLOGGER ":=&3C :
3380 ptr%=-1:REPEAT
3390 ptr%=ptr%+1:PROCfdcRd(data%,D%,ptr%,1) :
3400 IF err%:den%=3-den%:bps%=bps%EOR1:ssz%=ssz%EOR&300:PROCfdcRd(data%,D%,ptr%,1):
3410 fnd%=FNchk(data%) :
3420 UNTIL fnd% OR ptr%>&FE:IF err%:=err%OR-256 ELSE =ptr%
3430 :
3440
3450 DEFFNchk(p%):IF p%?0>&22:=FALSE :
3460 IF p%!12 AND &E080E0:=FALSE
3470
3480
3490
3500 IF p%?15>128:=FALSE :
3510 A%=1:REPEAT:fnd%=INSTR(""":=?*,.",CHR$FNc(p%?A%)):A%=A%+1:UNTIL A%=12 OR fnd%:=fnd%=0
3520 :
3530
3540
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
3610
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
3690
3700 DEFPROCReadCPM(addr%,block%,drive%):
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
3800
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%:
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):
3910 sec%=(Hd%*80+Tk%)*spt%+Sc%
3920
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
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
4130
4140
4150
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
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%:
4280
4290 SYS"XADFS_DiscOp",,op%+64+(diskrec%<<6),offset%+(drv%<<29),addr%,ssz% TO err%
4300 =err%
4310 :
4320 DEFFNfdcBBC
4330
4340
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
4370 IFden%>1:IFop%=1:=FNscsi(addr%,&08,drv%,sec0%+sec%,1):
4380 =-1
4390 :
4400 :
4410
4420
4430
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 :