home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
flex1
/
flxker.txt
next >
Wrap
Text File
|
1988-08-15
|
81KB
|
2,112 lines
*kermit for flex 9 system
*
* by D J ROWLAND
*ex-
*Brighton Polytechnic Computer centre
*Watts Building
*Lewes Rd.
*Moulsecoomb
*Brighton
*Sussex BN2 4GJ
*
*Queries now handled by Peter Morgan
*tel. 0273 693655 x2165
*This program is a very basic kermit, the code is based
*on the apple version of kermit and modified to run on the
*6809 cpu.
*
*I dont guarantee its operation! its a bit crude but it does work!
*It has be run with the DEC VAX kermit server and the DEC pro
*kermit server
*It will get a file , send a file , and close down the server
*It operates with text files only and does not have 8 bit quoting
* This software can be copied , modified etc. as required but
* subject to the kermit CUCCA conditions.
*There are no set and show commands
*To change the values modify the source!
*There is a receive data timer (for packet rcv)
*this can be modified or deleted!
*It is a simple timing loop round the rcv data subr.
**
* PGM: A minor bug I have noticed:
* after a transfer (say Flex to Vax), this program reports
* file in use when you try the next transfer. I believe this
* is caused by a missing call to close file (error conditions
* seem to be handled OK with JSR FMSCLS
*sytem equates
cons equ $F7E8 console i/f
line equ $F7EA line i/f
fms equ $d406
fmscls equ $d403
getfil equ $cd2d
setext equ $cd33
rpterr equ $cd3f
eom equ 4
xlev equ 200
xon equ $11
xoff equ $13
ctrlc equ $03
ctrly equ $19
max equ 255
xlo equ 20
suspec equ $04
*ram save locations
org $2000
inp rmb 2
outp rmb 2
startq rmb 256
end rmb 2
count rmb 1
fcs rmb 1
lastf rmb 1
suspend rmb 1 break out character
nolock rmb 1
tmode rmb 1
scount rmb 1
linbuf rmb 4
point rmb 2
rmb 64
stack rmb 1
monito rmb 1 diagnostic mode flag
linlen rmb 1
lfnext rmb 1
ram equ *
org $0000
begin jmp start
mdone fcc 'done'
fcb 4
prompt fcb $0d,$0a,4
menu1 fcc 'Please select option :- '
fcb $0d,$0a
fcc '0. Terminal to line'
fcb $0d,$0a
fcc '1. Return to flex'
fcb $0d,$0a
fcc '2. File send from Flex'
fcb $0d,$0a
fcc '3. File receive to Flex'
fcb $0d,$0a
fcc '4. Close server'
fcb $0d,$0a
fcc '5. Monitor on'
fcb $0d,$0a
fcc '6. Monitor off'
fcb $0d,$0a
fcc ' ? '
fcb 4
escstr fcc 'Type <CTRL D> to exit'
fcb $0d,$0a,4
filena fcc 'Flex Filename? '
fcb 4
filenr fcc 'Remote filename? '
fcb 4
query fcc ' ? '
fcb 4
start ldx #int
STX $f3c8
lda #3
sta line
lda #%00010101
lda #%10010101
sta line polled tx int rx
lda #suspec suspend character
sta suspend
ldx #startq
stx inp
stx outp set up line que
clr count
clr fcs
lda #xon
sta lastf
clr monito
clr tmode
clr pnum
clr pdlen
clr ptype
clr size
clr chksum
clr fld
clr rstat
clr ebqmod
clr datind
clr chebo
clr kerchr
clr delay
lda #dmaxtr
sta maxtry
lda #debq
sta rebq
sta sebq
lda #dpadln
sta rpad
sta spad
lda #dpadch
sta rpadch
sta spadch
lda #deol
sta reol
sta seol
lda #dpakln
sta rpsiz
sta spsiz
lda #dtime
sta rtime
sta stime
lda #dquote
sta rquote
sta squote
cli
jmp main
FCB $74,$35,$7A,$29,$6C,$8B,$77,$32,$68,$8C,$79,$36,$70,$30,$71,$8D
main equ * main loop and despatcher
ldy #$3000
sty point
ldx #prompt
jsr pstr issue welcome prompt
ldx #menu1
jsr pstr find out what user wants to do
lda cons+1
lda cons+1 clean i/f
jsr cinput
jsr coutch echo reply
cmpa #'0
lbeq term term emulation to line
cmpa #'2
lbeq send file transfer (kermit)
cmpa #'1
lbeq flexex return to flex
cmpa #'3
lbeq receve receive a file (kermit)
cmpa #'4
lbeq close
cmpa #'5
beq monon
cmpa #'6
beq monoff
bra main
monon sta monito
mmsg ldx #mdone
jsr pstr
bra main
monoff clr monito
bra mmsg
*************************************************
*terminal emulation******************************
term equ *
ldx #escstr tell user how tp break out
jsr pstr
terml jsr cinchk any console i/p
beq lhand no
bit b #$10 test for <break>
bne berr yes
jsr cinput read data
cmpa suspend
lbeq main exit at user request
sendl jsr loutch send it to line
bra lhand
berr lda cons+1 set line i/f to space
sei
lda #%11110101
sta line
ldx #$ffff
wait dex
INX
DEX
bne wait
lda #%10110101 restore i/f
sta line
cli
lhand equ *
jsr coutck ok to tx?
beq terml no
tst count que empty?
beq terml yes
jsr unque
jsr coutch send it
bra terml
************************************
flexex lda #$03 return to flex
sta line reset i/f causing ints
jmp $cd03 and warmstart to flex
*********************************
************************************
*line handler and other subrs.
qures equ *
sei
pshs x
ldx #startq
stx inp
stx outp
clr count
puls x
cli
rts
cinchk equ *
pshs a see if data from console
ldb cons
bitb #1
puls a,pc
cinput bsr cinchk
beq cinput no rxd
lda cons+1
anda #$7f
rts
loutck pshs a see if line ok to tx
lda line
bit a #2
puls a,pc
telppc equ *
loutch bsr loutck
beq loutch o/p to line
sta line+1
rts
pstr lda #$0d
jsr couts
lda #$0a
jsr couts
pstrs lda 0,x+ send string to console
cmpa #eom
beq pstre end of message
jsr couts send char
bra pstrs
pstre rts
getplc equ *
ldy #$ffff abort i/p timeout timer
getplt cmpy #$0000
*beq toexit timeout occured
leay -1,y keep timing
tst count
bne unque got data
jsr cinchk
beq getplt no console rx
jsr cinput get data
cmpa suspend
bne getplt not abort
toexit leas 2,s equiv to an rts
jmp rpkfls handle console abort back in kermit
unque equ * count must be checked as non 0 before entry
sei
pshs b,x
ldx outp
lda 0,x+ read char from line buffer
cmpx #end
bne un1
ldx #startq
un1 stx outp
dec count
ldb count
cli
cmpb #xlo
bne unx
ldb #xon send xon if reqd
cmpb lastf last code sent?
beq unx was an xon !
stb lastf
stb fcs set up for tx of an xon
ldb #%10110101
stb line set tx int on
unx puls b,x,pc
couts jsr coutck
beq couts
bra coutch
coutch equ *
sta cons+1 send data to console
cexit rts
coutcr jsr coutck
beq coutcr
bsr coutch o/p data
cmpa #cr
bne cexit
pshs a
lda #lf if cr then crlf
coutlf jsr coutck
beq coutlf
jsr coutch
puls a get back cr !
rts
coutck equ * see if can send to console
pshs a
lda cons
bita #2
puls a,pc
inline equ * read filename into fcb
clr b
inloop pshs b
jsr cinput get data
puls b
anda #$7f
cmpa #del
beq backc
cmpa #bs
beq backc
cmpa #ctrlx
beq dellin
cmpa #cr
beq endc fini
jsr couts echo char
sta 0,x save in buffer
inx
inc b
cmp b #$1e end of buffer?
beq endc yes force finish
bra inloop
dellin ldx #query
jsr pstr
bra inline start again
backc cmp b #0
beq inloop already at start of buffer
dex
decb back up 1 locn
lda #bs
jsr couts back up console
bra inloop and continue
endc clr a
sta 0,x
rts set terminator and exit
******************************************
* line int handler*****************
******************************************
int equ * interrupt
lda line
bita #1
beq ret1 not rxd
lda line+1 rxd int
ldb count
cmpb #max
beq ret que is totally full !
ldx inp
sta 0,x+ save char in buffer que
cpx #end
bne int1
ldx #startq
int1 stx inp
inc b
stb count
cmpb #xlev
bne ret
lda #xoff xoff level
cmpa lastf already sent?
beq ret yesd
sta lastf
sta fcs send an xoff
lda #%10110101 turn on line tx
sta line
ret rti
ret1 bit a #$80
beq ret2 not line tx
tst fcs
beq txs nothing to send
lda lastf
sta line+1 send flow code
txs lda #%10010101
sta line stop tx int
ret2 rti
*DESPATCH ROUTINE HERE FOR RECEVE AND SEND
KERMIT EQU * RETURN FROM KERMIT DRIVERS
*any error handling and status report
ldx #noerr
cmpa #true
beq kdone kermit ended succesfully
jsr fmscls close files on flex
lda errcod get error code
lsl a
ldx #errtab look up error message
ldx a,x
kdone jsr pstr error message/complete message
jmp main
errtab equ * lookup error message
fdb err0
fdb err1
fdb err2
fdb err3
fdb err4
fdb err5
fdb err6
fdb err7
err0 fcc 'error 0'
fcb 4
err1 fcc 'Cannot receive init'
fcb 4
err2 fcc 'Cannot receive file header'
fcb 4
err3 fcc 'Cannot receive data'
fcb 4
err4 fcc 'Maximum retry exceeded'
fcb 4
err5 fcc 'Bad checksum'
fcb 4
err6 fcc 'Checksum incorrect, resending packet'
fcb $0d,$0a
fcb 4
err7 fcc 'Program error'
fcb 4
noerr fcc 'Transfer completed succesfully'
fcb 4
ttl KL10 Error-free Reciprocol Micro-interface Transfer
STTL Character and string definitions
prom equ *
nul EQU $00 * <null>
soh EQU $01 * <soh>
bs EQU $08 * <bs>
tab EQU $09 * <tab> (ctrl/I)
lf EQU $0a * <lf>
ffd EQU $0c * Form feed
cr EQU $0d * <cr>
ctrlu EQU $15 * <ctrl/U>
ctrlx EQU $18 *[0] <ctrl/X>
esc EQU $1b * <esc>
sp EQU $20 * <space>
del EQU $7f * <del>
STTL Kermit defaults for operational parameters
*
* The following are the defaults which this Kermit uses for
* the protocol
*
dquote EQU '# * The quote character
dpakln EQU $5f * The packet length
dpadch EQU nul * The padding character
dpadln EQU 0 * The padding length
dmaxtr EQU 6 * The maximum number of tries
debq EQU '& * The eight-bit-quote character
deol EQU cr * The end-of-line character
dtime equ 5 *timeout interval
STTL Kermit data
*
* The following is data storage used by Kermit
*
mxpack EQU dpakln * Maximum packet size
eof EQU $01 * This is the value for End-of-file
buflen EQU $ff * Buffer length for received data
true EQU $01 * Symbol for true return code
false EQU $00 * Symbol for false return code
on EQU $01 * Symbol for value of 'on' keyword
off EQU $00 * Symbol for value of 'off' keyword
yes EQU $01 * Symbol for value of 'yes' keyword
no EQU $00 * Symbol for value of 'no' keyword
fbsbit EQU $01 * Value for SEVEN-BIT FILE-BYTE-SIZE
fbebit EQU $00 * Value for EIGHT-BIT FILE-BYTE-SIZE
errcri EQU $01 * Error code - cannot receive init
errcrf EQU $02 * Error code - cannot receive file-header
errcrd EQU $03 * Error code - cannot receive data
errmrc EQU $04 * Error code - maximum retry count exceeded
errbch EQU $05 * Error code - bad checksum
org ram
kerbf1 rmb 2
fcb1 rmb 20
fcb rmb 400 file spec
fcb2 rmb 20 remote file spec
pdbuf RMB mxpack+20 * Packet buffer JUST TO MAKE SURE ENOUGH ROOM
pdlen RMB 1 * Common area to place data length
ptype RMB 1 * Common area to place current packet type
pnum RMB 1 * Common area to put packet number received
rstat RMB 1 * Return status
delay RMB 1 * Amount of delay before first send
ebqmod RMB 1 * Eight-bit-quoting mode
datind RMB 1 * Data index into packet buffer
chebo RMB 1 * Switch to tell if 8th-bit was on
kerchr RMB 1 * Current character read off port
fld RMB 1 * State of receive in rpak routine
n RMB 1 * Message #
numtry RMB 1 * Number of tries for this packet
oldtry RMB 1 * Number of tries for previous packet
maxtry RMB 1 * Maximum tries allowed for a packet
state RMB 1 * Current state of system
size RMB 1 * Size of present data
chksum RMB 1 * Checksum for packet
rtot RMB 2 * Total number of characters received
stot RMB 2 * Total number of characters sent
rchr RMB 2 * Number characters received, current file
schr RMB 2 * Number of characters sent, current file
eofinp RMB 1 * End-of-file on input indicator
errcod RMB 1 * Error indicator
filend rmb 1 *end of file code rcvd
saddr rmb 2
*
* These fields are set parameters and should be kept in this
* order to insure integrity when setting and showing values
*
srind RMB 1 * Switch to indicate which parm to print
ebq RMB 1 debq * Eight-bit quote character (rec. and send)
RMB 1 debq * ...
pad RMB 1 dpadln * Number of padding characters (rec. and send)
RMB 1 dpadln * ...
padch RMB 1 dpadch * Padding character (receive and send)
RMB 1 dpaddh * ...
eol RMB 1 deol * End-of-line character (recevie and send)
RMB 1 deol * ...
psiz RMB 1 dpakln * Packet size (receive and send)
RMB 1 dpakln * ...
time RMB 2 $0000 * Time out interval (receive and send)
quote RMB 1 dquote * Quote character (receive and send)
RMB 1 dquote * ...
*
* Some definitions to make life easier when referencing the above
* fields
*
rebq EQU ebq * Receive eight-bit-quote char
sebq EQU ebq+1 * Send eight-bit-quote char
rpad EQU pad * Receive padding amount
spad EQU pad+1 * Send padding amount
rpadch EQU padch * Receive padding character
spadch EQU padch+1 * Send padding character
reol EQU eol * Receive end-of-line character
seol EQU eol+1 * Send end-of-line character
rpsiz EQU psiz * Receive packet length
spsiz EQU psiz+1 * Send packet length
rtime EQU time * Receive time out interval
stime EQU time+1 * Send time out interval
rquote EQU quote * Receive quote character
squote EQU quote+1 * Send quote character
org prom
*************************
close equ * close down server
lda #$00
sta numtry
closen lda numtry
inc numtry
cmpa maxtry
bne closec
lda #errmrc to many tries
sta errcod
lda #false exit to menu with error
jmp kermit
closec lda #'G
sta ptype set up close packet
ldx #pdbuf
stx kerbf1
lda #'F
sta 0,x
lda #1
sta pdlen
clr a
sta n packet #0 for closing
sta pnum
jsr spak send it
jsr rpak get back an ack?
lda ptype
cmpa #'Y
bne closen no
lda n
cmpa pnum right one?
bne closen no
lda #true
jmp term
STTL Receve routine
*
* This routine receives a file from the remote kermit and
* writes it to a disk file
*
* Input Filename returned from comnd, if any
*
* Output If file transfer is good, file is output to disk
*
* Registers destroyed A,X,Y
*
receve equ *
*get filename
ldx #filena
jsr pstr
ldx #fcb1
jsr inline
ldx #filenr
jsr pstr
ldx #fcb2
jsr inline
jsr rswt * Perform send-switch routine
jmp kermit * Go back to main routine
rswt lda #'R * The state is receive-init
sta state * Set that up
lda #$00 * Zero the packet sequence number
sta n * ..
sta numtry * Number of tries
sta oldtry * Old number of tries
sta eofinp * End of input flag
sta errcod * Error indicator
sta rtot * Total received characters
sta rtot+1 * ..
sta stot * Total Sent characters
sta stot+1 * ..
sta rchr * Received characters, current file
sta rchr+1 * ..
sta schr * and Sent characters, current file
sta schr+1 * ..
jsr qures
rswt1 lda state * Fetch the current system state
cmp a #'D * Are we trying to receive data?
bne rswt2 * If not, try the next one
jsr rdat * Go try for the data packet
jmp rswt1 * Go back to the top of the loop
rswt2 cmp a #'F * Do we need a file header packet?
bne rswt3 * If not, continue checking
jsr rfil * Go get the file-header
jmp rswt1 * Return to top of loop
rswt3 cmp a #'R * Do we need the init?
bne rswt41 * No, try next state
jsr rini * Yes, go get it
jmp rswt1 * Go back to top
rswt41 cmpa #'B
bne rswt4
jsr rrbrk1
jmp rswt1
rswt4 cmp a #'C * Have we completed the transfer?
bne rswt5 * No, we are out of states, fail
lda #true * Load AC for true return
rts * Return
rswt5 lda #false * Set up AC for false return
rts * Return
rini ldx #pdbuf * Point kerbf1 at the packet data buffer
stx kerbf1 * ..
lda numtry * Get current number of tries
inc numtry * Increment it for next time
cmp a maxtry * Have we tried this one enought times
bne rini1 * Not yet, go on
bra rini1a * Yup, go abort this transfer
rini1 jmp rini2 * Continue
rini1a lda #'A * Change state to 'abort'
sta state * ..
lda #errcri * Fetch the error index
sta errcod * and store it as the error code
lda #false * Load AC with false status
rts * and return
rini2 equ *
*send r packet to request file
clr b
rinif2 ldy #fcb2
lda b,y
cmpa #$00 move file header to packet
beq rinif1 fini
ldy #pdbuf
sta b,y
inc b
bra rinif2
rinif1 stb pdlen
lda #'R
sta ptype
lda n
sta pnum
jsr spak send it
jsr rpak * Go try to receive a packet
sta rstat * Store the return status for later
lda ptype * Fetch the packet type we got
cmp a #'S * Was it an 'Init'?
bne rini2a * No, check the return status
jmp rinici * Go handle the init case
rini2a lda rstat * Fetch the saved return status
cmp a #false * Is it false?
beq rini2b * Yes, just return with same state
lda #'A * No, abort this transfer
sta state * State is now 'abort'
lda #errcri * Fetch the error index
sta errcod * and store it as the error code
lda #false * Set return status to 'false'
rts * Return
rini2b lda n * Get packet sequence number expected
sta pnum * Stuff that parameter at the Nakit routine
jsr nakit * Go send the Nak
lda #false * Set up failure return status
rts * and go back
rinici lda pnum * Get the packet number we received
sta n * Synchronize our packet numbers with this
jsr rpar * Load in the init stuff from packet buffer
jsr spar * Stuff our init info into the packet buffer
lda #'Y * Store the 'Ack' code into the packet type
sta ptype * ..
lda n * Get sequence number
sta pnum * Stuff that parameter
lda #off * No, punt 8-bit quoting
sta ebqmod * ..
lda #$06 * BTW, the data length is now only 6
rinic1 sta pdlen * Store packet data length
jsr spak * Send that packet
lda numtry * Move the number of tries for this packet
sta oldtry * to prev packet try count
lda #$00 * Zero
sta numtry * the number of tries for current packet
jsr incn * Increment the packet number once
lda #'F * Advance to 'File-header' state
sta state * ..
lda #true * Set up return code
rts * Return
rfil lda numtry * Get number of tries for this packet
inc numtry * Increment it for next time around
cmp a maxtry * Have we tried too many times?
bne rfil1 * Not yet
bra rfil1a * Yes, go abort the transfer
rfil1 jmp rfil2 * Continue transfer
rfil1a bra rfilla
rfil2 jsr rpak *try to receive a packet
sta rstat * Save the return status
lda ptype * Get the packet type we found
cmp a #'S * Was it an 'init' packet?
bne rfil2a * Nope, try next one
jmp rfilci * Handle the init case
rfil2a cmp a #'Z * Is it an 'eof' packet??
bne rfil2b * No, try again
jmp rfilce * Yes, handle that case
rfil2b cmp a #'F * Is it a 'file-header' packet???
bne rfil2c * Nope
jmp rfilcf * Handle file-header case
rfil2c cmp a #'B * Break packet????
bne rfil2x * Wrong, go get the return status
jmp rfilcb * Handle a break packet
rfil2x cmpa #'E
bne rfil2d
jsr pemsg send error packet info to console
jmp rfilla and abort
rfil2d lda rstat * Fetch the return status from Rpak
cmp a #false * Was it a false return?
beq rfil2e * Yes, Nak it and return
rfilla lda #'A * No, abort this transfer, we don't know what
sta state * this is
lda #errcrf * Fetch the error index
sta errcod * and store it as the error code
lda #false * Set up failure return code
rts * and return
rfil2e lda n * Move the expected packet number
sta pnum * into the spot for the parameter
jsr nakit * Nak the packet
lda #false * Do a false return but don't change state
rts * Return
rfilci lda oldtry * Get number of tries for prev packet
inc oldtry * Increment it
cmp a maxtry * Have we tried this one too much?
bne rfili1 * Not quite yet
bra rfili2 * Yes, go abort this transfer
rfili1 jmp rfili3 * Continue
rfili2
rfili5 lda #'A * Move abort code
sta state * to system state
lda #errcrf * Fetch the error index
sta errcod * and store it as the error code
lda #false * Prepare failure return
rts * and go back
rfili3 lda pnum * See if pnum=n-1
clc * ..
add a #$01 * ..
cmp a n * ..
beq rfili4 * If it does, than we are ok
jmp rfili5 * Otherwise, abort
rfili4 jsr spar * Set up the init parms in the packet buffer
lda #'Y * Set up the code for Ack
sta ptype * Stuff that parm
lda #$06 * Packet length for init
sta pdlen * Stuff that also
jsr spak * Send the ack
lda #$00 * Clear out
sta numtry * the number of tries for current packet
lda #true * This is ok, return true with current state
rts * Return
rfilce lda oldtry * Get number of tries for previous packet
inc oldtry * Up it for next time we have to do this
cmp a maxtry * Too many times for this packet?
bne rfile1 * Not yet, continue
bra rfile2 * Yes, go abort it
rfile1 jmp rfile3 * ..
rfile2
rfile5 lda #'A * Load abort code
sta state * into current system state
lda #errcrf * Fetch the error index
sta errcod * and store it as the error code
lda #false * Prepare failure return
rts * and return
rfile3 lda pnum * First, see if pnum=n-1
clc * ..
add a #$01 * ..
cmp a n * ..
beq rfile4 * If so, continue
jmp rfile5 * Else, abort it
rfile4 lda #'Y * Load 'ack' code
sta ptype * Stuff that in the packet type
lda #$00 * This packet will have a packet data length
sta pdlen * of zero
jsr spak * Send the packet out
lda #$00 * Zero number of tries for current packet
sta numtry * ..
lda #true * Set up successful return code
rts * and return
rfilcf lda pnum * Does pnum=n?
cmp a n * ..
bne rfilf1 * If not, abort
jmp rfilf2 * Else, we can continue
rfilf1 lda #'A * Load the abort code
sta state * and stuff it as current system state
lda #errcrf * Fetch the error index
sta errcod * and store it as the error code
lda #false * Prepare failure return
rts * and go back
rfilf2 equ *
* open file for write (harris)
ldx #fcb1
rfnc lda 0,x+
cmpa #$00
bne rfnc
lda #$20 change terminator to space
leax -1,x
sta 0,x
ldx #fcb1 setup i/p point
stx $cc14 to line i/p buff
ldx #fcb
jsr getfil parse file spec
bcs fer1 error in file name
lda #2 open for write
sta 0,x set to txt
jsr setext set to text
jsr fms open file for write
bne fer1 file open error
lda #'Y * Stuff code for 'ack'
sta ptype * Into packet type parm
lda #$00 * Stuff a zero in as the packet data length
sta pdlen * ..
jsr spak * Ack the packet
lda numtry * Move current tries to previous tries
sta oldtry * ..
lda #$00 * Clear the
sta numtry * Number of tries for current packet
jsr incn * Increment the packet sequence number once
lda #'D * Advance the system state to 'receive-data'
sta state * ..
lda #true * Set up success return
rts * and go back
fer1 jsr rpterr tell userof error
jsr fmscls
jmp main
rfilcb lda pnum * Does pnum=n?
cmp a n * ..
bne rfilb1 * If not, abort the transfer process
jmp rfilb2 * Otherwise, we can continue
rfilb1 lda #'A * Code for abort
sta state * Stuff that into system state
lda #errcrf * Fetch the error index
sta errcod * and store it as the error code
lda #false * Load failure return status
rts * and return
rfilb2 lda #'Y * Set up 'ack' packet type
sta ptype * ..
lda #$00 * Zero out
sta pdlen * the packet data length
jsr spak * Send out this packet
lda #'C * Advance state to 'complete'
sta state * since we are now done with the transfer
lda #true * Return a true
rts * ..
rdat lda numtry * Get number of tries for current packet
inc numtry * Increment it for next time around
cmp a maxtry * Have we gone beyond number of tries allowed?
bne rdat1 * Not yet, so continue
bra rdat1a * Yes, we have, so abort
rdat1 jmp rdat2 * ..
rdat1a lda #'A * Code for 'abort' state
sta state * Stuff that in system state
lda #errcrd * Fetch the error index
sta errcod * and store it as the error code
jsr closef
lda #false * Set up failure return code
rts * and go back
rdat2 jsr rpak * Go try to receive a packet
sta rstat * Save the return status for later
lda ptype * Get the type of packet we just picked up
cmp a #'D * Was it a data packet?
bne rdat2a * If not, try next type
jmp rdatcd * Handle a data packet
rdat2a cmp a #'F * Is it a file-header packet?
bne rdat2b * Nope, try again
jmp rdatcf * Go handle a file-header packet
rdat2b cmp a #'Z * Is it an eof packet???
bne rdat2x * If not, go check the return status from rpak
jmp rdatce * It is, go handle eof processing
rdat2x cmpa #'E
bne rdat2c
jsr pemsg
bra rdater
rdat2c lda rstat * Fetch the return status
cmp a #false * Was it a failure return?
beq rdat2d * If it was, Nak it
rdater lda #'A * Otherwise, we give up the whole transfer
sta state * Set system state to 'false'
lda #errcrd * Fetch the error index
sta errcod * and store it as the error code
jsr closef
lda #false * Set up a failure return
rts * and go back
rdat2d lda n * Get the expected packet number
sta pnum * Stuff that parameter for Nak routine
jsr nakit * Send a Nak packet
lda #false * Give failure return
rts * Go back
rdatcd lda pnum * Is pnum the right sequence number?
cmp a n * ..
bne rdatd1 * If not, try another approach
jmp rdatd7 * Otherwise, everything is fine
rdatd1 lda oldtry * Get number of tries for previous packet
inc oldtry * Increment it for next time we need it
cmp a maxtry * Have we exceeded that limit?
bne rdatd2 * Not just yet, continue
bra rdatd3 * Yes, go abort the whole thing
rdatd2 jmp rdatd4 * Just continue working on the thing
rdatd3
rdatd6 lda #'A * Load 'abort' code into the
sta state * current system state
lda #errcrd * Fetch the error index
sta errcod * and store it as the error code
jsr closef
lda #false * Make this a failure return
rts * Return
rdatd4 lda pnum * Is pnum=n-1.. Is the received packet
clc * the one previous to the currently
add a #$01 * expected packet?
cmp a n * ..
beq rdatd5 * Yes, continue transfer
jmp rdatd6 * Nope, abort the whole thing
rdatd5 jsr spar * Go set up init data
lda #'Y * ***************** an ack to **********t
sta ptype * ..
lda #$00 * ..
sta pdlen * ..
jsr spak * Go send the ack
lda #$00 * Clear the
sta numtry * number of tries for current packet
lda #true * ..
rts * Return (successful!)
rdatd7 jsr bufemp * Go empty the packet buffer
lda #'Y * Set up an ack packet
sta ptype * ..
lda n * ..
sta pnum * ..
lda #$00 * Don't forget, there is no data
sta pdlen * ..
jsr spak * Send it!
lda numtry * Move tries for current packet count to
sta oldtry * tries for previous packet count
lda #$00 * Zero the
sta numtry * number of tries for current packet
jsr incn * Increment the packet sequence number once
lda #'D * Advance the system state to 'receive-data'
sta state * ..
lda #true * ..
rts * Return (successful)
rdatcf lda oldtry * Fetch number of tries for previous packet
inc oldtry * Increment it for when we need it again
cmp a maxtry * Have we exceeded maximum tries allowed?
bne rdatf1 * Not yet, go on
bra rdatf2 * Yup, we have to abort this thing
rdatf1 jmp rdatf3 * Just continue the transfer
rdatf2
rdatf5 lda #'A * Move 'abort' code to current system state
sta state * ..
lda #errcrd * Fetch the error index
sta errcod * and store it as the error code
jsr closef
lda #false * ..
rts * and return false
rdatf3 lda pnum * Is this packet the one before the expected
clc * one?
add a #$01 * ..
cmp a n * ..
beq rdatf4 * If so, we can still ack it
jmp rdatf5 * Otherwise, we should abort the transfer
rdatf4 lda #'Y * Load 'ack' code
sta ptype * Stuff that parameter
lda #$00 * Use zero as the packet data length
sta pdlen * ..
jsr spak * Send it!
lda #$00 * Zero the number of tries for current packet
sta numtry * ..
lda #true * ..
rts * Return (successful)
rdatce lda pnum * Is this the packet we are expecting?
cmp a n * ..
bne rdatf5 * No, we should go abort
jmp rdate2 * Yup, go handle it
rdate1 lda #'A * Load 'abort' code into
sta state * current system state
lda #errcrd * Fetch the error index
sta errcod * and store it as the error code
lda #false * ..
rts * Return (failure)
rdate2 lda #'Y * Get set up for the ack
sta ptype * Stuff the packet type
lda n * packet number
sta pnum * ..
lda #$00 * and packet data length
sta pdlen * parameters
jsr spak * Go send it!
jsr closef
lda #'B
sta state complete
lda numtry
sta oldtry
lda #$00
sta numtry
jsr incn
lda #true
rts exit
closef jmp fmscls
rrbrk1 lda numtry
inc numtry
cmpa maxtry
bne rrbrk2 not excceded try count
jmp rdate1 too many tries
rrbrk2 jsr rpak
sta rstat
lda ptype
cmpa #'Z
bne rrbrk3
jmp rreof reack last
rrbrk3 cmpa #'B
bne rrbrk4
jmp rrbp ack the break packet
rrbrk4 lda rstat
cmp a #false
lbeq rdat2d nak it
bra rdate1 wrong type ..abort
rreof lda oldtry
inc oldtry
cmpa maxtry
lbeq rdate1 error in packet #
lda pnum
adda #$01 prev
cmpa n
beq rdate4 ack it
lbra rdate1 error in packet #
rrbp lda pnum
cmpa n
lbne rdate1 abort wrong packet #
lbsr rdate4 ack B.. packet.
bra rrds
rdate4 lda #'Y
sta ptype
lda n
sta pnum
lda #$00
sta pdlen
jsr spak send ack
rts
rrds lda #'C
sta state
lda #true complete
rts
STTL Send routine
*
* This routine reads a file from disk and sends packets
* of data to the remote kermit
*
* Input Filename returned from Comnd routines
*
* Output File is sent over port
*
* Registers destroyed A,X,Y
*
send equ *
*get file name
ldx #filena
jsr pstr
ldx #fcb1
jsr inline
ldx #filenr
jsr pstr
ldx #fcb2
jsr inline
jsr sswt
jmp kermit * Go back to main routine
sswt lda #'S * Set up state variable as
sta state * Send-init
lda #$00 * Clear
sta n * Packet number
sta numtry * Number of tries
sta oldtry * Old number of tries
sta eofinp * End of input flag
sta errcod * Error indicator
sta rtot * Total received characters
sta rtot+1 * ...
sta stot * Total Sent characters
sta stot+1 * ...
sta rchr * Received characters, current file
sta rchr+1 * ...
sta schr * and a Sent characters, current file
sta schr+1 * ...
sta filend reset file end flag
ldx #pdbuf * Set up the address of the packet buffer
stx saddr * so that we can clear it out
lda #$00 * Clear AC
ldb #$00 * Clear Y
ldy saddr
clpbuf sta b,y * Step through buffer, clearing it out
inc b * Up the index
cmpb #mxpack * Done?
bne clpbuf * No, continue
sswt1 lda state * Fetch state of the system
cmp a #'D * Do Send-data?
bne sswt2 * No, try next one
jsr sdat * Yes, send a data packet
jmp sswt1 * Go to the top of the loop
sswt2 cmp a #'F * Do we want to send-file-header?
bne sswt3 * No, continue
jsr sfil * Yes, send a file header packet
jmp sswt1 * Return to top of loop
sswt3 cmp a #'Z * Are we due for an Eof packet?
bne sswt4 * Nope, try next state
jsr seof * Yes, do it
jmp sswt1 * Return to top of loop
sswt4 cmp a #'S * Must we send an init packet
bne sswt5 * No, continue
jsr sini * Yes, go do it
jmp sswt1 * And continue
sswt5 cmp a #'B * Time to break the connection?
bne sswt6 * No, try next state
jsr sbrk * Yes, go send a break packet
jmp sswt1 * Continue from top of loop
sswt6 cmp a #'C * Is the entire transfer complete?
bne sswt7 * No, something is wrong, go abort
lda #true * Return true
rts * ...
sswt7 lda #false * Return false
rts * ...
sdat lda numtry * Fetch the number for tries for current packet
inc numtry * Add one to it
cmp a maxtry * Is it more than the maximum allowed?
bne sdat1 * No, not yet
bra sdat1a * If it is, go abort
sdat1 jmp sdat1b * Continue
sdat1a lda #'A * Load the 'abort' code
sta state * Stuff that in as current state
lda #errmrc
sta errcod
lda #false * Enter false return code
rts * and a return
sdat1b lda #'D * Packet type will be 'Send-data'
sta ptype * ...
lda n * Get packet sequence number
sta pnum * Store that parameter to Spak
lda size * This is the size of the data in the packet
sta pdlen * Store that where it belongs
jsr spak * Go send the packet
sdat2 jsr rpak * Try to get an ack
sta rstat * First, save the return status
lda ptype * Now get the packet type received
cmp a #'N * Was it a NAK?
bne sdat2a * No, try for an ACK
jmp sdatcn * Go handle the nak case
sdat2a cmp a #'Y * Did we get an ACK?
bne sdat2x * No, try checking the return status
jmp sdatca * Yes, handle the ack
sdat2x cmp a #'E
bne sdat2b
jsr pemsg
bra sdat1a
sdat2b lda rstat * Fetch the return status
cmp a #false * Failure return?
beq sdat2c * Yes, just return with current state
lda #'A * Stuff the abort code
sta state * as the current system state
lda #false * Load failure return code
sdat2c rts * Go back
sdatcn dec pnum * Decrement the packet sequence number
lda n * Get the expected packet sequence number
cmp a pnum * If n=pnum-1 then this is like an ack
bne sdatn1 * No, continue handling the nak
jmp sdata2 * Jump to ack bypassing sequence check
sdata1
sdatn1 lda #false * Failure return
rts * ...
sdatca lda n * First check packet number
cmp a pnum * Did he ack the correct packet?
bne sdata1 * No, go give failure return
sdata2 lda #$00 * Zero out number of tries for current packet
sta numtry * ...
jsr incn * Increment the packet sequence number
jsr bufill * Go fill the packet buffer with data
sta size * Save the data size returned
lda eofinp * Load end-of-file indicator
cmp a #true * Was this set by Bufill?
beq sdatrz * If so, return state 'Z' ('Send-eof')
jmp sdatrd * Otherwise, return state 'D' ('Send-data')
sdatrz lda #'Z * Load the Eof code
sta state * and a make it the current system state
lda #true * We did succeed, so give a true return
rts * Go back
sdatrd lda #'D * Load the Data code
sta state * Set current system state to that
lda #true * Set up successful return
rts * and a go back
sfil lda numtry * Fetch the current number of tries
inc numtry * Up it by one
cmp a maxtry * See if we went up to too many
bne sfil1 * Not yet
bra sfil1a * Yes, go abort
sfil1 jmp sfil1b * If we are still ok, take this jump
sfil1a lda #'A * Load code for abort
sta state * and a drop that in as the current state
lda #errmrc
sta errcod
lda #false * Load false for a return code
rts * and a return
sfil1b ldb #$00 * Clear B
sfil1c ldy #fcb2
lda b,y * Get a byte from the filename
cmp a #$00 * Is it a null?
beq sfil1d * No, continue
ldy #pdbuf
sta b,y * Move the byte to this buffer
incb * Up the index once
jmp sfil1c * Loop and a do it again
sfil1d stb pdlen * This is the length of the filename
lda #'F * Load type ('Send-file')
sta ptype * Stuff that in as the packet type
lda n * Get packet number
sta pnum * Store that in its common area
jsr spak * Go send the packet
sfil2 jsr rpak * Go try to receive an ack
sta rstat * Save the return status
lda ptype * Get the returned packet type
cmp a #'N * Is it a NAK?
bne sfil2a * No, try the next packet type
jmp sfilcn * Handle the case of a nak
sfil2a cmp a #'Y * Is it, perhaps, an ACK?
bne sfil2x * If not, go to next test
jmp sfilca * Go and a handle the ack case
sfil2x cmpa #'E
bne sfil2b
jsr pemsg
bra sfil1a abort
sfil2b lda rstat * Get the return status
cmp a #false * Is it a failure return?
bne sfil2c * No, just go abort the send
rts * Return failure with current state
sfil2c bra sfil1a
sfilcn dec pnum * Decrement the receive packet number once
lda pnum * Load it into the AC
cmp a n * Compare that with what we are looking for
bne sfiln1 * If n=pnum-1 then this is like an ack, do it
jmp sfila2 * This is like an ack
sfila1
sfiln1 lda #false * Load failure return code
rts * and a return
sfilca lda n * Get the packet number
cmp a pnum * Is that the one that was acked?
bne sfila1 * They are not equal
sfila2 lda #$00 * Clear AC
sta numtry * Zero the number of tries for current packet
jsr incn * Up the packet sequence number
ldx #fcb1 * Load the fcb address into the pointer
* open the file (harris)
ldx #fcb1
sfcn lda 0,x+
cmpa #$00
bne sfcn
lda #$20
leax -1,x
sta 0,x
ldx #fcb1
stx $cc14
ldx #fcb
jsr getfil
bcs sfer1
lda #1
sta 0,x open for read
jsr setext
jsr fms open file
bne sfer1
clr linlen
clr lfnext
jsr bufill * Go get characters from the file
sta size * Save the returned buffer size
lda #'D * Set state to 'Send-data'
sta state * ...
lda #true * Set up true return code
rts * and a return
sfer1 jsr rpterr tell user
jsr fmscls
jmp main
seof lda numtry * Get the number of attempts for this packet
inc numtry * Now up it once for next time around
cmp a maxtry * Are we over the allowed max?
bne seof1 * Not quite yet
bra seof1a * Yes, go abort
seof1 jmp seof1b * Continue sending packet
seof1a lda #'A * Load 'abort' code
sta state * Make that the state of the system
lda #errmrc * Fetch the error index
sta errcod * and a store it as the error code
lda #false * Return false
rts * ...
seof1b lda #'Z * Load the packet type 'Z' ('Send-eof')
sta ptype * Save that as a parm to Spak
lda n * Get the packet sequence number
sta pnum * Copy in that parm
lda #$00 * This is our packet data length (0 for EOF)
sta pdlen * Copy it
jsr spak * Go send out the Eof
seof2 jsr rpak * Try to receive an ack for it
sta rstat * Save the return status
lda ptype * Get the received packet type
cmp a #'N * Was it a nak?
bne seof2a * If not, try the next packet type
jmp seofcn * Go take care of case nak
seof2a cmp a #'Y * Was it an ack
bne seof2x * If it wasn't that, try return status
jmp seofca * Take care of the ack
seof2x cmpa #'E
bne seof2b
jsr pemsg
bra seof1a
seof2b lda rstat * Fetch the return status
cmp a #false * Was it a failure?
beq seof2c * Yes, just fail return with current state
bra seof1a
seof2c rts * Return
seofcn dec pnum * Decrement the received packet sequence number
lda n * Get the expected sequence number
cmp a pnum * If it's the same as pnum-1, it is like an ack
bne seofn1 * It isn't, continue handling the nak
jmp seofa2 * Switch to an ack but bypass sequence check
seofa1
seofn1 lda #false * Load failure return status
rts * and a return
seofca lda n * Check sequence number expected against
cmp a pnum * the number we got.
bne seofa1 * If not identical, fail and a return curr. state
seofa2 lda #$00 * Clear the number of tries for current packet
sta numtry * ...
jsr incn * Up the packet sequence number
seofrb lda #'B * Load Eot state code
sta state * Store that as the current state
lda #true * Give a success on the return
rts * ...
sini ldy #pdbuf * Load the pointer to the
sty kerbf1 * packet buffer into its
jsr spar * Go fill in the send init parms
lda numtry * If numtry > maxtry
cmp a maxtry * ...
bne sini1 * ...
bra sini1a * then we are in bad shape, go fail
sini1 jmp sini1b * Otherwise, we just continue
sini1a lda #'A * Set state to 'abort'
sta state * ...
lda #errmrc * Fetch the error index
sta errcod * and a store it as the error code
lda #$00 * Set return status (AC) to fail
rts * Return
sini1b inc numtry * Increment the number of tries for this packet
lda #'S * Packet type is 'Send-init'
sta ptype * Store that
lda #$06 * Else it is 6
sini1d sta pdlen * Store that parameter
lda n * Get the packet number
sta pnum * Store that in its common area
jsr spak * Call the routine to ship the packet out
jsr rpak * Now go try to receive a packet
sta rstat * Hold the return status from that last routine
sinics lda ptype * Case statement, get the packet type
cmp a #'Y * Was it an ACK?
bne sinic1 * If not, try next type
jmp sinicy * Go handle the ack
sinic1 cmp a #'N * Was it a NAK?
bne sinicx * If not, try next condition
jmp sinicn * Handle a nak
sinicx cmpa #'E
bne sinic2
jsr pemsg
bra sini1a
sinic2 lda rstat * Fetch the return status
cmp a #false * Was this, perhaps false?
bne sinic3 * Nope, do the 'otherwise' stuff
jmp sinicf * Just go and a return
sinic3 bra sini1a
sinicn
sinicf rts * Return
sinicy ldb #$00 * Clear B
lda n * Get packet number
cmp a pnum * Was the ack for that packet number?
beq siniy1 * Yes, continue
lda #false * No, set false return status
rts * and a go back
siniy1 jsr rpar * Get parms from the ack packet
siniy3 lda #'F * Load code for 'Send-file' into AC
sta state * Make that the new state
lda #$00 * Clear AC
sta numtry * Reset numtry to 0 for next send
jsr incn * Up the packet sequence number
lda #true * Return true
rts
sbrk lda numtry * Get the number of tries for this packet
inc numtry * Incrment it for next time
cmp a maxtry * Have we exceeded the maximum
bne sbrk1 * Not yet
bra sbrk1a * Yes, go abort the whole thing
sbrk1 jmp sbrk1b * Continue send
sbrk1a lda #'A * Load 'abort' code
sta state * Make that the system state
lda #errmrc * Fetch the error index
sta errcod * and a store it as the error code
lda #false * Load the failure return status
rts * and a return
sbrk1b lda #'B * We are sending an Eot packet
sta ptype * Store that as the packet type
lda n * Get the current sequence number
sta pnum * Copy in that parameter
lda #$00 * The packet data length will be 0
sta pdlen * Copy that in
jsr spak * Go send the packet
sbrk2 jsr rpak * Try to get an ack
sta rstat * First, save the return status
lda ptype * Get the packet type received
cmp a #'N * Was it a NAK?
bne sbrk2a * If not, try for the ack
jmp sbrkcn * Go handle the nak case
sbrk2a cmp a #'Y * An ACK?
bne sbrk2b * If not, look at the return status
jmp sbrkca * Go handle the case of an ack
sbrk2b lda rstat * Fetch the return status from Rpak
cmp a #false * Was it a failure?
beq sbrk2c * Yes, just return with current state
bra sbrk1a
sbrk2c rts * and a return
sbrkcn dec pnum * Decrement the received packet number once
lda n * Get the expected sequence number
cmp a pnum * If =pnum-1 then this nak is like an ack
bne sbrkn1 * No, this was no the case
jmp sbrka2 * Yes! Go do the ack, but skip sequence check
sbrka1
sbrkn1 lda #false * Load failure return code
rts * and a go back
sbrkca lda n * Get the expected packet sequence number
cmp a pnum * Did we get what we expected?
bne sbrka1 * No, return failure with current state
sbrka2 lda #$00 * Yes, clear number of tries for this packet
sta numtry * ...
jsr incn * Up the packet sequence number
lda #'C * The transfer is now complete, reflect this
sta state * in the system state
lda #true * Return success!
rts * ...
STTL Packet routines - SPAK - send packet
*
* This routine forms and a sends out a complete packet in the
* following format
*
* <SOH><char(pdlen)><char(pnum)><ptype><data><char(chksum)><eol>
*
* Input kerbf1- Pointer to packet buffer
* pdlen- Length of data
* pnum- Packet number
* ptype- Packet type
*
* Output A- True or False return code
*
spak equ *
lda #'s
jsr couts tell console we are sending packet
jsr qures flush que
* PRINT PACKET NUMBER TO CONSOLE
spaknd lda spadch * Get the padding character
ldb #$00 * Init counter
spakpd cmpb spad * Are we done padding?
beq spakst * Yes, start sending packet
inc b * No, up the index and a count by one
jsr telppc * Output a padding character
jmp spakpd * Go around again
spakst lda #soh * Get the start-of-header char into AC
jsr telppc * Send it
lda pdlen * Get the data length
add a #$03 * Adjust it
pshs a * Save this to be added into stot
add a #sp * Make the thing a character
sta chksum * First item, start off chksum with it
jsr telppc * Send the character
puls a * Fetch the pdlen and a add it into the
add a stot * ...
sta stot * ...
lda stot+1 * ...
add a #$00 * ...
sta stot+1 * ...
lda pnum * Get the packet number
clc * ...
add a #sp * Char it
pshs a * Save it in this condition
add a chksum * Add this to the checksum
sta chksum * ...
puls a * Restore character
jsr telppc * Send it
lda ptype * Fetch the packet type
and a #$7f * Make sure H.O. bit is off for chksum
pshs a * Save it on stack
add a chksum * ...
sta chksum * ...
puls a * Get the original character off stack
jsr telppc * Send packet type
ldb #$00 * Initialize data count
stb datind * Hold it here
spaklp ldb datind * Get the current index into the data
cmpb pdlen * Check against packet data length, done?
blo spakdc * Not yet, process another character
jmp spakch * Go do chksum calculations
spakdc ldy kerbf1
lda b,y
add a chksum * ...
sta chksum * ...
lda b,y * Refetch data from packet buffer
jsr telppc * Send it
inc datind * Up the counter and a index
jmp spaklp * Loop to do next character
spakch lda chksum * Now, adjust the chksum to fit in 6 bits
and a #$c0 * First, take bits 6 and 7
lsr a * and a shift them to the extreme right
lsr a * side of the AC
lsr a * ...
lsr a * ...
lsr a * ...
lsr a * ...
add a chksum * ...
and a #$3f * All this should be mod decimal 64
add a #sp * Put it in printable range
jsr telppc * and a send it
lda seol * Fetch the eol character
jsr telppc * Send that as the last byte of the packet
spakcr rts * and a return
STTL Packet routines - RPAK - receive a packet
*
* This routine receives a standard Kermit packet and a then breaks
* it apart returning the individuals components in their respective
* memory locations.
*
* Input
*
* Output kerbf1- Pointer to data from packet
* pdlen- Length of data
* pnum- Packet number
* ptype- Packet type
*
rpak equ *
* update user console with packet number
lda #'r
jsr couts tell console we are receiving packet
rpaknd lda #$00 * Clear the
sta chksum * chksum
sta datind * index into packet buffer
sta kerchr * and the current character input
rpakfs jsr getplc * Get a char, find SOH
sta kerchr * Save it
cmp a #soh * Is it an SOH character?
bne rpakfs * Nope, try again
lda #$01 * Set up the switch for receive packet
sta fld * ...
rpklp1 lda fld * Get switch
cmp a #$06 * Compare for <= 5
blo rpklp2 * If it still is, continue
jmp rpkchk * Otherwise, do the chksum calcs
rpklp2 cmp a #$05 * Check fld
bne rpkif1 * If it is not 5, go check for SOH
lda datind * Fetch the data index
cmp a #$00 * If the data index is not null
bne rpkif1 * do the same thing
jmp rpkif2 * Go process the character
rpkif1 jsr getplc * Get a char, find SOH
sta kerchr * Save that here
cmp a #soh * Was it another SOH?
bne rpkif2 * If not, we don't have to resynch
lda #$00 * Yes, resynch
sta fld * Reset the switch
rpkif2 lda fld * Get the field switch
cmp a #$04 * Is it <= 3?
bhs rpkswt * No, go check the different cases now
lda kerchr * Yes, it was, get the character
add a chksum * ...
sta chksum * ...
rpkswt lda fld * Now check the different cases of fld
cmp a #$00 * Case 0?
bne rpkc1 * Nope, try next one
lda #$00 * Yes, zero the chksum
sta chksum * ...
jmp rpkef * and restart the loop
rpkc1 cmp a #$01 * Is it case 1?
bne rpkc2 * No, continue checking
lda kerchr * Yes, get the length of packet
sec * ...
sub a #sp * Unchar it
sec * ...
sub a #$03 * Adjust it down to data length
sta pdlen * That is the packet data length, put it there
jmp rpkef * Continue on to next item
rpkc2 cmp a #$02 * Case 2 (packet number)?
bne rpkc3 * If not, try case 3
lda kerchr * Fetch the character
sec * ...
sub a #sp * Take it down to what it really is
sta pnum * That is the packet number, save it
jmp rpkef * On to the next packet item
rpkc3 cmp a #$03 * Is it case 3 (packet type)?
bne rpkc4 * If not, try next one
lda kerchr * Get the character and
sta ptype * stuff it as is into the packet type
jmp rpkef * Go on to next item
rpkc4 cmp a #$04 * Is it case 4???
bne rpkc5 * No, try last case
ldb #$00 * Set up the data index
stb datind * ...
rpkchl ldb datind * Make sure datind is in Y
cmpb pdlen * Compare to the packet data length, done?
blo rpkif3 * Not yet, process the character as data
jmp rpkef * Yes, go on to last field (chksum)
rpkif3 cmpb #$00 * Is this the first time through the data loop?
beq rpkacc * If so, SOH has been checked, skip it
jsr getplc * Get a char, find SOH
sta kerchr * Store it here
cmp a #soh * Is it an SOH again?
bne rpkacc * No, go accumulate chksum
lda #$ff * Yup, SOH, go resynch packet input once again
sta fld * ...
jmp rpkef * ...
rpkacc lda kerchr * Get the character
clc * ...
add a chksum * Add it to the chksum
sta chksum * and save new chksum
lda kerchr * Get the character again
ldy kerbf1
ldb datind * Get our current data index
sta b,y * Stuff the current character into the buffer
inc datind * Up the index once
jmp rpkchl * Go back and check if we have to do this again
rpkc5 cmp a #$05 * Last chance, is it case 5?
beq rpkc51 * Ok, continue
jmp rpkpe * Warn user about program error
rpkc51 lda chksum * Do chksum calculations
and a #$c0 * Grab bits 6 and 7
lsr a * Shift them to the right (6 times)
lsr a * ...
lsr a * ...
lsr a * ...
lsr a * ...
lsr a * ...
clc * Clear carry for addition
add a chksum * Add this into original chksum
and a #$3f * Make all of this mod decimal 64
sta chksum * and resave it
rpkef inc fld * Now increment the field switch
jmp rpklp1 * And go check the next item
rpkchk lda kerchr * Get chksum from packet
sub a #sp * Unchar it
cmp a chksum * Compare it to the one this Kermit generated
beq rpkret * We were successful, tell the caller that
lda #$06 * Store the error code
sta errcod * ...
*print to console the
* error message,packet checksum,expected checksum,crlf
ldx #err6
jsr pstr
rpkfls equ *
sta rtot * ...
lda rtot+1 * ...
add a #$00 * ...
sta rtot+1 * ...
lda #'T
sta ptype error packet type
lda #false * Set up failure return
rts * and go back
rpkret equ *
rpkrnd lda pdlen * Get the packet data length
add a rtot * 'total characters received' counter
sta rtot * ...
lda rtot+1 * ...
add a #$00 * ...
sta rtot+1 * ...
lda #true * Show a successful return
rts * and return
rpkpe equ *
* send error message to console
lda #$07 * Load error code and store in errcod
sta errcod * ...
jmp rpkfls * Go give a false return
*
* Bufill - takes characters from the file, does any neccesary quoting,
* and then puts them in the packet data buffer. It returns the size
* of the data in the AC. If the size is zero and it hit end-of-file,
* it turns on eofinp.
*
bufill lda #$00 * Zero
sta datind * the buffer index
tst filend
bne bendit
bufil1
tst lfnext
bne flfs
ldx #fcb
jsr fms read char from file
bne frder
fcrchk cmpa #cr cr from file ?
bne nchck
clr linlen
sta lfnext
nchck bra notend
bendit jmp bffchk eof detect
crsubs
lda #cr
bra fcrchk
flfs clr lfnext
lda #lf
bra notend and send it
frder lda 1,x get error state
cmpa #8
bne frder1 error
bra bffchk eof
frder1 jsr rpterr
jsr fmscls
jmp main
notend tst monito
beq notenm
jsr couts data to console
notenm sta kerchr * Got a character, save it
bffqc0 cmp a #sp * Is the character less than a space?
bhs bffqc1 * If not, try next possibility
jmp bffctl * This has to be controlified
bffqc1 cmp a #del * Is the character a del?
bne bffqc2 * If not, try something else
jmp bffctl * Controlify it
bffqc2 cmp a squote * Is it the quote character?
bne bffqc3 * If not, continue trying
jmp bffstq * It was, go stuff a quote in buffer
bffqc3
bra bffstf * Nope, just stuff the character itself
bffctl lda kerchr *[2] Get original character back
eor a #$40 * Ctl(AC)
sta kerchr * Save the character again
bffstq lda squote * Get the quote character
ldy kerbf1
ldb datind * and the index into the buffer
sta b,y * Store it in the next location
inc b * Up the data index once
stb datind * Save the index again
bffstf inc schr * Increment the data character count
bne bffsdc * ...
inc schr+1 * ...
bffsdc ldy kerbf1 * Get the saved character
lda kerchr
ldb datind * and the data index
sta b,y * This is the actual char we must store
incb * Increment the index
stb datind * And resave it
pshs b * Take this index, put it in AC
puls a
add a #$06 * Adjust it so we can see if it
cmp a spsiz * is >= spsiz-6
bhs bffret * If it is, go return
jmp bufil1 * Otherwise, go get more characters
bffret lda datind * Get the index, that will be the size
rts * Return with the buffer size in AC
bffchk lda datind * Get the data index
cmp a #$00 * Is it zero?
bne bffnes * Nope, just return
pshs a * Yes, this means the entire file has
lda #true * been transmitted so turn on
sta eofinp * the eofinp flag
puls a
bffnes sta filend
bffne rts * Return
*
* Bufemp - takes a full data buffer, handles all quoting transforms
* and writes the reconstructed data out to the file using calls to
* FPUTC.
*
bufemp lda #$00 * Zero
sta datind * the data index
bfetol lda datind * Get the data index
cmp a pdlen * Is it >= the packet data length?
blo bfemor * No, there is more to come
rts * Yes, we emptied the buffer, return
bfemor ldy kerbf1
ldb datind * Get the current buffer index
lda b,y * Fetch the character in that position
sta kerchr * Save it for the moment
bfeqc cmp a rquote * Is it the normal quote character
bne bfeout * No, pass this stuff up
inc datind * Increment the data index
ldb datind * and fetch it in the Y-reg
lda b,y * Get the next character from buffer
sta kerchr * Save it
cmp a rquote * Were we quoting a quote?
beq bfeout * Yes, nothing has to be done
lda kerchr *[2] Fetch back the original character
eor a #$40 * No, so controlify this again
sta kerchr * Resave it
bfeout lda kerchr * Get the character
tst monito
beq bfeoum
jsr couts in monitor send to screen
bfeoum
ldx #fcb
jsr fms write char
bne wder1
inc rchr * Increment the 'data characters receive' count
bne bfeou1 * ...
inc rchr+1 * ...
bfeou1 inc datind * Up the buffer index once
jmp bfetol * Return to the top of the loop
wder1 jsr rpterr
jsr fmscls
jmp main
pemsg equ * write packet contents to screen
ldx kerbf1
lda #eom
ldb pdlen
sta b,x set eof
jsr pstr string to console
rts
* Incn - increment the packet sequence number expected by this
* Kermit. Then take that number Mod $3f.
*
incn psh a * Save AC
lda n * Get the packet number
add a #$01 * Up the number by one
and a #$3f * Do this Mod $3f!
sta n * Stuff the number where it belongs
puls a * Restore the AC
rts * and return
*
* Spar - This routine loads the data buffer with the init parameters
* requested for this Kermit.
*
* Input NONE
*
* Output @Kerbf1 - Operational parameters
*
* Registers destroyed A,Y
*
spar clr b * Clear B
ldy kerbf1
stb datind *clear datind
lda rpsiz * Fetch receive packet size
add a #$20 * Characterize it
sta b,y * Stuff it in the packet buffer
inc b * Increment the buffer index
lda rtime * get the timeout interval
add a #$20 * Make that a printable character
sta b,y * and stuff it in the buffer
inc b * Advance the index
lda rpad * Get the amount of padding required
add a #$20 * Make that printable
sta b,y * Put it in the buffer
inc b * Advance index
lda rpadch * Get the padding character expected
eor a #$40 * Controlify it
sta b,y * And stuff it
inc b * Up the packet buffer index
lda reol * Get the end-of-line expected
add a #$20 * Characterize it
sta b,y * Place that next in the buffer
inc b * Advance the index
lda rquote * Get the quote character expected
sta b,y * Store it as-is last in the buffer
inc b * Advance index
lda rebq * Get eight-bit-quote character
sta b,y * Stuff it into the data area
rts
*
* Rpar - This routine sets operational parameters for the other kermit
* from the init packet data buffer.
*
* Input @Kerbf1 - Operational parameters
*
* Output Operational parameters set
*
* Registers destroyed A,Y
*
rpar ldy kerbf1 * Start the data index at 0!
clr b
lda b,y * Start grabbing data from packet buffer
sub a #$20 * ...
sta spsiz * That must be the packet size of other Kermit
inc b * Increment the buffer index
lda b,y * Get the next item
sub a #$20 * Uncharacterize that
sta stime * Other Kermit's timeout interval
inc b * Up the index once again
lda b,y * Get next char
sub a #$20 * Restore to original value
sta spad * This is the amount of padding he wants
inc b * Advnace index
lda b,y * Next item
eor a #$40 * Uncontrolify this one
sta spadch * That is padding character for other Kermit
inc b * Advance index
lda b,y * Get next item of data
cmp a #$00 * If it is equal to zero
beq rpar2 * Use <cr> as a default
jmp rpar3 * ...
rpar2 lda #cr * Get value of <cr>
sta seol * That will be the eol character
jmp rpar4 * Continue
rpar3 sec * ...
sub a #$20 * unchar the character
sta seol * That is the eol character other Kermit wants
rpar4 inc b * Advance the buffer index
lda b,y * Get quoting character
cmp a #$00 * If that is zero
beq rpar5 * Use # sign as the qoute character
jmp rpar6 * Otherwise, give him what he wants
rpar5 lda #'# * Load # sign
rpar6 sta squote * Make that the other Kermit's quote character
inc b * Advance the index
lda b,y * Get 8-bit-quoting character
sta sebq * Store it - a higher level routine will work
* out how to use it
rts * Return
*
* Nakit - sends a standard NAK packet out to the other Kermit.
*
* Input NONE
*
* Output NONE
*
nakit lda #$00 * Zero the packet data length
sta pdlen * ...
lda #'N * Set up a nak packet type
sta ptype * ...
jsr spak * Now, send it
rts * Return
STTL End of Kermit-65 Source
end start