   10REM ***************************************
   20REM * Xfer/BBC                            *
   30REM * BBC <-> PC Serial Transfer program  *
   40REM * BBC End (Slave)                     *
   50REM * (c) Mark de Weger, 1996-1997        *
   60REM ***************************************
   70:
   80:
   90REM *****************
  100REM Main program
  110REM *****************
  120:
  130REM Initialisation
  140PROCreset
  150REM Clear serial port buffers
  160*FX 21,1
  170*FX 21,2
  180MODE 7
  190ON ERROR PROCfatal_error
  200PROCsetvars
  210PROCassemble
  220PROCinitconnection
  230PROCmain
  240END
  250:
  260REM Main procedure
  270DEF PROCmain
  280REM Switch RS423 Escape off
  290*FX 181,1
  300REM Switch RS423 Printer selection off
  310*FX 5,0
  320REM Switch RS423 Output off
  330*FX 3,0
  340REM Switch output to printer off
  350VDU 3
  360PROCsetvars
  370REPEAT
  380REM Switch RS423 Output off
  390*FX 3,0
  400PROCstatus("waiting for command","",0)
  410g$=GET$
  420IF (g$="*") OR (g$="S") OR (g$="R") THEN name$=FNread_string
  430IF g$="*" THEN PROCoscli(name$)
  440IF g$="S" THEN PROCsendfile(name$)
  450IF g$="R" THEN PROCreceivefile(name$)
  460IF g$="T" THEN PROCtermemu
  470REM C: command to send current directory name (before transfer of file)
  480IF g$="C" THEN PROCsenddir
  490REM B: command to send current boot option
  500IF g$="B" THEN PROCsendboot
  510REM D: command to receive and set boot option
  520IF g$="F" THEN PROCreceiveboot
  530UNTIL g$="Q" OR g$="E"
  540:
  550REM Quit
  560PROCreset
  570REM Clear RS423 input buffer
  580*FX 21,1
  590IF g$="Q" THEN PROCstatus("quitting XFER","",0) ELSE PROCstatus("error at PC; quitting XFER","",0)
  600END
  610:
  620:
  630REM ******************
  640REM Oscli command
  650REM ******************
  660:
  670REM Carry out * command
  680DEF PROCoscli(oscli$)
  690REM Switch output to printer on (*FX 3,3 doesn't work for *-commands)
  700VDU 2
  710REM Select RS423 for printer output
  720*FX 5,2
  730ON ERROR PROCallowed_error
  740OSCLI(oscli$)
  750ON ERROR PROCfatal_error
  760PRINT sync_text$
  770REM Switch output to printer off
  780VDU 3
  790REM Deselect RS423 for printer output
  800*FX 5,0
  810ENDPROC
  820:
  830:
  840REM ******************
  850REM Send files to PC
  860REM ******************
  870:
  880REM Send file
  890DEF PROCsendfile(f$)
  900ON ERROR PROCallowed_error:ENDPROC
  910fh%=OPENIN(f$)
  920ON ERROR PROCfatal_error
  930REM Print string to show OPENIN went well
  940*FX 3,3
  950PRINT sync_text$
  960*FX 3,0
  970IF fh%=0 THEN fs%=0 ELSE fs%=EXT#fh%
  980REM If file does not exist: send 0 to pc
  990IF fh%=0 THEN OSCLI("FX3,3"):PROCwrite_integer(fh%):OSCLI("FX3,0"):ENDPROC
 1000PROCstatus("sending file",f$,fs%)
 1010REM Select serial port for output
 1020*FX 3,3
 1030REM Send confirmation that file exists (by non-0 number)
 1040PROCwrite_integer(fh%)
 1050REM Send file size
 1060PROCwrite_integer(fs%)
 1070REM Send file contents
 1080crc2%=FNsfc(fh%,fs%)
 1090CLOSE#fh%
 1100REM Send CRC
 1110PROCwrite_integer(crc2%)
 1120REM Send .inf file
 1130PROCsendinf(f$,fs%)
 1140REM Select VDU for output
 1150*FX 3,0
 1160ENDPROC
 1170:
 1180REM Send file contents
 1190DEF FNsfc(fh%,fs%)
 1200REM Initialise
 1210!crc%=0
 1220?bufstart%=buffer% MOD 256
 1230bufstart%?1=buffer% DIV 256
 1240?pblockstart%=pblock% MOD 256
 1250pblockstart%?1=pblock% DIV 256
 1260?pblock%=fh%
 1270?blocks_tbt%=(fs% DIV bufsize%)+1
 1280rest_bytes%=fs% MOD bufsize%
 1290IF rest_bytes%=0 THEN rest_bytes%=bufsize%:?blocks_tbt%=?blocks_tbt%-1
 1300?end_lb%=(buffer%+rest_bytes%) MOD 256
 1310end_lb%?1=(buffer%+rest_bytes%) DIV 256
 1320?bufend%=(buffer%+bufsize%) MOD 256
 1330bufend%?1=(buffer%+bufsize%) DIV 256
 1340REM Do it
 1350CALL sendfile
 1360=!crc%
 1370:
 1380REM Send .inf file
 1390DEF PROCsendinf(f$,length%)
 1400REM Osfile 5: reads file's catalog info
 1410$nblock%=f$
 1420?pblock%=nblock% MOD 256
 1430pblock%?1=nblock% DIV 256
 1440X%=pblock% MOD 256
 1450Y%=pblock% DIV 256
 1460A%=5
 1470CALL osfile%
 1480start%=pblock%!2 AND &00FFFFFF
 1490exec%=pblock%!6 AND &00FFFFFF
 1500load%=pblock%!&0A AND &00FFFFFF
 1510IF pblock%!&0E <> 0 THEN locked$="  Locked" ELSE locked$=""
 1520IF MID$(f$,2,1)="." THEN dir$="" ELSE dir$=FNgetcurrentdir+"."
 1530PRINT dir$;f$;"  ";~start%;"  ";~exec%;"  ";~length%;locked$
 1540ENDPROC
 1550:
 1560:
 1570REM **********************
 1580REM Receive files from PC
 1590REM **********************
 1600:
 1610REM Receive file
 1620DEF PROCreceivefile(f$)
 1630REM Receive file attributes+length
 1640start%=FNread_integer
 1650exec%=FNread_integer
 1660length%=FNread_integer
 1670locked$=FNread_string
 1680PROCstatus("receiving file",f$,length%)
 1690ON ERROR PROCallowed_error:ENDPROC
 1700fh%=OPENOUT(f$)
 1710ON ERROR PROCfatal_error
 1720REM Print string to show OPENOUT went well
 1730*FX 3,3
 1740PRINT sync_text$
 1750*FX 3,0
 1760REM Receive file contents
 1770crc2%=FNgetfilecontents(fh%,length%)
 1780CLOSE#fh%
 1790IF crc2%=-1 THEN ENDPROC
 1800crcrec%=FNread_integer
 1810REM Tell pc if crc error
 1820*FX 3,3
 1830IF crcrec%<>crc2% THEN PRINT err_txt2$:ENDPROC ELSE PRINT sync_text$
 1840*FX 3,0
 1850REM Osfile 1: set file attributes
 1860$nblock%=f$
 1870?pblock%=nblock% MOD 256
 1880pblock%?1=nblock% DIV 256
 1890pblock%!2=start%
 1900pblock%!6=exec%
 1910pblock%!&0A=length%
 1920pblock%!&0E=0
 1930X%=pblock% MOD 256
 1940Y%=pblock% DIV 256
 1950A%=1
 1960CALL osfile%
 1970IF MID$(locked$,1,1)="L" THEN OSCLI("ACCESS "+f$+" L")
 1980ENDPROC
 1990:
 2000REM Receive file contents
 2010DEF FNgetfilecontents(fh%,fs%)
 2020REM Initialise
 2030!bytes_transferred%=0
 2040!crc%=0
 2050!filelength%=fs%
 2060?max_bib_min1%=(bufsize%-1) MOD 256
 2070max_bib_min1%?1=(bufsize%-1) DIV 256
 2080?bufstart%=buffer% MOD 256
 2090bufstart%?1=buffer% DIV 256
 2100?pblockstart%=pblock% MOD 256
 2110pblockstart%?1=pblock% DIV 256
 2120?pblock%=fh%
 2130REM Do it
 2140ON ERROR PROCallowed_error:ENDPROC
 2150CALL receivefile
 2160ON ERROR PROCfatal_error
 2170=!crc%
 2180:
 2190:
 2200REM ****************************
 2210REM Terminal emulation
 2220REM ****************************
 2230:
 2240REM Start terminal emulation
 2250DEF PROCtermemu
 2260PROCstatus("terminal emulation","",0)
 2270REM Select RS423 as printer (*FX 3,3 doesn't work for *-commands)
 2280*FX 5,2
 2290REM Switch output to printer on
 2300VDU 2
 2310REM Enable RS423 Escape
 2320*FX 181,0
 2330END
 2340ENDPROC
 2350:
 2360:
 2370REM ****************************
 2380REM Send current directory name
 2390REM ****************************
 2400:
 2410DEF PROCsenddir
 2420dir$=FNgetcurrentdir
 2430REM Switch RS423 output on
 2440*FX3,3
 2450PRINT dir$
 2460REM Switch RS423 output off
 2470*FX3,0
 2480ENDPROC
 2490:
 2500:
 2510REM ****************************
 2520REM Send set/get boot option
 2530REM ****************************
 2540:
 2550REM Send !BOOT option
 2560DEF PROCsendboot
 2570REM Osgbpb 5: read boot option
 2580pblock%?1=nblock% MOD 256
 2590pblock%?2=nblock% DIV 256
 2600pblock%?3=0
 2610pblock%?4=0
 2620X%=pblock% MOD 256
 2630Y%=pblock% DIV 256
 2640A%=5
 2650CALL osgbpb%
 2660*FX 3,3
 2670PROCwrite_integer(?(nblock%+?nblock%+1))
 2680*FX 3,0
 2690ENDPROC
 2700:
 2710REM Receive and set !BOOT option
 2720DEF PROCreceiveboot
 2730REM Osbyte 139: *OPT X%,Y%
 2740Y%=FNread_integer
 2750X%=4
 2760A%=139
 2770CALL osbyte%
 2780ENDPROC
 2790:
 2800:
 2810REM ****************************
 2820REM Initialisation/error/status
 2830REM ****************************
 2840:
 2850REM Initialise and check connection
 2860DEF PROCinitconnection
 2870PROCstatus("Waiting for connection","",0)
 2880REM 1200 Baud RS423 Receiving
 2890*FX 7,4
 2900REM Receive from RS423
 2910*FX 2,1
 2920REM Test connection
 2930text$=FNread_string
 2940IF text$<>sync_text$ THEN PROCreset:PRINT "Invalid data received. Please try again.":END
 2950REM Get baud rate and set it
 2960x%=FNread_integer
 2970PRINT
 2980PRINT "Initializing at ";STR$(x%);" baud."
 2990PRINT
 3000REM Osbyte 7: set RS423 receiving speed
 3010IF x%=1200 THEN X%=4
 3020IF x%=2400 THEN X%=5
 3030IF x%=4800 THEN X%=6
 3040IF x%=9600 THEN X%=7
 3050IF x%=19200 THEN X%=8
 3060A%=7
 3070CALL osbyte%
 3080REM Osbyte 8: set RS423 sending speed
 3090A%=8
 3100CALL osbyte%
 3110ENDPROC
 3120:
 3130REM Initialise variables
 3140DEF PROCsetvars
 3150DIM pblock% &11
 3160DIM nblock% &1F
 3170osbyte%=&FFF4
 3180oscli%=&FFF7
 3190osfile%=&FFDD
 3200osgbpb%=&FFD1
 3210oswrch%=&FFEE
 3220sync_text$="-----BBC-----PC-----"
 3230err_txt$="-----BBCerror-----PC-----"
 3240err_txt2$="-----BBCerror-----PC-----2"
 3250@%=&90A
 3260REM Variables for mc
 3270bufsize%=4000
 3280bytes_in_buffer%=&70
 3290max_bib_min1%=&72
 3300crc%=&74
 3310filelength%=&78
 3320bytes_transferred%=&7C
 3330bufptr%=&80
 3340bufstart%=&82
 3350pblockstart%=&84
 3360end_lb%=&86
 3370bufend%=&88
 3380blocks_tbt%=&8A
 3390receivefile=M%
 3400sendfile=N%
 3410ENDPROC
 3420:
 3430REM Print status of connection
 3440DEF PROCstatus(status$,file$,length%)
 3450CLS
 3460PRINT CHR$141;"XFER/BBC"
 3470PRINT CHR$141;"XFER/BBC"
 3480PRINT
 3490PRINT "(c) 1996 Mark de Weger"
 3500PRINT
 3510PRINT
 3520PRINT ""
 3530PRINT "Status: ";status$
 3540IF file$<>"" THEN PRINT "  File name: ";file$
 3550IF length%<>0 THEN PRINT "  File length: ";STR$(length%)
 3560PRINT ""
 3570ENDPROC
 3580:
 3590REM Reset RS423
 3600DEF PROCreset
 3610ON ERROR OFF
 3620REM Close serial port and reselect keyboard input
 3630*FX 2,0
 3640REM Flush serial port input buffer
 3650*FX 21,1
 3660REM Reselect VDU output
 3670*FX 3,0
 3680REM Deselect RS423 as printer destination
 3690*FX 5,0
 3700REM Switch printer output off
 3710VDU 3
 3720REM Close remaining open files
 3730CLOSE#0
 3740PRINT ""
 3750ENDPROC
 3760:
 3770REM Fatal error
 3780DEF PROCfatal_error
 3790PROCreset
 3800REPORT
 3810PRINT " at line ";ERL
 3820END
 3830ENDPROC
 3840:
 3850:
 3860REM ********************
 3870REM RS423 Utilities
 3880REM ********************
 3890:
 3900REM Read string
 3910DEF FNread_string
 3920LOCAL string$,g$
 3930string$=""
 3940REPEAT
 3950g$=GET$
 3960IF g$<>CHR$(13) THEN string$=string$+g$
 3970UNTIL g$=CHR$(13)
 3980=string$
 3990:
 4000REM Read integer
 4010DEF FNread_integer
 4020LOCAL s$
 4030s$=FNread_string
 4040=VAL(s$)
 4050:
 4060REM Write integer
 4070DEF PROCwrite_integer(i%)
 4080LOCAL s$,loop%
 4090s$=STR$(i%)
 4100PRINT s$
 4110ENDPROC
 4120:
 4130:
 4140REM ********************
 4150REM Other utilities
 4160REM ********************
 4170:
 4180REM Get current directory name
 4190DEF FNgetcurrentdir
 4200REM Osgbpb 6: read directory (and device)
 4210$nblock%="xxxx"
 4220pblock%?1=nblock% MOD 256
 4230pblock%?2=nblock% DIV 256
 4240pblock%?3=0
 4250pblock%?4=0
 4260X%=pblock% MOD 256
 4270Y%=pblock% DIV 256
 4280A%=6
 4290CALL osgbpb%
 4300=CHR$(nblock%?3)
 4310:
 4320REM Error to be trapped
 4330DEF PROCallowed_error
 4340ON ERROR PROCfatal_error
 4350REM Close open files
 4360CLOSE#0
 4370REM Switch off RS423 output
 4380*FX 3,0
 4390REM De-select RS423 printer
 4400*FX 5,0
 4410REM Switch output to printer off
 4420VDU 3
 4430REM Switch RS423 Escape off
 4440*FX 181,1
 4450PROCstatus("error, waiting for PC to respond","",0)
 4460REM Switch on RS423 output
 4470*FX 3,3
 4480REM Print string to tell PC of error
 4490PRINT err_txt$
 4500REM Wait for pc to respond acknowledgement of error
 4510pc$=""
 4520REPEAT
 4530g$=GET$
 4540IF g$<>"" THEN pc$=pc$+g$ ELSE pc$=""
 4550IF LEN(pc$)>LEN(err_txt$) THEN pc$=RIGHT$(pc$,LEN(pc$)-1)
 4560UNTIL pc$=err_txt$
 4570REM Send error to PC
 4580REPORT
 4590PRINT
 4600REM Switch off RS423 output
 4610*FX 3,0
 4620PROCmain
 4630:
 4640:
 4650REM ***********************
 4660REM Machine code generation
 4670REM ***********************
 4680:
 4690DEF PROCassemble
 4700DIM mc% 400
 4710DIM buffer% bufsize%
 4720FOR opt%=0 TO 3 STEP 3
 4730P%=mc%
 4740[
 4750OPT opt%
 4760\
 4770\ Receive file
 4780.receivefile
 4790.M%
 4800\ *bytes_in_buffer%=0
 4810LDA #0
 4820STA bytes_in_buffer%
 4830STA bytes_in_buffer%+1
 4840.fillrbloop
 4850\ if !bytes_transferred%=!filelength% then goto recexit
 4860LDA bytes_transferred%
 4870CMP filelength%
 4880BNE elsec
 4890LDA bytes_transferred%+1
 4900CMP filelength%+1
 4910BNE elsec
 4920LDA bytes_transferred%+2
 4930CMP filelength%+2
 4940BNE elsec
 4950LDA bytes_transferred%+3
 4960CMP filelength%+3
 4970BNE elsec
 4980JMP recexit
 4990.elsec
 5000\ if *bytes_in_buffer%=*max_bib_min1% then goto saveexit
 5010LDA bytes_in_buffer%
 5020CMP max_bib_min1%
 5030BNE getbyte
 5040LDA bytes_in_buffer%+1
 5050CMP max_bib_min1%+1
 5060BNE getbyte
 5070JMP saveexit
 5080.getbyte
 5090\ Y%=get from RS423 input buffer
 5100LDA #145
 5110LDX #1
 5120JSR osbyte%
 5130\ if not gotten then goto getbyte
 5140BCS getbyte
 5150\ *bufptr%=buffer%+*bytes_in_buffer%
 5160CLC
 5170LDA bufstart%
 5180ADC bytes_in_buffer%
 5190STA bufptr%
 5200LDA bufstart%+1
 5210ADC bytes_in_buffer%+1
 5220STA bufptr%+1
 5230\ ?(bufptr)=Y%
 5240TYA
 5250LDX #0
 5260STA (bufptr%,X)
 5270\ !crc%=!crc%+(bufptr%)
 5280CLC
 5290ADC crc%
 5300STA crc%
 5310BCC elsee
 5320LDA #0
 5330ADC crc%+1
 5340STA crc%+1
 5350BCC elsee
 5360LDA #0
 5370ADC crc%+2
 5380STA crc%+2
 5390BCC elsee
 5400LDA #0
 5410ADC crc%+3
 5420STA crc%+3
 5430.elsee
 5440\ !bytes_transferred%=!bytes_transferred%+1
 5450CLC
 5460LDA #1
 5470ADC bytes_transferred%
 5480STA bytes_transferred%
 5490BCC elsed
 5500LDA #0
 5510ADC bytes_transferred%+1
 5520STA bytes_transferred%+1
 5530BCC elsed
 5540LDA #0
 5550ADC bytes_transferred%+2
 5560STA bytes_transferred%+2
 5570BCC elsed
 5580LDA #0
 5590ADC bytes_transferred%+3
 5600STA bytes_transferred%+3
 5610.elsed
 5620\ *bytes_in_buffer%=*bytes_in_buffer%+1
 5630CLC
 5640LDA #1
 5650ADC bytes_in_buffer%
 5660STA bytes_in_buffer%
 5670LDA #0
 5680ADC bytes_in_buffer%+1
 5690STA bytes_in_buffer%+1
 5700\ goto fillrbloop
 5710JMP fillrbloop
 5720.saveexit
 5730JSR buffertofile
 5740JMP receivefile
 5750.recexit
 5760JSR buffertofile
 5770.rrecexit
 5780RTS
 5790\
 5800\ Save contents of buffer to file
 5810.buffertofile
 5820\ pblock%!1=*bufstart%
 5830LDY #1
 5840LDA bufstart%
 5850STA (pblockstart%),Y
 5860INY
 5870LDA bufstart%+1
 5880STA (pblockstart%),Y
 5890INY
 5900LDA #0
 5910STA (pblockstart%),Y
 5920INY
 5930STA (pblockstart%),Y
 5940\ pblock%!5=*bytes_in_buffer%
 5950INY
 5960LDA bytes_in_buffer%
 5970STA (pblockstart%),Y
 5980INY
 5990LDA bytes_in_buffer%+1
 6000STA (pblockstart%),Y
 6010INY
 6020LDA #0
 6030STA (pblockstart%),Y
 6040INY
 6050STA (pblockstart%),Y
 6060\ osgbpb 2 (Save block of data)
 6070LDA #2
 6080LDX pblockstart%
 6090LDY pblockstart%+1
 6100JSR osgbpb%
 6110RTS
 6120\
 6130\ Send file
 6140.sendfile
 6150.N%
 6160\ IF ?blocks_tbt%=0 THEN GOTO .sendexit
 6170LDA blocks_tbt%
 6180CMP #0
 6190BEQ sendexit
 6200\ load block of data
 6210\ pblock%!1=*bufstart%
 6220LDY #1
 6230LDA bufstart%
 6240STA (pblockstart%),Y
 6250INY
 6260LDA bufstart%+1
 6270STA (pblockstart%),Y
 6280INY
 6290LDA #0
 6300STA (pblockstart%),Y
 6310INY
 6320STA (pblockstart%),Y
 6330\ pblock%!5=bufsize%
 6340INY
 6350LDA #bufsize% MOD 256
 6360STA (pblockstart%),Y
 6370INY
 6380LDA #bufsize% DIV 256
 6390STA (pblockstart%),Y
 6400INY
 6410LDA #0
 6420STA (pblockstart%),Y
 6430INY
 6440STA (pblockstart%),Y
 6450\ load block
 6460LDA #4
 6470LDX pblockstart%
 6480LDY pblockstart%+1
 6490JSR osgbpb%
 6500\ ?blocks_tbt%=?blocks_tbt%-1
 6510DEC blocks_tbt%
 6520\ send block to pc and start new block
 6530JSR sendblock
 6540JMP sendfile
 6550.sendexit
 6560RTS
 6570\
 6580\ send block to pc and calculate crc
 6590.sendblock
 6600\ *bufptr%=*bufstart%
 6610LDA bufstart%
 6620STA bufptr%
 6630LDA bufstart%+1
 6640STA bufptr%+1
 6650.sbloop
 6660\ VDU ?(bufptr%)
 6670LDY #0
 6680LDA (bufptr%),Y
 6690JSR oswrch%
 6700\ !crc%=!crc%+?tempadr%
 6710CLC
 6720ADC crc%
 6730STA crc%
 6740BCC elses
 6750LDA #0
 6760ADC crc%+1
 6770STA crc%+1
 6780BCC elses
 6790LDA #0
 6800ADC crc%+2
 6810STA crc%+2
 6820BCC elses
 6830LDA #0
 6840ADC crc%+3
 6850STA crc%+3
 6860.elses
 6870\ *bufptr%=*bufptr%+1
 6880CLC
 6890LDA #1
 6900ADC bufptr%
 6910STA bufptr%
 6920LDA #0
 6930ADC bufptr%+1
 6940STA bufptr%+1
 6950\ IF ?blocks_tbt%<>0 THEN GOTO .testall
 6960LDA blocks_tbt%
 6970CMP #0
 6980BNE testall
 6990\ IF *bufptr%=*end_lb% THEN RETURN ELSE GOTO sbloop
 7000LDA bufptr%
 7010CMP end_lb%
 7020BNE elses1
 7030LDA bufptr%+1
 7040CMP end_lb%+1
 7050BNE elses1
 7060RTS
 7070.elses1
 7080JMP sbloop
 7090.testall
 7100\ IF *bufptr%=*bufend% THEN RETURN ELSE GOTO sbloop
 7110LDA bufptr%
 7120CMP bufend%
 7130BNE elses2
 7140LDA bufptr%+1
 7150CMP bufend%+1
 7160BNE elses2
 7170RTS
 7180.elses2
 7190JMP sbloop
 7200]
 7210NEXT
 7220ENDPROC