MODE 7
*TAPE
PAGE = &E00
REM
REM BBC end of !BBCTape application
REM
REM (C) S. Burke, 26/2/91
REM
REM The next few lines define where the buffers are, where the
REM code goes and where the file loads to.
REM
:
name       = &0B00
name_high  = &0B
name_low   = &00
block      = &0B10
block_high = &0B
block_low  = &10
code_start = &0B30
load_page  = &0E
:
osfind = &FFCE
osbget = &FFD7
osfile = &FFDD  :REM Page 335 of the Advanced User Guide is wrong!
osbyte = &FFF4
:
FOR opt%=0 TO 3 STEP 3
P% = code_start
[OPT opt%
.go
          LDX #0
          LDA #2
          JSR osbyte        \ disable RS423
          LDX #0
          LDA #15
          JSR osbyte        \ flush all buffers
          LDX #2
          TXA
          JSR osbyte        \ enable RS423 receive
.mainloop
          LDA #&0D
          STA name          \ null name
          JSR handshake
:
          JSR get           \ get command
          CPY #&C0
          BEQ end           \ quit
:
          CPY #&30
          BNE load
          JSR put_ok        \ confirm command
          JSR get_name      \ get filename
          JSR handshake
          JSR get
.load
          CPY #&0C
          BNE load_byte
          JSR put_ok        \ confirm command
          JSR load_file
          JSR send_file
          JMP mainloop
.load_byte
          CPY #&03
          BNE command_error
          JSR put_ok        \ confirm command
          JSR load_bget
          JSR send_file
          JMP mainloop
.command_error
          LDA #0
          JSR put           \ command error
          JMP mainloop
.end
          RTS
.load_file
          LDA #name_low     \ set up parameter block
          STA block
          LDA #name_high
          STA block+1
          LDA #0
          STA block+2
          STA block+6
          LDA #load_page
          STA block+3
          LDA #&FF
          STA block+4
          STA block+5
          LDX #block_low
          LDY #block_high
          JSR osfile        \ load file
          LDA block+10
          STA &71
          LDA block+11
          STA &72           \ put file length in &71, &72
          JSR read_load_exec
          JMP read_name     \ get load/exec address and name
.load_bget
          LDA #0
          STA &71:STA &72   \ file length in &71, &72
          STA &73
          LDA #load_page
          STA &74           \ load address in &73, &74
:
          LDX #name_low
          LDY #name_high
          LDA #&40
          JSR osfind        \ open file
          CMP #0
          BEQ end           \ open failed?
          STA &70           \ file handle
          LDY #0
.loop
          JSR escape        \ check for escape
          TYA:TAX           \ no TYX instruction!
          LDY &70
          JSR osbget        \ get byte
          PHA:TXA:TAY:PLA   \ just TXY!
          BCS eof           \ end of file?
          STA (&73),Y       \ can't use X register
          INY
          BNE loop          \ done 256 bytes?
          INC &72:INC &74   \ increment high bytes of counters
          BPL loop          \ should always be taken
.eof
          STY &71:STY &73   \ set low bytes of counters
          JSR read_load_exec
          JSR read_name     \ get load/exec address and name
          LDY &70
          LDA #0
          JMP osfind        \ close file
.read_name
          LDX #&FF
.nameloop
          INX
          CPX #&C
          BEQ too_far
          LDA &3B2,X        \ pull filename out of cassette workspace
          STA name,X        \ see AUG p. 279
          BNE nameloop
.too_far
          LDA #&0D
          STA name,X
          RTS
.get_name
          LDX #&FF
          STX &81           \ "get" corrupts registers
.get_char
          CPX #&B
          BEQ too_far
          JSR get           \ get filename from Arc
          TYA
          INC &81   
          LDX &81
          STA name,X
          CMP #&0D
          BNE get_char
          RTS
.read_load_exec
          LDX #8
.load_exec_loop
          LDA &3BD,X        \ load/exec address from cassette workspace
          STA &81,X
          DEX
          BNE load_exec_loop
          RTS
.handshake
          LDA #ASC("S")
          JSR put
          LDA #ASC("B")
          JSR put           \ send "SB" ...
          JSR get
          CPY #ASC("s")
          BNE handshake
          JSR get
          CPY #ASC("b")
          BNE handshake     \ ... and receive "sb" to handshake
          RTS
.send_file
          LDA &71
          JSR put
          LDA &72
          JSR put           \ send file length
:
          LDA #load_page
          STA &74
          LDA #0 
          STA &73           \ reset load address
          DEC &72           \ need this for test below
          BMI last_block    \ file length < 256 bytes?
          STA &80           \ block length = 0 ( = 256)
.send_block
          JSR put_ok        \ not eof
          LDA #3            \ send length 3 times
          STA &76           \ use CRC low byte as counter
.lenout
          LDA &80
          JSR put           \ output block length
          DEC &76
          BNE lenout        \ CRC low byte zero at exit
          LDY #0
          STY &75           \ initialise CRC high byte
.send_byte
          STY &70           \ save offset
          LDA (&73),Y       \ load next byte ...
          PHA
          JSR put
          PLA               \ get character back
          JSR crc           \ update crc
          LDY &70
          INY               \ increment offset
          CPY &80
          BNE send_byte     \ end of block?
:
          LDA &75
          JSR put           \ output CRC high byte
          LDA &76
          JSR put           \ output CRC low byte
:
          JSR get           \ look for confirmation
          TYA
          BEQ send_block    \ zero means error, so do again
:
          INC &74           \ increment address high byte
          DEC &72           \ decrement length high byte
          BPL send_block    \ are we finished?
.last_block
          LDY #0
          LDA &71           \ length of last block
          STY &71           \ set length to zero
          STA &80
          BNE send_block    \ output if non-zero
          LDA #0
          JSR put           \ zero marks eof
          JSR put_load_exec \ send the load/exec adress
.put_name                   \ fall through to put_name ...
          LDX #&FF
          STX &81           \ "put" corrupts registers
.put_char                   \ output file name
          INC &81
          LDX &81
          LDA name,X
          PHA
          JSR put
          PLA
          CMP #&0D
          BNE put_char
          RTS
.put_load_exec              \ put out load/exec address
          LDX #0
          STX &81           \ "put" corrupts registers
.put_load_exec_loop
          LDA &82,X
          JSR put
          INC &81
          LDX &81
          CPX #8
          BNE put_load_exec_loop
          RTS
.put_ok
          LDA #&FF
.put
          PHA               \ save value to output
          JSR escape
          LDX #&FD
          LDA #&80
          JSR osbyte        \ get # empty bytes in RS423 output buffer
          CPX #9
          PLA
          BCC put           \ if < 9 bytes remain, wait ...
:
          LDX #2
          TAY
          LDA #&8A
          JMP osbyte        \ ... and send it
.get
          JSR escape
          LDX #1
          LDA #&91
          JSR osbyte        \ read a byte
          BCS get
          RTS
.crc
          EOR &75           \ calculate CRC in &75, &76
          STA &75           \ algorithm from Advanced User Guide
          LDX #8            \ I hope it's right!
.crc_loop
          LDA &75
          ROL A
          BCC b7z
          LDA &75
          EOR #8
          STA &75
          LDA &76
          EOR #&10
          STA &76
.b7z
          ROL &76
          ROL &75
          DEX
          BNE crc_loop
          RTS
.escape
          LDA &FF
          BMI error
          RTS
.error
          LDA #&7E
          JSR osbyte        \ acknowledge escape
          LDX #0
          LDA #&0F
          JSR osbyte        \ flush buffers (just in case)
          LDY #0
          LDA #0
          JSR &FFCE         \ close all files
          BRK
]
?P% = &11
P%  = P% + 1
$P% = "Escape" + CHR$0
NEXT opt%
*OPT 1,2
RUN
CALL go
