10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180
190
200
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:
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
600
610 ; FN_INFO, FN_COPY, FN_QUIT, FN_INF, FN_MOUNT, FN_OPT :
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$):
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
1340
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:
1430 :
1440
1450 A%=FNfile(dst$,8):dst$=dst$+d$:
1460 oldcsd%=csd%:oldfptr%=fptr%:curr%=-1:csd%=fptr%!&17 AND &FFFFFF:PROCCopyDirectory(dst$)
1470
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
1540
1550 :
1560 DEFPROCCopyDirectory(dst$):LOCAL entry%,leaf$
1570 PROCRdDir:fptr%=thisdir%:IF thisdir%?15=0:ENDPROC
1580
1590
1600
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:
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
1720 PRINT"Copying "fname$;SPC(10-LENfname$)" to "dst$+fname$
1730 oldcsd%=csd%:oldfptr%=fptr% :
1740 curr%=-1:csd%=fptr%!&17 AND &FFFFFF :
1750 A%=FNfile(dst$+fname$,8) :
1760 PROCCopyDirectory(dst$+fname$+d$) :
1770 PROCSetDir:ENDPROC
1780 :
1790 DEFPROCSetDir
1800 curr%=-1:csd%=oldcsd%:PROCRdDir:fptr%=oldfptr% :
1810 PROCFileInfo(fptr%,1):PROCSetInfo(dst$+fname$) :
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:
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$) :
2060 X%!8=mdate%:A%=FNNetFS_OpN(19,5,10,dst$) :
2070 IF FNNetFS_Op(18,CHR$64+dst$):ENDPROC :
2080 X%!8=mdate%:X%!10=0:X%!13=mdate%:X%!15=0
2090 A%=FNNetFS_OpN(19,64,18,dst$) :
2100 ENDPROC
2110 :
2120 :
2130
2140
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
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:
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
2530
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 :
2790 PROCRdAlloc(map%+offset%DIV256,2) :
2800 offset%=alloc%!(offset%AND255) AND &FFFF :
2810 length%=length%+256:UNTIL offset% AND &4000
2820 A%=offset% AND 255:IF A%:length%=length%+A%-256:
2830 ENDPROC
2840 :
2850 DEFPROCFileLen2
2860 PROCRdAlloc(sin%,1):IFFNChkMap(alloc%):PRINT"Bad map":ENDPROC
2870 B%=alloc%?8:IF B%:length%=B%-256 :
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) :
3010 offset%=(fptr%AND&FFF)*2+5 :
3020 PROCRdAlloc(map%+offset%DIV256,2) :
3030 fptr%=alloc%!(offset%AND255) AND &FFFF :
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
3170
3180
3190
3200
3210
3220
3230
3240
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
3310 IF fsv%<4:root%=data%!22 AND &FFFFFF:IF !data%=valid%:dib%=0:PROCRdBlocks(data%,root%,D%,1):IF root%<spt%:fsv%=0:
3320 :
3330
3340 IF fsv%>3:!data%=-1:dib%=data%!&F6 AND &FFFFFF:PROCRdBlocks(data%,dib%,D%,1):
3350 IF fsv%>3:!data%=-1:root%=data%!&1F AND &FFFFFF:PROCRdBlocks(data%,root%,D%,1):
3360 IF fsv%>3:!data%=-1:PROCRdBlocks(data%,data%!&0A AND &FFFFFF,D%,1):
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:
3420 IFerr%=-2:PRINT "Disk error: image file not found":=-2
3430 IF!data%<>valid%:=-5 :
3440 PROCRdBlocks(data%,dib%,D%,1):path$="$"
3450 A%=data%?20:data%?20=13:title$=FNs($(data%+4)):data%?20=A%
3460 :
3470
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
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 :
3630 IFfsv%<4:PROCReadData1 ELSE PROCReadData2
3640 O%=data%:ENDPROC
3650 :
3660 DEFPROCReadData1
3670 PROCRdBlocks(data%,sin% AND &FFF,D%,1) :
3680 offset%=(sin%AND&FFF)*2+5 :
3690 PROCRdAlloc(map%+offset%DIV256,2) :
3700 sin%=alloc%!(offset%AND255) AND &FFFF :
3710 eof%=sin%AND&4000:ln%=256
3720 IFeof%:ln%=sin%AND255:IFln%=0:ln%=256 :
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 :
3800 num%=alloc%!(aptr%+3) AND &FFFF :
3810 IF aptr%=250:PROCRdAlloc(sec%,1):alloc%?8=ln%:aptr%=0 :
3820 UNTIL aptr%:PROCRdBlocks(data%,sec%,D%,1) :
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
3990
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
4120
4130
4140
4150
4160
4170
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
4390
4400
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 :