10 REM *************************************** 20 REM * DFS Xfer * 30 REM * BBC <-> PC Serial Transfer program * 40 REM * BBC End (Slave) * 50 REM * (c) Jon Welch, 2006 * 60 REM * Based on code written by : * 70 REM * Mark de Weger, 1996-1997 * 80 REM * Angus Duggan, 1999 * 90 REM *************************************** 100 : 110 REM ***************** 120 REM Main program 130 REM ***************** 140 : 150 REM Initialisation 160 PROCreset 170 REM Clear serial port buffers 180 *FX 21,1 190 *FX 21,2 200 MODE 7 210 ON ERROR PROCfatal_error 220 PROCsetvars 230 PROCassemble 240 PROCinitconnection 250 PROCmain 260 END 270 : 280 REM Main procedure 290 DEF PROCmain 300 REM Switch RS423 Escape off 310 *FX 181,1 320 REM Switch RS423 Printer selection off 330 *FX 5,0 340 REM Switch RS423 Output off 350 *FX 3,0 360 REM Switch output to printer off 370 VDU 3 380 REPEAT 390 REM Switch RS423 Output off 400 *FX 3,0 410 PROCstatus("waiting for command","",0) 420 g$=GET$ 430 IF g$="*" THEN name$=FNread_string 440 IF g$="*" THEN PROCoscli(name$) 450 REM N: command to send disc size 460 IF g$="N" THEN PROCsendsize 470 REM G: command to send disc sectors 480 IF g$="G" THEN PROCsendtrack 490 REM g: command to write DFS disc track 500 IF g$="g" THEN PROCwriteDFStrack 510 UNTIL g$="Q" 520 : 530 REM Quit 540 PROCreset 550 REM Clear RS423 input buffer 560 *FX 21,1 570 IF g$="Q" THEN PROCstatus("quitting DFS XFER","",0) ELSE PROCstatus("error at PC; quitting DFS XFER","",0) 580 END 590 : 600 REM ****************** 610 REM Oscli command 620 REM ****************** 630 : 640 REM Carry out * command 650 DEF PROCoscli(oscli$) 660 REM Switch output to printer on (*FX 3,3 doesn't work for *-commands) 670 VDU 2 680 REM Select RS423 for printer output 690 *FX 5,2 700 ON ERROR PROCallowed_error(err_txt$) 710 OSCLI(oscli$) 720 ON ERROR PROCfatal_error 730 PRINT sync_text$ 740 REM Switch output to printer off 750 VDU 3 760 REM Deselect RS423 for printer output 770 *FX 5,0 780 ENDPROC 790 : 800 REM **************************** 810 REM Send size of disc 820 REM **************************** 830 : 840 REM Send disc size 850 DEF PROCsendsize 860 ON ERROR PROCallowed_error(err_txt$):ENDPROC 870 X%=pblock% MOD 256 880 Y%=pblock% DIV 256 890 A%=&7E 900 CALL osword% 910 ON ERROR PROCfatal_error 920 REM Switch on RS423 output 930 *FX3,3 940 PROCwrite_integer(!pblock%) 950 REM Switch RS423 output off 960 *FX3,0 970 ENDPROC 980 : 990 REM **************************** 1000 REM 8271 read track 1010 REM **************************** 1020 : 1030 REM Send read track and perform CRC 1040 DEF PROCsendtrack 1050 ?pblock%=FNread_integer 1060 pblock%!1=buffer% 1070 pblock%?7=FNread_integer 1080 !crc%=0 1090 PROCstatus("sending drive "+STR$(?pblock%)+" track "+STR$(pblock%?7),"",0) 1100 REM Switch on RS423 output 1110 *FX3,3 1120 ON ERROR PROCallowed_error("") 1130 CALL readtrack% 1140 IF ?pblock%<>0 THEN PRINT err_txt2$ ELSE PROCwrite_integer(!crc%) 1150 ON ERROR PROCfatal_error 1160 REM Switch off RS423 output 1170 *FX3,0 1180 ENDPROC 1190 : 1200 REM **************************** 1210 REM 8271 write DFS track 1220 REM **************************** 1230 : 1240 REM Write track and perform CRC 1250 DEF PROCwriteDFStrack 1260 ?pblock%=FNread_integer 1270 pblock%!1=buffer% 1280 pblock%?7=FNread_integer 1290 !crc%=0 1300 PROCstatus("writing drive "+STR$(?pblock%)+" track "+STR$(pblock%?7),"",0) 1310 ON ERROR PROCallowed_error("") 1320 REM Print string to show ready to receive track 1330 *FX 3,3 1340 PRINT sync_text$ 1350 *FX 3,0 1360 CALL writeDFStrack% 1370 REM Send crc to pc 1380 *FX 3,3 1390 IF ?pblock%<>0 THEN PRINT err_txt2$ ELSE PROCwrite_integer(!crc%) 1400 ON ERROR PROCfatal_error 1410 REM Switch off RS423 output 1420 *FX3,0 1430 ENDPROC 1440 : 1450 REM **************************** 1460 REM Initialisation/error/status 1470 REM **************************** 1480 : 1490 REM Initialise and check connection 1500 DEF PROCinitconnection 1510 PROCstatus("Waiting for connection","",0) 1520 *FX 7,8 1530 *FX 8,8 1540 REM Receive from RS423 1550 *FX 2,1 1560 ENDPROC 1570 : 1580 REM Initialise variables 1590 DEF PROCsetvars 1600 DIM pblock% &11 1610 DIM nblock% 256 1620 osbyte%=&FFF4 1630 osword%=&FFF1 1640 oscli%=&FFF7 1650 osfile%=&FFDD 1660 osgbpb%=&FFD1 1670 oswrch%=&FFEE 1680 sync_text$="-----BBC-----PC-----" 1690 err_txt$="-----BBCerror1-----PC-----" 1700 err_txt2$="-----BBCerror2-----PC-----" 1710 @%=&90A 1720 REM Variables for mc 1730 bufsize%=4096 1740 crc%=&70 1750 filelength%=&74 1760 bufptr%=&78 1770 buflen%=&7A 1780 bufidx%=&7B 1790 dp%=&80 1800 sp%=&82 1810 sl%=&84 1820 dl%=&86 1830 ch%=&88 1840 ty%=&89 1850 ENDPROC 1860 : 1870 REM Print status of connection 1880 DEF PROCstatus(status$,file$,length%) 1890 CLS 1900 PRINT CHR$141;"DFS XFER" 1910 PRINT CHR$141;"DFS XFER" 1920 PRINT 1930 PRINT "" 1940 PRINT "Status: ";status$ 1950 IF file$<>"" THEN PRINT " File name: ";file$ 1960 IF length%<>0 THEN PRINT " File length: ";STR$(length%) 1970 PRINT "" 1980 ENDPROC 1990 : 2000 REM Reset RS423 2010 DEF PROCreset 2020 ON ERROR OFF 2030 REM Close serial port and reselect keyboard input 2040 *FX 2,0 2050 REM Flush serial port input buffer 2060 *FX 21,1 2070 REM Reselect VDU output 2080 *FX 3,0 2090 REM Deselect RS423 as printer destination 2100 *FX 5,0 2110 REM Switch printer output off 2120 VDU 3 2130 REM Close remaining open files 2140 CLOSE#0 2150 PRINT "" 2160 ENDPROC 2170 : 2180 REM Fatal error 2190 DEF PROCfatal_error 2200 PROCreset 2210 REPORT 2220 PRINT " at line ";ERL 2230 END 2240 ENDPROC 2250 : 2260 REM ******************** 2270 REM RS423 Utilities 2280 REM ******************** 2290 : 2300 REM Read string 2310 DEF FNread_string 2320 LOCAL string$,g$ 2330 string$="" 2340 REPEAT 2350 g$=GET$ 2360 REM IF ASC(g$)<32 THEN PRINT "~ ";~ASC(g$);" "; ELSE PRINT g$;" ";~ASC(g$);" "; 2370 IF g$<>CHR$(13) THEN string$=string$+g$ 2380 UNTIL g$=CHR$(13) 2390 PRINT 'string$ 2400 =string$ 2410 : 2420 REM Read integer 2430 DEF FNread_integer 2440 LOCAL s$ 2450 s$=FNread_string 2460 =VAL(s$) 2470 : 2480 REM Write integer 2490 DEF PROCwrite_integer(i%) 2500 LOCAL s$ 2510 s$=STR$(i%) 2520 PRINT s$ 2530 ENDPROC 2540 : 2550 REM Error to be trapped 2560 DEF PROCallowed_error(pc$) 2570 ON ERROR PROCfatal_error 2580 REM Close open files 2590 CLOSE#0 2600 REM Switch off RS423 output 2610 *FX 3,0 2620 REM De-select RS423 printer 2630 *FX 5,0 2640 REM Switch output to printer off 2650 VDU 3 2660 REM Switch RS423 Escape off 2670 *FX 181,1 2680 PROCstatus("error, waiting for PC to respond","",0) 2690 REM Switch on RS423 output 2700 *FX 3,3 2710 REM Print string to tell PC of error 2720 IF pc$<>"" THEN PRINT pc$ 2730 REM Wait for pc to respond acknowledgement of error 2740 pc$="" 2750 REPEAT 2760 g$=GET$ 2770 IF g$<>"" THEN pc$=pc$+g$ ELSE pc$="" 2780 IF LEN(pc$)>LEN(err_txt$) THEN pc$=RIGHT$(pc$,LEN(pc$)-1) 2790 UNTIL pc$=err_txt$ 2800 REM Send error to PC 2810 REPORT 2820 PRINT 2830 REM Switch off RS423 output 2840 *FX 3,0 2850 PROCmain 2860 : 2870 REM *********************** 2880 REM Machine code generation 2890 REM *********************** 2900 : 2910 DEF PROCassemble 2920 DIM mc% 800 2930 DIM buffer% bufsize% 2940 DIM destbuffer% 3000 2950 esc=27 2960 FOR opt%=0 TO 2 STEP 2 2970 P%=mc% 2980 [ 2990 OPT opt% 3000 \ Merge accumulator into CRC. Invalidates A,X,P 3010 .crccalc 3020 EOR crc%+1 3030 STA crc%+1 3040 LDX #8 3050 .crcloop 3060 LDA crc%+1 3070 ROL A 3080 BCC crcclear 3090 LDA crc% 3100 EOR #&57 3110 STA crc% 3120 .crcclear 3130 ROL crc% 3140 ROL crc%+1 3150 DEX 3160 BNE crcloop 3170 RTS 3180 \ 3190 \ 8271 command read track of data info buffer, and calculate CRC 3200 .readtrack% 3210 LDA #1 3220 STA pblock%+5 3230 LDA #&69 3240 STA pblock%+6 3250 LDX #pblock% MOD 256 3260 LDY #pblock% DIV 256 3270 LDA #&7F 3280 JSR osword% 3290 LDA pblock%+8 3300 BEQ P% + 5:JMP trackdone 3310 LDA #3 3320 STA pblock%+5 3330 LDA #&53:\ read multiple sectors 3340 STA pblock%+6 3350 LDA #0 3360 STA pblock%+8 3370 LDA #&2A 3380 STA pblock%+9 3390 LDX #pblock% MOD 256 3400 LDY #pblock% DIV 256 3410 LDA #&7F 3420 JSR osword% 3430 LDA pblock%+10 3440 BNE trackdone 3450 LDA #10 3460 STA buflen% 3470 .xfertrack 3480 \ Compress track and send 3490 LDA #buffer% MOD 256 3500 STA sp% 3510 LDA #buffer% DIV 256 3520 STA sp%+1 3530 .again 3540 LDA buflen% 3550 STA sl% + 1 3560 LDA #0 3570 STA sl% 3580 LDA #destbuffer% MOD 256 3590 STA dp% 3600 LDA #destbuffer% DIV 256 3610 STA dp%+1 3620 JSR compress 3630 LDA #destbuffer% MOD 256 3640 STA bufptr% 3650 LDA #destbuffer% DIV 256 3660 STA bufptr%+1 3670 LDA dl% 3680 JSR oswrch% 3690 JSR crccalc 3700 LDA dl% + 1 3710 JSR oswrch% 3720 JSR crccalc 3730 LDY #0 3740 .trackcrc 3750 LDA (bufptr%),Y 3760 JSR oswrch% 3770 JSR crccalc 3780 INC bufptr% 3790 BNE P% + 4 3800 INC bufptr%+1 3810 DEC dl% 3820 LDA dl% 3830 CMP #255 3840 BNE P% + 4 3850 DEC dl% + 1 3860 LDA dl% 3870 ORA dl% + 1 3880 BNE trackcrc 3890 LDA pblock%+10 3900 .trackdone 3910 STA pblock% 3920 RTS 3930 \ 3940 .put 3950 CPY #4:BCC P%+6:JSR multi:RTS 3960 CPY #1:BCC P%+5:JSR single 3970 CPY #2:BCC P%+5:JSR single 3980 CPY #3:BCC P%+5:JSR single 3990 RTS 4000 .multi 4010 LDA #esc:JSR single2 4020 TYA:JSR single1 4030 LDA ch%:JSR single1 4040 RTS 4050 .single2 4060 JSR single1 4070 LDA #0:JMP single1 4080 .single 4090 CMP #esc:BNE single1 4100 JSR single1 4110 PHA:LDA #1:JSR single1:PLA:RTS 4120 .single1 4130 STY ty%:LDY #0 4140 STA(dp%),Y 4150 INC dp%:BNE P%+4:INC dp%+1 4160 INC dl%:BNE P%+4:INC dl%+1 4170 LDY ty%:RTS 4180 .compress 4190 LDA #0:STA dl%:STA dl%+1 4200 .compress1 4210 LDA sl%:ORA sl%+1:BEQ compress5 4220 LDY #0 4230 LDA(sp%),Y:STA ch%:INY 4240 DEC sl%:LDA sl%:CMP#255:BNE P%+4:DEC sl%+1 4250 .compress2 4260 LDA sl%:ORA sl%+1:BEQ compress4 4270 LDA(sp%),Y:CMP ch%:BNE compress3 4280 INY 4290 DEC sl%:LDA sl%:CMP#255:BNE P%+4:DEC sl%+1 4300 CPY #255:BNE compress2 4310 .compress3 4320 LDA ch% 4330 JSR put 4340 CLC:TYA:ADC sp%:STA sp%:BCC P%+4:INC sp%+1 4350 JMP compress1 4360 .compress4 4370 LDA ch% 4380 JSR put 4390 CLC:TYA:ADC sp%:STA sp%:BCC P%+4:INC sp%+1 4400 .compress5 4410 RTS 4420 \ 4430 \ Receive a DFS track and write to disc 4440 .writeDFStrack% 4450 LDA #10 4460 STA buflen% 4470 JSR rcvtrack% 4480 \ Write track 4490 LDA #3 4500 STA pblock%+5 4510 LDA #&4B:\ write multiple sectors 4520 STA pblock%+6 4530 LDA #0 4540 STA pblock%+8 4550 LDA #&2A 4560 STA pblock%+9 4570 LDX #pblock% MOD 256 4580 LDY #pblock% DIV 256 4590 LDA #&7F 4600 JSR osword% 4610 LDA pblock%+10 4620 .write1 4630 STA pblock% 4640 RTS 4650 \ 4660 \ Receive a track 4670 .rcvtrack% 4680 LDA #buffer% MOD 256 4690 STA bufptr% 4700 LDA #buffer% DIV 256 4710 STA bufptr%+1 4720 JSR getchar:STA sl% 4730 JSR getchar:STA sl% + 1 4740 .rx1 4750 LDA sl%:ORA sl% + 1:BNE P% + 3:RTS 4760 JSR getchar1 4770 CMP#esc:BEQ rx2:JSR store:JMP rx1 4780 .rx2 4790 JSR getchar1 4800 CMP #0:BNE rx3 4810 JSR getchar1 4820 STA ty% 4830 JSR getchar1 4840 LDX ty% 4850 JSR store:DEX:BNE P% - 4:JMP rx1 4860 .rx3 4870 CMP #1:BEQ rx4:RTS 4880 .rx4 4890 LDA #esc:JSR store:JMP rx1 4900 .store 4910 LDY #0 4920 STA (bufptr%),Y 4930 INC bufptr%:BNE store1:INC bufptr% + 1 4940 \ PHA LDA#42 JSR&FFEE PLA 4950 .store1 4960 RTS 4970 .getchar 4980 LDA #145:LDX #1:JSR osbyte%:BCS getchar:TYA:PHA:JSR crccalc:PLA:RTS 4990 .getchar1 5000 JSR getchar:DEC sl%:LDX sl%:CPX#255:BNE P%+4:DEC sl%+1:RTS 5010 ] 5020 NEXT 5030 ENDPROC