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