Apple-2-SW/emailler
1
0
Fork 0
mirror of https://github.com/bobbimanners/emailler.git synced 2024-07-31 23:28:55 +00:00
Code Issues Projects Releases Wiki Activity

git-svn-id: http://svn.code.sf.net/p/netboot65/code@263 93682198-c243-4bdb-bd91-e943c89aac3b

Browse Source
This commit is contained in:
jonnosan 2010-08-08 09:02:30 +00:00
parent 97df9d4199
commit b63c85e95c
7 changed files with 719 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
client/basic/Makefile
View File

@ -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

BIN
client/basic/kbload
View File

Binary file not shown.

BIN
client/basic/kipperbas.d64
View File

Binary file not shown.

724
client/basic/kipperbas.s
View File

@ -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
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
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
ldy #>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
.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

1
client/basic/mlstub.s
View File

@ -33,6 +33,7 @@ CLOSE=$FFC3
.import dns_resolve
.import dns_ip
.import ip65_process
.import icmp_echo_ip
.zeropage
temp_buff: .res 2

25
client/cfg/kipperbas.cfg Normal file
View File

@ -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;
}

9
client/ip65/tftp.s
View File

@ -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