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