home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
c64cross.zip
/
c64slk.m65
< prev
next >
Wrap
Text File
|
1992-09-29
|
488KB
|
17,340 lines
.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 ^[[<int>;<int>;<int>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 By: 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 <esc> "," 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).
;
;
; 74 By: Ray Moody On: 06-Sep-1991
; Added basic Swiftlink support. "Set" and "show" commands
; still not fully implemented.
;
;
; 75 By: Matthew Sorrels On: 08-Feb-1992
; Fixed basic Swiftlink support so it really works.
; Added set/show port-address and working-drive
; Fixed start up sequence to not need INI file
; Swiftlink version using different INI file (SLKERMIT.INI)
;
; 76 By: Matthew Sorrels On: 23-May-1992
; Finished up Swiftlink version. Removed beta strings. Changed version
; to 2.2 (76)
;
; 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 ; <null>
soh = $01 ; <soh>
bs = $08 ; <bs>
tab = $09 ; <tab> (ctrl/I)
lf = $0a ; <lf>
ffd = $0c ; Form feed
cr = $0d ; <cr>
ctrlu = $15 ; <ctrl/U>
ctrlx = $18 ; <ctrl/X>
ctrly = $19 ; <ctrl/Y>
esc = $1b ; <esc>
sp = $20 ; <space>
space = $20 ; """"
del = $7f ; <del>
cdel = $14 ; commodore del
quest = $3F ; <?>
ctrlw = $17 ; <ctrl/W>
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
; To move vicclr1 and vicclr2 you need to compute vicdat1 and vicdat2
; where the top 4 bits are the screen memory location of vicclr1 and vicclr2
; then you need to adjust the vicswap value. It must be possible to xor
; vicdat1 with vicswap and get vicdat2 and the reverse must be true
; Note no space in the $9000-$a000 block is usable because of the char ROMs
vicmsk = %00000111 ; info to set up vic chip to use this memory
vicdat1 = %00111000 ; ""
; this isn't needed as it is computed by XOR'ing vicdat1 and vicswap
; It is just here as a reference
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
nmiv = $0318
; Just before the secondary color map don't move it into the $8800-$9000 block
rdbuf = $8700
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
orignmiv: .byte $00 ; Jump vector for NMI routine
.byte $00
.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 <ctrl/H>
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 <ctrl/H>
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 <ctrl/H>
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 <ctrl/H>
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 <ctrl/H>
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 #$a0 ; we are special caseing the space stuff
bne cmif22 ; so it is not an action char
lda #sp
cmif22:
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 #$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 <ctrl/H>
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 <ctrl/H>
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 <esc>?
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 <esc> loses
lda lenabf ; Ok, there is a default, but if
bne cmun14 ; something has been typed, <esc> 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 <ctrl/H>
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 <ctrl/H>
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 <bs>?
beq cminb3 ; Yes
; cmp #cdel ; A <del>?
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 <lf> and <cr>?
jmp cminac ; No, not in range at all
cmits1: cmp #cr+1 ; ...
bmi cmnb43 ; Yes, handle it
cmp #space ; Between <sp> 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 <tab>?
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 ; <tab>?
bne cmgtc3 ; Neither space nor <tab>
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 <tab>
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 ; <cr>?
beq cmgtc4 ;
cmp #lf ; <lf>?
beq cmgtc4 ;
cmp #ffd ; <ff>?
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 = $5d ; 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
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 <lf> flag
dellf: .byte ; Flush a <lf> 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 fbebit ; File-byte-size
filmod: .byte $01 ; Current file type
usehdr: .byte on ; Switch - where to get filename (on=file-head)
lecho: .byte off ; Local-echo switch
ibmmod: .byte off ; Ibm-mode switch
vtmod: .byte $02 ; Term Emulation mode switch (Vt100 default)
parity: .byte nparit ; Parity setting
baud: .byte $02 ;[17] Baud setting (default = 2400)
wrdsiz: .byte fbebit ;[17] Word length setting
flowmo: .byte on ;[24] Flow-Control switch
delay: .byte $00 ; Amount of delay before first send
filwar: .byte on ; File-warning switch
debug: .byte $01 ; Debug switch
ebqmod: .byte on ; Eight-bit-quoting mode
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 $01 ; 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 12 ; background color
britclr:.byte 15 ; light background color (selected with decrev)
foreclr:.byte 0 ; foreground color
altclr: .byte 1 ; alternate color
bordclr:.byte 6 ; border color
portadd: .byte $01 ; Swift-link port address
workdri: .byte 8
; ttime: .word $0000 ;[49] Time out interval (receive and send)
ttime: .byte $00,$00,$00
;
; 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 51 ; 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
cntrl .byte $00
.SBTTL Kermit initialization
;
; The following code sets up Kermit-65 for normal operation.
;
kstart:
lda nmiv
sta orignmiv
lda nmiv+1
sta orignmiv+1
jsr clall ;[] First close all open channels
; The auto-boot routine in C-128 mode requires you restore I/O vectors
; otherwise we don't want to do this because it would mess with RAMDOS
lda $cf00
cmp #$20
bne noboot
lda $cf01
cmp #$84
bne noboot
lda $cf02
cmp #$ff
bne noboot
jsr ioinit ;[16] Initialize I/O devices
jsr restoi ; restore vectors
noboot:
; Sometimes the current working drive is just wrong...so if the device
; is less than 8 we are making it 8
; This should be more comprehensive (ie greater than 15 should also be 8)
; but thats life
lda $BA
cmp #$08
bpl serialdr
lda #$08
serialdr:
sta workdri
jsr scrini ; initilize the screen packages
jsr scrent ; Init the 80 col screen
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
lda #$00 ; turn off graphics mode
sta tekmode
sta stat ; clear the error count
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
beq 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 <cr>
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
beq 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
beq 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 <esc> '[' 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 <esc> '[' 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 <esc> '[' integer ';' integer 'f' and
; <esc> '[' 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 <esc> 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 <esc> '[' integer 'A' sequence
;
; This routine moves the cursor up <integer> 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 <esc> '[' integer 'B' sequence
;
; This routine moves the cursor down <integer> 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 <esc> '[' integer 'C' sequence
;
; This routine moves the cursor right <integer> 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 <esc> '[' integer 'D' sequence
;
; This routine moves the cursor left <integer> 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 <esc> '[' [ 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 <esc> '[' '?' 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 <esc> '[' '?' 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 <esc> '[' 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 <esc> '[' 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 <esc> '[' <line> ';' <column> '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 <esc> '[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 <esc> 'Z' and <esc> '[' 'c' sequences
;
; The device attributes are sent to the modem.
;
vt100s: lda #esc ; send <esc> '[?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 <esc> '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 <esc> '[' integer h and <esc> '[' 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 <esc> '[' 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 <es> '[' 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 <esc> '[' 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 <esc> <comma> 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 <ESC>[
.word vt100a1-vt100ta
.byte '# ; many different sequences begin with <ESC>#
.word vt100a5-vt100ta
.byte 'M ; <esc> 'M'
.word scrrlf ; is reverse index
.byte 'E ; <esc> 'E'
.word vt100o ; is next line
.byte 'D ; <esc> 'D'
.word scrlf ; is index
.byte '7 ; <esc> '7'
.word scrsav ; means save cursor position
.byte '8 ; <esc> '8'
.word scrlod ; means load cursor position
.byte 'H ; <esc> 'H'
.word vt100p ; means set a tab stop
.byte '= ; <esc> '>'
.word vt100n ; puts keypad in alternate mode
.byte '> ; <esc> '='
.word vt100m ; puts keypad in numeric mode
.byte 'Z ; <esc> 'Z'
.word vt100s ; sends the terminal identity
.byte 'c ; <esc> 'c'
.word vt100t ; resets the terminal
.byte '( ; <esc> '('
.word vt100a6-vt100ta ; means mount a character set
.byte ') ; <esc> ')'
.word vt100a7-vt100ta ; means mount a character set
.byte $0c ; <esc> form-feed
.word vt100x1 ; means enter graphics mode
.byte ', ; <esc> ','
.word vt100z3 ; means delay for 250 ms
.byte $00
vt100a1:.byte $ff
.word 0
.byte 'J ; <esc> '[' integer 'J'
.word vt100b1
.byte 'K ; <esc> '[' integer 'K'
.word vt100c1
.byte 'A ; <esc> '[' integer 'A'
.word vt100f1
.byte 'B ; <esc> '[' integer 'B'
.word vt100g1
.byte 'C ; <esc> '[' integer 'C'
.word vt100h1
.byte 'D ; <esc> '[' integer 'D'
.word vt100i1
.byte 'm ; <esc> '[' integer ';']... 'm'
.word vt100j1
.byte ';
.word vt100a2-vt100ta
.byte 'f ; <esc> '[' 'f'
.word vt100d1
.byte 'H ; <esc> '[' 'H'
.word vt100d1
.byte 'r ; <esc> '[' 'r'
.word vt100e1
.byte '? ; <esc> '[' '?'
.word vt100a3-vt100ta
.byte 'g ; <esc> '[' integer 'g'
.word vt100q ; means clear tab stop(s)
.byte 'n ; <esc> '[' integer 'n'
.word vt100r ; means create a reply message
.byte 'c ; <esc> '[' integer 'c'
.word vt100s ; sends terminal identification
.byte 'h ; <esc> '[' integer 'h'
.word vt100v1 ; means set new line mode
.byte 'l ; <esc> '[' integer 'l'
.word vt100v2 ; means clear new line mode
.byte 'P ; <esc> '[' integer 'P'
.word vt100y1 ; means delete some characters
.byte 'L ; <esc> '[' integer 'L'
.word vt100z1 ; means insert some lines
.byte 'M ; <esc> '[' integer 'M'
.word vt100z2 ; means delete some lines
.byte $00
vt100a2:.byte $ff
.word 0
.byte 'H
.word vt100d1 ; <esc> '[' integer ';' integer 'H'
.byte 'f
.word vt100d1 ; <esc> '[' integer ';' integer 'f'
.byte 'r
.word vt100e1 ; <esc> '[' integer ';' integer 'r'
.byte 'm
.word vt100j1 ; <esc> '[' integer ';' integer 'm'
.byte ';
.word vt100a4-vt100ta ; <esc> '[' integer ';' integer ';' ... 'm'
.byte 0
vt100a3:.byte $ff
.word 0
.byte 'h ; <esc> '[' '?' integer 'h'
.word vt100k ; means set switchs
.byte 'l ; <esc> '[' '?' integer 'l'
.word vt100l ; means reset switchs
.byte ';
.word vt100a3-vt100ta
.byte 0
vt100a4:.byte $ff
.word 0
.byte ';
.word vt100a4-vt100ta ; <esc> '[' integer ';' integer ';' integer..
.byte 'm
.word vt100j1 ; <esc> '[' [ingeger ';'] ... 'm'
.byte 0
vt100a5:.byte '8 ; <ESC>#8 fills the screen with 'E's
.word screee
.byte 0
vt100a6:.byte 'A ; <esc> '(' 'A' means mount U.S. chars on g0
.word vt100w1
.byte 'B ; <esc> '(' 'B' means mount U.S. chars on g0
.word vt100w1
.byte '1 ; <esc> '(' '1' means mount U.S. chars on g0
.word vt100w1
.byte '2 ; <esc> '(' '2' means mount U.S. chars on g0
.word vt100w1
.byte '0 ; <esc> '(' '0' means mount graphic chars on g0
.word vt100w2
.byte $00
vt100a7:.byte 'A ; <esc> ')' 'A' means mount U.S. chars on g1
.word vt100w3
.byte 'B ; <esc> ')' 'B' means mount U.S. chars on g1
.word vt100w3
.byte '1 ; <esc> ')' '1' means mount U.S. chars on g1
.word vt100w3
.byte '2 ; <esc> ')' '2' means mount U.S. chars on g1
.word vt100w3
.byte '0 ; <esc> ')' '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 <esc> 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 <esc> '?' ??
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] ...
lda orignmiv
sta nmiv
lda orignmiv+1
sta nmiv+1
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:
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
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
; <cr>,<lf>,<ff>, or <esc> and tries to fetch the file
; represented by that string from a remote server Kermit.
;
getfrs:
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:
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:
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 ; <sp>?
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
jmp stport ; set port address
jmp stworkdisk ; set working disk number
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
mm1: sta $de02 ; fetch control register
lda ksavey ;[18] Fetch back H.O. byte
mm2: sta $de03 ; fetch command register
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 $de02 ;[17] Get the command register
and #%00011111 ; mask parity bits
ldx parity ;[17] Get the index
ora parval,x ;[17] and the parity value from the table
mm3: sta $de02 ; put back the command register
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: ldx baud ; get desired baud rate
mm4: lda $de03 ; get control register
and #%11110000 ; mask off baud bits
ora bdval,x ; or in new baud bits
mm5: sta $de03 ; put back control register
rts
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 $de03 ;[17] Get the control register
and #%10011111 ; mask word length bits
ldx wrdsiz ;[17] Get the word size
cpx #fbsbit ;[17] Is it seven-bit ?
bne dowrd1 ;[17] No, we have the value for eight-bit
ora #%00100000 ; set for seven bits (eight bit value is zero)
dowrd1: sta $de03 ; put back control register
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
stport: lda #pokey\ ;[17] Load the address of the keyword table
sta cminf1 ;[17] Save it for the keyword routine
lda #pokey^ ;[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 portadd ;[17] Stuff the returned value
lda #cmcfm ;[17] Set up for a confirm
jsr comnd ;[17] Do it
jmp kermt3 ;[17] Not confirmed
jsr changport ;[17] Really set the port
jmp kermit ;[17]
stworkdisk: ldx #$0A ;[DD] Base should be Dec
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
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
pha
jsr chkdriv
bne nodrive
pla
sta workdri
jmp kermit ;[DD]
nodrive:
pla
ldx #ermesf\
ldy #ermesf^
jsr prstr
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
jsr prcfm
jsr shport ; Show port address
jmp kermit
jsr prcfm
jsr shworkdr ; show working drive
jmp kermit
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 shport ; Show current SL port
jsr shworkdr ; Show working drive
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]
mm6: lda $de03 ;[DD] control register
jsr prbyte ;[DD]
mm7: lda $de02 ;[DD] command register
jsr prbyte ;[DD]
jsr prcrlf ;[DD] and a crlf
rts ;[DD]
shport: ldx #shin24\ ; Print SwiftLink Port
ldy #shin24^
jsr prstr
ldx portadd
lda portlist,x
jsr prbyte
ldx #shin25\
ldy #shin25^
jsr prstr
jsr prcrlf
rts
shworkdr: ldx #shin23\ ; print working-drive
ldy #shin23^
jsr prstr
ldx workdri
lda #$00
jsr prntad
jsr prcrlf
rts
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:
;
; <SOH><char(pdlen)><char(pnum)><ptype><data><char(chksum)><eol>
;
; Input: kerbf1- Pointer to packet buffer
; pdlen- Length of data
; pnum- Packet number
; ptype- Packet type
;
; Output: A- True or False return code
;
spak: 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
ldx #true
jsr timset
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 <reflect the fact we are in rpak>
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 <we are in rpkfls>
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 <we received a packet>
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: txa
pha
tya
pha
lda #$00
pha
cpx #true ; If X is true we are doing recieve timeout
bne timsst ; Else we are doing send timeout
lda rtime
jmp timfig
timsst:
lda stime
timfig:
clc ; Multiple timeout by 60
pha ; Multiple routine you push two values to multiply
lda #$00
pha
lda #$3c ; The stack will hold high-byte/low-byte after
; Multiply is over
pha
jsr ml16
clc ; Add the computed number of jiffies (seconds
; times 60) to the current clock to compute
; When the timeout is up
sei ; Don't bother us we are BUSY
pla ; Low byte of time out
clc
adc clock+2
sta ttime+2
lda clock+1
adc #$00
sta ttime+1
lda clock
adc #$00
sta ttime
clc
pla ; get high byte
clc
adc ttime+1
sta ttime+1
lda ttime
adc #$00
sta ttime
cli
pla
tay
pla
tax
rts
;
; 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: sei ; Cause commodore does it.
lda clock ; Get the high jiffy
cmp ttime ; Compare it to the new high jiffy
bmi timskp ; Still less
lda clock+1 ; Get the middle jiffy
cmp ttime+1 ; Compare it to the new middle jiffy
bmi timskp ; Still less
lda clock+2 ; Get the low jiffy
cmp ttime+2 ; Compate it to the new low jiffy
bmi timskp ; Still less
timret: cli
rts ; We have timed out, return
timskp: cli
jmp rskp ; 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 workdri
ldy #15
jsr setlfs
ldx #fcmd\
ldy #fcmd^
lda #2
jsr setnam
jsr open
jsr readst
and #$80
beq opnok
jmp opfail
opnok
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 workdri
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 workdri
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 #$fc
sta $d030
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]
; use current working drive
ldx workdri
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 workdri
ldy #15
jsr setlfs
ldx #buff+3\
ldy #buff+3^
lda len
jsr setnam
jsr open
bcs dosprmok
jsr rddsk ;[DD] Get disk status
dosprmok:
lda #15 ; in any case, close #15
jsr close
jmp kermit ;[40] Go back for more commands
; Chkdriv
;
; Checks to see if a drive exits by opening up the error channel on it
; and the closing the file. Readst then returns the error status
;
; ARG: A (drive number to check)
; Returns: A zero == drive OK
; A not zero == Drive not there
chkdriv: pha
lda #$0f
jsr close
pla
tax
lda #$0f ; [53]
ldy #$0f
jsr setlfs
ldx #buff+3\
ldy #buff+3^
lda #$00
jsr setnam
jsr open
bcs dosprmok
lda #$0f
jsr close
jsr readst
and #$80
rts
;
; 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 <lf>
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 <cr> problem
cmp #cr ; Do we have a <cr> here?
bne bffctl ; Nope, continue processing
ldx #on ; Set flag to add a <lf> 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 <cr>?
bne bfeclf ; No, then check for <lf>
lda #on ; Yes, set the 'Delete <lf>' flag
sta dellf ; ...
jmp bfefpc ; And then continue
bfeclf: cmp #lf ; Do we have a <lf>?
bne bfenlf ; Nope, We must go shut the Dellf flag.
lda dellf ; We have a <lf>, is the flag on?
cmp #on ; ...
bne bfefpc ; If not, continue normally
lda #off ; Flag is on, <lf> follows <cr>, 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 <cr> ?
beq rdds2 ;[DD] Yes, we are done
sta dskers,y ;[DD] Store it
iny ;[DD] Increment the index
cpy #50
bne rdds1
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 'SLKERMIT.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 #$0f ;[47]
sta inifil,y ;[47]
iny ;[47]
sty len ;[47]
; openm #8,#8,#8,inifil,len ;[47]
lda #8 ; [53]
ldx workdri
ldy #8
jsr setlfs
ldx #inifil\
ldy #inifil^
lda len
jsr setnam
jsr open
jsr readst
and #$80
bne saverr
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 #portadd+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 restin ;[47] Go restore the parameters
jmp kermit ;[47] Failed, restart kermit
restin: jsr scrext
lda #fncrea ;[47] Get switch for read
ldy #$0f ;[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
; Now we want to load the INI file from the device that loaded the exe
ldx workdri
ldy #8
jsr setlfs
ldx #inifil\
ldy #inifil^
lda len
jsr setnam
jsr open
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
pha
jsr readst ;[47]
and #$02
bne rstlop2 ;[47] No, failed - don't restore parameters
pla
ldy savey ;[47] Restore the index
sta escp,y ;[47] Store the character away
iny ;[47] Increment the index
cpy #portadd+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
jmp rstlop1
rstlop2: pla
rstlop1:
lda #8 ;[47] Close the init file
jsr close ;[47] ...
jsr scrent ; initilize the new screen package
jsr dobad
jsr changport
rts ; all done
inifil: .byte "SLKERMIT.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
bne 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 '^<chr>' 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 ; <commodore-128 keys start here>
.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: jsr sftini
rts
;
; 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 getrs3 ; Yes,
jsr sftrd ; read data
sta char ; save character
jsr rserrs ;
cmp #$00 ; set Z flag based on if we got data or not
rts
getrs3 lda #$00
rts
;
; Rserrs - Check for RS232 errors
;
; Input: Status in STAT
;
; Output:
;
; Registers Destroyed: A
rserrs: pha
lda stat ; get status
beq erret ; no error
jsr beeplo
lda #$00
sta stat
erret pla
rts
;
; 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 rdhead ;[24] Compute number of chars
sec ;[24] in RS-232 buffer
sbc rdtail ;[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 #70 ;[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
cmp #$00
bne flshin ;[33] No, get more
rts ;[25] Yes, finish
;
; Putrs - Send byte to RS232
;
; Input:
;
; Output:
;
; Registers Destroyed:
;
putrs: stx sftklu
jsr sfttr
ldx sftklu
rts
;
; Sbreak - Send a break signal
;
sbreak: lda $de02 ; get command register
pha
ora #%00001110 ; set "transmit BRK" condition
mm8: sta $de02 ; put back command register
ldy #$00
jsr sbdl2 ; 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
pla
mm9: sta $de02
rts
sbdl2: ldx #40 ; loop 40 times for slow mode
lda fast
lsr a
bcc sbdl3
ldx #80 ; loop 80 times for fast mode
sbdl3: rts
;
; 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
; sftini Setup SwiftLink Interupts and buffers
sftini
sei ; Turn off interupts
lda #sftint\ ; Set NMI vector to sftint
ldy #sftint^
sta nmiv
sty nmiv+1
lda #$00 ; Clear buffers
sta trtail
sta trhead
sta rdtail
sta rdhead
mma: sta $de01 ; Reset SL-232
lda #%00001001 ; enable Recieve Interupts and transmitter
mmb: sta $de02
lda #%00011000 ; enable baud rate generator (2400 baud)
mmc: sta $de03
cli
rts
; sftrd Read data from SL-232 buffer
;
sftrd sei
ldx rdtail
cpx rdhead ; Is there a char to read
beq sftrd1 ; no
lda rdbuf,x ; Get it into A
inc rdtail ; advance buffer
cli
rts
sftrd1 lda #$00 ; No char, A = 0
cli
rts
; Just send the byte
sfttr sei
pha
sfttr1 lda $de01
bit c07
beq sfttr2
pha
txa
pha
mmd: lda $de00
ldx rdhead
inx
cpx rdtail
beq sfttr7
dex
sta rdbuf,x
inc rdhead
jmp sfttr3
sfttr7:
lda #01
sta stat
sfttr3:
pla
tax
pla
sfttr2:
bit c10
beq sfttr1
pla
mme: sta $de00
cli
rts
; sftinit SL-232 Intrupt handler
;
sftint sei
pha
mmh: lda $de01
bit c0f
beq sftint3
sta tmpsl232
txa
pha
mmf: lda $de02
and #%11110000
ora #%00000011
mmg: sta $de02
lda tmpsl232
bit c07
beq sftint4
ldx #$01
stx stat
sftint4 bit c08
beq sftint9 ; Not a receive interrupt. Exit
mmi: lda $de00 ; Get received data
ldx rdhead
inx
cpx rdtail
beq sftint7 ; Receive buffer overrun
dex
sta rdbuf,x ; Store received data
inc rdhead
jmp sftint8
sftint7 lda #$01
sta stat ; receive buffer overrun; set stat nonzero
sftint8:
pla
tax
mmj: lda $de02
and #%11110000
ora #%00001001
mmk: sta $de02
pla ; Retrieve A register
rti
sftint9:
pla
tax
mml: lda $de02
and #%11110000
ora #%00001001
mmm: sta $de02
sftint3: pla ; Retrieve A register
jmp (orignmiv)
tmpsl232: .byte 00
; Change port. Set the port for use with the Swift Link Cart
; Loads the port High Address from portadd and stores modifies
; the code to use the new address
;
changport: sei
ldx portadd
lda portlist,x
sta chprest+2
chprest: sta $de01 ; This gets modified reset the port (xx01)
; Ok now we need to modify all the bloody code
sta mm1+2
sta mm2+2
sta dopari+2
sta mm3+2
sta mm4+2
sta mm5+2
sta dowrd+2
sta dowrd1+2
sta mm6+2
sta mm7+2
sta sbreak+2
sta mm8+2
sta mm9+2
sta mma+2
sta mmb+2
sta mmc+2
sta sfttr1+2
sta mmd+2
sta mme+2
sta mmf+2
sta mmg+2
sta mmh+2
sta mmi+2
sta mmj+2
sta mmk+2
sta mml+2
sta mmm+2
sta chprest+2
cli
jsr sftini
jsr dobad
jsr dopari
jsr dowrd
rts
rts
;
;
; 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 <cr> as a default
jmp rpar3 ; ...
rpar2: lda #cr ; Get value of <cr>
sta seol ; That will be the eol character
jmp rpar4 ; Continue
rpar3: sec ; ...
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 (76)"
.byte cr
.byte "for SwiftLink-232 interface ONLY"
.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 $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 $04
.byte "quit"
.byte 0 ; [53]
.byte $0C,$0C
.byte $07
.byte "receive"
.byte 0 ; [53]
.byte $0F,$0F
.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 $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 $18 ;[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 $0c
.byte "port-address"
.byte 0
.byte $42, $42
.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
.byte $0d
.byte "working-drive"
.byte 0
.byte $45, $45
shocmd: .byte $13 ;[DD][17]
.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 $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 $0c
.byte "port-address"
.byte 0
.byte $99, $99
.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]
.byte $0d
.byte "working-drive"
.byte 0
.byte $a2, $a2
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 $05 ; LENGTH OF THIS TABLE IS 5
.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
.byte $04
.byte "4800"
.byte 0 ;
.byte $03,$03
.byte $04
.byte "9600"
.byte 0 ;
.byte $04,$04
pokey: .byte $03 ; LENGTH OF THIS TABLE IS 3
.byte $05
.byte "$d700"
.byte 0 ; [53]
.byte $00,$00
.byte $05
.byte "$de00"
.byte 0
.byte $01,$01
.byte $05
.byte "$df00"
.byte 0
.byte $02,$02
portlist: .byte $d7,$de,$df
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]
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 %00000000 ;[17] None
.byte %11100000 ;[17] Space
.byte %10100000 ;[17] Mark
.byte %00100000 ;[17] Odd
.byte %01100000 ;[17] Even
kerbds: .byte "300 "
.byte 0
.byte "1200"
.byte 0
.byte "2400"
.byte 0
.byte "4800"
.byte 0
.byte "9600"
.byte 0
bdval: .byte $05,$07,$08,$0A,$0C ; swiftlink values for
; 300, 1200, 2400, 4800, 9600 baud
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 "Working-drive is "
.byte 0 ; [53]
shin24: .byte "Port-address is $"
.byte 0
shin25: .byte "00"
.byte 0
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-<vicbank/$4000> ; ""
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 ; <space> - ?
.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
c10 .byte $10
c08 .byte $08
.byte $04
.byte $02
.byte $01
c07 .byte $07
c0f .byte $0F
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)
sftklu: .byte $ff
trtail .byte $ff
trhead .byte $ff
rdtail .byte $ff
rdhead .byte $ff
.SBTTL Scratch area
freesiz = $20
freemem:.blkb freesiz
tabs: .blkb 81 ; tab stops
.blkb $100 ; safe and documented area for binary patches.
cmbuf: .blkb $100 ; Input command buffer
atmbuf: .blkb $100 ; Atombuffer, (for cmtxt and cmifil)
plnbuf: .blkb $100 ;[DD] Port line buffer
font40 = $9000
; Memory map of high kermit memory ver 2.2 (76)
;
; Kermit code $0800-$7FE0
; Data Tables $7FE1-$84A4
; Free Space $84A5-$86FF
; RS-232 input Buffer $8700-$87FF
; Second Color Map $8800-$8BFF
; Primary Color Map $8C00-$8FFF
; Font40 Definition $9000-$93F7
; Free Space $93F8-$97FF
; BI-80 Text Buff?? $9800-$9FCF
; Free Space (???) $9FD0-$9FFF
; High Res Screen $A000-$BFFF
; Reserved for MONITOR $C000-$CFFF
; IO Space $D000-$DFFF
; Kernal $E000-$FFFF