10 REM AMCOM for transferring files on Amcom discs to ADFS
   20 REM by H.L.Clarke and S.B.Yeo
   30 REM (C) 1991
   40 MODE 7:HIMEM=&7000
   50 PROCtitle
   60 READ fparm,fbuff,ftrack,fsec,secnums,fresult,faddr,pparms,putdata,putlength,pointer,cstring
   70 OSWRCH=&FFEE:OSNEWL=&FFE7:OSWORD=&FFF1:OSGBPB=&FFD1:OSFIND=&FFCE:oscli=&FFF7:!&7B08=0:U%=PAGE+&1A00:V%=&7000:W%=V%-U%
   80 PROCcode
   90 CHAIN"AMCOM2"
10000 DEFPROCcode
10010 FOR pass%=0 TO 2 STEP 2
10020 P%=V%
10030 [OPT pass%
10040 .centry:JSR transfer\sets up parameters for loading Amcom file
10050 LDA &7BE6
10060 ROR A:ROR A:ROR A:ROR A
10070 AND #3:STA &7B86
10080 LDA #0:STA &7B82:STA &7B83:STA &7B87
10090 LDA &7BE4:STA &7B84
10100 LDA &7BE5:STA &7B85\store file length in !&7B84
10110 LDA &7BE6:AND #3
10120 STA &7B81
10130 LDA &7BE7:STA &7B80
10140 RTS
10150 \
10160 \
10170 \
10180 \
10190 \
10200 \
10210 \
10220 \
10230 \
10240 \
10250 .transfer:STX &70:STY &71:LDY #0\transfers catalogue entry for Amcom file to &7BE0 onwards
10260 .tstring:LDA (&70),Y
10270 STA &7BE0,Y
10280 INY
10290 CPY #&18
10300 BNE tstring
10310 STA &7BFF:LDA #&20:STA &7BF7\Amcom directory in &7BFF
10320 .tcr:LDX #8
10330 .tcrloop:LDA &7BE0,X:CMP #&20
10340 BEQ crin:BCC bn
10350 INX:JMP tcrloop
10360 .crin:LDA #&0D:STA &7BE0,X
10370 RTS
10380 .bn:BRK
10390 OPT FNerror(&83,"Illegal filename")
10400 \
10410 BRK
10420 NOP:NOP
10430 NOP:NOP:NOP
10440 \
10450 \
10460 .name:JSR transfer\updates list of Amcom directories
10470 LDX &7B7A
10480 LDA &7BFF:AND #&7F
10490 STA &7B90,X:STX &7B90
10500 LDY #&28:LDA (&70),Y
10510 STA &7BF9
10520 RTS
10530 \
10540 .secread:LDA #&73:STA fbuff+1\loads Amcom catalogue to &7300
10550 LDA #&28:STA secnums
10560 LDA #0:STA fbuff:STA fbuff+2:STA fbuff+3
10570 STA ftrack:STA fsec
10580 \
10590 \
10600 LDA #&7F\function
10610 LDX faddr:LDY faddr+1\point X and Y @ fparm
10620 JSR OSWORD
10630 LDA fresult:BNE re
10640 LDA &7300
10650 BPL wrong
10660 RTS
10670 .wrong BRK
10680 OPT FNerror(&81,"Not an Amcom disc")
10690 \
10700 .re:BRK
10710 OPT FNerror(&82,"Can't read catalogue")
10720 \
10730 BRK
10740 \
10750 .long:LDA fsec:CLC:ADC &7B1E\sets up 'ftrack' and 'fsec' for loading long file by 'stload'
10760 CMP #&0A:BNE sametr
10770 INC ftrack:LDA #0
10780 .sametr:STA fsec
10790 .stload:LDA &7B85:STA &7B20\main loading routine
10800 LDA &7B86:STA &7B21
10810 \
10820 LDA #0:STA &7BFA\last load marker flag
10830 LDA &7B84:BEQ noadd
10840 LDA &7B20:CLC:ADC #1:STA &7B20
10850 LDA &7B21:ADC #0:STA &7B21
10860 \
10870 .noadd:LDA #&0A:SEC:SBC fsec:STA &7B24
10880 \
10890 .check:LDA &7B21:BNE morethan
10900 LDA &7B24:CMP &7B20:BCS lessthan
10910 .morethan:LDA &7B24:STA &7B1E:CLC:ADC #&20:STA secnums
10920 LDA &7B20:SEC:SBC &7B24:STA &7B20
10930 LDA &7B21:SBC #0:STA &7B21
10940 JMP opn
10950 .lessthan:LDA &7B20:STA &7B1E:CLC:ADC #&20:STA secnums:STA &7BFA
10960 .opn:LDA #&7F:LDX faddr:LDY faddr+1:JSR OSWORD
10970 LDA &7BFA:BNE endfile\last load marker set
10980 LDA #0:STA fsec:INC ftrack
10990 LDA fbuff+1:CLC:ADC &7B1E:STA fbuff+1
11000 LDA #&0A:STA &7B24:JMP check
11010 .endfile:RTS
11020 \
11030 \
11040 \
11050 \
11060 \
11070 .ecomp:LDX #0\takes filename+directory from E% loop, ANDs with &5F
11080 .ecomploop:LDA &7B60,X
11090 AND #&5F:STA &7B60,X
11100 INX:CPX #11:BNE ecomploop
11110 LDX &7B7A:LDA &7B90,X
11120 AND #&5F:STA &7B78
11130 RTS
11140 \
11150 \
11160 .fcomp:LDX #0\takes filename+directory from F% loop, ANDs with &5F, and compares with result of 'ecomp'
11170 .fcomploop:LDA &7B6C,X
11180 AND #&5F:STA &7B6C,X
11190 INX:CPX #11:BNE fcomploop
11200 LDX &7B7B:LDA &7B90,X
11210 AND #&5F:STA &7B79
11220 LDX #0
11230 .trycomp:LDA &7B60,X:CMP &7B6C,X
11240 BNE nomatch:INX
11250 CPX &73:BNE trycomp
11260 LDA &7B78:CMP &7B79
11270 BNE nomatch
11280 LDA #&FF:JMP matchmark
11290 .nomatch:LDA #0
11300 .matchmark:STA &7BF8:RTS
11310 \
11320 \
11330 \
11340 \
11350 .subd:STA &7B29:LDA #0:STA &7BD0\makes list of ADFS sub-directories to be created
11360 .subloop:STX &72:LDA &7B90,X:CMP #&24:BEQ s2
11370 AND #&5F:STA &7B78:LDA &7BD0:BEQ notere
11380 LDX #1
11390 .nsloop:LDA &7BD0,X:CMP &7B78:BEQ s3
11400 CPX &7BD0:BEQ notere
11410 INX:JMP nsloop
11420 .notere:INC &7BD0:LDX &7BD0
11430 LDA &7B78:STA &7BD0,X
11440 .s3:LDX &72
11450 .s2:CPX &7B29:BEQ endsub
11460 INX:JMP subloop
11470 .endsub RTS
11480 \
11490 \
11500 .title:LDX #8\prints title of Amcom disc
11510 .first:LDA &7300,X:AND #&7F:JSR OSWRCH:INX:CPX #&10:BNE first
11520 LDX #0
11530 .second:LDA &7300,X:AND #&7F:JSR OSWRCH:INX:CPX #4:BNE second
11540 JSR OSNEWL:JSR OSNEWL:RTS
11550 \
11560 \
11570 \
11580 \
11590 \
11600 .command:LDX #(cstring MOD 256):LDY #(cstring DIV 256)
11610 JSR oscli
11620 RTS
11630 \
11640 \
11650 .putbyte:LDA #&C0:LDX #&60:LDY #&7B\save second or later part of long file to ADFS disc
11660 JSR OSFIND\open file for random access
11670 BNE fileok
11680 LDA #&FE:STA fresult:RTS
11690 .fileok:STA pparms
11700 LDX #(pparms MOD 256):LDY #(pparms DIV 256)
11710 LDA #1:JSR OSGBPB
11720 LDA #0:LDY #0:JSR OSFIND
11730 RTS
11740 \
11750 ]
11760 NEXT
11770 ENDPROC
11780 DEFPROCtitle
11790 VDU31,0,3
11800 PROCband
11810 PRINT''''
11820 FOR N%=0 TO 1
11830 PRINTCHR$(130);CHR$(141);STRING$(12," ");"Amcom to"
11840 NEXT
11850 PRINT''''
11860 FOR N%=0 TO 1
11870 PRINTCHR$(130);CHR$(141);STRING$(10," ");"ADFS transfer"
11880 NEXT
11890 PRINT''''
11900 PROCband
11910 ENDPROC
11920 DEFPROCband
11930 FOR N%=0 TO 1
11940 PRINTCHR$(145);CHR$(154);CHR$(157);CHR$(146);STRING$(30,CHR$(255));"  ";CHR$(156)
11950 NEXT
11960 ENDPROC
15000 DEFFNerror(err,err$)
15010 ?P%=err
15020 P%=P%+1
15030 $P%=err$
15040 P%=P%+LEN(err$)
15050 =pass%
20000 DATA &7B10,&7B11,&7B17,&7B18,&7B19,&7B1A,&7B1B,&7B2A,&7B2B,&7B2F,&7B33,&72D0