Columbia Kermit/kermit.zip/flex1/flxpt4.txt

Text File | 2020-01-01 | 23KB | 518 lines

 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