.TITLE KERMIT-65 KL10 Error-free Reciprocal Micro-interface Transfer ; ; $Id: c64ker.m65,v 1.73 89/02/23 22:50:00 ray Exp $ ; ; 6502 version - Antonino N. J. Mione ; Commodore 64 version converted from Apple version 1.1 ; By Dave Dermott March, 1984 ; Additional improvements by Eric Lavitsky/Frank Prindle/ ; Michael Marchiondo ; Ray Moody ; Version 2.2 ; Based on the KERMIT Protocol. .SBTTL Revision History ; ; Edit # Description ; ------ ----------- ; 01 By: David Dermott On: Mar 1984 ; Start converting to C-64 ; Edits 15,18,25,27 from APPLEK included ; ; 02 By: David Dermott On: Jul 1984 ; Add SET RS232 REGISTERS to change baud rate ; ; 03 By: David Dermott On: Jul 1984 ; Add ASCII,PETASCI and SCRIPT file formats ; ; 04 By: David Dermott ; Add code to terminal emulate for lower case ; ; 05 By: David Dermott On: Oct 1984 ; Include macros movadr,ldadr,movw,ldxy,stxy, ; pusw,pulw,pusb,pulb ; ; 06 By: David Dermott On: Oct 1984 ; Change indexed jump with JMPIND ; ; 07 By: David Dermott On: Nov 1984 ; Add code to RPAK to set PTYPE to "false" if ; checksum fails. ; ; 08 By: David Dermott On: Nov 1984 ; Add DOS command for local file management ; ; ; 09 By: Eric Lavitsky On: 28-Nov-1984 ; Reformatted Dave Dermotts' code to look more like ; the current Apple version (2.1). ; ; ; 10 By: Eric Lavitsky On: 29-Nov-1984 ; Added or completed Apple revisions 11,13,14,20, ; 21,23,26. This includes fixes to the parser and ; new server commands. ; ; ; 11 By: Eric Lavitsky On: 01-Dec-1984 ; Replaced prrstr with prstr since C64 can display ; lower case. ; ; ; 12 By: Eric Lavitsky On: 03-Dec-1984 ; Make Kermit switch to upper/lower case mode at start ; and close all open channels. Also did more reformating ; of code. ; ; ; 13 By: Eric Lavitsky On: 05-Dec-1984 ; Remove macros pulw,pusw,pulb,pusb,ldadr,movadr,movw ; to be more consistent with Apple code. ; ; ; 14 By: Eric Lavitsky On: 06-Dec-1984 ; Fixed cursor routines, added blink, nblink. Added ; new bell procedure which turns off at next cursor blink. ; Added new definitions for C64 video and sound routines. ; Added a confirm before going into DOS. Cleaned keyword ; table organization to coincide with Apple definitions. ; ; ; 15 By: Eric Lavitsky On: 08-Dec-1984 ; Make the version 1.0 for the first release. Remove ; all Apple edit histories. Leave only [DD] for Dave ; Dermotts' remaining edits and [EL] for those that I ; have done. Future edits will include an edit number ; in the source. ; ; VERSION 1.1 Starts Here ; ; 16 By: Eric Lavitsky On: 15-Dec-1984 ; Add calls to RESTOI and IOINIT at the start of Kermit ; so we can use all those nifty new super loaders that ; mess around with the I/O vectors. ; ; ; 17 By: Eric Lavitsky On: 26-Dec-1984 ; Added Set Baud option. Also made Set Parity really ; set the parity and Set Ibm set the correct parity. ; Added Set Word-Size option and make IBM mode set ; seven bit word size. Also flip out BASIC ROM at start ; and flip it back in on Exit since Kermit doesn't need it. ; ; ; 18 By: Frank Prindle On: 26-Dec-1984 ; Fixed 'ldy ksavey' 7 instructions into stccr: ; to 'lda ksavey' ; ; VERSION 1.2 Starts Here ; ; 19 By: Eric Lavitsky On: 30-Dec-1984 ; Added full ASCII character set, new definitions for ; video and I/O. Added new key translations for telnet, ; including a table for function key translation. ; ; ; 20 By: Eric Lavitsky On: 3-Jan-1985 ; Fixed code in openf: that was ignoring the first two ; bytes of PRG files and writing/sending $00 $20 ; ; ; 21 By: Eric Lavitsky On: 10-Jan-1985 ; Added a jmp past tlcnc4 after getting a function key ; value to prevent corrupting the value sent. Also added ; fixes at buffchk: and fgetc: which were not handling ; the eof condition correctly. ; ; ; 22 By: Eric Lavitsky On: 11-Jan-1985 ; Moved RS232 open from Telnet: to Kstart: ; ; VERSION 1.3 Starts Here ; ; ; 23 By: Eric Lavitsky On: 11-Jan-1985 ; Added modified code from Applek for file-warning ; support- Lookup:, Alterf:, Altstv:. New routines- ; Locent:, Bldprm: ; ; ; 24 By: Eric Lavitsky On: 11-Jan-1985 ; Added new support for RS-232. Much of this code comes ; from Term.Plus from Frank Prindle & Eric Lavitsky. ; Code to allocate rs232 buffers properly, do flow control, ; and delay before sending a character. Add set ; flow-control option and show flow-control option. ; Routines include: Optimu:, Alocrs:, Sxon:, Sxoff: ; ; ; 25 By: Dave Dermott On: 12-Jan-1985 ; Make send init flush the input buffer before sending ; an INIT packet. Routine Flshin: called at Sini1d: ; ; ; 26 By: Eric Lavitsky On: 21-Jan-1985 ; Add support for printing tabs and linefeeds correctly. ; Also make some changes to screen output routines ; Ploth and Prttab come from Term.Plus ; ; ; 27 By: Eric Lavitsky On: 09-Feb-1985 ; Close and reopen the RS232 channel in telnet:, logo:, ; finish:, getfrs:, receve:, and send: to insure that ; the most recent parameters are being used for ; communication ; ; ; 28 By: Eric Lavitsky On: 10-Feb-1985 ; Close the file on an abort interrupt ('Q'). ; Make sbreak delay for 250 ms instead of 200 ms. ; ; ; 29 By: Michael Marchiondo On: 14-Feb-1985 ; Make kerbf1 point to pdbuf in logo so spak sees the ; logout packet. ; ; VERSION 1.4 Starts Here ; ; 30 By: Michael Marchiondo On: 21-Feb-1985 ; Fix Eight-Bit-Quoting code in Send & Spar ; ; ; 31 By: Eric Lavitsky On: 26-Feb-85 ; Remove old ASCII/PETSCII translation routine. Add ; two table pairs to handle conversion. One for Telnet ; and one for file transfer ; ; ; 32 By: Frank Prindle On: 27-Feb-85 ; Change stx to sta in Sxoff: so that the xoff flag ; is really set. Fix the compare in vtdca1: so we can ; address line 25 ; ; VERSION 1.5 Starts Here ; ; 33 By: Eric Lavitsky On: 29-Feb-85 ; Add error checking to RS232 routines. ; ; ; 34 By: Eric Lavitsky On: 29-Feb-85 ; Replace openm call for RS232 open at program start ; with call to subroutine Openrs ; ; ; 36 By: Eric Lavitsky On: 01-Mar-85 ; Restructure Exit: so it's easy to call the restor ; routine from other places. ; ; ; 37 By: Eric Lavitsky On: 31-Mar-85 ; Add 80 column support! ; ; ; 38 By: Eric Lavitsky On: 31-Mar-85 ; Make IBM mode turn off flow-control ; ; ; ; 39 By: Eric Lavitsky On: 31-Mar-85 ; Restructure Telnet and Intchr ; ; ; ; 40 By: Eric Lavitsky On: 08-Apr-85 ; Remove DOS parser. Add new commands: DIRECTORY and ; DISK ; ; ; 41 By: Frank Prindle On: 09-Apr-85 ; Change pnth as it was interfering with serial disk ; routines ; ; ; 42 By: Eric Lavitsky On: 09-Apr-85 ; Add new definitions for kernel routines ; ; ; 43 By: Eric Lavitsky On: 09-Apr-85 ; Change abort from 'Q' to '^X' add code to send EOF ; packet as well. ; ; ; 44 By: Eric Lavitsky On: 09-Apr-85 ; Add delay before printing in prstr a la Apple ; version. ; ; VERSION 1.6 Starts Here ; ; 45 By: Eric Lavitsky On: 11-Apr-85 ; Restructure status routine so we can return properly ; in intchr ; ; ; 46 By: Eric Lavitsky On: 18-Apr-85 ; Make parser use telnet (ASCII) key translations. ; Make tab work in the parser. ; ; ; 47 By: Eric Lavitsky On: 19-Apr-85 ; Add commands SAVE and RESTORE to save Kermit ; parameters in an init file and restore them from ; that file. ; ; 48 By: Eric Lavitsky On: 22-Apr-85 ; Add switch indicating whether or not we are in ; connect mode. ; ; 49 By: Eric Lavitsky On: 09-May-85 ; Add code to handle timeouts. Timset to set the ; timeout for send and receive. Timout to check if ; we have passed the timeout limit. ; ; VERSION 1.7 Starts Here ; ; 50 By: Frank Prindle On: 06-Aug-1985 ; Fix disk parser so all commands work. ; ; 51 By: Frank Prindle On: 06-Aug-1985 ; Add patch to optimu: to delay proper time for 1200 ; baud transmission. ; ; 52 By: Frank Prindle On: 06-Aug-1985 ; Fix translation table as2pt: to do proper conversions. ; ; VERSION 2.0 Starts Here ; ; 53 By: Ray Moody On: 09-Dec-1986 ; Changed source code so it assembles on a more conventional ; assembler. Removed .end directive, expanded macro, fixed ; problem with upper case labels, changed .ascii and .asciz ; to .byte, added a .byte 0 line after .asciz lines, commented ; out extra definitions, changed string delimiter to ". ; ; ; 54 By: Ray Moody On: 10-Dec-1986 ; Changed directory routine to print file sizes in decimal ; Added routine prntad to do the dirty work. ; ; ; 55 By: Ray Moody On: 18-Mar-1987 ; Put in a new screen driver with all the features needed ; for VT100 emulation. Prepared the way for C128 support. ; ; ; 56 By: Ray Moody On: 21-Mar-1987 ; Fixed a bug in cminbf. (It was ignoring ctrlw) ; Fixed a bug in telnet. (It was local-echoing garbage chars) ; Improved underlining. ; Also added VT100 emulation. ; ; ; 57 By: Ray Moody On: 24-Mar-1987 ; Added Commodore 128 support. ; Fixed assorted bugs (telnet was blowing the stack away!) ; Prepared for release!!! ; ; VERSION 2.1 Starts Here ; ; 58 By: Ray Moody On: 09-Apr-1987 ; Optimized everything. ; fixed a bug in vt100ta. (was ignoring ^[[;;m). ; fixed a bug in c40el2. (was erasing too much color ram). ; fixed a bug in telnet. (it was echoing strange control chars) ; fixed alot of cruddy commenting. ; Generally improved code. ; ; ; 59 By: Ray Moody On: 01-Mar-1987 ; Added new keyscanner that can detect the alternate keypad ; on the Commodore-128 and rebound all the keys. ; ; ; 60 By: Ray Moody On: 05-May-1987 ; Fixed bug in keytbl2. ^] was bound to ^^. ; ; ; 61 By: Ray Moody On: 05-May-1987 ; Added support for the Batteries Included 80-column card. ; ; ; 62 By: Kent Sullivan On: 05-May-1987 ; Fixed capitalization errors. ; ; ; 63 By: Ray Moody On: 06-May-1987 ; Changed mapping of characters for the Batteries Included card. ; ; ; 64 By: Kent Sullivan On: 06-May-1987 ; Fixed more capitalization errors and (gasp) a spelling error. ; ; ; 65 By: Ray Moody On: 11-Jun-1987 ; Un-kludged terminal type selection. ; Bound ^@ to null. ; Added the following features: key repeat, new line mode, ; graphics characters ; terminal reports (both modes), origin mode, bright background, ; next line, settable tabs, terminal reset, fill screen with Es. ; Kermit now saves the border color upon entry and restores it ; upon exit. ; ; 66 By: Ray Moody On: 16-Jun-1987 ; Fixed keybinding of run-stop. ; Changed the terminal ID report to reflect the fact that we ; have AVO. ; ; ; 67 By: Ray Moody On: 11-Apr-1988 ; moved around cmbuf, almbuf, plnbuf. ; dtime now 10 seconds (was 15). ; put color commands in. ; new version message. ; prints "push '?' for help" in bold. ; added tektronix graphics mode. ; set up ins/del and clr/home. ; vt102 insert/replace mode escape sequence. ; vt102 delete chars escape sequence. ; fixed status command. ; kludged for use with ckermit. ; run/stop abort directory listings. ; support for c-power. ; support c128 caps-lock key. ; temporarly put stuff back on f1 ... f8. ; renamed "petasci" to "petscii". ; renamed "batteries-included" to "bi-80". ; created m80 screen driver. ; fixed c128 cursor. ; ; ; 68 By: Ray Moody On: 14-Apr-1988 ; Changed "vt100" and "vt52" to "vt-100" and "vt-52" for Kent. ; Fixed suspend. We want to clear it when we break a connection. ; ; ; 68a Be: Ray Moody On: 21-Apr-1988 ; ``Testing can only prove the presence of bugs, never ; the absence thereof.'' ; Tried to release it, and prindle@nadc.arpa found a bug. ; Optimu was only sending characters at about 300 baud no ; matter what the baud rate was set to. Also took the ; opportunity to fix up scrrst/scrset problem. ; ; VERSION 2.2 Starts Here ; ; 69 By: Ray Moody On: 27-Nov-1988 ; Added support for C128 fast mode and 2400 baud. ; Added "," for visual bell. ; Fixed speedscript bug. ; Redid optimu from scratch. ; Fixed keyscanner bug. ; ; ; 70 By: Ray Moody On: 27-Nov-1988 ; Updated version number and prepared for release. ; ; ; 71 By: Ray Moody On: 23-Feb-1989 ; Added Fred Bowen's (fred@cbmvax.UUCP) fix for the parser. ; ; ; 72 By: Ray Moody On: 23-Feb-1988 ; Fixed the 1200 baud problem that C64s (not C128s) experienced. ; ; ; 73 By: Ray Moody On: 23-Feb-1989 ; Changed the version number. Now this is *really* ; version 2.2 (73). ; ; VERSION 3.0 Starts Here ; ; nnn By: xxxxxxxx xxxxxxxx On: nn-XXX-19nn ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ; ;+ .SBTTL Define start address for assembly .= $801 ; Start assembly at hex 801 .SBTTL BASIC start sequence 10 SYS(2064) basic: .byte $0D,$08,$0A,$00 ; Line 10 in BASIC .byte $9E ; SYS .byte "(2064)" ; .byte $00,$00,$00 ; end of line .byte $00 .= $810 .SBTTL Jump to start of code kst: jmp kstart ; Go past the data to the beginning of the code .SBTTL Macro definitions ; Macro to open a file ; [53] as6502 will not handle macros. Macros have been expanded. ; .macro openm,p1,p2,p3,p4,p5 ;lun,dv,sa,fnm,len ; lda p1 ; ldx p2 ; ldy p3 ; jsr setlfs ; ldx #p4\ ; ldy #p4^ ; lda p5 ; jsr setnam ; jsr open ; .endm .SBTTL C64 kernel entry points acptr = $ffa5 ;[42] Get byte from serial bus chkin = $ffc6 ; change kernel input channel chkout = $ffc9 ; change kernel output channel chrin = $ffcf ; input a character chrout = $ffd2 ; output a character cint = $ff81 ;[EL] initialize screen editor ciout = $ffa8 ;[42] Output byte to serial port clall = $ffe7 ; close all channels and files close = $ffc3 ; close a channel clrchn = $ffcc ; close input and output channel getin = $ffe4 ; input a character ioinit = $ff84 ;[EL] initialize I/O devices load = $ffd5 ;[42] Load RAM from a device open = $ffc0 ; open a channel plot = $fff0 ; fetch/set cursor position (40 col) ramtas = $ff87 ;[EL] init RAM, tape buffer, screen memory readst = $ffb7 ; read I/O status restoi = $ff8a ;[EL] restore default I/O vectors rdtim = $ffde ; read the builtin timer save = $ffd8 ;[42] Save RAM to device setlfs = $ffba ;[EL] set open parameters setnam = $ffbd ;[EL] set filename stop = $ffe1 ; Check if STOP key is pressed talk = $ffb4 ;[42] Send serial bus talk tksa = $ff96 ;[42] Send secondary address after talk untalk = $ffab ;[42] Send serial bus untalk dos = $a002 ; BASIC NMI vector .SBTTL Character and string definitions nul = $00 ; soh = $01 ; bs = $08 ; tab = $09 ; (ctrl/I) lf = $0a ; ffd = $0c ; Form feed cr = $0d ; ctrlu = $15 ; ctrlx = $18 ; ctrly = $19 ; esc = $1b ; sp = $20 ; space = $20 ; """" del = $7f ; cdel = $14 ; commodore del quest = $3F ; ctrlw = $17 ; dquot = $22 ; '"' ? quot = $27 ; "'" ? slash = $2f ; '/' ? apos = quot ; "'" ? rabr = $3e ; '>' ? colon = $3a ; ':' ? .SBTTL Commodore I/O addresses vicbank = $8000 ; vic bank select (remember -- rom present) victext = $a000 ; 40 column and 80 column bit map area vicclr1 = $8c00 ; primary color area vicclr2 = $8800 ; secondary color area vicmsk = %00000111 ; info to set up vic chip to use this memory vicdat1 = %00111000 ; "" vicdat2 = %00101000 ; "" vicswap = %00010000 vicnorm = %00010000 ; "" freqhi = $d401 ;[EL] sid frequency (high byte) attdec = $d405 ;[EL] sid attack/decay susrel = $d406 ;[EL] sid sustain/release vol = $d418 ;[EL] sid volume wave = $d404 ;[EL] sid waveform select .SBTTL Commodore-128 8563 addresses chr8563 = $2000 txt8563 = $0000 alt8563 = $0800 pad8563 = $1000 .SBTTL Batteries Included 80-column screen addresses b80text = $9800 ch = $d3 ;Cursor Horizontal position (col) cv = $d6 ;Cursor Vertical position (row) basl = $d1 ;L.O. byte of base address of current line bash = $d2 ;H.O. byte of base address of current line bas2l = $50 ;Base address work area bas2h = $51 ;Base address work area source = $fb ;[19] indirect address to be read dest = $fd ;[19] indirect address to be stored pnth = $71 ;[19][41] hires screen pntr (^cassette buffer) ndx = $c6 ;[EL] number of keyboard bytes pending r6510 = $01 ;[EL] Memory control register for 6510 ribuf = $f7 ;[19] rs-232 input buffer pointer (2-byte) robuf = $f9 ;[19] rs-232 ouput buffer pointer (2-byte) bitci = $a8 ;[19] rs-232 input bit count enabl = $2a0 ; rs-232 operations in progress clock = $a0 ;[EL] Jiffy clock (3-byte) ldtb1 = $d9 ;[19] Editor line link table (40 col) qtsw = $d4 ;[EL] quote-mode switch (40 col) ridbe = $29b ;[EL] RS-232 index to end of input buffer ridbs = $29c ;[EL] RS-232 index to start of input buffer shflag = $28d ;[EL] shift key flags (commodore key = bit 1) hibase = $288 ;[EL] video matrix page number (40 col) color = $286 ;[EL] 40 column foreground color rsout = $9000 ;[24] address of rs-232 output buffer rsin = $9100 ;[24] address of rs-232 input buffer char: .byte $00 ;[26] Character just read stat: .byte $00 ;[33] RS232 status byte lpcnt: .byte $00 ;[EL] cursor blink counter lineh: .byte $00 ;[19] hires cursor line number colh: .byte $00 ;[19] hires cursor column number hilo: .byte $f0 ;[19] hires nibble mask rvmask: .byte $00 ;[19] reverse video mask ($f=rev, $0=normal) cflag: .byte $ff ;[19] 0 if char under cursor has been reversed cstate: .byte $00 ;[19] top nibble of char und. cursor if cflag=0 flag79: .byte $00 ;[19] non-0 if previous char printed in col 79 fla79: .byte $00 ;[19] one shot copy of previous flag79 suspend:.byte $00 ;[24] RS-232 reads suspended if non-zero fxoff: .byte $00 ;[24] Xoff has been sent if non-zero commflg:.byte $00 ;[24] non-zero if commodore key is depressed .SBTTL Translation and Font Tables ; ASCII/PETSCII Translation Tables ; Pt2as - PETSCII to ASCII pt2as: .byte $00 ;[31] ^@ NUL .byte $01 ;[31] ^A SOH .byte $02 ;[31] ^B .byte $03 ;[31] ^C .byte $04 ;[31] ^D .byte $05 ;[31] ^E .byte $06 ;[31] ^F .byte $07 ;[31] ^G BEL .byte $08 ;[31] ^H BS .byte $09 ;[31] ^I TAB .byte $0a ;[31] ^J LF .byte $0b ;[31] ^K .byte $0c ;[31] ^L FF .byte $0d ;[31] ^M CR .byte $0e ;[31] ^N .byte $0f ;[31] ^O .byte $10 ;[31] ^P .byte $11 ;[31] ^Q .byte $12 ;[31] ^R .byte $13 ;[31] ^S .byte $14 ;[31] ^T .byte $15 ;[31] ^U .byte $16 ;[31] ^V .byte $17 ;[31] ^W .byte $18 ;[31] ^X .byte $19 ;[31] ^Y .byte $1a ;[31] ^Z .byte $1b ;[31] ^[ .byte $1c ;[31] ^\ .byte $1d ;[31] ^] .byte $1e ;[31] ^^ .byte $1f ;[31] ^_ .byte $20 ;[31] SPACE .byte '! ;[31] ! .byte '" ;[31] " .byte '# ;[31] # .byte '$ ;[31] $ .byte '% ;[31] % .byte '& ;[31] & .byte '' ;[31] ' .byte '( ;[31] ( .byte ') ;[31] ) .byte '* ;[31] * .byte '+ ;[31] + .byte ', ;[31] , .byte '- ;[31] - .byte '. ;[31] . .byte '/ ;[31] / .byte '0 ;[31] 0 .byte '1 ;[31] 1 .byte '2 ;[31] 2 .byte '3 ;[31] 3 .byte '4 ;[31] 4 .byte '5 ;[31] 5 .byte '6 ;[31] 6 .byte '7 ;[31] 7 .byte '8 ;[31] 8 .byte '9 ;[31] 9 .byte ': ;[31] : .byte '; ;[31] ; .byte '< ;[31] < .byte '= ;[31] = .byte '> ;[31] > .byte '? ;[31] ? .byte '@ ;[31] @ .byte 'a ;[31] a .byte 'b ;[31] b .byte 'c ;[31] c .byte 'd ;[31] d .byte 'e ;[31] e .byte 'f ;[31] f .byte 'g ;[31] g .byte 'h ;[31] h .byte 'i ;[31] i .byte 'j ;[31] j .byte 'k ;[31] k .byte 'l ;[31] l .byte 'm ;[31] m .byte 'n ;[31] n .byte 'o ;[31] o .byte 'p ;[31] p .byte 'q ;[31] q .byte 'r ;[31] r .byte 's ;[31] s .byte 't ;[31] t .byte 'u ;[31] u .byte 'v ;[31] v .byte 'w ;[31] w .byte 'x ;[31] x .byte 'y ;[31] y .byte 'z ;[31] z .byte '[ ;[31] [ .byte '\ ;[31] \ .byte '] ;[31] ] .byte '^ ;[31] ^ .byte '_ ;[31] _ .byte $60 ;[31] .byte 'A ;[31] A .byte 'B ;[31] B .byte 'C ;[31] C .byte 'D ;[31] D .byte 'E ;[31] E .byte 'F ;[31] F .byte 'G ;[31] G .byte 'H ;[31] H .byte 'I ;[31] I .byte 'J ;[31] J .byte 'K ;[31] K .byte 'L ;[31] L .byte 'M ;[31] M .byte 'N ;[31] N .byte 'O ;[31] O .byte 'P ;[31] P .byte 'Q ;[31] Q .byte 'R ;[31] R .byte 'S ;[31] S .byte 'T ;[31] T .byte 'U ;[31] U .byte 'V ;[31] V .byte 'W ;[31] W .byte 'X ;[31] X .byte 'Y ;[31] Y .byte 'Z ;[31] Z .byte '{ ;[31] { .byte '| ;[31] | .byte '} ;[31] } .byte '~ ;[31] ~ .byte $7f ;[31] DEL .byte '? ;[31] illegal .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte 'A ;[31] A from A key (dup) .byte 'B ;[31] B from B key (dup) .byte 'C ;[31] C from C key (dup) .byte 'D ;[31] D from D key (dup) .byte 'E ;[31] E from E key (dup) .byte 'F ;[31] F from F key (dup) .byte 'G ;[31] G from G key (dup) .byte 'H ;[31] H from H key (dup) .byte 'I ;[31] I from I key (dup) .byte 'J ;[31] J from J key (dup) .byte 'K ;[31] K from K key (dup) .byte 'L ;[31] L from L key (dup) .byte 'M ;[31] M from M key (dup) .byte 'N ;[31] N from N key (dup) .byte 'O ;[31] O from O key (dup) .byte 'P ;[31] P from P key (dup) .byte 'Q ;[31] Q from Q key (dup) .byte 'R ;[31] R from R key (dup) .byte 'S ;[31] S from S key (dup) .byte 'T ;[31] T from T key (dup) .byte 'U ;[31] U from U key (dup) .byte 'V ;[31] V from V key (dup) .byte 'W ;[31] W from W key (dup) .byte 'X ;[31] X from X key (dup) .byte 'Y ;[31] Y from Y key (dup) .byte 'Z ;[31] Z from Z key (dup) .byte '{ ;[31] { from SHIFT/+ key (dup) .byte '| ;[31] | from ????? (dup) .byte '} ;[31] } from SHIFT/- key (dup) .byte '~ ;[31] ~ from SHIFT/^ key (dup) .byte $7f ;[31] DEL from ????? .byte $20 ;[31] SPACE from SHIFT/SPACE key (dup) .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal .byte '? ;[31] illegal ; As2pt - ASCII to PETSCII as2pt: .byte $00 ;[31] NUL .byte $01 ;[31] ^A .byte $02 ;[31] ^B .byte $03 ;[31] ^C .byte $04 ;[31] ^D .byte $05 ;[31] ^E .byte $06 ;[31] ^F .byte $07 ;[31] BEL .byte $08 ;[31] BS .byte $09 ;[31] TAB .byte $0a ;[31] NL .byte $0b ;[31] ^K .byte $0c ;[31] ^L .byte $0d ;[31] CR .byte $0e ;[31] ^N .byte $0f ;[31] ^O .byte $10 ;[31] ^P .byte $11 ;[31] ^Q .byte $12 ;[31] ^R .byte $13 ;[31] ^S .byte $14 ;[31] ^T .byte $15 ;[31] ^U .byte $16 ;[31] ^V .byte $17 ;[31] ^W .byte $18 ;[31] ^X .byte $19 ;[31] ^Y .byte $1a ;[31] ^Z .byte $1b ;[31] ^[ .byte $1c ;[31] ^\ .byte $1d ;[31] ^] .byte $1e ;[31] ^^ .byte $1f ;[31] ^_ .byte $20 ;[31] SPACE .byte $21 ;[31] ! .byte $22 ;[31] " .byte $23 ;[31] # .byte $24 ;[31] $ .byte $25 ;[31] % .byte $26 ;[31] & .byte $27 ;[31] ' .byte $28 ;[31] ( .byte $29 ;[31] ) .byte $2a ;[31] * .byte $2b ;[31] + .byte $2c ;[31] , .byte $2d ;[31] - .byte $2e ;[31] . .byte $2f ;[31] / .byte $30 ;[31] 0 .byte $31 ;[31] 1 .byte $32 ;[31] 2 .byte $33 ;[31] 3 .byte $34 ;[31] 4 .byte $35 ;[31] 5 .byte $36 ;[31] 6 .byte $37 ;[31] 7 .byte $38 ;[31] 8 .byte $39 ;[31] 9 .byte $3a ;[31] : .byte $3b ;[31] ; .byte $3c ;[31] < .byte $3d ;[31] = .byte $3e ;[31] > .byte $3f ;[31] ? .byte $40 ;[31] @ .byte $c1 ;[31][52] A .byte $c2 ;[31][52] B .byte $c3 ;[31][52] C .byte $c4 ;[31][52] D .byte $c5 ;[31][52] E .byte $c6 ;[31][52] F .byte $c7 ;[31][52] G .byte $c8 ;[31][52] H .byte $c9 ;[31][52] I .byte $ca ;[31][52] J .byte $cb ;[31][52] K .byte $cc ;[31][52] L .byte $cd ;[31][52] M .byte $ce ;[31][52] N .byte $cf ;[31][52] O .byte $d0 ;[31][52] P .byte $d1 ;[31][52] Q .byte $d2 ;[31][52] R .byte $d3 ;[31][52] S .byte $d4 ;[31][52] T .byte $d5 ;[31][52] U .byte $d6 ;[31][52] V .byte $d7 ;[31][52] W .byte $d8 ;[31][52] X .byte $d9 ;[31][52] Y .byte $da ;[31][52] Z .byte $5b ;[31] [ .byte $5c ;[31] \ .byte $5d ;[31] ] .byte $5e ;[31] ^ .byte $5f ;[31] _ .byte $c0 ;[31][52] .byte $41 ;[31] a .byte $42 ;[31] b .byte $43 ;[31] c .byte $44 ;[31] d .byte $45 ;[31] e .byte $46 ;[31] f .byte $47 ;[31] g .byte $48 ;[31] h .byte $49 ;[31] i .byte $4a ;[31] j .byte $4b ;[31] k .byte $4c ;[31] l .byte $4d ;[31] m .byte $4e ;[31] n .byte $4f ;[31] o .byte $50 ;[31] p .byte $51 ;[31] q .byte $52 ;[31] r .byte $53 ;[31] s .byte $54 ;[31] t .byte $55 ;[31] u .byte $56 ;[31] v .byte $57 ;[31] w .byte $58 ;[31] x .byte $59 ;[31] y .byte $5a ;[31] z .byte $db ;[31][52] { .byte $dc ;[31][52] | .byte $dd ;[31][52] } .byte $de ;[31][52] ~ .byte $7f ;[31] DEL .SBTTL Flag definitions ; The following are flags passed in the Y register cmfehf = 1 ;[EL] Extra help available cmfdff = 2 ;[EL] 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 ; Token to parse for an unquoted string cmtok = 9 ; Token to parse 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 = $20 ; Saved string address - must be on page zero cm.rty = $22 ; 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 ; 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 = $24 ; Ptr. to current help text cmptab = $26 ; Ptr. to beginning of current keyword table cmfcb = $1a ; Pointer to FCB cmehpt = $1c ; 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 ; 16-bit multiply routine prcrlf = mul16+3 ; Routine to print a crelf prstr = prcrlf+3 ; Routine to print an ASCIZ string rskp = prstr+3 ; Routine to skip 3 bytes on return setbrk = rskp+3 ; Routine to set a break char in brkwrd rstbrk = setbrk+3 ; Routine to reset break char 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 ; Dispatch to Prcrlf jmp prst.0 ; Dispatch to Prstr jmp rskp.0 ; Dispatch to Rskp jmp sbrk.0 ; Dispatch to Setbrk jmp rbrk.0 ; Dispatch to Rstbrk .SBTTL Storage Declarations ; ; Following is the storage decalarations for the Comnd routines ; ; ; cmbuf and atmbuf have been moved to the end so that the text ; segment does not fall below $8000. The BI-80 card puts its own ; rom at $8000 ;cmbuf: .blkb $100 ; Input command buffer ;atmbuf:.blkb $100 ; Atombuffer, (for cmtxt and cmifil) lenabf: .byte ; Length of atom in Atombuffer brkwrd: .blkb $16 ; 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 ; Non-Zero when previous command failed cmfrcf: .byte 0 ; Non-Zero when signif char has been seen cmccnt: .byte ; Non-zero if a significant char is found cmocnt: .byte ; Saved length of command buffer cmoptr: .word ; 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 ; Hold area for Comnd parameters cmprmy: .byte ; 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 ; 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 ; [53] commented out following section. Caused extra definition errors in as65 ; 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 ; Save the address of the prompt in sty cm.rty+1 ; 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 ; Store old command line pointer sta cmoptr ; ... lda cm.ptr+1 ; ... sta cmoptr+1 ; ... lda cmccnt ; Store old character count sta cmocnt ; ... lda #$ff ; Set the failure flag sta cmcffl ; ... 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 ; ... 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 ; Save these parameters also sty cmprmy ; ... cmp #cmini ; Initialize the world? bne comn0 ; No, handle like a normal parse type jmp prompt ; Do the prompt routine to set things up comn0: jsr cminbf ; Get characters until action or erase cmp #cmcfm ; Parse a confirm? bne comn1 ; Nope jmp cmcfrm ; Yes, try for the confirm comn1: cmp #cmkey ; Parse a keyword perhaps? bne comn2 ; No, next item jmp cmkeyw ; Get the keyword comn2: cmp #cmifi ; Parse an input file? bne comn3 ; No, try next one jmp cmifil ; Get the input file comn3: cmp #cmofi ; Parse an output file? bne comn4 ; No, try next jmp cmofil ; Get the output file comn4: cmp #cmswi ; Parse a switch? bne comn5 ; No, try next again jmp cmswit ; Yes, do a switch comn5: cmp #cmnum ; Parse an integer? bne comn6 ; No, try next type jmp cminum ; Do the parse integer routine comn6: cmp #cmfls ; Parse a floating point????? bne comn7 ; Nope, thats it for types jmp cmflot ; Yes, go get a floating point number comn7: cmp #cmtxt ; Parse for an unquoted string? bne comn8 ; Nope, go try last type jmp cmunqs ; Go parse the string comn8: cmp #cmtok ; Parse for a single character? bne comn9 ; Nope, no more parse types jmp cmtokn ; 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 comand 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, er 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 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 ; Get address of prompt ldy cm.rty+1 ; 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 scrclr ; Yes, blank the screen cmcfr4: pla ; Since this succeeded, we can flush the pla ; old command line pointer lda #$00 ; Reset the failure flag sta cmcffl ; jmp rskp ; Do a return skip cmcfrr: pla ; Restore the old comand line pointer sta cm.ptr+1 ; sta cmoptr+1 ; pla ; sta cm.ptr ; sta cmoptr ; lda cmccnt ; Save count in case of sta cmocnt ; lda #$ff ; Set failure sta cmcffl ; 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 the old comand line pointer pha ; lda cm.ptr+1 pha ; lda #$00 ; Clear the 'real character' flag sta cmfrcf ; 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 ; Just move the pointer to the save area sty cmsptr ; ldy cm.ptr+1 ; sty cmsptr+1 ; and #$7f ;[EL] ???? cmp #esc ; Was the first terminator an escape? beq cmky12 ; Yes, handle this jmp cmkey2 ; No, continue cmky12: lda #cmfdff ; Is there a default? bit cmprmy ; ... bne cmky13 ; Yes, go copy it lda #$00 ; Shut the action flag sta cmaflg ; ... 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 cmkync ; If carry is clear, we are done dec cm.bfp+1 ; Do the carry on H.O. byte cmkync: lda cm.bfp+1 ; Copy this to next char to parse pointer sta cm.ptr+1 ; ... jmp cmky10 ; Continue by fetching a character again cmky13: lda #$00 ; Zero the action flag sta cmaflg ; ... jmp cmcpdf ; 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 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; ... lda #$ff ; Set the command-failure flag sta cmcffl ; ... 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 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 addr 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 ; Load extra help flag bit cmprmy ; Test bit beq cmk3b3 ; No extra help jsr cmehlp ; Go give extra help cmk3b3: ldx cm.rty ; Get address of prompt ldy cm.rty+1 ; 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 address of buffer ldy #cmbuf^ ; 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 ; Load the default-present flag bit cmprmy ; Check against flags beq cmk3d ; No, complain to user lda cmfrcf ; Have we seen a real character yet? bne cmk3d ; No, tell user jmp cmcpdf ; 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 ; ... sta cmkptr+1 ; Restore the keyword table pointer pla ; ... sta cmkptr ; 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 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 #$20 ; Clear AC (this is a terminator!) 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 keyword table pointer pha ; lda cmkptr+1 ; pha ; ... lda keylen ; The keylength pha ; ... 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 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 ; Reset the failure flag sta cmcffl ; jmp rskp ; Return skip means it succeeds! cmkey4: cmp #$41 ; Check range for upper case bmi cmky41 ; ... cmp #$5b ; ... bpl cmky41 ; ... ora #$20 ; Cutesy way to convert to lower case cmky41: sta cmwrk3 ; Save the character lda #$ff ; Set the 'real character' flag sta cmfrcf ; 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 ; If test len 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 ; 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 #$61 ; Check the range for lower case bmi cmamb2 ; ... cmp #$7b ; ... bpl cmamb2 ; ... and #$5F ; Capitalize it cmamb2: and #$7f ; Reset the 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 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 ; lda #'/ ; Yes, do not forget slash prefix 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 screl0 ; Clear to end of line sec ;[37] Get cursor coordinates jsr ploth ;[37] ... ldy #$14 ; Advance cursor to middle of screen clc ;[DD] ... jsr ploth ;[DD][26] ... 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 the old comand line pointer 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 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 ; Load extra help flag bit cmprmy ; Test bit beq cmsw10 ; No extra help jsr cmehlp ; Go give extra help cmsw10: ldx cm.rty ; Load the address of the prompt ldy cm.rty+1 ; 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. 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 ; See if there is a default bit cmprmy ; beq cmswnd ; No help, tell user jmp cmcpdf ; 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 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 ; Clear the failure flag sta cmcffl ; ... 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 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; lda #$ff ; Set failure flag sta cmcffl ; ... 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 ; Reset the failre flag sta cmcffl ; jmp rskp ; Success - skip return! cmswi5: pla ; Fetch back the old comand line pointer sta cm.ptr+1 ; ... sta cmoptr+1 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; lda #$ff ; Set failure flag sta cmcffl ; 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 filename length ; ; Output: Filename parsed is in buffer pointed to by X,Y ; ; Registers destroyed: A,X,Y ; cmifil: inx ; Increment max file length for tests stx cmprmx ; Maximum filename length lda cm.ptr ; Save the old comand line pointer in case pha ; lda cm.ptr+1 ; pha ; lda #$00 ; Zero the sta lenabf ; length of the atom buffer cmifl0: ldy #$00 ; Zero Y lda #' ; Blank the AC ; ora #$80 ; Make it look like a terminator cmifi0: sta atmbuf,y ; Now zero the buffer iny ; ... cpy cmprmx ; 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 ; Yes, check it out jmp cmifi2 ; No , process it as a normal character cmif10: and #$7f ; Yes, turn off the minus bit cmp #'? ; Does the user need help? bne cmif12 ; Nope 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 ; Load extra help flag bit cmprmy ; Test bit beq cmifnh ; No extra help jsr cmehlp ; Go give extra help cmifnh: ldx cm.rty ; Set up to reprint the prompt ldy cm.rty+1 ; ... 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 ; Load default-present flag bit cmprmy ; Test bit beq cmifnd ; No default lda lenabf ; Now check if user typed anything bne cmifnd ; Yup, can't use default jmp cmcpdf ; 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 ; 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 ; Are we over the maximum file length? bmi cmif15 ; Not quite yet jmp cmifi9 ; Yes, blow up cmif15: ldy lenabf ; Get the filename length lda #nul ; and stuff a null at that point sta atmbuf,y ; pla ; Flush the old comand line pointer pla ; ... ldx #atmbuf\ ; Set up the atombuffer address ldy #atmbuf^ ; ... lda #$00 ; Reset the failure flag sta cmcffl ; lda lenabf ; Load length into AC to be passed back jmp rskp ; No, we are successful cmifi2: cmp #sp ; Bad character? bmi cmifi9 ; Yes, blow up cmp #del ; bpl cmifi9 ; This is bad, punt cmp #$61 ; Lower case alphabetic? bmi cmifi8 ; Don't capitalize if it's not alphabetic cmp #$7b ; ... bpl cmifi8 ; ... and #$5f ; Capitalize cmifi8: ldy lenabf ; Set up length of buffer in Y sta atmbuf,y ; Stuff character in FCB inc lenabf ; Increment the length of the name jmp cmifi1 ; Go back for the next character cmifi9: pla ; Restore the old comand line pointer sta cm.ptr+1 ; in case the user wants to parse sta cmoptr+1 ; ... pla ; for something else sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; ... lda #$ff ; Set failure flag sta cmcffl ; rts .SBTTL Cmofil - try to parse an output file spec ; ; This routine attempts to parse an output file spec from the ; command buffer. ; ; Input: cminf1- Pointer to FCB ; ; Output: ; ; Registers destroyed: ; cmofil: jmp cmifil ; Same as parsing input file spec for now .SBTTL Cminum - Try to parse an integer number ; ; This routine tries to parse an integer number in the base ; specified. It will return a 16-bit number in cmintg. ; Cmintg is formatted H.O. byte first! ; ; Input: X- Base of integer (2<=x<=16) ; ; Output: Cmintg- 16-bit integer ; ; Registers destroyed: A,X,Y ; cminum: lda cm.ptr ; Save the old comand line pointer pha ; ... lda cm.ptr+1 ; ... pha ; ... cpx #$11 ; Are we within the proper range? bmi cmin1 ; If so, check high range jmp cmine1 ; No, tell them about it cmin1: cpx #$02 ; Too small of a base?? bpl cmin2 ; No, continue jmp cmine1 ; Base too small, tell them about it cmin2: stx cmbase ; The base requested is good, store it lda #$00 ; Clear AC sta cmmres ; and initialize these areas sta cmmres+1 ; ... sta cmmres+2 ; ... sta cmmres+3 ; ... sta cmintg ; ... sta cmintg+1 ; ... sta cmintg+2 ; ... sta cmintg+3 ; ... cminm1: jsr cmgtch ; Get next character from command buffer cmp #$00 ; Is this an action character bmi cmin1a ; Yes, handle it jmp cminm4 ; No, look for a digit cmin1a: and #$7f ; It is, turn off the H.O. bit cmp #esc ; Is it an escape? bne cminm2 ; No, try something else lda #cmfdff ; Load default-present flag bit cmprmy ; Test bit beq cminnd ; No, default lda cmmres ; Check if user typed anything significant ora cmmres+1 ; ... bne cminnd ; Yup, can't use default jmp cmcpdf ; 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 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 #$30 ; 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 #$30 ; Make it printable jsr cout ; Print the digit jsr prcrlf ; Print a crelf lda #cmfehf ; Load extra help flag bit cmprmy ; Test bit beq cminnh ; No extra help jsr cmehlp ; Go give extra help cminnh: ldx cm.rty ; Set up the pointer so we can print the prompt ldy cm.rty+1 ; ... 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 ; Move L.O. byte ldy cmmres+1 ; Move H.O. byte pla ; Flush the old comand line pointer pla ; ... lda #$00 ; Reset the failure flag sta cmcffl ; jmp rskp ; cminm4: cmp #$60 ; Is this a letter? bmi cmin41 ; Nope, skip this stuff sec ; It is, bring it into the proper range sbc #$27 ; ... 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 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; ... lda #$ff ; Set failure flag sta cmcffl ; ... 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 ; ; ; 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 ; Save the command buffer pointer pha ; ... lda cm.ptr+1 ; ... pha ; ... lda #$00 ; Zero length of Atom buffer sta lenabf ; ... cmunq1: jsr cmgtch ; Get a character jsr chkbrk ; Is it one of the break characters? jmp cmunq3 ; Yes, handle that condition cmp #$00 ; No, is it an action character? bpl cmunq2 ; No, handle it as normal text and #$7f ; We don't need the H.O. bit cmp #'? ; Does the user need help? bne cmun13 ; Nope, try next possibility jsr cout ; Print '?' ldy #$00 ; Zero the action flag sty cmaflg ; ... ldx #cmin06\ ; Get the help message ldy #cmin06^ ; ... jsr prstr ; and print it. jsr prcrlf ; Print a crelf after it lda #cmfehf ; Check for extra help. bit cmprmy ; ... beq cmun11 ; If no help, continue jsr cmehlp ; Process extra help cmun11: ldx cm.rty ; Go reprint prompt ldy cm.rty+1 ; ... jsr prstr ; ... sec ; Adjust buffer pointer lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... bcs cmun12 ; ... dec cm.bfp+1 ; Adjust H.O. byte cmun12: dec cmccnt ; Correct character count ldy #$00 ; Stuff a null at end of usable buffer lda #$00 ; ... sta (cm.bfp),y ; ... ldx #cmbuf\ ; Reprint command line ldy #cmbuf^ ; ... jsr prstr ; ... jmp cmunq1 ; Go back for more characters cmun13: cmp #esc ; Did the user type ? bne cmunq2 ; No, just stuff the character and cont. lda #$00 ; Clear the action flag sta cmaflg ; ... lda #cmfdff ; Check if there is a default value bit cmprmy ; ... beq cmun14 ; If not, the loses lda lenabf ; Ok, there is a default, but if bne cmun14 ; something has been typed, loses jmp cmcpdf ; Go copy default and reparse cmun14: jsr bell ; Feep at user sec ; and reset the buffer pointer lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... sta cm.ptr ; ... lda cm.bfp+1 ; ... sbc #$00 ; ... sta cm.bfp+1 ; ... sta cm.ptr+1 ; ... dec cmccnt ; Adjust the character count jmp repars ; and reparse the command line cmunq2: ldy lenabf ; Fetch where we are in atmbuf sta atmbuf,y ; and store our character there inc lenabf ; Reflect increased length jmp cmunq1 ; Go back for more characters cmunq3: lda lenabf ; Get the length beq cmunqf ; If we parsed a null string, fail pla ; Flush old command line pointer pla ; ... ldx #atmbuf\ ; Now, set up the return parameter ldy #atmbuf^ ; ... lda #$00 ; Reset the failure flag sta cmcffl ; ... lda lenabf ; Set up atom length jmp rskp ; Return cmunqf: pla ; Restore old command line pointer sta cm.ptr+1 ; ... sta cmoptr+1 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save count in case of sta cmocnt ; ... lda #$ff ; Set failure flag sta cmcffl ; ... rts ; 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 ; First, save the old command pointer pha ; on the stack lda cm.ptr+1 ; ... pha ; ... cmtk0: jsr cmgtch ; Fetch the next character bpl cmtk3 ; Not an action character and #$7f ; It's an action character cmp #esc ; User trying to be lazy? bne cmtk2 ; Nope, try next option jsr bell ; Yes, well, he's not allowed to be lazy lda #$00 ; Clear the action flag sta cmaflg ; ... sec ; Adjust the buffer pointer back once lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... sta cm.ptr ; Copy it into command pointer bcs cmtk1 ; Need to adjust H.O. byte? dec cm.bfp+1 ; Yes, do it cmtk1: lda cm.bfp+1 ; Copy it to command pointer sta cm.ptr+1 ; ... dec cmccnt ; Adjust the character count jmp cmtk0 ; and try again cmtk2: cmp #'? ; User need help? bne cmtk4 ; No, go fail jsr cout ; Print it ldx #cmin07\ ; Point to the information message ldy #cmin07^ ; ... jsr prstr ; and print it lda #dquot ; Print the character we are looking for jsr cout ; in between double quotes lda cmprmx ; ... jsr cout ; ... lda #dquot ; ... jsr cout ; ... jsr prcrlf ; End it with a crelf lda #cmfehf ; Load extra help flag bit cmprmy ; Test bit beq cmtknh ; No extra help jsr cmehlp ; Go give extra help cmtknh: ldx cm.rty ; Point to prompt ldy cm.rty+1 ; ... jsr prstr ; and print it sec ; Adjust the buffer pointer back one lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... lda cm.bfp+1 ; ... sbc #$00 ; ... sta cm.bfp+1 ; ... lda #$00 ; Stuff a null at the end of the buffer ldy #$00 ; ... sta (cm.ptr),y ; ... ldx #cmbuf\ ; Point to command buffer ldy #cmbuf^ ; ... jsr prstr ; and reprint it lda #$00 ; Clear action flag sta cmaflg ; ... jmp repars ; and go reparse cmtk3: cmp cmprmx ; Ok, this either is or is not the bne cmtk4 ; char we want. If not, go fail. pla ; It is, flush the old address pla ; ... lda #$00 ; Reset the failure flag sta cmcffl ; ... jmp rskp ; and skip return cmtk4: pla ; Restore old pointer sta cm.ptr+1 ; ... sta cmoptr+1 ; ... pla ; ... sta cm.ptr ; ... sta cmoptr ; ... lda cmccnt ; Save the count for sta cmocnt ; ... lda #$ff ; Set failure flag sta cmcffl ; ... rts ; 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 ; If we are overflowing the command buffer jsr bell ; Feep at the user and do Prserr dec cmccnt ; Make sure this doesn't happen again jmp prserr ; for same string cminb0: jsr rdkey ; Get next character from keyboard lda char ;[31] cmp #$90 bcs cminb10 cmp #$80 ; check if numeric keypad bcc cminb10 sbc #$80-'0 ; convert to a digit. Carry already set cminb10:cmp #$c0 ; check if special key bcc cminb11 cmp #$c4 bcs cminb11 tax lda out4a1-$c0,x ; convert spcial key cminb11:cmp #esc ; esc is a legal non-printing character beq cminb8 cmp #cr ; cr is a legal non-printing character beq cminb8 cmp #lf ; lf is a legal non-printing character beq cminb8 cmp #tab ; tab is a legal non-printing character beq cminb8 cmp #ctrlu ; ctrlu is a legal non-printing character beq cminb8 cmp #ctrlw ; ctrlw is a legal non-printing character beq cminb8 cmp #ffd ; form feed is a legal non-printing character beq cminb8 cmp #del ; del is a legal non-printing character beq cminb8 cmp #bs ; bs is a legal non-printing character beq cminb8 cmp #$20 ; ignore non-printing characters bcc cminb0 cmp #$20+95 ; ignore non-printing characters bcs cminb0 cminb8: cmp #$7f ;[46] beq cmind ; Yes cmp #bs ; Also a retry bne cmnbnh ; No, go on cmind: ldx cmccnt ; Check character count cpx #$01 ; Is this the first character? bne cmnbnh ; Nope, can't help him ldx cmcffl ; Did the previous command fail? bpl cmnbnh ; No, we can't reparse a good command lda cmoptr ; Ok, get the old pointer and set up sta cm.ptr ; the old command line again sta cm.bfp ; ... lda cmoptr+1 ; ... sta cm.ptr+1 ; ... sta cm.bfp+1 ; ... lda cmocnt ; Restore the character count sta cmccnt ; ... lda #$00 ; Zero this so we can safely use the sta cmwrk2 ; code that reprints a line after ^W jmp cmnbna ; Go reprint the line cmnbnh: ldy #$00 ; ... sta (cm.bfp),y ; Stuff it in buffer tax ; Hold it here for a while clc ; Clear the carry lda cm.bfp ; Increment the buffer pointer adc #$01 ; ... sta cm.bfp ; ... bcc cmnb11 ; Carry? inc cm.bfp+1 ; Yup, do H.O. byte cmnb11: txa ; Get the data back cmp #ctrlu ; Is it a ^U bne cminb2 ; Nope cmnb12: jsr screl2 ; Yes, clear the whole line sec ;[37] Get the cursor coordinates jsr ploth ;[37] ... ldy #$00 ;[DD] Reset cursor position to beg. of line clc ;[DD] ... jsr ploth ;[DD][26] ... ldx cm.rty ; Get L.O. byte addr of prompt ldy cm.rty+1 ; and H.O. byte jsr prstr ; Reprint the prompt jsr screl0 ; 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 #bs ; Is it a ? beq cminb3 ; Yes ; cmp #cdel ; A ? cmp #$7f ;[46] bne cminb4 ; No cminb3: jsr scrl ; move the cursor left jsr screl0 ; 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 #ctrlw ; Delete a word? beq cmnb41 ; Yes, go take care of that jmp cmib40 ; Nope, continue cmnb41: lda #$03 ; Set up negative offset count sta cmwrk2 ; ... sec ; Set up to adjust buffer pointer lda cm.bfp ; Get the L.O. byte sbc #$03 ; Adjust pointer down by 3 sta cm.bfp ; Store it back bcs cmnb42 ; Don't worry about H.O. byte dec cm.bfp+1 ; Adjust H.O. byte also cmnb42: lda cmwrk2 ; First, check the count cmp cmccnt ; Cmwrk2 > cmccnt? bmi cmints ; No, go test characters jmp cmnb12 ; Yes, go clear the whole line cmints: ldy #$00 ; Zero Y lda (cm.bfp),y ; Get previous character cmp #lf ; Start to test ranges... bpl cmits1 ; Between and ? jmp cminac ; No, not in range at all cmits1: cmp #cr+1 ; ... bmi cmnb43 ; Yes, handle it cmp #space ; Between and '"'? bpl cmits2 ; Possible, continue jmp cminac ; No, advance to previous character cmits2: cmp #dquot+1 ; ... bmi cmnb43 ; Yes, delete back to there cmp #apos ; Between Apostrophy and '/'? bpl cmits3 ; Could be, continue jmp cminac ; Nope, advance character cmits3: cmp #slash+1 ; ... bmi cmnb43 ; Yup, found a delimiter cmp #colon ; Between ':' and '>' perhaps? bpl cmits4 ; Maybe jmp cminac ; Nope, advance to previous character cmits4: cmp #rabr+1 ; ... bmi cmnb43 ; It is, go delete back to there cmp #quot ; Is it a "'"? bne cminac ; No, advance cmnb43: dec cmwrk2 ; Adjust this count clc ; and the buffer pointer lda cm.bfp ; ... adc #$01 ; ... sta cm.bfp ; ... bcc cmnb44 ; ... inc cm.bfp+1 ; ... cmnb44: lda cmccnt ; Get the command buffer length cmnbcc: sec ;[37] Get the cursor coordinates jsr ploth ;[37] ... sty savey ;[37] Save cursor position cmp savey ;[37] Check against horizontal cursor position bmi cmnbna ; It's smaller, skip vert. cursor adjust dex ;[37] Adjust cursor vertical position pha ; Save the AC across this call clc ;[37] Set the cursor to the new position jsr ploth ;[26] ... pla ; Restore the AC sec ; Reflect this in number of characters sbc #$28 ; we skipped back over jmp cmnbcc ; Go check again cmnbna: lda #$00 ; Put a null at the end of the buffer ldy #$00 ; ... sta (cm.bfp),y ; ... jsr screl2 ; Clear current line sec ;[37] Get the cursor position jsr ploth ;[37] ... ldy #$00 ;[EL] Zero the column number clc ;[37] ... jsr ploth ;[26] ... ldx cm.rty ; Reprint prompt ldy cm.rty+1 ; ... jsr prstr ; ... ldx #cmbuf\ ; Reprint command buffer ldy #cmbuf^ ; ... jsr prstr ; ... sec ; Now adjust the command character count lda cmccnt ; ... sbc cmwrk2 ; by what we have accumulated sta cmccnt ; ... jsr screl0 ; Clear to the end of this line jmp repars ; Go reparse the command cminac: inc cmwrk2 ; Increment count of chars to back up sec ; Adjust the buffer pointer down again lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... bcs cmnb45 ; If carry set, skip H.O. byte adjustment dec cm.bfp+1 ; Adjust this cmnb45: jmp cmnb42 ; Go around once again cmib40: cmp #quest ; Need help? beq cminb6 ; ... cmp #esc ; Is he lazy? beq cminb6 ; ... cmp #cr ; Are we at end of line? beq cminb5 ; ... cmp #lf ; End of line? beq cminb5 ; ... cmp #ffd ; Is it a form feed? bne cminb7 ; None of the above jsr scrclr ; clear the screen and home the cursor 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 #space ; Is the character a space ? bne cmnb71 ; No jsr cout ; Output the character jmp cminb1 ; Yes, get another character cmnb71: cmp #tab ; Is it a ? bne cmnb72 ; No ; jsr cout ; Output the character jsr prttab ;[46] 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 #space ; Space? beq cmgtc2 ; Yes cmp #tab ; ? bne cmgtc3 ; Neither space nor cmgtc2: pha ; Hold the character here till we need it lda #cmtxt ; Are we parsing a string? cmp cmstat ; ... beq cmgtis ; Yes, ignore space flag test lda #cmifi ; Are we parsing a file name? cmp cmstat ; ... beq cmgtis ; Yes, ignore the space flag test lda cmsflg ; Get the space flag cmp #$00 ; Was the last character a space? beq cmgtis ; No, go set space flag pla ; Pop the character off jmp cmgtch ; But ignore it and get another cmgtis: lda #$ff ; Set sta cmsflg ; the space flag pla ; 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 #esc ; Escape? beq cmgtc5 ; cmp #quest ; Need help? beq cmgtc4 ; cmp #cr ; ? beq cmgtc4 ; cmp #lf ; ? beq cmgtc4 ; cmp #ffd ; ? 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 #cr ; 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 ldx #3 ;[DD] Open chan 3 for output jsr chkout ;[DD] ... ldy #$00 ; Clear Y reg prst1: prst3: lda (saddr),y ; Get the next byte of the string beq prsdon ; If it is null, we are done and #$7f ;[DD] mask 7 bits jsr cout ;[DD] output to screen jsr dely ;[44] Delay 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: tya ;[44] Save Y pha ;[44] ... ldy #2 ;[44] Delay 2 ms. del1: ldx #250 ;[44] Inner loop 1 ms. del2: dex ;[44] Delay 1 ms. bne del2 ;[44] ... dey ;[44] 2 times. bne del1 ;[44] ... pla ;[44] Restore Y tay ;[44] ... rts ;[44] 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 ; 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 ; We don't want the H.O. bit ldy #$00 ; Set up Y to index the byte we want sbrkts: cmp #$08 ; Is the offset > 8 bmi sbrkfw ; No, we are at the right byte now sec ; Yes, adjust it down again sbc #$08 ; ... iny ; Advance index jmp sbrkts ; and try again sbrkfw: tax ; This is the remaining offset lda #$80 ; Start with H.O. bit on sbrklp: cpx #$00 ; Is it necessary to shift down? beq sbrkfb ; No, we are done dex ; Yes, adjust offset lsr a ; Shift bit down once jmp sbrklp ; Go back and try again sbrkfb: ora brkwrd,y ; We found the bit, use the byte offset sta brkwrd,y ; from above, set the bit and resave rts ; Return rbrk.0: asl a ; Check H.O. bit bcs rbrkal ; If that was on, Zero entire brkwrd lsr a ; Else shift back (H.O. bit is zeroed) rbrkts: cmp #$08 ; Are we in the right word? bmi rbrkfw ; Yes, go figure the rest of the offset sec ; No, Adjust the offset down sbc #$08 ; ... iny ; and the index up jmp rbrkts ; Try again rbrkfw: tax ; Stuff the remaining offset in X lda #$7f ; Start with H.O. bit off rbrklp: cpx #$00 ; Do we need to offset some more? beq rbrkfb ; No, we have the correct bit dex ; Yes, decrement the offset sec ; Make sure carry is on ror a ; and rotate a 1 bit into mask jmp rbrklp ; Go back and try again rbrkfb: and brkwrd,y ; We found the bit, now shut it off sta brkwrd,y ; ... rts ; and return rbrkal: lda #$00 ; Go stuff zeros in the entire word ldy #$00 ; ... rbrksz: sta brkwrd,y ; Stuff the zero iny ; Up the index once cpy #$10 ; Are we done? bmi rbrksz ; Not yet rts ; 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 ; Save byte to be checked and #$7f ; Shut H.O. bit ldy #$00 ; Zero this index cbrkts: cmp #$08 ; Are we at the right word? bmi cbrkfw ; Yes, go calculate bit position sec ; No, adjust offset down sbc #$08 ; ... iny ; Increment the index jmp cbrkts ; Go back and test again cbrkfw: tax ; Stuff the remaining offset in X lda #$80 ; Set H.O. bit on for testing cbrklp: cpx #$00 ; Are we in position yet? beq cbrkfb ; Yes, go test the bit dex ; No, decrement the offset lsr a ; and adjust the bit position jmp cbrklp ; Go and try again cbrkfb: and brkwrd,y ; See if the bit is on bne cbrkbc ; It is a break character lda savea ; Restore the character jmp rskp ; Not a break character, skip return cbrkbc: lda savea ; Restore the character rts ; 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 ; We are going to need this so pha ; save it across the call ldy #$00 ; Zero out the help index sty cmehix ; ... cmehl1: ldy cmehix ; Load the extra help index lda (cmehpt),y ; Fetch next type sta cmstat ; Store it here inc cmehix ; Increase the index by one cmp #$00 ; Is the type null? bne cmeh0 ; No, continue jmp cmehrt ; Yes, terminate cmeh0: cmp #cmtok+1 ; If the type is out of range, leave bmi cmeh1 ; ... jmp cmehrt ; ... cmeh1: pha ; Save the type across the call ldx #cmors\ ; Set up address of 'OR ' string ldy #cmors^ ; ... jsr prstr ; and print it pla ; Restore AC cmp #cmkey ; Compare with keyword bne cmeh2 ; No, try next type cmeh10: tax ; Hold type in X register lda cmsptr ; Save these parms so they can be restored pha ; ... lda cmsptr+1 ; ... pha ; ... lda cm.ptr ; Copy the pointer to the saved pointer sta cmsptr ; so the keyword print routine prints pha ; the entire table. Also, save it on lda cm.ptr+1 ; the stack so it can be restored later sta cmsptr+1 ; ... pha ; ... lda cmptab ; Save the table address also pha ; ... lda cmptab+1 ; ... pha ; ... txa ; Restore type cmp #cmkey ; Keyword? bne cmeh11 ; No, it must be a switch table ldx #cmin01\ ; Set up address of message ldy #cmin01^ ; ... jmp cmeh12 ; Go print the string cmeh11: ldx #cmin02\ ; Set up address of 'switch' string ldy #cmin02^ ; ... cmeh12: jsr prstr ; Print the message ldy cmehix ; Get the index into help string lda (cmehpt),y ; Fetch L.O. byte of table address sta cmptab ; Set that up for Cmktp iny ; Increment the index lda (cmehpt),y ; Get H.O. byte sta cmptab+1 ; Set it up for Cmktp iny ; Advance the index sty cmehix ; and store it jsr cmktp ; Print the keyword table pla ; Now restore all the stuff we saved before sta cmptab+1 ; ... pla ; ... sta cmptab ; ... pla ; ... sta cm.ptr+1 ; ... pla ; ... sta cm.ptr ; ... pla ; ... sta cmsptr+1 ; ... pla ; ... sta cmsptr ; ... jmp cmehl1 ; See if there is more to do cmeh2: cmp #cmswi ; Type is switch? bne cmeh3 ; No, continue jmp cmeh10 ; We can treat this just like a keyword cmeh3: cmp #cmifi ; Input file? bne cmeh4 ; No, go on ldx #cmin03\ ; Set up the message address ldy #cmin03^ ; ... jmp cmehps ; Go print it cmeh4: cmp #cmofi ; Output file? bne cmeh5 ; Nope, try again ldx #cmin04\ ; Set up message address ldy #cmin04^ ; ... jmp cmehps ; Go print the string cmeh5: cmp #cmcfm ; Confirm? bne cmeh6 ; No ldx #cmin00\ ; Set up address ldy #cmin00^ ; ... jmp cmehps ; Print the string cmeh6: cmp #cmtxt ; Unquoted string? bne cmeh7 ; No, try next one ldx #cmin06\ ; Set up address ldy #cmin06^ ; ... jmp cmehps ; Print cmeh7: cmp #cmnum ; Integer? bne cmeh8 ; Try again ldx #cmin05\ ; Set up message ldy #cmin05^ ; ... jsr prstr ; Print it ldy cmehix ; Get index inc cmehix ; Advance index lda (cmehpt),y ; Get base of integer cmp #$0a ; Is it greater than decimal 10? bmi cmeh71 ; No, just print the L.O. digit lda #$31 ; Print the H.O. digit as a 1 jsr cout ; Print the '1' ldy cmehix ; Load index dey ; Point back to last byte lda (cmehpt),y ; Get the base back sec ; Set the carry flag for subtraction sbc #$0a ; Subtract off decimal 10 cmeh71: clc ; Clear carry for addition adc #$30 ; Make it printable jsr cout ; Print the digit jsr prcrlf ; Print a crelf jsr prbyte ; Print the byte jmp cmehl1 ; Go back for more cmeh8: ldx #cmin07\ ; Assume it's a token ldy #cmin07^ ; ... cmehps: jsr prstr ; Print string jsr prcrlf ; Print a crelf jmp cmehl1 ; Go back cmehrt: pla ; Restore sta cmstat ; 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 ; Reset the buffer pointer lda cm.bfp ; ... sbc #$01 ; ... sta cm.bfp ; ... bcs cmcpst ; If carry set, don't adjust H.O. byte dec cm.bfp+1 ; ... cmcpst: dec cmccnt ; Adjust the character count ldy #$00 ; Zero the index cmcplp: lda (cmdptr),y ; Get byte beq cmcpdn ; Copy finished, leave ldx cmccnt ; Check character count inx ; If it is just short of wrapping bne cmcpl1 ; then we are overflowing buffer jsr bell ; If that is the case, tell the user dec cmccnt ; Make sure it doesn't happen again jmp prserr ; for same string. cmcpl1: ; ora #$80 ; Be consistent, make sure H.O. bit is on sta (cm.bfp),y ; Stuff it in the buffer inc cmccnt ; Adjust character count iny ; Up the buffer index jmp cmcplp ; Go to top of loop cmcpdn: lda #space ; Get a space sta (cm.bfp),y ; and place it in buffer after keyword iny ; Increment the buffer index lda #nul ; Get a null sta (cm.bfp),y ; and stuff that at the end of buffer clc ; Now recompute the end of usable buffer tya ; Get the number of chars added adc cm.bfp ; Add that to the buffer pointer sta cm.bfp ; ... lda #$00 ; ... adc cm.bfp+1 ; ... sta cm.bfp+1 ; ... lda #$00 ; Reset the action flag sta cmaflg ; ... sec ; Now adjust the command pointer to the lda cm.ptr ; beginning of the copied field sbc #$01 ; ... tax ; Set it up in X and Y so we can call Prstr lda cm.ptr+1 ; ... sbc #$00 ; ... tay ; ... jsr prstr ; Print the added field jmp repars ; Now go reparse the whole command .SBTTL Comnd Jsys messages and table storage cmer00: .byte cr .byte "? Program error: invalid comnd call" .byte 0 ; [53] cmer01: .byte cr .byte "? Ambiguous" .byte 0 ; [53] cmer02: .byte cr .byte "? Illegal input file spec" .byte 0 ; [53] cmer03: .byte cr .byte "? No keywords match this prefix" .byte 0 ; [53] cmer04: .byte cr .byte "? No switches match this prefix" .byte 0 ; [53] cmer05: .byte cr .byte "? Bad character in integer number" .byte 0 ; [53] cmer06: .byte cr .byte "? Base of integer out of range" .byte 0 ; [53] cmer07: .byte cr .byte "? Overflow while reading integer number" .byte 0 ; [53] cmin00: .byte " Confirm with carriage return" .byte 0 ; [53] cmin01: .byte " Keyword, one of the following:" .byte 0 ; [53] cmin02: .byte " Switch, one of the following:" .byte 0 ; [53] cmin03: .byte " Input file spec" .byte 0 ; [53] cmin04: .byte " Output file spec" .byte 0 ; [53] cmin05: .byte " Integer number in base " .byte 0 ; [53] cmin06: .byte " Unquoted text string " .byte 0 ; [53] cmin07: .byte " Single character token " .byte 0 ; [53] cmors: .byte " or " .byte 0 ; [53] .SBTTL Kermit defaults for operational parameters ; ; The following are the defaults which this Kermit uses for ; the protocol. ; dquote = '# ; The quote character dpakln = $5e ; 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 = 10 ; 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 ; Symbol for terse debug mode verbose = $02 ; Symbol for verbose debug mode xon = $11 ; Xon for Ibm-mode fbsbit = $01 ; Value for SEVEN-BIT FILE-BYTE-SIZE fbebit = $00 ; Value for EIGHT-BIT FILE-BYTE-SIZE nparit = $00 ; Value for PARITY NONE sparit = $01 ; Value for PARITY SPACE mparit = $02 ; Value for PARITY MARK oparit = $03 ; Value for PARITY ODD eparit = $04 ; Value for PARITY EVEN bd50 = $00 ;[17] Value for BAUD 50 bd75 = $01 ;[17] bd110 = $02 ;[17] Value for BAUD 110 bd150 = $03 ;[17] Value for BAUD 150 bd300 = $04 ;[17] Value for BAUD 300 bd1200 = $05 ;[17] Value for BAUD 1200 bd1800 = $06 ;[17] Value for BAUD 1800 bd2400 = $07 ;[17] Value for BAUD 2400 eprflg = $40 ; '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 ; Length of debug mode strings kerpsl = $06 ; Size of parity strings kerbsl = $05 ;[17] Size of baud strings keremu = $07 ; size of terminal emulation strings kerfrm = cminf1 ; 'From string' pointer for Kercpy routine kerto = cminf2 ; 'To string' pointer for Kercpy routine pdbuf: .blkb mxpack-2 ; 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 moved to the end. Make sure text segment does not extend ; past $8000. BI-80 rom lives at $8000, and interferes. ;plnbuf: .blkb $100 ;[DD] 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 prmt: .byte "Kermit-65>" ; Prompting text .byte 0 ; [53] lprmt = .-prmt ; Length of prompting text connec: .byte $00 ;[48] non-zero if in terminal 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) addlf: .byte ; Add a flag dellf: .byte ; Flush a flag jtaddr: .word ; Jump table address hold area hch: .byte ; Hold area for ch hcv: .byte ; Hold area for cv kwrk01: .byte ; Work area for Kermit kwrk02: .byte ; Work area for Kermit kertpc: .byte ; Hold area for parity check ksavea: .byte ; Save area for accumulator ksavex: .byte ; Save area for X reg ksavey: .byte ; Save area for Y reg kerchr: .byte ; Current character read off port kermbs: .word ; Base address of message table 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 ; 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 ; Number of packets for this transfer eofinp: .byte ; End-of-file (no characters left to send) eodind: .byte ; End-of-data reached on disk errcod: .byte ; Error indicator errrkm: .blkb mxpack-2 ; Error message from remote Kermit kerosp: .byte ; Save area for stack pointer escp: .byte $19 ; Character for escape from connection fbsize: .byte fbsbit ; File-byte-size filmod: .byte ; Current file type usehdr: .byte off ; Switch - where to get filename (on=file-head) lecho: .byte off ; Local-echo switch ibmmod: .byte off ; Ibm-mode switch vtmod: .byte on ; VT-52 Emulation mode switch parity: .byte nparit ; Parity setting baud: .byte bd300 ;[17] Baud setting wrdsiz: .byte fbebit ;[17] Word length setting flowmo: .byte off ;[24] Flow-Control switch delay: .byte ; Amount of delay before first send filwar: .byte off ; File-warning switch debug: .byte off ; Debug switch ebqmod: .byte off ; Eight-bit-quoting mode cntrl: .byte $06 ;[EL] rs-232 control reg (300 baud default) cmmnd: .byte $00 ;[EL] rs-232 command reg optbdl: .byte $3c ;[22] Kluge value for 1200 baud optbdh: .byte $01 ;[22] Kluge value for 1200 baud scrtype:.byte $01 ; Default screen is 80-columns ; ; 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 ; Time-out interval (receive and send) .byte dtime ; quote: .byte dquote ; Quote character (receive and send) .byte dquote ; ... backclr:.byte $ff ; background color britclr:.byte $ff ; light background color (selected with decrev) foreclr:.byte $ff ; foreground color altclr: .byte $ff ; alternate color bordclr:.byte $ff ; border color ttime: .word $0000 ;[49] Time out interval (receive and send) ; ; 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 .SBTTL Kermit - CBM DOS support ; ; The following definitions and storage will be used when setting ; up and executing calls to the DOS. ; fncrea = 'R ; Read function code fncwrt = 'W ; Write function code drdoll = '$ ;[40] Directory string drcolo = ': ;[40] drstar = '* ;[40] kerfcb = $1e ; Pointer to FCB buff = $200 ; Temp disk char read fmrcod: .byte 0 ; Disk status return code primfn: .blkb $23 ; File name decnum: .word ; [54] Number being converted to decimal dskers: .blkb 110 ; Storage for disk error messages dosffm: .byte $00 ; 'First file modification done' switch dosfni: .byte $00 ; Filename index dosfvn: .byte $00 ; File version number for the alter routine drivno: .byte $00 ;[40] Current drive device number drunit: .byte '0 ;[40] Current drive Unit number fcb1: .blkb mxfnl ; Fcb for file being transmitted flsrw: .byte 0 ; Switch for r(ead) or w(rite) flssp: .byte 0 ; Switch for file type s or p len: .byte 0 ; Length for Dos open fcmd: .byte "I0" ; String to send 'Init BAM' command .SBTTL Kermit initialization ; ; The following code sets up Kermit-65 for normal operation. ; kstart: jsr clall ;[] First close all open channels jsr ioinit ;[16] Initialize I/O devices jsr restoi ; restore vectors jsr scrini ; initilize the screen packages jsr restin ; restore parameters from kermit.ini init: jsr openrs ;[34] Open the RS-232 port ; openm #1,#0,#$ff,cntrl,#0 ;[DD] Open the keyboard lda #1 ; [53] ldx #0 ldy #$ff jsr setlfs ldx #cntrl\ ldy #cntrl^ lda #0 jsr setnam jsr open ; openm #3,#3,#$ff,cntrl,#0 ;[DD] Open the screen lda #3 ; [53] ldx #3 ldy #$ff jsr setlfs ldx #cntrl\ ldy #cntrl^ lda #0 jsr setnam jsr open jsr dopari ;[] jsr dobad ;[] jsr dowrd ;[] ldx #versio1\ ;Get address of version message ldy #versio1^ ; ... jsr prstr ;Print the version lda #$01 ; use bold for "type ? for help" sta alternt ldx #versio2\ ldy #versio2^ jsr prstr lda #$00 sta alternt jsr kermit ;Go execute kermit jmp exit1 ;[17] and reenter BASIC .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\ ; Fetch the address of the prompt ldy #prmt^ ; ... lda #cmini ; Argument for comnd call jsr comnd ; Set up the parser and print the prompt lda #kercmd\ ; addr of command table sta cminf1 ; ... lda #kercmd^ ; ... sta cminf1+1 ; ... lda #kerhlp\ ; Store address of help text sta cmhptr ; in help pointer lda #kerhlp^ ; ... sta cmhptr+1 ; ... ldy #$00 ; No special flags needed lda #cmkey ; Set up for keyword parse jsr comnd ; Try to parse it jmp kermt2 ; Failed lda #kermtb\ ; Get address of jump table sta jtaddr ; ... lda #kermtb^ ; ... sta jtaddr+1 ; ... txa ; Offset to AC jmpind: clc ;[DD] Jump indexed adc jtaddr ; Add offset to low byte sta jtaddr ; ... bcc jmpin1 ; ... inc jtaddr+1 ; If carry inc high byte jmpin1: jmp (jtaddr) ; Jump to address 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 ;[EL] Shut and logout remote server command jmp finish ;[EL] Shut remote server jmp getfrs ;[EL] Get file from remote server jmp doscmd ;[40] Send disk command jmp dirst ;[40] Get directory jmp savst ;[47] Save parameters jmp restst ;[47] Restore parameters 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 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 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 ; Try for another command line kermt9: ldx #ermesa\ ; L.O. byte of error message ldy #ermesa^ ; H.O. byte of error message jsr prstr ; Print the message ('') jmp kermit ; Try for another command line kermta: ldx #ermesb\ ; L.O. byte of error message ldy #ermesb^ ; H.O. byte of error message jsr prstr ; Print the message ('text') jmp kermit ; Go back to top of loop .SBTTL Telnet routine ; ; This routine handles the connect command. After connecting ; to a host system, this routine alternates calling routines ; which will pass input from the port to the screen and pass ; output from the keyboard to the port. This kermit will ; ignore all characters until it sees and assigned escape ; character. ; ; Input: RS232 REGISTERS IN CNTRL,CMMND ; ; Output: NONE ; ; Registers destroyed: A,X,Y ; telnet: jsr prcfm ; Parse and print a confirm lda #true ;[48] sta connec ;[48] 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 fast ; put us in fast mode, if possible sta $d030 jsr openrs ;[27] lda #$00 ; turn off graphics mode sta tekmode chrlup: jsr scrbel ; stop the nasty bell tone after 6 jiffys ldx tekmode ; do not flash anything in graphics mod bne chrlup1 jsr scrfls ; flash the cursor and screen if time to do so chrlup1:jsr keyscn bne telcnc telprc: jsr getrs ; Check for a port character bne chrlup ; None available, check keyboard lda char ;[31] Get the character read and #$7f ;[31] Shut off the high order bit sta char ;[26][31] Store the character back ldx tekmode ; in tektronics mode beq telprc1 jsr tek ; if so, handle this character special jmp chrlup ; and then get the next character telprc1:ldx escflg ; Was previous character an escape? cpx #on ; ... bne telp2a ; If not, skip vt52 emulation stuff ldy vtmod ; get type of terminal to emulate jsr case .word telp2a ; glass tty. skip vt52 emulation .word dovt52 ; call vt52 and jmp to telprr .word dovt100 ; call vt100 and jmp to telprr dovt52: jsr vt52 ; process the character after the esc jmp telprr dovt100:jsr vt100 ; process a character in an esc sequence jmp telprr telp2a: cmp #$20 ; if less than $20, not printable character bcc telp3a cmp #$20+95 ; one of the 95 printable characters? bcs telp3a ; nope jsr cout ; print the normal character clc ; repeat forever bcc chrlup telp3a: jsr telpr3 ; process it telprr: clc ;[39] Repeat Main terminal loop bcc chrlup ;[39] ... telcnc: cmp #$80 bcs out ; handle special character sequences on output tlcnc5: cmp escp ; Is it the connect-escape character? bne telp6a jmp intchr ; If so, go handle the interupt character telp6a: cmp #cr ; is this a cr bne telp6b ; no. ldx lmn ; is this a cr with new line mode set beq telp6b ; no jsr putrs ; if so, send the cr lda #lf ; and a line feed telp6b: jsr putrs ;[39] Output the port character ldx lecho ; Is local-echo turned on? cpx #on ; ... bne telcrs ; If not, we are done cmp #bs ; backspace is a real funny character beq telp5a cmp #cr ; cr is a printable character beq telp4a cmp #$20 ; is this a printable character? bcc telcrs ; no, so dont echo it cmp #$20+95 ; is this a printable character? bcs telcrs ; no, so dont echo it telp4a: jsr cout ; Output a copy to the screen telcrs: jmp chrlup ;[39] ... telp5a: jsr scrl ; handle the backspace in local-echo mode jmp chrlup ; ; out - output a special character sequence ; ; Input: A-reg holds a number indicating which sequence is to be output ; ; Output: putrs called to output character(s) ; ; This routine handles special key sequences like cursor up, pf1, ; and the likes. ; out: jsr outit jmp chrlup outit: pha ; save the identifier lsr a ; get the family lsr a lsr a lsr a and #$07 tay ; case selector is family pla ; remember the identifier and #$0f ; extract the family member to pass jsr case .word out0 ; numeric key pad .word out1 ; pf key .word out2 ; cursor key .word out3 ; programmable function key .word out4 ; miscellaneous keys .word out5 ; null out0: ldx #deckpam-vt100sw; check if keyboard is numeric or alternate jsr outsub jsr case .word out0a ; keypad does not exist if not emulating vtXX .word out0a ; keypad in vt52 numeric mode .word out0a ; keypad in vt100 numeric mode .word out0b ; keypad in vt52 alternate mode .word out0c ; keypad in vt100 alternate mode out0a: ora #'0 ; convert to digit jsr putrs ; send it rts ; all done out0b: pha ; save the key lda #esc ; send an escape jsr putrs lda #'? ; send a '?' jsr putrs pla clc adc #'p ; send 'p' plus whatever jsr putrs rts ; all done out0c: pha ; save the key lda #esc ; send an escape jsr putrs lda #'O ; send a 'O' jsr putrs pla clc adc #'p ; send 'p' plus whatever jsr putrs rts ; all done out1: ldy vtmod ; get terminal emulation jsr case .word anyrts ; if not emulating anything, no pf keys .word out1a ; pfkeys in vt52 mode .word out1b ; pfkeys in vt100 mode out1a: pha ; save the key lda #esc ; send an escape jsr putrs pla ; send 'P' plus whatever clc adc #'P jsr putrs rts out1b: pha ; save the key lda #esc ; send an escape jsr putrs lda #'O ; send 'O' jsr putrs pla clc adc #'P ; send 'P' plus whatever jsr putrs rts out2: ldx #decckm-vt100sw ; check the setting of the cursor keys jsr outsub jsr case .word anyrts ; cursor keys do not exist if not emulating vt .word out2a ; vt52 .word out2b ; vt100 in cursor mode .word out2a ; cursor mode does not matter if emulating vt52 .word out2c ; vt100 in application mode out2a: pha ; save the key to send lda #esc ; send esc jsr putrs pla clc adc #'A ; send 'A' plus whatever jsr putrs rts ; all done out2b: pha ; save the key to send lda #esc ; send an escape jsr putrs lda #'[ ; send an '[' jsr putrs pla clc adc #'A ; send 'A' plus whatever jsr putrs rts ; all done out2c: pha ; save the key to send lda #esc ; send an escape jsr putrs lda #'O ; send 'O' jsr putrs pla clc adc #'A ; send 'A' plus whatever jsr putrs rts out3: rts ; not handled yet out4: ldx #deckpam-vt100sw ; check the setting of the keypad jsr outsub jsr case .word out4a ; if no terminal emulation .word out4a ; emulating vt52 in numeric keypad mode .word out4a ; emulating vt100 in numeric keypad mode .word out4b ; emulating vt52 in alternate keypad mode .word out4c ; emulating a vt100 in alternate keypad mode out4a: tax ; look it up in out4a1 lda out4a1,x jsr putrs ; send it rts out4b: pha ; save it lda #esc ; send an escape jsr putrs lda #'? ; send a '?' jsr putrs pla ; remember character to send tax ; look it up in out4b1 lda out4b1,x jsr putrs ; send it rts out4c: pha ; save it lda #esc ; send an escape jsr putrs lda #'O ; send a 'O' jsr putrs pla ; remember character to send tax ; look it up in out4b1 lda out4b1,x jsr putrs ; send it rts out5: tay ; get the function to perfrom jsr case .word out5a ; send a null .word sbreak ; send a break out5a: lda #$00 ; send a nulll jsr putrs rts ; all done ; ; outsub - handy routine to determine which subroutine to call ; ; Input: X-reg index into vt100sw ; ; Output: Y-reg contains an index ; ; This routine returns 0 if no terminal is being emulated, ; 1 if a vt52 is being emulated, ; 2 if a vt100 is being emulated, ; 3 if a vt52 is being emulated and vt100sw,x is set ; 4 if a vt100 is being emulated and vt100sw,x is set ; outsub: ldy vt100sw,x ; check the switch bne outsub1 ; switch is set ldy vtmod rts outsub1:ldy vtmod ; get terminal emulation cpy #$00 beq outsub2 ; if zero, don't adjust for the switch iny ; add two to adjust for the switch being set iny outsub2:rts ; Handle special input characters telpr3: cmp #$07 ; Is it a ^G (bell) bne tlpr3a ; No jsr bell ; Ring bell rts ;[39] tlpr3a: cmp #$0d ; Is it a ^M (cr) ? bne tlpr3b ; No jsr scrcr ; Go do a rts ;[39] tlpr3b: cmp #$09 ;[26] Is it a ^I (tab) ? bne tlpr3c ;[26] No jsr prttab ;[26] Print to the next tab stop rts ;[39] tlpr3c: cmp #$1b ; Was it an 'escape'? bne tlpr3d ; No lda #on ; Set the escape flag on sta escflg ; ... lda #$00 ; zero pointers for vt100 emulation sta vt100st ; state is zero sta vt100pt ; parameter pointer is zero rts ; Return tlpr3d: cmp #$0a ; was it a line feed bne tlpr3e jsr scrlf ; perform the line feed ldx lmn ; is new line mode set beq tlpr3d1 ; if not, do nothing special jsr scrcr ; if it is set, lf implys cr tlpr3d1:rts tlpr3e: cmp #$08 ; was it a backspace? bne tlpr3f jsr scrl ; move the cursor left tlpr3f: cmp #$0e ; Was it a 'shift out' bne tlpr3g ; No lda #$01 ; select the g1 character set sta gx rts tlpr3g: cmp #$0f ; Was it a 'shift in' bne tlpr3h ; No lda #$00 ; select g0 character set sta gx tlpr3h: rts ; ; out4a1 - table of characters to send when keypad is in numeric mode ; ; This is a table of characters to send when '-', '+', '.', or enter ; is pushed on the numeric keypad. out4a1: .byte "-+." .byte cr ; ; out4b1 - table of characters to send when keypad is in alternate mode ; ; This is a table of characters to send when '-', '+', '.', or enter ; is pushed on the numeric keypad out4b1: .byte "mlnM" ; ; Intchr - processes the character which frollows the interupt ; character and performs functions based on what that character ; is. ; intchr: lda tekmode ; if we are in tek mode, we have to get out beq intch5 lda #$00 sta tekmode jsr scrtxt lda line25 ; clear the entire text screen including line25 pha lda #$01 sta line25 jsr scrclr pla sta line25 intch5: jsr rdkey ; Get the next character lda char ;[31] sta kerchr ; Save a copy of it and #$5f ; Capitalize it cmp #'C ; Does user want the connection closed? bne intch0 ; If not, try next option lda #$fc ; if we are in fast mode, we have to get out sta $d030 pla ;[39] Fix the stack pla ;[39] lda #false ;[48] sta connec ;[48] lda #$00 ; make sure output is turned on when we resume sta suspend jsr scrrst ; reset the screen to normal characterstics jmp kermit ;[39] intch0: cmp #'S ; Does the user want status? bne intch1 ; Nope jsr stat01 ;[EL] Give it to him jmp telcrs ;[39] intch1: cmp #'B ;[DD] Send break? bne intc1a ; No jsr sbreak ; Yes, go send one jmp telcrs ;[39] intc1a: lda kerchr ; Fetch back the original character and #$7f ; Get rid of the H.O. bit cmp #'? ; Does user need help? bne intch2 ; If not, continue ldx #inthlp\ ; Get the address of the proper help string ldy #inthlp^ ; ... jsr prstr ; Print the help stuff jmp intchr ; Get another option character intch2: cmp escp ; Is it another connect-escape? bne intch4 ;[39] jsr putrs ; Stuff the character at the port jmp telcrs ;[39] intch4: cmp #'0 ;[39] bne intch3 ;[39] Nope, this is an error lda #$00 ;[39] jsr putrs ;[39] jmp telcrs ;[39] intch3: jsr bell ; Sound bell at the user jmp telcrs ;[39] ; ; Vt52 - will carry out the equivalent of most of the vt52 functions ; available. ; vt52: lda #off ; First, turn off the escape flag sta escflg ; ... lda char ;[26] Get the character to check and #$7f ; Turn off the H.O. bit vt52z: sec ;[26] Get the cursor position jsr ploth ;[26] in X,Y sty hch ;[39] stx hcv ;[39] cmp #'A ; It is, is it an 'A'? bne vt52a ; No, try next character jsr scru ; Go up one line rts ; Return vt52a: cmp #'B ; Is it a 'B'? bne vt52b ; Next char jsr scrd ; Yes, go down one line rts ; and go back vt52b: cmp #'C ; 'C'? bne vt52c ; Nope jsr scrr ; Yes, go forward one space rts ; and return vt52c: cmp #'D ; 'D'? bne vt52d ; No jsr scrl ; Yes, do a back-space rts ; Return vt52d: cmp #'H ; 'H'? bne vt52e ; No, try next character jsr scrhom ; Home cursor (no clear screen) rts ; then return vt52e: cmp #'I ; 'I'? bne vt52f ; Nope jsr scrrlf ;[39] Do a reverse line feed rts ; and return vt52f: cmp #'J ; 'J'? bne vt52g ; No jsr scred0 ; Clear from where we are to end-of-page rts ; then return vt52g: cmp #'K ; 'K'? bne vt52h ; Try last option jsr screl0 ; Clear to end-of-line rts ; Return vt52h: cmp #'Y ; 'Y' bne vt52i ;[19] jsr vtdca ; Do direct cursor addressing rts ; then return vt52i: cmp #'o ;[19] 'o' bne vt52j ;[19] lda #$01 sta reverse ; turn reverse on rts ;[19] Return vt52j: cmp #'n ;[19] 'n' bne vt52k lda #$00 sta reverse ; turn reverse off rts ;[19] vt52k: cmp #'> ; '>' bne vt52l lda #$00 ; put keypad in numeric mode sta deckpam rts vt52l: cmp #'= ; '=' bne vt52m lda #$01 ; put keypad in alternate mode sta deckpam rts vt52m: cmp #'< ; '>' bne vt52n lda #$02 ; set terminal emulation to vt100 sta vtmod rts vt52n: cmp #'Z ; 'Z' bne vt52o lda #esc ; identify terminal type jsr putrs lda #'/ jsr putrs lda #'Z jsr putrs rts vt52o: cmp #'F ; set graphics mode bne vt52p lda #$01 sta g0 sta g1 rts vt52p: cmp #'G ; clear graphics mode bne vt52q lda #$00 sta g0 sta g1 rts vt52q: cmp #$0c ; put in tek mode bne vtig jsr scrtek jsr screra ; erase the graphics screen lda #$01 sta tekmode ; and enter grahics mode lda #747\ sta tekcylo lda #747^ sta tekcyhi lda #$00 sta tekcxlo sta tekcxhi rts vtig: pha ; Save a copy lda #esc ; Get an escape jsr prchr ; Print the special character pla ; Fetch the other character back cmp #esc ; Is it a second escape? bne vtig1 ; Nope, print it lda #on ; Set escflg on again for next time around sta escflg ; ... rts ; and return vtig1: jsr prchr ; Print the character rts ; and return vtdca: jsr getrs ; Check for a character from the port bne vtdca ; Try again lda char ;[31] and #$7f ; Make sure H.O. bit is off sec ; Subtract hex 30 (make it num from 0 to 23) sbc #$20 ; ... vtdca2: pha ; save it vtdca3: jsr getrs ; Check port for character bne vtdca3 ; go back and try again lda char ;[31] and #$7f ; Make sure h.o. bit is off sec ; Subtract hex 20 (make it num from 0 to 23) sbc #$20 ; ... vtdca5: tax ; this is the horizontal position pla ; remember the vertical position tay jsr scrplt ; move the cursor here rts ; and return .SBTTL VT100 Emulation Routines ; ; vt100 - parse a character in a vt100 command sequence ; ; Input - A character in the A-reg ; ; This routine processes characters after an esc in VT100 mode. ; It parses the command and calls a routine to perform the requested ; function when the last character in the sequence has been received. ; vt100: ldx vt100st ; state of the command parser vt100d: ldy vt100ta,x ; check the parser table beq vt100b ; escape sequence is illegal bpl vt100a ; is parameter expected? cmp #1+'9 ; yes. Was a digit received? bcs vt100a ; no, it is not a digit cmp #'0 bcc vt100a ; not a digit (carry set for next line) sbc #'0 ; convert the digit to a value (0..9) pha ; save it ldy vt100pt ; pointer into parameter list lda freemem,y ; get the current value asl a ; multiplied by 2 pha ; save that too asl a ; multiplied by 4 asl a ; multiplied by 8 sta freemem,y pla clc adc freemem,y ; multiplied by 10 sta freemem,y pla clc adc freemem,y ; add in the digit sta freemem,y ; save the new value of the parameter rts ; all done (for now. escflg still set) vt100a: cmp vt100ta,x ; found character in table? beq vt100c ; yes. go change state inx ; skip to the next entry inx inx jmp vt100d ; check this character vt100c: lda vt100ta+2,x ; high order byte of routine to call beq vt100e ; $00 = state change sta dest+1 lda vt100ta+1,x ; low order byte of routine to call sta dest lda #$00 sta escflg ; this command is complete jmp (dest) ; perform requested function vt100e: ldy vt100ta+1,x ; state to change to sty vt100st ; change to it lda vt100ta,y ; is a parameter expected? bpl vt100f ; no. inc vt100pt ; make pointer point to next parameter ldy vt100pt ; and zero the parameter cpy #freesiz ; still freespace available? bcs vt100b ; no. lda #$00 sta freemem,y vt100f: rts ; all done (for now. escflg still set) vt100b: lda #$00 ; an error has occured. abort processing sta escflg rts ; all done ; ; vt100b1 - process the '[' integer 'J' vt100 sequence ; ; This routine calls scred0, scred1, or scred2 depending on the ; value of the integer. ; vt100b1:ldy freemem+1 ; what is the integer cpy #$03 ; check for strange vt100 sequences bcs vt100er ; this is a strange sequence jsr case ; call the proper routine .word scred0 ; call scred0 if the integer is 0 .word scred1 ; call scred1 if the integer is 1 .word scred2 ; call scred2 if the integer is 2 ; ; vt100c1 - process the '[' integer 'K' ; ; This routine calls screl0, screl1, or screl2 depending on the ; value of the integer. vt100c1:ldy freemem+1 ; what is the integer cpy #$03 ; check for strange vt100 sequences bcs vt100er ; this is a strange sequence jsr case ; call the proper routine .word screl0 ; call screl0 if the integer is 0 .word screl1 ; call screl1 if the integer is 1 .word screl2 ; call screl2 if the integer is 2 ; ; vt100d1 - process the '[' integer ';' integer 'f' and ; '[' integer ';' integer 'H' vt100 commands ; ; This routine calls scrplt to put the cursor at the position indicated ; by the two integers. vt100d1:ldx #$00 ; get the first integer ldy #$01 ; default value is 1 jsr vt100pa ldx decom ; is origin mode absolute beq vt100d4 ; if absolute, do not add in top clc adc top ; if relative, add in top vt100d4:tay dey ; solve the off-by-one problem cpy #25 ; check it for reasonability bcc vt100d2 ldy #24 ; if unreasonable, move cursor to bottom line vt100d2:sty dest ; save y position ldx #$01 ; get the second integer ldy #$01 ; default value is 1 jsr vt100pa tax dex ; solve the off-by-one problem jsr scrrgh ; check it for reasconablilty bcc vt100d3 tax ; if unreasonable, move cursor to far right vt100d3:ldy dest ; get y position jsr scrplt ; finally move the cursor rts ; all done ; ; vt100e1 - process the integer ';' integer 'r' sequence ; ; This routine sets the top and bottom of the scrolling area. ; vt100e1:ldx #$00 ; get the first parameter ldy #$01 ; default value is one jsr vt100pa sta dest ; save it in a safe place dec dest ; solve the off-by-one problem jsr scrbot ; get default for second parameter tay iny ; solve the off-by-one problem ldx #$01 ; get the second parameter jsr vt100pa tay dey ; solve the off-by-one problem jsr scrbot ; check it for reasonablilty bcs vt100e2 cpy dest ; second must be greater than first bcc vt100e2 ; unreasonable sty bot ; set the bottom margin ldy dest ; set the top margin sty top lda decom ; check origin mode bne vt100e3 ; if origin mode off, move to top of area ldy #$00 ; if origin mode on, move to top of screen vt100e3:ldx #$00 ; in any case, move cursor to far left jsr scrplt vt100e2:rts vt100er:rts ; ; vt100f1 - process the '[' integer 'A' sequence ; ; This routine moves the cursor up lines ; vt100f1:ldx #$00 ; get the parameter ldy #$01 ; default value is one jsr vt100pa sec ; cutsy way to subtract it form cursor pos eor #$ff adc cy tay bcc vt100f3 ; gone past top of screen cpy top ; outside scrolling area bcs vt100f2 ; no vt100f3:ldy top ; move cursor to top vt100f2:ldx cx jsr scrplt ; plot the cursor here rts ; ; vt100g1 - process the '[' integer 'B' sequence ; ; This routine moves the cursor down lines ; vt100g1:ldx #$00 ; get the parameter ldy #$01 ; the default is one jsr vt100pa clc ; add the parameter to cy adc cy tay cpy bot ; see if still in scrolling area bcc vt100g2 ldy bot ; nope. move the cursor to the bottom vt100g2:ldx cx jsr scrplt ; plot the cursor here rts ; all done ; ; vt100h1 - process the '[' integer 'C' sequence ; ; This routine moves the cursor right characters ; vt100h1:ldx #$00 ; get the parameter ldy #$01 ; default value is one jsr vt100pa clc ; add it into the current cursor position adc cx tax jsr scrrgh ; check it for reasonability bcc vt100h2 ; it is reasonable tax ; if unreasonable, move cursor to far right vt100h2:ldy cy ; plot the cursor here jsr scrplt rts ; ; vt100i1 - process the '[' integer 'D' sequence ; ; This routine moves the cursor left characters ; vt100i1:ldx #$00 ; get the parameter ldy #$01 ; default value is one jsr vt100pa sec ; cutsy way to subtract from cx eor #$ff adc cx bcs vt100i2 ; check if gone past left margin lda #$00 ; if so, move to far left vt100i2:tax ldy cy ; plot the cursor here jsr scrplt rts ; ; vt100j1 - process the '[' [ integer ';' ...] 'm' sequence ; ; This routine sets the graphic rendition (reverse, alternate colors, ; underline and flashing) parameters. Note that it may be passed ; 0 or more parameters ; vt100j1:ldx #$00 ; start with the first parameter vt100j5:ldy #$00 ; default value is zero jsr vt100pa beq vt100j3 ; if zero, clear everything tay cpy #vt100gs bcs vt100j4 ; unreasonable parameter! lda #$01 ; set the proper parameter sta vt100gr,y bne vt100j4 ; always taken vt100j3:jsr vt100j2 ; clear everything vt100j4:inx ; get the next parameter cpx vt100pt ; all done? bcc vt100j5 ; nope. Do some more rts ; all done. vt100j2:lda #$00 ; clear everything sta alternt ; alternate color (highlighting) sta flash ; flashing off sta underln ; dont underline sta reverse ; dont reverse rts ; everything cleared. ; ; vt100k - process the '[' '?' integer 'h' sequence ; ; This routine sets a vt100 switch ; vt100k: ldx #$00 ; start with the first parameter vt100k1:ldy #$00 ; default value is zero jsr vt100pa ; get the value of the parameter cmp #vt100ss ; is this a legal switch? bcs vt100k2 ; nope. Better not try to set it tay lda #$01 sta vt100sw,y ; set this switch cpy #decrev-vt100sw ; reverse entire screen? bne vt100k2 txa ; save x register pha jsr scrset ; call screen driver pla tax ; restore x register vt100k2:inx cpx vt100pt ; done yet? bcc vt100k1 rts ; all done ; ; vt100l - process the '[' '?' integer 'l' sequence ; ; This routine clears a vt100 switch ; vt100l: ldx #$00 ; start with the first parameter vt100l1:ldy #$00 ; default value is zero jsr vt100pa ; get the value of the parameter cmp #vt100ss ; is this a legal switch? bcs vt100l2 ; nope. Better not try to clear it cmp #decanm-vt100sw ; enter vt52 emulation? bne vt100l3 jsr scrrst ; reset the terminal ldy #$01 ; put terminal in vt52 mode sty vtmod rts vt100l3:tay lda #$00 sta vt100sw,y ; clear this switch cpy #decrev-vt100sw ; reverse entire screen? bne vt100l2 txa ; save x register pha jsr scrset ; call screen driver pla tax ; restore x register vt100l2:inx cpx vt100pt ; done yet? bcc vt100l1 rts ; all done ; ; vt100m - put the keypad in numeric mode ; ; This routine puts the keypad into numeric mode ; vt100m: lda #$00 sta deckpam rts ; ; vt100n - put the keypad into alternate mode ; ; This routine puts the keypad into alternate mode ; vt100n: lda #$01 sta deckpam rts ; ; vt100o - perform the next line function ; ; This routine moves the cursor down one line and to the leftmost column ; vt100o: jsr scrlf ; move the cursor down one line jsr scrcr ; move the cursor to the leftmost column rts ; all done ; ; vt100p - set a tab stop ; ; This routine sets a tab stop at the current cursor position ; vt100p: ldx cx ; get the current cursor position lda #$00 ; zero means tab stop here sta tabs,x ; set the tab rts ; all done ; ; vt100q - clear tab stop(s) ; ; This routine processes the '[' integer 'g' sequence ; ; If 'integer' is zero, a tab stop is cleared. If 'integer' is three ; all the tab stops are cleared. Otherwise, nothing happens. ; vt100q: ldx #$00 ; get the first parameter ldy #$00 ; default value is zero jsr vt100pa ; get the parameter beq vt100q1 ; if zero, clear a tab stop cmp #3 ; if not zero or three, ignore bne vt100q3 ; if non-zero (usually 3), clear all tabs ldx #79 ; clear 80 tab stops lda #$01 ; non-zero entry in tabs means tab cleared vt100q2:sta tabs,x ; cleared one dex bpl vt100q2 ; repeat till done rts ; all done vt100q1:lda #$01 ; non-zero entry in tabs means tab cleared ldx cx ; get tabstop to clear sta tabs,x ; cleared vt100q3:rts ; all done ; ; vt100r - make a terminal report ; ; This routine processes the '[' integer 'n' sequence ; ; If 'integer' is 5, the 'terminal OK' reply is generated. Otherwise ; the cursor position reply is generated. ; vt100r: ldx #$00 ; get the first parameter ldy #$00 ; default is 0 jsr vt100pa ; get the parameter cmp #5 ; want the 'terminal OK' report? beq vt100r1 ; vt100r1 sends the 'terminal OK' reply cmp #6 ; if neither report desired, ignore bne vt100r3 lda #esc ; send '[' ';' 'R' jsr putrs lda #'[ jsr putrs lda cy ; send the line ldy decom ; if in origin mode, subtract top beq vt100r2 sec sbc top vt100r2:clc adc #$01 ; solve the off by one problem jsr outad ; print a decimal number to the modem lda #'; ; send ';' jsr putrs lda cx ; send the cursor column clc adc #$01 ; solve the off by one problem jsr outad ; print a decimal number to the modem lda #'R jsr putrs rts ; all done vt100r1:lda #esc ; send '[0n' (Terminal OK reply code) jsr putrs lda #'[ jsr putrs lda #'0 jsr putrs lda #'n jsr putrs vt100r3:rts ; done ; ; vt100s - report device attributes ; ; This routine processes the 'Z' and '[' 'c' sequences ; ; The device attributes are sent to the modem. ; vt100s: lda #esc ; send '[?1;1c' (Device attribute string) jsr putrs lda #'[ jsr putrs lda #'? jsr putrs lda #'1 jsr putrs lda #'; jsr putrs lda #'2 ; we have AVO (Advanced video option) jsr putrs lda #'c jsr putrs rts ; all done ; ; vt100t - reset terminal ; ; This routine processes the 'c' sequence ; ; The terminal is reset ; vt100t: jsr scrrst ; reset the terminal jsr scrhom ; home the cursor lda line25 ; save the status of the 25th line pha lda #$01 ; allow the 25th line to be cleared sta line25 jsr scred2 ; clear entire screen pla ; restore the status of the 25th line sta line25 rts ; all done ; ; vt100v - set/reset new line mode ; ; These routines processes '[' integer h and '[' integer 'l' ; ; vt100v1 - set new line mode if 'integer' is 20 ; - set insert replace mode if 'integer' is 4 ; vt100v2 - clear new line mode if 'integer' is 20 ; - clear insert replace mde if 'integer' is 4 ; vt100v1:ldx #$00 ; get the first parameter ldy #$00 ; default is 0 jsr vt100pa ; get the parameter cmp #20 ; is it 20 bne vt100v3 ; if not, ignore it lda #$01 ; set new line mode sta lmn rts ; all done vt100v3:cmp #4 ; is it 4 bne vt100v0 ; if not, ignore it lda #$01 sta irm rts vt100v2:ldx #$00 ; get the first parameter ldy #$00 ; default is 0 jsr vt100pa ; get the parameter cmp #20 ; is it 20 bne vt100v4 ; if not, ignore it lda #$00 ; set new line mode sta lmn rts vt100v4:cmp #4 ; is it 4 bne vt100v0 ; if not, ignre it lda #$00 sta irm vt100v0:rts ; all done ; ; vt100w - mount a character set ; ; vt100w1 - mount U.S. ascii character set on g0 ; vt100w2 - mount graphics character set on g0 ; vt100w3 - mount U.S. ascii character set on g1 ; vt100w4 - mount graphics character set on g1 ; vt100w1:lda #$00 ; mount U.S. ascii character set on g0 sta g0 rts vt100w2:lda #$01 ; mount graphics character set on g0 sta g0 rts vt100w3:lda #$00 ; mount U.S. ascii character set on g1 sta g1 rts vt100w4:lda #$01 ; mount graphics character set on g1 sta g1 rts ; ; vt100x1 - enter graphics mode vt100x1:jsr scrtek ; turn on the graphics screen jsr screra ; erase the graphics screen lda #$01 sta tekmode ; and enter grahics mode lda #747\ sta tekcylo lda #747^ sta tekcyhi lda #$00 sta tekcxlo sta tekcxhi rts ; ; vt100y1 - process the '[' integer 'P' vt102 commands ; ; This routine calls scrdch to delete some characters ; vt100y1:ldx #$00 ; get the first integer ldy #$01 ; default value is 1 jsr vt100pa ; how many characters to delete jsr scrdch ; go delete them rts ; all done ; ; vt100z1 - process the '[' integer 'L' vt102 comand ; ; This routine calls scral to add some lines ; vt100z1:ldx #$00 ; get the first integer ldy #$01 ; default value is 1 jsr vt100pa ; how many lines to insert jsr scral ; go insert them rts ; all done ; ; vt100z2 - process the '[' integer 'M' vt102 comand ; ; This routine calls scrdl to delete some lines ; vt100z2:ldx #$00 ; get the first integer ldy #$01 ; default value is 1 jsr vt100pa ; how many lines to delete jsr scrdl ; go insert them rts ; all done ; ; vt100z3 - process the sequence ; ; This routine delays processing for a 4 sixtieths of a second. The ; delay is intended to be used in a visual-bell escape sequence, so we ; synchronize ourself with the VIC raster scan. (Too bad we ; can't synchronize with the 8563 raster scan.) ; vt100z3:ldx #4 vt100z4:bit $d011 bmi vt100z4 vt100z5:bit $d011 bpl vt100z5 dex bne vt100z4 rts ; ; outad - send a decimal number to modem. ; ; Input: A - Number to be printed ; ; Registers Destroyed: A,X,Y ; ; Note the similarity between this routine and printad. ; ; This routine sends to the modem instead of the screen, and ; this routine only accepts numbers less than 255. ; outad: ldx #2 ; up to 3 digits (0..2) outad1: cmp tens1,x ; drop any leading zeros bcs outad2 dex bpl outad1 outad2: ldy #'0 ; y is the ascii value to print outad3: cmp tens1,x ; compare with 10^x bcc outad4 ; result would be negative. sbc tens1,x ; carry is already set iny ; keep track of the value of this digit bne outad3 ; always taken outad4: pha ; save the number we are printing txa ; save X pha tya ; print the character in Y jsr putrs pla ; restore X tax pla ; remember the number we are printing dex ; print the next digit. bpl outad2 rts ; ; vt100pa - get a parameter for vt100 emulation ; ; Input: X-reg - which parameter is desired (0..n) ; Y-reg - default value of this parameter ; ; Output: A-reg - value of this parameter ; ; This routine returns the value of the requested parameter. If ; the parameter is zero or undefined, it returns the default value. ; vt100pa:cpx vt100pt ; was the necessary number of params given bcs vt100pb ; no, use the default lda freemem+1,x ; get this parameter beq vt100pb ; if zero, use the default rts vt100pb:tya ; return the default rts ; ; vt100ta - parser table for vt100 commands ; ; the first byte of each entry is a character to expect. If the ; character to expect is negative, it means to parse a parameter ; and remain in the current state. If it is zero, that is the end ; of the entry. If it is the character received, the next word is looked ; at. If it is less than $100, the parser changes into that state. If ; it is greater or equal to $100, the routine at that address is called. ; vt100ta:.byte '[ ; many different sequences begin with [ .word vt100a1-vt100ta .byte '# ; many different sequences begin with # .word vt100a5-vt100ta .byte 'M ; 'M' .word scrrlf ; is reverse index .byte 'E ; 'E' .word vt100o ; is next line .byte 'D ; 'D' .word scrlf ; is index .byte '7 ; '7' .word scrsav ; means save cursor position .byte '8 ; '8' .word scrlod ; means load cursor position .byte 'H ; 'H' .word vt100p ; means set a tab stop .byte '= ; '>' .word vt100n ; puts keypad in alternate mode .byte '> ; '=' .word vt100m ; puts keypad in numeric mode .byte 'Z ; 'Z' .word vt100s ; sends the terminal identity .byte 'c ; 'c' .word vt100t ; resets the terminal .byte '( ; '(' .word vt100a6-vt100ta ; means mount a character set .byte ') ; ')' .word vt100a7-vt100ta ; means mount a character set .byte $0c ; form-feed .word vt100x1 ; means enter graphics mode .byte ', ; ',' .word vt100z3 ; means delay for 250 ms .byte $00 vt100a1:.byte $ff .word 0 .byte 'J ; '[' integer 'J' .word vt100b1 .byte 'K ; '[' integer 'K' .word vt100c1 .byte 'A ; '[' integer 'A' .word vt100f1 .byte 'B ; '[' integer 'B' .word vt100g1 .byte 'C ; '[' integer 'C' .word vt100h1 .byte 'D ; '[' integer 'D' .word vt100i1 .byte 'm ; '[' integer ';']... 'm' .word vt100j1 .byte '; .word vt100a2-vt100ta .byte 'f ; '[' 'f' .word vt100d1 .byte 'H ; '[' 'H' .word vt100d1 .byte 'r ; '[' 'r' .word vt100e1 .byte '? ; '[' '?' .word vt100a3-vt100ta .byte 'g ; '[' integer 'g' .word vt100q ; means clear tab stop(s) .byte 'n ; '[' integer 'n' .word vt100r ; means create a reply message .byte 'c ; '[' integer 'c' .word vt100s ; sends terminal identification .byte 'h ; '[' integer 'h' .word vt100v1 ; means set new line mode .byte 'l ; '[' integer 'l' .word vt100v2 ; means clear new line mode .byte 'P ; '[' integer 'P' .word vt100y1 ; means delete some characters .byte 'L ; '[' integer 'L' .word vt100z1 ; means insert some lines .byte 'M ; '[' integer 'M' .word vt100z2 ; means delete some lines .byte $00 vt100a2:.byte $ff .word 0 .byte 'H .word vt100d1 ; '[' integer ';' integer 'H' .byte 'f .word vt100d1 ; '[' integer ';' integer 'f' .byte 'r .word vt100e1 ; '[' integer ';' integer 'r' .byte 'm .word vt100j1 ; '[' integer ';' integer 'm' .byte '; .word vt100a4-vt100ta ; '[' integer ';' integer ';' ... 'm' .byte 0 vt100a3:.byte $ff .word 0 .byte 'h ; '[' '?' integer 'h' .word vt100k ; means set switchs .byte 'l ; '[' '?' integer 'l' .word vt100l ; means reset switchs .byte '; .word vt100a3-vt100ta .byte 0 vt100a4:.byte $ff .word 0 .byte '; .word vt100a4-vt100ta ; '[' integer ';' integer ';' integer.. .byte 'm .word vt100j1 ; '[' [ingeger ';'] ... 'm' .byte 0 vt100a5:.byte '8 ; #8 fills the screen with 'E's .word screee .byte 0 vt100a6:.byte 'A ; '(' 'A' means mount U.S. chars on g0 .word vt100w1 .byte 'B ; '(' 'B' means mount U.S. chars on g0 .word vt100w1 .byte '1 ; '(' '1' means mount U.S. chars on g0 .word vt100w1 .byte '2 ; '(' '2' means mount U.S. chars on g0 .word vt100w1 .byte '0 ; '(' '0' means mount graphic chars on g0 .word vt100w2 .byte $00 vt100a7:.byte 'A ; ')' 'A' means mount U.S. chars on g1 .word vt100w3 .byte 'B ; ')' 'B' means mount U.S. chars on g1 .word vt100w3 .byte '1 ; ')' '1' means mount U.S. chars on g1 .word vt100w3 .byte '2 ; ')' '2' means mount U.S. chars on g1 .word vt100w3 .byte '0 ; ')' '0' means mount graphic chars on g1 .word vt100w4 .byte $00 .byte *-vt100ta ; abort assembly if table length > $100 .SBTTL Tektronix ; ; These routines interpret Tektronix PLOT10 commands and draw lines ; ; ; tek - process tek4014 commands ; ; Input - character to process in A-reg ; ; This routine processes characters when tekmode != 0. It is called ; by telnet. ; tek: ldx escflg ; was the last character an escape? beq tek2 ldx #$00 ; clear the escape flag stx escflg cmp #$0c ; got a ff? bne tek1a jsr screra ; clear the screen lda #$00 ; home the cursor sta tekcxlo sta tekcxhi lda #747\ sta tekcylo lda #747^ sta tekcyhi lda #$01 ; and prepare to receive text. sta tekmode tekrts: rts tek1a: cmp #'? ; got '?' ?? bne tek1b lda #$7f ; simulate a DEL jmp tek2 tek1b: cmp #'[ ; got a '[' or an upper case letter = exit tek beq tek1c cmp #'A bcc tekrts ; otherwise, ignore cmp #'Z+1 bcs tekrts ; otherwise, ignore tek1c: pha ; save character to re-scan in vt100/vt52 mode jsr scrtxt ; exit tektronix mode lda line25 ; clear the entire text screen including line25 pha lda #$01 sta line25 jsr scrclr pla sta line25 ldx #$00 stx tekmode ldx #on ; Set the escape flag on stx escflg ; ... ldx #$00 ; zero pointers for vt100 emulation stx vt100st ; state is zero stx vt100pt ; parameter pointer is zero pla ; restore character to re-scan jmp telprc1 ; attempt to process the escape sequence tek2: cmp #$1e ; start incremental plotting mode? bne tek3 lda #$06 sta tekmode rts tek3: cmp #$1f ; got a record seporator? bne tek4 lda #$01 ; if so, prepare to receive text. sta tekmode rts tek4: cmp #$1d ; got a group separator? bne tek5 lda #$02 ; if so, prepare to receive graphics statements sta tekmode lda #$00 ; and lift the pen up sta tekpen rts tek5: cmp #$18 ; got a can? bne tek7 jsr scrtxt ; exit tek mode lda line25 ; clear the entire text screen including line25 pha lda #$01 sta line25 jsr scrclr pla sta line25 lda #$00 sta tekmode rts tek7: cmp #$0d ; got a carriage return? bne tek8 lda #$01 ; prepare to receive text sta tekmode lda #$00 ; move cursor to far left sta tekcxlo sta tekcxhi rts tek8: cmp #$0a ; got a line feed? bne tek9 lda #$01 ; prepare to receive text sta tekmode sec ; move cursor down lda tekcylo sbc #32 sta tekcylo lda tekcyhi sbc #0 sta tekcyhi bpl tek8a ; wrap up to the top lda #747\ sta tekcylo lda #747^ sta tekcyhi tek8a: rts tek9: cmp #$1b ; got an escape? bne tek6 lda #$01 ; if so, set the escape flag sta escflg rts tek6: ldy tekmode ; what type of command is expected? jsr case ; go process the command. .word anybrk ; can't happen. only called when tekmode != 0 .word tekm1 .word tekm2 .word tekm3 .word tekm4 .word tekm5 .word tekm6 tekm1: cmp #$7f ; cant print a del beq tekm1a sec ; convert to funny ascii sbc #$20 bcc tekm1a ; if non-ascii character, ignore pha jsr scrint ; convert coordinate to internal format pla jsr scrdrw ; draw the letter (returns size of letter) clc adc tekcxlo sta tekcxlo bcc tekm1a inc tekcxhi tekm1a: rts tekm2: and #$60 ; what type of command did we get? cmp #$20 ; is this the command we expected bne tekm3 lda char ; get the character and #$1f ; extract the low 5 bits sta tekryhi lda #$02 ; save this state sta tekmode rts tekm3: and #$60 ; what type of command did we get? cmp #$60 ; is this the command we expected bne tekm4 lda char ; get the character and #$1f ; extract the low 5 bits sta tekrylo ; and set the low y coordinate lda #$03 ; save this state sta tekmode rts tekm4: and #$60 ; what type of command did we get? cmp #$20 ; is this the command we expected bne tekm5 lda char ; get the character and #$1f ; extract the low 5 bits. sta tekrxhi ; and set the high y coordinate lda #$04 ; save this state sta tekmode rts tekm5: and #$60 ; what type of command did we get? cmp #$40 ; is this the command we expected bne tekm5b ; no. this is not a legial escape sequence lda char ; get the character and #$1f ; extract the low 5 bits sta tekrxlo ; and set the low x coordinate jsr teksave ; save up the current point as the destination lda tekrxlo ; now compute tekcxlo and tekcxhi sta tekcxlo lda tekrxhi asl a asl a asl a asl a asl a ora tekcxlo sta tekcxlo lda tekrxhi lsr a lsr a lsr a sta tekcxhi lda tekrylo ; now compute tekcylo and tekcyhi sta tekcylo lda tekryhi asl a asl a asl a asl a asl a ora tekcylo sta tekcylo lda tekryhi lsr a lsr a lsr a sta tekcyhi jsr scrint ; convert coordinates to internal format lda tekpen ; is the pen down beq tekm5c ; no, dont draw any line. jsr scrlin ; draw the line lda #$02 ; prepare to draw another line sta tekmode rts tekm5c: lda #$01 ; put the pen down sta tekpen lda #$02 ; prepare to draw another line sta tekmode tekm5b: rts tekm6: cmp #$20 ; pick pen up? bne tekm6e lda #$00 sta tekpen rts tekm6e: cmp #$50 ; put pen down? bne tekm6f lda #$01 sta tekpen rts tekm6f: pha ; remember character to process jsr teksave ; save the starting coordinate of the line pla ; restore coordinate lsr a ; incremental plotting mode bcc tekm6a inc tekcxlo ; go to the east bne tekm6a inc tekcxhi tekm6a: lsr a bcc tekm6b ldx tekcxlo ; go to the west bne tekm6a1 dec tekcxhi tekm6a1:dec tekcxlo tekm6b: lsr a bcc tekm6c inc tekcylo ; go to the north bne tekm6c inc tekcyhi tekm6c: lsr a bcc tekm6d ldx tekcylo ; go to the south bne tekm6c1 dec tekcyhi tekm6c1:dec tekcylo tekm6d: lda tekpen ; see if pen down beq tekm6d1 jsr scrint jsr scrlin ; draw the line tekm6d1:rts ; ; teksave - convert the current position to internal form and save it ; ; This routine sets up the 'from' point for line drawing ; teksave:jsr scrint lda tektxlo sta tekfxlo lda tektxhi sta tekfxhi lda tektylo sta tekfylo lda tektyhi sta tekfyhi rts .SBTTL Exit routine ; ; This routine exits properly from Kermit-65 and reenters ; BASIC. ; ; Input: NONE ; ; Output: NONE ; ; Registers destroyed: A,X ; exit: lda #cmcfm ; Try to get a confirm jsr comnd ; Do it jmp kermt3 ; Give '?not confirmed' message exit1: jsr restor ;[36] Restore everything to its' default state lda r6510 ;[17] Prepare to terminate ora #1 ;[17] by paging BASIC ROM in sta r6510 ;[17] ... exit2: jmp (dos) ; Now restart BASIC restor: jsr clall ;[19][36] Close all channels jsr scrext ; restore screen hardward to its initial state lda #00 sta ndx ; empty the key queue. rts ;[36] Return .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 ; Go parse and print the confirm jsr logo ; Tell other Kermit to log out jmp kermit ; Don't exit if there was an error jmp exit1 ; Leave ; ; Logo - This routine does the actual work to send the logout ; packet to the remote server ; logo: jsr openrs ;[27] Reset the RS-232 channel lda #$00 ; Zero the number of tries sta numtry ; ... sta tpak ; and the total packet number sta tpak+1 ; ... lda #pdbuf\ ;[29] Get the address of the packet buffer sta kerbf1 ;[29] and save it for Spak lda #pdbuf^ ;[29] ... sta kerbf1+1 ;[29] ... logo1: lda numtry ; Fetch the number of tries cmp maxtry ; Have we exceeded Maxtry? bmi logo3 ; Not yet, go send the packet logo2: ldx #ermesc\ ; Yes, give an error message ldy #ermesc^ ; ... jsr prstr ; ... jsr prcrlf ; ... rts ; and return logo3: inc numtry ; Increment the number of tries for packet lda #$00 ; Make it packet number 0 sta pnum ; ... lda #$01 ; Data length is only 1 sta pdlen ; ... lda #'L ; The 'Logout' command sta pdbuf ; Put that in first character of buffer lda #'G ; Generic command packet type sta ptype ; ... jsr flshin ;[25] Flush the RS232 buffer jsr spak ; Send the packet jsr rpak ; Try to fetch an ACK cmp #true ; Did we receive successfully? bne logo1 ; No, try to send the packet again lda ptype ; Get the type cmp #'Y ; An ACK? bne logoce ; No, go check for error jmp rskp ; Yes, skip return logoce: cmp #'E ; Error packet? bne logo1 ; Nope, resend packet jsr prcerp ; Go display the error rts ; 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 ; Go parse and print the confirm jsr openrs ;[27] Reset the RS232 channel lda #$00 ; Zero the number of tries sta numtry ; ... sta tpak ; and the total packet number sta tpak+1 ; ... lda #pdbuf\ ;[29] Get the address of the packet buffer sta kerbf1 ;[29] and save it for Spak lda #pdbuf^ ;[29] ... sta kerbf1+1 ;[29] ... finsh1: lda numtry ; Fetch the number of tries cmp maxtry ; Have we exceeded Maxtry? bmi finsh3 ; Not yet, go send the packet finsh2: ldx #ermesd\ ; Yes, give an error message ldy #ermesd^ ; ... jsr prstr ; ... jsr prcrlf ; ... jmp kermit ; and go back for more commands finsh3: inc numtry ; Increment the number of tries for packet lda #$00 ; Make it packet number 0 sta pnum ; ... lda #$01 ; Data length is only 1 sta pdlen ; ... lda #'F ; The 'Finish' command sta pdbuf ; Put that in first character of buffer lda #'G ; Generic command packet type sta ptype ; ... jsr flshin ;[25] Flush the RS232 buffer jsr spak ; Send the packet jsr rpak ; Try to fetch an ACK cmp #true ; Did we receive successfully? bne finsh1 ; No, try to send the packet again lda ptype ; Get the type cmp #'Y ; An ACK? bne fince ; No, go check for error jmp kermit ; Yes, go back for more commands fince: cmp #'E ; Error packet? bne finsh1 ; Nope, resend packet jsr prcerp ;; Go display the error jmp kermit ; 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: jsr openrs ;[27] Reset the RS232 channel lda #yes ; Make KERMIT use file headers sta usehdr ; for file names lda #mxfnl+1 ; The buffer size is one more than max sta kwrk01 ; file name length lda #fcb1\ ; Point to the buffer sta kerto ; ... lda #fcb1^ ; ... sta kerto+1 ; ... jsr kerflm ; Clear the buffer lda #$80 ; Reset all break characters jsr rstbrk ; ... lda #cr ; ... jsr setbrk ; ... lda #lf ; ... jsr setbrk ; ... lda #ffd ; ... jsr setbrk ; ... lda #esc ; ... jsr setbrk ; ... ldy #$00 ; ... lda #cmtxt ; Parse for text jsr comnd ; Do it jmp kermta ; Found null string cmp spsiz ; Larger than the set packet size? bmi getf1 ; No, continue lda spsiz ; Yes, it will have to be truncated getf1: sta kwrk01 ; Store packet size for Kercpy sta pdlen ; and Spak lda #pdbuf\ ; Point to the data buffer as destination sta kerto ; ... sta kerbf1 ; Store L.O.B. here for Spak routine lda #pdbuf^ ; ... sta kerto+1 ; ... sta kerbf1+1 ; Store H.O.B. here for Spak routine stx kerfrm ; Point to the atom buffer from Comnd sty kerfrm+1 ; as the source address txa ; Save the 'from buffer' pointers for later pha ; ... tya ; ... pha ; ... jsr kercpy ; Copy the string pla ; Restore these for the next move sta kerfrm+1 ; ... pla ; ... sta kerfrm ; ... lda #fcb1\ ; Set up the address of the target sta kerto ; ... lda #fcb1^ ; ... sta kerto+1 ; ... jsr clrfcb ; Clear the fcb first jsr kercpy ; Go move the string jsr prcfm ; Go parse and print the confirm lda #'R ; Packet type is 'Receive-init' sta ptype ; ... lda #$00 ; Packet number should be zero sta pnum ; ... jsr spak ; Packet length was set above, jsr rswt ; so just call spak and try to receive jmp kermit ; 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: jsr openrs ;[27] Reset the RS232 channel lda #on ; Set use file-header switch on in case we sta usehdr ; don't parse a filename lda #kerehr\ ; Point to extra help commands sta cmehpt ; ... lda #kerehr^ ; ... sta cmehpt+1 ; ... ldx #mxfnl ; Longest length a filename may be ldy #cmfehf ; 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 ; Store length of file parsed stx kerfrm ; Save the from address (addr[atmbuf]) sty kerfrm+1 ; ... lda #fcb1\ ; Save the to address (Fcb1) sta kerto ; ... lda #fcb1^ ; ... sta kerto+1 ; ... jsr clrfcb ; Clear the fcb jsr kercpy ; 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 prcfm ;[] Parse and print a confirm jsr rswt ; Perform send-switch routine jmp kermit ; Go back to main routine rswt: lda #'R ; The state is receive-init sta state ; Set that up lda #$00 ; Zero the packet sequence number sta n ; ... sta numtry ; Number of tries sta oldtry ; Old number of tries sta eofinp ; End of input flag sta errcod ; Error indicator sta rtot ; Total received characters sta rtot+1 ; ... sta stot ; Total Sent characters sta stot+1 ; ... sta rchr ; Received characters, current file sta rchr+1 ; ... sta schr ; and Sent characters, current file sta schr+1 ; ... sta tpak ; and the total packet number sta tpak+1 ; ... rswt1: lda state ; Fetch the current system state cmp #'D ; Are we trying to receive data? bne rswt2 ; If not, try the next one jsr rdat ; Go try for the data packet jmp rswt1 ; Go back to the top of the loop rswt2: cmp #'F ; Do we need a file header packet? bne rswt3 ; If not, continue checking jsr rfil ; Go get the file-header jmp rswt1 ; Return to top of loop rswt3: cmp #'R ; Do we need the init? bne rswt4 ; No, try next state jsr rini ; Yes, go get it jmp rswt1 ; Go back to top rswt4: cmp #'C ; Have we completed the transfer? bne rswt5 ; No, we are out of states, fail lda #true ; Load AC for true return rts ; Return rswt5: lda #false ; Set up AC for false return rts ; Return rini: lda #pdbuf\ ; Point kerbf1 at the packet data buffer sta kerbf1 ; ... lda #pdbuf^ ; ... sta kerbf1+1 ; ... lda numtry ; Get current number of tries inc numtry ; Increment it for next time cmp maxtry ; Have we tried this one enougth 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 ; No, fetch the error index sta errcod ; and store it as the error code jsr prcerp ; 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 ; No, punt 8-bit quoting sta ebqmod ; ... lda #$06 ; BTW, the data length is now only 6 jmp rinic1 ; Continue rinicy: lda #on ; Make sure everything is on sta ebqmod ; ... lda #$07 ; Data length for ack-init is 7 rinic1: sta pdlen ; Store packet data length jsr spak ; Send that packet lda numtry ; Move the number of tries for this packet sta oldtry ; to prev packet try count lda #$00 ; Zero sta numtry ; the number of tries for current packet jsr incn ; Increment the packet number once lda #'F ; Advance to 'File-header' state sta state ; ... lda #true ; Set up return code rts ; Return rfil: lda numtry ; Get number of tries for this packet inc numtry ; Increment it for next time around cmp maxtry ; Have we tried too many times? beq rfil1 ; Not yet bcs rfil1a ; Yes, go abort the transfer rfil1: jmp rfil2 ; Continue transfer rfil1a: lda #'A ; Set state of system to 'abort' sta state ; ... lda #false ; Return code should be 'false' rts ; Return rfil2: jsr rpak ; Try to receive a packet sta rstat ; Save the return status lda ptype ; Get the packet type we found cmp #'S ; Was it an 'init' packet? bne rfil2a ; Nope, try next one jmp rfilci ; Handle the init case rfil2a: cmp #'Z ; Is it an 'eof' packet?? bne rfil2b ; No, try again jmp rfilce ; Yes, handle that case rfil2b: cmp #'F ; Is it a 'file-header' packet??? bne rfil2c ; Nope jmp rfilcf ; Handle file-header case rfil2c: cmp #'B ; Break packet???? bne rfil2d ; Wrong, go get the return status jmp rfilcb ; Handle a break packet rfil2d: lda rstat ; Fetch the return status from Rpak cmp #false ; Was it a false return? beq rfil2e ; Yes, Nak it and return lda #errcrf ; No, fetch the error index sta errcod ; and store it as the error code jsr prcerp ; 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 ; Fetch the error index sta errcod ; and store it as the error code jsr prcerp ; 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: lda #'Y ; Make it look like an ack to a send-init sta ptype ; ... 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\ ; Get the pointer to the fcb ; sta kerfcb ; and store it where the close routine ; lda #fcb1^ ; can find it ; sta kerfcb ; ... ; lda #$00 ; Make CLOSEF see there are no errors jsr closef ; We are done with this file, so close it jsr incn ; 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: jsr openrs ;[27] Reset the RS232 channel ldx #mxfnl ; Longest length a filename may be ldy #$00 ; 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 ; Store length of file parsed stx kerfrm ; Save the from address (addr[atmbuf]) sty kerfrm+1 ; ... lda #fcb1\ ; Save the to address (Fcb1) sta kerto ; ... lda #fcb1^ ; ... sta kerto+1 ; ... jsr clrfcb ; Clear the fcb jsr kercpy ; Copy the string ldy kwrk01 ; Get filename length lda #nul ; Fetch a null character sta (kerto),y ; 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 ; 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 ; and Sent characters, current file sta schr+1 ; ... sta tpak ; and the total packet number sta tpak+1 ; ... lda #pdbuf\ ; Set up the address of the packet buffer sta saddr ; so that we can clear it out lda #pdbuf^ ; ... sta saddr+1 ; ... lda #$00 ; Clear AC ldy #$00 ; Clear Y clpbuf: sta (saddr),y ; Step through buffer, clearing it out iny ; Up the index cpy #mxpack-4 ; Done? bmi clpbuf ; No, continue sswt1: lda state ; Fetch state of the system cmp #'D ; Do Send-data? bne sswt2 ; No, try next one jsr sdat ; Yes, send a data packet jmp sswt1 ; Go to the top of the loop sswt2: cmp #'F ; Do we want to send-file-header? bne sswt3 ; No, continue jsr sfil ; Yes, send a file header packet jmp sswt1 ; Return to top of loop sswt3: cmp #'Z ; Are we due for an Eof packet? bne sswt4 ; Nope, try next state jsr seof ; Yes, do it jmp sswt1 ; Return to top of loop sswt4: cmp #'S ; Must we send an init packet bne sswt5 ; No, continue jsr sini ; Yes, go do it jmp sswt1 ; And continue sswt5: cmp #'B ; Time to break the connection? bne sswt6 ; No, try next state jsr sbrk ; Yes, go send a break packet jmp sswt1 ; Continue from top of loop sswt6: cmp #'C ; Is the entire transfer complete? bne sswt7 ; No, something is wrong, go abort lda #true ; Return true rts ; ... sswt7: lda #false ; Return false rts ; ... sdat: lda numtry ; Fetch the number for tries for current packet inc numtry ; Add one to it cmp maxtry ; Is it more than the maximum allowed? beq sdat1 ; No, not yet bcs sdat1a ; If it is, go abort sdat1: jmp sdat1b ; Continue sdat1a: lda #'A ; Load the 'abort' code sta state ; Stuff that in as current state lda #false ; Enter false return code rts ; and return sdat1b: lda #'D ; Packet type will be 'Send-data' sta ptype ; ... lda n ; Get packet sequence number sta pnum ; Store that parameter to Spak lda size ; This is the size of the data in the packet sta pdlen ; Store that where it belongs jsr spak ; Go send the packet sdat2: jsr rpak ; Try to get an ack sta rstat ; First, save the return status lda ptype ; Now get the packet type received cmp #'N ; Was it a NAK? bne sdat2a ; No, try for an ACK jmp sdatcn ; Go handle the nak case sdat2a: cmp #'Y ; Did we get an ACK? bne sdat2b ; No, try checking the return status jmp sdatca ; Yes, handle the ack sdat2b: lda rstat ; Fetch the return status cmp #false ; Failure return? beq sdat2c ; Yes, just return with current state jsr prcerp ; 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 ; Clear sta eofinp ; End of input flag lda #fcb1\ ; Get the pointer to the fcb sta kerfcb ; and store it where the close routine lda #fcb1^ ; can find it sta kerfcb ; ... lda #$00 ; Make CLOSEF see there are no errors jsr closef ; 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: 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 cmp #$20 ; ? beq sfil1d ;[DD] 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 ; 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 ; Check for error packet and process it lda #'A ; No, abort the whole thing sta state ; Set the state to that lda #false ; Get false return status seof2c: rts ; Return seofcn: dec pnum ; Decrement the received packet sequence number lda n ; Get the expected sequence number cmp pnum ; If it's the same as pnum-1, it is like an ack bne seofn1 ; It isn't, continue handling the nak jmp seofa2 ; Switch to an ack but bypass sequence check seofa1: seofn1: lda #false ; Load failure return status rts ; and return seofca: lda n ; Check sequence number expected against cmp pnum ; the number we got. bne seofa1 ; If not identical, fail and return curr. state seofa2: lda #$00 ; Clear the number of tries for current packet sta numtry ; ... jsr incn ; Up the packet sequence number jsr getnfl ; Call the routine to get the next file cmp #eof ; If it didn't find any more beq seofrb ; then return state 'B' ('Send-Eot') jmp seofrf ; Otherwise, return 'F' ('Send-file') seofrb: lda #'B ; Load Eot state code sta state ; Store that as the current state lda #true ; Give a success on the return rts ; ... seofrf: lda #'F ; Load File-header state code sta state ; Make that the current system state lda #true ; Make success the return status rts ; and return sini: lda #pdbuf\ ; Load the pointer to the sta kerbf1 ; packet buffer into its lda #pdbuf^ ; place on page zero sta kerbf1+1 ; ... jsr spar ; Go fill in the send init parms lda numtry ; If numtry > maxtry cmp maxtry ; ... beq sini1 ; ... bcs sini1a ; then we are in bad shape, go fail sini1: jmp sini1b ; Otherwise, we just continue sini1a: lda #'A ; Set state to 'abort' sta state ; ... lda #errmrc ; Fetch the error index sta errcod ; and store it as the error code lda #$00 ; Set return status (AC) to fail rts ; Return sini1b: inc numtry ; Increment the number of tries for this packet lda #'S ; Packet type is 'Send-init' sta ptype ; Store that ; lda ebqmod ; Do we want 8-bit quoting? ; cmp #on ; ... ; beq sini1c ; If so, data length is 7 ; lda #$06 ; Else it is 6 ; jmp sini1d ; ... sini1c: lda #$07 ; The length of data in a send-init is always 7 sini1d: sta pdlen ; Store that parameter lda n ; Get the packet number sta pnum ; Store that in its common area jsr flshin ;[25] Flush input buffer 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 ; 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 ; ... cmp #'N ;[30] bne siniy3 ;[30] Yes! Leave it alone lda #off ;[30] No .. Shut it off sta ebqmod ;[30] ... 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 ; Check for error packet and process it lda #'A ; No, set up the 'abort' code sta state ; as the system state lda #false ; load the false return status sbrk2c: rts ; and return sbrkcn: dec pnum ; Decrement the received packet number once lda n ; Get the expected sequence number cmp pnum ; If =pnum-1 then this nak is like an ack bne sbrkn1 ; No, this was no the case jmp sbrka2 ; Yes! Go do the ack, but skip sequence check sbrka1: sbrkn1: lda #false ; Load failure return code rts ; and go back sbrkca: lda n ; Get the expected packet sequence number cmp pnum ; Did we get what we expected? bne sbrka1 ; No, return failure with current state sbrka2: lda #$00 ; Yes, clear number of tries for this packet sta numtry ; ... jsr incn ; Up the packet sequence number lda #'C ; The transfer is now complete, reflect this sta state ; in the system state lda #true ; Return success! rts .SBTTL Setcom routine ; ; This routine sets Kermit-65 parameters. ; ; Input: Parameters from command line ; ; Output: NONE ; ; Registers destroyed: A,X,Y ; setcom: lda #setcmd\ ; Load the address of the keyword table sta cminf1 ; lda #setcmd^ ; sta cminf1+1 ; ldy #$00 ; No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #setcmb\ ; Get the address of jump table sta jtaddr ; lda #setcmb^ ; sta jtaddr+1 ; txa ; Offset to AC jmp jmpind ;[DD] Jump 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 stccr ;[DD] Set rs232 registers jmp stpari ; Set the parity for communication jmp stbaud ;[17] Set the baud rate for communication jmp stwrd ;[17] Set the word length for communication jmp stflow ;[24] Set flow control for communication jmp stscre ;[37] Set the screen size jmp stc1 ; set background color jmp stc2 ; set bright color jmp stc3 ; set foreground color jmp stc4 ; set alternate color jmp stc5 ; set border color stesc: ldx #$10 ; Base should be hex ldy #$00 ; No special flags needed lda #cmnum ; Parse for integer jsr comnd ; Go! jmp kermt4 ; Number is bad stx ksavex ; Hold the number across the next call sty ksavey ; ... lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed lda ksavey ; 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 ; Get L.O. byte cmp #$7f ; It shouldn't be bigger than this bmi stesc2 ; If it's less, it is ok jmp kermt4 ; Tell the user it is bad stesc2: sta escp ; Stuff it jmp kermit stibm: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx ibmmod ; Store value in the mode switch location stx lecho ; Also set local echo accordingly ldy #nparit ; Get ready to set the parity parameter lda #fbebit ;[17] Get ready to set the word-size parameter cpx #on ; Setting ibm mode on? bne stibm1 ; Nope so set parity none/word-size eight-bit ldy #mparit ; Set mark parity lda #fbsbit ;[17] Set up for seven bit word size ldx #off ;[38] Turn off flow-control stx flowmo ;[38] ... stibm1: sty parity ; Store the value sta wrdsiz ;[17] ... lda #cmcfm ;[17] Parse for confirm jsr comnd ;[17] Do it jmp kermt3 ;[17] Not confirmed, tell the user that jsr dopari ;[17] Really set the parity jsr dowrd ;[17] Really set the word size jmp kermit ; stle: jsr prson ; Try parsing an 'on' or 'off' jmp kermt2 ; Bad keyword stx lecho ; Store value in the mode switch location lda #cmcfm ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit strc: lda #$00 ; Set srind for receive parms sta srind ; ... lda #stscmd\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #stscmd^ ; sta cminf1+1 ; ldy #$00 ; No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #stcct\ ; Get addr. of jump table sta jtaddr ; lda #stcct^ ; ... sta jtaddr+1 ; ... txa ; Offset to AC jmp jmpind ;[DD] Jump 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 ; No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error lda #stcct\ ; Get addr. of jump table sta jtaddr ; lda #stcct^ ; sta jtaddr+1 ; txa ; offset to AC jmp jmpind ;[DD] Jump 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: lda #termemu\ ; parse for terminal emulation type sta cminf1 lda #termemu^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error 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: ldx #debkey\ ; Load the address of the keyword table ldy #debkey^ stx cminf1 ; Save it for the keyword routine sty cminf1+1 ldy #$00 ; No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error stx debug ; Stuff returned value into debug switch lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jmp kermit stebq: ldx #$10 ; Base for ASCII value ldy #$00 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; Parse for confirm jsr comnd ; Do it jmp kermt3 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; No special flags needed lda #cmnum ; Code for integer number jsr comnd ; Go do it jmp kermt4 ; The number was bad tya ; 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 ; 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 ; lda #ftcmd^ ; sta cminf1+1 ; lda #ftcdef\ ; Load default address sta cmdptr ; ... lda #ftcdef^ ; ... sta cmdptr+1 ; ... ldy #cmfdff ; 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 ; lda #fbskey^ ; sta cminf1+1 ; ldy #$00 ; 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 stccr: ldx #$10 ;[DD] Base should be hex ldy #$00 ; No special flags needed lda #cmnum ;[DD] Parse for integer jsr comnd ;[DD] Go do it jmp kermt4 ;[DD] The number was bad stccr1: stx ksavex ; Store it while we confirm sty ksavey ; ... lda #cmcfm ; Set up to parse confirm jsr comnd ; Do it jmp kermt3 ; Wasn't properly confirmed lda ksavex ; Fetch back L.O. byte sta cntrl ;[DD][EL] To rs232 reg 0 lda ksavey ;[18] Fetch back H.O. byte sta cmmnd ;[DD] To rs232 reg 1 jmp kermit ;[DD] stpari: lda #parkey\ ; Load the address of the keyword table sta cminf1 ; Save it for the keyword routine lda #parkey^ ; ... sta cminf1+1 ; ... ldy #$00 ; No special flags needed lda #cmkey ; Comnd code for parse keyword jsr comnd ; Go get it jmp kermt2 ; Give an error stx parity ; Stuff returned value into parity lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that jsr dopari ;[17] Now really set the parity jmp kermit ; dopari: lda cmmnd ;[17] Get the command register and #$1f ;[17] sta cmmnd ;[17] Store it back ldx parity ;[17] Get the index lda parval,x ;[17] and the parity value from the table ora cmmnd ;[17] sta cmmnd ;[17] Store it back rts ;[17] Return stbaud: lda #bdkey\ ;[17] Load the address of the keyword table sta cminf1 ;[17] Save it for the keyword routine lda #bdkey^ ;[17] ... sta cminf1+1 ;[17] ... ldy #$00 ;[17] No special flags needed lda #cmkey ;[17] Parse for a keyword jsr comnd ;[17] Do it jmp kermt2 ;[17] Give an error stx baud ;[17] Stuff the returned value lda #cmcfm ;[17] Set up for a confirm jsr comnd ;[17] Do it jmp kermt3 ;[17] Not confirmed jsr dobad ;[17] Really set the baud rate jmp kermit ;[17] dobad: lda baud asl a eor fast and #$fe eor fast asl a tax lda bdval,x sta optbdl lda bdval+1,x sta optbdh rts ;[17] stwrd: lda #fbskey\ ;[17] Load the address of the keyword table sta cminf1 ;[17] Save it for the keyword routine lda #fbskey^ ;[17] ... sta cminf1+1 ;[17] ... ldy #$00 ;[17] No special flags needed lda #cmkey ;[17] Comnd code for parse keyword jsr comnd ;[17] Go get it jmp kermt2 ;[17] Give an error stx wrdsiz ;[17] Stuff the returned value into wrd len lda #cmcfm ;[17] Parse for a confirm jsr comnd ;[17] Do it jmp kermt3 ;[17] Not confirmed, tell the user that jsr dowrd ;[17] Really set the word size jmp kermit ;[17] ... dowrd: lda cntrl ;[17] Get the control register and #$8f ;[17] sta cntrl ;[17] Store it back lda wrdsiz ;[17] Get the word size cmp #fbsbit ;[17] Is it seven-bit ? bne dwrd1 ;[17] No, we have the value for eight-bit lda #$20 ;[17] Yes, get value for seven-bit word size dwrd1: ora cntrl ;[17] Set it sta cntrl ;[17] Store it rts ;[17] Return stflow: jsr prson ;[24] Try parsing an 'on' or 'off' jmp kermt2 ;[24] Bad keyword stx flowmo ;[24] Store it lda #cmcfm ;[24] Parse for confirm jsr comnd ;[24] Do it jmp kermt3 ;[24] Not confirmed, tell the user that jmp kermit ;[24] stscre: lda #scrkey\ ;[37] Get the address of the screen mode table sta cminf1 ;[37] ... lda #scrkey^ ;[37] ... sta cminf1+1 ;[37] ... ldy #$00 ;[37] No special flags needed lda #cmkey ;[37] Comnd code for parse keyword jsr comnd ;[37] Go get it jmp kermt2 ;[37] Give an error stx kwrk01 ;[37] Stuff the returned value into kwrk01 lda #cmcfm ;[37] Parse for a confirm jsr comnd ;[37] Do it jmp kermt3 ;[37] Not confirmed, tell the user that lda kwrk01 ;[37] Are we switching to 80 columns? get: pha ; save the id of the screen driver we want jsr scrext ; exit the old screen driver pla pha ; keep the id of the screen driver on the stack jsr scrtst ; does this screen driver exist? pla ; restore desired screen type bcc get1 lda #$01 ; if it does not exist, use 80-columns instead get1: sta scrtype jsr scrent ; enter the screen driver jsr dobad ; reset baud kludge value based on fast mode jmp kermit ; all done stc1: lda #colors\ ; parse for color type sta cminf1 lda #colors^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error stx kwrk01 ; Stuff the returned value into kwrk01 lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that lda kwrk01 ; What color are we switching to? sta backclr ; set the background color jsr scrset jmp kermit stc2: lda #colors\ ; parse for color type sta cminf1 lda #colors^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error stx kwrk01 ; Stuff the returned value into kwrk01 lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that lda kwrk01 ; What color are we switching to? sta britclr ; set the highlighting color jsr scrset jmp kermit stc3: lda #colors\ ; parse for color type sta cminf1 lda #colors^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error stx kwrk01 ; Stuff the returned value into kwrk01 lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that lda kwrk01 ; What color are we switching to? sta foreclr ; set the foreground color jsr scrset jmp kermit stc4: lda #colors\ ; parse for color type sta cminf1 lda #colors^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error stx kwrk01 ; Stuff the returned value into kwrk01 lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that lda kwrk01 ; What color are we switching to? sta altclr ; set the alternate color jsr scrset jmp kermit stc5: lda #colors\ ; parse for color type sta cminf1 lda #colors^ sta cminf1+1 ldy #$00 ; no special flags needed lda #cmkey ; parse for a keyword jsr comnd ; do it jmp kermt2 ; go tell the user about the error stx kwrk01 ; Stuff the returned value into kwrk01 lda #cmcfm ; Parse for a confirm jsr comnd ; Do it jmp kermt3 ; Not confirmed, tell the user that lda kwrk01 ; What color are we switching to? sta bordclr ; set the border color jsr scrset jmp kermit .SBTTL Show routine ; ; This routine shows any of the operational parameters that ; can be altered with the set command. ; ; Input: Parameters from command line ; ; Output: Display parameter values on screen ; ; Registers destroyed: A,X,Y ; show: lda #shocmd\ ; Load address of keyword table sta cminf1 ; lda #shocmd^ ; sta cminf1+1 ; lda #shodef\ ; Fetch default address sta cmdptr ; ... lda #shodef^ ; ... sta cmdptr+1 ; ... ldy #cmfdff ; 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\ ; Get addr. of jump table sta jtaddr ; lda #shocmb^ ; sta jtaddr+1 ; txa ; Offset to AC jmp jmpind ;[DD] Jump 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 ;[DD] Parse for confirm jsr shccr ;[DD] Show rs232 regs. jmp kermit ;[DD] Go to top of main loop jsr prcfm ; Parse for confirm jsr shpari ; Show Parity jmp kermit ; Go to top of main loop jsr prcfm ;[17] Parse for a confirm jsr shbad ;[17] Show baud jmp kermit ;[17] Go to top of main loop jsr prcfm ;[17] Parse for a confirm jsr shwrd ;[17] Show word size jmp kermit ;[17] Go to top of main loop jsr prcfm ;[24] Parse for a confirm jsr shflow ;[24] Show flow-control jmp kermit ;[24] Go to top of main loop shall: jsr shdb ; Show debugging mode switch jsr shvt ; Show vt52-emulation mode switch jsr shibm ; Show ibm-mode switch jsr shle ; Show local-echo switch jsr shbad ;[17] Show baud rate jsr shpari ; Show parity setting jsr shwrd ;[17] Show word length jsr shflow ;[24] Show flow-control 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 shccr ;[DD] Show rs232 regs. jsr shrcal ; Show receive parameters jsr shsnal ; Show send parameters rts ; Return shdb: ldx #shin00\ ; Get address of message for this item ldy #shin00^ jsr prstr ; Print that message lda debug ; Get the switch value cmp #$03 ; Is it >= 3? bmi shdb1 ; If not just get the string and print it lda #$00 ; This is index for debug mode we want shdb1: tax ; Hold this index lda #kerdms\ ; Get the address of the device strings sta kermbs ; And stuff it here for genmad lda #kerdms^ ; ... sta kermbs+1 ; ... lda #kerdsz ; 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 shvt: ldx #shin01\ ; Get address of message for this item ldy #shin01^ jsr prstr ; Print that message lda #kertms\ ; get address of messages for this item sta kermbs lda #kertms^ sta kermbs+1 lda #keremu ; length of the messages pha lda vtmod ; which message pha jsr genmad ; calculate address of selected message jsr prstr ; print selected message jsr prcrlf ; and a carriage return / line feed rts ; all done 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 shccr: ldx #shin18\ ;[DD][EL] Print rs232 registers cntrl,cmmnd ldy #shin18^ ;[DD] jsr prstr ;[DD] lda cmmnd ;[DD] Print rs232 reg 1 jsr prbyte ;[DD] lda cntrl ;[DD] Print rs232 reg 0 jsr prbyte ;[DD] jsr prcrlf ;[DD] and a crlf rts ;[DD] shsn: lda #$01 ; Set up index to be used later sta srind lda #stscmd\ ; Get the set option table address sta cminf1 ; lda #stscmd^ ; sta cminf1+1 ; ldy #$00 ; 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 #shcmb\ ; Get addr. of jump table sta jtaddr ; lda #shcmb^ ; sta jtaddr+1 ; lda kwrk01 ; Get offset back asl a ; Double it jmp jmpind ;[DD] Jump ; shrc: lda #$00 ; Set up index to be used later sta srind lda #stscmd\ ; Get the set option table address sta cminf1 ; lda #stscmd^ ; sta cminf1+1 ; ldy #$00 ; 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 #shcmb\ ; Get addr. ofl jump table sta jtaddr ; lda #shcmb^ ; sta jtaddr+1 ; lda kwrk01 ; Get offset back asl a ; Double it jmp jmpind ;[DD] Jump shcmb: jsr shpdc ; Show send/rec padding character jmp kermit ; Go back jsr shpad ; Show amount of padding for send/rec jmp kermit ; Go back jsr shebq ; Show send/rec eight-bit-quoting character jmp kermit ; Go back jsr sheol ; Show send/rec end-of-line character jmp kermit ; Go back jsr shpl ; Show send/rec packet length jmp kermit ; Go back jsr shqc ; Show send/rec quote character jmp kermit ; Go back jsr shtim ; Show send/rec timeout jmp kermit ; Go back shpdc: ldx #shin11\ ; Get address of 'pad char' string ldy #shin11^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda padch,x ; If index is 1, this gets spadch jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shpad: ldx #shin12\ ; Get address of 'padding amount' string ldy #shin12^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda pad,x ; If index is 1, this gets spad jsr prbyte ; Print the amount of padding jsr prcrlf ; Print a crelf after it rts shebq: ldx #shin08\ ; Get address of 'eight-bit-quote' string ldy #shin08^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda ebq,x ; If index is 1, this gets sebq jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts sheol: ldx #shin09\ ; Get address of 'end-of-line' string ldy #shin09^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda eol,x ; If index is 1, this gets seol jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shpl: ldx #shin10\ ; Get address of 'packet length' string ldy #shin10^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda psiz,x ; If index is 1, this gets spsiz jsr prbyte ; Print the packet length jsr prcrlf ; Print a crelf after it rts ; and return shqc: ldx #shin13\ ; Get address of 'quote-char' string ldy #shin13^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda quote,x ; If index is 1, this gets squote jsr prchr ; Print the special character jsr prcrlf ; Print a crelf after it rts shtim: ldx #shin14\ ; Get address of 'timeout' string ldy #shin14^ jsr prstr ; Print that ldx srind ; Load index so we print correct parm lda time,x ; If index is 1, this gets stime jsr prbyte ; Print the hex value jsr prcrlf ; Print a crelf after it rts shsnal: lda #$01 ; Set up index for show parms sta srind ; and stuff it here ldx #shin07\ ; Get address of 'send' string ldy #shin07^ ; jsr prstr ; Print it jsr prcrlf ; Print a crelf jsr shpdc ; Show the padding character jsr shpad ; Show amount of padding jsr shebq ; Show eight-bit-quote character jsr sheol ; Show end-of-line character jsr shpl ; Show packet-length jsr shqc ; Show quote character jsr shtim ; Show timeout length rts shrcal: lda #$00 ; Set up index for show parms sta srind ; and stuff it here ldx #shin15\ ; Get address of 'receive' string ldy #shin15^ jsr prstr ; Print it jsr prcrlf ; Print a crelf jsr shpdc ; Show the padding character jsr shpad ; Show amount of padding jsr shebq ; Show eight-bit-quote character jsr sheol ; Show end-of-line character jsr shpl ; Show packet-length jsr shqc ; Show quote character jsr shtim ; Show timeout length rts shmod: ldx #shin16\ ; Get address of 'timeout' string ldy #shin16^ jsr prstr ; Print that lda filmod ; Get the file-type mode cmp #$05 ; 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 ; 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 shpari: ldx #shin20\ ; Get address of 'parity' string ldy #shin20^ ; ... jsr prstr ; Print that lda parity ; Get the parity index cmp #$05 ; Is it >= 5? bmi shpar1 ; If not just get the string and print it lda #$00 ; This is the index to the parity we want shpar1: tax ; Hold this index lda #kerprs\ ; Get address of the parity strings sta kermbs ; And stuff it here for genmad lda #kerprs^ ; ... sta kermbs+1 ; ... lda #kerpsl ; 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 shbad: ldx #shin19\ ;[17] Get the address of the 'baud' string ldy #shin19^ ;[17] ... jsr prstr ;[17] Print it lda baud ;[17] Get the baud rate cmp #$08 ;[17] Is it >= 8 ? bmi shbad1 ;[17] No, just print the string lda #$04 ;[17] Use 300 baud as default shbad1: tax ;[17] Hold the index here lda #kerbds\ ;[17] Get the address of sta kermbs ;[17] the baud rate strings lda #kerbds^ ;[17] ... sta kermbs+1 ;[17] ... lda #kerbsl ;[17] Get the length of the baud rate strings pha ;[17] Push that txa ;[17] pha ;[17] jsr genmad ;[17] jsr prstr ;[17] jsr prcrlf ;[17] rts ;[17] shwrd: ldx #shin21\ ;[17] Get the address of the 'wrod-size' ldy #shin21^ ;[17] message jsr prstr ;[17] Print that lda wrdsiz ;[17] Get the word-size beq shwrde ;[17] ldx #shsbit\ ;[17] Get address of 'SEVEN-BIT' string ldy #shsbit^ ;[17] ... jsr prstr ;[17] Print that jsr prcrlf ;[17] then a crelf rts ;[17] and return shwrde: ldx #shebit\ ;[17] Get address of 'EIGHT-BIT' string ldy #shebit^ ;[17] ... jsr prstr ;[17] Print that jsr prcrlf ;[17] and a crelf rts ;[17] and return shflow: ldx #shin22\ ;[24] ldy #shin22^ ;[24] jsr prstr ;[24] lda flowmo ;[24] jmp pron ;[24] .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 jsr stat01 ;[45] Go Give the status jmp kermit ;[45] and parse for more commands 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^ ; 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 lda errcod ; check and see if there even is an error beq stat04 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 ; Test for 'Error packet received' bit bpl stat02 bvs statpe ; Go process an error packet bpl stat02 ldx #erms0a\ ; this is a dos error. ldy #erms0a^ jsr prstr ldx #dskers\ ldy #dskers^ jsr prstr jsr prcrlf rts stat02: lda #kerems ; Get the error message size pha ; Push it lda errcod ; Get the error message offset in table pha ; Push that parameter lda #erms0a\ ; Use 'dskers' as the base address sta kermbs ; ... lda #erms0a^ ; ... 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 ; jmp kermit ; Start at the top rts ;[45] Return to the caller statpe: ldx #errrkm\ ; L.O. byte address of remote kermit error ldy #errrkm^ ; H.O. byte address... jsr prstr ; Print the text from the error packet jsr prcrlf ; Print an extra crelf ; jmp kermit ; Start at the top again stat04: rts ;[45] Return to the caller .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: lda fast ; do this in fast mode if we can sta $d030 jsr scrclr ; clear the screen ldx #snin01\ ; Give the user info on what we are doing ldy #snin01^ ; ... jsr prstr ; Print the information ldx #false ;[49] jsr timset ;[49] lda tpak+1 ; Get the total packets count jsr prbyte ; and print that lda tpak ; ... jsr prbyte ; ... jsr prcrlf ; Output a crelf lda #$00 ; Clear packet data index sta pdtind ; ... spaknd: lda spadch ; Get the padding character ldx #$00 ; Init counter spakpd: cpx spad ; Are we done padding? bcs spakst ; Yes, start sending packet inx ; No, up the index and count by one jsr 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 ; 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 ; 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 ; 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 ; 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 ; and send it lda seol ; Fetch the eol character jsr putplc ; Send that as the last byte of the packet lda pdtind ; Set the end of buffer pointer sta pdtend ; ... lda #$00 ; Set index to zero sta pdtind ; ... lda debug ; Is the debug option turned on? cmp #off ; ... beq spaksp ; Nope, go stuff packet at other kermit lda #$00 ; Option 0 jsr debg ; Do it spaksp: lda #$00 ; Zero the index sta pdtind ; ... spakdl: ldx pdtind ; Are we done? cpx pdtend ; ... bpl spakcd ; Yes, go call debug again lda plnbuf,x ; Get the byte to send jsr putrs ; Ship it out inc pdtind ; Increment the index once jmp spakdl ; Go to top of data send loop spakcd: lda debug ; Get debug switch cmp #off ; Do we have to do it? beq spakcr ; Nope, return lda #$01 ; Option 1 jsr debg ; Do the debug stuff spakcr: lda #$fc ; leave fast mode sta $d030 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: lda fast ; put us in fast mode, if possible sta $d030 jsr gobble ; Gobble a line up from the port jmp rpkfls ; Must have gotten a keyboard interupt, fail lda ibmmod ; Is ibm-mode on? cmp #on ; ... bne rpakst ; If not, start working on the packet rpakc0: jsr getc ; Any characters yet? jmp rpakst ; Got one from the keyboard lda char ;[31] cmp #xon ; Is it an XON? bne rpakc0 ; Nope, try again rpakst: jsr scrclr ; clear the screen ldx #rcin01\ ; Give the user info on what we are doing ldy #rcin01^ ; ... jsr prstr ; Print the information ldx #true ;[49] jsr timset ;[49] Set the timeout length lda tpak+1 ; Get the total packets count jsr prbyte ; and print that lda tpak ; ... jsr prbyte ; ... jsr prcrlf ; Output a crelf lda debug ; Is debugging on? cmp #off ; ... beq rpaknd ; Nope, no debugging, continue lda #$02 ; Option 2 jsr debg ; Do debug stuff rpaknd: lda #$00 ; Clear the sta chksum ; chksum sta datind ; index into packet buffer sta kerchr ; and the current character input rpakfs: jsr getplc ; Get a char, find SOH jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Save it and #$7f ; Shut off H.O. bit cmp #soh ; Is it an SOH character? bne rpakfs ; Nope, try again lda #$01 ; Set up the switch for receive packet sta fld ; ... rpklp1: lda fld ; Get switch cmp #$06 ; Compare for <= 5 bmi rpklp2 ; If it still is, continue jmp rpkchk ; Otherwise, do the chksum calcs rpklp2: cmp #$05 ; Check fld bne rpkif1 ; If it is not 5, go check for SOH lda datind ; Fetch the data index cmp #$00 ; If the data index is not null bne rpkif1 ; do the same thing jmp rpkif2 ; Go process the character rpkif1: jsr getplc ; Get a char, find SOH jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Save that here and #$7f ; Make sure H.O. bit is off cmp #soh ; Was it another SOH? bne rpkif2 ; If not, we don't have to resynch lda #$00 ; Yes, resynch sta fld ; Reset the switch rpkif2: lda fld ; Get the field switch cmp #$04 ; Is it < = 3? bpl rpkswt ; No, go check the different cases now lda kerchr ; Yes, it was, get the character clc ; and add it into the chksum adc chksum ; ... sta chksum ; ... rpkswt: lda fld ; Now check the different cases of fld cmp #$00 ; Case 0? bne rpkc1 ; Nope, try next one lda #$00 ; Yes, zero the chksum sta chksum ; ... jmp rpkef ; and restart the loop rpkc1: cmp #$01 ; Is it case 1? bne rpkc2 ; No, continue checking lda kerchr ; Yes, get the length of packet sec ; ... sbc #sp ; Unchar it sec ; ... sbc #$03 ; Adjust it down to data length sta pdlen ; That is the packet data length, put it there jmp rpkef ; Continue on to next item rpkc2: cmp #$02 ; Case 2 (packet number)? bne rpkc3 ; If not, try case 3 lda kerchr ; Fetch the character sec ; ... sbc #sp ; Take it down to what it really is sta pnum ; That is the packet number, save it jmp rpkef ; On to the next packet item rpkc3: cmp #$03 ; Is it case 3 (packet type)? bne rpkc4 ; If not, try next one lda kerchr ; Get the character and sta ptype ; stuff it as is into the packet type jmp rpkef ; Go on to next item rpkc4: cmp #$04 ; Is it case 4??? bne rpkc5 ; No, try last case ldy #$00 ; Set up the data index sty datind ; ... rpkchl: ldy datind ; Make sure datind is in Y cpy pdlen ; Compare to the packet data length, done? bmi rpkif3 ; Not yet, process the character as data jmp rpkef ; Yes, go on to last field (chksum) rpkif3: cpy #$00 ; Is this the first time through the data loop? beq rpkacc ; If so, SOH has been checked, skip it jsr getplc ; Get a char, find SOH jmp rpkfls ; Got a keyboard interupt instead sta kerchr ; Store it here and #$7f ; Shut H.O. bit cmp #soh ; Is it an SOH again? bne rpkacc ; No, go accumulate chksum lda #$ff ; Yup, SOH, go resynch packet input once again sta fld ; ... jmp rpkef ; ... rpkacc: lda kerchr ; Get the character clc ; ... adc chksum ; Add it to the chksum sta chksum ; and save new chksum lda ptype ; GROSS AND UGLY KLUDGE FOR CKERMIT and #$7f ; ignore any data in an ack packet. cmp #'Y ; Ckermit puts funny things in an F ack. bne ckrmt1 ; These bytes overwrite our next packet. lda state ; ... but not while expecting an init cmp #'R ; .... while receiving a file bne ckrmt2 ckrmt1: lda kerchr ; Get the character again ldy datind ; Get our current data index sta (kerbf1),y ; Stuff the current character into the buffer ckrmt2: 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 ; Zero the index for debug mode sta pdtind ; ... lda debug ; Is debug switch on? cmp #off ; ... beq rpkfnd ; Return doing no debug stuff lda #$03 ; Option 3 jsr debg ; Output debug information rpkfnd: lda pdlen ; Get the packet data length clc ; and add it into the adc rtot ; 'total characters received' counter sta rtot ; ... lda rtot+1 ; ... adc #$00 ; ... sta rtot+1 ; ... lda #$fc ; exit fast mode sta $d030 lda #false ; Set up failure return sta ptype ;[DD] Set packet type false rts ; and go back rpkret: lda #$00 ; Zero the index for debug mode sta pdtind ; ... lda debug ; Check debug switch cmp #off ; Is it on? beq rpkrnd ; No, return with no debug lda #$04 ; Yes, use option 4 jsr debg ; Print out the debug info rpkrnd: lda pdlen ; Get the packet data length clc ; and add it into the adc rtot ; 'total characters received' counter sta rtot ; ... lda rtot+1 ; ... adc #$00 ; ... sta rtot+1 ; ... lda #$fc ; turn off fast mode sta $d030 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 Timset and Timout ; ; Routines to set and check for Kermit timeouts ; ; ; Timset - Set the timeout for receive or send ; ; Input: X - True for receive, false for send ; ; Registers Detsroyed: A ; timset: lda clock+1 ;[49] Get the current seconds clc ;[49] cpx #true ;[49] Are we receiving? bne timsst ;[49] No adc rtime ;[49] Add in the receive timeout sta ttime+1 ;[49] and store it adc #$00 ;[49] Account for the carry if any sta ttime ;[49] and store it rts ;[49] Return timsst: adc stime ;[49] Add in the send timeout sta ttime+1 ;[49] and store it adc #$00 ;[49] Account for the carry if any sta ttime ;[49] and store it rts ;[49] Return ; ; Timout - Check to see if we have exceeded the timeout limit. ; ; Input: Ttim - time to timeout at ; Clock+1 - current time ; ; Registers Destroyed: A ; timout: lda clock ;[49] Get the current minutes cmp ttime ;[49] Compare it to the old minutes bmi timskp ;[49] Still less lda clock+1 ;[49] Get the current seconds cmp ttime+1 ;[49] Compare it to the old seconds bmi timskp ;[49] Still less timret: rts ;[49] We have timed out, return timskp: jmp rskp ;[49] No timeout, return with a skip .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 ; Get the debug switch cmp #terse ; Is it terse bne debgvr ; Nope, must be Verbose mode jmp debgtr ; Yes, to terse debug output debgvr: lda state ; Check the current state cmp #$00 ; If we just started this thing beq debgrf ; then we don't need debug output yet cmp #'C ; If the transmission state is 'complete' beq debgrf ; we don't need debug output either lda #kerrts\ ; Get base address of the routine name and sta kermbs ; action table so that we can calculate lda #kerrts^ ; ... sta kermbs+1 ; ... 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 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\ ; Get address of message text ldy #debms3^ ; ... jsr prstr ; Print it inc pdtind ; Pass the SOH ldx pdtind ; Get the index lda plnbuf,x ; Get the data length sec ; Uncharacter this value sbc #$20 ; ... jsr prbyte ; Print the hex value jsr prcrlf ; New line ldx #debms2\ ; Get address of message text ldy #debms2^ ; ... jsr prstr ; Print it inc pdtind ; Next character is packet number ldx pdtind ; ... lda plnbuf,x ; Load it sec ; Uncharacter this value sbc #$20 ; ... jsr prbyte ; Print the hex value jsr prcrlf ; New line inc pdtind ; Bypass the packet type ldy #$ff ; Start counter at -1 sty kwrk02 ; Store it here debprc: inc kwrk02 ; Increment the counter ldy kwrk02 ; Get counter cpy pdlen ; Are we done printing the packet data? bpl debdon ; If so, go finish up inc pdtind ; Point to next character ldx pdtind ; Fetch the index lda plnbuf,x ; Get next byte from packet jsr prchr ; Go output special character lda #space ; 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 ; Get next byte, this is the checksum ldx pdtind ; ... lda plnbuf,x ; ... sec ; Uncharacter this value sbc #$20 ; ... 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 ; Look at Option cmp #$00 ; Sending? beq debgsn ; Yes, output 'SENDING: ' cmp #$03 ; Failed receive? beq debgrc ; Yes, output 'RECEIVED: ' cmp #$04 ; Receive? beq debgrc ; Yes, output 'RECEIVED: ' rts ; Neither, just return debgsn: ldx #sstrng\ ; Get ready to print the string ldy #sstrng^ ; ... jsr prstr ; Do it! jsr prcrlf ; Print a crelf jmp debgdp ; Go dump the packet debgrc: ldx #rstrng\ ; Get ready to print the string ldy #rstrng^ ; ... jsr prstr ; Do it! jsr prcrlf ; Print a crelf debgdp: ldx pdtind ; Get index cpx pdtend ; Are we done? bpl debgfn ; Yes, return lda plnbuf,x ; Get the character jsr prchr ; Print it lda #space ; Print a space jsr cout ; ... inc pdtind ; Advance the index jmp debgdp ; Do next character debgfn: jsr prcrlf ; Print a crelf then... rts ; Return .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: sta flsrw ;[DD] Save mode w or r ; openm #15,#8,#15,fcmd,#2 ;[DD] Open error channel lda #15 ; [53] ldx #8 ldy #15 jsr setlfs ldx #fcmd\ ldy #fcmd^ lda #2 jsr setnam jsr open lda flsrw ;[23] Get the file mode cmp #fncwrt ;[23] Are we opening for output? bne opnnlu ;[23] No, no lookup needed lda #on ;[23] Yes, set the 'first mod' switch sta dosffm ;[23] in case we have to alter the filename lda filwar ;[23] Get the file warning switch cmp #on ;[23] Is it on? bne opnnlu ;[23] If not, don't do the lookup opnlu: jsr lookup ;[23] Do the lookup jmp opnnlu ;[23] Suceeded, open the file lda dosffm ;[23] Is this the first time through? cmp #on ;[23] ... bne opnalt ;[23] If not, continue ldx #erms1a\ ;[23] Otherwise, print an error message since ldy #erms1a^ ;[23] the file already exists jsr prstr ;[23] ... opnalt: jsr alterf ;[23] No good, go alter the filename jmp opnlu ;[23] Try the lookup again opnnlu: jsr bldprm ;[23] Build the filename again ; openm #8,#8,#8,primfn,len ;[DD] Open file without lookup lda #8 ; [53] ldx #8 ldy #8 jsr setlfs ldx #primfn\ ldy #primfn^ lda len jsr setnam jsr open opnfi1: jsr rddsk ;[DD] Get disk status cmp #00 ;[DD] Is it 0? bne opfail ;[DD] If not, error sta eodind ;[DD] Clear end of dat flag opnex: lda #true ;[DD] The open worked, return true rts ;[DD] ... opfail: jmp fatal ;[DD] Failed, go handle that ; rts ;[DD] ... ; ; Lookup - searches for a filename in a directory. It is used to ; support file warning during the opening of a file. ; lookup: lda #fncrea ;[23] Get an 'R sta flsrw ;[23] Store it in the file mode switch jsr locent ;[23] Go try to locate that file jmp locfnf ;[23] File not found? We are in good shape lda #errfae ;[23] Store the error code sta errcod ;[23] ... jmp rskp ;[23] Return with skip, have to alter filename locfnf: lda #fncwrt ;[23] Get a 'W sta flsrw ;[23] Store that rts ;[23] Return without a skip ; ; Alterf - changes a filename in the filename buffer to make it unique. ; It accomplishes this in the following manner. ; ; 1) First time through, it finds the last significant character ; in the filename and appends a '.0' to it. ; ; 2) Each succeeding time, it will increment the trailing integer ; that it inserted the first time through. ; alterf: lda dosffm ;[23] Get the 'first mod' flag cmp #on ;[23] Is it on? beq altfm ;[23] If it is, do an initial modification jmp altsm ;[23] Otherwise, just increment the version altfm: lda #off ;[23] Shut the 'first mod' flag off sta dosffm ;[23] ... ldy #mxfnl-1 ;[23] Stuff the maximum filename length in y altgnc: lda fcb1,y ;[23] Get the character from the buffer cmp #space ;[23] Is it a space? bne altco ;[23] If it is, try the character before it dey ;[23] Down the index once tya cmp #$00 bpl altgnc ;[23] Get the next character ldy #$00 ;[23] No filename, so user 0 as the index altco: sty dosfni ;[23] Save the filename index iny ;[23] Increment it twice iny ;[23] ... cpy #mxfnl ;[23] Does this exceed the filename length? bpl altng ;[23] Cannot do the alterations lda #$2e ;[23] Get the dot ldy dosfni ;[23] Get the original index back iny ;[23] Up it once sta fcb1,y ;[23] Store the dot lda #$00 ;[23] Zero the version count sta dosfvn ;[23] ... iny ;[23] Up the index again sty dosfni ;[23] This will be saved for future alterations jsr altstv ;[23] Go store the version in the filename rts ;[23] and return altsm: ldx dosfvn ;[23] Get the file version number inx ;[23] Increment it stx dosfvn ;[23] Save the new version number txa ;[23] Get the version number in the AC cmp #0 ;[23] Is it 0 ? beq altng ;[23] Yes, cannot alter name jsr altstv ;[23] Go store the version rts ;[23] And return altng: lda #$09 ;[23] Store the error code sta errcod ;[23] ... ldx kerosp ;[23] Get the old stack pointer txs ;[23] and restore it jmp kermit ;[23] 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 ;[23] Get the filename index pha ;[23] Save the value lsr a ;[23] Shift out the low order nibble lsr a ;[23] ... lsr a ;[23] ... lsr a ;[23] ... jsr altstf ;[23] Stuff the character pla ;[23] Grab back the original value and #$0f ;[23] Take the low order nibble iny ;[23] Increment the filename index jsr altstf ;[23] Stuff the next character rts ;[23] and return altstf: ora #$30 ;[23] Make the character printable cmp #$3a ;[23] If it is less than '9' bcc altdep ;[23] then go depisit the character adc #$06 ;[23] Put the character in the proper range altdep: sta fcb1,y ;[23] Stuff the character rts ;[23] and return ; ; Locent - Try to find a file ; locent: jsr bldprm ;[23] ; openm #8,#8,#8,primfn,len ;[23] Open file lda #8 ; [53] ldx #8 ldy #8 jsr setlfs ldx #primfn\ ldy #primfn^ lda len jsr setnam jsr open jsr rddsk ;[23] Get disk status cmp #00 ;[23] Is it 0? bne locok ;[23] No, file doesn't exist lda #8 ;[23] Fle exists, close the file jsr close ;[23] ... jmp rskp ;[23] Return with a skip! locok: lda #8 ;[23] File doesn't exist, close the file jsr close ;[23] ... rts ;[23] Return ; ; Bldprm - Build the primary filename ; bldprm: ldx #'P ;[DD] ... lda filmod ;[DD] Get the file-type mode and #$02 ;[DD] If 0 or 1 bne bldpr1 ;[DD] If > 1 P (PRG file) ldx #'S ;[DD] S for 0 or 1 (SEQ file) bldpr1: stx flssp ;[DD] Store it ldy #0 ;[DD] Start index bldpr2: lda fcb1,y ;[DD] Get char from file name beq bldfln ;[DD] End at null cmp #$20 ;[DD] or space beq bldfln ;[DD] ... sta primfn,y ;[DD] Save in filename iny ;[DD] Increment index bne bldpr2 ;[DD] Get more bldfln: lda #', ;[DD] Add comma sta primfn,y ;[DD] Save in filename lda flssp ;[DD] Add S or P iny ;[DD] Increment index sta primfn,y ;[DD] Save in filename iny ;[DD] Increment index lda #', ;[DD] Add comma sta primfn,y ;[DD] Save in filename iny ;[DD] Increment index lda flsrw ;[DD] Get mode W or R sta primfn,y ;[DD] Save in filename iny ;[DD] Increment index bldfl3: sty len ;[DD] Len of file name rts ;[23] Return ; ; Closef - closes the file which was open for transfer. ; closef: lda #8 ;[DD] Close disk file jsr close ;[DD] ... lda #15 ;[DD] Close error channel jsr close ;[DD] ... lda #true ; the close worked, return true rts ; ... ; ; Dirst - Get a disk directory ; dirst: jsr clrbuf ;[40] Clear the dos command buffer lda #drdoll ;[40] Get a '$' sta buff ;[40] lda drunit ;[40] Get the current drive unit no. sta buff+1 ;[40] lda #drcolo ;[40] Get a ':' sta buff+2 ;[40] lda #drstar ;[40] Get a '*' sta buff+3 ;[40] dirprm: jsr dosprs ;[40] Parse for the command ldx len ;[50] bne drnone ;[50] inc len ;[50] drnone: inc len ;[40] inc len ;[40] inc len ;[40] dirsfo: ; openm #8,#8,#0,buff,len ;[40] Get directory lda #8 ; [53] ldx #8 ldy #0 jsr setlfs ldx #buff\ ldy #buff^ lda len jsr setnam jsr open bcs drclos ;[DD] Close if error ldx #$08 ;[DD] Open for input jsr chkin ;[DD] Get 3 bytes jsr chrin ;[DD] jsr chrin ;[DD] drst1: jsr chrin ;[DD] Get byte jsr readst ;[DD] If eof close bne drclos ;[DD] jsr chrin ;[DD] Get 2nd byte beq drclos ;[DD] jsr clrchn ;[DD] Set input to keybd jsr getin ;[DD] Check for space or run/stop cmp #$03 ; if run/stop beq drclos ; then end directory listing cmp #$20 ;[DD] bne drskp ;[DD] If not space skip drloop: jsr getin ;[DD] Loop until beq drloop ;[DD] Any key pressed drskp: ldx #$08 ;[DD] Set input to disk jsr chkin ;[DD] jsr chrin ;[DD] Get a byte pha ;[DD] jsr chrin ;[DD] Get a byte tay ;[DD] pla ;[DD] tax ;[DD] tya ;[DD] jsr prntad ;[DD] [54] Print block count in Decimal lda #$20 ;[DD] jsr scrput ;[DD] Print a space drprnt: jsr chrin ;[DD] Get byte beq dreol ;[DD] If null end of line cmp #18 ; reverse on? bne drpr1 lda #$01 sta reverse jmp drprnt ; do the next character drpr1: jsr scrput ;[DD] Print byte clc ;[37] bcc drprnt ;[37] dreol: jsr scrcr ; print a cr jsr scrlf ; print a linefeed lda #$00 sta reverse ; turn off reverse lda #$00 ;[37] sta rvmask ;[37] beq drst1 ;[DD] Go back for more drclos: jsr clrchn ;[DD] Close channels lda #$08 ;[DD] Close 8 jsr close ;[DD] jmp kermit ;[40] ; ; Doscmd - Send a string to the disk command channel ; doscmd: lda #15 ;[DD] Close command channel jsr close ;[DD] ... jsr clrbuf ;[40] Clear the dos command buffer dosprm: jsr dosprs ;[40] Parse for the command ; openm #15,#8,#15,buff+3,len ;[DD] Send command out lda #15 ; [53] ldx #8 ldy #15 jsr setlfs ldx #buff+3\ ldy #buff+3^ lda len jsr setnam jsr open jsr rddsk ;[DD] Get disk status lda #15 ; in any case, close #15 jsr close jmp kermit ;[40] Go back for more commands ; ; Dosprs - parses a string to be passed to the ; disk drive command channel. ; ; Registeres Destroyed: ; dosprs: jsr clrchn ;[40] Set default I/O channels lda #kerehr\ ;[40] Point to the extra help commands sta cmehpt ;[40] ... lda #kerehr^ ;[40] ... sta cmehpt+1 ;[40] .. ldx #$2f ;[40] Longest length a disk string may be ldy #cmfehf ;[40] Tell Comnd about extra help lda #cmifi ;[40] Load opcode for parsing file jsr comnd ;[40] Call Comnd routine jmp dos1 ;[40] Continue, no string parsed stx kerfrm ;[40] Save the from address (addr[atmbuf]) sty kerfrm+1 ;[40] ... sta kwrk01 ;[40] Save length of string parsed lda #03 ;[40] Get the address of the buffer sta kerto ;[40] ... lda #02 ;[40] ... sta kerto+1 ;[40] ... jsr kercpy ;[40] Copy the string ldy kwrk01 ;[40] Get the length back ; iny ;[40] Increment it by one lda #0 ;[40] Stuff a null at the end sta buff+3,y ;[40] ... ; iny ;[40] sty len ;[40] clc ;[40] bcc dos2 ;[40] dos1: lda #0 ;[40] sta len ;[40] dos2: jsr prcfm ;[40] rts ;[40] ; ; 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: lda addlf ; Get the 'add a lf' flag cmp #on ; Is it on? bne bufil3 ; No, continue with normal processing lda #off ; Zero the flag first sta addlf ; ... lda #lf ; Get a bne bufcv2a ; always skip over character translation bufil3: jsr fgetc ; Get a character from the file jmp bffchk ; Go check for actual end-of-file sta kerchr ; Got a character, save it tax ;[31] and a copy to X lda filmod ;[DD] Check if conversion necessary cmp #1 ;[DD] Is it PETASCI? bne bufcv1 ;[DD] No lda pt2as,x ;[31] Get ASCII equivalent sta kerchr ; jmp bufceb ;[DD] bufcv1: cmp #2 ;[DD] Is it Speedscript? bne bufcv2 ;[DD] No jsr cvs2a ;[DD] Conv. Speedscript to ASCII jmp bufceb bufcv2: cmp #4 ; is it c-power bne bufceb lda #'_ cpx #$a4 ; $a4 is an underbar beq bufcv2a lda #'~ cpx #$af ; $af is a tilde beq bufcv2a lda #'| cpx #$df ; $df is a pipe beq bufcv2a lda pt2as,x ; if all else fails, use pt2as table bufcv2a:sta kerchr 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 ; When checking for quoting, use only 7 bits bffqc0: cmp #sp ; Is the character less than a space? bpl bffqc1 ; If not, try next possibility ldx filmod ; Get the file-type cpx #3 ;[DD] IF = 3 beq bffctl ; If it is not text, ignore problem cmp #cr ; Do we have a here? bne bffctl ; Nope, continue processing ldx #on ; Set flag to add a next time through stx addlf ; ... 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 ; Is 8-bit quoting turned on? cmp #on ; ... bne bffstf ; If not, skip this junk lda kerchr ; 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 ; 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 ;[21] Get the data index cmp #$00 ;[21] Is it zero? bne bffne ;[21] Nope, just return tay ;[21] Yes, this means the entire file has lda #true ; been transmitted so turn on sta eofinp ; the eofinp flag tya ;[21] 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 ; Check only 7 bits for quote cmp rquote ; Were we quoting a quote? beq bfeceb ; Yes, nothing has to be done cmp rebq ; Check for eight-bit quote char as well beq bfeceb ; Skip the character adjustment lda kerchr ; 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 ; Check if this is a text file cmp #3 ;[DD] Filmod = 3 ? beq bfefpc ; If not, continue normal processing lda kerchr ; Get a copy of the character and #$7f ; Make sure we test L.O. 7-bits only tax ;[31] Put a copy in X cmp #cr ; Do we have a ? bne bfeclf ; No, then check for lda #on ; Yes, set the 'Delete ' flag sta dellf ; ... jmp bfefpc ; And then continue bfeclf: cmp #lf ; Do we have a ? bne bfenlf ; Nope, We must go shut the Dellf flag. lda dellf ; We have a , is the flag on? cmp #on ; ... bne bfefpc ; If not, continue normally lda #off ; Flag is on, follows , ignore it sta dellf ; Start by zeroing flag jmp bfeou1 ; Now go to end of loop bfenlf: lda #off ; Zero Dellf sta dellf ; ... bfefpc: lda filmod ;[DD] Get file type cmp #1 ;[DD] Check PETASCI bne bfefp2 ;[DD] lda as2pt,x ;[31] Get ASCII equivalent sta kerchr ;[31] jmp bfefp4 ;[DD] bfefp2: cmp #2 ;[DD] Check Speedscript bne bfefp3 ;[DD] jsr cva2s ;[DD] Convert ASCII to Speedscript jmp bfefp4 bfefp3: cmp #4 ; check for c-power bne bfefp4 lda #$a4 ; $a4 is an underbar cpx #'_ beq bfefp3a lda #$af ; $af is a tilde cpx #'~ beq bfefp3a lda #$df ; $df is a pipe cpx #'| beq bfefp3a lda as2pt,x ; when all else fails, use as2pt table bfefp3a:sta kerchr bfefp4: lda kerchr ; 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 error code where it belongs and #$7f ; Shut off H.O. bit 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 ; ... ldy #$00 ; Initialize the y reg ; lda pdlen ; Copy the packet data length ; sec ; Now subtract off the overhead ; sbc #$03 ; ... ; sta kwrk02 ; into a work area getfl0: lda (kerbf1),y ; Get a character from the packet buffer 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 ; lda #0 ; ; sta fcb1,y ; Nul at end 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 eodind ;[DD] Check end-of-data flag cmp #off ;[21] Is it on? beq fgtc2a ;[DD][21] No, get next character jmp fgteof ;[21] Yes, no data to read fgtc2a: ldx #8 ;[DD] No, change input channel jsr chkin ;[DD] to disk jsr getin ;[DD] Get a char pha ;[DD] Save it jsr readst ;[DD] Get status sta eodind ;[DD] Save eof stat for next time cmp #$00 ;[DD] If 0 then ok beq fgtgnc ; Return jsr closef ;[DD] Eof so close but return fgtgnc: pla ; Get back character fgtgn1: ldx fbsize ; Get the file-byte-size cpx #fbsbit ; Is it seven-bit? bne fgtexi ; If not, leave with character intact and #$7f ; Shut off the H.O. byte fgtexi: jmp rskp ; Return skip fgteof: lda #$00 ; Return null 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: pha ;[DD] Save it ldx #8 ;[DD] Change output channel jsr chkout ;[DD] to disk pla ;[DD] Get it back jsr chrout ;[DD] Write it to disk jsr readst ;[DD] Check for errors cmp #00 ;[DD] Do we really need this? beq fputex ;[DD] No error sta errcod ;[DD] If error ldx #erms0a\ ;[DD] Get the address of the error message ldy #erms0a^ ;[DD] ... jsr prstr ;[DD] Print message lda errcod ;[DD] and status jsr prbyte ;[DD] ... jmp fatal ;[DD] Blow up fputex: lda #00 ; Return null jmp rskp ; with a skip! ; Check disk status rddsk: ldx #15 ;[DD] Change Kernel input channel jsr chkin ;[DD] to disk error channel ldy #0 ;[DD] rdds1: jsr getin ;[DD] Get a character cmp #cr ;[DD] Is it a ? beq rdds2 ;[DD] Yes, we are done sta dskers,y ;[DD] Store it iny ;[DD] Increment the index bne rdds1 ;[DD] Loop for more rdds2: lda #0 ;[DD] Stuff a null at the end sta dskers,y ;[DD] ... lda dskers ;[DD] Get 1st digit sec ;[DD] Convert to bcd sbc #$30 ;[DD] ... sta fmrcod ;[DD] asl a ;[DD] *2 asl a ;[DD] *4 asl a ;[DD] *8 asl a ;[DD] *16 sta fmrcod ;[DD] beq rddex ;[DD] If first digit is zero exit lda dskers+1 ;[DD] Get 2n digit sec ;[DD] Convert to binary sbc #$30 ;[DD] ... clc ;[DD] ... adc fmrcod ;[DD] sta fmrcod ;[DD] beq rddex ;[DD] If error = 0 exit ldx #dskers\ ;[DD] Get the address of the disk ldy #dskers^ ;[DD] error message jsr prstr ;[DD] Print it lda fmrcod ;[DD] ora #$80 ;[DD] Set high hbit rddex: sta errcod ;[DD] jsr clrchn ; turn off disk drive lda errcod rts ;[DD] Return .SBTTL Save and Restore Parameters ; The following routines will save and restore kermit ; parameters in a file named 'KERMIT.INI'. Eventually ; will add ability to specify file for save/restore. ; ; ; Savst - Save parameters ; ; Registers Destroyed: A,X,Y ; savst: jsr prcfm ;[47] Parse and print a confirm lda #fncwrt ;[47] ldy #$0d ;[47] sta inifil,y ;[47] iny ;[47] sty len ;[47] ; openm #8,#8,#8,inifil,len ;[47] lda #8 ; [53] ldx #8 ldy #8 jsr setlfs ldx #inifil\ ldy #inifil^ lda len jsr setnam jsr open ldx #8 ;[47] jsr chkout ;[47] ldy #0 ;[47] Start with the escape character savlop: lda escp,y ;[47] ... jsr chrout ;[47] Write it to disk iny ;[47] cpy #bordclr+1-escp ;[47] Are we at the end? bne savlop ;[47] No, do the next parameter jsr readst ;[47] Get the drive status bne saverr ;[47] We got an error lda #8 ;[47] OK, close the file when done jsr close ;[47] ... jmp kermit ;[47] and parse for more commands saverr: lda #8 ;[47] OK, close the file when done jsr close ;[47] ... jmp kermit ;[47] and parse for more commands ; ; Restst - Restore parameters ; restst: jsr prcfm ;[47] Parse and print a confirm jsr scrext ; exit the old screen driver jsr restin ;[47] Go restore the parameters jmp kermit ;[47] Failed, restart kermit restin: lda #fncrea ;[47] Get switch for read ldy #$0d ;[47] Get index into init filename sta inifil,y ;[47] Store the switch there iny ;[47] Increment the index sty len ;[47] Store it ; openm #8,#8,#8,inifil,len ;[47] Open the init file lda #8 ; [53] ldx #8 ldy #8 jsr setlfs ldx #inifil\ ldy #inifil^ lda len jsr setnam jsr open jsr readst ;[47] bne rsterr ;[47] No, failed - don't restore parameters ldx #8 ;[47] Change kernel input channel jsr chkin ;[47] to disk ldy #0 ;[47] Start index at escp rstlop: sty savey ;[47] Save the current index jsr chrin ;[47] Get a byte from the disk ldy savey ;[47] Restore the index sta escp,y ;[47] Store the character away iny ;[47] Increment the index cpy #bordclr+1-escp ;[47] Are we at the end of the parameter list? bne rstlop ;[47] No, get next parameter lda scrtype ; check if the new screen driver exists jsr scrtst bcc rstlop1 ; no it doesnt rsterr: lda #$01 ; default to 80-columns sta scrtype rstlop1:jsr scrent ; initilize the new screen package lda #8 ;[47] Close the init file jsr close ;[47] ... lda baud ldy #$00 ; new value for 300 baud cmp #$04 ; old value for 300 baud beq rstlop2 iny ; new value for 1200 baud cmp #$05 ; old value for 1200 baud beq rstlop2 iny ; new value for 2400 baud cmp #$07 ; old value for 2400 baud beq rstlop2 dey ; default to 1200 baud cmp #$03 ; not a legit new value -> 1200 baud. bcs rstlop2 tay ; we have a new value. Use it. rstlop2:sty baud jsr dobad rts ; all done inifil: .byte "KERMIT.INI,S,W";[47] Name of the init file .byte nul .SBTTL Utility routines ; ; The following routines are short low-level routines which help ; shorten the code and make it more readable ; ; ; Incn - increment the packet sequence number expected by this ; Kermit. Then take that number Mod $3f. ; incn: pha ; Save AC lda n ; Get the packet number clc ; Clear the carry flag for the add adc #$01 ; Up the number by one and #$3f ; Do this Mod $3f! sta n ; Stuff the number where it belongs clc ; Clear carry again lda tpak ; Increment lo byte adc #$01 ; total packet count sta tpak ; ... lda tpak+1 ; Do H.O. byte adc #$00 ; ... sta tpak+1 ; ... pla ; Restore the AC rts ; 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 ; Reload the packet type cmp #'E ; Is it an error packet? beq prcer1 ; Yes, continue processing rts ; No, return prcer1: lda #pdbuf\ ; Set up from-address sta kerfrm ; ... lda #pdbuf^ ; ... sta kerfrm+1 ; ... lda #errrkm\ ; Set up the to-address sta kerto ; ... lda #errrkm^ ; ... sta kerto+1 ; ... ldy pdlen ; Get packet data length sty kwrk01 ; Store for the copy routine lda #$00 ; Start by storing a null at the end sta (kerto),y ; ... jsr kercpy ; Copy the error text lda errcod ; Set the bit in the error code ora #eprflg ; saying that the remote Kermit sent us sta errcod ; an error packet. ldx #errrkm\ ; Finally, display the error packet ldy #errrkm^ ; ... jsr prstr ; Print string jsr prcrlf ; Make it look neat, add a crlf rts ; Return to caller ; ; 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 ; Zero the index pointing to end of line buffer sta pdtend ; ... sta ndx ; Make sure no unwarranted keyboard intrpt gobb: jsr getc ; Get a character jmp gobb2 ; Got a keyboard interupt lda char ;[31] cmp #soh ; Is it a start-of-header? bne gobb ; No, flush until first SOH jmp gobbst ; Ok, now we can start gobb0: jsr getc ; Get a character jmp gobb2 ; Got a keyboard interupt lda char ;[31] cmp #soh ; If this not an SOH bne gobb1 ; continue here tax ; Hold the character here lda #$00 ; Rezero the index pointing to end of buf sta pdtend ; ... txa ; Get the SOH back jmp gobbdb ; 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 ; Get the index we need gobbdb: sta plnbuf,x ; 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 ; Get end pointer again sta plnbuf,x ; 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 ; Get the current index inx ; Check if we are at end of buffer bne putpl1 ; No, continue rts ; Return without a skip putpl1: dex ; Set index back to what it was sta plnbuf,x ; Get the next character from the buffer inc pdtind ; Up the index once rts ; Return ; ; 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 keyscn ; Try and get a keyboard character bne getcy ;[] Got one jmp getc1 ;[] None available, try port getcy: cmp #ctrlx ;[43] Was it an 'abort current file' interrupt? beq getc3 ; Yes getc2: cmp #ctrly ;[43] Was it 'abort file group' interrupt ? bne getc0 ;[43] Nope, continue getc3: lda #$08 ; Error code for 'file trans abort' sta errcod ; Stuff it here jsr closef ;[28] Close the current file abo0: lda #$00 ;[43] Send a 'Z' packet with a 'D' field sta numtry ;[43] sta tpak ;[43] sta tpak+1 ;[43] lda #pdbuf\ ;[43] Get the address of the packet buffer sta kerbf1 ;[43] and save it for Spak lda #pdbuf^ ;[43] ... sta kerbf1+1 ;[43] ... abo1: lda numtry ;[43] Fetch the number of tries cmp maxtry ;[43] Have we exceeded Maxtry? bmi abo3 ;[43] Not yet, go send the packet abo2: ldx #ermesc\ ;[43] Yes, give an error message ldy #ermesc^ ;[43] ... jsr prstr ;[43] ... jsr prcrlf ;[43] ... jmp abo4 ;[43] and restart kermit abo3: inc numtry ;[43] Increment the number of tries for packet lda #$00 ;[43] Make it packet number 0 sta pnum ;[43] ... lda #$01 ;[43] Data length is only 1 sta pdlen ;[43] ... lda #'D ;[43] The 'Discard' command sta pdbuf ;[43] Put that in first character of buffer lda #'Z ;[43] EOF command packet type sta ptype ;[43] ... jsr flshin ;[43] Flush the RS232 buffer jsr spak ;[43] Send the packet ;jsr rpak ;[43] Try to fetch an ACK ;cmp #true ;[43] Did we receive successfully? ;bne abo1 ;[43] No, try to send the packet again ;lda ptype ;[43] Get the type ;cmp #'Y ;[43] An ACK? ;bne aboce ;[43] No, go check for error jmp abo4 ;[43] Yes, restart Kermit aboce: ;cmp #'E ;[43] Error packet? ;bne abo1 ;[43] Nope, resend packet ;jsr prcerp ;[43] Go display the error abo4: ldx kerosp ; Get the old stack pointer back txs ; Restore it jmp kermit ; Warmstart kermit getc0: lda #$00 ;[EL] And reset the strobe sta ndx ;[EL] ... rts ; Keyboard interupt, return getc1: jsr scrbel ; time to stop the beep? (after parity err) jsr timout ;[49] Have we timed out? jmp getc0 ;[49] Yes return jsr getrs ; No, Check the port beq getcn ;[] Got a character jmp getc ;[] No char, go back to top of loop getcn: lda char ;[31] Get the character read jmp rskp ; and return skip! ; ; 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\ ; Command table address sta cminf1 ; ... lda #oncmd^ ; ... sta cminf1+1 ; ... lda #shon\ ; Set up default string for parse sta cmdptr ; ... lda #shon^ ; ... sta cmdptr+1 ; ... ldy #cmfdff ; 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 #cr ; 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 ; ... 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 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 #mxfnl ; Load max filename length lda #space ; We will be filling with spaces clrfc1: sta fcb1,x ; Stuff the space dex ; Decrement our pointer bpl clrfc1 ; Not done, go back rts ; Return ; ; Clrbuf - clears the area BUFF so the disk string placed there ; will not be corrupted ; clrbuf: ldx #$2e ;[40] lda #space ;[40] clrbf1: sta buff,x ;[40] dex ;[40] bpl clrbf1 ;[40] rts ;[40] ; ; Kercpy - copies the string pointed to by Kerfrm to the ; block of memory pointed to by Kerto for Kwrk01 characters. ; kercpy: ldy kwrk01 ; Get the length of the string kerclp: dey ; One character less bmi kercrt ; If this went negative, we're done lda (kerfrm),y ; Get the next character sta (kerto),y ; And put it where it belongs jmp kerclp ; Go back for next char kercrt: rts ; Job is done, return ; ; Kerflm - fills the buffer pointed to by Kerto with the ; character in kwrk02 for Kwrk01 characters. ; kerflm: ldy kwrk01 ; Get the length of the string kerflp: dey ; One character less bmi kerflr ; If this went negative, we're done lda kwrk02 ; Get the fill character sta (kerto),y ; And put it in the next position jmp kerflp ; Go back to do next char kerflr: rts ; Job is done, return ; ; Prchr - takes a character from the AC and prints it. It ; echos control characters as '^' and escape as '$'. ; prchr: and #$7f ; Make sure it's in range cmp #$20 ; Less than escape?? bpl prchr1 ; If not, continue pha ; Hold the character lda #'^ ; Load the up-arrow for cntrl characters jsr cout ; Print the character pla ; Get the character back clc ; Clear carry for add adc #$40 ; Put this in the alphabetic range prchr1: jsr cout ; and print it rts ; Done, 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 Video Support Routines ; ; Prttab - Go to next tab stop ; prttab: ldx cx ; get the cursor x position prttab1:inx ; move cursor let jsr scrrgh ; do not allow the cursor past the right margin bcs prttab2 ; if past right margin, goto next line lda tabs,x ; see if tab stop here bne prttab1 ; if zero, there is a tabstop here ldy cy ; get the cursor y position jsr scrplt ; plot the new cursor position rts ; all done prttab2:jsr scrlf ; goto the next line if past right margin jsr scrcr ; goto the leftmost column rts ; all done ; ; Ploth - Plot the cursor position ; ; Input: Carry set to read cursor position ; X-reg cursor y position (if carry is set) ; Y-reg curosr x position (if carry is set) ; ; Output:X-reg is cursor y position (if carry is clear) ; Y-reg is cursor x position (if carry is clear) ; ; Registers Destroyed: None (if carry is set) ; ploth: bcc ploth1 ldx cy ldy cx rts ploth1: tya ; swap a-reg and x-reg pha txa tay pla tax jsr scrplt rts ; Print (X) spaces prbl2: stx savex ;[DD] Save X lda #sp ;[DD] Get a space jsr cout ;[DD] Print it ldx savex ;[DD] Get back X dex ;[DD] Decrement it bne prbl2 ;[DD] If not 0, do more rts ;[DD] Return ; Print a reg as 2 hex nibbles prbyte: ;[DD] Output byte in hex by2hx: pha ;[DD] Save byte lsr a ;[DD] lsr a ;[DD] lsr a ;[DD] lsr a ;[DD] jsr ny2hx ;[DD] High nyble tax ;[DD] to x pla ;[DD] Get back and #$0f ;[DD] Low nyble jsr ny2hx ;[DD] Translate to Hex pha ;[DD] Save low nyble txa ;[DD] Get high nyble jsr cout ;[DD] Print it pla ;[DD] Get back low nyble jmp cout ;[DD] Print and return ; Translate nyble to hex ny2hx: clc ;[DD] adc #$f6 ;[DD] bcc ny2h2 ;[DD] adc #$06 ;[DD] ny2h2: adc #$3a ;[DD] rts ;[DD] ; Print hex of A,X prntax: stx savex ;[DD] Save X jsr prbyte ;[DD] Print A first lda savex ;[DD] Get X into A jsr prbyte ;[DD] Print that next rts ;[DD] Return ; Prntad - Print a number in base 10. Leading zeros are skipped. ; ; Input: A,X - Number to be printed ; ; Registers Destroyed: A,X,Y ; ; This routine works by repeated subtraction. 10^X is subtracted ; until the result would be negative. After each subtraction, Y ; is incremented. Y starts out at '0. Thus, Y is the ascii value ; of the next digit. prntad: stx decnum ; [54] Save the number to print sta decnum+1 ; [54] ldx #4 ; [54] Up to 5 digits (0..4) prntad1:lda decnum ; [54] Compare with 10^x cmp tens1,x ; [54] lda decnum+1 ; [54] sbc tens2,x ; [54] bcs prntad2 ; [54] If greater, found first nonzero digit dex ; [54] Skip the leading zero bne prntad1 ; [54] Go test the next digit, unless last prntad2:ldy #'0 ; [54] Y is the ascii value to print prntad3:lda decnum ; [54] Compare with 10^x cmp tens1,x ; [54] lda decnum+1 ; [54] sbc tens2,x ; [54] bcc prntad4 ; [54] Result would be negative. lda decnum ; [54] Now subtract 10^x sbc tens1,x ; [54] carry is already set sta decnum ; [54] lda decnum+1 ; [54] sbc tens2,x ; [54] sta decnum+1 ; [54] iny ; [54] Keep track of the value of this digit bne prntad3 ; [54] Always taken prntad4:txa ; [54] Save X pha ; [54] tya ; [54] Print the character in Y jsr cout ; [54] pla ; [54] Restore X tax ; [54] dex ; [54] Print the next digit. bpl prntad2 ; [54] rts tens1 .byte 1\,10\,100\,1000\,10000\ ; [54] Powers of ten for prntad tens2 .byte 1^,10^,100^,1000^,10000^ ; ; Cout - Print byte to screen ; ; Input: A - character to be printed ; ; Output: ; ; Registers Destroyed: A,X,Y ; cout: sta source ; Save A-reg pha ; save A-reg again txa pha ; save X-reg tya pha ; save Y-reg lda source jsr scrput ; print the character pla ; restore Y-reg tay pla ; restore X-reg tax pla ; restore A-reg rts ; Rdkey - Read keyboard until a byte appears ; ; Input: ; ; Output: ; ; Registers Destroyed: ; rdkey: jsr keyscn ;[DD] Try and get a keyboard byte sta char bne rdret ;[DD] None, try again jsr scrfls ; flash the cursor jsr scrbel ; stop the nasty bell tone after 6 jiffys jmp rdkey ;[] rdret: rts ;[DD] ... ; Bell - Initiate sounds - will be terminated next cursor blink ; ; Input: None ; ; Output: None ; ; Registers Destroyed: None ; bell: pha ;[EL] Save the AC beephi: lda #$50 ;[EL] Select high frequency bne beep ;[33] ... beeplo: pha ;[33] Save the AC lda #$14 ;[33] Select low frequency beep: sta freqhi ;[EL] ... lda #$0f ;[EL] Select fast attack, slow decay sta attdec ;[EL] ... lda #$12 ;[EL] Select sustain ... sta susrel ;[EL] ... lda #6 ;[EL] Select not-too-loud volume sta vol ;[EL] ... lda #$21 ;[EL] Select sawtooth wave sta wave ;[EL] ... jsr rdtim ; remember when the sound started sta lpcnt ;[EL] ... pla ;[EL] Restore the AC rts ;[EL] Return ; ; keyscn - scan the keyboard ; ; Input: None ; ; Output: zero flag and A reg ; ; This routine checks the keyboard. If a new key is pressed, or if ; it is time for the current key to be repeated, it returns the ; the ascii (not petascii) value of the key, and clears the zero flag. ; If no key is pressed, or if it is not time to repeat the current ; key, it returns zero and sets the zero flag. ; ; This routine also returns the row/column of the key pressed in the ; X-reg. This is used to determine if a new key was pushed. ; keyscn: jsr rdtim ; only scan once per jiffy (avoid keybounce) cmp keytime beq keyscn1 ; not time yet. return sta keytime jsr keyscn2 ; scan the keyboard beq keyscn3 ; if no key pressed, reset repeat counter cpx keylast bne keyscn3 ; if new key pressed, reset repeat counter ldy decarm ; if keyboard not in automatic repeat mode... beq keyscn1 ; ... then no key pushed. dec keyrept ; if same key pressed, decrement repeat counter bne keyscn1 ; if not time to repeat yet, return $00 ldy #7 ; repeat every 7 jiffys (after the first rept) .byte $2c ; skip the ldy #30 keyscn3:ldy #30 ; set the repeat counter to 30 jiffys sty keyrept stx keylast ; remember row/column of last keypress ldx $d600 ; is this a commodore-128? beq keyscn0 ; if not, then there is no caps lock key cmp #'a ; is this a lower case letter? bcc keyscn0 ; if not, then caps lock has no effect cmp #'z+1 ; is this a lower case letter? bcs keyscn0 ; if not, then caps lock has no effect pha ; save the letter lda $01 and #$40 cmp #$40 ; carry clear if and only if caps lock down pla ; remember the letter bcs keyscn0 adc #'A-'a ; make the letter capital (note: carry clear) keyscn0:cmp #$00 ; set zero flag if new key, otherwise clear rts keyscn1:lda #$00 ; not time to scan keyboard yet. rts keyscn2:sei ; only one key scanner at once, please ldx #$ff ; no keypress detected (yet) lda #$00 ; check if any key is pressed sta $dc00 sta $d02f ; the extra keys on the C128 live here lda $dc01 cmp #$ff beq keyscn4 ; no key pressed. Skip excess junk. lda #$fe ; start scanning with the first column sta keycol sta $dc00 lda #$ff sta keycol1 sta $d02f ldx #$00 keyscn6:lda $dc01 ora keynon,x ; cancel out non-characters (shift, control) cmp #$ff ; any key pressed in this column? bne keyscn5 ; nope. Skip this junk sec ; check the next column rol keycol rol keycol1 lda keycol sta $dc00 lda keycol1 sta $d02f inx cpx #11 ; check for 11 different columns bcc keyscn6 ldx #$ff ; so '$' works. (last = 11 if only shift) lda #$00 ; the key press has gone away during the scan cli ; re-allow interupts rts keyscn5:pha ; save the row data txa ; multiply X-reg by 8 (8 rows/column) asl a asl a asl a tax pla ; remember row data sec ; make sure carry is always set in keyscn7 loop dex ; compensate for next inx keyscn7:inx ; inx till grounded row found ror a bcs keyscn7 lda #$ff sta $d02f lda #%01111111 ; check the ctrl key sta $dc00 lda $dc01 and #%00000100 beq keyscn8 ; control pushed lda #%11111101 ; next check the left shift key sta $dc00 lda $dc01 and #%10000000 beq keyscn9 ; left shift pushed lda #%10111111 ; next check the right shift key sta $dc00 lda $dc01 and #%00010000 beq keyscn9 ; right shift pushed lda keytbl1,x ; look up ascii value for given row/column cli ; re-allow interupts rts ; all done keyscn8:lda keytbl2,x ; look up ascii value for control + row/column cli ; re-allow interupts rts ; all done keyscn9:lda keytbl3,x ; look up ascii value for shift + row/column cli ; re-allow interupts rts ; all done keyscn4:lda #$ff ; fix things so that the keypad doesn't sta $d02f ; interfere with the suspend flag lda #$00 ; no key pushed anywhere cli ; re-allow interupts rts ; ; keynon - position of non-character keys. ; ; This table defines the position of non-character keys. A ; non-character key is any key that does not return a character. ; Example: Shift, Control, C=. ; keynon: .byte %00000000 .byte %10000000 ; left-shift .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00010000 ; right-shift .byte %00100100 ; unused, control .byte %00000000 ; .byte %00000000 .byte %10000001 ; no_scroll, alt ; ; keytbl1 - ascii values of characters at given row/column ; ; This table is used to translage row/column positions to ascii ; values. This table is only used if neither the shift or control ; keys is pushed. ; ; The following special non-ascii values exist: ; ; $80 .. $89 - numeric keypad ; $90 .. $93 - pf keys ; $a0 .. $a3 - cursor keys ; $b0 .. $b7 - programmable function keys ; $c0 - '-' (on the numeric keypad) ; $c1 - '+' (on the numeric keypad) ; $c2 - '.' (on the numeric keypad) ; $c3 - enter (on the numeric keypad) ; $d0 - null (ctrl-@) and (ctrl-space) ; $d1 - break (shift DEL) ; keytbl1:.byte $7f ; row 0, column 0 .byte $0d ; row 1, column 0 .byte $a2 ; row 2, column 0 .byte $08 ; row 3, column 0 (should be $b6) .byte '_ ; row 4, column 0 (should be $b0) .byte '` ; row 5, column 0 (should be $b2) .byte '{ ; row 6, column 0 (should be $b4) .byte $a1 ; row 7, column 0 .byte '3 ; row 0, column 1 .byte 'w ; row 1, column 1 .byte 'a ; row 2, column 1 .byte '4 ; row 3, column 1 .byte 'z ; row 4, column 1 .byte 's ; row 5, column 1 .byte 'e ; row 6, column 1 .byte $00 ; row 7, column 1 .byte '5 ; row 0, column 2 .byte 'r ; row 1, column 2 .byte 'd ; row 2, column 2 .byte '6 ; row 3, column 2 .byte 'c ; row 4, column 2 .byte 'f ; row 5, column 2 .byte 't ; row 6, column 2 .byte 'x ; row 7, column 2 .byte '7 ; row 0, column 3 .byte 'y ; row 1, column 3 .byte 'g ; row 2, column 3 .byte '8 ; row 3, column 3 .byte 'b ; row 4, column 3 .byte 'h ; row 5, column 3 .byte 'u ; row 6, column 3 .byte 'v ; row 7, column 3 .byte '9 ; row 0, column 4 .byte 'i ; row 1, column 4 .byte 'j ; row 2, column 4 .byte '0 ; row 3, column 4 .byte 'm ; row 4, column 4 .byte 'k ; row 5, column 4 .byte 'o ; row 6, column 4 .byte 'n ; row 7, column 4 .byte '+ ; row 0, column 5 .byte 'p ; row 1, column 5 .byte 'l ; row 2, column 5 .byte '- ; row 3, column 5 .byte '. ; row 4, column 5 .byte ': ; row 5, column 5 .byte '@ ; row 6, column 5 .byte ', ; row 7, column 5 .byte '\ ; row 0, column 6 .byte '* ; row 1, column 6 .byte '; ; row 2, column 6 .byte $08 ; row 3, column 6 .byte $00 ; row 4, column 6 .byte '= ; row 5, column 6 .byte '^ ; row 6, column 6 .byte '/ ; row 7, column 6 .byte '1 ; row 0, column 7 .byte $1b ; row 1, column 7 .byte $00 ; row 2, column 7 .byte '2 ; row 3, column 7 .byte $20 ; row 4, column 7 .byte $00 ; row 5, column 7 .byte 'q ; row 6, column 7 .byte $03 ; row 7, column 7 .byte '? ; row 0, column 8 .byte $88 ; row 1, column 8 .byte $85 ; row 2, column 8 .byte $09 ; row 3, column 8 .byte $82 ; row 4, column 8 .byte $84 ; row 5, column 8 .byte $87 ; row 6, column 8 .byte $81 ; row 7, column 8 .byte $1b ; row 0, column 9 .byte $c1 ; row 1, column 9 .byte $c0 ; row 2, column 9 .byte $0a ; row 3, column 9 .byte $c3 ; row 4, column 9 .byte $86 ; row 5, column 9 .byte $89 ; row 6, column 9 .byte $83 ; row 7, column 9 .byte $00 ; row 0, column 10 .byte $80 ; row 1, column 10 .byte $c2 ; row 2, column 10 .byte $a0 ; row 3, column 10 .byte $a1 ; row 4, column 10 .byte $a3 ; row 5, column 10 .byte $a2 ; row 6, column 10 .byte $00 ; row 7, column 10 ; ; keytbl2 - ascii values of characters at given row/column ; ; This table is used to translage row/column positions to ascii ; values. This table is only used if control is pushed ; ; The following special non-ascii values exist: ; ; $80 .. $89 - numeric keypad ; $90 .. $93 - pf keys ; $a0 .. $a3 - cursor keys ; $b0 .. $b7 - programmable function keys ; $c0 - '-' (on the numeric keypad) ; $c1 - '+' (on the numeric keypad) ; $c2 - '.' (on the numeric keypad) ; $c3 - enter (on the numeric keypad) ; $d0 - null (ctrl-@) and (ctrl-space) ; $d1 - break (shift DEL) ; keytbl2:.byte $7f ; row 0, column 0 .byte $c3 ; row 1, column 0 .byte $a2 ; row 2, column 0 .byte $93 ; row 3, column 0 .byte $90 ; row 4, column 0 .byte $91 ; row 5, column 0 .byte $92 ; row 6, column 0 .byte $a0 ; row 7, column 0 .byte $83 ; row 0, column 1 .byte $17 ; row 1, column 1 .byte $01 ; row 2, column 1 .byte $84 ; row 3, column 1 .byte $1a ; row 4, column 1 .byte $13 ; row 5, column 1 .byte $05 ; row 6, column 1 .byte $00 ; row 7, column 1 .byte $85 ; row 0, column 2 .byte $12 ; row 1, column 2 .byte $04 ; row 2, column 2 .byte $86 ; row 3, column 2 .byte $03 ; row 4, column 2 .byte $06 ; row 5, column 2 .byte $14 ; row 6, column 2 .byte $18 ; row 7, column 2 .byte $87 ; row 0, column 3 .byte $19 ; row 1, column 3 .byte $07 ; row 2, column 3 .byte $88 ; row 3, column 3 .byte $02 ; row 4, column 3 .byte $08 ; row 5, column 3 .byte $15 ; row 6, column 3 .byte $16 ; row 7, column 3 .byte $89 ; row 0, column 4 .byte $09 ; row 1, column 4 .byte $0a ; row 2, column 4 .byte $80 ; row 3, column 4 .byte $0d ; row 4, column 4 .byte $0b ; row 5, column 4 .byte $0f ; row 6, column 4 .byte $0e ; row 7, column 4 .byte $c1 ; row 0, column 5 .byte $10 ; row 1, column 5 .byte $0c ; row 2, column 5 .byte $c0 ; row 3, column 5 .byte $c2 ; row 4, column 5 .byte $1b ; row 5, column 5 .byte $d0 ; row 6, column 5 .byte ', ; row 7, column 5 .byte $1c ; row 0, column 6 .byte '* ; row 1, column 6 .byte $1d ; row 2, column 6 .byte $08 ; row 3, column 6 .byte $00 ; row 4, column 6 .byte $1f ; row 5, column 6 .byte $1e ; row 6, column 6 .byte '/ ; row 7, column 6 .byte $81 ; row 0, column 7 .byte $1b ; row 1, column 7 .byte $00 ; row 2, column 7 .byte $82 ; row 3, column 7 .byte $d0 ; row 4, column 7 .byte $00 ; row 5, column 7 .byte $11 ; row 6, column 7 .byte $03 ; row 7, column 7 .byte '? ; row 0, column 8 .byte $88 ; row 1, column 8 .byte $85 ; row 2, column 8 .byte $09 ; row 3, column 8 .byte $82 ; row 4, column 8 .byte $84 ; row 5, column 8 .byte $87 ; row 6, column 8 .byte $81 ; row 7, column 8 .byte $1b ; row 0, column 9 .byte $c1 ; row 1, column 9 .byte $c0 ; row 2, column 9 .byte $0a ; row 3, column 9 .byte $c3 ; row 4, column 9 .byte $86 ; row 5, column 9 .byte $89 ; row 6, column 9 .byte $83 ; row 7, column 9 .byte $00 ; row 0, column 10 .byte $80 ; row 1, column 10 .byte $c2 ; row 2, column 10 .byte $a0 ; row 3, column 10 .byte $a1 ; row 4, column 10 .byte $a3 ; row 5, column 10 .byte $a2 ; row 6, column 10 .byte $00 ; row 7, column 10 ; ; keytbl3 - ascii values of characters at given row/column ; ; This table is used to translage row/column positions to ascii ; values. This table is used only if shift, but not control, is pushed ; ; The following special non-ascii values exist: ; ; $80 .. $89 - numeric keypad ; $90 .. $93 - pf keys ; $a0 .. $a3 - cursor keys ; $b0 .. $b7 - programmable function keys ; $c0 - '-' (on the numeric keypad) ; $c1 - '+' (on the numeric keypad) ; $c2 - '.' (on the numeric keypad) ; $c3 - enter (on the numeric keypad) ; $d0 - null (ctrl-@) and (ctrl-space) ; $d1 - break (shift DEL) ; keytbl3:.byte $d1 ; row 0, column 0 .byte $0d ; row 1, column 0 .byte $a3 ; row 2, column 0 .byte $00 ; row 3, column 0 (should be $b7) .byte '| ; row 4, column 0 (should be $b1) .byte '~ ; row 5, column 0 (should be $b3) .byte '} ; row 6, column 0 (should be $b5) .byte $a0 ; row 7, column 0 .byte '# ; row 0, column 1 .byte 'W ; row 1, column 1 .byte 'A ; row 2, column 1 .byte '$ ; row 3, column 1 .byte 'Z ; row 4, column 1 .byte 'S ; row 5, column 1 .byte 'E ; row 6, column 1 .byte $00 ; row 7, column 1 .byte '% ; row 0, column 2 .byte 'R ; row 1, column 2 .byte 'D ; row 2, column 2 .byte '& ; row 3, column 2 .byte 'C ; row 4, column 2 .byte 'F ; row 5, column 2 .byte 'T ; row 6, column 2 .byte 'X ; row 7, column 2 .byte '' ; row 0, column 3 .byte 'Y ; row 1, column 3 .byte 'G ; row 2, column 3 .byte '( ; row 3, column 3 .byte 'B ; row 4, column 3 .byte 'H ; row 5, column 3 .byte 'U ; row 6, column 3 .byte 'V ; row 7, column 3 .byte ') ; row 0, column 4 .byte 'I ; row 1, column 4 .byte 'J ; row 2, column 4 .byte '0 ; row 3, column 4 .byte 'M ; row 4, column 4 .byte 'K ; row 5, column 4 .byte 'O ; row 6, column 4 .byte 'N ; row 7, column 4 .byte '{ ; row 0, column 5 .byte 'P ; row 1, column 5 .byte 'L ; row 2, column 5 .byte '} ; row 3, column 5 .byte '> ; row 4, column 5 .byte '[ ; row 5, column 5 .byte '` ; row 6, column 5 .byte '< ; row 7, column 5 .byte '| ; row 0, column 6 .byte '* ; row 1, column 6 .byte '] ; row 2, column 6 .byte $0c ; row 3, column 6 .byte $00 ; row 4, column 6 .byte '_ ; row 5, column 6 .byte '~ ; row 6, column 6 .byte '? ; row 7, column 6 .byte '! ; row 0, column 7 .byte $1b ; row 1, column 7 .byte $00 ; row 2, column 7 .byte '" ; row 3, column 7 .byte $20 ; row 4, column 7 .byte $00 ; row 5, column 7 .byte 'Q ; row 6, column 7 .byte $03 ; row 7, column 7 .byte '? ; row 0, column 8 .byte $88 ; row 1, column 8 .byte $85 ; row 2, column 8 .byte $09 ; row 3, column 8 .byte $82 ; row 4, column 8 .byte $84 ; row 5, column 8 .byte $87 ; row 6, column 8 .byte $81 ; row 7, column 8 .byte $1b ; row 0, column 9 .byte $c1 ; row 1, column 9 .byte $c0 ; row 2, column 9 .byte $0a ; row 3, column 9 .byte $c3 ; row 4, column 9 .byte $86 ; row 5, column 9 .byte $89 ; row 6, column 9 .byte $83 ; row 7, column 9 .byte $00 ; row 0, column 10 .byte $80 ; row 1, column 10 .byte $c2 ; row 2, column 10 .byte $a0 ; row 3, column 10 .byte $a1 ; row 4, column 10 .byte $a3 ; row 5, column 10 .byte $a2 ; row 6, column 10 .byte $00 ; row 7, column 10 .SBTTL RS232 Support Routines ; ; Openrs - Open the RS-232 Channel ; ; Input: RS232 Parameters in CNTRL,CMMD ; ; Ouput: ; ; Registers Destroyed: A ; openrs: lda #2 ;[27] Close the Current channel jsr close ;[27] ... ; openm #2,#2,#$ff,cntrl,#4 ;[27] Open new channel lda #2 ; [53] ldx #2 ldy #$ff jsr setlfs ldx #cntrl\ ldy #cntrl^ lda #4 jsr setnam jsr open ; ; Alocrs - Subroutine - allocate the RS232 buffers ; ; Input: Buffer locations in RSOUT,RSIN ; ; Output: ; ; Registers Destroyed: A ; alocrs: lda #rsout\ ;[24] Allocate the RS-232 buffers sta robuf ;[24] ... lda #rsout&$ff00^ ;[24] ... sta robuf+1 ;[24] ... lda #rsin\ ;[24] ... sta ribuf ;[24] ... lda #rsin&$ff00^ ;[24] ... sta ribuf+1 ;[24] ... rts ;[24] Return ; ; Getrs - Get byte from rs232 port ; ; Input: ; ; Output: Character read in CHAR ; ; ; ; Registers Destroyed: A,X ; getrs: jsr flowco ;[24] Do flow control if necessary lda suspend ;[24] Is RS-232 reading suspended? bne getr3 ; Yes, getr2: ldx #2 ;[DD] Change Kernel input jsr chkin ;[DD] channel to RS-232 jsr getin ;[DD] Get a byte sta char ;[31] Store it here jsr readst ;[33] Read the status sta stat ;[33] Store it here jsr rserrs ;[33] Check for RS232 errrors bne getr3 ;[33] If error, return no byte lda stat ;[33] Check stat to see if byte was read and #$08 ;[33] ... getr3: rts ;[DD] Return ; ; Rserrs - Check for RS232 errors ; ; Input: Status in STAT ; ; Output: ; ; Registers Destroyed: A rserrs: lda stat ;[33] Get the status and #$f7 ;[33] beq erret ;[33] jsr beeplo ;[33] Error, Feep! lda #1 ;[33] erret: rts ;[33] ; ; Flowco - perform RS-232 flow control ; ; Input: ; ; Output: ; ; Registers Destroyed: A,X ; flowco: lda flowmo ;[24] Get the flow control mode switch cmp #on ;[24] Is it on? bne flowre ;[24] No lda shflag ;[24] Check commodore key and #$02 ;[24] Is it depressed? beq nocomm ;[24] No lda commflg ;[24] Was it depressed before bne flowch ;[24] Yes, ignore it inc commflg ;[24] Set commodore key flag lda suspend ;[24] Currently suspended? beq notsus ;[24] No lda #0 ;[24] Clear suspend flag sta suspend ;[24] ... beq flowch ;[24] notsus: inc suspend ;[24] Set suspend flag bne flowch ;[24] nocomm: sta commflg ;[24] Clear commodore key flag flowch: lda ridbe ;[24] Compute number of chars sec ;[24] in RS-232 buffer sbc ridbs ;[24] ... lsr a ;[24] Divide count by 2 for accurate check ldx fxoff ;[24] Has an xoff already been sent bne itsoff ;[24] Yes cmp #100 ;[24] Number chars in buffer reached 200? bmi flowre ;[24] No - no flow control necessary yet jsr sxoff ;[24] Send an xoff rts ;[24] Return itsoff: cmp #10 ;[24] Has backlog dropped to 20 or less? bpl flowre ;[24] No - leave input suspended jsr sxon ;[24] Send an xon flowre: rts ;[24] Return ; ; Flshin - Flush the RS232 input buffer ; ; Input: ; ; Output: ; ; Registers Destroyed: A flshin: jsr getrs ;[25] Get from RS-232 buffer beq flshin ;[33] No, get more rts ;[25] Yes, finish ; ; Putrs - Send byte to RS232 ; ; Input: ; ; Output: ; ; Registers Destroyed: ; putrs: pha ;[DD] Save A-reg txa ;[DD] Save X-reg pha ;[DD] ... ldx #2 ;[DD] Change the Kernel output jsr chkout ;[DD] channel to RS-232 jsr optimu ;[24] Wait for optimum time to do RS-232 out pla ;[DD] Restore X tax ;[DD] ... pla ;[DD] Restore A jsr chrout ;[DD] Send the character rts ;[DD] Return ; ; Optimu - wait for optimum time to transmit an RS-232 character ; ; Input: ; ; Output: ; ; Registers Destroyed: ; ; If we are connected, we have to make sure that the modem interrupts ; will not collide. We do this by waiting for the first bit of a byte ; to be received. If we don't wait for a bit to be received, the ; transmitter interrupts will collide with the receiver interrupt. If ; we don't use the very first bit, then we might not be finished ; transmitting when the next start bit interrupt occurs. We never ; wait more than 1/120 of a second. If nothing has happened in 1/120 ; of a second, then we are not receiving data. ; ; If we are sending a packet, we have to stretch our stop bit or some ; devices (notably a DH-11, and maybe many others) cannot understand ; what we are saying. ; ; The magic stretch value is computed as follows: ; The "right" rate for 1200 baud transmission is $0146. ; (see the calculations on the bottom of page 350) ; (of the Programmer's Reference Guide) ; We choose to run with $013c. ; $0146-$013c = $a ; There are 10 bits in a byte. There are 2 clock cycles in ; A count. This means that we have to stretch our stop bit ; by 200 cycles. The delay loop has 5 cycles. (dex=2, bne=3). ; So we have to go through the delay loop 40 times. ; optimu: lda connec ;[] Get the connect mode flag cmp #true ;[] Are we in connect mode? bne opti4 lda #$07 ; what bit are we waiting for? opti1: cmp bitci ; if operation already in progress, wait beq opti1 jsr opti7 ; compute loop counter. 40=slow mode. 80=fast lda #$07 ; what bit are we waiting for? opti2: ldy #20 ; 40 executions * 2 cycles = 80 cycles. opti3: cmp bitci ; 800 * 3 = 2400 beq optirt ; 800 * 2 = 1600 dey ; 800 * 2 = 1600 bne opti3 ; 760 * 3 + 40 * 2 = 2360 pha ; 40 * 3 = 120 pla ; 40 * 4 = 160 dex ; 40 * 2 = 80 bne opti2 ; 39 * 3 + 1 * 2 = 119 rts ; total delay = 8521 cycles = approx /120 sec opti4: lda baud ; are we running at 1200 baud? cmp #$01 bne optirt ; guess not. Don't have to kludge. lda #$01 ; wait for transmission of last byte to end opti5: bit $02a1 bne opti5 jsr opti7 ; compute loop counter. 40=slow mode. 80=fast opti6: dex bne opti6 optirt: rts opti7: ldx #40 ; outer loop = 40 for slow mode lda fast lsr a bcc opti8 ldx #80 ; outer loop = 80 for fast mode opti8: rts ; ; Sbreak - Send a break signal ; sbreak: lda $dd00 ;[DD] Get pa of cia and #$fb ;[DD] Zero pa2 sta $dd00 ;[DD] ... ldy #$00 jsr opti7 ; get a timing value depending on fast mode sbdl0: pha ; 10240 * 3 = 30720 pla ; 10240 * 4 = 40960 pha ; 10240 * 3 = 30720 pla ; 10240 * 4 = 40960 nop ; 10240 * 2 = 20480 nop ; 10240 * 2 = 20480 dey ; 10240 * 2 = 20480 bne sbdl0 ; 10200 * 3 + 40 * 2 = 30680 ldy #51 ; 40 * 2 = 80 sbdl1: nop ; 2040 * 2 = 4080 dey ; 2040 * 2 = 4080 bne sbdl1 ; 2000 * 3 + 40 * 2 = 6080 dex ; 40 * 2 = 80 bne sbdl0 ; 39 * 3 + 1 * 2 = 119 lda $dd00 ; total = 249999 = approx 250 ms ora #$04 ;[DD] Set pa2 sta $dd00 ;[DD] ... rts ;[DD] Return ; ; Subroutine - send out ^Q (xon) to remote host ; sxon: lda #0 ;[24] Clear xoff flag sta fxoff ;[24] ... lda #$11 ;[24] Transmit ^Q bne xcom ;[24] ... ; ; Subroutine - send out ^S (xoff) to remote host ; sxoff: lda #5 ;[24] Set xoff flag sta fxoff ;[24][32] ... lda #$13 ;[24] then, transmit ^S xcom: jsr putrs ;[24] ... rts ;[24] Return ; ; ; Cva2s - Convert ASCII to Speedscript (word processor) ; ; Input: Character in KERCHR ; ; Output: Converted character in KERCHR ; ; Registers Destroyed: A ; cva2s: lda kerchr ;[DD] and #$7f ;[DD] cmp #cr ;[DD] bne cva2s1 ;[DD] Check cr lda #$1f ;[DD] cva2s1: cmp #$61 ;[DD] bcc cva2s2 ;[DD] cmp #$7b ;[DD] bcs cva2s2 ;[DD] and #$1f ;[DD] Convert lower case cva2s2: cmp #$5b ;[DD] bcc cva2s3 ;[DD] cmp #$5f ;[DD] bcs cva2s3 ;[DD] and #$1f ;[DD] cva2s3: sta kerchr ;[DD] rts ;[DD] ; Convert Seedscript (word processor) to ASCII cvs2a: lda kerchr ;[DD] and #$7f ;[DD] cvs2a1: cmp #$1b ;[DD] bcs cvs2a2 ;[DD] If <$1b ora #$60 ;[DD] Convert to lc cvs2a2: cmp #$1f ;[DD] bcs cvs2a3 ;[DD] ora #$40 ;[DD] cvs2a3: bne cvs2a4 ;[DD] If =$1f lda #cr ;[DD] cr cvs2a4: sta kerchr ;[DD] rts ;[DD] .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 ; Send 'Y' - I will support 8-bit quoting ; sta (kerbf1),y ; Stuff it into the data area lda ebqmod ;[30] Get eight-bit quoting cmp #off ;[30] Is it off? beq spar1 ;[30] Yes...say we will do it if HE wants to lda sebq ;[30] Get eight-bit quote character sta (kerbf1),y ;[30] So other Kermit knows we are rts ;[30] requesting it spar1: lda #'Y ; 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 quote 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 ; Check the data length to see cmp #$09 ; if the 8-bit quote is there bmi rparrt ; If not, return lda (kerbf1),y ; Fetch the 8-bit quote cmp #'N ; Is it 'N' beq rpar8 ; Yes, leave.(he doesn't support 8-bit) cmp #'Y ; Does he support 8-bit quoting? beq rpar8 ; If so, leave. (we don't need it.) cmp #'! ; Now, it should be a real character bmi rparrt ; Check if it is in range. cmp #'? ; If so, we set the 8-bit quote char bmi rpar7 ; and set 8-bit quoting on. cmp #$60 ; If not, just leave. bmi rparrt ; ... cmp #del ; ... bpl rparrt ; ... rpar7: sta sebq ; Stuff the character here lda #on ; Set 8-bit quoting on sta ebqmod ; ... rts ; Return rpar8: sta sebq ; Make sure this parm is stored lda #off ; AND that 8-bit quoting is off. sta ebqmod ; ... rparrt: rts ; Return ; ; ; Nakit - sends a standard NAK packet out to the other Kermit. ; ; Input: NONE ; ; Output: NONE ; nakit: lda #$00 ; Zero the packet data length sta pdlen ; ... lda #'N ; Set up a nak packet type sta ptype ; ... jsr spak ; Now, send it rts ; Return .SBTTL Message text versio1:.byte "Commodore 64/128 Kermit version 2.2 (73)" .byte cr .byte 0 versio2:.byte "Type '?' for help" .byte cr .byte 0 ; [53] .SBTTL Command tables and help text kercmd: .byte $10 ;[DD][EL][40][] Table length ; .byte $11 ; Table length with SCRATCH command installed ; .byte $12 ; Table length with RENAME command installed ; .byte $13 ; Table length with LOG command installed .byte $03 ; .byte "bye" ; .byte 0 ; [53] .byte $1E,$1E ; .byte $07 ; Keyword length .byte "connect" ; Keyword terminated with a null .byte 0 ; [53] .byte $00,$00 ; Two bytes of data .byte $09 ; .byte "directory" ; .byte 0 ; [53] .byte $2a,$2a ; .byte $04 ; .byte "disk" ; .byte 0 ; [53] .byte $27,$27 ; .byte $04 ; .byte "exit" ; .byte 0 ; [53] .byte $03,$03 ; .byte $06 ; .byte "finish" ; .byte 0 ; [53] .byte $21,$21 ; .byte $03 ; .byte "get" ; .byte 0 ; [53] .byte $24,$24 ; .byte $04 .byte "help" .byte 0 ; [53] .byte $06,$06 ; .byte $03 ; NOT IMPLEMENTED YET ; .asciz /LOG/ ; .byte $09,$09 .byte $04 .byte "quit" .byte 0 ; [53] .byte $0C,$0C .byte $07 .byte "receive" .byte 0 ; [53] .byte $0F,$0F ; .byte $06 ;[] ; .asciz /RENAME/ ;[] ; .byte ;[] .byte $07 ;[47] .byte "restore" ;[47] .byte 0 ; [53] .byte $30,$30 ;[47] .byte $04 ;[47] .byte "save" ;[47] .byte 0 ; [53] .byte $2d,$2d ;[47] ; .byte $07 ;[] ; .asciz /SCRATCH/ ;[] ; .byte ;[] .byte $04 .byte "send" .byte 0 ; [53] .byte $12,$12 .byte $03 .byte "set" .byte 0 ; [53] .byte $15,$15 .byte $04 .byte "show" .byte 0 ; [53] .byte $18,$18 .byte $06 .byte "status" .byte 0 ; [53] .byte $1B,$1B setcmd: .byte $16 ;[DD][EL][17][37] .byte $04 ;[17] .byte "baud" ;[17] .byte 0 ; [53] .byte $27,$27 ;[17] .byte $04 .byte "bold" .byte $00 .byte $3c,$3c .byte $06 .byte "border" .byte $00 .byte $3f,$3f .byte $09 .byte "character" .byte $00 .byte $39,$39 .byte $0f .byte "dark-background" .byte $00 .byte $33,$33 .byte $09 .byte "debugging" .byte 0 ; [53] .byte $18,$18 .byte $11 .byte "eight-bit-quoting" .byte 0 ; [53] .byte $15,$15 .byte $06 .byte "escape" .byte 0 ; [53] .byte $00,$00 .byte $0E .byte "file-byte-size" .byte 0 ; [53] .byte $1E,$1E .byte $09 .byte "file-type" .byte 0 ; [53] .byte $1B,$1B .byte $0C .byte "file-warning" .byte 0 ; [53] .byte $12,$12 .byte $0C ;[24] .byte "flow-control" ;[24] .byte 0 ; [53] .byte $2d,$2d ;[24] .byte $03 ; .byte "ibm" ; .byte 0 ; [53] .byte $03,$03 ; .byte $10 .byte "light-background" .byte $00 .byte $36,$36 .byte $0A .byte "local-echo" .byte 0 ; [53] .byte $06,$06 .byte $06 ; .byte "parity" ; .byte 0 ; [53] .byte $24,$24 ; .byte $07 .byte "receive" .byte 0 ; [53] .byte $09,$09 .byte $0F ;[DD] .byte "rs232-registers" ;[DD] .byte 0 ; [53] .byte $21,$21 ;[DD] .byte $04 .byte "send" .byte 0 ; [53] .byte $0C,$0C .byte $0d ;[37] .byte "screen-driver" ;[37] .byte 0 ; [53] .byte $30,$30 ;[37] .byte $12 .byte "terminal-emulation" .byte 0 ; [53] .byte $0F,$0F .byte $09 ;[17] .byte "word-size" ;[17] .byte 0 ; [53] .byte $2a,$2a shocmd: .byte $11 ;[DD][17] ; .byte $12 ; Table length with DEFAULT-DISK opt included .byte $03 shodef: .byte "all" .byte 0 ; [53] .byte $00,$00 .byte $04 ;[17] .byte "baud" ;[17] .byte 0 ; [53] .byte $7e,$7e ;[17] .byte $09 .byte "debugging" .byte 0 ; [53] .byte $51,$51 ; .byte $0C ; .asciz /DEFAULT-DISK/ ; .byte $a0,$a0 .byte $11 .byte "eight-bit-quoting" .byte 0 ; [53] .byte $48,$48 .byte $06 .byte "escape" .byte 0 ; [53] .byte $09,$09 .byte $0E .byte "file-byte-size" .byte 0 ; [53] .byte $63,$63 .byte $09 .byte "file-type" .byte 0 ; [53] .byte $5A,$5A .byte $0C .byte "file-warning" .byte 0 ; [53] .byte $3F,$3F .byte $0C ;[24] .byte "flow-control" ;[24] .byte 0 ; [53] .byte $90,$90 ;[24] .byte $03 ; .byte "ibm" .byte 0 ; [53] .byte $12,$12 .byte $0A .byte "local-echo" .byte 0 ; [53] .byte $1B,$1B .byte $06 .byte "parity" .byte 0 ; [53] .byte $75,$75 .byte $07 .byte "receive" .byte 0 ; [53] .byte $24,$24 .byte $0F ;[DD] .byte "rs232-registers" ;[DD] .byte 0 ; [53] .byte $6C,$6C ;[DD] .byte $04 .byte "send" .byte 0 ; [53] .byte $2D,$2D .byte $12 .byte "terminal-emulation" .byte 0 ; [53] .byte $36,$36 .byte $09 ;[17] .byte "word-size" ;[17] .byte 0 ; [53] .byte $87,$87 ;[17] stscmd: .byte $07 .byte $14 .byte "eight-bit-quote-char" .byte 0 ; [53] .byte $06,$06 .byte $0B .byte "end-of-line" .byte 0 ; [53] .byte $09,$09 .byte $0D .byte "packet-length" .byte 0 ; [53] .byte $0C,$0C .byte $08 .byte "pad-char" .byte 0 ; [53] .byte $00,$00 .byte $07 .byte "padding" .byte 0 ; [53] .byte $03,$03 .byte $0A .byte "quote-char" .byte 0 ; [53] .byte $0F,$0F .byte $07 .byte "timeout" .byte 0 ; [53] .byte $12,$12 ftcmd: .byte $05 .byte $05 ftcdef: .byte "ascii" .byte 0 ; [53] .byte $00,$00 .byte $06 .byte "binary" .byte 0 ; [53] .byte $03,$03 .byte $07 .byte "c-power" .byte 0 .byte $04,$04 .byte $07 .byte "petscii" .byte 0 ; [53] .byte $01,$01 .byte $06 .byte "script" .byte 0 ; [53] .byte $02,$02 parkey: .byte $05 ; LENGTH OF THIS TABLE IS 5 .byte $04 ; .byte "even" ; .byte 0 ; [53] .byte $04,$04 ; .byte $04 ; .byte "mark" ; .byte 0 ; [53] .byte $02,$02 ; .byte $04 ; .byte "none" ; .byte 0 ; [53] .byte $00,$00 ; .byte $03 ; .byte "odd" ; .byte 0 ; [53] .byte $03,$03 ; .byte $05 ; .byte "space" ; .byte 0 ; [53] .byte $01,$01 ; bdkey: .byte $03 .byte $03 .byte "300" .byte 0 .byte $00,$00 .byte $04 .byte "1200" .byte 0 .byte $01,$01 .byte $04 .byte "2400" .byte 0 ; [53] .byte $02,$02 debkey: .byte $03 ; LENGTH OF THIS TABLE IS 3 .byte $03 ; .byte "off" ; .byte 0 ; [53] .byte $00,$00 ; .byte $05 ; .byte "terse" ; .byte 0 ; [53] .byte $01,$01 ; .byte $07 ; .byte "verbose" ; .byte 0 ; [53] .byte $02,$02 ; fbskey: .byte $02 .byte $09 .byte "eight-bit" .byte 0 ; [53] .byte $00,$00 .byte $09 .byte "seven-bit" .byte 0 ; [53] .byte $01,$01 oncmd: .byte $02 .byte $02 .byte "on" .byte 0 ; [53] .byte $01,$01 .byte $03 .byte "off" .byte 0 ; [53] .byte $00,$00 yescmd: .byte $02 .byte $02 .byte "no" .byte 0 ; [53] .byte $00,$00 .byte $03 .byte "yes" .byte 0 ; [53] .byte $01,$01 scrkey: .byte $05 ;[37] .byte $0a ;[37] .byte "40-columns" ;[37] .byte 0 ; [53] .byte $00,$00 ;[37] .byte $0a ;[37] .byte "80-columns" ;[37] .byte 0 ; [53] .byte $01,$01 ;[37] .byte 5 .byte "bi-80" .byte 0 .byte $03,$03 .byte $0d .byte "commodore-128" .byte 0 .byte $02,$02 .byte $0c .byte "custom-bi-80" .byte 0 .byte $04,$04 termemu:.byte $03 ;terminal emulation may be none, vt52 or vt100 .byte $04 .byte "none" .byte 0 .byte $00,$00 .byte $06 .byte "vt-100" .byte 0 .byte $02,$02 .byte $05 .byte "vt-52" .byte 0 .byte $01,$01 colors: .byte $10 ; color names .byte $05 .byte "black" .byte $00 .byte $00,$00 .byte $04 .byte "blue" .byte $00 .byte $06,$06 .byte $05 .byte "brown" .byte $00 .byte $09,$09 .byte $04 .byte "cyan" .byte $00 .byte $03,$03 .byte $09 .byte "dark-grey" .byte $00 .byte $0b,$0b .byte $05 .byte "green" .byte $00 .byte $05,$05 .byte $0a .byte "light-blue" .byte $00 .byte $0e,$0e .byte $0b .byte "light-green" .byte $00 .byte $0d,$0d .byte $0a .byte "light-grey" .byte $00 .byte $0f,$0f .byte $09 .byte "light-red" .byte $00 .byte $0a,$0a .byte $0b .byte "medium-grey" .byte $00 .byte $0c,$0c .byte $06 .byte "orange" .byte $00 .byte $08,$08 .byte $06 .byte "purple" .byte $00 .byte $04,$04 .byte $03 .byte "red" .byte $00 .byte $02,$02 .byte $05 .byte "white" .byte $00 .byte $01,$01 .byte $06 .byte "yellow" .byte $00 .byte $07,$07 ;ddskey: .byte $01 ; .byte $05 ; .asciz /DRIVE/ ; .byte $00,$00 kerehr: .byte cmcfm ; tell them they can also confirm .byte nul ; end help command string kereht: .byte cmtxt ;[] .byte nul kerhlp: .byte cr .byte "Kermit commands for this version are:" .byte cr .byte cr .byte "Bye Shut down and log out a" ; new command .byte cr ; .byte " remote Kermit server, then" ; .byte cr ; .byte " exit." ; .byte cr .byte cr .byte "Connect Allow user to talk to remote" .byte cr .byte " Kermit directly." .byte cr .byte cr ; .ascii /dos send dos command to disk/ ;[DD] .byte "Directory List disk directory." ;[] .byte cr .byte cr .byte "Disk Send command string to disk." ;[] .byte cr .byte cr .byte "Exit Exit from Kermit back to" .byte cr .byte " the host operating system." .byte cr .byte cr .byte "Finish Shut down remote Kermit" ; new command .byte cr ; .byte " server but do not log out" ; .byte cr ; .byte " remote job. Do not exit from" ; .byte cr ; .byte " local Kermit." ; .byte cr .byte cr .byte "Get Fetch a file from a remote" ; new command .byte cr ; .byte " server Kermit. The filename" ; .byte cr ; .byte " is validated by the remote" ; .byte cr ; .byte " server." ; .byte cr ; .byte cr ; .byte "Quit Same as exit." .byte cr .byte cr .byte "Receive Receive a file or file group" .byte cr .byte " from the remote host." .byte cr .byte cr .byte "Restore Restore Kermit parameters" ;[47] .byte cr .byte " from file KERMIT.INI." .byte cr .byte cr .byte "Save Save Kermit parameters in" ;[47] .byte cr .byte " file KERMIT.INI." .byte cr .byte cr .byte "Send Sends a file from the" .byte cr .byte " Commodore to the remote" .byte cr .byte " host." .byte cr .byte cr .byte "Set Establish various parameters," .byte cr .byte " such as debugging mode, eol" .byte cr .byte " character, and transmission" .byte cr .byte " delay." .byte cr .byte cr .byte "Show Display various parameters" .byte cr .byte " established by the set" .byte cr .byte " command." .byte cr .byte cr .byte "Status Give information about the" .byte cr .byte " last file transfer." .byte cr,nul inthlp: .byte "One of the following:" .byte cr .byte " ? - this help message." .byte cr .byte " b - send a break signal." .byte cr .byte " c - close the connection." .byte cr .byte " s - status of connection." .byte cr .byte " 0 - send a null." .byte cr .byte " escape-char - transmit the escape character." .byte cr,nul .SBTTL Message Text ermes1: .byte cr .byte "? Unrecognized command" .byte 0 ; [53] ermes2: .byte cr .byte "? Illegal character" .byte 0 ; [53] ermes3: .byte cr .byte "? Not confirmed" .byte 0 ; [53] ermes4: .byte cr .byte "? Integer out of range" .byte 0 ; [53] ermes5: .byte cr .byte "? ASCII character is not in proper range" .byte 0 ; [53] ermes6: .byte cr .byte "? Expecting keyword" .byte 0 ; [53] ermes7: .byte cr .byte "? Expecting file spec" .byte 0 ; [53] ermes8: .byte cr .byte "? Expecting integer" .byte 0 ; [53] ermes9: .byte cr .byte "? Expecting switch" .byte 0 ; [53] ermesa: .byte cr .byte "?" .byte 0 ; [53] ermesb: .byte cr .byte "? Null string found while looking for text" .byte 0 ; [53] ermesc: .byte cr .byte "? Could not send generic logout packet" .byte 0 ; [53] ermesd: .byte cr .byte "? Could not send generic finish packet" .byte 0 ; [53] ermesf: .byte cr .byte "? Drive number out of range" .byte 0 ; [53] erms0a: .byte "Disk error stat = " .byte 0 ; [53] erms10: .byte "Cannot receive init " .byte 0 ; [53] erms11: .byte "Cannot receive file-head" .byte 0 ; [53] erms12: .byte "Cannot receive data " .byte 0 ; [53] erms14: .byte "Max retry count exceeded" .byte 0 ; [53] erms15: .byte "Bad chksum:pack, actual " .byte 0 ; [53] erms16: .byte "Program error in rpak " .byte 0 ; [53] erms17: .byte "8-bit quoting refused " .byte 0 ; [53] erms18: .byte "Transfer aborted by user" .byte 0 ; [53] erms19: .byte "Cannot alter filename " .byte 0 ; [53] erms1a: .byte "File already exists " .byte 0 ; [53] kerftp: .byte "ascii " .byte 0 ; [53] .byte "petscii " .byte 0 ; [53] .byte "script " .byte 0 ; [53] .byte "binary " .byte 0 ; [53] .byte "c-power " .byte 0 kerprs: .byte "none " ; parity strings .byte 0 ; [53] .byte "space" ; .byte 0 ; [53] .byte "mark " ; .byte 0 ; [53] .byte "odd " ; .byte 0 ; [53] .byte "even " ; .byte 0 ; [53] parval: .byte $00 ;[17] None .byte $e0 ;[17] Space .byte $a0 ;[17] Mark .byte $20 ;[17] Odd .byte $60 ;[17] Even kerbds: .byte "300 " .byte 0 .byte "1200" .byte 0 .byte "2400" .byte 0 bdval: .word $0645,$0645 ; 300 baud, slow + fast modes .word $013c,$0148 ; 1200 baud, slow + fast modes .word $0071,$0074 ; 2400 baud, doesn't work well in slow mode kerdms: .byte "off " ; Debug mode strings .byte 0 ; [53] .byte "terse " ; .byte 0 ; [53] .byte "verbose " ; .byte 0 ; [53] kertms: .byte "none " ; terminal emulation strings .byte 0 .byte "vt-52 " .byte 0 .byte "vt-100" .byte 0 kerrts: .byte "Spak: Sending - " .byte 0 ; [53] .byte "Spakch: Send complete - " .byte 0 ; [53] .byte "Rpak: Trying to receive - " .byte 0 ; [53] .byte "Rpkfls: Failed to receive - " .byte 0 ; [53] .byte "Rpkret: Received - " .byte 0 ; [53] debms1: .byte "Additional data" .byte 0 ; [53] debms2: .byte " Seq number " .byte 0 ; [53] debms3: .byte " Number of data chars " .byte 0 ; [53] debms4: .byte " Packet checksum " .byte 0 ; [53] snin01: .byte "Sending: packet no. " .byte 0 ; [53] rcin01: .byte "Waiting: packet no. " .byte 0 ; [53] shin00: .byte "Debugging is " .byte 0 ; [53] shin01: .byte "Terminal emulation is " .byte 0 ; [53] shin02: .byte "Ibm-mode is " .byte 0 ; [53] shin03: .byte "Local-echo is " .byte 0 ; [53] shin04: .byte "Eight-bit-quoting is " .byte 0 ; [53] shin05: .byte "File-warning is " .byte 0 ; [53] shin06: .byte "Escape character is " .byte 0 ; [53] shin07: .byte "Send" .byte 0 ; [53] shin08: .byte " Eight-bit-quoting char is " .byte 0 ; [53] shin09: .byte " End-of-line character is " .byte 0 ; [53] shin10: .byte " Packet-length is " .byte 0 ; [53] shin11: .byte " Padding character is " .byte 0 ; [53] shin12: .byte " Amount of padding is " .byte 0 ; [53] shin13: .byte " Quote character is " .byte 0 ; [53] shin14: .byte " Timeout character is " .byte 0 ; [53] shin15: .byte "Receive" .byte 0 ; [53] shin16: .byte "File-type mode is " .byte 0 ; [53] shin17: .byte "File-byte-size is " .byte 0 ; [53] shin18: .byte "RS-232 registers = $" .byte 0 ; [53] shin19: .byte "Baud rate is " ;[17] .byte 0 ; [53] shin20: .byte "Parity is " ; FOR /SHOW PARITY/ .byte 0 ; [53] shin21: .byte "Word-size is " ;[17] .byte 0 ; [53] shin22: .byte "Flow-control is " ;[24] .byte 0 ; [53] shin23: .byte "Default-drive is " .byte 0 ; [53] shon: .byte "on" .byte 0 ; [53] shoff: .byte "off" .byte 0 ; [53] shsbit: .byte "seven-bit" .byte 0 ; [53] shebit: .byte "eight-bit" .byte 0 ; [53] sstrng: .byte "Sending: " ; for terse debug .byte 0 ; [53] rstrng: .byte "Received: " ; ... .byte 0 ; [53] stin00: .byte "Number of data chars sent is: " .byte 0 ; [53] stin01: .byte "Number of data chars received is: " .byte 0 ; [53] stin02: .byte "Total no. of chars sent is: " .byte 0 ; [53] stin03: .byte "Total no. of chars received is: " .byte 0 ; [53] stin04: .byte "Overhead for send packets is: " .byte 0 ; [53] stin05: .byte "Overhead for receive packets is: " .byte 0 ; [53] stin06: .byte "Last error encountered is: " .byte 0 ; [53] inf01a: .byte "[Connecting to host: type " .byte 0 ; [53] inf01b: .byte " c to return]" ; second half of connect message .byte 0 ; [53] .SBTTL General Screen Manipulation Routines ; ; These routines perform screen manipulation functions. The usually ; call a screen driver, but some call lower-level manipulation routines. ; ; These routines all turn the cursor off before calling the screen ; driver. ; ; ; scrini - call the screen drivers initilization code ; ; Input: None ; Output: Assorted screen parameters are set ; ; Registers destroyed - A,X,Y ; ; This routine initilizes some parameters and calls all of the screen ; drivers initilization code. ; scrini: lda #$00 sta line25 ; the 25th line is a status line jsr c40ini jsr c80ini jsr c28ini jsr b80ini jsr m80ini rts ; ; scrent - start up a screen driver ; ; Input: Screen type in scrtype ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine sets some parameters and then calls the screen driver to ; start it and set its parameters. It then calls scred2 to erase the ; screen. ; scrent: lda #$00 ; cursor starts at row 1, column 1 sta cx sta cy jsr scrent1 ; call the screen driver jsr scrtxt ; initialize screen driver in text mode jsr scrrst ; reset parameters to normal values lda line25 ; save the status of the 25th line pha lda #$01 ; allow the 25th line to be cleared sta line25 jsr scred2 ; clear entire screen pla ; restore the status of the 25th line sta line25 rts ; all done scrent1:ldy scrtype jsr case .word c40ent .word c80ent .word c28ent .word b80ent .word m80ent ; ; scrext - exit from the screen driver ; ; Input: Screen type in scrtype ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine calls the screen driver to exit. The hardware is returned ; to the state it was left in before kermit started. ; scrext: ldy scrtype jsr case .word c40ext .word c80ext .word c28ext .word b80ext .word m80ext ; ; scrrst - reset the screen parameters to normal values ; ; Input: None ; Output: Assorted parameters changed. ; ; Registers destroyed - A ; ; This routine sets reverse mode off, flashing off, the scrolling ; region to full size, and many other things ; scrrst: lda #0 ; top of scrolling area is line 1 sta top lda #23 ; bottom of scrolling area is line 24 clc adc line25 ; or 25 sta bot lda #$00 sta underln ; underline is off sta reverse ; reverse is off sta alternt ; alternt colors are off sta flash ; flashing is disabled sta deckpam ; keypad is numeric sta decckm ; cursor is in application mode sta decrev ; screen is not reversed sta decom ; use absolute cursor addressing. not origion sta lmn ; new line mode is clear sta irm ; insert replace mode is replace sta g0 ; mount U.S. character set on g0 sta g1 ; mount U.S. character set on g1 sta gx ; select g0 lda #$01 sta wrap ; autowrap is on sta decanm ; vt100 is not emulating a vt52 sta decarm ; keys repeat by default jsr scrsav ; make these as the saved parameters ldx #79 ; set/clear the tab stops for 80 columns scrrst1:txa and #$07 ; one tab stop every 8 characters sta tabs,x ; put the entry in tabs dex bpl scrrst1 ; repeat for every column jsr scrset ; tell the screen driver that things changed rts ; all done ; ; scrset - reset the hardware after a "set screen xxxx" command ; ; Input: Screen type in scrtype. ; Assorted screen parameters ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine adjusts the hardware after a set command. ; scrset: ldy scrtype jsr case .word c40set .word c80set .word c28set .word b80set .word m80set ; ; screee - fill screen with 'E's ; ; Input: Screen type in scrtype ; Output: Screen is filled with 'E's ; ; This routine simply fills the screen with 'E's. Real exciting. ; screee: jsr scroff ; turn cursor off now so we can use scrput3 lda cx ; save the cursor x and y coordinates pha lda cy pha jsr scrbot ; determine the line number of the bottom line sta cy ; row to start filling at screee2:jsr scrrgh ; determine the column number of the far right sta cx jsr flowch ; kludge. Sends XOFF when/if necessary screee1:lda #'E-$20 ; 'E' in funny-ascii jsr scrput3 ; scrput has too much overhead. scrput3 works dec cx ; repeat till all of this line is done bpl screee1 dec cy ; repeat till all lines done bpl screee2 pla ; restore cursor x and y coordinates sta cy pla sta cx rts ; all done ; ; scrput - put a character on the screen ; ; Input: Character to put in a-reg. ; Screen type in scrtype. ; Output: Screen ram, both color rams, and cursor position are changed. ; ; Registers destroyed - A,X,Y ; ; This routine puts a character on the screen. It advances the cursor ; and scrolls the screen when necessary. It handels a carriage ; return specially. It prints a carriage return and line feed. ; This can only happen in the parser since telnet handels cr and lf ; special. ; scrput: cmp #$0d ; is it a carriage return? bne scrput4 ; no jsr scrcr ; yes. Do a carriage return and line feed jsr scrlf rts scrput4:ldx irm ; insert replace mode set? beq scrput6 pha ; save character to print jsr scrirm ; make room for it pla ; remember character to print scrput6:cmp #'` ; is this different in the graphics charset bcc scrput5 ; no. ldx gx ; which character set is mouned ldy g0,x ; is the mounted charset graphics beq scrput5 ; no clc ; if grapics, add in 31 adc #31 scrput5:sec ; convert to funey-ascii by subtracting $20 sbc #$20 pha ; save the character to put jsr scroff ; cant use screen driver while cursor blinks ldx cx ; check if cursor at rightmost edge jsr scrrgh pla ; restore character to put bcc scrput2 ; no ldx wrap ; are we in wrap mode beq scrput3 ; no. do not wrap pha ; save the character to put jsr scrcr ; yes. do a carriage return jsr scrlf ; and a linefeed pla ; restore the character to put scrput2:jsr scrput3 ; call the routine to put a character. inc cx rts scrput3:ldy scrtype ; call the screen driver jsr case .word c40put .word c80put .word c28put .word b80put .word m80put ; ; scrirm - make room for a character in insert/replace mode ; scrirm: jsr scroff ; cant use screen driver while cursor blinks ldy scrtype ; call the screen driver jsr case .word c40irm .word c80irm .word c28irm .word b80irm .word m80irm ; ; scrdch - delete one or more characters ; Input: Number of characters to delete in A-reg ; screen type in scrtype ; scrdch: pha ; save number of characters to delete jsr scroff ; cant use screen driver while cursor blinks pla ldy scrtype jsr case .word c40dch .word c80dch .word c28dch .word b80dch .word m80dch ; ; scral - insert one or more lines ; ; Input: Number of lines to add in A-reg ; Cursor position in cx, cy ; Dimensions of scrolling region on top, bot ; Screen type in scrtype ; scral: tax ; save number of lines to add ldy bot ; see if cursor is below scrolling region cpy cy bcc scral2 ldy cy ; see if cursor is above scrolling region cpy top bmi scral2 lda top pha ; save the top of the scrolling region sty top ; set top to cy txa ; restore number of lines to add jsr scral1 ; go do it pla sta top scral2: rts scral1: pha jsr scroff ; cannot run screen driver with cursor on pla ; restore number of lines to add ldy scrtype jsr case .word c40ri .word c80ri .word c28ri .word b80ri .word m80ri ; ; scrdl - delete one or more lines ; ; Input: Number of lines to delete in A-reg ; Cursor position in cx, cy ; Dimensions of scrolling region on top, bot ; Screen type in scrtype ; scrdl: tax ; save number of lines to delete ldy bot ; see if cursor is below scrolling region cpy cy bcc scrdl2 ldy cy ; see if cursor is above scrolling region cpy top bmi scrdl2 lda top pha ; save the top of the scrolling region sty top ; set top to cy txa ; restore number of lines to delete jsr scrdl1 ; go do it pla sta top scrdl2: rts scrdl1: pha jsr scroff ; cannot run screen driver with cursor on pla ; restore number of lines to delete ldy scrtype jsr case .word c40ind .word c80ind .word c28ind .word b80ind .word m80ind ; ; scrcr - perform a carriage return ; ; Input: Screen type in scrtype. ; Cursor position in cx, cy ; ; Output: New new cursor column in cx. ; ; Registers destroyed - A,X,Y ; ; This routine performs a carriage return. ; scrcr: ldy cy ldx #$00 ; put cursor in column zero jsr scrplt ; move the cursor there rts ; all done ; ; scrlf - perform a line feed ; ; Input: screen type in scrtype ; cursor column in cy ; cursor row in cx ; Output: New cursor position in cx, cy. ; ; Registers destroyed - A,X,Y ; ; This routine performs a line feed. ; scrlf: ldy cy ; check if bottom reached cpy bot bcc scrlf1 ; yes. scroll screen jmp scrind scrlf1: iny ldx cx jsr scrplt ; no. move the cursor down one line. rts ; ; scrrlf - perform a reverse line feed with scrolling ; ; Input: Type of screen in scrtype ; Cursor coordinates in cx, cy ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine performs a reverse line feed. The cursor is moved up ; one line. If the cursor reaches the top of the scrolling area, scrri ; is called to scroll the screen backwards. ; scrrlf: ldy cy cpy top beq scrrlf1 ; reached top of the screen? dey ; no, just move the cursor up ldx cx jsr scrplt rts scrrlf1:jsr scrri ; yes, at top of screen. Scroll backwards rts ; ; scru - move the cursor up stopping at the top of the screen ; ; Input: Type of screen in scrtype ; Cursor coordinates in cx, cy ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine moves the cursor up. If the cursor reaches the top ; of the screen it stops. ; scru: ldy cy beq scru1 ; at top of screen? dey ldx cx jsr scrplt ; move the cursor to its new position scru1: rts ; ; scrd - move the cursor down stopping at the bottom of the screen ; ; Input: Type of screen in scrtype ; Cursor coordinates in cx, cy ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine moves the cursor down. If the cursor reaches the bottom ; of the screen it stops. ; scrd: ldy cy iny jsr scrbot ; test to see if cursor past bottom bcs scrd2 ; if so, dont move cursor ldx cx jsr scrplt ; put the cursor at its new position scrd2: rts ; all done ; ; scrl - move the cursor left stopping at the left side of the screen ; ; Input: Type of screen in scrtype ; Cursor coordinates in cx, cy ; ; Output: New cursor coordinates in cx, cy ; ; Registers Destroyed: A,X,Y ; ; This routine moves the cursor left. If the cursor reaches the left ; most side of the display, it stops. ; scrl: ldx cx beq scrl1 ; at left side of screen? dex ldy cy jsr scrplt ; move the cursor to its new position scrl1: rts ; ; scrr - move the cursor right stopping at the right side of the screen ; ; Input: Type of screen in scrtype ; Cursor coordinates in cx, cy ; ; Output: New cursor coordinates in cx, cy ; ; Registers Destroyed: A,X,Y ; ; This routine moves the cursor right. If the cursor reaches the right ; side of the screen it stops. ; scrr: ldx cx scrr1: inx ; move the cursor right jsr scrrgh ; check if past rightmost edge bcs scrr2 ldy cy jsr scrplt ; move the cursor to its new position scrr2: rts ; all done ; ; scrind - perfrom the VT100 index function (scroll the screen one line) ; ; Input: Screen type in scrtype ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen down one line. It calls either c40ind, ; c80ind, or c28ind depending on the screen type. ; scrind: jsr scroff ; cant use screen driver while cursor blinks ldy scrtype lda #$01 jsr case .word c40ind .word c80ind .word c28ind .word b80ind .word m80ind ; ; scrri - perfrom the VT100 reverse index function (scroll backwards) ; ; Input: Screen type in scrtyp ; Output: Screen and color rams are changed ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen up one line. It calls either c40ri, ; c80ri, or c28ri depending on the screen type. ; scrri: jsr scroff ; cant use screen driver while cursor blinks ldy scrtype lda #$01 jsr case .word c40ri .word c80ri .word c28ri .word b80ri .word m80ri ; ; scrclr - home and clear the screen ; ; This routine homes the cursor and clears the screen ; scrclr: jsr scrhom ; home the cursor jsr scred2 ; clear the screen rts ; all done ; ; scrhom - home the cursor ; ; This routine homes the cursor ; scrhom: ldx #$00 ; home is at 0,0 ldy #$00 jsr scrplt ; plot the cursor rts ; all done ; ; scred0 - perform the Erase Display #0 VT100 function ; ; Input: Type of screen to erase in scrtype ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine clears from the cursor position to the end of the screen. ; This routine works in 40 column mode, 80 column mode, or Commodore 128 ; mode. ; scred0: lda cy ; save the cursor y position pha jsr screl0 ; erase from the cursor to the line scred0b:inc cy ; do the next line ldy cy jsr scrbot ; on bottom line? bcs scred0a ; yes. jsr screl2 ; erase all of this line jmp scred0b ; repeat till done scred0a:pla ; restore cursor y position sta cy rts ; all done ; ; scred1 - perform the Erase Display #1 VT100 function ; ; Input: Type of screen to erase in scrtype ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine clears from the beginning of the screen to the cursor. ; This routine works for 40 column mode, 80 column mode, and commodore ; 128 mode. ; scred1: lda cy ; save the cursor y position pha jsr screl1 ; erase from beginning of line to cursor dec cy ; go up one line bmi scred1a ; on top of screen scred1b:jsr screl2 ; erase all of this line dec cy bpl scred1b ; repeat till done scred1a:pla ; restore cursor position sta cy rts ; all done ; ; scred2 - perform the Erase Display #2 VT100 function (clear screen) ; ; Input: Type of screen to erase in scrtype ; ; Output: None ; ; Registers Destroyed: A,X,Y ; ; This routine clears the entire screen in either 40 column mode, ; 80 column mode, or c128 mode. It calls screl2 to do the dirty work. ; scred2: lda cy ; save the cursor y position pha jsr scrbot ; get bottom of screen sta cy scred2a:jsr screl2 ; erase the line dec cy ; do the next line bpl scred2a ; repeat till done pla ; restore cursor position sta cy rts ; all done ; ; screl0 - Perform the VT100 Erase Line function #0 ; ; Input: Line number to erase in cy ; Screen type in scrtyp ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the cursor to the end of the line ; screl0: jsr scroff ; cant use screen driver while curosr blinks ldy scrtype ; which routine to use jsr case .word c40el0 .word c80el0 .word c28el0 .word b80el0 .word m80el0 ; ; screl1 - Perform the VT100 Erase Line function #1 ; ; Input: Line number to erase in cy ; Screen type in scrtyp ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the beginning of line to the cursor ; screl1: jsr scroff ; cant use screen driver while curosr blinks ldy scrtype ; which routine to use jsr case .word c40el1 .word c80el1 .word c28el1 .word b80el1 .word m80el1 ; ; screl2 - Perform the VT100 Erase Line function #2 ; ; Input: Line number to erase in cy ; Type of screen in scrtype ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases one line compleatly. ; screl2: jsr scroff ; cant use screen driver while cursor blinks ldy scrtype ; which routine to use to erase jsr case ; go to proper routine .word c40el2 ; erase one line on 40 column screen .word c80el2 ; erase one line on 80 column screen .word c28el2 ; erase one line on the commodore-128 screen .word b80el2 ; erase one line on the BI-80 screen .word m80el2 ; erase one line on the modified BI-80 screen ; ; scrsav - save screen attributes and cursor position ; ; Input: screen attributes and cursor position ; ; Output: save1, save2, save3, ... save6 ; ; This routine saves the screen attributes and cursor position ; scrsav: lda cx sta save1 lda cy sta save2 lda alternt sta save3 lda underln sta save4 lda flash sta save5 lda reverse sta save6 lda g0 sta save7 lda g1 sta save8 lda gx sta save9 rts ; ; scrlod - load the saved screen attributes and cursor position ; ; Input: save1, save2, save3, ... save6 ; ; This routine restores the saved screen attributes and cursor position ; scrlod: ldx save1 ldy save2 jsr scrplt lda save3 sta alternt lda save4 sta underln lda save5 sta flash lda save6 sta reverse lda save7 sta g0 lda save8 sta g1 lda save9 sta gx rts ; ; scrplt - plot the cursor ; ; Input: Cursor X position in X-reg ; Cursor Y position in Y-reg ; ; Output: cx and cy are set. ; ; Registers destroyed - A,X,Y ; ; This routine puts the cursor at X,Y. ; scrplt: tya ; save the new y position pha txa ; save the new x position pha jsr scroff ; turn off the cursor pla ; get the new x position sta cx pla ; get the new y position sta cy scrplt1:rts ; all done ; ; scroff - disable the cursor. ; ; Input: cx, cy, curstat, curabrt, scrtype ; ; Output: curabrt ; ; Registers destroyed - A,X,Y ; ; This routine disables the cursor. It calls the proper screen driver ; to do the dirty work. ; scroff: lda curabrt ; is the cursor flash already aborted? bne scroff1 ; yes. lda curstat ; cursor light? beq scroff1 ; yes. sta curabrt ; mark cursor flash as aborted jsr scrtgl ; toggle the cursor scroff1:rts ; all done ; ; scrfls - flash the screen and cursor ; ; Input: curstat - status of cursor (light or dark) ; curabrt - flag indicating if cursor flash was aborted early. ; scrtype - type of screen ; ; Output: curstat - curstat is toggled if time ; curabrt - curabrt is always cleared ; ; Registers destroyed - A,X,Y ; ; This routine flashes the screen and toggles the cursor. This routine ; should be called a frequently as possible. ; scrfls: lda curabrt ; was the cursor flash aborted early? beq scrfls1 ; no. No need to light it. lda #$00 ; clear the abort flag sta curabrt jsr scrtgl ; toggle the cursor scrfls1:jsr rdtim ; check the time tay ; save time for later use sec sbc cntdown cmp #20 ; have 36 jiffies elapsed? bcs scrfls2 ; yes they have rts ; no they havent. stop here scrfls2:sty cntdown ; reset the countdown timer jsr scrtgl ; toggle the cursor status ldy scrtype ; flash the flashing characters jsr case .word c40fls .word c80fls .word c28fls .word b80fls .word m80fls ; ; scrtgl - Toggle the cursor ; ; Input: cx - x coordinate of cursor ; cy - y coordinate of cursor ; Type of screen in scrtype ; ; Output: None ; ; Registers destroyed - A,X,Y ; ; this routine calls the screen driver to toggle the cursor ; scrtgl: lda curstat ; keep track if cursor is dark or light eor #$01 sta curstat ldy scrtype ; call the screen driver jsr case .word c40tgl .word c80tgl .word c28tgl .word b80tgl .word m80tgl ; ; scrbel - stop the sound of the bell ; ; Input: lpcnt - time when the bell sound started ; ; Output: wave is zeroed to stop the bell ; ; This routine stops the sound of the bell if enough jiffys ; have elapsed since it started. ; This routine should be called as often as possible. ; scrbel: jsr rdtim ; what time is it now? sec sbc lpcnt ; subtract the time the bell started cmp #6 ; been 6 jiffys since it started? bcc scrbel1 ; nope. Dont stop the bell yet lda #$00 sta wave ; stop the bell scrbel1:rts ; all done ; ; scrbot - check to see if y-reg is below bottom of screen ; ; Input: line25 ; ; Output: Carry flag set if past bottom of screen ; A-reg holds line number of screen bottom ; ; This routine checks to see if the y-reg is greater than the bottom ; of the screen. scrbot: lda line25 ; check to see if the 25th line is in use bne scrbot1 ; branch if it is lda #23 cpy #24 rts scrbot1:lda #24 ; 25th line is enabled cpy #25 ; lines 25 and up are illegal rts ; ; scrrgh - check to see if x-reg is past right margin of screen ; ; Input: scrtype ; ; Output: Carry flag set if past right margin of screen ; A-reg holds right margin of screen ; ; This routine checks to see if the x-reg is greater than the bottom ; of the screen. scrrgh: lda scrtype ; check to see if in 40-column mode beq scrrgh1 ; branch if it is lda #79 cpx #80 rts scrrgh1:lda #39 ; only 40 columns available cpx #40 rts ; ; scrdrw - draw a character in graphics mode ; ; Input: character to draw in a-reg ; place to draw in tektxlo, tektxhi, tektylo, tektylo ; screen driver in scrtype ; Output: char is drawen ; ; This routine calls the screen driver to draw a character in graphics ; mode. ; scrdrw: ldy scrtype jsr case .word c40drw ; 40 column mode .word c80drw ; 80 column mode .word c28drw ; commodore-128 mode .word b80drw ; batteries included .word m80drw ; modified batteries included ; ; scrtek - go into tektronix mode ; ; Input: screen driver in scrtype ; ; This routine calls the proper screen driver to start tektronix mode. ; scrtek: ldy scrtype jsr case .word c40tek ; 40 column mode .word c80tek ; 80 column mode .word c28tek ; commodore-128 mode .word b80tek ; batteries included mode .word m80tek ; modified batteries included mode ; ; scrtxt - return to text mode from tektronix modoe ; ; Input: screen driver in scrtype ; ; This routine calls the proper screen driver to exit tektronix mode. ; scrtxt: lda #$00 sta curstat lda #$01 ; mark cursor flash as aborted sta curabrt ; cursor is off but supposed to be on jsr rdtim ; set cntdown to wait the usual amount of time sta cntdown ldy scrtype jsr case .word c40txt ; 40 column mode .word c80txt ; 80 column mode .word c28txt ; commodore-128 mode .word b80txt ; batteries included mode .word m80txt ; modified batteries included mode ; ; scrlin - draw a line in graphics mode ; ; Input: starting point: tekfxlo, tekfxhi, tekfylo, tekfyhi ; ending point: tektxlo, tektxhi, tektylo, tektyhi ; ; This routine calls the proper screen driver to draw a line. ; scrlin: ldy scrtype jsr case .word c40lin ; 40 column mode .word c80lin ; 80 column mode .word c28lin ; commodore-128 mode .word b80lin ; batteries included mode .word m80lin ; modified batteries included mode ; ; screra - erase the graphics screen ; ; This routine calls the proper screen driver to erase the graphics ; screen. ; screra: ldy scrtype jsr case .word c40era ; 40 column mode .word c80era ; 80 column mode .word c28era ; commodore-128 mode .word b80era ; batteries included mode .word m80era ; modified batteries included mode ; ; scrint - put graphics coordinate into internal form ; ; Input: tekcxlo, tekcxhi, tekcylo, tekcyhi ; screen driver in scrtype ; Output: tektxlo, tektxhi, tektylo, tektylo ; scrint: ldy scrtype jsr case .word c40int ; 40 column mode .word c80int ; 80 column mode .word c28int ; commodore-128 .word b80int ; batteries included mode .word m80int ; modified batteries included mode ; ; scrtst - test to see if a given screen driver is present ; ; Input: Desired screen type in a-reg ; Output: carry clear if present, set otherwise ; ; Registers destroyed - A,X,Y ; ; This routine checks to see if a given screen driver is present. ; Currently the only one that might not be available is the ; Commodore 128 80-column screen. ; scrtst: tay ; device to test for jsr case .word c40tst .word c80tst .word c28tst .word b80tst .word m80tst .SBTTL Modified Batteries Included 80-column screen driver ; ; These routines manipulate the screen using a Batteries Included ; 80-column card with a custom ROM. ; ; ; The only thing different in this screen driver is that this screen ; driver uses the uppercase/graphics half of the character rom. It ; is the half that has been modified. ; ; m80txt - enter text mode (possibly from graphics mode) ; ; If the b80flag is clear, then we are in graphics mode and must ; call the 80-column screen driver to leave it. Otherwise we ; just call a rom routine (on the bi-80 card) to initialize things. ; m80txt: asl b80flag ; test and clear the flag bcs m80txt1 ; skip graphics stuff if not in graphics mode jsr m80ext ; turn off graphics. m80txt1:lda #$37 sta $01 ; turn the rom back on. jsr $80f4 ; initialize 80 column display lda #$36 sta $01 ; back to normal memory map lda #$0c ; put in upper-case/graphics mode sta $df00 lda #$20 sta $df10 rts ; all done m80ini: jmp b80ini m80ent: jmp b80ent m80ext: jmp b80ext m80set: jmp b80set m80put: jmp b80put m80irm: jmp b80irm m80dch: jmp b80dch m80ind: jmp b80ind m80ri: jmp b80ri m80el0: jmp b80el0 m80el1: jmp b80el1 m80el2: jmp b80el2 m80fls: jmp b80fls m80tgl: jmp b80tgl m80tek: jmp b80tek m80drw: jmp b80drw m80lin: jmp b80lin m80era: jmp b80era m80int: jmp b80int m80tst: jmp b80tst .SBTTL Batteries Included 80-column screen driver ; ; These routines manipulate the screen in Batteries Included mode ; ; ; b80ini - initialize the Batteries Included screen. ; ; Input: None ; ; Output: None ; ; This routine does nothing because all the hardware is initialized ; when the 80-column card is entered. ; b80ini: rts ; ; b80ent - enter the Batteries Included screen driver ; ; Input: None ; ; Output: None ; ; This routine sets a flag so that b80txt knows what to do. ; b80ent: lda #$80 sta b80flag rts ; ; b80ext - exit from the Batteries Included screen-driver ; ; Input: None ; ; Output: None ; ; This routine calls the rom routine at $80fd to de-init the CRTC chip ; b80ext: lda #$37 sta $01 ; turn the rom back on. jsr $80fd ; de-init the 80 column display lda #$36 sta $01 ; back to normal memory map lda bordold ; border color fouled up by BI-80 sta $d020 rts ; all done ; ; b80set - change the hardware after a "set screen xxx" command ; ; This routine does nothing because there is nothing on the B80 card ; that can be set. ; b80set: rts ; ; b80put - put a character on the Batteries Included screen ; ; Input: A-reg is the character to put ; cx and cy show where to put it ; ; Output: A character is displayed upon the Batteries Included screen ; ; This routine prints stuff on the Batteries Included screen. It does ; not advance the cursor. ; b80put: ldx #b80map2-b80map1; run it through the translation table b80put1:cmp b80map1-1,x ; look for character less than current bcs b80put2 dex bne b80put1 ; always taken b80put2:sbc b80map1-1,x ; carry already set clc adc b80map2-1,x ; now we have a screen code pha ldx cx ldy cy jsr b80adrt ; compute the address to store char at pla ; remember screen code to store cmp #$20 ; is it a space? beq b80put3 ; dont reverse if highlighted space ldx alternt ; in alternate color mode? beq b80put3 ora #$80 ; yes. Reverse will have to do.... b80put3:ldx reverse ; is reverse on? beq b80put4 ; no. dont reverse ora #$80 b80put4:ldx underln ; underline on? beq b80put5 ora #$80 ; reverse will have to do... b80put5:ldx flash ; flashing on? beq b80put6 ; no, dont reverse ora #$80 ; reverse will have to do... b80put6:ldy #$00 ; finally, store the character sta (dest),y rts ; all done ; ; b80irm - make space for a character if insert replace mode is insert ; b80irm: ldx #$00 ldy cy jsr b80adrt ldy cx b80irm4:lda (dest),y ; who cares what x is the first time? pha txa sta (dest),y pla tax iny cpy #80 bcc b80irm4 rts ; ; b80dch - delete one or more characters. ; ; Input: Number of characters to delete in A-reg ; Cursor position in cx, cy ; b80dch: sta freemem ; save number of characters to delete lda cx b80dch2:pha ; save counter tax ; compute character address ldy cy jsr b80adrt clc ; see if this character should be blank pla pha adc freemem cmp #80 lda #$20 ; get a blank ready bcs b80dch1 ldy freemem ; no blank. get another character ready lda (dest),y b80dch1:ldy #$00 sta (dest),y ; put in the character clc ; now add 1 to the counter and repeat pla adc #$01 cmp #80 bcc b80dch2 ; more characters to handle? rts ; all done ; ; b80ind - scroll the screen in Batteries Included mode ; ; Input: top, bot ; Number of lines to scroll in a-reg ; Output: Batteries Included ram is scrolled ; ; This routine scrolls the area of the Batteries Included screen that ; is between top and bot ; ; This routine is also used by delete line. ; b80ind: tax ; save number of lines to scroll lda cy ; save the cursor y position pha lda top ; top of scrolling region sta cy txa ; push number of lines to scroll pha b80ind1:clc pla pha adc cy cmp bot beq b80ind3 bcs b80ind2 b80ind3:tay ldx #$00 jsr b80adrt ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr b80adrt ldx #10 ; 10 * 8 = 80 bytes to move jsr move8 ; scroll one line inc cy jmp b80ind1 b80ind2:jsr b80el2 ; erase the bottom line inc cy ldy bot cpy cy bcs b80ind1 pla ; discard number of lines to sccroll pla ; restore the cursor position sta cy rts ; ; b80ri - perform the VT100 reverse index function (scroll backwards) ; ; Input: Number of lines to scroll in A-reg ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen upwards in Batteries Include mode. ; Only the area in the scrolling region is changed. ; ; This routine is also used for insert line. ; b80ri: tax ; save number of lines to scroll lda cy ; save the cursor y position pha lda bot ; top of scrolling region sta cy txa ; put number of lines to scroll on stack pha b80ri1: sec pla pha eor #$ff adc cy cmp top ; have we reached the bottom of the region? bmi b80ri2 tay ldx #$00 jsr b80adrt ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr b80adrt ldx #10 ; 10 * 8 = 80 bytes to move jsr move8 ; scroll one line dec cy jmp b80ri1 ; repeat until done b80ri2: jsr b80el2 ; erase the bottom line dec cy ldy cy cpy top bpl b80ri1 pla ; discard number of lines to scroll pla ; restore the cursor position sta cy rts ; ; b80el0 - erase from the cursor to the end of the current line ; ; Input: Cursor y coordinate in cy ; ; Output: A line is cleared on the Batteries Included card ; ; This routine erases one line starting at the cursor ; b80el0: ldy cy ; compute address of line to clear ldx cx jsr b80adrt ldy #$00 ldx cx lda #$20 ; clear with spaces b80el0a:sta (dest),y iny inx cpx #80 bcc b80el0a ; repeat till column 80 is cleared rts ; all done ; ; b80el1 - erase from the beginning of the line to the cursor ; ; Input: cy ; ; Output: spaces written to the Batteries Included screen ; ; This routine erases form the beginning of the current line to the ; cursor ; b80el1: ldy cy ; compute address to erase ldx #$00 jsr b80adrt lda #$20 ldy #$00 b80el1a:sta (dest),y ; erase text iny cpy cx ; repeat till done bcc b80el1a beq b80el1a rts ; all done ; ; b80el2 - erase one line totally ; ; Input: line to erase in cy ; ; Output: stuff written to the Batteries Included screen ; ; This routine erases one line completly from the Batteries Included ; screen ; b80el2: ldy cy ; compute address to erase ldx #$00 jsr b80adrt ldx #10 ; 10 * 8 = 80 bytes to erase lda #$20 jsr fill8 rts ; ; b80fls - flash the screen Batteries Included mode ; ; Input: None ; ; Output: None ; ; This routine does nothing because it is not possible to flash the ; Batteries Included screen b80fls: rts ; ; b80tgl - toggle the cursor in Batteries included mode ; ; Input: cx, cy ; ; Output: The cursor is toggled ; ; This routine toggles the cursor in Batteries Included mode ; b80tgl: ldy cy ; get the address to toggle ldx cx jsr b80adrt ldy #$00 ; toggle it lda (dest),y eor #$80 sta (dest),y rts ; all done ; ; b80txt - enter text mode (possibly from graphics mode) ; ; If the b80flag is clear, then we are in graphics mode and must ; call the 80-column screen driver to leave it. Otherwise we ; just call a rom routine (on the bi-80 card) to initialize things. ; b80txt: asl b80flag ; test and clear the flag bcs b80txt1 ; skip graphics stuff if not in graphics mode jsr b80ext ; turn off graphics. b80txt1:lda #$37 sta $01 ; turn the rom back on. jsr $80f4 ; initialize 80 column display lda #$0e ; put in uppercase/lowercase mode jsr chrout jsr restoi ; restore operating system lda #$36 sta $01 ; back to normal memory map rts ; all done ; ; b80tek - enter tektronix mode ; ; Since there is no graphics support on the batteries included ; card, we go to 80-column mode. ; b80tek: jsr b80ext ; exit b80 screen driver jsr c80ent ; enter 80 column screen driver jsr c80tek ; set up for graphics rts ; ; graphics routines. ; b80drw: jmp c80drw b80lin: jmp c80lin b80era: jmp c80era b80int: jmp c80int ; b80adrt - compute the text address of x,y ; ; Input: x and y coordinates in X-reg and Y-reg ; ; Output: text address in (dest) ; ; This routine calculates the address of text ram associated ; with x,y ; b80adrt:jsr c28adr ; compute the base address clc ; add in the address of attribute ram lda dest+1 adc #b80text^ sta dest+1 rts ; ; b80tst - test to see if the Batteries Included screen driver is present ; ; Input: None ; ; Output: carry set if Battries Included 80-column display not present ; ; Registers destroyed - A, X ; ; This routine returns with the carry clear if Batteries Included ; screen is available. If it isn't, it returns with the carry set ; b80tst: lda #$37 ; turn on the rom before reading from it sta $01 ldx #b80tst4-b80tst3; look for "batteries included" at $8009 b80tst2:lda b80tst3-1,x cmp $8009-1,x bne b80tst1 dex bne b80tst2 lda #$36 ; restore ram sta $01 clc ; found "batteries included". Is available rts b80tst1:lda #$36 ; restore ram sta $01 sec ; is not available rts b80tst3:.byte "BATTERIES INCLUDED" b80tst4: ; ; b80map - translation table. 'funky' ascii -> screen code. ; ; This table translates 'funky' ascii into screen codes. ; b80map1:.byte $00 ; ' ' to '?' .byte $20 ; '@' .byte $21 ; 'A' to 'Z' .byte $3b ; '[' .byte $3c ; '\' .byte $3d ; ']' to '^' .byte $3f ; '_' .byte $40 ; '`' .byte $41 ; 'a' to 'z' .byte $5b ; '{' .byte $5c ; '|' .byte $5d ; '}' .byte $5e ; '~' .byte $5f ; diamond .byte $60 ; square .byte $61 ; h-t .byte $62 ; f-f .byte $63 ; c-r, l-f, degrees, plus/minus .byte $67 ; n-l .byte $68 ; v-t .byte $69 ; upper-left .byte $6a ; lower-left .byte $6b ; lower-right .byte $6c ; upper-right .byte $6d ; crossed lines .byte $6e ; scan 1, scan 3, scan 5, scan 7 .byte $72 ; scan 9 .byte $73 ; middle-right .byte $74 ; middle-left .byte $75 ; upper-middle, lower-middle .byte $77 ; vertical line .byte $78 ; <= .byte $79 ; >= .byte $7a ; pi .byte $7b ; != .byte $7c ; british pund .byte $7d ; dot b80map2:.byte $20 ; ' ' to '?' .byte $00 ; '@' .byte $41 ; 'A' to 'Z' .byte $1b ; '[' .byte $7f ; '\' .byte $1d ; ']' to '^' .byte $64 ; '_' .byte $7e ; '`' .byte $01 ; 'a' to 'z' .byte $75 ; '{' .byte $69 ; '|' .byte $76 ; '}' .byte $5f ; '~' .byte $40 ; diamond .byte $66 ; square .byte $5c ; h-t .byte $7c ; f-f .byte $60 ; c-r, l-f, degrees, plus/minus .byte $65 ; n-l .byte $67 ; v-t .byte $7d ; upper-left .byte $6e ; lower-left .byte $70 ; lower-right .byte $6d ; upper-right .byte $5b ; crossed lines .byte $77 ; scan 1, scan 3, scan 5, scan 7 .byte $6f ; scan 9 .byte $6b ; middle-right .byte $73 ; middle-left .byte $71 ; upper-middle, lower-middle .byte $5d ; vertical line .byte $68 ; <= .byte $6a ; >= .byte $5e ; pi .byte $6c ; != .byte $1c ; british pund .byte $74 ; dot .SBTTL Commodore 128 screen driver ; ; These routines manipulate the screen in Commodore 128 mode ; ; ; c28ini - initilize the commodore-128 screen. ; ; Input: None ; ; Output: Commodore 128 hardware initilized ; ; This routine is called once during powerup to initilize the ; Commodore 128 hardware ; ; Warning: The 8563 registers must be initialized lowest to highest. ; If you do it any other way, you will discover an undocumented "feature" ; c28ini: ldy #$47 ; init smooth scroll to $47 if rev 8 chip lda $d600 ; check the revision level beq c28ini1 ; oops no 8563 here and #$03 ; extract revision level bne c28ini2 ; new 8563 ldy #$40 ; init to $40 if old 8563 c28ini2:tya ldx #25 ; init reg 25 jsr wr8563 ldx #$00 ; initilize 36 regs c28ini4:lda in8563,x ; get byte to init with cmp #$ff ; nothing inits to $ff beq c28ini3 ; was $ff. dont init jsr wr8563 c28ini3:inx ; repeat till done cpx #37 ; there are 36 registers to initialize bcc c28ini4 ; not done yet c28ini1:lda #$fc ; mark us as not being in fast mode sta fast rts ; ; c28ent - enter the commodore-128 80-column screen-driver ; ; This routine starts the 8563 screen driver and allows the use of fast ; mode. ; c28ent: lda #$fd ; mark us as being in fast mode sta fast rts ; ; c28ext - exit from the commodore-128 80-column screen-driver ; ; this routine does nothing because nothing exciting has to happen ; to turn off the 80-column screen. ; c28ext: lda #$fc ; exit from fast mode sta fast rts ; this routine does nothing ; ; c28set - change the hardware after a "set screen xxx" command ; c28set: ldx foreclr ; foreclr only important when entering tek lda c28map,x asl a asl a asl a asl a ldy decrev ; is screen bright or dark ldx backclr,y ora c28map,x ldx #26 jsr wr8563 rts ; ; c28put - put a character on the Commodore-128 screen ; ; Input: A-reg is the character to put ; cx and cy show where to put it ; ; Output: A character is displayed upon the Commodore-128 screen ; ; This routine prints stuff on the Commodore-128 screen. It does ; not advance the cursor. ; c28put: pha ; save the character to put ldx cx ; compute the address in txt8563 ldy cy jsr c28adrt jsr c28r18 ; write it to 8563 regs 18 and 19 pla ; remember the character to put ldx #31 ; reg 31 writes to ram jsr wr8563 ; write to 8563 ram ldx cx ; compute the address in alt8563 ldy cy jsr c28adra jsr c28r18 ; write the address to 8563 regs 18 and 19 ldy alternt ; check the alternt flag (1 or 0) ldx foreclr,y ; get the color to use lda c28map,x ; map to commodore-128 colors from c-64 colors ldx reverse ; if reverse is set, tell the 8563 about it beq c28put1 ora #$40 c28put1:ldx underln ; if underlining is on, tell the 8563 about it beq c28put2 ora #$20 c28put2:ldx flash ; if character is flashing, tell the 8563. beq c28put4 ora #$10 c28put4:ldx #31 ; write the attribute byte into 8563 ram jsr wr8563 rts ; ; c28irm - make space for a character if insert replace mode is insert ; c28irm: ldx cx cpx #79 ; if in last column, no space needed bcc c28irm1 rts c28irm1:ldy cy jsr c28adrt lda #pad8563^ ; write the msb to r18 ldx #18 jsr wr8563 inx ; r19 gets the lsb lda #pad8563\ jsr wr8563 lda in8563+24 ora #$80 ; set bit 7 in register 24 ldx #24 jsr wr8563 jsr c28r32 ; write source address to r32 sec lda #79 sbc cx pha ldx #30 ; number of bytes to copy jsr wr8563 ; go copy junk into the pad area inc dest bne c28irm2 inc dest+1 c28irm2:jsr c28r18 ; write dest address to r18 lda in8563+24 ora #$80 ; set bit 7 in register 24 ldx #24 jsr wr8563 lda #pad8563^ ; write the msb to r32 ldx #32 jsr wr8563 inx ; r33 gets the lsb lda #pad8563\ jsr wr8563 pla ; number of bytes to copy pha ldx #30 ; number of bytes to copy jsr wr8563 ; go copy junk into the pad area ldx cx ldy cy jsr c28adra lda #pad8563^ ; write the msb to r18 ldx #18 jsr wr8563 inx ; r33 gets the lsb lda #pad8563\ jsr wr8563 lda in8563+24 ora #$80 ; set bit 7 in register 24 ldx #24 jsr wr8563 jsr c28r32 ; write source address to r32 pla pha ldx #30 ; number of bytes to copy jsr wr8563 ; go copy junk into the pad area inc dest bne c28irm3 inc dest+1 c28irm3:jsr c28r18 ; write dest address to r18 lda in8563+24 ora #$80 ; set bit 7 in register 24 ldx #24 jsr wr8563 lda #pad8563^ ; write the msb to r32 ldx #32 jsr wr8563 inx ; r33 gets the lsb lda #pad8563\ jsr wr8563 pla ; number of bytes to copy ldx #30 ; number of bytes to copy jsr wr8563 ; go copy junk into the pad area rts ; ; c28dch - delete one or more characters ; ; Input: Number of characters to delete in A-reg ; Cursor position in cx, cy ; c28dch: tax ; save number of characters to delete clc adc cx cmp #80 ; deleting rest of line? bcc c28dch3 jmp c28el0 ; if so, just erase rest of line c28dch3:txa ; remember number of characters to delete pha ; save number of characters to delete ldx cx ; set up destination address ldy cy jsr c28adrt jsr c28r18 lda in8563+24 ora #%10000000 ; set bit seven ldx #24 jsr wr8563 clc ; set up source address pla ; restore and save number of characters to del pha adc cx pha ; 80 - this value is number of bytes to copy tax ldy cy jsr c28adrt jsr c28r32 sec ; compute 80 - value on stack pla eor #$ff adc #80 ldx #30 ; write block count to register 30 jsr wr8563 lda #$00 ; write in a space at the end of the line ldx #31 jsr wr8563 sec pla ; restore and save number of characters to del pha sbc #$01 beq c28dch1 ; skip this if zero additional blanks needed pha ; save number of characters to blank lda in8563+24 ; clear bit 7 of register 24 and #%01111111 ldx #24 jsr wr8563 pla ; restore number of characters to blank ldx #30 ; block copy word count jsr wr8563 c28dch1:ldx cx ; set up destination address ldy cy jsr c28adra jsr c28r18 lda in8563+24 ora #%10000000 ; set bit seven ldx #24 jsr wr8563 clc ; set up source address pla ; restore and save number of characters to del pha adc cx pha ; 80 - this value is number of bytes to copy tax ldy cy jsr c28adra jsr c28r32 sec ; compute 80 - value on stack pla eor #$ff adc #80 ldx #30 ; write block count to register 30 jsr wr8563 lda #$00 ; write in a space at the end of the line ldx #31 jsr wr8563 sec pla ; save number of characters to del sbc #$01 ; we already did one beq c28dch2 ; skip this if zero additional blanks needed pha ; save number of characters to blank lda in8563+24 ; clear bit 7 of register 24 and #%01111111 ldx #24 jsr wr8563 pla ; restore number of characters to blank ldx #30 ; block copy word count jsr wr8563 c28dch2:rts ; ; ; c28ind - scroll the screen in commodore-128 mode ; ; Input: top, bot ; ; Output: 8563 ram is scrolled ; ; This routine scrolls the area of the commodore-128 screen that ; is between top and bot ; ; This routine is also used for delete line. ; c28ind: tax ; save the number of lines to scroll. lda cy ; save the cursor y position pha lda top ; start scrolling at the top sta cy txa ; push number of lines to scroll pha c28ind1:clc pla pha adc cy ; compute the address of this line cmp bot beq c28ind3 bcs c28ind2 c28ind3:pha ; save this result. Usefull later tay ldx #$00 jsr c28adrt jsr c28r32 ; write it into block copy source addres ldy cy ldx #$00 jsr c28adrt lda in8563+24 ; set bit seven in register 24 ora #$80 ldx #24 jsr wr8563 jsr c28r18 ; write destination address to 8563 lda #80 ; copy 80 bytes ldx #30 jsr wr8563 pla tay ldx #$00 ; compute address of this line jsr c28adra jsr c28r32 ; write it into block copu source address ldy cy ; compute destination address ldx #$00 jsr c28adra lda in8563+24 ; set bit seven in register 24 ora #$80 ldx #24 jsr wr8563 jsr c28r18 ; write it into the destination address lda #80 ; copy 80 bytes ldx #30 jsr wr8563 inc cy jmp c28ind1 c28ind2:jsr c28el2 inc cy ldy bot cpy cy bcs c28ind1 ; nope pla ; discard number of lines to scroll pla ; restore cursor position sta cy rts ; ; c28ri - scroll the screen backwards in commodore 128 mode ; ; Input: top, bot ; Number of lines to scroll in A-reg ; Output: ram in the 8563 is scrolled backwards ; ; This routine scrolls the part of the screen between top and bot ; in commodore 128 mode ; ; This routine is also used for insert line. ; c28ri: tax ; save number of lines to scroll lda cy ; save the cursor position pha lda bot sta cy txa ; push number of lines to scroll pha c28ri1: sec ; comput cy-top_of_stack the hard way pla pha eor #$ff adc cy cmp top ; see if on screen bmi c28ri2 pha ; save this result. It is usefull tay ldx #$00 jsr c28adrt ; compute the source address jsr c28r32 ldy cy ; compute the destination address ldx #$00 jsr c28adrt lda in8563+24 ; set the msb in register 24 ora #$80 ldx #24 jsr wr8563 jsr c28r18 ; write the destination in r18 lda #80 ; block copy 80 bytes ldx #30 jsr wr8563 pla tay ldx #$00 jsr c28adra ; compute the source address jsr c28r32 ldy cy ; now do the same thing to the attribute ram ldx #$00 jsr c28adra lda in8563+24 ; set the msb in register 24 ora #$80 ldx #24 jsr wr8563 jsr c28r18 ; write the destination in r18 lda #80 ; block copy 80 bytes ldx #30 jsr wr8563 dec cy jmp c28ri1 ; repeat till done c28ri2: jsr c28el2 dec cy ldy cy cpy top bpl c28ri1 pla ; discard number of lines to scroll pla ; restore cursor position sta cy rts ; ; c28el0 - erase from the cursor to the end of the current line ; ; Input: Cursor y coordinate in cy ; ; Output: A line is cleared on the 8563 ; ; This routine erases one line starting at the cursor ; c28el0: ldy cy ldx cx jsr c28adrt ; compute the address to start erasing at jsr c28r18 ; write it to the 8563 lda #$00 ; write zeros over the line ldx #31 jsr wr8563 ; write one byte sec ; how many more bytes? Compute 79-cx lda #79 sbc cx pha ; save number of bytes that need erased beq c28el0a ; maby zero more bytes tay ; save the number lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 tya ; restore the number ldx #30 ; block write jsr wr8563 c28el0a:ldy cy ; now do the attribute ram ldx cx jsr c28adra ; compute the address to start erasing at jsr c28r18 ; write it to the 8563 ldx foreclr lda c28map,x ldx #31 jsr wr8563 ; write one byte pla ; remember the number of bytes to erase beq c28el0b ; maby zero more bytes tay ; save the number lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 tya ; restore the number ldx #30 ; block write jsr wr8563 c28el0b:rts ; all done ; ; c28el1 - erase from the beginning of the line to the cursor ; ; Input: cy ; ; Output: zeros written to the 8563 ; ; This routine erases from the beginning of the current line to the ; cursor ; c28el1: ldy cy ldx #$00 jsr c28adrt ; compute the starting area jsr c28r18 ; write the address to the 8563 ldx #31 ; write a zero here lda #$00 jsr wr8563 lda cx ; how many more zeros necessary? beq c28el1a ; maby zero lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 lda cx ldx #30 ; block copy the zeros jsr wr8563 c28el1a:ldy cy ldx #$00 jsr c28adra ; compute the starting address jsr c28r18 ; write the address to the 8563 ldx foreclr lda c28map,x ldx #31 ; write a zero here jsr wr8563 lda cx ; how many more zeros necessary? beq c28el1b ; maby zero lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 lda cx ldx #30 ; block copy jsr wr8563 c28el1b:rts ; all done ; ; ; c28el2 - erase one line totally ; ; Input: line to erase in cy ; ; Output: stuff written to the 8563 ; ; This routine erases one line completly from the commodore-128 screen ; c28el2: ldy cy ; compute the starting address ldx #$00 jsr c28adrt jsr c28r18 ldx #31 ; write a zero to 8563 ram lda #$00 jsr wr8563 lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 lda #79 ; copy 79 more zeros ldx #30 jsr wr8563 ldy cy ; now do the same thing to attribute ram ldx #$00 ; compute the starting address jsr c28adra jsr c28r18 ldx foreclr lda c28map,x ldx #31 ; write a $04 to 8563 ram jsr wr8563 lda in8563+24 ; clear bit seven in register 24 ldx #24 jsr wr8563 lda #79 ; copy 79 more zeros ldx #30 jsr wr8563 rts ; all done ; c28fls - flash the screen in commodore 128 mode ; ; Input: None ; ; Output: None ; ; This routine does nothing because the 8563 will flash characters ; with no attention from the cpu. ; c28fls: rts ; this routine does nothing ; ; c28tgl - toggle the cursor in commodore 128 mode ; ; Input: cx,cy ; ; Output: registers in the 8563 are changed ; ; This routine toggles the cursor in commodore 128 mode. ; c28tgl: lda curabrt ; is the cursor being turned on? beq c28tgl1 ; yes lda #$a0 ldx #10 jsr wr8563 ; turn cursor off rts ; all done c28tgl1:ldy cy ; compute the address of the cursor ldx cx jsr c28adrt lda dest+1 ; write the high byte into r14 ldx #14 jsr wr8563 lda dest ; write the lsb into r15 ldx #15 jsr wr8563 lda in8563+10 ; turn cursor on ldx #10 jsr wr8563 lda #$01 ; KLUDGE!! Mark the cursor as always on sta curstat rts ; all done ; ; c28drw - draw a character at cx, cy ; ; Input: character to put in a-reg (use funny ascii) ; Output: A - size of character ; ; Registers destroyed - A,X,Y ; ; This routine puts a character at screen position tektx, tekty and ; returns the size of the character. ; c28drw: sta source lda #$00 sta source+1 asl source ; multiplied by 2 rol source+1 asl source ; multiplied by 4 rol source+1 asl source ; multiplied by 8 rol source+1 lda source ; now add in font40 adc #font40\ ; carry is clear sta source lda source+1 adc #font40^ sta source+1 lda tektxhi cmp #80 ; see if on screen bcs c28drw5 lda #$00 sta tektylo ; so that c40sub doesnt do too much... ldy #$07 ; copy the character for c40sub c28drw1:lda (source),y sta freemem,y dey bpl c28drw1 jsr c40sub ; offset the character lda tektyhi sta source+1 ldy #$00 ; 8 scan lines in a character c28drw2:sty source ldy source+1 cpy #200 ; off screen? bcs c28drw5 ; if so, quit now ldx tektxhi jsr c28adrg jsr c28r18 ldx #31 jsr rd8563 ldy source ora freemem,y sta freemem,y lda tektxhi cmp #79 ; if in the last column, no rightmost half beq c28drw3 jsr rd8563 ora freemem+16,y sta freemem+16,y c28drw3:jsr c28r18 ldx #31 lda freemem,y jsr wr8563 lda tektxhi cmp #79 beq c28drw4 lda freemem+16,y jsr wr8563 c28drw4:inc source+1 iny cpy #$08 bcc c28drw2 c28drw5:lda #13 ; 13 pixels wide rts ; ; c28tek - initialize for tektronix mode ; ; This routine sets up the 8563 for bit map graphics. Note that register ; 25 is special. It is initialized differently depending on the chip ; version level. Also note that the foreground color used when ; attributes are disabled is already set for us in c40set, even though ; that is not necessary for the display of text. ; c28tek: ldx #25 ; read register 25 from 8563 jsr rd8563 ora #$80 and #%10111111 ; disable attributes. jsr wr8563 lda in8563+10 ; disable cursor and #%10011111 ora #%00100000 ldx #10 jsr wr8563 rts ; ; c28txt - initialize the 8563 for displaying text ; ; Input: font40 ; Output: chr8563 (inside the 8563 ram) gets updated ; ; This routine initializes the 8563 for displaying text by copying ; in the character set and clearing bit 7 of register 25. Note that ; register 25 is special. it is initialized differently for different ; versions of the chip. c28txt: ldx #25 ; read register 25 jsr rd8563 and #$7f ; clear bit 7 ora #%01000000 ; enable attributes jsr wr8563 ; write it back lda in8563+10 ; restart the cursor ldx #10 jsr wr8563 lda #chr8563^ ; address (in 8563) to store character set ldx #18 jsr wr8563 ; write it in lda #chr8563\ inx jsr wr8563 ; write in the high order byte too lda #font40\ ; copy in character definitions to chr8563 sta dest lda #font40^ sta dest+1 ldx #31 ; write to 8563 ram lda #95+32 ; loop for 95 printable characters + 32 graphic c28txt4:pha ldy #$00 c28txt1:lda (dest),y ; write 8 bytes for the character jsr wr8563 iny cpy #$08 bcc c28txt1 lda #$00 ; now pad with 8 zeros c28txt2:jsr wr8563 dey bne c28txt2 clc lda dest ; go on to the next character adc #$08 sta dest bcc c28txt3 inc dest+1 c28txt3:pla ; repeat till all 95 characters done sec sbc #$01 bne c28txt4 rts ; ; c28lin - draw a line from the current point to the destination point ; ; Input: tekfxlo, tekfxhi - point to draw line from (x position) ; tekfyhi - point to draw line from (y position) ; tektxlo, tektxhi - point to draw line to (x position) ; tektyhi - point to draw line to (y position) ; ; This routine draws a line. ; ; It works by computing a delta. we then add the delta to the current ; point and plot. we stop only when the current point is equal to the ; destination point. ; ; We optimize this by multiplying the delta by 2 until we know that ; each point plotted is at a different spot. (We do not need to plot ; the same point more than once) ; c28lin: lda #$00 ; zero the ultra-low coordinate (no yul!!) sta tekfxul sec ; compute delta x lda tektxlo sbc tekfxlo sta tekdxul lda tektxhi sbc tekfxhi sta tekdxlo lda #$00 sbc #$00 sta tekdxhi sec ; compute delta y (ylo = 0!!) lda tektyhi sbc tekfyhi sta tekdylo lda #$00 sbc #$00 sta tekdyhi ldx #$08 ; dont optimize more than 8 times!!!! c28lin2:lda tekdxlo ; is the x delta negative bpl c28lin3 eor #$ff ; get the positive equivalent c28lin3:cmp #$0f ; is it big enough bcs c28lin1 lda tekdylo ; is the y delta negative ldy tekdyhi bpl c28lin4 eor #$ff ; get the positive equivalent c28lin4:cmp #$7f ; is it big enough bcs c28lin1 asl tekdxul ; multiply the x delta by two rol tekdxlo asl tekdylo ; multiply the y delta by two (no dyul) dex bne c28lin2 ; try to optimize some more c28lin1:jsr c28pnt ; now we can finally plot a point clc ; add in the x delta lda tekfxul adc tekdxul sta tekfxul lda tekfxlo adc tekdxlo sta tekfxlo lda tekfxhi adc tekdxhi sta tekfxhi clc ; add in the y delta (no dyul or tylo) lda tekfylo adc tekdylo sta tekfylo lda tekfyhi adc tekdyhi sta tekfyhi lda tekfxlo ; compare current point with destination cmp tektxlo bne c28lin1 ; if not the same, go plot another point lda tekfxhi ; compare current point with destination cmp tektxhi bne c28lin1 ; if not the same, go plot another point lda tekfyhi ; compare current point with destination cmp tektyhi bne c28lin1 ; if not the same, go plot another point rts ; all done ; ; c28pnt - plot a point ; ; input: point to plot in tektxlo, tektxhi, tektyhi ; ; This routine plots a point on the 8563 bitmap screen ; c28pnt: ldx tekfxhi ; get x coordinate of character to change cpx #80 ; check to see if off screen bcs c28pnt1 ldy tekfyhi ; get y coordinate of character to change cpy #200 ; check to see if off screen bcs c28pnt1 jsr c28adrg ; get address of character to change lda tekfxlo ; get the column of the character to change lsr a lsr a lsr a lsr a lsr a tay jsr c28r18 ldx #31 jsr rd8563 ora powers,y tay jsr c28r18 tya ldx #31 jsr wr8563 c28pnt1:rts ; ; c28era - erase the graphics screen ; ; This routine erases the graphics screen by filling all 16k of 8563 ; ram with zeros ; c28era: lda #$00 ; fill 8563 memory starting at $0000 ldx #18 ; write $0000 into registers 18 and 19 jsr wr8563 inx jsr wr8563 lda #$00 ; fill memory with zeros ldx #31 jsr wr8563 lda in8563+24 ; clear bit 7 in r24 for block write and #%01111111 ldx #24 jsr wr8563 lda #$ff ; write the rest of the page (255 bytes left) ldx #30 jsr wr8563 ldy #$3f ; $3f pages more to zero. lda #$00 ; now work with full pages. c28era1:jsr wr8563 dey bne c28era1 rts ; ; c28int - put coordinates into internal form ; ; Input: tekcxlo, tekcxhi, tekcylo, tekcyhi ; Output: tektxlo, tektxhi, tektyhi ; ; This routine puts coordinates into internal form by calling the ; (very similiar) 40-column mode routine and then doubling the x ; resolution. A change to the y-coordinate is made too. The ; y-coordinate is no longer split into two bytes. ; c28int: jsr c40int ; call similiar 40-column routine asl tektxlo ; double x resolution. rol tektxhi asl tektylo ; store the y resolution in a single byte rol tektyhi asl tektylo rol tektyhi asl tektylo ; (tektylo now zero) rol tektyhi rts ; ; c28tst - test to see if the Commodore 128 screen driver is present ; ; Input: None ; ; Output: carry set if Commodore 8563 80-column display not present ; ; Registers destroyed - A ; ; This routine returns with the carry clear if Commodore-128 80-column ; screen is available. If it isnt, it returns with the carry set ; c28tst: lda #$00 cmp $d600 ; Commodore-128 available if $d600 <> $00 rts ; ; c28adrg - compute the address of a character in graphics mode ; ; Input: x and y coordinates in x-reg and y-reg. Offset in a-reg ; Output: address in dest ; c28adrg:sty dest ; put y value in dest (expand to 2 bytes) lda #$00 sta dest+1 asl dest ; multiply by 4 rol dest+1 asl dest rol dest+1 clc ; add in one. 4 + 1 = 5 tya adc dest sta dest lda dest+1 adc #$00 sta dest+1 asl dest ; multiply by 16 more for a total of times 80 rol dest+1 asl dest rol dest+1 asl dest rol dest+1 asl dest rol dest+1 clc ; now add in x txa adc dest sta dest lda dest+1 adc #$00 sta dest+1 rts ; ; c28adrt - compute the text address of x,y ; ; Input: x and y coordinates in X-reg and Y-reg ; ; Output: text address in (dest) ; ; This routine calculates the text address at point x,y ; c28adrt:jmp c28adr ; no offset necessary ; ; c28adra - compute the alternate address of x,y ; ; Input: x and y coordinates in X-reg and Y-reg ; ; Output: attribute address in (dest) ; ; This routine calculates the address of attribute ram associated ; with x,y ; c28adra:jsr c28adr ; compute the base address clc ; add in the address of attribute ram lda dest+1 adc #alt8563^ sta dest+1 rts ; ; c28adr - compute the base address associated with x,y ; ; Input: x and y coordinates in X-reg and Y-reg ; ; Output: base address in (dest) ; ; This routine calculates the base address associated with x,y ; c28adr: cpx #80 ; in funny column? bcc c28adr1 ldx #79 ; if so, reduce X to far left c28adr1:lda #$00 ; zero dest+1 while we have a free register sta dest+1 tya ; put y where it can be shifted asl a ; multiplied by 2 asl a ; multiplied by 4 sta dest tya ; add in y. now multiplied by 5 clc ; ( 5*25 < $100. No msb yet) adc dest ; msb in dest+1. lsb in a-reg asl a ; multipled by 10 rol dest+1 asl a ; multiplied by 20 rol dest+1 asl a ; multiplied by 40 rol dest+1 asl a ; multiplied by 80 rol dest+1 sta dest txa ; add in x-reg clc adc dest sta dest bcc c28adr2 inc dest+1 c28adr2:rts ; ; c28r18 - write dest and dest+1 to r18 and r19 in the 8563 ; ; Input: dest and dest+1 ; ; Output: r18 and r19 in the 8563 ; ; This routine writes the address in dest to the 8563 update location ; c28r18: lda dest+1 ; write the msb to r18 ldx #18 jsr wr8563 inx ; r19 gets the lsb lda dest jsr wr8563 rts ; ; c28r32 - write dest and dest+1 to r32 and r33 in the 8563 ; ; Input: dest and dest+1 ; ; Output: r32 and r33 in the 8563 ; ; This routine writes the address in dest to the 8563 block copy ; source address ; c28r32: lda dest+1 ; write the msb to r32 ldx #32 jsr wr8563 inx ; r33 gets the lsb lda dest jsr wr8563 rts ; all done ; ; wr8563 - write to a register in the 8563 ; ; Input: register to write to in x-reg ; data to write in a-reg ; ; Output: a register in the 8563 is changed ; wr8563: stx $d600 ; tell the 8563 which reg we want to write to wr8563a:bit $d600 ; wait for 8563 to be ready bpl wr8563a ; not yet ready sta $d601 ; is ready. write. rts ; all done ; ; rd8563 - read from a register in the 8563 ; ; Input: register to read from in x-reg ; Output: Data in a-reg ; ; This routine reads from a register in the 8563 80-column chip. ; rd8563: stx $d600 ; tell the 8563 which reg we want to read from rd8563a:bit $d600 ; wait for the 8563 to be ready bpl rd8563a ; not yet ready lda $d601 ; is ready. read. rts ; all done ; ; in8563 - data to write to the 8563 during powerup initilization ; ; The zeroth value is written to r0, the first value is written to r1, ; and so on. A value of $ff is not written. ; in8563: .byte $7e ; horizontal total .byte $50 ; horizontal displayed .byte $66 ; horizontal sync position .byte $49 ; horizontal/vertical sync width .byte $20 ; vertical total .byte $e0 ; vertical total adjust .byte $19 ; vertical displayed .byte $1d ; vertical sync position .byte $fc ; interlace mode control .byte $e7 ; character total, vertical .byte $e0 ; cursor start scan line/cursor mode .byte $f0 ; end scan line .byte $00 ; display start address (hi) .byte $00 ; display start address (lo) .byte $20 ; cursor position (hi) .byte $00 ; cursor position (lo) .byte $ff ; light pen vertical .byte $ff ; light pen horizontal .byte chr8563^ ; update location (hi) .byte chr8563\ ; update location (lo) .byte $08 ; attribute start address (hi) .byte $00 ; attribute start address (lo) .byte $78 ; character displayed, horizontal .byte $e8 ; character displayed, vertical .byte $20 ; vertical smooth scroll .byte $ff ; smooth horizontal scroll .byte $f0 ; background/foreground r, g, b, i .byte $00 ; address increment per row .byte $2f ; 8563 ram type .byte $e7 ; underline scan line count .byte $ff ; block copy word count .byte $ff ; cpu data .byte $ff ; block copy source address (hi) .byte $ff ; block copy source address (lo) .byte $7d ; display enable begin .byte $64 ; display enable end .byte $f5 ; 8563 ram refresh/scan line c28map: .byte $00 ; black .byte $0f ; white .byte $08 ; red .byte $07 ; cyan .byte $0b ; purple .byte $04 ; green .byte $02 ; blue .byte $0d ; yellow .byte $0a ; "orange" .byte $0c ; brown .byte $09 ; light red .byte $01 ; medium grey (not according to basic rom!) .byte $06 ; dark grey (not according to basic rom!) .byte $05 ; light green .byte $03 ; light blue .byte $0e ; light grey .SBTTL 80 Column screen driver ; ; These routines manipulate the screen in 80 column mode. ; ; ; c80ini - initilize 80 column screen during powerup ; ; Input: None ; Output: scrtype set to use 80 columns ; ; Registers destroyed - None ; ; This routine does all of the powerup initilization necessary for ; 80 columns that was not done in c40ini, and sets the screen type ; to 80 columns. ; c80ini: rts ; ; c80ent - enter the 80 column screen driver ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine starts the 80 column screen driver. ; c80ent: jmp c40ent ; hardware is initilized the same as 40 cols ; ; c80ext - exit the 80 column screen driver ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine starts the 80 column screen driver. ; c80ext: jmp c40ext ; hardware is de-initilized the same as 40 cols ; ; c80set - reset the hardware after a "set screen xxxx" command ; ; Input: border color in bordclr ; Output: None ; ; Registers destroyed - A ; ; This routine adjusts the hardware after a set command. ; c80set: jmp c40set ; hardware is the same as 40 cols ; ; c80put - put a character at cx, cy ; ; Input: character to put in a-reg (use funny ascii) ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine puts a character at screen position cx,cy. This routine ; does not advance the cursor position. ; c80put: pha ; save character put sta source ; compute character*8+font80 lda #$00 sta source+1 asl source ; multiplied by 2 rol source+1 asl source ; multiplied by 4 rol source+1 asl source ; multiplied by 8 rol source+1 lda source ; now add in font80 adc #font80\ ; carry is clear sta source lda source+1 adc #font80^ sta source+1 ldy cy ; compute the address to store at ldx cx jsr c80adrt ldy #$07 ; copy in 8 bytes c80put1:lda (dest),y ; select hi or low half abcdefgh eor (source),y ; ABCDEFGH and evenodd ; xxxx0000 eor (dest),y ; ABCDefgh ldx reverse ; $01 is reverse on, $00 is reverse off beq c80put7 eor evenodd ; reverse the character c80put7:sta (dest),y dey bpl c80put1 ; put in the entire character (8 bytes) lda underln ; $01 is underline on, $00 is underline off beq c80put2 ; do not underline lda reverse ; underline and reverse bne c80put6 ldy #$07 ; underline the last row lda evenodd ora (dest),y sta (dest),y ; underlined, but not reversed jmp c80put2 c80put6:ldy #$07 lda evenodd eor #$ff and (dest),y sta (dest),y c80put2:pla ; check to see if color must be updated bne c80put3 ; if character is not a space, update lda reverse ; if reverse on, update bne c80put3 lda underln ; if underline on, update beq c80put4 c80put3:ldy cy ; calculate primary color address ldx cx jsr c80adrp ldx alternt ; 1=alternate color, 0=normal color lda foreclr,x ; get proper foreground color asl a ; put in high nybble asl a asl a asl a ldx decrev ; is the background bright or dark ora backclr,x ; or in background color ldy #$00 sta (dest),y ; adjust primary color ram pha ; save for future use ldy cy ; compute alternate color address ldx cx jsr c80adra pla ; restore colors used for primary color ldx flash ; can we use it? beq c80put5 ; yes. ldx decrev ; is the background bright or dark lda backclr,x ; or in background color asl a ; use background color for forground asl a asl a asl a ora backclr,x ; or in background color c80put5:ldy #$00 sta (dest),y ; adjust alternate color ram c80put4:rts ; all done. ; ; c80irm - make space for a character if insert replace mode is insert ; ; Unfortunatly, there is no way to make room for the color information. ; c80irm: ldy #$07 lda #$00 c80irm1:sta freemem,y dey bpl c80irm1 ldx cx ldy cy jsr c80adrt ldx cx bit evenodd bmi c80irm2 ldy #$07 c80irm3:lda (dest),y sta freemem,y and #$f0 sta (dest),y dey bpl c80irm3 c80irm6:inx inx c80irm2:cpx #80 ; all done? bcs c80irm5 txa ; save column number currently working on pha ldy cy jsr c80adrt ldx #$07 ldy #$07 c80irm4:lda (dest),y lsr freemem,x ror a ror freemem,x ror a ror freemem,x ror a ror freemem,x ror a ror freemem,x sta (dest),y lsr freemem,x lsr freemem,x lsr freemem,x lsr freemem,x dey dex bpl c80irm4 pla tax ; remember column number working on jmp c80irm6 c80irm5:rts ; ; c80dch - delete one or more characters. ; ; Input: Number of characters to delete in A-reg ; Cursor position in cx, cy ; c80dch: tay ; save number of characters to delete clc ; compute x coordinate of first char to keep adc cx cmp #80 ; see if fits on screen bcc c80dch1 jmp c80el0 c80dch1:tya ; remember number of characters to delete pha ; save number of characters to delete ldx cx ; get address of first char to write over ldy cy jsr c80adrt bit evenodd ; must do funny things if in odd column bmi c80dch2 lda dest ; copy dest to source sta source lda dest+1 sta source+1 pla ; set up x-register. pha clc adc cx tax ldy cy ; x already set up.... jsr c80adrt ; get address of first char to keep ldy #$07 ; copy in this character c80dch3:lda (dest),y bit evenodd bpl c80dch4 lsr a lsr a lsr a lsr a c80dch4:eor (source),y and #$0f eor (source),y sta (source),y dey bpl c80dch3 c80dch2:pla ; remember number of chars to delete tax ; save number of chars to delete lda cx ; set up cx so we can use c40dch (neat!) pha ; save cx lsr a ; divide by two adc #$00 ; round up sta cx ; freak out c40dch txa ; remember number of characters to delete pha ; on stack too lsr a ; divide by two. (round down) jsr c40dch ; freaked out pla ; remember number of characters to delete lsr a ; check if even or odd bcc c80dch5 ; must delete another char if odd lda #$00 ; shift in a blank ldy #$07 c80dch6:sta freemem,y dey bpl c80dch6 ldx #40 ; still useing 40-column stuff c80dch8:txa ; save current column number on stack pha ldy cy jsr c40adrt ; stil using 40-column stuff ldy #$07 ; shift one character ldx #$07 c80dch7:lda (dest),y asl freemem,x rol a rol freemem,x rol a rol freemem,x rol a rol freemem,x rol a rol freemem,x asl freemem,x asl freemem,x asl freemem,x asl freemem,x sta (dest),y dex dey bpl c80dch7 pla tax dex cpx cx bpl c80dch8 c80dch5:pla ; restore cx. was freaked out to use c40dch sta cx rts ; c80ind - perform the VT100 index function (scroll the screen) ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen in 80 column mode. Only the area ; in the scrolling region is changed. ; ; This routine is also used for delete line. ; c80ind: jmp c40ind ; the 40 column routine works in 80 cols too! ; ; c80ri - perform the VT100 reverse index function (scroll backwards) ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen in 80 column mode. Only the area ; in the scrolling region is changed. ; ; This routine is also used for insert line. ; c80ri: jmp c40ri ; the 40 column routine works in 80 cols too! ; ; c80el0 - Perform the VT100 Erase Line function #0 on 80 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the cursor to the end of the line ; c80el0: ldy cy ldx cx jsr c80adrt txa ; evaluate 40-x eor #$ff sec adc #40 tax ; put 40-x back in x bit evenodd bmi c80el0b ; need to erase under cursor specially ldy #$07 ; yes c80el0a:lda (dest),y and #$f0 sta (dest),y ; erase under the cursor dey bpl c80el0a clc lda dest ; add 8 into the address clear8 starts from adc #$08 sta dest bcc c80el0c inc dest+1 c80el0c:dex beq c80el0d c80el0b:jsr clear8 ; erase characters c80el0d:rts ; all done ; ; c80el1 - Perform the VT100 Erase Line function #1 on 80 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the beginning of line to cursor ; c80el1: ldy cy ldx cx jsr c80adrt ; compute the cursors address bit evenodd ; must clear under cursor specially? bpl c80el1b ldy #$07 ; yes c80el1a:lda (dest),y and #$0f sta (dest),y ; erase under the cursor dey bpl c80el1a c80el1b:ldy cy ldx #$00 jsr c80adrt ; compute the address to start clearing ldx cx ; compute the number of bytes to clear inx ; round up if in odd column txa lsr a tax ; x = number_of_bytes / 8 beq c80el1c ; carefull! there might be 0 bytes to clear! jsr clear8 ; erase characters c80el1c:rts ; all done ; ; c80el2 - Perform the VT100 Erase Line function #2 on 80 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases one line compleatly from the 80 column display. ; c80el2: jmp c40el2 ; the 40 column routine works in 80 cols too! ; ; c80fls - flash the screen and cursor in 80 column mode ; ; Input: None ; Output: None ; ; Registers destroyed - A ; ; This routine flashes the screen in 80 column mode ; c80fls: jmp c40fls ; flashing is done the same way in 40 cols ; ; c80tgl - toggle the cursor in 80 column mode ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine toggles the cursor in 80 column mode. ; c80tgl: ldy cy ; compute cursor address ldx cx jsr c80adrt ldy #$07 ; blink the cursor c80tgl2:lda (dest),y eor evenodd sta (dest),y dey bpl c80tgl2 c80tgl1:rts ; ; c80drw - draw a character at cx, cy ; ; Input: character to put in a-reg (use funny ascii) ; Output: A - size of character ; ; Registers destroyed - A,X,Y ; ; This routine puts a character at screen position tektx, tekty and ; returns the size of the character. ; c80drw: sta source lda #$00 sta source+1 asl source ; multiplied by 2 rol source+1 asl source ; multiplied by 4 rol source+1 asl source ; multiplied by 8 rol source+1 lda source ; now add in font80 adc #font80\ ; carry is clear sta source lda source+1 adc #font80^ sta source+1 ldy #$07 ; copy the character for c40sub c80drw1:lda (source),y and #$f0 sta freemem,y dey bpl c80drw1 jsr c40sub ; offset the character ldx tektxhi cpx #40 ; skip if past right of screen bcs c80drw3 ldy tektyhi ; compute the address to store at dey cpy #25 ; skip if past bottom of screen bcs c80drw3 jsr c40adrt ldy #$07 ; copy in the upper left c80drw2:lda freemem,y ora (dest),y sta (dest),y dey bpl c80drw2 c80drw3:ldx tektxhi inx ; put this part of the character 1 space right cpx #40 ; skip if past right edge bcs c80drw5 ldy tektyhi dey cpy #25 ; skip if past bottom of screen bcs c80drw5 jsr c40adrt ldy #$07 ; copy in the upper right c80drw4:lda freemem+16,y ora (dest),y sta (dest),y dey bpl c80drw4 c80drw5:ldx tektxhi cpx #40 ; skip if past right edge bcs c80drw7 ldy tektyhi cpy #25 ; skip if past bottom bcs c80drw7 jsr c40adrt ldy #$07 ; copy in the lower left c80drw6:lda freemem+8,y ora (dest),y sta (dest),y dey bpl c80drw6 c80drw7:ldx tektxhi inx ; put this part of the character 1 space left cpx #40 ; skip if past right edge bcs c80drw9 ldy tektyhi cpy #25 ; skip if past bottom bcs c80drw9 jsr c40adrt ldy #$07 ; copy in the lower right c80drw8:lda freemem+24,y ora (dest),y sta (dest),y dey bpl c80drw8 c80drw9:lda #13 ; move cursor 13 pixels right rts ; ; graphics routines ; c80tek: jmp c40tek c80txt: jmp c40txt c80lin: jmp c40lin c80pnt: jmp c40pnt c80era: jmp c40era c80int: jmp c40int ; ; c80tst - test to see if the 80 column screen driver is present ; ; Input: None ; Output: carry always clear because 80 columns is always available ; ; Registers destroyed - None ; ; This routine returns with the carry clear to indicate that the 80 ; column screen is always available. ; c80tst: clc rts ; ; c80adrt - calculate address of a text character for 80 column mode ; ; Input: x coordinate in x-reg ; y coordinate in y-reg ; Output: dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the address of a character at x,y in 80 ; column mode. It uses c80adr to set things up and c40adrt to do the ; dirty work ; c80adrt:jsr c80adr ; freak out c40adr jmp c40adrt ; do the dirty work ; ; c80adrp - calculate primary color address of a character at x,y ; ; Input: x coordinate in x-reg ; y coordinate in y-reg ; Output: dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the address of primary color memory for a ; character at x,y in 80 column mode. It uses c80adr to set things up ; and c40adrp to do the dirty work. ; c80adrp:jsr c80adr ; freak out c40adr jmp c40adrp ; do the dirty work ; ; c80adra - calculate alternate color address of a character at x,y ; ; Input: x coordinate in x-reg ; y coordinate in y-reg ; Output: dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the address of alternate color memory for a ; character at x,y in 80 column mode. It uses c80adr to set things up ; and c40adra to do the dirty work. ; c80adra:jsr c80adr ; freak out c40adr jmp c40adra ; do the dirty work ; ; c80adr - calculate int(y/2) and y%2 ; ; Input: number in y-reg ; Output: evenodd = $0f if y is odd, $f0 if y is even ; y-reg = y-reg/2 ; ; Registers destroyed - A,Y ; ; This routine calculated int(x/2) and x % 2. It is used to freak ; c40adr into calculating addresses for 80 column mode. Real ; funny things happen if the x-reg is the funny column (81). ; c80adr: cpx #80 ; is the cursor in the funny column? bcc c80adr2 ; no ldx #81 ; 81 % 2 = 1 c80adr2:txa ; divide x by two lsr a tax ; put result back in x-reg lda #$0f ; put $0f in evenodd if odd bcs c80adr1 ; is odd lda #$f0 ; put $f0 in evenodd if even c80adr1:sta evenodd rts ; ; Font80 - Character definitions ; ; this defines the shape of the characters in 80 column mode ; this table is in ascii sequence ; font80: .byte $00,$00,$00,$00,$00,$00,$00,$00 ; " " .byte $44,$44,$44,$44,$44,$00,$44,$00 ; "!" .byte $aa,$aa,$00,$00,$00,$00,$00,$00 ; """ .byte $aa,$ee,$aa,$ee,$aa,$00,$00,$00 ; "#" .byte $44,$66,$88,$44,$22,$ee,$44,$00 ; "$" .byte $00,$99,$aa,$22,$55,$99,$00,$00 ; "%" .byte $44,$aa,$aa,$44,$aa,$aa,$55,$00 ; "&" .byte $22,$44,$00,$00,$00,$00,$00,$00 ; "'" .byte $22,$44,$44,$44,$44,$44,$22,$00 ; "(" .byte $44,$22,$22,$22,$22,$22,$44,$00 ; ")" .byte $00,$99,$66,$ff,$66,$99,$00,$00 ; "*" .byte $00,$00,$44,$ee,$44,$00,$00,$00 ; "+" .byte $00,$00,$00,$00,$00,$44,$44,$88 ; "," .byte $00,$00,$00,$ee,$00,$00,$00,$00 ; "-" .byte $00,$00,$00,$00,$00,$00,$44,$00 ; "." .byte $00,$22,$22,$44,$44,$88,$88,$00 ; "/" .byte $44,$aa,$aa,$ee,$aa,$aa,$44,$00 ; "0" .byte $44,$cc,$44,$44,$44,$44,$ee,$00 ; "1" .byte $44,$aa,$22,$44,$88,$88,$ee,$00 ; "2" .byte $ee,$22,$44,$22,$22,$22,$cc,$00 ; "3" .byte $aa,$aa,$aa,$ee,$22,$22,$22,$00 ; "4" .byte $ee,$88,$cc,$22,$22,$22,$cc,$00 ; "5" .byte $44,$88,$88,$cc,$aa,$aa,$44,$00 ; "6" .byte $ee,$22,$22,$44,$44,$88,$88,$00 ; "7" .byte $44,$aa,$aa,$44,$aa,$aa,$44,$00 ; "8" .byte $44,$aa,$aa,$66,$22,$44,$88,$00 ; "9" .byte $00,$00,$44,$00,$00,$44,$00,$00 ; ":" .byte $00,$00,$44,$00,$44,$44,$88,$00 ; ";" .byte $00,$22,$44,$88,$44,$22,$00,$00 ; "<" .byte $00,$00,$ee,$00,$ee,$00,$00,$00 ; "=" .byte $00,$88,$44,$22,$44,$88,$00,$00 ; ">" .byte $44,$aa,$22,$44,$44,$00,$44,$00 ; "?" .byte $44,$ee,$aa,$aa,$88,$66,$00,$00 ; "@" .byte $44,$aa,$aa,$ee,$aa,$aa,$aa,$00 ; "A" .byte $cc,$aa,$aa,$cc,$aa,$aa,$cc,$00 ; "B" .byte $66,$88,$88,$88,$88,$88,$66,$00 ; "C" .byte $cc,$aa,$aa,$aa,$aa,$aa,$cc,$00 ; "D" .byte $ee,$88,$88,$cc,$88,$88,$ee,$00 ; "E" .byte $ee,$88,$88,$cc,$88,$88,$88,$00 ; "F" .byte $44,$aa,$88,$88,$aa,$aa,$44,$00 ; "G" .byte $aa,$aa,$aa,$ee,$aa,$aa,$aa,$00 ; "H" .byte $ee,$44,$44,$44,$44,$44,$ee,$00 ; "I" .byte $66,$22,$22,$22,$22,$aa,$44,$00 ; "J" .byte $aa,$aa,$aa,$cc,$aa,$aa,$aa,$00 ; "K" .byte $88,$88,$88,$88,$88,$88,$ee,$00 ; "L" .byte $aa,$ee,$aa,$aa,$aa,$aa,$aa,$00 ; "M" .byte $cc,$aa,$aa,$aa,$aa,$aa,$aa,$00 ; "N" .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$00 ; "O" .byte $cc,$aa,$aa,$cc,$88,$88,$88,$00 ; "P" .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$22 ; "Q" .byte $cc,$aa,$aa,$cc,$aa,$aa,$aa,$00 ; "R" .byte $66,$88,$88,$44,$22,$22,$cc,$00 ; "S" .byte $ee,$44,$44,$44,$44,$44,$44,$00 ; "T" .byte $aa,$aa,$aa,$aa,$aa,$aa,$ee,$00 ; "U" .byte $aa,$aa,$aa,$aa,$aa,$aa,$44,$00 ; "V" .byte $aa,$aa,$aa,$aa,$aa,$ee,$aa,$00 ; "W" .byte $aa,$aa,$aa,$44,$aa,$aa,$aa,$00 ; "X" .byte $aa,$aa,$aa,$44,$44,$44,$44,$00 ; "Y" .byte $ee,$22,$22,$44,$88,$88,$ee,$00 ; "Z" .byte $ee,$88,$88,$88,$88,$88,$ee,$00 ; "[" .byte $00,$88,$88,$44,$44,$22,$22,$00 ; "\" .byte $ee,$22,$22,$22,$22,$22,$ee,$00 ; "]" .byte $44,$aa,$00,$00,$00,$00,$00,$00 ; "^" .byte $00,$00,$00,$00,$00,$00,$00,$ff ; "_" .byte $44,$22,$00,$00,$00,$00,$00,$00 ; "`" .byte $00,$00,$cc,$22,$66,$aa,$ee,$00 ; "a" .byte $88,$88,$cc,$aa,$aa,$aa,$cc,$00 ; "b" .byte $00,$00,$66,$88,$88,$88,$66,$00 ; "c" .byte $22,$22,$66,$aa,$aa,$aa,$66,$00 ; "d" .byte $00,$00,$44,$aa,$ee,$88,$66,$00 ; "e" .byte $00,$66,$88,$cc,$88,$88,$88,$00 ; "f" .byte $00,$00,$44,$aa,$aa,$66,$22,$cc ; "g" .byte $88,$88,$cc,$aa,$aa,$aa,$aa,$00 ; "h" .byte $44,$00,$44,$44,$44,$44,$44,$00 ; "i" .byte $22,$00,$22,$22,$22,$22,$aa,$44 ; "j" .byte $88,$88,$aa,$aa,$cc,$aa,$aa,$00 ; "k" .byte $cc,$44,$44,$44,$44,$44,$ee,$00 ; "l" .byte $00,$00,$aa,$ee,$aa,$aa,$aa,$00 ; "m" .byte $00,$00,$cc,$aa,$aa,$aa,$aa,$00 ; "n" .byte $00,$00,$44,$aa,$aa,$aa,$44,$00 ; "o" .byte $00,$00,$cc,$aa,$aa,$cc,$88,$88 ; "p" .byte $00,$00,$44,$aa,$aa,$66,$22,$33 ; "q" .byte $00,$00,$66,$88,$88,$88,$88,$00 ; "r" .byte $00,$00,$66,$88,$44,$22,$cc,$00 ; "s" .byte $00,$44,$ee,$44,$44,$44,$22,$00 ; "t" .byte $00,$00,$aa,$aa,$aa,$aa,$ee,$00 ; "u" .byte $00,$00,$aa,$aa,$aa,$aa,$44,$00 ; "v" .byte $00,$00,$aa,$aa,$aa,$ee,$aa,$00 ; "w" .byte $00,$00,$aa,$aa,$44,$aa,$aa,$00 ; "x" .byte $00,$00,$aa,$aa,$aa,$66,$22,$cc ; "y" .byte $00,$00,$ee,$22,$44,$88,$ee,$00 ; "z" .byte $66,$44,$44,$cc,$44,$44,$66,$00 ; "{" .byte $44,$44,$44,$44,$44,$44,$44,$00 ; "|" .byte $66,$22,$22,$33,$22,$22,$66,$00 ; "}" .byte $55,$aa,$00,$00,$00,$00,$00,$00 ; "~" .byte $00,$00,$44,$ee,$ee,$44,$00,$00 ; (graphics) diamond .byte $aa,$55,$aa,$55,$aa,$55,$aa,$55 ; (graphics) square .byte $aa,$ee,$aa,$00,$ee,$44,$44,$00 ; (graphics) h-t .byte $ee,$ee,$88,$00,$ee,$ee,$88,$00 ; (graphics) f-f .byte $ee,$88,$ee,$ee,$aa,$cc,$aa,$00 ; (graphics) c-r .byte $88,$88,$cc,$00,$ee,$ee,$88,$00 ; (graphics) l-f .byte $44,$aa,$44,$00,$00,$00,$00,$00 ; (graphics) degrees .byte $00,$00,$44,$ee,$44,$ee,$00,$00 ; (graphics) plus/minus .byte $aa,$ee,$aa,$00,$44,$44,$66,$00 ; (graphics) n-l .byte $aa,$aa,$44,$00,$ee,$44,$44,$00 ; (graphics) v-t .byte $44,$44,$44,$cc,$00,$00,$00,$00 ; (graphics) upper-left .byte $00,$00,$00,$cc,$44,$44,$44,$44 ; (graphics) lower-left .byte $00,$00,$00,$77,$44,$44,$44,$44 ; (graphics) lower-right .byte $44,$44,$44,$77,$00,$00,$00,$00 ; (graphics) upper-right .byte $44,$44,$44,$ee,$44,$44,$44,$44 ; (graphics) crossed lines .byte $ff,$00,$00,$00,$00,$00,$00,$00 ; (graphics) scan 1 .byte $00,$ff,$00,$00,$00,$00,$00,$00 ; (graphics) scan 3 .byte $00,$00,$00,$ff,$00,$00,$00,$00 ; (graphics) scan 5 .byte $00,$00,$00,$00,$00,$ff,$00,$00 ; (graphics) scan 7 .byte $00,$00,$00,$00,$00,$00,$00,$ff ; (graphics) scan 9 .byte $44,$44,$44,$77,$44,$44,$44,$44 ; (graphics) middle-right .byte $44,$44,$44,$cc,$44,$44,$44,$44 ; (graphics) middle-left .byte $44,$44,$44,$ff,$00,$00,$00,$00 ; (graphics) upper-middle .byte $00,$00,$00,$ff,$44,$44,$44,$44 ; (graphics) lower-middle .byte $44,$44,$44,$44,$44,$44,$44,$44 ; (graphics) vertical line .byte $00,$22,$44,$88,$44,$22,$ee,$00 ; (graphics) <= .byte $00,$88,$44,$22,$44,$88,$ee,$00 ; (graphics) >= .byte $00,$00,$00,$ee,$aa,$aa,$00,$00 ; (graphics) pi .byte $00,$22,$ee,$44,$ee,$88,$00,$00 ; (graphics) != .byte $00,$00,$66,$44,$66,$44,$ee,$00 ; (graphics) british-pound .byte $00,$00,$00,$44,$00,$00,$00,$00 ; (graphics) dot .SBTTL 40 Column screen driver ; ; These routines manipulate the screen in 40 column mode. ; ; ; c40ini - initilize the 40 column screen ; ; Input: None ; ; Output: font40 created ; ; Registers destroyed - A,X,Y ; ; this routine builds the 40 column character font from stuff in rom ; and ram. it calls move8 to do the copying. the memory locations ; of the characters is stored in newchar. the vic chip is initilized ; and the screen is cleared. The memory map is changed to put ram where ; basic is now. ; c40ini: sei ; cannot have interrupts without I/O lda #%00110010 ; swap out the I/O. Get the character rom sta $01 ldy #$00 ; zero the y-reg ldx newchar,y ; number of characters defined in this chunk c40ini1:iny lda newchar,y ; source of characters (lo order) sta source iny lda newchar,y ; source of characters (hi order) sta source+1 iny lda newchar,y ; destination of characters (lo order) sta dest iny lda newchar,y ; destination of characters (hi order) sta dest+1 iny tya ; save y-reg across call to move8 pha jsr move8 pla ; restore y-reg tay ldx newchar,y ; number of characters in this chunk (0=end) bne c40ini1 ; loop until done lda #%00110110 ; swap I/O back in. We gotta have it... sta $01 lda $d020 ; save the bordor color sta bordold rts ; ; c40ent - enter the 40 column screen driver ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine starts the 40 column screen driver. ; c40ent: lda $dd02 ; select video bank ora #$03 ; "" sta $dd02 ; "" lda $dd00 ; "" and #%11111100 ; "" ora #$03- ; "" sta $dd00 ; "" lda $d011 ; set bit-map mode ora #$20 ; "" sta $d011 ; "" rts ; all done ; ; c40ext - exit the 40 column screen driver ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine exits from the 40 column screen driver. ; c40ext: lda $dd02 ; select video bank and #$fc ; "" sta $dd02 ; "" lda $dd00 ; "" ora #$03 ; "" sta $dd00 ; "" lda $d011 ; re-set bit-map mode and #$df sta $d011 ; "" lda $d018 ; tell vic where to find screen & color ram and #vicmsk ora #vicnorm sta $d018 ; "" lda bordold ; restore the old bordor color sta $d020 rts ; all done ; ; c40set - reset the hardware after a "set screen xxxx" command ; ; Input: border color in bordclr ; Output: None ; ; Registers destroyed - A ; ; This routine adjusts the hardware after a set command. ; ; c40set: lda bordclr sta $d020 lda #vicclr1\ ; get the address of primary color ram sta source lda #vicclr1^ sta source+1 lda #vicclr2\ ; get the address of alternate color ram sta dest lda #vicclr2^ sta dest+1 ldx decrev ; is screen bright or dark lda #25 ; do 25 lines c40set3:pha ldy #39 ; reverse 40 columns c40set2:lda (source),y ; get the color in primary color memory cmp (dest),y ; character is flasing if alternate != primary php ; remember if character is flashing and #$f0 ; replace the upper nybble with the new backclr ora backclr,x sta (source),y plp ; remember if character is flashing beq c40set1 ; if not flashing, alternate == primary asl a ; if flashing, alternate(hi & lo) = backclr asl a asl a asl a ora backclr,x c40set1:sta (dest),y dey ; repeat for all of the columns bpl c40set2 clc ; go do the next row lda source adc #40 sta source lda source+1 adc #$00 sta source+1 lda dest adc #40 sta dest lda dest+1 adc #$00 sta dest+1 pla ; count off 25 rows sec sbc #$01 bne c40set3 c40set5:rts ; all done ; ; c40put - put a character at cx, cy ; ; Input: character to put in a-reg (use funny ascii) ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine puts a character at screen position cx,cy. This routine ; does not advance the cursor position. ; c40put: sta source lda #$00 sta source+1 asl source ; multiplied by 2 rol source+1 asl source ; multiplied by 4 rol source+1 asl source ; multiplied by 8 rol source+1 lda source ; now add in font40 adc #font40\ ; carry is clear sta source lda source+1 adc #font40^ sta source+1 ldy cy ; compute the address to store at ldx cx jsr c40adrt ldy #$07 ; copy in 8 bytes c40put1:lda (source),y ldx reverse ; $01 is reverse on, $00 is reverse off beq c40put3 eor #$ff c40put3:sta (dest),y dey bpl c40put1 ; put in the entire character (8 bytes) lda underln ; $ff is underline on, $00 is underline off beq c40put2 ; do not underline lda reverse ; underline and reverse? beq c40put6 ; yes. lda #$00 ; turn all the bits off ldy #$07 sta (dest),y jmp c40put2 c40put6:lda #$ff ; turn all the bits on ldy #$07 ; underline the last row sta (dest),y c40put2:ldy cy ; calculate primary color address ldx cx jsr c40adrp ldx alternt ; 1=alternate color, 0=normal color lda foreclr,x ; get proper foreground color asl a ; put in high nybble asl a asl a asl a ldx decrev ; is the background bright or dark ora backclr,x ; or in background color ldy #$00 sta (dest),y ; adjust primary color ram pha ; save for future use ldy cy ; compute alternate color address ldx cx jsr c40adra pla ; restore colors used for primary color ldx flash ; can we use it? beq c40put5 ; yes. ldx decrev ; is the background bright or dark lda backclr,x ; or in background color asl a ; use background color for forground asl a asl a asl a ora backclr,x ; or in background color c40put5:ldy #$00 sta (dest),y ; adjust alternate color ram c40put4:rts ; all done. ; ; c40irm - make space for a character if insert replace mode is insert ; ; In this code, the sense of dest and source are reversed. ; c40irm: ldx #39 ldy cy jsr c40adrt c40irm2:sec lda dest sta source sbc #$08 sta dest lda dest+1 sta source+1 sbc #$00 sta dest+1 dex bmi c40irm1 cpx cx bcc c40irm1 ldy #$07 c40irm3:lda (dest),y sta (source),y dey bpl c40irm3 bmi c40irm2 ; always taken c40irm1:ldx #$00 ldy cy jsr c40adra ldy cx c40irm4:lda (dest),y ; who cares what x is the first time? pha txa sta (dest),y pla tax iny cpy #40 bcc c40irm4 ldx #$00 ldy cy jsr c40adrp ldy cx c40irm5:lda (dest),y ; who cares what x is the first time? pha txa sta (dest),y pla tax iny cpy #40 bcc c40irm5 rts ; ; c40dch - delete one or more characters. ; ; Input: Number of characters in A-reg ; Cursor position in cx, cy ; ; Note that in this routine, the sense of dest and source are reversed ; c40dch: sta freemem ; save number of characters to delete lda cx c40dch3:pha ; save counter tax ; address of character to cover up ldy cy jsr c40adrt ; copy dest -> source lda dest sta source lda dest+1 sta source+1 clc pla ; remember counter pha ; save again adc freemem ; what to cover character with cmp #40 ; cover with a blank? bcs c40dch1 tax ; compute address of character to use ldy cy jsr c40adrt ldy #$07 ; copy in 8 bytes c40dch2:lda (dest),y sta (source),y dey bpl c40dch2 pla ; remember & save counter pha tax ; compute primary color address ldy cy jsr c40adrp ldy freemem ; number of characters to delele lda (dest),y ; attribute for character to use ldy #$00 sta (dest),y ; address of character to replace pla ; remember & save counter pha tax ; compute alternate color address ldy cy jsr c40adra ldy freemem ; number of characters to delele lda (dest),y ; attribute for character to use ldy #$00 sta (dest),y ; address of character to replace clc ; now add 1 to the counter and repeat pla adc #$01 bcc c40dch3 ; always taken c40dch1:lda #$00 ; replace character with a blank ldy #$07 ; 8 bytes c40dch4:sta (dest),y dey bpl c40dch4 clc ; now add 1 to the counter and repeat pla adc #$01 cmp #40 bcc c40dch3 rts ; all done ; ; c40drw - draw a character at cx, cy ; ; Input: character to put in a-reg (use funny ascii) ; Output: A - size of character ; ; Registers destroyed - A,X,Y ; ; This routine puts a character at screen position tektx, tekty and ; returns the size of the character. ; c40drw: sta source lda #$00 sta source+1 asl source ; multiplied by 2 rol source+1 asl source ; multiplied by 4 rol source+1 asl source ; multiplied by 8 rol source+1 lda source ; now add in font40 adc #font40\ ; carry is clear sta source lda source+1 adc #font40^ sta source+1 ldy #$07 ; copy the character for c40sub c40drw1:lda (source),y sta freemem,y dey bpl c40drw1 jsr c40sub ; offset the character ldx tektxhi cpx #40 ; skip if past right of screen bcs c40drw3 ldy tektyhi ; compute the address to store at dey cpy #25 ; skip if past bottom of screen bcs c40drw3 jsr c40adrt ldy #$07 ; copy in the upper left c40drw2:lda freemem,y ora (dest),y sta (dest),y dey bpl c40drw2 c40drw3:ldx tektxhi inx ; put this part of the character 1 space right cpx #40 ; skip if past right edge bcs c40drw5 ldy tektyhi dey cpy #25 ; skip if past bottom of screen bcs c40drw5 jsr c40adrt ldy #$07 ; copy in the upper right c40drw4:lda freemem+16,y ora (dest),y sta (dest),y dey bpl c40drw4 c40drw5:ldx tektxhi cpx #40 ; skip if past right edge bcs c40drw7 ldy tektyhi cpy #25 ; skip if past bottom bcs c40drw7 jsr c40adrt ldy #$07 ; copy in the lower left c40drw6:lda freemem+8,y ora (dest),y sta (dest),y dey bpl c40drw6 c40drw7:ldx tektxhi inx ; put this part of the character 1 space left cpx #40 ; skip if past right edge bcs c40drw9 ldy tektyhi cpy #25 ; skip if past bottom bcs c40drw9 jsr c40adrt ldy #$07 ; copy in the lower right c40drw8:lda freemem+24,y ora (dest),y sta (dest),y dey bpl c40drw8 c40drw9:lda #26 ; move cursor 26 pixels right rts ; ; freemem | freemem + 16 ; ------------------------------------ ; freemem + 8 | freemem + 24 ; c40sub: ldy #$17 ; zero 24 bytes at freemem+8 lda #$00 c40sub1:sta freemem+8,y dey bpl c40sub1 lda tektylo ; how far to offset down? lsr a ; divide by 2 lsr a ; divide by 4 lsr a ; divide by 8 lsr a ; divide by 16 lsr a ; divide by 32 beq c40sub5 ; skip this if zero tay ; remember how may bits to sift c40sub3:ldx #$0e ; shift down c40sub4:lda freemem,x sta freemem+1,x dex bpl c40sub4 lda #$00 sta freemem dey bne c40sub3 c40sub5:lda tektxlo ; how far to offset left? lsr a ; divide by 2 lsr a ; divide by 4 lsr a ; divide by 8 lsr a ; divide by 16 lsr a ; divide by 32 beq c40sub6 ; skip this if zero tay ; remember c40sub7:ldx #$0f c40sub8:lsr freemem,x ror freemem+16,x dex bpl c40sub8 dey bne c40sub7 c40sub6:rts ; ; c40ind - perform the VT100 index function (scroll the screen) ; ; Input: number of lines to scroll in A-reg ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen in 40 column mode. Only the area ; in the scrolling region is changed. ; ; This routine is also used for delete line. ; c40ind: tax ; save number of lines to delete lda cy ; save the cursor y position pha lda top ; top of scrolling region sta cy txa ; put number of liens to delete on stack pha c40ind1:clc ; get source line pla pha adc cy cmp bot ; see if this line is on the scrolling area beq c40ind3 bcs c40ind2 c40ind3:pha ; save this result -- useful later tay ldx #$00 jsr c40adrt ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adrt ldx #40 ; 40 * 8 = 320 bytes to move jsr move8 ; scroll one line pla ; source line numver pha tay ldx #$00 jsr c40adrp ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adrp ldx #5 ; 5 * 8 = 40 bytes to move jsr move8 ; scroll one line pla tay ldx #$00 jsr c40adra ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adra ldx #5 ; 5 * 8 = 40 bytes to move jsr move8 ; scroll one line inc cy ; no do the next line jmp c40ind1 c40ind2:jsr c40el2 ; whoops... Clear a line at bottom of area inc cy ; go do the next line ldy bot cpy cy bcs c40ind1 pla ; discard number of lines to scroll pla ; restore the cursor position sta cy rts ; ; c40ri - perform the VT100 reverse index function (scroll backwards) ; ; Input: Number of lines to scroll in A-reg. ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine scrolls the screen upwards in 40 column mode. Only the ; area in the scrolling region is changed. ; ; This routine is also used for insert line. ; c40ri: tax ; save numver of lines to delete lda cy ; save the cursor y position pha lda bot ; top of scrolling region sta cy txa ; put number of lines to delete on stack pha c40ri1: sec ; compute cy-top_of_stack the hard way pla pha eor #$ff adc cy cmp top bmi c40ri2 ; ran off the top of the scrolling region pha ; save this results. Useful later tay ldx #$00 jsr c40adrt ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adrt ldx #40 ; 40 * 8 = 320 bytes to move jsr move8 ; scroll one line pla pha tay ldx #$00 jsr c40adrp ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adrp ldx #5 ; 5 * 8 = 40 bytes to move jsr move8 ; scroll one line pla tay ldx #$00 jsr c40adra ; calculate source address lda dest ; source address must be moved from dest sta source lda dest+1 sta source+1 ldy cy ; calculate destination address ldx #$00 jsr c40adra ldx #5 ; 5 * 8 = 40 bytes to move jsr move8 ; scroll one line dec cy jmp c40ri1 ; repeat until done c40ri2: jsr c40el2 ; erase the bottom line dec cy ldy cy cpy top bpl c40ri1 pla ; discard number of lines to delete pla ; restore the cursor position sta cy rts ; ; c40el0 - Perform the VT100 Erase Line function #0 on 40 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the cursor to the end of the line ; c40el0: ldy cy ldx cx jsr c40adrt ; find address to clear lda #40 sec sbc cx ; number of characters to erase tax jsr clear8 ; zero some memory rts ; ; c40el1 - Perform the VT100 Erase Line function #1 on 40 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases from the beginning of line to cursor ; c40el1: ldy cy ldx #$00 jsr c40adrt ; find address to clear ldx cx jsr clear8 ; zero some memory rts ; ; c40el2 - Perform the VT100 Erase Line function #2 on 40 column screen ; ; Input: Number of line to erase in cy ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine erases one line compleatly from the 40 column display. ; c40el2: ldy cy ; get line to erase ldx #$00 ; start erasing at start of line jsr c40adrt ; put address of text to erase in dest ldx #40 ; number of bytes to erase (320 / 8 = 40) jsr clear8 ldy cy ; erase the color ram too ldx #$00 jsr c40adrp lda foreclr ; get proper foreground color asl a ; put in high nybble asl a asl a asl a ldx decrev ; is the background bright or dark ora backclr,x ; or in background color pha ; save color stuff for secondary color ram ldx #5 ; number of bytes to fill (40 / 8 = 5) jsr fill8 ; erase one line ldy cy ; erase secondary color ram ldx #$00 jsr c40adra pla ; remember what to erase it with ldx #5 ; number of bytes to fill (40 / 8 = 5) jsr fill8 ; erase one line rts ; all done ; ; c40int - convert tektronix coordinates into internal form ; ; Input: tekcxlo, tekcxhi ; tekcylo, tekcyhi ; Output: tektxlo, tektxhi ; tektylo, tektyhi ; ; This routine converts tektronix coordinates into internal form ; ; In tektronix form, there is a 10 bit number in tekcxlo, tekcxhi ; representing the distance from the left edge. ; ; In internal form, there is a number in tektxhi between 0 and 39 ; representing the number of characters between the left edge and the ; point in ; question. There is a number ; (one of 0,32,64,96,...,224) in tekcxlo representing a fraction of ; a character. ; ; In tektronix form, there is a 10 bit number in tekcylo, tekcyhi ; representing the distance from the _bottom_ of the screen. ; ; In internal form, there is a number in tektyhi between 0 and 24 ; representing the distance from the _top_ of the screen in characters. ; The fractional part of a character is stored in tektylo. It will ; be one of these numbers: 0,32,64,96,...,224. ; c40int: lda tekcxlo ; get the current x coordinate sta tektxlo lda tekcxhi sta tektxhi asl tektxlo ; multiply x coordinate by 4 rol tektxhi asl tektxlo rol tektxhi clc ; add in one. Now multiplied by 5 lda tektxlo adc tekcxlo sta tektxlo lda tektxhi adc tekcxhi sta tektxhi asl tektxlo ; multiply by 2 more for a total of 10. done. rol tektxhi sec ; invert the sence of y coordinate (799 - y) lda #779\ sbc tekcylo sta tektylo lda #779^ sbc tekcyhi sta tektyhi asl tektylo ; multiply by 8 (800 * 8 / 256 = 25) rol tektyhi ; now multiplied by 2 asl tektylo rol tektyhi ; now multiplied by 4 asl tektylo rol tektyhi ; now multiplied by 8 rts ; ; c40lin - draw a line from the current point to the destination point ; ; Input: tekfxlo, tekfxhi - point to draw line from (x position) ; tekfylo, tekfyhi - point to draw line from (y position) ; tektxlo, tektxhi - point to draw line to (x position) ; tektylo, tektyhi - point to draw line to (y position) ; ; This routine draws a line. ; ; It works by computing a delta. we then add the delta to the current ; point and plot. we stop only when the current point is equal to the ; destination point. ; ; We optimize this by multiplying the delta by 2 until we know that ; each point plotted is at a different spot. (We do not need to plot ; the same point more than once) ; c40lin: lda #$00 ; zero the ultra-low coordinate sta tekfxul sta tekfyul sec ; compute delta x lda tektxlo sbc tekfxlo sta tekdxul lda tektxhi sbc tekfxhi sta tekdxlo lda #$00 sbc #$00 sta tekdxhi sec ; compute delta y lda tektylo sbc tekfylo sta tekdyul lda tektyhi sbc tekfyhi sta tekdylo lda #$00 sbc #$00 sta tekdyhi ldx #$08 ; dont optimize more than 8 times!!!! c40lin2:lda tekdxlo ; is the x delta negative bpl c40lin3 eor #$ff ; get the positive equivalent c40lin3:cmp #$0f ; is it big enough bcs c40lin1 lda tekdylo ; is the y delta negative bpl c40lin4 eor #$ff ; get the positive equivalent c40lin4:cmp #$0f ; is it big enough bcs c40lin1 asl tekdxul ; multiply the x delta by two rol tekdxlo asl tekdyul ; multiply the y delta by two rol tekdylo dex bne c40lin2 ; try to optimize some more c40lin1:jsr c40pnt ; now we can finally plot a point clc ; add in the x delta lda tekfxul adc tekdxul sta tekfxul lda tekfxlo adc tekdxlo sta tekfxlo lda tekfxhi adc tekdxhi sta tekfxhi clc ; add in the y delta lda tekfyul adc tekdyul sta tekfyul lda tekfylo adc tekdylo sta tekfylo lda tekfyhi adc tekdyhi sta tekfyhi lda tekfxlo ; compare current point with destination cmp tektxlo bne c40lin1 ; if not the same, go plot another point lda tekfxhi ; compare current point with destination cmp tektxhi bne c40lin1 ; if not the same, go plot another point lda tekfylo ; compare current point with destination cmp tektylo bne c40lin1 ; if not the same, go plot another point lda tekfyhi ; compare current point with destination cmp tektyhi bne c40lin1 ; if not the same, go plot another point rts ; all done ; ; c40pnt - plot a point ; ; input: point to plot in tektxlo, tektxhi, tektylo, tektyhi ; ; This routine plots a point in 40 column mode ; c40pnt: ldx tekfxhi ; get x coordinate of character to change cpx #40 ; check to see if off screen bcs c40pnt1 ldy tekfyhi ; get y coordinate of character to change cpy #25 ; check to see if off screen bcs c40pnt1 jsr c40adrt ; get address of character to change lda tekfylo ; get the row of the character to change lsr a lsr a lsr a lsr a lsr a tay lda tekfxlo ; get the column of the character to change lsr a lsr a lsr a lsr a lsr a tax lda powers,x ora (dest),y ; plot the character sta (dest),y c40pnt1:rts ; ; c40era - erase the graphics screen in tektronix mode ; c40era: jmp c40clr ; just like erasing in text mode ; ; c40txt - show the text screen ; ; This routine swaps the text and graphics screens ; c40txt: lda $d018 ; tell vic where to find screen & color ram and #vicmsk ora #vicdat1 sta $d018 ; "" rts ; ; c40tek - show the graphics screen ; ; This routine swaps the current screen in underneath the kernal and IO, ; and swaps the hidden screen back out. ; c40tek: lda $d018 ; tell vic where to find screen & color ram and #vicmsk ora #vicdat1 sta $d018 lda #vicclr1\ ; fill the color ram sta dest lda #vicclr1^ sta dest+1 lda foreclr asl a asl a asl a asl a ora backclr ldx #$400/$08 jsr fill8 rts ; ; c40clr - clear the graphics screen in 40 column mode ; c40clr: lda #victext\ sta dest lda #victext^ sta dest+1 jsr clr8k rts ; ; c40fls - flash the screen in 40 column mode ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine flashes the screen in 40 column mode ; c40fls: lda $d018 ; swap between primary color ram and alternate eor #vicswap sta $d018 rts ; all done ; ; c40tgl - toggle the cursor in 40 column mode ; ; Input: None ; Output: None ; ; Registers destroyed - A,X,Y ; ; This routine toggles the cursor in 40 column mode. ; c40tgl: ldy cy ; compute cursor address ldx cx jsr c40adrt ldy #$07 ; blink the cursor c40tgl2:lda (dest),y eor #$ff sta (dest),y dey bpl c40tgl2 c40tgl1:rts ; ; c40tst - test to see if the 40 column screen driver is present ; ; Input: None ; Output: carry always clear because 40 columns is always available ; ; Registers destroyed - None ; ; This routine returns with the carry clear to indicate that the 40 ; column screen is always available. ; c40tst: clc rts ; ; c40adrt - Compute the address of 40 column text ; ; Input: Line number to y-reg ; Column number in x-reg ; Output: Address stored in dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the memory address of a character in 40 column ; mode. ; c40adrt:jsr c40adr ; compute 40*y+x asl dest ; multiply by 2 rol dest+1 asl dest ; multiply by 4 rol dest+1 asl dest ; multiply by 8 rol dest+1 lda dest ; add in start of screen adc #victext\ ; carry already clear sta dest lda dest+1 adc #victext^ sta dest+1 rts ; ; c40adrp - Compute the address of 40 column primary color ram ; ; Input: Line number to y-reg ; Column number in x-reg ; Output: Address stored in dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the memory address of a character in 40 column ; mode. The address returned is the address of the primary color ram. ; c40adrp:jsr c40adr ; compute base address clc ; add in vicclr1 lda dest adc #vicclr1\ sta dest lda dest+1 adc #vicclr1^ sta dest+1 rts ; ; c40adra - Compute the address of 40 column alternate color ram ; ; Input: Line number to y-reg ; Column number in x-reg ; Output: Address stored in dest ; ; Registers destroyed - A,X,Y ; ; This routine calculates the memory address of a character in 40 column ; mode. The address returned is the address of the alternate color ram. ; c40adra:jsr c40adr ; compute base address clc ; add in vicclr1 lda dest adc #vicclr2\ sta dest lda dest+1 adc #vicclr2^ sta dest+1 rts ; ; c40adr - calculate 40*y+x ; ; Input: numbers in x-reg and y-reg ; Output: dest ; ; Registers destroyed - A,Y ; ; This routine calculates 40*y+x and puts the result in dest. If x > 40, ; one is subtracted first. This will happen after a character is printed ; on the last character on a line. This routine is for calculating ; screen addresses. ; c40adr: sty dest ; put y-reg in dest lda #$00 ; zero extend sta dest+1 asl dest ; multiplied by 2 rol dest+1 asl dest ; multiplied by 4 rol dest+1 tya ; add in y to get 5*y adc dest ; carry is clear sta dest bcc c40adr1 inc dest+1 c40adr1:asl dest ; multiplied by 10 rol dest+1 asl dest ; multiplied by 20 rol dest+1 asl dest ; multiplied by 40 rol dest+1 cpx #40 ; are we in the funny row? bcc c40adr2 ; no ldx #39 c40adr2:txa ; add in x-reg clc adc dest sta dest bcc c40adr3 inc dest+1 c40adr3:rts ; all done ; ; Newchar - character mapping table ; ; This table is used to define the 80 column and 40 column character sets ; The format of this table is: ; Number of characters to copy (byte) ; Source of characters (word) ; Destination for characters (word) ; newchar:.byte 32 ; - ? .word $d000+<32*8> .word font40+<00*8> .byte 28 ; @ A-Z [ .word $d000+<00*8> .word font40+<32*8> .byte 1 ; \ .word char92 .word font40+<60*8> .byte 1 ; ] .word $d000+<29*8> .word font40+<61*8> .byte 3 ; ^ _ ` .word char94 .word font40+<62*8> .byte 26 ; a-z .word $d800+<01*8> .word font40+<65*8> .byte 4 ; { | } ~ .word char123 .word font40+<91*8> .byte 1 ; diamond .word $d000+<90*8> .word font40+<95*8> .byte 1 ; square .word $d000+<102*8> .word font40+<96*8> .byte 8 ; h-t, f-f, c-r, l-f, degrees, plus/minus, n-l, v-t .word char129 .word font40+<97*8> .byte 1 ; upper-left .word $d000+<125*8> .word font40+<105*8> .byte 1 ; lower-left .word $d000+<110*8> .word font40+<106*8> .byte 1 ; lower-right .word $d000+<112*8> .word font40+<107*8> .byte 1 ; upper-right .word $d000+<109*8> .word font40+<108*8> .byte 1 ; crossed lines .word $d000+<91*8> .word font40+<109*8> .byte 1 ; scan 1 .word $d000+<119*8> .word font40+<110*8> .byte 1 ; scan 3 .word $d000+<69*8> .word font40+<111*8> .byte 1 ; scan 5 .word $d000+<67*8> .word font40+<112*8> .byte 1 ; scan 7 .word $d000+<82*8> .word font40+<113*8> .byte 1 ; scan 9 .word $d000+<111*8> .word font40+<114*8> .byte 1 ; middle-right .word $d000+<107*8> .word font40+<115*8> .byte 1 ; middle-left .word $d000+<115*8> .word font40+<116*8> .byte 2 ; upper-middle, lower-middle .word $d000+<113*8> .word font40+<117*8> .byte 1 ; vertical line .word $d000+<93*8> .word font40+<119*8> .byte 2 ; <=, >= .word char152 .word font40+<120*8> .byte 1 ; pi .word $d000+<94*8> .word font40+<122*8> .byte 1 ; != .word char155 .word font40+<123*8> .byte 1 ; british pound .word $d000+<28*8> .word font40+<124*8> .byte 1 ; dot .word char157 .word font40+<125*8> .byte 0 ; end of table .byte *-newchar ; abort assembly if table too long ; ; charXXX - 40 column character definitions not available in rom ; char92: .byte $00,$60,$30,$18,$0c,$06,$03,$00 ; \ char94: .byte $00,$00,$18,$3c,$66,$00,$00,$00 ; ^ .byte $00,$00,$00,$00,$00,$00,$00,$7f ; _ .byte $30,$18,$0c,$00,$00,$00,$00,$00 ; ` char123:.byte $0e,$18,$08,$3c,$08,$18,$0e,$00 ; { .byte $18,$18,$18,$00,$18,$18,$18,$00 ; | .byte $70,$18,$10,$3c,$10,$18,$70,$00 ; } .byte $00,$00,$3b,$6e,$00,$00,$00,$00 ; ~ char129:.byte $a0,$a0,$e0,$ae,$a4,$04,$04,$00 ; (graphics) h-t .byte $e0,$80,$ee,$88,$8e,$08,$08,$00 ; (graphics) f-f .byte $60,$80,$8c,$6a,$0c,$0a,$0a,$00 ; (graphics) c-r .byte $80,$80,$8e,$88,$ee,$08,$08,$00 ; (graphics) l-f .byte $18,$24,$24,$18,$00,$00,$00,$00 ; (graphics) degrees .byte $00,$18,$7e,$18,$7e,$00,$00,$00 ; (graphics) plus/minus .byte $a0,$e0,$e8,$e8,$a8,$08,$0e,$00 ; (graphics) n-l .byte $a0,$a0,$a0,$4e,$04,$04,$04,$00 ; (graphics) v-t char152:.byte $06,$18,$30,$18,$06,$00,$7e,$00 ; (graphics) <= .byte $60,$18,$06,$18,$60,$00,$7e,$00 ; (graphics) >= char155:.byte $00,$03,$7e,$0c,$7e,$30,$60,$00 ; (graphics) != char157:.byte $00,$00,$00,$18,$18,$00,$00,$00 ; (graphics) dot .SBTTL Miscellaneous routines ; ; These are miscellaneous routines used in many different places ; ; ; Move8 - move x-reg 8-byte chunks of memory ; ; Input: X - Number of 8-byte chunks of memory to move ; (source) - address of source of memory move ; (dest) - address of destination of memory move ; ; Output: Memory is moved ; ; Registers Destroyed: A,X,Y ; move8: ldy #$00 ; zero y-reg move8a: lda (source),y ; get one byte to move sta (dest),y ; move it iny ; go on to the next byte lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny lda (source),y ; duplicated for speed sta (dest),y iny bne move8b ; crossed page boundry? inc source+1 inc dest+1 move8b: dex ; anything more to move? bne move8a ; yes, move it. rts ; ; clr8k - clear 8000 (not 8192!) bytes of memory ; clr8k: lda #4 ; loop through 4 times clr8k1: pha lda dest+1 pha lda dest pha ldx #250 ; clear 2000 bytes (250 * 8 = 2000) jsr clear8 pla clc adc #2000\ sta dest pla adc #2000^ sta dest+1 pla sec sbc #$01 bne clr8k1 rts ; ; Clear8 - clear x-reg 8-byte chunks of memory ; ; Input: X - Number of 8-byte chunks of memory to clear ; (dest) - address of destination of memory move ; ; Output: Memory is cleared ; ; Registers Destroyed: A,X,Y ; clear8: lda #$00 ; clear memory by filling with $00 jsr fill8 rts ; ; Fill8 - fill x-reg 8-byte chunks of memory with a-reg ; ; Input: X - Number of 8-byte chunks of memory to fill ; A - Byte to fill memory with ; (dest) - address of destination of memory move ; ; Output: Memory is filled ; ; Registers Destroyed: A,X,Y ; fill8: ldy #$00 ; zero y-reg fill8a: sta (dest),y ; fill it iny ; go on to the next byte sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny sta (dest),y ; duplicated for speed iny bne fill8b ; crossed page boundry? inc dest+1 fill8b: dex ; anything more to fill? bne fill8a ; yes, fill it. rts ; ; Case - Pascal like case function ; ; Input: Y - Case statement to select ; The addresses of the routines to select are compiled inline ; ; Registers Destroyed: X, Y ; ; this routine transfers controll to a routine selected by the Y register ; case: tax ; preserve a-reg across case statement pla ; get lo bype of case list sta source ; save it pla ; get hi byte of case list sta source+1 ; save it tya ; put case selector into a-reg sec ; add one half rol a ; and multiply by two tay ; put (2*case_selector)+1 into y-reg lda (source),y ; get lo byte of routine to go to sta dest ; save it iny ; prepare to get hi byte of routines address lda (source),y ; get hi byte of routines address sta dest+1 ; save it txa ; preserve a-reg across case statement jmp (dest) ; go to appropriate ; ; powers - powers of 2 ; powers: .byte $80 .byte $40 .byte $20 .byte $10 .byte $08 .byte $04 .byte $02 .byte $01 anyrts: rts ; a handy return from subroutine instruction anybrk: brk ; a handy break instruction end.asm:= * .SBTTL Data for the screen package fast: .byte $ff ; flag for fast mode. Copied to $d030. b80flag:.byte $ff ; flag for b80. set if initializing. clear otherwise bordold:.byte $ff ; saved bordor color line25: .byte $ff ; $01=use 25th line, $00=keep line as blank or sysline top: .byte $ff ; top of scrolling area bot: .byte $ff ; bottom of scrolling area cx: .byte $ff ; cursor x coordinate cy: .byte $ff ; cursor y coordinate cntdown:.byte $ff ; countdown timer curabrt:.byte $ff ; $00=cursor disabled. Incremented & decremented. curstat:.byte $ff ; $00=cursor light now, $01=cursor dark now evenodd:.byte $ff ; $f0=cursor on even column, $0f=cursor on odd column save1: .byte $ff ; screen save area #1 save2: .byte $ff ; screen save area #2 save3: .byte $ff ; screen save area #3 save4: .byte $ff ; screen save area #4 save5: .byte $ff ; screen save area #5 save6: .byte $ff ; screen save area #6 save7: .byte $ff ; screen save area #7 save8: .byte $ff ; screen save area #8 save9: .byte $ff ; screen save area #9 vt100gs = 8 ; there are seven graphic rendition parameters vt100gr .blkb vt100gs ; graphic rendition params for vt100 emulation alternt = vt100gr+1; $00=normal color, $01=alternate color underln = vt100gr+4; $00=underline off, $ff=underline on flash = vt100gr+5; $00=normal text, $01=flashing text reverse = vt100gr+7; $00=reverse off, $ff=reverse on vt100ss = 10 ; there are nine settable switches vt100sw:.blkb vt100ss ; vt100 switches decckm = vt100sw+1; $01=cursor keys in application mode decanm = vt100sw+2; $01=normal emulation, $00=vt100 emulating vt52 decrev = vt100sw+5; $01=screen reversed, $00=screen normal decom = vt100sw+6; $01=relative, $00=absolute wrap = vt100sw+7; $01=automatic wrapping, $00=no automatic wrapping decarm = vt100sw+8; $01=automatic key repeat, $00=no automatic repeat deckpam .byte $ff ; $00 = use numeric keypad, $01=use alternat keypad lmn: .byte $ff ; $00 = new line mode clear, $01 = new line mode set irm: .byte $ff ; $00 = insert/replace mode = replace, $01 = insert g0: .byte $ff ; $00 = U.S. charset on g0, $01 = graphics on g0 g1: .byte $ff ; $00 = U.S. charset on g1, $01 = graphics on g1 gx: .byte $ff ; $00 = g0 selected, $01 = g1 selected .SBTTL Data for the key scanner keylast:.byte $ff keyrept:.byte $ff keytime:.byte $ff keycol: .byte $ff keycol1:.byte $ff .SBTTL Data for the vt100 emulation package vt100st:.byte $ff ; parser state vt100pt:.byte $ff ; parameter pointer tekmode:.byte $ff ; mode of the tektronics PLOT10 command parser tekpen: .byte $ff ; $00 = pen up, $01 = pen down tekrxlo:.byte $ff ; tektronix receive buffer tekrxhi:.byte $ff tekrylo:.byte $ff tekryhi:.byte $ff tekcxlo:.byte $ff ; tektronix cursor (tektronix format) tekcxhi:.byte $ff tekcylo:.byte $ff tekcyhi:.byte $ff tekfxlo:.byte $ff ; tektronix 'from point' (screen driver format) tekfxhi:.byte $ff tekfylo:.byte $ff tekfyhi:.byte $ff tektxlo:.byte $ff ; tektronix 'to point' (screen driver fromat) tektxhi:.byte $ff tektylo:.byte $ff tektyhi:.byte $ff tekdxlo:.byte $ff ; tektronix 'delta' for line drawing tekdxhi:.byte $ff tekdylo:.byte $ff tekdyhi:.byte $ff tekfxul:.byte $ff ; ultra-low from point (only used in line drawing) tekfyul:.byte $ff ; ultra-low from point (only used in line drawing) tekdxul:.byte $ff ; ultra-low delta point (only used in line drawing) tekdyul:.byte $ff ; ultra-low delta point (only used in line drawing) .SBTTL Scratch area freesiz = $20 freemem:.blkb freesiz tabs: .blkb 81 ; tab stops .blkb $100 ; safe and documented area for binary patches. ; cmbuf, atmbuf and plnbuf transplanted so that end of program does not ; go past $8000. cmbuf: .blkb $100 ; Input command buffer atmbuf: .blkb $100 ; Atombuffer, (for cmtxt and cmifil) plnbuf: .blkb $100 ;[DD] Port line buffer font40: = *