The IC is 4K ROM 2732.
Only the last 2K is used.
This code assembles using the ca65 assembler.
This code is the starting point for my own 65C02 prototype, which does not have a Tube chip.
Instead, the handshaking signals of an FTDI USB FIFO module were arranged
to look like one channel of a Tube interface.
This minimised the amount of software alteration work (and potential for error).
; Copied from http://stardot.org.uk/forums/viewtopic.php?t=8852$f=44
; Has to have CRLF so it can be pasted into BeebEm
; NB not all bytes are shown in listing for text messages
; >Client/src
; Source for 6502 Tube Client
; As supplied with External 6502 Second Processor
; Code copyright Acorn Computer
; Commentary copyright J.G.Harston
; Uncomment the next line to get
; the original source as a reference
; reference_code
LF =$0A
CR =$0D
vector_table =$200
USERV =$200
BRKV =$202
IRQ1V =$204
IRQ2V =$206
CLIV =$208
BYTEV =$20A
WORDV =$20C
WRCHV =$20E
RDCHV =$210
FILEV =$212
ARGSV =$214
BGetV =$216
BPutV =$218
GBPBV =$21A
FINDV =$21C
FSCV =$21E
EVNTV =$220
UPTV =$222
NETV =$224
VduV =$226
KEYV =$228
INSV =$22A
RemV =$22C
CNPV =$22E
IND1V =$230
IND2V =$232
IND3V =$234
ERRBUF =$236
INPBUF =$236
vector_table_size = VECDEF-vector_table_defaults
; Memory addresses
pointer_to_current_program =$EE ; $EE/F = PROG 0 Current program
hex_accumulator =$F0 ; $F0/1 = NUM 0 hex accumulator
pointer_to_top_of_memory =$F2 ; $F2/3 = MEMTOP 0 top of memory
address_of_byte_transfer_address =$F4 ; $F4/5 = address of byte transfer address, NMIAddr or ADDR
pointer_to_transfer =$F6 ; $F6/7 = ADDR 0 Data transfer address
string_pointer =$F8 ; $F8/9 = String pointer, OSWORD control block
pointer_at_FA =$FA ; $FA/B = CTRL 0 OSFILE, OSGBPB control block, PrText string pointer
IRQ_A_store =$FC ; $FC = IRQ A store
error_510_last_error =$FD ; $FD/E Err 510 last error
escape_flag =$FF ; $FF = Escape flag
; Status register bits:
; bit 7 - data available/IRQ
; bit 6 - not full
;
; I/O Co-proc
; addr addr
; Register number 1
;
; &FEE0 &FEF8 status write/read (clears IRQ)
; &FEE1 &FEF9 data
; Parasite to Host: Carries the OSWRCH call.
; Data register is a FIFO that can handle
; a VDU command length (10 bytes).
; Host to Parasite: There is a 1 byte buffer.
; It is used to generate IRQ's in the parasite
; from events in the host.
;
; Register number 2
;
; &FEE2 &FEFA status write/read
; &FEE3 &FEFB data
; Used to implement OS calls that take a long time
; or that cannot interrupt Host tasks.
; The parasite passes a byte describing the required task.
; The two processors then exchange data until the task is complete.
; OS calls handled through this register include:
; OSRDCH, OSCLI, OSBYTE, OSWORD, OSBPUT,
; OSBGET, OSFIND, OSARGS, OSFILE, OSGBPB.
;
; Register number 3
;
; &FEE4 &FEFC status write/read (clears IRQ)
; &FEE5 &FEFD data available/NMI
; Used for the background task of fast data transfer between the two processors.
;
; Register number 4
;
; &FEE6 &FEFE write (sets IRQ)/read (clears IRQ)
; bit 7 - data available/IRQ
; bit 6 - not full/IRQ
; &FEE7 &FEFF data available/NMI
; Used for the background task of fast data transfer between the two processors.
; Used as the control channel for block transfers going through Register 3,
; and also the transfer register for error strings from host to parasite.
; In both cases, the host interrupts the parasite by placing a byte into the Register.
; In the former case it is a byte describing the required action,
; in the latter it is an error code.
;
;
.macro pull_var16_via_A var
PLA
STA var
PLA
STA var+1
.endmacro
.macro inc16 addr
.local skip
inc addr
bne skip
inc addr+1
skip:
.endmacro
.macro load_ax arg
.if (.match (.left (1, {arg}), #))
; immediate mode
LDA #<(.right (.tcount ({arg})-1, {arg}))
LDX #>(.right (.tcount ({arg})-1, {arg}))
.else
; assume absolute or zero page
LDA arg
LDX 1+(arg)
.endif
.endmacro
.macro load_xy arg
.if (.match (.left (1, {arg}), #))
; immediate mode
LDX #<(.right (.tcount ({arg})-1, {arg}))
LDY #>(.right (.tcount ({arg})-1, {arg}))
.else
; assume absolute or zero page
LDX arg
LDY 1+(arg)
.endif
.endmacro
; .macro load_xy value
; LDX #<value ; X := bits 0 to 7
; LDY #>value ; Y := bits 8 to 16
; .endmacro
.macro load_vector_with_address_via_A address, value
LDA #<value ; move LS byte first
STA address
LDA #>value
STA address+1
.endmacro
.macro copy_word_from_src_to_dst_via_A src, dst
LDA src
STA dst
LDA src+1
STA dst+1
.endmacro
; Tube macros use the BIT instruction to test the handshake flags.
; The USB module FIFO can be made to look exactly
; like a Tube FIFO, lucky for us!
; USB_BASE+0
; bit 7 = data available
; bit 6 = not full
; USB_BASE+1
; bit 7 =
; bit 6 =
; The BIT instruction copies bits 7 and 6 to the flag register
; The S and V flags are set to match bits 7 and 6 respectively in the value stored at the tested address.
; So
; BIT status
; BPL branch_here_if_bit_7_is_0 ; no data available, so wait
; BMI branch_here_if_bit_7_is_1 ; okay to read
; BVC branch_here_if_bit_6_is_0 ; full, so wait
; BVS branch_here_if_bit_6_is_1 ; okay to write
;
; In my VHDL code for the Atom, the bits are in the right position,
;
; -- cpu reads the usb status for handshaking
; s_status_d(7) <= usb_rd_wait;
; s_status_d(6) <= usb_wr_wait;
;
; # external USB module control signals
; ############################################
; NET "usb_rd_wait" LOC = "P192"; # rxf
; NET "usb_wr_wait" LOC = "P194"; # txe
; NET "usb_n_rd_strobe" LOC = "P193"; # n_rd
; NET "usb_wr_strobe" LOC = "P198"; # n_wr
;
; This is the module I have:
; http://www.ftdichip.com/Support/Documents/DataSheets/DLP/dlp2232ml-v21-ds.pdf
; using the FT2232 chip
; http://www.ftdichip.com/Support/Documents/DataSheets/ICs/DS_FT2232D.pdf
; in "245 FIFO" mode,
; pin 13 = TXE# so 1 = tx empty, okay to write (same sense as the tube?)
; pin 15 = RXF# so 0 = rx full, data available
; pins
; A B
; 15 30 RXF# OUTPUT When high, do not read data from the FIFO.
; When low, there is data available in the FIFO
; 13 29 TXE# OUTPUT When high, do not write data into the FIFO.
; When low, data can be written into
;
; so these both work as "wait while high"
; this is the opposite of the Tube,
; so one can either modify the code
; or use inverting buffers in hardware
;
; We can make the one USB FIFO look like all four Tube FIFOs
; by just partially decoding the address,
; i.e. it appears in four locations.
;
; Pimp BBC micro to 8 MHz?
;
; Idea for testing:
; Use BBC micro as ready-wired 6502 system,
; add USB module as a Tube!
; Add socket for Flash ROM
;
;
;=============================
;
; These macros hide the polarity of the status flags
;
;
.macro wait_to_write_FIFO n
.local wait
wait:
BIT TUBE_BASE +n*2-2 ; S = (n-1)*2 == n*2-2
BVC wait ; writing tests using BVC
.endmacro
.macro wait_to_read_FIFO n
.local wait
wait:
BIT TUBE_BASE +n*2-2
BPL wait ; reading tests using BPL
.endmacro
;=========================
.macro STA_FIFO n
wait_to_write_FIFO n
STA TUBE_BASE +n*2-1 ; S = (n-1)*2 == n*2-2
.endmacro
.macro STX_FIFO n
wait_to_write_FIFO n
STX TUBE_BASE +n*2-1
.endmacro
.macro STY_FIFO n
wait_to_write_FIFO n
STY TUBE_BASE +n*2-1
.endmacro
.macro LDA_FIFO n
wait_to_read_FIFO n
LDA TUBE_BASE +n*2-1
.endmacro
.macro LDX_FIFO n
wait_to_read_FIFO n
LDX TUBE_BASE +n*2-1
.endmacro
.macro LDY_FIFO n
wait_to_read_FIFO n
LDY TUBE_BASE +n*2-1
.endmacro
; .enum command_codes
command_OSRDCH = $00
command_OSCLI = $02
command_OSBYTELO = $04
command_OSBYTEHI = $06
command_RDLINE = $0A
command_OSARGS = $0C
command_OSBGET = $0E
command_OSBPUT = $10
command_OSFIND = $12
command_OSFILE = $14
command_OSGBPB = $16
; .endenum
.macro send_command_code code
LDA code
JSR SendCommand
.endmacro
;
; load% =$F800
.org $F800 ; actually the job of the linker
; DIM mcode% $900
; FOR P=0TO1
; P%=load%
; O%=mcode%
; [OPT P*3+4
last_256_bytes = $FF00
last_4K_space = $F000
ROM_BASE = $8000; copies 16K BASIC and User BIOS space
ROM_START:
RESET:
LDX #0 ; Move 256 bytes
loop_F802:
LDA last_256_bytes,X ; Read from ROM
STA last_256_bytes,X ; Write to RAM
DEX
BNE loop_F802
;
LDX #vector_table_size ;
load_vector_table:
LDA vector_table_defaults,X
STA vector_table,X ; Set up default vectors
DEX
BPL load_vector_table
TXS ; Clear stack
;
LDX #$F0 ; $FDFF+$F0 = $FEEF
loop_F819:
LDA $FDFF,X
STA $FDFF,X ; Copy $FE00-$FEEF to RAM, avoiding
DEX
BNE loop_F819 ; the Tube registers at $FEFx
;
LDY #<ROM_BASE ; was RESET
STY string_pointer ; Point to start of ROM
LDA #>ROM_BASE ; was RESET
STA string_pointer+1
;
; loop_F82A:
Copy_rest_of_ROM_to_RAM: ; Copy a page
LDA (string_pointer),Y ; from ROM
STA (string_pointer),Y ; to RAM
INY
BNE Copy_rest_of_ROM_to_RAM ; Loop for 256 bytes
;
INC string_pointer+1 ; the high byte
LDA string_pointer+1 ; Inc. address high byte
CMP #$FE
BNE Copy_rest_of_ROM_to_RAM ; Loop from $F800 to $FDFF
;
LDX #$10
;
; loop_F83B:
Copy_jump_code_to_hex_0100:
LDA code_for_post_ROM_copy,X
STA $0100,X ; Copy jump code to $100
DEX
BPL Copy_jump_code_to_hex_0100
;
copy_word_from_src_to_dst_via_A pointer_to_current_program, pointer_to_transfer
LDA #$00
STA escape_flag ; Clear Escape flag
STA pointer_to_top_of_memory
LDA #$F8
STA pointer_to_top_of_memory+1 ; Set memtop to start of ROM at $F800
JMP $0100 ; Jump via low memory to page ROM out
; Executed in low memory to page ROM out
; --------------------------------------
; LF859:
code_for_post_ROM_copy:
LDA TubeS 1 ; Acessing the Tube disables the ROM
CLI ;
LF85D:
JMP startup ; Jump to initialise I/O with banner
;
vector_F85E = LF85D+1
;
; Warning: self-modifying code above!
;
;
; LF860:
startup:
JSR PrText ; Display startup banner
.byte LF
.byte "Acorn TUBE 6502 64K"
.byte LF, LF, CR
.byte 0
NOP
load_vector_with_address_via_A vector_F85E, CmdOSLoop
JSR WaitByte ; Wait for Acknowledge
CMP #$80
BEQ EnterCode ; If $80, jump to enter code
; Otherwise, enter command prompt loop
; Minimal Command prompt
; Err 510
CmdOSLoop:
LDA #'*'
JSR OSWRCH ; Print '*' prompt
load_xy #Control_block_for_command_prompt_input
LDA #$00
JSR OSWORD ; Read line to INPBUF
BCS CmdOSEscape
load_xy #INPBUF
JSR OS_CLI
JMP CmdOSLoop ; and loop back for another
CmdOSEscape:
LDA #$7E
JSR OSBYTE ; Acknowledge Escape state
BRK
.byte 17
.byte "Escape"
BRK
; Enter Code pointer to by $F6/7
; Err 510
; Checks to see if code has a ROM header, and verifies
; it if it has
EnterCode:
LDA pointer_to_transfer
STA pointer_to_current_program
STA pointer_to_top_of_memory ; Set current program and memtop
LDA pointer_to_transfer+1
STA pointer_to_current_program+1
STA pointer_to_top_of_memory+1 ; to address being entered
LDY #$07
LDA (pointer_to_current_program),Y ; Get copyright offset
CLD
CLC
ADC pointer_to_current_program
STA error_510_last_error
LDA #$00
ADC pointer_to_current_program+1
STA error_510_last_error+1 ; $FD/E=>copyright message
;
; Now check for $00,"(C)"
LDY #0
;
LDA (error_510_last_error),Y
BNE no_copyright ; Jump if no initial $00
;
INY
LDA (error_510_last_error),Y
CMP #'('
BNE no_copyright ; Jump if no '('
;
INY
LDA (error_510_last_error),Y
CMP #'C'
BNE no_copyright ; Jump if no 'C'
;
INY
LDA (error_510_last_error),Y
CMP #')'
BNE no_copyright ; Jump if no ')'
;
; $00,"(C)" exists
LDY #$06
LDA (pointer_to_current_program),Y ; Get ROM type
AND #$4F ; $4F == 01001111
CMP #$40
BCC NotLanguage ; b6=0, not a language
;
AND #$0D ; $0D == 00001101
BNE Not6502Code ; type<>0 and <>2, not 6502 code
no_copyright:
LDA #$01
JMP (pointer_to_top_of_memory) ; Enter code with A=1
;
; Any existing error handler will probably have been overwritten
; Set up new error handler before generating an error
NotLanguage:
load_vector_with_address_via_A BRKV, ErrorHandler ; Claim error handler
BRK
.byte 0
.byte "This is not a language"
.byte 0
Not6502Code:
load_vector_with_address_via_A BRKV, ErrorHandler ; Claim error handler
BRK
.byte 0
.byte "I cannot run this code"
.byte 0
ErrorHandler:
LDX #$FF
TXS ; Clear stack
JSR OSNEWL
LDY #$01
loop_F94D:
LDA (error_510_last_error),Y
BEQ LF957 ; Print error string
JSR OSWRCH
INY
BNE loop_F94D
LF957:
JSR OSNEWL
JMP CmdOSLoop ; Jump to command prompt
; Control block for command prompt input
; --------------------------------------
LF95D:
Control_block_for_command_prompt_input:
.word INPBUF ; Input text to INPBUF at $236
.byte $CA ; Up to $CA characters
.byte $20 ; Min =$20,
.byte $FF ; Max =$FF
; MOS INTERFACE
; Err 510
;
;
; OSWRCH 0 Send character to output stream
; Err 510
; On entry, A 0
; On exit, A #NAME?
;
; Tube data character --
;
osWRCH:
BIT TubeS 1 ; Read Tube R1 status
NOP ; is this delay needed?
BVC osWRCH ; Loop until b6 set
STA TubeR 1
RTS ; Send character to Tube R1
; OSRDCH 0 Wait for character from input stream
; Err 510
; On exit, A Err 509 Cy=Escape flag
;
; Tube data $00 -- Carry Char
;
osRDCH:
send_command_code #command_OSRDCH
WaitCarryChar:
; Wait for Carry and A
JSR WaitByte
ASL A ; Wait for carry
WaitByte:
LDA_FIFO 2 ; Fetch character
NullReturn:
RTS
; Skip Spaces
; Err 510
SkipSpaces1:
INY
SkipSpaces:
LDA (string_pointer),Y
CMP #$20
BEQ SkipSpaces1
RTS
;
; Scan hex
; Err 510
ScanHex:
LDX #0
STX hex_accumulator
STX hex_accumulator+1 ; Clear hex accumulator
LF98C:
LDA (string_pointer),Y ; Get current character
CMP #'0'
BCC LF9B1 ; <'0', exit
CMP '9'+1
BCC LF9A0 ; '0'..'9', add to accumulator
AND #$DF
SBC #7
BCC LF9B1 ; Convert letter, if <'A', exit
CMP #$40
BCS LF9B1 ; >'F', exit
LF9A0:
ASL A
ASL A
ASL A
ASL A ; *16
LDX #3 ; Prepare to move 3+1 bits
LF9A6:
ASL A
ROL hex_accumulator
ROL hex_accumulator+1 ; Move bits into accumulator
DEX
BPL LF9A6 ; Loop for four bits, no overflow check
INY
BNE LF98C ; Move to next character
LF9B1:
RTS
; Send string to Tube R2
; Err 510
SendString:
STX string_pointer
STY string_pointer+1 ; Set $F8/9=>string
SendStringF8:
LDY #0
loop_F9B8:
.if 1
wait_to_write_FIFO 2 ; Wait for Tube R2 free
LDA (string_pointer),Y
STA TubeR 2 ; Send character to Tube R2
.else
LDA (string_pointer),Y ; alternatively, pre-fetch it?
STA_FIFO 2
.endif
INY
CMP #CR
BNE loop_F9B8 ; Loop until <cr> sent
LDY string_pointer+1
RTS ; Restore Y from string_pointer+1 and return
; OSCLI 0 Execute command
; Err 510
; On entry, XY=>command string
; On exit, XY= preserved
;
osCLI:
PHA
STX string_pointer
STY string_pointer+1 ; Save A, $F8/9=>command string
LDY #0
loop_F9D1:
JSR SkipSpaces
INY
CMP #'*'
BEQ loop_F9D1 ; Skip spaces and stars
AND #$DF
TAX ; Ignore case, and save in X
LDA (string_pointer),Y ; Get next character
CPX #'G'
BEQ CmdGO ; Jump to check '*GO'
CPX #'H'
BNE osCLI_IO ; Not H---, jump to pass to Tube
CMP #'.'
BEQ CmdHELP ; H., jump to do *DELETEHIMEM
AND #$DF ; Ignore case
CMP #'E'
BNE osCLI_IO ; Not HE---, jump to pass to Tube
INY
LDA (string_pointer),Y ; Get next character
CMP #'.'
BEQ CmdHELP ; HE., jump to do *DELETEHIMEM
AND #$DF ; Ignore case
CMP #'L'
BNE osCLI_IO ; Not HEL---, jump to pass to Tube
INY
LDA (string_pointer),Y ; Get next character
CMP #'.'
BEQ CmdHELP ; HEL., jump to do *DELETEHIMEM
AND #$DF ; Ignore case
CMP #'P'
BNE osCLI_IO ; Not HELP---, jump to pass to Tube
INY
LDA (string_pointer),Y ; Get next character
AND #$DF ; Ignore case
CMP #'A'
BCC CmdHELP ; HELP terminated by non-letter, do *DELETEHIMEM
CMP #'['
BCC osCLI_IO ; HELP followed by letter, pass to Tube
; *Help 0 Display help information
; --------------------------------
CmdHELP:
JSR PrText ; Print help message
.byte LF, CR
.byte "6502 TUBE 1.10"
.byte LF, CR
NOP ; Continue to pass '*DELETEHIMEM' command to Tube
; OSCLI 0 Send command line to host
; Err 510
; On entry, $F8/9=>command string
;
; Tube data $02 string $0D -- $7F or $80
;
osCLI_IO:
send_command_code #command_OSCLI
JSR SendStringF8 ; Send command string at $F8/9
osCLI_Ack:
JSR WaitByte ; Wait for acknowledgement
CMP #$80
BEQ LFA5C ; Jump if code to be entered
PLA
RTS ; Restore A and return
; *GO 0 call machine code
; -----------------------
CmdGO:
AND #$DF ; Ignore case
CMP #'O'
BNE osCLI_IO ; Not '*GO', jump to pass to Tube
JSR SkipSpaces1 ; Move past any spaces
JSR ScanHex
JSR SkipSpaces ; Read hex value and move past spaces
CMP #CR
BNE osCLI_IO ; More parameters, pass to Tube to deal with
TXA
BEQ LFA5C ; If no address given, jump to current program
;
copy_word_from_src_to_dst_via_A hex_accumulator, pointer_to_transfer
;
LFA5C:
LDA pointer_to_current_program+1
PHA
LDA pointer_to_current_program
PHA ; Save current program
JSR EnterCode
;
PLA
STA pointer_to_current_program
STA pointer_to_top_of_memory ; Restore current program and
;
PLA
STA pointer_to_current_program+1
STA pointer_to_top_of_memory+1 ; set address top of memory to it
;
PLA
;
RTS
CheckAck:
BEQ osCLI_Ack
; OSBYTE 0 Byte MOS functions
; Err 510
; On entry, A, X, Y=OSBYTE parameters
; On exit, A preserved
; If A<$80, X=returned value
; If A>$7F, X, Y, Carry=returned values
;
osBYTE:
CMP #$80
BCS ByteHigh ; Jump for long OSBYTEs
;
; Tube data $04 X A -- X
;
PHA
.if 1
LDA #command_OSBYTELO ; Send command $04 0 OSBYTELO
STA_FIFO 2 ;; inline code
.else
; cannot use this, it calls SendCommand
send_command_code #command_OSBYTELO
.endif
STX_FIFO 2
PLA ; Send single parameter
STA_FIFO 2 ; Send function
LDX_FIFO 2
RTS ; Get return value
ByteHigh:
CMP #$82
BEQ Byte82 ; Read memory high word
CMP #$83
BEQ Byte83 ; Read bottom of memory
CMP #$84
BEQ Byte84 ; Read top of memory
;
; Tube data $06 X Y A -- Cy Y X
;
PHA
LDA #command_OSBYTEHI
STA_FIFO 2 ; Send command $06 0 OSBYTEHI
STX_FIFO 2 ; Send parameter 1
STY_FIFO 2 ; Send parameter 2
PLA
STA_FIFO 2 ; Send function
CMP #$8E
BEQ CheckAck ; If select language, check to enter code
CMP #$9D
BEQ LFAEF ; Fast return with Fast BPUT
PHA ; Save function
LDA_FIFO 2
ASL A
PLA ; Get Carry
;
LDY_FIFO 2 ; Get return high byte
LDX_FIFO 2 ; Get return low byte
;
LFAEF:
RTS
Byte84:
LDX pointer_to_top_of_memory
LDY pointer_to_top_of_memory+1
RTS ; Read top of memory from pointer_to_top_of_memory/3
Byte83:
LDX #$00
LDY #$08
RTS ; Read bottom of memory
Byte82:
LDX #$00
LDY #$00
RTS ; Return $0000 as memory high word
; OSWORD 0 Various functions
; Err 510
; On entry, A 0
; XY=>control block
;
osWORD:
STX string_pointer
STY string_pointer+1 ; $F8/9=>control block
TAY
BEQ RDLINE ; OSWORD 0, jump to read line
PHA
LDY #$08
STY_FIFO 2 ; Send command $08 0 OSWORD
STA_FIFO 2 ; Send function
TAX
BPL WordSendLow ; Jump with functions<$80
LDY #0
LDA (string_pointer),Y ; Get send block length from control block
TAY
JMP WordSend ; Jump to send control block
WordSendLow:
LDY WordLengthsLo-1,X ; Get send block length from table
CPX #$15
BCC WordSend ; Use this length for OSWORD 1 to $14
LDY #$10 ; Send 16 bytes for OSWORD $15 to $7F
WordSend:
STY_FIFO 2 ; Send send block length
DEY
BMI nothing_to_send ; Zero or $81..$FF length, nothing to send
loop_FB38:
.if 1
wait_to_write_FIFO 2
LDA (string_pointer),Y
STA TubeR 2 ; Send byte from control block
.else
LDA (string_pointer),Y
STA_FIFO 2
.endif
DEY
BPL loop_FB38 ; Loop for number to be sent
LFB45:
nothing_to_send:
TXA
BPL WordRecvLow ; Jump with functions < $80
LDY #$01
LDA (string_pointer),Y ; Get receive block length from control block
TAY
JMP WordRecv ; Jump to receive control block
WordRecvLow:
LDY WordLengthsHi-1,X ; Get receive length from table
CPX #$15
BCC WordRecv ; Use this length for OSWORD 1 to $14
LDY #16 ; Receive 16 bytes for OSWORD $15 to $7F
WordRecv:
STY_FIFO 2 ; Send receive block length
DEY
BMI LFB71 ; Zero of $81..$FF length, nothing to receive
loop_FB64:
LDA_FIFO 2
STA (string_pointer),Y ; Get byte to control block
DEY
BPL loop_FB64 ; Loop for number to receive
LFB71:
LDY string_pointer+1
LDX string_pointer
PLA ; Restore registers
RTS
; RDLINE 0 Read a line of text
; Err 510
; On entry, A 0
; XY=>control block
; On exit, A #NAME?
; Y for of returned string
; Cy=0 ok, Cy=1 Escape
;
; Tube data $0A block -- $FF or $7F string CR
;
RDLINE:
send_command_code #command_RDLINE
LDY #4
loop_FB7E:
.if 1
wait_to_write_FIFO 2
LDA (string_pointer),Y
STA TubeR 2 ; Send control block
.else
LDA (string_pointer),Y ; alternatively prefetch?
STA_FIFO 2
.endif
DEY
CPY #$01
BNE loop_FB7E ; Loop for 4, 3, 2
LDA #$07
JSR SendByte ; Send $07 as address high byte
LDA (string_pointer),Y
PHA ; Get text buffer address high byte
DEY
;
STY_FIFO 2 ; Send $00 as address low byte
LDA (string_pointer),Y
PHA ; Get text buffer address low byte
LDX #$FF
JSR WaitByte ; Wait for response
CMP #$80
BCS RdLineEscape ; Jump if Escape returned
.if 0
PLA
STA string_pointer
PLA
STA string_pointer+1 ; Set $F8/9=>text buffer
.else
pull_var16_via_A string_pointer
.endif
LDY #0
loop_RdLine:
LDA_FIFO 2
STA (string_pointer),Y ; Store returned character
INY
CMP #CR
BNE loop_RdLine ; Loop until <cr>
LDA #$00
DEY
CLC
INX ; Return A=0, Y=len, X=00, Cy=0
RTS
RdLineEscape:
PLA
PLA
LDA #$00 ; Return A=0, Y=len, X=FF, Cy=1
RTS
; OSARGS 0 Read info on open file
; Err 510
; On entry, A 0
; X Err 510 word in zero page
; Y #NAME?
; On exit, A #REF! value
; X preserved
; Y preserved
;
; Tube data $0C handle block function -- result block
;
osARGS:
PHA
send_command_code #command_OSARGS
;
STY_FIFO 2 ; Send handle
LDA $03,X
JSR SendByte ; Send data word
LDA $02,X
JSR SendByte
LDA $01,X
JSR SendByte
LDA $00,X
JSR SendByte
PLA
JSR SendByte ; Send function
JSR WaitByte
PHA ; Get and save result
JSR WaitByte
STA $03,X ; Receive data word
JSR WaitByte
STA $02,X
JSR WaitByte
STA $01,X
JSR WaitByte
STA $00,X
PLA
RTS ; Get result back and return
; OSFIND 0 Open of Close a file
; Err 510
; On entry, A #REF!
; Y 0 or XY=>filename
; On exit, A 0 or handle
;
; Tube data $12 function string $0D -- handle
; $12 $00 handle -- $7F
;
osFIND:
PHA
send_command_code #command_OSFIND
PLA
JSR SendByte ; Send function
CMP #$00
BNE OPEN ; If <>0, jump to do OPEN
PHA
TYA
JSR SendByte ; Send handle
JSR WaitByte
PLA
RTS ; Wait for acknowledge, restore regs and return
OPEN:
JSR SendString ; Send pathname
JMP WaitByte ; Wait for and return handle
; OSBGet 0 Get a byte from open file
; Err 510
; On entry, H #REF!
; On exit, A #REF! Read
; H 0
; Cy set if EOF
;
; Tube data $0E handle -- Carry byte
;
osBGET:
send_command_code #command_OSBGET
TYA
JSR SendByte ; Send handle
JMP WaitCarryChar ; Jump to wait for Carry and byte
; OSBPut 0 Put a byte to an open file
; Err 510
; On entry, A A to write
; Y 0
; On exit, A #REF!
; Y 0
;
; Tube data $10 handle byte -- $7F
;
osBPUT:
PHA
send_command_code #command_OSBPUT
TYA
JSR SendByte ; Send handle
PLA
JSR SendByte ; Send byte
PHA
JSR WaitByte
PLA
RTS ; Wait for acknowledge and return
; Send a byte to Tube R2
; Err 510
SendCommand:
SendByte:
STA_FIFO 2
RTS
; OSFILE 0 Operate on whole files
; Err 510
; On entry, A #REF!
; XY=>control block
; On exit, A 0
; control block updated
;
; Tube data $14 block string <cr> function -- result block
;
osFILE:
STY pointer_at_FA+1
STX pointer_at_FA ; $FA/B=>control block
PHA
send_command_code #command_OSFILE
LDY #$11
loop_FC5F:
LDA (pointer_at_FA),Y
JSR SendByte ; Send control block
DEY
CPY #$01
BNE loop_FC5F ; Loop for $11..$02
DEY
LDA (pointer_at_FA),Y
TAX
INY
LDA (pointer_at_FA),Y
TAY ; Get pathname address to XY
JSR SendString ; Send pathname
PLA
JSR SendByte ; Send function
JSR WaitByte
PHA ; Wait for result
LDY #$11
loop_FC7E:
JSR WaitByte
STA (pointer_at_FA),Y ; Get control block back
DEY
CPY #$01
BNE loop_FC7E ; Loop for $11..$02
LDY pointer_at_FA+1
LDX pointer_at_FA ; Restore registers
PLA
RTS ; Get result and return
; OSGBPB 0 Multiple byte Read and write
; Err 510
; On entry, A #REF!
; XY=>control block
; On exit, A #REF! value
; control block updated
;
; Tube data $16 block function -- block Carry result
;
osGBPB:
STY pointer_at_FA+1
STX pointer_at_FA ; $FA/B=>control block
PHA
send_command_code #command_OSGBPB
LDY #$0C
loop_FC9A:
LDA (pointer_at_FA),Y
JSR SendByte ; Send control block
DEY
BPL loop_FC9A ; Loop for $0C..$00
PLA
JSR SendByte ; Send function
LDY #$0C
loop_FCA8:
JSR WaitByte
STA (pointer_at_FA),Y ; Get control block back
DEY
BPL loop_FCA8 ; Loop for $0C..$00
LDY pointer_at_FA+1
LDX pointer_at_FA ; Restore registers
JMP WaitCarryChar ; Jump to get Carry and result
Unsupported:
BRK
.byte 255
.byte "Bad"
.byte 0
; OSWORD control block lengths
; Err 510
WordLengthsLo:
.byte <$0500
.byte <$0005
.byte <$0500
.byte <$0005
.byte <$0502
.byte <$0005
.byte <$0008
.byte <$000E
.byte <$0504
.byte <$0901
.byte <$0501
.byte <$0005
.byte <$0800
.byte <$1801
.byte <$0020
.byte <$0110
.byte <$0D0D
.byte <$8000
.byte <$0404
.byte <$8080
WordLengthsHi:
.byte >$0500
.byte >$0005
.byte >$0500
.byte >$0005
.byte >$0502
.byte >$0005
.byte >$0008
.byte >$000E
.byte >$0504
.byte >$0901
.byte >$0501
.byte >$0005
.byte >$0800
.byte >$1801
.byte >$0020
.byte >$0110
.byte >$0D0D
.byte >$8000
.byte >$0404
.byte >$8080
; Interrupt Handler
; Err 510
InterruptHandler:
STA $FC
PLA
PHA ; Save A, get flags from stack
AND #$10
BNE BRKHandler ; If BRK, jump to BRK handler
JMP (IRQ1V) ; Continue via IRQ1V handler
IRQ1Handler:
BIT TubeS 4
BMI LFD3F ; If data in Tube R4, jump to process errors and transferes
BIT TubeS 1
BMI LFD18 ; If data in Tube R1, jump to process Escape and Events
JMP (IRQ2V) ; Pass on to IRQ2V
BRKHandler:
TXA
PHA ; Save X
TSX
LDA $0103,X ; Get address from stack
CLD
SEC
SBC #$01
STA error_510_last_error
LDA $0104,X
SBC #$00
STA error_510_last_error+1 ; $FD/E=>after BRK opcode
PLA
TAX
LDA $FC ; Restore X, get saved A
CLI
JMP (BRKV) ; Restore IRQs, jump to Error Handler
; Interrupt generated by data in Tube R1
; --------------------------------------
LFD18:
LDA TubeR 1
BMI LFD39 ; b7=1, jump to set Escape state
TYA
PHA
TXA
PHA ; Save registers
JSR get_A_from_FIFO_1
TAY ; Get Y parameter from Tube R1
JSR get_A_from_FIFO_1
TAX ; Get X parameter from Tube R1
JSR get_A_from_FIFO_1 ; Get event number from Tube R1
JSR LFD36
PLA
TAX
PLA
TAY ; Dispatch event, restore registers
LDA $FC
RTI ; Restore A, return from interrupt
LFD36:
JMP (EVNTV)
LFD39:
ASL A
STA $FF ; Set Escape flag from b6
LDA $FC
RTI ; Restore A, return from interrupt
; Interrupt generated by data in Tube R4
; --------------------------------------
LFD3F:
LDA TubeR 4
BPL LFD65 ; b7=0, jump for data transfer
CLI
;; loop_FD45:
LDA_FIFO 2 ;; is this getting a dummy byte?
;
LDA #0 ;; A is cleared and stored immediately
STA ERRBUF
TAY ; Store BRK opcode in error buffer
JSR WaitByte
STA ERRBUF+1 ; Get error number
;
loop_FD59:
INY
JSR WaitByte ; Store bytes fetched from Tube R2
STA ERRBUF+1,Y
BNE loop_FD59 ; Loop until final zero
JMP ERRBUF ; Jump to error block to generate error
; Data transfer initiated by IRQ via Tube R4
; ------------------------------------------
LFD65:
STA NMIV+0
TYA
PHA ; Save transfer type, save Y
LDY NMIV+0 ; Get transfer type back
LDA LFE70,Y
STA NMIV+0 ; get NMI routine address from table
LDA LFE78,Y
STA NMIV+1 ; and point NMIV to it
LDA LFE60,Y
STA address_of_byte_transfer_address ; Point $F4/5 to transfer address field
LDA LFE68,Y
STA address_of_byte_transfer_address+1
;
LDA_FIFO 4 ; Get called ID from Tube R4
;
CPY #$05
BEQ exit_FDE7 ; If 'TubeRelease', jump to exit
TYA
PHA
LDY #$01 ; Save transfer type
;
LDA_FIFO 4 ; Fetch and disgard address byte 4
LDA_FIFO 4 ; Fetch and disgard address byte 3
;
LDA_FIFO 4 ; Fetch address byte 2,
STA (address_of_byte_transfer_address),Y ; and store in address
DEY
LDA_FIFO 4
STA (address_of_byte_transfer_address),Y ; Fetch address byte 1, store in address
BIT TubeR 3 ;; This tests the bits of the data register
BIT TubeR 3 ;; Reads from Tube R3 twice, but A is not changed.
;
LDA_FIFO 4
PLA ; Get sync byte from Tube R4
CMP #6
BCC exit_FDE7 ; Exit if not 256-byte transfers
BNE Read_256_bytes_from_Tube_R3 ; Jump with 256-byte read
; Send 256 bytes to Tube via R3
; -----------------------------
LDY #0
loop_FDCF:
.if 1
; original code does this:
;
LDA TubeS 3
AND #$80 ; isolate bit 7 = sign
;
BPL loop_FDCF ; Wait for Tube R3 free
.else
; I think the BIT instruction would have been more efficient
wait_to_read_FIFO 3
AND #$80 ; do this outside the loop
.endif
NMI6Addr:
LDA $FFFF,Y
STA TubeR 3 ; Fetch byte and send to Tube R3
INY
BNE loop_FDCF ; Loop for 256 bytes
wait_to_read_FIFO 3 ; wait to read but then write ???
STA TubeR 3 ; Send final sync byte
exit_FDE7:
PLA
TAY
LDA $FC
RTI ; Restore registers and return
; Read 256 bytes from Tube via R3
; -------------------------------
LFDEC:
Read_256_bytes_from_Tube_R3:
LDY #0
loop_FDEE:
.if 1
LDA TubeS 3
AND #$80
BPL loop_FDEE ; Wait for Tube R3 data present
LDA TubeR 3 ; Fetch byte from Tube R3
; 00FDEE 1 loop_FDEE:
; 00FDEE 1 AD FC FE LDA TubeS 3
; 00FDF1 1 29 80 AND #$80
; 00FDF3 1 10 F9 BPL loop_FDEE ; Wait for Tube R3 data present
; 00FDF5 1 AD FD FE LDA TubeR 3 ; Fetch byte from Tube R3
.else
LDA_FIFO 3 ;; would this do just as well?
AND #$80
.endif
NMI7Addr:
STA $FFFF,Y
INY
BNE loop_FDEE ; Store byte and loop for 256 bytes
BEQ exit_FDE7 ; Jump to restore registers and return
; Transfer 0 0 Transfer single byte to Tube
; -----------------------------------------
NMI0:
PHA ; Save A
NMI0Addr:
LDA $FFFF
STA TubeR 3 ; Get byte and send to Tube R3
inc16 NMI0Addr+1
PLA
RTI ; Restore A and return
; Transfer 1 0 Transfer single byte from Tube
; -------------------------------------------
NMI1:
PHA
LDA TubeR 3 ; Save A, get byte from Tube R3
NMI1Addr:
STA $FFFF ; Store byte
;
; Warning: The instruction above is self-modifying code!
;
;
;
inc16 NMI1Addr+1 ; Increment transfer address
PLA
RTI ; Restore A and return
; Transfer 2 0 Transfer two bytes to Tube
; ---------------------------------------
NMI2:
PHA
TYA
PHA
LDY #0 ; Save registers
LDA (pointer_to_transfer),Y
STA TubeR 3 ; Get byte and send to Tube R3
inc16 pointer_to_transfer
LDA (pointer_to_transfer),Y
STA TubeR 3 ; Get byte and send to Tube R3
inc16 pointer_to_transfer
PLA
TAY
PLA
RTI ; Restore registers and return
; Transfer 3 0 Transfer two bytes from Tube
; -----------------------------------------
NMI3:
PHA
TYA
PHA
LDY #0 ; Save registers
LDA TubeR 3
STA (pointer_to_transfer),Y ; Get byte from Tube R3 and store
inc16 pointer_to_transfer
LDA TubeR 3
STA (pointer_to_transfer),Y ; Get byte from Tube R3 and store
inc16 pointer_to_transfer
PLA
TAY
PLA
RTI ; Restore registers and return
; Data transfer address pointers
; ------------------------------
LFE60:
.byte <(NMI0Addr+1)
.byte <(NMI1Addr+1)
.byte <$00F6
.byte <$00F6
.byte <$00F6
.byte <$00F6
.byte <(NMI6Addr+1)
.byte <(NMI7Addr+1)
LFE68:
.byte >(NMI0Addr+1)
.byte >(NMI1Addr+1)
.byte >$00F6
.byte >$00F6
.byte >$00F6
.byte >$00F6
.byte >(NMI6Addr+1)
.byte >(NMI7Addr+1)
; Data transfer routine addresses
; -------------------------------
LFE70:
.byte <NMI0
.byte <NMI1
.byte <NMI2
.byte <NMI3
.byte <NMI_Ack
.byte <NMI_Ack
.byte <NMI_Ack
.byte <NMI_Ack
LFE78:
.byte >NMI0
.byte >NMI1
.byte >NMI2
.byte >NMI3
.byte >NMI_Ack
.byte >NMI_Ack
.byte >NMI_Ack
.byte >NMI_Ack
; Wait for byte in Tube R1 while allowing requests via Tube R4
; Err 510
LFE80:
get_A_from_FIFO_1:
BIT TubeS 1 ; If data in Tube R1, jump to fetch it
BMI fetch_A_from_tube_1_and_return
; loop_FE85: ; unused label
BIT TubeS 4 ; Check if data present in Tube R4
BPL get_A_from_FIFO_1 ; If nothing there, jump back to check Tube R1
; get her if Tube R4 has data.
LDA $FC ; Save IRQ's A store in A register
PHP
CLI
PLP ; Allow an IRQ through to process R4 request
STA $FC
JMP get_A_from_FIFO_1 ; Restore IRQ's A store and jump back to check R1
fetch_A_from_tube_1_and_return:
LDA TubeR 1
RTS
; Print embedded string
; Err 510
PrText:
PLA
STA pointer_at_FA
PLA
STA pointer_at_FA+1 ; $FA/B=>embedded string
LDY #0
LFEA0:
inc16 pointer_at_FA ; pre-increment
LDA (pointer_at_FA),Y ; Get character,
BMI LFEB0 ; exit if >$7F
JSR OSWRCH ; Print character
JMP LFEA0 ; and loop back for more
LFEB0:
JMP (pointer_at_FA) ; Jump back to code after string
; Null NMI code
; -------------
NMI_Ack: ; Store to TubeR 3 to acknowlege NMI
STA TubeR 3
RTI
; Spare space
; Err 510
.ifdef reference_code
;; .byte ($FEF0-$,$FF)
.else
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.byte $FF
.endif
IO_SPACE:
.ifdef reference_code
; I/O Space
; Err 510
;; .byte STRING$(8,CHR$0)
.else
.byte $00,$00,$00,$00,$00,$00,$00,$00
.endif
; Tube I/O Registers
; Err 510
; TubeS n = TUBE_BASE +n*2-2
; TubeR n = TUBE_BASE +n*2
;
TUBE_BASE :
TubeS 1: ; $FEF8
.byte 0
TubeR 1: ; $FEF9
.byte 0
TubeS 2: ; $FEFA
.byte 0
TubeR 2: ; $FEFB
.byte 0
TubeS 3: ; $FEFC
.byte 0
TubeR 3: ; $FEFD
.byte 0
TubeS 4: ; $FEFE
.byte 0
TubeR 4: ; $FEFF
.byte 0
; Spare space
; Err 510
LFF00:
.ifdef reference_code
;; .byte STRING$($FF80-P%,CHR$255)
.else
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.word $FFFF,$FFFF,$FFFF,$FFFF
.endif
; DEFAULT VECTOR TABLE
; Err 510
LFF80:
vector_table_defaults:
.word Unsupported ; $200 0 USERV
.word ErrorHandler ; $202 0 BRKV
.word IRQ1Handler ; $204 0 IRQ1V
.word Unsupported ; $206 0 IRQ2V
.word osCLI ; $208 0 CLIV
.word osBYTE ; $20A 0 BYTEV
.word osWORD ; $20C 0 WORDV
.word osWRCH ; $20E 0 WRCHV
.word osRDCH ; $210 0 RDCHV
.word osFILE ; $212 0 FILEV
.word osARGS ; $214 0 ARGSV
.word osBGET ; $216 0 BGetV
.word osBPUT ; $218 0 BPutV
.word osGBPB ; $21A 0 GBPBV
.word osFIND ; $21C 0 FINDV
.word Unsupported ; $21E 0 FSCV
.word NullReturn ; $220 0 EVNTV
.word Unsupported ; $222 0 UPTV
.word Unsupported ; $224 0 NETV
.word Unsupported ; $226 0 VduV
.word Unsupported ; $228 0 KEYV
.word Unsupported ; $22A 0 INSV
.word Unsupported ; $22C 0 RemV
.word Unsupported ; $22E 0 CNPV
.word NullReturn ; $230 0 IND1V
.word NullReturn ; $232 0 IND2V
.word NullReturn ; $234 0 IND3V
VECDEF: ; at $FFB6
.byte vector_table_size ; $36
.word vector_table_defaults
OS_FFB9: ; $
JMP Unsupported
OS_FFBC: ; $FFBC
JMP Unsupported
OS_FFBF: ; $FFBF
JMP Unsupported
OS_FFC2: ; $FFC2
JMP Unsupported
OS_FFC5: ; $FFC5
JMP Unsupported
NVRDCH: ; $FFC8
JMP osRDCH
NVWRCH: ; $FFCB
JMP osWRCH
OSFIND: ; $FFCE
JMP (FINDV)
OSGBPB: ; $FFD1
JMP (GBPBV)
OSBPUT: ; $FFD4
JMP (BPutV)
OSBGET: ; $FFD7
JMP (BGetV)
OSARGS: ; $FFDA
JMP (ARGSV)
OSFILE: ; $FFDD
JMP (FILEV)
OSRDCH:
; $FFE0
JMP (RDCHV)
OSASCI: ; $FFE3
CMP #CR
BNE OSWRCH
OSNEWL:
; $FFE7
LDA #LF
JSR OSWRCH
OSWRCR: ; $FFEC
LDA #CR
OSWRCH: ; $FFEE
JMP (WRCHV)
OSWORD: ; $FFF1
JMP (WORDV)
OSBYTE: ; $FFF4
JMP (BYTEV)
OS_CLI: ; $FFF7
JMP (CLIV)
NMIV: ; $FFFA
.word NMI0 ; NMI Vector
RESETV: ; $FFFC
.word RESET ; RESET Vector
IRQV: ; $FFFE
.word InterruptHandler ; IRQ Vector