Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / c / flex.asm < prev next >

Wrap

Assembly Source File | 2020-01-01 | 81KB | 2,103 lines

*kermit for flex 9 system * * by d j rowland *Brighton Polytechnic Computer centre *Watts building *Lewes rd. * Brighton *Sussex * England *From: <BENDALL%DHDEMBL5.BITNET@wiscvm.wisc.edu> *Organisation: European Molecular Biology Laboratory *Postal-Address: Meyerhofstrasse 1, 6900 Heidelberg, W. Germany *Phone: (6221)387-0 [switchboard] *Subject: 6809 flex kermit source code *tel. +44 273 693655 x2163 *This program is a very basic kermit , the basic 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! *its a simple timing loop round the rcv data subr. *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 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 w hat 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 ac k 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. stat e 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 0$ * Check against packet data length, done? blo spakdc * Not yet, process another character jmp spakch * Go do chksum calculations spakdg 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