diff --git a/client/basic/Makefile b/client/basic/Makefile index 15f4884..4b01c12 100644 --- a/client/basic/Makefile +++ b/client/basic/Makefile @@ -17,26 +17,19 @@ IP65LIB=../ip65/ip65_tcp.lib C64PROGLIB=../drivers/c64prog.lib -all: gopherd.d64 kipperbas.d64 +all: kipperbas.d64 %.o: %.s $(INCFILES) $(AS) $(AFLAGS) $< -%.prg: %.o $(IP65LIB) $(C64PROGLIB) $(INCFILES) ../cfg/c64_mlstub.cfg - $(LD) -m $*.map -vm -C ../cfg/c64_mlstub.cfg -o $*.prg $(AFLAGS) $< $(IP65LIB) $(C64PROGLIB) - +%.prg: %.o $(IP65LIB) $(C64PROGLIB) $(INCFILES) ../cfg/kipperbas.cfg + $(LD) -m $*.map -vm -C ../cfg/kipperbas.cfg -o $*.prg $(AFLAGS) $< $(IP65LIB) $(C64PROGLIB) + kipperbas.d64: kipperbas.prg ripxplore.rb -r -e kbload $@ -o kbload ripxplore.rb -r -e kbapp $@ -o kbapp ripxplore.rb $@ -a kipperbas.prg - - -gopherd.d64: mlstub.prg gophermap.txt addresses.txt - ripxplore.rb -r -e gopherd $@ -o gopherd.bas - ripxplore.rb $@ -a mlstub.prg - ripxplore.rb $@ -a gophermap.txt -t C64Seq - ripxplore.rb $@ -a addresses.txt -t C64Seq clean: rm -f *.o *.bin *.map *.prg diff --git a/client/basic/kbload b/client/basic/kbload index 19cfcf8..1ee3da0 100644 Binary files a/client/basic/kbload and b/client/basic/kbload differ diff --git a/client/basic/kipperbas.d64 b/client/basic/kipperbas.d64 index 1577517..19ef2f5 100644 Binary files a/client/basic/kipperbas.d64 and b/client/basic/kipperbas.d64 differ diff --git a/client/basic/kipperbas.s b/client/basic/kipperbas.s index eb743ed..1af4261 100644 --- a/client/basic/kipperbas.s +++ b/client/basic/kipperbas.s @@ -1,11 +1,12 @@ .include "../inc/common.i" -;.include "../inc/commonprint.i" VARTAB = $2D ;BASIC variable table storage ARYTAB = $2F ;BASIC array table storage FREETOP = $33 ;bottom of string text storage area MEMSIZ = $37 ;highest address used by BASIC +VARNAM = $45 ;current BASIC variable name +VARPNT = $47 ; pointer to current BASIC variable value SETNAM = $FFBD SETLFS = $FFBA @@ -30,22 +31,74 @@ CHKCOM = $AEFD NEW = $A642 CLR = $A65E NEWSTT = $A7AE - +GETVAR = $B0E7 ;find or create a variable +FRMEVL = $AD9E ;evaluate expression +FRESTR = $B6A3 ;free temporary string + +VALTYP=$0D ;00=number, $FF=string + LINNUM = $14 ;Number returned by GETPAR crunched_line = $0200 ;Input buffer +.import copymem +.importzp copy_dest +.import dhcp_init +.import ip65_init +.import cfg_get_configuration_ptr +.import tcp_listen +.import tcp_callback +.import tcp_connect_ip +.import tcp_send +.import tcp_connect +.import tcp_close +.import tcp_send_data_len +.import tcp_inbound_data_ptr +.import tcp_inbound_data_length +.import dns_set_hostname +.import dns_resolve +.import dns_ip +.import ip65_process +.import ip65_error +.import cfg_ip +.import cfg_dns +.import cfg_gateway +.import cfg_netmask +.import cfg_tftp_server +.import icmp_ping +.import icmp_echo_ip +.import print_a +.import print_cr +.import dhcp_server +.import cfg_mac +.import cs_driver_name +.importzp tftp_filename +.import tftp_ip +.import tftp_download +.import tftp_set_callback_vector +.import tftp_data_block_length + .zeropage temp: .res 2 temp2: .res 2 - +pptr=temp .segment "STARTUP" ;this is what gets put at the start of the file on the C64 .word jump_table ; load address jump_table: jmp init ; $4000 (PTR 16384) - vars io$,io%,er% should be created (in that order!) before calling -.code +safe_getvar: ;if GETVAR doesn't find the desired variable name in the VARTABLE, a routine at $B11D will create it + ;however that routine checks if the low byte of the return address of the caller is $2A. if it is, + ;it assumes the caller is the routine at $AF28 which just wants to get the variable value, and + ;returns a pointer to a dummy 'zero' pointer. + ;so if user code that is calling GETVAR happens to be compiled to an address $xx28, it will + ;trigger this check, and not create a new variable, which (from painful experience) will create + ;a really nasty condition to debug! + ;so vector to GETVAR via here, so the return address seen by $B11D is here, and never $xx28 + jsr GETVAR + rts +.code ; ;BASIC extensions derived from BLARG - http://www.ffd2.com/fridge/programs/blarg/blarg.s ; @@ -65,9 +118,18 @@ install_new_vectors_loop: sta ICRUNCH,x dex bpl install_new_vectors_loop - rts - -; + + + ;BASIC keywords installed, now bring up the ip65 stack + + jsr ip65_init + bcs @init_failed + lda #0 + sta ip65_error + +@init_failed: + jmp set_error + ; CRUNCH -- If this is one of our keywords, then tokenize it ; crunch: @@ -215,16 +277,19 @@ list: jmp $A700 ;Normal exit -execute: - -; -; EXECUTE -- if this is one of my -; tokens, then execute it. -; -; jmp (oldexec) +; +; EXECUTE -- if this is one of our new +; tokens, then execute it. +execute: jsr CHRGET +execute_a: php + + cmp #$8B ;is it 'IF'? + bne @not_if + lda #$E0 ;our dummy IF token +@not_if: cmp #$E0 bcc @notmine cmp #HITOKEN @@ -243,21 +308,599 @@ execute: jmp CHRGET ;exit to routine (via RTS) @notmine: plp - cmp #0 + cmp #0 ;reset flags jmp $A7E7 - -goober: - inc $d020 - rts + +;the standard BASIC IF routine calls the BASIC EXECUTE routine directly, +;without going through the vector. That means an extended keyword following THEN +;will lead to a syntax error. So we have to reimpliment IF here +;this is taken from TransBASIC - The Transactor, vol 5, Issue 04 (March 1985) page 34 +if_keyword: + jsr FRMEVL ;evaluate expression + jsr CHRGOT + cmp #$89 ;is next token GOTO? + beq @ok + lda #$A7 ;is next token THEN + jsr $AEFF ;will generate SYNTAX ERROR if not +@ok: + jsr CHRGOT + ldx $61 ;result of expression : 0 means false + bne @expression_was_true + jmp $A93B ;go to REM implementation - skips rest of line +@expression_was_true: + bcs @not_numeric;CHRGOT clears carry flag if current char is a number + jmp $A8A0 ;do a GOTO +@not_numeric: + pla + pla ;pop the return address off the stack + jsr CHRGOT + jmp execute_a ;execute current token + +set_result_code: + pha + txa + pha + lda #'R'+$80 + sta VARNAM + lda #'C'+$80 + sta VARNAM+1 + jsr safe_getvar + ldy #0 + pla + sta (VARPNT),y + iny + pla + sta (VARPNT),y +clear_error: + lda #0 + sta ip65_error +set_error: + lda #'E'+$80 + sta VARNAM + lda #'R'+$80 + sta VARNAM+1 + jsr safe_getvar + lda #0 + tay + sta (VARPNT),y + iny + lda ip65_error + sta (VARPNT),y + + rts + + +;emit the 4 bytes pointed at by AX as dotted decimals +emit_dotted_quad: + sta pptr + stx pptr + 1 + ldy #0 + lda (pptr),y + jsr emit_decimal + lda #'.' + jsr emit_a + + ldy #1 + lda (pptr),y + jsr emit_decimal + lda #'.' + jsr emit_a + + ldy #2 + lda (pptr),y + jsr emit_decimal + lda #'.' + jsr emit_a + + ldy #3 + lda (pptr),y + jsr emit_decimal + + rts + +emit_decimal: ;emit byte in A as a decimal number + pha + sta temp_bin ;save + sed ; Switch to decimal mode + lda #0 ; Ensure the result is clear + sta temp_bcd + sta temp_bcd+1 + ldx #8 ; The number of source bits + : + asl temp_bin+0 ; Shift out one bit + lda temp_bcd+0 ; And add into result + adc temp_bcd+0 + sta temp_bcd+0 + lda temp_bcd+1 ; propagating any carry + adc temp_bcd+1 + sta temp_bcd+1 + dex ; And repeat for next bit + bne :- + + cld ;back to binary + + pla ;get back the original passed in number + bmi @emit_hundreds ; if N is set, the number is >=128 so emit all 3 digits + cmp #10 + bmi @emit_units + cmp #100 + bmi @emit_tens +@emit_hundreds: + lda temp_bcd+1 ;get the most significant digit + and #$0f + clc + adc #'0' + jsr emit_a + +@emit_tens: + lda temp_bcd + lsr + lsr + lsr + lsr + clc + adc #'0' + jsr emit_a +@emit_units: + lda temp_bcd + and #$0f + clc + adc #'0' + jsr emit_a + + rts + +print: + sta pptr + stx pptr + 1 + +@print_loop: + ldy #0 + lda (pptr),y + beq @done_print + jsr print_a + inc pptr + bne @print_loop + inc pptr+1 + bne @print_loop ;if we ever get to $ffff, we've probably gone far enough ;-) +@done_print: + rts +extract_string: + jsr FRMEVL + jsr $AD8F ;check result is a string, if not create type mismatch error + ldy $19 ;temp string created by FRMEVL + sty param_length + lda #0 + sta transfer_buffer,y + dey +@loop: + lda ($1a),y + sta transfer_buffer,y + dey + bpl @loop + jmp FRESTR ;free up the temp string created by FRMEVL + +;get a string value from BASIC command, turn into a 32 bit IP address,save it in the 4 bytes pointed at by AX +get_ip_parameter: + stax temp2 + jsr extract_string + ldax #transfer_buffer + jsr dns_set_hostname + + bcs @error + jsr dns_resolve + bcc @ok +@error: + ldax #dns_error + jsr print + sec + rts +@ok: + ldax #dns_ip + ldx #4 +@copy_dns_ip: + lda dns_ip,y + sta (temp2),y + iny + dex + bne @copy_dns_ip + rts + +print_dotted_quad: + ldy #string_buffer + sty current_output_ptr+1 + jsr emit_dotted_quad +make_null_terminated_and_print: + lda #0 + jsr emit_a + ldax #string_buffer + jmp print + +print_mac: + ldy #string_buffer + sty current_output_ptr+1 + jsr emit_mac + jmp make_null_terminated_and_print + +;print 6 bytes printed at by AX as a MAC address +emit_mac: + stax pptr + ldy #0 +@one_mac_digit: + tya ;just to set the Z flag + pha + beq @dont_print_colon + lda #':' + jsr emit_a +@dont_print_colon: + pla + tay + lda (pptr),y + jsr emit_hex + iny + cpy #06 + bne @one_mac_digit + rts + +emit_hex: + pha + pha + lsr + lsr + lsr + lsr + tax + lda hexdigits,x + jsr emit_a + pla + and #$0F + tax + lda hexdigits,x + jsr emit_a + pla + rts + +get_optional_byte: + jsr CHRGOT + beq @no_param ;leave X as it was + jsr CHKCOM ;make sure next char is a comma (and skip it) + jsr CHRGOT + beq @eol + jsr GETBYT +@no_param: + rts +@eol: + jmp $AF08 ;SYNTAX ERROR +ipcfg_keyword: + + ldax #interface_type + jsr print + + ldax #cs_driver_name + jsr print + jsr print_cr + + ldax #mac_address_msg + jsr print + ldax #cfg_mac + jsr print_mac + jsr print_cr + + ldax #ip_address_msg + jsr print + ldax #cfg_ip + jsr print_dotted_quad + jsr print_cr + + ldax #netmask_msg + jsr print + ldax #cfg_netmask + jsr print_dotted_quad + jsr print_cr + + ldax #gateway_msg + jsr print + ldax #cfg_gateway + jsr print_dotted_quad + jsr print_cr + + ldax #dns_server_msg + jsr print + ldax #cfg_dns + jsr print_dotted_quad + jsr print_cr + + + ldax #dhcp_server_msg + jsr print + ldax #dhcp_server + jsr print_dotted_quad + jsr print_cr + + ldax #tftp_server_msg + jsr print + ldax #cfg_tftp_server + jsr print_dotted_quad + jsr print_cr + + jmp clear_error + +dhcp_keyword: + jsr dhcp_init + bcc @init_ok + jsr ip65_init ;if DHCP failed, then reinit the IP stack (which will reset IP address etc that DHCP messed with to default values) + +@init_failed: + jsr set_error + ldax #dhcp_error + jmp print +@init_ok: + jmp clear_error + rts + +ping_keyword: + ldax #icmp_echo_ip + jsr get_ip_parameter + bcc @no_error + rts +@no_error: + + ;is there an optional parameter? + ldx #3 + jsr get_optional_byte + stx ping_counter + + ldax #pinging + jsr print + ldax #dns_ip + jsr print_dotted_quad + jsr print_cr + +@ping_loop: + jsr icmp_ping + bcs @error + jsr set_result_code + lda #'.' +@print_and_loop: + jsr print_a + dec ping_counter + bne @ping_loop + jsr print_cr + jmp set_error +@error: + lda #'!' + jmp @print_and_loop + + +myip_keyword: + ldax #cfg_ip + jmp get_ip_parameter + +dns_keyword: + ldax #cfg_dns + jmp get_ip_parameter + +gateway_keyword: + ldax #cfg_gateway + jmp get_ip_parameter + +netmask_keyword: + ldax #cfg_netmask + jmp get_ip_parameter + +tftp_keyword: + ldax #cfg_tftp_server + jmp get_ip_parameter + +tfget_keyword: + jsr extract_string + ldax #get_msg + jsr print + ldax #transfer_buffer + stax tftp_filename + jsr print + ldax #from_msg + jsr print + ldax #cfg_tftp_server + jsr print_dotted_quad + jsr print_cr + + ldx #$03 +: + lda cfg_tftp_server,x + sta tftp_ip,x + dex + bpl :- + ldax #tftp_download_callback + jsr tftp_set_callback_vector + lda #0 + sta file_opened +;make file output name + lda #'@' + sta string_buffer + lda #':' + sta string_buffer+1 + ldy #$FF +@loop: + iny + lda transfer_buffer,y + sta string_buffer+2,y + bne @loop + iny + iny + lda #',' + sta string_buffer,y + iny + lda #'P' + sta string_buffer,y + iny + lda #',' + sta string_buffer,y + iny + lda #'W' + sta string_buffer,y + iny + sta string_length + + jsr tftp_download + bcs @error + jsr close_file + rts +@error: + ldax #tftp_error +@error_set: + jsr print + jsr close_file + jmp set_error + +close_file: + lda #$02 ; filenumber 2 + jsr $FFC3 ; call CLOSE + rts + + +tftp_download_callback: + + ;buffer pointed at by AX now contains "tftp_data_block_length" bytes + stax temp + + lda #'.' + jsr print_a + lda file_opened + bne @already_opened + lda string_length + ldx #string_buffer + + ;A,X,Y set up ready for a call to SETNAM for file #2 + jsr $FFBD ; call SETNAM + lda #$02 ; file number 2 + ldx $BA ; last used drive + + ldy #$02 ; secondary address 2 + jsr $FFBA ; call SETLFS + + jsr $FFC0 ; call OPEN + +@already_opened: + + ldx #$02 ; filenumber 2 = output file + jsr $FFC9 ; call CHKOUT + +@copy_one_byte: + lda tftp_data_block_length + bne @not_done + lda tftp_data_block_length+1 + beq @done + +@not_done: + ldy #2 ;we want to skip the first 2 bytes in the buffer + lda (temp),y + jsr $ffd2 ;write byte + inc temp + bne :+ + inc temp+1 +: + lda tftp_data_block_length + dec tftp_data_block_length + cmp #0 + bne @copy_one_byte + dec tftp_data_block_length+1 + jmp @copy_one_byte +@done: + + ldx #$00 ; filenumber 0 = console + jsr $FFC9 ; call CHKOUT + + rts + .rodata vectors: .word crunch .word list .word execute - -.data + +; Keyword list +; Keywords are stored as normal text, +; followed by the token number. +; All tokens are >$80, +; so they easily mark the end of the keyword +hexdigits: +.byte "0123456789ABCDEF" + +pinging: +.byte"PINGING ",0 +interface_type: +.byte "INTERFACE : ",0 + +mac_address_msg: +.byte "MAC ADDRESS : ", 0 + +ip_address_msg: +.byte "IP ADDRESS : ", 0 + +netmask_msg: +.byte "NETMASK : ", 0 + +gateway_msg: +.byte "GATEWAY : ", 0 + +dns_server_msg: +.byte "DNS SERVER : ", 0 + +dhcp_server_msg: +.byte "DHCP SERVER : ", 0 + +tftp_server_msg: +.byte "TFTP SERVER : ", 0 + +dns_error: +.byte "ADDRESS RESOLUTION ERROR",0 +get_msg: +.byte "GETTING ",0 +from_msg: +.byte " FROM ",0 +tftp_error: +.byte "TFTP ERROR",0 +dhcp_error: +.byte "DHCP INITIALIZATION ERROR",13,0 +keywords: + .byte "IF",$E0 ;our dummy 'IF' entry takes $E0 + .byte "IPCFG",$E1 + .byte "DHCP",$E2 + .byte "PING",$E3 + .byte "MYIP",$E4 + .byte "NETMASK",$E5 + .byte "GATEWAY",$E6 + .byte "DNS",$E7 + .byte "TFTP",$E8 + .byte "TFGET",$E9 + .byte "TF",$A1,$E9 ;since BASIC will replace GET with A1 + + .byte $00 ;end of list +HITOKEN=$EA + +; +; Table of token locations-1 +; +token_routines: +E0: .word if_keyword-1 +E1: .word ipcfg_keyword-1 +E2: .word dhcp_keyword-1 +E3: .word ping_keyword-1 +E4: .word myip_keyword-1 +E5: .word netmask_keyword-1 +E6: .word gateway_keyword-1 +E7: .word dns_keyword-1 +E8: .word tftp_keyword-1 +E9: .word tfget_keyword-1 +.segment "SELF_MODIFIED_CODE" jmp_crunch: .byte $4C ;JMP @@ -265,22 +908,29 @@ oldcrunch: .res 2 ;Old CRUNCH vector oldlist: .res 2 oldexec: .res 2 +emit_a: +current_output_ptr=emit_a+1 + sta $ffff + inc string_length + inc current_output_ptr + bne :+ + inc current_output_ptr+1 +: + rts -; Keyword list -; Keywords are stored as normal text, -; followed by the token number. -; All tokens are >$80, -; so they easily mark the end of the keyword -keywords: - .byte "FIZZ",$E0 - .byte $00 ;end of list -HITOKEN=$E1 -; -; Table of token locations-1 -; Subtract $E0 first -; Then check to make sure number isn't greater than NUMWORDS -; -token_routines: -E0: .word goober-1 \ No newline at end of file +.bss +string_length: .res 1 +param_length: .res 1 +ip_string: .res 15 +netmask_string: .res 15 +dns_string: .res 15 +gateway_string: .res 15 + temp_bin: .res 1 +temp_bcd: .res 2 +ping_counter: .res 1 +string_buffer: .res 128 +transfer_buffer: .res 256 +file_opened: .res 1 + \ No newline at end of file diff --git a/client/basic/mlstub.s b/client/basic/mlstub.s index 59d0a89..23ad8e0 100644 --- a/client/basic/mlstub.s +++ b/client/basic/mlstub.s @@ -33,6 +33,7 @@ CLOSE=$FFC3 .import dns_resolve .import dns_ip .import ip65_process +.import icmp_echo_ip .zeropage temp_buff: .res 2 diff --git a/client/cfg/kipperbas.cfg b/client/cfg/kipperbas.cfg new file mode 100644 index 0000000..a074110 --- /dev/null +++ b/client/cfg/kipperbas.cfg @@ -0,0 +1,25 @@ +# CA65 config for a M/L stub that will use memory from $6000..$A000 and $c010..$cfff + +MEMORY { + IP65ZP: start = $A3, size = $12, type = rw; + MAINRAM: start = $3ffe, size = $3FC9, define = yes, file = %O; + HIRAM: start = $C010, size = $0fE0; + +} + + + SEGMENTS { + STARTUP: load = MAINRAM, type = ro; + IP65_DEFAULTS: load = MAINRAM, type = ro; + CODE: load = MAINRAM, type = ro; + SELF_MODIFIED_CODE: load = MAINRAM, type = rw; + RODATA: load = MAINRAM, type = ro; + DATA: load = MAINRAM, type = rw, define = yes; + BSS: load = MAINRAM, type = bss; + + IP65ZP: load = IP65ZP, type = zp; + + ZEROPAGE: load = IP65ZP, type = zp; + + TCP_VARS: load = HIRAM, type = bss; + } diff --git a/client/ip65/tftp.s b/client/ip65/tftp.s index 3bd3d41..6b6bd53 100644 --- a/client/ip65/tftp.s +++ b/client/ip65/tftp.s @@ -18,7 +18,6 @@ .export tftp_upload .export tftp_data_block_length .export tftp_set_callback_vector - .export tftp_data_block_length .export tftp_clear_callbacks .export tftp_filesize .export tftp_upload_from_memory @@ -105,12 +104,7 @@ tftp_bytes_remaining: .res 2 ; outputs: carry flag is set if there was an error ; if a callback vector has been set with tftp_set_callback_vector ; then the specified routine will be called once for each 512 byte packet -; sent from the tftp server (each time AX will point at data block just arrived, -; and tftp_data_block_length will contain number of bytes in that data block) -; otherwise, the buffer at tftp_load_address will be filled -; with file downloaded. -; tftp_load_address: will be set to the actual address loaded into (NB - this field is -; ignored if a callback vector has been set with tftp_set_callback_vector) +; to be sent to the tftp server tftp_upload_from_memory: ldax #copy_ram_to_tftp_block jsr tftp_set_callback_vector @@ -559,6 +553,7 @@ copy_ram_to_tftp_block: ; outputs: none tftp_set_callback_vector: stax tftp_callback_vector+1 + inc tftp_callback_address_set rts ;clear callback vectors, i.e. all future transfers read from/write to RAM