.TITLE KERMIT-65 KL10 Error-free Reciprocol Micro-interface Transfer .SBTTL 6502 version - Antonino N. J. Mione ; Version 1.0 ; Based on the KERMIT Protocol. .SBTTL Define start address for assembly .=$800 ; Start assembly at hex 800 .SBTTL Revision History ; ; Edit # Description ; ------ ----------- ; ; ; 1 By: Antonino N.J. Mione On: 26-APR-1983 ; Fix I/O hooks so that Kermit-65 may be BRUN ; instead of requiring that it be BLOADED and then ; executed. ; ; ; 2 By: Antonino N.J. Mione On: 26-APR-1983 ; Make quoting work for characters with parity bit on. ; ; ; 3 By: Antonino N.J. Mione On: 04-MAY-1983 ; Make Kermit write last buffer on receive. Do this ; by making sure AC is zero on entry to 'Closef' so ; 'Closef' knows that there were no errors. Also, ; put address of buffer into the right place in the ; file manager parameter list. ; ; ; nnn By: xxxxxxxx xxxxxxxx On: nn-XXX-19nn ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; ;+ .SBTTL Jump to start of code kst: jmp kstart ; Go past the data to the beginning of the code .SBTTL Feature test definitions ; Machines ftappl = $01 ; Apple (under DOS 3.3) ; Communication devices ftaser = $01 ; Apple serial communications board fthays = $02 ; D.C. Hayes modem .SBTTL Kermit feature test options ftcom = ftappl ; Assemble for Apple ][ under DOS 3.3 ftcdev = ftaser ; Assemble for Apple communications board .SBTTL Additional definitions kerslo = $c200 ; Slot rom address (default slot is 2) kercsr = kerslo^ ; High order byte address of comm card rom kercsi = *16-$0c00 ; Communication card slot index .ifeq .SBTTL Apple monitor support rdkey = $fd0c ; Routine - Read a char from curr input device keyin = $fd1b ; Routine - Read a char from keyboard cout = $fded ; Routine - Print char in AC cout1 = $fdf0 ; Routine - Print char in AC to screen setio1 = $fe89 ;[1] Routine - take I/O control away from DOS setio2 = $fe93 ;[1] Routine - ... prbl2 = $f94a ; Routine - Print (X) spaces prbl3 = $f94c ; Routine - Print char in AC and (X)-1 spaces prbyte = $fdda ; Routine - Print A-reg as 2 hex nibbles prntyx = $f940 ; Routine - Print hex of y,x regs prntax = $f941 ; Routine - Print hex of a,x regs scrl3 = $fc95 ; Routine - Clear entire current line bell = $ff3a ; Routine - Sound bell home = $fc58 ; Routine - Home cursor and clr screen lfeed = $fc66 ; Routine - Output a line-feed to screen upline = $fc1a ; Routine - Go up one line if possible advanc = $fbf4 ; Routine - Go forward (right) one character bsp = $fc10 ; Routine - Go back (left) one character clreol = $fc9c ; Routine - Clear from cursor to end of line clreop = $fc42 ; Routine - Clear from cursor to end of page clreoz = $fc9e ; Routine - Clear current line vtab = $fc22 ; Routine - calculate base addr of line CV vtabz = $fc24 ; Routine - calculate base addr of line in AC dos = $03d0 ; Dos entry point kbd = $c000 ; Keyboard character input location kbdstr = $c010 ; Keyboard strobe location slot = $c200 ;[0] Address of slot I/O driver ; ; These are some monitor scratch areas that may be needed ; a1l = $3c a1h = $3d a2l = $3e a2h = $3f a3l = $40 a3h = $41 a4l = $42 a4h = $43 a5l = $44 a5h = $45 .endc .SBTTL Character and string definitions nul = $00 ; soh = $01 ; bs = $08 ; tab = $09 ; (ctrl/I) lf = $0a ; ffd = $0c ; Form feed cr = $0d ; ctrlu = $15 ; ctrlx = $18 ;[0] esc = $1b ; sp = $20 ; del = $7f ; hbs = $88 ; with H.O. bit on htab = $89 ; with H.O. bit on hcr = $8d ; with H.O. bit on hlf = $8a ; with H.O. bit on hffd = $8c ; wiht H.O. bit on hctrlu = $95 ; with H.O. bit on hctrlx = $98 ;[0] with H.O. bit on hesc = $9b ; with H.O. bit on hspace = $a0 ; with H.O. bit on hquest = $bf ; '?' with H.O. bit on hdel = $ff ; with H.O. bit on .ifeq wndlft = $20 ; Left side of scroll window <0-39> wndwth = $21 ; Width of scroll window <1-(40-(wndlft)> wndtop = $22 ; Top of scroll window <0-22> wndbtm = $23 ; Bottom of scroll window <((wintop)+1)-24> ch = $24 ; Cursor Horizontal position cv = $25 ; Cursor Vertical position basl = $26 ; L.O. byte of base address of current line bash = $27 ; H.O. byte of base address of current line bas2l = $2a ; Base address work area bas2h = $2b ; Base address work area .endc .SBTTL Parse types ; The following are different items to parse for cmini = 0 ; Token to indicate parser init cmkey = 1 ; Token to parse for keyword cmifi = 2 ; Token to parse for input file cmofi = 3 ; Token to parse for output file cmcfm = 4 ; Token to parse for confirm cmnum = 5 ; Token to parse for a number cmswi = 6 ; Token to parse for a switch cmfls = 7 ; Token to parse for a floating-point number .SBTTL Parser support ; Define storage for pointers into command buffer. They must be ; on zero-page to take advantage of pre- and post-indexed indirect ; and also the simulated indirect addressing mode. saddr = $00 ; Saved string address - must be on page zero cm.rty = $02 ; Byte pointer to CTRL/R Text cm.bfp = $04 ; Byte pointer to start of text buffer cm.ptr = $06 ; Byte pointer to Next Input to be parsed cm.inc = $08 ; Number of characters left in buffer cm.cnt = $09 ; Space left in buffer cminf1 = $0a ; Information passed to comnd routines cminf2 = $0c ; ... cmkptr = $0e ; Pointer for Cmkeyw routine cmsptr = $10 ; Saved character pointer cmspt2 = $12 ; Saved keyword table pointer cmspt3 = $14 ; Saved buffer pointer cmhptr = $16 ; Ptr. to current help text cmptab = $18 ; Ptr. to beginning of current keyword table cmfcb = $1a ; Pointer to FCB cmfcb2 = $1c ; Pointer into FCB .SBTTL COMND JSYS routines ; ; The following set of routines provides a user oriented way of parsing ; commands. It is similar to that of the COMND JSYS in TOPS-20. For ; convenience, a dispatch table is used. ; comnd: jmp comand ; Dispatch to main command routine jmp mul16 ; Dispatch to 16-bit multiply routine .SBTTL Character and string definitions crlf: .byte $8d,$8a,$00 ; String with .SBTTL Macro definitions .macro nasc str opt .irpc chr .byte ''chr!$80 .endr .ifnz .byte nul .endc .endm cmbuf: .blkb $80 ; Input command buffer prmt: nasc 0 ; Prompting text .byte $80!'> ; Kludge to add '>' to prompt .byte $00 ; End of kludge lprmt = .-prmt ; Length of prompting text savea: .byte ; savex: .byte ; savey: .byte ; cmbase: .byte ; Base of integer to be parsed cmmres: .blkb 4 ; Return value from cmmult call cmintg: .blkb 4 ; Return value for cminum call cmfltp: .blkb 6 ; Return value for cmflot call cmflen: .byte ; Field length cmcdrv: .byte ; Current drive cmostp: .word ; Save area for stack pointer cmrprs: .word ; Reparse address cmaflg: .byte ; Non-zero when an action char has been found cmccnt: .byte ; Non-zero if a significant char is found cmsflg: .byte ; Non-zero when the last char was a space cmstat: .byte ; Save area for parse type cmkyln: .byte ; Keyword length cmtlen: .byte ; Test length (for ?-prompting) cmscrs: .byte ; Screen output switch cmentr: .byte ; Number of remaining entries in table keylen: .byte ; Keyword length cmwrk1: .byte ; Command processing scratch area cmwrk2: .byte ; ... cmwrk3: .byte ; ... cmwrk4: .byte ; ... hch: .byte ; Hold area for ch hcv: .byte ; Hold area for cv .SBTTL Symbol definitions true = $01 ; Symbol for true return code false = $00 ; Symbol for false return code on = $01 ; Symbol for value of 'on' keyword off = $00 ; Symbol for value of 'off' keyword yes = $01 ; Symbol for value of 'yes' keyword no = $00 ; Symbol for value of 'no' keyword .SBTTL Prompt subroutine ; ; This routine prints the prompt for the program and specifies the ; reparse address. ; ; Inputs: ; ; Outputs: ; ; Registers destroyed: A,X,Y ; prompt: pla ; Get Low order byte of return address sta cmrprs ; Save that half of reparse address pla ; Get High order byte sta cmrprs+1 ; Save the half pha ; Restore the return lda cmrprs ; address to pha ; the stack clc ; Clear the carry adc #$01 ; Increment this address since it is one sta cmrprs ; short of the desired target. lda cmrprs+1 ; Account for the carry, if any adc #$00 ; ... sta cmrprs+1 ; ... tsx ; Get the stack pointer stx cmostp ; Save it for later restoral lda #prmt\ ; Save the address sta cm.rty ; of the prompt in lda #prmt^ ; the pointer to the sta cm.rty+1 ; ctrl/r text lda #cmbuf\ ; Get Low order byte of buffer address sta cm.bfp ; Init start of text buffer sta cm.ptr ; Init next input to be parsed lda #cmbuf^ ; Get High order byte of buffer address sta cm.bfp+1 ; H.O. byte of text buffer pointer sta cm.ptr+1 ; H.O. byte of next input pointer lda #$00 ; Clear AC sta cmaflg ; Clear the flags sta cmccnt ; sta cmsflg ; jsr prcrlf ; Print crlf ldx cm.rty ; Get L.O. byte of prompt address to be passed ldy cm.rty+1 ; Get H.O. byte of prompt address jsr prstr ; Print the prompt rts ; Return .SBTTL Repars routine ; ; This routine sets stuff up to reparse the current command ; buffer. ; ; Input: ; ; Output: Reinitialize comnd pointers and flags ; ; Registers destroyed: A,X ; repars: ldx cmostp ; Fetch old Stack pointer txs ; Make it the current one lda #cmbuf\ ; Get L.O. byte address of cmbuf sta cm.ptr ; Stuff it lda #cmbuf^ ; Get H.O. byte address of cmbuf sta cm.ptr+1 ; The buffer pointer is now reset lda #$00 ; Clear AC sta cmsflg ; Clear the space flag jmp (cmrprs) ; Jump at the reparse address .SBTTL Prserr routine ; ; This routine is used when a parsing error occurs. It resets ALL ; of the pointers and flags and then goes to the reparse address. ; ; Input: ; ; Output: ; ; Registers destroyed: ; Prserr: ldx cmostp ; Fetch the saved SP txs ; Make it the current one lda #cmbuf\ ; Set up the command buffer sta cm.bfp ; address in both the sta cm.ptr ; buffer pointer and the lda #cmbuf^ ; next input pointer. sta cm.bfp+1 ; ... sta cm.ptr+1 ; ... lda #$00 ; Clear AC sta cmaflg ; Zero the action flag sta cmccnt ; the character count sta cmsflg ; and the space flag jsr prcrlf ; Print a crelf ldx #prmt\ ; Get the address of the prompt ldy #prmt^ ; ... jsr prstr ; Reprint the prompt jmp (cmrprs) ; Jump at the reparse address .SBTTL COMND - Entry point for command Jsys stuff ; ; COMND routine - This routine checks the code in the AC for ; what parse type is wanted and then dispatches to an appropriate ; routine to look for it. Additional information is located in ; CMINF1 and CMINF2 on page zero. ; ; Input: A - parse type ; ; Output: A - +1 = success ; +4 = failure (assumes JMP after call) ; ; Registers destroyed: A ; comand: sta cmstat ; Save what we are parsing cmp #cmini ; Initialize the world? bne comn0 ; No, handle like a normal parse type jmp prompt ; Do the prompt routine to set things up comn0: jsr cminbf ; Get characters until action or erase cmp #cmcfm ; Parse a confirm? bne comn1 ; Nope jmp cmcfrm ; Yes, try for the confirm comn1: cmp #cmkey ; Parse a keyword perhaps? bne comn2 ; No, next item jmp cmkeyw ; Get the keyword comn2: cmp #cmifi ; Parse an input file? bne comn3 ; No, try next one jmp cmifil ; Get the input file comn3: cmp #cmofi ; Parse an output file? bne comn4 ; No, try next jmp cmofil ; Get the output file comn4: cmp #cmswi ; Parse a switch? bne comn5 ; No, try next again jmp cmswit ; Yes, do a switch comn5: cmp #cmnum ; Parse an integer? bne comn6 ; No, try next type jmp cminum ; Do the parse integer routine comn6: cmp #cmfls ; Parse a floating point????? bne comn7 ; Nope, thats it for types jmp cmflot ; Yes, go get a floating point number comn7: ldx #cmer00\ ; Error 0 - Bad parse type ldy #cmer00^ ; ... jsr prstr ; Print the error text lda #$04 ; Fail rts ; Return to caller .SBTTL Cmcfrm routine - get a confirm ; ; This routine tries to get a confirm from the command input ; buffer. ; ; Input: Cm.ptr - Beginning of next field to be parsed ; ; Output: On success, routine skip returns ; ; Registers destroyed: A,X,Y ; cmcfrm: lda cm.ptr ; Save the current command line pointer pha ; on the stack in case the user lda cm.ptr+1 ; wants to parse for an alternate item pha ; ... cmcfr0: jsr cmgtch ; Get a character cmp #$00 ; Is it negative? bpl cmcfrr ; No, fail and #$7f ; Yes, zero the sign bit cmp #esc ; An escape? bne cmcfr2 ; No, continue jsr bell ; Sound bell, error... lda #$00 ; Clear AC sta cmaflg ; Clear the action flag sec ; Set carry for subtraction lda cm.bfp ; Get L.O. byte sbc #$01 ; Decrement it once sta cm.bfp ; Store it back sta cm.ptr ; Make this pointer look like the other one bcs cmcfr1 ; If set, we don't have to do H.O. byte dec cm.bfp+1 ; Adjust H.O. byte cmcfr1: lda cm.bfp+1 ; Move this to H.O. byte of the other pointer sta cm.ptr+1 ; ... dec cmccnt ; Decrement the character count jmp cmcfr0 ; Try again. cmcfr2: cmp #'? ; User need help?? bne cmcfr3 ; Nope ora #$80 ; Make sure this is negative ascii jsr cout ; Print the '?' ldx #cmin00\ ; Get address of some help info ldy #cmin00^ ; ... jsr prstr ; Print it. jsr prcrlf ; Print the crelf ldx #prmt\ ; Get address of prompt ldy #prmt^ ; reprint it jsr prstr ; Reprint the prompt lda #$00 ; Clear AC ldy #$00 ; Clear Y sta (cm.ptr),y ; Drop null at end of command buffer sec ; Set carry for subtraction lda cm.bfp ; Get L.O. byte sbc #$01 ; Decrement it sta cm.bfp ; Store it back lda cm.bfp+1 ; Now do H.O. byte sbc #$00 ; ... sta cm.bfp+1 ; ... ldx #cmbuf\ ; Get address of the command buffer ldy #cmbuf^ ; ... jsr prstr ; Reprint the command line lda #$00 ; Clear AC sta cmaflg ; Action flag off jmp repars ; Go reparse the line cmcfr3: cmp #ffd ; Is it a form feed? bne cmcfr4 ; Nope jsr home ; Yes, blank the screen cmcfr4: pla ; Since this succeeded, we can flush the pla ; old command line pointer jmp rskp ; Do a return skip cmcfrr: pla ; Restore the old comand line pointer sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... rts ; Return .SBTTL Cmkeyw - Try to parse a keyword next ; ; This routine tries to parse a keyword from the table ; pointed to by cminf1. The keywords must be in alphabetical ; order. The routine returns the two bytes of data associated ; with the keyword. The format of the table is as follows: ; ; addr: .byte n ; Where n is the # of entries in the table. ; .byte m ; m is the size of the next keyword ; .asciz /string/; keyword ending in a null ; .byte a,b ; 16 bits of data related to keyword ; ; Input: Cminf1- Pointer to keyword table ; ; Output: X- byte a ; Y- byte b ; ; Registers destroyed: A,X,Y ; cmkeyw: lda cm.ptr ; Save current comand line pointer pha ; ... lda cm.ptr+1 ; ... pha ; ... lda cminf1 ; Copy to address of sta cmptab ; the keyword table clc ; Clear the carry adc #$01 ; Add one to the addr. (pass the table length) sta cmkptr ; Save the keyword pointer (L.O. byte) lda cminf1+1 ; Get H.O. byte sta cmptab+1 ; Save a copy of that bcc cmkey1 ; Carry? adc #$00 ; Add in the carry for cmkptr cmkey1: sta cmkptr+1 ; Save it ldy #$00 ; Clear Y lda (cmptab),y ; Get the table length sta cmentr ; Save number of entries in the table jsr cmgtch ; Get first character cmp #$00 ; Was the first character a terminator? bmi cmky11 ; Yup, the saved pointer does not get decr. sec ; Make sure saved buffer pointer is correct lda cm.ptr ; Now, reset it back one character for later sbc #$01 ; ... sta cm.ptr ; ... sta cmsptr ; ... lda cm.ptr+1 ; ... sbc #$00 ; ... sta cm.ptr+1 ; ... sta cmsptr+1 ; ... jmp cmkey2 ; Continue cmky11: lda cm.ptr ; Just move the pointer to the save area sta cmsptr ; ... lda cm.ptr+1 ; ... sta cmsptr+1 ; ... cmkey2: lda cmentr ; Get number of entries left cmp #$00 ; 0 entries left? bne cmky21 ; No, go try next entry pla ; Fetch back to previous comand line pointer sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... rts cmky21: ldy #$00 ; Clear Y lda (cmkptr),y ; Get length of keyword sta keylen ; Store it lda cmkptr ; Get the new table pointer sta cmspt2 ; and save it for later lda cmkptr+1 ; ... sta cmspt2+1 ; ... inc cmkptr ; Increment the L.O. byte once bne cmkey3 ; If it didn't wrap, there is no carry inc cmkptr+1 ; There was a carry, add it in. cmkey3: dec keylen ; Decrement the number of chars. left lda keylen ; Get the remaining length cmp #$ff ; Have we passed the end bpl cmk3a ; No jmp cmkey5 ; Yes cmk3a: jsr cmgtch ; Get a character cmp #$00 ; Is it a terminator? bmi cmk3b ; Yup, it is negative jmp cmkey4 ; Nope, it's positive cmk3b: and #$7f ; Shut off the minus bit cmp #'? ; Need any help? bne cmky31 ; Nope ora #$80 ; Set the H.O. bit jsr cout ; And print the question mark lda #$00 ; Clear AC sta cmaflg ; Clear the action flag lda cmstat ; Get saved parse type cmp #cmswi ; Are we really doing a switch? beq cmk3b1 ; Yes, give that message instead ldx #cmin01\ ; L.O. byte addr of informational message ldy #cmin01^ ; H.O. byte of address jmp cmk3b2 ; Go print the message cmk3b1: ldx #cmin02\ ; Load address of switch message ldy #cmin02^ ; ... cmk3b2: jsr prstr ; Print the message jsr prcrlf ; Print a crelf jsr cmktp ; and the valid entries in keyword table jsr prcrlf ; Print another crlf ldx #prmt\ ; Get L.O. address of prompt ldy #prmt^ ; And H.O. address of prompt jsr prstr ; Reprint the prompt lda #$00 ; Clear AC ldy #$00 ; Clear Y sta (cm.ptr),y ; Stuff a null in the buffer at that point sec ; Set the carry lda cm.bfp ; Get ready to decrement buffer pointer sbc #$01 ; Subtract it sta cm.bfp ; Store it bcs cmky3a ; Do we have to account for carry dec cm.bfp+1 ; Decrement the H.O. byte cmky3a: ldx #cmbuf\ ; Get L.O. byte address of buffer ldy #cmbuf^ ; and H.O. byte jsr prstr ; Reprint the command line jmp repars ; Go reparse all of it cmky31: cmp #esc ; escape character? beq cmk3c ; Yup, process it jmp cmky35 ; Nope. cmk3c: lda #$00 ; Clear AC sta cmaflg ; Clear action flag lda keylen ; Save on the stack, the pha ; keylength lda cmentr ; number of entries left pha ; ... lda cmkptr ; L.O. byte of keyword table pointer pha ; ... lda cmkptr+1 ; H.O. byte of keyword table pointer pha ; ... jsr cmambg ; Is it ambiguous? jmp cmky32 ; Nope jsr bell ; Yes, start by feeping terminal sec ; Set the carry bit for subtraction lda cm.bfp ; Take L.O. byte of buffer pointer sbc #$01 ; Decrement it (back up before escape) sta cm.bfp ; Store it sta cm.ptr ; And stuff it in next input char pointer bcs cmky3b ; If carry is clear, we are done dec cm.bfp+1 ; Do the carry on H.O. byte cmky3b: lda cm.bfp+1 ; Copy this to the next char to parse pointer sta cm.ptr+1 ; ... dec cmccnt ; Decrement the character count pla ; Restore the sta cmkptr+1 ; H.O. byte of keyword table pointer pla ; ... sta cmkptr ; L.O. byte of keyword table pointer pla ; ... sta cmentr ; Number of entries left in table pla ; ... sta keylen ; And the remaining keylength inc keylen ; Adjust the keylength to make it correct jmp cmkey3 ; And go back to try again cmky32: ldy #$00 ; Clear Y sec ; Set the carry flag lda cm.bfp ; Move buffer pointer behind the escape sbc #$01 ; ... sta cm.bfp ; ... sta cm.ptr ; ... bcs cmk32c ; ... dec cm.bfp+1 ; Have to adjust the H.O. byte cmk32c: lda cm.bfp+1 ; ... sta cm.ptr+1 ; ... pla ; Fetch the old keytable pointer sta cmkptr+1 ; ... pla ; ... sta cmkptr ; ... pha ; Now push it back on the stack lda cmkptr+1 ; ... pha ; ... cmky33: lda (cmkptr),y ; Get next character cmp #$00 ; Done? beq cmky34 ; Yes tax ; No, hold on to the byte clc ; Clear the carry flag lda cmkptr ; Adjust the keyword pointer up one place adc #$01 ; Do L.O. byte sta cmkptr ; Store it bcc cmky3c ; Carry? inc cmkptr+1 ; Yes, increment H.O. byte cmky3c: txa ; Get the data ora #$80 ; Make sure H.O. bit is set for consistency sta (cm.ptr),y ; Stuff it in the buffer clc ; Clear the carry flag again lda cm.ptr ; Get L.O byte of buffer pointer adc #$01 ; Increment it sta cm.ptr ; Store it bcc cmky3d ; Carry? inc cm.ptr+1 ; Increment H.O. byte cmky3d: inc cmccnt ; Increment character count jmp cmky33 ; Get next character from table cmky34: inc cmccnt ; Incrment the character count lda #$a0 ; Clear AC sta (cm.ptr),y ; Stuff a null in the buffer ldx cm.bfp ; Get L.O. byte of buffer pointer ldy cm.bfp+1 ; and H.O byte - save these for later clc ; Clear carry lda cm.ptr ; Increment next char of input pointer adc #$01 ; ... sta cm.ptr ; ... sta cm.bfp ; ... bcc cmky3e ; Carry? inc cm.ptr+1 ; Do H.O. byte cmky3e: lda cm.ptr+1 ; Make buffer pointer match next char pointer sta cm.bfp+1 ; ... sty savey ; Hold y for a bit lda #$00 ; Put a null in the buffer to terminate string ldy #$00 ; ... sta (cm.ptr),y ; ... ldy savey ; Get Y value back jsr prstr ; Print remainder of keyword pla ; Restore the sta cmkptr+1 ; H.O. byte of keyword table pointer pla ; ... sta cmkptr ; L.O. byte of keyword table pointer pla ; ... sta cmentr ; Number of entries left in table pla ; ... sta keylen ; And the remaining keylength jmp cmky37 ; Go get some data to return cmky35: lda cmkptr ; Save on the stack the pha ; L.O. byte of keyword table pointer lda cmkptr+1 ; ... pha ; H.O. byte of keyword table pointer lda keylen ; ... pha ; The keylength jsr cmambg ; Check for ambiguity jmp cmky36 ; Not ambiguous ldx #cmer01\ ; Get addr of ambiguous error ldy #cmer01^ ; ... jsr prstr ; Print the error message jmp prserr ; Go do parsing error stuff cmky36: pla ; Fetch off of the stack the sta keylen ; remaining keylength pla ; ... sta cmkptr+1 ; H.O. byte of keyword table address pla ; ... sta cmkptr ; L.O. byte of keyword table address cmky37: inc keylen ; Adjust the remaining keylength inc keylen ; ... clc ; Clear the carry flag lda cmkptr ; Get the keyword table pointer adc keylen ; Add in remaining keylength sta cmkptr ; Store it bcc cmky3f ; Carry? inc cmkptr+1 ; Yes, adjust H.O. byte cmky3f: ldy #$00 ; Make sure Y is clear lda (cmkptr),y ; Get first data byte tax ; Put it in X iny ; Up the index once lda (cmkptr),y ; Get the second data byte tay ; Put that in Y pla ; Flush the old comand line pointer pla ; ... jmp rskp ; Return skip means it succeeds! cmkey4: cmp #'a ; Check range for lower case bmi cmky41 ; ... cmp #<'z+1> ; ... bpl cmky41 ; ... and #^o137 ; Cutesy way to capitalize it cmky41: sta cmwrk3 ; Save the character ldy #$00 ; Clear Y again lda (cmkptr),y ; Get next keyword byte sta cmwrk4 ; Hold that for now clc ; Clear the carry flag lda cmkptr ; Get L.O. byte of keyword pointer adc #$01 ; Add one sta cmkptr ; Store it bcc cmky4a ; Need to do carry? inc cmkptr+1 ; Yes, do H.O. byte cmky4a: lda cmwrk3 ; Get input character cmp cmwrk4 ; Does it match keyword character? bne cmkey5 ; No, advance to next keyword in table jmp cmkey3 ; Yup, try next input byte cmkey5: inc keylen ; Adjust keylength so that it is correct inc keylen ; ... inc keylen ; ... clc ; Clear carry lda cmkptr ; Ok, get keyword pointer and adc keylen ; Add the remaining keylength sta cmkptr ; Store it bcc cmky5a ; See if we have to do carry inc cmkptr+1 ; Yes, increment H.O. byte cmky5a: dec cmentr ; Decrement the number of entries left lda cmsptr ; Get the saved buffer pointer and sta cm.ptr ; restore it lda cmsptr+1 ; ... sta cm.ptr+1 ; ... jmp cmkey2 ; Try to parse this keyword now .SBTTL Cmambg - check if keyword prefix is ambiguous ; ; This routine looks at the next keyword in the table and ; determines if the prefix entered in the buffer is ambiguous ; or not. If it is ambiguous, it skip returns, otherwise it ; returns normally. ; ; Input: Cmentr- number of entries left in table ; Cmkptr- current keyword table pointer ; Keylen- remaining keyword length ; ; Output: If ambiguous, does a skip return ; ; Registers destroyed: A,X,Y ; cmambg: dec cmentr ; Start by decrementing remaining entries bpl cma1 ; We still have stuff left rts ; Nothing left, it can't be ambiguous cma1: inc keylen ; Adjust this up by one lda keylen ; Save character count sta cmwrk3 ; ... clc ; Clear the carry adc #$03 ; Adjust the keylength to include terminator sta keylen ; and data bytes clc ; Clear carry lda cmkptr ; Up the keyword table pointer adc keylen ; by remaining keylength sta cmkptr ; Save it bcc cma2 ; Need to adjust H.O byte? inc cmkptr+1 ; Yes, do it cma2: ldy #$00 ; Clear Y lda (cmkptr),y ; Get keyword length sta cmwrk4 ; Hold that byte clc ; Clear carry lda cmkptr ; Advance keyword table pointer adc #$01 ; ... sta cmkptr ; ... bcc cma3 ; ... inc cmkptr+1 ; ... cma3: lda (cmspt2),y ; Get previous keyword length sec ; Set carry sbc cmwrk3 ; Subtract number of characters left sta cmtlen ; This is the testing length cmp cmwrk4 ; Check this against length of new keyword bmi cmamb0 ; This may be ambiguous rts ; Test length is longer, cannot be ambiguous cmamb0: ldy #$00 ; Clear Y cmamb1: dec cmtlen ; Decrement the length to test bpl cma4 ; Still characters left to check jmp rskp ; The whole thing matched, it is ambiguous cma4: lda (cmkptr),y ; Get next character of keyword sta cmwrk3 ; Hold that for now lda (cmsptr),y ; Get next parsed character iny ; Up the pointer once cmp #'a ; Check the range for lower case bmi cmamb2 ; ... cmp #<'z+1> ; ... bpl cmamb2 ; ... and #^o137 ; Capitalize it cmamb2: and #$7f ; Reset H.O. bit cmp cmwrk3 ; Same as keyword table character beq cmamb1 ; Yup, check next character rts ; Nope, prefix is not ambiguous .SBTTL Cmktp - print entries in keyword table matching prefix ; ; This routine steps through the keyword table passed to cmkeyw ; and prints all the keywords with the prefix currently in the ; command buffer. If there is no prefix, it issues an error. ; ; Input: Cmptab- ptr to beginning of table ; Cmsptr- saved buffer pointer ; Cm.ptr- current buffer pointer ; ; Output: List of possible keywords to screen ; ; Registers destroyed: A,X,Y ; cmktp: lda cmptab ; Get a copy of the pointer sta cminf2 ; to the beginning of lda cmptab+1 ; the current keyword table sta cminf2+1 ; ... ldy #$00 ; Clear Y sty cmscrs ; Clear the 'which half of screen' switch sty cmwrk3 ; Clear the 'print any keywords?' switch lda (cminf2),y ; Get the table length sta cmwrk1 ; and save it in a safe place sec ; Prepare for some subtracting lda cm.ptr ; Get difference between the current pointer sbc cmsptr ; and pointer to beginning of keyword sta cmtlen ; That is how much we must test clc ; Clear carry lda cminf2 ; Increment the pointer to the table adc #$01 ; ... sta cminf2 ; ... bcc cmktp1 ; Need to increment H.O. byte? inc cminf2+1 ; Yup cmktp1: dec cmwrk1 ; 1 less keyword to do lda cmwrk1 ; Now... bmi cmkdon ; No keywords left, we are done lda (cminf2),y ; Get the keyword length sta cmkyln ; and stuff it clc ; Clear carry lda cminf2 ; Increment pointer to table again adc #$01 ; ... sta cminf2 ; ... bcc cmktp2 ; Need to up the H.O. byte? inc cminf2+1 ; Yup cmktp2: lda cmtlen ; Get test length beq cmktp3 ; If test length is zero, just print keyword cmkp21: lda (cminf2),y ; Get character from table ora #$80 ; Set the H.O. bit so the compare works cmp (cmsptr),y ; Compare it to the buffer character bne cmadk ; Nope, advance to next keyword iny ; Up the index cpy cmtlen ; Compare with the test length bmi cmkp21 ; Not yet, do next character cmktp3: jsr cmprk ; Print the keyword cmadk: inc cmkyln ; Adjust cmkyln to include terminator and data inc cmkyln ; ... inc cmkyln ; ... clc ; Clear the carry lda cminf2 ; Get the L.O. byte adc cmkyln ; Add in the keyword length sta cminf2 ; Store it away bcc cmadk2 ; Need to do the H.O. byte? inc cminf2+1 ; Yup cmadk2: ldy #$00 ; Zero the index jmp cmktp1 ; Go back to the top of the loop cmkdon: lda cmwrk3 ; See if we printed anything bne cmkdn2 ; Yup, go exit lda cmstat ; Are we parsing switches or keywords? cmp #cmswi ; ... beq cmkdse ; The error should be for switches ldx #cmer03\ ; Nope, get address of error message ldy #cmer03^ ; ... jmp cmkdn1 ; Go print the message now cmkdse: ldx #cmer04\ ; Get address of switch error message ldy #cmer04^ ; ... cmkdn1: jsr prstr ; Print error jsr prcrlf ; Print a crelf cmkdn2: lda cmscrs ; Where did we end up? beq cmkdn3 ; Beginning of line, good jsr prcrlf ; Print a crelf cmkdn3: rts ; Return ; ; Cmprk - prints one keyword from the table. Consults the ; cmscrs switch to see which half of the line it ; is going to and acts accordingly. ; ; Input: Cmscrs- Which half of screen ; Cminf2- Pointer to string to print ; ; Output: print keyword on screen ; ; Registers destroyed: A,X,Y ; cmprk: lda #on ; Make sure to tell them we printed something sta cmwrk3 ; Put it back lda cmstat ; Get saved parse type cmp #cmswi ; Is it a switch we are looking for? bne cmpr2 ; No... lda #'/ ; Yes, do not forget slash prefix ora #$80 ; Make sure it is negative ascii jsr cout ; Print slash cmpr2: ldx cminf2 ; L.O. byte of string pointer ldy cminf2+1 ; H.O. byte of string pointer jsr prstr ; Print the keyword lda cmscrs ; Where were we? bne cmprms ; Mid screen jsr clreol ; Clear to end of line lda #$14 ; Advance cursor to middle of screen sta ch ; ... jmp cmprdn ; We are done cmprms: jsr prcrlf ; Print a crelf cmprdn: lda cmscrs ; Flip the switch now eor #$01 ; ... sta cmscrs ; Stuff it back rts ; Return .SBTTL Cmswit - try to parse a switch next ; ; This routine tries to parse a switch from the command buffer. It ; first looks for the / and then calls cmkeyw to handle the keyword ; lookup. ; ; Input: Cminf1- Address of keyword table ; ; Output: X- byte a ; Y- byte b ; ; Registers destroyed: A,X,Y ; cmswit: lda cm.ptr ; Save old comand line pointer in case the pha ; user wants to try another item lda cm.ptr+1 ; ... pha ; ... cmswi0: jsr cmgtch ; Go get a character cmp #$00 ; Action? bmi cmswi1 ; Yes, process it jmp cmswi3 ; No, it is a real character cmswi1: and #$7f ; Turn off the minus cmp #'? ; Does the user need help? bne cmsw12 ; No ora #$80 ; Set the H.O. bit jsr cout ; And print the question mark lda #$00 ; Clear AC sta cmaflg ; Clear Action flag ldx #cmin02\ ; Low order byte addr of info message ldy #cmin02^ ; High order byte addr of info message jsr prstr ; Print the message jsr prcrlf ; Print a crelf jsr cmktp ; Any valid entries from keyword table jsr prcrlf ; And another crelf ldx #prmt\ ; Load ldy #prmt^ ; the address of the prompt jsr prstr ; Reprint it lda #$00 ; Clear AC ldy #$00 ; Clear Y sta (cm.ptr),y ; Stuff a null at the end of the buffer sec ; Set the carry flag lda cm.bfp ; Increment buffer pointer sbc #$01 ; ... sta cm.bfp ; ... bcs cmsw1a ; Borrow? dec cm.bfp+1 ; Yup cmsw1a: ldx #cmbuf\ ; L.O. byte addr of command buffer ldy #cmbuf^ ; H.O. byte jsr prstr ; Reprint the command line jmp repars ; Go reparse everything cmsw12: cmp #esc ; Lazy?? beq cmsw2a ; Yes, try to help jmp cmswi2 ; No, this is something else cmsw2a: lda #$00 ; Clear AC sta cmaflg ; Clear action flag ldy #$00 ; Clear Y lda (cminf1),y ; Get the length of the table cmp #$02 ; Greater than 1 entry bmi cmsw2c ; No jsr bell ; Yes, it is ambiguous - ring bell sec ; Set carry lda cm.bfp ; Decrement buffer pointer sbc #$01 ; ... sta cm.bfp ; ... sta cm.ptr ; Make this pointer point there too bcs cmsw2b ; No carry to handle dec cm.bfp+1 ; Do H.O. byte cmsw2b: lda cm.bfp+1 ; Now make H.O. byte match sta cm.ptr+1 ; ... dec cmccnt ; Decrement the character count jmp cmswi0 ; Try again cmsw2c: lda #'/ ; Load a slash ora #$80 ; Make sure this character is negative ascii jsr cout ; Print slash clc ; Clear carry lda cminf1 ; Set the keyword table pointer adc #$02 ; to point at the beginning sta cmkptr ; of the keyword and move it lda cminf1+1 ; to cmkptr bcc cmsw2d ; ... adc #$00 ; ... cmsw2d: sta cmkptr+1 ; ... ldy #$00 ; Clear Y sec ; Set carry lda cm.bfp ; Increment the buffer pointer sbc #$01 ; ... sta cm.bfp ; ... bcs cmsw2e ; ... dec cm.bfp+1 ; ... cmsw2e: lda (cmkptr),y ; Get next character cmp #$00 ; Done? beq cmsw13 ; Yes tax ; No, hold on to the byte clc ; while we increment the pointer lda cmkptr ; Do L.O. byte adc #$01 ; ... sta cmkptr ; ... bcc cmsw2f ; And, if neccesary inc cmkptr+1 ; the H.O. byte as well cmsw2f: txa ; Get the data sta (cm.ptr),y ; Stuff it in the buffer clc ; Clear carry lda cm.ptr ; Increment the next character pointer adc #$01 ; ... sta cm.ptr ; ... bcc cmsw2g ; ... inc cm.ptr+1 ; ... cmsw2g: inc cmccnt ; Increment the character count jmp cmsw2e ; Get next character from table cmsw13: inc cmccnt ; Increment the character count lda #$00 ; Clear AC sta (cm.ptr),y ; Stuff a null in the buffer ldx cm.bfp ; Hold on to this pointer ldy cm.bfp+1 ; for later printing of switch clc ; Clear carry lda cm.ptr ; Now make both pointers look like adc #$01 ; (cm.ptr)+1 sta cm.ptr ; ... sta cm.bfp ; ... bcc cmsw3a ; ... inc cm.ptr+1 ; ... cmsw3a: lda cm.ptr+1 ; Copy H.O. byte sta cm.bfp+1 ; ... jsr prstr ; Now print string with pointer saved earlier ldx #$01 ; Set up argument jsr prbl2 ; Print one blank cmsw14: clc ; Clear carry lda cmkptr ; Increment keyword pointer adc #$01 ; Past null terminator sta cmkptr ; ... bcc cmsw4a ; ... inc cmkptr+1 ; ... cmsw4a: ldy #$00 ; Clear Y lda (cmkptr),y ; Get first data byte tax ; Put it here iny ; Up the index lda (cmkptr),y ; Get second data byte tay ; Put that in Y pla ; Flush the old comand line pointer pla ; ... jmp rskp ; And give a skip return cmswi2: ldy #$00 ; Clear Y lda (cminf1),y ; Get length of table cmp #$02 ; Greater than 1 bmi cmsw21 ; No, go fetch data ldx #cmer01\ ; Yes, fetch pointer to error message ldy #cmer01^ ; ... jsr prstr ; Print the error jmp prserr ; And go handle the parser error cmsw21: iny ; Add one to the index lda (cminf1),y ; Get the length of the keyword sta keylen ; Save that lda cminf1+1 ; Copy pointer to table sta cmkptr+1 ; ... clc ; Get set to increment an address lda cminf1 ; Do L.O. byte last for efficiency adc keylen ; Add in the keyword length adc #$02 ; Now account for table length and terminator sta cmkptr ; Save the new pointer bcc cmsw22 ; If no carry, continue inc cmkptr+1 ; Adjust H.O. byte cmsw22: jmp cmsw4a ; Go to load data and skip return cmswi3: cmp #'/ ; Is the real character a slash? beq cmswi4 ; Yes, go do the rest tax ; Move the data byte lda #$00 ; Clear AC pla ; Fetch back the old comand line pointer sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... rts ; Fail - non-skip return cmswi4: jsr cmkeyw ; Let Keyw do the work for us jmp cmswi5 ; We had problems, restore comand ptr and ret. pla ; Flush the old comand pointer pla ; ... jmp rskp ; Success - skip return! cmswi5: pla ; Retore the old comand line pointer sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... rts ; Now return .SBTTL Cmifil - try to parse an input file spec next ; ; This routine attempts to parse an input file spec. ; ; Input: Cminf1- Pointer to FCB ; ; Output: Filename parsed is in buffer pointed to by Cminf1 ; ; Registers destroyed: A,X,Y ; cmifil: lda cm.ptr ; Save the old comand line pointer in case pha ; the user wants to parse for an lda cm.ptr+1 ; alternate item pha ; ... lda #$00 ; Zero the sta cmflen ; field length lda cminf1 ; Move the FCB pointer sta cmfcb ; ... sta cmfcb2 ; ... lda cminf1+1 ; ... sta cmfcb+1 ; ... sta cmfcb2+1 ; ... cmifl0: ldy #$00 ; Zero Y lda #' ; Blank the AC ora #$80 ; Turn on the H.O. bit cmifi0: sta (cmfcb),y ; Now blank the FCB iny ; ... cpy #mxfnl+1 ; Done? bpl cmifi1 ; Yes, start parsing jmp cmifi0 ; No, continue blanking cmifi1: jsr cmgtch ; Get a character from command buffer cmp #$00 ; Is it an action character bpl cmifi2 ; No and #$7f ; Yes, turn off the minus bit cmp #'? ; Does the user need help? bne cmif12 ; Nope ora #$80 ; Set the H.O. bit jsr cout ; And print the question mark ldy #$00 ; Yes sty cmaflg ; Clear the action flag ldx #cmin03\ ; Now get set to give the 'file spec' message ldy #cmin03^ ; ... jsr prstr ; Print it jsr prcrlf ; Print a crelf ldx #prmt\ ; Set up to reprint the prompt ldy #prmt^ ; ... jsr prstr ; Do it sec ; Set the carry flag for subtraction lda cm.bfp ; Get the buffer pointer sbc #$01 ; Decrement it once sta cm.bfp ; ... bcs cmif11 ; If it's set, we need not do H.O. byte dec cm.bfp+1 ; Adjust the H.O. byte cmif11: dec cmccnt ; Decrement the character count ldy #$00 ; Clear Y lda #$00 ; Clear AC sta (cm.bfp),y ; Stuff a null at the end of the command buffer ldx #cmbuf\ ; Now get the address of the command buffer ldy #cmbuf^ ; ... jsr prstr ; Reprint the command line jmp cmifi1 ; Go back and continue cmif12: cmp #esc ; Got an escape? bne cmif13 ; No lda #$00 ; Yup, clear the action flag sta cmaflg ; ... jsr bell ; Escape does not work here, ring the bell sec ; Set carry for subtraction lda cm.bfp ; Decrement the buffer pointer sbc #$01 ; once sta cm.bfp ; ... sta cm.ptr ; Make both pointers look at the same spot lda cm.bfp+1 ; ... sbc #$00 ; H.O. byte adjustment sta cm.bfp+1 ; ... sta cm.ptr+1 ; ... dec cmccnt ; Decrement the character count jmp repars ; and go reparse everything cmif13: lda cmflen ; Get the field length cmp #$00 ; Is it zero? bne cmif14 ; No, continue jmp cmifi9 ; Yes, this is not good cmif14: cmp #mxfnl+1 ; Are we over the maximum file length? bmi cmif15 ; Not quite yet jmp cmifi9 ; Yes, blow up cmif15: ldy cmflen ; Get the filename length lda #nul ; and stuff a null at that point sta (cmfcb2),y ; ... pla ; Flush the old comand line pointer pla ; ... jmp rskp ; No, we are successful cmifi2: cmp #'! ; Bad character? bmi cmifi9 ; Yes, blow up cmp #<'z+1> ; ... bpl cmifi9 ; This is bad, punt cmp #'A ; Alphabetic? bmi cmifi8 ; Don't capitalize if it's not alphabetic and #$5f ; Capitalize cmifi8: ldy #$00 ; Zero Y sta (cmfcb2),y ; Stuff character in FCB clc ; Clear the carry flag for addition lda cmfcb2 ; Increment the fcb pointer adc #$01 ; once sta cmfcb2 ; ... lda cmfcb2+1 ; ... adc #$00 ; Adjust H.O. byte if neccesary sta cmfcb2+1 ; ... inc cmflen ; Increment the length of the name jmp cmifi1 ; Go back for next character cmifi9: pla ; Restore the old comand line pointer sta cm.ptr+1 ; in case the user wants to parse pla ; for something else sta cm.ptr ; ... rts .SBTTL Cmofil - try to parse an output file spec ; ; This routine attempts to parse an output file spec from the ; command buffer. ; ; Input: cminf1- Pointer to FCB ; ; Output: ; ; Registers destroyed: ; cmofil: jmp cmifil ; Same as parsing input file spec for now .SBTTL Cminum - Try to parse an integer number ; ; This routine tries to parse an integer number in the base ; specified. It will return a 16-bit number in cmintg. ; Cmintg is formatted H.O. byte first! ; ; Input: X- Base of integer (2<=x<=16) ; ; Output: Cmintg- 16-bit integer ; ; Registers destroyed: A,X,Y ; cminum: lda cm.ptr ; Save the old comand line pointer pha ; ... lda cm.ptr+1 ; ... pha ; ... cpx #$11 ; Are we within the proper range? bmi cmin1 ; If so, check high range jmp cmine1 ; No, tell them about it cmin1: cpx #$02 ; Too small of a base?? bpl cmin2 ; No, continue jmp cmine1 ; Base too small, tell them about it cmin2: stx cmbase ; The base requested is good, store it lda #$00 ; Clear AC sta cmmres ; and initialize these areas sta cmmres+1 ; ... sta cmmres+2 ; ... sta cmmres+3 ; ... sta cmintg ; ... sta cmintg+1 ; ... sta cmintg+2 ; ... sta cmintg+3 ; ... cminm1: jsr cmgtch ; Get next character from command buffer cmp #$00 ; Is this an action character bmi cmin1a ; Yes, handle it jmp cminm4 ; No, look for a digit cmin1a: and #$7f ; It is, turn off the H.O. bit cmp #esc ; Is it an escape? bne cminm2 ; No, try something else jsr bell ; Yes, but escape is not allowed, ring bell lda #$00 ; Zero sta cmaflg ; the action flag sec ; Set the carry flag for subtraction lda cm.bfp ; Get the command buffer pointer sbc #$01 ; Decrement it once sta cm.bfp ; Store it away sta cm.ptr ; Make this pointer look like it also bcs cmin11 ; If carry set don't adjust H.O. byte dec cm.bfp+1 ; Adjust the H.O. byte cmin11: lda cm.bfp+1 ; Move a copy of this H.O. byte sta cm.ptr+1 ; to this pointer dec cmccnt ; Decrement the character count jmp cminm1 ; Go try for another character cminm2: cmp #'? ; Does the user need help? bne cminm3 ; If not, back up the pointer and accept ora #$80 ; Set the H.O. bit jsr cout ; And print the question mark ldx #cmin05\ ; Set up the pointer to info message to be ldy #cmin05^ ; printed jsr prstr ; Print the text of the message lda cmbase ; Get the base of the integer number cmp #$0a ; Is it greater than decimal 10? bmi cmin21 ; No, just print the L.O. digit clc ; Clear the carry lda #$01 ; Print the H.O. digit as a 1 adc #$b0 ; Make it printable jsr cout ; Print the '1' lda cmbase ; Get the base back sec ; Set the carry flag for subtraction sbc #$0a ; Subtract off decimal 10 cmin21: clc ; Clear carry for addition adc #$b0 ; Make it printable jsr cout ; Print the digit jsr prcrlf ; Print a crelf ldx #prmt\ ; Set up the pointer so we can print the prompt ldy #prmt^ ; ... jsr prstr ; Reprint the prompt lda #$00 ; Clear AC ldy #$00 ; Clear Y sta (cm.ptr),y ; Drop a null at the end of the command buffer sec ; Set the carry flag for subtraction lda cm.bfp ; Get the L.O. byte of the address sbc #$01 ; Decrement it once sta cm.bfp ; Store it back bcs cmin22 ; If carry set, don't adjust H.O. byte dec cm.bfp+1 ; Adjust H.O. byte cmin22: ldx #cmbuf\ ; Get the address of the command buffer ldy #cmbuf^ ; ... jsr prstr ; Reprint the command buffer lda #$00 ; Clear the sta cmaflg ; action flag jmp repars ; Reparse everything cminm3: sec ; Set the carry flag for subtraction lda cm.bfp ; Get the command buffer pointer sbc #$01 ; Decrement it once sta cm.bfp ; Store it away sta cm.ptr ; Make this pointer look like it also bcs cmin31 ; If carry set don't adjust H.O. byte dec cm.bfp+1 ; Adjust the H.O. byte cmin31: lda cm.bfp+1 ; Move a copy of this H.O. byte sta cm.ptr+1 ; to this pointer lda cmmres ; Move L.O. byte sta cmintg ; into return parameter lda cmmres+1 ; Move H.O. byte sta cmintg+1 ; into return parameter pla ; Flush the old comand line pointer pla ; ... jmp rskp cminm4: cmp #$40 ; Is this a letter? bmi cmin41 ; Nope, skip this stuff sec ; It is, bring it into the proper range sbc #$07 ; ... cmin41: sec ; Set carry for subtraction sbc #$30 ; Make the number unprintable cmp #$00 ; Is the number in the proper range? bmi cminm5 ; No, give an error cmp cmbase ; ... bmi cminm6 ; This number is good cminm5: pla ; Restore the old comand line pointer sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... rts ; Then return cminm6: pha ; Save the number to add in lda cmmres+1 ; Move the number to multiply pha ; onto the stack for lda cmmres ; call to mul16 pha ; ... lda #$00 ; Move base onto the stack (H.O. byte first) pha ; ... lda cmbase ; ... pha ; ... jsr mul16 ; Multiply this out pla ; Get L.O. byte of product sta cmmres ; Store it for now pla ; Get H.O. byte of product sta cmmres+1 ; Store that too pla ; Get the digit to add in clc ; Clear the carry for the add adc cmmres ; Add in L.O. byte of result sta cmmres ; Store it back lda cmmres+1 ; Get the H.O. byte adc #$00 ; Add in the carry sta cmmres+1 ; Save the H.O. byte bcs cmine2 ; Wrong, we overflowed jmp cminm1 ; Try for the next digit cmine1: ldx #cmer06\ ; Get the address of the error message ldy #cmer06^ ; ... jsr prstr ; Print the error jmp prserr ; Handle the parse error cmine2: ldx #cmer07\ ; Get the address of the error message ldy #cmer07^ ; ... jsr prstr ; Print the error message jmp prserr ; Handle the error .SBTTL Cmflot - Try to parse a floating point number ; ; This routine tries to parse a floating point number in the ; format: ; sd-d.d-dEsddd ; ; s is an optional sign bit ; d is a decimal digit ; E is the letter 'E' ; . is a decimal point ; ; Input: ; ; Output: Cmfltp- 6 byte floating point number ; 4.5 byte signed mantissa ; 1.5 byte signed exponent ; ; s b........b s e.....e ; bit 0 1 35 36 37 47 ; ; Registers destroyed: A,X,Y ; cmflot: rts .SBTTL Cminbf - read characters from keyboard ; ; This routine reads characters from the keyboard until ; an action or editing character comes up. ; ; Input: ; ; Output: Cmbuf- characters from keyboard ; ; Registers destroyed: ; cminbf: pha ; Save the AC txa ; and X pha ; ... tya ; and Y pha ; ... php ; Save the processor status ldy #$00 ; Clear Y lda cmaflg ; Fetch the action flag cmp #$00 ; Set?? beq cminb1 ; Nope jmp cminb9 ; Yes, so leave cminb1: inc cmccnt ; Up the character count once jsr rdkey ; Get next character from keyboard ldy #$00 ; sta (cm.bfp),y ; Stuff it in buffer tax ; Hold it here for a while clc ; Clear the carry lda cm.bfp ; Increment the buffer pointer adc #$01 ; ... sta cm.bfp ; ... bcc cmnb11 ; Carry? inc cm.bfp+1 ; Yup, do H.O. byte cmnb11: txa ; Get the data back cmp #hctrlu ; Is it a ^U bne cminb2 ; Nope cmnb12: jsr scrl3 ; Yes, clear the whole line ldx #prmt\ ; Get L.O. byte addr. ldy #prmt^ ; and H.O. byte addr of prompt lda #$00 ; Reset cursor position to beginning of line sta ch ; ... jsr prstr ; Reprint the prompt jsr clreol ; Get rid of garbage on that line lda #cmbuf\ ; Now reset the buffer pointer sta cm.bfp ; to the beginning of the buffer lda #cmbuf^ ; ... sta cm.bfp+1 ; ... lda #$00 ; Clear AC sta cmccnt ; Clear the character count jmp repars ; Reparse new line from beginning cminb2: cmp #hbs ; Is it a ? beq cminb3 ; Yes cmp #hdel ; A ? bne cminb4 ; No cminb3: dec ch ; Backup cursor horizontal position jsr clreol ; Now clear from there to end of line dec cmccnt ; Decrement the character count dec cmccnt ; twice. lda cmccnt ; Now fetch it cmp #$00 ; Did we back up too far?? bpl cmnb32 ; No, go on jsr bell ; Yes, ring the bell and jmp cmnb12 ; go reprint prompt and reparse line cmnb32: sec ; Set the carry lda cm.bfp ; Now decrement the buffer pointer sbc #$02 ; twice. sta cm.bfp ; Store it bcs cmnb33 ; ... dec cm.bfp+1 ; Decrement to account for the borrow cmnb33: jmp repars ; Time to reparse everything cminb4: cmp #hquest ; Need help? beq cminb6 ; ... cmp #hesc ; Is he lazy? beq cminb6 ; ... cmp #hcr ; Are we at end of line? beq cminb5 ; ... cmp #hlf ; End of line? beq cminb5 ; ... cmp #hffd ; Is it a form feed? bne cminb7 ; None of the above jsr home ; Clear the whole screen cminb5: lda cmccnt ; Fetch character count cmp #$01 ; Any characters yet? bne cminb6 ; Yes jmp prserr ; No, parser error cminb6: lda #$ff ; Go sta cmaflg ; and set the action flag jmp cminb9 ; Leave cminb7: cmp #' ; Is the character a space? bne cmnb71 ; No jsr cout ; Output the character jmp cminb1 ; Yes, get another character cmnb71: cmp #htab ; Is it a ? bne cmnb72 ; No jsr cout ; Output the character jmp cminb1 ; Yes, get more characters cmnb72: jsr cout ; Print the character on the screen jmp cminb1 ; Get more characters cminb9: dec cmccnt ; Decrement the count once plp ; Restore the processor status pla ; the Y register tay ; ... pla ; the X register tax ; ... pla ; and the AC rts ; and return! .SBTTL Cmgtch - get a character from the command buffer ; ; This routine takes the next character out of the command ; buffer, does some checking (action character, space, etc.) ; and then returns it to the calling program in the AC ; ; Input: NONE ; ; Output: A- Next character from command buffer ; ; Registers destroyed: A,X,Y ; cmgtch: ldy #$00 ; Y should always be zero here to index buffer lda cmaflg ; Fetch the action flag cmp #$00 ; Set?? bne cmgt1 ; Yes jsr cminbf ; No, go fetch some more input cmgt1: lda (cm.ptr),y ; Get the next character tax ; Hold on to it here for a moment clc ; Clear the carry flag lda cm.ptr ; Increment adc #$01 ; the next character pointer sta cm.ptr ; ... bcc cmgt2 ; ... inc cm.ptr+1 ; Have carry, increment H.O. byte cmgt2: txa ; Now, get the data cmp #hspace ; Space? beq cmgtc2 ; Yes cmp #htab ; ? bne cmgtc3 ; Neither space nor cmgtc2: lda cmsflg ; Get the space flag cmp #$00 ; Was the last character a space? bne cmgtch ; Yup, go get another character lda #$ff ; Set sta cmsflg ; the space flag lda #hspace ; Put a space in the AC jmp cmgtc5 ; Go return cmgtc3: php ; Save the processor status pha ; Save this so it doesn't get clobbered lda #$00 ; Clear AC sta cmsflg ; Clear space flag pla ; Restore old AC plp ; Restore the processor status cmp #hesc ; Escape? beq cmgtc5 ; ... cmp #hquest ; Need help? beq cmgtc4 ; ... cmp #hcr ; ? beq cmgtc4 ; ... cmp #hlf ; ? beq cmgtc4 ; ... cmp #hffd ; ? beq cmgtc4 ; ... and #$7f ; Make sure the character is positive rts ; Not an action character, just return cmgtc4: tax ; Hold the data sec ; Set the carry flag lda cm.ptr ; Get the next character pointer sbc #$01 ; and decrement it sta cm.ptr ; ... bcs cmgtc5 ; ... dec cm.ptr+1 ; ... cmgtc5: txa ; Now, fetch the data ora #$80 ; Make it look like a terminator rts ; Go back .SBTTL Prcrlf subroutine - print a crelf ; ; This routine sets up a call to prstr pointing to the crlf ; string. ; ; Registers destroyed: A ; prcrlf: lda #hcr ; Get a cr in the AC jsr cout ; and print it out rts ; Return .SBTTL Prstr subroutine ; ; This routine prints a string ending in a null. ; ; Input: X- Low order byte address of string ; Y- High order byte address of string ; ; Output: Prints string on screen ; ; Registers destroyed: A,X,Y ; prstr: stx saddr ; Save Low order byte sty saddr+1 ; Save High order byte ldy #$00 ; Clear Y reg prst1: lda (saddr),y ; Get the next byte of the string beq prsdon ; If it is null, we are done ora #$80 ; Make sure it is printable jsr dely ; Call screen output routine iny ; Up the index bne prst2 ; If it is zero, the string is <256, continue inc saddr+1 ; Increment page number prst2: jmp prst1 ; Go back to print next byte prsdon: rts ; Return dely: pha ; Hold the AC lda #$32 ; Set delay jsr $fca8 ; Do the delay pla ; Fetch the character back jsr cout ; Print the character rts ; Return .SBTTL Mul16 - 16-bit multiply routine ; ; This and the following four routines is math support for the ; Comnd package. These routines come from '6502 Assembly Language ; Subroutines' by Lance A. Leventhal. Refer to that source for ; more complete documentation. ; mul16: pla ; Save the return address sta rtaddr ; ... pla ; ... sta rtaddr+1 ; ... pla ; Get multiplier sta mlier ; ... pla ; ... sta mlier+1 ; ... pla ; Get multiplicand sta mcand ; ... pla ; ... sta mcand+1 ; ... lda #$00 ; Zero sta hiprod ; high word of product sta hiprod+1 ; ... ldx #17 ; Number of bits in multiplier plus 1, the ; extra loop is to move the last carry ; into the product. clc ; Clear carry for first time through the loop mullp: ror hiprod+1 ; Shift the whole thing down ror hiprod ; ... ror mlier+1 ; ... ror mlier ; ... bcc deccnt ; Branch if next bit of multiplier is 0 clc ; next bit is 1 so add multiplicand to product lda mcand ; ... adc hiprod ; ... sta hiprod ; ... lda mcand+1 ; ... adc hiprod+1 ; ... sta hiprod+1 ; Carry = overflow from add deccnt: dex ; ... bne mullp ; Continue until done lda mlier+1 ; Get low word of product and push it pha ; onto the stack lda mlier ; ... pha ; ... lda rtaddr+1 ; Restore the return address pha ; ... lda rtaddr ; ... pha ; ... rts ; Return mcand: .blkb 2 ; Multiplicand mlier: .blkb 2 ; Multiplier and low word of product hiprod: .blkb 2 ; High word of product rtaddr: .blkb 2 ; Save area for return address .SBTTL Rskp - Do a skip return ; ; This routine returns, skipping the instruction following the ; original call. It is assumed that the instruction following the ; call is a JMP. ; ; Input: ; ; Output: ; ; Registers destroyed: X,Y ; rskp: sta savea ; stx savex ; sty savey ; sta cminf2 ; Save AC in scratch area pla ; Get Low order byte of return address tax ; Hold it pla ; Get High order byte tay ; Hold that txa ; Get Low order byte clc ; Clear the carry flag adc #$04 ; Add 4 to the address bcc rskp2 ; No carry iny ; Increment the high order byte rskp2: sta saddr ; Store L.O. byte sty saddr+1 ; Store H.O. byte lda cminf2 ; Restore AC value lda savea ; ldx savex ; ldy savey ; jmp (saddr) ; Jump at the new address .SBTTL Comnd Jsys messages and table storage cmer00: .byte hcr,hlf nasc 1 cmer01: .byte hcr,hlf nasc 1 cmer02: .byte hcr,hlf nasc 1 cmer03: .byte hcr,hlf nasc 1 cmer04: .byte hcr,hlf nasc 1 cmer05: .byte hcr,hlf nasc 1 cmer06: .byte hcr,hlf nasc 1 cmer07: .byte hcr,hlf nasc 1 cmin00: nasc < CONFIRM WITH CARRIAGE RETURN> 1 cmin01: nasc < KEYWORD, ONE OF THE FOLLOWING:> 1 cmin02: nasc < SWITCH, ONE OF THE FOLLOWING:> 1 cmin03: nasc < INPUT FILE SPEC> 1 cmin04: nasc < OUTPUT FILE SPEC> 1 cmin05: nasc < INTEGER NUMBER IN BASE > 1 .SBTTL Macro definitions .macro nasc str opt .irpc chr .byte ''chr!$80 .endr .ifnz .byte nul .endc .endm .SBTTL Kermit defaults for operational parameters ; ; The following are the defaults which this Kermit uses for ; the protocol. ; dquote = '# ; The quote character dpakln = $5f ; The packet length dpadch = nul ; The padding character dpadln = 0 ; The padding length dmaxtr = $14 ; The maximum number of tries debq = '& ; The eight-bit-quote character deol = cr ; The end-of-line character .SBTTL Kermit data ; ; The following is data storage used by Kermit ; mxpack = dpakln ; Maximum packet size mxfnl = $1e ; Maximum file-name length eof = $01 ; This is the value for End-of-file buflen = $ff ; Buffer length for received data kerbf1 = $1a ; This always points to packet buffer kerbf2 = $1c ; This always points to data buffer true = $01 ; Symbol for true return code false = $00 ; Symbol for false return code on = $01 ; Symbol for value of 'on' keyword off = $00 ; Symbol for value of 'off' keyword yes = $01 ; Symbol for value of 'yes' keyword no = $00 ; Symbol for value of 'no' keyword fbsbit = $01 ; Value for SEVEN-BIT FILE-BYTE-SIZE fbebit = $00 ; Value for EIGHT-BIT FILE-BYTE-SIZE errcri = $01 ; Error code - cannot receive init errcrf = $02 ; Error code - cannot receive file-header errcrd = $03 ; Error code - cannot receive data errmrc = $04 ; Error code - maximum retry count exceeded errbch = $05 ; Error code - bad checksum errfae = $0a ; Error code - file already exists emesln = $19 ; Standard error message length kerrns = $1f ; Routine name and action string length kerdel = $15 ; Disk error length kerems = $19 ; Error message size kerfts = $0b ; Size of file-type strings (incl. term. nul) .ifeq cswl = $36 ; Character out routine pointer (z-pag) cswh = $37 ; ... kswl = $38 ; Keyboard character in routine pointer (z-pag) kswh = $39 ; ... errptr = $9d5a ; DOS error handler vector basws = $9d5e ; DOS basic warmstart vector .ifeq kerpch = $c087 ; Base for port character locations kerpst = $c086 ; Base for port strobe locations .endc .ifeq kerpch = $c08f ; Base for port character locations kerpst = $c08e ; Base for port strobe locations .endc .endc pdbuf: .blkb mxpack-4 ; Packet buffer pdlen: .byte ; Common area to place data length ptype: .byte ; Common area to place current packet type pnum: .byte ; Common area to put packet number received plnbuf: .blkb mxpack ; Port line buffer pdtend: .byte ; End of plnbuf pointer pdtind: .byte ; Index for plnbuf rstat: .byte ; Return status kerrta: .word ; Save area for return address escp: .byte ; Character for escape from connection fbsize: .byte ; File-byte-size filmod: .byte ; Current file type usehdr: .byte ; Switch - where to get filename (on=file-head) lecho: .byte ; Local-echo switch ibmmod: .byte ; Ibm-mode switch vtmod: .byte ; VT-52 Emulation mode switch parity: .byte ; Parity setting delay: .byte ; Amount of delay before first send filwar: .byte ; File-warning switch debug: .byte ; Debug switch ebqmod: .byte ; Eight-bit-quoting mode datind: .byte ; Data index into packet buffer chebo: .byte ; Switch to tell if 8th-bit was on escflg: .byte ; Flag indicating we have seen and escape ($1b) kwrk01: .byte ; Work area for Kermit kwrk02: .byte ; Work area for Kermit kerchr: .byte ; Current character read off port kermbs: .word ; Base address of message table kerhcs: .word ; Hold area for char out routine address kerhks: .word ; Hold area for input routine address herrpt: .word ; Hold area for DOS error routine vector hbasws: .word ; Hold area for DOS basic warmstart vector debchk: .byte ; Checksum for debug routine debinx: .byte ; Debug routine action index fld: .byte ; State of receive in rpak routine retadr: .word ; Hold area for return address n: .byte ; Message # numtry: .byte ; Number of tries for this packet oldtry: .byte ; Number of tries for previous packet maxtry: .byte ; Maximum tries allowed for a packet state: .byte ; Current state of system local: .byte ; Local/Remote switch size: .byte ; Size of present data chksum: .byte ; Checksum for packet rtot: .word ; Total number of characters received stot: .word ; Total number of characters sent rchr: .word ; Number characters received, current file schr: .word ; Number of characters sent, current file rovr: .word ; Number of overhead characters on receive sovr: .word ; Number of overhead characters on send eofinp: .byte ; End-of-file on input indicator errcod: .byte ; Error indicator kerosp: .byte ; Save area for stack pointer ; ; These fields are set parameters and should be kept in this ; order to insure integrity when setting and showing values ; srind: .byte ; Switch to indicate which parm to print ebq: .byte debq ; Eight-bit quote character (rec. and send) .byte debq ; ... pad: .byte dpadln ; Number of padding characters (rec. and send) .byte dpadln ; ... padch: .byte dpadch ; Padding character (receive and send) .byte dpadch ; ... eol: .byte deol ; End-of-line character (recevie and send) .byte deol ; ... psiz: .byte dpakln ; Packet size (receive and send) .byte dpakln ; ... time: .word $0000 ; Time out interval (receive and send) quote: .byte dquote ; Quote character (receive and send) .byte dquote ; ... ; ; Some definitions to make life easier when referencing the above ; fields. ; rebq = ebq ; Receive eight-bit-quote char sebq = ebq+1 ; Send eight-bit-quote char rpad = pad ; Receive padding amount spad = pad+1 ; Send padding amount rpadch = padch ; Receive padding character spadch = padch+1 ; Send padding character reol = eol ; Receive end-of-line character seol = eol+1 ; Send end-of-line character rpsiz = psiz ; Receive packet length spsiz = psiz+1 ; Send packet length rtime = time ; Receive time out interval stime = time+1 ; Send time out interval rquote = quote ; Receive quote character squote = quote+1 ; Send quote character .ifeq .SBTTL Kermit - Apple DOS and File Manager support ; ; The following definitions and storage will be used when setting ; up and executing calls to the File manager in DOS. ; primfn = $aa75 ; Filename buffers scndfn = $aa93 ; ... fmpars = $b5bb ; File manager parameter list address opcod = fmpars ; Operation code subcod = fmpars+1 ; Operation subcode reclh = fmpars+2 ; Record length (H.O. byte) recll = fmpars+3 ; Record length (L.O. byte) cvol = fmpars+4 ; Current volume cdisk = fmpars+5 ; Current disk drive cslot = fmpars+6 ; Current slot ftype = fmpars+7 ; File type fnadrl = fmpars+8 ; File name address (L.O.) fnadrh = fmpars+9 ; File name address (H.O.) fmrcod = fmpars+10 ; File manager return code fmwadl = fmpars+12 ; File manager work area address (L.O.) fmwadh = fmpars+13 ; File manager work area address (H.O.) tslbfl = fmpars+14 ; Track/sector list address (L.O.) tslbfh = fmpars+15 ; Track/sector list address (H.O.) dsbufl = fmpars+16 ; Data sector buffer address (L.O.) dsbufh = fmpars+17 ; Data sector buffer address (H.O.) rnumh = fmpars+2 ; Record number (H.O.) rnuml = fmpars+3 ; Record number (L.O.) bytofh = fmpars+4 ; Byte offset in file (H.O.) bytofl = fmpars+5 ; Byte offset in file (L.O.) rnglnh = fmpars+7 ; Range length (H.O.) rnglnl = fmpars+6 ; Range length (L.O.) fncopn = $01 ; Open function code fncclo = $02 ; Close function code fncrea = $03 ; Read function code fncwrt = $04 ; Write function code fncpos = $0a ; Position function code sfntrn = $02 ; Trnasfer range of bytes sub-code sfnptr = $04 ; Position then transfer range sub-code dosopn = $a3d5 ; DOS open routine address dosonc = $a2a8 ; DOS open address, no type checking dosclo = $a2ea ; DOS close routine address dosdel = $a263 ; DOS delete routine address dosfmn = $ab06 ; DOS file manager entry point locent = $b1c9 ; DOS locate directory entry routine doscmi = $aa5f ; DOS comand index - used when calling dosopn ; ; Error codes ; dsener = $00 ; No error dsebct = $02 ; Bad call type dsebst = $03 ; Bad sub-call type dsewpr = $04 ; Write protected dseeod = $05 ; End-of-data dsefnf = $06 ; File not found dsevmm = $07 ; Volume mismatch dsedio = $08 ; Disk I/O dsedfl = $09 ; Disk full dseflk = $0a ; File locked kerfcb = $1e ; Pointer to file control block mxdb = $7f ; Maximum DOS buffer size ; ; Data area ; dsbfcc: .byte $00 dsbind: .byte $00 ; DOS buffer index dsbend: .byte $00 ; Current DOS buffer length (last char pointer) dosffm: .byte $00 ; 'First file modification done' switch dosfni: .byte $00 ; Filename index dosfvn: .byte $00 ; File version number for the alter routine fcb1: .blkb $1f ; Fcb for file being transmitted dosbuf: .blkb $100 ; DOS file buffer .endc .SBTTL Kermit initialization ; ; The following code sets up Kermit-65 for normal operation. ; kstart: jsr setio1 ;[1] Set I/O hooks appropriately so that jsr setio2 ;[1] DOS does not interfere with Kermit jsr home ; Start by clearing the screen ldx #versio\ ; Get Low order byte of version message ldy #versio^ ; And H.O. byte jsr prstr ; Print the version jsr prcrlf ; Print a crlf .ifeq lda errptr ; Move DOS vectors to a hold area sta herrpt ; ... lda errptr+1 ; ... sta herrpt+1 ; ... lda basws ; ... sta hbasws ; ... lda basws+1 ; ... sta hbasws+1 ; ... lda #nonftl\ ; Point dos error handler pointer sta errptr ; at our error routine lda #nonftl^ ; ... sta errptr+1 ; ... lda #nonftl\ ; Point basic warmstart at us sta basws ; ... lda #nonftl^ ; ... sta basws+1 ; ... .endc lda #off ; The default for 8-bit quoting is 'on' sta ebqmod ; ... lda #dmaxtr ; ... sta maxtry ; and the default number of tries jsr kermit ; Go execute kermit .ifeq jmp dos ; Restart dos .endc brk ; Break .SBTTL Kermit - main routine ; ; This routine is the main KERMIT loop. It prompts for commands ; and then it dispatches to the appropriate routine. ; kermit: tsx ; Get the stack pointer stx kerosp ; and save it in case of a fatal error lda #cmini ; Argument for comnd call jsr comnd ; Set up the parser and print the prompt lda #kercmd\ ; L.O. byte addr of command table sta cminf1 ; Stuff it lda #kercmd^ ; H.O. byte addr of command table sta cminf1+1 ; Stuff that too lda #kerhlp\ ; L.O. byte addr of help text sta cmhptr ; Store it in help pointer lda #kerhlp^ ; H.O. byte addr of help text sta cmhptr+1 ; Store H.O. byte lda #cmkey ; Set up for keyword parse jsr comnd ; Try to parse it jmp kermt2 ; Failed txa ; Get offset in AC clc ; Clear the carry flag adc #\ ; Add in L.O. byte of jump table tax ; Hold it here for a while lda #kermtb^ ; Get H.O. byte adc #$00 ; Add in carry if there is any pha ; Push it on the stack txa ; Get modified L.O. byte again pha ; Push that rts ; Jump indexed (the hard way) kermtb: jmp telnet ; Connect command jmp exit ; Exit command jmp help ; Help command jmp log ; Log command jmp exit ; Quit command jmp receve ; Receive command jmp send ; Send command jmp setcom ; Set command jmp show ; Show command jmp status ; Status command kermt2: ldx #ermes1\ ; L.O. byte of error message ldy #ermes1^ ; H.O. byte of error message jsr prstr ; Print the error jmp kermit ; Go back kermt3: ldx #ermes3\ ; L.O. byte of error ldy #ermes3^ ; H.O. byte of error jsr prstr ; Print it jmp kermit ; Try again kermt4: ldx #ermes4\ ; L.O. byte of error ldy #ermes4^ ; H.O. byte of error jsr prstr ; Print the text jmp kermit ; Try again kermt5: ldx #ermes6\ ; L.O. byte of error ldy #ermes6^ ; H.O. byte of error jsr prstr ; Print error text ('keyword') jmp kermit ; Start at the beginning again kermt6: ldx #ermes7\ ; L.O. byte of error ldy #ermes7^ ; H.O. byte of error message jsr prstr ; Print the error message ('file spec') jmp kermit ; and try again kermt7: ldx #ermes8\ ; L.O. byte of error message text ldy #ermes8^ ; H.O. byte of error message jsr prstr ; Print it ('integer') jmp kermit ; Try for another command line kermt8: ldx #ermes9\ ; L.O. byte of error ldy #ermes9^ ; H.O. byte of error jsr prstr ; Print the message ('switch') jmp kermit ; Go back to top of loop .SBTTL Telnet routine ; ; This routine handles the connect command. After connecting ; to a host system, this routine alternates calling routines ; which will pass input from the port to the screen and pass ; output from the keyboard to the port. This kermit will ; ignore all characters until it sees and assigned escape ; character. ; ; Input: NONE ; ; Output: NONE ; ; Registers destroyed: A,X,Y ; telnet: jsr prcfm ; Parse and print a confirm ldx #inf01a\ ; Get address of first half of message ldy #inf01a^ ; ... jsr prstr ; Print it out lda escp ; Get the 'break connection' character jsr prchr ; Print that as a special character ldx #inf01b\ ; Get address of second half of message ldy #inf01b^ ; ... jsr prstr ; Print that jsr prcrlf ; and a crelf chrlup: jsr telprc ; Check for port character, write to screen jsr telcnc ; Check for console character, write to port jmp kermit ; This means user wants to shut connection jmp chrlup ; Go back and do all that again telprc: jsr telcp ; Check for a port character cmp #false ; No character beq telprr ; Return jsr telgpc ; Go fetch the character telpr2: tay ; Hold the character here lda vtmod ; Are we in vt52 mode? cmp #on ; ... bne telpr3 ; If not, we do not need any of this, continue lda escflg ; Was previous character an escape? cmp #on ; ... bne telp2a ; If not, skip vt52 emulation stuff jmp vt52 ; It was escape, do vt52 emulation telp2a: tya ; Get the character back cmp #del ; Was it a delete? beq telprr ; If so, return cmp #esc ; Was it an 'escape'? bne telpr3 ; If not, just output the character lda #on ; Set the escape flag on sta escflg ; ... jmp telprc ; Go try for another character telpr3: tya ; Get the data into the AC ora #$80 ; Make absolutely sure the H.O. bit is on cmp #$e0 ; Is it a lower case character? bmi telpr4 ; If not, skip the convert to upper case and #$df ; Convert the thing to upper case telpr4: jsr cout ; Print the character we got above jmp telprc ; Try for another telprr: rts ; Return .ifeq telcp: ldx #kercsi\ ; Offset into I/O locations lda kerpst,x ; Try for a character and #$01 ; Check for receive register full beq telnc ; No character, return false lda #true ; Successful return rts ; ... telnc: lda #false ; Indicate failure rts ; and return telgpc: ldx #kercsi\ ; Get offset into I/O locations lda kerpch,x ; Fetch the character waiting here rts ; and return telcnc: bit kbd ; Check the keyboard for a character bpl telcrs ; If none, return skip lda kbd ; Get the character we found tax ; Hold the data bit kbdstr ; Reset the keyboard strobe txa ; Fetch the data and #$7f ; Make sure H.O. bit is off cmp escp ; Is it the connect-escape character? beq intchr ; If so, go handle the interupt character jsr telppc ; Output the port character tax ; Hold it in X lda lecho ; Is local-echo turned on? cmp #on ; ... bne telcrs ; If not, we are done, return skip txa ; Output a copy to the screen jsr cout ; telcrs: jmp rskp ; Skip return telppc: pha ; Hold the byte to send ldx #kercsi\ ; Get I/O location offset telpp1: lda kerpst,x ; Get the status byte and #$02 ; Isolate the flag we want (TRE) beq telpp1 ; Transmit register is NOT empty, try again pla ; Fetch the data byte off the stack sta kerpch,x ; Stuff it at the proper location to send it rts ; and return .endc ; ; Intchr - processes the character which frollows the interupt ; character and performs functions based on what that character ; is. ; intchr: jsr rdkey ; Get the next character sta kerchr ; Save a copy of it and #$5f ; Capitalize it cmp #'C ; Does user want the connection closed? bne intch0 ; If not, try next option rts ; Otherwise, do non-skip return and end it intch0: cmp #'S ; Does the user want status? bne intch1 ; Nope jmp stat01 ; Give it to him intch1: lda kerchr ; Fetch back the original character and #$7f ; Get rid of the H.O. bit cmp #'? ; Does user need help? bne intch2 ; If not, continue ldx #inthlp\ ; Get the address of the proper help string ldy #inthlp^ ; ... jsr prstr ; Print the help stuff jmp intchr ; Get another option character intch2: cmp escp ; Is it another connect-escape? bne intch3 ; Nope, this is an error jsr telppc ; Stuff the character at the port jmp rskp ; Give skip return intch3: jsr bell ; Sound bell at the user jmp rskp ; Go back (skip) ; ; Vt52 - will carry out the equivalent of most of the vt52 functions ; available. ; vt52: lda #off ; First, turn off the escape flag sta escflg ; ... tya ; Get the character to check and #$7f ; Turn off the H.O. bit cmp #'A ; Is it greater than 'A' and less than bmi vtig ; or equal to 'Y'???? cmp #<'Y+1> ; ... bpl vtig ; If it isn't, ignore it cmp #'A ; It is, is it an 'A'? bne vt52a ; No, try next character jsr upline ; Go up one line rts ; Return vt52a: cmp #'B ; Is it a 'B'? bne vt52b ; Next char jsr lfeed ; Yes, do a line feed rts ; and go back vt52b: cmp #'C ; 'C'? bne vt52c ; Nope jsr advanc ; Yes, go forward one space rts ; and return vt52c: cmp #'D ; 'D'? bne vt52d ; No jsr bsp ; Yes, do a back-space rts ; Return vt52d: cmp #'H ; 'H'? bne vt52e ; No, try next character lda #$00 ; Zero out sta ch ; cursor horizontal sta cv ; and cursor vertical jsr vtabz ; And then set the line base address rts ; then return vt52e: cmp #'I ; 'I'? bne vt52f ; Nope lda cv ; Get the vertical cursor position cmp #$00 ; If it is zero beq vt52e1 ; Do reverse scrolling jsr upline ; Otherwise, just go up one line rts ; and return vt52e1: jsr vrscrl ; Do the reverse scroll rts ; and return vt52f: cmp #'J ; 'J'? bne vt52g ; No jsr clreop ; Clear from where we are to end-of-page rts ; then return vt52g: cmp #'K ; 'K'? bne vt52h ; Try last option jsr clreol ; Clear to end-of-line rts ; Return vt52h: cmp #'Y ; 'Y' bne vtig ; Must be an unimplemented function, do vtig jsr vtdca ; Do direct cursor addressing rts ; then return vtig: ora #$80 ; Set the H.O. bit for output pha ; Save a copy lda #hesc ; Get an escape jsr prchr ; Print the special character pla ; Fetch the other character back cmp #esc ; Is it a second escape? bne vtig1 ; Nope, print it lda #on ; Set escflg on again for next time around sta escflg ; ... rts ; and return vtig1: jsr prchr ; Print the character rts ; and return vrscrl: lda wndbtm ; Start at bottom of window pha ; Save ac jsr vtabz ; Generate base address vrsc1: lda basl ; Move basl,h to bas2l,h sta bas2l ; ... lda bash ; ... sta bas2h ; ... ldy wndwth ; Init Y to rightmost index dey ; of scrolling window pla ; Get window bottom sec ; Decrement by one sbc #$01 ; ... cmp wndtop ; Are we done? bcs vrsc3 ; Yup pha ; Save new line number jsr vtabz ; Generate this line's base address vrsc2: lda (basl),y ; Move a character down a line sta (bas2l),y ; ... dey ; Next char bpl vrsc2 ; If not done, do next char bmi vrsc1 ; Otherwise, go to next line vrsc3: jsr scrl3 ; Clear the entire top line rts ; Return vtdca: jsr telcp ; Check for a character from the port cmp #false ; If we didn't get one beq vtdca ; Try again jsr telgpc ; Get the character waiting at the port and #$7f ; Make sure H.O. bit is off sec ; Subtract hex 30 (make it num from 0 to 23) sbc #$20 ; ... cmp #$00 ; Is it less than 0? bpl vtdca1 ; No, continue clc ; Clear carry adc #$20 ; Add this back in jmp vtig ; Now ignore it as a control paramenter vtdca1: cmp #$23 ; Is it too large? bmi vtdca2 ; No, it is fine, store it away clc ; Clear carry adc #$20 ; Add this back in jmp vtig ; Ignore it vtdca2: sta hcv ; Store it as the vertical cursor position vtdca3: jsr telcp ; Check port for character cmp #false ; If we didn't get one yet beq vtdca3 ; go back and try again jsr telgpc ; Get the character waiting at the port and #$7f ; Make sure H.O. bit is off sec ; Subtract hex 20 (make it num from 0 to 23) sbc #$20 ; ... cmp #$00 ; Is it less than 0? bpl vtdca4 ; No, continue clc ; Clear carry adc #$20 ; Add this back in jmp vtig ; Now ignore it as a control paramenter vtdca4: cmp #$28 ; Is it too large? bmi vtdca5 ; No, it is fine, store it away clc ; Clear carry adc #$20 ; Add this back in jmp vtig ; Ignore it vtdca5: sta hch ; Store it as the horizontal cursor position lda hcv ; Move this to the real position now sta cv ; ... lda hch ; This too sta ch ; ... jsr vtab ; Now place the cursor there rts ; and return .SBTTL Exit routine ; ; This routine exits properly from Kermit-65 and reenters ; Dos. ; ; Input: NONE ; ; Output: NONE ; ; Registers destroyed: A,X ; exit: .ifeq lda herrpt ; Reset the DOS and BASIC error vectors sta errptr ; ... lda herrpt+1 ; ... sta errptr+1 ; ... lda hbasws ; ... sta basws ; ... lda hbasws+1 ; ... sta basws+1 ; ... .endc lda #cmcfm ; Try to get a confirm jsr comnd ; Do it jmp kermt3 ; Give '?not confirmed' message exit2: jmp dos ; We got it, now restart DOS .SBTTL Help routine ; ; This routine prints help from the current help text ; area. ; ; Input: Cmhptr - Pointer to the desired text to be printed ; ; Output: ASCIZ string at Cmhptr is printed on screen ; ; Registers destroyed: A,X,Y ; help: lda #cmcfm ; Try to get a confirm jsr comnd ; Go get it jmp kermt3 ; Didn't find one? Give 'not confirmed' message help2: ldx cmhptr ; L.O. byte of current help text address ldy cmhptr+1 ; H.O. byte of address jsr prstr ; Print it jmp kermit ; Return to main routine .SBTTL Log routine ; ; This routine logs a session to a disk file. ; ; Input: NONE ; ; Output: NONE ; ; Registers destroyed: NONE ; log: jmp kermit .SBTTL 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: lda #on ; Set use file-header switch on in case we sta usehdr ; don't parse a filename lda #fcb1\ ; Pass the address of the sta cminf1 ; fcb in cminf1 lda #fcb1^ ; ... sta cminf1+1 ; ... lda #cmifi ; Load opcode for parsing input files jsr comnd ; Call comnd routine jmp recev1 ; Continue, don't turn file-header switch off lda #off ; We parsed a filename so we don't need the sta usehdr ; info from the file-header recev1: lda #cmcfm ; Get token for confirm jsr comnd ; and try to parse that jmp kermt3 ; Failed - give the error 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 ; ... rswt1: lda state ; Fetch the current system state cmp #'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 #'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 #'R ; Do we need the init? bne rswt4 ; No, try next state jsr rini ; Yes, go get it jmp rswt1 ; Go back to top rswt4: cmp #'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: lda #pdbuf\ ; Point kerbf1 at the packet data buffer sta kerbf1 ; ... lda #pdbuf^ ; ... sta kerbf1+1 ; ... lda numtry ; Get current number of tries inc numtry ; Increment it for next time cmp maxtry ; Have we tried this one enought times beq rini1 ; Not yet, go on bcs 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: 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 #'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 #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 sebq ; See what we got for an 8-bit quoting cmp #$21 ; First check the character range bmi rinicn ; Not in range cmp #$3f ; ... bmi rinicy ; Inrange cmp #$60 ; ... bmi rinicn ; Not in range cmp #$7f ; ... bmi rinicy ; Inrange rinicn: cmp #'Y ; Does it say he agrees to 8-bit quoting? beq rinicy ; Ok, that's just like an inrange character lda #off ; No, punt 8-bit quoting sta ebqmod ; ... lda #$06 ; BTW, the data length is now only 6 jmp rinic1 ; Continue rinicy: lda #on ; Make sure everything is on sta ebqmod ; ... lda #$07 ; Data length for ack-init is 7 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 maxtry ; Have we tried too many times? beq rfil1 ; Not yet bcs rfil1a ; Yes, go abort the transfer rfil1: jmp rfil2 ; Continue transfer rfil1a: lda #'A ; Set state of system to 'abort' sta state ; ... lda #false ; Return code should be 'false' rts ; Return rfil2: jsr rpak ; Try to receive a packet sta rstat ; Save the return status lda ptype ; Get the packet type we found cmp #'S ; Was it an 'init' packet? bne rfil2a ; Nope, try next one jmp rfilci ; Handle the init case rfil2a: cmp #'Z ; Is it an 'eof' packet?? bne rfil2b ; No, try again jmp rfilce ; Yes, handle that case rfil2b: cmp #'F ; Is it a 'file-header' packet??? bne rfil2c ; Nope jmp rfilcf ; Handle file-header case rfil2c: cmp #'B ; Break packet???? bne rfil2d ; Wrong, go get the return status jmp rfilcb ; Handle a break packet rfil2d: lda rstat ; Fetch the return status from Rpak cmp #false ; Was it a false return? beq rfil2e ; Yes, Nak it and return 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 maxtry ; Have we tried this one too much? beq rfili1 ; Not quite yet bcs 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 ; ... adc #$01 ; ... cmp 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 maxtry ; Too many times for this packet? beq rfile1 ; Not yet, continue bcs 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 ; ... adc #$01 ; ... cmp 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 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: jsr getfil ; Get the filename we are to use lda #fncwrt ; Tell the open routine we want to write jsr openf ; Open up the file 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 rfilcb: lda pnum ; Does pnum=n? cmp 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 maxtry ; Have we gone beyond number of tries allowed? beq rdat1 ; Not yet, so continue bcs 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 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 #'D ; Was it a data packet? bne rdat2a ; If not, try next type jmp rdatcd ; Handle a data packet rdat2a: cmp #'F ; Is it a file-header packet? bne rdat2b ; Nope, try again jmp rdatcf ; Go handle a file-header packet rdat2b: cmp #'Z ; Is it an eof packet??? bne rdat2c ; If not, go check the return status from rpak jmp rdatce ; It is, go handle eof processing rdat2c: lda rstat ; Fetch the return status cmp #false ; Was it a failure return? beq rdat2d ; If it was, Nak it 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 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 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 maxtry ; Have we exceeded that limit? beq rdatd2 ; Not just yet, continue bcs 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 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 adc #$01 ; expected packet? cmp n ; ... beq rdatd5 ; Yes, continue transfer jmp rdatd6 ; Nope, abort the whole thing rdatd5: jsr spar ; Go set up init data lda #'Y ; Make it look like an ack to a send-init sta ptype ; ... lda #$06 ; ... 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 maxtry ; Have we exceeded maximum tries allowed? beq rdatf1 ; Not yet, go on bcs 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 lda #false ; ... rts ; and return false rdatf3: lda pnum ; Is this packet the one before the expected clc ; one? adc #$01 ; ... cmp 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 n ; ... bne rdate1 ; 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! lda #fcb1\ ; Get the pointer to the fcb sta kerfcb ; and store it where the close routine lda #fcb1^ ; can find it sta kerfcb ; ... lda #$00 ;[3] Make sure CLOSEF sees there are no errors jsr closef ; We are done with this file, so close it jsr incn ; Increment the packet number lda #'F ; Advance system state to 'file-header' sta state ; incase more files are coming lda #true ; ... rts ; Return (successful) .SBTTL 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: lda #fcb1\ ; Pass the address of the sta cminf1 ; fcb in cminf1 lda #fcb1^ ; ... sta cminf1+1 ; ... lda #cmifi ; Load opcode for parsing input files jsr comnd ; Call comnd routine jmp kermt6 ; Give the 'missing filespec' error jsr prcfm ; Parse and print a confirm jsr sswt ; Perform send-switch routine 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 Sent characters, current file sta schr+1 ; ... lda #pdbuf\ ; Set up the address of the packet buffer sta saddr ; so that we can clear it out lda #pdbuf^ ; ... sta saddr+1 ; ... lda #$00 ; Clear AC ldy #$00 ; Clear Y clpbuf: sta (saddr),y ; Step through buffer, clearing it out iny ; Up the index cpy #mxpack-4 ; Done? bmi clpbuf ; No, continue sswt1: lda state ; Fetch state of the system cmp #'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 #'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 #'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 #'S ; Must we send an init packet bne sswt5 ; No, continue jsr sini ; Yes, go do it jmp sswt1 ; And continue sswt5: cmp #'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 #'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 maxtry ; Is it more than the maximum allowed? beq sdat1 ; No, not yet bcs 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 #false ; Enter false return code rts ; and 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 #'N ; Was it a NAK? bne sdat2a ; No, try for an ACK jmp sdatcn ; Go handle the nak case sdat2a: cmp #'Y ; Did we get an ACK? bne sdat2b ; No, try checking the return status jmp sdatca ; Yes, handle the ack sdat2b: lda rstat ; Fetch the return status cmp #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 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 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 #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 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 go back sfil: lda numtry ; Fetch the current number of tries inc numtry ; Up it by one cmp maxtry ; See if we went up to too many beq sfil1 ; Not yet bcs 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 drop that in as the current state lda #false ; Load false for a return code rts ; and return sfil1b: ldy #$00 ; Clear Y sfil1c: lda fcb1,y ; Get a byte from the filename cmp #$00 ; Is it a null? beq sfil1d ; No, continue sta pdbuf,y ; Move the byte to this buffer iny ; Up the index once jmp sfil1c ; Loop and do it again sfil1d: lda #' ; Stuff a space ora #$80 ; with H.O. bit on sta fcb1,y ; over the null that is there sty 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 #'N ; Is it a NAK? bne sfil2a ; No, try the next packet type jmp sfilcn ; Handle the case of a nak sfil2a: cmp #'Y ; Is it, perhaps, an ACK? bne sfil2b ; If not, go to next test jmp sfilca ; Go and handle the ack case sfil2b: lda rstat ; Get the return status cmp #false ; Is it a failure return? bne sfil2c ; No, just go abort the send rts ; Return failure with current state sfil2c: lda #'A ; Set state to 'abort' sta state ; Stuff it in its place lda #false ; Set up a failure return code rts ; and go back sfilcn: dec pnum ; Decrement the receive packet number once lda pnum ; Load it into the AC cmp 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 return sfilca: lda n ; Get the packet number cmp 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 lda #fcb1\ ; Load the fcb address into the pointer sta kerfcb ; for the DOS open routine lda #fcb1^ ; ... sta kerfcb+1 ; ... lda #fncrea ; Open for input jsr openf ; Open the file 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 return seof: lda numtry ; Get the number of attempts for this packet inc numtry ; Now up it once for next time around cmp maxtry ; Are we over the allowed max? beq seof1 ; Not quite yet bcs 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 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 #'N ; Was it a nak? bne seof2a ; If not, try the next packet type jmp seofcn ; Go take care of case nak seof2a: cmp #'Y ; Was it an ack bne seof2b ; If it wasn't that, try return status jmp seofca ; Take care of the ack seof2b: lda rstat ; Fetch the return status cmp #false ; Was it a failure? beq seof2c ; Yes, just fail return with current state lda #'A ; No, abort the whole thing sta state ; Set the state to that lda #false ; Get false return status seof2c: rts ; Return seofcn: dec pnum ; Decrement the received packet sequence number lda n ; Get the expected sequence number cmp 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 return seofca: lda n ; Check sequence number expected against cmp pnum ; the number we got. bne seofa1 ; If not identical, fail and return curr. state seofa2: lda #$00 ; Clear the number of tries for current packet sta numtry ; ... jsr incn ; Up the packet sequence number jsr getnfl ; Call the routine to get the next file cmp #eof ; If it didn't find any more beq seofrb ; then return state 'B' ('Send-Eot') jmp seofrf ; Otherwise, return 'F' ('Send-file') seofrb: lda #'B ; Load Eot state code sta state ; Store that as the current state lda #true ; Give a success on the return rts ; ... seofrf: lda #'F ; Load File-header state code sta state ; Make that the current system state lda #true ; Make success the return status rts ; and return sini: lda #pdbuf\ ; Load the pointer to the sta kerbf1 ; packet buffer into its lda #pdbuf^ ; place on page zero sta kerbf1+1 ; ... jsr spar ; Go fill in the send init parms lda numtry ; If numtry > maxtry cmp maxtry ; ... beq sini1 ; ... bcs 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 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 ebqmod ; Do we want 8-bit quoting? cmp #on ; ... beq sini1c ; If so, data length is 7 lda #$06 ; Else it is 6 jmp sini1d ; ... sini1c: lda #$07 ; The length of data in a send-init is always 7 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 #'Y ; Was it an ACK? bne sinic1 ; If not, try next type jmp sinicy ; Go handle the ack sinic1: cmp #'N ; Was it a NAK? bne sinic2 ; If not, try next condition jmp sinicn ; Handle a nak sinic2: lda rstat ; Fetch the return status cmp #false ; Was this, perhaps false? bne sinic3 ; Nope, do the 'otherwise' stuff jmp sinicf ; Just go and return sinic3: lda #'A ; Set state to 'abort' sta state ; ... sinicn: sinicf: rts ; Return sinicy: ldy #$00 ; Clear Y lda n ; Get packet number cmp pnum ; Was the ack for that packet number? beq siniy1 ; Yes, continue lda #false ; No, set false return status rts ; and go back siniy1: jsr rpar ; Get parms from the ack packet lda sebq ; Check if other Kermit agrees to 8-bit quoting cmp #'Y ; ... beq siniy2 ; Yes! lda #off ; Shut it off sta ebqmod ; ... siniy2: 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 maxtry ; Have we exceeded the maximum beq sbrk1 ; Not yet bcs 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 store it as the error code lda #false ; Load the failure return status rts ; and 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 #'N ; Was it a NAK? bne sbrk2a ; If not, try for the ack jmp sbrkcn ; Go handle the nak case sbrk2a: cmp #'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 #false ; Was it a failure? beq sbrk2c ; Yes, just return with current state lda #'A ; No, set up the 'abort' code sta state ; as the system state lda #false ; load the false return status sbrk2c: rts ; and return sbrkcn: dec pnum ; Decrement the received packet number once lda n ; Get the expected sequence number cmp 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 go back sbrkca: lda n ; Get the expected packet sequence number cmp 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 ; ... .SBTTL Setcom routine ; ; This routine sets Kermit-65 parameters. ; ; Input: Parameters from command line ; ; Output: NONE ; ; Registers destroyed: A,X,Y ; setcom: lda #setcmd\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #setcmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error txa ; Get offset in AC clc ; Clear the carry flag adc #\ ; Add in L.O. byte of jump table tax ; Hold it here for a while lda #setcmb^ ; Get H.O. byte adc #$00 ; Add in carry if there is any pha ; Push it on the stack txa ; Get modified L.O. byte again pha ; Push that rts ; Jump indexed (the hard way) setcmb: jmp stesc ; Set escape character jmp stibm ; Set ibm-mode switch jmp stle ; Set local-echo switch jmp strc ; Set receive parameters jmp stsn ; Set send parameters jmp stvt ; Set vt52-emulation switch jmp stfw ; Set file-warning switch jmp steb ; Set Eight-bit quoting character jmp stdb ; Set debugging switch jmp stmod ; Set file-type mode jmp stfbs ; Set the file-byte-size for transfer stesc: ldx #$10 ; Base should be hex lda #cmnum ; Parse for integer jsr comnd ; Go! jmp kermt4 ; Number is bad lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq stesc1 ; It is, continue jmp kermt4 ; Bad number, tell them stesc1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi stesc2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stesc2: sta escp ; Stuff it jmp kermit stibm: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx ibmmod ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stle: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx lecho ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit strc: lda #$00 ; Set srind for receive parms sta srind ; ... lda #stscmd\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #stscmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error txa ; Get offset in AC clc ; Clear the carry flag adc #\ ; Add in L.O. byte of jump table tax ; Hold it here for a while lda #stcct^ ; Get H.O. byte adc #$00 ; Add in carry if there is any pha ; Push it on the stack txa ; Get modified L.O. byte again pha ; Push that rts ; Jump indexed (the hard way) stsn: lda #$01 ; Set srind for send parms sta srind ; ... lda #stscmd\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #stscmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error txa ; Get offset in AC clc ; Clear the carry flag adc #\ ; Add in L.O. byte of jump table tax ; Hold it here for a while lda #stcct^ ; Get H.O. byte adc #$00 ; Add in carry if there is any pha ; Push it on the stack txa ; Get modified L.O. byte again pha ; Push that rts ; Jump indexed (the hard way) stcct: jmp stpdc ; Set send/rec padding character jmp stpad ; Set amount of padding on send/rec jmp stebq ; Set send/rec eight-bit-quoting character jmp steol ; Set send/rec end-of-line jmp stpl ; Set send/rec packet length jmp stqc ; Set send/rec quote character jmp sttim ; Set send/rec timeout stvt: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx vtmod ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stfw: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx filwar ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit steb: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx ebqmod ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stdb: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx debug ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stebq: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq steb1 ; It is, continue jmp kermt4 ; Bad number, tell them steb1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi steb2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad steb2: cmp #$21 ; First check the character range bmi steb4 ; Not in range cmp #$3f ; ... bmi steb3 ; Inrange cmp #$60 ; ... bmi steb4 ; Not in range steb3: ldx srind ; Get index for receive or send parms sta ebq,x ; Stuff it jmp kermit steb4: ldx #ermes5\ ; Get error message ldy #ermes5^ ; ... jsr prstr ; Print the error jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back steol: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq steo1 ; It is, continue jmp kermt4 ; Bad number, tell them steo1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi steo2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad steo2: ldx srind ; Fetch index for receive or send parms sta eol,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back stpad: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq stpd1 ; It is, continue jmp kermt4 ; Bad number, tell them stpd1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi stpd2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stpd2: ldx srind ; Get index (receive or send) sta pad,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back stpdc: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq stpc1 ; It is, continue jmp kermt4 ; Bad number, tell them stpc1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi stpc2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stpc2: ldx srind ; Get index for parms sta padch,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back stpl: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq stpl1 ; It is, continue jmp kermt4 ; Bad number, tell them stpl1: lda cmintg ; Get L.O. byte cmp #mxpack ; It shouldn't be bigger than this bmi stpl2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stpl2: ldx srind ; Get index sta psiz,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back stqc: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq stqc1 ; It is, continue jmp kermt4 ; Bad number, tell them stqc1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi stqc2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stqc2: ldx srind ; Fetch index for receive or send parms sta quote,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back sttim: ldx #$10 ; Base for ASCII value lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad lda cmintg+1 ; If this isn't zero cmp #$00 ; it's not an ASCII character beq sttm1 ; It is, continue jmp kermt4 ; Bad number, tell them sttm1: lda cmintg ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi sttm2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad sttm2: ldx srind ; Fetch index for receive or send parms sta time,x ; Stuff it jsr prcfm ; Go parse and print a confirm jmp kermit ; Go back stmod: lda #ftcmd\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #ftcmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error stx filmod ; Save the file-type mode lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stfbs: lda #fbskey\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #fbskey^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error stx fbsize ; Stuff the returned value into file-byte-size lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit .SBTTL Show routine ; ; This routine shows any of the operational parameters that ; can be altered with the set command. ; ; Input: Parameters from command line ; ; Output: Display parameter values on screen ; ; Registers destroyed: A,X,Y ; show: lda #shocmd\ ; Load address of keyword table sta cminf1 ; Save it for the keyword routine lda #shocmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Comnd code to parse keyword jsr comnd ; Go parse the keyword jmp kermt2 ; Bad keyword, go give an error txa ; Get the offset into the AC clc ; Clear carry for add adc #\ ; Add in L.O. byte of jump table tax ; Hold that here for a while lda #shocmb^ ; Get H.O. byte of address adc #$00 ; Add in carry, if any pha ; Push it on the stack txa ; Get modified L.O. byte pha ; Push that as well rts ; Jump indexed! shocmb: jsr prcfm ; Parse for confirm jsr shall ; Show all setable parameters jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shesc ; Show escape character jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shibm ; Show ibm-mode switch jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shle ; Show local-echo switch jmp kermit ; Go to top of main loop nop ; We should not parse for confirm nop ; since this routine parses for nop ; a keyword next jsr shrc ; Show receive parameters jmp kermit ; Go to top of main loop nop ; We should not parse for confirm nop ; since this routine parses for nop ; a keyword next jsr shsn ; Show send parameters jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shvt ; Show vt52-emulation mode switch jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shfw ; Show file-warning switch jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr sheb ; Show eight-bit-quoting switch jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shdb ; Show debugging mode switch jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shmod ; Show File mode jmp kermit ; Go to top of main loop jsr prcfm ; Parse for confirm jsr shfbs ; Show the file-byte-size jmp kermit ; Go to top of main loop shall: jsr shdb ; Show debugging mode switch jsr shvt ; Show vt52-emulation mode switch ; jsr shibm ; Show ibm-mode switch (not implemented) jsr shle ; Show local-echo switch jsr sheb ; Show eight-bit-quoting switch jsr shfw ; Show file-warning switch jsr shesc ; Show the current escape character jsr shmod ; Show the file-type mode jsr shfbs ; Show the file-byte-size jsr shrcal ; Show receive parameters jsr shsnal ; Show send parameters rts ; Return shdb: ldx #shin00\ ; Get address of message for this item ldy #shin00^ ; ... jsr prstr ; Print that message lda debug ; Get the switch value jmp pron ; Go print the 'on' or 'off' string shvt: ldx #shin01\ ; Get address of message for this item ldy #shin01^ ; ... jsr prstr ; Print that message lda vtmod ; Get the switch value jmp pron ; Go print the 'on' or 'off' string shibm: ldx #shin02\ ; Get address of message for this item ldy #shin02^ ; ... jsr prstr ; Print that message lda ibmmod ; Get the switch value jmp pron ; Go print the 'on' or 'off' string shle: ldx #shin03\ ; Get address of message for this item ldy #shin03^ ; ... jsr prstr ; Print that message lda lecho ; Get the switch value jmp pron ; Go print the 'on' or 'off' string sheb: ldx #shin04\ ; Get address of message for this item ldy #shin04^ ; ... jsr prstr ; Print that message lda ebqmod ; Get the switch value jmp pron ; Go print the 'on' or 'off' string shfw: ldx #shin05\ ; Get address of message for this item ldy #shin05^ ; ... jsr prstr ; Print that message lda filwar ; Get the switch value jmp pron ; Go print the 'on' or 'off' string shesc: ldx #shin06\ ; Get address of message ldy #shin06^ ; ... jsr prstr ; Print message lda escp ; Get the escape character jsr prchr ; Print the special character jsr prcrlf ; Print a crelf rts ; and return shsn: lda #$01 ; Set up index to be used later sta srind ; ... lda #stscmd\ ; Get the set option table address sta cminf1 ; and save it as a parm to cmkey lda #stscmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Code for keyword parse jsr comnd ; Try to parse it jmp kermt2 ; Invalid keyword stx kwrk01 ; Hold offset into jump table jsr prcfm ; Parse and print a confirm lda kwrk01 ; Get the value back clc ; Clear the carry flag adc kwrk01 ; Now double the value to provide the ; neccesary index clc ; Clear carry again adc #\ ; Add in L.O. byte of jump table tax ; Hold it temporarily here lda #shcmb^ ; Get H.O. byte adc #$00 ; Adjust for carry pha ; Push that txa ; Get L.O. byte pha ; Push that giving us a return address rts ; Jump indexed! shrc: lda #$00 ; Set up index to be used later sta srind ; ... lda #stscmd\ ; Get the set option table address sta cminf1 ; and save it as a parm to cmkey lda #stscmd^ ; ... sta cminf1+1 ; ... lda #cmkey ; Code for keyword parse jsr comnd ; Try to parse it jmp kermt2 ; Invalid keyword stx kwrk01 ; Hold offset into jump table jsr prcfm ; Parse and print a confirm lda kwrk01 ; Get the value back clc ; Clear the carry flag adc kwrk01 ; Now double the value to provide the ; neccesary index clc ; Clear carry again adc #\ ; Add in L.O. byte of jump table tax ; Hold it temporarily here lda #shcmb^ ; Get H.O. byte adc #$00 ; Adjust for carry pha ; Push that txa ; Get L.O. byte pha ; Push that giving us a return address rts ; Jump indexed! shcmb: jsr shpdc ; Show send/rec padding character jmp kermit ; Go back jsr shpad ; Show amount of padding for send/rec jmp kermit ; Go back jsr shebq ; Show send/rec eight-bit-quoting character jmp kermit ; Go back jsr sheol ; Show send/rec end-of-line character jmp kermit ; Go back jsr shpl ; Show send/rec packet length jmp kermit ; Go back jsr shqc ; Show send/rec quote character jmp kermit ; Go back jsr shtim ; Show send/rec timeout jmp kermit ; Go back shpdc: ldx #shin11\ ; Get address of 'pad char' string ldy #shin11^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda padch,x ; If index is 1, this gets spadch jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shpad: ldx #shin12\ ; Get address of 'padding amount' string ldy #shin12^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda pad,x ; If index is 1, this gets spad jsr prbyte ; Print the amount of padding jsr prcrlf ; Print a crelf after it rts shebq: ldx #shin08\ ; Get address of 'eight-bit-quote' string ldy #shin08^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda ebq,x ; If index is 1, this gets sebq jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts sheol: ldx #shin09\ ; Get address of 'end-of-line' string ldy #shin09^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda eol,x ; If index is 1, this gets seol jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shpl: ldx #shin10\ ; Get address of 'packet length' string ldy #shin10^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda psiz,x ; If index is 1, this gets spsiz jsr prbyte ; Print the packet length jsr prcrlf ; Print a crelf after it rts ; and return shqc: ldx #shin13\ ; Get address of 'quote-char' string ldy #shin13^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda quote,x ; If index is 1, this gets squote jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shtim: ldx #shin14\ ; Get address of 'timeout' string ldy #shin14^ ; ... jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda time,x ; If index is 1, this gets stime jsr prbyte ; Print the hex value jsr prcrlf ; Print a crelf after it rts shsnal: lda #$01 ; Set up index for show parms sta srind ; and stuff it here ldx #shin07\ ; Get address of 'send' string ldy #shin07^ ; ... jsr prstr ; Print it jsr prcrlf ; Print a crelf jsr shpdc ; Show the padding character jsr shpad ; Show amount of padding jsr shebq ; Show eight-bit-quote character jsr sheol ; Show end-of-line character jsr shpl ; Show packet-length jsr shqc ; Show quote character jsr shtim ; Show timeout length rts shrcal: lda #$00 ; Set up index for show parms sta srind ; and stuff it here ldx #shin15\ ; Get address of 'receive' string ldy #shin15^ ; ... jsr prstr ; Print it jsr prcrlf ; Print a crelf jsr shpdc ; Show the padding character jsr shpad ; Show amount of padding jsr shebq ; Show eight-bit-quote character jsr sheol ; Show end-of-line character jsr shpl ; Show packet-length jsr shqc ; Show quote character jsr shtim ; Show timeout length rts shmod: ldx #shin16\ ; Get address of 'timeout' string ldy #shin16^ ; ... jsr prstr ; Print that lda filmod ; Get the file-type mode cmp #$04 ; Is it >= 4? bmi shmod1 ; If not just get the string and print it lda #$03 ; This is the index to the file-type we want shmod1: tax ; Hold this index lda #kerftp\ ; Get the address if the file type strings sta kermbs ; And stuff it here for genmad lda #kerftp^ ; ... sta kermbs+1 ; ... lda #kerfts ; Get the string length pha ; Push that txa ; Fetch the index back pha ; Push that parm then jsr genmad ; call genmad jsr prstr ; Print the the string at that address jsr prcrlf ; Print a crelf after it rts shfbs: ldx #shin17\ ; Get address of 'file-byte-size' string ldy #shin17^ ; ... jsr prstr ; Print that lda fbsize ; Get the file-type mode beq shfbse ; It is in eight-bit mode ldx #shsbit\ ; Get address of 'SEVEN-BIT' string ldy #shsbit^ ; ... jsr prstr ; Print that jsr prcrlf ; then a crelf rts ; and return shfbse: ldx #shebit\ ; Get the address of 'EIGHT-BIT' string ldy #shebit^ ; ... jsr prstr ; Print the the string at that address jsr prcrlf ; Print a crelf after it rts .SBTTL Status routine ; ; This routine shows the status of the most recent transmission ; session. ; ; Input: NONE ; ; Output: Status of last transmission is sent to screen ; ; Registers destroyed: A,X,Y ; status: jsr prcfm ; Parse and print a confirm stat01: ldx #stin00\ ; Get address of first line of text ldy #stin00^ ; ... jsr prstr ; Print that lda schr ; Get low order byte of character count tax ; Put that in x lda schr+1 ; Get high order byte jsr prntax ; Print that pair in hex jsr prcrlf ; Add a crelf at the end ldx #stin01\ ; Get address of second line ldy #stin01^ ; ... jsr prstr ; Print it lda rchr ; Get L.O. byte of char count tax ; Stuff it here for the call lda rchr+1 ; Get H.O. byte jsr prntax ; Print that count jsr prcrlf ; Add a crelf at the end ldx #stin02\ ; Get L.O. address of message ldy #stin02^ ; Get H.O. byte jsr prstr ; Print message lda stot ; Get L.O. byte of count tax ; Save it lda stot+1 ; Get H.O. byte jsr prntax ; Print the count jsr prcrlf ; Add a crelf at the end ldx #stin03\ ; Get address of next status item message ldy #stin03^ ; ... jsr prstr ; Print it lda rtot ; Get the proper count (L.O. byte) tax ; Hold it here for the call lda rtot+1 ; Get H.O. byte jsr prntax ; Print the 16-bit count jsr prcrlf ; Add a crelf at the end jsr prcrlf ; Add a crelf at the end ldx #stin04\ ; Get address of overhead message ldy #stin04^ ; ... jsr prstr ; Print that message sec ; Get ready to calculate overhead amount lda stot ; Get total character count and sbc schr ; subtract off data character count tax ; Stuff that here for printing lda stot+1 ; ... sbc schr+1 ; ... jsr prntax ; Print it jsr prcrlf ; Add a crelf at the end ldx #stin05\ ; Get address of next overhead message ldy #stin05^ ; ... jsr prstr ; Print that sec ; Get ready to calculate overhead amount lda rtot ; Get total character count and sbc rchr ; subtract off data character count tax ; Stuff that here for printing lda rtot+1 ; ... sbc rchr+1 ; ... jsr prntax ; Print the count jsr prcrlf ; Add a crelf at the end jsr prcrlf ; Add a crelf at the end ldx #stin06\ ; Get message for 'last error' ldy #stin06^ ; ... jsr prstr ; Print the message jsr prcrlf ; Print a crelf before the error message lda #kerems ; Get the error message size pha ; Push it lda errcod ; Get the error message offset in table bmi stat02 ; If this is a DOS error, do extra adjusting pha ; Push that lda #erms0a\ ; Put the base address in kermbs sta kermbs ; ... lda #erms0a^ ; ... sta kermbs+1 ; ... jmp statle ; Go print the 'last error' encountered stat02: and #$7f ; Shut off H.O. bit beq stat03 ; If it is zero, we are done adjusting sec ; Decrement by one for the unused error code sbc #$01 ; ... stat03: pha ; Push that parameter lda #dskers\ ; Use 'dskers' as the base address sta kermbs ; ... lda #dskers^ ; ... sta kermbs+1 ; ... statle: jsr genmad ; Translate code to address of message jsr prstr ; Print the text of error message jsr prcrlf ; Add a crelf at the end jsr prcrlf ; Add a crelf at the end jmp kermit .SBTTL Packet routines - SPAK - send packet ; ; This routine forms and sends out a complete packet in the ; following format: ; ; ; ; Input: kerbf1- Pointer to packet buffer ; pdlen- Length of data ; pnum- Packet number ; ptype- Packet type ; ; Output: A- True or False return code ; spak: jsr home ; Clear the screen ldx #snin01\ ; Give the user info on what we are doing ldy #snin01^ ; ... jsr prstr ; Print the information lda pnum ; Get the packet number jsr prbyte ; and print that jsr prcrlf ; Output a crelf lda debug ; Is the debug option turned on? cmp #on ; ... bne spaknd ; Nope, skip debug stuff lda #$00 ; Option 0 jsr debg ; Do it spaknd: lda spadch ; Get the padding character ldx #$00 ; Init counter spakpd: cpx spad ; Are we done padding? bcs spakst ; Yes, start sending packet inx ; No, up the index and 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 clc ; Clear the carry adc #$03 ; Adjust it pha ; Save this to be added into stot clc ; Clear carry again adc #sp ; Make the thing a character sta chksum ; First item, start off chksum with it jsr telppc ; Send the character pla ; Fetch the pdlen and add it into the clc ; 'total characters sent' counter adc stot ; ... sta stot ; ... lda stot+1 ; ... adc #$00 ; ... sta stot+1 ; ... lda pnum ; Get the packet number clc ; ... adc #sp ; Char it pha ; Save it in this condition clc ; Clear carry adc chksum ; Add this to the checksum sta chksum ; ... pla ; Restore character jsr telppc ; Send it lda ptype ; Fetch the packet type and #$7f ; Make sure H.O. bit is off for chksum pha ; Save it on stack clc ; Add to chksum adc chksum ; ... sta chksum ; ... pla ; Get the original character off stack jsr telppc ; Send packet type ldy #$00 ; Initialize data count sty datind ; Hold it here spaklp: ldy datind ; Get the current index into the data cpy pdlen ; Check against packet data length, done? bmi spakdc ; Not yet, process another character jmp spakch ; Go do chksum calculations spakdc: lda (kerbf1),y ; Fetch data from packet buffer clc ; Add the character into the chksum adc chksum ; ... sta chksum ; ... lda (kerbf1),y ; Refetch data from packet buffer jsr telppc ; Send it inc datind ; Up the counter and index jmp spaklp ; Loop to do next character spakch: lda chksum ; Now, adjust the chksum to fit in 6 bits and #$c0 ; First, take bits 6 and 7 lsr a ; and shift them to the extreme right lsr a ; side of the AC lsr a ; ... lsr a ; ... lsr a ; ... lsr a ; ... clc ; Now add in the original chksum byte adc chksum ; ... and #$3f ; All this should be mod decimal 64 clc ; ... adc #sp ; Put it in printable range jsr telppc ; and send it lda seol ; Fetch the eol character jsr telppc ; Send that as the last byte of the packet lda debug ; Get debug switch cmp #on ; Do we have to do it? bne spakcr ; Nope, return lda #$01 ; Option 1 jsr debg ; Do the debug stuff spakcr: rts ; and return .SBTTL Packet routines - RPAK - receive a packet ; ; This routine receives a standard Kermit packet and 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: jsr gobble ; Gobble a line up from the port jmp rpkfls ; Must have gotten a keyboard interupt, fail jsr home ; Clear the screen ldx #rcin01\ ; Give the user info on what we are doing ldy #rcin01^ ; ... jsr prstr ; Print the information lda pnum ; Get the packet number jsr prbyte ; and print that jsr prcrlf ; Output a crelf lda debug ; Is debugging on? cmp #on ; ... bne rpaknd ; Nope, no debugging, continue lda #$02 ; Option 2 jsr debg ; Do debug stuff 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 jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Save it and #$7f ; Shut off H.O. bit cmp #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 #$06 ; Compare for <= 5 bmi rpklp2 ; If it still is, continue jmp rpkchk ; Otherwise, do the chksum calcs rpklp2: cmp #$05 ; Check fld bne rpkif1 ; If it is not 5, go check for SOH lda datind ; Fetch the data index cmp #$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 jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Save that here and #$7f ; Make sure H.O. bit is off cmp #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 #$04 ; Is it <= 3? bpl rpkswt ; No, go check the different cases now lda kerchr ; Yes, it was, get the character clc ; and add it into the chksum adc chksum ; ... sta chksum ; ... rpkswt: lda fld ; Now check the different cases of fld cmp #$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 #$01 ; Is it case 1? bne rpkc2 ; No, continue checking lda kerchr ; Yes, get the length of packet sec ; ... sbc #sp ; Unchar it sec ; ... sbc #$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 #$02 ; Case 2 (packet number)? bne rpkc3 ; If not, try case 3 lda kerchr ; Fetch the character sec ; ... sbc #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 #$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 #$04 ; Is it case 4??? bne rpkc5 ; No, try last case ldy #$00 ; Set up the data index sty datind ; ... rpkchl: ldy datind ; Make sure datind is in Y cpy pdlen ; Compare to the packet data length, done? bmi rpkif3 ; Not yet, process the character as data jmp rpkef ; Yes, go on to last field (chksum) rpkif3: cpy #$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 jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Store it here and #$7f ; Shut H.O. bit cmp #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 ; ... adc chksum ; Add it to the chksum sta chksum ; and save new chksum lda kerchr ; Get the character again ldy datind ; Get our current data index sta (kerbf1),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 #$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 #$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 adc chksum ; Add this into original chksum and #$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 sec ; Set carry for subtraction sbc #sp ; Unchar it cmp 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 ; ... ldx #erms15\ ; Create pointer to error text ldy #erms15^ ; ... jsr prstr ; Print the chksum error lda kerchr ; Print chksum from packet jsr prbyte ; ... lda #sp ; Space things out a bit jsr cout ; ... lda chksum ; Now get what we calculated jsr prbyte ; and print that rpkfls: lda debug ; Is debug switch on? cmp #on ; ... bne rpkfnd ; Return doing no debug stuff lda #$03 ; Option 3 jsr debg ; Output debug information rpkfnd: lda pdlen ; Get the packet data length clc ; and add it into the adc rtot ; 'total characters received' counter sta rtot ; ... lda rtot+1 ; ... adc #$00 ; ... sta rtot+1 ; ... lda #false ; Set up failure return rts ; and go back rpkret: lda debug ; Check debug switch cmp #on ; Is it on? bne rpkrnd ; No, return with no debug lda #$04 ; Yes, use option 4 jsr debg ; Print out the debug info rpkrnd: lda pdlen ; Get the packet data length clc ; and add it into the adc rtot ; 'total characters received' counter sta rtot ; ... lda rtot+1 ; ... adc #$00 ; ... sta rtot+1 ; ... lda #true ; Show a successful return rts ; and return rpkpe: ldx #erms16\ ; Set up pointer to error text ldy #erms16^ ; ... jsr prstr ; Print the error lda #$07 ; Load error code and store in errcod sta errcod ; ... jmp rpkfls ; Go give a false return .SBTTL DEBG - debugging output routines ; ; When the debugging option is turned on, these routines periodically ; display information about what data is being sent or received. ; ; Input: A- Action type ; Ptype- Packet type sent or received ; Pnum- Packet number sent or received ; Pdlen- Packet data length ; ; Output: Display info on current packet status ; ; Registers destroyed: A,X,Y ; debg: tax ; Hold the action code here sta debinx ; Save it here lda state ; Check the current state cmp #$00 ; If we just started this thing beq debgrf ; then we don't need debug output yet cmp #'C ; If the transmission state is 'complete' beq debgrf ; we don't need debug output either lda #kerrts\ ; Get base address of the routine name and sta kermbs ; action table so that we can calculate lda #kerrts^ ; the address of the routine name string sta kermbs+1 ; which we need. lda #kerrns ; Load the routine name size pha ; Push that txa ; Fetch the offset for the one we want pha ; And push that parameter jsr genmad ; Go generate the message address jsr prstr ; Now, go print the string lda ptype ; Get the current packet type pha ; Save this accross the routine calls ora #$80 ; Make sure H.O. bit is on before printing jsr cout ; Write that out jsr prcrlf ; Now write a crelf pla ; Get back the packet type sta debchk ; and start the checksum with that lda debinx ; Get the debug action index bne debg1 ; If not 'sending', continue jsr debprd ; Yes, go do some extra output debg1: cmp #$04 ; Have we just received a packet? bne debgrt ; No, just return jsr debprd ; Print the packet info debgrt: lda #true ; Load true return code into AC rts ; and return debgrf: lda #false ; Set up failure return rts ; and go back ; ; Debprd - does special information output including packet number, ; packet data length, the entire packet buffer, and the checksum ; of the packet as calculted by this routine. ; debprd: jsr prcrlf ; Start by giving us a new line ldx #debms1\ ; Get the first info message address ldy #debms1^ ; ... jsr prstr ; and print it jsr prcrlf ; New line ldx #debms2\ ; Get address of message text ldy #debms2^ ; ... jsr prstr ; Print it lda pnum ; Get the packet sequence number pha ; Save it on the stack for later jsr prbyte ; Print the hex value jsr prcrlf ; Output another crelf pla ; Fetch back the sequence number clc ; Clear carry for addition adc #$20 ; Make this value a printable character clc ; Clear carry again adc debchk ; Now add this into the checksum sta debchk ; and resave the checksum ldx #debms3\ ; Get the address of the next message to print ldy #debms3^ ; ... jsr prstr ; Print that one lda pdlen ; Get the packet data length pha ; Save it for the checksum calcs jsr prbyte ; Print the hex value to the screen jsr prcrlf ; New line pla ; Get the data length back clc ; Clear carry adc #$20 ; Make it a character clc ; Clear carry for addition again adc #$03 ; Add in the overhead clc ; Clear the carry one more time adc debchk ; Accumulate checksum and sta debchk ; resave it ldy #$ff ; Start Y with a -1 debprc: iny ; Increment the packet index cpy pdlen ; Are we done printing the packet data? bpl debdon ; If so, go finish up lda (kerbf1),y ; Otherwise, get next byte from packet clc ; Clear the carry adc debchk ; Add the data length into the checksum sta debchk ; and restore the checksum lda (kerbf1),y ; Otherwise, get next byte from packet jsr prchr ; Go output special character ldx #$01 ; Now print 1 space jsr prbl2 ; ... jmp debprc ; Go check next character debdon: jsr prcrlf ; Nes line ldx #debms4\ ; Get the address to the 'checksum' message ldy #debms4^ ; ... jsr prstr ; Print that message lda debchk ; Get the checksum and #$c0 ; Mask off everything but bits 6 and 7 lsr a ; Shift right to right justify lsr a ; ... lsr a ; ... lsr a ; ... lsr a ; ... lsr a ; ... clc ; Clear the carry flag for addition adc debchk ; Add in the original checksum value and #$3f ; Make calculations mod '$3f' jsr prbyte ; Print the hex value of the checksum jsr prcrlf ; Print two(2) crelfs jsr prcrlf ; ... rts ; and return .ifeq .SBTTL Dos routines ; ; These routines handle files and calls to the DOS ; ; ; This routine opens a file for either input or output. If it ; opens it for output, and the file exists, and file-warning is ; on, the routine will issue a warning and attempt to modify ; the filename so that it is unique. ; ; Input: A- Fncrea - open for read ; Fncwrt - open for write ; ; Output: File is opened or error is issued ; openf: pha ; Hold the parameter on the stack cmp #fncwrt ; Are we openning for output? beq openfw ; Open for output lda #$01 ; Open for input, doscmi must be non-zero sta doscmi ; so that we do not allocate the file jmp opnmfs ; Start moving the filename openfw: lda #on ; Set the 'first mod' switch sta dosffm ; in case we have to alter the filename lda filwar ; Get the file warning switch cmp #on ; Is it on? bne opnnlu ; If not, don't do the lookup opnlu: jsr lookup ; Do the lookup jmp opnnlu ; Lookup succeeded, fcb1 contains the filename lda dosffm ; Is this the first time through? cmp #on ; ... bne opnalt ; If not, continue ldx #erms1a\ ; Otherwise, print an error message since ldy #erms1a^ ; the file already exists jsr prstr ; ... opnalt: jsr alterf ; No good, go alter the filename jmp opnlu ; Try the lookup again opnnlu: lda #$00 ; Make doscmi zero so it allocates the file sta doscmi ; if it is not found opnmfs: ldy #$00 ; Move the filename from the FCB to opnmfn: lda fcb1,y ; the primary filename buffer in DOS ora #$80 ; Make sure this is negative ascii cmp #$80 ; Was the character a null? bne opnmfc ; If not, continue lda #hspace ; If so, make it a space opnmfc: sta primfn,y ; ... iny ; Up the buffer index once cpy #mxfnl+1 ; Done? bpl opnfil ; If so, leave jmp opnmfn ; Nope, continue move opnfil: lda filmod ; Use the file-type mode as the file-type jsr dosopn ; Open file with type-checking pla ; Get the parameter back cmp #fncwrt ; Are we writing? beq opnsiw ; If so, set the indices up for writing lda #mxdb ; Maximum DOS buffer size sta dsbind ; Stuff that in the index to initialize it lda #mxdb-1 ; ... sta dsbend ; Initialize end-of-buffer pointer lda #true ; If it returns here, there were no errors rts opnsiw: lda #$00 ; Set the index to zero sta dsbind ; ... lda #mxdb ; The end of buffer should be set to sta dsbend ; half the length of a DOS buffer lda #true ; Then return true rts ; ... ; ; Lookup - searches for a filename in a directory. It is used to ; support file warning during the opening of a file. ; lookup: lda #fcb1\ ; Get the address of the filename buffer sta fnadrl ; and stuff it where it will be found lda #fcb1^ ; by the 'locate' routine sta fnadrh ; ... jsr locent ; Go try to locate that file bcs locfnf ; File not found? We are in good shape lda #errfae ; Store the error code sta errcod ; ... jmp rskp ; Return with skip, we have to alter filename locfnf: rts ; Return without a skip ; ; Alterf - changes a filename in the filename buffer to make it unique. ; It accomplishes this in the following manner. ; ; 1) First time through, it finds the last significant character ; in the filename and appends a '.0' to it. ; ; 2) Each succeeding time, it will increment the trailing integer ; that it inserted the first time through. ; alterf: lda dosffm ; Get the 'first mod' flag cmp #on ; Is it on? beq altfm ; If it is, do an initial modification jmp altsm ; Otherwise, just increment the version altfm: lda #off ; Shut the 'first mod' flag off sta dosffm ; ... ldy #mxfnl ; Stuff the maximum filename length in y altgnc: lda fcb1,y ; Get the character from the buffer cmp #hspace ; Is it a space? bne altco ; If not, we can continue with the alteration dey ; Down the index once bpl altgnc ; Get the next character ldy #$00 ; There is no filename, so user 0 as the index altco: sty dosfni ; Save the filename index iny ; Increment it twice iny ; ... cpy #mxfnl ; Does this exceed the filename length? bpl altng ; Cannot do the alterations lda #'. ; Get the dot ora #$80 ; Make it negative ascii ldy dosfni ; Get the original index back iny ; Up it once sta fcb1,y ; Store the dot lda #$00 ; Zero the version count sta dosfvn ; ... iny ; Up the index again sty dosfni ; This will be saved for future alterations jsr altstv ; Go store the version in the filename rts ; and return altsm: ldx dosfvn ; Get the file version number inx ; Increment it stx dosfvn ; Save the new version number beq altng ; Cannot alter name txa ; Get the version number in the AC jsr altstv ; Go store the version rts ; And return altng: lda #$09 ; Store the error code sta errcod ; ... ldx kerosp ; Get the old stack pointer txs ; and restore it jmp kermit ; Go back to top of loop ; ; Altstv - stores the version number passed to it into the filename ; buffer at whatever position dosfni is pointing to. ; altstv: ldy dosfni ; Get the filename index pha ; Save the value lsr a ; Shift out the low order nibble lsr a ; ... lsr a ; ... lsr a ; ... jsr altstf ; Stuff the character pla ; Grab back the original value and #$0f ; Take the low order nibble iny ; Increment the filename index jsr altstf ; Stuff the next character rts ; and return altstf: ora #$b0 ; Make the character printable cmp #$ba ; If it is less than '9' bcc altdep ; then go depisit the character adc #$06 ; Put the character in the proper range altdep: sta fcb1,y ; Stuff the character rts ; and return ; ; Closef - closes the file which was open for transfer. If it was ; an output file, it will go write the last buffer if neccessary. ; closef: cmp #$00 ; If there were errors bne clonlb ; don't write the last buffer jsr clowlb ; Otherwise, write last buffer if non-empty clonlb: ldy #$00 ; Clear index clomfn: lda fcb1,y ; Move the filename to the primary sta primfn,y ; filename buffer iny ; Increment the buffer index once cpy #mxfnl+1 ; Done? bpl clofil ; If so, go close the file jmp clomfn ; Continue to move the filename in clofil: lda filmod ; Fetch the file type jsr dosclo ; Close it lda #true ; If we return to here, the close worked rts clowlb: lda dsbind ; Get the index beq clowlr ; Nothing in buffer, just return lda #fncwrt ; Get the 'write' function code sta opcod ; and stuff it in the file manager parms lda #$00 ; Make the range length sta rnglnh ; look like the buffer length less one dec dsbind ; ... lda dsbind ; ... sta rnglnl ; ... lda #sfntrn ; Subfunction is 'transfer range' of bytes sta subcod ; ... lda #dosbuf\ ;[3] Load the address of the DOS buffer sta fnadrl ;[3] into the appropriate location in the lda #dosbuf^ ;[3] file manager parameter list. sta fnadrh ;[3] ... jsr dosfmn ; Call the file manager cmp #dsener ; No errors? beq clowlr ; No errors, return ora #$80 ; Set H.O. bit since it is a DOS error sta errcod ; Store that clowlr: rts ; 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 bufil1: jsr fgetc ; Get a character from the file jmp bffchk ; Go check for actual end-of-file sta kerchr ; Got a character, save it lda ebqmod ; Check if 8-bit quoting is on cmp #on ; ... beq bufil2 ; If it is, see if we have to use it jmp bffqc ; Otherwise, check normal quoting only bufil2: lda kerchr ; Get the character and #$80 ; Mask everything off but H.O. bit beq bffqc ; H.O. bit was not on, so continue lda sebq ; H.O. bit was on, get 8-bit quote ldy datind ; Set up the data index sta (kerbf1),y ; Stuff the quote character in buffer iny ; Up the data index sty datind ; And save it lda kerchr ; Get the original character saved and #$7f ; Shut H.O. bit, we don't need it sta kerchr ; ... bffqc: lda kerchr ; Fetch the character and #$7f ;[2] When checking for quoting, use only 7 bits ; bpl bffqc0 ;[2] If >0, check against space w/o H.O. bit on ; cmp #hspace ;[2] Greater than space (H.O. bit on) ; bpl bffqc1 ;[2] If so, no quoting needed ; jmp bffctl ;[2] Check next possibility bffqc0: cmp #sp ; Is the character less than a space? bpl bffqc1 ; If not, try next possibility jmp bffctl ; This has to be controlified bffqc1: cmp #del ; Is the character a del? bne bffqc2 ; If not, try something else jmp bffctl ; Controlify it bffqc2: cmp squote ; Is it the quote character? bne bffqc3 ; If not, continue trying jmp bffstq ; It was, go stuff a quote in buffer bffqc3: cmp sebq ; Is it an 8-bit quote? bne bffstf ; Nope, just stuff the character itself jmp bffstq ; Go stuff a quote in the buffer bffctl: lda kerchr ;[2] Get original character back eor #$40 ; Ctl(AC) sta kerchr ; Save the character again bffstq: lda squote ; Get the quote character ldy datind ; and the index into the buffer sta (kerbf1),y ; Store it in the next location iny ; Up the data index once sty datind ; Save the index again bffstf: inc schr ; Increment the data character count bne bffsdc ; ... inc schr+1 ; ... bffsdc: lda kerchr ; Get the saved character ldy datind ; and the data index sta (kerbf1),y ; This is the actual char we must store iny ; Increment the index sty datind ; And resave it tya ; Take this index, put it in AC clc ; Clear carry for addition adc #$06 ; Adjust it so we can see if it cmp spsiz ; is >= spsiz-6 bpl 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 #$00 ; Is it zero? bne bffne ; Nope, just return tay ; Yes, this means the entire file has lda #true ; been transmitted so turn on sta eofinp ; the eofinp flag tya ; Get back the size of zero 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 pdlen ; Is it >= the packet data length? bmi bfemor ; No, there is more to come rts ; Yes, we emptied the buffer, return bfemor: lda #false ; Reset the H.O.-bit-on flag to false sta chebo ; ... ldy datind ; Get the current buffer index lda (kerbf1),y ; Fetch the character in that position sta kerchr ; Save it for the moment cmp rebq ; Is it the 8-bit quote? bne bfeqc ; No, go check for normal quoting lda ebqmod ; Is 8-bit quoting on? cmp #on ; ... bne bfeout ; No quoting at all, place char in file lda #true ; Set H.O.-bit-on flag to true sta chebo ; ... inc datind ; Increment the data index ldy datind ; Fetch it into Y lda (kerbf1),y ; Get the next character from buffer sta kerchr ; Save it bfeqc: cmp rquote ; Is it the normal quote character bne bfeceb ; No, pass this stuff up inc datind ; Increment the data index ldy datind ; and fetch it in the Y-reg lda (kerbf1),y ; Get the next character from buffer sta kerchr ; Save it and #$7f ;[2] Check only 7 bits for quote cmp rquote ; Were we quoting a quote? beq bfeceb ; Yes, nothing has to be done cmp rebq ;[2] Check for eight-bit quote char as well beq bfeceb ;[2] Skip the character adjustment lda kerchr ;[2] Fetch back the original character eor #$40 ; No, so controlify this again sta kerchr ; Resave it bfeceb: lda chebo ; Is the H.O.-bit-on flag lit? cmp #true ; ... bne bfeout ; Just output the character to the file lda kerchr ; Fetch the character ora #$80 ; Light up the H.O. bit sta kerchr ; Resave it bfeout: lda kerchr ; Get the character jsr fputc ; Go write it to the file jmp bfeerr ; Check out the error 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 bfeerr: sta errcod ; Store the erro code where it belongs and #$7f ; Shut off H.O. bit tay ; Save the error code here lda #kerdel ; Get the disk error message length pha ; Push that parameter dey ; Decrement the error code twice to make dey ; it correct for the disk error table tya ; Fetch it back pha ; Push that as an argument to genmad lda #dskers\ ; Get L.O. byte of base address sta kermbs ; and stuff it where it is expected lda #dskers^ ; Do the same for the H.O. byte address sta kermbs+1 ; ... jsr genmad ; Genereate the message address jsr prstr ; Go print that error message lda #false ; Indicate failure rts ; and return ; ; Getnfl - returns the next filename to be transferred. Currently ; it always return Eof to indicate there are no other files to ; process. ; getnfl: lda #eof ; No more files (return eof) rts ; ; Getfil - gets the filename from the receive command if one was ; parsed. Otherwise, it returns the name in the file header packet. ; getfil: lda usehdr ; Get the use-header switch cmp #on ; Is it on bne getfl1 ; If not, keep what we have in the fcb ldy #$00 ; Initialize the y reg lda pdlen ; Copy the packet data length sec ; Now subtract off the overhead sbc #$03 ; ... sta kwrk02 ; into a work area getfl0: lda (kerbf1),y ; Get a character from the packet buffer ora #$80 ; Turn on H.O. bit sta fcb1,y ; Stuff it in the fcb iny ; Up the index once cpy pdlen ; Are we finished? bmi getfl0 ; Nope, go do next byte getfl1: rts ; ; Fgetc - returns the next character from the file in the AC. It ; handles all of the low level disk I/O. Whenever it successfully ; gets a character, it skips on return. If it does not get a ; character, it doesn't skip. ; fgetc: ldx dsbind ; Get the file buffer index cpx dsbend ; Are we passed the last character? bmi fgtgnc ; Not quite yet, get next character lda #fncrea ; Load the file manager opcode (read) sta opcod ; ... lda #$00 ; Make the range length one sector sta rnglnh ; ... lda #mxdb-1 ; ... sta rnglnl ; ... lda #sfntrn ; Subfunction is transfer 'range of bytes' sta subcod ; ... lda #dosbuf\ ; Get the dos buffer and stuff that parm into sta fnadrl ; DOS' parm list lda #dosbuf^ ; ... sta fnadrh ; ... jsr dosfmn ; Do the read lda fmrcod ; Get the return code cmp #dsener ; Do we have an error? beq fgtset ; If not, go set up the pointers cmp #dseeod ; Did we hit 'End-of-data'? bne fgtcan ; Nope, this is a serious error, fail lda #mxdb-2 ; If the range length returned is 2 less than sec ; the DOS buffer size we are using sbc rnglnl ; then there is NO data left and it beq fgteof ; is a real EOF, go set the flag sta dsbend ; There is some data left to transmit lda #$00 ; Zero the index sta dsbind ; ... jmp fgtgnc ; Go return the next character jmp fgtgnc ; Skip the normal index and end reset fgtset: lda #$00 ; No errors, zero sta dsbind ; the index lda #mxdb-1 ; Stuff (max_buflen - 1) into end-of-buffer ptr sta dsbend ; ... fgtgnc: ldx dsbind ; Fetch the current index lda dosbuf,x ; Get the character at that point inc dsbind ; Increment the index ldx fbsize ; Get the file-byte-size cpx #fbsbit ; Is it seven-bit? bne fgtexi ; If not, leave with the character intact and #$7f ; Shut off the H.O. byte fgtexi: jmp rskp ; Do a skip return fgteof: lda #true ; Set the eof indicator on sta eofinp ; ... lda #$00 ; Return nul for a character rts fgtcan: jmp fatal ; Just go give an error ; ; Fputc - takes a character passed to it in the AC and writes it ; to the file being transferred in. ; fputc: ldx fbsize ; Get the file-byte-size cpx #fbsbit ; Is it seven-bit? bne fptstc ; If not, just go store the character ora #$80 ; This should be negative ascii fptstc: ldx dsbind ; Fetch the buffer index sta dosbuf,x ; Stuff the character in the buffer inc dsbind ; Up the index once lda dsbind ; Get the current index cmp #mxdb ; If that is equal to the DOS buffer length... beq fptwrt ; We just filled last position, write buffer lda #$00 ; Clear AC, no error jmp rskp ; Do a skip return fptwrt: lda #fncwrt ; Get the 'write' function code sta opcod ; and stuff it in the file manager parms lda #$00 ; Make the range length sta rnglnh ; look like the buffer length less one lda #mxdb-1 ; ... sta rnglnl ; ... lda #sfntrn ; Subfunction is 'transfer range' of bytes sta subcod ; ... lda #dosbuf\ ; Get the dos buffer and stuff that parm into sta fnadrl ; DOS' parm list lda #dosbuf^ ; ... sta fnadrh ; ... jsr dosfmn ; Call the file manager lda fmrcod ; Fetch the return code from the last call cmp #dsener ; No errors? beq fptrst ; No errors! reset everything jmp fatal ; The error was probably bad, handle it fptrst: lda #mxdb-1 ; Set last character to one less than actual sta dsbend ; buffer size lda #$00 ; Clear sta dsbind ; the buffer index jmp rskp ; Do a skip return .endc .SBTTL Utility routines ; ; The following routines are short low-level routines which help ; shorten the code and make it more readable ; ; ; Incn - increment the packet sequence number expected by this ; Kermit. Then take that number Mod $3f. ; incn: pha ; Save AC lda n ; Get the packet number clc ; Clear the carry flag for the add adc #$01 ; Up the number by one and #$3f ; Do this Mod $3f! sta n ; Stuff the number where it belongs pla ; Restore the AC rts ; and return ; ; Gobble - snarfs a line of characters from the port up to ; the receive end-of-line character. If it sees a keyboard ; interupt, it punts and does not skip. ; gobble: lda #$00 sta pdtend ; Zero the index pointing to end of line buffer gobb0: jsr getc ; Get a character jmp gobb1 ; Got a keyboard interupt cmp reol ; Is it the end-of-line character? beq gobb2 ; Yes, finish up ldx pdtend ; Get the index we need sta plnbuf,x ; Stuff the character at the buffer inc pdtend ; Increment the index once jmp gobb0 ; Loop for another character gobb1: rts ; Just return, no skip gobb2: lda #$00 ; Zero the index, leave eob ptr where it is sta pdtind ; ... jmp rskp ; Return with a skip! ; ; Getplc - gets a character from the port line buffer and ; returns it. If the buffer is empty, it returns without ; skipping. ; getplc: ldx pdtind ; Get the current index cpx pdtend ; Less than the end buffer pointer? bmi getpl1 ; If so, go return the next character rts ; Return without a skip getpl1: lda plnbuf,x ; Get the next character from the buffer inc pdtind ; Up the index once jmp rskp ; Return with a skip! .ifeq ; ; Getc - skip returns with a character from the port or does ; a normal return if a key from the keyboard is received first. ; If it skips, the character from the port is returned in the ; AC. ; getc: jsr telck ; No character from keyboard? cmp #false ; ... beq getc1 ; If not try port lda kbd ; Get the key and #$7f ; Shut H.O. bit cmp #'Q ; Was it an 'abort' interupt? bne getc0 ; Nope, continue lda #$08 ; Error code for 'file trans abort' sta errcod ; Stuff it here ldx kerosp ; Get the old stack pointer back txs ; Restore it jmp kermit ; Warmstart kermit getc0: bit kbdstr ; and reset the strobe rts ; Keyboard interupt, return getc1: jsr telcp ; Check the port cmp #false ; If there was no character beq getc ; go back to the top of the loop jsr telgpc ; Go get the port character jmp rskp ; and return skip! ; ; Telck - checks the keyboard for a character. It returns ; false if none is present, otherwise it returns true. ; It does NOT return the character. ; telck: bit kbd ; Check the keyboard bpl telckf ; No character lda #true ; There is a character there rts ; Return true telckf: lda #false ; No character, failure return rts ; Go back .endc ; ; Prson - parses an 'on' or an 'off' keyword and passes ; the result back to the calling routine in the x-index ; register. If there is an error, it pops the return ; address off the stack and transfers control to kermt2 ; to issue the error message. ; prson: lda #oncmd\ ; L.O. byte of command table sta cminf1 ; Store that lda #oncmd^ ; Get H.O. byte of command table address sta cminf1+1 ; Stuff that parameter lda #cmkey ; Code for keyword jsr comnd ; Go do it rts ; The command was not recognized nop ; ... nop ; ... jmp rskp ; Good, skip return ; ; prcfm - parses for a confirm, then transfers control directly ; to the top of the main loop ; prcfm: lda #cmcfm ; Load token for confirm jsr comnd ; Parse a confirm jmp kermt3 ; No confirm, give an error lda #hcr ; Print a crlf jsr cout ; ... rts ; Return ; ; Pron - checks the value in the AC and prints either 'ON' or ; 'OFF'. (on=1, off=0). ; pron: cmp #on ; Should we print 'on'? bne pron1 ; No, go print 'off' ldx #shon\ ; Point to the 'on' string ldy #shon^ ; ... pron0: jsr prstr ; Print it jsr prcrlf ; Add a crelf at the end rts ; And return pron1: ldx #shoff\ ; Point to the 'off' string ldy #shoff^ ; ... jmp pron0 ; Go print it ; ; Nonftl - handles non-fatal DOS errors. When Kermit does its ; initialization it points the error vector and the basic ; warmstart vector here. ; nonftl: lda fmrcod ; Get the DOS return code ora #$80 ; Make sure H.O. bit is on (DOS error) sta errcod ; Save that here ldx kerosp ; Get the old stack pointer back txs ; Restore it jmp kermit ; Warmstart kermit ; ; Fatal - closes and deletes a file on which a bad error ; has occured (most likely a 'disk full' error). It then ; restores the old stack pointer and warmstarts Kermit. ; fatal: lda fmrcod ; Get the DOS return code ora #$80 ; Set H.O. bit to indicate DOS error sta errcod ; Store the error code lda #$01 ; Make sure 'closef' knows there was an error jsr closef ; Close the file jsr dosdel ; Now, delete the useless file ldx kerosp ; Get the old stack pointer txs ; Restore it jmp kermit ; Warmstart kermit ; ; Prchr - takes a character from the AC and prints it. It ; echos control characters as '^' and escape as '$'. ; prchr: ora #$80 ; Make sure it's in range cmp #$9b ; Less than escape?? bpl prchr1 ; If not, continue tax ; Hold the character lda #'^ ; Load the up-arrow for cntrl characters ora #$80 ; Put it in printable range jsr cout ; Print the character txa ; Get the character back clc ; Clear carry for add adc #$40 ; Put this in the alphabetic range jsr cout ; and print it rts ; Done, go back prchr1: bne prchr2 ; Maybe it is an escape? lda #'$ ; If it is, echo it as a '$' ora #$80 ; Make sure it's printable jsr cout ; Output the character rts ; Return prchr2: jsr cout ; Normal character, just dump it rts ; and go back ; ; Genmad - takes a message base, offset and size and calculates ; the address of the message leaving it in the X and Y registers ; ready for a call to PRSTR. The size and offset are taken from ; the stack and the base address is found in kermbs. ; genmad: pla ; Get return address sta kerrta ; and save it till later pla ; ... sta kerrta+1 ; ... pla ; Get message offset tax ; Hold it here for a while pla ; Get the message length tay ; and put it here lda #$00 ; H.O. byte of message offset for mul16 pha ; ... txa ; L.O. byte of message offset pha ; ... lda #$00 ; H.O. byte of message size for mul16 pha ; ... tya ; L.O. byte of message size pha ; ... jsr mul16 ; Calculate the actual offset in table pla ; Get L.O. byte of result clc ; Clear the carry for addition adc kermbs ; Add the L.O. byte of the base address tax ; Put it in X for the return pla ; Get the H.O. byte adc kermbs+1 ; Add the H.O. byte of the base address w/carry tay ; Stuff it here for the return lda kerrta+1 ; Replace the return address on the stack pha ; ... lda kerrta ; ... pha ; ... rts ; Return .SBTTL Spar and Rpar routines ; ; 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: ldy #$00 ; Clear Y sty datind ; Clear datind lda rpsiz ; Fetch receive packet size clc ; Clear the carry flag adc #$20 ; Characterize it sta (kerbf1),y ; Stuff it in the packet buffer iny ; Increment the buffer index lda rtime ; Get the timeout interval clc ; ... adc #$20 ; Make that a printable character sta (kerbf1),y ; and stuff it in the buffer iny ; Advance the index lda rpad ; Get the amount of padding required clc ; ... adc #$20 ; Make that printable sta (kerbf1),y ; Put it in the buffer iny ; Advance index lda rpadch ; Get the padding character expected eor #$40 ; Controlify it sta (kerbf1),y ; And stuff it iny ; Up the packet buffer index lda reol ; Get the end-of-line expected clc ; ... adc #$20 ; Characterize it sta (kerbf1),y ; Place that next in the buffer iny ; Advance the index lda rquote ; Get the quote character expected sta (kerbf1),y ; Store it as-is last in the buffer iny ; Advance index lda rebq ; Get eight-bit-quote character sta (kerbf1),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 #$00 ; Start the data index at 0! lda (kerbf1),y ; Start grabbing data from packet buffer sec ; Uncharacterize it sbc #$20 ; ... sta spsiz ; That must be the packet size of other Kermit iny ; Increment the buffer index lda (kerbf1),y ; Get the next item sec ; ... sbc #$20 ; Uncharacterize that sta stime ; Other Kermit's timeout interval iny ; Up the index once again lda (kerbf1),y ; Get next char sec ; ... sbc #$20 ; Restore to original value sta spad ; This is the amount of padding he wants iny ; Advnace index lda (kerbf1),y ; Next item eor #$40 ; Uncontrolify this one sta spadch ; That is padding character for other Kermit iny ; Advance index lda (kerbf1),y ; Get next item of data cmp #$00 ; If it is equal to zero beq rpar2 ; Use as a default jmp rpar3 ; ... rpar2: lda #cr ; Get value of sta seol ; That will be the eol character jmp rpar4 ; Continue rpar3: sec ; ... sbc #$20 ; unchar the character sta seol ; That is the eol character other Kermit wants rpar4: iny ; Advance the buffer index lda (kerbf1),y ; Get quoting character cmp #$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 iny ; Advance the index lda (kerbf1),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 .SBTTL Message text .ifeq versio: nasc 1 .endc .SBTTL Command tables and help text kercmd: .byte $09 ; Table length ; .byte $0a ; Table length with LOG command installed .byte $07 ; Keyword length .asciz /CONNECT/ ; Keyword terminated with a null .byte $00,$00 ; Two bytes of data .byte $04 .asciz /EXIT/ .byte $03,$03 .byte $04 .asciz /HELP/ .byte $06,$06 ; .byte $03 ; Not implemented yet ; .asciz /LOG/ ; .byte $09,$09 .byte $04 .asciz /QUIT/ .byte $0C,$0C .byte $07 .asciz /RECEIVE/ .byte $0F,$0F .byte $04 .asciz /SEND/ .byte $12,$12 .byte $03 .asciz /SET/ .byte $15,$15 .byte $04 .asciz /SHOW/ .byte $18,$18 .byte $06 .asciz /STATUS/ .byte $1B,$1B setcmd: .byte $0a ; .byte $0b ; Table length with IBM option in .byte $09 .asciz /DEBUGGING/ .byte $18,$18 .byte $11 .asciz /EIGHT-BIT-QUOTING/ .byte $15,$15 .byte $06 .asciz /ESCAPE/ .byte $00,$00 .byte $0e .asciz /FILE-BYTE-SIZE/ .byte $1e,$1e .byte $09 .asciz /FILE-TYPE/ .byte $1b,$1b .byte $0C .asciz /FILE-WARNING/ .byte $12,$12 ; .byte $03 ; Not yet implemented ; .asciz /IBM/ ; .byte $03,$03 .byte $0A .asciz /LOCAL-ECHO/ .byte $06,$06 .byte $07 .asciz /RECEIVE/ .byte $09,$09 .byte $04 .asciz /SEND/ .byte $0C,$0C .byte $0E .asciz /VT52-EMULATION/ .byte $0F,$0F shocmd: .byte $0b ; .byte $0c ; Table length with IBM option included .byte $03 .asciz /ALL/ .byte $00,$00 .byte $09 .asciz /DEBUGGING/ .byte $51,$51 .byte $11 .asciz /EIGHT-BIT-QUOTING/ .byte $48,$48 .byte $06 .asciz /ESCAPE/ .byte $09,$09 .byte $0e .asciz /FILE-BYTE-SIZE/ .byte $63,$63 .byte $09 .asciz /FILE-TYPE/ .byte $5a,$5a .byte $0C .asciz /FILE-WARNING/ .byte $3f,$3f ; .byte $03 ; Not yet implemented ; .asciz /IBM/ ; .byte $12,$12 .byte $0A .asciz /LOCAL-ECHO/ .byte $1b,$1b .byte $07 .asciz /RECEIVE/ .byte $24,$24 .byte $04 .asciz /SEND/ .byte $2d,$2d .byte $0E .asciz /VT52-EMULATION/ .byte $36,$36 stscmd: .byte $07 .byte $14 .asciz /EIGHT-BIT-QUOTE-CHAR/ .byte $06,$06 .byte $0B .asciz /END-OF-LINE/ .byte $09,$09 .byte $0D .asciz /PACKET-LENGTH/ .byte $0C,$0C .byte $08 .asciz /PAD-CHAR/ .byte $00,$00 .byte $07 .asciz /PADDING/ .byte $03,$03 .byte $0A .asciz /QUOTE-CHAR/ .byte $0F,$0F .byte $07 .asciz /TIMEOUT/ .byte $12,$12 ftcmd: .byte $04 .byte $09 .asciz /APPLESOFT/ .byte $02,$02 .byte $06 .asciz /BINARY/ .byte $04,$04 .byte $07 .asciz /INTEGER/ .byte $01,$01 .byte $04 .asciz /TEXT/ .byte $00,$00 fbskey: .byte $02 .byte $09 .asciz /EIGHT-BIT/ .byte $00,$00 .byte $09 .asciz /SEVEN-BIT/ .byte $01,$01 oncmd: .byte $02 .byte $02 .asciz /ON/ .byte $01,$01 .byte $03 .asciz /OFF/ .byte $00,$00 yescmd: .byte $02 .byte $02 .asciz /NO/ .byte $00,$00 .byte $03 .asciz /YES/ .byte $01,$01 kerhlp: .byte hcr nasc 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < THE HOST OPERATING SYSTEM.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < VARIOUS COMMANDS AVAILABLE> 0 .byte hcr nasc < IN KERMIT.> 0 .byte hcr .byte hcr nasc 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < FROM THE REMOTE HOST.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < BASED COMPUTER TO THE REMOTE> 0 .byte hcr nasc < HOST.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < SUCH AS DUBBUGING MODE, EOL> 0 .byte hcr nasc < CHARACTER, AND TRANSMISSION> 0 .byte hcr nasc < DELAY.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < ESTABLISHED BY THE SET> 0 .byte hcr nasc < COMMAND.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < LAST FILE TRANSFER.> 0 .byte hcr,nul inthlp: nasc 0 .byte hcr nasc < ? - THIS HELP MESSAGE> 0 .byte hcr nasc < C - CLOSE THE CONNECTION> 0 .byte hcr nasc < S - STATUS> 0 .byte hcr,nul .SBTTL Message text ermes1: .byte hcr nasc 1 ermes2: .byte hcr nasc 1 ermes3: .byte hcr nasc 1 ermes4: .byte hcr nasc 1 ermes5: .byte hcr nasc 1 ermes6: .byte hcr nasc 1 ermes7: .byte hcr nasc 1 ermes8: .byte hcr nasc 1 ermes9: .byte hcr nasc 1 erms0a: nasc < > 1 erms10: nasc 1 erms11: nasc 1 erms12: nasc 1 erms14: nasc 1 erms15: nasc 1 erms16: nasc 1 erms17: nasc <8-BIT QUOTING REFUSED > 1 erms18: nasc 1 erms19: nasc 1 erms1a: nasc 1 .ifeq dskers: nasc < > 1 nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 kerftp: nasc 1 nasc 1 nasc 1 nasc 1 .endc kerrts: nasc 1 nasc 1 nasc 1 nasc 1 nasc 1 debms1: nasc 1 debms2: nasc < SEQ NUMBER > 1 debms3: nasc < NUMBER OF DATA CHARS > 1 debms4: nasc < PACKET CHECKSUM > 1 snin01: nasc 1 rcin01: nasc 1 shin00: nasc 1 shin01: nasc 1 shin02: nasc 1 shin03: nasc 1 shin04: nasc 1 shin05: nasc 1 shin06: nasc 1 shin07: nasc 1 shin08: nasc < EIGHT-BIT-QUOTING CHAR IS > 1 shin09: nasc < END-OF-LINE CHAR IS > 1 shin10: nasc < PACKET-LENGTH IS > 1 shin11: nasc < PADDING CHAR IS > 1 shin12: nasc < AMOUNT OF PADDING IS > 1 shin13: nasc < QUOTE CHAR IS > 1 shin14: nasc < TIMEOUT CHAR IS > 1 shin15: nasc 1 shin16: nasc 1 shin17: nasc 1 shon: nasc 1 shoff: nasc 1 shsbit: nasc 1 shebit: nasc 1 stin00: nasc 1 stin01: nasc 1 stin02: nasc 1 stin03: nasc 1 stin04: nasc 1 stin05: nasc 1 stin06: nasc 1 inf01a: nasc <[CONNECTING TO HOST: TYPE > 1 inf01b: nasc < TO RETURN]> 1 .SBTTL End of Kermit-65 Source .end