10
20
30 :
40 MODE7
50 IF PAGE>&1200 PROCreloc
60 LOMEM=&7400
70 DIM control% 17,name% 80
80 osfile=&FFDD
90 p%=&8000-&3400
100 PRINT
110 FOR x=0TO1
120 PRINTCHR$141;SPC(8);"Acorn User ROMFiler":NEXT
130 VDU28,0,23,39,4
140 PRINT"‚Write-enable your RAM."'
150 REPEAT:INPUT"RAM socket: "bk:UNTILbk>=0 AND bk<16
160 PROCass:C%=0
170 FOR x=crc TO(read-1):C%=C%+?x
180 NEXT:IF C%<>5782 PROCerr("CRC")
190 !&8B=&70:?&8F=check-&70:CALL crc
200 x=!&8D AND &FFFF
210 IF x<>26070 PROCerr("INPUT")
220 !&8B=read:?&8F=P%-read:CALL crc
230 x=!&8D AND &FFFF
240 REPEATREADs,v:UNTILs=bk
250 IFv<>x PROCerr("READ/WRITE")
260 helptext$=" To load any program from sideways"+CHR$13+" RAM, type *ROM<return>"+CHR$13+" then LOAD, CHAIN, *LOAD, *RUN, *CAT"+CHR$13+" etc. in the normal way"+CHR$13
270 PRINTTAB(0,8)CHR$(134);
280 PRINT"Romfile title:"CHR$(133);
290 title$=FNinput(10)
300 PRINTTAB(0,10)CHR$(134);
310 PRINT"8K or 16K RAM?"CHR$(133);
320 REPEATx=GET
330 UNTILx=56 OR x=49
340 VDUx
350 IF x=56 rom=&2000:GOTO400
360 REPEATx=GET
370 UNTILx=54
380 VDUx
390 rom=0
400 REPEATx=GET
410 UNTILx=13:PRINT
420 PRINTCHR$134"ROM *HELP message:"CHR$(133):h2text$=FNinput(20):IFh2text$="":h2text$="Acorn User ROMFiler"
430 PRINTCHR$134"ROM *HELP text:"
440 hh$="":REPEAT:VDU9:h2$=FNinput(37):hh$=hh$+" "+h2$+CHR$13:UNTIL h2$=""
450 IF LEN hh$>4 helptext$=LEFT$(hh$,LEN hh$-3)
460 PRINTCHR$134"Give ROMname on *HELP? (Y/N)";
470 aa=GET AND&DF:IF aa<>89 AND aa<>78 AND aa<>13 GOTO470
480 PRINTSTRING$(5,CHR$8);:IF aa=89 OR aa=13 PRINT"Yes ":rnam=1 ELSE PRINT"No ":rnam=0
490 ON ERROR REPORT:IF ERR<>17 a$=GET$:CLS:GOTO540 ELSE PRINT:END
500 PROCromsetup
510 PROCmemleft
520 IF memleft<1 PRINT"No memory left":GOTO690
530 *FX15
540 PRINTTAB(0,8)CHR$(134);
550 PRINT"Filename:"CHR$(133);
560 file$=FNinput(20)
570 IF LEFT$(file$,1)="*" THEN PROCoscli(file$):PRINT"Press SPACE...";:a$=GET$:CLS:GOTO530
580 IF file$="" GOTO690
590 PROCoscli("LOAD "+file$+" 3400")
600 PROCrdaddr
610 PRINTCHR$(134);"Filename to save by:"CHR$(133);:file2$=FNinput(10):IF file2$<>"" file$=file2$
620 x=length DIV 256
630 x=x-((length MOD 256)<>0)
640 search=P%+length+(23+LEN(file$))*(1-(x>1))-(x-2)*3*(x>1)
650 IF length>memleft GOTO810
660 PROCencode
670 PROCmore
680 IF x=89 VDU28,0,23,39,4:GOTO510
690 PRINT'CHR$(130);
700 PRINT"Press SPACE to save"
710 REPEATUNTIL GET=32
720 PROCequb(43)
730 PROCsave
740 VDU7
750 PROCmore
760 IF x=89 CLS:GOTO260
770 *FX18
780 PRINT'"Press BREAK."
790 GOTO790
800 :
810 IF length>&3400 GOTO860
820 PRINTTAB(0,8)CHR$(129);
830 PRINT"This file is too long."
840 GOTO670
850 :
860 CLS
870 PRINTTAB(0,9)CHR$(129);
880 PRINT"This file is far too long."
890 PRINTCHR$(129)"You will have to start again."
900 x=GET
910 RUN
920 :
930 DEFPROCromsetup
940 FOR pass=0 TO 2 STEP2
950 P%=&3400
960 PROCequw(0)
970 PROCequb(0)
980 [OPT pass
990 JMP entry+p%
1000 ]
1010 PROCequb(&83)
1020 PROCequb(LEN(title$)+9)
1030 PROCequb(1)
1040 PROCequs(title$)
1050 PROCequb(0)
1060 PROCequs("(C) Acorn User")
1070 PROCequb(0)
1080 [OPT pass
1090 .entry
1100 CMP #&FE
1110 BEQ v4
1120 CMP #9
1130 BEQ v1
1140 CMP #13
1150 BEQ v2
1160 CMP #14
1170 BEQ v3
1180 RTS
1190 .v1
1200 JMP help1+p%
1210 .v2
1220 JMP file+p%
1230 .v3
1240 JMP byte+p%
1250 .v4
1260 JMP boot+p%
1270 .help1
1280 PHA
1290 LDA (&F2),Y
1300 CMP #13
1310 BNE help2
1320 LDX #0
1330 .loop1
1340 LDA message1+p%,X
1350 INX
1360 CMP #0
1370 BEQ exit1
1380 JSR &FFE3
1390 JMP loop1+p%
1400 .exit1
1410 PLA
1420 RTS
1430 .message1
1440 ]
1450 PROCequb(13)
1460 PROCequs(h2text$)
1470 PROCequb(13)
1480 PROCequs(" ROMFILE")
1490 PROCequb(13)
1500 PROCequb(0)
1510 [OPT pass
1520 .help2
1530 TYA
1540 PHA
1550 LDX #0
1560 .loop2
1570 LDA (&F2),Y
1580 AND #&DF
1590 CMP #&21
1600 BCC skip1
1610 CMP romfile+p%,X
1620 BNE exit2
1630 INX
1640 INY
1650 JMP loop2+p%
1660 .skip1
1670 LDA romfile+p%,X
1680 BNE exit2
1690 JMP help3+p%
1700 .exit2
1710 PLA
1720 TAY
1730 PLA
1740 RTS
1750 .romfile
1760 ]
1770 PROCequs("ROMFILE")
1780 PROCequb(0)
1790 [OPT pass
1800 .help3
1810 LDX #0
1820 .loop3
1830 LDA message2+p%,X
1840 INX
1850 CMP #0
1860 BEQ exit2
1870 JSR &FFE3
1880 JMP loop3+p%
1890 .message2
1900 ]
1910 PROCequb(13)
1920 PROCequs(h2text$)
1930 PROCequb(13)
1940 PROCequs(helptext$)
1950 IF rnam PROCequs(" This ROMFile: "+title$):PROCequb(13)
1960 PROCequb(0)
1970 [OPT pass
1980 .file
1990 PHA
2000 TYA
2010 EOR #&F
2020 CMP &F4
2030 BCC exit3
2040 LDA #((data+p%)MOD 256)
2050 STA &F6
2060 LDA #((data+p%)DIV 256)
2070 STA &F7
2080 LDA &F4
2090 EOR #&F
2100 STA &F5
2110 PLA
2120 LDA #0
2130 RTS
2140 .exit3
2150 PLA
2160 RTS
2170 .byte
2180 PHA
2190 LDA &F5
2200 EOR #&F
2210 CMP &F4
2220 BNE exit3
2230 LDY #0
2240 LDA (&F6),Y
2250 TAY
2260 INC &F6
2270 BNE skip2
2280 INC &F7
2290 .skip2
2300 PLA
2310 LDA #0
2320 RTS
2330 .boot
2340 PHA
2350 TYA
2360 PHA
2370 \CPY #&FF:\BEQ exit4
2380 LDY #0
2390 .loop4
2400 LDA message3+p%,Y
2410 BEQ exit4
2420 JSR &FFE3
2430 INY
2440 JMP loop4+p%
2450 .message3
2460 ]
2470 PROCequs("ROMFile:")
2480 PROCequb(134)
2490 PROCequs(title$)
2500 PROCequb(13)
2510 PROCequb(0)
2520 [OPT pass
2530 .exit4
2540 PLA
2550 TAY
2560 PLA
2570 RTS
2580 .data
2590 ]NEXT
2600 ?&8F=((data-&3400)/256)+1
2610 !&8B=&34008000
2620 ?&89=0
2630 CALL write
2640 P%=P%+p%
2650 ENDPROC
2660 :
2670 DEFPROCass
2680 P%=&70
2690 [OPT 0
2700 .input
2710 CLC
2720 LDA #0
2730 TAX
2740 STX &8B
2750 LDX #&C
2760 STX &8C
2770 LDX #32
2780 STX &8E
2790 LDX #127
2800 STX &8F
2810 TAY
2820 LDX #&8B
2830 JSR &FFF1
2840 RTS
2850 .check
2860 ]
2870 :
2880 FOR pass=0 TO 2 STEP2
2890 P%=&900
2900 [OPT pass
2910 .crc
2920 CLC
2930 LDA #0
2940 STA &8E
2950 STA &8D
2960 TAY
2970 .loop1
2980 LDA &8E
2990 EOR (&8B),Y
3000 STA &8E
3010 LDX #8
3020 .loop2
3030 LDA &8E
3040 ROL A
3050 BCC skip
3060 LDA &8E
3070 EOR #8
3080 STA &8E
3090 LDA &8D
3100 EOR #16
3110 STA &8D
3120 .skip
3130 ROL &8D
3140 ROL &8E
3150 DEX
3160 BNE loop2
3170 INY
3180 CPY &8F
3190 BNE loop1
3200 RTS
3210 .read
3220 LDA #&80
3230 STA &8E
3240 LDA #&34
3250 STA &8C
3260 LDY #0
3270 STY &8D
3280 STY &8B
3290 STY &89
3300 .write
3310 LDY #0
3320 LDA &F4
3330 PHA
3340 LDA #bk
3350 STA &FE30
3360 LDX &8F
3370 .loop3
3380 LDA (&8D),Y
3390 STA (&8B),Y
3400 INY
3410 CPY &89
3420 BNE loop3
3430 INC &8C
3440 INC &8E
3450 DEX
3460 BNE loop3
3470 PLA
3480 STA &FE30
3490 RTS
3500 ]NEXT
3510 ENDPROC
3520 :
3530 DEFFNinput(x)
3540 PRINTSTRING$(x+1,CHR$(9))CHR$(124);
3550 PRINTSTRING$(x+2,CHR$(8))CHR$(124);
3560 ?&8D=x
3570 CALL&70
3580 =$&C00
3590 :
3600 DEFPROCmemleft
3610 x=&C000-P%-rom-30
3620 IF x<257 memleft=x ELSE x=x-30:IF x<513 memleft=x ELSE memleft=x-((x-512) DIV259)*3+(((x-512) MOD259)<>0)*3
3630 CLS
3640 PRINT'SPC(6)CHR$(131);
3650 PRINT"Maximum file length=&";
3660 PRINT;~memleft
3670 VDU28,0,23,39,8
3680 ENDPROC
3690 :
3700 DEFPROCencode
3710 @%=6
3720 block=0:address=&3400
3730 flag=0:blen=256
3740 IF length<257 blen=length:flag=&80
3750 PROCheader
3760 PRINTTAB(0,10)CHR$(131);
3770 PRINTfile$~block
3780 ?&89=blen:?&8F=1:!&8B=P%
3790 ?&8D=address MOD 256
3800 ?&8E=address DIV 256
3810 CALL write
3820 !&8B=address:?&8F=blen
3830 CALL crc
3840 hcrc=?&8E:lcrc=?&8D
3850 P%=P%+blen
3860 address=address+blen
3870 length=length-blen
3880 block=block+1
3890 PROCequb(hcrc)
3900 PROCequb(lcrc)
3910 IF flag=&80 @%=5:PRINTTAB(14,10)~!&2F8:VDU7:ENDPROC
3920 IF length<257 GOTO3740
3930 PROCequb(35)
3940 GOTO3760
3950 :
3960 DEFPROChblock
3970 PROCequb(42)
3980 PROCequs(file$)
3990 PROCequb(0)
4000 PROCequd(load)
4010 PROCequd(exec)
4020 PROCequw(block)
4030 PROCequw(blen)
4040 PROCequb(flag)
4050 PROCequd(search)
4060 ENDPROC
4070 :
4080 DEFPROCheader
4090 x=P%:P%=&980
4100 PROChblock
4110 !&8B=&981:?&8F=P%-&981
4120 CALL crc
4130 hcrc=?&8E:lcrc=?&8D:P%=x
4140 PROChblock
4150 PROCequb(hcrc)
4160 PROCequb(lcrc)
4170 ENDPROC
4180 :
4190 DEFPROCsave
4200 ?&8F=((P%-&8000)/256)+1
4210 CALL read
4220 VDU28,0,23,39,4
4230 CLS
4240 PRINTTAB(0,8)CHR$(134);
4250 PRINT"Name to save by: ";:tt$=FNinput(20)
4260 PRINT"Saving ";tt$
4270 PROCoscli("SAVE "+tt$+" 3400+"+STR$~(P%-&8000)+" FFFFD9CD FFFF8000")
4280 x=TIME+300:REPEAT:UNTILx<TIME
4290 ENDPROC
4300 DEFPROCequb(n)
4310 PROCsetequ
4320 ?&89=1:?&9F0=n
4330 CALL write
4340 P%=P%+1
4350 ENDPROC
4360 :
4370 DEFPROCequw(n)
4380 PROCsetequ
4390 ?&89=2:!&9F0=n
4400 :
4410 CALL write
4420 P%=P%+2
4430 ENDPROC
4440 :
4450 DEFPROCequd(n)
4460 PROCsetequ
4470 ?&89=4:!&9F0=n
4480 CALL write
4490 P%=P%+4
4500 ENDPROC
4510 :
4520 DEFPROCequs(n$)
4530 PROCsetequ
4540 ?&89=LEN n$:$&9F0=n$
4550 CALL write
4560 P%=P%+LEN n$
4570 ENDPROC
4580 :
4590 DEFPROCoscli(n$)
4600 OSCLI n$
4610 :
4620 ENDPROC
4630 :
4640 DEFPROCmore
4650 PRINTTAB(0,12)CHR$(134);
4660 PRINT"Any more? "CHR$(133);
4670 REPEAT x=GET
4680 x=(x OR &20)-32
4690 UNTIL x=89 OR x=78
4700 VDUx
4710 ENDPROC
4720 :
4730 DEFPROCsetequ
4740 ?&8F=1:!&8B=P%:?&8D=&F0:?&8E=&9
4750 ENDPROC
4760 :
4770 DEFPROCerr(n$)
4780 CLS
4790 PRINT'"There is an error in the ";n$
4800 PRINT"routine. Please check again."
4810 END
4820 :
4830 :
4840 DEFPROCcheck
4850 !&8B=&3400:?&8F=message2-&3400
4860 CALL crc
4870 x=!&8D AND &FFFF
4880 IF x<>42307 PROCerr("SETUP")
4890 !&8B=message2:?&8F=P%-message2
4900 CALL crc
4910 x=!&8D AND &FFFF
4920 IF x<>1569 PROCerr("SETUP")
4930 CLS:PRINT'"Code is correct."
4940 END
4950 :
4960 DEFPROCrdaddr
4970 !control%=name%
4980 $name%=file$
4990 X%=control%
5000 Y%=control% DIV 256
5010 A%=5:CALL osfile
5020 length=control%!10
5030 load=control%!2
5040 exec=control%!6
5050 ENDPROC
5060 :
5070 DEFPROCreloc
5080 PRINT"Relocating... Please wait."
5090 FOR X%=0 TO TOP-PAGE STEP4
5100 X%!&1200=X%!PAGE
5110 NEXT
5120 PAGE=&1200
5130 *K.0 OLD|MRUN|M
5140 *FX138,0,128
5150 END
5160 :
5170 DATA 0,2644,1,7986,2,8344,3,13822
5180 DATA 4,24524,5,19114,6,29952,7,24678
5190 DATA 8,41316,9,46082,10,35752,11,40654
5200 DATA 12,62716,13,57754,14,56880,15,52054