10REM AMCOM listing II - loaded as AM COM2 20REM by H.L.Clarke and S.B.Yeo 30REM (C) 1991 40MODE 7:HIMEM=U% 50DIM F$(63) 60B%=0:Q%=0 70READ centry,transfer,name,secread,l ong,stload,ecomp,fcomp,subd,title,fparm, fbuff,ftrack,fsec,secnums,fresult,faddr, pparms,putdata,putlength,pointer,putbyte ,command,cstring 80?&7B15=3:?&7B16=&53:!faddr=fparm 90PRINT''"Printout of filenames of"'" transferred files ?" 100INPUT yn$ 110IF LEFT$(yn$,1)="Y" OR LEFT$(yn$,1) ="y" THEN Q%=2 120PRINT''"Insert capital letter to be first"'"character of ADFS sub-directori es":REPEAT:INPUT F$:Z%=ASC(F$):UNTIL Z%> 64 AND Z%<91 130PRINT"Insert blank formatted ADFS d isc"'"in drive 0" 140PRINT 150PRINT'"Insert Amcom disc in drive 1 "' 160PRINT"Press Space Bar to proceed"' 170IF GET=32 THEN 180 ELSE 160 180*ADFS 190*MOUNT0 200FOR N%=B% TO (B%+3):$cstring="CDIR "+CHR$(Z%)+STR$(N%):CALL command:NEXT 210FOR D%=1 TO 3 STEP 2 220*DISC 230?fparm=D%:CALL secread 240IF ?&7328=0 THEN B%=B%+2:GOTO 680 250E%=0:PRINT'"Checking filenames -"' 260REPEAT 270E%=E%+1:PROCaddr 280CALL name 290F$=$&7BE8:IF LEN(F$)<11 THEN 330 300PRINT"Filename ";F$;" is too long"' "- please replace with one no more than" '"ten characters in length."'' 310INPUT F$:IF LEN(F$)>10 THEN 300 320IF INSTR(F$,".")<>0 THEN PRINT"Bad directory"'"please try again"':GOTO310 330F$(E%)=F$ 340UNTIL ?&7BF9=0 350FOR E%=1 TO ?&7B90 360$&7B60=F$(E%):?&73=LEN(F$(E%)):?&7B 7A=E%:CALL ecomp 370FOR F%=1 TO ?&7B90 380IF E%=F% OR LEN(F$(F%))<>?&73 THEN 580 390$&7B6C=F$(F%):?&7B7B=F%:CALL fcomp 400IF ?&7BF8=0 THEN 580 410PRINT"The following filenames will be"'"equated by ADFS"'' 420PRINT"(1) ";F$(E%);" directory "; CHR$?(&7B90+E%) 430PRINT"(2) ";F$(F%);" directory "; CHR$?(&7B90+F%) 440PRINT 450REPEAT 460PRINT"Will you change (1) or (2) ?" 470INPUT H% 480UNTIL H%=1 OR H%=2 490PRINT'"Insert new filename" 500INPUT F3$ 510IF LEN(F3$)>10 THEN PRINT"Too long !":GOTO 490 520IF INSTR(MID$(F3$,3),".")=0 THEN 53 0 ELSE 540 530IF INSTR(F3$,".")=0 OR INSTR(F3$,". ")=2 THEN 550 ELSE 540 540PRINT"Bad directory !":GOTO 490 550IF H%=2 THEN 570 ELSE IF INSTR(F3$, ".")=0 THEN F$(E%)=F3$ ELSE F$(E%)=MID$( F3$,3):?(&7B90+E%)=ASC(LEFT$(F3$,1)) 560GOTO580 570IF INSTR(F3$,".")=0 THEN F$(F%)=F3$ ELSE F$(F%)=MID$(F3$,3):?(&7B90+F%)=ASC (LEFT$(F3$,1)) 580NEXT F% 590NEXT E% 600IF ?&7BF8<>0 THEN 350 610PRINT CHR$(Q%):PRINT'''"Transferrin g from drive ";STR$(D%):PRINT"Disc ";:CA LL title:PRINT 620IF ?&7B90>&20 THEN I%=&20 ELSE I%=? &7B90 630PROCtransfer(1,I%) 640B%=B%+1 650IF ?&7B90<&21 THEN 670 660PROCtransfer(33,?&7B90) 670B%=B%+1 680VDU3 690NEXT D% 700PRINT':PRINTTAB(18)"***"'':INPUT"Tr ansfer another Amcom disc ",yn$ 710IF LEFT$(yn$,1)="Y" OR LEFT$(yn$,1) ="y" THEN 140 720PRINT''"The ADFS disc will need som e editing."'"Note that files are now in ADFS"'"directories from ";CHR$(Z%);"0 to ";CHR$(Z%);STR$(B%-1);" inclusive." 730END 10000DEFPROCaddr 10010X%=&7300+(&20*E%):Y%=X%DIV256 10020?&7B7A=E% 10030ENDPROC 10040DEFPROCA 10050*ADFS 10060*MOUNT0 10070$cstring="DIR "+CHR$(Z%)+STR$(B%):C ALL command 10080ENDPROC 10090DEFPROCtransfer(X%,A%) 10100CALL subd 10110REM 10120PROCA 10130IF ?&7BD0=0 THEN 10170 10140FOR F%=1 TO ?&7BD0 10150$cstring="CDIR "+CHR$(?(&7BD0+F%)): CALL command 10160NEXT 10170FOR E%=X% TO A% 10180PROCaddr 10190*DISC 10200CALL centry:?ftrack=!&7B80 DIV 10:? fsec=!&7B80 MOD 10 10210!fbuff=HIMEM:PRINT CHR$(?&7BFF);"." ;$&7BE8;STRING$((18-LEN($&7BE8))," "); 10220IF !&7B84>W% THEN PROClong:GOTO 102 60 10230R%=0:CALL stload:IF ?fresult<>0 THE N PROCde:GOTO10290 10240PRINT"-> "; 10250PROCA:PROCsave 10260IF R%=1 THEN 10290 10270PRINT CHR$(Z%);STR$(B%);".";F$ 10280IF ?&7BFF>&80 THEN $cstring="ACCESS "+F$+" R":CALL command 10290NEXT E% 10300ENDPROC 10310DEFPROCsave 10320IF ?(&7B90+E%)=&24 THEN F$=F$(E%) E LSE F$=CHR$(?(&7B90+E%))+"."+F$(E%) 10330$cstring="SAVE "+F$+" "+STR$÷HIMEM+ " "+STR$÷(HIMEM+!&7B84)+" "+FNadr(&7BE2, &C0)+" "+FNadr(&7BE0,&C):CALL command 10340ENDPROC 10350DEFPROClong 10360L%=!&7B84:!&7B84=W%:M%=0:T%=0 10370REM L%=total length of file yet unl oaded, M% is marker for very long file ( >2*W%),T%=PTR 10380R%=0:CALL stload:IF ?fresult<>0 THE N PROCde:GOTO 10530 10390PRINT"-> "; 10400PROCA:PROCsave 10410L%=L%-W%:IF L%>W% THEN M%=1 ELSE M% =0 10420IF M%=1 THEN !&7B84=W% ELSE !&7B84= L% 10430*DISC 10440!fbuff=HIMEM:R%=0:CALL long:IF ?fre sult<>0 THEN PROCde:GOTO 10530 10450PROCA:T%=T%+W%:!pointer=T% 10460!putdata=HIMEM:!putlength=!&7B84 10470$&7B60=F$ 10480R%=0:CALL putbyte:IF ?fresult<>0 TH EN PROCde:GOTO 10530 10490REM 10500REM 10510REM 10520IF M%=1 THEN 10410 10530ENDPROC 10540DEFPROCde 10550R%=1 10560PRINTTAB(20)"not transferable" 10570ENDPROC 15000DEFFNadr(I%,J%) 15010REM I% represents load address (&7B E0) or execution address (&7BE2) 15020REM J% represents bits of &7BE6 whi ch when set imply a second processor add ress (&C for load, &C0 for execution) 15030IF (?&7BE6 AND J%)=0 THEN K%=0 ELSE K%=&FFFF0000 15040A$=STR$÷((!I%AND&FFFF)+K%) 15050=A$ 20000DATA &7000,&7035,&707A,&7093,&70EE, &7101,&7199,&71B4,&71F0,&7236,&7B10,&7B1 1,&7B17,&7B18,&7B19,&7B1A,&7B1B,&7B2A,&7 B2B,&7B2F,&7B33,&7263,&725B,&72D0