.TITLE KERMIT-65 KL10 Error-free Reciprocol Micro-interface Transfer .SBTTL 6502 version - Antonino N. J. Mione/PT/MP/TH ; Version 2.1 ; Based on the KERMIT Protocol. .SBTTL Define start address for assembly .=$801 ;[39] Start assembly at hex 801 .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. ; ; ; 4 By: Antonino N.J. Mione On: 17-MAY-1983 ; Reduce max packet length by one so we don't get ; a character when we quote it. ; Make escape sequence read '^''C'. ; Make VT52-EMULATION be ON by default. ; ; ; 5 By: Antonino N.J. Mione On: 27-JUN-1983 ; Make the default time-out interval default to a ; reasonable amount of time instead of 0. The default ; is now 15 seconds for both send and receive. ; ; ; 6 By: Antonino N.J. Mione On: 28-JUN-1983 ; Make Kermit locate the actual end-of-file instead ; of sending blindly to the end of the last sector ; of the file. ; ; ; 7 By: Antonino N.J. Mione On: 28-JUN-1983 ; Don't send trailing spaces in the file header ; packets. ; ; ; 8 By: Antonino N.J. Mione On: 28-JUN-1983 ; Convert to line terminator on the way ; out and to on the way in for text ; files. ; ; ; 9 By: Antonino N.J. Mione On: 29-JUN-1983 ; Account for carry in jump table calculations for ; those cases where the table starts on a page ; boundary. ; ; ; 10 By: Antonino N.J. Mione On: 21-JUL-1983 ; Fix edit [7] so that it works all the time. The ; operand in the compare should be immediate since ; a space is what we are looking for. ; ; ; 11 By: Antonino N.J. Mione On: 25-JUL-1983 ; Fix how we set eight-bit quoting from the init ; packet. Also, make sure we don't quote the 8-bit ; quote character unless 8-bit quoting is turned on. ; ; VERSION 1.1 Starts here ; ; 12 By: Antonino N.J. Mione On: 22-SEP-1983 ; Add 'SET SLOT' and 'SHOW SLOT' commands to make ; the I/O port settable by the user. Add ; 'SET DEVICE-DRIVER' and 'SHOW DEVICE-DRIVER' ; commands to make the I/O device user-selectable. ; Also, make some of the option initialization ; static as opposed to wasting instructions on it. ; ; ; 13 By: Antonino N.J. Mione On: 05-OCT-1983 ; Alter the calling sequence for some references ; to Comnd. This is due to a standardization of the ; parameter calling and returning conventions. ; ; ; 14 By: Antonino N.J. Mione On: 11-OCT-1983 ; Add code for Kermit-65 to talk to a Server-mode ; Kermit. Includes the new commands 'BYE', 'FINISH', ; and 'GET'. ; ; ; 15 By: Antonino N.J. Mione On: 26-OCT-1983 ; For cases where 8-bit quote is 'Y' or 'N' make ; sure that Rpar places the value in Sebq AND sets ; 8-bit quoting off. ; ; ; 16 By: Antonino N.J. Mione On: 26-OCT-1983 ; Change display during transfers to show a total ; packet count as oppossed to the packet number being ; sent in the packet itself. ; ; ; 17 By: Antonino N.J. Mione On: 31-OCT-1983 ; Make Kermit suppress printing s while CONNECTed ; to a host which sends as a line terminator. ; ; ; 18 By: Antonino N.J. Mione On: 31-OCT-1983 ; Move call to Closef before code to send ACK in Rdat ; after the Eof-packet has been received. This will ; fix the problem with Kermit-65 hanging just before ; the break packet. ; ; ; 19 By: Antonino N.J. Mione On: 31-OCT-1983 ; Fix Closef right by making it insert the filename ; into the buffer in negative ascii. Previously, DOS ; was running out of buffers on long sessions because ; the files being transferred were not being closed ; and thus the buffers were not being released. ; ; ; 20 By: Antonino N.J. Mione On: 01-NOV-1983 ; Make sure Pdlen does not get clobbered. Make Pdbuf ; long enough for a full packet. It was 2 characters ; too short. ; ; ; 21 By: Antonino N.J. Mione On: 02-NOV-1983 ; Add IBM-mode support. ; ; ; 22 By: Mark Paczkowski On: 03-NOV-1983 ; Put in support for super serial card. ; ; ; 23 By: Antonino N.J. Mione On: 03-NOV-1983 ; Put checks into the command parser to ensure that ; the command buffer does not overflow. ; ; ; 24 By: Antonino N.J. Mione On: 03-NOV-1983 ; Fix local-echo so that the H.O. bit is one when ; printing the character locally. ; ; ; 25 By: Antonino N.J. Mione On: 15-NOV-1983 ; Change the way Kermit sends packets. Build up the ; entire packet first, then send it all at once. ; ; ; 26 By: Antonino N.J. Mione On: 15-NOV-1983 ; Implement Terse-mode debugging. ; ; ; 27 By: Antonino N.J. Mione On: 18-NOV-1983 ; Make 'gobble' smarter so it sees start-of-header ; as well as end-of-line. This aids us in talking ; to crufty IBM machines. ; ; ; 28 By: Antonino N.J. Mione On: 28-NOV-1983 ; Make sure the primary filename buffer is space ; filled after the filename. ; ; ; 29 By: Antonino N.J. Mione On: 28-NOV-1983 ; Make sure fcb is cleared so that filename does not ; get currupted. ; ; ; 30 By: Antonino N.J. Mione On: 28-NOV-1983 ; Make this look like Version 2.0. Fix the Version ; message. ; ; VERSION 2.0 Starts here ; ; 31 By: Peter Trei On: 10-Feb-1984 ; Added support for visible cursor. See CURON and ; CUROFF routines. ; oc.trei%cu20b@columbia-20 ; ; ; 32 By: Peter Trei On: 12-Feb-1984 ; Fixed bug in SSC support software; altered RRF ; flag mask from $#04 to $#08. ; oc.trei%cu20b@columbia-20 ; ; ; 33 By: Peter Trei On: 21-FEB-1984 ; Corrected definitions of BASL and BASH. ; oc.trei%cu20b@columbia-20 ; ; ; 34 By: Peter Trei On: 23-FEB-1984 ; Adjustments to make uppercase and weird chars appear ; inverse. ; ; ; 35 By Peter Trei On: 17-MAR-84 ; Installed CHRCON routine to allow the 2/2+ ; keyboard to enter lowercase, rubout, and other ; 'missing' characters. This also involved adding the ; 'SET KEYBOARD' switch, with positions for 2P and 2E. ; ; ; 36 By: Antonino N.J. Mione On: 22-JUN-1984 ; Make the FILE-BYTE-SIZE default sensible (i.e. ; Seven-bit since we are defaulting the FILE-TYPE-MODE ; to TEXT). ; ; ; 37 By: Antonino N.J. Mione On: 25-JUN-1984 ; Fix 'Get' so that the first time it is used, ; it will work. ; ; ; 38 By: Antonino N.J. Mione On: 25-JUN-1984 ; Handle error packet processing correctly. ; ; ; 39 By: Tim Heuser On: 26-JUN-1984 ; Start assembly at $801 so we don't break Applesoft. ; ; ; 40 By: Antonino N.J. Mione On: 29-JUN-1984 ; Add capability to set drive for file transfers. ; Added the 'SET DEFAULT-DISK' and 'SHOW DEFAULT-DISK' ; commands. ; ; ; 41 By: Antonino N.J. Mione On: 29-JUN-1984 ; Add capabilities to code which processes Escaping ; from CONNECT mode. Give user ability to send a ; BREAK signal, a nul character, or the Escape ; character itself. Also, add these to the online ; help message. ; ; ; 42 By: Antonino N.J. Mione On: 02-JUL-1984 ; Fix the 'GET' command. When receiving files, have ; KERMIT-65 use the filenames from the File-header ; packets. ; ; ; 43 By: Antonino N.J. Mione On: 11-JUL-1984 ; Clear the FCB when fetching a filename from the ; packet buffer. Previously when receiving files, ; if subsequent filenames where shorter than filenames ; in the beginning of the session, the name of the ; file created on disk would be incorrect. ; ; ; 44 By: Antonino N.J. Mione On: 12-JUL-1984 ; Fix 'No buffers available' problem when doing ; >3 SENDs in one session. Make the SDAT routine ; reset the eofinp flag and close the file when ; the BUFILL routine returns an end-of-file. ; ; ; 45 By: Antonino N.J. Mione On: 12-JUL-1984 ; Make version read '2.1'. ; ; VERSION 2.1 Established here ; ; 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 ; Include support for Apple Com card fthays = $01 ; Include support for D.C. Hayes modem ftssc = $01 ; Include support for Super Ser card .SBTTL Kermit feature test options ftcom = ftappl ; Assemble for Apple ][ under DOS 3.3 .SBTTL Macro definitions ; ; Nasc - This macro produces negative ascii text from ; the argument string passed to it. A zero or one option ; is specified after the string. If the option is one, ; nasc adds a null to the end of the string putting it ; in ASCIZ format. ; .macro nasc str opt .irpc chr .byte ''chr!$80 .endr .ifnz .byte nul .endc .endm .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 ; lftarw = $08 ;[35] tab = $09 ; (ctrl/I) lf = $0a ; ffd = $0c ; Form feed cr = $0d ; ctrlu = $15 ; rhtarw = $15 ;[35] ctrlx = $18 ;[0] esc = $1b ; sp = $20 ; del = $7f ; hbs = $88 ; with H.O. bit on hctrlh = hbs ;[1] with H.O. bit on htab = $89 ; with H.O. bit on hlf = $8a ; with H.O. bit on hffd = $8c ; wiht H.O. bit on hcr = $8d ; with H.O. bit on hctrlu = $95 ; with H.O. bit on hctrlw = $97 ;[1] 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 hdquot = $a2 ;[1] '"' with H.O. bit on hapos = $a7 ;[1] Apostrophy with H.O. bit on hslash = $af ;[1] '/' with H.O. bit on hcolon = $ba ;[1] ':' with H.O. bit on hrabr = $be ;[1] '>' with H.O. bit on hquest = $bf ; '?' with H.O. bit on hquote = $e0 ;[1] "'" 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 = $28 ;[33] L.O.B. of base address of current line bash = $29 ;[33] H.O.B. of base address of current line bas2l = $2a ; Base address work area bas2h = $2b ; Base address work area ;[31] These two locs are in a 'hole' on page 0 which neither basic nor the ;[31] monitor use. obasl = $F9 ;[31] Save loc for cursor address obash = $FA ;[31] Save loc for cursor address .endc .SBTTL Flag definitions ; The following are flags passed in the Y register cmfehf = 1 ;[1] Extra help available cmfdff = 2 ;[1] Default value present .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 cmtxt = 8 ;[1] Token to parse for an unquoted string cmtok = 9 ;[1] Token to barse for a single char token .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 ; ... cmdptr = cminf2 ;[1] Pointer to default for parse 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 cmehpt = $1c ;[1] Pointer to help commands .SBTTL COMND package entry points ; ; The following addresses are locations in a jump table which ; dispatch to appropriate routines in the Comnd package. ; mul16 = comnd+3 ;[1] 16-bit multiply routine prcrlf = mul16+3 ;[1] Routine to print a crelf prstr = prcrlf+3 ;[1] Routine to print an ASCIZ string rskp = prstr+3 ;[1] Routine to skip 3 bytes on return setbrk = rskp+3 ;[1] Routine to set a break character in brkwrd rstbrk = setbrk+3 ;[1] Routine to reset break character in brkwrd .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 ml16 ; Dispatch to 16-bit multiply routine jmp prcl.0 ;[13] Dispatch to Prcrlf jmp prst.0 ;[13] Dispatch to Prstr jmp rskp.0 ;[13] Dispatch to Rskp jmp sbrk.0 ;[13] Dispatch to Setbrk jmp rbrk.0 ;[13] Dispatch to Rstbrk .SBTTL Storage Declarations ; ; Following is the storage declarations for the Comnd routines. ; cmbuf: .blkb $100 ;[13] Input command buffer atmbuf: .blkb $100 ;[13] Atombuffer, (for cmtxt and cmifil) lenabf: .byte ;[13] Length of atom in Atombuffer brkwrd: .blkb $16 ;[13] Break mask 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 cmcffl: .byte 0 ;[13] Non-zero when privious command failed cmfrcf: .byte 0 ;[13] Non-zero when signif. char has been seen cmccnt: .byte ; Non-zero if a significant char is found cmocnt: .byte ;[13] Saved length of command buffer cmoptr: .word ;[13] Saved ptr to command buffer for cmsflg: .byte ; Non-zero when the last char was a space cmstat: .byte ; Save area for parse type cmprmx: .byte ;[13] Hold area for Comnd parameters cmprmy: .byte ;[13] Hold area for Comnd flags cmkyln: .byte ; Keyword length cmtlen: .byte ; Test length (for ?-prompting) cmscrs: .byte ; Screen output switch cmentr: .byte ; Number of remaining entries in table cmehix: .byte ;[13] Index to extra help command buffer keylen: .byte ; Keyword length cmwrk1: .byte ; Command processing scratch area cmwrk2: .byte ; ... cmwrk3: .byte ; ... cmwrk4: .byte ; ... .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: X - L.O. byte address of prompt ; Y - H.O. byte address of prompt ; ; 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 ; ... stx cm.rty ;[13] Save address of the prompt in sty cm.rty+1 ;[13] the pointer to the ctrl/r text tsx ; Get the stack pointer stx cmostp ; Save it for later restoral 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: lda cm.ptr ;[13] Store old command line pointer sta cmoptr ;[13] ... lda cm.ptr+1 ;[13] ... sta cmoptr+1 ;[13] ... lda cmccnt ;[13] Store old character count sta cmocnt ;[13] ... lda #$ff ;[13] Set the failure flag sta cmcffl ;[13] ... 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 cm.rty ; Get the address of the prompt ldy cm.rty+1 ;[13] ... 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 ; X,Y - optional parameters ; ; Output: A - +1 = success ; +4 = failure (assumes JMP after call) ; ; Registers destroyed: A ; comand: sta cmstat ; Save what we are parsing stx cmprmx ;[13] Save these parameters also sty cmprmy ;[13] ... 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, try next one jmp cmflot ; Yes, go get a floating point number comn7: cmp #cmtxt ;[13] Parse for Unquoted string? bne comn8 ;[13] Nope, go try last type jmp cmunqs ;[13] Go parse the string comn8: cmp #cmtok ;[13] Parse for a Single Character? bne comn9 ;[13] Nope, no more parse types jmp cmtokn ;[13] Go parse for char comn9: 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 cm.rty ;[13] Get address of prompt ldy cm.rty+1 ;[13] 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 lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... jmp rskp ; Do a return skip cmcfrr: pla ; Restore the old comand line pointer sta cm.ptr+1 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure sta cmcffl ;[13] ... 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 #$00 ;[13] Clear the 'real character' flag sta cmfrcf ;[13] ... 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 cmky10: 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: ldy cm.ptr ;[13] Just move the pointer to the save area sty cmsptr ;[13] ... ldy cm.ptr+1 ;[13] ... sty cmsptr+1 ;[13] ... cmp #hesc ;[13] Was the first terminator an escape? beq cmky12 ;[13] Yes, handle this jmp cmkey2 ;[13] No, continue cmky12: lda #cmfdff ;[13] Is there a default? bit cmprmy ;[13] ... bne cmky13 ;[13] Yes, go copy it lda #$00 ;[13] Shut the action flag sta cmaflg ;[13] ... jsr bell ;[13] Yes, start by feeping terminal sec ;[13] Set the carry bit for subtraction lda cm.bfp ;[13] Take L.O. byte of buffer pointer sbc #$01 ;[13] Decrement it (back up before escape) sta cm.bfp ;[13] Store it sta cm.ptr ;[13] And stuff it in next input char pointer bcs cmkync ;[13] If carry is clear, we are done dec cm.bfp+1 ;[13] Do the carry on H.O. byte cmkync: lda cm.bfp+1 ;[13] Copy this to next char to parse pointer sta cm.ptr+1 ;[13] ... jmp cmky10 ;[13] Continue by fetching a character again cmky13: lda #$00 ;[13] Zero the action flag sta cmaflg ;[13] ... jmp cmcpdf ;[13] Do the copy 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 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set the command-failure flag sta cmcffl ;[13] ... 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 lda #cmfehf ;[13] Load extra help flag bit cmprmy ;[13] Test bit beq cmk3b3 ;[13] No extra help jsr cmehlp ;[13] Go give extra help cmk3b3: ldx cm.rty ;[13] Get L.O. address of prompt ldy cm.rty+1 ;[13] 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 lda #cmfdff ;[13] Load default-present flag bit cmprmy ;[13] Check against flags beq cmk3d ;[13] No, complain to user lda cmfrcf ;[13] Have we seen a real character yet? bne cmk3d ;[13] No, tell user jmp cmcpdf ;[13] Yes, Go copy the default cmk3d: 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 ; ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... 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 lda #$ff ;[13] Set the 'real character' flag sta cmfrcf ;[13] ... 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 beq cmambs ;[13] If test length is 0, don't bother trying 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 cmambs: jmp rskp ;[13] 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 lda #cmfehf ;[13] Load extra help flag bit cmprmy ;[13] Test bit beq cmsw10 ;[13] No extra help jsr cmehlp ;[13] Go give extra help cmsw10: ldx cm.rty ;[13] Load ldy cm.rty+1 ;[13] 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 lda #cmfdff ;[13] See if there is a default bit cmprmy ;[13] ... beq cmswnd ;[13] No help, tell user jmp cmcpdf ;[13] Go copy the default cmswnd: 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 ; ... lda #$00 ;[13] Clear the failure flag sta cmcffl ;[13] ... 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 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... 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 ; ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... jmp rskp ; Success - skip return! cmswi5: pla ; Retore the old comand line pointer sta cm.ptr+1 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... rts ; Now return .SBTTL Cmifil - try to parse an input file spec next ; ; This routine attempts to parse an input file spec. ; ; Input: X - Max filname length ; ; Output: Filename parsed is in the atom buffer pointed to ; by X,Y ; ; Registers destroyed: A,X,Y ; cmifil: inx ;[13] Increment Max file length for tests stx cmprmx ;[13] Maximum filename length 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 lenabf ;[13] length of the atom buffer cmifl0: ldy #$00 ; Zero Y lda #' ; Blank the AC ora #$80 ; Turn on the H.O. bit cmifi0: sta atmbuf,y ; Now blank the buffer iny ; ... cpy cmprmx ;[13] 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 bmi cmif10 ;[13] Yes, check it out jmp cmifi2 ;[13] No, process it as a normal character cmif10: and #$7f ;[13] 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 lda #cmfehf ;[13] Load extra help flag bit cmprmy ;[13] Test bit beq cmifnh ;[13] No extra help jsr cmehlp ;[13] Go give extra help cmifnh: ldx cm.rty ;[13] Set up to reprint the prompt ldy cm.rty+1 ;[13] ... 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 ; ... lda #cmfdff ;[13] Load default-present flag bit cmprmy ;[13] Test bit beq cmifnd ;[13] No default lda lenabf ;[13] Now check if user typed anything bne cmifnd ;[13] Yup, can't use default jmp cmcpdf ;[13] Go copy the default cmifnd: 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 lenabf ;[13] Get the length of the buffer cmp #$00 ; Is it zero? bne cmif14 ; No, continue jmp cmifi9 ; Yes, this is not good cmif14: cmp cmprmx ;[13] Are we over the maximum file length? bmi cmif15 ; Not quite yet jmp cmifi9 ; Yes, blow up cmif15: ldy lenabf ;[13] Get the filename length lda #nul ; and stuff a null at that point sta atmbuf,y ;[13] ... pla ; Flush the old comand line pointer pla ; ... ldx #atmbuf\ ;[13] Set up the atom buffer address ldy #atmbuf^ ;[13] ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... lda lenabf ;[13] Load length into AC to be passed back jmp rskp ; No, we are successful cmifi2: cmp #sp ;[13] Bad character? bmi cmifi9 ; Yes, blow up cmp #del ;[13] ... bpl cmifi9 ; This is bad, punt cmp #'a ;[13] Is character a lower-case alpha? bmi cmifi8 ;[13] No, don't capitalize cmp #<'z+1> ;[13] ... bpl cmifi8 ;[13] ... and #$5f ; Capitalize cmifi8: ldy lenabf ;[13] Set up length of buffer in Y sta atmbuf,y ;[13] Stuff character in FCB inc lenabf ;[13] 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 sta cmoptr+1 ;[13] ... pla ; for something else sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... 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: X - L.O. byte of 16-bit integer parsed ; Y - H.O. byte of 16-bit integer parsed ; ; 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 lda #cmfdff ;[13] Load default-present flag bit cmprmy ;[13] Test bit beq cminnd ;[13] No default lda cmmres ;[13] Check if user typed anything significant ora cmmres+1 ;[13] ... bne cminnd ;[13] Yup, can't use default jmp cmcpdf ;[13] Go copy the default cminnd: 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 lda #cmfehf ;[13] Load extra help flag bit cmprmy ;[13] Test bit beq cminnh ;[13] No extra help jsr cmehlp ;[13] Go give extra help cminnh: ldx cm.rty ;[13] Set up pointer so we can print the prompt ldy cm.rty+1 ;[13] ... 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: ldx cmmres ;[13] Move L.O. byte ldy cmmres+1 ;[13] Move H.O. byte pla ; Flush the old comand line pointer pla ; ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... 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 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... 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 Cmunqs - Try to parse an unquoted string ; ; This routine tries to parse an unquoted string terminating ; with one of the break characters in brkwrd. ; ; Input: ; ; Output: X - L.O. byte address of ASCII string ; Y - H.O. byte address of ASCII string ; A - Length of string parsed ; ; Registers destroyed: A,X,Y ; cmunqs: lda cm.ptr ;[13] Save the command buffer pointer pha ;[13] ... lda cm.ptr+1 ;[13] ... pha ;[13] ... lda #$00 ;[13] Zero length of Atom buffer sta lenabf ;[13] ... cmunq1: jsr cmgtch ;[13] Get a character jsr chkbrk ;[13] Is it one of the break characters? jmp cmunq3 ;[13] Yes, handle that condition cmp #$00 ;[13] No, is it an action character? bpl cmunq2 ;[13] No, handle it as normal text and #$7f ;[13] We don't need the H.O. bit cmp #'? ;[13] Does the user need help? bne cmun13 ;[13] Nope, try next possibility ora #$80 ;[13] Have to print this, set H.O. bit jsr cout ;[13] Print '?' ldy #$00 ;[13] Zero the action flag sty cmaflg ;[13] ... ldx #cmin06\ ;[13] Get the help message ldy #cmin06^ ;[13] ... jsr prstr ;[13] and print it. jsr prcrlf ;[13] Print a crelf after it lda #cmfehf ;[13] Check for extra help. bit cmprmy ;[13] ... beq cmun11 ;[13] If no help, continue jsr cmehlp ;[13] Process extra help cmun11: ldx cm.rty ;[13] Go reprint prompt ldy cm.rty+1 ;[13] ... jsr prstr ;[13] ... sec ;[13] Adjust buffer pointer lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... bcs cmun12 ;[13] ... dec cm.bfp+1 ;[13] Adjust H.O. byte cmun12: dec cmccnt ;[13] Correct character count ldy #$00 ;[13] Stuff a null at end of usable buffer lda #$00 ;[13] ... sta (cm.bfp),y ;[13] ... ldx #cmbuf\ ;[13] Reprint command line ldy #cmbuf^ ;[13] ... jsr prstr ;[13] ... jmp cmunq1 ;[13] Go back for more characters cmun13: cmp #esc ;[13] Did the user type ? bne cmunq2 ;[13] No, just stuff the character and cont. lda #$00 ;[13] Clear the action flag sta cmaflg ;[13] ... lda #cmfdff ;[13] Check if there is a default value bit cmprmy ;[13] ... beq cmun14 ;[13] If not, the loses lda lenabf ;[13] Ok, there is a default, but if bne cmun14 ;[13] something has been typed, loses jmp cmcpdf ;[13] Go copy default and reparse cmun14: jsr bell ;[13] Feep at user sec ;[13] and reset the buffer pointer lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... sta cm.ptr ;[13] ... lda cm.bfp+1 ;[13] ... sbc #$00 ;[13] ... sta cm.bfp+1 ;[13] ... sta cm.ptr+1 ;[13] ... dec cmccnt ;[13] Adjust the character count jmp repars ;[13] and reparse the command line cmunq2: ldy lenabf ;[13] Fetch where we are in atmbuf sta atmbuf,y ;[13] and store our character there inc lenabf ;[13] Reflect increased length jmp cmunq1 ;[13] Go back for more characters cmunq3: lda lenabf ;[13] Get the length beq cmunqf ;[13] If we parsed a null string, fail pla ;[13] Flush old command line pointer pla ;[13] ... ldx #atmbuf\ ;[13] Now, set up the return parameter ldy #atmbuf^ ;[13] ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... lda lenabf ;[13] Set up atom length jmp rskp ;[13] Return cmunqf: pla ;[13] Restore old command line pointer sta cm.ptr+1 ; ... sta cmoptr+1 ;[13] ... pla ; ... sta cm.ptr ; ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save count in case of sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... rts ;[13] Return .SBTTL Cmtokn - Try to parse for a single character token ; ; This routine tries to parse for the character in the X-register. ; ; Input: X - Character to be parsed ; ; Output: +1 - failed to find character ; +4 - success, found character ; ; Registers destroyed: A,X,Y ; cmtokn: lda cm.ptr ;[13] First, save the old command pointer pha ;[13] on the stack lda cm.ptr+1 ;[13] ... pha ;[13] ... cmtk0: jsr cmgtch ;[13] Fetch the next character bpl cmtk3 ;[13] Not an action character and #$7f ;[13] It's an action character cmp #esc ;[13] User trying to be lazy? bne cmtk2 ;[13] Nope, tyr next option jsr bell ;[13] Yes, well, he's not allowed to be lazy lda #$00 ;[13] Clear the action flag sta cmaflg ;[13] ... sec ;[13] Adjust the buffer pointer back once lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... sta cm.ptr ;[13] Copy it into command pointer bcs cmtk1 ;[13] Need to adjust H.O. byte? dec cm.bfp+1 ;[13] Yes, do it cmtk1: lda cm.bfp+1 ;[13] Copy it to command pointer sta cm.ptr+1 ;[13] ... dec cmccnt ;[13] Adjust the character count jmp cmtk0 ;[13] and try again cmtk2: cmp #'? ;[13] User need help? bne cmtk4 ;[13] No, go fail ora #$80 ;[13] Yes, set bit to print char jsr cout ;[13] Print it ldx #cmin07\ ;[13] Point to the information message ldy #cmin07^ ;[13] ... jsr prstr ;[13] and print it lda #hdquot ;[13] Print the character we are looking for jsr cout ;[13] in between double quotes lda cmprmx ;[13] ... ora #$80 ;[13] ... jsr cout ;[13] ... lda #hdquot ;[13] ... jsr cout ;[13] ... jsr prcrlf ;[13] End it with a crelf lda #cmfehf ;[13] Load extra help flag bit cmprmy ;[13] Test bit beq cmtknh ;[13] No extra help jsr cmehlp ;[13] Go give extra help cmtknh: ldx cm.rty ;[13] Point to prompt ldy cm.rty+1 ;[13] ... jsr prstr ;[13] and print it sec ;[13] Adjust the buffer pointer back one lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... lda cm.bfp+1 ;[13] ... sbc #$00 ;[13] ... sta cm.bfp+1 ;[13] ... lda #$00 ;[13] Stuff a null at the end of the buffer ldy #$00 ;[13] ... sta (cm.ptr),y ;[13] ... ldx #cmbuf\ ;[13] Point to command buffer ldy #cmbuf^ ;[13] ... jsr prstr ;[13] and reprint it lda #$00 ;[13] Clear action flag sta cmaflg ;[13] ... jmp repars ;[13] and go reparse cmtk3: cmp cmprmx ;[13] Ok, this either is or is not the bne cmtk4 ;[13] char we want. If not, go fail. pla ;[13] It is, flush the old address pla ;[13] ... lda #$00 ;[13] Reset the failure flag sta cmcffl ;[13] ... jmp rskp ;[13] and skip return cmtk4: pla ;[13] Restore old pointer sta cm.ptr+1 ;[13] ... sta cmoptr+1 ;[13] ... pla ;[13] ... sta cm.ptr ;[13] ... sta cmoptr ;[13] ... lda cmccnt ;[13] Save the count for sta cmocnt ;[13] ... lda #$ff ;[13] Set failure flag sta cmcffl ;[13] ... rts ;[13] Return .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 bne cminb0 ;[23] If we are overflowing the command buffer jsr bell ;[23] Feep at the user and do Prserr dec cmccnt ;[23] Make sure this doesn't happen again jmp prserr ;[23] for same string cminb0: jsr rdkey ; Get next character from keyboard cmp #hctrlh ;[13] User want a retry? bne cmnbnh ;[13] Nope, go on ldx cmccnt ;[13] Check character count cpx #$01 ;[13] Is this the first character? bne cmnbnh ;[13] Nope, can't help him ldx cmcffl ;[13] Did the previous command fail? bpl cmnbnh ;[13] No, we can't reparse a good command lda cmoptr ;[13] Ok, get the old pointer and set up sta cm.ptr ;[13] the old command line again sta cm.bfp ;[13] ... lda cmoptr+1 ;[13] ... sta cm.ptr+1 ;[13] ... sta cm.bfp+1 ;[13] ... lda cmocnt ;[13] Restore the character count sta cmccnt ;[13] ... lda #$00 ;[13] Zero this so we can safely use the sta cmwrk2 ;[13] code that reprints a line after ^W jmp cmnbna ;[13] Go reprint the line cmnbnh: ldy #$00 ; sta (cm.bfp),y ; Stuff character 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 cm.rty ;[13] Get L.O. byte addr. ldy cm.rty+1 ;[13] 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 #hctrlw ;[13] Delete a word? beq cmnb41 ;[13] Yes, go take care of that jmp cmib40 ;[13] Nope, continue cmnb41: lda #$03 ;[13] Set up negative offset count sta cmwrk2 ;[13] ... sec ;[13] Set up to adjust buffer pointer lda cm.bfp ;[13] Get the L.O. byte sbc #$03 ;[13] Adjust pointer down by 3 sta cm.bfp ;[13] Store it back bcs cmnb42 ;[13] Don't worry about H.O. byte dec cm.bfp+1 ;[13] Adjust H.O. byte also cmnb42: lda cmwrk2 ;[13] First, check the count cmp cmccnt ;[13] Cmwrk2 > cmccnt? bmi cmints ;[13] No, go test characters jmp cmnb12 ;[13] Yes, go clear the whole line cmints: ldy #$00 ;[13] Zero Y lda (cm.bfp),y ;[13] Get previous character cmp #hlf ;[13] Start to test ranges... bpl cmits1 ;[13] Between and ? jmp cminac ;[13] No, not in range at all cmits1: cmp #hcr+1 ;[13] ... bmi cmnb43 ;[13] Yes, handle it cmp #hspace ;[13] Between and '"'? bpl cmits2 ;[13] Possible, continue jmp cminac ;[13] No, advance to previous character cmits2: cmp #hdquot+1 ;[13] ... bmi cmnb43 ;[13] Yes, delete back to there cmp #hapos ;[13] Between Apostrophy and '/'? bpl cmits3 ;[13] Could be, continue jmp cminac ;[13] Nope, advance character cmits3: cmp #hslash+1 ;[13] ... bmi cmnb43 ;[13] Yup, found a delimiter cmp #hcolon ;[13] Between ':' and '>' perhaps? bpl cmits4 ;[13] Maybe jmp cminac ;[13] Nope, advance to previous character cmits4: cmp #hrabr+1 ;[13] ... bmi cmnb43 ;[13] It is, go delete back to there cmp #hquote ;[13] Is it a "'"? bne cminac ;[13] No, advance cmnb43: dec cmwrk2 ;[13] Adjust this count clc ;[13] and the buffer pointer lda cm.bfp ;[13] ... adc #$01 ;[13] ... sta cm.bfp ;[13] ... bcc cmnb44 ;[13] ... inc cm.bfp+1 ;[13] ... cmnb44: lda cmccnt ;[13] Get the command buffer length cmnbcc: cmp ch ;[13] Check against horizontal cursor position bmi cmnbna ;[13] It's smaller, skip veritcal cursor adjust dec cv ;[13] Adjust cursor vertical position sec ;[13] Reflect this in number of characters sbc #$28 ;[13] we skipped back over jmp cmnbcc ;[13] Go check again cmnbna: lda #$00 ;[13] Put a null at the end of the buffer ldy #$00 ;[13] ... sta (cm.bfp),y ;[13] ... sta ch ;[13] Zero position on current line jsr scrl3 ;[13] Clear current line ldx cm.rty ;[13] Reprint prompt ldy cm.rty+1 ;[13] ... jsr prstr ;[13] ... ldx #cmbuf\ ;[13] Reprint command buffer ldy #cmbuf^ ;[13] ... jsr prstr ;[13] ... sec ;[13] Now adjust the command character count lda cmccnt ;[13] ... sbc cmwrk2 ;[13] by what we have accumulated sta cmccnt ;[13] ... jsr clreol ;[13] Clear to the end of this line jmp repars ;[13] Go reparse the command cminac: inc cmwrk2 ;[13] Increment count of chars to back up sec ;[13] Adjust the buffer pointer down again lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... bcs cmnb45 ;[13] If carry set, skip H.O. byte adjustment dec cm.bfp+1 ;[13] Adjust this cmnb45: jmp cmnb42 ;[13] Go around once again cmib40: 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: pha ;[13] Hold the character here till we need it lda #cmtxt ;[13] Are we parsing a string? cmp cmstat ;[13] ... beq cmgtis ;[13] Yes, ignore space flag test lda #cmifi ;[13] Are we parsing a file name? cmp cmstat ;[13] ... beq cmgtis ;[13] Yes, ignore space flag test lda cmsflg ; Get the space flag cmp #$00 ; Was the last character a space? beq cmgtis ;[13] No, go set space flag pla ;[13] Pop the character off jmp cmgtch ;[13] But ignore it and get another cmgtis: lda #$ff ; Set sta cmsflg ; the space flag pla ;[13] Restore the space or 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 ; prcl.0: 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 ; prst.0: 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. ; ml16: 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: None ; rskp.0: sta savea ; Save the registers stx savex ; sty savey ; 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 savea ; Restore the registers ldx savex ; ldy savey ; jmp (saddr) ; Jump at the new address .SBTTL Setbrk and Rstbrk ; ; These routines are called from the user program to set or reset ; break characters to be used by Cmunqs. The byte to set or reset ; is located in the Accumulator. Rstbrk has the option to reset ; the entire break-word. This occurs if the H.O. bit of AC is on. ; sbrk.0: and #$7f ;[13] We don't want the H.O. bit ldy #$00 ;[13] Set up Y to index the byte we want sbrkts: cmp #$08 ;[13] Is the offset > 8 bmi sbrkfw ;[13] No, we are at the right byte now sec ;[13] Yes, adjust it down again sbc #$08 ;[13] ... iny ;[13] Advance index jmp sbrkts ;[13] and try again sbrkfw: tax ;[13] This is the remaining offset lda #$80 ;[13] Start with H.O. bit on sbrklp: cpx #$00 ;[13] Is it necessary to shift down? beq sbrkfb ;[13] No, we are done dex ;[13] Yes, adjust offset lsr a ;[13] Shift bit down once jmp sbrklp ;[13] Go back and try again sbrkfb: ora brkwrd,y ;[13] We found the bit, use the byte offset sta brkwrd,y ;[13] from above, set the bit and resave rts ;[13] Return rbrk.0: asl a ;[13] Check H.O. bit bcs rbrkal ;[13] If that was on, Zero entire brkwrd lsr a ;[13] Else shift back (H.O. bit is zeroed) rbrkts: cmp #$08 ;[13] Are we in the right word? bmi rbrkfw ;[13] Yes, go figure the rest of the offset sec ;[13] No, Adjust the offset down sbc #$08 ;[13] ... iny ;[13] and the index up jmp rbrkts ;[13] Try again rbrkfw: tax ;[13] Stuff the remaining offset in X lda #$7f ;[13] Start with H.O. bit off rbrklp: cpx #$00 ;[13] Do we need to offset some more? beq rbrkfb ;[13] No, we have the correct bit dex ;[13] Yes, decrement the offset sec ;[13] Make sure carry is on ror a ;[13] and rotate a 1 bit into mask jmp rbrklp ;[13] Go back and try again rbrkfb: and brkwrd,y ;[13] We found the bit, now shut it off sta brkwrd,y ;[13] ... rts ;[13] and return rbrkal: lda #$00 ;[13] Go stuff zeros in the entire word ldy #$00 ;[13] ... rbrksz: sta brkwrd,y ;[13] Stuff the zero iny ;[13] Up the index once cpy #$10 ;[13] Are we done? bmi rbrksz ;[13] Not yet rts ;[13] Yes, return .SBTTL Chkbrk ; ; Chkbrk - This routine looks for the flag in the break word ; which represents the character passed to it. If this bit is ; on, it is a break character and the routine will simply ; return. If it is not a break character, the routine skips.. ; chkbrk: sta savea ;[13] Save byte to be checked and #$7f ;[13] Shut H.O. bit ldy #$00 ;[13] Zero this index cbrkts: cmp #$08 ;[13] Are we at the right word? bmi cbrkfw ;[13] Yes, go calculate bit position sec ;[13] No, adjust offset down sbc #$08 ;[13] ... iny ;[13] Increment the index jmp cbrkts ;[13] Go back and test again cbrkfw: tax ;[13] Stuff the remaining offset in X lda #$80 ;[13] Set H.O. bit on for testing cbrklp: cpx #$00 ;[13] Are we in position yet? beq cbrkfb ;[13] Yes, go test the bit dex ;[13] No, decrement the offset lsr a ;[13] and adjust the bit position jmp cbrklp ;[13] Go and try again cbrkfb: and brkwrd,y ;[13] See if the bit is on bne cbrkbc ;[13] It is a break character lda savea ;[13] Restore the character jmp rskp ;[13] Not a break character, skip return cbrkbc: lda savea ;[13] Restore the character rts ;[13] Return .SBTTL Cmehlp - Do extra help on Question-mark prompting ; ; Cmehlp - This routine uses a string of commands passed to it ; in order to display alternate valid parse types to the user. ; ; Input: Cmehpt- Pointer to valid parse types (end in 00) ; ; Output: Display on screen, alternate parse types ; ; Registers destroyed: A,X,Y ; cmehlp: lda cmstat ;[13] We are going to need this so pha ;[13] save it across the call ldy #$00 ;[13] Zero out the help index sty cmehix ;[13] ... cmehl1: ldy cmehix ;[13] Load the extra help index lda (cmehpt),y ;[13] Fetch next type sta cmstat ;[13] Store it here inc cmehix ;[13] Increase the index by one cmp #$00 ;[13] Is the type null? bne cmeh0 ;[13] No, continue jmp cmehrt ;[13] Yes, terminate cmeh0: cmp #cmtok+1 ;[13] If the type is out of range, leave bmi cmeh1 ;[13] ... jmp cmehrt ;[13] ... cmeh1: pha ;[13] Save the type across the call ldx #cmors\ ;[13] Set up address of 'OR ' string ldy #cmors^ ;[13] ... jsr prstr ;[13] and print it pla ;[13] Restore AC cmp #cmkey ;[13] Compare with keyword bne cmeh2 ;[13] No, try next type cmeh10: tax ;[13] Hold type in X register lda cmsptr ;[13] Save these parms so they can be restored pha ;[13] ... lda cmsptr+1 ;[13] ... pha ;[13] ... lda cm.ptr ;[13] Copy the pointer to the saved pointer sta cmsptr ;[13] so the keyword print routine prints pha ;[13] the entire table. Also, save it on lda cm.ptr+1 ;[13] the stack so it can be restored later sta cmsptr+1 ;[13] ... pha ;[13] ... lda cmptab ;[13] Save the table address also pha ;[13] ... lda cmptab+1 ;[13] ... pha ;[13] ... txa ;[13] Restore type cmp #cmkey ;[13] Keyword? bne cmeh11 ;[13] No, it must be a switch table ldx #cmin01\ ;[13] Set up address of message ldy #cmin01^ ;[13] ... jmp cmeh12 ;[13] Go print the string cmeh11: ldx #cmin02\ ;[13] Set up address of 'switch' string ldy #cmin02^ ;[13] ... cmeh12: jsr prstr ;[13] Print the message ldy cmehix ;[13] Get the index into help string lda (cmehpt),y ;[13] Fetch L.O. byte of table address sta cmptab ;[13] Set that up for Cmktp iny ;[13] Increment the index lda (cmehpt),y ;[13] Get H.O. byte sta cmptab+1 ;[13] Set it up for Cmktp iny ;[13] Advance the index sty cmehix ;[13] and store it jsr cmktp ;[13] Print the keyword table pla ;[13] Now restore all the stuff we saved before sta cmptab+1 ;[13] ... pla ;[13] ... sta cmptab ;[13] ... pla ;[13] ... sta cm.ptr+1 ;[13] ... pla ;[13] ... sta cm.ptr ;[13] ... pla ;[13] ... sta cmsptr+1 ;[13] ... pla ;[13] ... sta cmsptr ;[13] ... jmp cmehl1 ;[13] See if there is more to do cmeh2: cmp #cmswi ;[13] Type is switch? bne cmeh3 ;[13] No, continue jmp cmeh10 ;[13] We can treat this just like a keyword cmeh3: cmp #cmifi ;[13] Input file? bne cmeh4 ;[13] No, go on ldx #cmin03\ ;[13] Set up the message address ldy #cmin03^ ;[13] ... jmp cmehps ;[13] Go print it cmeh4: cmp #cmofi ;[13] Output file? bne cmeh5 ;[13] Nope, try again ldx #cmin04\ ;[13] Set up message address ldy #cmin04^ ;[13] ... jmp cmehps ;[13] Go print the string cmeh5: cmp #cmcfm ;[13] Confirm? bne cmeh6 ;[13] No ldx #cmin00\ ;[13] Set up address ldy #cmin00^ ;[13] ... jmp cmehps ;[13] Print the string cmeh6: cmp #cmtxt ;[13] Unquoted string? bne cmeh7 ;[13] No, try next one ldx #cmin06\ ;[13] Set up address ldy #cmin06^ ;[13] ... jmp cmehps ;[13] Print cmeh7: cmp #cmnum ;[13] Integer? bne cmeh8 ;[13] Try again ldx #cmin05\ ;[13] Set up message ldy #cmin05^ ;[13] ... jsr prstr ;[13] Print it ldy cmehix ;[13] Get index inc cmehix ;[13] Advance index lda (cmehpt),y ;[13] Get base of integer cmp #$0a ;[13] Is it greater than decimal 10? bmi cmeh71 ;[13] No, just print the L.O. digit lda #$b1 ;[13] Print the H.O. digit as a 1 jsr cout ;[13] Print the '1' ldy cmehix ;[13] Load index dey ;[13] Point back to last byte lda (cmehpt),y ;[13] Get the base back sec ;[13] Set the carry flag for subtraction sbc #$0a ;[13] Subtract off decimal 10 cmeh71: clc ;[13] Clear carry for addition adc #$b0 ;[13] Make it printable jsr cout ;[13] Print the digit jsr prcrlf ;[13] Print a crelf jsr prbyte ;[13] Print the byte jmp cmehl1 ;[13] Go back for more cmeh8: ldx #cmin07\ ;[13] Assume it's a token ldy #cmin07^ ;[13] ... cmehps: jsr prstr ;[13] Print string jsr prcrlf ;[13] Print a crelf jmp cmehl1 ;[13] Go back cmehrt: pla ;[13] Restore sta cmstat ;[13] current parse type rts .SBTTL Cmcpdf - Copy a default string into the command buffer ; ; Cmcpdf - This routine copies a default for a field ; into the command buffer andreparses the string. ; ; Input: Cmdptr- Pointer to default field value (asciz) ; ; Output: ; ; Registers destroyed: A,X,Y ; cmcpdf: sec ;[13] Reset the buffer pointer lda cm.bfp ;[13] ... sbc #$01 ;[13] ... sta cm.bfp ;[13] ... bcs cmcpst ;[13] If carry set, don't adjust H.O. byte dec cm.bfp+1 ;[13] ... cmcpst: dec cmccnt ;[13] Adjust the character count ldy #$00 ;[13] Zero the index cmcplp: lda (cmdptr),y ;[13] Get byte beq cmcpdn ;[13] Copy finished, leave ldx cmccnt ;[23] Check character count inx ;[23] If it is just short of wrapping bne cmcpl1 ;[23] then we are overflowing buffer jsr bell ;[23] If that is the case, tell the user dec cmccnt ;[23] Make sure it doesn't happen again jmp prserr ;[23] for same string. cmcpl1: ora #$80 ;[13] Be consistent, make sure H.O. bit is on sta (cm.bfp),y ;[13] Stuff it in the buffer inc cmccnt ;[13] Adjust character count iny ;[13] Up the buffer index jmp cmcplp ;[13] Go to top of loop cmcpdn: lda #hspace ;[13] Get a space sta (cm.bfp),y ;[13] and place it in buffer after keyword iny ;[13] Increment the buffer index lda #nul ;[13] Get a null sta (cm.bfp),y ;[13] and stuff that at the end of buffer clc ;[13] Now recompute the end of usable buffer tya ;[13] Get the number of chars added adc cm.bfp ;[13] Add that to the buffer pointer sta cm.bfp ;[13] ... lda #$00 ;[13] ... adc cm.bfp+1 ;[13] ... sta cm.bfp+1 ;[13] ... lda #$00 ;[13] Reset the action flag sta cmaflg ;[13] ... sec ;[13] Now adjust the command pointer to the lda cm.ptr ;[13] beginning of the copied field sbc #$01 ;[13] ... tax ;[13] Set it up in X and Y so we can call Prstr lda cm.ptr+1 ;[13] ... sbc #$00 ;[13] ... tay ;[13] ... jsr prstr ;[13] Print the added field jmp repars ;[13] Now go reparse the whole command .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 cmin06: nasc < UNQUOTED TEXT STRING > 1 cmin07: nasc < SINGLE CHARACTER TOKEN > 1 cmors: nasc < OR > 1 ;[13] 'OR ' string for extra help .SBTTL Kermit defaults for operational parameters ; ; The following are the defaults which this Kermit uses for ; the protocol. ; dquote = '# ; The quote character dpakln = $5e ;[4] 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 dtime = 15 ;[5] The default time-out amount 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 terse = $01 ;[26] Symbol for terse debug mode verbose = $02 ;[26] Symbol for verbose debug mode xon = $11 ;[21] Xon for Ibm-mode dch.di = $00 ;[41] Device index for DC-HAYES acc.di = $03 ;[41] Device index for APPLE-COM-CARD ssc.di = $06 ;[41] Device index for SUPER-SER-CARD fbsbit = $01 ; Value for SEVEN-BIT FILE-BYTE-SIZE fbebit = $00 ; Value for EIGHT-BIT FILE-BYTE-SIZE nparit = $00 ;[21] Value for PARITY NONE sparit = $01 ;[21] Value for PARITY SPACE mparit = $02 ;[21] Value for PARITY MARK oparit = $03 ;[21] Value for PARITY ODD eparit = $04 ;[21] Value for PARITY EVEN eprflg = $40 ;[38] 'Error packet received' flag 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) kerdsz = $09 ;[26] Length of debug mode strings kerpsl = $06 ;[21] Size of parity strings kerddl = kerdel ;[12] Size of device-driver strings kbdl = $05 ;[35] Size of keyboard-type strings. kerfrm = cminf1 ;[13] 'From string' pointer for Kercpy routine kerto = cminf2 ;[13] 'To string' pointer for Kercpy routine .ifeq invflg = $32 ;[34] Location used to indicate display mode. nrmdsp = $ff ;[34] Mode is normal. invdsp = $3f ;[34] Mode is inverse. flsdsp = $7f ;[34] Mode is flashing. cswl = $36 ; Character out routine pointer (z-pag) cswh = $37 ; ... kswl = $38 ; Keyboard character in routine pointer (z-pag) kswh = $39 ; ... kbap2p = $00 ;[35] Keyboard is apple 2/2+ type kbap2e = $01 ;[35] Keyboard is apple 2e type kmnorm = $00 ;[35] Keyboard mode is normal kmpref = $01 ;[35] Keyboard mode is prefixed kmlit = $02 ;[35] Keyboard mode is literal. errptr = $9d5a ; DOS error handler vector basws = $9d5e ; DOS basic warmstart vector .ifne kr0pch = $c087 ;[12] Base for port char location (DC Hayes) kr0pst = $c086 ;[12] Base for port strobe locations (DC Hayes) kr0pcr = $c086 ;[41] Base for prot control register (DC Hayes) dch.cr = $7f8 ;[41] Save area for Control register .endc .ifne kr1pch = $c08f ;[12] Base for port char location (Com card) kr1pst = $c08e ;[12] Base for port strobe location (Com card) kr1pcr = $c08d ;[41] Base for prot control register (Com card) .endc .ifne kr2pch = $c088 ;[22] Port character base (Super Serial card) kr2pst = $c089 ;[22] Port strobe base (Super Serial card) kr2pcr = $c08a ;[41] Base for prot control register (SSC) sscbrk = $cdc1 ;[41] Address of firmware break routine .endc .endc pdbuf: .blkb mxpack-2 ;[20] 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 $100 ;[25] 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 kersli: .byte $20 ;[12] Current I/O port index kerdd: .byte $03 ;[12] Device driver in use (def=Apple Com card) kerdd1: .byte $01 ;[12] Device driver print string index kbd1: .byte $00 ;[35] Keyboard-type string index. prmt: nasc 0 ;[13] Prompting text .byte $80!'> ;[13] Kludge to add '>' to prompt .byte $00 ;[13] End of kludge lprmt = .-prmt ;[13] Length of prompting text escp: .byte ; Character for escape from connection fbsize: .byte fbsbit ;[36] File-byte-size (Default = 7-bit) filmod: .byte ; Current file type usehdr: .byte off ;[12] Where to get filename (on=file-head) lecho: .byte off ;[12] Local-echo switch ibmmod: .byte off ;[12] Ibm-mode switch vtmod: .byte on ;[12] VT-52 Emulation mode switch kbdtyp: .byte kbap2p ;[35] Keyboard type 2/2+,2e,etc kbmode: .byte kmnorm ;[35] Mode for keyboard input kbcase: .byte off ;[35] Default case of keyboard parity: .byte ; Parity setting delay: .byte ; Amount of delay before first send filwar: .byte off ;[12] File-warning switch debug: .byte off ;[12] Debug switch ebqmod: .byte off ;[12] 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) fillen: .word ;[6] Length of current file left to send fetfl: .byte ;[6] Flag indicating we need the file length addlf: .byte ;[8] Add a flag dellf: .byte ;[8] Flush a flag jtaddr: .word ;[9] Jump table address hold area hch: .byte ;[13] Hold horizontal cursor position hcv: .byte ;[13] Hold vertical cursor position kwrk01: .byte ; Work area for Kermit kwrk02: .byte ; Work area for Kermit kertpc: .byte ;[21] Hold area for parity check ksavea: .byte ;[12] Save area for accumulator ksavex: .byte ;[12] Save area for X reg ksavey: .byte ;[12] Save area for Y reg 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 dmaxtr ;[12] 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 tpak: .word ;[16] Number of packets for this transfer eofinp: .byte ; End-of-file (no characters left to send) eodind: .byte ;[6] End-of-data reached on disk errcod: .byte ; Error indicator errrkm: .blkb mxpack-2 ;[38] Error message from remote Kermit kerosp: .byte ; Save area for stack pointer oldch: .byte ;[31] Save loc for cursor address x coord. curchr: .byte ;[31] True value for char under cursor ; ; 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: .byte dtime ;[5] Time-out interval (receive and send) .byte dtime ;[5] ... ; .word $0000 ;[5] 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 ;[35] Table for prefixed conversions by CHRCON. chrtab: .byte '< ;[35] replace < .byte '{ ;[35] with left curly brace. .byte '. ;[35] .byte '| ;[35] vertical bar. .byte '> ;[35] .byte '} ;[35] right curly brace. .byte $27 ;[35] .byte $40 ;[35] accent grave .byte ') ;[35] .byte '] ;[35] right square bracket .byte '( ;[35] .byte '[ ;[35] left square bracket .byte '/ ;[35] .byte '\ ;[35] backslash .byte '- ;[35] .byte '_ ;[35] underline .byte '^ ;[35] .byte '~ ;[35] tilde .byte $ff ;[35] end of table. .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. ; kdvol = $aa66 ;[40] Keyboard or default volume kddisk = $aa68 ;[40] Keyboard or default disk drive kdslot = $aa6a ;[40] Keyboard or default slot 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 minslt = $01 ;[40] Minimum slot number maxslt = $07 ;[40] Maximum slot number mindrv = $01 ;[40] Minimum drive number maxdrv = $02 ;[40] Maximum drive number ; ; Data area ; defslt: .byte $06 ;[40] Default slot for file transfers defdrv: .byte $01 ;[40] Default drive for file transfers 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 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 ldx #prmt\ ;[13] Fetch the address of the prompt ldy #prmt^ ;[13] for Comnd routines 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 ldy #$00 ;[13] No special flags needed lda #cmkey ; Set up for keyword parse jsr comnd ; Try to parse it jmp kermt2 ; Failed lda #kermtb\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #kermtb^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that txa ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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 jmp bye ;[14] Shut and logout remote server command jmp finish ;[14] Shut remote server jmp getfrs ;[14] Get file from remote server 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 kermt9: ldx #ermesa\ ;[12] L.O. byte of error message text ldy #ermesa^ ;[12] H.O. byte of error message jsr prstr ;[12] Print message ('invalid device driver') jmp kermit ;[12] Go back to top of loop kermta: ldx #ermesb\ ;[13] L.O. byte of error message text ldy #ermesb^ ;[13] H.O. byte of error message jsr prstr ;[13] Print message ('null string found') jmp kermit ;[13] 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: sta ksavea ;[12] Save the AC so it isn't destroyed 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 lda #tnjtb\ ;[12] Save appropriate table address sta jtaddr ;[12] ... lda #tnjtb^ ;[12] ... sta jtaddr+1 ;[12] ... jmp teldsp ;[12] Go dispatch to the routine telppc: sta ksavea ;[12] Save AC so we have it for telppc lda #tppjtb\ ;[12] Save appropriate table address sta jtaddr ;[12] ... lda #tppjtb^ ;[12] ... sta jtaddr+1 ;[12] ... jmp teldsp ;[12] Go dispatch to the routine telcp: sta ksavea ;[12] Save AC so we have it for telcp lda #tcpjtb\ ;[12] Save appropriate table address sta jtaddr ;[12] ... lda #tcpjtb^ ;[12] ... sta jtaddr+1 ;[12] ... jmp teldsp ;[12] Go dispatch to the routine telgpc: sta ksavea ;[12] Save AC so we have it for telgpc lda #tgpjtb\ ;[12] Save appropriate table address sta jtaddr ;[12] ... lda #tgpjtb^ ;[12] ... sta jtaddr+1 ;[12] ... jmp teldsp ;[12] Go dispatch to the routine ; ; Teldsp - the telnet routine dispatcher. This routine ; dispatches to one of a number of entry points ; based on which I/O function is needed and which ; device driver is being used. ; teldsp: ldx kerdd ;[12] Get device driver offset lda jtaddr ;[12] Get the L.O. byte of jump table sec ;[12] Turn carry on for subtraction sbc #$01 ;[12] Decrement the address once sta jtaddr ;[12] Put the L.O. byte here until needed lda jtaddr+1 ;[12] Get the H.O. byte sbc #$00 ;[12] And adjust for carry (borrow) if any sta jtaddr+1 ;[12] Store that txa ;[12] Get the offset in AC clc ;[12] Clear the carry adc jtaddr ;[12] Add the L.O. byte of address tax ;[12] Hold it here for now lda jtaddr+1 ;[12] Get the H.O. byte of address adc #$00 ;[12] Add in carry if there is any pha ;[12] Push it on the stack txa ;[12] Get modified L.O. byte again pha ;[12] Push that lda ksavea ;[12] Restore AC from where we saved it earlier rts ;[12] Jump indexed (the hard way) tnjtb: .ifne ;[12] Include this if DC Hayes requested jmp ch0lup ;[12] DC Hayes telnet support .endc .ifeq ;[12] Include this if DC Hayes not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[12] Include this if Apple Com card requested jmp ch1lup ;[12] Apple Com card telnet support .endc .ifeq ;[12] Include this if Com card not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[22] Include this if Super Ser card requested jmp ch2lup ;[22] Super Ser card telnet support .endc .ifeq ;[22] Include this if Ser card not requested jmp kermt9 ;[22] Bad device driver error .endc tppjtb: .ifne ;[12] Include this if DC Hayes requested jmp tl0ppc ;[12] DC Hayes telnet support .endc .ifeq ;[12] Include this if DC Hayes not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[12] Include this if Apple Com card requested jmp tl1ppc ;[12] Apple Com card telnet support .endc .ifeq ;[12] Include this if Com card not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[22] Include this if Super Ser card requested jmp tl2ppc ;[22] Super Ser card telnet support .endc .ifeq ;[22] Include this if Ser card not requested jmp kermt9 ;[22] Bad device driver error .endc tcpjtb: .ifne ;[12] Include this if DC Hayes requested jmp tl0cp ;[12] DC Hayes telnet support .endc .ifeq ;[12] Include this if DC Hayes not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[12] Include this if Apple Com card requested jmp tl1cp ;[12] Apple Com card telnet support .endc .ifeq ;[12] Include this if Com card not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[22] Include this if Super Ser card requested jmp tl2cp ;[22] Super Ser card telnet support .endc .ifeq ;[22] Include this if Ser card not requested jmp kermt9 ;[22] Bad device driver error .endc tgpjtb: .ifne ;[12] Include this if DC Hayes requested jmp tl0gpc ;[12] DC Hayes telnet support .endc .ifeq ;[12] Include this if DC Hayes not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[12] Include this if Apple Com card requested jmp tl1gpc ;[12] Apple Com card telnet support .endc .ifeq ;[12] Include this if Com card not requested jmp kermt9 ;[12] Bad device driver error .endc .ifne ;[22] Include this if Super Ser card requested jmp tl2gpc ;[22] Super Ser card telnet support .endc .ifeq ;[22] Include this if Ser card not requested jmp kermt9 ;[22] Bad device driver error .endc .ifne ;[12] Include this if DC Hayes requested ; ; D. C. Hayes I/O Device support - These routines support the ; D. C. Hayes Micromodem. ; ch0lup: jsr tl0prc ;[12] Check for port character, write to screen jsr telcnc ;[12] Check for console char, write to port jmp kermit ;[12] This means user wants to shut connection jmp ch0lup ;[12] Go back and do all that again tl0prc: jsr tl0cp ;[12] Check for a port character cmp #false ;[12] No character beq tl0prr ;[12] Return jsr tl0gpc ;[12] Go fetch the character tl0pr2: and #$7f ;[17] Make sure H.O. bit is off for testing tay ;[12] Hold the character here lda vtmod ;[12] Are we in vt52 mode? cmp #on ;[12] ... bne tl0pr3 ;[12] If not, we don't need this, continue lda escflg ;[12] Was previous character an escape? cmp #on ;[12] ... bne tl0p2a ;[12] If not, skip vt52 emulation stuff jmp vt52 ;[12] It was escape, do vt52 emulation tl0p2a: tya ;[12] Get the character back cmp #del ;[12] Was it a delete? beq tl0prr ;[12] If so, return cmp #esc ;[12] Was it an 'escape'? bne tl0pr3 ;[12] If not, just output the character lda #on ;[12] Set the escape flag on sta escflg ;[12] ... jmp tl0prc ;[12] Go try for another character tl0pr3: cmp #cr ;[17] Do we have a ? bne tl0pcl ;[17] No, then check for lda #on ;[17] Yes, set the 'Delete ' flag sta dellf ;[17] ... jmp tl0poc ;[17] And then continue tl0pcl: cmp #lf ;[17] Do we have a ? bne tl0pnl ;[17] Nope, We must go shut the Dellf flag. lda dellf ;[17] We have a , is the flag on? cmp #on ;[17] ... bne tl0poc ;[17] If not, continue normally lda #off ;[17] Flag is on, follows , ignore it sta dellf ;[17] Start by zeroing flag jmp tl0prc ;[17] Now go to top of loop and try again tl0pnl: lda #off ;[17] Zero Dellf sta dellf ;[17] ... tl0poc: tya ;[12] Get the data into the AC jsr curoff ;[31] Turn the cursor off jsr dspchr ;[34] Show the character replaces COUT jsr curon ;[31] Turn the cursor on jmp tl0prc ;[12] Try for another tl0prr: rts ;[12] Return .ifeq tl0cp: ldx kersli ;[12] Offset into I/O locations lda kr0pst,x ;[12] Try for a character and #$01 ;[12] Check for receive register full beq tl0nc ;[12] No character, return false lda #true ;[12] Successful return rts ;[12] ... tl0nc: lda #false ;[12] Indicate failure rts ;[12] and return tl0gpc: ldx kersli ;[12] Get offset into I/O locations lda kr0pch,x ;[12] Fetch the character waiting here ldx parity ;[21] Check parity cpx #nparit ;[21] No parity beq tl0rtc ;[21] Go return the character and #$7f ;[21] There is parity, so strip it off tl0rtc: rts ;[12] and return tl0ppc: pha ;[12] Hold the byte to send ldx kersli ;[12] Get I/O location offset tl0pp1: lda kr0pst,x ;[12] Get the status byte and #$02 ;[12] Isolate the flag we want (TRE) beq tl0pp1 ;[12] Transmit register is NOT empty, try again pla ;[12] Fetch the data byte off the stack jsr telspa ;[21] Go set the parity appropriately ldx kersli ;[21] Fetch the index again sta kr0pch,x ;[12] Stuff it at the proper loc to send it rts ;[12] and return .endc ;[12] Apple computer conditional .endc ;[12] DC Hayes support conditional .ifne ;[12] Include this if Apple Com card requested ; ; Apple Com card I/O Device support - These routines support the ; Apple Com card. ; ch1lup: jsr tl1prc ;[12] Check for port character, write to screen jsr telcnc ;[12] Check for console char, write to port jmp kermit ;[12] This means user wants to shut connection jmp ch1lup ;[12] Go back and do all that again tl1prc: jsr tl1cp ;[12] Check for a port character cmp #false ;[12] No character beq tl1prr ;[12] Return jsr tl1gpc ;[12] Go fetch the character tl1pr2: and #$7f ;[17] Make sure H.O. bit is off for testing tay ;[12] Hold the character here lda vtmod ;[12] Are we in vt52 mode? cmp #on ;[12] ... bne tl1pr3 ;[12] If not, we don't need this, continue lda escflg ;[12] Was previous character an escape? cmp #on ;[12] ... bne tl1p2a ;[12] If not, skip vt52 emulation stuff jmp vt52 ;[12] It was escape, do vt52 emulation tl1p2a: tya ;[12] Get the character back cmp #del ;[12] Was it a delete? beq tl1prr ;[12] If so, return cmp #esc ;[12] Was it an 'escape'? bne tl1pr3 ;[12] If not, just output the character lda #on ;[12] Set the escape flag on sta escflg ;[12] ... jmp tl1prc ;[12] Go try for another character tl1pr3: cmp #cr ;[17] Do we have a ? bne tl1pcl ;[17] No, then check for lda #on ;[17] Yes, set the 'Delete ' flag sta dellf ;[17] ... jmp tl1poc ;[17] And then continue tl1pcl: cmp #lf ;[17] Do we have a ? bne tl1pnl ;[17] Nope, We must go shut the Dellf flag. lda dellf ;[17] We have a , is the flag on? cmp #on ;[17] ... bne tl1poc ;[17] If not, continue normally lda #off ;[17] Flag is on, follows , ignore it sta dellf ;[17] Start by zeroing flag jmp tl1prc ;[17] Now go to top of loop and try again tl1pnl: lda #off ;[17] Zero Dellf sta dellf ;[17] ... tl1poc: tya ;[12] Get the data into the AC jsr curoff ;[31] Turn the cursor off. jsr dspchr ;[34] Go show the char. replaces COUT . jsr curon ;[31] turn the cursor on jmp tl1prc ;[12] Try for another tl1prr: rts ;[12] Return .ifeq tl1cp: ldx kersli ;[12] Offset into I/O locations lda kr1pst,x ;[12] Try for a character and #$01 ;[12] Check for receive register full beq tl1nc ;[12] No character, return false lda #true ;[12] Successful return rts ;[12] ... tl1nc: lda #false ;[12] Indicate failure rts ;[12] and return tl1gpc: ldx kersli ;[12] Get offset into I/O locations lda kr1pch,x ;[12] Fetch the character waiting here ldx parity ;[21] Check parity cpx #nparit ;[21] No parity beq tl1rtc ;[21] Go return the character and #$7f ;[21] There is parity, so strip it off tl1rtc: rts ;[12] and return tl1ppc: pha ;[12] Hold the byte to send ldx kersli ;[12] Get I/O location offset tl1pp1: lda kr1pst,x ;[12] Get the status byte and #$02 ;[12] Isolate the flag we want (TRE) beq tl1pp1 ;[12] Transmit register is NOT empty, try again pla ;[12] Fetch the data byte off the stack jsr telspa ;[21] Go set the parity appropriately ldx kersli ;[21] Fetch the index again sta kr1pch,x ;[12] Stuff it at the proper loc to send it rts ;[12] and return .endc ;[12] Apple computer conditional .endc ;[12] Apple Com card support conditional .ifne ;[22] Include this if Super Ser requested ; ; Super Serial Card I/O Device support - These routines support the ; Apple Super Serial Card. ; ch2lup: jsr tl2prc ;[22] Check for port character, write to screen jsr telcnc ;[22] Check for console char, write to port jmp kermit ;[22] This means user wants to shut connection jmp ch2lup ;[22] Go back and do all that again tl2prc: jsr tl2cp ;[22] Check for a port character cmp #false ;[22] No character beq tl2prr ;[22] Return jsr tl2gpc ;[22] Go fetch the character tl2pr2: and #$7f ;[22] Make sure H.O. bit is off for testing tay ;[22] Hold the character here lda vtmod ;[22] Are we in vt52 mode? cmp #on ;[22] ... bne tl2pr3 ;[22] If not, we don't need this, continue lda escflg ;[22] Was previous character an escape? cmp #on ;[22] ... bne tl2p2a ;[22] If not, skip vt52 emulation stuff jmp vt52 ;[22] It was escape, do vt52 emulation tl2p2a: tya ;[22] Get the character back cmp #del ;[22] Was it a delete? beq tl2prr ;[22] If so, return cmp #esc ;[22] Was it an 'escape'? bne tl2pr3 ;[22] If not, just output the character lda #on ;[22] Set the escape flag on sta escflg ;[22] ... jmp tl2prc ;[22] Go try for another character tl2pr3: cmp #cr ;[22] Do we have a ? bne tl2pcl ;[22] No, then check for lda #on ;[22] Yes, set the 'Delete ' flag sta dellf ;[22] ... jmp tl2poc ;[22] And then continue tl2pcl: cmp #lf ;[22] Do we have a ? bne tl2pnl ;[22] Nope, We must go shut the Dellf flag. lda dellf ;[22] We have a , is the flag on? cmp #on ;[22] ... bne tl2poc ;[22] If not, continue normally lda #off ;[22] Flag is on, follows , ignore it sta dellf ;[22] Start by zeroing flag jmp tl2prc ;[22] Now go to top of loop and try again tl2pnl: lda #off ;[22] Zero Dellf sta dellf ;[22] ... tl2poc: tya ;[22] Get the data into the AC jsr curoff ;[31] Turn the cursor off. jsr dspchr ;[34] Go show the char. replaces COUT. jsr curon ;[31] Turn the cursor on. jmp tl2prc ;[22] Try for another tl2prr: rts ;[22] Return .ifeq tl2cp: ldx kersli ;[22] Offset into I/O locations lda kr2pst,x ;[22] Try for a character and #$08 ;[32] Check for receive register full beq tl2nc ;[22] No character, return false lda #true ;[22] Successful return rts ;[22] ... tl2nc: lda #false ;[22] Indicate failure rts ;[22] and return tl2gpc: ldx kersli ;[22] Get offset into I/O locations lda kr2pch,x ;[22] Fetch the character waiting here ldx parity ;[22] Check parity cpx #nparit ;[22] No parity beq tl2rtc ;[22] Go return the character and #$7f ;[22] There is parity, so strip it off tl2rtc: rts ;[22] and return tl2ppc: pha ;[22] Hold the byte to send ldx kersli ;[22] Get I/O location offset tl2pp1: lda kr2pst,x ;[22] Get the status byte and #$10 ;[22] Isolate the flag we want (TRE) beq tl2pp1 ;[22] Transmit register is NOT empty, try again pla ;[22] Fetch the data byte off the stack jsr telspa ;[22] Go set the parity appropriately ldx kersli ;[22] Fetch the index again sta kr2pch,x ;[22] Stuff it at the proper loc to send it rts ;[22] and return .endc ;[22] Apple computer conditional .endc ;[22] Super Serial card support conditional .ifeq telcnc: bit kbd ;[12] Check the keyboard for a character bpl telcrs ;[12] If none, return skip lda kbd ;[12] Get the character we found tax ;[12] Hold the data bit kbdstr ;[12] Reset the keyboard strobe txa ;[12] Fetch the data and #$7f ;[12] Make sure H.O. bit is off cmp escp ;[12] Is it the connect-escape character? bne telcn1 ;[35] jmp intchr ;[35] If so, go handle the interupt character telcn1: jsr chrcon ;[35] Go deal with loosing 2/2+ keyboard. jsr telppc ;[12] Output the port character tax ;[12] Hold it in X lda lecho ;[12] Is local-echo turned on? cmp #on ;[12] ... bne telcrs ;[12] If not, we are done, return skip txa ;[12] Output a copy to the screen jsr curoff ;[31] Turn off cursor. jsr dspchr ;[34] Show the char. replaces COUT. jsr curon ;[31] Turn the cursor back on. telcrs: jmp rskp ;[12] Skip return .endc ;[12] Apple computer conditional ; ; Telspa - This routine sets the parity according to the ; current value of the PARITY parameter. ; telspa: sta kertpc ;[21] Hold character here lda #telpjt\ ;[21] Get the L.O. byte of parity jump table sec ;[21] Turn carry on for subtraction sbc #$01 ;[21] Decrement the address once sta jtaddr ;[21] Put the L.O. byte here until needed lda #telpjt^ ;[21] Get the H.O. byte sbc #$00 ;[21] And adjust for carry (borrow) if any sta jtaddr+1 ;[21] Store that lda parity ;[21] Get the offset in AC clc ;[21] Clear the carry adc parity ;[21] Make it an offset for a jump table adc parity ;[21] ... clc ;[21] Make sure carry is clear again adc jtaddr ;[21] Add the L.O. byte of address tax ;[21] Hold it here for now lda jtaddr+1 ;[21] Get the H.O. byte of address adc #$00 ;[21] Add in carry if there is any pha ;[21] Push it on the stack txa ;[21] Get modified L.O. byte again pha ;[21] Push that lda kertpc ;[21] Get the character rts ;[21] Jump indexed (the hard way) telpjt: jmp tlpnon ;[21] No parity jmp tlpspc ;[21] Space parity jmp tlpmrk ;[21] Mark parity jmp tlpodd ;[21] Odd parity jmp tlpevn ;[21] Even parity tlpnon: rts ;[21] No parity, so return intact tlpspc: and #$7f ;[21] Turn off the parity bit rts ;[21] Go back tlpmrk: ora #$80 ;[21] Set the parity bit rts ;[21] and go back tlpevn: lda #$00 ;[21] Start with 0 (for even parity) jmp tlpeo ;[21] Continue with even parity tlpodd: lda #$01 ;[21] Set bit for odd parity tlpeo: ldx #$07 ;[21] Repeat count for parity toggle tlplp0: bit kertpc ;[21] Test H.O. bit bpl tlplp1 ;[21] Don't do the EOR if bit 7 not set eor #$01 ;[21] Toggle parity tlplp1: rol kertpc ;[21] Get next bit in position dex ;[21] Decrement the count bpl tlplp0 ;[21] Not done, do next bit rol kertpc ;[21] Now we have original byte again ror a ;[21] Get the parity bit to bit 7 ror a ;[21] ... ora kertpc ;[21] Merge the two rts ;[21] and return ; ; Intchr - processes the character which follows the interupt ; character and performs functions based on what that character ; is. ; intchr: jsr rdkey ;[12] Get the next character sta kerchr ;[12] Save a copy of it and #$5f ;[12] Capitalize it cmp #'C ;[12] Does user want the connection closed? bne intch0 ;[12] If not, try next option rts ;[12] Otherwise, do non-skip return and end it intch0: cmp #'S ;[12] Does the user want status? bne intch1 ;[12] Nope jmp stat01 ;[12] Give it to him intch1: cmp #'B ;[41] Does user want to send a Break? bne intch2 ;[41] No, continue lda kerdd ;[41] Fetch the device driver index jsr brkcmd ;[41] Send the Break signal jmp rskp ;[41] Do a skip return intch2: lda kerchr ;[41][12] Fetch back the original character and #$7f ;[12] Get rid of the H.O. bit cmp #'? ;[12] Does user need help? bne intch3 ;[41][12] If not, continue ldx #inthlp\ ;[12] Get the address of the proper help string ldy #inthlp^ ;[12] ... jsr prstr ;[12] Print the help stuff jmp intchr ;[12] Get another option character intch3: cmp escp ;[41][12] Is it another connect-escape? bne intch4 ;[41][12] No, try next thing jsr telppc ;[12] Stuff the character at the port jmp rskp ;[12] Give skip return intch4: cmp #'0 ;[41] Wants to send a null? bne intch5 ;[41] Nope, this is definitely an error lda #nul ;[41] Fetch a null jsr telppc ;[41] and stuff it at the port jmp rskp ;[41] Return with a skip intch5: jsr bell ;[41][12] Sound bell at the user jmp rskp ;[12] Go back (skip) ; ; Brkcmd - This routine checks which communication device is ; being used and takes the appropriate action to send a Break ; signal (Space condition on line for 233 ms.). ; brkcmd: cmp #dch.di ;[41] Are we using a D.C. Hayes? bne brkcm0 ;[41] If not, try next device ldy kersli ;[41] Get slot index tya ;[41] Move a copy to A lsr a ;[41] Divide by 16 lsr a ;[41] ... lsr a ;[41] ... lsr a ;[41] ... tax ;[41] Place it in X pha ;[41] Save on stack for later lda dch.cr,x ;[41] Get saved Control Register ora #$60 ;[41] Set appropriate flags for break sta kr0pcr,y ;[41] Start break signal lda #233 ;[41] Wait for 233 ms. jsr wait ;[41] Do it pla ;[41] Restore the index tax ;[41] ... lda dch.cr,x ;[41] Get saved Control reg and #$9f ;[41] Reset flags ldy kersli ;[41] Get slot index sta kr0pcr,y ;[41] Stop break signal rts ;[41] and return brkcm0: cmp #acc.di ;[41] Apple Com Card? bne brkcm1 ;[41] If not , try next ldy kersli ;[41] Get slot index lda kr1pcr,y ;[41] Get saved Control Register ora #$0c ;[41] Set appropriate flags for break sta kr1pcr,y ;[41] Start break signal lda #233 ;[41] Wait for 233 ms. jsr wait ;[41] Do it ldy kersli ;[41] Get slot index lda kr1pcr,y ;[41] Get saved Control reg and #$f3 ;[41] Reset flags sta kr1pcr,y ;[41] Stop break signal rts ;[41] Return brkcm1: cmp #ssc.di ;[41] Super Serial Card? bne brkcme ;[41] Nope, no more devices jsr sscbrk ;[41] Handy break routine in firmware rts ;[41] return brkcme: rts ;[41] Return ; ; Wait - This routine will wait for some number of milliseconds. ; ; Input: A - number of milliseconds to delay ; ; Output: Nothing ; ; Regs Destroyed: A,X,Y ; wait: ldx #202 ;[41] Count for a 1 millisecond loop .ifeq <<.\> - $ff> nop ;[41] Push to beginning of next page .endc ;[41] .ifeq <<.\> - $fe> nop ;[41] Push to beginning of next page nop ;[41] ... .endc ;[41] wait1m: dex ;[41] Count down bne wait1m ;[41] If not done, continue sec ;[41] Finished a millisecond sbc #$01 ;[41] Decr # ms done bne wait ;[41] More to do?, then go to top rts ;[41] Done, return to caller .ifeq ;[34] Process the character before display, so that caps and odd chars appear ;[34] as inverse. dspchr: ora #$80 ;[34] Make sure h.o. bit is set. cmp #$c1 ;[34] bmi dspnrm ;[34] Digit, or normal punctuation char. cmp #$db ;[34] bmi dspinv ;[34] Capital letter. cmp #$e0 ;[34] bmi dspnrm ;[34] More normal punctuation. bne dsp1 ;[34] Branch if lowercase. lda #'' ;[34] Accent grave. load a ' bne dspinv ;[34] And show it inverted. dsp1: and #$df ;[34] Shift high (lowercase) chars to capital. cmp #$db ;[34] bmi dspnrm ;[34] Lowercase letter. dspinv: pha ;[34] Save the char. lda #invdsp ;[34] Show as inverse. sta invflg ;[34] pla ;[34] Restore the char. dspnrm: jsr cout ;[34] Show the character. lda #nrmdsp ;[34] Switch back to normal display. sta invflg ;[34] rts ;[34] ;[35] Convert the character as required for the Apple loosing keyboard. chrcon: tax ;[35] Save a copy of the char in X lda kbdtyp ;[35] If 2e, just send it. cmp #kbap2e ;[35] beq chclrs lda kbmode ;[35] Ditto if in literal mode cmp #kmlit ;[35] beq chclrs ;[35] cpx #lftarw ;[35] If left arrow, send a delete bne chrco1 ;[35] ldx #$7f ;[35] bne chclrs ;[35] chrco1: cpx #'A ;[35] Is this a letter? bmi chnoaz ;[35] branch if too low. cpx #'[ ;[36] Left square brace, follows Z. bpl chnoaz ;[35] Branch if too high for letter. lda kbcase ;[35] Decide if it needs lowercase. eor kbmode ;[35] Weird, but it works beq chclrs ;[35] Send uppercase, no modification. txa ;[35] ora #$20 ;[35] Lowercase it. tax ;[35] bne chclrs ;[35] chnoaz: lda #kmpref ;[35] Is this char prefixed? cmp kbmode ;[35] beq chspec ;[35] Branch if so. cpx #rhtarw ;[35] Was this a right-arrow? bne chclrs ;[35] No. just send char. sta kbmode ;[35] Else set prefix mode bpl chpopr ;[35] And dont send char. ; Is it one of the special, prefixed characters? chspec: ldy #$00 ;[35] Set up index to step thru table txa ;[35] chslop: pha ;[35] Top of loop lda chrtab,y ;[35] Get 1st half of 2-byte pair bmi chesc ;[35] $FF is end of table. pla ;[35] Get our character. cmp chrtab,y ;[35] Compare it with the table entry. beq chrrep ;[35] Match. Go replace it. iny ;[35] No match. Step onto next iny ;[35] Byte pair. bne chslop ;[35] And test it. chrrep: iny ;[35] Second half of pair is the replacment. lda chrtab,y tax ;[35] So put it in X. bpl chclrs ;[35] And send it. ;Are we trying to enter literal mode? Prefix-Escape does this. chesc: pla ;[35] Get the char from where chspec put it. cmp #esc ;[35] Is it escape? bne chtogg ;[35] No. check for case toggle. lda #kmlit ;[35] Yes. set mode to literal. sta kbmode ;[35] And store it. bpl chpopr ;[35] Return without sending char. chtogg: cpx #rhtarw ;[35] Was it another right-arrow? bne chclrs ;[35] No. just send it & clear mode. lda kbcase ;[35] Get the current default case eor #$01 ;[35] Flip it. sta kbcase ;[35] Store it. lda #kmnorm ;[35] Set mode to normal. sta kbmode ;[35] ... bpl chpopr ;[35] Return without printing the char. ;Clear mode and send the character. chclrs: lda #kmnorm ;[35] Clear the mode. sta kbmode ;[35] txa ;[35] Get the char into A. rts ;[35] Return normally. ;Return via skip return, without sending the char. This pops the latest return ;address off the stack, revealing the next one down. It then does a retskp, ;matching the telppc routine. chpopr: pla ;[35] Pop off the latest return address pla ;[35] jmp rskp ;[35] And return skip. .endc ; ; Vt52 - will carry out the equivalent of most of the vt52 functions ; available. ; vt52: jsr curoff ;[31] turn off the cursor 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 jmp vt52rt ;[31] Turn on cursor and return vt52a: cmp #'B ; Is it a 'B'? bne vt52b ; Next char jsr lfeed ; Yes, do a line feed jmp vt52rt ;[31] Turn on cursor and return vt52b: cmp #'C ; 'C'? bne vt52c ; Nope jsr advanc ; Yes, go forward one space jmp vt52rt ;[31] Turn on cursor and return vt52c: cmp #'D ; 'D'? bne vt52d ; No jsr bsp ; Yes, do a back-space jmp vt52rt ;[31] Turn on cursor and 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 jmp vt52rt ;[31] Turn on cursor and 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 jmp vt52rt ;[31] Turn on cursor and return vt52e1: jsr vrscrl ; Do the reverse scroll jmp vt52rt ;[31] Turn on cursor and return vt52f: cmp #'J ; 'J'? bne vt52g ; No jsr clreop ; Clear from where we are to end-of-page jmp vt52rt ;[31] Turn on cursor and return vt52g: cmp #'K ; 'K'? bne vt52h ; Try last option jsr clreol ; Clear to end-of-line jmp vt52rt ;[31] Turn on cursor and return vt52h: cmp #'Y ; 'Y' bne vtig ; Must be an unimplemented function, do vtig jsr vtdca ; Do direct cursor addressing jmp vt52rt ;[31] Turn on cursor and 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 ; ... jmp vt52rt ;[31] Turn on cursor and return vtig1: jsr prchr ; Print the character vt52rt: jsr curon ;[31] Turn on cursor rts ; 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 Flashing cursor support routines. ;[31] ;[31] Take the byte on the screen at (basl),ch, stash it and its location in ;[31] obasl,obash, oldch, and curchar, convert the character to flashing, and ;[31] stuff it back to the screen. This will display a flashing character at ;[31] the next location for writing. ;[31] No registers or flags are altered. curon: php ;[31] Save flags. pha ;[31] Save A tya ;[31] and Y pha ;[31] ldy ch ;[31] Make a safe copy of the cursor char sty oldch ;[31] location lda basl ;[31] sta obasl ;[31] lda bash ;[31] sta obash ;[31] lda (basl),y ;[31] sta curchr ;[31] and value and #$7f ;[31] convert it to flashing. ora #$40 ;[31] sta (basl),y ;[31] store flashing char to screen pla ;[31] restore regs. tay ;[31] pla ;[31] plp ;[31] rts ;[31] ;[31] Turn the cursor off ;[31] Check to see if the location where we last turned on the cursor is still ;[31] flashing. If so, restore it to its old (non-flashing) value. ;[31] All registers and flags preserved. curoff: php ;[31] pha ;[31] Preserve the regs tya ;[31] pha ;[31] ldy oldch ;[31] Get the current screen char at lda (obasl),y ;[31] old cursor location. bmi curof1 ;[31] Too high to be flashing; Quit cmp #$40 ;[31] bcc curof1 ;[31] Too low to be flashing; Quit lda curchr ;[31] It is flashing; restore the old sta (obasl),y ;[31] character curof1: pla ;[31] Restore the registers. tay ;[31] pla ;[31] plp ;[31] rts ;[31] .SBTTL Exit routine ; ; This routine exits properly from kermit-65 and reenters ; Dos. ; ; Input: NONE ; ; Output: NONE ; ; Registers destroyed: A,X ; exit: lda #cmcfm ;[14] Try to get a confirm jsr comnd ;[14] Do it jmp kermt3 ;[14] Give '?not confirmed' message exit1: ;[14] .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 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 Bye routine ; ; This routine terminates the remote server, logs out and terminates ; the local Kermit. ; bye: jsr prcfm ;[14] Go parse and print the confirm jsr logo ;[14] Tell other Kermit to log out jmp kermit ;[14] Don't exit if there was an error jmp exit1 ;[14] Leave ; ; Logo - This routine does the actual work to send the logout ; packet to the remote server ; logo: lda #$00 ;[14] Zero the number of tries sta numtry ;[14] ... sta tpak ;[16] and the total packet number sta tpak+1 ;[16] ... logo1: lda numtry ;[14] Fetch the number of tries cmp maxtry ;[14] Have we exceeded Maxtry? bmi logo3 ;[14] Not yet, go send the packet logo2: ldx #ermesc\ ;[14] Yes, give an error message ldy #ermesc^ ;[14] ... jsr prstr ;[14] ... jsr prcrlf ;[14] ... rts ;[14] and return logo3: inc numtry ;[14] Increment the number of tries for packet lda #$00 ;[14] Make it packet number 0 sta pnum ;[14] ... lda #$01 ;[14] Data length is only 1 sta pdlen ;[14] ... lda #'L ;[14] The 'Logout' command sta pdbuf ;[14] Put that in first character of buffer lda #'G ;[14] Generic command packet type sta ptype ;[14] ... jsr spak ;[14] Send the packet jsr rpak ;[14] Try to fetch an ACK cmp #true ;[14] Did we receive successfully? bne logo1 ;[14] No, try to send the packet again lda ptype ;[14] Get the type cmp #'Y ;[14] An ACK? bne logoce ;[14] No, go check for error jmp rskp ;[14] Yes, skip return logoce: cmp #'E ;[14] Error packet? bne logo1 ;[14] Nope, resend packet jsr prcerp ;[38][14] Go display the error rts ;[14] and return .SBTTL Finish routine ; ; This routine terminates the remote server but does not log ; it out. It also keeps the local Kermit running. ; finish: jsr prcfm ;[14] Go parse and print the confirm lda #$00 ;[14] Zero the number of tries sta numtry ;[14] ... sta tpak ;[16] and the total packet number sta tpak+1 ;[16] ... finsh1: lda numtry ;[14] Fetch the number of tries cmp maxtry ;[14] Have we exceeded Maxtry? bmi finsh3 ;[14] Not yet, go send the packet finsh2: ldx #ermesd\ ;[14] Yes, give an error message ldy #ermesd^ ;[14] ... jsr prstr ;[14] ... jsr prcrlf ;[14] ... jmp kermit ;[14] and go back for more commands finsh3: inc numtry ;[14] Increment the number of tries for packet lda #$00 ;[14] Make it packet number 0 sta pnum ;[14] ... lda #$01 ;[14] Data length is only 1 sta pdlen ;[14] ... lda #'F ;[14] The 'Finish' command sta pdbuf ;[14] Put that in first character of buffer lda #'G ;[14] Generic command packet type sta ptype ;[14] ... jsr spak ;[14] Send the packet jsr rpak ;[14] Try to fetch an ACK cmp #true ;[14] Did we receive successfully? bne finsh1 ;[14] No, try to send the packet again lda ptype ;[14] Get the type cmp #'Y ;[14] An ACK? bne fince ;[14] No, go check for error jmp kermit ;[14] Yes, go back for more commands fince: cmp #'E ;[14] Error packet? bne finsh1 ;[14] Nope, resend packet jsr prcerp ;;[38][14] Go display the error jmp kermit ;[14] Go back for more .SBTTL Get routine ; ; This routine accepts an unquoted string terminated by ; ,,, or and tries to fetch the file ; represented by that string from a remote server Kermit. ; getfrs: lda #yes ;[42] Make KERMIT use file headers sta usehdr ;[42] for file names lda #mxfnl+1 ;[14] The buffer size is one more than max sta kwrk01 ;[14] file name length lda #fcb1\ ;[14] Point to the buffer sta kerto ;[14] ... lda #fcb1^ ;[14] ... sta kerto+1 ;[14] ... jsr kerflm ;[14] Clear the buffer lda #$80 ;[14] Reset all break characters jsr rstbrk ;[14] ... lda #cr ;[14] ... jsr setbrk ;[14] ... lda #lf ;[14] ... jsr setbrk ;[14] ... lda #ffd ;[14] ... jsr setbrk ;[14] ... lda #esc ;[14] ... jsr setbrk ;[14] ... ldy #$00 ;[14] ... lda #cmtxt ;[14] Parse for text jsr comnd ;[14] Do it jmp kermta ;[14] Found null string cmp spsiz ;[14] Larger than the set packet size? bmi getf1 ;[14] No, continue lda spsiz ;[14] Yes, it will have to be truncated getf1: sta kwrk01 ;[14] Store packet size for Kercpy sta pdlen ;[14] and Spak lda #pdbuf\ ;[14] Point to the data buffer as destination sta kerto ;[14] ... sta kerbf1 ;[37] Store L.O.B. here for Spak routine lda #pdbuf^ ;[14] ... sta kerto+1 ;[14] ... sta kerbf1+1 ;[37] Store H.O.B. here for Spak routine stx kerfrm ;[14] Point to the atom buffer from Comnd sty kerfrm+1 ;[14] as the source address txa ;[14] Save the 'from buffer' pointers for later pha ;[14] ... tya ;[14] ... pha ;[14] ... jsr kercpy ;[14] Copy the string pla ;[14] Restore these for the next move sta kerfrm+1 ;[14] ... pla ;[14] ... sta kerfrm ;[14] ... lda #fcb1\ ;[14] Set up the address of the target sta kerto ;[14] ... lda #fcb1^ ;[14] ... sta kerto+1 ;[14] ... jsr clrfcb ;[14] Clear the fcb first jsr kercpy ;[14] Go move the string jsr prcfm ;[14] Go parse and print the confirm lda #'R ;[14] Packet type is 'Receive-init' sta ptype ;[14] ... lda #$00 ;[14] Packet number should be zero sta pnum ;[14] ... jsr spak ;[14] Packet length was set above, jsr rswt ;[14] so just call spak and try to receive jmp kermit ;[14] Go back for more commands .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 #kerehr\ ;[13] Point to extra help commands sta cmehpt ;[13] ... lda #kerehr^ ;[13] ... sta cmehpt+1 ;[13] ... ldx #$1e ;[13] Longest length a filename may be ldy #cmfehf ;[13] Tell Comnd about extra help lda #cmifi ; Load opcode for parsing input files jsr comnd ; Call comnd routine jmp recev1 ; Continue, don't turn file-header switch off sta kwrk01 ;[13] Store length of file parsed stx kerfrm ;[13] Save the from address (addr[atmbuf]) sty kerfrm+1 ;[13] ... lda #fcb1\ ;[13] Save the to address (Fcb1) sta kerto ;[13] ... lda #fcb1^ ;[13] ... sta kerto+1 ;[13] ... jsr clrfcb ;[13] Clear the fcb jsr kercpy ;[13] Copy the string 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 ; Sent characters, current file sta schr+1 ; ... sta tpak ;[16] and the total packet number sta tpak+1 ;[16] ... 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 #errcri ;[38] No, fetch the error index sta errcod ;[38] and store it as the error code jsr prcerp ;[38] Check for error packet and process it lda #'A ; Abort this transfer sta state ; State is now 'abort' 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: lda #off ; 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 #errcrf ;[38] No, fetch the error index sta errcod ;[38] and store it as the error code jsr prcerp ;[38] Check for error packet and process it lda #'A ; Abort this transfer sta state ; ... 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 #errcrd ;[38] Fetch the error index sta errcod ;[38] and store it as the error code jsr prcerp ;[38] Check for error packet and process it lda #'A ; Give up the whole transfer sta state ; Set system state to 'false' 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 #fcb1\ ;[18] Get the pointer to the fcb sta kerfcb ;[18] and store it where the close routine lda #fcb1^ ;[18] can find it sta kerfcb ;[18] ... lda #$00 ;[18][3] Make CLOSEF see there are no errors jsr closef ;[18] We are done with this file, so close it jsr incn ;[18] Increment the packet number 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 #'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: ldx #$1e ;[13] Longest length a filename may be ldy #$00 ;[13] No special flags needed lda #cmifi ; Load opcode for parsing input files jsr comnd ; Call comnd routine jmp kermt6 ; Give the 'missing filespec' error sta kwrk01 ;[13] Store length of file parsed stx kerfrm ;[13] Save the from address (addr[atmbuf]) sty kerfrm+1 ;[13] ... lda #fcb1\ ;[13] Save the to address (Fcb1) sta kerto ;[13] ... lda #fcb1^ ;[13] ... sta kerto+1 ;[13] ... jsr clrfcb ;[13] Clear the fcb jsr kercpy ;[13] Copy the string ldy kwrk01 ;[13] Get filename length lda #nul ;[13] Fetch a null character sta (kerto),y ;[13] Stuff a null at end-of-buffer 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 eodind ;[6] The End-of-Data indicator 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 ; Sent characters, current file sta schr+1 ; ... sta tpak ;[16] and the total packet number sta tpak+1 ;[16] ... 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 jsr prcerp ;[38] Check for error packet and process it 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 #$00 ;[44] Clear sta eofinp ;[44] End of input flag lda #fcb1\ ;[44] Get the pointer to the fcb sta kerfcb ;[44] and store it where the close routine lda #fcb1^ ;[44] can find it sta kerfcb ;[44] ... lda #$00 ;[44] Make CLOSEF see there are no errors jsr closef ;[44] We are done with this file, so close it 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 filmod ;[6] Fetch the file mode beq sfil0 ;[6] If it is a text file, we don't need length lda #on ;[6] Otherwise, set flag to get length of file sta fetfl ;[6] from first sector sfil0: 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: 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: jsr prcerp ;[38] Check for error packet and process it 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 jsr prcerp ;[38] Check for error packet and process it lda #'A ; 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: jsr prcerp ;[38] Check for error packet and process it 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 jsr prcerp ;[38] Check for error packet and process it lda #'A ; 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 ; ... ldy #$00 ;[13] No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #setcmb\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #setcmb^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that txa ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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 jmp stslot ;[12] Set the I/O port index jmp stddr ;[12] Set the device-driver jmp stpari ;[21] Set the parity for communication jmp stkbd ;[35] Set the keyboard type. jmp stddsk ;[40] Set the default disk for I/O stesc: ldx #$10 ; Base should be hex ldy #$00 ;[13] No special flags needed lda #cmnum ; Parse for integer jsr comnd ; Go! jmp kermt4 ; Number is bad stx ksavex ;[13] Hold the number across the next call sty ksavey ;[13] ... lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed lda ksavey ;[13] 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 ksavex ;[13] 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 ;[21] Try parsing an 'on' or 'off' jmp kermt2 ;[21] Bad keyword stx ibmmod ;[21] Store value in the mode switch location stx lecho ;[21] Also set local echo accordingly ldy #nparit ;[21] Get ready to set the parity parameter cpx #on ;[21] Setting ibm mode on? bne stibm1 ;[21] Nope so set no parity ldy #mparit ;[21] Set mark parity stibm1: sty parity ;[21] Store the value lda #cmcfm ;[21] Parse for confirm jsr comnd ;[21] Do it jmp kermt3 ;[21] Not confirmed, tell the user that jmp kermit ;[21] 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 ; ... ldy #$00 ;[13] No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #stcct\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #stcct^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that txa ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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 ; ... ldy #$00 ;[13] No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #stcct\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #stcct^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that txa ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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: lda #debkey\ ;[26] Load the address of the keyword table sta cminf1 ;[26] Save it for the keyword routine lda #debkey^ ;[26] ... sta cminf1+1 ;[26] ... ldy #$00 ;[26] No special flags needed lda #cmkey ;[26] Comnd code for parse keyword jsr comnd ;[26] Go get it jmp kermt2 ;[26] Give an error stx debug ;[26] Stuff returned value into debug switch lda #cmcfm ;[26] Parse for a confirm jsr comnd ;[26] Do it jmp kermt3 ;[26] Not confirmed, tell the user that jmp kermit stebq: ldx #$10 ; Base for ASCII value ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 lda #cmcfm ;[13] Parse for confirm jsr comnd ;[13] Do it jmp kermt3 ;[13] Not confirmed, tell the user that 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 ldy #$00 ;[13] No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ;[13] 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: txa ;[13] 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 #ftcdef\ ;[13] Load default address sta cmdptr ;[13] ... lda #ftcdef^ ;[13] ... sta cmdptr+1 ;[13] ... ldy #cmfdff ;[13] Tell Comnd there is a default 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 ; ... ldy #$00 ;[13] No special flags needed 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 stslot: ldx #$08 ;[12] Base for ASCII value ldy #$00 ;[13] No special flags needed lda #cmnum ;[12] Code for integer number jsr comnd ;[12] Go do it jmp kermt4 ;[12] The number was bad tya ;[13][12] If this isn't zero cmp #$00 ;[12] then the number is too big beq stslt1 ;[12] It is, continue jmp kermt4 ;[12] Bad number, tell them stslt1: txa ;[13][12] Get L.O. byte cmp #$08 ;[12] It shouldn't be bigger than this bmi stslt2 ;[12] If it's less, it is ok jmp kermt4 ;[12] Tell the user it is bad stslt2: sta kersli ;[12] Stuff it in the slot index asl kersli ;[12] Shift it 4 times to make it an index asl kersli ;[12] for I/O operations asl kersli ;[12] ... asl kersli ;[12] ... jsr prcfm ;[12] Go parse and print a confirm jmp kermit ;[12] Go back stddr: lda #ddkey\ ;[12] Load the address of the keyword table sta cminf1 ;[12] Save it for the keyword routine lda #ddkey^ ;[12] ... sta cminf1+1 ;[12] ... ldy #$00 ;[13] No special flags needed lda #cmkey ;[12] Comnd code for parse keyword jsr comnd ;[12] Go get it jmp kermt2 ;[12] Give an error stx kerdd ;[12] Save the device-driver index sty kerdd1 ;[12] and its print string index lda #cmcfm ;[12] Parse for a confirm jsr comnd ;[12] Do it jmp kermt3 ;[12] Not confirmed, tell the user that jmp kermit stpari: lda #parkey\ ;[21] Load the address of the keyword table sta cminf1 ;[21] Save it for the keyword routine lda #parkey^ ;[21] ... sta cminf1+1 ;[21] ... ldy #$00 ;[21] No special flags needed lda #cmkey ;[21] Comnd code for parse keyword jsr comnd ;[21] Go get it jmp kermt2 ;[21] Give an error stx parity ;[21] Stuff returned value into parity lda #cmcfm ;[21] Parse for a confirm jsr comnd ;[21] Do it jmp kermt3 ;[21] Not confirmed, tell the user that jmp kermit ;[21] stkbd: lda #kbkey\ ;[35] Load the address of the keyword table sta cminf1 ;[35] Save it for the keyword routine lda #kbkey^ ;[35] ... sta cminf1+1 ;[35] ... ldy #$00 ;[35] No special flags needed lda #cmkey ;[35] Comnd code for parse keyword jsr comnd ;[35] Go get it jmp kermt2 ;[35] Give an error stx kbd1 ;[35] Save the print string index sty kbdtyp ;[35] and the keyboard-type index. lda #cmcfm ;[35] Parse for a confirm jsr comnd ;[35] Do it jmp kermt3 ;[35] Not confirmed, tell the user that jmp kermit ;[35] stddsk: lda #ddskey\ ;[40] Set up keyword table pointer sta cminf1 ;[40] ... lda #ddskey^ ;[40] ... sta cminf1+1 ;[40] ... ldy #$00 ;[40] No special features lda #cmkey ;[40] We are looking for a keyword jsr comnd ;[40] Do the call to find the keyword jmp kermt2 ;[40] Nope, we lost lda #stddjt\ ;[40] Fetch the address of the jump table sec ;[40] ... sbc #$01 ;[40] and adjust it accordingly sta jtaddr ;[40] Stuff it in a hold area for now lda #stddjt^ ;[40] Do H.O. byte sbc #$00 ;[40] ... sta jtaddr+1 ;[40] ... txa ;[40] Get data returned from keyword clc ;[40] Set up to adjust address adc jtaddr ;[40] Add it into the address tax ;[40] Hold first byte lda jtaddr+1 ;[40] Do H.O. byte adc #$00 ;[40] ... pha ;[40] Push the address txa ;[40] Get back L.O. byte pha ;[40] and push it rts ;[40] Jump through the table stddjt: jmp stdddr ;[40] Set drive jmp stddsl ;[40] Set slot stdddr: ldx #$10 ;[40] Base 16 ldy #$00 ;[40] No special features about parse lda #cmnum ;[40] Parse an integer jsr comnd ;[40] Do it jmp kermt4 ;[40] Didn't find an integer cpy #$00 ;[40] H.O. byte should be zero bne stdddo ;[40] Otherwise we are way out of range cpx #maxdrv+1 ;[40] > maximum drive number available? bpl stdddo ;[40] Yup, out of range cpx #mindrv ;[40] < minimum drive number available? bmi stdddo ;[40] Out of range stx ksavex ;[40] Save while we parse confirm lda #cmcfm ;[40] Set up to parse confirm jsr comnd ;[40] Do it jmp kermt3 ;[40] Wasn't properly confirmed lda ksavex ;[40] Fetch back the data sta defdrv ;[40] Stuff it where it belongs jmp kermit ;[40] Jump to top again stdddo: ldx #ermesf\ ;[40] Fetch the address of the error ldy #ermesf^ ;[40] ... jsr prstr ;[40] Print the text jsr prcrlf ;[40] Follow with a crelf jmp kermit ;[40] Return to top stddsl: ldx #$10 ;[40] Base 16 ldy #$00 ;[40] No special parse features lda #cmnum ;[40] Parse integer jsr comnd ;[40] Do it jmp kermt4 ;[40] No integer, give error cpy #$00 ;[40] H.O. byte better be 0 bne stddso ;[40] else, slot out of range cpx #maxslt+1 ;[40] > maximum slot available? bpl stddso ;[40] Out of range cpx #minslt ;[40] < minimum slot available? bmi stddso ;[40] Out of range stx ksavex ;[40] Save while we parse the confirm lda #cmcfm ;[40] Set up token for confirm jsr comnd ;[40] Parse it jmp kermt3 ;[40] Lost, no confirm lda ksavex ;[40] Fetch the saved value sta defslt ;[40] Place it where it belongs jmp kermit ;[40] Jump to top again stddso: ldx #ermese\ ;[40] Tell user about the range error ldy #ermese^ ;[40] ... jsr prstr ;[40] Print the error text jsr prcrlf ;[40] Print a crelf jmp kermit ;[40] Go to top .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 #shodef\ ;[13] Fetch default address sta cmdptr ;[13] ... lda #shodef^ ;[13] ... sta cmdptr+1 ;[13] ... ldy #cmfdff ;[13] Indicate that there is a default lda #cmkey ; Comnd code to parse keyword jsr comnd ; Go parse the keyword jmp kermt2 ; Bad keyword, go give an error lda #shocmb\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #shocmb^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that txa ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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) 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 jsr prcfm ;[12] Parse for confirm jsr shslot ;[12] Show the I/O index jmp kermit ;[12] Go to top of main loop jsr prcfm ;[12] Parse for confirm jsr shddr ;[12] Show Device-driver jmp kermit ;[12] Go to top of main loop jsr prcfm ;[21] Parse for confirm jsr shpari ;[21] Show Device-driver jmp kermit ;[21] Go to top of main loop jsr prcfm ;[35] Parse for confirm. jsr shkbd ;[35] Show keyboard type. jmp kermit ;[35] Go to top of main loop. jsr prcfm ;[40] Parse for confirm. jsr shddsk ;[40] Show keyboard type. jmp kermit ;[40] Go to top of main loop. shall: jsr shdb ; Show debugging mode switch jsr shvt ; Show vt52-emulation mode switch jsr shibm ;[21] Show ibm-mode switch jsr shle ; Show local-echo switch jsr shpari ;[21] Show parity setting 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 shslot ;[12] Show the I/O index jsr shddr ;[12] Show the device-driver begin used jsr shkbd ;[35] Show keyboard type. jsr shddsk ;[40] Show keyboard type. jsr shrcal ; Show receive parameters jsr shsnal ; Show send parameters rts ; Return shdb: ldx #shin00\ ;[26] Get address of 'debug mode' string ldy #shin00^ ;[26] ... jsr prstr ;[26] Print that lda debug ;[26] Get the debug mode cmp #$03 ;[26] Is it >= 3? bmi shdb1 ;[26] If not just get the string and print it lda #$00 ;[26] This is index for debug mode we want shdb1: tax ;[26] Hold this index lda #kerdms\ ;[26] Get the address of the device strings sta kermbs ;[26] And stuff it here for genmad lda #kerdms^ ;[26] ... sta kermbs+1 ;[26] ... lda #kerdsz ;[26] Get the string length pha ;[26] Push that txa ;[26] Fetch the index back pha ;[26] Push that parm then jsr genmad ;[26] call genmad jsr prstr ;[26] Print the the string at that address jsr prcrlf ;[26] Print a crelf after it rts 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 ; ... ldy #$00 ;[13] No special flags needed 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 sta kwrk01 ;[9] Hold it here until it is needed lda #shcmb\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #shcmb^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that lda kwrk01 ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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) 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 ; ... ldy #$00 ;[13] No special flags needed 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 sta kwrk01 ;[9] Hold it here until it is needed lda #shcmb\ ;[9] Get the L.O. byte of jump table sec ;[9] Turn carry on for subtraction sbc #$01 ;[9] Decrement the address once sta jtaddr ;[9] Put the L.O. byte here until needed lda #shcmb^ ;[9] Get the H.O. byte sbc #$00 ;[9] And adjust for carry (borrow) if any sta jtaddr+1 ;[9] Store that lda kwrk01 ;[9] Get the offset in AC clc ;[9] Clear the carry adc jtaddr ;[9] Add the L.O. byte of address tax ;[9] Hold it here for now lda jtaddr+1 ;[9] Get the H.O. byte of address 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) 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 'file-type' 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 shslot: ldx #shin18\ ;[12] Get address of 'slot' string ldy #shin18^ ;[12] ... jsr prstr ;[12] Print that lda kersli ;[12] If index is 1, this gets spsiz sta kwrk01 ;[12] Hold it here so we can shift it lsr kwrk01 ;[12] Shift it 4 times lsr kwrk01 ;[12] to make it a slot number lsr kwrk01 ;[12] ... lsr kwrk01 ;[12] ... lda kwrk01 ;[12] Fetch it back jsr prbyte ;[12] Print the current slot number jsr prcrlf ;[12] Print a crelf after it rts ;[12] and return shddr: ldx #shin19\ ;[12] Get address of 'device-driver' string ldy #shin19^ ;[12] ... jsr prstr ;[12] Print that lda kerdd1 ;[12] Get the device-driver identification cmp #$03 ;[12] Is it >= 3? bmi shddr1 ;[12] If not just get the string and print it lda #$01 ;[12] This is index for device-driver we want shddr1: tax ;[12] Hold this index lda #kerdds\ ;[12] Get the address of the device strings sta kermbs ;[12] And stuff it here for genmad lda #kerdds^ ;[12] ... sta kermbs+1 ;[12] ... lda #kerddl ;[12] Get the string length pha ;[12] Push that txa ;[12] Fetch the index back pha ;[12] Push that parm then jsr genmad ;[12] call genmad jsr prstr ;[12] Print the the string at that address jsr prcrlf ;[12] Print a crelf after it rts shpari: ldx #shin20\ ;[21] Get address of 'parity' string ldy #shin20^ ;[21] ... jsr prstr ;[21] Print that lda parity ;[21] Get the parity index cmp #$05 ;[21] Is it >= 5? bmi shpar1 ;[21] If not just get the string and print it lda #$00 ;[21] This is the index to the parity we want shpar1: tax ;[21] Hold this index lda #kerprs\ ;[21] Get address of the parity strings sta kermbs ;[21] And stuff it here for genmad lda #kerprs^ ;[21] ... sta kermbs+1 ;[21] ... lda #kerpsl ;[21] Get the string length pha ;[21] Push that txa ;[21] Fetch the index back pha ;[21] Push that parm then jsr genmad ;[21] call genmad jsr prstr ;[21] Print the the string at that address jsr prcrlf ;[21] Print a crelf after it rts shkbd: ldx #shin21\ ;[35] Get address of 'keyboard-type' string ldy #shin21^ ;[35] ... jsr prstr ;[35] Print that lda kbd1 ;[35] Get the keyboard-type identification. cmp #$03 ;[35] Is it >= 3? bmi shkbd1 ;[35] If not just get the string and print it lda #$01 ;[35] This is index for keyboard-type we want. shkbd1: tax ;[35] Hold this index lda #kbds\ ;[35] Get the address of the keyboard strings sta kermbs ;[35] And stuff it here for genmad lda #kbds^ ;[35] ... sta kermbs+1 ;[35] ... lda #kbdl ;[35] Get the string length pha ;[35] Push that txa ;[35] Fetch the index back pha ;[35] Push that parm then jsr genmad ;[35] call genmad jsr prstr ;[35] Print the the string at that address jsr prcrlf ;[35] Print a crelf after it rts ;[35] shddsk: ldx #shin22\ ;[40] Set up to print slot message ldy #shin22^ ;[40] ... jsr prstr ;[40] Print the text lda defslt ;[40] Get the number jsr prbyte ;[40] Put it on the screen jsr prcrlf ;[40] Print a crelf ldx #shin23\ ;[40] Set up for the drive message ldy #shin23^ ;[40] ... jsr prstr ;[40] Print the text lda defdrv ;[40] Get the number jsr prbyte ;[40] Put drive number on screen jsr prcrlf ;[40] Print a crelf rts ;[40] Return .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 bit errcod ;[38] Test for 'Error packet received' bit bvs statpe ;[38] Go process an error packet 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 statpe: ldx #errrkm\ ;[38] L.O. byte address of remote kermit error ldy #errrkm^ ;[38] H.O. byte address... jsr prstr ;[38] Print the text from the error packet jsr prcrlf ;[38] Print an extra crelf jmp kermit ;[38] Start at the top again .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: ldx #snin01\ ; Give the user info on what we are doing ldy #snin01^ ; ... jsr prstr ; Print the information lda tpak+1 ;[16] Get the total packets count jsr prbyte ;[16] and print that lda tpak ;[16] ... jsr prbyte ;[16] ... jsr prcrlf ; Output a crelf lda #$00 ;[25] Clear packet data index sta pdtind ;[25] ... spaknd: lda spadch ; Get the padding character ldx #$00 ; Init counter spakpd: cpx spad ; Are we done padding? bcs spakst ;[21] Yes, start sending packet inx ; No, up the index and count by one jsr putplc ; Output a padding character jmp spakpd ; Go around again spakst: lda #soh ; Get the start-of-header char into AC jsr putplc ; 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 putplc ;[25] 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 putplc ;[25] 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 putplc ;[25] 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 putplc ;[25] 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 putplc ;[25] and send it lda seol ; Fetch the eol character jsr putplc ;[25] Send that as the last byte of the packet lda pdtind ;[25] Set the end of buffer pointer sta pdtend ;[25] ... lda #$00 ;[25] Set index to zero sta pdtind ;[25] ... lda debug ;[25] Is the debug option turned on? cmp #off ;[25] ... beq spaksp ;[25] Nope, go stuff packet at other kermit lda #$00 ;[25] Option 0 jsr debg ;[25] Do it spaksp: lda #$00 ;[25] Zero the index sta pdtind ;[25] ... spakdl: ldx pdtind ;[25] Are we done? cpx pdtend ;[25] ... bpl spakcd ;[25] Yes, go call debug again lda plnbuf,x ;[25] Get the byte to send jsr telppc ;[25] Ship it out inc pdtind ;[25] Increment the index once jmp spakdl ;[25] Go to top of data send loop spakcd: lda debug ; Get debug switch cmp #off ;[26] Do we have to do it? beq spakcr ;[26] 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 lda ibmmod ;[21] Is ibm-mode on? cmp #on ;[21] ... bne rpakst ;[21] If not, start working on the packet rpakc0: jsr getc ;[21] Any characters yet? jmp rpakst ;[21] Got one from the keyboard cmp #xon ;[21] Is it an XON? bne rpakc0 ;[21] Nope, try again rpakst: jsr home ; Clear the screen ldx #rcin01\ ; Give the user info on what we are doing ldy #rcin01^ ; ... jsr prstr ; Print the information lda tpak+1 ;[16] Get the total packets count jsr prbyte ;[16] and print that lda tpak ;[16] ... jsr prbyte ;[16] ... jsr prcrlf ; Output a crelf lda debug ; Is debugging on? cmp #off ;[26] ... beq rpaknd ;[26] 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 #$00 ;[26] Zero the index for debug mode sta pdtind ;[26] ... lda debug ; Is debug switch on? cmp #off ;[26] ... beq rpkfnd ;[26] 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 #$00 ;[26] Zero the index for debug mode sta pdtind ;[26] ... lda debug ; Check debug switch cmp #off ;[26] Is it on? beq rpkrnd ;[26] 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 debug ;[26] Get the debug switch cmp #terse ;[26] Is it terse bne debgvr ;[26] Nope, must be Verbose mode jmp debgtr ;[26] Yes, to terse debug output debgvr: lda state ;[26] 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 #debms3\ ;[26] Get address of message text ldy #debms3^ ;[26] ... jsr prstr ; Print it inc pdtind ;[26] Pass the SOH ldx pdtind ;[26] Get the index lda plnbuf,x ;[26] Get the data length sec ;[26] Uncharacter this value sbc #$20 ;[26] ... jsr prbyte ; Print the hex value jsr prcrlf ; New line ldx #debms2\ ;[26] Get address of next message to print ldy #debms2^ ;[26] ... jsr prstr ; Print that one inc pdtind ;[26] Next character is packet number ldx pdtind ;[26] ... lda plnbuf,x ;[26] Load it sec ;[26] Uncharacter this value sbc #$20 ;[26] ... jsr prbyte ; Print the hex value jsr prcrlf ; New line inc pdtind ;[26] Bypass the packet type ldy #$ff ;[26] Start counter at -1 sty kwrk02 ;[26] Store it here debprc: inc kwrk02 ;[26] Increment the counter ldy kwrk02 ;[26] Get counter cpy pdlen ; Are we done printing the packet data? bpl debdon ; If so, go finish up inc pdtind ;[26] Point to next character ldx pdtind ;[26] Fetch the index lda plnbuf,x ;[26] Get next byte from packet jsr prchr ; Go output special character lda #hspace ;[26] Now print 1 space jsr cout ; ... jmp debprc ; Go check next character debdon: jsr prcrlf ; Next line ldx #debms4\ ; Get the address to the 'checksum' message ldy #debms4^ ; ... jsr prstr ; Print that message inc pdtind ;[26] Get next byte, this is the checksum ldx pdtind ;[26] ... lda plnbuf,x ;[26] ... sec ;[26] Uncharacter this value sbc #$20 ;[26] ... jsr prbyte ; Print the hex value of the checksum jsr prcrlf ; Print two(2) crelfs jsr prcrlf ; ... rts ; and return .SBTTL Terse debug output ; ; This routine does brief debug output. It prints only the contents ; of the packet with no identifying text. ; debgtr: txa ;[26] Look at Option cmp #$00 ;[26] Sending? beq debgsn ;[26] Yes, output 'SENDING: ' cmp #$03 ;[26] Failed receive? beq debgrc ;[26] Yes, output 'RECEIVED: ' cmp #$04 ;[26] Receive? beq debgrc ;[26] Yes, output 'RECEIVED: ' rts ;[26] Neither, just return debgsn: ldx #sstrng\ ;[26] Get ready to print the string ldy #sstrng^ ;[26] ... jsr prstr ;[26] Do it! jsr prcrlf ;[26] Print a crelf jmp debgdp ;[26] Go dump the packet debgrc: ldx #rstrng\ ;[26] Get ready to print the string ldy #rstrng^ ;[26] ... jsr prstr ;[26] Do it! jsr prcrlf ;[26] Print a crelf debgdp: ldx pdtind ;[26] Get index cpx pdtend ;[26] Are we done? bpl debgfn ;[26] Yes, return lda plnbuf,x ;[26] Get the character jsr prchr ;[26] Print it lda #hspace ;[26] Print a space jsr cout ;[26] ... inc pdtind ;[26] Advance the index jmp debgdp ;[26] Do next character debgfn: jsr prcrlf ;[26] Print a crelf then... rts ;[26] 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: jsr movdds ;[40] Go move in the default slot and disk 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 opnfls: sta primfn,y ;[28] Stuff the space there iny ;[28] Up the pointer cpy #mxfnl+1 ;[28] Done bpl opnfil ;[28] Yup, continue jmp opnfls ;[28] No, loop again 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: jsr movdds ;[40] Go move in default slot and drive 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: jsr movdds ;[40] Go move in default slot and drive 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: jsr movdds ;[40] Go move in default slot and drive 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 filename ora #$80 ;[19] buffer in negative ascii format cmp #$80 ;[19] Was the character null? bne cloms ;[19] If it wasn't, move it in. lda #hspace ;[19] Otherwise, replace it with a space cloms: sta primfn,y ;[19] format 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 filmod ;[6] Get the file-type beq bufcet ;[6] Text file, go check for end of text sec ;[6] Set the carry for subtraction lda fillen ;[6] Get the remaining file length sbc #$01 ;[6] Decrement it once sta fillen ;[6] Put it back lda fillen+1 ;[6] Do the High order byte sbc #$00 ;[6] ... sta fillen+1 ;[6] ... cmp #$ff ;[6] Did this just go below zero? beq bufcfl ;[6] If so, check the low order byte jmp bufceb ;[6] Otherwise, continue filling buffer bufcfl: lda fillen ;[6] Get the low order byte of the file length cmp #$ff ;[6] If this is also -1 we are at eof bne bufceb ;[6] No, continue processing ldx dsbend ;[6] Make sure fgetc fails next time through stx dsbind ;[6] and shows eof. lda #on ;[6] Set the end-of-data flag on sta eodind ;[6] ... jmp bffret ;[6] Go return with the length of the buffer bufcet: lda kerchr ;[6] Get the character and #$7f ;[6] Make sure we are only working with 7-bits bne bufceb ;[6] If it's not null, there's still more text ldx dsbend ;[6] Otherwise, make sure fgetc fails and stx dsbind ;[6] returns eof next time jmp bffchk ;[6] Go return with the buffer length bufceb: 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 ldx filmod ;[8] Get the file-type bne bffctl ;[8] If it is not text, ignore problem cmp #cr ;[8] Do we have a here? bne bffctl ;[8] Nope, continue processing ldx #on ;[8] Set flag to add a next time through stx addlf ;[8] ... 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: lda ebqmod ;[11] Is 8-bit quoting turned on? cmp #on ;[11] ... bne bffstf ;[11] If not, skip this junk lda kerchr ;[11] otherwise, check for 8-bit quote char. 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 filmod ;[8] Check if this is a text file bne bfefpc ;[8] If not, continue normal processing lda kerchr ;[8] Get a copy of the character and #$7f ;[8] Make sure we test L.O. 7-bits only cmp #cr ;[8] Do we have a ? bne bfeclf ;[8] No, then check for lda #on ;[8] Yes, set the 'Delete ' flag sta dellf ;[8] ... jmp bfefpc ;[8] And then continue bfeclf: cmp #lf ;[8] Do we have a ? bne bfenlf ;[8] Nope, We must go shut the Dellf flag. lda dellf ;[8] We have a , is the flag on? cmp #on ;[8] ... bne bfefpc ;[8] If not, continue normally lda #off ;[8] Flag is on, follows , ignore it sta dellf ;[8] Start by zeroing flag jmp bfeou1 ;[8] Now go to end of loop bfenlf: lda #off ;[8] Zero Dellf sta dellf ;[8] ... bfefpc: lda kerchr ;[8] Get the character once more 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 jsr clrfcb ;[43] Clear fcb, else things get messed up ldy #$00 ; Initialize the y reg 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: lda addlf ;[8] Get the 'add a lf' flag cmp #on ;[8] Is it on? bne fgetc1 ;[8] No, continue with normal processing lda #off ;[8] Zero the flag first sta addlf ;[8] ... lda #hlf ;[8] Get a jmp fgtgn1 ;[8] and return that as the next character fgetc1: ldx dsbind ;[8] Get the file buffer index cpx dsbend ; Are we passed the last character? bpl fgetc2 ;[6] Yes, go read next sector jmp fgtgnc ;[6] No, get next character fgetc2: lda eodind ;[6] Check for end-of-data first cmp #on ;[6] Is it on? bne fgtc2a ;[6] No, go read next sector jmp fgteof ;[6] It was on so there is no data to read fgtc2a: lda #fncrea ;[6] 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'? beq fgetc3 ;[6] Yes, just handle the eof condition jmp fgtcan ;[6] No, this is a serious error, fail fgetc3: lda #mxdb-2 ;[6] If 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 ; ... lda fetfl ;[6] Get the 'fetch file-length' flag cmp #on ;[6] Is it on? bne fgtgnc ;[6] If not, continue processing normally ldx #$00 ;[6] The length should be first lda filmod ;[6] Unless... cmp #$04 ;[6] This is a binary file bne fgtst1 ;[6] If not, continue inx ;[6] Otherwise get length from bytes 2 and 3 inx ;[6] instead of bytes 0 and 1 fgtst1: lda dosbuf,x ;[6] Get the L.O. byte sta fillen ;[6] Stuff it in the file length word inx ;[6] Point at H.O. byte lda dosbuf,x ;[6] Fetch it sta fillen+1 ;[6] Store that in the file length word ldx #$02 ;[6] We have to adjust the length lda filmod ;[6] by either 2 or 4 depending on the cmp #$04 ;[6] file type... bne fgtst2 ;[6] If it's not binary, 2 will do inx ;[6] Otherwise we have to adjust up by 4 inx ;[6] fgtst2: stx kwrk01 ;[6] Store it here for now clc ;[6] Clear carry for addition lda fillen ;[6] Fetch L.O. byte of file length adc kwrk01 ;[6] Add in the adjustment sta fillen ;[6] ... lda fillen+1 ;[6] Do H.O. byte adc #$00 ;[6] ... sta fillen+1 ;[6] ... lda #off ;[6] Finally, make sure we turn off the flag sta fetfl ;[6] ... fgtgnc: ldx dsbind ; Fetch the current index lda dosbuf,x ; Get the character at that point inc dsbind ; Increment the index fgtgn1: ldx fbsize ;[8] 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. ; Edit 16 adds the function of incrementing the total packet ; count for display during transmission ; 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 clc ;[16] Clear carry again lda tpak ;[16] Increment L.O. byte of adc #$01 ;[16] total packet count sta tpak ;[16] ... lda tpak+1 ;[16] Do H.O. byte adc #$00 ;[16] ... sta tpak+1 ;[16] ... pla ; Restore the AC rts ; and return ; ; Movdds - This routine moves the default slot and drive for ; file transfers into the appropriate locations for DOS to ; find them. ; movdds: pha ;[40] Save the AC across this call lda defslt ;[40] Move the slot sta kdslot ;[40] to where it belongs lda defdrv ;[40] Move the drive sta kddisk ;[40] to where it belongs pla ;[40] Restore the AC rts ;[40] and return ; ; Prcerp - Process error packet. Moves the Remote Kermit error ; text into a save area, notes that there was an error received ; from the remote Kermit in Errcod (set H.O. bit), and displays ; the text on the screen. ; prcerp: lda ptype ;[38] Reload the packet type cmp #'E ;[38] Is it an error packet? beq prcer1 ;[38] Yes, continue processing rts ;[38] No, return prcer1: lda #pdbuf\ ;[38] Set up from-address sta kerfrm ;[38] ... lda #pdbuf^ ;[38] ... sta kerfrm+1 ;[38] ... lda #errrkm\ ;[38] Set up the to-address sta kerto ;[38] ... lda #errrkm^ ;[38] ... sta kerto+1 ;[38] ... ldy pdlen ;[38] Get packet data length sty kwrk01 ;[38] Store for the copy routine lda #$00 ;[38] Start by storing a null at the end sta (kerto),y ;[38] ... jsr kercpy ;[38] Copy the error text lda errcod ;[38] Set the bit in the error code ora #eprflg ;[38] saying that the remote Kermit sent us sta errcod ;[38] an error packet. ldx #errrkm\ ;[38] Finally, display the error packet ldy #errrkm^ ;[38] ... jsr prrstr ;[38] Print string jsr prcrlf ;[38] Make it look neat, add a crlf rts ;[38] Return to caller ; ; Prrstr - print a string from a remote source (i.e. there may ; be lower case or special characters in it. ; prrstr: stx saddr ;[38] Save Low order byte sty saddr+1 ;[38] Save High order byte ldy #$00 ;[38] Clear Y reg prrst1: lda (saddr),y ;[38] Get the next byte of the string beq prrsrt ;[38] If it is null, we are done pha ;[38] Hold the AC lda #$32 ;[38] Set delay jsr $fca8 ;[38] Do the delay pla ;[38] Fetch the character back jsr dspchr ;[38] Print the character iny ;[38] Up the index bne prrst2 ;[38] If zero, the string is <256, continue inc saddr+1 ;[38] Increment page number prrst2: jmp prrst1 ;[38] Go back to print next byte prrsrt: rts ;[38] 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 sta kbd ;[21] Try to make sure we don't get an sta kbdstr ;[21] unwarranted keyboard interupt gobb: jsr getc ;[27] Get a character jmp gobb2 ;[27] Got a keyboard interupt cmp #soh ;[27] Is it a start-of-header? bne gobb ;[27] No, flush until first SOH jmp gobbst ;[27] Ok, now we can start gobb0: jsr getc ; Get a character jmp gobb2 ; Got a keyboard interupt cmp #soh ;[27] If this not an SOH bne gobb1 ;[27] continue here tax ;[27] Hold the character here lda #$00 ;[27] Rezero the index pointing to end of buf sta pdtend ;[27] ... txa ;[27] Get the SOH back jmp gobbdb ;[27] Go stuff the character in the buffer gobb1: cmp reol ; Is it the end-of-line character? beq gobb3 ; Yes, finish up gobbst: ldx pdtend ;[27] Get the index we need gobbdb: sta plnbuf,x ;[27] Stuff the character at the buffer inc pdtend ; Increment the index once jmp gobb0 ; Loop for another character gobb2: rts ; Just return, no skip gobb3: ldx pdtend ;[27] Get end pointer again sta plnbuf,x ;[27] Store the End-of-line before we leave 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! ; ; Putplc - puts a character to the port line buffer. ; putplc: ldx pdtind ;[25] Get the current index inx ;[25] Check if we are at end of buffer bne putpl1 ;[25] No, continue rts ;[25] Return without a skip putpl1: dex ;[25] Set index back to what it was sta plnbuf,x ;[25] Get the next character from the buffer inc pdtind ;[25] Up the index once rts ;[25] Return .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 #shon\ ;[13] Set up default string for parse sta cmdptr ;[13] ... lda #shon^ ;[13] ... sta cmdptr+1 ;[13] ... ldy #cmfdff ;[13] Show there is a default 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 ; ; Clrfcb - clears the area FCB1 so the filename placed there ; will not be corrupted. ; clrfcb: ldx #$1f ;[29] Load max filename length lda #hspace ;[29] We will be filling with spaces clrfc1: sta fcb1,x ;[29] Stuff the space dex ;[29] Decrement our pointer bpl clrfc1 ;[29] Not done, go back rts ;[29] Return ; ; Kercpy - copies the string pointed to by Kerfrm to the ; block of memory pointed to by Kerto for Kwrk01 characters. ; kercpy: ldy kwrk01 ;[13] Get the length of the string kerclp: dey ;[13] One character less bmi kercrt ;[13] If this went negative, we're done lda (kerfrm),y ;[13] Get the next character sta (kerto),y ;[13] And put it where it belongs jmp kerclp ;[13] Go back for next char kercrt: rts ;[13] Job is done, return ; ; Kerflm - fills the buffer pointed to by Kerto with the ; character in kwrk02 for Kwrk01 characters. ; kerflm: ldy kwrk01 ;[13] Get the length of the string kerflp: dey ;[13] One character less bmi kerflr ;[13] If this went negative, we're done lda kwrk02 ;[13] Get the fill character sta (kerto),y ;[13] And put it in the next position jmp kerflp ;[13] Go back to do next char kerflr: rts ;[13] Job is done, return ; ; 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 #$a0 ;[26] 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: jsr cout ;[26] 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 #'Y ;[11] Send 'Y' - I will support 8-bit quoting 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 pdlen ;[11] Check the data length to see cmp #$09 ;[11] if the 8-bit quote is there bmi rparrt ;[11] If not, return lda (kerbf1),y ;[11] Fetch the 8-bit quote cmp #'N ;[11] Is it 'N' beq rpar8 ;[15][11] Yes, leave.(he doesn't support 8-bit) cmp #'Y ;[11] Does he support 8-bit quoting? beq rpar8 ;[15][11] If so, leave. (we don't need it.) cmp #'! ;[11] Now, it should be a real character bmi rparrt ;[11] Check if it is in range. cmp #'? ;[11] If so, we set the 8-bit quote char bmi rpar7 ;[11] and set 8-bit quoting on. cmp #$60 ;[11] If not, just leave. bmi rparrt ;[11] ... cmp #del ;[11] ... bpl rparrt ;[11] ... rpar7: sta sebq ;[11] Stuff the character here lda #on ;[11] Set 8-bit quoting on sta ebqmod ;[11] ... rts ;[15] Return rpar8: sta sebq ;[15] Make sure this parm is stored lda #off ;[15] AND that 8-bit quoting is off. sta ebqmod ;[15] ... rparrt: rts ;[11] 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 ;[45][30] .endc .SBTTL Command tables and help text kercmd: .byte $0c ;[14] Table length ; .byte $0d ;[14] Table length with LOG command installed .byte $03 ;[14] Keyword length .asciz /BYE/ ;[14] Keyword terminated with a null .byte $1E,$1E ;[14] Two bytes of data .byte $07 .asciz /CONNECT/ .byte $00,$00 .byte $04 .asciz /EXIT/ .byte $03,$03 .byte $06 ;[14] New command .asciz /FINISH/ ;[14] .byte $21,$21 ;[14] .byte $03 ;[14] New commnad .asciz /GET/ ;[14] .byte $24,$24 ;[14] .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 $10 ;[40][35] Edit 12, 21, 35, and 40 new commands .byte $09 .asciz /DEBUGGING/ .byte $18,$18 .byte $0C ;[40] Add the 'SET DEFAULT-DISK' command .asciz /DEFAULT-DISK/ ;[40] ... .byte $2D,$2D ;[40] ... .byte $0D ;[12] Add the 'SET DEVICE-DRIVER' command .asciz /DEVICE-DRIVER/ ;[12] ... .byte $24,$24 ;[12] ... .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 ;[21] ibm-mode switch .asciz /IBM/ ;[21] .byte $03,$03 ;[21] .byte $08 ;[35] Add the 'SET KEYBOARD' command. .asciz /KEYBOARD/ ;[35] .byte $2A,$2A ;[35] .byte $0A .asciz /LOCAL-ECHO/ .byte $06,$06 .byte $06 ;[21] Add the 'SET PARITY' option .asciz /PARITY/ ;[21] .byte $27,$27 ;[21] .byte $07 .asciz /RECEIVE/ .byte $09,$09 .byte $04 .asciz /SEND/ .byte $0C,$0C .byte $04 ;[12] Add the 'SET SLOT' option .asciz /SLOT/ ;[12] ... .byte $21,$21 ;[12] ... .byte $0E .asciz /VT52-EMULATION/ .byte $0F,$0F shocmd: .byte $11 ;[40][21] Edits 12, 21, 35 and 40 Add options .byte $03 shodef: .asciz /ALL/ ;[13] Default option for 'SHOW' command .byte $00,$00 .byte $09 .asciz /DEBUGGING/ .byte $51,$51 .byte $0C ;[40] Add the 'SHOW DEFAULT-DISK' option .asciz /DEFAULT-DISK/ ;[40] ... .byte $90,$90 ;[40] ... .byte $0D ;[12] Add the 'SHOW DEVICE-DRIVER' option .asciz /DEVICE-DRIVER/ ;[12] ... .byte $75,$75 ;[12] ... .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 ;[21] Add Ibm mode option .asciz /IBM/ ;[21] .byte $12,$12 ;[21] .byte $08 ;[35] Add 'SHOW KEYBOARD' command. .asciz /KEYBOARD/ ;[35] .byte $87,$87 ;[35] .byte $0A .asciz /LOCAL-ECHO/ .byte $1b,$1b .byte $06 ;[21] Add 'SHOW PARITY' command .asciz /PARITY/ ;[21] .byte $7e,$7e ;[21] .byte $07 .asciz /RECEIVE/ .byte $24,$24 .byte $04 .asciz /SEND/ .byte $2d,$2d .byte $04 ;[12] Add the 'SHOW SLOT' option .asciz /SLOT/ ;[12] ... .byte $6c,$6c ;[12] ... .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 ftcdef: .asciz /TEXT/ ;[13] Default for File-type .byte $00,$00 parkey: .byte $05 ;[21] Length of this table is 5 .byte $04 ;[21] .asciz /EVEN/ ;[21] .byte $04,$04 ;[21] .byte $04 ;[21] .asciz /MARK/ ;[21] .byte $02,$02 ;[21] .byte $04 ;[21] .asciz /NONE/ ;[21] .byte $00,$00 ;[21] .byte $03 ;[21] .asciz /ODD/ ;[21] .byte $03,$03 ;[21] .byte $05 ;[21] .asciz /SPACE/ ;[21] .byte $01,$01 ;[21] debkey: .byte $03 ;[26] Length of this table is 3 .byte $03 ;[26] .asciz /OFF/ ;[26] .byte $00,$00 ;[26] .byte $05 ;[26] .asciz /TERSE/ ;[26] .byte $01,$01 ;[26] .byte $07 ;[26] .asciz /VERBOSE/ ;[26] .byte $02,$02 ;[26] ddkey: ;[12] ddcnt=0 ;[12] This section figures out how many .ifne ;[12] keywords there will be in this table. ddcnt=ddcnt+1 ;[12] It does this by counting how many of .endc ;[12] the device feature tests are non-zero. .ifne ;[12] ... ddcnt=ddcnt+1 ;[12] ... .endc ;[12] ... .ifne ;[22] ... ddcnt=ddcnt+1 ;[22] ... .endc ;[22] ... .byte ddcnt ;[12] Now insert the count in the table .ifne ;[12] Check if Apple Com card support requested .byte $0E ;[12] and put it in is so. .asciz /APPLE-COM-CARD/ ;[12] ... .byte $03,$01 ;[12] ... .endc ;[12] ... .ifne ;[12] Check for DC Hayes support requested .byte $08 ;[12] and put it in if so. .asciz /DC-HAYES/ ;[12] ... .byte $00,$00 ;[12] ... .endc ;[12] ... .ifne ;[22] Check if Super Ser card support requested .byte $0E ;[22] and put it in is so. .asciz /SUPER-SER-CARD/ ;[22] ... .byte $06,$02 ;[22] ... .endc ;[22] ... kbkey: .byte $02 ;[35] Entries in keyboard type table. .byte $02 ;[35] .asciz /2E/ ;[35] Apple 2E keyboard .byte $03,kbap2e ;[35] .byte $02 ;[35] .asciz /2P/ ;[35] Apple 2/2+ keyboard .byte $00,kbap2p ;[35] 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 ddskey: .byte $02 ;[40] Two options for now .byte $05 ;[40] Length .asciz /DRIVE/ ;[40] Keyword .byte $00,$00 ;[40] Data .byte $04 ;[40] Length .asciz /SLOT/ ;[40] Keyword .byte $03,$03 ;[40] Data kerehr: .byte cmcfm ;[13] Tell them they can also confirm .byte nul ;[13] End Help command string kerhlp: .byte hcr nasc 0 .byte hcr .byte hcr nasc 0 ;[14] New command .byte hcr ;[14] nasc < REMOTE KERMIT SERVER, THEN> 0 ;[14] .byte hcr ;[14] nasc < EXIT.> 0 ;[14] .byte hcr ;[14] .byte hcr ;[14] nasc 0 .byte hcr nasc < KERMIT DIRECTLY.> 0 .byte hcr .byte hcr nasc 0 .byte hcr nasc < THE HOST OPERATING SYSTEM.> 0 .byte hcr .byte hcr nasc 0 ;[14] New command .byte hcr ;[14] nasc < SERVER BUT DO NOT LOG OUT> 0 ;[14] .byte hcr ;[14] nasc < REMOTE JOB. DO NOT EXIT FROM> 0 ;[14] .byte hcr ;[14] nasc < LOCAL KERMIT.> 0 ;[14] .byte hcr ;[14] .byte hcr ;[14] nasc 0 ;[14] New command .byte hcr ;[14] nasc < SERVER KERMIT. THE FILENAME> 0 ;[14] .byte hcr ;[14] nasc < IS VALIDATED BY THE REMOTE> 0 ;[14] .byte hcr ;[14] nasc < SERVER.> 0 ;[14] .byte hcr ;[14] .byte hcr ;[14] 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 DEBBUGING 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 < 0 - NULL CHARACTER> 0 .byte hcr nasc < B - BREAK SIGNAL> 0 .byte hcr nasc < C - CLOSE THE CONNECTION> 0 .byte hcr nasc < S - STATUS> 0 .byte hcr nasc < ESCAPE-CHAR - TRANSMIT THE ESCAPE CHARACTER> 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 ermesa: .byte hcr nasc 1 ermesb: .byte hcr ;[13] nasc 1 ;[13] ermesc: .byte hcr ;[14] nasc 1 ;[14] ermesd: .byte hcr ;[14] nasc 1 ;[14] ermese: .byte hcr ;[40] nasc 1 ;[40] ermesf: .byte hcr ;[40] nasc 1 ;[40] 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 kerdds: nasc 1 ;[12] Device driver strings nasc 1 ;[12] ... nasc 1 ;[22] ... kbds: nasc <2P > 1 ;[35] keyboard type strings nasc <2E > 1 ;[35] kerftp: nasc 1 nasc 1 nasc 1 nasc 1 kerprs: nasc 1 ;[21] Parity strings nasc 1 ;[21] nasc 1 ;[21] nasc 1 ;[21] nasc 1 ;[21] kerdms: nasc 1 ;[26] Debug mode strings nasc 1 ;[26] nasc 1 ;[26] .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 shin18: nasc 1 ;[12] Add for 'SHOW SLOT' shin19: nasc 1 ;[12] For 'SHOW DEVICE-DRIVER' shin20: nasc 1 ;[21] For 'SHOW PARITY' shin21: nasc 1 ;[35] For 'SHOW KEYBOARD'. shin22: nasc 1 ;[40] Default drive shin23: nasc < DRIVE= > 1 ;[40] messages shon: nasc 1 shoff: nasc 1 shsbit: nasc 1 shebit: nasc 1 sstrng: nasc 1 ;[26] For Terse debug rstrng: nasc 1 ;[26] ... 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 1 ;[4] Second half of connect message .SBTTL End of Kermit-65 Source .end