MODE 7
*TAPE
PAGE = &E00
40REM
50REM BBC end of !BBCTape application
60REM
70REM (C) S. Burke, 26/2/91
80REM
90REM The next few lines define where the buffers are, where the
100REM code goes and where the file loads to.
110REM
120:
130name       = &0B00
140name_high  = &0B
150name_low   = &00
160block      = &0B10
170block_high = &0B
180block_low  = &10
190code_start = &0B30
200load_page  = &0E
210:
220osfind = &FFCE
230osbget = &FFD7
240osfile = &FFDD  :REM Page 335 of the Advanced User Guide is wrong!
250osbyte = &FFF4
260:
270FOR opt%=0 TO 3 STEP 3
280P% = code_start
290[OPT opt%
300.go
310LDX #0
320LDA #2
330JSR osbyte        \ disable RS423
340LDX #0
350LDA #15
360JSR osbyte        \ flush all buffers
370LDX #2
380TXA
390JSR osbyte        \ enable RS423 receive
400.mainloop
410LDA #&0D
420STA name          \ null name
430JSR handshake
440:
450JSR get           \ get command
460CPY #&C0
470BEQ end           \ quit
480:
490CPY #&30
500BNE load
510JSR put_ok        \ confirm command
520JSR get_name      \ get filename
530JSR handshake
540JSR get
550.load
560CPY #&0C
570BNE load_byte
580JSR put_ok        \ confirm command
590JSR load_file
600JSR send_file
610JMP mainloop
620.load_byte
630CPY #&03
640BNE command_error
650JSR put_ok        \ confirm command
660JSR load_bget
670JSR send_file
680JMP mainloop
690.command_error
700LDA #0
710JSR put           \ command error
720JMP mainloop
730.end
740RTS
750.load_file
760LDA #name_low     \ set up parameter block
770STA block
780LDA #name_high
790STA block+1
800LDA #0
810STA block+2
820STA block+6
830LDA #load_page
840STA block+3
850LDA #&FF
860STA block+4
870STA block+5
880LDX #block_low
890LDY #block_high
900JSR osfile        \ load file
910LDA block+10
920STA &71
930LDA block+11
940STA &72           \ put file length in &71, &72
950JSR read_load_exec
960JMP read_name     \ get load/exec address and name
970.load_bget
980LDA #0
990STA &71:STA &72   \ file length in &71, &72
1000STA &73
1010LDA #load_page
1020STA &74           \ load address in &73, &74
1030:
1040LDX #name_low
1050LDY #name_high
1060LDA #&40
1070JSR osfind        \ open file
1080CMP #0
1090BEQ end           \ open failed?
1100STA &70           \ file handle
1110LDY #0
1120.loop
1130JSR escape        \ check for escape
1140TYA:TAX           \ no TYX instruction!
1150LDY &70
1160JSR osbget        \ get byte
1170PHA:TXA:TAY:PLA   \ just TXY!
1180BCS eof           \ end of file?
1190STA (&73),Y       \ can't use X register
1200INY
1210BNE loop          \ done 256 bytes?
1220INC &72:LDA #23:CMP &72:BCS loop:INC &74
1230BPL loop          \ should always be taken
1240.eof
1250STY &71:STY &73   \ set low bytes of counters
1260JSR read_load_exec
1270JSR read_name     \ get load/exec address and name
1280LDY &70
1290LDA #0
1300JMP osfind        \ close file
1310.read_name
1320LDX #&FF
1330.nameloop
1340INX
1350CPX #&C
1360BEQ too_far
1370LDA &3B2,X        \ pull filename out of cassette workspace
1380STA name,X        \ see AUG p. 279
1390BNE nameloop
1400.too_far
1410LDA #&0D
1420STA name,X
1430RTS
1440.get_name
1450LDX #&FF
1460STX &81           \ "get" corrupts registers
1470.get_char
1480CPX #&B
1490BEQ too_far
1500JSR get           \ get filename from Arc
1510TYA
1520INC &81   
1530LDX &81
1540STA name,X
1550CMP #&0D
1560BNE get_char
1570RTS
1580.read_load_exec
1590LDX #8
1600.load_exec_loop
1610LDA &3BD,X        \ load/exec address from cassette workspace
1620STA &81,X
1630DEX
1640BNE load_exec_loop
1650RTS
1660.handshake
1670LDA #ASC("S")
1680JSR put
1690LDA #ASC("B")
1700JSR put           \ send "SB" ...
1710JSR get
1720CPY #ASC("s")
1730BNE handshake
1740JSR get
1750CPY #ASC("b")
1760BNE handshake     \ ... and receive "sb" to handshake
1770RTS
1780.send_file
1790LDA &71
1800JSR put
1810LDA &72
1820JSR put           \ send file length
1830:
1840LDA #load_page
1850STA &74
1860LDA #0 
1870STA &73           \ reset load address
1880DEC &72           \ need this for test below
1890BMI last_block    \ file length < 256 bytes?
1900STA &80           \ block length = 0 ( = 256)
1910.send_block
1920JSR put_ok        \ not eof
1930LDA #3            \ send length 3 times
1940STA &76           \ use CRC low byte as counter
1950.lenout
1960LDA &80
1970JSR put           \ output block length
1980DEC &76
1990BNE lenout        \ CRC low byte zero at exit
2000LDY #0
2010STY &75           \ initialise CRC high byte
2020.send_byte
2030STY &70           \ save offset
2040LDA (&73),Y       \ load next byte ...
2050PHA
2060JSR put
2070PLA               \ get character back
2080JSR crc           \ update crc
2090LDY &70
2100INY               \ increment offset
2110CPY &80
2120BNE send_byte     \ end of block?
2130:
2140LDA &75
2150JSR put           \ output CRC high byte
2160LDA &76
2170JSR put           \ output CRC low byte
2180:
2190JSR get           \ look for confirmation
2200TYA
2210BEQ send_block    \ zero means error, so do again
2220:
2230INC &74           \ increment address high byte
2240DEC &72           \ decrement length high byte
2250BPL send_block    \ are we finished?
2260.last_block
2270LDY #0
2280LDA &71           \ length of last block
2290STY &71           \ set length to zero
2300STA &80
2310BNE send_block    \ output if non-zero
2320LDA #0
2330JSR put           \ zero marks eof
2340JSR put_load_exec \ send the load/exec adress
2350.put_name                   \ fall through to put_name ...
2360LDX #&FF
2370STX &81           \ "put" corrupts registers
2380.put_char                   \ output file name
2390INC &81
2400LDX &81
2410LDA name,X
2420PHA
2430JSR put
2440PLA
2450CMP #&0D
2460BNE put_char
2470RTS
2480.put_load_exec              \ put out load/exec address
2490LDX #0
2500STX &81           \ "put" corrupts registers
2510.put_load_exec_loop
2520LDA &82,X
2530JSR put
2540INC &81
2550LDX &81
2560CPX #8
2570BNE put_load_exec_loop
2580RTS
2590.put_ok
2600LDA #&FF
2610.put
2620PHA               \ save value to output
2630JSR escape
2640LDX #&FD
2650LDA #&80
2660JSR osbyte        \ get # empty bytes in RS423 output buffer
2670CPX #9
2680PLA
2690BCC put           \ if < 9 bytes remain, wait ...
2700:
2710LDX #2
2720TAY
2730LDA #&8A
2740JMP osbyte        \ ... and send it
2750.get
2760JSR escape
2770LDX #1
2780LDA #&91
2790JSR osbyte        \ read a byte
2800BCS get
2810RTS
2820.crc
2830EOR &75           \ calculate CRC in &75, &76
2840STA &75           \ algorithm from Advanced User Guide
2850LDX #8            \ I hope it's right!
2860.crc_loop
2870LDA &75
2880ROL A
2890BCC b7z
2900LDA &75
2910EOR #8
2920STA &75
2930LDA &76
2940EOR #&10
2950STA &76
2960.b7z
2970ROL &76
2980ROL &75
2990DEX
3000BNE crc_loop
3010RTS
3020.escape
3030LDA &FF
3040BMI error
3050RTS
3060.error
3070LDA #&7E
3080JSR osbyte        \ acknowledge escape
3090LDX #0
3100LDA #&0F
3110JSR osbyte        \ flush buffers (just in case)
3120LDY #0
3130LDA #0
3140JSR &FFCE         \ close all files
3150BRK
3160]
3170?P% = &11
3180P%  = P% + 1
3190$P% = "Escape" + CHR$0
3200NEXT opt%
*OPT 1,2
RUN
CALL go
