8-Bit Software Online Conversion
:0.$.AMCOM2 - Listing
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