home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
appleii
/
appmai.m65
< prev
next >
Wrap
Text File
|
2018-01-01
|
609KB
|
17,699 lines
.SBTTL 6502 version - Antonino N. J. Mione/PT/MP/TH
; Version 3.0
; Based on the KERMIT Protocol.
; $Header: appmai.m65,v 1.17 89/11/06 10:40:26 medin Locked $
.SBTTL Define start address for assembly
.=$1000 ;[58][39] Start assembly at hex 1000
.nlst ;[84]
.SBTTL Revision History
;
; Edit # Description
; ------ -----------
;
;
; 1 By: Antonino N.J. Mione On: 26-APR-1983
; Fix I/O hooks so that Kermit-65 may be BRUN
; instead of requiring that it be BLOADED and then
; executed.
;
;
; 2 By: Antonino N.J. Mione On: 26-APR-1983
; Make quoting work for characters with parity bit on.
;
;
; 3 By: Antonino N.J. Mione On: 04-MAY-1983
; Make Kermit write last buffer on receive. Do this
; by making sure AC is zero on entry to 'Closef' so
; 'Closef' knows that there were no errors. Also,
; put address of buffer into the right place in the
; file manager parameter list.
;
;
; 4 By: Antonino N.J. Mione On: 17-MAY-1983
; Reduce max packet length by one so we don't get
; a <Del> character when we quote it.
; Make escape sequence read '^'<esc-char>'C'.
; Make VT52-EMULATION be ON by default.
;
;
; 5 By: Antonino N.J. Mione On: 27-JUN-1983
; Make the default time-out interval default to a
; reasonable amount of time instead of 0. The default
; is now 15 seconds for both send and receive.
;
;
; 6 By: Antonino N.J. Mione On: 28-JUN-1983
; Make Kermit locate the actual end-of-file instead
; of sending blindly to the end of the last sector
; of the file.
;
;
; 7 By: Antonino N.J. Mione On: 28-JUN-1983
; Don't send trailing spaces in the file header
; packets.
;
;
; 8 By: Antonino N.J. Mione On: 28-JUN-1983
; Convert <cr> to <cr><lf> line terminator on the way
; out and <cr><lf> to <cr> on the way in for text
; files.
;
;
; 9 By: Antonino N.J. Mione On: 29-JUN-1983
; Account for carry in jump table calculations for
; those cases where the table starts on a page
; boundary.
;
;
; 10 By: Antonino N.J. Mione On: 21-JUL-1983
; Fix edit [7] so that it works all the time. The
; operand in the compare should be immediate since
; a space is what we are looking for.
;
;
; 11 By: Antonino N.J. Mione On: 25-JUL-1983
; Fix how we set eight-bit quoting from the init
; packet. Also, make sure we don't quote the 8-bit
; quote character unless 8-bit quoting is turned on.
;
; VERSION 1.1 Starts here
;
; 12 By: Antonino N.J. Mione On: 22-SEP-1983
; Add 'SET SLOT' and 'SHOW SLOT' commands to make
; the I/O port settable by the user. Add
; 'SET DEVICE-DRIVER' and 'SHOW DEVICE-DRIVER'
; commands to make the I/O device user-selectable.
; Also, make some of the option initialization
; static as opposed to wasting instructions on it.
;
;
; 13 By: Antonino N.J. Mione On: 05-OCT-1983
; Alter the calling sequence for some references
; to Comnd. This is due to a standardization of the
; parameter calling and returning conventions.
;
;
; 14 By: Antonino N.J. Mione On: 11-OCT-1983
; Add code for Kermit-65 to talk to a Server-mode
; Kermit. Includes the new commands 'BYE', 'FINISH',
; and 'GET'.
;
;
; 15 By: Antonino N.J. Mione On: 26-OCT-1983
; For cases where 8-bit quote is 'Y' or 'N' make
; sure that Rpar places the value in Sebq AND sets
; 8-bit quoting off.
;
;
; 16 By: Antonino N.J. Mione On: 26-OCT-1983
; Change display during transfers to show a total
; packet count as oppossed to the packet number being
; sent in the packet itself.
;
;
; 17 By: Antonino N.J. Mione On: 31-OCT-1983
; Make Kermit suppress printing <lf>s while CONNECTed
; to a host which sends <cr><lf> as a line terminator.
;
;
; 18 By: Antonino N.J. Mione On: 31-OCT-1983
; Move call to Closef before code to send ACK in Rdat
; after the Eof-packet has been received. This will
; fix the problem with Kermit-65 hanging just before
; the break packet.
;
;
; 19 By: Antonino N.J. Mione On: 31-OCT-1983
; Fix Closef right by making it insert the filename
; into the buffer in negative ascii. Previously, DOS
; was running out of buffers on long sessions because
; the files being transferred were not being closed
; and thus the buffers were not being released.
;
;
; 20 By: Antonino N.J. Mione On: 01-NOV-1983
; Make sure Pdlen does not get clobbered. Make Pdbuf
; long enough for a full packet. It was 2 characters
; too short.
;
;
; 21 By: Antonino N.J. Mione On: 02-NOV-1983
; Add IBM-mode support.
;
;
; 22 By: Mark Paczkowski On: 03-NOV-1983
; Put in support for super serial card.
;
;
; 23 By: Antonino N.J. Mione On: 03-NOV-1983
; Put checks into the command parser to ensure that
; the command buffer does not overflow.
;
;
; 24 By: Antonino N.J. Mione On: 03-NOV-1983
; Fix local-echo so that the H.O. bit is one when
; printing the character locally.
;
;
; 25 By: Antonino N.J. Mione On: 15-NOV-1983
; Change the way Kermit sends packets. Build up the
; entire packet first, then send it all at once.
;
;
; 26 By: Antonino N.J. Mione On: 15-NOV-1983
; Implement Terse-mode debugging.
;
;
; 27 By: Antonino N.J. Mione On: 18-NOV-1983
; Make 'gobble' smarter so it sees start-of-header
; as well as end-of-line. This aids us in talking
; to crufty IBM machines.
;
;
; 28 By: Antonino N.J. Mione On: 28-NOV-1983
; Make sure the primary filename buffer is space
; filled after the filename.
;
;
; 29 By: Antonino N.J. Mione On: 28-NOV-1983
; Make sure fcb is cleared so that filename does not
; get currupted.
;
;
; 30 By: Antonino N.J. Mione On: 28-NOV-1983
; Make this look like Version 2.0. Fix the Version
; message.
;
; VERSION 2.0 Starts here
;
; 31 By: Peter Trei On: 10-Feb-1984
; Added support for visible cursor. See CURON and
; CUROFF routines.
; oc.trei%cu20b@columbia-20
;
;
; 32 By: Peter Trei On: 12-Feb-1984
; Fixed bug in SSC support software ; altered RRF
; flag mask from $#04 to $#08.
; oc.trei%cu20b@columbia-20
;
;
; 33 By: Peter Trei On: 21-FEB-1984
; Corrected definitions of BASL and BASH.
; oc.trei%cu20b@columbia-20
;
;
; 34 By: Peter Trei On: 23-FEB-1984
; Adjustments to make uppercase and weird chars appear
; inverse.
;
;
; 35 By Peter Trei On: 17-MAR-84
; Installed CHRCON routine to allow the 2/2+
; keyboard to enter lowercase, rubout, and other
; 'missing' characters. This also involved adding the
; 'SET KEYBOARD' switch, with positions for 2P and 2E.
;
;
; 36 By: Antonino N.J. Mione On: 22-JUN-1984
; Make the FILE-BYTE-SIZE default sensible (i.e.
; Seven-bit since we are defaulting the FILE-TYPE-MODE
; to TEXT).
;
;
; 37 By: Antonino N.J. Mione On: 25-JUN-1984
; Fix 'Get' so that the first time it is used,
; it will work.
;
;
; 38 By: Antonino N.J. Mione On: 25-JUN-1984
; Handle error packet processing correctly.
;
;
; 39 By: Tim Heuser On: 26-JUN-1984
; Start assembly at $801 so we don't break Applesoft.
;
;
; 40 By: Antonino N.J. Mione On: 29-JUN-1984
; Add capability to set drive for file transfers.
; Added the 'SET DEFAULT-DISK' and 'SHOW DEFAULT-DISK'
; commands.
;
;
; 41 By: Antonino N.J. Mione On: 29-JUN-1984
; Add capabilities to code which processes Escaping
; from CONNECT mode. Give user ability to send a
; BREAK signal, a nul character, or the Escape
; character itself. Also, add these to the online
; help message.
;
;
; 42 By: Antonino N.J. Mione On: 02-JUL-1984
; Fix the 'GET' command. When receiving files, have
; KERMIT-65 use the filenames from the File-header
; packets.
;
;
; 43 By: Antonino N.J. Mione On: 11-JUL-1984
; Clear the FCB when fetching a filename from the
; packet buffer. Previously when receiving files,
; if subsequent filenames where shorter than filenames
; in the beginning of the session, the name of the
; file created on disk would be incorrect.
;
;
; 44 By: Antonino N.J. Mione On: 12-JUL-1984
; Fix 'No buffers available' problem when doing
; >3 SENDs in one session. Make the SDAT routine
; reset the eofinp flag and close the file when
; the BUFILL routine returns an end-of-file.
;
;
; 45 By: Antonino N.J. Mione On: 12-JUL-1984
; Make version read '2.1'.
;
; VERSION 2.1 Established here
;
; 46 By: Peter Trei On: 30-JUL-1984
; The new Apple 2c does not have inverse capitals ; these codes
; are used for a bunch of graphics characters. Thus, the method
; of showing true caps as inverse and lowercase as normal caps
; will not work. This mod involves a switch to indicate whether
; the users apple can show lowercase (2e/2c) or caps only (2/2+).
; If the user CAN show these, DSPCHR (edit 34) just prints
; characters 'as is' without any reformatting.
;
; VERSION 2.1A Established here
;
; 47 By: Ted Medin On: 22-JUN-1985
; Initialize the Super Serial card from within the program.
; Most of the code was translated from the cp4 code in cp/m
; apple.
;
; 48 By: Ted Medin On: 29-JUN-1985
; Initialize the Hayes micro modem card from within the program.
; Most of the code was translated from the cp4 code in cp/m
; apple.
;
; 49 By: Ted Medin On: 19-JUL-1985
; Support a 80 col card display. Display was debuged on a Franklin
; but should work on a 2e 80 col or equivalent. The Franklin is
; an apple ][+ done right. The special codes required for the
; the display follows:
; $0c-form feed - clear screen and position top left
; $1d-gs - clear line from cursor to end of line
; $0b-vt - clear screen from cursor
; $0a-line feed - move cursor down one line
; $1f-us - move cursor up one line
; $1c-nak - move cursor right one
; $1e,ch,cv - 3 chs in a row,position cursor to ch,cv
; - ch & cv each have a bias of 32
;
; 50 By: Ted Medin On: 25-JUL-1985
; Error in code checking for cr,lf. The a reg was destroyed
; so code was rewritten and shortened. Code now depends on "on"
; being non zero and "off" being zero.
;
;
; 51 By: Ted Medin On: '85 Oct 29
; Use interupts to drive the Super Serial card, sw2-6 must be on.
; That is the switch that allows the interupts to occur. The code
; uses two buffers of 256 bytes each for the input and output
; characters. No checking is done for overuns on these buffers
; in the interest of speed. We have had the ][+ with a Videx
; 80 col card runing at 9600 baud with out fail.
;
;
; 52 By: Sam Lam On: '85 Nov
; Correct 8 bit quoting problem in rpar
;
; 53 By: Ted Medin On: '85 Dec 24
; Correct bad checksum response to rpar on received packet
;
;
; Version 3.0
;
; 54 By: Ted Medin On: '86 Jan 7
; Rearrange and remove all com card code. This will allow
; the com card code to be separately assembled. Communications
; with the main Kermit routine will be thru a vector of data
; and jumps to routines in the main routine and the com routine.
;
; 55 By: Ted Medin On: '86 Jan 14
; Add printer control. Take into account the display may be
; a 80 col card.
;
; 56 By: Ted Medin On: '86 Jan15
; Add logging of connected session. File closed when control
; is returned to kermit.
;
; 57 By: Ted Medin On: '86 Jan 17
; Add flow control via xon/xoff with remote. This is about the
; only way printer and loging can work.
;
; 58 By: Ted Medin On: '86 Jan 24
; Correct problems with vt52 emulation. Vtab & vtabz were not
; being handled. The problem with reverse scrolling and a 80
; col card is not handled correctly at this time.
;
; 59 By: Ted Medin On: '86 Mar 7
; Allow kermit to run with prodos or dos 3.3. Add the two commands
; "set prefix" and "show prefix" for the prodos environment.
; Allow flow control from/to remote.
;
; 60 By: Ted Medin On: '86 May 30
; Allow vol specification for the default disk. Fix bug in file
; warning checking wrong diskette. Allow file xfer from a diskette
; when file protect tab is on.
;
; 61 By: Ted Medin On: '86 June 19
; Fix several problems with the //e 80 col display. Apparently
; there is a lot i dont know about those banks so let basic
; initialize the display and then use the pascal entries.
;
; 62 By: Ted Medin On: '86 july 29
; Allow server mode. Initially only get and put but more later.
; Fix vt52 mode with 40 col display(drop cntr ch printing)
;
; 63 By: Ted Medin On: '86 Aug 4
; Put in code for terminal program. Special string from remote
; site puts kermit 65 into server mode.
;
; 64 By: Ted Medin On: '86 Aug 6
; Put in code for fuzzy timer. This code does a timeout on
; file transfer when no communications is received from the
; remote. Also allow seting timer on/off.
;
; 65 By: Ted Medin On: '86 Aug 21
; Remove file-byte-size since it is redundant. The type of file
; determines the file byte size. Text is 7 with high bit on all
; other types are 8 bits.Also fix bug in file xfer when the
; parity bit is on.
;
; 66 By: Ted Medin On: '86 Aug 24
; Begin to show more info while file xfering. Start by
; displaying the local file name being xfered.
;
; 67 By: Ted Medin On: '86 Sep 1
; Fix bug in file xfer when failure to complete xfer
; leaves local file open. Fix loop in fin command when
; local and remote get into a nak loop. Fix problem with
; received error packets.
;
; 68 By: Ted Medin On: '86 Sep 29
; Remove ibmmod since all ibm controllers do not use mark
; parity. Thanks to Mark Johnson %irishmvs
;
; 69 By: Ted Medin On: '86 Oct 10
; Put delay at end of file transfer so operator can read
; any messages. Correct problem in file transfer when bad
; packet happens to be going from $37 to 0. Check was
; not handling the modulo $37 correctly.
;
; 70 By: Ted Medin On: '86 Oct 27
; Correct problem with interupts using $45 and the pasal 80 col
; routines using $44 & $45. Also slight speed up of prchr rtn.
;
; 71 By: Ted Medin On: '86 Oct 28
; Change pascal screen & keyboard routines so they are not so
; rom dependent.
;
; 72 By: Ted Medin On: '86 Nov 3
; Change eight bit quoting to follow the file type. If file type
; is not text then eight bit quoting will be used providing the
; other kermit agrees.
; Correct bug in logo used by bye and fin. Initialize the com
; card and the send/rec routines
; Fix bug in binary file xfer. The other kermit needs to
; know what our 8 bit prefix character is.
; Allow verbose debug output in all xmission states.
; Correct bug in send-sometimes file is truncated
; Remove set & show 8 bit quoting flag
; 73 By: Ted Medin On: '86 Nov 26
; Install function keys. Allow vt52 keypad starting with keys
; 678&9 when open/close apple (joystick buttons) are also pressed,
; use h19 function keys for keys 1-5 and help function on key 0.
; Ignore vt52 mode when using printer instead of screen
; Allow swap of the del and bs keys from the keyboard.
; If terminal pgm then start directly with the com command.
; 74 By: Ted Medin On: '87 Jan 23
; Minor change to clear to end of line, scr13 & clear to end
; of page to check for flow control
; Some pgms send lf & cr rather than cr & lf so we now check
; for both orders.
; Minor change to dspchr to speed things up a bit.
; Change telnet to drop nulls. You wouldnt believe and i couldnt
; find the problems this caused on a //e. Problem didnt exist
; on a //e+ so PTL dropping nulls solved it and i dont know why.
; 75 By: Ted Medin On: '87 Jan 28
; Add extended length packets
; Fix problems caused by packet lengths > 128. Had to us bcs &
; bcc instead of bpl & bmi. Fix problem in flow control if com
; initialization was not done.
; Fix problems with 8 bit data path.
; Fix nak loop in get file & purge com buffers when starting up
; any filexfer functions.
; 76 By: Ted Medin On: '87 Mar 17
; Allow toggle of swap del & bs key via the escape
; Terminal type vt100
; Change display of control chs to inverse
; Flow control only when connected, not file xfer etc
; 77 By: Ted Medin On: '87 May 15
; Fix bug in set disp 80 col to properly init the card
; Remove the lf cr look and only remove the cr lf sequence
; Allow the operator to look at some of the defaults in terminal
; 78 By: Ted Medin On: '87 May 24
; Add the catalog command
; Add the modem command which reads file kermit.modem database
; Initialize kermit by reading file kermit.init for commands
; Replace help with alan kalkers version
; Use basic.system to get prefix. Thanks Rick Fincher
; Add the delete file command
; Remove the delay while printing locally
; Correct bug in open for eof, eodind now cleared on open
; Replace wait routine with rom wait 220=125ms
; Force the aux in prodos to be $801 for applesoft
; Add wraparound on/off for vt100 & vt52 mode
; Get the defaults correctly for prefix or drive if the user
; doesnt specify a default. One should now startup with the
; path the binary begain executing at unless the user specifies
; the path or drive.
; Lots of fixes tto vt52 & vt100 emulation.
; Add other to file-type so user can set any type he wants.
; 79 By: Ted Medin On: '87 Aug 31
; Fix vt100 prob with //c & //gs (they reset the regions).
; Thanks to Grant Delaney for his help on the above.
; Fix filename in file xfer to be the current file
; 80 By: ted medin on: '87 sep 29
; Fix vt100 mode so screen mode works and bold blink &
; underscore use revers video.
; Add keypad for gs & new e, change modem delay to &
; Add save and restore irq & correct dos vectors save & restore
; Add print screen - argggggggg
; Improve initial prefix get - thanks Sean Noland
; Allow cursor keys to be vt100 cursor keys
; Improve vt52 <--> vt100 and keypad
; 81 by: ted medin on: '88 jan 11
; add wildcard send - thanks dick atlee
; add end of com routine to main vectors
; fix upper/lower case problems in comnd
; clear com buffers when we initialize com driver
; allow server mode to do any command via local
; add keypad application set
; server mode remote command
; server mode process x packets
; fix keypad bug
; fix vt100 cursor keys bug
; redo help
; 82 by ted medin on: '88 apr 8
; allow prodos text to use 8 bit width
; fix vt100 bugs
; fix flow control bugs and less of it
; shorten up jmp tables
; change wait loops for non interupt drivers
; allow start of packet to be varied
; help for crimmins mouse support
; 83 by ted medin on: '88 may 16
; more fixes for vt100, add xmodem protocol,
; speed up rskp, add take command, add restore screen,
; show version with show all, fixes for debug display
; 84 by ted medin on: '88 may
; fix dos to use file manager-thanks to bob holley
; more vt100 fixes & drop the display of unknown esc seq
; exit now uses prodos quit
; fix u/l case problem in syntax scanner
; file xfer now shows bytes xfered
; cr<-->cr,lf option added to file xfer
; long packets only used when size dictates
; fix remote command initialization loop
; 85 by ted medin on: '88 dec
; speed up where possible
; time constant added
; help now from kermit.help
; modem command now has escape ch \
; type command
; wildcard xfers now use the hardware stack
; 86 by ted medin on: '89 jan
;+ Dont forget to update version and help version !!!!!!!!!!!!!!!!!
;$Log: appmai.m65,v $
;Revision 1.17 89/11/06 10:40:26 medin
; These are the changes in 3.86
;1. Prodos quit is fixed
;2. vt100 bug fixes (will it ever stop)
;3. //c+ now works - thanks Steve Kunz
;4. blinking cursor when connected
;5. connect escape menu now has modem and quit added
;6. file xfer downloads in prodos, illegal characters are now replaced with
; periods. it was Klaus Schnathmeier's (hamberg germany) idea, unfortulately
; i missunderstood so klaus didnt get what he wanted. His english is 1000%
; better than my german. so hope someone needs this. after looking at this
; you may think anybodys english is 1000% better than mine. :-(
;7. wildcard file xfer uploads sometimes missed one file - fixed (it says here)
;8. Nice new install by Les Ferch of university of british columbia
; if you like the new install send him a thank you <les_ferch@mtsg.ubc.ca>
;9. apple cat serial driver - thanks Dick Wotiz
;10.comands lock,unlock & rename added
;11.get & send commands now allow two filespecs so one can change the name
; of the file during file xfer. Maybe this is what Klaus wanted? :-)
;Revision 1.16 88/12/22 09:32:19 medin
;version 3.85 with these changes:
;1. time constant added so different speed cpus can give same wall clock time
;2. speed up wherever possible
;3. help is now read from kermit.help
;4. modem command now has escape character "\"
;5. type command added
;6. wildcard send now uses the hardware stack which may overflow
; if the wild cards are too wild????
;Revision 1.15 88/07/20 18:06:39 medin
; corresponds to 3.84
;dos 3.3 now uses file mgr - more robust
;vt100 fixes, drop display of unknown esc seq
;exit uses prodos quit
;fix u/l case pbms in scanner
;file xfer now shows bytes xfered
;cr<->cr,lf option
;long packets used when length dictates
;fix remote command init loop
;Revision 1.14 88/05/16 11:16:41 medin
; Add xmodem protocol, add take command, add restore screen,
;fixes for vt100, fixes for debug display, speed up rskp
;and show all now showes the version.
;Revision 1.13 88/04/08 20:50:28 medin
;This corresponds to 3.82 with the following:
;Prodos text 8 bit width
;fix vt100 bugs
;fix flow control problems and less of it
;help for crimmins mouse support
;wait loops for non interupt drivers
;allow variable start of packet character
;shorter up jmp tables
;Revision 1.12 88/02/24 16:59:48 medin
;version 3.81 changes:
;wildcard send, indicate end of kermit for buffer area
;fix upper/lower case problem in comnd, clear com buffers when initializing
;server mode command remote, keypad application set
;server mode process x packets, fix keypad bug
;fix vt100 cursor bug, redo help
;Revision 1.11 87/12/10 10:28:24 medin
;Corresponds to 3.80
;1. Fix vt100 screen mode
;2. Bold blink and underscore use reverse video
;3. Add keypad for gs & new e
;4. Change modem delay to &
;5. Correct save and restore irq vectors and dos vectors
;6. Add print screen when connected
;7. Fix initial prefix so it works better
;8. Allow cursor keys to be vt100 keys
;9. Improve vt52 keypad
;Revision 1.10 87/09/29 15:23:31 medin
; Fix //gs & //c problems in vt100 mode. The computers reset the
;scrolling region in their rom. Thanks to Grant Delaney for these
;fixes.
;This should correspond to 3.79.
;Revision 1.9 87/08/13 16:15:10 medin
;Add the catalog, modem, delete file commands.
;Initialize by reading file kermit.init.
;Replace the wait rtn with the rom wait.
;Add wraparound option to vt52 & vt100.
;Add other option to the file-type.
;Lots of fixes to vt52 & vt100.
;Revision 1.8 87/05/24 15:31:42 medin
; Bug fix in set 80 col, remove check for lf cr, bring kermit up to level
;3.77 so alans version and ours match.
;Revision 1.7 87/05/13 18:01:09 medin
; Kermit-65 version 3.76
;1.Vt100 terminal emulation
;2.Allow swap of del and bs via the interupt character
;3.Display control chs in inverse instead of ^whatever
;4.Flow control only when "connect" not in file xfer etc
;Revision 1.6 87/03/12 15:56:29 medin
;Changes for 3.75 1. Extended len packets with fixes for > 127 bytes.
;2. Flow control prblms because initialization not done.
;3. Fix 8 bit data path. Now one can xfer binary with parity none.
;4. Purge com buffers when file xfer starts up.
;Revision 1.5 87/01/28 08:10:02 medin
;Change telnet to drop null and linefeeds when they are preceeded or followed
;by carrage returns. Minor changes to the telnet loop to speed things up a
;bit.
;Revision 1.4 86/12/09 13:24:34 medin
;CHANGES for 3.72
;1. 8 bit quoting now followes file type.
;2. A bug in bye & fin. We forgot to initialize the com card.
;3. A bug in non text file xfer. 8 bit quoting incorrect
;4. Allow verbose debug in all states.
;5. Bug in end of file truncation.
;6. Remove set & show eight bit quoting.
;CHANGES for 3.73
;1. Add vt52 keypad emulation also add h19 f1-f5 & help keys.
;2. Fix terminal so it starts with the connect command.
;Revision 1.3 86/10/31 11:42:57 medin
; This is 3.71 the change was to the //e & c 80 col drivers. There was a
;bug in duplicate use of loc $45 by the drivers and the super serial driver.
;The 80 col driver was changed to use the pascal entries completely. No
;more reliance on loc $mode. If a cr was detected then a lf was added.
;Revision 1.2 86/10/28 12:40:49 medin
;3.70 fixed bug in pascal screen routines using $45 while the super serial
;routine also required $45 due to the interupts. Also make a slight change
;to the prchr routine to speed up returns.
.list ;[84]
.SBTTL Jump to start of code
kst: jmp kstart ; Go past the data to the beginning of the code
;
;
rskp = rskp.0 ;[78] Routine to skip 3 bytes on return
setbrk = sbrk.0 ;[78] Routine to set a break character in brkwrd
rstbrk = rbrk.0 ;[78] Routine to reset break character in brkwrd
comnd = comand ;[78]
;[87]mul16 = ml16 ;[78]
mul24 = ml24 ;[87][78]
;[87]div16 = dv16 ;[78]
div24 = dv24 ;[78]
prstr = prst.0 ;[78]
;
; Vector for com cards starts here
; location $1003 for data
; location $1020 for com routines
; location $1040 for main routines
;
sscdbd: .byte 6 ;[54] start with 300 baud(ala super serial)
; 6 - 300 baud
; 7 - 600
; etc
.byte ;
ddrnm: .word ermesa+1 ;[54] com card name-max 27 chs
kersli: .byte $20 ;[54] com slot $n0
kerins: .byte ;[54] force initialization flag-when 0
.word endker ;[54] address of end of main kermit
flowfg: .byte 0 ;[57] xon/xoff flow control flag b7=1 - yes
tl0end .word $c300 ;[81] end of com rtns-try c300
timect .byte 17 ;[85] 1ms delay thru rom rtn $fca8
escsv .word $c000 ;[87] end of screen save memory
fscsv .byte 0 ;[87] flag if screen saved
.=kst+$20 ;[54] future expansion
tlinit: ;[54] initialize com card
;[75] .byte 0,0,0 ;[54] room for jump
lda #0 ;[75] must be exactly 3 bytes
rts ;[75] this gives a false retrun
tl0cmd: ;[54] command for ACIA
.byte 0,0,0 ;[54] room for jump
;
;[54] command is in the A reg as follows:
;
;[54] 0 - hang up
;[54] $b - set baud
;[54] $c - set break on the line
;[57] $91 - xon the remote
;[57] $93 - xoff the remote
;
;[54] routine will return false(0) if unable
;
tl0cp: ;[54] check for input ch ready-0 false
.byte 0,0,0 ;[54] room for jump
tl0gpc: ;[54] get input ch
.byte 0,0,0 ;[54] room for jump
tl0ppc: ;[54] put output character
.byte 0,0,0 ;[54] room for jump
tl0exi: ;[54] reset card and restore initialized
.byte 0,0,0 ;[54] room for jump
.=kst+$40
vwait: jmp wait ;[54] wait routine-a reg used in rom wait rtn
vprstr: jmp prstr ;[54] print string
vrdkey: jmp rdkey ;[54] read keyboard
veol: jmp prcrlf ;[54] print cr and lf
vtelcn: jmp telcnc ;[54] check for keyboard character
vtelsp: jmp telspa ;[57] set parity correctly
;[86]prdqut .byte 0,0,0,0,0 ;[84] just need 5 0's for prodos quit
prdqut .byte 4,0,0,0,0,0,0 ;[86] just need 0's for prodos quit
;[78] .=kst+$60 ;[54] room for expansion
.SBTTL Feature test definitions
; Machines
ftappl = $01 ; Apple (under DOS 3.3)
.SBTTL Kermit feature test options
ftcom = ftappl ; Assemble for Apple ][ under DOS 3.3
.SBTTL Terminal feature for easy file transfers
termnl = 1 ;[63] 0 if you want terminal else non 0
.SBTTL Function keys feature ;[73]
funkey = 0 ;[73] 0 if you want function keys else non 0
.SBTTL Alans help feature ;[78]
akhelp = 0 ;[78] 0 if you want alan kalkers help version
.ifeq <ftcom-ftappl>
.SBTTL Apple monitor support
rdkey = $fd0c ; Routine - Read a char from curr input device
keyin = $fd1b ; Routine - Read a char from keyboard
crout = $fd8e ;[58] send cr to current out
prcrlf = crout ;[58] nice rom routine
cout = $fded ; Routine - Print char in AC
cout1 = $fdf0 ; Routine - Print char in AC to screen
setio1 = $fe89 ;[1] Routine - take I/O control away from DOS
setio2 = $fe93 ;[1] Routine - ...
prbl2 = $f94a ; Routine - Print (X) spaces
prbl3 = $f94c ; Routine - Print char in AC and (X)-1 spaces
prbyte = $fdda ; Routine - Print A-reg as 2 hex nibbles
prhex = $fde3 ;[78] print a reg low hex nibble
prntyx = $f940 ; Routine - Print hex of y,x regs
prntax = $f941 ; Routine - Print hex of a,x regs
dscrl3 = $fc95 ; [49] Routine - Clear entire current line
bell = $ff3a ; Routine - Sound bell
dhome = $fc58 ; [49] Routine - Home cursor and clr screen
dlfeed = $fc66 ; [49] Routine - Output a line-feed to screen
duplin = $fc1a ; [49] Routine - Go up one line if possible
dadvan = $fbf4 ; [49] Routine - Go forward (right) one character
dbsp = $fc10 ; [49] Routine - Go back (left) one character
dclrel = $fc9c ; [49] Routine - Clear from cursor to end of line
dclrep = $fc42 ; [49] Routine - Clear from cursor to end of page
clreoz = $fc9e ; Routine - Clear current line
dvtab = $fc22 ;[58] Routine - calculate base addr of line CV
vtabz = $fc24 ;[58] Routine - calculate base addr of line in AC
wait = $fca8 ;[78] wait rtn-a=220(125ms),a=25(2ms) us=.5(26+27a+5a*a)
;[81]dely = cout ;[78] go directly to cout
dos = $03d0 ; Dos entry point
kbd = $c000 ; Keyboard character input location
kbdstr = $c010 ; Keyboard strobe location
mode = $4fb ;[58] //e 80 col flag byte
;0....... - esc-r inactive ;[76]
;1....... - esc-r active ;[76]
;.0...... - basic print ;[76]
;.1...... - basic input ;[76]
;..0..... - language basic ;[76]
;..1..... - " pascal ;[76]
;...0.... - u/c restrice ;[76]
;...1.... - literal u/l case ;[76]
;....1... - goto in process ;[76]
;.....0.. - normal video ;[76]
;.....1.. - inverse ;[76]
;......0. - pascal 1.1 ;[76]
;......1. - 1.0 ;[76]
;.......0 - normal mode pascal ;[76] resets windows to std
;.......1 - xparent ;[76] trusts windows & no wrap arround
pvect = $c30d ;[59] pascal rtns vector init,read,write&stat
pinit = $c34b ;[58] //e pascal initialization point
pread = $c351 ;[58] " read
pwrite = $c357 ;[58] " output point
bsp: lda dsptyp ;[49] get display type
bpl bsp1 ;[49] is this 80 col?,no
jsr dchch ;[76]
lda #bs ;[49] do a real back space to the card
jmp cout ;[49] position cursor and return
bsp1: jmp dbsp ;[49] let 40 col do its thing
upline: ;[49]
lda dsptyp ;[49] get display type
bpl uplin1 ;[49] is this 80 col?,no
jsr dchcv ;[76]
lda #$1f ;[49] tell card to do an upline
jmp cout ;[49] position cursor and return
uplin1: ;[55][49] restore a
jmp duplin ;[49] let os go up one line
home: lda dsptyp ;[49] get display type
bpl home1 ;[49] is this 80 col?,no
lda #ffd ;[49] form feed should home
jmp cout ;[49] 80 col and return
home1: jmp dhome ;[49] just return
clreol: lda dsptyp ;[49] get display type
bpl clrel1 ;[49] is this 80 col?,no
jsr fflow ;[74] force flow check
lda #$1d ;[49] 80 col clear to end of line
jmp cout ;[49] give to 80 col card
clrel1: jmp dclrel ;[49] let os do it
scrl3: lda dsptyp ;[49] get display type
bpl scrl9 ;[49] is this 80 col?,no
jsr pos80c ;[49] pos cursor at start of line
;[76] let pos80c do the flow***** jsr fflow ;[74] force flow check
jsr fflow ;[82] force flow control
lda #$1d ;[49] erase to end of line
jmp cout ;[49]
scrl9: jmp dscrl3 ;[49] let os clear line
;[74]clreop lda #hlf ;[57] force the test
;[74] ldx #hcr ;[57] limit is cr-1 to lf
;[74] jsr ckflow ;[57] now for flow control
clreop ;[74]
lda dsptyp ;[49] get display type
bpl clreo1 ;[49] is this 80 col?,no
jsr fflow ;[74] force flow check
lda #$b ;[49] clear to end of page
jmp cout ;[49] hope all card handle this
clreo1: jmp dclrep ;[49] os thing
;[85]fflow lda #hlf ;[74] force the test
;[85] ldx #hcr+1 ;[74] limit is cr to lf
;[85] jmp ckflow ;[74] now for flow control & rtn to caller
;
; These are some monitor scratch areas that may be needed
;
a1l = $3c
a1h = $3d
a2l = $3e
a2h = $3f
a3l = $40
a3h = $41
a4l = $42
a4h = $43
a5l = $44
;[70] used by interupts a5h = $45
;***************************************************************
;
; PART 1: DATA DEFINITIONS -- zero page locations were used where
; speed or indirect addressing were
; deemed important. These locations
; avoid conflicts with DOS.
;
;***************************************************************
;
.SBTTL Symbol definitions
samef = $ff ;[81]WCHPAT settings: apply curr pat to curr fname
samep = 0 ;[81] curr pattern on remainder of name
dosrdk = $ae39 ;[81] dos 3.3 read key during catalog
remnp = 1 ;[81] remainder of pattern on remainder of name
.SBTTL Kermit zero-page usage
name = $5a ;[81]Current start of name being checked
pat = $5c ;[81]Current start of pattern being checked
stack = $60 ;[81]Current page-base of stack
stix = $62 ;[81]Stack index
;
.endc
.SBTTL Character and string definitions
nul = $00 ; <null>
soh = $01 ; <soh>
eot = 4 ;[83] end of transmission
ack = 6 ;[83] acknowledge
bel = 7 ;[82] ring those bells
bs = $08 ; <bs>
lftarw = $08 ;[35] <left-arrow>
tab = $09 ; <tab> (ctrl/I)
lf = $0a ; <lf>
ctrlk = $b ;[76] <vt>
ffd = $0c ; Form feed
cr = $0d ; <cr>
so = $e ;[76] shift out normal video
si = $f ;[73] shift in invers video
nak = $15 ;[83] negative acknowledge
ctrlu = $15 ; <ctrl/U>
rhtarw = $15 ;[35] <right-arrow>
ctrlx = $18 ;[0] <ctrl/X>
ctrlz = $1a ;[57] ^Z
esc = $1b ; <esc>
sp = $20 ; <space>
del = $7f ; <del>
hbs = $88 ; <bs> with H.O. bit on
hctrlh = hbs ;[1] <ctrl/H> with H.O. bit on
htab = $89 ; <tab> with H.O. bit on
hlf = $8a ; <lf> with H.O. bit on
hffd = $8c ; <ff> wiht H.O. bit on
hcr = $8d ; <cr> with H.O. bit on
hxon = $91 ;[57] ^Q with h.o. bit on
hxoff = $93 ;[57] ^S "
hctrlu = $95 ; <ctrl/U> with H.O. bit on
hctrlw = $97 ;[1] <ctrl/W> with H.O. bit on
hctrlx = $98 ;[0] <ctrl/X> with H.O. bit on
hesc = $9b ; <esc> with H.O. bit on
hspace = $a0 ; <sp> with H.O. bit on
hdquot = $a2 ;[1] '"' with H.O. bit on
hapos = $a7 ;[1] Apostrophy with H.O. bit on
hslash = $af ;[1] '/' with H.O. bit on
hcolon = $ba ;[1] ':' with H.O. bit on
hrabr = $be ;[1] '>' with H.O. bit on
hquest = $bf ; '?' with H.O. bit on
hquote = $e0 ;[1] "'" with H.O. bit on
hdel = $ff ; <del> with H.O. bit on
.ifeq <ftcom-ftappl>
wndlft = $20 ; Left side of scroll window <0-39>
wndwth = $21 ; Width of scroll window <1-(40-(wndlft)>
wndtop = $22 ; Top of scroll window <0-22>
wndbtm = $23 ; Bottom of scroll window <((wintop)+1)-24>
ch = $24 ; Cursor Horizontal position
cv = $25 ; Cursor Vertical position
basl = $28 ;[33] L.O.B. of base address of current line
bash = $29 ;[33] H.O.B. of base address of current line
bas2l = $2a ; Base address work area
bas2h = $2b ; Base address work area
textfm = $32 ;[76] normal/inverse text mode
;[31] These two locs are in a 'hole' on page 0 which neither basic nor the
;[31] monitor use.
obasl = $F9 ;[31] Save loc for cursor address
obash = $FA ;[31] Save loc for cursor address
ourch = $57b ;[49] //3 80 col cards ch
ourcv = $5fb ;[49] " cv
coldch = $47b ;[49] " oldch
pos80c: ;[76]
;[82] jsr fflow ;[76] is this really rqd? *****
lda cv ;[58] save this from card
sta hcv ;[76] need to keep track for ourselves
pha ;[58]
lda ch ;[58] save this from card
sta hch ;[76] need to keep track for ourselves
pha ;[58]
lda #$1e ;[49] this is the positioning command
jsr cout ;[49] first of three
pla ;[58][49] horizontal position
clc ;[49]
adc #32 ;[49] add the bias
jsr cout ;[49] and give second to card
clc ;[49] clear the carry flag for add
pla ;[58][49] vertical pos
adc #32 ;[49] and the bias
jmp cout ;[49] let 80 col return
vtab: lda dsptyp ;[58] 80 col display ?
bpl vtab1 ;[58] no
jmp pos80c ;[58] tell 80 col about the move
vtab1: jmp dvtab ;[58] now let 40 col do its thing
lfeed: ;[49]
;[74] lda #hlf ;[57] force the test
;[74] ldx #hcr ;[57] limit is cr-1 to lf
;[74] jsr ckflow ;[57] now for flow control
jsr fflow ;[74] force flow control
lda dsptyp ;[49] get display type
bpl lfeed1 ;[49] is this 80 col?,no
jsr bphcv ;[76] got to keep track of cv
lda #$a ;[49] would you believe a line feed
jmp cout ;[49] let the card do it now
lfeed1: jmp dlfeed ;[49] os thing
advanc: lda dsptyp ;[49] get display type
bpl advan1 ;[49] is this 80 col?,no
inc hch ;[58] move one to the right
;[76] lda #80 ;[58] off screen ?
lda #79 ;[76][58] off screen ?
cmp hch ;[58]
bpl advan0 ;[58] no
jsr bphcv ;[76] yes scrool or bump
lda #0 ;[58] yes we scrool
sta hch ;[58] left edge now
advan0 ;[58]
lda #$1c ;[49] move cursor one to the right
jmp cout ;[49] position the cursor
advan1: jmp dadvan ;[49] os thing
.endc
;[87] .nlst ;[84]
.SBTTL Flag definitions
; The following are flags passed in the Y register
cmfehf = 1 ;[1] Extra help available
cmfdff = 2 ;[1] Default value present
.SBTTL Parse types
; The following are different items to parse for
cmini = 0 ; Token to indicate parser init
cmkey = 1 ; Token to parse for keyword
cmifi = 2 ; Token to parse for input file
cmofi = 3 ; Token to parse for output file
cmcfm = 4 ; Token to parse for confirm
cmnum = 5 ; Token to parse for a number
cmswi = 6 ; Token to parse for a switch
cmfls = 7 ; Token to parse for a floating-point number
cmtxt = 8 ;[1] Token to parse for an unquoted string
cmtok = 9 ;[1] Token to barse for a single char token
.SBTTL Parser support
; Define storage for pointers into command buffer. They must be
; on zero-page to take advantage of pre- and post-indexed indirect
; and also the simulated indirect addressing mode.
saddr = $00 ; Saved string address - must be on page zero
cm.rty = $02 ; Byte pointer to CTRL/R Text
cm.bfp = $04 ; Byte pointer to start of text buffer
cm.ptr = $06 ; Byte pointer to Next Input to be parsed
cm.inc = $08 ; Number of characters left in buffer
cm.cnt = $09 ; Space left in buffer
cminf1 = $0a ; Information passed to comnd routines
cminf2 = $0c ; ...
cmdptr = cminf2 ;[1] Pointer to default for parse
cmkptr = $0e ; Pointer for Cmkeyw routine
cmsptr = $10 ; Saved character pointer
cmspt2 = $12 ; Saved keyword table pointer
cmspt3 = $14 ; Saved buffer pointer
cmhptr = $16 ; Ptr. to current help text
cmptab = $18 ; Ptr. to beginning of current keyword table
cmfcb = $1a ; Pointer to FCB
cmehpt = $1c ;[1] Pointer to help commands
irqsva = $45 ;[51] interupt saves areg here
.SBTTL COMND package entry points
;
; The following addresses are locations in a jump table which
; dispatch to appropriate routines in the Comnd package.
;
;[78]rskp = prstr+3 ;[1] Routine to skip 3 bytes on return
;[78]setbrk = rskp+3 ;[1] Routine to set a break character in brkwrd
;[78]rstbrk = setbrk+3 ;[1] Routine to reset break character in brkwrd
.SBTTL COMND JSYS routines
;
; The following set of routines provides a user oriented way of parsing
; commands. It is similar to that of the COMND JSYS in TOPS-20. For
; convenience, a dispatch table is used.
;
;[78]comnd: jmp comand ; Dispatch to main command routine
;[78]mul16: jmp ml16 ; Dispatch to 16-bit multiply routine
;[78]div16 jmp dv16 ;[75] " divide
;[75] jmp prcl.0 ;[13] Dispatch to Prcrlf
;[78]prstr: jmp prst.0 ;[13] Dispatch to Prstr
;[78] jmp rskp.0 ;[13] Dispatch to Rskp
;[78] jmp sbrk.0 ;[13] Dispatch to Setbrk
;[78] jmp rbrk.0 ;[13] Dispatch to Rstbrk
.SBTTL Storage Declarations
;
; Following is the storage declarations for the Comnd routines.
;
;[78]cmbuf: .blkb $100 ;[13] Input command buffer
;[78]atmbuf: .blkb $100 ;[13] Atombuffer, (for cmtxt and cmifil)
cmbuf: .blkb 100 ;[78] Input command buffer
atmbuf: .blkb 100 ;[78] Atombuffer, (for cmtxt and cmifil)
lenabf: .byte ;[13] Length of atom in Atombuffer
brkwrd: .blkb $16 ;[13] Break mask
savea: .byte ;
savex: .byte ;
savey: .byte ;
cmbase: .byte ; Base of integer to be parsed
cmmres: .blkb 4 ; Return value from cmmult call
cmintg: .blkb 4 ; Return value for cminum call
cmfltp: .blkb 6 ; Return value for cmflot call
cmflen: .byte ; Field length
cmescf .byte 0 ;[87] escape ch flag, 0 = no
cmcdrv: .byte ; Current drive
cmostp: .word ; Save area for stack pointer
cmrprs: .word ; Reparse address
cmaflg: .byte ; Non-zero when an action char has been found
cmcffl: .byte 0 ;[13] Non-zero when privious command failed
cmfrcf: .byte 0 ;[13] Non-zero when signif. char has been seen
cmccnt: .byte ; Non-zero if a significant char is found
cmocnt: .byte ;[13] Saved length of command buffer
cmoptr: .word ;[13] Saved ptr to command buffer for <ctrl/H>
cmsflg: .byte ; Non-zero when the last char was a space
cmstat: .byte ; Save area for parse type
cmprmx: .byte ;[13] Hold area for Comnd parameters
cmprmy: .byte ;[13] Hold area for Comnd flags
cmkyln: .byte ; Keyword length
cmtlen: .byte ; Test length (for ?-prompting)
cmscrs: .byte ; Screen output switch
cmentr: .byte ; Number of remaining entries in table
cmehix: .byte ;[13] Index to extra help command buffer
keylen: .byte ; Keyword length
cmwrk1: .byte ; Command processing scratch area
cmwrk2: .byte ; ...
cmwrk3: .byte ; ...
cmwrk4: .byte ; ...
.SBTTL Symbol definitions
true = $01 ; Symbol for true return code
false = $00 ; Symbol for false return code
on = $01 ; Symbol for value of 'on' keyword
off = $00 ; Symbol for value of 'off' keyword
yes = $01 ; Symbol for value of 'yes' keyword
no = $00 ; Symbol for value of 'no' keyword
.SBTTL Prompt subroutine
;
; This routine prints the prompt for the program and specifies the
; reparse address.
;
; Inputs: X - L.O. byte address of prompt
; Y - H.O. byte address of prompt
;
; Outputs:
;
; Registers destroyed: A,X,Y
;
prompt: pla ; Get Low order byte of return address
sta cmrprs ; Save that half of reparse address
pla ; Get High order byte
sta cmrprs+1 ; Save the half
pha ; Restore the return
lda cmrprs ; address to
pha ; the stack
; clc ; Clear the carry
; adc #$01 ; Increment this address since it is one
; sta cmrprs ; short of the desired target.
; lda cmrprs+1 ; Account for the carry, if any
; adc #$00 ; ...
; sta cmrprs+1 ; ...
inc cmrprs
bne promp0
inc cmrprs+1
promp0
stx cm.rty ;[13] Save address of the prompt in
sty cm.rty+1 ;[13] the pointer to the ctrl/r text
tsx ; Get the stack pointer
stx cmostp ; Save it for later restoral
lda #cmbuf\ ; Get Low order byte of buffer address
sta cm.bfp ; Init start of text buffer
sta cm.ptr ; Init next input to be parsed
lda #cmbuf^ ; Get High order byte of buffer address
sta cm.bfp+1 ; H.O. byte of text buffer pointer
sta cm.ptr+1 ; H.O. byte of next input pointer
lda #$00 ; Clear AC
sta cmaflg ; Clear the flags
sta cmccnt ;
sta cmsflg ;
jsr prcrlf ; Print crlf
ldx cm.rty ; Get L.O. byte of prompt address to be passed
ldy cm.rty+1 ; Get H.O. byte of prompt address
jsr prstr ; Print the prompt
rts ; Return
.SBTTL Repars routine
;
; This routine sets stuff up to reparse the current command
; buffer.
;
; Input:
;
; Output: Reinitialize comnd pointers and flags
;
; Registers destroyed: A,X
;
repars: ldx cmostp ; Fetch old Stack pointer
txs ; Make it the current one
lda #cmbuf\ ; Get L.O. byte address of cmbuf
sta cm.ptr ; Stuff it
lda #cmbuf^ ; Get H.O. byte address of cmbuf
sta cm.ptr+1 ; The buffer pointer is now reset
lda #$00 ; Clear AC
sta cmsflg ; Clear the space flag
jmp (cmrprs) ; Jump at the reparse address
.SBTTL Prserr routine
;
; This routine is used when a parsing error occurs. It resets ALL
; of the pointers and flags and then goes to the reparse address.
;
; Input:
;
; Output:
;
; Registers destroyed:
;
prserr: lda cm.ptr ;[13] Store old command line pointer
sta cmoptr ;[13] ...
lda cm.ptr+1 ;[13] ...
sta cmoptr+1 ;[13] ...
lda cmccnt ;[13] Store old character count
sta cmocnt ;[13] ...
lda #$ff ;[13] Set the failure flag
sta cmcffl ;[13] ...
ldx cmostp ; Fetch the saved SP
txs ; Make it the current one
lda #cmbuf\ ; Set up the command buffer
sta cm.bfp ; address in both the
sta cm.ptr ; buffer pointer and the
lda #cmbuf^ ; next input pointer.
sta cm.bfp+1 ; ...
sta cm.ptr+1 ; ...
lda #$00 ; Clear AC
sta cmaflg ; Zero the action flag
sta cmccnt ; the character count
sta cmsflg ; and the space flag
jsr prcrlf ; Print a crelf
ldx cm.rty ; Get the address of the prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ; Reprint the prompt
jmp (cmrprs) ; Jump at the reparse address
.SBTTL COMND - Entry point for command Jsys stuff
;
; COMND routine - This routine checks the code in the AC for
; what parse type is wanted and then dispatches to an appropriate
; routine to look for it. Additional information is located in
; CMINF1 and CMINF2 on page zero.
;
; Input: A - parse type
; X,Y - optional parameters
;
; Output: A - +1 = success
; +4 = failure (assumes JMP after call)
;
; Registers destroyed: A
;
comand: sta cmstat ; Save what we are parsing
stx cmprmx ;[13] Save these parameters also
sty cmprmy ;[13] ...
cmp #cmini ; Initialize the world?
bne comn0 ; No, handle like a normal parse type
jmp prompt ; Do the prompt routine to set things up
comn0: jsr cminbf ; Get characters until action or erase
cmp #cmcfm ; Parse a confirm?
bne comn1 ; Nope
jmp cmcfrm ; Yes, try for the confirm
comn1: cmp #cmkey ; Parse a keyword perhaps?
bne comn2 ; No, next item
jmp cmkeyw ; Get the keyword
comn2: cmp #cmifi ; Parse an input file?
bne comn3 ; No, try next one
jmp cmifil ; Get the input file
comn3: cmp #cmofi ; Parse an output file?
bne comn4 ; No, try next
jmp cmofil ; Get the output file
comn4: cmp #cmswi ; Parse a switch?
bne comn5 ; No, try next again
jmp cmswit ; Yes, do a switch
comn5: cmp #cmnum ; Parse an integer?
bne comn6 ; No, try next type
jmp cminum ; Do the parse integer routine
comn6: cmp #cmfls ; Parse a floating point?????
bne comn7 ; Nope, try next one
jmp cmflot ; Yes, go get a floating point number
comn7: cmp #cmtxt ;[13] Parse for Unquoted string?
bne comn8 ;[13] Nope, go try last type
jmp cmunqs ;[13] Go parse the string
comn8: cmp #cmtok ;[13] Parse for a Single Character?
bne comn9 ;[13] Nope, no more parse types
jmp cmtokn ;[13] Go parse for char
comn9: ldx #cmer00\ ; Error 0 - Bad parse type
ldy #cmer00^ ; ...
jsr prstr ; Print the error text
lda #$04 ; Fail
rts ; Return to caller
.SBTTL Cmcfrm routine - get a confirm
;
; This routine tries to get a confirm from the command input
; buffer.
;
; Input: Cm.ptr - Beginning of next field to be parsed
;
; Output: On success, routine skip returns
;
; Registers destroyed: A,X,Y
;
cmcfrm: lda cm.ptr ; Save the current command line pointer
pha ; on the stack in case the user
lda cm.ptr+1 ; wants to parse for an alternate item
pha ; ...
cmcfr0: jsr cmgtch ; Get a character
cmp #$00 ; Is it negative?
bpl cmcfrr ; No, fail
and #$7f ; Yes, zero the sign bit
cmp #esc ; An escape?
bne cmcfr2 ; No, continue
jsr bell ; Sound bell, error...
lda #$00 ; Clear AC
sta cmaflg ; Clear the action flag
sec ; Set carry for subtraction
lda cm.bfp ; Get L.O. byte
sbc #$01 ; Decrement it once
sta cm.bfp ; Store it back
sta cm.ptr ; Make this pointer look like the other one
bcs cmcfr1 ; If set, we don't have to do H.O. byte
dec cm.bfp+1 ; Adjust H.O. byte
cmcfr1: lda cm.bfp+1 ; Move this to H.O. byte of the other pointer
sta cm.ptr+1 ; ...
dec cmccnt ; Decrement the character count
jmp cmcfr0 ; Try again.
cmcfr2: cmp #'? ; User need help??
bne cmcfr3 ; Nope
ora #$80 ; Make sure this is negative ascii
jsr cout ; Print the '?'
ldx #cmin00\ ; Get address of some help info
ldy #cmin00^ ; ...
;[79] jsr prstr ; Print it.
;[79] jsr prcrlf ; Print the crelf
jsr prstrl ;[79]
ldx cm.rty ;[13] Get address of prompt
ldy cm.rty+1 ;[13] reprint it
jsr prstr ; Reprint the prompt
lda #$00 ; Clear AC
ldy #$00 ; Clear Y
sta (cm.ptr),y ; Drop null at end of command buffer
;[87] sec ; Set carry for subtraction
;[87] lda cm.bfp ; Get L.O. byte
;[87] sbc #$01 ; Decrement it
;[87] sta cm.bfp ; Store it back
;[87] lda cm.bfp+1 ; Now do H.O. byte
;[87] sbc #$00 ; ...
;[87] sta cm.bfp+1 ; ...
ldx cm.bfp ;[87] lsb
dex ;[87]
stx cm.bfp ;[87]
cpx #$ff ;[87] did we carry?
bne .+5 ;[87] no
dec cm.bfp+1 ;[87]
ldx #cmbuf\ ; Get address of the command buffer
ldy #cmbuf^ ; ...
jsr prstr ; Reprint the command line
lda #$00 ; Clear AC
sta cmaflg ; Action flag off
jmp repars ; Go reparse the line
cmcfr3: cmp #ffd ; Is it a form feed?
bne cmcfr4 ; Nope
jsr home ; Yes, blank the screen
cmcfr4: pla ; Since this succeeded, we can flush the
pla ; old command line pointer
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
jmp rskp ; Do a return skip
cmcfrr: pla ; Restore the old comand line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure
sta cmcffl ;[13] ...
rts ; Return
.SBTTL Cmkeyw - Try to parse a keyword next
;
; This routine tries to parse a keyword from the table
; pointed to by cminf1. The keywords must be in alphabetical
; order. The routine returns the two bytes of data associated
; with the keyword. The format of the table is as follows:
;
; addr: .byte n ; Where n is the # of entries in the table.
; .byte m ; m is the size of the next keyword
; .asciz /string/ ; keyword ending in a null
; .byte a,b ; 16 bits of data related to keyword
;
; Input: Cminf1- Pointer to keyword table
;
; Output: X- byte a
; Y- byte b
;
; Registers destroyed: A,X,Y
;
cmkeyw: lda cm.ptr ; Save current comand line pointer
pha ; ...
lda cm.ptr+1 ; ...
pha ; ...
lda #$00 ;[13] Clear the 'real character' flag
sta cmfrcf ;[13] ...
lda cminf1 ; Copy to address of
sta cmptab ; the keyword table
clc ; Clear the carry
adc #$01 ; Add one to the addr. (pass the table length)
sta cmkptr ; Save the keyword pointer (L.O. byte)
lda cminf1+1 ; Get H.O. byte
sta cmptab+1 ; Save a copy of that
;[73] bcc cmkey1 ; Carry?
adc #$00 ; Add in the carry for cmkptr
cmkey1: sta cmkptr+1 ; Save it
ldy #$00 ; Clear Y
lda (cmptab),y ; Get the table length
sta cmentr ; Save number of entries in the table
cmky10: jsr cmgtch ; Get first character
cmp #$00 ; Was the first character a terminator?
bmi cmky11 ; Yup, the saved pointer does not get decr.
sec ; Make sure saved buffer pointer is correct
lda cm.ptr ; Now, reset it back one character for later
sbc #$01 ; ...
sta cm.ptr ; ...
sta cmsptr ; ...
lda cm.ptr+1 ; ...
sbc #$00 ; ...
sta cm.ptr+1 ; ...
sta cmsptr+1 ; ...
jmp cmkey2 ; Continue
cmky11: ldy cm.ptr ;[13] Just move the pointer to the save area
sty cmsptr ;[13] ...
ldy cm.ptr+1 ;[13] ...
sty cmsptr+1 ;[13] ...
cmp #hesc ;[13] Was the first terminator an escape?
beq cmky12 ;[13] Yes, handle this
jmp cmkey2 ;[13] No, continue
cmky12: lda #cmfdff ;[13] Is there a default?
bit cmprmy ;[13] ...
bne cmky13 ;[13] Yes, go copy it
lda #$00 ;[13] Shut the action flag
sta cmaflg ;[13] ...
jsr bell ;[13] Yes, start by feeping terminal
sec ;[13] Set the carry bit for subtraction
lda cm.bfp ;[13] Take L.O. byte of buffer pointer
sbc #$01 ;[13] Decrement it (back up before escape)
sta cm.bfp ;[13] Store it
sta cm.ptr ;[13] And stuff it in next input char pointer
bcs cmkync ;[13] If carry is clear, we are done
dec cm.bfp+1 ;[13] Do the carry on H.O. byte
cmkync: lda cm.bfp+1 ;[13] Copy this to next char to parse pointer
sta cm.ptr+1 ;[13] ...
jmp cmky10 ;[13] Continue by fetching a character again
cmky13: lda #$00 ;[13] Zero the action flag
sta cmaflg ;[13] ...
jmp cmcpdf ;[13] Do the copy
cmkey2: lda cmentr ; Get number of entries left
; cmp #$00 ; 0 entries left?
bne cmky21 ; No, go try next entry
pla ; Fetch back to previous comand line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set the command-failure flag
sta cmcffl ;[13] ...
rts
cmky21: ldy #$00 ; Clear Y
lda (cmkptr),y ; Get length of keyword
sta keylen ; Store it
lda cmkptr ; Get the new table pointer
sta cmspt2 ; and save it for later
lda cmkptr+1 ; ...
sta cmspt2+1 ; ...
inc cmkptr ; Increment the L.O. byte once
bne cmkey3 ; If it didn't wrap, there is no carry
inc cmkptr+1 ; There was a carry, add it in.
cmkey3: dec keylen ; Decrement the number of chars. left
lda keylen ; Get the remaining length
cmp #$ff ; Have we passed the end
bpl cmk3a ; No
jmp cmkey5 ; Yes
cmk3a: jsr cmgtch ; Get a character
cmp #$00 ; Is it a terminator?
bmi cmk3b ; Yup, it is negative
jmp cmkey4 ; Nope, it's positive
cmk3b: and #$7f ; Shut off the minus bit
cmp #'? ; Need any help?
bne cmky31 ; Nope
ora #$80 ; Set the H.O. bit
jsr cout ; And print the question mark
lda #$00 ; Clear AC
sta cmaflg ; Clear the action flag
lda cmstat ; Get saved parse type
cmp #cmswi ; Are we really doing a switch?
beq cmk3b1 ; Yes, give that message instead
ldx #cmin01\ ; L.O. byte addr of informational message
ldy #cmin01^ ; H.O. byte of address
jmp cmk3b2 ; Go print the message
cmk3b1: ldx #cmin02\ ; Load address of switch message
ldy #cmin02^ ; ...
;[79]cmk3b2: jsr prstr ; Print the message
;[79] jsr prcrlf ; Print a crelf
cmk3b2 jsr prstrl ;[79]
jsr cmktp ; and the valid entries in keyword table
jsr prcrlf ; Print another crlf
lda #cmfehf ;[13] Load extra help flag
bit cmprmy ;[13] Test bit
beq cmk3b3 ;[13] No extra help
jsr cmehlp ;[13] Go give extra help
cmk3b3: ldx cm.rty ;[13] Get L.O. address of prompt
ldy cm.rty+1 ;[13] And H.O. address of prompt
jsr prstr ; Reprint the prompt
lda #$00 ; Clear AC
ldy #$00 ; Clear Y
sta (cm.ptr),y ; Stuff a null in the buffer at that point
sec ; Set the carry
lda cm.bfp ; Get ready to decrement buffer pointer
sbc #$01 ; Subtract it
sta cm.bfp ; Store it
bcs cmky3a ; Do we have to account for carry
dec cm.bfp+1 ; Decrement the H.O. byte
cmky3a: ldx #cmbuf\ ; Get L.O. byte address of buffer
ldy #cmbuf^ ; and H.O. byte
jsr prstr ; Reprint the command line
jmp repars ; Go reparse all of it
cmky31: cmp #esc ; escape character?
beq cmk3c ; Yup, process it
jmp cmky35 ; Nope.
cmk3c: lda #$00 ; Clear AC
sta cmaflg ; Clear action flag
lda keylen ; Save on the stack, the
pha ; keylength
lda cmentr ; number of entries left
pha ; ...
lda cmkptr ; L.O. byte of keyword table pointer
pha ; ...
lda cmkptr+1 ; H.O. byte of keyword table pointer
pha ; ...
jsr cmambg ; Is it ambiguous?
jmp cmky32 ; Nope
lda #cmfdff ;[13] Load default-present flag
bit cmprmy ;[13] Check against flags
beq cmk3d ;[13] No, complain to user
lda cmfrcf ;[13] Have we seen a real character yet?
bne cmk3d ;[13] No, tell user
jmp cmcpdf ;[13] Yes, Go copy the default
cmk3d: jsr bell ; Yes, start by feeping terminal
sec ; Set the carry bit for subtraction
lda cm.bfp ; Take L.O. byte of buffer pointer
sbc #$01 ; Decrement it (back up before escape)
sta cm.bfp ; Store it
sta cm.ptr ; And stuff it in next input char pointer
bcs cmky3b ; If carry is clear, we are done
dec cm.bfp+1 ; Do the carry on H.O. byte
cmky3b: lda cm.bfp+1 ; Copy this to the next char to parse pointer
sta cm.ptr+1 ; ...
dec cmccnt ; Decrement the character count
pla ; Restore the
sta cmkptr+1 ; H.O. byte of keyword table pointer
pla ; ...
sta cmkptr ; L.O. byte of keyword table pointer
pla ; ...
sta cmentr ; Number of entries left in table
pla ; ...
sta keylen ; And the remaining keylength
inc keylen ; Adjust the keylength to make it correct
jmp cmkey3 ; And go back to try again
cmky32: ldy #$00 ; Clear Y
sec ; Set the carry flag
lda cm.bfp ; Move buffer pointer behind the escape
sbc #$01 ; ...
sta cm.bfp ; ...
sta cm.ptr ; ...
bcs cmk32c ; ...
dec cm.bfp+1 ; Have to adjust the H.O. byte
cmk32c: lda cm.bfp+1 ; ...
sta cm.ptr+1 ; ...
pla ; Fetch the old keytable pointer
sta cmkptr+1 ; ...
pla ; ...
sta cmkptr ; ...
pha ; Now push it back on the stack
lda cmkptr+1 ; ...
pha ; ...
cmky33: lda (cmkptr),y ; Get next character
; cmp #$00 ; Done?
beq cmky34 ; Yes
;[73] tax ; No, hold on to the byte
;[73] clc ; Clear the carry flag
;[73] lda cmkptr ; Adjust the keyword pointer up one place
;[73] adc #$01 ; Do L.O. byte
;[73] sta cmkptr ; Store it
;[73] bcc cmky3c ; Carry?
inc cmkptr ;[73]
bne cmky3c ;[73]
inc cmkptr+1 ; Yes, increment H.O. byte
cmky3c: ;[73]txa ; Get the data
ora #$80 ; Make sure H.O. bit is set for consistency
sta (cm.ptr),y ; Stuff it in the buffer
;[73] clc ; Clear the carry flag again
;[73] lda cm.ptr ; Get L.O byte of buffer pointer
;[73] adc #$01 ; Increment it
;[73] sta cm.ptr ; Store it
;[73] bcc cmky3d ; Carry?
inc cm.ptr ;[73]
bne cmky3d ;[73]
inc cm.ptr+1 ; Increment H.O. byte
cmky3d: inc cmccnt ; Increment character count
jmp cmky33 ; Get next character from table
cmky34: inc cmccnt ; Incrment the character count
lda #$a0 ; Clear AC
sta (cm.ptr),y ; Stuff a null in the buffer
ldx cm.bfp ; Get L.O. byte of buffer pointer
ldy cm.bfp+1 ; and H.O byte - save these for later
clc ; Clear carry
lda cm.ptr ; Increment next char of input pointer
adc #$01 ; ...
sta cm.ptr ; ...
sta cm.bfp ; ...
bcc cmky3e ; Carry?
inc cm.ptr+1 ; Do H.O. byte
cmky3e: lda cm.ptr+1 ; Make buffer pointer match next char pointer
sta cm.bfp+1 ; ...
sty savey ; Hold y for a bit
lda #$00 ; Put a null in the buffer to terminate string
ldy #$00 ; ...
sta (cm.ptr),y ; ...
ldy savey ; Get Y value back
jsr prstr ; Print remainder of keyword
pla ; Restore the
sta cmkptr+1 ; H.O. byte of keyword table pointer
pla ; ...
sta cmkptr ; L.O. byte of keyword table pointer
pla ; ...
sta cmentr ; Number of entries left in table
pla ; ...
sta keylen ; And the remaining keylength
jmp cmky37 ; Go get some data to return
cmky35: lda cmkptr ; Save on the stack the
pha ; L.O. byte of keyword table pointer
lda cmkptr+1 ; ...
pha ; H.O. byte of keyword table pointer
lda keylen ; ...
pha ; The keylength
jsr cmambg ; Check for ambiguity
jmp cmky36 ; Not ambiguous
ldx #cmer01\ ; Get addr of ambiguous error
ldy #cmer01^ ; ...
jsr prstr ; Print the error message
jmp prserr ; Go do parsing error stuff
cmky36: pla ; Fetch off of the stack the
sta keylen ; remaining keylength
pla ; ...
sta cmkptr+1 ; H.O. byte of keyword table address
pla ; ...
sta cmkptr ; L.O. byte of keyword table address
cmky37: inc keylen ; Adjust the remaining keylength
inc keylen ; ...
clc ; Clear the carry flag
lda cmkptr ; Get the keyword table pointer
adc keylen ; Add in remaining keylength
sta cmkptr ; Store it
bcc cmky3f ; Carry?
inc cmkptr+1 ; Yes, adjust H.O. byte
cmky3f: ldy #$00 ; Make sure Y is clear
lda (cmkptr),y ; Get first data byte
tax ; Put it in X
iny ; Up the index once
lda (cmkptr),y ; Get the second data byte
tay ; Put that in Y
pla ; Flush the old comand line pointer
pla ; ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
jmp rskp ; Return skip means it succeeds!
;[81]cmkey4: cmp #'a ; Check range for lower case
;[81] bmi cmky41 ; ...
;[81] cmp #<'z+1> ; ...
;[81] bpl cmky41 ; ...
;[81] and #^o137 ; Cutesy way to capitalize it
cmkey4 jsr convuc ;[81] convert to upper case
;[81]cmky41: sta cmwrk3 ; Save the character
sta cmwrk3 ; Save the character
lda #$ff ;[13] Set the 'real character' flag
sta cmfrcf ;[13] ...
ldy #$00 ; Clear Y again
lda (cmkptr),y ; Get next keyword byte
sta cmwrk4 ; Hold that for now
;[73] clc ; Clear the carry flag
;[73] lda cmkptr ; Get L.O. byte of keyword pointer
;[73] adc #$01 ; Add one
;[73] sta cmkptr ; Store it
;[73] bcc cmky4a ; Need to do carry?
inc cmkptr ;[73]
bne cmky4a ;[73]
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 ;[58]
bne cma3 ;[58]
inc cmkptr+1 ; ...
cma3: lda (cmspt2),y ; Get previous keyword length
sec ; Set carry
sbc cmwrk3 ; Subtract number of characters left
beq cmambs ;[13] If test length is 0, don't bother trying
sta cmtlen ; This is the testing length
cmp cmwrk4 ; Check this against length of new keyword
bmi cmamb0 ; This may be ambiguous
rts ; Test length is longer, cannot be ambiguous
cmamb0: ldy #$00 ; Clear Y
cmamb1: dec cmtlen ; Decrement the length to test
bpl cma4 ; Still characters left to check
cmambs: jmp rskp ;[13] The whole thing matched, it is ambiguous
cma4: lda (cmkptr),y ; Get next character of keyword
sta cmwrk3 ; Hold that for now
lda (cmsptr),y ; Get next parsed character
iny ; Up the pointer once
;[81]~ cmp #'a ; Check the range for lower case
;[81] bmi cmamb2 ; ...
;[81] cmp #<'z+1> ; ...
;[81] bpl cmamb2 ; ...
;[81] and #^o137 ; Capitalize it
;[81]cmamb2: and #$7f ; Reset H.O. bit
jsr convuc ;[81]
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 ;[58]
bne cmktp1 ;[58]
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 ;[58]
bne cmktp2 ;[58]
inc cminf2+1 ; Yup
cmktp2: lda cmtlen ; Get test length
beq cmktp3 ; If test length is zero, just print keyword
;[84]cmkp21: lda (cminf2),y ; Get character from table
cmkp21: lda (cmsptr),y ;[84] Get character from buffer
jsr convuc ;[84] convert to upper case ascii
;[84] ora #$80 ; Set the H.O. bit so the compare works
;[84] cmp (cmsptr),y ; Compare it to the buffer character
cmp (cminf2),y ;[84] Compare it to the table
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^ ; ...
;[79]cmkdn1: jsr prstr ; Print error
;[79] jsr prcrlf ; Print a crelf
cmkdn1 jsr prstrl ;[79]
cmkdn2: lda cmscrs ; Where did we end up?
beq cmkdn3 ; Beginning of line, good
jsr prcrlf ; Print a crelf
cmkdn3: rts ; Return
;
; Cmprk - prints one keyword from the table. Consults the
; cmscrs switch to see which half of the line it
; is going to and acts accordingly.
;
; Input: Cmscrs- Which half of screen
; Cminf2- Pointer to string to print
;
; Output: print keyword on screen
;
; Registers destroyed: A,X,Y
;
cmprk: lda #on ; Make sure to tell them we printed something
sta cmwrk3 ; Put it back
lda cmstat ; Get saved parse type
cmp #cmswi ; Is it a switch we are looking for?
bne cmpr2 ; No...
lda #'/+$80 ;[64] Yes, do not forget slash prefix
;[64] ora #$80 ; Make sure it is negative ascii
jsr cout ; Print slash
cmpr2: ldx cminf2 ; L.O. byte of string pointer
ldy cminf2+1 ; H.O. byte of string pointer
jsr prstr ; Print the keyword
lda cmscrs ; Where were we?
bne cmprms ; Mid screen
; jsr clreol ; Clear to end of line
lda #$14 ; Advance cursor to middle of screen
sta ch ; ...
jsr vtab ;[58] so it works for 80 col card too
jmp cmprdn ; We are done
cmprms: jsr prcrlf ; Print a crelf
cmprdn: lda cmscrs ; Flip the switch now
eor #$01 ; ...
sta cmscrs ; Stuff it back
rts ; Return
.SBTTL Cmswit - try to parse a switch next
;
; This routine tries to parse a switch from the command buffer. It
; first looks for the / and then calls cmkeyw to handle the keyword
; lookup.
;
; Input: Cminf1- Address of keyword table
;
; Output: X- byte a
; Y- byte b
;
; Registers destroyed: A,X,Y
;
cmswit: lda cm.ptr ; Save old comand line pointer in case the
pha ; user wants to try another item
lda cm.ptr+1 ; ...
pha ; ...
cmswi0: jsr cmgtch ; Go get a character
cmp #$00 ; Action?
bmi cmswi1 ; Yes, process it
jmp cmswi3 ; No, it is a real character
cmswi1: and #$7f ; Turn off the minus
cmp #'? ; Does the user need help?
bne cmsw12 ; No
ora #$80 ; Set the H.O. bit
jsr cout ; And print the question mark
lda #$00 ; Clear AC
sta cmaflg ; Clear Action flag
ldx #cmin02\ ; Low order byte addr of info message
ldy #cmin02^ ; High order byte addr of info message
;[79] jsr prstr ; Print the message
;[79] jsr prcrlf ; Print a crelf
jsr prstrl ;[79]
jsr cmktp ; Any valid entries from keyword table
jsr prcrlf ; And another crelf
lda #cmfehf ;[13] Load extra help flag
bit cmprmy ;[13] Test bit
beq cmsw10 ;[13] No extra help
jsr cmehlp ;[13] Go give extra help
cmsw10: ldx cm.rty ;[13] Load
ldy cm.rty+1 ;[13] the address of the prompt
jsr prstr ; Reprint it
lda #$00 ; Clear AC
ldy #$00 ; Clear Y
sta (cm.ptr),y ; Stuff a null at the end of the buffer
sec ; Set the carry flag
lda cm.bfp ; Increment buffer pointer
sbc #$01 ; ...
sta cm.bfp ; ...
bcs cmsw1a ; Borrow?
dec cm.bfp+1 ; Yup
cmsw1a: ldx #cmbuf\ ; L.O. byte addr of command buffer
ldy #cmbuf^ ; H.O. byte
jsr prstr ; Reprint the command line
jmp repars ; Go reparse everything
cmsw12: cmp #esc ; Lazy??
beq cmsw2a ; Yes, try to help
jmp cmswi2 ; No, this is something else
cmsw2a: lda #$00 ; Clear AC
sta cmaflg ; Clear action flag
lda #cmfdff ;[13] See if there is a default
bit cmprmy ;[13] ...
beq cmswnd ;[13] No help, tell user
jmp cmcpdf ;[13] Go copy the default
cmswnd: jsr bell ; Yes, it is ambiguous - ring bell
sec ; Set carry
lda cm.bfp ; Decrement buffer pointer
sbc #$01 ; ...
sta cm.bfp ; ...
sta cm.ptr ; Make this pointer point there too
bcs cmsw2b ; No carry to handle
dec cm.bfp+1 ; Do H.O. byte
cmsw2b: lda cm.bfp+1 ; Now make H.O. byte match
sta cm.ptr+1 ; ...
dec cmccnt ; Decrement the character count
jmp cmswi0 ; Try again
cmsw2c: lda #'/ ; Load a slash
ora #$80 ; Make sure this character is negative ascii
jsr cout ; Print slash
clc ; Clear carry
lda cminf1 ; Set the keyword table pointer
adc #$02 ; to point at the beginning
sta cmkptr ; of the keyword and move it
lda cminf1+1 ; to cmkptr
;[73] 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
;[73] tax ; No, hold on to the byte
;[73] clc ; while we increment the pointer
;[73] lda cmkptr ; Do L.O. byte
;[73] adc #$01 ; ...
;[73] sta cmkptr ; ...
;[73] bcc cmsw2f ; And, if neccesary
inc cmkptr ;[73] do it the easy way
bne cmsw2f ;[73]
inc cmkptr+1 ; the H.O. byte as well
cmsw2f: ;[73]txa ; Get the data
sta (cm.ptr),y ; Stuff it in the buffer
;[73] clc ; Clear carry
;[73] lda cm.ptr ; Increment the next character pointer
;[73] adc #$01 ; ...
;[73] sta cm.ptr ; ...
;[73] bcc cmsw2g ; ...
inc cm.ptr ;[73] do it the easy way
bne cmsw2g ;[73]
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: ;[73]clc ; Clear carry
;[73] lda cmkptr ; Increment keyword pointer
;[73] adc #$01 ; Past null terminator
;[73] sta cmkptr ; ...
;[73] bcc cmsw4a ; ...
inc cmkptr ;[73] do it the easy way
bne cmsw4a ;[73]
inc cmkptr+1 ; ...
cmsw4a: ldy #$00 ; Clear Y
lda (cmkptr),y ; Get first data byte
tax ; Put it here
iny ; Up the index
lda (cmkptr),y ; Get second data byte
tay ; Put that in Y
pla ; Flush the old comand line pointer
pla ; ...
lda #$00 ;[13] Clear the failure flag
sta cmcffl ;[13] ...
jmp rskp ; And give a skip return
cmswi2: ldy #$00 ; Clear Y
lda (cminf1),y ; Get length of table
cmp #$02 ; Greater than 1
bmi cmsw21 ; No, go fetch data
ldx #cmer01\ ; Yes, fetch pointer to error message
ldy #cmer01^ ; ...
jsr prstr ; Print the error
jmp prserr ; And go handle the parser error
cmsw21: iny ; Add one to the index
lda (cminf1),y ; Get the length of the keyword
sta keylen ; Save that
lda cminf1+1 ; Copy pointer to table
sta cmkptr+1 ; ...
clc ; Get set to increment an address
lda cminf1 ; Do L.O. byte last for efficiency
adc keylen ; Add in the keyword length
adc #$02 ; Now account for table length and terminator
sta cmkptr ; Save the new pointer
bcc cmsw22 ; If no carry, continue
inc cmkptr+1 ; Adjust H.O. byte
cmsw22: jmp cmsw4a ; Go to load data and skip return
cmswi3: cmp #'/ ; Is the real character a slash?
beq cmswi4 ; Yes, go do the rest
tax ; Move the data byte
lda #$00 ; Clear AC
pla ; Fetch back the old comand line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts ; Fail - non-skip return
cmswi4: jsr cmkeyw ; Let Keyw do the work for us
jmp cmswi5 ; We had problems, restore comand ptr and ret.
pla ; Flush the old comand pointer
pla ; ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
jmp rskp ; Success - skip return!
cmswi5: pla ; Retore the old comand line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts ; Now return
.SBTTL Cmifil - try to parse an input file spec next
;
; This routine attempts to parse an input file spec.
;
; Input: X - Max filname length
;
; Output: Filename parsed is in the atom buffer pointed to
; by X,Y
;
; Registers destroyed: A,X,Y
;
;[81]cmifil: inx ;[13] Increment Max file length for tests
;[86]cmifil: lda #0 ;[81] init wildcard flag
;[86] sta wcpres ;[81]
cmifil ;[86]
inx ;[13] Increment Max file length for tests
stx cmprmx ;[13] Maximum filename length
lda cm.ptr ; Save the old comand line pointer in case
pha ; the user wants to parse for an
lda cm.ptr+1 ; alternate item
pha ; ...
lda #$00 ; Zero the
sta lenabf ;[13] length of the atom buffer
cmifl0: ldy #$00 ; Zero Y
lda #' ; Blank the AC
ora #$80 ; Turn on the H.O. bit
cmifi0: sta atmbuf,y ; Now blank the buffer
iny ; ...
cpy cmprmx ;[13] Done?
;[86] bpl cmifi1 ; Yes, start parsing
;[86] jmp cmifi0 ; No, continue blanking
bmi cmifi0 ;[86] No, continue blanking
cmifi1: jsr cmgtch ; Get a character from command buffer
cmp #$00 ; Is it an action character
bmi cmif10 ;[13] Yes, check it out
jmp cmifi2 ;[13] No, process it as a normal character
cmif10: and #$7f ;[13] Yes, turn off the minus bit
cmp #'? ; Does the user need help?
bne cmif12 ; Nope
ora #$80 ; Set the H.O. bit
jsr cout ; And print the question mark
ldy #$00 ; Yes
sty cmaflg ; Clear the action flag
ldx #cmin03\ ; Now get set to give the 'file spec' message
ldy #cmin03^ ; ...
;[79] jsr prstr ; Print it
;[79] jsr prcrlf ; Print a crelf
jsr prstrl ;[79]
lda #cmfehf ;[13] Load extra help flag
bit cmprmy ;[13] Test bit
beq cmifnh ;[13] No extra help
jsr cmehlp ;[13] Go give extra help
cmifnh: ldx cm.rty ;[13] Set up to reprint the prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ; Do it
sec ; Set the carry flag for subtraction
lda cm.bfp ; Get the buffer pointer
sbc #$01 ; Decrement it once
sta cm.bfp ; ...
bcs cmif11 ; If it's set, we need not do H.O. byte
dec cm.bfp+1 ; Adjust the H.O. byte
cmif11: dec cmccnt ; Decrement the character count
ldy #$00 ; Clear Y
lda #$00 ; Clear AC
sta (cm.bfp),y ; Stuff a null at the end of the command buffer
ldx #cmbuf\ ; Now get the address of the command buffer
ldy #cmbuf^ ; ...
jsr prstr ; Reprint the command line
jmp cmifi1 ; Go back and continue
cmif12: cmp #esc ; Got an escape?
bne cmif13 ; No
lda #$00 ; Yup, clear the action flag
sta cmaflg ; ...
lda #cmfdff ;[13] Load default-present flag
bit cmprmy ;[13] Test bit
beq cmifnd ;[13] No default
lda lenabf ;[13] Now check if user typed anything
bne cmifnd ;[13] Yup, can't use default
jmp cmcpdf ;[13] Go copy the default
cmifnd: jsr bell ; Escape does not work here, ring the bell
sec ; Set carry for subtraction
lda cm.bfp ; Decrement the buffer pointer
sbc #$01 ; once
sta cm.bfp ; ...
sta cm.ptr ; Make both pointers look at the same spot
lda cm.bfp+1 ; ...
sbc #$00 ; H.O. byte adjustment
sta cm.bfp+1 ; ...
sta cm.ptr+1 ; ...
dec cmccnt ; Decrement the character count
jmp repars ; and go reparse everything
cmif13: lda lenabf ;[13] Get the length of the buffer
; cmp #$00 ; Is it zero?
bne cmif14 ; No, continue
jmp cmifi9 ; Yes, this is not good
cmif14: cmp cmprmx ;[13] Are we over the maximum file length?
;[86] bmi cmif15 ; Not quite yet
;[86] jmp cmifi9 ; Yes, blow up
bpl cmifi9 ;[86] Yes, blow up
cmif15: ldy lenabf ;[13] Get the filename length
lda #nul ; and stuff a null at that point
sta atmbuf,y ;[13] ...
pla ; Flush the old comand line pointer
pla ; ...
ldx #atmbuf\ ;[13] Set up the atom buffer address
ldy #atmbuf^ ;[13] ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
lda lenabf ;[13] Load length into AC to be passed back
jmp rskp ; No, we are successful
cmifi2: cmp #sp ;[13] Bad character?
bmi cmifi9 ; Yes, blow up
cmp #del ;[13] ...
bpl cmifi9 ; This is bad, punt
;[81] cmp #'a ;[13] Is character a lower-case alpha?
;[81] bmi cmifi8 ;[13] No, don't capitalize
;[81] cmp #<'z+1> ;[13] ...
;[81] bpl cmifi8 ;[13] ...
;[81] and #$5f ; Capitalize
jsr convuc ;[81] convert to upper case
cmifi8: ldy lenabf ;[13] Set up length of buffer in Y
;[86] cmp #wcmult ;[81]
;[86] beq cmif85 ;[81] wc present
;[86] cmp #wcsing ;[81]
;[86] bne cmif86 ;[81] not a single ch wc
;[86]cmif85 sta wcpres ;[81] got one
;[86]cmif86 ;[81]
sta atmbuf,y ;[13] Stuff character in FCB
inc lenabf ;[13] Increment the length of the name
jmp cmifi1 ; Go back for next character
cmifi9: pla ; Restore the old comand line pointer
sta cm.ptr+1 ; in case the user wants to parse
sta cmoptr+1 ;[13] ...
pla ; for something else
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts
.SBTTL Cmofil - try to parse an output file spec
;
; This routine attempts to parse an output file spec from the
; command buffer.
;
; Input: cminf1- Pointer to FCB
;
; Output:
;
; Registers destroyed:
;
cmofil: jmp cmifil ; Same as parsing input file spec for now
.SBTTL Cminum - Try to parse an integer number
;
; This routine tries to parse an integer number in the base
; specified. It will return a 16-bit number in cmintg.
; Cmintg is formatted H.O. byte first!
;
; Input: X- Base of integer (2<=x<=16)
;
; Output: X - L.O. byte of 16-bit integer parsed
; Y - H.O. byte of 16-bit integer parsed
;
; Registers destroyed: A,X,Y
;
cminum: lda cm.ptr ; Save the old comand line pointer
pha ; ...
lda cm.ptr+1 ; ...
pha ; ...
cpx #$11 ; Are we within the proper range?
bmi cmin1 ; If so, check high range
jmp cmine1 ; No, tell them about it
cmin1: cpx #$02 ; Too small of a base??
bpl cmin2 ; No, continue
jmp cmine1 ; Base too small, tell them about it
cmin2: stx cmbase ; The base requested is good, store it
lda #$00 ; Clear AC
sta cmmres ; and initialize these areas
sta cmmres+1 ; ...
sta cmmres+2 ; ...
sta cmmres+3 ; ...
sta cmintg ; ...
sta cmintg+1 ; ...
sta cmintg+2 ; ...
sta cmintg+3 ; ...
cminm1: jsr cmgtch ; Get next character from command buffer
cmp #$00 ; Is this an action character
bmi cmin1a ; Yes, handle it
jmp cminm4 ; No, look for a digit
cmin1a: and #$7f ; It is, turn off the H.O. bit
cmp #esc ; Is it an escape?
bne cminm2 ; No, try something else
lda #cmfdff ;[13] Load default-present flag
bit cmprmy ;[13] Test bit
beq cminnd ;[13] No default
lda cmmres ;[13] Check if user typed anything significant
ora cmmres+1 ;[13] ...
bne cminnd ;[13] Yup, can't use default
jmp cmcpdf ;[13] Go copy the default
cminnd: jsr bell ; Yes, but escape is not allowed, ring bell
lda #$00 ; Zero
sta cmaflg ; the action flag
sec ; Set the carry flag for subtraction
lda cm.bfp ; Get the command buffer pointer
sbc #$01 ; Decrement it once
sta cm.bfp ; Store it away
sta cm.ptr ; Make this pointer look like it also
bcs cmin11 ; If carry set don't adjust H.O. byte
dec cm.bfp+1 ; Adjust the H.O. byte
cmin11: lda cm.bfp+1 ; Move a copy of this H.O. byte
sta cm.ptr+1 ; to this pointer
dec cmccnt ; Decrement the character count
jmp cminm1 ; Go try for another character
cminm2: cmp #'? ; Does the user need help?
bne cminm3 ; If not, back up the pointer and accept
ora #$80 ; Set the H.O. bit
jsr cout ; And print the question mark
ldx #cmin05\ ; Set up the pointer to info message to be
ldy #cmin05^ ; printed
jsr prstr ; Print the text of the message
lda cmbase ; Get the base of the integer number
cmp #$0a ; Is it greater than decimal 10?
bmi cmin21 ; No, just print the L.O. digit
clc ; Clear the carry
lda #$01 ; Print the H.O. digit as a 1
adc #$b0 ; Make it printable
jsr cout ; Print the '1'
lda cmbase ; Get the base back
sec ; Set the carry flag for subtraction
sbc #$0a ; Subtract off decimal 10
cmin21: clc ; Clear carry for addition
adc #$b0 ; Make it printable
;[79] jsr cout ; Print the digit
;[79] jsr prcrlf ; Print a crelf
jsr coutl ;[79] Print the digit & crlf
lda #cmfehf ;[13] Load extra help flag
bit cmprmy ;[13] Test bit
beq cminnh ;[13] No extra help
jsr cmehlp ;[13] Go give extra help
cminnh: ldx cm.rty ;[13] Set up pointer so we can print the prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ; Reprint the prompt
lda #$00 ; Clear AC
ldy #$00 ; Clear Y
sta (cm.ptr),y ; Drop a null at the end of the command buffer
sec ; Set the carry flag for subtraction
lda cm.bfp ; Get the L.O. byte of the address
sbc #$01 ; Decrement it once
sta cm.bfp ; Store it back
bcs cmin22 ; If carry set, don't adjust H.O. byte
dec cm.bfp+1 ; Adjust H.O. byte
cmin22: ldx #cmbuf\ ; Get the address of the command buffer
ldy #cmbuf^ ; ...
jsr prstr ; Reprint the command buffer
lda #$00 ; Clear the
sta cmaflg ; action flag
jmp repars ; Reparse everything
cminm3: ldx cmmres ;[13] Move L.O. byte
ldy cmmres+1 ;[13] Move H.O. byte
pla ; Flush the old comand line pointer
pla ; ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
jmp rskp ;
cminm4: cmp #$40 ; Is this a letter?
bmi cmin41 ; Nope, skip this stuff
and #$df ;[75] make it upper case
sec ; It is, bring it into the proper range
sbc #$07 ; ...
cmin41: sec ; Set carry for subtraction
sbc #$30 ; Make the number unprintable
; cmp #$00 ; Is the number in the proper range?
bmi cminm5 ; No, give an error
cmp cmbase ; ...
bmi cminm6 ; This number is good
cminm5: pla ; Restore the old comand line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts ; Then return
cminm6: pha ; Save the number to add in
lda #0 ;[87] msb
pha ;[87]
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 ;[87] msb
pha ; ...
lda cmbase ; ...
pha ; ...
;[87] jsr mul16 ; Multiply this out
jsr mul24 ;[87] 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 ;[87] msb thro away
pla ; Get the digit to add in
clc ; Clear the carry for the add
adc cmmres ; Add in L.O. byte of result
sta cmmres ; Store it back
lda cmmres+1 ; Get the H.O. byte
adc #$00 ; Add in the carry
sta cmmres+1 ; Save the H.O. byte
bcs cmine2 ; Wrong, we overflowed
jmp cminm1 ; Try for the next digit
cmine1: ldx #cmer06\ ; Get the address of the error message
ldy #cmer06^ ; ...
jsr prstr ; Print the error
jmp prserr ; Handle the parse error
cmine2: ldx #cmer07\ ; Get the address of the error message
ldy #cmer07^ ; ...
jsr prstr ; Print the error message
jmp prserr ; Handle the error
.SBTTL Cmflot - Try to parse a floating point number
;
; This routine tries to parse a floating point number in the
; format:
; sd-d.d-dEsddd
;
; s is an optional sign bit
; d is a decimal digit
; E is the letter 'E'
; . is a decimal point
;
; Input:
;
; Output: Cmfltp- 6 byte floating point number
; 4.5 byte signed mantissa
; 1.5 byte signed exponent
;
; s b........b s e.....e
; bit 0 1 35 36 37 47
;
; Registers destroyed: A,X,Y
;
cmflot: rts
.SBTTL Cmunqs - Try to parse an unquoted string
;
; This routine tries to parse an unquoted string terminating
; with one of the break characters in brkwrd.
;
; Input:
;
; Output: X - L.O. byte address of ASCII string
; Y - H.O. byte address of ASCII string
; A - Length of string parsed
;
; Registers destroyed: A,X,Y
;
;[86]cmunqs: lda cm.ptr ;[13] Save the command buffer pointer
cmunqs: ;[86]
lda #0 ;[86] init wildcard flag
sta wcpres ;[86]
lda cm.ptr ;[86] Save the command buffer pointer
pha ;[13] ...
lda cm.ptr+1 ;[13] ...
pha ;[13] ...
lda #$00 ;[13] Zero length of Atom buffer
sta lenabf ;[13] ...
cmunq1: jsr cmgtch ;[13] Get a character
jsr chkbrk ;[13] Is it one of the break characters?
jmp cmunq3 ;[13] Yes, handle that condition
cmp #$00 ;[13] No, is it an action character?
bpl cmunq2 ;[13] No, handle it as normal text
and #$7f ;[13] We don't need the H.O. bit
cmp #'? ;[13] Does the user need help?
bne cmun13 ;[13] Nope, try next possibility
ora #$80 ;[13] Have to print this, set H.O. bit
jsr cout ;[13] Print '?'
ldy #$00 ;[13] Zero the action flag
sty cmaflg ;[13] ...
ldx #cmin06\ ;[13] Get the help message
ldy #cmin06^ ;[13] ...
;[79] jsr prstr ;[13] and print it.
;[79] jsr prcrlf ;[13] Print a crelf after it
jsr prstrl ;[79]
lda #cmfehf ;[13] Check for extra help.
bit cmprmy ;[13] ...
beq cmun11 ;[13] If no help, continue
jsr cmehlp ;[13] Process extra help
cmun11: ldx cm.rty ;[13] Go reprint prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ;[13] ...
sec ;[13] Adjust buffer pointer
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
bcs cmun12 ;[13] ...
dec cm.bfp+1 ;[13] Adjust H.O. byte
cmun12: dec cmccnt ;[13] Correct character count
ldy #$00 ;[13] Stuff a null at end of usable buffer
lda #$00 ;[13] ...
sta (cm.bfp),y ;[13] ...
ldx #cmbuf\ ;[13] Reprint command line
ldy #cmbuf^ ;[13] ...
jsr prstr ;[13] ...
jmp cmunq1 ;[13] Go back for more characters
cmun13: cmp #esc ;[13] Did the user type <esc>?
bne cmunq2 ;[13] No, just stuff the character and cont.
lda #$00 ;[13] Clear the action flag
sta cmaflg ;[13] ...
lda #cmfdff ;[13] Check if there is a default value
bit cmprmy ;[13] ...
beq cmun14 ;[13] If not, the <esc> loses
lda lenabf ;[13] Ok, there is a default, but if
bne cmun14 ;[13] something has been typed, <esc> loses
jmp cmcpdf ;[13] Go copy default and reparse
cmun14: jsr bell ;[13] Feep at user
sec ;[13] and reset the buffer pointer
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
sta cm.ptr ;[13] ...
lda cm.bfp+1 ;[13] ...
sbc #$00 ;[13] ...
sta cm.bfp+1 ;[13] ...
sta cm.ptr+1 ;[13] ...
dec cmccnt ;[13] Adjust the character count
jmp repars ;[13] and reparse the command line
cmunq2: ldy lenabf ;[13] Fetch where we are in atmbuf
jsr convuc ;[86] now for files we need upper case
cmp #wcmult ;[86]
beq cmif85 ;[86] wc present
cmp #wcsing ;[86]
bne cmif86 ;[86] not a single ch wc
cmif85 sta wcpres ;[86] got one
cmif86 ;[86]
sta atmbuf,y ;[13] and store our character there
inc lenabf ;[13] Reflect increased length
jmp cmunq1 ;[13] Go back for more characters
cmunq3: lda lenabf ;[13] Get the length
beq cmunqf ;[13] If we parsed a null string, fail
pla ;[13] Flush old command line pointer
pla ;[13] ...
ldx #atmbuf\ ;[13] Now, set up the return parameter
ldy #atmbuf^ ;[13] ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
lda lenabf ;[13] Set up atom length
jmp rskp ;[13] Return
cmunqf: pla ;[13] Restore old command line pointer
sta cm.ptr+1 ; ...
sta cmoptr+1 ;[13] ...
pla ; ...
sta cm.ptr ; ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save count in case of <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts ;[13] Return
.SBTTL Cmtokn - Try to parse for a single character token
;
; This routine tries to parse for the character in the X-register.
;
; Input: X - Character to be parsed
;
; Output: +1 - failed to find character
; +4 - success, found character
;
; Registers destroyed: A,X,Y
;
cmtokn: lda cm.ptr ;[13] First, save the old command pointer
pha ;[13] on the stack
lda cm.ptr+1 ;[13] ...
pha ;[13] ...
cmtk0: jsr cmgtch ;[13] Fetch the next character
bpl cmtk3 ;[13] Not an action character
and #$7f ;[13] It's an action character
cmp #esc ;[13] User trying to be lazy?
bne cmtk2 ;[13] Nope, tyr next option
jsr bell ;[13] Yes, well, he's not allowed to be lazy
lda #$00 ;[13] Clear the action flag
sta cmaflg ;[13] ...
sec ;[13] Adjust the buffer pointer back once
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
sta cm.ptr ;[13] Copy it into command pointer
bcs cmtk1 ;[13] Need to adjust H.O. byte?
dec cm.bfp+1 ;[13] Yes, do it
cmtk1: lda cm.bfp+1 ;[13] Copy it to command pointer
sta cm.ptr+1 ;[13] ...
dec cmccnt ;[13] Adjust the character count
jmp cmtk0 ;[13] and try again
cmtk2: cmp #'? ;[13] User need help?
bne cmtk4 ;[13] No, go fail
ora #$80 ;[13] Yes, set bit to print char
jsr cout ;[13] Print it
ldx #cmin07\ ;[13] Point to the information message
ldy #cmin07^ ;[13] ...
jsr prstr ;[13] and print it
lda #hdquot ;[13] Print the character we are looking for
jsr cout ;[13] in between double quotes
lda cmprmx ;[13] ...
ora #$80 ;[13] ...
jsr cout ;[13] ...
lda #hdquot ;[13] ...
;[79] jsr cout ;[13] ...
;[79] jsr prcrlf ;[13] End it with a crelf
jsr coutl ;[79] print ch & crlf
lda #cmfehf ;[13] Load extra help flag
bit cmprmy ;[13] Test bit
beq cmtknh ;[13] No extra help
jsr cmehlp ;[13] Go give extra help
cmtknh: ldx cm.rty ;[13] Point to prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ;[13] and print it
sec ;[13] Adjust the buffer pointer back one
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
lda cm.bfp+1 ;[13] ...
sbc #$00 ;[13] ...
sta cm.bfp+1 ;[13] ...
lda #$00 ;[13] Stuff a null at the end of the buffer
ldy #$00 ;[13] ...
sta (cm.ptr),y ;[13] ...
ldx #cmbuf\ ;[13] Point to command buffer
ldy #cmbuf^ ;[13] ...
jsr prstr ;[13] and reprint it
lda #$00 ;[13] Clear action flag
sta cmaflg ;[13] ...
jmp repars ;[13] and go reparse
cmtk3: cmp cmprmx ;[13] Ok, this either is or is not the
bne cmtk4 ;[13] char we want. If not, go fail.
pla ;[13] It is, flush the old address
pla ;[13] ...
lda #$00 ;[13] Reset the failure flag
sta cmcffl ;[13] ...
jmp rskp ;[13] and skip return
cmtk4: pla ;[13] Restore old pointer
sta cm.ptr+1 ;[13] ...
sta cmoptr+1 ;[13] ...
pla ;[13] ...
sta cm.ptr ;[13] ...
sta cmoptr ;[13] ...
lda cmccnt ;[13] Save the count for <ctrl/H>
sta cmocnt ;[13] ...
lda #$ff ;[13] Set failure flag
sta cmcffl ;[13] ...
rts ;[13] Return
.SBTTL Cminbf - read characters from keyboard
;
; This routine reads characters from the keyboard until
; an action or editing character comes up.
;
; Input:
;
; Output: Cmbuf- characters from keyboard
;
; Registers destroyed:
;
cminbf: pha ; Save the AC
txa ; and X
pha ; ...
tya ; and Y
pha ; ...
php ; Save the processor status
ldy #$00 ; Clear Y
lda cmaflg ; Fetch the action flag
beq cminb1 ; Nope
jmp cminb9 ; Yes, so leave
cminb1: inc cmccnt ; Up the character count once
bne cminb0 ;[23] If we are overflowing the command buffer
jsr bell ;[23] Feep at the user and do Prserr
dec cmccnt ;[23] Make sure this doesn't happen again
jmp prserr ;[23] for same string
cminb0: jsr rdkey ; Get next character from keyboard
ldy cmescf ;[87] are we escaping this ch?
beq cminba ;[87] no
ldy #0 ;[87] stuff it asis
sty cmescf ;[87] only once
and #$7f ;[87] hope this hides it
sta (cm.bfp),y ;[87]
inc cm.bfp ;[87] and tattle
bne .+4 ;[87] hate this & its page 0
inc cm.bfp+1 ;[87]
jmp cmnb72 ;[87] print it & next
cminba ;[87]
cmp #hctrlh ;[13] User want a retry?
bne cmnbnh ;[13] Nope, go on
ldx cmccnt ;[13] Check character count
cpx #$01 ;[13] Is this the first character?
bne cmnbnh ;[13] Nope, can't help him
ldx cmcffl ;[13] Did the previous command fail?
bpl cmnbnh ;[13] No, we can't reparse a good command
lda cmoptr ;[13] Ok, get the old pointer and set up
sta cm.ptr ;[13] the old command line again
sta cm.bfp ;[13] ...
lda cmoptr+1 ;[13] ...
sta cm.ptr+1 ;[13] ...
sta cm.bfp+1 ;[13] ...
lda cmocnt ;[13] Restore the character count
sta cmccnt ;[13] ...
lda #$00 ;[13] Zero this so we can safely use the
sta cmwrk2 ;[13] code that reprints a line after ^W
jmp cmnbna ;[13] Go reprint the line
cmnbnh: ldy #$00 ;
cmp #'\+$80 ;[87] escape ch?
bne cmnb10 ;[87] no
dec cmccnt ;[87] yup
sta cmescf ;[87] set the flag
jmp cmnb72 ;[87] print it but thats all
cmnb10 ;[87]
sta (cm.bfp),y ; Stuff character in buffer
inc cm.bfp ; Increment the buffer pointer
bne cmnb11 ; Carry?
inc cm.bfp+1 ; Yup, do H.O. byte
cmnb11
cmp #hctrlu ; Is it a ^U
bne cminb2 ; Nope
cmnb12: jsr scrl3 ; Yes, clear the whole line
ldx cm.rty ;[13] Get L.O. byte addr.
ldy cm.rty+1 ;[13] and H.O. byte addr of prompt
lda #$00 ; Reset cursor position to beginning of line
sta ch ; ...
jsr vtab ;[58] position 80 col too
jsr prstr ; Reprint the prompt
;[49] jsr clreol ; Get rid of garbage on that line
lda #cmbuf\ ; Now reset the buffer pointer
sta cm.bfp ; to the beginning of the buffer
lda #cmbuf^ ; ...
sta cm.bfp+1 ; ...
lda #$00 ; Clear AC
sta cmccnt ; Clear the character count
jmp repars ; Reparse new line from beginning
cminb2: cmp #hbs ; Is it a <bs>?
beq cminb3 ; Yes
cmp #hdel ; A <del>?
bne cminb4 ; No
cminb3: jsr bsp ; [49] Backup cursor horizontal position
jsr clreol ; Now clear from there to end of line
dec cmccnt ; Decrement the character count
dec cmccnt ; twice.
; lda cmccnt ; Now fetch it
; cmp #$00 ; Did we back up too far??
bpl cmnb32 ; No, go on
jsr bell ; Yes, ring the bell and
jmp cmnb12 ; go reprint prompt and reparse line
cmnb32: sec ; Set the carry
lda cm.bfp ; Now decrement the buffer pointer
sbc #$02 ; twice.
sta cm.bfp ; Store it
bcs cmnb33 ; ...
dec cm.bfp+1 ; Decrement to account for the borrow
cmnb33: jmp repars ; Time to reparse everything
cminb4: cmp #hctrlw ;[13] Delete a word?
beq cmnb41 ;[13] Yes, go take care of that
jmp cmib40 ;[13] Nope, continue
cmnb41: lda #$03 ;[13] Set up negative offset count
sta cmwrk2 ;[13] ...
sec ;[13] Set up to adjust buffer pointer
lda cm.bfp ;[13] Get the L.O. byte
sbc #$03 ;[13] Adjust pointer down by 3
sta cm.bfp ;[13] Store it back
bcs cmnb42 ;[13] Don't worry about H.O. byte
dec cm.bfp+1 ;[13] Adjust H.O. byte also
cmnb42: lda cmwrk2 ;[13] First, check the count
cmp cmccnt ;[13] Cmwrk2 > cmccnt?
bmi cmints ;[13] No, go test characters
jmp cmnb12 ;[13] Yes, go clear the whole line
cmints: ldy #$00 ;[13] Zero Y
lda (cm.bfp),y ;[13] Get previous character
cmp #hlf ;[13] Start to test ranges...
bpl cmits1 ;[13] Between <lf> and <cr>?
jmp cminac ;[13] No, not in range at all
cmits1: cmp #hcr+1 ;[13] ...
bmi cmnb43 ;[13] Yes, handle it
cmp #hspace ;[13] Between <sp> and '"'?
bpl cmits2 ;[13] Possible, continue
jmp cminac ;[13] No, advance to previous character
cmits2: cmp #hdquot+1 ;[13] ...
bmi cmnb43 ;[13] Yes, delete back to there
cmp #hapos ;[13] Between Apostrophy and '/'?
bpl cmits3 ;[13] Could be, continue
jmp cminac ;[13] Nope, advance character
cmits3: cmp #hslash+1 ;[13] ...
bmi cmnb43 ;[13] Yup, found a delimiter
cmp #hcolon ;[13] Between ':' and '>' perhaps?
bpl cmits4 ;[13] Maybe
jmp cminac ;[13] Nope, advance to previous character
cmits4: cmp #hrabr+1 ;[13] ...
bmi cmnb43 ;[13] It is, go delete back to there
cmp #hquote ;[13] Is it a "'"?
bne cminac ;[13] No, advance
cmnb43: dec cmwrk2 ;[13] Adjust this count
;[73] clc ;[13] and the buffer pointer
;[73] lda cm.bfp ;[13] ...
;[73] adc #$01 ;[13] ...
;[73] sta cm.bfp ;[13] ...
;[73] bcc cmnb44 ;[13] ...
inc cm.bfp ;[73] better way to do it
bne cmnb44 ;[73]
inc cm.bfp+1 ;[13] ...
cmnb44: lda cmccnt ;[13] Get the command buffer length
cmnbcc: cmp ch ;[13] Check against horizontal cursor position
bmi cmnbna ;[13] It's smaller, skip veritcal cursor adjust
pha ;[49] save a since upline doesnt
jsr upline ;[49] [13] Adjust cursor vertical position
pla ;[49]
sec ;[13] Reflect this in number of characters
sbc #$28 ;[13] we skipped back over
jmp cmnbcc ;[13] Go check again
cmnbna: lda #$00 ;[13] Put a null at the end of the buffer
ldy #$00 ;[13] ...
sta (cm.bfp),y ;[13] ...
sta ch ;[13] Zero position on current line
jsr scrl3 ;[13] Clear current line
ldx cm.rty ;[13] Reprint prompt
ldy cm.rty+1 ;[13] ...
jsr prstr ;[13] ...
ldx #cmbuf\ ;[13] Reprint command buffer
ldy #cmbuf^ ;[13] ...
jsr prstr ;[13] ...
sec ;[13] Now adjust the command character count
lda cmccnt ;[13] ...
sbc cmwrk2 ;[13] by what we have accumulated
sta cmccnt ;[13] ...
jsr clreol ;[13] Clear to the end of this line
jmp repars ;[13] Go reparse the command
cminac: inc cmwrk2 ;[13] Increment count of chars to back up
sec ;[13] Adjust the buffer pointer down again
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
bcs cmnb45 ;[13] If carry set, skip H.O. byte adjustment
dec cm.bfp+1 ;[13] Adjust this
cmnb45: jmp cmnb42 ;[13] Go around once again
cmib40: cmp #hquest ; Need help?
beq cminb6 ; ...
cmp #hesc ; Is he lazy?
beq cminb6 ; ...
cmp #hcr ; Are we at end of line?
beq cminb5 ; ...
cmp #hlf ; End of line?
beq cminb5 ; ...
cmp #hffd ; Is it a form feed?
;[87] bne cminb7 ; None of the above
bne cmnb71 ;[87] None of the above
jsr home ; Clear the whole screen
cminb5: lda cmccnt ; Fetch character count
cmp #$01 ; Any characters yet?
bne cminb6 ; Yes
jmp prserr ; No, parser error
cminb6: lda #$ff ; Go
sta cmaflg ; and set the action flag
jmp cminb9 ; Leave
;[87]cminb7: cmp #' ; Is the character a space?
;[87] bne cmnb71 ; No
;[87] jsr cout ; Output the character
;[87] jmp cminb1 ; Yes, get another character
cmnb71: cmp #htab ; Is it a <tab>?
bne cmnb72 ; No
jsr cout ; Output the character
jmp cminb1 ; Yes, get more characters
cmnb72: jsr cout ; Print the character on the screen
jmp cminb1 ; Get more characters
cminb9: dec cmccnt ; Decrement the count once
plp ; Restore the processor status
pla ; the Y register
tay ; ...
pla ; the X register
tax ; ...
pla ; and the AC
rts ; and return!
.SBTTL Cmgtch - get a character from the command buffer
;
; This routine takes the next character out of the command
; buffer, does some checking (action character, space, etc.)
; and then returns it to the calling program in the AC
;
; Input: NONE
;
; Output: A- Next character from command buffer
;
; Registers destroyed: A,X,Y
;
cmgtch: ldy #$00 ; Y should always be zero here to index buffer
lda cmaflg ; Fetch the action flag
; cmp #$00 ; Set??
bne cmgt1 ; Yes
jsr cminbf ; No, go fetch some more input
cmgt1: lda (cm.ptr),y ; Get the next character
;[73] tax ; Hold on to it here for a moment
;[73] clc ; Clear the carry flag
;[73] lda cm.ptr ; Increment
;[73] adc #$01 ; the next character pointer
;[73] sta cm.ptr ; ...
;[73] bcc cmgt2 ; ...
inc cm.ptr ;[73] another way to do it
bne cmgt2 ;[73]
inc cm.ptr+1 ; Have carry, increment H.O. byte
cmgt2: ;[73]txa ; Now, get the data
cmp #hspace ; Space?
beq cmgtc2 ; Yes
cmp #htab ; <tab>?
bne cmgtc3 ; Neither space nor <tab>
cmgtc2: pha ;[13] Hold the character here till we need it
lda #cmtxt ;[13] Are we parsing a string?
cmp cmstat ;[13] ...
beq cmgtis ;[13] Yes, ignore space flag test
lda #cmifi ;[13] Are we parsing a file name?
cmp cmstat ;[13] ...
beq cmgtis ;[13] Yes, ignore space flag test
lda cmsflg ; Get the space flag
; cmp #$00 ; Was the last character a space?
beq cmgtis ;[13] No, go set space flag
pla ;[13] Pop the character off
jmp cmgtch ;[13] But ignore it and get another
cmgtis: lda #$ff ; Set
sta cmsflg ; the space flag
pla ;[13] Restore the space or <tab>
;[73] jmp cmgtc5 ; Go return
rts ;[73] if u only knew the trouble this caused
cmgtc3: php ; Save the processor status
pha ; Save this so it doesn't get clobbered
lda #$00 ; Clear AC
sta cmsflg ; Clear space flag
pla ; Restore old AC
plp ; Restore the processor status
cmp #hesc ; Escape?
;[73] beq cmgtc5 ; ...
beq cmgtc7 ;[73] sigh! trouble maker
cmp #hquest ; Need help?
beq cmgtc4 ; ...
cmp #hcr ; <cr>?
beq cmgtc4 ; ...
cmp #hlf ; <lf>?
beq cmgtc4 ; ...
cmp #hffd ; <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
cmgtc7 ;[73]
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
;
;[75]prcl.0: lda #hcr ; Get a cr in the AC
;[75] jsr cout ; and print it out
;[75] rts ; Return
.SBTTL Prstr subroutine
;
; This routine prints a string ending in a null.
;
; Input: X- Low order byte address of string
; Y- High order byte address of string
;
; Output: Prints string on screen
;
; Registers destroyed: A,X,Y
;
prst.0: stx saddr ; Save Low order byte
sty saddr+1 ; Save High order byte
ldy #$00 ; Clear Y reg
prst1: lda (saddr),y ; Get the next byte of the string
beq prsdon ; If it is null, we are done
ora #$80 ; Make sure it is printable
jsr dely ; Call screen output routine
iny ; Up the index
bne prst1 ; [49]If it is zero, the string is <256, continue
inc saddr+1 ; Increment page number
prst2: jmp prst1 ; Go back to print next byte
prsdon: rts ; Return
dely: pha ; Hold the AC
;[85] lda #$32 ; Set delay
lda timect ;[85] Set delay
rol a ;[85] just double it
;[78] jsr $fca8 ; Do the delay
jsr wait ;[78] Do the delay
pla ; Fetch the character back
jmp cout ; [49] Print the character
;[49] rts ; Return
;[87].SBTTL Mul16 - 16-bit multiply routine
.SBTTL Mul24 - 24-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.
;
; ENTRY top of stack
;
; low rtn
; high rtn
; low multiplier
; "
; high "
; low multiplican
; "
; high "
; EXIT
; low product
; "
; high "
;[87]ml16: pla ; Save the return address
ml24: pla ;[87] Save the return address
sta rtaddr ; ...
pla ; ...
sta rtaddr+1 ; ...
pla ; Get multiplier
sta mlier ; ...
pla ; ...
sta mlier+1 ; ...
pla ;[87] ...
sta mlier+2 ;[87] ...
pla ; Get multiplicand
sta mcand ; ...
pla ; ...
sta mcand+1 ; ...
pla ;[87] ...
sta mcand+2 ;[87] ...
lda #$00 ; Zero
sta hiprod ; high word of product
sta hiprod+1 ; ...
sta hiprod+2 ;[87] ...
;[87] ldx #17 ; Number of bits in multiplier plus 1, the
ldx #25 ;[87] Number of bits in multiplier plus 1, the
; extra loop is to move the last carry
; into the product.
clc ; Clear carry for first timehrough the loop
;[87]mullp: ror hiprod+1 ; Shift the whole thing down
mullp: ror hiprod+2 ;[87]
ror hiprod+1 ;[87] Shift the whole thing down
ror hiprod ; ...
ror mlier+2 ;[87] ...
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
lda mcand+2 ;[87] ...
adc hiprod+2 ;[87] ...
sta hiprod+2 ;[87] Carry = overflow from add
deccnt: dex ; ...
bne mullp ; Continue until done
lda mlier+2 ;[87] Get low word of product and push it
pha ;[87] onto the stack
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
;[87]mcand: .blkb 2 ; Multiplicand
;[87]mlier: .blkb 2 ; Multiplier and low word of product
;[87]hiprod: .blkb 2 ; High word of product
mcand: .blkb 3 ;[87] Multiplicand
mlier: .blkb 3 ;[87] Multiplier and low word of product
hiprod: .blkb 3 ;[87] High word of product
rtaddr: .blkb 2 ; Save area for return address
;[87].SBTBL 16 bit unsigned division ;[75]
.SBTBL 24 bit unsigned division ;[87]
; entry top of stack ;[75]
;
; low rtn ;[75]
; high rtn ;[75]
; low divisor ;[75]
; divisor ;[87]
; high divisor - most significant byte ;[75]
; low dividend ;[75]
; dividend ;[87]
; high dividend - most significant byte ;[75]
; exit top of stack ;[75]
;
; low byte of quotient ;[75]
; quotient ;[87]
; high " ;[75]
; low byte of remainder ;[75]
; remainder ;[87]
; high " ;[75]
;
; if no errors then carry is clear (0) ;[75]
; REGISTERS A X & Y USED AND NOT RESTORED ;[75]
;[87]dv16 pla ;[75]
dv24 pla ;[87]
sta retadr ;[75] save the return
pla ;[75]
sta retadr+1 ;[75]
pla ;[75]
sta dvsor ;[75] get the divisor
pla ;[75]
sta dvsor+1 ;[75]
pla ;[87]
sta dvsor+2 ;[87]
pla ;[75]
sta dvend ;[75] get the dividend
pla ;[75]
sta dvend+1 ;[75]
pla ;[87]
sta dvend+2 ;[87]
jsr udiv ;[75] now for the divide
bcc divok ;[75] good
lda #0 ;[75] set q & rem to 0
sta dvend ;[75]
sta dvend+1 ;[75]
sta dvend+2 ;[75]
sta dvend+3 ;[75]
sta dvend+4 ;[87]
sta dvend+5 ;[87]
;[87]divok lda dvend+3 ;[75] first the remainder
divok lda dvend+5 ;[87] first the remainder
pha ;[87]
lda dvend+4 ;[87]
pha ;[87]
lda dvend+3 ;[75] now the q
pha ;[75]
lda dvend+2 ;[75] now the q
pha ;[75]
lda dvend+1 ;[75] now the q
pha ;[75]
lda dvend ;[75]
pha ;[75]
lda retadr+1 ;[75] now the return address
pha ;[75]
lda retadr ;[75]
pha ;[75]
rts ;[75] thats all
;********************************* ;[75]
; udiv ;[75]
;[87]; divide a 16 bit div by a 16 bit divisor ;[75]
; divide a 24 bit div by a 24 bit divisor ;[87]
;entry dvend = dividend ;[75]
; dvsor = divisor ;[75]
;exit dvend = quotient ;[75]
;[87]; dvend+2 = remainder ;[75]
; dvend+3 = remainder ;[87]
;********************************* ;[75]
udiv ;[75]
lda #0 ;[75] 0 upper word of dividend
;[87] sta dvend+2 ;[75]
sta dvend+3 ;[75]
sta dvend+4 ;[87]
sta dvend+5 ;[87] called dividend[1] later
lda dvsor ;[75] check for div by 0
ora dvsor+1 ;[75]
ora dvsor+2 ;[87]
bne okudiv ;[75] it not 0
sec ;[75] error
rts ;[75] tell the bad news
;[87]okudiv ldx #16 ;[75] loop thru 16 bits
okudiv ldx #24 ;[87] loop thru 24 bits
stx savex ;[87]
divlp ;[75]
rol dvend ;[75] shift the carry into bit 0 of dividend
rol dvend+1 ;[75] which will be the q
rol dvend+2 ;[75] shift dividend
rol dvend+3 ;[75] also
rol dvend+4 ;[87]
rol dvend+5 ;[87]
; check if dividend[1] is less than divisor ;[75]
chklt ;[75]
sec ;[75]
;[87] lda dvend+2 ;[75] first the low byte
lda dvend+3 ;[87] first the low byte
sbc dvsor ;[75]
tay ;[75] save the low byte in y
;[87] lda dvend+3 ;[75]
lda dvend+4 ;[87]
sbc dvsor+1 ;[75] now the high bytes
tax ;[87] hold it here
lda dvend+5 ;[87]
sbc dvsor+2 ;[87]
bcc divcnt ;[75] brandch if dividend < divisor & carry
;[87] sty dvend+2 ;[75] else div[1] = div[1] - divisor
sty dvend+3 ;[87] else div[1] = div[1] - divisor
stx dvend+4 ;[87]
;[87] sta dvend+3 ;[75]
sta dvend+5 ;[87]
;[87]divcnt dex ;[75] next bit
divcnt dec savex ;[87] next bit
bne divlp ;[75] yes
rol dvend ;[75] no shift in last carry for the q
rol dvend+1 ;[75]
rol dvend+2 ;[87]
clc ;[75] no errors so tattle
rts ;[75]
dvsor = mcand ;[75]
dvend = mlier ;[75] dividend[0] & q
;dvend+2 ;[75] div[1] & remainder
;[87]
;[87] binary to ascii
;[87]
;[87] convert a 24 bit unsigned binary number to ascii
;[87]
;[87] ENTRY: top of stack
;[87] lsb of jsr address
;[87] msb "
;[87] lsb of output address
;[87] msb "
;[87] lsb value to convert
;[87] 2nd "
;[87] msb "
;[87]
;[87] EXIT: 1st byte of output is binary length
;[87] followed by the ascii chs
;[87]
;[87] REGISTERS USER: all
;[87]
bn2asc pla ;[87] save parameters
sta rtaddr ;[87]
pla ;[87]
sta rtaddr+1 ;[87]
pla ;[87]
sta a4l ;[87] page 0 a4 will have the address of output
pla ;[87]
sta a4h ;[87]
pla ;[87]
sta value ;[87] this is the binary to convert
pla ;[87]
sta value+1 ;[87]
pla ;[87]
sta value+2 ;[87]
lda #0 ;[87] set length to 0
tay ;[87]
sta (a4l),y ;[87]
cnvert lda #0 ;[87] convert value to ascii chs
sta mod10 ;[87] value -> value/10
sta mod10+1 ;[87] mod10 -> value mod 10
sta mod10+2 ;[87]
ldx #24 ;[87] 3 bytes of them
clc ;[87]
dvloop rol value ;[87] carry into dividend bit 0
rol value+1 ;[87]
rol value+2 ;[87]
rol mod10 ;[87]
rol mod10+1 ;[87]
rol mod10+2 ;[87]
sec ;[87] now dividend - divisor
lda mod10 ;[87] lsb
sbc #10 ;[87]
tay ;[87] save this for later
lda mod10+1 ;[87]
sbc #0 ;[87] for the carry
sta savea ;[87] save it here
lda mod10+2 ;[87]
sbc #0 ;[87] finally
bcc bn2dcn ;[87] br if dividend < divisor
sty mod10 ;[87] no got to try agn
sta mod10+2 ;[87]
lda savea ;[87]
sta mod10+1 ;[87]
bn2dcn dex ;[87]
bne dvloop ;[87] all done no
rol value ;[87]
rol value+1 ;[87]
rol value+2 ;[87]
conch lda mod10 ;[87] add this to output
ora #'0 ;[87] bin to ascii
jsr concat ;[87]
lda value ;[87]
ora value+1 ;[87] any left?
ora value+2 ;[87]
bne cnvert ;[87] yes, its a long loop :-)
lda rtaddr+1 ;[87] return
pha ;[87]
lda rtaddr ;[87]
pha ;[87]
rts ;[87] thats all folks
concat pha ;[87] add this ch to the front of output
ldy #0 ;[87] shift chs right one
lda (a4l),y ;[87] this is the length
tay ;[87]
beq exitmr ;[87] first time? yes
mvelp lda (a4l),y ;[87] ascii ch
iny ;[87]
sta (a4l),y ;[87] shift one
dey ;[87]
dey ;[87]
bne mvelp ;[87] shift another ch
exitmr pla ;[87] now for the original ch
ldy #1 ;[87]
sta (a4l),y ;[87]
dey ;[87]
lda (a4l),y ;[87] length
clc ;[87] bump
adc #1 ;[87]
sta (a4l),y ;[87]
rts ;[87] bye
value = mcand ;[87] need 6 in a row
mod10 = mcand+3 ;[87]
convuc and #$7f ; first make it ascii
cmp #'a ; Is character a lower-case alpha?
bcc convrt ; No, don't capitalize
cmp #<'z+1> ; ...
bcs convrt ; ...
and #$5f ; Capitalize
convrt rts
.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
;[83] stx savex ;
;[83] sty savey ;
pla ; Get Low order byte of return address
;[83] tax ; Hold it
;[83] pla ; Get High order byte
;[83] tay ; Hold that
;[83] txa ; Get Low order byte
clc ; Clear the carry flag
adc #$04 ; Add 4 to the address
;[83] bcc rskp2 ; No carry
;[83] iny ; Increment the high order byte
sta saddr ; Store L.O. byte
pla ;[83] high order return address
adc #0 ;[83] just involve the carry
sta saddr+1 ; Store H.O. byte
lda savea ; Restore the registers
;[83] ldx savex ;
;[83] ldy savey ;
jmp (saddr) ; Jump at the new address
.SBTTL Setbrk and Rstbrk
;
; These routines are called from the user program to set or reset
; break characters to be used by Cmunqs. The byte to set or reset
; is located in the Accumulator. Rstbrk has the option to reset
; the entire break-word. This occurs if the H.O. bit of AC is on.
;
sbrk.0: and #$7f ;[13] We don't want the H.O. bit
ldy #$00 ;[13] Set up Y to index the byte we want
sbrkts: cmp #$08 ;[13] Is the offset > 8
bmi sbrkfw ;[13] No, we are at the right byte now
sec ;[13] Yes, adjust it down again
sbc #$08 ;[13] ...
iny ;[13] Advance index
jmp sbrkts ;[13] and try again
sbrkfw: tax ;[13] This is the remaining offset
lda #$80 ;[13] Start with H.O. bit on
sbrklp: cpx #$00 ;[13] Is it necessary to shift down?
beq sbrkfb ;[13] No, we are done
dex ;[13] Yes, adjust offset
lsr a ;[13] Shift bit down once
jmp sbrklp ;[13] Go back and try again
sbrkfb: ora brkwrd,y ;[13] We found the bit, use the byte offset
sta brkwrd,y ;[13] from above, set the bit and resave
rts ;[13] Return
rbrk.0: asl a ;[13] Check H.O. bit
bcs rbrkal ;[13] If that was on, Zero entire brkwrd
lsr a ;[13] Else shift back (H.O. bit is zeroed)
rbrkts: cmp #$08 ;[13] Are we in the right word?
bmi rbrkfw ;[13] Yes, go figure the rest of the offset
sec ;[13] No, Adjust the offset down
sbc #$08 ;[13] ...
iny ;[13] and the index up
jmp rbrkts ;[13] Try again
rbrkfw: tax ;[13] Stuff the remaining offset in X
lda #$7f ;[13] Start with H.O. bit off
rbrklp: cpx #$00 ;[13] Do we need to offset some more?
beq rbrkfb ;[13] No, we have the correct bit
dex ;[13] Yes, decrement the offset
sec ;[13] Make sure carry is on
ror a ;[13] and rotate a 1 bit into mask
jmp rbrklp ;[13] Go back and try again
rbrkfb: and brkwrd,y ;[13] We found the bit, now shut it off
sta brkwrd,y ;[13] ...
rts ;[13] and return
rbrkal: lda #$00 ;[13] Go stuff zeros in the entire word
ldy #$00 ;[13] ...
rbrksz: sta brkwrd,y ;[13] Stuff the zero
iny ;[13] Up the index once
cpy #$10 ;[13] Are we done?
bmi rbrksz ;[13] Not yet
rts ;[13] Yes, return
.SBTTL Chkbrk
;
; Chkbrk - This routine looks for the flag in the break word
; which represents the character passed to it. If this bit is
; on, it is a break character and the routine will simply
; return. If it is not a break character, the routine skips..
;
chkbrk: sta savea ;[13] Save byte to be checked
and #$7f ;[13] Shut H.O. bit
ldy #$00 ;[13] Zero this index
cbrkts: cmp #$08 ;[13] Are we at the right word?
bmi cbrkfw ;[13] Yes, go calculate bit position
sec ;[13] No, adjust offset down
sbc #$08 ;[13] ...
iny ;[13] Increment the index
jmp cbrkts ;[13] Go back and test again
cbrkfw: tax ;[13] Stuff the remaining offset in X
lda #$80 ;[13] Set H.O. bit on for testing
cbrklp: cpx #$00 ;[13] Are we in position yet?
beq cbrkfb ;[13] Yes, go test the bit
dex ;[13] No, decrement the offset
lsr a ;[13] and adjust the bit position
jmp cbrklp ;[13] Go and try again
cbrkfb: and brkwrd,y ;[13] See if the bit is on
bne cbrkbc ;[13] It is a break character
lda savea ;[13] Restore the character
jmp rskp ;[13] Not a break character, skip return
cbrkbc: lda savea ;[13] Restore the character
rts ;[13] Return
.SBTTL Cmehlp - Do extra help on Question-mark prompting
;
; Cmehlp - This routine uses a string of commands passed to it
; in order to display alternate valid parse types to the user.
;
; Input: Cmehpt- Pointer to valid parse types (end in 00)
;
; Output: Display on screen, alternate parse types
;
; Registers destroyed: A,X,Y
;
cmehlp: lda cmstat ;[13] We are going to need this so
pha ;[13] save it across the call
ldy #$00 ;[13] Zero out the help index
sty cmehix ;[13] ...
cmehl1: ldy cmehix ;[13] Load the extra help index
lda (cmehpt),y ;[13] Fetch next type
sta cmstat ;[13] Store it here
inc cmehix ;[13] Increase the index by one
cmp #$00 ;[13] Is the type null?
bne cmeh0 ;[13] No, continue
jmp cmehrt ;[13] Yes, terminate
cmeh0: cmp #cmtok+1 ;[13] If the type is out of range, leave
bmi cmeh1 ;[13] ...
jmp cmehrt ;[13] ...
cmeh1: pha ;[13] Save the type across the call
ldx #cmors\ ;[13] Set up address of 'OR ' string
ldy #cmors^ ;[13] ...
jsr prstr ;[13] and print it
pla ;[13] Restore AC
cmp #cmkey ;[13] Compare with keyword
bne cmeh2 ;[13] No, try next type
cmeh10: tax ;[13] Hold type in X register
lda cmsptr ;[13] Save these parms so they can be restored
pha ;[13] ...
lda cmsptr+1 ;[13] ...
pha ;[13] ...
lda cm.ptr ;[13] Copy the pointer to the saved pointer
sta cmsptr ;[13] so the keyword print routine prints
pha ;[13] the entire table. Also, save it on
lda cm.ptr+1 ;[13] the stack so it can be restored later
sta cmsptr+1 ;[13] ...
pha ;[13] ...
lda cmptab ;[13] Save the table address also
pha ;[13] ...
lda cmptab+1 ;[13] ...
pha ;[13] ...
txa ;[13] Restore type
cmp #cmkey ;[13] Keyword?
bne cmeh11 ;[13] No, it must be a switch table
ldx #cmin01\ ;[13] Set up address of message
ldy #cmin01^ ;[13] ...
jmp cmeh12 ;[13] Go print the string
cmeh11: ldx #cmin02\ ;[13] Set up address of 'switch' string
ldy #cmin02^ ;[13] ...
cmeh12: jsr prstr ;[13] Print the message
ldy cmehix ;[13] Get the index into help string
lda (cmehpt),y ;[13] Fetch L.O. byte of table address
sta cmptab ;[13] Set that up for Cmktp
iny ;[13] Increment the index
lda (cmehpt),y ;[13] Get H.O. byte
sta cmptab+1 ;[13] Set it up for Cmktp
iny ;[13] Advance the index
sty cmehix ;[13] and store it
jsr cmktp ;[13] Print the keyword table
pla ;[13] Now restore all the stuff we saved before
sta cmptab+1 ;[13] ...
pla ;[13] ...
sta cmptab ;[13] ...
pla ;[13] ...
sta cm.ptr+1 ;[13] ...
pla ;[13] ...
sta cm.ptr ;[13] ...
pla ;[13] ...
sta cmsptr+1 ;[13] ...
pla ;[13] ...
sta cmsptr ;[13] ...
jmp cmehl1 ;[13] See if there is more to do
cmeh2: cmp #cmswi ;[13] Type is switch?
bne cmeh3 ;[13] No, continue
jmp cmeh10 ;[13] We can treat this just like a keyword
cmeh3: cmp #cmifi ;[13] Input file?
bne cmeh4 ;[13] No, go on
ldx #cmin03\ ;[13] Set up the message address
ldy #cmin03^ ;[13] ...
jmp cmehps ;[13] Go print it
cmeh4: cmp #cmofi ;[13] Output file?
bne cmeh5 ;[13] Nope, try again
ldx #cmin04\ ;[13] Set up message address
ldy #cmin04^ ;[13] ...
jmp cmehps ;[13] Go print the string
cmeh5: cmp #cmcfm ;[13] Confirm?
bne cmeh6 ;[13] No
ldx #cmin00\ ;[13] Set up address
ldy #cmin00^ ;[13] ...
jmp cmehps ;[13] Print the string
cmeh6: cmp #cmtxt ;[13] Unquoted string?
bne cmeh7 ;[13] No, try next one
ldx #cmin06\ ;[13] Set up address
ldy #cmin06^ ;[13] ...
jmp cmehps ;[13] Print
cmeh7: cmp #cmnum ;[13] Integer?
bne cmeh8 ;[13] Try again
ldx #cmin05\ ;[13] Set up message
ldy #cmin05^ ;[13] ...
jsr prstr ;[13] Print it
ldy cmehix ;[13] Get index
inc cmehix ;[13] Advance index
lda (cmehpt),y ;[13] Get base of integer
cmp #$0a ;[13] Is it greater than decimal 10?
bmi cmeh71 ;[13] No, just print the L.O. digit
lda #$b1 ;[13] Print the H.O. digit as a 1
jsr cout ;[13] Print the '1'
ldy cmehix ;[13] Load index
dey ;[13] Point back to last byte
lda (cmehpt),y ;[13] Get the base back
sec ;[13] Set the carry flag for subtraction
sbc #$0a ;[13] Subtract off decimal 10
cmeh71: clc ;[13] Clear carry for addition
adc #$b0 ;[13] Make it printable
;[79] jsr cout ;[13] Print the digit
;[79] jsr prcrlf ;[13] Print a crelf
jsr coutl ;[79] print ch & crlf
jsr prbyte ;[13] Print the byte
jmp cmehl1 ;[13] Go back for more
cmeh8: ldx #cmin07\ ;[13] Assume it's a token
ldy #cmin07^ ;[13] ...
;[79]cmehps: jsr prstr ;[13] Print string
;[79] jsr prcrlf ;[13] Print a crelf
cmehps jsr prstrl ;[79]
jmp cmehl1 ;[13] Go back
cmehrt: pla ;[13] Restore
sta cmstat ;[13] current parse type
rts
.SBTTL Cmcpdf - Copy a default string into the command buffer
;
; Cmcpdf - This routine copies a default for a field
; into the command buffer andreparses the string.
;
; Input: Cmdptr- Pointer to default field value (asciz)
;
; Output:
;
; Registers destroyed: A,X,Y
;
cmcpdf: sec ;[13] Reset the buffer pointer
lda cm.bfp ;[13] ...
sbc #$01 ;[13] ...
sta cm.bfp ;[13] ...
bcs cmcpst ;[13] If carry set, don't adjust H.O. byte
dec cm.bfp+1 ;[13] ...
cmcpst: dec cmccnt ;[13] Adjust the character count
ldy #$00 ;[13] Zero the index
cmcplp: lda (cmdptr),y ;[13] Get byte
beq cmcpdn ;[13] Copy finished, leave
ldx cmccnt ;[23] Check character count
inx ;[23] If it is just short of wrapping
bne cmcpl1 ;[23] then we are overflowing buffer
jsr bell ;[23] If that is the case, tell the user
dec cmccnt ;[23] Make sure it doesn't happen again
jmp prserr ;[23] for same string.
cmcpl1: ora #$80 ;[13] Be consistent, make sure H.O. bit is on
sta (cm.bfp),y ;[13] Stuff it in the buffer
inc cmccnt ;[13] Adjust character count
iny ;[13] Up the buffer index
jmp cmcplp ;[13] Go to top of loop
cmcpdn: lda #hspace ;[13] Get a space
sta (cm.bfp),y ;[13] and place it in buffer after keyword
iny ;[13] Increment the buffer index
lda #nul ;[13] Get a null
sta (cm.bfp),y ;[13] and stuff that at the end of buffer
clc ;[13] Now recompute the end of usable buffer
tya ;[13] Get the number of chars added
adc cm.bfp ;[13] Add that to the buffer pointer
sta cm.bfp ;[13] ...
lda #$00 ;[13] ...
adc cm.bfp+1 ;[13] ...
sta cm.bfp+1 ;[13] ...
lda #$00 ;[13] Reset the action flag
sta cmaflg ;[13] ...
sec ;[13] Now adjust the command pointer to the
lda cm.ptr ;[13] beginning of the copied field
sbc #$01 ;[13] ...
tax ;[13] Set it up in X and Y so we can call Prstr
lda cm.ptr+1 ;[13] ...
sbc #$00 ;[13] ...
tay ;[13] ...
jsr prstr ;[13] Print the added field
jmp repars ;[13] Now go reparse the whole command
.list ;[84]
.SBTTL Comnd Jsys messages and table storage
.nlst ;[57] save a tree
cmer00: .byte hcr,hlf
nasc <?PROGRAM ERROR: INVALID COMND CALL> 1
cmer01: .byte hcr,hlf
nasc <?AMBIGUOUS> 1
cmer02: .byte hcr,hlf
nasc <?ILLEGAL INPUT FILE SPEC> 1
cmer03: .byte hcr,hlf
nasc <?NO KEYWORDS MATCH THIS PREFIX> 1
cmer04: .byte hcr,hlf
nasc <?NO SWITCHES MATCH THIS PREFIX> 1
cmer05: .byte hcr,hlf
nasc <?BAD CHARACTER IN INTEGER NUMBER> 1
cmer06: .byte hcr,hlf
nasc <?BASE OF INTEGER OUT OF RANGE> 1
cmer07: .byte hcr,hlf
nasc <?OVERFLOW WHILE READING INTEGER NUMBER> 1
cmin00: nasc < CONFIRM WITH CARRIAGE RETURN> 1
cmin01: nasc < KEYWORD, ONE OF THE FOLLOWING:> 1
cmin02: nasc < SWITCH, ONE OF THE FOLLOWING:> 1
cmin03: nasc < INPUT FILE SPEC> 1
cmin04: nasc < OUTPUT FILE SPEC> 1
cmin05: nasc < INTEGER NUMBER IN BASE > 1
cmin06: nasc < UNQUOTED TEXT STRING > 1
cmin07: nasc < SINGLE CHARACTER TOKEN > 1
cmors: nasc < OR > 1 ;[13] 'OR ' string for extra help
.list ;[57]
.SBTTL Kermit defaults for operational parameters
;
; The following are the defaults which this Kermit uses for
; the protocol.
;
dquote = '# ; The quote character
dpakln = $5e ;[4] The packet length
dpadch = nul ; The padding character
dpadln = 0 ; The padding length
dmaxtr = $14 ; The maximum number of tries
debq = '& ; The eight-bit-quote character
dtime = 15 ;[5] The default time-out amount
deol = cr ; The end-of-line character
.SBTTL Kermit data
;
; The following is data storage used by Kermit
;
mxpack = dpakln ; Maximum packet size
mxfnl = $1e ; Maximum file-name length
eof = $01 ; This is the value for End-of-file
buflen = $ff ; Buffer length for received data
kerbf1 = $1a ; This always points to packet buffer
kerbf2 = $1c ; This always points to data buffer
terse = $01 ;[26] Symbol for terse debug mode
verbose = $02 ;[26] Symbol for verbose debug mode
xon = $11 ;[21] Xon for Ibm-mode
;[65]fbsbit = $01 ; Value for SEVEN-BIT FILE-BYTE-SIZE
;[65]fbebit = $00 ; Value for EIGHT-BIT FILE-BYTE-SIZE
nparit = $00 ;[21] Value for PARITY NONE
sparit = $01 ;[21] Value for PARITY SPACE
mparit = $02 ;[21] Value for PARITY MARK
oparit = $03 ;[21] Value for PARITY ODD
eparit = $04 ;[21] Value for PARITY EVEN
eprflg = $40 ;[38] 'Error packet received' flag
errcri = $01 ; Error code - cannot receive init
errcrf = $02 ; Error code - cannot receive file-header
errcrd = $03 ; Error code - cannot receive data
errmrc = $04 ; Error code - maximum retry count exceeded
errbch = $05 ; Error code - bad checksum
errfae = $0a ; Error code - file already exists
emesln = $19 ; Standard error message length
;[64]kerrns = $1f ; Routine name and action string length
kerdel = $15 ; Disk error length
kerems = $19 ; Error message size
kerfts = $0b ; Size of file-type strings (incl. term. nul)
kerdsz = $09 ;[26] Length of debug mode strings
kerpsl = $06 ;[21] Size of parity strings
kbdl = $05 ;[35] Size of keyboard-type strings.
dspl = 13 ;[49] [46] Size of display-type strings.
kerfrm = cminf1 ;[13] 'From string' pointer for Kercpy routine
kerto = cminf2 ;[13] 'To string' pointer for Kercpy routine
.ifeq <ftcom-ftappl>
invflg = $32 ;[34] Location used to indicate display mode.
nrmdsp = $ff ;[34] Mode is normal.
invdsp = $3f ;[34] Mode is inverse.
flsdsp = $7f ;[34] Mode is flashing.
cswl = $36 ; Character out routine pointer (z-pag)
cswh = $37 ; ...
kswl = $38 ; Keyboard character in routine pointer (z-pag)
kswh = $39 ; ...
kbap2p = $00 ;[35] Keyboard is apple 2/2+ type
kbap2e = $01 ;[35] Keyboard is apple 2e type
kmnorm = $00 ;[35] Keyboard mode is normal
kmpref = $01 ;[35] Keyboard mode is prefixed
kmlit = $02 ;[35] Keyboard mode is literal.
ds40up = $00 ;[46] Display is 40 col, uppercase only (2/2+)
ds40mx = $01 ;[46] Display is 40 col, full set (2e/2c)
ds80mx = $80 ;[49] Display is 80 col, full set (2e/2c)
errptr = $9d5a ; DOS error handler vector
basws = $9d5e ; DOS basic warmstart vector
.endc
;[75]pdbuf: .blkb mxpack-2 ;[20] Packet buffer
;[75]pdlen: .byte ; Common area to place data length
;[75]ptype: .byte ; Common area to place current packet type
;[75]pnum: .byte ; Common area to put packet number received
;[75]plnbuf: .blkb $100 ;[25] Port line buffer
;[75]pdtend: .byte ; End of plnbuf pointer
;[75]pdtind: .byte ; Index for plnbuf
rstat: .byte ; Return status
kerrta: .word ; Save area for return address
; ******************** begin area for install pgm, no adds or deletes pls
kbd1: .byte $00 ;[35] Keyboard-type string index.
dsp1: .byte $00 ;[46] Display-type string index.
.ifeq termnl ;[63]
prmt: nasc <TERMINAL > 0 ;[63] Prompting text
.endc ;[63]
.ifne termnl ;[63]
prmt: nasc <KERMIT-65> 0 ;[13] Prompting text
.endc ;[63]
.byte $80!'> ;[13] Kludge to add '>' to prompt
.byte $00 ;[13] End of kludge
lprmt = .-prmt ;[13] Length of prompting text
escp: .byte ; Character for escape from connection
;[65]fbsize: .byte fbsbit ;[36] File-byte-size (Default = 7-bit)
filmod: .byte ; Current file type
;ascii .byte ;[82] ascii 7bit text files for prodos text
prtcl .byte 0 ;[83] protocol
sfxmd = 128 ;[83] size of xmodem data
usehdr: .byte off ;[12] Where to get filename (on=file-head)
lecho: .byte off ;[12] Local-echo switch
;ibmmod: .byte off ;[68][12] Ibm-mode switch
;[76]vtmod: .byte off ;[51][12] VT-52 Emulation mode switch
vtmod: .byte 1 ;[76] terminal Emulation switch - start with none
timer .byte on ;[64] receive timeout on/off
.ifeq termnl ;[63]
termct .byte 0 ;[63] count of characters in term init string
;[82] mcp string -> ^_^_^_^_^_s{S/R}name,ascii chs of size,{t/b/a/i}
;[82] send/recfile name,count,file type
termst .byte $1f,$1f,$1f,$1f,$1f,$73 ;[63] (5)us,s - term init string
lterms = .-termst ;[63] length of term init string
termco .byte "solid" ;[63] ack for mcp pgm
.byte cr ;[63] terminate with carrage return
ltermc = .-termco ;[63] len of above
termsc .byte 0 ;[63]
stoft .byte 't ;[63]
.byte 0 ;[63] text filemode
.byte 'a ;[63]
.byte 2 ;[63] applesoft filemode
.byte 'i ;[63]
.byte 1 ;[63] integer basic filemode
.byte 'b ;[63]
.byte 4 ;[63] binary filemode
etoft ;[63]
.endc ;[63]
twrk1 .blkb 3 ;[64] working space for fuzzy timer
lpcycl .word ;[64] getc cycles to convert to rtime in sec
cv2lp = 50 ;[64] convert seconds to loops in getc
kbdtyp: .byte kbap2p ;[35] Keyboard type 2/2+,2e,etc
kbmode: .byte kmnorm ;[35] Mode for keyboard input
kbcase: .byte off ;[35] Default case of keyboard
dsptyp: .byte ds40up ;[46] Display type default.
dsp2: .byte 3 ;[49] Display 80 col default slot.
; ******************** end area for install pgm, no adds or deletes pls
; ************** dont add anything new above this ***********************
swapf .byte 0 ;[73] swap bs & del keypress flag
.ifeq funkey ;[73]
usfkey .byte ;[73] should we look for function keys
.endc ;[73]
prnfg: .byte ;[55] Printer flag off=0
prnsl: .byte ;[55] Printer slot
logfg: .byte ;[56] logging flag $80=yes,0=no
xonfg .byte ;[57] flow control flag
flowdl .byte $0 ;[57] delay for xon/xoff to take effect
;[74]flowlp .byte ;[57] times to wait 1 ms
;[76]confg .byte ;[57] are we talking to a remote ? yes non 0
confg .byte ;[76] flowfg when not connected
softvc = $3f2 ;[57] soft vector entry when reset is pushed
warmst = $fb6f ;[57] calculate new power up byte
dosflg .byte ;[59] which dos 0=3.3 , <>0 prodos
errcnt .word ;[59] retry count for file xfer
rplocv = 0 ;[59] line for recv msg
pclocv = 10 ;[87] starting loc of % of xfer-0 is first
lensh = 22 ;[87] length of show line to variable print pos
rploch = 35 ;[66][59] starting ch in rplocv line
ellocv = 1 ;[75] line for error message
splocv = 2 ;[59] line for send msg
erlocv = 3 ;[59] line for error count msg
dblocv = 4 ;[59] line for debug msg
dbloch = 0 ;[59] starting ch in dblocv line
fnflag .byte 0 ;[66] flag to write file name when file xfering
getfg .byte 0 ;[75] get file flag
parity: .byte ; Parity setting
delay: .byte ; Amount of delay before first send
filwar: .byte on ;[51][12] File-warning switch
debug: .byte off ;[12] Debug switch
;[66]ebqmod: .byte off ;[12] Eight-bit-quoting mode
ebqmod: .byte on ;[66][12] Eight-bit-quoting mode
datind: .byte ; Data index into packet buffer
chebo: .byte ; Switch to tell if 8th-bit was on
getfln .byte 0 ;[86] get file name length
vtcnlm .byte 0 ;[86] new line mode vt100
itse80 .word 0 ;[86] its //e or better in 80 col screen
itsefl .byte 1 ;[86] times we have inverted cursor
;exqufl .byte 0 ;[87] exit quit flag
sch .byte ;[87] hch when screen saved
scv .byte 0 ;[87] hcv when screen saved
fgetgn .byte 0 ;[87] fget flag for getting file name
lcurfl .word 0 ;[87] length of current file xfer
.byte 0 ;[87] " its 3 bytes long
cvaflw .byte ;[87] length of current print ascii field
flatr .byte ;[87] file attribute flag on = yes
csfg .byte 1 ;[87] clear screen flag is on
vtcorm .byte 0 ;[78] org mode 0=abs else relative to region
vtcsgr .byte $e ;[76] vt100 special graphics rendition
vtcmod .byte 0 ;[76] vt100 modes flag
vtcscs .byte 0 ;[76] vt100 g1 special ch sset
vtcso .byte 0 ;[76] are we using vtcscs?
nita .byte 0 ;[76] number in tab arrray
;[76]escflg: .byte ; Flag indicating we have seen and escape ($1b)
fillen: .word ;[6] Length of current file left to send
fetfl: .byte ;[6] Flag indicating we need the file length
addlf: .byte ;[8] Add a <lf> flag
lffg .byte 0 ;[74]
dellf: .byte ;[8] Flush a <lf> flag
jtaddr: .word ;[9] Jump table address hold area
hch: .byte ;[13] Hold horizontal cursor position
hcv: .byte ;[13] Hold vertical cursor position
ohcv .byte ;[76] saved hcv
ohch .byte ;[76] saved hch
ovtcsc .byte ;[76] saved which character set
ovtcsg .byte ;[76] saved graphics rendition
ovtcso .byte ;[78] saved graphics action
wrapar .byte on ;[76] start in set mode
;owntop .byte 0 ;[76] our wndtop, since pascal keeps changing wndtop
;ownbtm .byte 24 ;[76] our wndbtm "
kerrki .byte 0 ;[78] initializing reading file kermit.ini etc
kersft .byte ;[78] initializing save current file type
kpfl .byte ;[80] do we have a keypad?
kpafl .byte ;[80] is the keypad in applications mode?
ckfl .byte ;[80] curson keys application mode ?
match .byte ;[81]Got-a-match flag
wchpat .byte ;[81]What versions of pattern & name being checked?
patl .byte ;[81] pattern
patbuf .blkb mxfnl+1 ;[81] wildcard pattern
fnl = nfcb1 ;[81]Lengths: filename
infind .blkb 1 ;[81]Now in a wildcard search (recursion monitor)
wcpres .blkb 1 ;[81]Wildcard-found-during-parsing flag
wcmult = '* ;[81] multiple-char
wcsing = '= ;[81] single-char
gfcol .byte ;[81] current col
lgfcol .byte ;[81] last non blank col in name
filect .byte ;[81] current matching file in catalog
catlin .byte ;[81] current file in catalog
msgfl .byte ;[81] message file
putcut .byte ;[81] put packet to cout
kwrk01: .byte ; Work area for Kermit
kwrk02: .byte ; Work area for Kermit
kertpc: .byte ;[21] Hold area for parity check
ksavea: .byte ;[12] Save area for accumulator
ksavex: .byte ;[12] Save area for X reg
ksavey: .byte ;[12] Save area for Y reg
kerchr: .byte ; Current character read off port
kermbs: .word ; Base address of message table
;[75]kerhcs: .word ; Hold area for char out routine address
;[75]kerhks: .word ; Hold area for input routine address
hsoftv .word ;[75] hold area for original soft vector
;[84]herrpt: .word ; Hold area for DOS error routine vector
;[84]hbasws: .word ; Hold area for DOS basic warmstart vector
;[83]debchk: .byte ; Checksum for debug routine
debinx: .byte ; Debug routine action index
fld: .byte ; State of receive in rpak routine
retadr: .word ; Hold area for return address
n: .byte ; Message #
numtry: .byte ; Number of tries for this packet
oldtry: .byte ; Number of tries for previous packet
maxtry: .byte dmaxtr ;[12] Maximum tries allowed for a packet
state: .byte ; Current state of system
local: .byte ; Local/Remote switch
size: .byte ; Size of present data
chksum: .byte ; Checksum for packet
rtot: .word ; Total number of characters received
.byte ;[87] need 3 bytes
stot: .word ; Total number of characters sent
.byte ;[87] need 3 bytes
rchr: .word ; Number characters received, current file
.byte ;[84] need 3 bytes for size
schr: .word ; Number of characters sent, current file
.byte ;[84] need 3 bytes for size
rovr: .word ; Number of overhead characters on receive
sovr: .word ; Number of overhead characters on send
tpak: .word ;[16] Number of packets for this transfer
eofinp: .byte ; End-of-file (no characters left to send)
eodind: .byte ;[6] End-of-data reached on disk
errcod: .byte ; Error indicator
;[87]errrkm: .blkb mxpack-2 ;[38] Error message from remote Kermit
errrkm: = getln ;[87] Error message from remote Kermit
kerosp: .byte ; Save area for stack pointer
oldch: .byte ;[31] Save loc for cursor address x coord.
curchr: .byte ;[31] True value for char under cursor
;
; These fields are set parameters and should be kept in this
; order to insure integrity when setting and showing values
;
srind: .byte ; Switch to indicate which parm to print
ebq: .byte debq ; Eight-bit quote character (rec. and send)
.byte debq ; ...
pad: .byte dpadln ; Number of padding characters (rec. and send)
.byte dpadln ; ...
padch: .byte dpadch ; Padding character (receive and send)
.byte dpadch ; ...
eol: .byte deol ; End-of-line character (recevie and send)
.byte deol ; ...
;[75]psiz: .byte dpakln ; Packet size (receive and send)
psiz: .byte maxxdl ;[75] Packet size (receive and send)
.byte dpakln ; ...
time: .byte dtime ;[5] Time-out interval (receive and send)
.byte dtime ;[5] ...
; .word $0000 ;[5] Time out interval (receive and send)
quote: .byte dquote ; Quote character (receive and send)
.byte dquote ; ...
sop .byte soh ;[82] start of packet
.byte soh ;[82]
xcrlf .byte on ;[84] should we xlate cr<->cr,lf for rec
.byte on ;[84] for send
;
; Some definitions to make life easier when referencing the above
; fields.
;
rebq = ebq ; Receive eight-bit-quote char
sebq = ebq+1 ; Send eight-bit-quote char
rpad = pad ; Receive padding amount
spad = pad+1 ; Send padding amount
rpadch = padch ; Receive padding character
spadch = padch+1 ; Send padding character
reol = eol ; Receive end-of-line character
seol = eol+1 ; Send end-of-line character
rpsiz = psiz ; Receive packet length
spsiz = psiz+1 ; Send packet length
rtime = time ; Receive time out interval
stime = time+1 ; Send time out interval
rquote = quote ; Receive quote character
squote = quote+1 ; Send quote character
;[35] Table for prefixed conversions by CHRCON.
chrtab: .byte '< ;[35] replace <
.byte '{ ;[35] with left curly brace.
.byte '. ;[35]
.byte '| ;[35] vertical bar.
.byte '> ;[35]
.byte '} ;[35] right curly brace.
.byte $27 ;[35]
.byte $40 ;[35] accent grave
.byte ') ;[35]
.byte '] ;[35] right square bracket
.byte '( ;[35]
.byte '[ ;[35] left square bracket
.byte '/ ;[35]
.byte '\ ;[35] backslash
.byte '- ;[35]
.byte '_ ;[35] underline
.byte '^ ;[35]
.byte '~ ;[35] tilde
.byte $ff ;[35] end of table.
.ifeq <ftcom-ftappl>
.SBTTL Kermit - Apple DOS and File Manager support
;
; The following definitions and storage will be used when setting
; up and executing calls to the File manager in DOS.
;
kdvol = $aa66 ;[40] Keyboard or default volume
kddisk = $aa68 ;[40] Keyboard or default disk drive
kdslot = $aa6a ;[40] Keyboard or default slot
primfn = $aa75 ; Filename buffers
scndfn = $aa93 ; ...
fmpars = $b5bb ; File manager parameter list address
opcod = fmpars ; Operation code
subcod = fmpars+1 ; Operation subcode
reclh = fmpars+2 ; Record length (H.O. byte)
recll = fmpars+3 ; Record length (L.O. byte)
cvol = fmpars+4 ; Current volume
cdisk = fmpars+5 ; Current disk drive
cslot = fmpars+6 ; Current slot
ftype = fmpars+7 ; File type
fnadrl = fmpars+8 ; File name address (L.O.)
fnadrh = fmpars+9 ; File name address (H.O.)
fmrcod = fmpars+10 ; File manager return code
fmwadl = fmpars+12 ; File manager work area address (L.O.)
fmwadh = fmpars+13 ; File manager work area address (H.O.)
tslbfl = fmpars+14 ; Track/sector list address (L.O.)
tslbfh = fmpars+15 ; Track/sector list address (H.O.)
dsbufl = fmpars+16 ; Data sector buffer address (L.O.)
dsbufh = fmpars+17 ; Data sector buffer address (H.O.)
rnumh = fmpars+2 ; Record number (H.O.)
rnuml = fmpars+3 ; Record number (L.O.)
bytofh = fmpars+4 ; Byte offset in file (H.O.)
bytofl = fmpars+5 ; Byte offset in file (L.O.)
rnglnh = fmpars+7 ; Range length (H.O.)
rnglnl = fmpars+6 ; Range length (L.O.)
fncopn = $01 ; Open function code
fncclo = $02 ; Close function code
fncrea = $03 ; Read function code
fncwrt = $04 ; Write function code
fncdel = 5 ;[78] delete file function code
fnccat = 6 ;[78] catalog function code
fnclck = 7 ; lock function code
fnculk = 8 ; unlock function code
fncren = 9 ; rename function code
fncpos = $0a ; Position function code
sfntrn = $02 ; Trnasfer range of bytes sub-code
sfnptr = $04 ; Position then transfer range sub-code
dosopn = $a3d5 ; DOS open routine address
dosonc = $a2a8 ; DOS open address, no type checking
dosclo = $a2ea ; DOS close routine address
dosdel = $a263 ; DOS delete routine address
dosfmn = $ab06 ; DOS file manager entry point
locent = $b1c9 ; DOS locate directory entry routine
doscmi = $aa5f ; DOS comand index - used when calling dosopn
dosfmg = $3d6 ;[78] entry to dos file manager
dosfmi = $3dc ;[78] entry to dos file mgr initialize
getln = $200 ;[78] address of get line buffer
;
; Error codes
;
dsener = $00 ; No error
dsebct = $02 ; Bad call type
dsebst = $03 ; Bad sub-call type
dsewpr = $04 ; Write protected
dseeod = $05 ; End-of-data
dsefnf = $06 ; File not found
dsevmm = $07 ; Volume mismatch
dsedio = $08 ; Disk I/O
dsedfl = $09 ; Disk full
dseflk = $0a ; File locked
kerfcb = $1e ; Pointer to file control block
mxdb = $7f ; Maximum DOS buffer size<limit 255>
mxpfn = 15 ;[59] max prodos file name length
mxppth = 64 ;[59] max prodos path name length
minslt = $01 ;[40] Minimum slot number
maxslt = $07 ;[40] Maximum slot number
mindrv = $01 ;[40] Minimum drive number
maxdrv = $02 ;[40] Maximum drive number
;
; Data area
;
;[78]defslt: .byte $06 ;[40] Default slot for file transfers
;[78]defdrv: .byte $01 ;[40] Default drive for file transfers
;[78]defvol .byte 0 ;[60] default vol for file xfers
defslt: .byte 0 ;[78][40] Default slot for file transfers
defdrv: .byte 0 ;[78][40] Default drive for file transfers
defvol .byte 0 ;[60] default vol for file xfers
servef .byte 0 ;[62] server mode default off (0)
dsbfcc: .byte $00
dsbind: .byte $00 ; DOS buffer index
dsbend: .byte $00 ; Current DOS buffer length (last char pointer)
dosffm: .byte $00 ; 'First file modification done' switch
dosfni: .byte $00 ; Filename index
dosfvn: .byte $00 ; File version number for the alter routine
;[75]nfcb1 .byte ;[59] part 1 of 2
;[75]fcb1: .blkb mxppth ; [59]Fcb for file being transmitted part 2 of 2
;[75] .byte 0 ;[59] terminate string with a null
;[75] .byte 0 ;[59] terminate string with a null
;[75]dosbuf: .blkb $100 ; DOS file buffer
pbasic = $be00 ;[59] basic.system
prodos = $bf00 ;[59] prodos entry
devnum = $bf30 ;[80] last vol number
gfilin = $c4 ;[59] prodos get file info
online = $c5 ;[80] online vols
setpre = $c6 ;[59] prodos set prefix call
getpre = $c7 ;[59] prodos get prefix call
seteof = $d0 ;[59] prodos set end of file
geteof = $d1 ;[87] prodos get end of file
getmk = $cf ;[59] prodos get file mark
wrfil = $cb ;[59] prodos write
prdfil = $ca ;[59] prodos read
peof = $4c ;[59] prodos error end of file
nofile = $46 ;[59] prodos error file not found
opnfl = $c8 ;[59] prodos open file
clofl = $cc ;[59] prodos close file
crefil = $c0 ;[59] prodos create file
pdquit = $65 ;[84] prodos quit
pttxt = 4 ;[59] prodos text type file
ptibas = $fa ;[59] prodos integer basic type file
ptbas = $fc ;[59] prodos basic type file
ptbin = 6 ;[59] prodos binary type file
volbuf = dosbuf ;[87] hope we can use this
pvols .byte 2 ;[87]
.byte 0 ;[87] all the vols
.word volbuf ;[87] need 256 it says
ponline .byte 2 ;[80] get online vol name
pdvnum .byte ;[80] vol #
.word prefix+1 ;[80] where to put name
propen .byte 3 ;[59] prodos open par list
.word nfcb1 ;[59] path
.word buffer ;[59]prodos buffer
refnu .byte ;[59] prodos ref number
prdwr .byte 4 ;[59] prodos read write par list
.byte ;[59] ref number
.word dosbuf ;[59] where were coming/going from/to
.word mxdb ;[59] how many bytes to read/write
pnrdwr .word ;[59] how many actually got read/written
pmark .byte 2 ;[59] prodos mark/eof parameter list
.byte ;[59] ref #
.blkb 3 ;[59] number of bytes in file
pclose .byte 1 ;[59] prodos close par list
.byte ;[59] ref #
create .byte 7 ;[59] -> prodos create parameter list
.word nfcb1 ;[59] pathname
.byte $c3 ;[59] file access
pfilty .byte 0 ;[59] file type
pfilta .word 0 ;[59] aux type
.byte 1 ;[59] storage type
pcrdat ;[87] create date
.word 0 ;[59] create date
pcrtim ;[87] create time
.word 0 ;[59] create time
predel .byte 1 ;[59] -> prodos delete/prefix par list
.word prefix ;[59] pathname
gsinfo .byte 10 ;[59] get/set file info par list
.word nfcb1 ;[59] path
gfilac .byte ;[59] file access
gfilty .byte ;[59] file type
.word ;[59] aux type
.byte ;[59] storage type
.word ;[59] blocks
.word ;[59] change date
.word ;[59] change time:lsb=min,msb=hr
.word ;[59] create date
.word ;[59] create time:lsb=min,msb=hr
brkorg ;[75] break the org here
.=$800 ;[75] use this space for buffer
prdsbl = 1024 ;[75] prodos buffer len
maxxlp = 256 ;[75] max extended packet len
maxxdl = 250 ;[75] max extended data len - 6 already out
buffer .blkb prdsbl ;[75] prodos buffer ******* must start on $x00 *******
;[78] ************* begining of keep following in order
pdbuf .blkb maxxlp ;[75] packet buffer
pdlen .blkb 1 ;[75] packet data length
ptype .blkb 1 ;[75] type of packet
pnum .blkb 1 ;[75] packet number modulo $37
plnbuf .blkb maxxlp ;[75] line buffer
pdtend .blkb 1 ;[75] end pointer
pdtind .blkb 1 ;[75] index into buf
exfg .blkb 1 ;[75] ex len flag
hcrc .blkb 1 ;[75] ex len header crc
exchs .blkb 3 ;[75] 3 chs of the ex header
rpkexx .blkb 1 ;[75]
.blkb $3b ;[78] ******* filler *******
;[78] ************* end of keep above + nfcb1 in order
nfcb1 .blkb 1 ;[59] part 1 of 2
fcb1: .blkb mxppth ; [59]Fcb for file being transmitted part 2 of 2
.blkb 1 ;[59] terminate string with a null
.blkb 1 ;[59] terminate string with a null
chssvd .blkb 17 ;[76] saved chs
dosbuf: .blkb $100 ; DOS file buffer ******* used by prodos
kicrct = dosbuf ;[81] remote kermit count of cr's
cmdctr = dosbuf+1 ;[81] cmd counter
cmdlen = dosbuf+2 ;[81] length of cmd
cmdbuf = dosbuf+3 ;[81] buffer for command
;[76] *************** begining of zero bytes
nisc .blkb 1 ;[76] number of saved chs
vtcesc .blkb 1 ;[76] esc flag
escflg: = vtcesc ;[76] Flag indicating we have seen and escape ($1b)
vtcpnm .blkb 1 ;[76] param #
;[85]vtcpar .blkb 17 ;[76] params
vtcpar .blkb 10 ;[85] params
;[85]vtcqmf .blkb 1 ;[76] vt100 ? flag in esc sequence
;[76] *************** end of zeroing bytes
tabary .blkb 80 ;[76] tabs array
orgend ;[75] end of buf should be < $1000
.=brkorg ;[75] hope this sets us back
prefix
.byte 0 ;[59] First time we have no prefix
.blkb mxppth+1 ;[59] " max 64 chs
sprerr .byte nofile ;[59] file not found prodos error
.byte dsefnf+$80 ;[59] dos error - must be in pairs
.byte 1 ;[59] bad system call #
.byte dsebct+$80 ;[59] bad call type
.byte 4 ;[59] bad call parameter count
.byte dsebst+$80 ;[59] bad subtype call
.byte $27 ;[59] i/o error
.byte dsedio+$80 ;[59] disk i/o
.byte $2b ;[59] disk write protected
.byte dsewpr+$80 ;[59] "
.byte $40 ;[62] invalid pathname
.byte $8b ;[62]
.byte $45 ;[59] vol not found
.byte dsevmm+$80 ;[59] vol mismatch
.byte $48 ;[59] vol full
.byte dsedfl+$80 ;[59]
.byte $4a ;[62] incompatible file format(directory)?
.byte $8c ;[62]
.byte $4c ;[62] end of file
.byte dseeod+$80 ;[62] "
.byte $4e ;[59] file access error or file locked
.byte dseflk+$80 ;[59] "
.byte $50 ;[62] file already open
.byte $8d ;[62]
.byte $53 ;[59] invalid system call parameter
.byte dsebct+$80 ;[59] bad call type
eprerr ;[59] end of 2 entry error table
perror sta kwrk01 ;[59] prodos error
jsr crout ;[59] cr
ldx #erms1g\ ;[59]
ldy #erms1g^ ;[59]
jsr prstr ;[59] comment about prodos error and address
lda #'$ ;[59]
jsr cout ;[59]
lda kwrk01 ;[59] get error code
jsr prbyte ;[59] and print it
lda #hspace ;[59]
jsr cout ;[59]
pla ;[59] get return from stack
tax ;[59]
pla ;[59]
;[79] jsr prntax ;[59] print return address
;[79] jsr crout ;[59] cr
jsr prntal ;[79] pr a,x in hex & crlf
lda #0 ;[59] all files
sta pclose+1 ;[59]
jsr prodos ;[59] close files
.byte clofl ;[59]
.word pclose ;[59]
ldx kerosp ;[59] Get the old stack pointer
txs ;[59] and restore it
lda kwrk01 ;[59] get the error
ldy #eprerr-sprerr ;[59] size of table
perro2 cmp sprerr-2,y ;[59] do we have a matching dos msg?
beq perr04 ;[59] yes
dey ;[59]
dey ;[59]
bne perro2 ;[59] are we thru with table? no
lda servef ;[62] are we in server mode?
beq perr30 ;[62] no
lda #'E ;[62] yes send error back to remote
sta ptype ;[62]
ldy #lerm1g+3 ;]62] length of total message
sty pdlen ;[62]
ldx #erms1g\ ;[62] boiler plate part
stx saddr ;[62]
ldx #erms1g^ ;[62]
stx saddr+1 ;[62]
ldy #0 ;[62] now to move the message
perr03 lda (saddr),y ;[62]
and #$7f ;[62] forget about that high bit
sta (kerbf1),y ;[62] hope srini set this up
iny ;[62]
cpy #lerm1g ;[62] are we thru
bne perr03 ;[62] no
lda #'$ ;[62] now to tell its hex
sta (kerbf1),y ;[62]
iny ;[62]
lda kwrk01 ;[62] get the prodos error
pha ;[62] and send it
lsr a ;[62]
lsr a ;[62]
lsr a ;[62]
lsr a ;[62]
ora #$b0 ;[62]
cmp #$ba ;[62]
;[76] bcc .+4 ;[62] hate to do this
bcc dtpt1 ;[76][62] hate to do this
adc #6 ;[62]
dtpt1 ;[76]
sta (kerbf1),y ;[62] first hex ch
iny ;[62]
pla ;[62]
and #$f ;[62] now for the second hex ch
ora #$b0 ;[62]
cmp #$ba ;[62] there is a gap between 9 & a
bcc .+4 ;[62] sigh!
adc #6 ;[62]
sta (kerbf1),y ;[62]
jsr spak ;[62] finally send msg to rmt
jmp server ;[62]
perr30 ;[62]
jmp kermit ;[59] Go back to top of loop
perr04 lda sprerr-1,y ;[59] get dos error
sta errcod ;[59] and ready for the comment
jmp stat07 ;[59] use the status rtn
.endc
;
; routines for pascal i/o on //e 80 col
;
pin sta (basl),y ;[58] restore rdkey cursor
;[71] lda #$40 ;[58] tell firmware we are basic input
;[71] ora mode ;[58] got to keep video & gotoxy,ignore pascal
;[71] sta mode ;[58] but use the pascal rtns
prent jsr pread ;[58] get keystroke
ora #$80 ;[58] we expect the high bit
rts ;[58]
pcout ;[59] got to save a reg
pha ;[59]
and #$7f ;[58] pascal doesnt want high bit
stx a1h ;[85] save x since cout restors x
sty a1l ;[85] save y
;[85] pha ;[58] now say we are basic output
cmp #cr ;[59] first lets check for ^S hold
;[85] bne pcout2 ;[59] not yet
bne pwent ;[85] not yet
;[85] lda kbd ;[59] do we have a key press
ldx kbd ;[85] do we have a key press
bpl pcout2 ;[59] not yet
;[85] cmp #hxoff ;[59] how about a ^S
cpx #hxoff ;[85] how about a ^S
bne pcout2 ;[59] no must not be a hold screen
bit kbdstr ;[59] yes, reset keyboard strobe
;[85]pcout3 lda kbd ;[59] get next keypress
pcout3 ldx kbd ;[85] get next keypress
bpl pcout3 ;[59] not yet
;[85] cmp #$83 ;[59] yes, now is it a ^C
cpx #$83 ;[85] yes, now is it a ^C
beq pcout2 ;[59] yes, keep the keypress for later
bit kbdstr ;[59] no, reset strobe throw away keypress
pcout2 ;[59]
;[71] lda #$c ;[58] this is the gotoxy & video flag
;[71] and mode ;[58] say we are basic output with gotoxy flag
;[71] sta mode ;[58]
;[71] and #8 ;[58] are we doing gotoxy ?
;[71] beq pcout0 ;[58] no
;[71] lda #$20 ;[58] this is the pascal flag
;[71] ora mode ;[58] we must till it so gotoxy works ok
;[71] sta mode ;[58]
;[71]pcout0 ;[58] just a plact to hang ones hat
;[85] pla ;[58] restore print ch
;[85] stx a1h ;[70][58] save x since cout restors x
;[85] sty a1l ;[70][58] save y
;[85] cmp #cr ;[71] pascal rtn requires a line feed
;[85] bne pwent ;[71]
pha ;[71] save the cr
lda #lf ;[71] and send the lf first
pwent1 jsr pwrite ;[71] output the lf
pla ;[71] get cr back
pwent jsr pwrite ;[58] pascal rtn
pla ;[59] restore a reg
ldy a1l ;[70][58] restore
ldx ourcv ;[58] keep track of the verticle pos
stx cv ;[58]
ldx a1h ;[70][58] now all regs are restored
pcout1 rts ;[58]
pcoee jsr $c36d ;[78] stupid rom, leave
tax ;[78] the window
jsr $ced7 ;[78] alone
jmp $c9f6 ;[78] blah! blah! blah!
pcoec ora #$80 ;[79] leave the window alone
ldx $cfff ;[86] first free up all of it
ldx $c332 ;[79] get the bank in
;[86] ldx $cfff ;[79] all of it
tax ;[79]
jsr $cf59 ;[79]
jmp $cec8 ;[79]
pcoeg jsr $c38f ;[79] leave the window alone
tax ;[79]
jsr $ce6c ;[79]
jmp $c9f0 ;[79]
; apple machine id
;rom add --> $fbb3 $fbbf $fbc0 $c333 $c35a $c37c
; II $38
; II+ $ea
; franklin 1000 $c1 0
; //e $06 $c1 $ea
; //e+ enhanced $06 0 $e0 $f0
; laser128 2.90 $06 $e0 $00 $13
; //c(org) $06 $ff $00
; //c(3.5) $06 $00 $00
; //c(v3) $06 $03 $00 $c2
; //c+ $06 $04 $00 $c2
; //gs $06 0 $e0 $8f
; to distinguish the gs from the e+
; sec
; jsr $fe1f
; bcc gs
;
; prodos address $bf98
; II,II+,//e bit 3 = 0
; others bit 3 = 1
; //c bits 7,6 = 10
test2h jmp home ;[79][68] clear screen for every one & rtn
test2e lda $fbb3 ;[58] is this a //e
cmp #6 ;[58]
bne test2h ;[68][58] no
lda dsptyp ;[58] is it //e 80 col ?
bpl test2h ;[68][58] no
lda dsp2 ;[61] get slot number for pr#n
sta itse80 ;[86] ist //e or better in 80 col
jsr setio2+2 ;[61]
jsr home ;[61] let basic initialize 2e 80 col
lda #pcout^ ;[58] change the cout
sta cswh ;[58] routine
lda #pcout\ ;[58]
sta cswl ;[58]
lda #pin^ ;[58] set up the read also
sta kswh ;[58] reads will go to pin
lda #pin\ ;[58]
sta kswl ;[58]
lda pvect ;[59]set up the pascal initilize jmp
sta pient+1 ;[59]
lda pvect+1 ;[59] now for the read entry
sta prent+1 ;[59]
lda pvect+2 ;[59] now for the write entry
ldx #pwrite^ ;[78] stupid enhanced rom
ldy $fbc0 ;[78]
bne itsnac ;[79] its not a //c
ldy $c333 ;[79] just another
cpy #$c2 ;[79] check
bne test23 ;[79] different //c rom?????????
ldx #pcoec^ ;[79] get around the reset
lda #pcoec\ ;[79] region
jmp test23 ;[79] thats all
itsnac ;[79]
cpy #$e0 ;[78] is this enhanced //e ?
bne test23 ;[78] no
ldy $c37c ;[79] maybe, try //gs first
cpy #$8f ;[79]
bne itsnag ;[79] its not a //gs
sty kpfl ;[80] tell we have the keypad
ldx #pcoeg^ ;[79]
lda #pcoeg\ ;[79] //gs address
jmp test23 ;[79]
itsnag ;[79]
ldy $c35a ;[78] one final check for the e+
cpy #$f0 ;[78] hope the rom versions stay the same
bne test23 ;[78]
ldx #pcoee^ ;[78] yes skip redoing the windows
lda #pcoee\ ;[78]
test23 ;[78]
stx pwent+2 ;[78] 80 col better be slot 3
stx pwent1+2 ;[78] sigh!!
sta pwent+1 ;[59]
sta pwent1+1 ;[71]
;[76]pient jmp pinit ;[58] now initilize pascal rtns
pient jsr pinit ;[76][58] now initilize pascal rtns
lda vtmod ;[76]
cmp #1 ;[76] is this vt52?
beq pient2 ;[76] yup
cmp #2 ;[76] how about vt100
bne pientr ;[76] no
pient2 lda mode ;[76] use xparent so windowing will work
ora #1 ;[76]
sta mode ;[76]
pientr rts ;[76] thats all folks
;[78]dfsv lda #27 ;[69] wait a few seconds
dfsv lda #54 ;[78] wait a few seconds
sta kwrk01 ;[69] so operator can read any messages
dfsv3 lda #125 ;[85] 1 ms at a time
sta kwrk02 ;[85] hope this is available
;[78]test2l lda #255 ;[69] 255 ms
;[85]test2l lda #220 ;[78] 125 ms
test2l lda timect ;[85] 125 ms
jsr wait ;[69]
lda kbd ;[73] allow any keypress to exit also
bmi test27 ;[73]
dec kwrk02 ;[85]
bne test2l ;[85]
dec kwrk01 ;[69] all 7 secs?
;[85] bne test2l ;[69]
bne dfsv3 ;[85]
test27 rts ;[73][69] thats all
sucout lda #0 ;[78] assume 40 col
ldy #40 ;[78] set the window width correctly
ldx dsptyp ;[78] get display type
bpl kstar1 ;[78] is this 80 col?,no
ldy #80 ;[78] just in case card doesnt
lda dsp2 ;[78] get slot number for pr#n
kstar1: ;[78]
sty wndwth ;[78] set this
jsr setio2+2 ;[78] DOS does not interfere with Kermit
jmp test2e ;[78] test for //e 80 co1 & rts
.SBTTL Kermit initialization
;
; The following code sets up Kermit-65 for normal operation.
;
kstart: jsr setio1 ;[1] Set I/O hooks appropriately so that
lda #0 ;[49] just in case a pr#0
sta $c000 ;[58] //e 80store off
sta $c002 ;[58] " read main mem
sta $c004 ;[58] " write main mem
sta $c008 ;[58] main mem stack & z.p.
sta $c051 ;[58] text mode on
sta $c054 ;[58] page 1
;[81] sta kerins ;[75][47] make sure we initialize
sta servef ;[75][62] and get out of server mode
;[80] sta dosflg ;[75][59] assume dos 3.3
sta kerrki ;[78] allow initialization each time
;[78] ldy #40 ;[78] set the window width correctly
;[78] ldx dsptyp ;[49] get display type
;[78] bpl kstar1 ;[49] is this 80 col?,no
;[78] lda #80 ;[76] just in case card doesnt
;[78] ldy #80 ;[78][76] just in case card doesnt
;[78] sta wndwth ;[76] set this
;[78] lda dsp2 ;[49] get slot number for pr#n
;[78]kstar1: ;[49]
;[78] sty wndwth ;[78] set this
;[78] jsr setio2+2 ;[49][1] DOS does not interfere with Kermit
;[78] jsr test2e ;[58] test for //e 80 co1
jsr sucout ;[78] set up cout
;[68] jsr home ; start by clearing screen
;[87] lda #0 ;[64]
;[87] pha ;[64]
;[87] pha ;[87]
;[87] lda #cv2lp ;[64] convert sec to loops thru getc
;[87] pha ;[64]
;[87] lda #0 ;[64]
;[87] pha ;[64]
;[87] pha ;[87]
;[87] lda rtime ;[64] rec timeout in seconds
;[87] pha ;[64]
;[87] jsr mul16 ;[64] now for the multiply
;[87] pla ;[64]
;[87] sta lpcycl ;[64] answer in here
;[87] pla ;[64]
;[87] sta lpcycl+1 ;[64]
;[87] pla ;[87] throw away msb
jsr cvs2lp ;[87] convert seconds to loops
ldx #versio\ ; Get Low order byte of version message
ldy #versio^ ; And H.O. byte
;[79] jsr prstr ; Print the version
;[79] jsr prcrlf ; Print a crlf
jsr prstrl ;[79]
.ifeq funkey ;[73]
ldy #$ff ;[73] got to check and see if game plug exists
lda $fbb3 ;[73] how about //e or c
cmp #6 ;[73]
beq kstar9 ;[73] yes switches are built in
sty $c070 ;[73] first reset timing circut
kstar7 lda $c064 ;[73] now check for decay
bpl kstar9 ;[73] if hi bit drops we must have game plug
dey ;[73] give it lots of time
bne kstar7 ;[73] thru,no
kstar9 sty usfkey ;[73] tell if we can check for funct keys
.endc ;[73]
.ifeq <ftcom-ftappl>
;[80] lda herrpt ;[75] only do this once (it says here)
;[80] ora herrpt+1 ;[75]
lda hsoftv+1 ;[80] only do this once (it says here)
;[80] bne kstara ;[75] only once
beq kstarb ;[80] unable to make the long jump
jmp kstara ;[80]
kstarb ;[80]
sta dosflg ;[80] assume dos 3.3
lda softvc ;[75] save the soft vector
sta hsoftv ;[75]
lda softvc+1 ;[75]
sta hsoftv+1 ;[75]
lda #theend\ ;[57] setup reset for monitor stop
sta softvc ;[57]
lda #theend^ ;[57]
sta softvc+1 ;[57]
jsr warmst ;[57] so we wont do a cold start
lda tl0end+1 ;[87] init screen save
clc ;[87] now for the end of 1920 bytes
adc #1920^ ;[87]
sta escsv+1 ;[87] for the next block of memory
lda tl0end ;[87]
clc ;[87]
adc #1920\ ;[87]
sta escsv ;[87]
bcc .+5 ;[87] did we carry?
inc escsv+1 ;[87] yup its one more
;[80] lda errptr ; Move DOS vectors to a hold area
;[80] sta herrpt ; ...
;[80] lda errptr+1 ; ...
;[80] sta herrpt+1 ; ...
;[80] lda basws ; ...
;[80] sta hbasws ; ...
;[80] lda basws+1 ; ...
;[80] sta hbasws+1 ; ...
;[80] lda #nonftl\ ; Point dos error handler pointer
;[80] sta errptr ; at our error routine
;[80] lda #nonftl^ ; ...
;[80] sta errptr+1 ; ...
;[80] lda #nonftl\ ; Point basic warmstart at us
;[80] sta basws ; ...
;[80] lda #nonftl^ ; ...
;[80] sta basws+1 ; ...
;[80]kstara ;[75]
;[75] lda #0 ;[47] we must go thru init at least once
;[75] sta kerins ;[47]
;[75] sta servef ;[62] and get out of server mode
;[75] sta dosflg ;[59] assume dos 3.3
lda #$8d ;[59] lets look and see if 3.3 open rtn
cmp dosopn ;[59] should be a "sta b5c2"
bne kstar2 ;[59] its prodos
lda #$c2 ;[59] maybe prodos
cmp dosopn+1 ;[59] well
bne kstar2 ;[59] its prodos
lda #$b5 ;[59] final chance
cmp dosopn+2 ;[59]
;[78] beq kstar3 ;[59] as i said before its 3.3
bne kstar2 ;[78] its prodos
;[84] lda errptr ;[80] Move DOS vectors to a hold area
;[84] sta herrpt ;[80] ...
;[84] lda errptr+1 ;[80] ...
;[84] sta herrpt+1 ;[80] ...
;[84] lda basws ;[80] ...
;[84] sta hbasws ;[80] ...
;[84] lda basws+1 ;[80] ...
;[84] sta hbasws+1 ;[80] ...
;[84] lda #nonftl\ ;[80] Point dos error handler pointer
;[84] sta errptr ;[80] at our error routine
;[84] lda #nonftl^ ;[80] ...
;[84] sta errptr+1 ;[80] ...
;[84] lda #nonftl\ ;[80] Point basic warmstart at us
;[84] sta basws ;[80] ...
;[84] lda #nonftl^ ;[80] ...
;[84] sta basws+1 ;[80] ...
;[80] lda defslt ;[78]
;[80] ora defdrv ;[78]
;[80] bne kstar3 ;[78] the default is already set
lda kdslot ;[78] no use dos 3.3 setings
sta defslt ;[78]
lda kddisk ;[78]
sta defdrv ;[78]
lda kdvol ;[78] and finally the vol
sta defvol ;[78]
jmp kstar3 ;[78]
;[80]kstarp stx kwrk01 ;[78] routine to field output from basic.system
;[80] ldx prefix ;[78] have we found the leading / ?
;[80] bne kstarq ;[78] yes
;[80] cmp #'/+$80 ;[78] no, do we have one now
;[80] bne kstarr ;[78] no just return waiting for one
;[80]kstarq cmp #hcr ;[78] throw away these
;[80] beq kstarr ;[78]
;[80] sta prefix+1,x ;[78] save the prefix from basic.system
;[80] inc prefix ;[78] and tell how many
;[80]kstarr ldx kwrk01 ;[78] now restore x
;[80] rts ;[78]
kstar2 sta dosflg ;[59] say its prodos
lda prefix ;[62] does user have a prefix already??
bne kstar4 ;[62] yes use his
;[80] lda cswh ;[78] interupt cout
;[80] pha ;[78]
;[80] lda #kstarp^ ;[78]
;[80] sta cswh ;[78] with our routine
;[80] lda cswl ;[78]
;[80] pha ;[78]
;[80] lda #kstarp\ ;[78]
;[80] sta cswl ;[78]
;[80] ldx prefsz ;[78]
;[80] lda #hcr ;[78] terminate it
;[80] sta getln,x ;[78]
;[80]kstloo lda prefsz,x ;[78] move command
;[80] sta getln-1,x ;[78] to get line for basic.system
;[80] dex ;[78]
;[80] bne kstloo ;[78]
;[80] jsr pbasic+3 ;[78] let basic system put out prefix
;[80] ldx prefix ;[78]
;[80] lda #0 ;[78] null terminate the prefix for listing
;[80] sta prefix+1,x ;[78]
;[80] pla ;[78]
;[80] sta cswl ;[78] now restore cout
;[80] pla ;[78]
;[80] sta cswh ;[78]
jsr prodos ;[62] no see if there is one?
.byte getpre ;[62] get prefix
.word predel ;[62]
bcc .+5 ;[62] good call? yes
jsr perror ;[62] no
ldy prefix ;[62] got to null terminate the string
beq kstarc ;[80] no prefix try for vol name
lda #0 ;[62]
sta prefix+1,y ;[^2]
jmp kstar3
kstarc ;[80]
lda devnum ;[80] thanks to sean nolan
sta pdvnum ;[80] for this code, we have brun vol #
jsr prodos ;[80] get vol name
.byte online ;[80]
.word ponline ;[80]
bcc .+5 ;[80] good call? yes
jsr perror ;[80] no
lda prefix+1 ;[80] get count
and #$f ;[80]
tax ;[80]
inx ;[80] one more for the /
stx prefix ;[80] this is the total count
lda #'/ ;[80] start the vol name
sta prefix+1 ;[80] with a / so its now a prefix
kstar4 ;[62]
jsr prodos ;[59] set the prefix
.byte setpre ;[59]
.word predel ;[59]
bcc kstar3 ;[59] good call? yes
jsr perror ;[59] no sigh!
kstar3 ;[59]
.endc
tsx ;[67] Get the stack pointer
stx kerosp ;[67] and save it in case of a fatal error
kstara ;[80] end of one time stuff
.ifeq termnl ;[73] is this terminal pgm?
jsr shvt ;[73] tell the user about
jsr shfw ;[73] some of the
jsr shddsk ;[73] defaults
jsr shbaud ;[73]
jsr shswp ;[73]
jsr dfsv ;[77] let the operator look at it
jsr telne3 ;[73] yes start out immeadiately with connect
.endc ;[73]
.ifne termnl ;[73] otherwise carry on normaly
jsr vtccom ;[76] start vt100 with clean start
jsr clrfcb ;[83] clear fcb for dos,for kermit.init
ldy #kercmd-kerinn-1 ;[83] now for the size of the file name - null
sty nfcb1 ;[83]
kerin2 lda kerinn-1,y ;[83] now move the file name to fcb1
sta fcb1-1,y ;[83]
dey ;[83]
bne kerin2 ;[83] are we thru? no
jsr kermit ; Go execute kermit
.endc ;[73]
.ifeq <ftcom-ftappl>
lda dosflg ;[59]prodos?
beq .+5 ;[59] no
jmp pbasic ;[59] restart basic
jmp dos ; Restart dos
.endc
theend brk ; Break
.SBTTL Kermit - main routine
;
; This routine is the main KERMIT loop. It prompts for commands
; and then it dispatches to the appropriate routine.
;
kermit: ;[67]tsx ; Get the stack pointer
;[67]stx kerosp ;and save it in case of a fatal error
ldx #prmt\ ;[13] Fetch the address of the prompt
ldy #prmt^ ;[13] for Comnd routines
lda #cmini ; Argument for comnd call
jsr comnd ; Set up the parser and print the prompt
kermt0 ;[81]
jsr kerini ;[78] read the initialize file
lda #kercmd\ ; L.O. byte addr of command table
sta cminf1 ; Stuff it
lda #kercmd^ ; H.O. byte addr of command table
sta cminf1+1 ; Stuff that too
;[85] lda #kerhlp\ ; L.O. byte addr of help text
;[85] sta cmhptr ; Store it in help pointer
;[85] lda #kerhlp^ ; H.O. byte addr of help text
;[85] sta cmhptr+1 ; Store H.O. byte
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Set up for keyword parse
jsr comnd ; Try to parse it
jmp kermt2 ; Failed
xjmp stx xjmp1+1 ;[82] set up jmp address
sty xjmp1+2 ;[82]
xjmp1 jmp xjmp1 ;[82] now do it
;[81] lda #kermtb\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9]
;[82] ldy #kermtb\ ;[9] Get the L.O. byte of jump table
;[82] lda #kermtb^ ;[9] Get the H.O. byte
;[82] jmp indexj ; its easier this way
;[82]kermtb: jmp telnet ; Connect command
;[82] jmp exit ; Exit command
;[82] jmp help ; Help command
;[82] jmp log ; Log command
;[82] jmp exit ; Quit command
;[82] jmp receve ; Receive command
;[82] jmp send ; Send command
;[82] jmp setcom ; Set command
;[82] jmp show ; Show command
;[82] jmp status ; Status command
;[82] jmp bye ;[14] Shut and logout remote server command
;[82] jmp finish ;[14] Shut remote server
;[82] jmp getfrs ;[14] Get file from remote server
;[82] jmp server ;[62] server mode
;[82]kercat jmp catlog ;[78] catalog command
;[82]kerdil jmp modem ;[78] modem command
;[82]kerdlf jmp deletf ;[78] delete file command
;[82]kerrmt jmp remote ;[81] remote command
kermt2: ldx #ermes1\ ; L.O. byte of error message
ldy #ermes1^ ; H.O. byte of error message
;[83] jsr prstr ; Print the error
;[83] jmp kermit ; Go back
jmp kermtx ;[83] thats all
kermt3: ldx #ermes3\ ; L.O. byte of error
ldy #ermes3^ ; H.O. byte of error
;[83] jsr prstr ; Print it
;[83] jmp kermit ; Try again
jmp kermtx ;[83] thats all
kermt4: ldx #ermes4\ ; L.O. byte of error
ldy #ermes4^ ; H.O. byte of error
;[83] jsr prstr ; Print the text
;[83] jmp kermit ; Try again
jmp kermtx ;[83] thats all
kermt5: ldx #ermes6\ ; L.O. byte of error
ldy #ermes6^ ; H.O. byte of error
;[83] jsr prstr ; Print error text ('keyword')
;[83] jmp kermit ; Start at the beginning again
jmp kermtx ;[83] thats all
kermt6: ldx #ermes7\ ; L.O. byte of error
ldy #ermes7^ ; H.O. byte of error message
;[83] jsr prstr ; Print the error message ('file spec')
;[83] jmp kermit ; and try again
jmp kermtx ;[83] thats all
kermt7: ldx #ermes8\ ; L.O. byte of error message text
ldy #ermes8^ ; H.O. byte of error message
;[83] jsr prstr ; Print it ('integer')
;[83] jmp kermit ; Try for another command line
jmp kermtx ;[83] thats all
kermt8: ldx #ermes9\ ; L.O. byte of error
ldy #ermes9^ ; H.O. byte of error
;[83] jsr prstr ; Print the message ('switch')
;[83] jmp kermit ; Go back to top of loop
jmp kermtx ;[83] thats all
kermt9: ldx #ermesa\ ;[12] L.O. byte of error message text
ldy #ermesa^ ;[12] H.O. byte of error message
;[83] jsr prstr ;[12] Print message ('invalid device driver')
;[83] jmp kermit ;[12] Go back to top of loop
jmp kermtx ;[83] thats all
kermta: ldx #ermesb\ ;[13] L.O. byte of error message text
ldy #ermesb^ ;[13] H.O. byte of error message
;[83] jsr prstr ;[13] Print message ('null string found')
;[83] jmp kermit ;[13] Go back to top of loop
jmp kermtx ;[83] thats all
kerrtn rts ;[78]
svcmd stx cminb0+1 ;[81] rather than reading keyboard
sty cminb0+2 ;[81]
rts ;[81]
rscmd lda #rdkey\ ;[81] restore cminb0
sta cminb0+1 ;[81] to read from the keyboard
lda #rdkey^ ;[81]
sta cminb0+2 ;[81]
rts ;[81]
kerini lda kerrki ;[78] are we reading the init file?
beq kerin1 ;[78] just starting
cmp #1 ;[78] are we trying to open
bne kerrtn ;[78] no, just keep reading kermit.ini or keyboard
jsr kerin9 ;[78] yes and failing
ldx kerosp ;[78] restore stack pointer
txs ;[78] keep the stack straight
jsr setio1 ;[78] stop dos 3.3
lda #24 ;[78] wait 3 sec for viewer
sta kwrk01 ;[78]
kerint lda #125 ;[85] 125 ms
sta kwrk02 ;[85] 1 ms at a time
;[85]kerina lda #220 ;[78]
kerina lda timect ;[85]
jsr wait ;[78]
dec kwrk02 ;[85]
bne kerina ;[85]
dec kwrk01 ;[78] thru?
;[85] bne kerina ;[78] no
bne kerint ;[85] no
jsr sucout ;[78] stop dos 3.3
jmp kermit ;[78] around we go again
;[81]kerin1 lda #kerin3\ ;[78] set command reader to go here
;[81] sta cminb0+1 ;[78] rather than reading keyboard
;[81] lda #kerin3^ ;[78]
;[81] sta cminb0+2 ;[78]
kerin1 ldx #kerin3\ ;[81]
ldy #kerin3^ ;[81]
jsr svcmd ;[81] redirect cmd reader
inc kerrki ;[78] say were trying to open
;[83] jsr clrfcb ;[78] clear fcb for dos
;[83] ldy #kercmd-kerinn-1 ;[78] now for the size of the file name - null
;[83] sty nfcb1 ;[78]
;[83]kerin2 lda kerinn-1,y ;[78] now move the file name to fcb1
;[83] sta fcb1-1,y ;[78]
;[83] dey ;[78]
;[83] bne kerin2 ;[78] are we thru? no
jsr prcrlf ;[78]
ldx #kerinm\ ;[78] tell what
ldy #kerinm^ ;[78] were going to do
;[83] jsr prstr ;[78]
;[83] ldx #kerinn\ ;[78] now for the
;[83] ldy #kerinn^ ;[78] file name
;[79] jsr prstr ;[78]
;[79] jsr prcrlf ;[78]
jsr prstrl ;[79]
jsr opentf ;[78] save current and open text file
inc kerrki ;[78] if we get here its a good open so tattle
rts ;[78]
kerin3 jsr fgetc ;[78] get a ch from file
jmp kerin9 ;[78] eof return
ora #$80 ;[78] make sure its negative ascii
kerin5 rts ;[78] got a ch give it to cminb0
kerin7 lda kerrki ;[78] have we already closed
cmp #3 ;[78] should be>2
bcs kerin5 ;[78]
kerin9 jsr clostf ;[78] close file and restore filmod
;[81] lda #rdkey\ ;[78] restore cminb0
;[81] sta cminb0+1 ;[78] to read from the keyboard
;[81] lda #rdkey^ ;[78]
;[81] sta cminb0+2 ;[78]
jsr rscmd ;[81] restore cmd reader
sta kerrki ;[78] say weve read kermit.ini > 2
;[85] lda #hesc ;[78] give cminb0 the last ch
lda #hctrlu ;[85] give cminb0 the last ch
rts ;[78] thats all folks
opentf lda filmod ;[78] save current file
sta kersft ;[78] file type
lda #0 ;[78] set file type = text
sta filmod ;[78]
lda #fncrea ;[78] say we are reading
jsr openf ;[78] try to open the file
rts ;[78]
clostf lda #1 ;[78] say were reading
jsr closef ;[78] close the text file
lda kersft ;[78] now restore current file type
sta filmod ;[78]
rts ;[78]
telcom jsr test2e ;[85] clear the screen & allow windowing
ldx #inf01a\ ;[85] Get address of first half of message
ldy #inf01a^ ;[85] ...
jsr prstr ;[85] Print it out
lda escp ;[85] Get the 'break connection' character
jsr prchr ;[85] Print that as a special character
ldx #inf01b\ ;[85] Get address of second half of message
ldy confg ;[85]
sty flowfg ;[85] now set up flow flag
ldy #inf01b^ ;[85] ...
jsr prstrl ;[85]
jmp sutljp ;[85] set up screen distributor
.SBTTL Telnet routine
;
; This routine handles the connect command. After connecting
; to a host system, this routine alternates calling routines
; which will pass input from the port to the screen and pass
; output from the keyboard to the port. This kermit will
; ignore all characters until it sees and assigned escape
; character.
;
; Input: NONE
;
; Output: NONE
;
; Registers destroyed: A,X,Y
;
telnet: ;[74]sta ksavea ;[12] Save the AC so it isn't destroyed
jsr prcfm ; Parse and print a confirm
telne3 ;[73] place for terminal to begin
jsr kerin7 ;[78] just in case were reading kermit.ini
;[85] jsr test2e ;[76] clear the screen & allow windowing
;[85] ldx #inf01a\ ; Get address of first half of message
;[85] ldy #inf01a^ ; ...
;[85] jsr prstr ; Print it out
;[85] lda escp ; Get the 'break connection' character
;[85] jsr prchr ; Print that as a special character
;[85] ldx #inf01b\ ; Get address of second half of message
;[85] ldy confg ;[76]
;[85] sty flowfg ;[76] now set up flow flag
;[85] ldy #inf01b^ ; ...
;[76] sty confg ;[57] say we are talking to a remote
;[79] jsr prstr ; Print that
;[79] jsr prcrlf ; and a crelf
;[85] jsr prstrl ;[79]
;[85] jsr sutljp ;[85] set up screen distributor
jsr telcom ;[85] common code
;[81] jsr tlinit ;[47] initialize the serial port
jsr comint ;[81] common init
;[87] bne ch0lup ;[58] good init so go ahead
;[81] jsr u2icc ;[62] tell someone
;[81] jmp kermit ;[58] failure so try again
jsr rstscr ;[87] restore screen
jmp ch0lup ;[87] good init so go ahead
rstscr lda fscsv ;[87] is the screen saved?
beq rstrts ;[87] no
lda scv ;[87] restore ch & cv
sta cv ;[87]
ldx sch ;[87]
stx ch ;[87]
jsr pos80c ;[87] now pos to original
ldx #0 ;[87]
stx itsefl ;[87] now we know its off
lda tl0end+1 ;[87] set up the restore address
sta gscsv+2 ;[87]
lda tl0end ;[87]
sta gscsv+1 ;[87]
ldx #gscsv^ ;[87] set up screen put
ldy #gscsv\ ;[87]
jsr scrsvr ;[87]
ldx #cffke^ ;[87] set up end of line (nada)
ldy #cffke\ ;[87]
jsr ssceln ;[87]
ldx #0 ;[87] set up first and last rows(+1)
ldy #24 ;[87]
jsr ssclns ;[87]
jmp scrrtn ;[87] now for the screen routine & rts
gscsv lda $c000 ;[87] place to get restore chs
sta (a1l,x) ;[87]
sta $c054 ;[87] got to do this for correct bank
inc gscsv+1 ;[87]
bne .+5 ;[87]
inc gscsv+2 ;[87]
rstrts rts ;[87]
telppc:
jsr telspa ;set parity
jmp tl0ppc ;[54]
;[87]telcp:
;[87] jmp tl0cp ;[54]
telcp = tl0cp ;[87]
;[87]telgpc:
;[87] jmp tl0gpc ;[54]
telgpc = tl0gpc ;[87]
telb2k jsr rstrcr ;[86] restore cursor
lda csfg ;[87] should we clear screen?
beq .+5 ;[87] no
jsr home ;[87] clear screen
jmp kermit ;[86]
;[85] jmp .+3 ;[82] needed for crimmins mouse support
;[86] nop ;[85] 3 in a row for you crimmins
;[86] nop ;[85] 3 in a row for you crimmins
;[86] nop ;[85] 3 in a row for you crimmins
ch0lup: jsr tl0prc ;[12] Check for port character, write to screen
;[85] jmp .+3 ;[82] needed for crimmins mouse support
jsr telcnc ;[12] Check for console char, write to port
;[86] jmp kermit ;[12] This means user wants to shut connection
jmp telb2k ;[86] This means user wants to shut connection
lda itse80 ;[86] a //e or better?
ora itse80+1 ;[86]
beq ch0lu3 ;[86] no
inc itse80 ;[86] blinking cursor
bne ch0lu3 ;[86]
ldx itse80+1 ;[86]
inx ;[86] lets see if its time to reverse
cpx timect ;[86] lets see if this is acceptable
bne ch0lu0 ;[86] no
jsr rstclc ;[86] now invert- requires x=0 on exit <----
ch0lu0 stx itse80+1 ;[86]
ch0lu3 ;[86]
ldx xonfg ;[57] are we waiting for a wake up call
beq ch0lup ;[57] no
;[74] ldx flowlp ;[57] have we waited long enough ?
;[74] beq ch0la ;[57] yes
;[74] lda #2 ;[57] yes wait 2 ms
;[74] jsr wait ;[57]
;[74] dec flowlp ;[57] long enough
;[74] jmp ch0lup ;[57] around the loop again
;[74]ch0la:
ldx #0 ;[74] tattle
stx xonfg ;[57] dont forget
lda #hxon ;[57]
jsr tl0cmd ;[57] start the com up again
jmp ch0lup ;[12] Go back and do all that again
tl0prr: rts ;[74][12] Return
tl0prc: jsr tl0cp ;[12] Check for a port character
;[63] beq tl0prr ;[12] Return
;[74] bne .+3 ;[63] hate to do this
;[74] rts ;[63] only way to reach this
beq tl0prr ;[74] Return
jsr tl0gpc ;[12] Go fetch the character
and #$7f ;[17] Make sure H.O. bit is off for testing
;[74] tay ;[12] Hold the character here
beq tl0prc ;[74] ignore nulls
sta ksavea ;[74] Save the AC so it isn't destroyed
jsr rstrcr ;[86] restore cursor
.ifeq termnl ;[63]
ldx termsc ;[63] get count of commas
beq tl0pra ;[63] are we searching for commas,no
cmp #cr ;[63] yes ,did we get to the end of line?
beq tl0pr6 ;[63] yes, just assume text file xfer
cpx #3 ;[63] have we seen 2 commas?
bne tl0pr5 ;[63] no, keep looking
ldy #etoft-stoft ;[63] we have the type in a (lower case)
tl0pr7 cmp stoft-2,y ;[63] is it in table?
beq tl0pr8 ;[63] yes, set type of file xfer
dey ;[63]
dey ;[63]
bne tl0pr7 ;[63] have we searched all of table?,no
tl0pr6 ldy #2 ;[63] yes, assume text file xfer
tl0pr8 lda stoft-1,y ;[63] get file mode
sta filmod ;[63] and set it
; lda #0 ;[82] make sure ascii type is off
; sta ascii ;[82]
jmp tl0pr1 ;[63] now to server mode
tl0pr5 cmp #', ;[63] is this a comma?
bne tl0pr2 ;[63] no, try next
tl0pr9 inc termsc ;[63] bump the count of commas seen
jmp tl0pr2 ;[63] get next ch from remote
tl0pra ;[63]
ldx termct ;[63] index into term init string
cmp termst,x ;[63] is this part of term init string?
bne tl0pro ;[63] no
inx ;[63] yes
cpx #lterms ;[63] have we got the whole string?
beq tl0pr9 ;[63] yes, go to server mode
stx termct ;[63] no, wait for next ch of string
jmp tl0pr2 ;[63]
tl0pr1 ldx #0 ;[63] use ctr for the ack message
stx termct ;[63]
stx termsc ;[63] ready to start again
tl0prl lda termco,x ;[63] get ch from mcp ack
inc termct ;[63]
jsr telppc ;[63] send ch to remote (mcp)
ldx termct ;[63]
cpx #ltermc ;[63] have we sent all the ack?
bne tl0prl ;[63] no
; Probably should wait for the "cool" ack from mcp
ldx #0 ;[63] ctr must be 0 initially
stx flowfg ;[78] stop flow control while in file xfer
stx termct ;[63]
jsr sutljp ;[85] set up screen distributor
ldx kerosp ;[63] restart the stack
txs ;[63]
jmp server ;[63] away we go
tl0pro ldx #0 ;[63] start at the begining
stx termct ;[63]
tl0pr2 ;[63]
.endc ;[63]
;[76] ldx vtmod ;[58] how about vt52 mode ?
;[76] beq tl0pr4 ;[58] no
;[76] ldx prnfg ;[73] forget about vt52 mode if printer is on
;[76] bne tl0pr4 ;[73] on?, yes
;[76] jsr logput ;[56] may have to record this ch
;[76] ldx vtmod ;[76] how about vt52 mode ?
;[76] cpx #2 ;[76]
;[76] bne jmvtc ;[76] is this vt52?
;[76] jmp vt52 ;[58] yes
;[76]jmvtc jmp vt100 ;[76]
tl0jmp jmp tl0pr4 ;[76] term emulation jump
tl0pr4 ;[58]
jsr logput ;[85] this must immediatly follow tl0pr4
;[74] cmp #cr ;[17] Do we have a <cr>?
;[74] bne tl0pcl ;[17] No, then check for <lf>
;[74] lda #on ;[17] Yes, set the 'Delete <lf>' flag
;[74] sta dellf ;[17] ...
;[74] jmp tl0poc ;[17] And then continue
;[74]tl0pcl: cmp #lf ;[17] Do we have a <lf>?
;[74] bne tl0pnl ;[17] Nope, We must go shut the Dellf flag.
;[74] lda dellf ;[17] We have a <lf>, is the flag on?
;[74] beq tl0poc ;[50][17] If not, continue normally
;[74] lda #off ;[17] Flag is on, <lf> follows <cr>, ignore it
;[74] sta dellf ;[17] Start by zeroing flag
;[74] jmp tl0prc ;[17] Now go to top of loop and try again
;[74]tl0pnl: lda #off ;[17] Zero Dellf
;[74] sta dellf ;[17] ...
;[77] cmp #cr ;[74]
;[77] bne tl0pcl ;[74] not cr
;[77] lda lffg ;[74] have we delayed a lf?
;[77] beq tl0p11 ;[74] no
;[77] lda #off ;[74] yes ignore it
;[77] sta lffg ;[74]
;[77] jmp tl0poc ;[74] print this ch
;[77]tl0p11 lda #on ;[74] turn on cr flag
;[77] sta dellf ;[74]
;[77] jmp tl0prc ;[74] get next ch
;[77]tl0pcl cmp #lf ;[74]
;[77] bne tl0p21 ;[74] not a lf
;[77] lda dellf ;[74] have we delayed a cr
;[77] beq tl0p23 ;[74] no
;[77] lda #cr ;[74] yes print it now
;[77] jsr tl0prt ;[74]
;[77] lda #off ;[74] and tell we did it
;[77] sta dellf ;[74]
;[77] jmp tl0prc ;[74] get next ch
;[77]tl0p23 lda lffg ;[74] have we delayed a lf?
;[77] beq tl0p25 ;[74] no
;[77] lda #lf ;[74] yes now print it
;[77] jsr tl0prt ;[74]
;[77] jmp tl0prc ;[74] next
;[77]tl0p25 lda #on ;[74] tell were delaying a lf
;[77] sta lffg ;[74]
;[77] jmp tl0prc ;[74] next
;[77]tl0p21 lda dellf ;[74] have we delayed a cr?
;[77] beq tl0p27 ;[74] no
;[77] lda #cr ;[74] yes do it now
;[77] jsr tl0prt ;[74]
;[77] lda #off ;[74] and tattle
;[77] sta dellf ;[74]
;[77]tl0p27 lda lffg ;[74] have we delayed a lf?
;[77] beq tl0poc ;[74] no
;[77] lda #lf ;[74] yes do it now
;[77] jsr tl0prt ;[74]
;[77] lda #off ;[74] and tattle
;[77] sta lffg ;[74]
cmp #cr ;[77][17] Do we have a <cr>?
bne tl0pcl ;[77][17] No, then check for <lf>
sta dellf ;[77][17] no nulls so this should be <> 0
;[87] jmp tl0p22 ;[77][17] And then continue
beq tl0p22 ;[87] And then continue
tl0pcl: cmp #lf ;[77][17] Do we have a <lf>?
bne tl0pnl ;[77][17] Nope, We must go shut the Dellf flag.
lda dellf ;[77][17] We have a <lf>, is the flag on?
beq tl0poc ;[77][50][17] If not, continue normally
lda #off ;[77][17] Flag is on, <lf> follows <cr>, ignore it
sta dellf ;[77][17] Start by zeroing flag
;[87] jmp tl0prc ;[77][17] Now go to top of loop and try again
beq tl0prc ;[87] Now go to top of loop and try again
;[87]tl0pnl: lda #off ;[77][17] Zero Dellf
;[87] sta dellf ;[77][17] ...
tl0pnl: ldx #off ;[87] Zero Dellf
stx dellf ;[87] but preserve a
tl0poc: ;[77][74]tya ;[12] Get the data into the AC
;[87] lda ksavea ;[74] restore a
tl0p22 ;[77]
;[77] jsr tl0prt ;[74] print ch
;[74] jsr logput ;[56] We may log this ch
;[74] jsr curoff ;[31] Turn the cursor off
;[74] jsr dspchr ;[34] Show the character replaces COUT
;[74] jsr curon ;[31] Turn the cursor on
;[85] jsr logput ;[77][56] We may log this ch
;[87] jsr curoff ;[77][31] Turn the cursor off
;[87] jsr dspchr ;[77][34] Show the character replaces COUT
;[87] jsr curon ;[77][31] Turn the cursor on
jsr ktocur ;[87] keep track of cursor
jmp tl0prc ;[12] Try for another
ktocur cmp #cr ;[87] Do we have a <cr>?
bne ktocu3 ;[87] No
ldx #0 ;[87] keep track of hch
stx hch ;[87]
jsr bphcv ;[87] & hcv
jmp ktocu7 ;[87] And then continue
ktocu3: ;[87] Do we have a <lf>?
cmp #bs ;[87] more house keeping
bne ktocu5 ;[87]
jsr dchch ;[87] back up but not too far
jmp ktocu7 ;[87]
ktocu5 inc hch ;[87]
ktocu7 ;[87]
jsr curoff ;[87] Turn the cursor off
jsr dspchr ;[87] Show the character replaces COUT
jmp curon ;[87] Turn the cursor on
;[77]tl0prt jsr logput ;[74] We may log this ch
;[77] jsr curoff ;[74] Turn the cursor off
;[77] jsr dspchr ;[74] Show the character replaces COUT
;[77] jsr curon ;[74] Turn the cursor on
;[77] rts ;[74] thats all
.ifeq <ftcom-ftappl>
telcnc: lda kbd ;[12] Check the keyboard for a character
bpl telcrs ;[12] If none, return skip
ldx kpfl ;[86] do we have a keypad
beq telcn0 ;[86] no, //c+ doesnt like us looking @ c025
ldx $c025 ;[80] just in case its gs keypad
stx kwrk01 ;[80]
telcn0 ;[86]
bit kbdstr ;[12] Reset the keyboard strobe
and #$7f ;[12] Make sure H.O. bit is off
;[80] jsr swapbs ;[73] swap bs & del
cmp escp ;[12] Is it the connect-escape character?
bne telcn1 ;[35]
jmp intchr ;[35] If so, go handle the interupt character
telcn1:
ldx xonfg ;[57] have we stopped the flow ?
beq telcn3 ;[57] no
ldx #0 ;[57] tatle
stx xonfg ;[57]
pha ;[57] save the current ch
lda #hxon ;[57] and tell remote
jsr tl0cmd ;[57] to start up again
pla ;[57] now print the current ch
telcn3:
.ifeq funkey ;[73]
ldy kpfl ;[80] do we have a keypad
beq telcn4 ;[80] no
ldy kpafl ;[80] is the keypad in application mode
beq telcn4 ;[80] no
asl kwrk01 ;[80] yes look for keypad pushed
asl kwrk01 ;[80] yes look for keypad pushed
asl kwrk01 ;[80] yes look for keypad pushed
;[81] bmi telcn4 ;[80] this was a keypad key
bmi telcn5 ;[81] this was a keypad key
telcn4 ;[80]
ldy usfkey ;[73] is game plug in?
beq telcn7 ;[73] no dont try
ldy $c061 ;[73] how about open apple
bmi telcn5 ;[73] yes
ldy $c062 ;[73] how about closed apple
bpl telcn7 ;[73] no
telcn5 jsr cffk ;[73] check for a function keypress - & + entries
jmp rskp ;[73] we have a function key so just return
;[80]telcn7 ;[73]
telcn9 ;[80]
.endc ;[73]
jsr swapbs ;[80] swap bs & del
jsr chrcon ;[35] Go deal with loosing 2/2+ keyboard.
pha ;[86] save a for local echo
jsr telppc ;[12] Output the port character
pla ;[86] just in case
ldx lecho ;[57][12] Is local-echo turned on?
beq telcrs ;[57][12] If not, we are done, return skip
sta ksavea ;[87]
jsr rstrcr ;[87] restore cursor
;[87] jsr curoff ;[31] Turn off cursor.
;[87] jsr dspchr ;[34] Show the char. replaces COUT.
;[87] jsr curon ;[31] Turn the cursor back on.
jsr ktocur ;[87] keep track of cursor
telcrs: jmp rskp ;[12] Skip return
telcn7 ldy ckfl ;[80] how about cursor keys
bne telcn5 ;[80] yes, look for functions via a + entry
beq telcn9 ;[80]
u2icc ldx #erms1j\ ;[62] tell about initialization fail
ldy #erms1j^ ;[62]
;[79] jsr prstr ;[62]
;[79] jsr prcrlf ;[62]
jmp prstrl ;[79] & let it rts
;[79] rts ;[62]
u2s8b ldx #erms1k\ ;[72] tell about initialization fail
ldy #erms1k^ ;[72]
;[79] jsr prstr ;[72]
;[79] jsr prcrlf ;[72]
prwait ;[87]
jsr prstrl ;[79]
jsr bell ;[72] attention
;[87] jsr dfsv ;[72] wait a bit so i can read this
;[87] rts ;[72]
jmp dfsv ;[72] wait a bit so i can read this
rstrcr ;[86]
lda itsefl ;[86] do we need to restore cursor?
ror a ;[86]
bcs tl0prd ;[86] no
jsr rstclc ;[86]
stx itse80+1 ;[86]
tl0prd lda ksavea ;[86] restore acc
rts ;[86]
rstclc inc itsefl ;[86] tatle abt inverted
rstcl3 ;[87]
lda hch ;[86] where are we?
cmp wndwth ;[86] did we do that 80th col stuff
bne .+5 ;[86] no
sec ;[86]
sbc #1 ;[86] we only go 0 to 79
lsr a ;[86]
tay ;[86] div by 2
; sei ;[86] lockout interupts
;[87] lda $c055 ;[86] assume page 2
;[87] bcc .+5 ;[86] yes
;[87] lda $c054 ;[86] page 1
bcs .+5 ;[87] page 1 is normal
lda $c055 ;[87] page 2
lda (basl),y ;[86] flip inverse
eor #$80 ;[86]
sta (basl),y ;[86]
lda $c054 ;[86] back to page 1 if necessary
; cli ;[86] ok n now u can interupt
ldx #1 ;[86]
stx itse80 ;[86]
dex ;[86] now for a 0
rts ;[86]
.endc ;[12] Apple computer conditional
;
; Telspa - This routine sets the parity according to the
; current value of the PARITY parameter.
;
telspa: sta kertpc ;[21] Hold character here
lda #telpjt\ ;[21] Get the L.O. byte of parity jump table
sta jtaddr ;[21] Put the L.O. byte here until needed
lda #telpjt^ ;[21] Get the H.O. byte
sta jtaddr+1 ;[21] Store that
lda parity ;[21] Get the offset in AC
clc ;[21] Clear the carry
adc parity ;[21] Make it an offset for a jump table
adc parity ;[21] ...
clc ;[21] Make sure carry is clear again
adc jtaddr ;[21] Add the L.O. byte of address
sta jtaddr ;[57]
lda jtaddr+1 ;[21] Get the H.O. byte of address
adc #$00 ;[21] Add in carry if there is any
sta jtaddr+1 ;[57]
lda kertpc ;[21] Get the character
jmp (jtaddr) ;[57] indexed jump
telpjt: jmp tlpnon ;[21] No parity
jmp tlpspc ;[21] Space parity
jmp tlpmrk ;[21] Mark parity
jmp tlpodd ;[21] Odd parity
jmp tlpevn ;[21] Even parity
tlpnon: rts ;[21] No parity, so return intact
tlpspc: and #$7f ;[21] Turn off the parity bit
rts ;[21] Go back
tlpmrk: ora #$80 ;[21] Set the parity bit
rts ;[21] and go back
tlpevn: lda #$00 ;[21] Start with 0 (for even parity)
jmp tlpeo ;[21] Continue with even parity
tlpodd: lda #$01 ;[21] Set bit for odd parity
tlpeo: ldx #$07 ;[21] Repeat count for parity toggle
tlplp0: bit kertpc ;[21] Test H.O. bit
bpl tlplp1 ;[21] Don't do the EOR if bit 7 not set
eor #$01 ;[21] Toggle parity
tlplp1: rol kertpc ;[21] Get next bit in position
dex ;[21] Decrement the count
bpl tlplp0 ;[21] Not done, do next bit
rol kertpc ;[21] Now we have original byte again
ror a ;[21] Get the parity bit to bit 7
ror a ;[21] ...
ora kertpc ;[21] Merge the two
rts ;[21] and return
.ifeq funkey ;[73]
;[80]cffk ldy vtmod ;[76]
cffk bpl cffkc ;[80] is this cursor keys vt100, yes
ldy vtmod ;[76]
cpy #2 ;[76] vt 100?
beq gafk0 ;[76] yes
ldy #efkls-sfkls ;[73] length of fun key list
cffklp cmp sfkls-1,y ;[73] is it in list
beq gafk ;[73] yes
dey ;[73]
bne cffklp ;[73] at end of list? no
jmp rskp ;[73] yes, thats all return to normal process
cffkc ldy #efkckk-sfklsk ;[80] only search for the cursor keypress
bne gafk01 ;[80] always branch
;[80]gafk0 ldy #efklsc-sfklsc ;[76] length of fun key list
gafk0 ldy kpfl ;[80] do we have a keypad?
beq gafk03 ;[80] no
ldy #efklsk-sfklsk ;[80] len of table
gafk01 cmp sfklsk-1,y ;[80]
beq gafk3 ;[80] got one use common code
dey ;[80] no try next
bne gafk01 ;[80]
gafk02 ;[81]
jmp rskp ;[80] no more
gafk03 ;[80]
ldy #efklsc-sfklsc ;[76] length of fun key list
gafk1 cmp sfklsc-1,y ;[76] is it in list
;[81] beq gafk3 ;[76] yes
beq gafk2 ;[81] yes
dey ;[76]
bne gafk1 ;[76] at end of list? no
jmp rskp ;[76] yes, thats all return to normal process
gafk2 ldx ckfl ;[81] how about vt100 keys
beq gafk3 ;[81] no
cpy #efkckk-sfklsk+1 ;[81]
bcc gafk02 ;[81] yes forget cursor keys
gafk3 tya ;[76]
asl a ;[76]
tay ;[76] double it
lda efklsc-2,y ;[76] get address of fk equivalents
;[86] sta saddr ;[76]
sta cffk3+1 ;[86]
lda efklsc-1,y ;[76] all of it
;[86] sta saddr+1 ;[76]
sta cffk3+2 ;[86]
jmp gafk7 ;[76]
gafk tya ;[76] now
asl a ;[76] double
tay ;[76] it
lda efkls-2,y ;[73] get address of fk equivalents
;[86] sta saddr ;[73]
sta cffk3+1 ;[86]
lda efkls-1,y ;[73] all of it
;[86] sta saddr+1 ;[73]
sta cffk3+2 ;[86]
gafk7 ;[76]
ldy #0 ;[73] start at the begining
sty kwrk01 ;[73] routines use a,x & y
cffkl ldy kwrk01 ;[73]
;[86] lda (saddr),y ;[73] get next ch of function key
cffk3 lda cffk3,y ;[86] page 0 may be used?
beq cffke ;[73] 0 is end of list
inc kwrk01 ;[73] ready for next
jsr telppc ;[73] send it down the line
jmp cffkl ;[73]
cffke rts ;[73] thats all folks
.endc ;[73]
swapbs ldx swapf ;[73] are we swapping bs & del keypress
beq swaprt ;[73] no
cmp #bs ;[73] yes check for the swap
bne swap3 ;[73] not bs
lda #del ;[73] yes make it a del
;[80] bne swaprt ;[73] and return
rts ;[80]
swap3 cmp #del ;[73] how about a del?
bne swaprt ;[73] no so return
lda #bs ;[73] swap del for bs
swaprt rts ;[73] thats all folks
;
; since rdkey wont leave wndtop & wndbtm alone
; we have our own
nrdkey lda kbd ;[87] have we got a ch?
bpl nrdkey ;[87] no tight loop
bit kbdstr ;[87] ready for next
rts ;[87]
;
; Intchr - processes the character which follows the interupt
; character and performs functions based on what that character
; is.
;
;[87]intchr: jsr rdkey ;[12] Get the next character
intchr: jsr savscr ;[87] save screen
jsr nrdkey ;[87] Get the next character
intsvk sta kerchr ;[12] Save a copy of it
and #$5f ;[12] Capitalize it
cmp #'D ;[48] is this drop
bne intch9 ;[48] no
lda #0 ;[54] command the card to
;[85] sta logfg ;[56] turn off logging
jsr tl0cmd ;[54] tell card to hang up
;[85] bne intcha ;[75] yes, weve hung up
bne intchf ;[85] yes, weve hung up
;[75] beq intch8 ;[54] card says he is unable
;[75] rts ;[48] and stay here
;[75]intch8: ldx #erms1b\ ;[48] tell the user its not supported
ldx #erms1b\ ;[48] tell the user its not supported
ldy #erms1b^ ;[48]
;[79] jsr prstr ;[48]
;[79] jsr prcrlf ;[48]
;[87] jsr prstrl ;[79]
jsr prwait ;[87] print & wait for op to read
jsr rstscr ;[87] now restore screen
jmp rskp ;[48] go back with a skip
intch9: ;[48]
cmp #'C ;[12] Does user want the connection closed?
bne intch0 ;[12] If not, try next option
intchf ;[85]
lda logfg ;[56] are we logging ?
bpl intcha ;[56] no
lda #$00 ;[56][3] Make CLOSEF see there are no errors
sta logfg ;[56] turn off logging
jsr closef ;[56] We are done with this file, so close it
;[75]intcha: rts ;[56] Otherwise, do non-skip return and end it
intcha: ;[75]
lda #0 ;[75]
sta flowfg ;[76] turn off flow control when local
jmp sutljp ;[85] set up screen distributor& rts
;[76] sta confg ;[75] talk to local again
;[85] rts ;[75] Otherwise, do non-skip return and end it
intch0: cmp #'S ;[12] Does the user want status?
bne intch1 ;[12] Nope
jmp stat01 ;[12] Give it to him
intch1: cmp #'B ;[41] Does user want to send a Break?
bne intch2 ;[41] No, continue
jsr brkcmd ;[41] Send the Break signal
jmp rskp ;[41] Do a skip return
intch2:
cmp #'P ;[55] is this print toggle
bne intch6 ;[55] no
jsr prntgl ;[55] yes toggle printer
jmp rskp ;[55] skip rtn
intch6:
cmp #'W ;[76] allow swap of bs & del keys
bne intch7 ;[76] no
lda swapf ;[76] yes
eor #1 ;[76] swap it
sta swapf ;[76]
jmp rskp ;[76]
intch7 ;[76]
cmp #'R ;[80] how about print screen
bne intchb ;[80] no
; lda wndtop ;[87] see if this fixes delaneys prob
; pha ;[87]
; lda wndbtm ;[87]
; pha ;[87]
lda cswl ;[80] save the current display
pha ;[80]
lda cswh ;[80]
pha ;[80]
lda prnfg ;[80] the printer flag
pha ;[80] save it
bne intchd ;[80] if its already on no need to turn on
jsr prntgl ;[80] turn printer on
intchd jsr prscr ;[80] now print the screen
pla ;[80] restore printer
sta prnfg ;[80] restore printer flag
; bne intcdd ;[87] is printer on? yes
; lda dsp2 ;[87] reset the screen?
; jsr setio2+2 ;[87] hope so
; jsr rstscr ;[87] see if this gets arnd edt
;intcdd ;[87]
pla ;[80] restore current display
sta cswh ;[80]
pla ;[80]
sta cswl ;[80]
; pla ;[87]
; sta wndbtm ;[87] restore the window
; pla ;[87]
; sta wndtop ;[87]
jsr sutljp ;[80] dont forget to reset terminal type
intchc jmp rskp ;[80] thats all
intchb ;[80]
cmp #'K ;[81] allow swap of keypad application mode
bne intch8 ;[81] no
lda kpafl ;[81] yes
eor #1 ;[81] swap it
sta kpafl ;[81]
jmp rskp ;[81]
intch8 ;[81]
cmp #'E ;[83]
bne intche ;[83] not restore screen
jsr sucout ;[83]
; lda #si+$80 ;[87] turn off mouse text?
; jsr cout ;[87] hope so :-)
lda #0 ;[87] turn off special vt100 graphics
sta vtcso ;[87]
jmp rskp ;[83]
intche ;[83]
cmp #'M ;[86] ok ralpho lets see
bne intchg ;[86] if this is useful
jsr intchf ;[86] clean up things
jmp modem ;[86]
intchg ;[86]
cmp #'Q ;[86] how about an exit, ralpho
bne intchh ;[86]
jsr intchf ;[86] clean up things
jmp exit1 ;[86]
intchh ;[86]
cmp #'V ;[87] is this toggle cursor-keys-vt100
bne intchi ;[87] no
lda ckfl ;[87]
eor #1 ;[87]
sta ckfl ;[87]
jmp rskp ;[87]
intchi ;[87]
lda kerchr ;[12] now for the special chs
and #$7f ;[12] dont worry about case
cmp #'? ;[12] Does user need help?
bne intch3 ;[41][12] If not, continue
jsr home ;[87] clear the screen
ldx #inthlp\ ;[12] Get the address of the proper help string
ldy #inthlp^ ;[12] ...
jsr prstr ;[12] Print the help stuff
jsr nrdkey ;[87] see what he wants
pha ;[87] save key
jsr rstscr ;[87] restore screen
pla ;[87] key he pushed
;[87] jmp intchr ;[12] Get another option character
jmp intsvk ;[87] Get another option character
intch3: cmp escp ;[41][12] Is it another connect-escape?
bne intch4 ;[41][12] No, try next thing
jsr telppc ;[12] Stuff the character at the port
jmp rskp ;[12] Give skip return
intch4: cmp #'0 ;[41] Wants to send a null?
bne intch5 ;[41] Nope,this is definitely an error
lda #nul ;[41] Fetch a null
jsr telppc ;[41] and stuff it at the port
jmp rskp ;[41] Return with a skip
intch5:
jsr bell ;[41][12] Sound bell at the user
jmp rskp ;[12] Go back (skip)
savscr lda itse80 ;[87] are we saving screen?
ora itse80+1 ;[87] slight hole wid blinking cursor
beq savrts ;[87] no
inc itsefl ;[87] if we turned it off leave it off
jsr rstrcr ;[87] may have to reset cursor
inc itsefl ;[87] hope hope
lda tl0end+1 ;[87] set up save address
sta intsvc+2 ;[87]
sta fscsv ;[87] tattle that its saved
lda tl0end ;[87]
sta intsvc+1 ;[87]
lda hcv ;[87] save pos on screen
sta scv ;[87]
lda hch ;[87]
sta sch ;[87]
ldx #intgts^ ;[87] set up put
ldy #intgts\ ;[87]
jsr scrsvr ;[87]
ldx #cffke^ ;[87] what to do at end of line
ldy #cffke\ ;[87]
jsr ssceln ;[87]
ldx #0 ;[87] and the range +1
ldy #24 ;[87]
jsr ssclns ;[87]
jmp scrrtn ;[87] do the screen & rts
intgts lda (a1l,x) ;[87] get ch from screen
sta $c054 ;[87] always get bank back
intsvc sta $c000 ;[87] place to save screen
inc intsvc+1 ;[87] next
bne .+5 ;[87]
inc intsvc+2 ;[87]
savrts rts ;[87]
;
; Print toggle command - turn printer on/off unless printer
; slot is not defined
;
prntgl: lda prnfg ;[55]
bne prnon ;[55] is printer on ? yes
prnoff lda prnsl ;[55] no, how about the slot
beq prnfal ;[55] no slot sigh!
ldx #3 ;[55] turn printer on
stx prnfg ;[55]
jsr setio2+2 ;[55] nice pr#n rtn
ldx vtmod ;[87]
cpx #2 ;[87] vt100?
beq savrts ;[87] yes may have vt102 printer stuff
jmp sutljp ;[76] set up tel term jp and rtn
;[76] rts ;[55]
prnfal:
ldx #ermese\ ;[55] Tell user about the range error
ldy #ermese^ ;[55] ...
;[79] jsr prstr ;[55] Print the error text
;[79] jsr prcrlf ;[55] Print a crelf
jmp prstrl ;[79] let it do a rts
;[79] rts ;[55] Go to top
prnon: lda #0 ;[55] turn printer off
sta prnfg ;[55]
;[78] ldx dsptyp ;[55] is this 80 col video ?
;[78] bpl prn40 ;[55] no
;[78] lda dsp2 ;[55] get 80 col slot
;[78]prn40: jsr setio2+2 ;[55] and set proper display
jsr sutljp ;[76]
;[76] jsr test2e ;[58] just in case its //e 80 col
;[78] jmp test2e ;[76] just in case its //e 80 col
jmp sucout ;[78] do it all & rts
;[76] rts ;[55] thats all
sutljp lda prnfg ;[76] set up tel term type jump
bne sutlj2 ;[76] if printer is on forget about type
lda vtmod ;[76] now let see what terminal we are
beq sutlj4 ;[76] just monitor the line
cmp #1 ;[76]
beq sutlj2 ;[76] none
cmp #2 ;[76]
beq sutlj6 ;[76] vt 100
ldx #vt52\ ;[76] vt52 i hope
ldy #vt52^ ;[76]
;[85]sutljc stx tl0jmp+1 ;[76]
sutljc ;[85]
lda #$48 ;[85] its a pha
bit dsptyp ;[85] are we 80 col?
bpl .+4 ;[85] no
lda #$60 ;[85] ist a rts
sta curon ;[85] speed it up (hope hope hope)
sta curoff ;[85] "
lda #$c9 ;[85] its a cmp #
bit flowfg ;[85] flow control?
bmi .+4 ;[85] yes
lda #$60 ;[85] its a rts
sta ckflow ;[85] speed things up (i hope)
lda #$ae ;[85] its a ldx abs
bit flowfg ;[85] flow control?
bmi .+4 ;[85] yes
lda #$60 ;[85] its a rts
sta fflow ;[85] speed things up (i hope)
lda logfg ;[85] are we logging?
bne sutlj0 ;[85] yes
inx ;[85]
inx ;[85]
inx ;[85]
cpx #3 ;[85] did we carry?
bge sutlj0 ;[85] no
iny ;[85] yes make it right
sutlj0 ;[85]
stx tl0jmp+1 ;[85]
sty tl0jmp+2 ;[76]
rts ;[76] bye
sutlj2 ldx #tl0pr4\ ;[76] forget the term emulation stuff
ldy #tl0pr4^ ;[76]
jmp sutljc ;[76] common return
sutlj4 ldx #prchrl\ ;[76] monitor the input to the screen
ldy #prchrl^ ;[76]
jmp sutljc ;[76]
sutlj6 ldx #vt100\ ;[76]
ldy #vt100^ ;[76]
jmp sutljc ;[76]
;[87]prscr ldx #0 ;[80] must be 0 for rest of rtn to work
;[87] stx kwrk01 ;[80] this is entry in prstab
;[87]prsadd lda kwrk01 ;[80] table is 2 bytes each
;[87] pha ;[80] save the current line number
;[87] lsr a ;[80]
;[87] and #3 ;[80]
;[87] ora #4 ;[80]
;[87] sta a1h ;[80] high order byte of address
;[87] pla ;[80] now get the original line #
;[87] and #$18 ;[80]
;[87] bcc .+4 ;[80] hate to do this
;[87] adc #$7f ;[80]
;[87] sta a1l ;[80] part of the lsb
;[87] asl a ;[80]
;[87] asl a ;[80]
;[87] ora a1l ;[80]
;[87] sta a1l ;[80] finally
;[87] jsr calca1 ;[87] calc a1 depending on line #
;[87] ldy #0 ;[80] start at col 0
;[87] sty kwrk02 ;[80]
;[87]prsnx ldy dsptyp ;[80] is this 80 col?
;[87] bpl prs40c ;[80] no
;[87] sta $c055 ;[80] get evens
;[87] lda (a1l,x) ;[80] this is why x must be 0
;[87] sta $c054 ;[80] now for the odds, arggggggggggggggggg
;[87] jsr prsguc ;[80] correct for upper case inverse
;[87] jsr cout ;[80] and send it to printer
;[87]prs40c lda (a1l,x) ;[80] this is why x must be 0
;[87] jsr prsguc ;[80] correct for upper case inverse
;[87] jsr cout ;[80] and send it to printer
;[87] inc a1l ;[80] next ch
;[87] bne prs01 ;[80] hate to do this
;[87] inc a1h ;[80]
;[87]prs01 inc kwrk02 ;[80] bump ch cnt
;[87] lda #40 ;[80]
;[87] cmp kwrk02 ;[80] have we got the whole line?
;[87] bne prsnx ;[80] no
;[87] lda #hcr ;[80] yes, terminate line ready for next line
;[87] jsr cout ;[80]
;[87] inc kwrk01 ;[80]
;[87] lda #24 ;[80] have we finished the screen?
;[87] cmp kwrk01 ;[80]
;[87] bne prsadd ;[80] no
;[87] rts ;[80] yes thats all folks
prscr ldx #prsgts^ ;[87] set up get from scren
ldy #prsgts\ ;[87]
jsr scrsvr ;[87]
ldx #prseol^ ;[87] set up end of line work
ldy #prseol\ ;[87]
jsr ssceln ;[87]
ldx #0 ;[87] now for the range +1
ldy #24 ;[87]
jsr ssclns ;[87]
jmp scrrtn ;[87] now do the sceen & rts
prseol lda #hcr ;[87]
jmp cout ;[87] print and rts
prsgts lda (a1l,x) ;[87] get ch from screen
sta $c054 ;[87] back to bank
and #$7f ;[87] turn off neq ascii
cmp #$20 ;[87] a control ch?
bpl .+4 ;[87] no
ora #$40 ;[87] yes make it upper case
jmp cout ;[87] print & rts
;[87]prsguc and #$7f ;[80] turn off neq ascii
;[87] cmp #$20 ;[80] a control ch?
;[87] bpl .+4 ;[80] no
;[87] ora #$40 ;[80] yes make it upper case
;[87] rts ;[80]
scrrtn ldx #0 ;[87] must be 0 for rest of rtn to work
scrstl ldy #99 ;[87] starting line
sty kwrk01 ;[87] this is entry in prstab
scrcln lda kwrk01 ;[87] table is 2 bytes each
pha ;[87] save the current line number
lsr a ;[87]
and #3 ;[87]
ora #4 ;[87]
sta a1h ;[87] high order byte of address
pla ;[87] now get the original line #
and #$18 ;[87]
bcc .+4 ;[87] hate to do this
adc #$7f ;[87]
sta a1l ;[87] part of the lsb
asl a ;[87]
asl a ;[87]
ora a1l ;[87]
sta a1l ;[87] finally
ldy #0 ;[87] start at col 0
sty kwrk02 ;[87]
scrnx bit dsptyp ;[87] is this 80 col?
bpl scrga1 ;[87] no
sta $c055 ;[87] get evens
scrg1 jsr $c000 ;[87] user exit for evens-user better $c054
scrga1 jsr $c000 ;[87] & now odds
inc a1l ;[87] next ch
bne .+4 ;[87] hate to do this
inc a1h ;[87]
inc kwrk02 ;[87] bump ch cnt
lda #40 ;[87]
cmp kwrk02 ;[87] have we got the whole line?
bne scrnx ;[87] no
screol jsr $c000 ;[87] yes, terminate line ready for next line
inc kwrk01 ;[87]
scrlln lda #99 ;[87] have we finished the screen?
cmp kwrk01 ;[87]
bne scrcln ;[87] no
rts ;[87] yes thats all folks
scrsvr stx scrg1+2 ;[87] set up users
sty scrg1+1 ;[87]
stx scrga1+2 ;[87]
sty scrga1+1 ;[87]
rts ;[87]
ssclns stx scrstl+1 ;[87] starting row
sty scrlln+1 ;[87] ending row +1
rts ;[87]
ssceln stx screol+2 ;[87] users end of line
sty screol+1 ;[87]
rts ;[87]
;
; Brkcmd - This routine checks which communication device is
; being used and takes the appropriate action to send a Break
; signal (Space condition on line for 233 ms.).
;
brkcmd:
lda #$c ;[54] command for break
jmp tl0cmd ;[54] let com do rts for us
;
; Wait - This routine will wait for some number of milliseconds.
;
; Input: A - number of milliseconds to delay
;
; Output: Nothing
;
; Regs Destroyed: A,X ;[47] Y is not changed
;
;[78]wait: ldx #202 ;[41] Count for a 1 millisecond loop
;[78] .ifeq <.\-$ff>
;[78] nop ;[41] Push to beginning of next page
;[78] .endc ;[41]
;[78] .ifeq <.\-$fe>
;[78] nop ;[41] Push to beginning of next page
;[78] nop ;[41] ...
;[78] .endc ;[41]
; does crossing a page boundary change the timing that much ?????
;[78]wait1m: dex ;[41] Count down
;[78] bne wait1m ;[41] If not done, continue
;[78] sec ;[41] Finished a millisecond
;[78] sbc #$01 ;[41] Decr # ms done
;[78] bne wait ;[41] More to do?, then go to top
;[78] rts ;[41] Done, return to caller
logput ;[56]
ldx logfg ;[56]
bpl logpt1 ;[56]
pha ;[56] save ch
jsr fputc ;[56] write ch
jmp logpt2 ;[56] error exit
pla ;[56] restore ch
logpt1: rts ;[56]
logpt2: pla ;[56] just to keep stack straight
jsr bfeerr ;[56] tell about error
sta logfg ;[56] since bfeerr returns a 0, turn off logging
rts ;[56]
.ifeq <ftcom-ftappl>
;[34] Process the character before display, so that caps and odd chars appear
;[34] as inverse.
;[46] Evade this processing if the display is something better than
; 2/2+ 40 col.
dspchr: ora #$80 ;[34] Make sure h.o. bit is set.
;[74] pha ;[46] Save the character
;[74] lda dsptyp ;[46] Is the display
;[74] cmp #ds40up ;[46] the 2/2+ one?
ldx dsptyp ;[74][46] Is the display
;[76] cpx #ds40up ;[74][46] the 2/2+ one?
bne dspch2 ;[46] If not, we can skip this processing.
;[74] pla ;[46] Else, we have to munge the character.
cmp #$c1 ;[34]
bmi dspnrm ;[34] Digit, or normal punctuation char.
cmp #$db ;[34]
bmi dspinv ;[34] Capital letter.
cmp #$e0 ;[34]
bmi dspnrm ;[34] More normal punctuation.
bne dspch1 ;[46][34] Branch if lowercase.
lda #'' ;[34] Accent grave. load a '
bne dspinv ;[34] And show it inverted.
dspch1: and #$df ;[46][34] Shift high (lowercase) char to caps.
cmp #$db ;[34]
bmi dspnrm ;[34] Lowercase letter.
;[74]dspinv: pha ;[34] Save the char.
;[74] lda #invdsp ;[34] Show as inverse.
;[74] sta invflg ;[34]
;[74]dspch2: pla ;[46][34] Restore the char.
dspinv: ;;[74][34] Save the char.
ldx #invdsp ;[74][34] Show as inverse.
stx invflg ;[74][34]
dspch2: ;;[74][46][34] Restore the char.
dspnrm:
;[85] ldx #hcr+1 ;[57] this is one of the search limits
jsr ckflow ;[57] see if flow control is on
jsr cout ;[34] Show the character.
lda #nrmdsp ;[34] Switch back to normal display.
sta invflg ;[34]
rts ;[34]
;
; check for flow control
; x must be set for the upper limit of the ch search
; the lower limit of the search is line feed
;
ckflow ;[57]
;[81] stx dspch5+1 ;[57] set the search limit
;[85] stx dspch3+1 ;[81] set the search limit
;[85] ldx flowfg ;[57] do we have flow control
;[81] bpl dspch4 ;[57] no
;[85] bpl dspch5 ;[81] no
;[76] ldx confg ;[75] are we connected to remote?
;[76] beq dspch4 ;[75] no
;[81] ldx xonfg ;[57] have we already stoped the flow ?
;[81] beq dspch5 ;[57] no
;[81] pha ;[57] save ch
;[81] ldx #0 ;[57] tattle
;[81] stx xonfg ;[57]
;[81] lda #hxon ;[57] tell remote to
;[81] jsr tl0cmd ;[57] start up again
;[81] pla ;[57] restore ch
;[81]dspch5: ;[57]
;[85]dspch3 ;[81]
cmp #hcr+1 ;[57] are we about to start the printer?
;[81] bpl dspch4 ;[57] no
bcs dspch4 ;[81] no
cmp #hlf ;[57] all chs between lf & cr
;[81] bmi dspch4 ;[57] no
bcc dspch4 ;[81] no
fflow ;[85] force flow ctnl
ldx xonfg ;[81]
bne dspch5 ;[81] are we already stopped? yes
pha ;[57] save current ch
lda #hxoff ;[57] tell remote to
sta xonfg ;[57] stop and tattle
jsr tl0cmd ;[57]
lda flowdl ;[57] get the flow delay
beq dspch8 ;[74] none so carry on
sta kwrk01 ;[57] place to dec
dspch7: jsr telcp ;[57] check the port and save the input
;[74] lda kwrk01 ;[57] thru waiting ?
;[74] beq dspch8 ;[57] yes
;[78] lda #2 ;[57] 2 ms wait
;[82] lda #25 ;[78] 2 ms wait
;[85] lda #17 ;[82] 1 ms wait
lda timect ;[85] 1 ms wait
jsr wait ;[57] and wait for it to stop
dec kwrk01 ;[57] thru ?
;[74] jmp dspch7 ;[57]
bne dspch7 ;[74]
dspch8:
pla ;[57] restore current ch
rts ;[81]
dspch4:
ldx xonfg ;[81] have we already stoped the flow ?
beq dspch5 ;[81] no
pha ;[81] save ch
ldx #0 ;[81] tattle
stx xonfg ;[81]
lda #hxon ;[81] tell remote to
jsr tl0cmd ;[81] start up again
pla ;[81] restore ch
dspch5: ;[81]
rts ;[57] thats all
;[35] Convert the character as required for the Apple loosing keyboard.
chrcon: tax ;[35] Save a copy of the char in X
lda kbdtyp ;[35] If 2e, just send it.
;[72] cmp #kbap2e ;[35]
;[72] beq chclrs
bne chclrs ;[72]
lda kbmode ;[35] Ditto if in literal mode
cmp #kmlit ;[35]
beq chclrs ;[35]
cpx #lftarw ;[35] If left arrow, send a delete
bne chrco1 ;[35]
ldx #$7f ;[35]
bne chclrs ;[35]
chrco1: cpx #'A ;[35] Is this a letter?
bmi chnoaz ;[35] branch if too low.
cpx #'[ ;[36] Left square brace, follows Z.
bpl chnoaz ;[35] Branch if too high for letter.
lda kbcase ;[35] Decide if it needs lowercase.
eor kbmode ;[35] Weird, but it works
beq chclrs ;[35] Send uppercase, no modification.
txa ;[35]
ora #$20 ;[35] Lowercase it.
tax ;[35]
bne chclrs ;[35]
chnoaz: lda #kmpref ;[35] Is this char prefixed?
cmp kbmode ;[35]
beq chspec ;[35] Branch if so.
cpx #rhtarw ;[35] Was this a right-arrow?
bne chclrs ;[35] No. just send char.
sta kbmode ;[35] Else set prefix mode
bpl chpopr ;[35] And dont send char.
; Is it one of the special, prefixed characters?
chspec: ldy #$00 ;[35] Set up index to step thru table
txa ;[35]
chslop: pha ;[35] Top of loop
lda chrtab,y ;[35] Get 1st half of 2-byte pair
bmi chesc ;[35] $FF is end of table.
pla ;[35] Get our character.
cmp chrtab,y ;[35] Compare it with the table entry.
beq chrrep ;[35] Match. Go replace it.
iny ;[35] No match. Step onto next
iny ;[35] Byte pair.
bne chslop ;[35] And test it.
chrrep: iny ;[35] Second half of pair is the replacment.
lda chrtab,y
tax ;[35] So put it in X.
bpl chclrs ;[35] And send it.
;Are we trying to enter literal mode? Prefix-Escape does this.
chesc: pla ;[35] Get the char from where chspec put it.
cmp #esc ;[35] Is it escape?
bne chtogg ;[35] No. check for case toggle.
lda #kmlit ;[35] Yes. set mode to literal.
sta kbmode ;[35] And store it.
bpl chpopr ;[35] Return without sending char.
chtogg: cpx #rhtarw ;[35] Was it another right-arrow?
bne chclrs ;[35] No. just send it & clear mode.
lda kbcase ;[35] Get the current default case
eor #$01 ;[35] Flip it.
sta kbcase ;[35] Store it.
lda #kmnorm ;[35] Set mode to normal.
sta kbmode ;[35] ...
bpl chpopr ;[35] Return without printing the char.
;Clear mode and send the character.
chclrs: lda #kmnorm ;[35] Clear the mode.
sta kbmode ;[35]
txa ;[35] Get the char into A.
chclrt rts ;[35] Return normally.
;Return via skip return, without sending the char. This pops the latest return
;address off the stack, revealing the next one down. It then does a retskp,
;matching the telppc routine.
chpopr: pla ;[35] Pop off the latest return address
pla ;[35]
jmp rskp ;[35] And return skip.
.endc
;
; Vt52 - will carry out the equivalent of most of the vt52 functions
; available.
;
vt52:
jsr logput ;[76]
ldx escflg ;[58] Was previous character an escape?
bne vt527 ;[58] yes
;[81] cmp #del ;[58] Was it a delete?
;[81] beq chclrt ;[58] If so, return
cmp #si ;[73] is this vms sending this rediculus ch
beq chclrt ;[73] yes just forget it
cmp #esc ;[58] Was it an 'escape'?
bne vt523 ;[58] If not, just output the character
lda #on ;[58] Set the escape flag on
sta escflg ;[58] ...
vt522 jmp tl0prc ;[58] Go try for another character
vt523 jsr curoff ;[58] turn cur off
cmp #tab ;[58] lets cover horizontal tabs
beq vt524 ;[58] not this one
jmp vtig1 ;[58] just output the ch
vt524 lda hch ;[58] get the horiz position
and #7 ;[58] now for the remainder of div by 8
eor #7 ;[58] now complement it
tax ;[58] into x
vtloop jsr advanc ;[58] move cursor right one
dex ;[58] all thru spacing ?
bpl vtloop ;[58] no
jmp tl0prc ;[58] next
vt527 ;[58]
jsr curoff ;[31] turn off the cursor
lda #off ; First, turn off the escape flag
sta escflg ; ...
;[74] tya ; Get the character to check
lda ksavea ;[74] restore input ch
cmp #'A ; It is, is it an 'A'?
bne vt52a ; No, try next character
vt52a0 jsr dchcv ;[78] check for the top
bcc vt52b2 ;[78] yes
lda #$1f ;[78] this is up one line
jmp cout ;[78] doit and rtn
;[78] jsr upline ; Go up one line
;[78] jmp vt52rt ;[31] Turn on cursor and return
vt52a: cmp #'B ; Is it a 'B'?
bne vt52b ; Next char
vt52a2 jsr bphcv ;[78] check for the bottom
bcs vt52b2 ;[78] yes dont move down
lda #$a ;[78] line feed
jmp cout ;[78] doit and let cout rtn
;[78] jsr lfeed ; Yes, do a line feed
;[78] jmp vt52rt ;[31] Turn on cursor and return
vt52b: cmp #'C ; 'C'?
bne vt52c ; Nope
vt52b1 lda #79 ;[78]
cmp hch ;[78] have we gone too far?
beq vt52b2 ;[78] yes, forget about the movement
jsr advanc ; Yes, go forward one space
vt52b2 ;[78]
jmp vt52rt ;[31] Turn on cursor and return
vt52c: cmp #'D ; 'D'?
bne vt52d ; No
;[76] dec hch ;[58] back up one,do this for 80 col
;[76] bpl vbsp2 ;[58] too far ? no
;[76] inc hch ;[58] yes stay at left side
;[76]vbsp2 jsr bsp ;[58] now do the movement
;[78] jsr bsp ;[76] let backspace keep track of ch
vt52c2 jsr dchch ;[78]
bcs vt52b2 ;[78] too far ignore it
lda #bs ;[78] now do a back space
jsr cout ;[78]
jmp vt52rt ;[31] Turn on cursor and return
vt52d: cmp #'G ;[73] is this exit graphics?
;[76] beq vt52rt ;[73] yes currently just ignor it
beq vt52gg ;[76] yes tell
cmp #'F ;[76] how about special graphics?
beq vt52ff ;[76] yes set it up
cmp #'H ; 'H'?
bne vt52e ; No, try next character
lda #$00 ; Zero out
sta ch ; cursor horizontal
sta cv ; and cursor vertical
jsr vtab ; And then set the line base address
jmp vt52rt ;[31] Turn on cursor and return
vt52e: cmp #'I ; 'I'?
bne vt52f ; Nope
;[76] lda cv ; Get the vertical cursor position
;[76] beq vt52e1 ; Do reverse scrolling
vt52ri lda hcv ;[76]
cmp wndtop ;[76] are we at the top?
beq vt52e1 ;[76] yes do reverse scrool
;[86] jsr upline ; Otherwise, just go up one line
ldx hcv ;[86] apple rom wont move above region
beq vt52rj ;[86] dont go above 0
dex ;[86]
stx cv ;[86] tell it where to go
lda hch ;[86]
sta ch ;[86]
jsr pos80c ;[86] move up this way
vt52rj ;[86]
jmp vt52rt ;[31] Turn on cursor and return
;[76]vt52e1: lda #hlf ;[58] this may take some time
;[76] ldx #hcr ;[58]
;[76] jsr ckflow ;[58] is case we must wait
vt52e1 jsr fflow ; force the flow stop
jsr vrscrl ; Do the reverse scroll
jmp vt52rt ;[31] Turn on cursor and return
vt52f: cmp #'J ; 'J'?
bne vt52g ; No
jsr clreop ; Clear from where we are to end-of-page
jmp vt52rt ;[31] Turn on cursor and return
vt52g: cmp #'K ; 'K'?
bne vt52h ; Try last option
jsr clreol ; Clear to end-of-line
jmp vt52rt ;[31] Turn on cursor and return
vt52h: cmp #'Y ; 'Y'
;[75] bne vtig ; Must be an unimplemented function, do vtig
bne vt52eq ;[75] try next
jsr vtdca ; Do direct cursor addressing
jmp vt52rt ;[31] Turn on cursor and return
vt52ff inc vtcso ;[76] use vt100 sp graphics for now
rts ;[76]
vt52gg lda #0 ;[76] turn off spec graphics
sta vtcso ;[76]
rts ;[76]
vt52ac lda #2 ;[80] switch to vt100
sta vtmod ;[80]
jsr sutljp ;[80] set it up
rts ;[80]
vt52ao lda #0 ;[80]
vt52ap sta kpafl ;[80] turn on/off application mode
jmp vt52rt ;[80]
vt52eq cmp #'= ;[75] how about alt keypad
;[80] beq vt52rt ;[75] yes, currently just ignore
beq vt52ap ;[80] set application mode
cmp #'> ;[80] how about keypad
beq vt52ao ;[80] set numeric mode
cmp #'< ;[80] how about switching to vt100
beq vt52ac ;[80] yup
cmp #'w ;[85] wrap on
beq h19wn ;[85]
cmp #'v ;[85] wrap off
beq h19wf ;[85]
cmp #'x ;[85] h19 set modes
beq h19mds ;[85]
cmp #'y ;[85] h19 reset modes
beq h19mds ;[85]
cmp #'Z ;[76] is this identify terminal
bne vtig ;[76] no
lda #esc ;[76]
jsr telppc ;[76]
lda #'/ ;[76]
jsr telppc ;[76]
lda #'K ;[76]
jsr telppc ;[76]
jmp vt52rt ;[76]
h19wn inc wrapar ;[85] h19 wrap on
rts ;[85]
h19wf lda #0 ;[85] h19 wrap off
sta wrapar ;[85]
rts ;[85]
h19mds jsr telcp ;[85] ignore next ch
beq h19mds ;[85]
jsr telgpc ;[85]
jsr logput ;[85] in case were loging
rts ;[85]
vtig: ora #$80 ; Set the H.O. bit for output
pha ; Save a copy
lda #hesc ; Get an escape
jsr vprchr ; Print the special character
pla ; Fetch the other character back
cmp #esc ; Is it a second escape?
bne vtig1 ; Nope, print it
lda #on ; Set escflg on again for next time around
sta escflg ; ...
jmp vt52rt ;[31] Turn on cursor and return
;[76]vtig1: jsr vprchr ; Print the character
;[78]vtig1: jsr vt1003 ;[76] check for sp graphics & pr ch
vtig1: jsr vt1002 ;[78] check for sp graphics & pr ch
;[78]vt52rt: jsr curon ;[31] Turn on cursor
vt52rt: jmp curon ;[78][31] Turn on cursor & rts
vt5rts rts ; Return
;[85]vprchr cmp #cr ;[58] is this cr ?
vprchr cmp #del ;[85] decs bs
beq vt52rt ;[85] yes forget it
cmp #' ;[85] a control ch?
bge vprch7 ;[85] no speed this up
cmp #cr ;[85] is this cr ?
bne vprch0 ;[58] no
vpracr ;[76]
lda #0 ;[58] position to start of line
sta ch ;[58]
sta hch ;[58] just in case were counting
ldx dsptyp ;[62] is this 40 col
;[76] bpl vt5rts ;[58] yes
bpl vt52rt ;[76][58] yes
vprch3 ;[84] so we can position not line feed
lda hcv ;[76]
sta cv ;[76] keep track
jmp pos80c ;[58] yes position to start of line
vprch0 cmp #lf ;[58] is this a line feed ?
bne vprchw ;[58] no
;[76] ldx dellf ;[58] should we ignore this one ?
;[76] beq vprchb ;[58] no let card handle cv
;[76] bne vprch2 ;[76] no let lfeed handle cv
vprchl ;[86] lf,ff & vt
lda vtmod ;[76]
cmp #2 ;[76] is this vt100 mode
beq vprchm ;[76] yes
jmp lfeed ;[76] no just do the lf
;[84]vprchm lda #$e ;[76] make it normal video
;[86]vprchm lda hch ;[84] in case the region is above us
vprchm ;[86]
lda vtcnlm ;[86] how about new line mode
beq vprchn ;[86] reset
jsr vpracr ;[86] set, position to start of line
vprchn ;[86]
lda hch ;[84] in case the region is above us
sta ch ;[84]
jsr bphcv ;[84] incrememt hcv
cpy wndbtm ;[85] y=hcv
bne vprch3 ;[84] were not about to scroll
lda #$e ;[76] make it normal video
jsr cout ;[76] in case this causes a scrool
jsr lfeed ;[76] now do the lf
lda vtcsgr ;[76] and restore the video
jmp cout ;[76] & let cout do the rtn
;[76] ldx #off ;[58] only once
;[76] stx dellf ;[58]
;[76] beq vt5rts ;[58] yes ignore this, always jump
;[76] beq vt52rt ;[76][58] yes ignore this, always jump
vprchw cmp #bs ;[58] how about a back space
;[81] bne vprchd ;[58] no
;[85] bne vprchy ;[81] no
bne vprchd ;[85] no
jmp vt52c2 ;[78] do the backup thing
;[85]vprchy cmp #del ;[81] how about a del(decs back space)
;[85] bne vprchd ;[81] no
;[85] jmp vt52rt ;[81] ignore it
;[78] dec hch ;[58] yes back up
;[78] bmi vprcha ;[58] too far ? yes
;[78] bpl vprchb ;[58] no, now do the back up
;[76]vprchx ldx #hcr ;[58] at the right edge, cursor causes scroll
vprchx ;[76]
;[78] pha ;[58] save the current ch
;[76] lda #hlf ;[58] make it think we should stop
;[76] jsr ckflow ;[58] so we got to check for flow
; jsr fflow ;[76] force the flow check
;[76] sta dellf ;[58] turn on flag
;[78] lda wrapar ;[76] are we wrapping arround?
ldx wrapar ;[78] are we wrapping arround?
;[78] beq vprchy ;[76] no
beq vt5rts ;[78] no, do nothing
pha ;[78]
jsr vpracr ;[76] yes first a cr
jsr lfeed ;[76]
;[78]vprchy ;[76]
pla ;[58] restore current ch
bne vprch7 ;[85] keep track of pos
;[76] ldx #0 ;[58]
;[76] stx hch ;[58] let us know its the start of the line
;[76] jsr bphcv ;[76] bump hcv if not at window bottom
;[78] ora #$80 ;[58] so it will print
;[78] jmp cout ;[58] do it
vprchd ;[58]
cmp #ffd ;[86] form feed is like a lf
beq vprchl ;[86]
cmp #ctrlk ;[86] vertical tab is like a lf
beq vprchl ;[86]
;[76] ldx #off ;[58] turn off lf delete
;[76] stx dellf ;[58]
;[76] ldx #80 ;[58]
;[76] ldy dsptyp ;[62] is this 80 col display?
;[76] bmi .+4 ;[62] hate to do this
;[76] ldx #40 ;[62] no
;[76] cpx hch ;[58] too far ?
;[76] beq vprchx ;[58] just right this should cause scroll
cmp #bel ;[82]
;[85] bne vprche ;[82]
bne vprchb ;[85]
;[85] fflow prsevers a reg pha ;[82] save it
jsr fflow ;[82] stop this while ring ring
;[85] pla ;[82] now ring those bells
;[86] bne vprchb ;[82]
jmp vprchb ;[86] dono how it got past the bne
;[85]vprche ;[82]
;[85] cmp #' ;[78] is this control ch?
;[85] bcc vprchb ;[78] yes, forget about keeping track
vprch7 ;[85]
ldx hch ;[76]
cpx wndwth ;[76] this is 40 or 80
bcs vprchx ;[76] too much,yes
;[85] inc hch ;[58] move one right
inx ;[85] is quicker this way
;[76] bpl vprchb ;[58] no
;[76] bne vprchb ;[76] no
;[78] bcc vprchb ;[76] always jump
;[78]vprcha ldx #0 ;[58] start at left edge of screen
;[78] stx hch ;[58]
;[85] ldx $fbb3 ;[78]
;[85] cpx #6 ;[78] is this a //e or above ?
;[85] bne vprchb ;[78] no forget about 24 x 80 position
;[85] ldx hch ;[78]
stx hch ;[85] speed?
;[84] cpx #80 ;[78] cludge to not write
cpx wndwth ;[84] cludge to not write
bne vprchb ;[78] in last position
;[86] ldx hcv ;[78] of screen **** stupid ****
;[83] cpx #23 ;[78]
;[86] inx ;[83]
;[86] cpx wndbtm ;[83] use end of scrooling region
;[84] bne vprchb ;[78]
;[86] blt vprchb ;[84]
;[86] ldx $fbb3 ;[85]
;[86] cpx #6 ;[85] is this a //e or above ?
;[86] bne vprchb ;[85] no forget about 24 x 80 position
;[87] ldx itse80 ;[86] //e or better?
ldy itse80 ;[87] //e or better?
beq vprchb ;[86] no forget about 24 x 80 position
ldy #39 ;[78] depend upon cursor
sta (basl),y ;[78] being in correct position & overwrite
dex ;[87] hope this moves cursor but not scrool
stx ch ;[87]
lda hcv ;[87]
sta cv ;[87]
jsr pos80c ;[87] let rom know where we are
inc hch ;[87] now back
rts ;[78] cant write it or it will scrool
vprchb ora #$80 ;[58] make it printable
;[85] ldx #hcr ;[57] range of test is cr-1 thru lf
jsr ckflow ;[57] now check for flow control
jmp cout ;[58] and print ch
;[62]vprch1 jmp prchr ;[58] print ch
vrscrl: lda dsptyp ;[58] we may have an 80 col
bpl vrscr0 ;[58] that will do this! sigh! no
lda #$16 ;[58] a syn does reverse scroll ?
jmp cout ;[58] maybe else were no better than we were
vrscr0 ;[58] do it the hard way
lda wndbtm ; Start at bottom of window
pha ; Save ac
jsr vtabz ; Generate base address
vrsc1: lda basl ; Move basl,h to bas2l,h
sta bas2l ; ...
lda bash ; ...
sta bas2h ; ...
;[76] ldy #0 ;[58] got to start at first ch
ldy wndwth ;[76] doesnt mater which order you move
dey ;[76] but count must be -1
pla ; Get window bottom
sec ; Decrement by one
sbc #$01 ; ...
cmp wndtop ; Are we done?
;[76] bcs vrsc3 ; Yup
bmi vrsc3 ;[76] Yup
pha ; Save new line number
jsr vtabz ; Generate this line's base address
vrsc2: lda (basl),y ; Move a character down a line
sta (bas2l),y ; ...
;[76]vrsc2b cpy wndwth ;[58] are we at the edge of the window ?
;[76] beq vrsc2c ;[58] not yet
;[76] bpl vrsc1 ;[58] yes get next line up
;[76]vrsc2c iny ;[58] ready for next ch
;[76] jmp vrsc2 ;[58]
dey ;[76] next
bpl vrsc2 ;[76] theres more
bmi vrsc1 ;[76] next line
;[76]vrsc3: ldy #0 ;[58] set for top line
vrsc3: ldy wndtop ;[76][58] set for top line
sty cv ;[58]
jsr scrl3 ; Clear the entire top line
rts ; Return
vtdca: jsr telcp ; Check for a character from the port
beq vtdca ; Try again
jsr telgpc ; Get the character waiting at the port
jsr logput ;[56] may be loging
and #$7f ; Make sure H.O. bit is off
sec ; Subtract hex 20 (make it num from 0 to 23)
sbc #$20 ; ...
bpl vtdca1 ; No, continue
vtdca9 clc ; Clear carry
adc #$20 ; Add this back in
jmp vtig ; Now ignore it as a control paramenter
vtdca1: cmp #24 ; Is it too large?
bpl vtdca9 ;[58] yes
vtdca2: sta hcv ; Store it as the vertical cursor position
vtdca3: jsr telcp ; Check port for character
beq vtdca3 ; go back and try again
jsr telgpc ; Get the character waiting at the port
jsr logput ;[56] may be loging
and #$7f ; Make sure H.O. bit is off
sec ; Subtract hex 20 (make it num from 0 to 23)
sbc #$20 ; ...
bmi vtdca9 ;[58] too small
vtdca4: cmp #80 ; Is it too large?
bpl vtdca9 ;[58] yes
vtdca5: sta ch ; Store it as the horizontal cursor position
sta hch ;[58] save this for our count
lda hcv ; Move this to the real position now
sta cv ; ...
jsr vtab ; Now place the cursor there
rts ; and return
dchch pha ;[76] dec hch
clc ;[78] clear carry for ok
dec hch ;[76]
bpl dchchr ;[76] too far?,no
inc hch ;[76] yes
sec ;[78] set carry for too far
dchchr pla ;[76]
rts ;[76]
dchcv pha ;[76] dec hcv
dec hcv ;[76] up one line
lda hcv ;[76]
cmp wndtop ;[76] but not too far
bcs dchcvr ;[76] ok? yes
inc hcv ;[76] no
dchcvr pla ;[76]
rts ;[76]
;[84]bphcv pha ;[76] bump hcv
;[84] inc hcv ;[76]
;[84] lda hcv ;[76]
;[84] cmp wndbtm ;[76] too far? rem wndbtm is +1
;[84] bcc bphcvr ;[76] no
;[84] dec hcv ;[76]
;[84] lda #0 ;[84] make the status beq
;[84]bphcvr pla ;[76]
;[84] rts ;[76]
bphcv ldy hcv ;[84] bump hcv unless scrolling
iny ;[84]
cpy wndbtm ;[84] at window bottom?
beq bphcvr ;[84] yes no change we should scroll
cpy #24 ;[85] dont go off the screen
bge bphcvr ;[85]
sty hcv ;[84] bump hcv
bphcvr rts ;[84]
vtc2i ;[87] VT102 PRINTER ON/OFF CODE
lda vtcpar ;[87]
cmp #4 ;[87] is this printer off?
bne vtc2i3 ;[87] no
jsr prnon ;[87] yes turn printer off
jmp vtccom ;[87] bye
vtc2i3 cmp #5 ;[87] how about printer on?
bne vtc2i7 ;[87] no,just ignore it maybe it will go away
jsr prnoff ;[87] yes try and turn it on
vtc2i7 jmp vtccom ;[87] bye
vtclb jsr telcp ;[79] LINE SIZE ETC
beq vtclb ;[79]
jsr telgpc ;[79] now get the next ch
jsr logput ;[79] fputc adds the $80
jmp vtccom ;[79] bye
vtcglp ;[76] G0 CHARACTER SET
;[78] jsr telcp ;[76] gpet the next ch we need it
;[78] beq vtcglp ;[76]
;[78] jsr telgpc ;[76] now get the next ch
;[78] and #$7f ;[76] make it ascii
;[78] jsr logput ;[76] just in case were loging
;[78] jmp vtcgr2 ;[76] spill it
lda #1 ;[78] this is mask for bit 0
jmp vtcgr0 ;[78] together again
vtcgrp ;[76] G1 CHARACTER SET
lda #2 ;[78] mask for bit 1
vtcgr0 sta kwrk01 ;[78] save the mask
vtcgr7 ;[78]
jsr telcp ;[76] get the next ch we need it
;[78] beq vtcgrp ;[76]
beq vtcgr7 ;[76] wait for next ch
jsr telgpc ;[76] now get the next ch
and #$7f ;[76] make it ascii
jsr logput ;[76] just in case were loging
cmp #'B ;[76]
beq vtcgr4 ;[76]
cmp #'A ;[78] uk set will be the same
beq vtcgr4 ;[78]
cmp #'1 ;[78] alt rom will be the same
beq vtcgr4 ;[78]
cmp #'2 ;[78] alt rom special graphics is the same
beq vtcgr1 ;[78]
cmp #'0 ;[76] are we drawing lines etc?
;[78] bne vtcgr2 ;[76] no
beq vtcgr1 ;[78] yes
;[78]vtcgr2 jsr svnisc ;[76] save this one for spill
jsr svnisc ;[78] save this one for spill
jmp vtcspl ;[76] tattle
;[78]vtcgr1 inc vtcscs ;[76] now tell we need g1 ch set
vtcgr1 lda kwrk01 ;[78] get the mask
ora vtcscs ;[78]
sta vtcscs ;[78]
jmp vtccom ;[76]
;[78]vtcgr2 jsr svnisc ;[76] save this one for spill
;[78] jmp vtcspl ;[76] tattle
;[78]vtcgr4 lda #0 ;[76] turn off the special graphics
vtcgr4 lda kwrk01 ;[78]
eor #$ff ;[78] complement it
and vtcscs ;[78] this clears the bit
sta vtcscs ;[76]
jmp vtccom ;[76]
vtc7 lda hcv ;[76] SAVE CURSOR
sta ohcv ;[76] first hcv
lda hch ;[76]
sta ohch ;[76] and now hch
lda vtcscs ;[76] save the ch set
sta ovtcsc ;[76]
lda vtcso ;[78] save the graphics in action flags
sta ovtcso ;[78]
lda vtcsgr ;[76] save the graphics rendition
sta ovtcsg ;[76]
jmp vtccom ;[76] thats all
vtc8 lda ohcv ;[76] RESTORE CURSOR
sta cv ;[76] pos80c will set hcv & hch
lda ohch ;[76]
sta ch ;[76]
jsr pos80c ;[76] now reposition
lda ovtcsc ;[76] restore the ch set
sta vtcscs ;[76]
lda ovtcso ;[78] restore the graphics in action flags
sta vtcso ;[78]
lda ovtcsg ;[76] restore the graphics rendition
sta vtcsgr ;[76]
jsr cout ;[76]
jmp vtccom ;[76] bye
;[85]vtcqmk inc vtcqmf ;[76] tell that we have a ?
vtcqmk ;[85] not used
rts ;[76]
vtca lda #0 ;[80] KEYPAD NUMERIC MODE
vtc9 sta kpafl ;[80] KEYPAD APPLICATION MODE
jmp vtccom ;[80] application better not be first in table
vtc2ll ;[76] RESET MODES
; lda vtcqmf ;[76] was there a ?
; beq vtcll0 ;[76]
lda vtcpar ;[76]
cmp #1 ;[76] was the param a 1?
beq vtcll2 ;[76] yes, cursor key mode
cmp #6 ;[76]
beq vtcll8 ;[76] origin mode - absolute
cmp #5 ;[78]
;[80] beq vtcll6 ;[78] screen mode normal-we cant do anything
beq vtclla ;[80] screen mode normal
cmp #2 ;[80] switch to vt52?
beq vtcllc ;[80] yes
cmp #3 ;[76]
beq vtcll6 ;[76] 80 col mode
cmp #4 ;[76]
beq vtcll6 ;[76] scroll mode - jump
cmp #8 ;[76]
beq vtcll6 ;[76] auto repeat - off
cmp #7 ;[76]
beq vtcll5 ;[76] wraparound off
cmp #20 ;[76]
;[86] beq vtcll6 ;[76] its line feed
beq vtclld ;[86] its line feed
vtcll0 jmp vtcspl ;[76] no dont understand this one, tattle
vtcll2 lda #off ;[76] clear the vt100 mode flag
vtcll3 ;[82]
sta vtcmod ;[76]
jsr scurst ;[82]
jmp vtccom ;[76]
vtcll5 lda #off ;[76] maybe we should check for the ?
sta wrapar ;[76] no wrap arround
vtcll6 jmp vtccom ;[76]
vtcll8 lda #0 ;[78] set abs mode
sta vtcorm ;[78]
jmp vtccom ;[78]
vtclla ;[80]
lda #$e ;[80] normal video
vtcllb sta vtcsgr ;[80] save special graphics rendition
jsr cout ;[80]
jmp vtccom ;[80]
vtcllc lda #3 ;[80] switch to vt52
sta vtmod ;[80]
jsr sutljp ;[80] setup term
jmp vtccom ;[80]
scurst lda #'O ;[82] assume set
ldy vtcmod ;[82]
bne scurs3 ;[82]
lda #'[ ;[82] its reset
scurs3 sta cufksc+1 ;[82] now set vt100 cursor keys
sta bsfksc+1 ;[82] appropiately
sta ckfksc+1 ;[82]
sta cjfksc+1 ;[82]
rts ;[82]
vtclld lda #0 ;[86] reset line feed
vtclht sta vtcnlm ;[86] new line mode
jmp vtccom ;[86]
vtc2lh ;[76] SET MODES
; lda vtcqmf ;[76] was there a ?
; beq vtcll0 ;[76] no dont know what this is
lda vtcpar ;[76]
cmp #1 ;[76]
beq vtclh2 ;[76] cursor keys
cmp #7 ;[76] how about wrap arround?
beq vtclh4 ;[76] yes
cmp #5 ;[78] how about reverse screen?
;[80] beq vtcll6 ;[78] yes - we cant do anything
beq vtclh8 ;[80] yes
cmp #6 ;[78] how about relative origin?
beq vtclh6 ;[78] yes
cmp #8 ;[76]
beq vtcll6 ;[76] auto repeat - on
cmp #20 ;[86] new line
beq vtclht ;[86] yup set it
jmp vtcspl ;[76] tattle, we dont know this one
;[82]vtclh2 inc vtcmod ;[76] tell were using "O"
;[82] jmp vtccom ;[76]
vtclh2 lda #on ;[82] for set
jmp vtcll3 ;[82]
vtclh4 lda #on ;[76]
sta wrapar ;[76] yes we will wrap arround
jmp vtccom ;[76] thats all
vtclh6 inc vtcorm ;[78] set relative origin for the region
jmp vtccom ;[78]
vtclh8 lda #$f ;[80] inverse video
jmp vtcllb ;[80] common code
vtlesc lda #esc ;[76] 2 esc in a row
dec nisc ;[76]
jmp prchr ;[76] print a ^$ and let it rts
vtc2bp inc vtcpnm ;[76] next param
rts ;[76]
vtcpsq inc vtcesc ;[76] its a [ so look for parms
rts ;[76]
;[78]vtc2b jsr lfeed ;[76] its a LINE FEED
vtc2b jsr vt52a2 ;[78] its a LINE FEED
dec vtcpar ;[76] 1st param
beq vtc2b2 ;[76]
bpl vtc2b ;[76] another line feed
vtc2b2 jmp vtccom ;[76] common
;[78]vtc2d jsr bsp ;[76] its a BACKSPACE
vtc2d jsr vt52c2 ;[78] use this so we keep track of where we are
dec vtcpar ;[76] 1st param
beq vtc2d2 ;[76] thats all
bpl vtc2d ;[76] another
vtc2d2 jmp vtccom ;[76]
;[78]vtc2c jsr advanc ;[76] FORWARD SPACE
vtc2c jsr vt52b1 ;[78] FORWARD SPACE
dec vtcpar ;[76] 1st parm
beq vtc2c2 ;[76] more? no
bpl vtc2c ;[76] yes
vtc2c2 jmp vtccom ;[76]
vtc2h lda vtcpar ;[76] 1st param POSITION
beq vtc2h2 ;[76]
sec ;[76]
sbc #1 ;[76]
vtc2h2 sta cv ;[76]
ldx vtcorm ;[78] is this relative origin?
beq vtc2h3 ;[78] no its absolute
clc ;[78] yes add the top
adc wndtop ;[78]
sta cv ;[78] now set the new origin
vtc2h3 ;[78]
cmp #25 ;[87] are we off the screen?
blt vtc2h7 ;[87]
ldx #24 ;[87] yes, too big
dex ;[87] force bottom
stx cv ;[87]
vtc2h7 ;[87]
lda vtcpar+1 ;[76] 2nd param
beq vtc2h4 ;[76]
cmp wndwth ;[87] are we beyond the edge?
blt vtc2h9 ;[87]
lda wndwth ;[87] yes bring it back
vtc2h9 ;[87]
sec ;[76]
sbc #1 ;[76]
vtc2h4 sta ch ;[76]
jsr pos80c ;[76] position to it
jmp vtccom ;[76]
;[78]vtc2a jsr upline ;[76] UP ONE
vtc2a jsr vt52a0 ;[78] UP ONE
dec vtcpar ;[76] 1st param
beq vtc2a2 ;[76] default
bpl vtc2a ;[76] another? yes
vtc2a2 jmp vtccom ;[76] thats all
vtc2j ;[76] - ERASING SCREEN
lda #$e ;[76] make it normal
jsr cout ;[76] while we erase
lda vtcpar ;[76] 1st param
;[82] beq jcleop ;[76] any params? no
beq jclpg3 ;[82] any params? no
cmp #2 ;[76] page?
beq jclpg ;[76] yes
jcl2cu lda hcv ;[76] save current
sta kwrk01 ;[76]
lda hch ;[76]
sta kwrk02 ;[76]
lda #0 ;[76] now home it
sta cv ;[76]
jcl2cw sta ch ;[76]
jsr pos80c ;[76]
vtc2j1 ;[76]
ldx hcv ;[76]
cpx kwrk01 ;[76] are we down to current line
;[85] bcs vtc2j2 ;[76]
bge vtc2j2 ;[85]
jsr clreol ;[76] no clear this line
inc cv ;[76]
lda #0 ;[76] position to next line
jmp jcl2cw ;[76]
; lda wrapar ;[76] in order for this to work
; pha ;[76] we must wrap arround, save current
; lda #hspace ;[76] print a space
; sta wrapar ;[76] set wrap arround on (non 0)
vtc2j2 lda #hspace ;[76] blank start of this line
;[85]vtc2j3 jsr vprchd ;[76] vt52 rtn to keep track of hvh & hcv
vtc2j3 jsr vprch7 ;[85] vt52 rtn to keep track of hvh & hcv
ldx hch ;[76]
cpx kwrk02 ;[76]
;[85] bcc vtc2j3 ;[76]
blt vtc2j3 ;[85]
; pla ;[76] restore the wrap arround
; sta wrapar ;[76]
; lda kwrk01 ;[76] now restore cursor to orig place
; sta cv ;[76]
; lda kwrk02 ;[76]
; sta ch ;[76]
; jsr pos80c ;[76]
;[85] jmp jclep2 ;[76]
bge jclep2 ;[76]
jcleop jsr clreop ;[76] clear to end of page
jclep2 lda vtcsgr ;[76] restore current special graphics
jsr cout ;[76]
jmp vtccom ;[76]
jclpg ;[76] clear page and home
lda #0 ;[76]
sta cv ;[76]
sta ch ;[76]
jsr pos80c ;[76]
jclpg3 ;[82]
lda wndbtm ;[78]
pha ;[78] save current bottom
lda #24 ;[78] and set max
sta wndbtm ;[78] to clear all of screen
;[78] jmp jcleop ;[76] common code
jsr jcleop ;[78] common code
pla ;[78] restore current bottom of screen
sta wndbtm ;[78]
rts ;[78] bye
vtc2k lda vtcpar ;[76] 1st param - LINE ERASING
beq vtc2k4 ;[76] default is 0
ldx hcv ;[76]
stx kwrk01 ;[76]
stx cv ;[85]
cmp #2 ;[76]
beq vtc2k2 ;[76]clear line
lda hch ;[76] clear from sart of line to current pos
sta kwrk02 ;[76]
;[85] lda hcv ;[76]
;[85] sta cv ;[76]
;[85] sta kwrk01 ;[76]
lda #0 ;[76] start of line
jmp jcl2cw ;[76]
vtc2k2 lda #0 ;[76]
sta ch ;[76]
;[85] lda hcv ;[76]
;[85] sta cv ;[76]
jsr pos80c ;[76]
vtc2k4 lda #$e ;[76] clear must also reset inverse video
jsr cout ;[76] so reset it
jsr clreol ;[76] clear this line
;[83] jmp vtccom ;[76]
jmp jclep2 ;[83] just in case its special video
vtlh ldx nita ;[76] # in tab array - SET TABS
beq vtlh4 ;[76] 0? yes
vtlh2 lda tabary-1,x ;[76]
cmp hch ;[76]
bcc vtlh4 ;[76] add it
beq vtlh6 ;[76] already there
sta tabary,x ;[76]
dex ;[76]
bne vtlh2 ;[76] all of array? no
vtlh4 lda hch ;[76] add current position
sta tabary,x ;[76]
inc nita ;[76] and tell how many
vtlh6 jmp vtccom ;[76]
vtld jsr lfeed ;[76] DOWN ONE
jmp vtccom ;[76]
vtle jsr prcrlf ;[76] start of next line
lda #0 ;[76]
sta hch ;[76]
jsr bphcv ;[76] bump hcv
jmp vtccom ;[76]
;[85]vtlm jsr vt52ri ;[76] REVERSE LINE FEED
vtlm lda #$e ;[85] do this in rormal
jsr cout ;[85]
jsr vt52ri ;[85] REVERSE LINE FEED
lda vtcsgr ;[85] now restore graphics
jsr cout ;[85]
jmp vtccom ;[76]
vtc2g lda vtcpar ;[76] 1st param- CLEAR TABS
beq vtc2g2 ;[76]
cmp #3 ;[76]
bne vtc2g7 ;[76]
lda #0 ;[76]
sta nita ;[76] empty tab array
vtc2g1 jmp vtccom ;[76]
vtc2g7 jmp vtcspl ;[76] unknown spill it
vtc2g2 ldy #0 ;[76]
ldx nita ;[76] number in tab array
beq vtc2g1 ;[76] none
lda hch ;[76] current pos
vtc2g4 cmp tabary,y ;[76]
beq vtc2g6 ;[76]
bcc vtc2g1 ;[76] thats all
iny ;[76]
dex ;[76]
bne vtc2g4 ;[76] thru? no
beq vtc2g1 ;[76] yes
vtc2g6 iny ;[76]
lda tabary,y ;[76]
sta tabary-1,y ;[76]
cpy nita ;[76]
bne vtc2g6 ;[76] all of tabs? no
dec nita ;[76]
jmp vtccom ;[76]
vtc2m ldx #0 ;[76] search in fifo order SET
vtc2m2 lda vtcpar,x ;[76]
beq vtc2m6 ;[76]
cmp #7 ;[76]
beq vtc2m8 ;[76] reverse video
cmp #4 ;[76] is it underline?
beq vtc2m8 ;[76] reverse video is the best we have
cmp #5 ;[80] is it blink?
beq vtc2m8 ;[80] reverse video is the best we have
cmp #1 ;[80] is it bold?
beq vtc2m8 ;[80] reverse video is the best we have
vtc2m4 inx ;[76] next
cpx vtcpnm ;[76]
beq vtc2m2 ;[76]
bmi vtc2m2 ;[76]
jmp vtccom ;[76] no more
vtc2m6 lda #$e ;[76] normal video
vtc2m7 sta vtcsgr ;[76] save special graphics rendition
jsr cout ;[76]
jmp vtc2m4 ;[76]
vtc2m8 lda #$f ;[76] inverse video
bne vtc2m7 ;[76] always branch
;talso lda #$e ;[76] the default case of 0
; jsr cout ;[76]
; jmp vtccom ;[76]
vtc2lr lda vtcpar ;[76] 1st param - DEFINE SCROOL REGION
cmp vtcpar+1 ;[76] 2nd param
bcc vtclr2 ;[76]
ora vtcpar+1 ;[76] is this the default?
beq vtclr6 ;[76] yes
jmp vtcspl ;[76] bad window
vtclr2 ;[76]
sta wndtop ;[76] top line of window
dec wndtop ;[76] they start at 1
bpl vtclr4 ;[76] is this default of 0?
inc wndtop ;[76] yes set it back to 0
vtclr4 lda vtcpar+1 ;[76] 2nd param
vtclr5 sta wndbtm ;[76] bottom line of window, we need +1
lda #0 ;[76]
sta ch ;[76]
;apple 80 col must home to 0 sigh! jove fails insert chs then cr
; lda wndtop ;[84] home to top of region
sta cv ;[76] expects to home also
jsr pos80c ;[76]
jmp vtccom ;[76]
vtclr6 lda #0 ;[76] reset the region
sta wndtop ;[76]
lda #24 ;[76]
jmp vtclr5 ;[76]
vtc2lc ldy #0 ;[76] need a byte to keep track
sty kwrk01 ;[76]
vtclc2 ldy kwrk01 ;[76]
lda vtcid,y ;[76]
beq vtc2lm ;[76] end of string
jsr telppc ;[76] send it down the line
inc kwrk01 ;[76] next
jmp vtclc2 ;[76]
vtc2lm jmp vtccom ;[76] thats all
vtlc ;[76] - RESET
vtlc2 lda #0 ;[76] reset window
sta wndtop ;[76]
sta wrapar ;[76] wrap arround start off
lda #24 ;[76] end+1 on the bottom
sta wndbtm ;[76]
jsr home ;[76] start at top
jmp vtccom ;[76]
vtc2r lda vtcpar ;[76] 1st param - TELL WHERE
cmp #5 ;[76]
bne vtc2r9 ;[76]
lda #0 ;[76]
jsr vtcpos ;[76]
jmp vtc2r7 ;[76]
vtc2r9 cmp #6 ;[76]
beq vtc2r1 ;[76]
jmp vtcspl ;[76] its an unknown
vtc2r1 lda hcv ;[76]
jsr vtcpos ;[76]
lda #'; ;[76]
jsr telppc ;[76]
lda hch ;[76]
jsr vtcpud ;[76] put out number
vtc2r7 lda #'R ;[76]
jsr telppc ;[76]
rts ;[76]
vtcpud cmp #10 ;[76]
bcc vtc2r3 ;[76]
pha ;[76] save count
cmp #20 ;[76]
bcs vtc2r2 ;[76]
lda #'1 ;[76]
jsr telppc ;[76]
pla ;[76] get original bin number
clc ;[76]
sbc #10 ;[76]
jmp vtc2r3 ;[76]
vtc2r2 lda #'2 ;[76]
jsr telppc ;[76]
pla ;[76] get bin number again
clc ;[76]
sbc #20 ;[76]
vtc2r3 clc ;[76]
adc #'0 ;[76]
jsr telppc ;[76]
rts ;[76]
vtcpos pha ;[76]
lda #esc ;[76] tell where we are
jsr telppc ;[76]
lda #'[ ;[76]
jsr telppc ;[76]
pla ;[76]
jsr vtcpud ;[76] put out the number
rts ;[76]
svnisc ldy nisc ;[76] # saved chs
sta chssvd,y ;[76] save this one
inc nisc ;[76]
rts ;[76]
vt100 jsr logput ;[76]
ldx vtcesc ;[76]have we seen an esc
bne vtc2 ;[76] yes
cmp #esc ;[76] is this an esc?
beq vtc1 ;[76] yes
ldx prnfg ;[87] are we printing?
beq .+5 ;[87] no
jmp tl0pr4+3 ;[87] yes give non esc seq direct to pr
bge vt1002 ;[85] speed things up a bit
cmp #tab ;[76] how about a tab
beq vtctab ;[76] yes
;[78]vt1002 cmp #so ;[76]
cmp #so ;[78]
beq vt100a ;[76] turn on g1 special
cmp #si ;[76]
;[78] beq vt100c ;[76]turn off g1 special
beq vt100c ;[76] turn on g0 special
;[78] ldx vtcscs ;[76] have we got special ch set
vt1002 ldx vtcso ;[78] have we got special ch set
;[78] bne vt1002 ;[76] yes
bne vt1003 ;[78] yes
vt1004 jmp vprchr ;[76] just print it & let cout rts
;[78]vt1003 ldx vtcso ;[76]
;[78] beq vt1004 ;[76] is g1 special on, no
vt1003 ;[78]
cmp #'_ ;[76]
bcc vt1004 ;[76] is it in the range?,no
sec ;[76]
sbc #'_ ;[76] make it a short table
tax ;[76] set the index into special chs
lda vtcg1,x ;[76] get new ch
;[85] jmp vprchd ;[76] now print new ch-we know its printable
jmp vprch7 ;[85] now print new ch-we know its printable
;[78]vt100a inc vtcso ;[76] make it non 0
vt100a lda #2 ;[78] bit 1 for g1 (turned on by so)
vt100b and vtcscs ;[78] is the graphics bit on?
sta vtcso ;[78] non 0 if it is
rts ;[76]
;[78]vt100c lda #0 ;[76] turn off vtcso
vt100c lda #1 ;[78] bit 0 for g0 (turned on by si)
;[87] jmp vt100b ;[78] common code
bne vt100b ;[87] common code
;[78] sta vtcso ;[78][76]
;[78] rts ;[76]
vtctab ldy nita ;[76] we have a tab so move
bne .+5 ;[76]
jmp vt524 ;[76] no tabs so use vt52s
ldx #0 ;[76] entry in tab table
;[78] lda ch ;[76] where we currently are
lda hch ;[78] where we currently are
vtctb1 cmp tabary,x ;[76]
;[84] beq vtctb3 ;[76]
;[78] bcs vtctb2 ;[76]
bcc vtctb2 ;[76]
inx ;[76] next entry
dey ;[76] are we thru
bne vtctb1 ;[76] no
beq vtctb3 ;[78] what to do its not in array, sigh!
vtctb2 lda tabary,x ;[78]
;[78]vtch01 sta ch ;[76] got on set loc
sta ch ;[78] got on set loc
jmp pos80c ;[76] position and let it rts
;[78]vtctb2 dex ;[76]
;[78] lda tabary,x ;[76]
;[78] jmp vtch01 ;[76]
vtctb3 rts ;[76]
vtc1 inc vtcesc ;[76] tattle
rts ;[76] next
vtc2 jsr svnisc ;[76] save current ch
cpx #1 ;[76] what type esc
bne vtclfp ;[76] [ so look for parms
ldx #vtcoca-vtcoct ;[76] logic only good for 256 byte table
vtcjp2 cmp vtcoct-1,x ;[76] now search the table
bne vtcjp1 ;[76] not this one
txa ;[76]
asl a ;[76] double it
tax ;[76]
ldy vtcoca-2,x ;[76] yup got one
sty vtcjp+1 ;[76] set up the jump
ldy vtcoca-1,x ;[76]
sty vtcjp+2 ;[76]
vtcjp jmp $ffff ;[76]
vtcjp1 dex ;[76]
bne vtcjp2 ;[76] more? yes
vtcspl ;[84] no more
;[84]vtcspl lda #esc ;[76] no dont understand this one so print it
;[84] jsr prchr ;[76] make it look like ^$
;[84] ldy nisc ;[76] # of chs saved
;[84] ldx #0 ;[76]
;[84]vtcsp1 lda chssvd,x ;[76] get next ch saved
;[84] ora #$80 ;[76]
;[84] jsr cout ;[76] printit
;[84] inx ;[76]
;[84] dey ;[76]
;[84] bne vtcsp1 ;[76] all the saved ones? no
vtccom lda #0 ;[76] commonexit clear all kinds of things
ldy #tabary-nisc ;[76]
vtcc01 sta nisc-1,y ;[76]
dey ;[76]
bne vtcc01 ;[76] thru? no
rts ;[76] yes
vtclfp cmp #'9+1 ;[76] check for param a number
bcs vtclf3 ;[76] not a number
cmp #'0 ;[76]
bcc vtclf3 ;[76] not a number
ldx vtcpnm ;[76] get current param
sec ;[76]
sbc #'0 ;[76] make it binary
clc ;[76]
ldy #10 ;[76] mult previous by 10
vtclf1 adc vtcpar,x ;[76]
dey ;[76] done?
bne vtclf1 ;[76] no
sta vtcpar,x ;[76] set current param
rts ;[76] thats all
vtclf3 ldx #vtctca-vtctct ;[76] look thru the param posibilities
vtclf4 cmp vtctct-1,x ;[76]
bne vtclf6 ;[76] not in this one
txa ;
asl a ; double it
tax ;
ldy vtctca-2,x ;[76] got one
sty vtclf5+1 ;[76] set up jump
ldy vtctca-1,x ;[76]
sty vtclf5+2 ;[76]
vtclf5 jmp $ffff ;[76]
vtclf6 dex ;[76]
bne vtclf4 ;[76] thru? no
jmp vtcspl ;[76] cant find a match so give up
.SBTTL Flashing cursor support routines.
;[31]
;[31] Take the byte on the screen at (basl),ch, stash it and its location in
;[31] obasl,obash, oldch, and curchar, convert the character to flashing, and
;[31] stuff it back to the screen. This will display a flashing character at
;[31] the next location for writing.
;[31] No registers or flags are altered.
curon: ;[58]
pha ;[31] Save A
lda dsptyp ;[58] 80 col display ?
bmi curon1 ;[58] yes ignore all this
php ;[31] Save flags.
tya ;[31] and Y
pha ;[31]
ldy ch ;[31] Make a safe copy of the cursor char
sty oldch ;[31] location
lda basl ;[31]
sta obasl ;[31]
lda bash ;[31]
sta obash ;[31]
lda (basl),y ;[31]
sta curchr ;[31] and value
and #$7f ;[31] convert it to flashing.
ora #$40 ;[31]
sta (basl),y ;[31] store flashing char to screen
pla ;[31] restore regs.
tay ;[31]
plp ;[31]
curon1 pla ;[31]
rts ;[31]
;[31] Turn the cursor off
;[31] Check to see if the location where we last turned on the cursor is still
;[31] flashing. If so, restore it to its old (non-flashing) value.
;[31] All registers and flags preserved.
curoff ;[58]
pha ;[31] Preserve the regs
lda dsptyp ;[58] 80 col display ?
bmi curof2 ;[58] yes skip all this
php ;[31]ha ;[31] Preserve the regs
tya ;[31]
pha ;[31]
ldy oldch ;[31] Get the current screen char at
lda (obasl),y ;[31] old cursor location.
bmi curof1 ;[31] Too high to be flashing ; Quit
cmp #$40 ;[31]
bcc curof1 ;[31] Too low to be flashing ; Quit
lda curchr ;[31] It is flashing ; restore the old
sta (obasl),y ;[31] character
curof1: pla ;[31] Restore the registers.
tay ;[31]
plp ;[31]
curof2 pla ;[31]
rts ;[31]
scrfrm jsr home ;[59]first clear the screen
;[79] lda #rplocv ;[59]
;[79] sta cv ;[59]
;[79] lda #0 ;[59]
;[79] sta errcnt ;[59] start with 0 errors
;[79] sta errcnt+1 ;[59]
;[79] sta ch ;[59]
;[79] jsr vtab ;[59] position recieve line
;[79] ldx #rcin01\ ;[59]
;[79] ldy #rcin01^ ;[59]
;[79] jsr prstr ;[59]print receive
lda #splocv ;[59]
sta cv ;[59]
lda #0 ;[59]
sta ch ;[59]
jsr vtab ;[59] position send line
ldx #snin01\ ;[59]
ldy #snin01^ ;[59]
jsr prstr ;[59]print sending
lda #erlocv ;[59]
sta cv ;[59]
lda #rploch-7 ;[59] 7 chs in fixed part
sta ch ;[59]
jsr vtab ;[59] position error line
ldx #erin01\ ;[59]
ldy #erin01^ ;[59]
jsr prstr ;[59]print error count
lda #rplocv ;[79]
sta cv ;[79]
lda #0 ;[79]
sta errcnt ;[79] start with 0 errors
sta errcnt+1 ;[79]
sta ch ;[79]
jsr vtab ;[79] position recieve line
ldx #rcin01\ ;[79]
ldy #rcin01^ ;[79]
jsr prstrl ;[79]print receive & move to next line
lda #1 ;[66]
sta fnflag ;[66] tell open to print file name
rts ;[59] thats all
.SBTTL Exit routine
;
; This routine exits properly from kermit-65 and reenters
; Dos.
;
; Input: NONE
;
; Output: NONE
;
; Registers destroyed: A,X
;
;quit lda #0 ;[87] this is quit dont reset serial port
; beq exit0 ;[87]
exit:
; lda #1 ;[87] tatle abt this permanent exit
;exit0 sta exqufl ;[87]
;[78] lda #cmcfm ;[14] Try to get a confirm
;[78] jsr comnd ;[14] Do it
;[78] jmp kermt3 ;[14] Give '?not confirmed' message
jsr prcfm ;[78] parse and confirm
exit1: ;[14]
.ifeq <ftcom-ftappl>
jsr kerin7 ;[78] just in case were reading kermit.ini
;[84] lda dosflg ;[80] is this prodos?
;[84] bne exit4 ;[80] yes
;[84] lda herrpt ; Reset the DOS and BASIC error vectors
;[84] sta errptr ; ...
;[84] lda herrpt+1 ; ...
;[84] sta errptr+1 ; ...
;[84] lda hbasws ; ...
;[84] sta basws ; ...
;[84] lda hbasws+1 ; ...
;[84] sta basws+1 ; ...
;[84]exit4 ;[80]
lda hsoftv ;[75] restore the soft vector also
sta softvc ;[75]
lda hsoftv+1 ;[75]
sta softvc+1 ;[75]
jsr warmst ;[75] and make it right
; lda exqufl ;[87] quit?
; beq .+5 ;[87] yes
jsr tl0exi ;[80] restore interupt vector also
jsr setio1 ;[58] reset keyboard
lda #0 ;[58] assume pr#0
;[80] sta herrpt ;[75] and tell we restored the vectors
;[80] sta herrpt+1 ;[75]
sta hsoftv+1 ;[80] high byte should be enough
;[87] sta $800 ;[86] According to Chip Welch we need this,thanks
ldx dsptyp ;[58] are we 80 col ?
bpl exit3 ;[58] no
lda dsp2 ;[58] yes get pr#n
exit3 jsr setio2+2 ;[58] do it
lda dosflg ;[84] prodos?
beq exit2 ;[84] no
jsr prodos ;[84] quit
.byte pdquit ;[84]
.word prdqut ;[84]
jsr perror ;[86] if we come back its an error
.endc
exit2: jmp dos ; We got it, now restart DOS
.SBTTL Help routine
;
; This routine prints help from the current help text
; area.
;
; Input: Cmhptr - Pointer to the desired text to be printed
;
; Output: ASCIZ string at Cmhptr is printed on screen
;
; Registers destroyed: A,X,Y
;
;[78]help: lda #cmcfm ; Try to get a confirm
;[78] jsr comnd ; Go get it
;[78] jmp kermt3 ; Didn't find one? Give 'not confirmed' message
;[85]help jsr prcfm ;[78] parse and confirm
;[85]help2: ldx cmhptr ; L.O. byte of current help text address
;[85] ldy cmhptr+1 ; H.O. byte of address
;[83] jsr prstr ; Print it
;[83] jmp kermit ; Return to main routine
;[85] jmp kermtx ;[83] thats all
help: lda #on ;[85] Set use file-header switch on in case we
sta usehdr ;[85] don't parse a filename
jsr kerin7 ;[85] just in case were reading kermit.ini
lda #hlpfne-hlpfn ;[85] size
sta pdlen ;[85] of name
lda #hlpfn\ ;[85] and where it is
sta kerbf1 ;[85]
lda #hlpfn^ ;[85]
sta kerbf1+1 ;[85]
lda #kerehr\ ;[85] Point to extra help commands
sta cmehpt ;[85] ...
lda #kerehr^ ;[85] ...
sta cmehpt+1 ;[85] ...
ldx #mxfnl ;[85] Longest length a filename may be
lda dosflg ;[85] prodos?
beq .+4 ;[85] no
ldx #mxppth ;[85] yes allow for path name
ldy #cmfehf ;[85] Tell Comnd about extra help
lda #cmifi ;[85] Load opcode for parsing input files
jsr comnd ;[85] Call comnd routine
jmp help1 ;[85] Continue, don't turn file-header switch off
sta pdlen ;[85] length of name parsed
stx kerbf1 ;[85] and where it is
sty kerbf1+1 ;[85]
help1 jsr getfil ;[85] set up fcb1
helpb jsr opentf ;[85]
helpa jsr home ;[85] top & clear screen
ldx #morem\ ;[85] instructions
ldy #morem^ ;[85]
jsr prstrl ;[85]
lda #0 ;[85]
sta match ;[85] line count
sta ch ;[85] position to line 2
lda #1 ;[85]
sta cv ;[85]
jsr vtab ;[85]
jsr clreop ;[85] clear page
help2 jsr fgetc ;[85] get ch from file
jmp help3 ;[85] eof
ora #$80 ;[85] make it printable
cmp #hlf ;[85] end of line?
beq help21 ;[85]
cmp #hffd ;[85] top of form?
beq help22 ;[85]
cmp #hcr ;[85] end of line?
bne help23 ;[85] no just printit
help21 inc match ;[85] yes are we at eop
ldx #22 ;[85]
cpx match ;[85]
bne help23 ;[85] no
help22 lda kbd ;[85] get users wish
bpl help22 ;[85]
bit kbdstr ;[85] clear strobe
ora #$20 ;[85] make it lower case
cmp #'q+$80 ;[85] want to quit?
beq help3 ;[85]
cmp #'t+$80 ;[85] want to start over?
bne helpa ;[85] no, next page
jsr clostf ;[85]
jmp helpb ;[85]
help23 jsr cout ;[85] print it
jmp help2 ;[85] till we read it all
help3 jsr clostf ;[85] restore
jmp kermit ;[85] adios
.SBTTL Bye routine
;
; This routine terminates the remote server, logs out and terminates
; the local Kermit.
;
bye: jsr prcfm ;[14] Go parse and print the confirm
;[67] jsr scrfrm ;[59] make the screen look nice
lda #'L ;[67] this is logout
sta logo4+1 ;[67]
jsr logo ;[14] Tell other Kermit to log out
jmp kermit ;[14] Don't exit if there was an error
lda #0 ;[54] command to hang up phone
jsr tl0cmd ;[54] and let card handle it
jmp exit1 ;[14] Leave
;
; Logo - This routine does the actual work to send the logout
; packet to the remote server
;
logo: lda #$00 ;[14] Zero the number of tries
sta numtry ;[14] ...
sta tpak ;[16] and the total packet number
sta tpak+1 ;[16] ...
;[81] sta kerins ;[75] make sure we purge com buffers
sta exfg ;[75] tell it to use classic packets
;[83] lda #pdbuf\ ;[72] Point kerbf1 at the packet data buffer
;[83] sta kerbf1 ;[72] ...
;[83] lda #pdbuf^ ;[72] ...
;[83] sta kerbf1+1 ;[72] ...
jsr sukrbf ;[83] setup kerbf1
;[81] jsr tlinit ;[72] initialize the serial port
;[81] bne logoa ;[72] unable to use the com port
;[81] jsr u2icc ;[72] tattle
;[81] jmp kermit ;[72]
;[81]logoa ;[72]
jsr comint ;[81] common com init
jsr scrfrm ;[59] make the screen look nice
logo1: lda numtry ;[14] Fetch the number of tries
cmp maxtry ;[14] Have we exceeded Maxtry?
bmi logo3 ;[14] Not yet, go send the packet
logo2: ldx #ermesc\ ;[14] Yes, give an error message
ldy #ermesc^ ;[14] ...
;[79] jsr prstr ;[14] ...
;[79] jsr prcrlf ;[14] ...
jmp prstrl ;[79] & let it rts
;[79] rts ;[14] and return
logo3: inc numtry ;[14] Increment the number of tries for packet
lda #$00 ;[14] Make it packet number 0
sta pnum ;[14] ...
lda #$01 ;[14] Data length is only 1
sta pdlen ;[14] ...
logo4 lda #'L ;[67][14] The 'Logout' command
sta pdbuf ;[14] Put that in first character of buffer
lda #'G ;[14] Generic command packet type
sta ptype ;[14] ...
jsr spak ;[14] Send the packet
jsr rpak ;[14] Try to fetch an ACK
;[53] cmp #true ;[14] Did we receive successfully?
;[53] bne logo1 ;[14] No, try to send the packet again
;[67] beq logo1 ;[53] since false is 0
lda ptype ;[14] Get the type
cmp #'Y ;[67] is this a ack?
beq logo7 ;[67] yes
ldy #0 ;[67] ready the error message
logo5 lda erms18,y ;[67]
beq logo6 ;[67] end of message? yes
and #$7f ;[67] make it ascii
sta pdbuf,y ;[67] this message is going to remote
iny ;[67]
jmp logo5 ;[67]
logo6 sty pdlen ;[67]
lda #'E ;[67] this is an error packet
sta ptype ;[67]
jsr spak ;[67] send the packet
jsr rpak ;[67] and get a packet
beq logo1 ;[67] not very sophisticated
lda ptype ;[67]
cmp #'Y ;[14] An ACK?
bne logoce ;[14] No, go check for error
logo7 ;[67]
jmp rskp ;[14] Yes, skip return
logoce: ;[67]cmp #'E ;[14] Error packet?
;[67]bne logo1 ;[14] Nope, resend packet
jsr prcerp ;[38][14] Go display the error
beq logo1 ;[67] not an error pkt try again
rts ;[14] and return
sukrbf lda #pdbuf\ ;[83] Point kerbf1 at the packet data buffer
sta kerbf1 ;[83] ...
lda #pdbuf^ ;[83] ...
sta kerbf1+1 ;[83] ...
rts ;[83]
.SBTTL Finish routine
;
; This routine terminates the remote server but does not log
; it out. It also keeps the local Kermit running.
;
finish: jsr prcfm ;[14] Go parse and print the confirm
lda #'F ;[67] this is finish command
sta logo4+1 ;[67]
jsr logo ;[67] and tell remote
jmp finshe ;[67] error return
;[67] jsr scrfrm ;[59] make the screen look nice
;[67] lda #$00 ;[14] Zero the number of tries
;[67] sta numtry ;[14] ...
;[67] sta tpak ;[16] and the total packet number
;[67] sta tpak+1 ;[16] ...
;[67]finsh1: lda numtry ;[14] Fetch the number of tries
;[67] cmp maxtry ;[14] Have we exceeded Maxtry?
;[67] bmi finsh3 ;[14] Not yet, go send the packet
;[67]finsh2: ldx #ermesd\ ;[14] Yes, give an error message
;[67] ldy #ermesd^ ;[14] ...
;[67] jsr prstr ;[14] ...
;[67] jsr prcrlf ;[14] ...
;[67]; jmp kermit ;[14] and go back for more commands
;[67] jmp finshe ;[61] handle 2e 80 col screen
;[67]finsh3: inc numtry ;[14] Increment the number of tries for packet
;[67] lda #$00 ;[14] Make it packet number 0
;[67] sta pnum ;[14] ...
;[67] lda #$01 ;[14] Data length is only 1
;[67] sta pdlen ;[14] ...
;[67] lda #'F ;[14] The 'Finish' command
;[67] sta pdbuf ;[14] Put that in first character of buffer
;[67] lda #'G ;[14] Generic command packet type
;[67] sta ptype ;[14] ...
;[67] jsr spak ;[14] Send the packet
;[67] jsr rpak ;[14] Try to fetch an ACK
;[67];[53] cmp #true ;[14] Did we receive successfully?
;[67];[53] bne finsh1 ;[14] No, try to send the packet again
;[67] beq finsh1 ;[53] since false is 0
;[67] lda ptype ;[14] Get the type
;[67] cmp #'Y ;[14] An ACK?
;[67] bne fince ;[14] No, go check for error
;[67]; jmp kermit ;[14] Yes, go back for more commands
;[67] jmp finshe ;[61] handle 2e 80 col screen
;[67]fince: cmp #'E ;[14] Error packet?
;[67] bne finsh1 ;[14] Nope, resend packet
;[67] jsr prcerp ; ;[38][14] Go display the error
;[69]finshe jsr test2e ;[61] what is going on????
finshe jsr dfsv ;[69] let operator look at screen
jsr test2e ;[61] what is going on????
jmp kermit ;[14] Go back for more
.SBTTL Take routine
;
; This routine accepts an unquoted string terminated by
; <cr> and tries to use the file
; represented by that string for kermit commands.
;
take: jsr kerin7 ;[83] just in case were reading kermit.ini
lda #$80 ;[83] Reset all break characters
jsr rstbrk ;[83] ...
lda #cr ;[83] ...
jsr setbrk ;[83] ...
ldy #$00 ;[83] ...
sty kerrki ;[83] get commands from file
lda #cmtxt ;[83] Parse for text
jsr comnd ;[83] Do it
jmp kermta ;[83] Found null string
sta kwrk01 ;[83] Store packet size for Kercpy
sta nfcb1 ;[83] just in case of prodos
stx kerfrm ;[83] Point to the atom buffer from Comnd
sty kerfrm+1 ;[83] as the source address
lda #fcb1\ ;[83] Set up the address of the target
sta kerto ;[83] ...
lda #fcb1^ ;[83] ...
sta kerto+1 ;[83] ...
jsr clrfcb ;[83] Clear the fcb first
jsr kercpy ;[83] Go move the string
jmp stflo7 ;[83] common parse & print confirm
preptx lda #$80 ;[86] Reset all break characters
jsr rstbrk ;[86]
lda #cr ;[86] Now set some break chs
jsr setbrk ;[86] ...
lda #lf ;[86] ...
jsr setbrk ;[86] ...
lda #ffd ;[86] ...
jsr setbrk ;[86] ...
lda #esc ;[86] ...
jsr setbrk ;[86] ...
lda #', ;[86] ...
jsr setbrk ;[86] ...
ldy #$00 ;[86] nothing special
lda #cmtxt ;[86] Parse for text
rts ;[86]
.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 ;[42] Make KERMIT use file headers
sta usehdr ;[42] for file names
jsr kerin7 ;[78] just in case were reading kermit.ini
;[59] lda #mxfnl+1 ;[14] The buffer size is one more than max
;[59] sta kwrk01 ;[14] file name length
;[59] lda #fcb1\ ;[14] Point to the buffer
;[59] sta kerto ;[14] ...
;[59] lda #fcb1^ ;[14] ...
;[59] sta kerto+1 ;[14] ...
;[59] jsr kerflm ;[14] Clear the buffer
;[86] lda #$80 ;[14] Reset all break characters
;[86] jsr rstbrk ;[14] ...
;[86] lda #cr ;[14] ...
;[86] jsr setbrk ;[14] ...
;[86] lda #lf ;[14] ...
;[86] jsr setbrk ;[14] ...
;[86] lda #ffd ;[14] ...
;[86] jsr setbrk ;[14] ...
;[86] lda #esc ;[14] ...
;[86] jsr setbrk ;[14] ...
;[86] ldy #$00 ;[14] ...
;[81] sty kerins ;[75] make sure we empty buffers
;[86] lda #cmtxt ;[14] Parse for text
jsr preptx ;[86] get string up to comma ...
jsr comnd ;[14] Do it
jmp kermta ;[14] Found null string
cmp spsiz ;[14] Larger than the set packet size?
;[75] bmi getf1 ;[14] No, continue
bcc getf1 ;;[75][14] No, continue
lda spsiz ;[14] Yes, it will have to be truncated
getf1: sta kwrk01 ;[14] Store packet size for Kercpy
sta pdlen ;[14] and Spak
sta nfcb1 ;[59] just in case of prodos
sta getfln ;[87] size of get file name
;[87] lda #pdbuf\ ;[14] Point to the data buffer as destination
lda #dosbuf\ ;[87] place to save filename
sta kerto ;[14] ...
;[62] sta kerbf1 ;[37] Store L.O.B. here for Spak routine
;[87] lda #pdbuf^ ;[14] ...
lda #dosbuf^ ;[87] place to save filename
sta kerto+1 ;[14] ...
;[62] sta kerbf1+1 ;[37] Store H.O.B. here for Spak routine
stx kerfrm ;[14] Point to the atom buffer from Comnd
sty kerfrm+1 ;[14] as the source address
;[87] stx kerbf1 ;[59] prep getfil
;[87] sty kerbf1+1 ;[59]
;[59] txa ;[14] Save the 'from buffer' pointers for later
;[59] pha ;[14] ...
;[59] tya ;[14] ...
;[59] pha ;[14] ...
jsr kercpy ;[14] Copy the string
;[59] pla ;[14] Restore these for the next move
;[59] sta kerfrm+1 ;[14] ...
;[59] pla ;[14] ...
;[59] sta kerfrm ;[14] ...
lda #fcb1\ ;[14] Set up the address of the target
sta kerto ;[14] ...
lda #fcb1^ ;[14] ...
sta kerto+1 ;[14] ...
jsr clrfcb ;[14] Clear the fcb first
jsr kercpy ;[14] Go move the string
lda #cmtxt ;[86] see if we have to change name
jsr comnd ;[86]
jmp getf3 ;[86] no, carry on there the same name
sta kwrk01 ;[86] len of new name
sta nfcb1 ;[86] len of new name
stx kerfrm ;[86] where to get it from
sty kerfrm+1 ;[86]
jsr clrfcb ;[86]
jsr kercpy ;[86]
lda #no ;[86] dont use header
sta usehdr ;[86]
getf3 ;[86]
jsr prcfm ;[14] Go parse and print the confirm
;[81] jsr tlinit ;[47] initialize the serial port
;[81] bne getf3 ;[62] unable to init com
;[81] jsr u2icc ;[62] tell someone
;[81] jmp kermit ;[62]
;[81]getf3 ;[62]
jsr comint ;[81] common com init
;[87] lda #'R ;[14] Packet type is 'Receive-init'
;[87] sta ptype ;[14] ...
;[87] sta getfg ;[75] tell were from get
;[87] lda #$00 ;[14] Packet number should be zero
;[87] sta pnum ;[14] ...
;[87] sta exfg ;[75] start out with clasic packet
;[66] jsr scrfrm ;[59] ready the screen for file xfer
;[87] lda prtcl ;[83] is this xmodem
;[87] bne .+5 ;[83] yes hate to do this
;[87] jsr spak ;[14] Packet length was set above,
lda prtcl ;[87] is this xmodem
bne getf7 ;[87] yes
lda #'I ;[87] set up lots of things
jsr rswint ;[87]
getl1 lda state ;[87]
cmp #'I ;[87] do we have an init?
bne getl2 ;[87] no
jsr sinio ;[87]
jmp getl1 ;[87]
getl2 cmp #'F ;[87] good init?
beq getl3 ;[87] yes
jmp stat07 ;[87] no error out
getl3 sta getfg ;[87] in case of retry
jsr rini2c ;[87] send the file name packet
getf7 ;[87]
jsr rswt ;[14] so just call spak and try to receive
pha ;[67] save error return
lda #0 ;[75] turn off get file flag
sta getfg ;[75]
;[68] jsr home ;[67]
jsr bell ;[56] Sound bell at the user
jsr dfsv ;[69] let operator look at screen
jsr test2e ;[61] test for //e 80 col
pla ;[67] get posible error
bne getf2 ;[67] error?,no
jmp stat07 ;[67] yes tell user
getf2 jmp kermit ;[14] Go back for more commands
;
; This routine setsup a log file for the remote session
;
; Input: Filename returned from comnd
;
; Output: If file spec is ok file is opened
;
; Registers destroyed: A,X,Y
;
log: ;[56]
jsr kerin7 ;[78] just in case were reading kermit.ini
lda #kerehr\ ;[56] Point to extra help commands
sta cmehpt ;[56] ...
lda #kerehr^ ;[56] ...
sta cmehpt+1 ;[56] ...
ldx #mxfnl ;[56] Longest length a filename may be
lda dosflg ;[59] is this prodos
beq .+4 ;[59] no
ldx #mxppth ;[59] yes
ldy #cmfehf ;[56] Tell Comnd about extra help
lda #cmifi ;[56] Load opcode for parsing input files
jsr comnd ;[56] Call comnd routine
jmp kermt6 ;[56] file spec required
sta pdlen ;[57] length of name parsed
stx kerbf1 ;[57] and where it is
sty kerbf1+1 ;[57]
lda #on ;[57] force getfil
sta usehdr ;[57] to convert to neg ascii
jsr getfil ;[57] set up fcb1
;[78] lda #cmcfm ;[56] Get token for confirm
;[78] jsr comnd ;[56] and try to parse that
;[78] jmp kermt3 ;[56] Failed - give the error
jsr prcfm ;[78] parse and confirm
lda #fncwrt ;[56] open for writing
jsr openf ;[56] use other files defaults
lda #$80 ;[56] turn on flag
sta logfg ;[56]
;[76] lda flowfg ;[57] do we have flow control
lda confg ;[76] do we have flow control
bmi log0 ;[57] yes
ldx #erms1c\ ;[57] dont think it will work without
ldy #erms1c^ ;[57]
;[79] jsr prstr ;[57] tell user
;[79] jsr prcrlf ;[57]
jsr prstrl ;[79]
log0:
jsr sutljp ;[85] setup screen distributor
jmp kermit ;[56] 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
;
recev0 lda prtcl ;[85] is this xmodem?
beq recev1 ;[85] no
jmp kermta ;[85] yes a filename is required
receve: lda #on ; Set use file-header switch on in case we
sta usehdr ; don't parse a filename
jsr kerin7 ;[78] just in case were reading kermit.ini
lda #kerehr\ ;[13] Point to extra help commands
sta cmehpt ;[13] ...
lda #kerehr^ ;[13] ...
sta cmehpt+1 ;[13] ...
ldx #mxfnl ;[59][13] Longest length a filename may be
lda dosflg ;[59] prodos?
beq .+4 ;[59] no
ldx #mxppth ;[59] yes allow for path name
ldy #cmfehf ;[13] Tell Comnd about extra help
lda #cmifi ; Load opcode for parsing input files
jsr comnd ; Call comnd routine
;[85] jmp recev1 ; Continue, don't turn file-header switch off
jmp recev0 ;[85] Continue, don't turn file-header switch off
sta pdlen ;[57] length of name parsed
stx kerbf1 ;[57] and where it is
sty kerbf1+1 ;[57]
jsr getfil ;[57] set up fcb1
lda #off ; We parsed a filename so we don't need the
sta usehdr ; info from the file-header
;[78]recev1: lda #cmcfm ; Get token for confirm
;[78] jsr comnd ; and try to parse that
;[78] jmp kermt3 ; Failed - give the error
recev1 jsr prcfm ;[78] parse & confirm
;[81] lda #0 ;[75]
;[81] sta kerins ;[75] make sure we purge com buffers
;[81] jsr tlinit ;[47] initialize the serial port
;[81] bne recev3 ;[62] unable to use the com port
;[81] jsr u2icc ;[62] tattle
;[81] jmp kermit ;[62]
;[81]recev3 ;[62]
jsr comint ;[81] common com init
jsr rswt ; Perform send-switch routine
pha ;[67] save error return
;[68] jsr home ;[67]
jsr bell ;[56] Sound bell at the user
jsr dfsv ;[69] let operator look at screen
jsr test2e ;[61] test for //e 80 col
pla ;[67] get posible error
bne recev2 ;[67] error?,no
jmp stat07 ;[67] yes tell user
recev2 jmp kermit ; Go back to main routine
rswint sta state ;[87] Set that up
lda #$00 ;[87] Zero the packet sequence number
sta n ;[87] ...
sta numtry ;[87] Number of tries
sta oldtry ;[87] Old number of tries
sta eofinp ;[87] End of input flag
sta errcod ;[87] Error indicator
sta rtot ;[87] Total received characters
sta rtot+1 ;[87] ...
sta rtot+2 ;[87] ...
sta stot ;[87] Total Sent characters
sta stot+1 ;[87] ...
sta stot+2 ;[87] ...
sta rchr ;[87] Received characters, current file
sta rchr+1 ;[87] ...
sta rchr+2 ;[87]
sta schr ;[87] Sent characters, current file
sta schr+1 ;[87] ...
sta schr+2 ;[87]
sta tpak ;[87] and the total packet number
sta tpak+1 ;[87]
sta exfg ;[87] start out with classic packet
sta flowfg ;[87] xmodem may need this
jsr sutljp ;[87] set up screen distributor
jsr scrfrm ;[87] format the screen for file xfer
rts ;[87] thats all folks
rswt: lda #'R ; The state is receive-init
jsr rswint ;[87] init lots of things
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
;[83]rini: lda #pdbuf\ ; Point kerbf1 at the packet data buffer
;[83] sta kerbf1 ; ...
;[83] lda #pdbuf^ ; ...
;[83] sta kerbf1+1 ; ...
rini jsr sukrbf ;[83] setup kerbf1
lda prtcl ;[83]
beq .+5 ;[83] its a long reach
jmp rfilf5 ;[83] xmodem? yes
lda numtry ; Get current number of tries
inc numtry ; Increment it for next time
cmp maxtry ; Have we tried this one enought times
bmi rini2 ;[59] no
;[59] beq rini1 ; Not yet, go on
;[59] bcs rini1a ; Yup, go abort this transfer
;[59]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
;[81] lda #false ; Load AC with false status
rts ; and return
rini2: lda servef ;[62] is this server mode?
bne rinici ;[62] yes
jsr rpak ; Go try to receive a packet
;[53] sta rstat ; Store the return status for later
beq rini2b ;[53] ok since false is 0
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
beq rinici ; Go handle the init case
rini2a: ;[53]lda rstat ; Fetch the saved return status
;[53] cmp #false ; Is it false?
;[53] beq rini2b ; Yes, just return with same state
;[53] lda #errcri ;[38] No, fetch the error index
;[53] sta errcod ;[38] and store it as the error code
jsr prcerp ;[38] Check for error packet and process it
bne rini1a ;[67] it was an error so quit
lda getfg ;[75] is this from a get file request
beq rini2b ;[75] no
;[87] lda nfcb1 ;[75] we should resend the R packet
;[87] sta pdlen ;[75] good thing we saved this
;[87] sta kwrk01 ;[75] kercpy needs the count here
;[87] lda #pdbuf\ ;[75] this is
;[87] sta kerto ;[75] where to
;[87] lda #pdbuf^ ;[75] put the
;[87] sta kerto+1 ;[75] file name
;[87] jsr kercpy ;[75] hope kerfrm is ok
rini2c ;[87]
lda #'R ;[75] now for the
sta ptype ;[75] details
sta state ;[87]
lda #0 ;[75] pnum should be 0
sta pnum ;[75]
jsr sfsufn ;[87] now for the file name
jsr spak ;[75] resend the file name
lda #false ;[75] and tell about our troubles
rts ;[75]
;[53] lda #'A ; Abort this transfer
;[53] sta state ; State is now 'abort'
;[53] lda #false ; Set return status to 'false'
;[53] 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
;[81] 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
jsr sparl ;[72] go set the init par length
;[72] lda sebq ; See what we got for an 8-bit quoting
;[72] cmp #$21 ; First check the character range
;[72] bmi rinicn ; Not in range
;[72] cmp #$3f ; ...
;[72] bmi rinicy ; Inrange
;[72] cmp #$60 ; ...
;[72] bmi rinicn ; Not in range
;[72] cmp #$7f ; ...
;[72] bmi rinicy ; Inrange
;[72]rinicn: lda #off ; Punt 8-bit quoting
;[72]rinic3 sta ebqmod ; ...
;[72] lda #$06 ; BTW, the data length is now only 6
;[72] jmp rinic1 ; Continue
;[72]rinicy: lda #on ; Make sure everything is on
;[72] sta ebqmod ; ...
;[72]rinic4 lda #$07 ; Data length for ack-init is 7
;[72]rinic1: sta pdlen ; Store packet data length
jsr spak ; Send that packet
;[87] lda numtry ; Move the number of tries for this packet
;[87] sta oldtry ; to prev packet try count
;[87] lda #$00 ; Zero
;[87] sta numtry ; the number of tries for current packet
;[87] jsr incn ; Increment the packet number once
lda #'F ; Advance to 'File-header' state
rfil00 ldx numtry ;[87]
stx oldtry ;[87]
jmp siniy8 ;[87] common code
;[87] sta state ; ...
;[81] lda #true ; Set up return code
;[87] rts ; Return
rfil0 sta msgfl ;[81] set message file
lda pnum ;[81] do we have the
cmp n ;[81] the correct packet number
beq .+5 ;[81] yes
jmp rfilf1 ;[81] no abort
jsr scrfrm ;[81] format the screen for file xfer
;[87] jmp rfilf9 ;[81] its a long reach
jmp rdatda ;[87] its a long reach
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?
bmi rfil2 ;[59] no
jmp rfilf1 ;[59] yes
;[59] beq rfil1 ; Not yet
;[59] bcs rfil1a ; Yes, go abort the transfer
;[59]rfil1: jmp rfil2 ; Continue transfer
;[59]rfil1a: lda #'A ; Set state of system to 'abort'
;[59]sta state ; ...
;[59] lda #errcrf ;[53] fetch the error index
;[59] sta errcod ;[53] and store it as the error code
;[59] lda #false ; Return code should be 'false'
;[59] rts ; Return
rfil2: jsr rpak ; Try to receive a packet
;[53] sta rstat ; Save the return status
beq rfil2e ;[53] false is 0
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
beq rfilci ; Handle the init case
rfil2a: cmp #'Z ; Is it an 'eof' packet??
; bne rfil2b ; No, try again
; jmp rfilce ; Yes, handle that case
beq rfilce ; Yes, handle that case
cmp #'X ;[81] is this a message?
beq rfil0 ;[81] yes
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: ;[53] lda rstat ; Fetch the return status from Rpak
cmp #'D ;[87] attribute case?
bne rfil2f ;[87] no
rfile2h lda #fncwrt ;[87] yes had to wait for attributes
jsr openf ;[87]
lda #'D ;[87] advance to d case
sta state ;[87]
jmp rdatcd ;[87] let d handle this
rfil2f cmp #'A ;[87] is this file attribute?
bne rfile2g ;[87] no
lda pnum ;[87] right seq?
cmp n ;[87]
bne rfilf1 ;[87] no abort
jsr rapar ;[87] handle the attributes
; lda #0 ;[87] turn off file attr flag
; sta flatr ;[87]
jmp rfilf9 ;[87] its a long reach
rfile2g ;[87]
;[53] cmp #false ; Was it a false return?
;[53] beq rfil2e ; Yes, Nak it and return
;[53] lda #errcrf ;[38] No, fetch the error index
;[53] sta errcod ;[38] and store it as the error code
jsr prcerp ;[38] Check for error packet and process it
bne rfilf1 ;[67] its an error pkt so quit
;[53] lda #'A ; Abort this transfer
;[53] sta state ; ...
;[53] lda #false ; Set up failure return code
;[53] rts ; and return
rfil2e: lda n ; Move the expected packet number
sta pnum ; into the spot for the parameter
jsr nakit ; Nak the packet
;[81] 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?
bpl rfilf1 ;[59] yes
;[59] beq rfili1 ; Not quite yet
;[59] bcs rfili2 ; Yes, go abort this transfer
;[59]rfili1: jmp rfili3 ; Continue
;[59]rfili2:
;[59]rfili5: lda #'A ; Move abort code
;[59] sta state ; to system state
;[59] lda #errcrf ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Prepare failure return
;[59] rts ; and go back
;[69]rfili3: lda pnum ; See if pnum=n-1
;[69] clc ; ...
;[69] adc #$01 ; ...
;[69] cmp n ; ...
rfili3: jsr bpnum ;[69] See if pnum=n-1
bne rfilf1 ;[59] fail
;[59] beq rfili4 ; If it does, than we are ok
;[59] 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
;[72] lda #$06 ; Packet length for init
;[72] sta pdlen ; Stuff that also
jsr sparl ;[72] set paramater list leng
jsr spak ; Send the ack
lda #$00 ; Clear out
sta numtry ; the number of tries for current packet
;[81] 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?
bpl rfilf1 ;[59] yes
;[59] beq rfile1 ; Not yet, continue
;[59] bcs rfile2 ; Yes, go abort it
;[59]rfile1: jmp rfile3 ; ...
;[59]rfile2:
;[59]rfile5: lda #'A ; Load abort code
;[59] sta state ; into current system state
;[59] lda #errcrf ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Prepare failure return
;[59] rts ; and return
;[69]rfile3: lda pnum ; First, see if pnum=n-1
;[69] clc ; ...
;[69] adc #$01 ; ...
;[69] cmp n ; ...
rfile3: jsr bpnum ;[69] First, see if pnum=n-1
bne rfilf1 ;[59] no good
;[59] beq rfile4 ; If so, continue
;[59] 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 ; ...
;[81] lda #true ; Set up successful return code
rts ; and return
rfilcf: lda pnum ; Does pnum=n?
cmp n ; ...
beq rfilf2 ;[59] yes carry on
;[59] bne rfilf1 ; If not, abort
;[59] 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
;[81] lda #false ; Prepare failure return
rts ; and go back
rfilf2: jsr getfil ; Get the filename we are to use
rfilf5 ;[83]
lda #0 ;[81] tell were a file
sta msgfl ;[81]
sta lcurfl ;[87] start with 0
sta lcurfl+1 ;[87]
sta lcurfl+2 ;[87]
sta rchr ;[87] start with 0
sta rchr+1 ;[87]
sta rchr+2 ;[87]
jsr scrfrm ;[79] format the screen for file xfer
;[87] lda flatr ;[87] possible file attributes?
;[87] bne rfilf9 ;[87] wait til we see abt file attributes
;[87] lda #fncwrt ; Tell the open routine we want to write
;[87] jsr openf ; Open up the file
lda prtcl ;[83] xmodem?
beq rfilf9 ;[83] no
lda #'N ;[83] nak it first
bne rfilfa ;[83]
rfilf9 ;[81]
lda #'Y ; Stuff code for 'ack'
rfilfa ;[83]
sta ptype ; Into packet type parm
lda #$00 ; Stuff a zero in as the packet data length
sta pdlen ; ...
jsr spak ; Ack the packet
;[87] lda numtry ; Move current tries to previous tries
;[87] sta oldtry ; ...
;[87] lda #$00 ; Clear the
;[87] sta numtry ; Number of tries for current packet
;[87] jsr incn ; Increment the packet sequence number once
lda #'F ;[87] no change?
;[87] ldx flatr ;[87] file attributes?
;[87] bne .+4 ;[87] yes
;[87] lda #'D ; Advance the system state to 'receive-data'
jmp rfil00 ;[87] common code
;[87] sta state ; ...
;[81] lda #true ; Set up success return
rfilrt ;[87]
rts ; and go back
rfilcb: lda pnum ; Does pnum=n?
cmp n ; ...
bne rfilf1 ;[59] no give it up
;[59] bne rfilb1 ; If not, abort the transfer process
;[59] jmp rfilb2 ; Otherwise, we can continue
;[59]rfilb1: lda #'A ; Code for abort
;[59] sta state ; Stuff that into system state
;[59] lda #errcrf ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Load failure return status
;[59] 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
;[81] 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?
bmi rdat2 ;[59] not yet
jmp rdatf5 ;[59] yes sigh!
;[59] beq rdat1 ; Not yet, so continue
;[59] bcs rdat1a ; Yes, we have, so abort
;[59]rdat1: jmp rdat2 ; ...
;[59]rdat1a: lda #'A ; Code for 'abort' state
;[59] sta state ; Stuff that in system state
;[59] lda #errcrd ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Set up failure return code
;[59] rts ; and go back
rdat2: jsr rpak ; Go try to receive a packet
;[53] sta rstat ; Save the return status for later
beq rdat2d ;[53] bad packet? yes,since false is 0
lda ptype ; Get the type of packet we just picked up
cmp #'D ; Was it a data packet?
;[59] bne rdat2a ; If not, try next type
;[59] jmp rdatcd ; Handle a data packet
beq rdatcd ;[59] yes
rdat2a: cmp #'F ; Is it a file-header packet?
;[59] bne rdat2b ; Nope, try again
;[59] jmp rdatcf ; Go handle a file-header packet
beq rdatcf ;[59] yes
cmp #'X ;[81] is it text (a long reply)
beq rdatcf ;[81] yes, treat it like file-header
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: ;[53]lda rstat ; Fetch the return status
;[53] cmp #false ; Was it a failure return?
;[53] beq rdat2d ; If it was, Nak it
;[53] lda #errcrd ;[38] Fetch the error index
;[53] sta errcod ;[38] and store it as the error code
jsr prcerp ;[38] Check for error packet and process it
bne rdatf5 ;[67] its an error pkt so quit
;[53] lda #'A ; Give up the whole transfer
;[53] sta state ; Set system state to 'false'
;[53] lda #false ; Set up a failure return
;[53] 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
;[81] lda #false ; Give failure return
rts ; Go back
rdatcd: lda pnum ; Is pnum the right sequence number?
cmp n ; ...
beq rdatd7 ;[59] yes
;[59] bne rdatd1 ; If not, try another approach
;[59] 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?
bpl rdatf5 ;[59] yes
;[59] beq rdatd2 ; Not just yet, continue
;[59] bcs rdatd3 ; Yes, go abort the whole thing
;[59]rdatd2: jmp rdatd4 ; Just continue working on the thing
;[59]rdatd3:
;[59]rdatd6: lda #'A ; Load 'abort' code into the
;[59] sta state ; current system state
;[59] lda #errcrd ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Make this a failure return
;[59] rts ; Return
;[69]rdatd4: lda pnum ; Is pnum=n-1... Is the received packet
;[69] clc ; the one previous to the currently
;[69] adc #$01 ; expected packet?
;[69] cmp n ; ...
rdatd4: jsr bpnum ; [69]Is pnum=n-1... Is the received packet
bne rdatf5 ;[59] no give it up
;[59] beq rdatd5 ; Yes, continue transfer
;[59] jmp rdatd6 ; Nope, abort the whole thing
rdatd5: jsr spar ; Go set up init data
lda #'Y ; Make it look like an ack to a send-init
sta ptype ; ...
;[72] lda #$06 ; ...
;[72] sta pdlen ; ...
jsr sparl ;[72] set init par list length
jsr spak ; Go send the ack
lda #$00 ; Clear the
sta numtry ; number of tries for current packet
;[81] lda #true ; ...
rts ; Return (successful!)
;[81]rdatd7: jsr bufemp ; Go empty the packet buffer
rdatd7: lda msgfl ;[81] is this a message?
bne rdatd8 ;[81] yes
jsr bufemp ;[81] Go empty the packet buffer
jmp rdatd9 ;[81]
rdatd8 jsr dbloc ;[81] position to the debug area
jsr abufmt ;[81] now put to the screen
rdatd9 ;[81]
;[81] lda #'Y ; Set up an ack packet
;[81] sta ptype ; ...
lda n ; ...
sta pnum ; ...
;[87] jmp rfilf9 ; [81] common code
rdatda lda #'Y ;[87] Stuff code for 'ack'
sta ptype ;[87] Into packet type parm
lda #$00 ;[87] Stuff a zero in as the packet data length
sta pdlen ;[87] ...
jsr spak ;[87] Ack the packet
lda #'D ;[87] Advance the system state to 'receive-data'
jmp rfil00 ;[87] common code
;[81] lda #$00 ; Don't forget, there is no data
;[81] sta pdlen ; ...
;[81] jsr spak ; Send it!
;[81] lda numtry ; Move tries for current packet count to
;[81] sta oldtry ; tries for previous packet count
;[81] lda #$00 ; Zero the
;[81] sta numtry ; number of tries for current packet
;[81] jsr incn ; Increment the packet sequence number once
;[81] lda #'D ; Advance the system state to 'receive-data'
;[81] sta state ; ...
;[81] lda #true ; ...
;[81] 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?
bmi rdatf3 ;[59] no
;[59] beq rdatf1 ; Not yet, go on
;[59] bcs rdatf2 ; Yup, we have to abort this thing
;[59]rdatf1: jmp rdatf3 ; Just continue the transfer
;[59]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
;[81] lda #0 ;[67] tell close no errors
lda msgfl ;[81] is this a message?
bne .+5 ;[81] yes, nice to have a=0
jsr closef ;[67] now close the file
;[81] lda #false ; ...
rts ; and return false
;[69]rdatf3: lda pnum ; Is this packet the one before the expected
;[69] clc ; one?
;[69] adc #$01 ; ...
;[69] cmp n ; ...
rdatf3: jsr bpnum ; [69]Is this packet the one before the expected
;[69] beq rdatf4 ; If so, we can still ack it
;[69] jmp rdatf5 ; Otherwise, we should abort the transfer
bne rdatf5 ;[69] not even the previous que passo
;[81]rdatf4: lda #'Y ; Load 'ack' code
rdatf4: jmp rfile4 ;[81] common code
;[81] sta ptype ; Stuff that parameter
;[81] lda #$00 ; Use zero as the packet data length
;[81] sta pdlen ; ...
;[81] jsr spak ; Send it!
;[81] lda #$00 ; Zero the number of tries for current packet
;[81] sta numtry ; ...
;[81] lda #true ; ...
;[81] rts ; Return (successful)
;[83]rdatce: lda pnum ; Is this the packet we are expecting?
rdatce: lda prtcl ;[83] xmodem?
bne rdate2 ;[83] yes
lda pnum ;[83] Is this the packet we are expecting?
cmp n ; ...
bne rdatf5 ;[59] no fail it
;[59] bne rdate1 ; No, we should go abort
;[59] jmp rdate2 ; Yup, go handle it
;[59]rdate1: lda #'A ; Load 'abort' code into
;[59] sta state ; current system state
;[59] lda #errcrd ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; ...
;[59] rts ; Return (failure)
rdate2:
; lda #fcb1\ ;[18] Get the pointer to the fcb
; sta kerfcb ;[18] and store it where the close routine
; lda #fcb1^ ;[18] can find it
; sta kerfcb+1 ;[56] ??????[18] ...
;[81] lda #$00 ;[18][3] Make CLOSEF see there are no errors
lda msgfl ; is this a message
bne .+5 ; yes, nice to have a=0
jsr closef ;[18] We are done with this file, so close it
lda rchr+2 ;[87] make the % 100
sta lcurfl+2 ;[87]
lda rchr+1 ;[87]
sta lcurfl+1 ;[87]
;[87] jsr incn ;[18] Increment the packet number
lda #'Y ; Get set up for the ack
sta ptype ; Stuff the packet type
lda n ; packet number
sta pnum ; ...
lda #$00 ; and packet data length
sta pdlen ; parameters
jsr spak ; Go send it!
;[87] jsr incn ;[87] Increment the packet number
lda #'F ; Advance system state to 'file-header'
ldx prtcl ;[83]
beq .+4 ;[83] xmodem? no
lda #'C ;[83] yes thats all
jmp siniy8 ;[87] common code
;[87] sta state ; incase more files are coming
;[81] lda #true ; ...
;[87] rts ; Return (successful)
bpnum lda pnum ;[69] bump pnum mod $3f
clc ;[69]
adc #1 ;[69]
ldx prtcl ;[83] xmodem?
bne .+4 ;[83] yes no modulo
and #$3f ;[69]
cmp n ;[69] kermit recycles @ $3f
rts ;[69]
dpnum dec pnum ;[69]decrement kermit packet #
lda pnum ;[69]
and #$3f ;[69] mod $3f
cmp n ;[69]
rts ;[69]
;[75]sparl lda filmod ;[72] is this text file?
;[75] beq rinic3 ;[72] yes turn off ebq
;[75] lda parity ;[75] is this no parity?
;[75] beq rinic3 ;[75] yes we dont need ebq
;[75] lda ebqmod ;[72] did other kermit agree to ebq?
;[75] bne rinic4 ;[72] yes
;[75] jsr u2s8b ;[72] unable to send/rec 8 bits
;[75] lda #0 ;[72] tell
;[75]rinic3 sta ebqmod ;[72] ...
;[75] lda #$06 ;[72] BTW, the data length is now only 6
;[75] jmp rinic1 ;[72] Continue
;[75]rinic4 lda #$07 ;[72] Data length for ack-init is 7
;[75]rinic4 lda #13 ;[75] Data length for ack-init
;[75] ldx rpsiz ;[75] should we use extended len
;[75] cpx #95 ;[75] > 94 means yes
;[75] bcs rinic1 ;[75] yes
;[75] lda #7 ;[75] tell him only ebq
;[75]rinic1: sta pdlen ;[72] Store packet data length
;[75] rts ;[72]
sparl lda #13 ;[75] tell remote all we can do
sta pdlen ;[75]
rts ;[75]
.SBTTL Send routine
;
; This routine reads a file from disk and sends packets
; of data to the remote kermit.
;
; Input: Filename returned from Comnd routines
;
; Output: File is sent over port
;
; Registers destroyed: A,X,Y
;
send:
jsr kerin7 ;[78] just in case were reading kermit.ini
;[86] ldx #mxfnl ;[59][13] Longest length a filename may be
;[86] lda dosflg ;[59] prodos?
;[86] beq .+4 ;[59] no
;[86] ldx #mxppth ;[59] max path length
;[86] ldy #$00 ;[13] No special flags needed
;[81] sty kerins ;[75] make sure we purge the com buffers
;[86] lda #cmifi ; Load opcode for parsing input files
jsr preptx ; got to stop on comma
;[87] sty getfln ; 0 len
jsr comnd ; Call comnd routine
jmp kermt6 ; Give the 'missing filespec' error
sta kwrk01 ;[13] Store length of file parsed
sta nfcb1 ;[59] in case of prodos set # chs
sta getfln ;[87] size of get file name
stx kerfrm ;[13] Save the from address (addr[atmbuf])
sty kerfrm+1 ;[13] ...
;[81] lda #fcb1\ ;[13] Save the to address (Fcb1)
;[81] sta kerto ;[13] ...
;[81] lda #fcb1^ ;[13] ...
;[81] sta kerto+1 ;[13] ...
sta patl ;[81] just in case we wildcd
ldx #fcb1\ ;[81]
ldy #fcb1^ ;[81] incase were not
lda wcpres ;[81] are we wildcd
beq send7 ;[81] no
jsr sfilec ;[81] set up line of catalog to start on
ldx #patbuf\ ;[81] yes put it in pattern
ldy #patbuf^ ;[81]
send7 stx kerto ;[81]
sty kerto+1 ;[81]
jsr clrfcb ;[13] Clear the fcb
jsr kercpy ;[13] Copy the string
;[66] ldy kwrk01 ;[13] Get filename length
;[66] lda #nul ;[13] Fetch a null character
;[66] sta (kerto),y ;[13] Stuff a null at end-of-buffer
lda wcpres ;[86] are we wild card
bne send9 ;[86] yes only one
lda #dosbuf\ ;[87] now save the file name
sta kerto ;[87]
lda #dosbuf^ ;[87]
sta kerto+1 ;[87]
jsr kercpy ; need for the file name
lda #cmtxt ;[86] see if we got to change name
jsr comnd ;[86]
jmp send9 ;[86] no
sta getfln ;[86] size
sta kwrk01 ;[86] needed for kercpy
stx kerfrm ;[86] where it is
sty kerfrm+1 ;[86]
;[87] ldx #getln\ ;[86] where to put it
;[87] ldy #getln^ ;[86]
;[87] stx kerto ;[86]
;[87] sty kerto+1 ;[86]
jsr kercpy ;[86] save new name for later
send9 ;[86]
jsr prcfm ; Parse and print a confirm
;[81] jsr tlinit ;[47] initialize the serial port
;[81] bne send2 ;[62] unable to use the com port
;[81] jsr u2icc ;[62] tattle
;[81] jmp kermit ;[62]
;[81]send2 ;[62]
jsr comint ;[81] common com init
jsr sswt ; Perform send-switch routine
pha ;[67] save error
;[68] jsr home ;[67]
jsr bell ;[56] Sound bell at the user
jsr dfsv ;[69]
jsr test2e ;[61] test for //e 80 col
pla ;[67] any error?
bne send1 ;[67] no
jmp stat07 ;[67] yes tattle
send1 jmp kermit ; Go back to main routine
sswt: lda #'S ; Set up state variable as
jsr rswint ;[87] set up lots
;[87] sta state ; Send-init
;[87] lda #$00 ; Clear
;[78] sta eodind ;[6] The End-of-Data indicator
;[87] sta n ; Packet number
;[87] sta numtry ; Number of tries
;[87] sta oldtry ; Old number of tries
;[87] sta eofinp ; End of input flag
;[87] sta errcod ; Error indicator
;[87] sta rtot ; Total received characters
;[87] sta rtot+1 ; ...
;[87] sta stot ; Total Sent characters
;[87] sta stot+1 ; ...
;[87] sta rchr ; Received characters, current file
;[87] sta rchr+1 ; ...
;[87] sta rchr+2 ;[84] ...
;[87] sta schr ; Sent characters, current file
;[87] sta schr+1 ; ...
;[87] sta schr+2 ;[84] ...
;[87] sta tpak ;[16] and the total packet number
;[87] sta tpak+1 ;[16] ...
;[87] sta exfg ;[75] start out with classic packet
;[87] sta flowfg ;[83] xmodem may need this
;[87] jsr sutljp ;[85] set up screen distributor
;[87] jsr scrfrm ;[59] and format the screen for file xfer
;[83] lda #pdbuf\ ; Set up the address of the packet buffer
;[83] sta saddr ; so that we can clear it out
;[83] lda #pdbuf^ ; ...
;[83] sta saddr+1 ; ...
lda #$00 ; Clear AC
ldy #$00 ; Clear Y
;[83]clpbuf: sta (saddr),y ; Step through buffer, clearing it out
clpbuf: sta pdbuf,y ;[83] 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 ; ...
;[87]sswt7: lda #false ; Return false
sswt7: cmp #'T ;[87] how abt file attrib?
bne sswt8 ;[87] no
jsr sflatr ;[87] yes send them
jmp sswt1 ;[87] around we go
sswt8 ;[87]
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?
;[67] bpl sdat2q ;[59] yes
bmi sdat1b ;[67]
lda #1 ;[67] so close wont write
jsr closef ;[67] now close the file
jmp sdat2q ;[67] and abort
;[59] beq sdat1 ; No, not yet
;[59] bcs sdat1a ; If it is, go abort
;[59]sdat1: jmp sdat1b ; Continue
;[59]sdat1a: lda #'A ; Load the 'abort' code
;[59] sta state ; Stuff that in as current state
;[59] lda #false ; Enter false return code
;[59] 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
;[59] sta rstat ; First, save the return status
beq sdat2c ;[59] bad get try again
lda ptype ; Now get the packet type received
cmp #'N ; Was it a NAK?
;[59] bne sdat2a ; No, try for an ACK
;[59] jmp sdatcn ; Go handle the nak case
beq sdatcn ; [59]Go handle the nak case
sdat2a: cmp #'Y ; Did we get an ACK?
;[59] bne sdat2b ; No, try checking the return status
;[59] jmp sdatca ; Yes, handle the ack
beq sdatca ; [59]Yes, handle the ack
;[59]sdat2b: lda rstat ; Fetch the return status
;[59] cmp #false ; Failure return?
;[59] beq sdat2c ; Yes, just return with current state
sdat2p jsr prcerp ;[38] Check for error packet and process it
beq sdat2c ;[68] try again
sdat2q lda #'A ; Stuff the abort code
sta state ; as the current system state
;[81] lda #false ; Load failure return code
sdat2c: rts ; Go back
;[69]sdatcn: dec pnum ; Decrement the packet sequence number
;[69] lda n ; Get the expected packet sequence number
;[69] cmp pnum ; If n=pnum-1 then this is like an ack
;[83]sdatcn: jsr dpnum ; [69]Decrement the packet sequence number
sdatcn: ;[83]
lda prtcl ;[83] xmodem?
bne sdatn1 ;[83] yes
jsr dpnum ;[83] Decrement the packet sequence number
;[69] bne sdatn1 ; No, continue handling the nak
;[69] jmp sdata2 ; Jump to ack bypassing sequence check
beq sdata2 ;[69] previous sequence so its ok
sdata1:
;[81]sdatn1: lda #false ; Failure return
sdatn1: ;[81] Failure return
jmp bperrc ;[83] tally the retries
;[83] rts ; ...
;[83]sdatca: lda n ; First check packet number
sdatca: ;[83]
lda prtcl ;[83] xmodem?
bne sdata2 ;[83] yes
lda n ;[83] First check packet number
cmp pnum ; Did he ack the correct packet?
bne sdata1 ; No, go give failure return
;[87]sdata2: lda #$00 ; Zero out number of tries for current packet
sdata2: ;[87]
;[87] lda #$00 ;[87] Zero out number of tries for current packet
;[87] sta numtry ; ...
;[87] jsr incn ; Increment the packet sequence number
jsr bufill ; Go fill the packet buffer with data
sta size ; Save the data size returned
;[72] lda eofinp ; Load end-of-file indicator
;[72] beq sdatrd ;[59] not eof
cmp #0 ;[72] 0 is eof,flags may not be set
bne sdatrd ;[72] works better this way
;[59] cmp #true ; Was this set by Bufill?
;[59] beq sdatrz ; If so, return state 'Z' ('Send-eof')
;[59] jmp sdatrd ; Otherwise, return state 'D' ('Send-data')
;[87]sdatrz: lda #$00 ;[44] Clear
sta eofinp ;[44] End of input flag
; lda #fcb1\ ;[44] Get the pointer to the fcb
; sta kerfcb ;[44] and store it where the close routine
; lda #fcb1^ ;[44] can find it
; sta kerfcb+1 ;[56] ???????????[44] ...
;[59] lda #$00 ;[44] Make CLOSEF see there are no errors
lda #1 ;[59] since we are reading,do not attempt write
jsr closef ;[44] We are done with this file, so close it
lda schr+2 ;[87] make it 100%
sta lcurfl+2 ;[87]
lda schr+1 ;[87]
sta lcurfl+1 ;[87]
lda #'Z ; Load the Eof code
jmp siniy8 ;[87] common code
;[87] sta state ; and make it the current system state
;[81] lda #true ; We did succeed, so give a true return
;[87] rts ; Go back
sdatrd: lda #'D ; Load the Data code
jmp siniy8 ;[87] common code
;[87] sta state ; Set current system state to that
;[81] lda #true ; Set up successful return
;[87] rts ; and go back
sfsufn lda dosflg ;[87] save temp
pha ;[87]
lda #true ;[87]
sta dosflg ;[87] for bufill to work right
sta fgetgn ;[87] say were from filename
jsr bufill ;[87] fill packet
sta pdlen ;[87] and how many
lda #0 ;[87]
sta schr ;[87] start over
sta schr+1 ;[87]
sta schr+2 ;[87]
sta fgetgn ;[87] turn off fgetc filename
pla ;[87] restore dosflg
sta dosflg ;[87]
rts ;[87]
sfil: lda filmod ;[6] Fetch the file mode
;[83] beq sfil0 ;[6] If it is a text file, we don't need length
;[83] lda #on ;[6] Otherwise, set flag to get length of file
sta fetfl ;[6] from first sector
sfil0: lda numtry ; Fetch the current number of tries
inc numtry ; Up it by one
cmp maxtry ; See if we went up to too many
;[87] bpl sdat2q ;[59] yes
bmi sfil1b ;[87] its a long reach
jmp sdat2q ;[87] yes
;[59] beq sfil1 ; Not yet
;[59] bcs sfil1a ; Yes, go abort
;[59]sfil1: jmp sfil1b ; If we are still ok, take this jump
;[59]sfil1a: lda #'A ; Load code for abort
;[59] sta state ; and drop that in as the current state
;[59] lda #false ; Load false for a return code
;[59] rts ; and return
;[59]sfil1b: ldy #$00 ; Clear Y
;[83]sfil1b ldy nfcb1 ;[59] get # chs
sfil1b ;[83]
ldy prtcl ;[83] xmodem?
beq sfil1a ;[83] no
jsr rpak ;[83] wait for a nak
beq sfil1e ;[83] bad packet
lda ptype ;[83] what kind of packet?
cmp #'N ;[83] we need a nak to start
beq sfila2 ;[83] got one now carry on
sfil1e rts ;[83] try again
sfil1a ;[83]
;[87] ldy getfln ;[86] are we changing names?
;[87] beq sfil1z ;[86] no
;[87] sty pdlen ;[86]
;[87]sfil1w dey ;[86]
;[87] bmi sfil1y ;[86]
;[87] lda getln,y ;[86]
;[87] sta pdbuf,y ;[86]
;[87] jmp sfil1w ;[86]
;[87]sfil1y ldy #0 ;[86] only once
;[87] sty getfln ;[86]
;[87] beq sfil1d ;[86] together again
;[87]sfil1z ;[86]
;[87] ldy nfcb1 ;[83] get # chs
;[87] sty pdlen ;[59] This is the length of the filename
;[87]sfil1c dey ;[59]
;[87] bmi sfil1d ;[59]
;[59]sfil1c: lda fcb1,y ; Get a byte from the filename
;[87] lda fcb1,y ;[59]
;[59] cmp #$00 ; Is it a null?
;[59] beq sfil1d ; No, continue
;[87] sta pdbuf,y ; Move the byte to this buffer
;[59] iny ; Up the index once
;[87] jmp sfil1c ; Loop and do it again
sfil1d:
;[59] 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 sfsufn ;[87] put filename in buf controlified
jsr spak ; Go send the packet
sfil2: jsr rpak ; Go try to receive an ack
;[59] sta rstat ; Save the return status
beq sfil2r ;[59] bad packet so how can we look further?
lda ptype ; Get the returned packet type
cmp #'N ; Is it a NAK?
;[59] bne sfil2a ; No, try the next packet type
;[59] jmp sfilcn ; Handle the case of a nak
beq sfilcn ;[59] yes
sfil2a: cmp #'Y ; Is it, perhaps, an ACK?
;[59] bne sfil2b ; If not, go to next test
;[59] jmp sfilca ; Go and handle the ack case
beq sfilca ;[59] yes
;[59]sfil2b: lda rstat ; Get the return status
;[59] beq sfil2r ;[59] failure
jmp sdat2p ;[59] check for error first
;[59] cmp #false ; Is it a failure return?
;[59] bne sfil2c ; No, just go abort the send
sfil2r rts ; Return failure with current state
;[59]sfil2c: jsr prcerp ;[38] Check for error packet and process it
;[59] lda #'A ; Set state to 'abort'
;[59] sta state ; Stuff it in its place
;[59] lda #false ; Set up a failure return code
;[59] rts ; and go back
;[69]sfilcn: dec pnum ; Decrement the receive packet number once
;[69] lda pnum ; Load it into the AC
;[69] cmp n ; Compare that with what we are looking for
sfilcn: jsr dpnum ; [69]Decrement the receive packet number once
beq sfila2 ;[59]
;[59] bne sfiln1 ; If n=pnum-1 then this is like an ack, do it
;[59] jmp sfila2 ; This is like an ack
sfila1:
;[81]sfiln1: lda #false ; Load failure return code
sfiln1: ;[81] Load failure return code
;[83] rts ; and return
jmp bperrc ;[83] bump and print retries
sfilca: lda n ; Get the packet number
cmp pnum ; Is that the one that was acked?
bne sfila1 ; They are not equal
;[87]sfila2: lda #$00 ; Clear AC
sfila2: ;[87]
;[87] lda #$00 ; Clear AC
;[87] sta numtry ; Zero the number of tries for current packet
;[87] 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 ; ...
jsr scrfrm ;[79] and format the screen for file xfer
lda #fncrea ; Open for input
jsr openf ; Open the file
lda dosflg ;[87] is this prodos?
bne sfila3 ;[87] yes
lda fillen ;[87] ok this is best 3.3 can give us
sta lcurfl ;[87] lsb of file length (non text)
lda fillen+1 ;[87] msb
sta lcurfl+1 ;[87]
lda #0 ;[87]
sta lcurfl+2 ;[87] needed for 3.3 file length
beq sfila5 ;[87]
sfila3 jsr prodos ;[87] prodos file size in bytes
.byte geteof ;[87]
.word pmark ;[87]
bcc .+5 ;[87] error
jsr perror ;[87] sigh yes
lda pmark+2 ;[87] size in bytes
sta lcurfl ;[87] lsb
lda pmark+3 ;[87]
sta lcurfl+1 ;[87]
lda pmark+4 ;[87]
sta lcurfl+2 ;[87] msb
sfila5 ;[87]
lda #'T ;[87] file attributes?
ldx flatr ;[87]
beq sfila7 ;[87] no
jmp siniy8 ;[87]
sfila7 ;[87]
jsr bufill ; Go get characters from the file
sta size ; Save the returned buffer size
jsr comint ;[85] make sure the buffer is empty
lda #'D ; Set state to 'Send-data'
jmp siniy8 ;[87]
;[87] sta state ; ...
;[81] lda #true ; Set up true return code
;[87]sfila7 ;[83]
;[87] 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?
bmi seof1b ;[59] no
jmp sini1a ;[59] yes sigh!
;[59] beq seof1 ; Not quite yet
;[59] bcs seof1a ; Yes, go abort
;[59]seof1: jmp seof1b ; Continue sending packet
;[59]seof1a: lda #'A ; Load 'abort' code
;[59] sta state ; Make that the state of the system
;[59] lda #errmrc ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Return false
;[59] 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
;[59] sta rstat ; Save the return status
;[83] beq seof2c ;[59] bad get
;[87] beq sfila7 ;[83] bad get
beq seofa7 ;[87] bad get
lda ptype ; Get the received packet type
cmp #'N ; Was it a nak?
;[59] bne seof2a ; If not, try the next packet type
;[59] jmp seofcn ; Go take care of case nak
beq seofcn ;[59] Go take care of case nak
seof2a: cmp #'Y ; Was it an ack
;[59] bne seof2b ; If it wasn't that, try return status
;[59] jmp seofca ; Take care of the ack
beq seofca ;[59] Take care of the ack
;[59]seof2b: lda rstat ; Fetch the return status
;[59] cmp #false ; Was it a failure?
;[59] beq seof2c ; Yes, just fail return with current state
jmp sdat2p ;[59]
;[59] jsr prcerp ;[38] Check for error packet and process it
;[59] lda #'A ; Abort the whole thing
;[59] sta state ; Set the state to that
;[59] lda #false ; Get false return status
;[59]seof2c: rts ; Return
;[69]seofcn: dec pnum ; Decrement the received packet sequence number
;[69] lda n ; Get the expected sequence number
;[69] cmp pnum ; If it's the same as pnum-1, it is like an ack
;[83]seofcn: jsr dpnum ; [69]Decrement the received packet sequence number
seofcn: ;[83]
lda prtcl ;[83] xmodem?
bne seof2c ;[83] yes
jsr dpnum ;[83] Decrement the received packet sequence number
beq seofa2 ;[59]
;[59] bne seofn1 ; It isn't, continue handling the nak
;[59] jmp seofa2 ; Switch to an ack but bypass sequence check
seofa1:
;[81]seofn1: lda #false ; Load failure return status
seofn1: ;[81] Load failure return status
;[83]seof2c rts ;[59] and return
seof2c jmp bperrc ;[83] bump and print retries
;[83]seofca: lda n ; Check sequence number expected against
seofca: ;[83]
lda prtcl ;[83]xmodem?
beq seofcx ;[83] no
lda #'C ;[83] yes thats all
sta state ;[83]
seofa7 ;[87] place to hang ur hat
rts ;[83]
seofcx ;[83]
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 clrfcb ;[81] just in case we wildcd
jsr getnfl ; Call the routine to get the next file
;[81] cmp #eof ; If it didn't find any more
bne seofrf ;[59] no eof
;[59] beq seofrb ; then return state 'B' ('Send-Eot')
;[59] jmp seofrf ; Otherwise, return 'F' ('Send-file')
seofrb: lda #'B ; Load Eot state code
sta state ; Store that as the current state
;[81] 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
;[81] lda #true ; Make success the return status
sflat3 ;[87]
rts ; and return
sflatr ;[87] send file attributes
lda numtry ;[87]
cmp maxtry ;[87] too much?
blt .+5 ;[87] no
jmp sini1a ;[87] ugh
inc numtry ;[87]
jsr sapar ;[87]
lda #'A ;[87] this is attribute pkt
sta ptype ;[87] len is set in sapar
lda n ;[87]
sta pnum ;[87]
jsr spak ;[87] send the pkt
jsr rpak ;[87] and receive pkt
beq sflat3 ;[87] malo
lda ptype ;[87] see what we got
cmp #'Y ;[87]
beq .+5 ;[87] its an ack
jmp sinic1 ;[87] now what?
lda n ;[87]
cmp pnum ;[87] right pkt?
bne sflat3 ;[87] no
jmp sfila7 ;[87] Set state to 'Send-data'
;[81]sini: lda #pdbuf\ ; Load the pointer to the
sini: lda #'S ;[81]
sinio sta sinioo+1 ;[81] set type of init
;[83] lda #pdbuf\ ; Load the pointer to the
;[83] sta kerbf1 ; packet buffer into its
;[83] lda #pdbuf^ ; place on page zero
;[83] sta kerbf1+1 ; ...
jsr sukrbf ;[83] setup kerbf1
lda prtcl ;[83]
beq sinio3 ;[83]
jmp sfil ;[83] xmodem this way
sinio3 ;[83]
jsr spar ; Go fill in the send init parms
lda numtry ; If numtry > maxtry
cmp maxtry ; ...
bmi sini1b ;[59] ok
;[59] beq sini1 ; ...
;[59] bcs sini1a ; then we are in bad shape, go fail
;[59]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
sinioo lda #'S ; Packet type is 'Send-init'
sta ptype ; Store that
;[62] lda ebqmod ; Do we want 8-bit quoting?
;[62] cmp #on ; ...
;[62] beq sini1c ; If so, data length is 7
;[72] lda #$06 ; Else it is 6
;[72] ldx ebqmod ;[62] is this 8 bit quoting?
;[72] beq sini1d ;[62] no
;[62] jmp sini1d ; ...
;[72]sini1c: lda #$07 ; The length of data in a send-init is always 7
;[72]sini1d: sta pdlen ; Store that parameter
jsr sparl ;[72] set par length according to 8 bit q
lda n ; Get the packet number
sta pnum ; Store that in its common area
jsr spak ; Call the routine to ship the packet out
jsr rpak ; Now go try to receive a packet
;[59] sta rstat ; Hold the return status from that last routine
;[83] beq sinicf ;[59] bad packet how can we continue?
beq siniy9 ;[83] bad packet how can we continue?
sinics: lda ptype ; Case statement, get the packet type
cmp #'Y ; Was it an ACK?
;[59] bne sinic1 ; If not, try next type
;[59] jmp sinicy ; Go handle the ack
beq sinicy ;[59] handle the ack
sinic1: cmp #'N ; Was it a NAK?
;[59] bne sinic2 ; If not, try next condition
;[59] jmp sinicn ; Handle a nak
beq sinicn ;[59] handle a nak
;[59]sinic2: lda rstat ; Fetch the return status
;[59] beq sinicf ;[59] failure
;[59] cmp #false ; Was this, perhaps false?
;[59] bne sinic3 ; Nope, do the 'otherwise' stuff
;[59] jmp sinicf ; Just go and return
sinic3: jsr prcerp ;[38] Check for error packet and process it
beq sinicf ;[68] no try again
lda #'A ; Set state to 'abort'
sta state ; ...
lda #false ;[81]
sinicn:
;[83]sinicf: rts ; Return
sinicf: jmp bperrc ;[83] bump and print retries
;[87]sinicy: ldy #$00 ; Clear Y
sinicy: ;[87]
lda n ; Get packet number
cmp pnum ; Was the ack for that packet number?
beq siniy1 ; Yes, continue
;[83] lda #false ; No, set false return status
rts ; and go back
siniy1: jsr rpar ; Get parms from the ack packet
;[72] lda sebq ; Check if other Kermit agrees to 8-bit quoting
;[72] cmp #'Y ; ...
;[75] lda filmod ;[72] is this text file?
;[75] beq siniy4 ;[72] yes turn off ebq
;[75] lda ebqmod ;[72] did other kermit agree to ebq?
;[75] bne siniy2 ;[72] yes were ok
;[75] jsr u2s8b ;[72] problems unable to send 8 bits
;[75]siniy4 lda #off ; Shut it off
;[75] sta ebqmod ; ...
;[75]siniy2:
;[81]siniy3: lda #'F ; Load code for 'Send-file' into AC
siniy3: lda wcpres ;[81] are we wildcd
beq siniy7 ;[81] no
;[87] lda tl0end ;[81] set up stack
;[87] sta stack ;[81]
;[87] lda tl0end+1 ;[81]
;[87] sta stack+1 ;[81]
jmp seofa2 ;[81]
siniy7 lda #'F ;[81] Load code for 'Send-file' into AC
siniy8 ;[87] common code
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
;[83] lda #true ; Return true
lda #true ;[84] Return true, needed for remote
siniy9 ;[83]
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
bmi sbrk1b ;[59] no
jmp sini1a ;[59] yes
;[59] beq sbrk1 ; Not yet
;[59] bcs sbrk1a ; Yes, go abort the whole thing
;[59]sbrk1: jmp sbrk1b ; Continue send
;[59]sbrk1a: lda #'A ; Load 'abort' code
;[59] sta state ; Make that the system state
;[59] lda #errmrc ; Fetch the error index
;[59] sta errcod ; and store it as the error code
;[59] lda #false ; Load the failure return status
;[59] 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
;[83] sta rstat ; First, save the return status
beq siniy9 ;[83] bad packet
lda ptype ; Get the packet type received
cmp #'N ; Was it a NAK?
;[83] bne sbrk2a ; If not, try for the ack
;[83] jmp sbrkcn ; Go handle the nak case
beq sbrkcn ;[83] Go handle the nak case
sbrk2a: cmp #'Y ; An ACK?
beq sbrkca ;[59] yes
;[59] bne sbrk2b ; If not, look at the return status
;[59] jmp sbrkca ; Go handle the case of an ack
sbrk2b: lda rstat ; Fetch the return status from Rpak
;[59] cmp #false ; Was it a failure?
beq sbrk2c ; Yes, just return with current state
jmp sdat2p ;[59] common routine
;[59] jsr prcerp ;[38] Check for error packet and process it
;[59] lda #'A ; Set up the 'abort' code
;[59] sta state ; as the system state
;[59] lda #false ; load the false return status
sbrk2c: rts ; and return
;[69]sbrkcn: dec pnum ; Decrement the received packet number once
;[69] lda n ; Get the expected sequence number
;[69] cmp pnum ; If =pnum-1 then this nak is like an ack
sbrkcn: jsr dpnum ; [69]Decrement the received packet number once
beq sbrka2 ;[59]
;[59] bne sbrkn1 ; No, this was no the case
;[59] jmp sbrka2 ; Yes! Go do the ack, but skip sequence check
sbrka1:
;[81]sbrkn1: lda #false ; Load failure return code
sbrkn1: ;[81] Load failure return code
;[83] rts ; and go back
jmp bperrc ;[83] bump and print retries
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
;[87]sbrka2: lda #$00 ; Yes, clear number of tries for this packet
sbrka2: ;[87]
;[87] sta numtry ; ...
;[87] jsr incn ; Up the packet sequence number
lda #'C ; The transfer is now complete, reflect this
jmp siniy8 ;[87] common code
;[87] sta state ; in the system state
;[87] lda #true ; Return success!
;[87] rts ; ...
.SBTTL Server mode
kicmd lda cmdctr ;[81] have we given them
cmp cmdlen ;[81] all the command?
bcs kicmd3 ;[81] yes
ldx cmdctr ;[81] no give more of the cmd
lda cmdbuf,x ;[81]
ora #$80 ;[81] make sure its neg ascii
inc cmdctr ;[81] ready for next
rts ;[81]
kicmd3 lda #hcr ;[81] terminate it
rts ;[81]
kicout ;[81]
sty kwrk01 ;[81] save
ldy pdlen ;[81] send another ch?
bne kicou3 ;[81] no
pha ;[81]
cmp #hcr ;[81] have more than the prompt?
bne kicou2 ;[81]
inc kicrct ;[81] bump the cr count
ldy #2 ;[81]
cpy kicrct ;[81] have we seen 3 or more?
bcs kicou2 ;[81] no
ldy #'E ;[81] make it an error packet
sty ptype ;[81]
kicou2 and #$7f ;[81] make it ascii
jsr ctrlch ;[81] put it in com buffer
bcc kicou7 ;[81] are we full, no
kicou5 inc pdlen ;[81] tattle, no more
bne kicou9 ;[81]
kicou7 lda addlf ;[81]
beq kicou9 ;[81] do we need to add a lf, no
lda #lf ;[81] yes
jsr ctrlch ;[81]
bcs kicou5 ;[81]
lda #0 ;[81] turn off lf flag
sta addlf ;[81]
kicou9 pla ;[81]
kicou3 ldy kwrk01 ;[81] restore
rts ;[81] thats all folks
servre ldy #0 ;[81]
servr3 lda erms1h,y ;[81]
beq servr7 ;[81] all thru? yes
and #$7f ;[81] make it ascii
sta pdbuf,y ;[81] return the error to remote
iny ;[81]
bne servr3 ;[81]
servr7 lda ptype ;[81]
sta pdbuf,y ;[81] finish error
iny ;[81] tell how many
sty pdlen ;[81]
lda #'E ;[81] make it an error packet
sta ptype ;[81]
jmp sercm7 ;[81]
sercmd ldy pdlen ;[81] get length of this cmd
sty cmdlen ;[81] and save it
beq sercm3 ;[81] just in case its null
sercm2 lda pdbuf-1,y ;[81] now save the remote cmd
sta cmdbuf-1,y ;[81]
dey ;[81]
bne sercm2 ;[81] thru? no
sercm3 sty cmdctr ;[81] start with 0
sty pdlen ;[81]
sty datind ;[81]
sty kicrct ;[81]
ldx #kicout\ ;[81] place for cout to come
ldy #kicout^ ;[81]
jsr svcout ;[81] interupt cout & save current on stack
ldx #kicmd\ ;[81] place for cmd to come for instructions
ldy #kicmd^ ;[81]
jsr svcmd ;[81]
lda kermit ;[81] now to interupt kermit return
pha ;[81]
lda #$ea ;[81] a nop
sta sercm5 ;[81] the first time only
lda #'Y ;[81] return a ack
sta ptype ;[81]
ldx #prmt\ ;[81] first instruction of kermit
ldy #prmt^ ;[81] for Comnd routines
lda #cmini ;[81] Argument for comnd call
jsr comnd ;[81] Set up the parser and print the prompt
sercm5 nop ;[81]
lda #$60 ;[81] a rts
sta kermit ;[81] hope this works
sta sercm5 ;[81] turn error rtn into a rts
jsr kermt0 ;[81] go do the command
pla ;[81] should rtn here when thru
sta kermit ;[81] restore kermit to normal
jsr rscmd ;[81] restore cmd reader
jsr rscout ;[81] restore cout
lda datind ;[81] tell how many
sta pdlen ;[81]
sercm7 jsr spak ;[81] send it down the line
jmp servel ;[81] around we go again
;[81]server jsr tlinit ;[62] initilize the com card
;[81] bne serve9 ;[62] unable to use the com port
;[81] jsr u2icc ;[62] tattle
;[81] jmp sallt1 ;[62]
;[81]serve9 ;[62]
server jsr comint ;[81] common com init
jsr kerin7 ;[78] just in case were reading kermit.ini
jsr home ;[62] make it look nice
ldx #shsm01\ ;[75[ tell whats going on
ldy #shsm01^ ;[75]
jsr prstr ;[75]
lda #on ;[62] set server mode flag on
sta servef ;[62]
sta usehdr ;[62] use paacket info
servel lda #$00 ;[62] Zero the packet sequence number
sta n ;[62] ...
sta exfg ;[75] use classic packets
lda maxtry ;[62] back down for test
sta numtry ;[62] Number of tries
sta state ;[62] initilize so we can get debug info
sltry jsr telck ;[62] a keyboard ch?
beq sltry2 ;[62] no
jsr rdkey ;[62] yes get it
cmp #$83 ;[62] is it ^c ?
beq sallt2 ;[62] yes quit
sltry2 jsr srini ;[62] get a packet
beq sltry ;[62] no good try again
lda ptype ;[62] what packet did we get
cmp #'K ;[81] is this a kermit cmd?
bne .+5 ;[81] hate to do this
jmp sercmd ;[81] yes here comes a command
cmp #'S ;[62] is this a send?
beq swfaf ;[62] yes here comes a file
cmp #'R ;[62] is this a get?
beq sstf ;[62] yes send the file
cmp #'E ;[62] an error packet?
beq sepkt ;[62] tattle
cmp #'G ;[62] perhaps were thru
beq swmbt ;[62] maybe
cmp #'B ;[62] how about a break
bne .+5 ;[62] hate to do this
jmp sallth ;[62] yes were all thru
cmp #'I ;[62] how about initilize
beq serint ;[62] yes
cmp #'Y ;[81] how about a ack
beq sltry ;[81] yes just ignore it for now
cmp #'N ;[81] how about a nak
beq sltry ;[81] yes just ignore it for now
pha ;[62] save the error character
ldx #erms1h\ ;[62] tell about server command
ldy #erms1h^ ;[62]
jsr prstr ;[62]
pla ;[62] now print the character
;[79] jsr prchr ;[62] handle cntl chs also
;[79] jsr prcrlf ;[62] and end the line
jsr prchrr ;[79] cntl chs & crlf
;[81] lda ptype ;[62] what packet did we get
;[81] cmp #'Y ;[62] how about a ack
;[81] beq sltry ;[62] yes just ignore it for now
;[81] cmp #'N ;[62] how about a nak
;[81] beq sltry ;[62] yes just ignore it for now
jmp servre ;[81] return the error
sallt2 lda #off ;[62] turn server mode off
sta servef ;[62]
jsr bell ;[62] wake up
jsr home ;[62] make it look nice
sallt1 ;[62]
.ifeq termnl ;[63]
lda confg ;[78]
sta flowfg ;[78] restore flow controll
jsr sutljp ;[85] set up screen distributor
jmp ch0lup ;[63] and return to where we came from
.endc ;[63]
.ifne termnl ;[63]
jmp kermit ;[62] exit server mode
.endc ;[63]
serint
jsr rinici ;[62] nice rtn
lda oldtry ;[62] got to save this
sta numtry ;[62]
jmp sltry ;[62] around we go again
swfaf jsr rswt ;[62] hope this works
.ifeq termnl ;[63]
jmp sallt2 ;[63] in terminal we are thru
.endc ;[63]
.ifne termnl ;[63]
jmp servel ;[62] around we go again
.endc ;[63]
sstf jsr clrfcb ;[66] clear fcb
jsr sfilec ;[81] index of lines in catalog
ldy #0 ;[62] move file name to fcb1
sty wcpres ;[81]
sstf1 lda (kerbf1),y ;[62] get ch of filename
sta fcb1,y ;[62] and set it up for open
cmp #wcmult ;[81]
beq sstf7 ;[81] wildcd present
cmp #wcsing ;[81]
bne sstf8 ;[81] no
sstf7 sta wcpres ;[81] tatle about wildcd present
sstf8 jsr convuc ;[81] convert to upper case
sta patbuf,y ;[81] just in case
iny ;[62] now for the next
cpy pdlen ;[62] are we thru?
bne sstf1 ;[62] well soon know
sty nfcb1 ;[62] set count of chs in fcb1
sty patl ;[81] pattern length also
jsr sswt ;[62] hope hope
.ifeq termnl ;[63]
jmp sallt2 ;[63] in terminal we are thru
.endc ;[63]
.ifne termnl ;[63]
jmp servel ;[62] around we go again
.endc ;[63]
sepkt jsr prcerp ;[62] process error packet
.ifeq termnl ;[63]
jmp sallt2 ;[63] in terminal we are thru
.endc ;[63]
.ifne termnl ;[63]
jmp servel ;[62] around we go again
.endc ;[63]
swmbt ldy #0 ;[62] only way to do indirect
lda (kerbf1),y ;[62] get first data ch
cmp #'L ;[62] are we thru
beq sallth ;[62] yes
cmp #'F ;[62] maybe
beq sallth ;[62] yes
pha ;[62] save the unknown operand
ldx #erms1i\ ;[62] tell about unknown operand
ldy #erms1i^ ;[62]
jsr prstr ;[62]
pla ;[62] now for the offending ch
;[79] jsr prchr ;[62] handle cntl chs
;[79] jsr prcrlf ;[62] end the line
jsr prchrr ;[79] cntl chs & crlf
jmp kermit ;[62] and stop server
sallth lda #'Y ;[62] now to send an ack
sta ptype ;[62]
lda #0 ;[62] set the len
sta pdlen ;[62] of the packet
jsr spak ;[62] send the packet
jmp sallt2 ;[62] thats all
;[83]srini lda #pdbuf\ ;[62] Point kerbf1 at the packet data buffer
;[83] sta kerbf1 ;[62] ...
;[83] lda #pdbuf^ ;[62] ...
;[83] sta kerbf1+1 ;[62] ...
srini jsr sukrbf ;[83] setup kerbf1
dec numtry ;[62]
bne srini2 ;[62] Have we tried this one enought times
lda #errcri ;[62] Fetch the error index
sta errcod ;[62] and store it as the error code
jmp stat07 ;[62] Tell somebody unable to communicate
srini2: jsr rpak ;[62] Go try to receive a packet
beq srini3 ;[62] ok since false is 0
rts ;[62]
srini3: lda n ;[62] Get packet sequence number expected
sta pnum ;[62] Stuff that parameter at the Nakit routine
jsr nakit ;[62] Go send the Nak
;[81] lda #false ;[62] Load AC with false status
rts ;[62] and go back
.SBTTL Modem routine ;
modem jsr kerin7 ;[78] just in case were reading kermit.ini
jsr clrfcb ;[78] dos needs this
ldy #dialms-dialnm-1 ;[78] now for the size of the file name - null
sty nfcb1 ;[78]
dial2 lda dialnm-1,y ;[78] now move the file name to fcb1
sta fcb1-1,y ;[78]
dey ;[78]
bne dial2 ;[78] are we thru? no
jsr prcrlf ;[78]
ldx #dialms\ ;[78] tell what
ldy #dialms^ ;[78] were going to do
jsr prstr ;[78]
ldx #dialnm\ ;[78] now for the
ldy #dialnm^ ;[78] file name
;[79] jsr prstr ;[78]
;[79] jsr prcrlf ;[78]
jsr prstrl ;[79]
jsr opentf ;[78] save current and open text file
ldx #pdbuf\ ;[78] if we get here its a good open
ldy #pdbuf^ ;[78] hope theres enough room
stx cminf1 ;[78]
sty cminf1+1 ;[78]
dial3 jsr home ;[78] clear screen for choice
ldx #dials\ ;[78] tell options
ldy #dials^ ;[78]
;[79] jsr prstr ;[78] at top of screen
;[79] jsr prcrlf ;[78]
jsr prstrl ;[79]
ldy #0 ;[78] start things out
sty kwrk01 ;[78] at 0
;[85] sty kwrk02 ;[78]
;[85]dial5 lda kwrk02 ;[78] print the
sty wchpat ;[85] hope we dont use this one
dial5 lda wchpat ;[85] print the
jsr prhex ;[78] index
lda #0 ;[78] flag for start of comments
sta chksum ;[78]
lda #':+$80 ;[78]
jsr cout ;[78] nicely
dial7 jsr fgetc ;[78] get a ch from file
jmp dialef ;[78] got a eof
ora #$80 ;[78] make it nasc
jsr cout ;[78] on the screen
cmp #hcr ;[78] eol ?
beq dial4 ;[78] that always get entered
ldx chksum ;[78] have we seen the begining of comments?
bne dial7 ;[78] yes dont enter in table
cmp #hspace ;[78] no, is this start of comments?
bne dial4 ;[78] no
sta chksum ;[78] yes turn flag on
jmp dial7 ;[78] and dont enter into table
dial4 ldy kwrk01 ;[78] index into buffer
sta (cminf1),y ;[78]
inc kwrk01 ;[78] ready for next
bne dial8 ;[78] are we > 256? no
inc cminf1+1 ;[78] yes next page
dial8 cmp #hcr ;[78] end of line
bne dial7 ;[78] no
;[85] inc kwrk02 ;[78] bump line counter
inc wchpat ;[85] bump line counter
lda #pdbuf+257^ ;[78] limit of 512 bytes or so
cmp cminf1+1 ;[78] some test huh
bcc dialef ;[78] enough already
lda #10 ;[78] only print 10 at a time
;[85] cmp kwrk02 ;[78]
cmp wchpat ;[85]
bne dial5 ;[78] get the next line
dialef jsr bell ;[78] get someones attention
jsr rdkey ;[78] get users option
and #$7f ;[78] make it ascii
ora #$20 ;[78] make it lower case
cmp #'m ;[78] want more?
beq dial3 ;[78] yes
cmp #'q ;[78] want to quit?
bne dial27 ;[78] no
jmp dialc ;[78] yes only way to reach this
dial27 sec ;[78] make it binary
sbc #'0 ;[78] try for numbers
dial9 ;[78]
;[85] cmp kwrk02 ;[78] is this a legal option?
cmp wchpat ;[85] is this a legal option?
bcs dialef ;[78] no
sta kwrk01 ;[78] save the users option
jsr clostf ;[78] close file and restore filmod
;[81] jsr tlinit ;[78] initialize the serial port
;[81] bne dial17 ;[78] ok
;[81] jsr u2icc ;[78] tell we cant
;[81] jmp kermit ;[78] thats all
jsr comint ;[81] common com init
dial17 ldy #0 ;[78] now for the search
sty chksum ;[78] this will be the line counter
sty match ;[85] 0 esc ch seen flag
ldx #pdbuf\ ;[84]
stx cminf1 ;[84] reset start of array
ldx #pdbuf^ ;[78]
stx cminf1+1 ;[78] reset start of array
ldx kwrk01 ;[78] users choice
dial11 cpx chksum ;[78] current line?
beq dial13 ;[78] yes dial it
dial12 lda (cminf1),y ;[78] search for next line
iny ;[78] ready for next ch
bne dial14 ;[78]
inc cminf1+1 ;[78] next page
dial14 cmp #hcr ;[78] eol ?
bne dial12 ;[78] no
inc chksum ;[78] yes
jmp dial11 ;[78] try this one
dial13 sty chksum ;[78] this is the start of the line
lda (cminf1),y ;[78] get ch for modem
ldx match ;[85] have we seen esc ch?
bne modmeo ;[85] yes take this ch asis & shut off flg
cmp #'\+$80 ;[85] is this esc ch?
bne modmnp ;[85] no
sta match ;[85] yes set flg on
beq dial24 ;[85] and skip this ch
modmnp ;[85] carry on
;[80] cmp #'*+$80 ;[78] is this a delay?
cmp #'&+$80 ;[80] is this a delay?
bne dial23 ;[78] no
lda #8 ;[78] yes wait for 1 sec
sta kwrk01 ;[78] ans to 16 bit problem
;[82]dial22 lda #220 ;[78] just a we bit more than 250
dial22 lda #125 ;[82]
sta kwrk02 ;[82]
dial18 jsr telcp ;[82] for non interupt drivers
;[85] lda #17 ;[82] 1 ms at a time
lda timect ;[85] 1 ms at a time
;[82] jsr wait ;[78] wait for 255 ms, destroys x reg
jsr wait ;[82]
dec kwrk02 ;[82] are we thru
bne dial18 ;[82] no
dec kwrk01 ;[78]
bne dial22 ;[78] rest of the second
;[82] jmp dial24 ;[78] now dont tell modem
beq dial24 ;[82] now dont tell modem
modmeo ldx #0 ;[85] turn esc flg off
stx match ;[85] and process this ch
;[82]dial23 jsr telppc ;[78] send it down the line
dial23 and #$7f ;[82] make it ascii, telppc need it this way
pha ;[82] save it
jsr telppc ;[82] send it down the line
pla ;[82] restore it
;dial25 jsr modmsr ;[78]
dial24 ;jsr cout ;[78] print it
ldy chksum ;[78] get it again
iny ;[78]
bne dial20 ;[78]
inc cminf1+1 ;[78] next page
;[82]dial20 cmp #hcr ;[78] end of line?
dial20 cmp #cr ;[82] end of line?
bne dial13 ;[78] no send another
lda #0 ;[78]
;[85] ldx #4 ;[78]
ldx #lmodmc-1 ;[85]
modm19 sta modmwc,x ;[78] flag for messages
dex ;[78]
bpl modm19 ;[78]
sta ksavex ;[78] index into connect message
dial19 jsr modmsr ;[78] now whats the response
beq modm12 ;[78] no more chs
jsr cout ;[78]
jmp dial19 ;[78] around we go again
modm12 ;[78]
lda modmwc ;[78] did we see a connect
beq dialjp ;[78] no, now go to loop
;[85] jmp telne3 ;[78] so do the connect
jsr telcom ;[85] now we connect
jmp ch0lup ;[85]
dialjp jsr opentf ;[78] save current and open text file
jmp dialef ;[78] and give another chance
dialc jsr clostf ;[78] close file and restore filmod
jmp kermit ;[78]
;[85]modmsr ldy #8 ;[78] timing loop about 1 sec
modmsr ldy #3 ;[85] timing loop about 375 ms
;[85] ldx #4 ;[78] number of responses -1
ldx #lmodmc-1 ;[85] number of responses -1
lda #0 ;[78] were going to see if we got any
modm02 ora modmwc,x ;[78]
dex ;[78]
bpl modm02 ;[78] look at all 5
tax ;[78] so we can see if its non 0
bne modm4 ;[78] yes so dont wait so long ~ 1 sec
;[86] ldy #200 ;[78] about 25 sec?
ldy #240 ;[86] about 30 sec?
modm4 sty kwrk01 ;[78] 1 or 25 seconds
modm20 lda kbd ;[78] any ch gets us out
bpl modm21 ;[78]
bit kbdstr ;[78] off with the strobe
jsr telppc ;[78] wake up the modem
lda #false ;[78] thats all
rts ;[78]
modm21 jsr telcp ;[78]
bne modm23 ;[78] wait for next
;[82] lda #220 ;[78] wait 125 ms
lda #125 ;[82] wait 125 ms
;[83] sta kwrk02 ;[82]
sta kertpc ;[83]
;[85]modm22 lda #17 ;[82] 1 ms at a time
modm22 lda timect ;[85] 1 ms at a time
jsr wait ;[78]
jsr telcp ;[82] for non interupt drivers
bne modm23 ;[82] wait for next?, got one
;[83] dec kwrk02 ;[82] all 125 ms?
dec kertpc ;[83] all 125 ms?
bne modm22 ;[82] no
dec kwrk01 ;[78]
bne modm20 ;[78]
rts ;[78] false return
modm23 jsr telgpc ;[78]
ora #$80 ;[78]
ldx ksavex ;[78]
modm30 cmp modmco,x ;[78]
beq modm33 ;[78] yes we have a hit
tay ;[78] save our ch
txa ;[78] now see if were odd
ror a ;[78]
bcs modm39 ;[78] yes we best start over from the top
tya ;[78] no lets try next response
inx ;[78]
inx ;[78]
;[85] cpx #8 ;[78] have we looked at all?
;[85]b bcc modm30 ;[78] no try next entry
cpx #lmodmc*2 ;[85] have we looked at all?
blt modm30 ;[85] no try next entry
modm31 ldx #0 ;[78] ready for next ch
stx ksavex ;[78]
ldx #true ;[78] tell we have a ch
rts ;[78]
modm33 tay ;[78] save the response ch
txa ;[78] see if were odd
clc ;[78]
ror a ;[78]
bcc modm37 ;[78] no
tax ;[78] this should be
tya ;[78] index into resonse array
sta modmwc,x ;[78] response ch should be non 0
jmp modm31 ;[78] and get ready for next
modm37 inx ;[78]
stx ksavex ;[78] ready for next ch in array
tya ;[78] restore response ch
rts ;[78] and return it
modm39 ldx #0 ;[78] restart the array search
stx ksavex ;[78]
tya ;[78] restore the ch
jmp modm30 ;[78]
.SBTTL Catalog routine ;[78]
;[80]catrtn ldx catsz ;[78]
catrtn jsr prcrlf ;[80] basic sys fouls up everyother ch
ldx catsz ;[78]
lda #hcr ;[78] terminate it
sta getln,x ;[78]
catloo lda catsz,x ;[78] move command
sta getln-1,x ;[78] to get line for basic.system
dex ;[78]
bne catloo ;[78]
jsr pbasic+3 ;[78] let basic system put out catalog
;[81] jmp kermit ;[78]
jmp catext ;[81] common return so we can jsr to it
catlog lda dosflg ;[78] is this prodos?
bne catrtn ;[78] yes dont know how to do this yet
lda #fnccat ;[78] the catalog command
jsr initfm ;[78] initialize the dos file manager & do it
;[81] jmp kermit ;[78] thats all
catext jmp kermit ;[81] thats all
initpo ldy #$60 ;[84] init the parameters only
sty initf3 ;[84] a rts
bne initf1 ;[84] common code
;[84]initfm pha ;[78] save the command
initfm ldy #$ae ;[84] this will call the file manager
sty initf3 ;[84] a ldx
initf1 pha ;[84] save the command
jsr dosfmi ;[78] initialize dos 3.3
sty cminf1 ;[78] save the parameter table address in page 0
sta cminf1+1 ;[78]
ldy #0 ;[78] index into parameter table
pla ;[78] get the command
sta (cminf1),y ;[78] put it in byte 0 of parameter table
ldy #2 ;[86] new name slot
lda #getln\ ;[86]
sta (cminf1),y ;[86]
iny ;[86]
lda #getln^ ;[86]
sta (cminf1),y ;[86]
ldy #4 ;[78] ofset for vol
lda defvol ;[78] get default vol
sta (cminf1),y ;[78]
iny ;[78]
lda defdrv ;[78] get default drive
sta (cminf1),y ;[78]
iny ;[78]
lda defslt ;[78] get default slot
sta (cminf1),y ;[78]
;[84] ldy #8 ;[78] now for the file name address
iny ;[84]
lda filmod ;[84] set up file-type
sta (cminf1),y ;[84]
iny ;[84]
;[84] lda #getln+7\ ;[78] we put the file name in getln
lda #fcb1\ ;[84] we put the file name in fcb1
sta (cminf1),y ;[78]
iny ;[78]
;[84] lda #getln+7^ ;[78]
lda #fcb1^ ;[84]
sta (cminf1),y ;[78]
ldy #$c ;[78] now for a work area
lda #buffer+512\ ;[78] lets use the prodos buffer 45 bytes
sta (cminf1),y ;[78]
iny ;[78]
lda #buffer+512^ ;[78]
sta (cminf1),y ;[78]
iny ;[78] work area for track/sector list
lda #buffer\ ;[78] 256 byte part of the prodos buffer
sta (cminf1),y ;[78]
iny ;[78]
lda #buffer^ ;[78]
sta (cminf1),y ;[78]
iny ;[84] now for a work area
lda #buffer+256\ ;[84] lets use the prodos buffer 256 bytes
sta (cminf1),y ;[84]
iny ;[84]
lda #buffer+256^ ;[84]
sta (cminf1),y ;[84]
initf3 ldx doscmi ;[84] now for the type of open
jsr dosfmg ;[78] now do the command
bcc initf7 ;[84] error?
jmp nonftl ;[84] yes
initf7 ;[84]
rts ;[78]
.SBTTL Lock file routine ;[86]
lock lda #fnclck ;[86] dos cmd to lock file
ldx #locksz\ ;[86] where name is
ldy #locksz^ ;[86]
jmp cmnfle ;[86] common code
.SBTTL Unlock file routine ;[86]
unlock lda #fnculk ;[86] dos cmd to unlock file
ldx #unlksz\ ;[86] where name is
ldy #unlksz^ ;[86]
jmp cmnfle ;[86] common code
.SBTTL Rename file routine ;[86]
rename lda #fncren ;[86] dos cmd to rename file
ldx #renmsz\ ;[86] where name is
ldy #renmsz^ ;[86]
jmp cmnfle ;[86] common code
.SBTTL Delete file routine
delprd ldx delsz ;[78]
delloo lda delsz,x ;[78] move command
sta getln-1,x ;[78] to get line for basic.system
dex ;[78]
bne delloo ;[78]
jsr pbasic+3 ;[78] let basic do it
delcom bcc delrtn ;[78] its ok
ldx #erms19\ ;[78]
ldy #erms19^ ;[78]
kermtx jsr prstr ;[78]
delrtn jmp kermit ;[78] around we go again
;[86]deletf jsr kerin7 ;[78] just in case were reading kermit.init
deletf lda #fncdel ;[86] dos cmd to delete file
ldx #delsz\ ;[86] where the name is
ldy #delsz^ ;[86]
cmnfle sta cmncmd+1 ;[86] save the dos cmd
stx delprd+1 ;[86] and where the name is
sty delprd+2 ;[86]
stx delloo+1 ;[86]
sty delloo+2 ;[86]
jsr kerin7 ;[86] just in case were reading kermit.init
ldx #70 ;[78] got to
lda #hcr ;[78] terminate it with return
sta getln,x ;[78]
lda #hspace ;[78] blank out getln for dos & prodos
delet1 sta getln-1,x ;[78]
dex ;[78]
bne delet1 ;[78]
;[86] ldx #mxfnl ;[78] Longest length a filename may be
;[86] lda dosflg ;[78] prodos?
;[86] beq .+4 ;[78] no
;[86] ldx #mxppth ;[78] max path length
;[86] ldy #$00 ;[78] No special flags needed
;[86] lda #cmifi ;[78] Load opcode for parsing input files
jsr preptx ;[86]
jsr comnd ;[78] Call comnd routine
jmp kermt6 ;[78] Give the 'missing filespec' error
sta kwrk01 ;[78] Store length of file parsed
stx kerfrm ;[78] Save the from address (addr[atmbuf])
sty kerfrm+1 ;[78] ...
lda #getln+7\ ;[78] set the to address
ldx #getln+7^ ;[84]
ldy dosflg ;[84] prodos?
bne delet3 ;[84] yes
jsr clrfcb ;[84] dos needs fcb1 cleared
lda #fcb1\ ;[84] dos place for file name
ldx #fcb1^ ;[84]
delet3 ;[84]
sta kerto ;[78] ...
;[84] lda #getln+7^ ;[78] ...
;[84] sta kerto+1 ;[78] ...
stx kerto+1 ;[84]
jsr kercph ;[78] Copy the string & make it nasc
;[86] jsr prcfm ;[78] Parse and print a confirm
lda #fncren ;[86] is this rename?
cmp cmncmd+1 ;[86]
bne delet7 ;[86] no
lda dosflg ;[86] prodos?
bne delet5 ;[86] yes
ldx #getln\ ;[86] we can use this for dos
ldy #getln^ ;[86]
jmp delet6 ;[86]
delet5 ldy kwrk01 ;[86] size of previous name
lda #',+$80 ;[86] need a comma
sta (kerto),y ;[86] between names
iny ;[86]
tya ;[86] now calc getln+7+n
ldy #getln+7^ ;[86] msb
clc ;[86]
adc #getln+7\ ;[86] lsb
bcc .+3 ;[86]
iny ;[86] carry into msb
tax ;[86] lsb
delet6 stx kerto ;[86] new place to move to
sty kerto+1 ;[86]
lda #cmtxt ;[86] initialize
jsr comnd ;[86] and get name
jmp kermt6 ;[86] Give the 'missing filespec' error
sta kwrk01 ;[86] Store length of file parsed
stx kerfrm ;[86] Save the from address (addr[atmbuf])
sty kerfrm+1 ;[86] ...
jsr kercph ;[86] Copy the string & make it nasc
jsr prcfm ;[86] Parse and print a confirm
delet7 ;[86]
jsr prcrlf ;[86] basic sys fouls up everyother ch
lda dosflg ;[78] is this prodos
;[86] bne delprd ;[78] yes
beq cmncmd ;[86]
jmp delprd ;[86] yes
cmncmd ;[86]
lda #fncdel ;[78] delete command
jsr initfm ;[78] initialize the file manager & do it
;[84] jmp delcom ;[78] check for good delete
jmp kermit ;[84] thats all initfm checks for error
.SBTTL Remote routine
;
; This routine sends commands to the remore Kermit.
;
; Input: Parameters from command line
;
; Output: NONE
;
; Registers destroyed: A,X,Y
;
remote: jsr kerin7 ;[78] just in case were reading kermit.ini
lda #remcmd\ ;[81] Load the address of the keyword table
sta cminf1 ;[81] Save it for the keyword routine
lda #remcmd^ ;[81] ...
sta cminf1+1 ;[81] ...
ldy #$00 ;[81] No special flags needed
lda #cmkey ;[81] Comnd code for parse keyword
jsr comnd ;[81] Go get it
remerr jmp kermt2 ;[81] Give an error
ldy #remcmb\ ;[81] Get the L.O. byte of jump table
lda #remcmb^ ;[81] Get the H.O. byte
jmp indexj ;[81]
remcmb: ;[81] jmp remker send remote kermit
remker: lda #$80 ;[81] Reset all break characters
jsr rstbrk ;[81] ...
lda #cr ;[81] Now set break characters
jsr setbrk ;[81] ...
lda #lf ;[81] ...
jsr setbrk ;[81] ...
lda #ffd ;[81] ...
jsr setbrk ;[81] ...
lda #esc ;[81] ...
jsr setbrk ;[81] ...
ldy #$00 ;[81] ...
sty n ;[81]
sty numtry ;[81]
;[81] sty kerins ;[81] make sure we empty buffers
sty state ;[81]
sty exfg ;[81]
sty wcpres ;[84] just in case
lda #cmtxt ;[81] Parse for text
jsr comnd ;[81] Do it
jmp kermta ;[81] Found null string
sta nfcb1 ;[81] Store packet size for copy
stx remk20+1 ;[81] Point to the atom buffer from Comnd
sty remk20+2 ;[81] as the source address
jsr prcfm ;[81] Go parse and print the confirm
jsr comint ;[81] common com init
jsr scrfrm ;[81] ready the screen
remke7 lda #'I ;[81]
jsr sinio ;[81]
bne remk2r ;[81] good initialization
lda state ;[81]
cmp #'A ;[81] abort?
beq remka2 ;[81] yes
bne remke7 ;[81] try again
remk2r lda numtry ;[81] Fetch the current number of tries
inc numtry ;[81] Up it by one
cmp maxtry ;[81] See if we went up to too many
bpl remerr ;[81] yes
lda #'K ;[81] Load type remote kermit
sta ptype ;[81] Stuff that in as the packet type
lda n ;[81] Get packet number
sta pnum ;[81] Store that in its common area
ldy #0 ;[81]
sty datind ;[81] index into pdbuf
remk22 sty kwrk01 ;[81] got to preserve y
remk20 lda $ffff,y ;[81]
jsr ctrlch ;[81] controlifiy it if necessary
bcs remk23 ;[81] packet is full
ldy kwrk01 ;[81]
iny ;[81]
cpy nfcb1 ;[81]
bne remk22 ;[81]
remk23 lda datind ;[81]
sta pdlen ;[81] and Spak
jsr spak ;[81] Go send the packet
remk2: jsr rpak ;[81] Go try to receive an ack
beq remk2r ;[81] bad packet so how can we look further?
jsr dbloc ;[81] position to debug area of screen
lda ptype ;[81] Get the returned packet type
cmp #'N ;[81] Is it a NAK?
beq remkcn ;[81] yes
remk2a: cmp #'Y ;[81] Is it, perhaps, an ACK?
beq remkca ;[81] yes
cmp #'E ;[81] error pkt?
;[84] bne remk2r ;[81] try again
beq remka0 ;[84]
sta servef ;[84] must be long response
jsr rswt ;[84] hope it starts with s type
lda #0 ;[84] turn server off
sta servef ;[84]
beq remka2 ;[84] thats all
remka0 ;[84]
jsr abufmt ;[81] empty buffer to screen
;[85]remka2 jmp kermit ;[81] thats all
remka2 jsr prcrlf ;[85]
jmp kermit ;[85] thats all
remkcn: jsr dpnum ;[81] Decrement the receive packet number once
beq remka2 ;[81] a nak of n-1 is like a ack???????
bne remk2r ;[81] try again
remkca: lda n ;[81] Get the packet number
cmp pnum ;[81] Is that the one that was acked?
bne remk2r ;[81] They are not equal
;[84] beq remka2 ;[81] good ack
beq remka0 ;[84] good ack
.SBTTL Setcom routine
;
; This routine sets Kermit-65 parameters.
;
; Input: Parameters from command line
;
; Output: NONE
;
; Registers destroyed: A,X,Y
;
setcom: lda #setcmd\ ; Load the address of the keyword table
sta cminf1 ; Save it for the keyword routine
lda #setcmd^ ; ...
sta cminf1+1 ; ...
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Comnd code for parse keyword
jsr comnd ; Go get it
jmp kermt2 ; Give an error
jmp xjmp ; now do routine
;[81] lda #setcmb\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
;[82] ldy #setcmb\ ;[81] Get the L.O. byte of jump table
;[82] lda #setcmb^ ;[9] Get the H.O. byte
;[82] jmp indexj ;[57]
;[82]setcmb: jmp stesc ; Set escape character
;[68] jmp stibm ; Set ibm-mode switch
;[82]setle jmp stle ; Set local-echo switch
;[82]setrc jmp strc ; Set receive parameters
;[82]setsn jmp stsn ; Set send parameters
;[82]setvt jmp stvt ; Set vt52-emulation switch
;[82]setfw jmp stfw ; Set file-warning switch
;[72]seteb jmp steb ; Set Eight-bit quoting character
;[82]setdb jmp stdb ; Set debugging switch
;[82]setmod jmp stmod ; Set file-type mode
;[65] jmp stfbs ; Set the file-byte-size for transfer
;[82]setcsl jmp stslot ;[12] Set the I/O port index
;[82]setcpa jmp stpari ;[21] Set the parity for communication
;[82]setckb jmp stkbd ;[35] Set the keyboard type.
;[82]setcdd jmp stddsk ;[40] Set the default disk for I/O
;[82]setcds jmp stdspy ;[46] Set the display type.
;[82]setcba jmp stbaud ;[47] set the baud for super serial card
;[82]setcpr jmp stprn ;[55] Set the printer
;[82]setcfl jmp stflow ;[57] flow control xon etc
;[82]setcpf jmp stpre ;[59] set prefix for prodos
;[82]setctm jmp sttmr ;[62] set timer on/off
;[82]setcsw jmp stswp ;[73] set swap bs & del on/off
;[82]setckp jmp stkp ;[80] set keypad
;setcka jmp stkpa ;[80] set keypad application mode
;[82]setcka jmp stkpa ;[81] set keypad application mode
;[82]setckc jmp stcko ;[80] set cursor keys only in vt100 mode
stesc: ldx #$10 ; Base should be hex
ldy #$00 ;[13] No special flags needed
lda #cmnum ; Parse for integer
jsr comnd ; Go!
jmp kermt4 ; Number is bad
stx ksavex ;[13] Hold the number across the next call
sty ksavey ;[13] ...
;[78] lda #cmcfm ; Parse for confirm
;[78] jsr comnd ; Do it
;[78] jmp kermt3 ; Not confirmed
jsr prcfm ;[78] parse & confirm
lda ksavey ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
beq stesc1 ; It is, continue
jmp kermt4 ; Bad number, tell them
stesc1: lda ksavex ;[13] Get L.O. byte
cmp #$7f ; It shouldn't be bigger than this
bmi stesc2 ; If it's less, it is ok
jmp kermt4 ; Tell the user it is bad
stesc2: sta escp ; Stuff it
jmp kermit
;[68]stibm: jsr prson ;[21] Try parsing an 'on' or 'off'
;[68] jmp kermt2 ;[21] Bad keyword
;[68] stx ibmmod ;[21] Store value in the mode switch location
;[68] stx lecho ;[21] Also set local echo accordingly
;[68] ldy #nparit ;[21] Get ready to set the parity parameter
;[68] cpx #on ;[21] Setting ibm mode on?
;[68] bne stibm1 ;[21] Nope so set no parity
;[68] ldy #mparit ;[21] Set mark parity
;[68]stibm1: sty parity ;[21] Store the value
;[68] lda #cmcfm ;[21] Parse for confirm
;[68] jsr comnd ;[21] Do it
;[68] jmp kermt3 ;[21] Not confirmed, tell the user that
;[68] jmp kermit ;[21]
sttmr: jsr prson ;[64] Try parsing an 'on' or 'off'
jmp kermt2 ;[64] Bad keyword
;[80] stx ksavex ;[64] Store value in the mode switch location
stx timer ;[80] set timer on/off - forget about parse error
;[78] lda #cmcfm ;[64] Parse for confirm
;[78] jsr comnd ;[64] Do it
;[78] jmp kermt3 ;[64] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] ldx ksavex ;[64] now set timer on/off
;[80] stx timer ;[64]
;[80] jmp kermit ;[64]
jmp stflo7 ;[80] common parse, comfirm & rtn to kermit
stswp jsr prson ;[73] pars on/off
jmp kermt2 ;[73] bad keyword
;[80] stx ksavex ;[73] save it for after the confirm
stx swapf ;[80] set swap on/off - forget about parse error
;[78] lda #cmcfm ;[73]
;[78] jsr comnd ;[73] now for the confirm
;[78] jmp kermt3 ;[73] no! que passo
;[80] jsr prcfm ;[78] parse & confirm
;[80] ldx ksavex ;[73]
;[80] stx swapf ;[73] now we set it
;[80] jmp kermit ;[73] around we go again
jmp stflo7 ;[80] common parse, comfirm & rtn to kermit
stkp jsr prson ;[80] pars on/off
jmp kermt2 ;[80] bad keyword
stx kpfl ;[80] now we set it-ignore confirm error
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;stkpa jsr prson ;[80] pars on/off
; jmp kermt2 ;[80] bad keyword
; stx kpafl ;[80] now we set it-ignore confirm error
; jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stkpa jsr prson ;[81] pars on/off
jmp kermt2 ;[81] bad keyword
stx kpafl ;[81] now we set it-ignore confirm error
jmp stflo7 ;[81] common parse, confirm & rtn to kermit
stcko jsr prson ;[80] pars on/off
jmp kermt2 ;[80] bad keyword
stx ckfl ;[80] now we set it-ignore confirm error
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stle: jsr prson ; Try parsing an 'on' or 'off'
jmp kermt2 ; Bad keyword
stx lecho ; Store value in the mode switch location
;[78] lda #cmcfm ; Parse for confirm
;[78] jsr comnd ; Do it
;[78] jmp kermt3 ; Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stcs jsr prson ;[87] Try parsing an 'on' or 'off'
jmp kermt2 ;[87] Bad keyword
stx csfg ;[87] Store value in the mode switch location
jmp stflo7 ;[87] common parse, confirm & rtn to kermit
strc: lda #$00 ; Set srind for receive parms
sta srind ; ...
lda #stscmd\ ; Load the address of the keyword table
sta cminf1 ; Save it for the keyword routine
lda #stscmd^ ; ...
sta cminf1+1 ; ...
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Comnd code for parse keyword
jsr comnd ; Go get it
jmp kermt2 ; Give an error
;[81] lda #stcct\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
ldy #stcct\ ;[81] Get the L.O. byte of jump table
lda #stcct^ ;[9] Get the H.O. byte
jmp indexj ;[57]
stsn: lda #$01 ; Set srind for send parms
sta srind ; ...
lda #stscmd\ ; Load the address of the keyword table
sta cminf1 ; Save it for the keyword routine
lda #stscmd^ ; ...
sta cminf1+1 ; ...
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Comnd code for parse keyword
jsr comnd ; Go get it
jmp kermt2 ; Give an error
;[81] lda #stcct\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
ldy #stcct\ ;[81] Get the L.O. byte of jump table
lda #stcct^ ;[9] Get the H.O. byte
jmp indexj ;[57] indexed 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
jmp stsop ;[82] Set send/rec start of packet
jmp stcrlf ;[84] set cr<->cr,lf xlation
stcrlf jsr prson ;[84]
jmp kermt2 ;[84] failure
txa ;[84] on/off to acc
ldx srind ;[84] is this rec/send?
sta xcrlf,x ;[84] set it
jmp stflo7 ;[84]
stvt: ;[76]jsr prson ; Try parsing an 'on' or 'off'
lda #terkey\ ;[76]
sta cminf1 ;[76] search for type of terminal
lda #terkey^ ;[76]
sta cminf1+1 ;[76]
ldy #0 ;[76] nothing special
lda #cmkey ;[76] key word search
jsr comnd ;[76]
jmp kermt2 ; Bad keyword
cpy #4 ;[78] is this wraparround?
beq stvt1 ;[78] yes
;[76] stx vtmod ; Store value in the mode switch location
sty vtmod ;[76] Store value in the mode switch location
;[78] lda #cmcfm ; Parse for confirm
;[78] jsr comnd ; Do it
;[78] jmp kermt3 ; Not confirmed, tell the user that
jsr sutljp ;[80] setup tel term type jp
;[80] jsr prcfm ;[78] parse & confirm
;[80] jsr sutljp ;[76] setup tel term type jp
;[80] jmp kermit
jmp stflo7 '[80] parse, confirm and ignore errors
stvt1 jsr prson ;[78] parse for on/off
jmp kermt2 ;[78] malo
stx wrapar ;[78] set the wrap arround
;[78] lda #cmcfm ;[78] Parse for confirm
;[78] jsr comnd ;[78] Do it
;[78] jmp kermt3 ;[78] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit ;[78]
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stfw: jsr prson ; Try parsing an 'on' or 'off'
jmp kermt2 ; Bad keyword
stx filwar ; Store value in the mode switch location
;[78] lda #cmcfm ; Parse for confirm
;[78] jsr comnd ; Do it
;[78] jmp kermt3 ; Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;[72]steb: jsr prson ; Try parsing an 'on' or 'off'
;[72] jmp kermt2 ; Bad keyword
;[72] stx ebqmod ; Store value in the mode switch location
;[72] lda #cmcfm ; Parse for confirm
;[72] jsr comnd ; Do it
;[72] jmp kermt3 ; Not confirmed, tell the user that
;[72] jmp kermit
stdb: lda #debkey\ ;[26] Load the address of the keyword table
sta cminf1 ;[26] Save it for the keyword routine
lda #debkey^ ;[26] ...
sta cminf1+1 ;[26] ...
ldy #$00 ;[26] No special flags needed
lda #cmkey ;[26] Comnd code for parse keyword
jsr comnd ;[26] Go get it
jmp kermt2 ;[26] Give an error
stx debug ;[26] Stuff returned value into debug switch
;[78] lda #cmcfm ;[26] Parse for a confirm
;[78] jsr comnd ;[26] Do it
;[78] jmp kermt3 ;[26] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stcom: ldx #$10 ;[82] Base for ASCII value
ldy #$00 ;[82][13] No special flags needed
lda #cmnum ;[82] Code for integer number
jsr comnd ;[82] Go do it
jmp stcom4 ;[82] The number was bad
tya ;[82] If this isn't zero
beq stcom1 ;[82] It is, continue
jmp stcom4 ;[82] Bad number, tell them
stcom1: txa ;[82] Get L.O. byte
cmp #$7f ;[82] It shouldn't be bigger than this
bmi stcom2 ;[82] If it's less, it is ok
jmp stcom4 ;[82] Tell the user it is bad
stcom2: ldx srind ;[82] Fetch index for receive or send parms
rts ;[82]
stcom4 pla ;[82] keep stack straight
pla ;[82]
jmp kermt4 ;[82] now tell user
;[82]stebq: ldx #$10 ; Base for ASCII value
stebq: jsr stcom ; first the common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq steb1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]steb1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi steb2 ; If it's less, it is ok
;[82] 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
;[82]steb3: ldx srind ; Get index for receive or send parms
steb3: ;[82]
sta ebq,x ; Stuff it
;[78] lda #cmcfm ;[13] Parse for confirm
;[78] jsr comnd ;[13] Do it
;[78] jmp kermt3 ;[13] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
steb4: ldx #ermes5\ ; Get error message
ldy #ermes5^ ; ...
jsr prstr ; Print the error
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;[82]steol: ldx #$10 ; Base for ASCII value
steol: jsr stcom ;[82 common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq steo1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]steo1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi steo2 ; If it's less, it is ok
;[82] jmp kermt4 ; Tell the user it is bad
;[82]steo2: ldx srind ; Fetch index for receive or send parms
sta eol,x ; Stuff it
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stsop jsr stcom ;[82] common code
sta sop,x ;[82] set the rec/send start of packet
jmp stflo7 ;[82] thats all
;[82]stpad: ldx #$10 ; Base for ASCII value
stpad: jsr stcom ;[82] common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq stpd1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]stpd1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi stpd2 ; If it's less, it is ok
;[82] jmp kermt4 ; Tell the user it is bad
;[82]stpd2: ldx srind ; Get index (receive or send)
sta pad,x ; Stuff it
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;[82]stpdc: ldx #$10 ; Base for ASCII value
stpdc: jsr stcom ;[82] common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq stpc1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]stpc1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi stpc2 ; If it's less, it is ok
;[82] jmp kermt4 ; Tell the user it is bad
;[82]stpc2: ldx srind ; Get index for parms
sta padch,x ; Stuff it
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stpl: ldx #$10 ; Base for ASCII value
ldy #$00 ;[13] No special flags needed
lda #cmnum ; Code for integer number
jsr comnd ; Go do it
jmp kermt4 ; The number was bad
tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[81] beq stpl1 ; It is, continue
;[81] jmp kermt4 ; Bad number, tell them
;[81]stpl1: txa ;[13] Get L.O. byte
bne stpl1 ;[81]
txa ;[81]
;[75] cmp #mxpack ; It shouldn't be bigger than this
cmp #maxxdl+1 ;[75] It shouldn't be bigger than this
bcc stpl2 ; If it's less, it is ok
stpl1 ;[81]
ldx #erms1l\ ;[75] tell user
ldy #erms1l^ ;[75] what the
jsr prstr ;[75] max is
lda #maxxdl ;[75]
;[79] jsr prbyte ;[75]
;[79] jsr prcrlf ;[75]
;[87] jsr prbytl ;[79] pr byte in hex & crlf
jsr prbydr ;[87] pr byte in ascii & cr
lda #maxxdl ;[81]
;[81] jmp kermt4 ; Tell the user it is bad
stpl2: ldx srind ; Get index
sta psiz,x ; Stuff it
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;[82]stqc: ldx #$10 ; Base for ASCII value
stqc: jsr stcom ;[82] common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq stqc1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]stqc1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi stqc2 ; If it's less, it is ok
;[82] jmp kermt4 ; Tell the user it is bad
;[82]stqc2: ldx srind ; Fetch index for receive or send parms
sta quote,x ; Stuff it
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
;[82]sttim: ldx #10 ;[64] Base for ASCII value
sttim: jsr stcom ;[82] common code
;[82] ldy #$00 ;[13] No special flags needed
;[82] lda #cmnum ; Code for integer number
;[82] jsr comnd ; Go do it
;[82] jmp kermt4 ; The number was bad
;[82] tya ;[13] If this isn't zero
; cmp #$00 ; it's not an ASCII character
;[82] beq sttm1 ; It is, continue
;[82] jmp kermt4 ; Bad number, tell them
;[82]sttm1: txa ;[13] Get L.O. byte
;[82] cmp #$7f ; It shouldn't be bigger than this
;[82] bmi sttm2 ; If it's less, it is ok
;[82] jmp kermt4 ; Tell the user it is bad
;[82]sttm2: ldx srind ; Fetch index for receive or send parms
sta time,x ; Stuff it
bne sttm7 ;[64] did we change rec timeout?,no
;[87] lda #0 ;[64]
;[87] pha ;[64]
;[87] pha ;[87]
;[87] lda #cv2lp ;[64] convert sec to loops thru getc
;[87] pha ;[64]
;[87] lda #0 ;[64]
;[87] pha ;[64]
;[87] pha ;[87]
;[87] lda rtime ;[64] rec timeout in seconds
;[87] pha ;[64]
;[87] jsr mul16 ;[64] now for the multiply
;[87] pla ;[64]
;[87] sta lpcycl ;[64] answer in here
;[87] pla ;[64]
;[87] sta lpcycl+1 ;[64]
;[87] pla ;[87] msb throw away
jsr cvs2lp ;[87]
sttm7 ;[64]
;[80] jsr prcfm ; Go parse and print a confirm
;[80] jmp kermit ; Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
cvs2lp lda #0 ;[87] convert seconds to loops
pha ;[87]
pha ;[87]
lda #cv2lp ;[87] convert sec to loops thru getc
pha ;[87]
lda #0 ;[87]
pha ;[87]
pha ;[87]
lda rtime ;[87] rec timeout in seconds
pha ;[87]
jsr mul24 ;[87] now for the multiply
pla ;[87]
sta lpcycl ;[87] answer in here
pla ;[87]
sta lpcycl+1 ;[87]
pla ;[87] msb throw away
rts
stmod: lda #ftcmd\ ; Load the address of the keyword table
sta cminf1 ; Save it for the keyword routine
lda #ftcmd^ ; ...
sta cminf1+1 ; ...
lda #ftcdef\ ;[13] Load default address
sta cmdptr ;[13] ...
lda #ftcdef^ ;[13] ...
sta cmdptr+1 ;[13] ...
ldy #cmfdff ;[13] Tell Comnd there is a default
lda #cmkey ; Comnd code for parse keyword
jsr comnd ; Go get it
jmp kermt2 ; Give an error
cpx #$ff ;[78] is this other ?
bne stmod1 ;[78] no
; sty ascii ;[82] signals type of text
ldx #16 ;[78] other type base 16
ldy #0 ;[78] nothing special
lda #cmnum ;[78] parse integer
jsr comnd ;[78]
jmp kermt4 ;[78] no integer, error
; jmp stmod3 ;[82]
stmod1 ;[78]
; sty ascii ;[82] signals type of text
;stmod3 ;[82]
stx filmod ; Save the file-type mode
stx kersft ;[78] just in case were initializing
;[78] lda #cmcfm ; Parse for a confirm
;[78] jsr comnd ; Do it
;[78] jmp kermt3 ; Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[63] ldx #4 ;[59] is this binary ?
;[63] cpx filmod ;[59]
;[63] bne stmod2 ;[59] no we dont need 8 bits
;[65] ldx filmod ;[63] is this text mode?
;[65] beq stmod2 ;[63] yes dont worry about byte size
;[65] ldx fbsize ;[59] yes what is the byte size
;[65] beq stmod2 ;[59] its 8
;[65] ldx #erms1f\ ;[59] warn about 8 probably required
;[65] ldy #erms1f^ ;[59]
;[65] jsr prstr ;[59]
;[65] jsr prcrlf ;[59]
;[65]stmod2 ;[59]
;[80] jmp kermit
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stprt lda #prcmd\ ;[83] Load the address of the keyword table
sta cminf1 ;[83] Save it for the keyword routine
lda #prcmd^ ;[83] ...
sta cminf1+1 ;[83] ...
lda #prcdef\ ;[83] Load default address
sta cmdptr ;[83] ...
lda #prcdef^ ;[83] ...
sta cmdptr+1 ;[83] ...
ldy #cmfdff ;[83] Tell Comnd there is a default
lda #cmkey ;[83] Comnd code for parse keyword
jsr comnd ;[83] Go get it
jmp kermt2 ;[83] Give an error
sty prtcl ;[83] Save the protocol mode
jmp stflo7 ;[83][80] common parse, confirm & rtn to kermit
;[65]stfbs: lda #fbskey\ ; Load the address of the keyword table
;[65] sta cminf1 ; Save it for the keyword routine
;[65] lda #fbskey^ ; ...
;[65] sta cminf1+1 ; ...
;[65] ldy #$00 ;[13] No special flags needed
;[65] lda #cmkey ; Comnd code for parse keyword
;[65] jsr comnd ; Go get it
;[65] jmp kermt2 ; Give an error
;[65] stx fbsize ; Stuff the returned value into file-byte-size
;[65] lda #cmcfm ; Parse for a confirm
;[65] jsr comnd ; Do it
;[65] jmp kermt3 ; Not confirmed, tell the user that
;[65] jmp kermit
stslot: ldx #$08 ;[12] Base for ASCII value
ldy #$00 ;[13] No special flags needed
lda #cmnum ;[12] Code for integer number
jsr comnd ;[12] Go do it
jmp kermt4 ;[12] The number was bad
tya ;[13][12] If this isn't zero
; cmp #$00 ;[12] then the number is too big
beq stslt1 ;[12] It is, continue
jmp kermt4 ;[12] Bad number, tell them
stslt1: txa ;[13][12] Get L.O. byte
cmp #$08 ;[12] It shouldn't be bigger than this
bmi stslt2 ;[12] If it's less, it is ok
jmp kermt4 ;[12] Tell the user it is bad
;[81]stslt2: sta kersli ;[12] Stuff it in the slot index
;[81] asl kersli ;[12] Shift it 4 times to make it an index
;[81] asl kersli ;[12] for I/O operations
;[81] asl kersli ;[12] ...
;[81] asl kersli ;[12] ...
stslt2 asl a ;[81] its quicker this way
asl a ;[81]
asl a ;[81]
asl a ;[81]
sta kersli ;[81]
;[81] lda #0 ;[75] force com initialize
;[81] sta kerins ;[75]
;[80] jsr prcfm ;[12] Go parse and print a confirm
;[80] jmp kermit ;[12] Go back
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stpari: lda #parkey\ ;[21] Load the address of the keyword table
sta cminf1 ;[21] Save it for the keyword routine
lda #parkey^ ;[21] ...
sta cminf1+1 ;[21] ...
ldy #$00 ;[21] No special flags needed
lda #cmkey ;[21] Comnd code for parse keyword
jsr comnd ;[21] Go get it
jmp kermt2 ;[21] Give an error
stx parity ;[21] Stuff returned value into parity
;[78] lda #cmcfm ;[21] Parse for a confirm
;[78] jsr comnd ;[21] Do it
;[78] jmp kermt3 ;[21] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit ;[21]
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stkbd: lda #kbkey\ ;[35] Load the address of the keyword table
sta cminf1 ;[35] Save it for the keyword routine
lda #kbkey^ ;[35] ...
sta cminf1+1 ;[35] ...
ldy #$00 ;[35] No special flags needed
lda #cmkey ;[35] Comnd code for parse keyword
jsr comnd ;[35] Go get it
jmp kermt2 ;[35] Give an error
stx kbd1 ;[35] Save the print string index
sty kbdtyp ;[35] and the keyboard-type index.
;[78] lda #cmcfm ;[35] Parse for a confirm
;[78] jsr comnd ;[35] Do it
;[78] jmp kermt3 ;[35] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit ;[35]
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stdspy: lda #dspkey\ ;[46] Load the address of the keyword table
sta cminf1 ;[46] Save it for the keyword routine
lda #dspkey^ ;[46] ...
sta cminf1+1 ;[46] ...
ldy #$00 ;[46] No special flags needed
lda #cmkey ;[46] Comnd code for parse keyword
jsr comnd ;[46] Go get it
jmp kermt2 ;[46] Give an error
stx dsp1 ;[46] Save the print string index
sty dsptyp ;[46] and the display-type index.
;[81] lda #stdspj\ ;[49] Get the L.O. byte of jump table
ldy #stdspj\ ;[49] Get the L.O. byte of jump table
; sec ;[49] Turn carry on for subtraction
; sbc #$01 ;[49] Decrement the address once
;[81] sta jtaddr ;[49] Put the L.O. byte here until needed
lda #stdspj^ ;[49] Get the H.O. byte
jmp indexj ;[57] indexed jump
; sbc #$00 ;[49] And adjust for carry (borrow) if any
; sta jtaddr+1 ;[49] Store that
; txa ;[49] Get the offset in AC
; clc ;[49] Clear the carry
; adc jtaddr ;[49] Add the L.O. byte of address
; tax ;[49] Hold it here for now
; lda jtaddr+1 ;[49] Get the H.O. byte of address
; adc #$00 ;[49] Add in carry if there is any
; pha ;[49] Push it on the stack
; txa ;[49] Get modified L.O. byte again
; pha ;[49] Push that
; rts ;[49] Jump indexed (The Hard Way)
stdspj: jmp stdsp3 ;[49] 2p-40
jmp stdsp3 ;[49] 2e-40
ldx #$10 ;[49] 80 col slot,Base 16
ldy #$00 ;[49] No special parse features
lda #cmnum ;[49] Parse integer
jsr comnd ;[49] Do it
jmp kermt4 ;[49] No integer, give error
cpy #$00 ;[49] H.O. byte better be 0
bne stdsp2 ;[49] else, slot out of range
cpx #maxslt+1 ;[49] > maximum slot available?
bpl stdsp2 ;[49] Out of range
cpx #minslt ;[49] < minimum slot available?
bmi stdsp2 ;[49] Out of range
;[78] lda #80 ;[77] just in case card
;[78] sta wndwth ;[77] doesnt set this
txa ;[49] now so we can adjust
sta dsp2 ;[49] set 80 col card slot
;[77] lda #80 ;[76] just in case card
;[77] sta wndwth ;[76] doesnt set this
;[78] jsr setio2+2 ;[57] nice pr#n rtn
;[78] jsr test2e ;[58] just in case its //e 80 col
stdsp1 ;[49]
jsr sucout ;[78] setup cout
;[78] lda #cmcfm ;[46] Parse for a confirm
;[78] jsr comnd ;[46] Do it
;[78] jmp kermt3 ;[46] Not confirmed, tell the user that
;[80] jsr prcfm ;[78] parse & confirm
;[80] jmp kermit ;[46]
jsr sutljp ;[85] set up screen distribution
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stdsp2: jmp stddso ;[49] got to do it this way sigh! relative
stdsp3: lda #ctrlz ;[57] shut down 80 col I hope
jsr cout ;[57] wonder how universal this is
lda #'1 ;[57] does ^Z1 really stop all 80 col videos
jsr cout ;[57]
lda #hxon ;[68] this is for the //e & company
jsr cout ;[68] see what this does
jmp stdsp1 ;[57] we shall see
stprn: lda #prnkey\ ;[55] Load the address of the keyword table
sta cminf1 ;[55] Save it for the keyword routine
lda #prnkey^ ;[55] ...
sta cminf1+1 ;[55] ...
ldy #$00 ;[55] No special flags needed
lda #cmkey ;[55] Comnd code for parse keyword
jsr comnd ;[55] Go get it
jmp kermt2 ;[55] Give an error
cpx #6 ;[55] is this set slot ?
beq stprn0 ;[55] yes dont change on off flag
stx prnfg ;[55] Set the on off flag
stprn0: ;[55]
;[81] lda #stprnj\ ;[55] Get the L.O. byte of jump table
ldy #stprnj\ ;[55] Get the L.O. byte of jump table
;[81] sta jtaddr ;[55] Put the L.O. byte here until needed
lda #stprnj^ ;[55] Get the H.O. byte
;[81]indexj: sta jtaddr+1 ;[57] save the H O byte
indexj: sty jtaddr ;[81] L O byte
sta jtaddr+1 ;[81] save the H O byte
txa ;[57] now a has the offset
clc ;[57] ready for the add
adc jtaddr ;[57] add to L O byte
sta jtaddr ;[57] and save it
lda #0 ;[57] now for the carry
adc jtaddr+1 ;[57] to the H O byte
sta jtaddr+1 ;[57] now jump is ready
jmp (jtaddr) ;[57] an indexed jump
stprnj: jmp stprn4 ;[55] off
jmp stprn2 ;[55] on
ldx #$10 ;[55] slot,Base 16
ldy #$00 ;[55] No special parse features
lda #cmnum ;[55] Parse integer
jsr comnd ;[55] Do it
jmp kermt4 ;[55] No integer, give error
cpy #$00 ;[55] H.O. byte better be 0
bne stdsp2 ;[55] else, slot out of range
cpx #maxslt+1 ;[55] > maximum slot available?
bpl stdsp2 ;[55] Out of range
cpx #minslt ;[55] < minimum slot available?
bmi stdsp2 ;[55] Out of range
stx prnsl ;[55] set printer slot
;[78]stprn1: lda #cmcfm ;[55] Parse for a confirm
;[78] jsr comnd ;[55] Do it
;[78] jmp kermt3 ;[55] Not confirmed, tell the user that
;[80]stprn1 jsr prcfm ;[78] parse & confirm
;[80] jsr sutljp ;[78] set up the tel term type jump
;[80] jmp kermit ;[55]
stprn1 jsr sutljp ;[80] set up the tel term type jump
jmp stflo7 ;[80] common rtn
stprn2:
;[76] lda flowfg ;[57] flow control ?
lda confg ;[76] flow control ?
bmi stprn7 ;[57] yes should be ok
ldx #erms1c\ ;[57] warn user
ldy #erms1c^ ;[57] that it will not
;[79] jsr prstr ;[57] work
;[79] jsr prcrlf ;[57]
jsr prstrl ;[79]
stprn7:
;[59] lda prnsl ;[55] get printer slot
;[59] beq stprne ;[55] Error we need the slot
;[59]stprn3: jsr setio2+2 ;[55] Nice pr#n routine
;[59] jmp stprn1 ;[55] Now return
jsr prnoff ;[59] now turn printer on
jmp stprn1 ;[59] and finish up neatly
stprn4: ;[55]
;[59] lda #0 ;[55] nice pr#0
;[59] bit dsptyp ;[55] do we have a video slot?
;[59] bpl stprn3 ;[55] no do pr#0
;[59] lda dsp2 ;[55] get video slot
;[59] jmp stprn3 ;[55] and do pr#n
;[59]stprne: sta prnfg ;[55] first set off
;[59] jmp stddso ;[55] now tell its a nono
jsr prnon ;[59] turn printer off
jmp stprn1 ;[59] and finish up neatly
stflow: lda #flokey\ ;[57] Load the address of the keyword table
sta cminf1 ;[57] Save it for the keyword routine
lda #flokey^ ;[57] ...
sta cminf1+1 ;[57] ...
ldy #$00 ;[57] No special flags needed
lda #cmkey ;[57] Comnd code for parse keyword
jsr comnd ;[57] Go get it
jmp kermt2 ;[57] Give an error
;[81] lda #stfloj\ ;[57] Get the L.O. byte of jump table
;[81] sta jtaddr ;[57] Put the L.O. byte here until needed
ldy #stfloj\ ;[81] Get the L.O. byte of jump table
lda #stfloj^ ;[57] Get the H.O. byte
jmp indexj ;[57] an indexed jump
stfloj: jmp stflo4 ;[57] off
jmp stflo2 ;[57] xon
stflo9:
ldx #10 ;[57] delay,Base 10
ldy #$00 ;[57] No special parse features
lda #cmnum ;[57] Parse integer
jsr comnd ;[57] Do it
jmp kermt4 ;[57] No integer, give error
cpy #$00 ;[57] H.O. byte better be 0
beq stflo1 ;[57] else, delay too large
stflo8: ldx #ermes4\ ;[57] tell
ldy #ermes4^ ;[57] user its too big
;[79] jsr prstr ;[57]
;[79] jsr prcrlf ;[57]
jsr prstrl ;[79]
jmp kermit ;[57] try again
stflo1: stx flowdl ;[57] set the delay time in ms
;[78]stflo7: lda #cmcfm ;[57] parse for a comfirm
;[78] jsr comnd ;[57] do it
;[78] jmp kermt3 ;[57] not confirmed tell user
stflo7 jsr prcfm ;[78] parse & confirm
jmp kermit ;[57] next
stflo4: lda #0 ;[57] flow off
;[76]stflo3: sta flowfg ;[57]
stflo3: sta confg ;[76]
jmp stflo7 ;[57]
stflo2: lda #$80 ;[57] xon
jmp stflo3 ;[57]
sttmct ldx #10 ;[85] set timing base 10
ldy #0 ;[85] nothing special
lda #cmnum ;[85] need an integer
jsr comnd ;[85] get it
jmp kermt4 ;[85] que passo
stx timect ;[85] set default timing - forget about parse error
jmp stflo7 ;[85] common parse, confirm & rtn to kermit
stpre ;[59] set prodos prefix
lda #$80 ;[59] Reset all break characters
jsr rstbrk ;[59] ...
lda #cr ;[59] ...
jsr setbrk ;[59] ...
lda #lf ;[59] ...
jsr setbrk ;[59] ...
lda #ffd ;[59] ...
jsr setbrk ;[59] ...
lda #esc ;[59] ...
jsr setbrk ;[59] ...
lda #sp ;[59] we need a space terminator also
jsr setbrk ;[59]
ldy #$00 ;[59] ...
lda #cmtxt ;[59] Parse for text
jsr comnd ;[59] Do it
jmp kermta ;[59] Found null string
cmp #64 ;[59] Larger than the set packet size?
bmi stpre1 ;[59] No, continue
lda #64 ;[59] Yes, it will have to be truncated
stpre1 sta kwrk01 ;[59] Store packet size for Kercpy
sta prefix ;[59] start of prefix is # of chs in prefix
lda #prefix+1\ ;[59] Point to the data buffer as destination
sta kerto ;[59] ...
lda #prefix+1^ ;[59] ...
sta kerto+1 ;[59] ...
stx kerfrm ;[59] Point to the atom buffer from Comnd
sty kerfrm+1 ;[59] as the source address
jsr kercph ;[59] Copy the string with high bit set
ldy kwrk01 ;[59] now for trailing null
lda #0 ;[59]
sta (kerto),y ;[59]
jsr prodos ;[59] now see if its a good prefix
.byte setpre ;[59]
.word predel ;[59] and the par list
bcc .+5 ;[59] a good prefix
jsr perror ;[59] tattle
jmp kermit ;[59]
stcd lda dosflg ;[87] is this prodos?
bne stpre ;[87] yes
stddsk: lda #ddskey\ ;[40] Set up keyword table pointer
sta cminf1 ;[40] ...
lda #ddskey^ ;[40] ...
sta cminf1+1 ;[40] ...
ldy #$00 ;[40] No special features
lda #cmkey ;[40] We are looking for a keyword
jsr comnd ;[40] Do the call to find the keyword
jmp kermt2 ;[40] Nope, we lost
;[81] lda #stddjt\ ;[40] Fetch the address of the jump table
;[81] sta jtaddr ;[40] Stuff it in a hold area for now
ldy #stddjt\ ;[81] Fetch the address of the jump table
lda #stddjt^ ;[40] Do H.O. byte
jmp indexj ;[57] an indexed jump
stddjt: jmp stdddr ;[40] Set drive
jmp stddsl ;[60] set slot
ldx #10 ;[60] set vol base 10
ldy #0 ;[60] nothing special
lda #cmnum ;[60] need an integer
jsr comnd ;[60] get it
jmp kermt4 ;[60] que passo
;[81] sta defvol ;[80] set default vol - forget about parse error
stx defvol ;[81] set default vol - forget about parse error
;[80] stx ksavex ;[60] save while we confirm
;[78] lda #cmcfm ;[60]
;[78] jsr comnd ;[60] how about it?
;[78] jmp kermt3 ;[60] no confirm
;[80] jsr prcfm ;[78] parse & confirm
;[80] lda ksavex ;[60] finally set the vol
;[80] sta defvol ;[60]
;[80] jmp kermit ;[60] around we go
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stddsl: ldx #$10 ;[40] Base 16
ldy #$00 ;[40] No special parse features
lda #cmnum ;[40] Parse integer
jsr comnd ;[40] Do it
jmp kermt4 ;[40] No integer, give error
cpy #$00 ;[40] H.O. byte better be 0
bne stddso ;[40] else, slot out of range
cpx #maxslt+1 ;[40] > maximum slot available?
bpl stddso ;[40] Out of range
cpx #minslt ;[40] < minimum slot available?
bmi stddso ;[40] Out of range
;[80] stx ksavex ;[40] Save while we parse the confirm
;[81] sta defslt ;[80] set default slot - forget about parse error
stx defslt ;[81] set default slot - forget about parse error
;[78] lda #cmcfm ;[40] Set up token for confirm
;[78] jsr comnd ;[40] Parse it
;[78] jmp kermt3 ;[40] Lost, no confirm
;[80] jsr prcfm ;[78] parse & confirm
;[80] lda ksavex ;[40] Fetch the saved value
;[80] sta defslt ;[40] Place it where it belongs
;[80] jmp kermit ;[40] Jump to top again
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stdddr: ldx #$10 ;[40] Base 16
ldy #$00 ;[40] No special features about parse
lda #cmnum ;[40] Parse an integer
jsr comnd ;[40] Do it
jmp kermt4 ;[40] Didn't find an integer
cpy #$00 ;[40] H.O. byte should be zero
bne stdddo ;[40] Otherwise we are way out of range
cpx #maxdrv+1 ;[40] > maximum drive number available?
bpl stdddo ;[40] Yup, out of range
cpx #mindrv ;[40] < minimum drive number available?
bmi stdddo ;[40] Out of range
;[80] stx ksavex ;[40] Save while we parse confirm
;[81] sta defdrv ;[80] set default drive - forget about parse error
stx defdrv ;[81] set default drive - forget about parse error
;[78] lda #cmcfm ;[40] Set up to parse confirm
;[78] jsr comnd ;[40] Do it
;[78] jmp kermt3 ;[40] Wasn't properly confirmed
;[80] jsr prcfm ;[78] parse & confirm
;[80] lda ksavex ;[40] Fetch back the data
;[80] sta defdrv ;[40] Stuff it where it belongs
;[80] jmp kermit ;[40] Jump to top again
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
stdddo: ldx #ermesf\ ;[40] Fetch the address of the error
ldy #ermesf^ ;[40] ...
;[79] jsr prstr ;[40] Print the text
;[79] jsr prcrlf ;[40] Follow with a crelf
jsr prstrl ;[79]
jmp kermit ;[40] Return to top
stddso: ldx #ermese\ ;[40] Tell user about the range error
ldy #ermese^ ;[40] ...
;[79] jsr prstr ;[40] Print the error text
;[79] jsr prcrlf ;[40] Print a crelf
jsr prstrl ;[79]
jmp kermit ;[40] Go to top
stbaud: lda #baukey\ ;[47] Set the baud for ssc
sta cminf1 ;[47] ready keyword routine
lda #baukey^ ;[47]
sta cminf1+1 ;[47]
ldy #0 ;[47]
lda #cmkey ;[47] tell its keyword search
jsr comnd ;[47] and do it
jmp kermt2 ;[47] its an error
sty sscdbd ;[47] save baud index
;[78] lda #cmcfm ;[47] now for the confirm
;[78] jsr comnd ;[47]
;[78] jmp kermt3 ;[47]
;[80] jsr prcfm ;[78] parse & confirm
lda #$b ;[54] baud command
jsr tl0cmd ;[54] tell com card about it
;[80] jmp kermit ;[47] arround we go again
jmp stflo7 ;[80] common parse, confirm & rtn to kermit
.SBTTL Show routine
;
; This routine shows any of the operational parameters that
; can be altered with the set command.
;
; Input: Parameters from command line
;
; Output: Display parameter values on screen
;
; Registers destroyed: A,X,Y
;
show: lda #shocmd\ ; Load address of keyword table
sta cminf1 ; Save it for the keyword routine
lda #shocmd^ ; ...
sta cminf1+1 ; ...
lda #shodef\ ;[13] Fetch default address
sta cmdptr ;[13] ...
lda #shodef^ ;[13] ...
sta cmdptr+1 ;[13] ...
ldy #cmfdff ;[13] Indicate that there is a default
lda #cmkey ; Comnd code to parse keyword
jsr comnd ; Go parse the keyword
jmp kermt2 ; Bad keyword, go give an error
cpx #shrc\ ;[82] exception
bne show3 ;[82] for confirm? no
cpy #shrc^ ;[82] maybe
beq xjsr ;[82] yes
show3 cpx #shsn\ ;[82] how about this one
bne show7 ;[82] no
cpy #shsn^ ;[82] maybe
beq xjsr ;[82] yes
show7 stx xjsr1+1 ;[82] needed later
sty xjsr1+2 ;[82]
jsr prcfm ;[82] parse for confirm
jmp xjsr1 ;[82]
xjsr stx xjsr1+1 ;[82] now set up the
sty xjsr1+2 ;[82] for the jsr
xjsr1 jsr xjsr1 ;[82]
jmp kermit ;[82]
;[81] lda #shocmb\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
;[82] ldy #shocmb\ ;[81] Get the L.O. byte of jump table
;[82] lda #shocmb^ ;[9] Get the H.O. byte
;[82] jmp indexj ;[57] an indexed jump
;[82]shocmb: jsr prcfm ; Parse for confirm
;[82] jsr shall ; Show all setable parameters
;[82] jmp kermit ; Go to top of main loop
;[82]shoesc jsr prcfm ; Parse for confirm
;[82] jsr shesc ; Show escape character
;[82] jmp kermit ; Go to top of main loop
;[68] jsr prcfm ; Parse for confirm
;[68] jsr shibm ; Show ibm-mode switch
;[68] jmp kermit ; Go to top of main loop
;[82]shole jsr prcfm ; Parse for confirm
;[82] jsr shle ; Show local-echo switch
;[82] jmp kermit ; Go to top of main loop
;[82]shorc nop ; We should not parse for confirm
;[82] nop ; since this routine parses for
;[82] nop ; a keyword next
;[82] jsr shrc ; Show receive parameters
;[82] jmp kermit ; Go to top of main loop
;[82]shosn nop ; We should not parse for confirm
;[82] nop ; since this routine parses for
;[82] nop ; a keyword next
;[82] jsr shsn ; Show send parameters
;[82] jmp kermit ; Go to top of main loop
;[82]shovt jsr prcfm ; Parse for confirm
;[82] jsr shvt ; Show vt52-emulation mode switch
;[82] jmp kermit ; Go to top of main loop
;[82]shofw jsr prcfm ; Parse for confirm
;[82] jsr shfw ; Show file-warning switch
;[82] jmp kermit ; Go to top of main loop
;[72]shoeb jsr prcfm ; Parse for confirm
;[72] jsr sheb ; Show eight-bit-quoting switch
;[72] jmp kermit ; Go to top of main loop
;[82]shodb jsr prcfm ; Parse for confirm
;[82] jsr shdb ; Show debugging mode switch
;[82] jmp kermit ; Go to top of main loop
;[82]shomod jsr prcfm ; Parse for confirm
;[82] jsr shmod ; Show File mode
;[82] jmp kermit ; Go to top of main loop
;[65] jsr prcfm ; Parse for confirm
;[65] jsr shfbs ; Show the file-byte-size
;[65] jmp kermit ; Go to top of main loop
;[82]shocot jsr prcfm ;[12] Parse for confirm
;[82] jsr shslot ;[12] Show the I/O index
;[82] jmp kermit ;[12] Go to top of main loop
;[82]shocdr jsr prcfm ;[12] Parse for confirm
;[82] jsr shddr ;[12] Show Device-driver
;[82] jmp kermit ;[12] Go to top of main loop
;[82]shocri jsr prcfm ;[21] Parse for confirm
;[82] jsr shpari ;[21] Show parity
;[82] jmp kermit ;[21] Go to top of main loop
;[82]shocbd jsr prcfm ;[35] Parse for confirm.
;[82] jsr shkbd ;[35] Show keyboard type.
;[82] jmp kermit ;[35] Go to top of main loop.
;[82]shocsk jsr prcfm ;[40] Parse for confirm.
;[82] jsr shddsk ;[40] Show default disk.
;[82] jmp kermit ;[40] Go to top of main loop.
;[82]shocpy jsr prcfm ;[46] Parse for confirm.
;[82] jsr shdspy ;[46] show the display type
;[82] jmp kermit ;[46] and return
;[82]shocud jsr prcfm ;[47] parse for confirm
;[82] jsr shbaud ;[47] show baud rate
;[82] jmp kermit ;[47] around the loop again
;[82]shocrn jsr prcfm ;[55] parse for confirm
;[82] jsr shprn ;[55] show printer
;[82] jmp kermit ;[55] around the loop again
;[82]shocow jsr prcfm ;[57] parse for confirm
;[82] jsr shflow ;[57] show flow control
;[82] jmp kermit ;[57] around the loop again
;[82]shocog jsr prcfm ;[56] parse for confirm
;[82] jsr shlog ;[56] show log
;[82] jmp kermit ;[56] around the loop again
;[82]shocmr jsr prcfm ;[64] parse for confirm
;[82] jsr shtmr ;[64] show timer
;[82] jmp kermit ;[64] around the loop again
;[82]shoswp jsr prcfm ;[73] confirm parse
;[82] jsr shswp ;[73] swap bs & del keypress
;[82] jmp kermit ;[73]
;[82]shokp jsr prcfm ;[80] confirm parse
;[82] jsr shkp ;[80] keypad
;[82] jmp kermit ;[80]
;shokpa jsr prcfm ;[80] confirm parse
; jsr shkpa ;[80] keypad application mode
; jmp kermit ;[80]
;[82]shokco jsr prcfm ;[80] confirm parse
;[82] jsr shcko ;[80] cursor keys only in vt100 mode
;[82] jmp kermit ;[80]
;[83]shall jsr shdb ; Show debugging mode switch
shall: ;[83]
ldx #versio\ ;[83] tell what version kermit
ldy #versio^ ;[83] is also
jsr prstrl ;[83] prints string & cr
jsr shdb ;[83] Show debugging mode switch
jsr shvt ; Show vt52-emulation mode switch
;[68] jsr shibm ;[21] Show ibm-mode switch
jsr shle ; Show local-echo switch
jsr shpari ;[21] Show parity setting
;[72] 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
;[65] jsr shfbs ; Show the file-byte-size
jsr shslot ;[12] Show the I/O index
jsr shddr ;[12] Show the device-driver begin used
jsr shkbd ;[35] Show keyboard type.
jsr shdspy ;[46] Show display type.
jsr shddsk ;[40] Show default disk.
jsr shbaud ;[47] yes,show baud rate
jsr shprn ;[55] show printer info
jsr shlog ;[56] show log
jsr shflow ;[57] show flow control
jsr shtmr ;[64] show timer
jsr shswp ;[73] show swap bs & del keypress
jsr shkp ;[80] show keypad
; jsr shkpa ;[80] show keypad application mode
jsr shcko ;[80] show cursor keys only
jsr shprt ;[83] show protocol
jsr shcs ;[87] show clear screen flag
;[86] jsr shtmct ;[85] show timing constant
jmp shtmct ;[86] show timing constant
;[86] jsr shrcal ; Show receive parameters
;[80] jsr shsnal ; Show send parameters
;[86] jmp shsnal ;[80] Show send parameters
;[80] rts ; Return
shdb: ldx #shin00\ ;[26] Get address of 'debug mode' string
ldy #shin00^ ;[26] ...
lda shin00 ;[87]
;[87] jsr prstr ;[26] Print that
jsr prncfm ;[87] Print that
lda debug ;[26] Get the debug mode
cmp #$03 ;[26] Is it >= 3?
bmi shdb1 ;[26] If not just get the string and print it
lda #$00 ;[26] This is index for debug mode we want
shdb1: tax ;[26] Hold this index
lda #kerdms\ ;[26] Get the address of the device strings
sta kermbs ;[26] And stuff it here for genmad
lda #kerdms^ ;[26] ...
sta kermbs+1 ;[26] ...
lda #kerdsz ;[26] Get the string length
pha ;[26] Push that
txa ;[26] Fetch the index back
pha ;[26] Push that parm then
jsr genmad ;[26] call genmad
;[79] jsr prstr ;[26] Print the the string at that address
;[79] jsr prcrlf ;[26] Print a crelf after it
jmp prstrl ;[79] let it do the rts
;[79] rts
shlog: ldx #shin28\ ;[56] tell about log
ldy #shin28^ ;[56]
lda shin28 ;[87]
;[87] jsr prstr ;[56] first say log
jsr prncfm ;[87] first say log
lda logfg ;[56] is log on ?
bmi shlog1 ;[56] yes
jmp pron ;[56] let routine print off
shlog1: ldx #shon\ ;[56] say on
ldy #shon^ ;[56] with a trailing space
jsr prstr ;[56]
ldx #shin29\ ;[56] now for file=
ldy #shin29^ ;[56]
jsr prstr ;[56]
;[66] ldy nfcb1 ;[59] # chs in name
;[66] lda fcb1,y ;[59] null terminate string
;[66] pha ;[59] save current member
;[66] lda #0 ;[59]
;[66] sta fcb1,y ;[59]
lda nfcb1 ;[66] get length of string
ldx #fcb1\ ;[56] now the file name
ldy #fcb1^ ;[56]
;[66] jsr prstr ;[56]
jsr prstrn ;[66]
jmp prcrlf ;[56] let this routine do the rts
;[66] jsr prcrlf ;[59]
;[66] ldy nfcb1 ;[59] restore current member
;[66] pla ;[59]
;[66] sta fcb1,y ;[59]
;[66] rts ;[59]
shvt: ldx #shin01\ ; Get address of message for this item
ldy #shin01^ ; ...
lda shin01 ;[87]
;[87] jsr prstr ; Print that message
jsr prncfm ;[87] Print that message
;[76] lda vtmod ; Get the switch value
lda #terstr\ ;[76] Get the address of the display strings
sta kermbs ;[76] And stuff it here for genmad
lda #terstr^ ;[76] ...
sta kermbs+1 ;[76] ...
lda #terlen ;[76] Get the string length
pha ;[76] Push that
lda vtmod ;[76] Get the switch value
pha ;[76] Push that parm then
jsr genmad ;[76] call genmad
jsr prstr ;[76] Print the the string at that address
ldx #shin2d\ ;[78] Get address of message for this item
ldy #shin2d^ ;[78] ...
jsr prstr ;[78] Print that message
lda wrapar ;[78]
jmp pron ;[78] print wraparound
;[78] jsr prcrlf ;[76] Print a crelf after it
;[78] rts ;[76]
;[76] jmp pron ; Go print the 'on' or 'off' string
;shibm: ldx #shin02\ ; Get address of message for this item
; ldy #shin02^ ; ...
; jsr prstr ; Print that message
; lda ibmmod ; Get the switch value
; jmp pron ; Go print the 'on' or 'off' string
shtmr: ldx #shin2b\ ;[64] Get address of message for this item
ldy #shin2b^ ;[64] ...
lda shin2b ;[87]
;[87] jsr prstr ;[64] Print that message
jsr prncfm ;[87] Print that message
lda timer ;[64] Get the switch value
jmp pron ;[64] Go print the 'on' or 'off' string
shswp ldx #shin2c\ ;[73] message about
ldy #shin2c^ ;[73] swaping bs & del keypress
lda shin2c ;[87]
;[87] jsr prstr ;[73]
jsr prncfm ;[87]
lda swapf ;[73] now for the on/off
jmp pron ;[73] print it and let it return
;[87]shkp ldx #shin2e\ ;[80] message about
;[87] ldy #shin2e^ ;[80] keypad vt100
;[87] jsr prstr ;[80]
;[87] lda kpfl ;[80] now for the on/off
;[81] jmp pron ;[80] print it and let it return
;[87] jsr pronnr ;[81] print it
shkp ;[87]
ldx #shin2f\ ;[81] message about
ldy #shin2f^ ;[81] keypad application mode vt100
lda shin2f ;[87]
;[87] jsr prstr ;[81]
jsr prncfm ;[87]
lda kpafl ;[81] now for the on/off
jmp pron ;[81] print it and let it return
;shkpa ldx #shin2f\ ;[80] message about
; ldy #shin2f^ ;[80] keypad application mode vt100
; jsr prstr ;[80]
; lda kpafl ;[80] now for the on/off
; jmp pron ;[80] print it and let it return
shcko ldx #shin2g\ ;[80] message about
ldy #shin2g^ ;[80] cursor keys only in vt100 mode
lda shin2g ;[87]
;[87] jsr prstr ;[80]
jsr prncfm ;[87]
lda ckfl ;[80] now for the on/off
jmp pron ;[80] print it and let it return
shle: ldx #shin03\ ; Get address of message for this item
ldy #shin03^ ; ...
lda shin03
;[87] jsr prstr ; Print that message
jsr prncfm ;[87] Print that message
lda lecho ; Get the switch value
jmp pron ; Go print the 'on' or 'off' string
shcs lda setcs ;[87] first the count
ldx #setcs\ ;[87] Get address of message for this item
ldy #setcs^ ;[87]
jsr prncfm ;[87] Print that message
lda csfg ;[87] Get the switch value
jmp pron ;[87] Go print the 'on' or 'off' string
;[72]sheb: ldx #shin04\ ; Get address of message for this item
;[72] ldy #shin04^ ; ...
;[72] jsr prstr ; Print that message
;[72] lda ebqmod ; Get the switch value
;[72] jmp pron ; Go print the 'on' or 'off' string
shfw: ldx #shin05\ ; Get address of message for this item
ldy #shin05^ ; ...
lda shin05 ;[87] ...
;[87] jsr prstr ; Print that message
jsr prncfm ;[87] 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^ ; ...
lda shin06 ;[87] ...
;[87] jsr prstr ; Print message
jsr prncfm ;[87] Print message
lda escp ; Get the escape character
;[79] jsr prchr ; Print the special character
;[79] jsr prcrlf ; Print a crelf
jmp prchrr ;[79] cntl chs, crlf & let it rts
;[79] rts ; and return
shsn: lda #$01 ; Set up index to be used later
sta srind ; ...
lda #stscmd\ ; Get the set option table address
sta cminf1 ; and save it as a parm to cmkey
lda #stscmd^ ; ...
sta cminf1+1 ; ...
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Code for keyword parse
jsr comnd ; Try to parse it
jmp kermt2 ; Invalid keyword
stx kwrk01 ; Hold offset into jump table
jsr prcfm ; Parse and print a confirm
;[82] lda kwrk01 ; Get the value back
ldx kwrk01 ;[82] Get the value back
;[82] clc ; Clear the carry flag
;[82] adc kwrk01 ; Now double the value to provide the
; neccesary index
;[82] tax ;[57] save the offset in x
;[81] lda #shcmb\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
ldy #shcmb\ ;[81] Get the L.O. byte of jump table
lda #shcmb^ ;[9] Get the H.O. byte
jmp indexj ;[57] an indexed jump
shrc: lda #$00 ; Set up index to be used later
sta srind ; ...
lda #stscmd\ ; Get the set option table address
sta cminf1 ; and save it as a parm to cmkey
lda #stscmd^ ; ...
sta cminf1+1 ; ...
ldy #$00 ;[13] No special flags needed
lda #cmkey ; Code for keyword parse
jsr comnd ; Try to parse it
jmp kermt2 ; Invalid keyword
stx kwrk01 ; Hold offset into jump table
jsr prcfm ; Parse and print a confirm
;[82] lda kwrk01 ; Get the value back
ldx kwrk01 ;[82] Get the value back
;[82] clc ; Clear the carry flag
;[82] adc kwrk01 ; Now double the value to provide the
;[82] tax ;[57] neccesary index
;[81] lda #shcmb\ ;[9] Get the L.O. byte of jump table
;[81] sta jtaddr ;[9] Put the L.O. byte here until needed
ldy #shcmb\ ;[81] Get the L.O. byte of jump table
lda #shcmb^ ;[9] Get the H.O. byte
jmp indexj ;[57] indexed jump
;[82]shcmb: jsr shpdc ; Show send/rec padding character
shcmb: jmp shpdc ;[82] Show send/rec padding character
;[82] jmp kermit ; Go back
;[82] jsr shpad ; Show amount of padding for send/rec
jmp shpad ;[82] Show amount of padding for send/rec
;[82] jmp kermit ; Go back
;[82] jsr shebq ; Show send/rec eight-bit-quoting character
jmp shebq ;[82] Show send/rec eight-bit-quoting character
;[82] jmp kermit ; Go back
;[82] jsr sheol ; Show send/rec end-of-line character
jmp sheol ;[82] Show send/rec end-of-line character
;[82] jmp kermit ; Go back
;[82] jsr shpl ; Show send/rec packet length
jmp shpl ; [82]Show send/rec packet length
;[82] jmp kermit ; Go back
;[82] jsr shqc ; Show send/rec quote character
jmp shqc ; [82]Show send/rec quote character
;[82] jmp kermit ; Go back
;[82] jsr shtim ; Show send/rec timeout
jmp shtim ;[82] Show send/rec timeout
;[82] jmp kermit ; Go back
jmp shsop ;[82] Show send/rec start of packet
;[82] jmp kermit ;[82] Go back
shcrlf ldx #shin2j\ ;[84] must follow above ************
ldy #shin2j^ ;[84]
jsr prstr ;[84] tell option
ldx srind ;[84] is this rec/send?
lda xcrlf,x ;[84] on/off
jmp pron ;[84] print the on/off
shsop: ldx #shin2h\ ;[82] Get address of 'sop char' string
ldy #shin2h^ ;[82] ...
lda shin2h ;[87]
;[87] jsr prstr ;[82] Print that
jsr prncfm ;[87] Print that
ldx srind ;[82] Load index so we print correct parm
lda sop,x ;[82] If index is 1, this gets spadch
jmp prchrr ;[82] cntl chs, crlf & let it rts
shpdc: ldx #shin11\ ; Get address of 'pad char' string
ldy #shin11^ ; ...
lda shin11 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda padch,x ; If index is 1, this gets spadch
;[79] jsr prchr ; Print the special character
;[79] jsr prcrlf ; Print a crelf after it
jmp prchrr ;[79] cntl chs, crlf & let it rts
;[79] rts
shpad: ldx #shin12\ ; Get address of 'padding amount' string
ldy #shin12^ ; ...
lda shin12 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda pad,x ; If index is 1, this gets spad
;[79] jsr prbyte ; Print the amount of padding
;[79] jsr prcrlf ; Print a crelf after it
jmp prbytl ;[79] pr byte in hex, crlf & let it rts
; jmp prbydr ;[87] pr byte in ascii & cr
;[79] rts
shebq: ldx #shin08\ ; Get address of 'eight-bit-quote' string
ldy #shin08^ ; ...
lda shin08 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda ebq,x ; If index is 1, this gets sebq
;[79] jsr prchr ; Print the special character
;[79] jsr prcrlf ; Print a crelf after it
jmp prchrr ;[79] cntl chs, crlf & let it rts
;[79] rts
sheol: ldx #shin09\ ; Get address of 'end-of-line' string
ldy #shin09^ ; ...
lda shin09 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda eol,x ; If index is 1, this gets seol
;[79] jsr prchr ; Print the special character
;[79] jsr prcrlf ; Print a crelf after it
jmp prchrr ;[79] cntl c,s, crlf & let it rts
;[79] rts
shpl: ldx #shin10\ ; Get address of 'packet length' string
ldy #shin10^ ; ...
lda shin10 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda psiz,x ; If index is 1, this gets spsiz
;[79] jsr prbyte ; Print the packet length
;[79] jsr prcrlf ; Print a crelf after it
jmp prbytl ;[79] pr byte in hex, crlf & let it rts
; jmp prbydr ;[87] pr byte in ascii & cr
;[79] rts ; and return
shqc: ldx #shin13\ ; Get address of 'quote-char' string
ldy #shin13^ ; ...
lda shin13 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda quote,x ; If index is 1, this gets squote
;[79] jsr prchr ; Print the special character
;[79] jsr prcrlf ; Print a crelf after it
jmp prchrr ;[79] cntl chs, crlf & let it rts
;[79] rts
shtim: ldx #shin14\ ; Get address of 'timeout' string
ldy #shin14^ ; ...
lda shin14 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
ldx srind ; Load index so we print correct parm
lda time,x ; If index is 1, this gets stime
;[79] jsr prbyte ; Print the hex value
;[79] jsr prcrlf ; Print a crelf after it
jmp prbytl ;[79] pr byte in hex, crlf & let it rts
; jmp prbydr ;[87] pr byte in ascii & cr
;[79] rts
;[87]shsnal: lda #$01 ; Set up index for show parms
;[87] sta srind ; and stuff it here
;[87] ldx #shin07\ ; Get address of 'send' string
;[87] ldy #shin07^ ; ...
;[79] jsr prstr ; Print it
;[79] jsr prcrlf ; Print a crelf
;[87]shsna3 ;[82]
;[87] jsr prstrl ;[79]
;[87] jsr shpdc ; Show the padding character
;[87] jsr shpad ; Show amount of padding
;[87] jsr shebq ; Show eight-bit-quote character
;[87] jsr shsop ;[82] show start of packet character
;[87] jsr sheol ; Show end-of-line character
;[87] jsr shpl ; Show packet-length
;[87] jsr shqc ; Show quote character
;[79] jsr shtim ; Show timeout length
;[84] jmp shtim ;[79] Show timeout length & let it rts
;[87] jsr shtim ;[84] Show timeout length
;[87] jmp shcrlf ;[84] show cr<->cr,lf xlation
;[79] rts
;[87]shrcal: lda #$00 ; Set up index for show parms
;[87] sta srind ; and stuff it here
;[87] ldx #shin15\ ; Get address of 'receive' string
;[87] ldy #shin15^ ; ...
;[79] jsr prstr ; Print it
;[79] jsr prcrlf ; Print a crelf
;[87] jmp shsna3 ;[82] common code
;[82] jsr prstrl ;[79]
;[82] jsr shpdc ; Show the padding character
;[82] jsr shpad ; Show amount of padding
;[82] jsr shebq ; Show eight-bit-quote character
;[82] jsr shsop ;[82] show start of packet character
;[82] jsr sheol ; Show end-of-line character
;[82] jsr shpl ; Show packet-length
;[82] jsr shqc ; Show quote character
;[79] jsr shtim ; Show timeout length
;[82] jmp shtim ;[79] Show timeout length & let it rts
;[79] rts
shmod: ldx #shin16\ ; Get address of 'file-type' string
ldy #shin16^ ; ...
lda shin16 ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
lda filmod ; Get the file-type mode
; bne shmod3 ;[82] is this text, no
; ldx ascii ;[82] is this 7bit text?
; beq shmod3 ;[82] no
; lda #5 ;[82] this is index to ascii string
; bne shmod1 ;[82]
;shmod3 ;[82]
;[78] cmp #$04 ; Is it >= 4?
;[78] bmi shmod1 ; If not just get the string and print it
cmp #5 ;[78] is this type other?
bcc shmod1 ;[78] no, other gets a 3
lda #$03 ; This is the index to the file-type we want
shmod1: tax ; Hold this index
lda #kerftp\ ; Get the address if the file type strings
sta kermbs ; And stuff it here for genmad
lda #kerftp^ ; ...
sta kermbs+1 ; ...
lda #kerfts ; Get the string length
pha ; Push that
txa ; Fetch the index back
pha ; Push that parm then
jsr genmad ; call genmad
jsr prstr ; Print the the string at that address
lda filmod ;[78] is this type other?
cmp #5 ;[78]
bcc shmod4 ;[78] no
jsr prbyte ;[78] yes print the byte in hex
shmod4 ;[78]
;[79] jsr prcrlf ; Print a crelf after it
jmp prcrlf ; Print a crelf after it, let it rts
;[79] rts
shprt: ldx #shin2i\ ; Get address of 'file-type' string
ldy #shin2i^ ; ...
lda shin2i ;[87] ...
;[87] jsr prstr ; Print that
jsr prncfm ;[87] Print that
lda #prcdef\ ; Get the address if the file type strings
sta kermbs ; And stuff it here for genmad
lda #prcdef^ ; ...
sta kermbs+1 ; ...
lda #prclen ; Get the string length
pha ; Push that
lda prtcl ; Get the protocol mode
pha ; Push that parm then
jsr genmad ; call genmad
jsr prstr ; Print the the string at that address
jmp prcrlf ; Print a crelf after it, let it rts
;[65]shfbs: ldx #shin17\ ; Get address of 'file-byte-size' string
;[65] ldy #shin17^ ; ...
;[65] jsr prstr ; Print that
;[65] lda fbsize ; Get the file-type mode
;[65] beq shfbse ; It is in eight-bit mode
;[65] ldx #shsbit\ ; Get address of 'SEVEN-BIT' string
;[65] ldy #shsbit^ ; ...
;[65] jsr prstr ; Print that
;[65] jsr prcrlf ; then a crelf
;[65] rts ; and return
;[65]shfbse: ldx #shebit\ ; Get the address of 'EIGHT-BIT' string
;[65] ldy #shebit^ ; ...
;[65] jsr prstr ; Print the the string at that address
;[65] jsr prcrlf ; Print a crelf after it
;[65] rts
shtmct: ldx #shin2k\ ;[85] Get address of time constant string
ldy #shin2k^ ;[85] ...
lda shin2k ;[87][85] ...
;[87] jsr prstr ;[85] Print that
jsr prncfm ;[87][85] Print that
lda timect ;[85] now for the current constant
jmp prbytl ;[85] pr byte in hex, crlf & let it rts
; jmp prbydr ;[87] pr byte in ascii & cr
shvole rts ;[87]
shvols lda dosflg ;[87] is this prodos
beq shvole ;[87] no only for prodos
jsr prodos ;[87]
.byte online ;[87]
.word pvols ;[87] get all the online vols
bcc .+5 ;[87] ok
jmp perror ;[87] malo, let it rts
ldx #0 ;[87] and away we go
shvol1 lda #' ;[87] blank out vol name
ldy #15 ;[87]
shvol2 sta shin2m+6,y ;[87]
dey ;[87]
bne shvol2 ;[87]
lda volbuf,x ;[87] better only be 256 max
beq shvole ;[87]
and #$0f ;[87] get the len of name
beq shvol6 ;[87] some kind of error
sta ksavey ;[87] the counter
lda volbuf,x ;[87]
clc ;[87]
and #$80 ;[87] now for the drive
rol a ;[87] into carry
rol a ;[87] right justified
adc #'1 ;[87] ascii it
sta shin2l+13 ;[87] into msg
lda volbuf,x ;[87]
and #$70 ;[87] slot
clc ;[87]
ror a ;[87]
ror a ;[87]
ror a ;[87]
ror a ;[87]
adc #'0 ;[87] ascii it
sta shin2l+5 ;[87]
stx ksavex ;[87] need this agn
ldy #0 ;[87]
shvol3 inx ;[87]
lda volbuf,x ;[87] ch of vol name
sta shin2m+7,y ;[87]
iny ;[87]
dec ksavey ;[87] thru?
bne shvol3 ;[87] no
ldx #shin2l\ ;[87] now print it
ldy #shin2l^ ;[87]
jsr prstrl ;[87] and crlf
ldx ksavex ;[87]
shvol6 txa ;[87]
clc ;[87]
adc #16 ;[87] nextvol name
tax ;[87]
jmp shvol1 ;[87] around we go
shslot: ldx #shin18\ ;[12] Get address of 'slot' string
ldy #shin18^ ;[12] ...
lda shin18 ;[87][12] ...
;[87] jsr prstr ;[12] Print that
jsr prncfm ;[87][12] Print that
lda kersli ;[12] If index is 1, this gets spsiz
;[82] sta kwrk01 ;[12] Hold it here so we can shift it
;[82] lsr kwrk01 ;[12] Shift it 4 times
;[82] lsr kwrk01 ;[12] to make it a slot number
;[82] lsr kwrk01 ;[12] ...
;[82] lsr kwrk01 ;[12] ...
;[82] lda kwrk01 ;[12] Fetch it back
lsr a ;[82] quicker and shorter
lsr a ;[82] quicker and shorter
lsr a ;[82] quicker and shorter
lsr a ;[82] quicker and shorter
;[79] jsr prbyte ;[12] Print the current slot number
;[79] jsr prcrlf ;[12] Print a crelf after it
jmp prbytl ;[79] pr byte in hex, crlf & let it rts
; jmp prbydr ;[87] pr byte in ascii, crlf & let it rts
;[79] rts ;[12] and return
shddr: ldx #shin19\ ;[12] Get address of 'device-driver' string
ldy #shin19^ ;[12] ...
lda shin19 ;[87]
;[87] jsr prstr ;[12] Print that
jsr prncfm ;[87] Print that
;[83] lda ddrnm ;[54] tell what
;[83] sta shddr1+1 ;[54] com card
;[83] lda ddrnm+1 ;[54] we are
;[83] sta shddr1+2 ;[54] a nice indirect would be slick
;[83] ldy #0 ;[54]
;[83]shddr1: lda shddr1,y ;[54] get ch
;[83] beq shddr2 ;[54] null terminator?
;[83] jsr prchr ;[54] no print the ch - rtn uses x
;[83] iny ;[54]
;[83] cpy #27 ;[54] max # chs?
;[83] bne shddr1 ;[54] not at max get another
;[83]shddr2: ;[54]
;[79] jsr prcrlf ;[12] Print a crelf after it
;[83] jmp prcrlf ;[79][12] Print a crelf after it,let it rts
;[79] rts
ldx ddrnm ;[83] its so much easier
ldy ddrnm+1 ;[83] this way
jmp prstrl ;[83] string & cr
shpari: ldx #shin20\ ;[21] Get address of 'parity' string
ldy #shin20^ ;[21] ...
lda shin20 ;[87]
;[87] jsr prstr ;[21] Print that
jsr prncfm ;[87] Print that
lda parity ;[21] Get the parity index
cmp #$05 ;[21] Is it >= 5?
bmi shpar1 ;[21] If not just get the string and print it
lda #$00 ;[21] This is the index to the parity we want
shpar1: tax ;[21] Hold this index
lda #kerprs\ ;[21] Get address of the parity strings
sta kermbs ;[21] And stuff it here for genmad
lda #kerprs^ ;[21] ...
sta kermbs+1 ;[21] ...
lda #kerpsl ;[21] Get the string length
pha ;[21] Push that
txa ;[21] Fetch the index back
pha ;[21] Push that parm then
jsr genmad ;[21] call genmad
;[79] jsr prstr ;[21] Print the the string at that address
;[79] jsr prcrlf ;[21] Print a crelf after it
jmp prstrl ;[79] let it rts
;[79] rts
shkbd: ldx #shin21\ ;[35] Get address of 'keyboard-type' string
ldy #shin21^ ;[35] ...
lda shin21 ;[87]
;[87] jsr prstr ;[35] Print that
jsr prncfm ;[87] Print that
lda kbd1 ;[35] Get the keyboard-type identification.
cmp #$03 ;[35] Is it >= 3?
bmi shkbd1 ;[35] If not just get the string and print it
lda #$01 ;[35] This is index for keyboard-type we want.
shkbd1: tax ;[35] Hold this index
lda #kbds\ ;[35] Get the address of the keyboard strings
sta kermbs ;[35] And stuff it here for genmad
lda #kbds^ ;[35] ...
sta kermbs+1 ;[35] ...
lda #kbdl ;[35] Get the string length
pha ;[35] Push that
txa ;[35] Fetch the index back
pha ;[35] Push that parm then
jsr genmad ;[35] call genmad
;[79] jsr prstr ;[35] Print the the string at that address
;[79] jsr prcrlf ;[35] Print a crelf after it
jmp prstrl ;[79] let it rts
;[79] rts ;[35]
shdspy: ldx #shin24\ ;[46] Get address of 'display-type' string
ldy #shin24^ ;[46] ...
lda shin24 ;[87]
;[87] jsr prstr ;[46] Print that
jsr prncfm ;[87] Print that
lda dsp1 ;[46] Get the display-type identification.
cmp #6 ;[49] 0,3,6 -> 0,1,2
bne .+4 ;[49]
lda #2 ;[49] some way to divide by three
cmp #$03 ;[46] Is it >= 3?
bmi shdsp1 ;[46] If not just get the string and print it
lda #$01 ;[46] This is index for display-type we want.
shdsp1: tax ;[46] Hold this index
lda #dsps\ ;[46] Get the address of the display strings
sta kermbs ;[46] And stuff it here for genmad
lda #dsps^ ;[46] ...
sta kermbs+1 ;[46] ...
lda #dspl ;[46] Get the string length
pha ;[46] Push that
txa ;[46] Fetch the index back
pha ;[46] Push that parm then
jsr genmad ;[46] call genmad
jsr prstr ;[46] Print the the string at that address
lda dsptyp ;[49] get display type
bpl shdsp2 ;[49] is this 80 col? no
lda #'=+$80 ;[49]
jsr cout ;[49] print it
lda dsp2 ;[49] get display slot
jsr prbyte ;[49] and print it
; jsr prbydc ;[87] pr in ascii
shdsp2: ;[49]
;[79] jsr prcrlf ;[46] Print a crelf after it
jmp prcrlf ;[79][46] Print a crelf after it,let it rts
;[79] rts ;[46]
shprn: ldx #shin26\ ;[55] Get address of printer string
ldy #shin26^ ;[55] ...
lda shin26 ;[87]
;[87] jsr prstr ;[55] Print that
jsr prncfm ;[87] Print that
lda prnfg ;[55] Get the printer info identification.
;[81] cmp #$03 ;[55] Is it >= 3?
;[81] bmi shprn1 ;[55] If not just get the string and print it
;[81] lda #$01 ;[55] This is index for display-type we want.
;[81]shprn1: tax ;[55] Hold this index
;[81] lda #shoff\ ;[55] Get the address of the display strings
;[81] sta kermbs ;[55] And stuff it here for genmad
;[81] lda #shoff^ ;[55] ...
;[81] sta kermbs+1 ;[55] ...
;[81] lda #5 ;[55] Get the string length
;[81] pha ;[55] Push that
;[81] txa ;[55] Fetch the index back
;[81] pha ;[55] Push that parm then
;[81] jsr genmad ;[55] call genmad
;[81] jsr prstr ;[55] Print the the string at that address
;[81] lda prnsl ;[55] get slot number
;[81] beq shprn2 ;[55] do we have a printer slot? no
jsr pronnr ;[81] print the on/off
ldx #prnslm\ ;[55]
ldy #prnslm^ ;[55]
jsr prstr ;[55] print slot
lda #'= ;[55] separate
jsr dspchr ;[55] to separate
lda prnsl ;[55] get printer slot
jsr prbyte ;[55] and print it
; jsr prbydc ;[87] pr in ascii
shprn2: ;[55]
;[79] jsr prcrlf ;[55] Print a crelf after it
jmp prcrlf ;[79][55] Print a crelf after it,let it rts
;[79] rts ;[55]
shpwd jsr prcfm ;[87] confirm
jsr shddsk ;[87]
jmp kermit ;[87]
shddsk: ;[59]
lda dosflg ;[59] is this prodos
beq shdds1 ;[59] no
ldx #shin2a\ ;[59] yes tell about prodos prefix instead
ldy #shin2a^ ;[59]
lda shin2a ;[87]
;[87] jsr prstr ;[59]
jsr prncfm ;[87]
lda prefix ;[59] is this a null string?
beq shdds2 ;[59] yes,dont print it
ldx #prefix+1\ ;[59] now for the prefix itself
ldy #prefix+1^ ;[59]
jsr prstr ;[59]
jmp shdds2 ;[59] and terminate it
shdds1 ;[59]
ldx #shin22\ ;[40] Set up to print slot message
ldy #shin22^ ;[40] ...
lda shin22 ;[87]
;[87] jsr prstr ;[40] Print the text
jsr prncfm ;[87] Print the text
lda defslt ;[40] Get the number
;[79] jsr prbyte ;[40] Put it on the screen
;[79] jsr prcrlf ;[40] Print a crelf
jsr prbytl ;[79] pr byte in hex & crlf
; jsr prbydr ;[87] pr byte in ascii & cr
ldx #shin23\ ;[40] Set up for the drive message
ldy #shin23^ ;[40] ...
jsr prstr ;[40] Print the text
lda defdrv ;[40] Get the number
;[79] jsr prbyte ;[40] Put drive number on screen
;[79] jsr prcrlf ;[40] Print a crelf
jsr prbytl ;[79] pr byte in hex & crlf
; jsr prbydr ;[87] pr byte in ascii & cr
ldx #shi231\ ;[60] Set up to print vol message
ldy #shi231^ ;[60] ...
jsr prstr ;[60] Print the text
lda defvol ;[60] Get the number
;[87] jsr prbyte ;[60] Put it on the screen
jsr prbydc ;[87] pr in ascii
shdds2 ;[59] place to hang your hat
;[79] jsr prcrlf ;[60] Print a crelf
jmp prcrlf ;[79][60] Print a crelf,let it rts
;[79] rts ;[40] Return
shflow: ldx #shin27\ ;[57] tell about flow control
ldy #shin27^ ;[57]
lda shin27 ;[87]
;[87] jsr prstr ;[57]
jsr prncfm ;[87]
;[76] lda flowfg ;[57] now is it off
lda confg ;[76] now is it off
bpl shflo0 ;[57] yes
ldx #floxon\ ;[57] its xon
ldy #floxon^ ;[57]
jsr prstr ;[57]
shflo1: lda #hspace ;[57] separate with a space
jsr dspchr ;[57]
ldx #flodly\ ;[57] now for the delay
ldy #flodly^ ;[57]
jsr prstr ;[57]
lda #'= ;[57] separate
jsr dspchr ;[57]
lda flowdl ;[57] now for the value of delay
;[87] jsr prbyte ;[57]
jsr prbydc ;[87] pr in ascii
lda #hspace ;[57] separate with a space
jsr dspchr ;[57]
;[79] jsr prcrlf ;[57]
jmp prcrlf ;[79][57] let it rts
;[79] rts ;[57] thats all folks
shflo0: ldx #shoff\ ;[57]
ldy #shoff^ ;[57]
jsr prstr ;[57]
jmp shflo1 ;[57]
shbaud: ;[54]
ldx #shin25\ ;[47] yes,set up show message
ldy #shin25^ ;[47]
lda shin25 ;[87]
;[87] jsr prstr ;[47] and print it
jsr prncfm ;[87] and print it
lda #kerbau\ ;[47] ready the search message
sta kermbs ;[47]
lda #kerbau^ ;[47]
sta kermbs+1 ;[47]
lda #kerbal ;[47]
pha ;[47]
sec ;[47] set carry for subtract
lda sscdbd ;[47] get default baud
sbc #3 ;[47] we ignore the first three
pha ;[47]
jsr genmad ;[47] get the address
;[79] jsr prstr ;[47] and print it
;[79] jsr prcrlf ;[47] and the line feed
jmp prstrl ;[79] let it rts
;[79] rts ;[47]
.SBTTL Status routine
;
; This routine shows the status of the most recent transmission
; session.
;
; Input: NONE
;
; Output: Status of last transmission is sent to screen
;
; Registers destroyed: A,X,Y
;
status: jsr prcfm ; Parse and print a confirm
stat01: ldx #stin00\ ; Get address of first line of text
ldy #stin00^ ; ...
jsr prstr ; Print that
;[84] lda schr ; Get low order byte of character count
;[84] tax ; Put that in x
lda schr+2 ;[87] msb
;[87] ldx schr ;[84] Get low order byte of character count
;[87] lda schr+1 ; Get high order byte
ldy schr ;[87] lsb
ldx schr+1 ;[87]
jsr cv6prr ;[87] print & cr
;[79] jsr prntax ; Print that pair in hex
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
ldx #stin01\ ; Get address of second line
ldy #stin01^ ; ...
jsr prstr ; Print it
;[84] lda rchr ; Get L.O. byte of char count
;[84] tax ; Stuff it here for the call
;[87] ldx rchr ;[84] Get L.O. byte of char count
;[87] lda rchr+1 ; Get H.O. byte
;[79] jsr prntax ; Print that count
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
lda rchr+2 ;[87] msb
ldx rchr+1 ;[87]
ldy rchr ;[87]
jsr cv6prr ;[87]
ldx #stin02\ ; Get L.O. address of message
ldy #stin02^ ; Get H.O. byte
jsr prstr ; Print message
;[87] lda stot ; Get L.O. byte of count
;[87] tax ; Save it
;[87] lda stot+1 ; Get H.O. byte
;[79] jsr prntax ; Print the count
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
lda stot+2 ;[87] msb
ldx stot+1 ;[87]
ldy stot ;[87]
jsr cv6prr ;[87]
ldx #stin03\ ; Get address of next status item message
ldy #stin03^ ; ...
jsr prstr ; Print it
;[87] lda rtot ; Get the proper count (L.O. byte)
;[87] tax ; Hold it here for the call
;[87] lda rtot+1 ; Get H.O. byte
;[79] jsr prntax ; Print the 16-bit count
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
;[87] jsr prcrlf ; Add a crelf at the end
lda rtot+2 ;[87]
ldx rtot+1 ;[87]
ldy rtot ;[87]
jsr cv6prr ;[87]
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
;[87] tax ; Stuff that here for printing
tay ;[87] Stuff that here for printing
lda stot+1 ; ...
sbc schr+1 ; ...
tax ;[87]
lda #0 ;[87]
;[79] jsr prntax ; Print it
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
jsr cv6prr ;[87]
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
;[87] tax ; Stuff that here for printing
tay ;[87] Stuff that here for printing
lda rtot+1 ; ...
sbc rchr+1 ; ...
;[79] jsr prntax ; Print the count
;[79] jsr prcrlf ; Add a crelf at the end
;[87] jsr prntal ;[79] pr a,x in hex & crlf
tax ;[87]
lda #0 ;[87]
jsr cv6prr ;[87]
jsr prcrlf ; Add a crelf at the end
ldx #stin06\ ; Get message for 'last error'
ldy #stin06^ ; ...
;[79] jsr prstr ; Print the message
;[79] jsr prcrlf ; Print a crelf before the error message
jsr prstrl ;[79]
stat07 ;[59] entry for error message only
bit errcod ;[38] Test for 'Error packet received' bit
bvs statpe ;[38] Go process an error packet
lda #kerems ; Get the error message size
pha ; Push it
lda errcod ; Get the error message offset in table
bmi stat02 ; If this is a DOS error, do extra adjusting
pha ; Push that
lda #erms0a\ ; Put the base address in kermbs
sta kermbs ; ...
lda #erms0a^ ; ...
sta kermbs+1 ; ...
jmp statle ; Go print the 'last error' encountered
stat02: and #$7f ; Shut off H.O. bit
beq stat03 ; If it is zero, we are done adjusting
sec ; Decrement by one for the unused error code
sbc #$01 ; ...
stat03: pha ; Push that parameter
lda #dskers\ ; Use 'dskers' as the base address
sta kermbs ; ...
lda #dskers^ ; ...
sta kermbs+1 ; ...
statle: jsr genmad ; Translate code to address of message
;[79] jsr prstr ; Print the text of error message
;[79] jsr prcrlf ; Add a crelf at the end
jsr prstrl ;[79]
;[59] jsr prcrlf ; Add a crelf at the end
lda servef ;[62] is this server mode?
beq stat06 ;[62] no
lda #1 ;[62] times to try it
sta numtry ;[62]
stat04 jsr statec ;[62] try and send error packet
bne stat09 ;[62] ok? yes
dec numtry ;[62]
bne stat04 ;[62] no try again
stat09 ;[62] thats all
.ifeq termnl ;[63]
jmp sallt2 ;[63] in terminal we are thru
.endc ;[63]
.ifne termnl ;[63]
jmp server ;[62] around we go again
.endc ;[63]
statpe:
ldx #erin02\ ;[59]
ldy #erin02^ ;[59]
jsr prstr ;[59] say its from the remote
ldx #errrkm\ ;[38] L.O. byte address of remote kermit error
ldy #errrkm^ ;[38] H.O. byte address...
;[79] jsr prstr ;[38] Print the text from the error packet
;[79] jsr prcrlf ;[38] Print an extra crelf
jsr prstrl ;[79]
stat06 ;[62]
jmp kermit ;[38] Start at the top again
statec lda #'E ;[62] yes send error to rmt
sta ptype ;[62]
lda n ;[62] set ther correct pck number
sta pnum ;[62]
ldy #0 ;[62] move msg to packet
stat05 lda (saddr),y ;[62] setup by prstr
and #$7f ;[62] get rid of high bit
sta (kerbf1),y ;[62] setup by srini
iny ;[62]
cpy #kerems-1 ;[62] length of message,forget about nulls
bne stat05 ;[62] all thru? no
sty pdlen ;[62] tell packet how long
jsr spak ;[62] send packet
jsr rpak ;[62] try and read a pkt
beq statrt ;[62] bad packet,what we need is a timer
lda ptype ;[62]
cmp #'Y ;[64] now that we have timer check ack
beq stattt ;[64] yes give true rtn
lda #false ;[64] no, now what
statrt rts ;[64]
stattt lda #true ;[64] were ok
rts ;[64]
.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:
;[59] ldx #snin01\ ; Give the user info on what we are doing
;[59] ldy #snin01^ ; ...
;[59] jsr prstr ; Print the information
;[87] lda #splocv ;[59] position to data
;[87] sta cv ;[59] field
;[84] lda #rploch ;[59] and print
;[87] lda #rploch-2 ;[84] and print
;[87] sta ch ;[59]
;[87] jsr vtab ;[59] hope this works for all kinds
;[87] lda schr+2 ;[84]
;[87] jsr prbyte ;[84]
;[87] lda schr+1 ;[84]
;[87] ldx schr ;[84] bytes sent
;[84] lda tpak+1 ;[16] Get the total packets count
;[59] jsr prbyte ;[16] and print that
;[59] lda tpak ;[16] ...
;[59] jsr prbyte ;[16] ...
;[84] ldx tpak ;[59]
;[79] jsr prntax ;[59] just one call does it all
;[79] jsr prcrlf ; Output a crelf
;[87] jsr prntal ;[79] pr a,x in hex & crlf
lda #$00 ;[25] Clear packet data index
sta pdtind ;[25] ...
spaknd: lda spadch ; Get the padding character
ldx #$00 ; Init counter
spakpd: cpx spad ; Are we done padding?
bcs spakst ;[21] Yes, start sending packet
inx ; No, up the index and count by one
jsr putplc ; Output a padding character
jmp spakpd ; Go around again
;[82]spakst: lda #soh ; Get the start-of-header char into AC
spakst: lda sop+1 ;[82] Get the start-of-header char into AC
jsr putplc ; Send it
;[84] lda exfg ;[75] is this extended packet?
;[84] beq spaks2 ;[75] no
lda pdlen ;[75] increment the # of chs send
ldx prtcl ;[85] xmodem?
bne spaks2 ;[85] yes
cmp #dpakln+1 ;[84] do we need to use long pkts?
blt spaks2 ;[84] no
jsr spnocs ;[75]
lda #6 ;[75] ex len has 6 extra
jsr spnocs ;[75]
lda #sp ;[75] maxl = 0
sta chksum ;[75] start out checksum
jsr putplc ;[75] adios ch
jmp spaks3 ;[75]
spaks2 ;[75]
;[84] lda pdlen ; Get the data length
clc ; Clear the carry
adc #$03 ; Adjust it
ldx prtcl ;[83] xmodem?
bne spaks6 ;[83] yes
pha ; Save this to be added into stot
clc ; Clear carry again
adc #sp ; Make the thing a character
sta chksum ; First item, start off chksum with it
jsr putplc ;[25] Send the character
pla ; Fetch the pdlen and add it into the
spaks6 ;[83]
jsr spnocs ;[75] bump # of chs sent
;[75] clc ; 'total characters sent' counter
;[75] adc stot ; ...
;[75] sta stot ; ...
;[75] lda stot+1 ; ...
;[75] adc #$00 ; ...
;[75] sta stot+1 ; ...
spaks3 ;[75]
lda pnum ; Get the packet number
ldy prtcl ;[83] xmodem?
beq spaks8 ;[83]
jsr putplc ;[83] first the pkt #
eor #$ff ;[83] a is still intact
jsr putplc ;[83] now the pkt # complimented
jmp spaks5 ;[83]
spaks8 ;[83]
clc ; ...
adc #sp ; Char it
jsr ccrcpu ;[75]
;[75] pha ; Save it in this condition
;[75] clc ; Clear carry
;[75] adc chksum ; Add this to the checksum
;[75] sta chksum ; ...
;[75] pla ; Restore character
;[75] jsr putplc ;[25] Send it
lda ptype ; Fetch the packet type
and #$7f ; Make sure H.O. bit is off for chksum
jsr ccrcpu ;[75]
;[75] pha ; Save it on stack
;[75] clc ; Add to chksum
;[75] adc chksum ; ...
;[75] sta chksum ; ...
;[75] pla ; Get the original character off stack
;[75] jsr putplc ;[25] Send packet type
;[84] lda exfg ;[75] are we extended packet
;[84] beq spaks5 ;[75] no
ldy pdlen ;[84]
cpy #dpakln+1 ;[84] do we need to use long pkts?
blt spaks5 ;[84] no
lda #0 ;[75] msb
pha ;[75]
pha ;[87]
;[84] lda pdlen ;[75] lsb
;[84] clc ;[75] must include the crc also
;[84] adc #1 ;[75]
iny ;[84]
tya ;[84]
bne spaks4 ;[75] we cant handle 0
brk ;[75] got to do something about this
spaks4
pha ;[75]
lda #0 ;[75] msb
pha ;[75]
pha ;[87]
;[84] lda #95 ;[75] lsb
lda #dpakln+1 ;[84] lsb
pha ;[75]
;[87] jsr div16 ;[75] get q and rem
jsr div24 ;[87] get q and rem
bcc spaks7 ;[75] always good it says here
brk ;[75] got to do something better
spaks7 pla ;[75]
clc ;[75]
adc #' ;[75] char it
jsr ccrcpu ;[75] and output it
pla ;[75] msb got to be 0
pla ;[87] msb got to be 0
pla ;[75] lsb of rem
clc ;[75]
adc #' ;[75] char it
jsr ccrcpu ;[75] and output it
jsr putcrc ;[75] get hcrc
jsr ccrcpu ;[75] and put it
pla ;[75] msb of rem
pla ;[87] msb of rem
spaks5 ;[75]
ldy #$00 ; Initialize data count
sty datind ; Hold it here
lda prtcl ;[83] xmodem?
beq spaklp ;[83] no
sty chksum ;[83] start check sum at 0
spaklp: ldy datind ; Get the current index into the data
cpy pdlen ; Check against packet data length, done?
;[75] bmi spakdc ; Not yet, process another character
;[83] bcc spakdc ; Not yet, process another character
;[83] jmp spakch ; Go do chksum calculations
bcs spakch ;[83] Go do chksum calculations
spakdc: lda (kerbf1),y ; Fetch data from packet buffer
jsr ccrcpu ;[75]
;[75] clc ; Add the character into the chksum
;[75] adc chksum ; ...
;[75] sta chksum ; ...
;[75] lda (kerbf1),y ; Refetch data from packet buffer
;[75] jsr putplc ;[25] Send it
inc datind ; Up the counter and index
jmp spaklp ; Loop to do next character
;[83]spakch jsr putcrc ;[75] finalize crc
spakch ;[83]
lda prtcl ;[83] xmodem?
beq spakcj ;[83] no
spakci lda #sfxmd ;[83] size of xmodem data
cmp pdlen ;[83] is this a full one?
beq spakck ;[83] yes
lda #ctrlz ;[83] no fill with ^z
jsr ccrcpu ;[83]
inc pdlen ;[83] make it full
jmp spakci ;[83]
spakck lda chksum ;[83] now finish up
jmp spakcy ;[83]
spakcj ;[83]
jsr putcrc ;[83] finalize crc
;[75]spakch: lda chksum ; Now, adjust the chksum to fit in 6 bits
;[75] and #$c0 ; First, take bits 6 and 7
;[75] lsr a ; and shift them to the extreme right
;[75] lsr a ; side of the AC
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] clc ; Now add in the original chksum byte
;[75] adc chksum ; ...
;[75] and #$3f ; All this should be mod decimal 64
;[75] clc ; ...
;[75] adc #sp ; Put it in printable range
jsr putplc ;[25] and send it
lda seol ; Fetch the eol character
spakcy ;[83]
jsr putplc ;[25] Send that as the last byte of the packet
lda pdtind ;[25] Set the end of buffer pointer
sta pdtend ;[25] ...
lda #$00 ;[25] Set index to zero
sta pdtind ;[25] ...
lda debug ;[25] Is the debug option turned on?
;[59] cmp #off ;[25] ...
beq spaksp ;[25] Nope, go stuff packet at other kermit
lda #$00 ;[25] Option 0
jsr debg ;[25] Do it
spaksp: lda #$00 ;[25] Zero the index
sta pdtind ;[25] ...
ldx prtcl ;[83] xmodem?
beq spakdl ;[83] no
lda ptype ;[83]
cmp #'Y ;[83] is this ack?
bne spakd3 ;[83] no
lda #ack ;[83] just send the single chs for xmodem
spakd2 jsr telppc ;[83] send it down the line
jmp spakcd ;[83]
spakd3 cmp #'N ;[83] how about nak?
bne spakd7 ;[83] no
lda #nak ;[83]
bne spakd2 ;[83]
spakd7 cmp #'Z ;[83] end of file
bne spakdl ;[83]
lda #eot ;[83]
bne spakd2 ;[83]
spakdl: ldx pdtind ;[25] Are we done?
cpx pdtend ;[25] ...
;[75] bpl spakcd ;[25] Yes, go call debug again
bcs spakcd ;[75][25] Yes, go call debug again
lda plnbuf,x ;[25] Get the byte to send
jsr telppc ;[25] Ship it out
inc pdtind ;[25] Increment the index once
jmp spakdl ;[25] Go to top of data send loop
;[87]spakcd: lda debug ; Get debug switch
spakcd: ;[87]
lda #splocv ;[87] position to data
sta cv ;[87] field
lda #0 ;[87]
ldx schr+2 ;[87]
ldy schr+1 ;[87]
jsr prnpct ;[87] print %
lda #rploch-2 ;[87] and print
sta ch ;[87]
jsr vtab ;[87] hope this works for all kinds
lda schr+2 ;[87]
ldx schr+1 ;[87]
ldy schr ;[87] bytes sent
jsr cv6prr ;[87] convert to ascii & print
lda debug ;[87] Get debug switch
;[59] cmp #off ;[26] Do we have to do it?
beq spakcr ;[26] Nope, return
lda #$01 ; Option 1
jsr debg ; Do the debug stuff
spakcr: rts ; and return
;[87]
;[87] convert 24 binary bits to ascii and print them
;[87]
;[87] ENTRY:
;[87] a - msb of 24 bits
;[87] x - next 8 bits
;[87] y - lsb of 24 bits
;[87]
cvaprn pha ;[87] msb of value
txa ;[87] next 8
pha ;[87]
tya ;[87] lsb of value
pha ;[87]
lda #getln^ ;[87] msb
pha ;[87]
lda #getln\ ;[87] lsb
pha ;[87]
jsr bn2asc ;[87] this should get interesting
sec ;[87]
lda cvaflw ;[87] field width
sbc getln ;[87] leading blanks
beq cvapr2 ;[87] no
bpl cvapr0 ;[87] yes
eor #$ff ;[87] trouble not wide enough
tay ;[87] so only last cvaflw chs
iny ;[87]
jmp cvapr3 ;[87]
cvapr0 tay ;[87] count of leading blanks
lda #' ;[87]
cvapr1 jsr cout ;[87]
dey ;[87] thru?
bne cvapr1 ;[87]
cvapr2 ldy #0 ;[87]
cvapr3 cpy getln ;[87] length of ascii chs
beq cvapr7 ;[87]
lda getln+1,y ;[87]
jsr cout ;[87] print it
iny ;[87]
bne cvapr3 ;[87] more
cvapr7 rts ;[87]
cv6prr pha ;[87] field 6 wide with cr
lda #6 ;[87]
sta cvaflw ;[87]
pla ;[87]
jsr cvaprn ;[87]
jmp prcrlf ;[87] now add a cr
;cv5prr pha ;[87] field 5 wide cr
; lda #5 ;[87]
; sta cvaflw ;[87]
; pla ;[87]
; jsr cvaprn ;[87]
; jmp prcrlf ;[87] finaly the cr
cv4prn pha ;[87] field 4 wide no cr
lda #4 ;[87]
sta cvaflw ;[87]
pla ;[87]
jmp cvaprn ;[87]
cv3prn pha ;[87] field 3 wide no cr
lda #3 ;[87]
sta cvaflw ;[87]
pla ;[87]
jmp cvaprn ;[87]
cv3prr pha ;[87] field 3 wide cr
lda #3 ;[87]
sta cvaflw ;[87]
pla ;[87]
jsr cvaprn ;[87]
jmp prcrlf ;[87] finaly the cr
spnocs clc ; 'total characters sent' counter
adc stot ; ...
sta stot ; ...
;[87] bcc .+5 ;[75] hate to do this
bcc spakcr ;[87]
inc stot+1 ;[75]
bne spakcr ;[87] did this one carry?
inc stot+2 ;[87] yup
rts ;[75] thats all
fincrc ;[75]
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
rts ;[75]
putcrc ;[75] finalize crc
jsr fincrc ;[75]
clc ; ...
adc #sp ; Put it in printable range
rts ;[75]
ccrcpu ;[75]
pha ; Save it in this condition
clc ; Clear carry
adc chksum ; Add this to the checksum
sta chksum ; ...
pla ; Restore character
jsr putplc ;[25] Send it
rts ;[75]
rpnocr lda pdlen ;[75] Get the packet data length
clc ; and add it into the
adc rtot ; 'total characters received' counter
sta rtot ; ...
bcc rpnoc3
inc rtot+1 ; ...
bne rpnoc3 ;[87] carry more?
inc rtot+2 ;[87] yes
rpnoc3 rts
prnpct pha ;[87] msb
txa ;[87]
pha ;[87] msb
tya ;[87]
pha ;[87] lsb
lda #0 ;[87] times 100
pha ;[87] msb
pha ;[87]
lda #100 ;[87] lsb
pha ;[87]
jsr mul24 ;[87] 24bit multiply
lda #0 ;[87]
pha ;[87]
lda lcurfl+2 ;[87] msb of current file length
pha ;[87]
lda lcurfl+1 ;[87]
pha ;[87]
jsr div24 ;[87] should be %
lda #pclocv ;[87]
sta ch ;[87] cv should still be ok
jsr vtab ;[87] pos for % number
pla ;[87]
tay ;[87] lsb of q
pla ;[87] msb "
tax ;[87]
pla ;[87] msb of 24 bits
jsr cv3prn ;[87] this should get interesting
pla ;[87] remainder
pla ;[87] keep the stack straight
pla ;[87]
rts ;[87] bye
.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
;
;[87]rpak: jsr gobble ; Gobble a line up from the port
;[87] jmp rpkfls ; Must have gotten a keyboard interupt, fail
rpak ;[87] hope this speeds it up
;[68] lda ibmmod ;[21] Is ibm-mode on?
;[62] cmp #on ;[21] ...
;[62] bne rpakst ;[21] If not, start working on the packet
;[68] beq rpakst ;[62][21] If not, start working on the packet
;[68]rpakc0: jsr getc ;[21] Any characters yet?
;[68] jmp rpakst ;[21] Got one from the keyboard
;[68] cmp #xon ;[21] Is it an XON?
;[68] bne rpakc0 ;[21] Nope, try again
;[87]rpakst:
;[59] jsr home ; Clear the screen
;[59] ldx #rcin01\ ; Give the user info on what we are doing
;[59] ldy #rcin01^ ; ...
;[59] jsr prstr ; Print the information
lda #rplocv ;[59] position to data
sta cv ;[59] field
lda #0 ; msb
ldx rchr+2 ;
ldy rchr+1 ; lsb
jsr prnpct ; print %
;[84] lda #rploch ;[59] and print it
lda #rploch-2 ;[59] and print it
sta ch ;[59]
jsr vtab ;[59] hope this works on //e . . .
lda rchr+2 ;[84]
;[87] jsr prbyte ;[84]
;[87] lda rchr+1 ;[84] now for the bytes received
ldx rchr+1 ;[87] now for the bytes received
;[87] ldx rchr ;[84]
;[87] lda rchr ;[87]
ldy rchr ;[87]
jsr cv6prr ;[87] convert and print
;[84] lda tpak+1 ;[16] Get the total packets count
;[59] jsr prbyte ;[16] and print that
;[59] lda tpak ;[16] ...
;[59] jsr prbyte ;[16] ...
;[84] ldx tpak ;[59]
;[79] jsr prntax ;[59] one call does it all
;[79] jsr prcrlf ; Output a crelf
;[87] jsr prntal ;[79] pr a,x in hex & crlf
jsr gobble ;[87] Gobble a line up from the port
jmp rpkfls ;[87] Must have gotten a keyboard interupt, fail
lda debug ; Is debugging on?
;[59] cmp #off ;[26] ...
beq rpaknd ;[26] 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
;[75] sta kerchr ; and the current character input
sta rpkexx ;[75] & extended len index
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
;[82] cmp #soh ; Is it an SOH character?
ldx prtcl ;[83] xmodem?
beq rpakf9 ;[83] no
cmp #'C ;[83] crc request?
beq rpakf7 ;[83] yes
cmp #eot ;[83] end of file
bne rpakf3 ;[83] no
lda #'Z ;[83] use kermit protocol end of file
bne rpakf7 ;[83] common code
rpakf3 cmp #ack ;[83] ok?
bne rpakf5 ;[83]
lda #'Y ;[83] this is kermits ack
bne rpakf7 ;[83]
rpakf5 cmp #nak ;[83] failure?
bne rpakf9 ;[83]
lda #'N ;[83] yes kermits nak
rpakf7 sta ptype ;[83]
lda #0 ;[83]
sta pdlen ;[83] the data len is 0
jmp rpkret ;[83] good return
rpakf9 ;[83]
cmp sop ;[82] Is it a rec SOH character?
bne rpakfs ; Nope, try again
lda prtcl ;[83] xmodem?
beq rpakfc ;[83] no
jsr getplc ;[83]
jmp rpkfls ;[83] failure rtn
sta pnum ;[83] packet #
jsr getplc ;[83] next ch
rpakfa jmp rpkfls ;[83] failure rtn
eor #$ff ;[83] complemented packet #
cmp pnum ;[83] are they the same?
bne rpakfa ;[83] no sigh!
ldy #sfxmd ;[83] set xmodems data size
sty pdlen ;[83]
lda #'D ;[83] its data
sta ptype ;[83]
jmp rpkif7 ;[83]
rpakfc ;[83]
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
;[82] cmp #soh ; Was it another SOH?
cmp sop ;[82] Was it another rec SOH?
bne rpkif2 ; If not, we don't have to resynch
rpkif4 ;[75]
lda #$00 ; Yes, resynch
sta fld ; Reset the switch
sta rpkexx ;[75] reset the extended pak index
rpkif2: lda fld ; Get the field switch
cmp #$04 ; Is it <= 3?
bpl rpkswt ; No, go check the different cases now
jsr rcrccl ;[75]
;[75] lda kerchr ; Yes, it was, get the character
;[75] clc ; and add it into the chksum
;[75] adc chksum ; ...
;[75] 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
bne rpkc7 ;[75]
inc rpkexx ;[75] this is extended packet
rpkc7 ;[75]
sec ; ...
sbc #$03 ; Adjust it down to data length
rpke1b ;[75]
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???
;[75] bne rpkc5 ; No, try last case
beq .+5 ;[75] hate to do this
jmp rpkc5 ;[75] its a long reach
ldy rpkexx ;[75] is this extended pkt
beq rpkc9 ;[75] no
lda kerchr ;[75] get current ch
pha ;[75] save it
jsr rcrccl ;[75] calc checksum
pla ;[75] retrieve it again
sec ;[75] unchar it
sbc #sp ;[75]
sta exchs-1,y ;[75] save it for the hcrc
inc rpkexx ;[75] ready for the next
cpy #2 ;[75] are we ready for the header crc calc?
bne rpkc6 ;[75] no
jsr fincrc ;[75] yes get current crc and finalize
sta hcrc ;[75] save it
jmp rpklp1 ;[75] next
rpkc6 cpy #3 ;[75] have we got all the header?
beq .+5 ;[75] hate to do this
jmp rpklp1 ;[75] no, next
lda exchs+2 ;[75] get hcrc
cmp hcrc ;[75] is header crc ok?
beq rpkc8 ;[75] yes
lda hcrc ;[75] make print ok
sta chksum ;[75]
jmp rpkpl ;[75] bad header crc so do no more
rpkc8 lda #0 ;[75] msb
sta rpkexx ;[75] now turn off extended to process data
pha ;[87] msb
pha ;[75]
lda exchs ;[75] get xl1
pha ;[75] lsb
lda #0 ;[75] msb
pha ;[87]
pha ;[75]
;[84] lda #95 ;[75] lsb
lda #dpakln+1 ;[84] lsb
pha ;[75]
;[87] jsr mul16 ;[75] calc the extended len
jsr mul24 ;[87][75] calc the extended len
pla ;[75] lsb
sta pdlen ;[75] this should be only data len
pla ;[75] keep stack straight
pla ;[87] "
lda exchs+1 ;[75] get xl2
clc ;[75] now add them together
adc pdlen ;[75]
sta pdlen ;[75]
dec pdlen ;[75] remove the crc byte from the count
jmp rpklp1 ;[75] now process the data
rpkc9 ;[75]
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?
;[75] bmi rpkif3 ; Not yet, process the character as data
;[75] jmp rpkef ; Yes, go on to last field (chksum)
bcs rpkef ;;[75] 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
rpkif7 ;[83]
jsr getplc ; Get a char, find SOH
jmp rpkfls ; Got a keyboard interupt instead
sta kerchr ; Store it here
ldx prtcl ;[83] xmodem?
bne rpkacc ;[83] yes
and #$7f ; Shut H.O. bit
;[82] cmp #soh ; Is it an SOH again?
cmp sop ;[82] Is it a rec SOH again?
bne rpkacc ; No, go accumulate chksum
jmp rpkif4 ;[75] think this is cleaner
;[75] lda #$ff ; Yup, SOH, go resynch packet input once again
;[75] sta fld ; ...
;[75] jmp rpkef ; ...
rpkacc jsr rcrccl ;[75]
;[75]rpkacc: lda kerchr ; Get the character
;[75] clc ; ...
;[75] adc chksum ; Add it to the chksum
;[75] sta chksum ; and save new chksum
lda kerchr ; Get the character again
ldy datind ; Get our current data index
sta (kerbf1),y ; Stuff the current character into the buffer
inc datind ; Up the index once
jmp rpkchl ; Go back and check if we have to do this again
rpkc5: cmp #$05 ; Last chance, is it case 5?
beq rpkc51 ; Ok, continue
jmp rpkpe ; Warn user about program error
rpkc51 jsr fincrc ;[75]
;[75]rpkc51: lda chksum ; Do chksum calculations
;[75] and #$c0 ; Grab bits 6 and 7
;[75] lsr a ; Shift them to the right (6 times)
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] lsr a ; ...
;[75] clc ; Clear carry for addition
;[75] adc chksum ; Add this into original chksum
;[75] and #$3f ; Make all of this mod decimal 64
sta chksum ; and resave it
;[83]rpkef: inc fld ; Now increment the field switch
rpkef: ;[83]
lda prtcl ;[83] xmodem?
beq rpkef7 ;[83] no
jsr getplc ;[83] now for the checksum
jmp rpkfls ;[83] failure rtn
sta kerchr ;[83] save it for error print
cmp chksum ;[83] do they agree?
bne rpkpl ;[83] no
beq rpkret ;[83] ok
rpkef7 ;[83]
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
rpkpl ;[75]
lda #$06 ; Store the error code
sta errcod ; ...
lda #ellocv ;[75] position to
sta cv ;[75] error msg line
lda #dbloch ;[75]
sta ch ;[75]
jsr vtab ;[75] so it will print nice
ldx #erms15\ ; Create pointer to error text
ldy #erms15^ ; ...
jsr prstr ; Print the chksum error
lda kerchr ; Print chksum from packet
ldx prtcl ;[83]
bne rpkpl3 ;[83]
sec ;[75] un char it
sbc #sp ;[75]
rpkpl3 ;[83]
jsr prbyte ; ...
lda #sp ; Space things out a bit
jsr cout ; ...
lda chksum ; Now get what we calculated
;[79] jsr prbyte ; and print that
;[79] jsr prcrlf ;[53] make it look nice on the screen
jsr prbytl ;[79] pr byte in hex & crlf
rpkfls: lda #$00 ;[26] Zero the index for debug mode
sta pdtind ;[26] ...
lda debug ; Is debug switch on?
;[59] cmp #off ;[26] ...
beq rpkfnd ;[26] Return doing no debug stuff
lda #$03 ; Option 3 <we are in rpkfls>
jsr debg ; Output debug information
rpkfnd jsr rpnocr ;[75] bump number of chs received
;[75]rpkfnd: lda pdlen ; Get the packet data length
;[75] clc ; and add it into the
;[75] adc rtot ; 'total characters received' counter
;[75] sta rtot ; ...
;[75] lda rtot+1 ; ...
;[75] adc #$00 ; ...
;[75] sta rtot+1 ; ...
bperrc ;[83]
lda #erlocv ;[59] position to data
sta cv ;[59] field
lda #rploch ;[59] and print it
sta ch ;[59]
jsr vtab ;[59] hope hope
inc errcnt ;[59] bump the error count
bne .+5 ;[59] would rather use a label
inc errcnt+1 ;[59]
;[87] ldx errcnt ;[59] now to print the count
;[87] lda errcnt+1 ;[59]
;[87] jsr prntax ;[59]
lda #0 ;[87] msb
ldx errcnt+1 ;[87]
ldy errcnt ;[87] lsb
jsr cv4prn ;[87] in decimal
lda #false ; Set up failure return
rts ; and go back
rpkret: lda #$00 ;[26] Zero the index for debug mode
sta pdtind ;[26] ...
lda debug ; Check debug switch
;[59] cmp #off ;[26] Is it on?
beq rpkrnd ;[26] No, return with no debug
lda #$04 ; Yes, use option 4 <we received a packet>
jsr debg ; Print out the debug info
rpkrnd jsr rpnocr ;[75] bump number of chs rec
;[75]rpkrnd: lda pdlen ; Get the packet data length
;[75] clc ; and add it into the
;[75] adc rtot ; 'total characters received' counter
;[75] sta rtot ; ...
;[75] lda rtot+1 ; ...
;[75] adc #$00 ; ...
;[75] sta rtot+1 ; ...
lda #true ; Show a successful return
rts ; and return
rpkpe: ldx #erms16\ ; Set up pointer to error text
ldy #erms16^ ; ...
jsr prstr ; Print the error
lda #$07 ; Load error code and store in errcod
sta errcod ; ...
jmp rpkfls ; Go give a false return
rcrccl ;[75] calc checksum
lda kerchr ; Yes, it was, get the character
clc ; and add it into the chksum
adc chksum ; ...
sta chksum ; ...
rts ;[75]
.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: ;[64] Hold the action code here
sta debinx ; Save it here
jsr dbloc ;[59] position to debug area of screen
lda debug ;[26] Get the debug switch
cmp #terse ;[26] Is it terse
bne debgvr ;[26] Nope, must be Verbose mode
jmp debgtr ;[26] Yes, to terse debug output
debgvr: ;[72]lda state ;[26] Check the current state
;[72]; cmp #$00 ; If we just started this thing
;[72] beq debgrf ; then we don't need debug output yet
;[72] cmp #'C ; If the transmission state is 'complete'
;[72] beq debgrf ; we don't need debug output either
lda #kerrts\ ; Get base address of the routine name and
sta kermbs ; action table so that we can calculate
lda #kerrts^ ; the address of the routine name string
sta kermbs+1 ; which we need.
lda #kerrns ; Load the routine name size
pha ; Push that
lda debinx ;[64] restore action type
;[64] 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
;[83] sta debchk ;[64] and start the checksum with that
;[64] pha ; Save this accross the routine calls
ora #$80 ; Make sure H.O. bit is on before printing
;[79] jsr cout ; Write that out
;[79] jsr prcrlf ; Now write a crelf
jsr coutl ;[79] print ch & crlf
;[64] pla ; Get back the packet type
lda debinx ; Get the debug action index
;[64] bne debg1 ; If not 'sending', continue
;[64] jsr debprd ; Yes, go do some extra output
;[64]debg1: cmp #$04 ; Have we just received a packet?
;[64] bne debgrt ; No, just return
beq debg1 ;[64] are we sending? yes
;[83] cmp #4 ;[64] just received?
;[83] bne debgrt ;[64] no
cmp #3 ;[83]
blt debgrt ;[83] print both states of receive
debg1 ;[64]
jsr debprd ; Print the packet info
debgrt:
jsr wfakp ;[75] wait if a ^S keypress for next keypress
lda #true ; Load true return code into AC
rts ; and return
;[75]debgrf: lda #false ; Set up failure return
;[75] rts ; and go back
keyprs lda kbd ;[85] do we have a key press
bpl debg5 ;[85] not yet
cmp #hxoff ;[85] how about a ^S
bne debg5 ;[85] no must not be a hold screen
bit kbdstr ;[85] yes, reset keyboard strobe
debg4 lda kbd ;[85] get next keypress
bpl debg4 ;[85] not yet
bit kbdstr ;[85] no, reset strobe throw away keypress
debg5 rts ;[85]
wfakp ;[75]
;[78] lda #4 ;[59] wait 1 sec for viewing
lda #8 ;[78] wait 1 sec for viewing
sta kwrk01 ;[59]
;[78]debg3 lda #255 ;[59] 255 ms wait
debg3 lda #220 ;[78] 125 ms wait
jsr wait ;[59]
;[85] lda kbd ;[75] do we have a key press
;[85] bpl debg5 ;[75] not yet
;[85] cmp #hxoff ;[75] how about a ^S
;[85] bne debg5 ;[75] no must not be a hold screen
;[85] bit kbdstr ;[75] yes, reset keyboard strobe
;[85]debg4 lda kbd ;[75] get next keypress
;[85] bpl debg4 ;[75] not yet
;[85] bit kbdstr ;[75] no, reset strobe throw away keypress
;[85]debg5
jsr keyprs ;[85] check for a ^s keypress
dec kwrk01 ;[59]
bne debg3 ;[59]
rts ;[75]
;
; 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^ ; ...
;[79] jsr prstr ; and print it
;[79] jsr prcrlf ; New line
jsr prstrl ;[79]
ldx #debms3\ ;[26] Get address of message text
ldy #debms3^ ;[26] ...
jsr prstr ; Print it
inc pdtind ;[26] Pass the SOH
ldx pdtind ;[26] Get the index
lda plnbuf,x ;[26] Get the data length
sec ;[26] Uncharacter this value
sbc #$20 ;[26] ...
sta kwrk01 ;[75] 0 is extended len packet
lda pdlen ;[75] this may be extended len packet
;[79] jsr prbyte ; Print the hex value
;[79] jsr prcrlf ; New line
jsr prbytl ;[79] pr byte in hex & crlf
ldx #debms2\ ;[26] Get address of next message to print
ldy #debms2^ ;[26] ...
jsr prstr ; Print that one
inc pdtind ;[26] Next character is packet number
ldx pdtind ;[26] ...
lda plnbuf,x ;[26] Load it
ldy prtcl ;[83] xmodem?
beq debpr1 ;[83]
eor #$ff ;[83] complemented packet #
dec pdtind ;[83] keep things straight
jmp debpr3 ;[83]
debpr1 ;[83]
sec ;[26] Uncharacter this value
sbc #$20 ;[26] ...
;[79] jsr prbyte ; Print the hex value
;[79] jsr prcrlf ; New line
debpr3 ;[83]
jsr prbytl ;[79] pr byte in hex & crlf
inc pdtind ;[26] Bypass the packet type
ldy #$ff ;[26] Start counter at -1
sty kwrk02 ;[26] Store it here
ldy prtcl ;[83] xmodem?
bne debprc ;[83] yes
ldy kwrk01 ;[75] is this extended len pkt
bne debprc ;[75] no
inc pdtind ;[75] skip xl1
inc pdtind ;[75] skip xl2
inc pdtind ;[75] skip hcrc
debprc: inc kwrk02 ;[26] Increment the counter
ldy kwrk02 ;[26] Get counter
cpy pdlen ; Are we done printing the packet data?
;[75] bpl debdon ; If so, go finish up
bcs debdon ;[75] If so, go finish up
inc pdtind ;[26] Point to next character
ldx pdtind ;[26] Fetch the index
lda plnbuf,x ;[26] Get next byte from packet
jsr prchr ; Go output special character
;[75] lda #hspace ;[26] Now print 1 space
;[75] jsr cout ; ...
jmp debprc ; Go check next character
debdon: jsr prcrlf ; Next line
ldx #debms4\ ; Get the address to the 'checksum' message
ldy #debms4^ ; ...
jsr prstr ; Print that message
inc pdtind ;[26] Get next byte, this is the checksum
ldx pdtind ;[26] ...
lda plnbuf,x ;[26] ...
ldx prtcl ;[83] xmodem?
bne debdo3 ;[83] yes
sec ;[26] Uncharacter this value
sbc #$20 ;[26] ...
;[79] jsr prbyte ; Print the hex value of the checksum
;[79] jsr prcrlf ; Print two(2) crelfs
debdo3 ;[83]
jsr prbytl ;[79] pr byte in hex & crlf
;[79] jsr prcrlf ; ...
jmp prcrlf ;[79] ...
;[79] 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: ;[75]txa ;[26] Look at Option
lda debinx ;[75] option has been moved
; cmp #$00 ;[26] Sending?
beq debgsn ;[26] Yes, output 'SENDING: '
cmp #$03 ;[26] Failed receive?
beq debgrc ;[26] Yes, output 'RECEIVED: '
cmp #$04 ;[26] Receive?
beq debgrc ;[26] Yes, output 'RECEIVED: '
rts ;[26] Neither, just return
debgsn: ldx #sstrng\ ;[26] Get ready to print the string
ldy #sstrng^ ;[26] ...
;[79] jsr prstr ;[26] Do it!
;[79] jsr prcrlf ;[26] Print a crelf
;[83] jsr prstrl ;[79]
;[83] jmp debgdp ;[26] Go dump the packet
bne debgr3 ;[83] common code
debgrc: ldx #rstrng\ ;[26] Get ready to print the string
ldy #rstrng^ ;[26] ...
;[79] jsr prstr ;[26] Do it!
;[79] jsr prcrlf ;[26] Print a crelf
debgr3 ;[83]
jsr prstrl ;[79]
debgdp: ldx pdtind ;[26] Get index
cpx pdtend ;[26] Are we done?
;[75] bpl debgfn ;[26] Yes, return
bcs debgfn ;[75][26] Yes, return
lda plnbuf,x ;[26] Get the character
jsr prchr ;[26] Print it
;[75] lda #hspace ;[26] Print a space
;[75] jsr cout ;[26] ...
inc pdtind ;[26] Advance the index
jmp debgdp ;[26] Do next character
debgfn: jsr prcrlf ;[26] Print a crelf then...
jmp debgrt ;[75] wait if a ^S keypress for next keypress
;[75] rts ;[26] Return
dbloc ;[59] position to debug area on screen
lda #dblocv ;[59] place for debug output on screen
sta cv ;[59]
lda #dbloch ;[59]
sta ch ;[59]
jsr vtab ;[59] hope hope
;[75] jsr clreop ;[59]
jmp clreop ;[75][59]
;[75] rts ;[59]
.ifeq <ftcom-ftappl>
.SBTTL Dos routines
;
; These routines handle files and calls to the DOS
;
;
; This routine opens a file for either input or output. If it
; opens it for output, and the file exists, and file-warning is
; on, the routine will issue a warning and attempt to modify
; the filename so that it is unique.
;
; Input: A- Fncrea - open for read
; Fncwrt - open for write
;
; Output: File is opened or error is issued
;
openf
pha ; Hold the parameter on the stack
;[84] jsr movdds ;[40] Go move in the default slot and disk
ldx dosflg ;[66]
bne .+5 ;[66] is this prodos? yes
jsr opnupc ;[66] no force file name to upper case
cmp #fncwrt ; Are we openning for output?
beq openfw ; Open for output
ldx dosflg ;[59] this is input
beq openf2 ;[59]prodos? no
jsr prodos ;[59] get file info
.byte gfilin ;[59]
.word gsinfo ;[59]
bcc .+5 ;[59] any error? no
jsr perror ;[59] yes
;[87] lda filmod ;[59] get file type
;[87] cmp #5 ;[78] is this type other?
;[87] bcs pckfty ;[78] yes, just use it
;[87] cmp #4 ;[59] make sure its in range
;[87] bmi openf0 ;[59] ok
;[87] lda #3 ;[59] make it fit
;[87]openf0 sta kwrk01 ;[59] now * 3
;[87] asl kwrk01 ;[59] double it
;[87] clc ;[59] so we can add
;[87] adc kwrk01 ;[59] finally * 3
;[87] tax ;[59] indexed jump needs it here
;[81] lda #pktyp\ ;[59]
;[81] sta jtaddr ;[59]
;[87] ldy #pktyp\ ;[81]
;[87] lda #pktyp^ ;[59]
;[87] jmp indexj ;[59] and indexed jump
;[87]pktyp jmp itstxt ;[59] text file
;[87] jmp itsiba ;[59] int basic
;[87] jmp itsaba ;[59] applesoft basic
;[87] lda #ptbin ;[59] binary file
;[87]pckfty cmp gfilty ;[59] is this the same kind
;[87] beq pgdfl ;[59] yes
;[87] ldx #erms1d\ ;[59] tell wrong type
;[87] ldy #erms1d^ ;[59]
;[87] jsr prstr ;[59]
;[87] jsr shmod ;[59] and show mode
;[87] pla ;[59] keep the stack straight
;[87] lda #false ;[59]
;[87] rts ;[59] and return
lda gfilty ;[87]
cmp #ptbin ;[87] bin file?
bne opfl02 ;[87]
lda #4 ;[87] yes set filmod
bne opfl05 ;[87] and open the file
opfl02 cmp #pttxt ;[87] text file?
bne opfl03 ;[87]
lda #0 ;[87] yes
beq opfl05 ;[87]
opfl03 cmp #ptbas ;[87] applesoft?
bne opfl04 ;[87]
lda #2 ;[87] yes
bne opfl05 ;[87]
opfl04 cmp #ptibas ;[87] integer basic?
bne opfl05 ;[87]
lda #1 ;[87] yes
opfl05 sta filmod ;[87] ok its type other
pgdfl jsr prodos ;[59] ok open file
.byte opnfl ;[59]
.word propen ;[59]
bcc .+5 ;[59] good open? yes
jsr perror ;[59] no
jmp prok ;[59] carry on
;[87]itstxt lda #pttxt ;[59] ascii text type
;[87] jmp pckfty ;[59]
;[87]itsaba lda #ptbas ;[59] prodos applesoft basic
;[87] jmp pckfty ;[59]
;[87]itsiba lda #ptibas ;[59] wonder what to do with integer
;[87] jmp pckfty ;[59]
openf2 ;[59] hope we have the reach
lda #$01 ; Open for input, doscmi must be non-zero
sta doscmi ; so that we do not allocate the file
jmp opnmfs ; Start moving the filename
openfw: lda #on ; Set the 'first mod' switch
sta dosffm ; in case we have to alter the filename
lda filwar ; Get the file warning switch
;[59] cmp #on ;[59] Is it on?
beq opnlu1 ; If not, don't do the lookup
opnlu: jsr lookup ; Do the lookup
opnlu1 jmp opnnlu ; Lookup succeeded, fcb1 contains the filename
lda dosffm ; Is this the first time through?
;[59] cmp #on ; ...
beq opnalt ; [59]If not, continue
ldx #erms1a\ ; Otherwise, print an error message since
ldy #erms1a^ ; the file already exists
;[79] jsr prstr ; ...
;[79] jsr prcrlf ;[59]
jsr prstrl ;[79]
opnalt: jsr alterf ; No good, go alter the filename
jmp opnlu ; Try the lookup again
propn jsr prodos ;[59] try to open the file
.byte opnfl ;[59]
.word propen ;[59] open par list
bcc prok ;[59] we have the file
cmp #nofile ;[59] do we have to create one?
beq .+5 ;[59] yes
jsr perror ;[59] sigh we have trouble
lda filmod ;[59] get file type
cmp #5 ;[78] how about type other?
bcs prostz ;[78] yes, just use filmod
cmp #4 ;[59] make sure its in range
bmi .+4 ;[59] ok
lda #3 ;[59] make it fit
sta kwrk01 ;[59] now * 3
asl kwrk01 ;[59] double it
clc ;[59] so we can add
adc kwrk01 ;[59] finally * 3
tax ;[59] indexed jump needs it here
;[81] lda #protyp\ ;[59]
;[81] sta jtaddr ;[59]
ldy #protyp\ ;[81]
lda #protyp^ ;[59]
jmp indexj ;[59] and indexed jump
protyp jmp dost0 ;[59] text file
jmp dost1 ;[59] int basic
jmp dost2 ;[59] applesoft basic
lda #ptbin ;[59] binary file
prostz ldx #0 ;[78] wish i could do better for aux
ldy #0 ;[78]
prosty sta pfilty ;[59] set file type
stx pfilta ;[78] set aux type LSB
sty pfilta+1 ;[78] & MSB
jsr prodos ;[59] now to create a file
.byte crefil ;[59]
.word create ;[59]
bcc propn ;[59] ok, now open it
jsr perror ;[59] sigh
prok lda refnu ;[59] ref # must be set lots of places
sta prdwr+1 ;[59] first the read/write par
sta pmark+1 ;[59] also the mark/eof
sta pclose+1 ;[59] also the close
lda #mxdb-1\ ;[59] size of full buf writes
sta prdwr+4 ;[59]
jmp prook ;[59] together again
dost0 lda #pttxt ;[59] text file
;[78] jmp prosty ;[59]
jmp prostz ;[78]
dost2 lda #ptbas ;[59] applesoft basic
dostt ldy #8 ;[78] is this always true of basic? MSB
ldx #1 ;[78] LSB
jmp prosty ;[59]
dost1 lda #ptibas ;[59] treat int basic
;[78] jmp prosty ;[59]
jmp dostt ;[78]
opnnlu
lda dosflg ;[59] is this prodos?
bne propn ;[59] yes
lda #$00 ; Make doscmi zero so it allocates the file
sta doscmi ; if it is not found
;[84]opnmfs: ldy #$00 ; Move the filename from the FCB to
opnmfs: ;[84]
;[84]opnmfn: lda fcb1,y ; the primary filename buffer in DOS
;[84] beq opnfl2 ;[59] a null ch? yes
;[66] and #$7f ;[62] make it ascii
;[66] cmp #'a ;[62] is this < a ?
;[66] bmi opnmf1 ;[62] yes its not in lowercase range
;[66] cmp #'{ ;[62] how about beyond the range?
;[66] bpl opnmf1 ;[62] yes
;[66] and #$df ;[62] convert lower to upper case
;[66]opnmf1 ;[62]
;[84] ora #$80 ; Make sure this is negative ascii
;[59] cmp #$80 ; Was the character a null?
;[84] bne opnmfc ; If not, continue
;[84]opnfl2 lda #hspace ; If so, make it a space
;[84]opnfls: sta primfn,y ;[28] Stuff the space there
;[84]opnfls: sta getln+7,y ;[84] Stuff the space there
;[84] iny ;[28] Up the pointer
;[84] cpy #mxfnl+1 ;[28] Done
;[84] bpl opnfil ;[28] Yup, continue
;[84] jmp opnfls ;[28] No, loop again
;[84] bmi opnfls ;[84] No, loop again
;[84]opnmfc: sta primfn,y ; ...
;[84]opnmfc: sta getln+7,y ;[84] ...
;[84] iny ; Up the buffer index once
;[84] cpy #mxfnl+1 ; Done?
;[84] bmi opnmfn ;[59]
; bpl opnfil ; If so, leave
; jmp opnmfn ; Nope, continue move
;[84]opnfil: lda filmod ; Use the file-type mode as the file-type
;[84] jsr dosopn ; Open file with type-checking
opnfil: lda #fncopn ;[84] open command
jsr initfm ;[84] do it
lda ftype ;[84] see if file type match
and #$7f ;[84] hi bit on when file locked
;[87] cmp filmod ;[84]
;[87] beq prook ;[84] good open
;[87] jsr clonlb ;[84] no, close it
;[87] lda #12 ;[84] entry to error msg
;[87] jmp nonft0 ;[84] tattle
sta filmod ;[87] set file type from file
prook ;[59]
jsr opnpfn ;[66]
pla ; Get the parameter back
ldx #mxdb ;[59] Maximum DOS buffer size
cmp #fncwrt ; Are we writing?
bne opnsiw ;[59] If so, set the indices up for writing
ldx #0 ;[59] Maximum DOS buffer size
inc prdwr+4 ;[59] just in case were prodos
opnsiw ;[59]
;[59] sta dsbind ; Stuff that in the index to initialize it
stx dsbind ; Stuff that in the index to initialize it
lda #mxdb-1 ; ...
sta dsbend ; Initialize end-of-buffer pointer
lda #0 ;[78] make sure the eof is clear
sta eodind ;[78]
lda #true ; If it returns here, there were no errors
rts
opnupc: pha ;[66]
ldy #$00 ;[66] Move the filename from the FCB to
opnup1: lda fcb1,y ;[66] the primary filename buffer in DOS
;[81] and #$7f ;[66] make it ascii
;[81] cmp #'a ;[66] is this < a ?
;[81] bmi opnuc2 ;[66] yes its not in lowercase range
;[81] cmp #'{ ;[66] how about beyond the range?
;[81] bpl opnuc2 ;[66] yes
;[81] and #$df ;[66] convert lower to upper case
;[81]opnuc2 ;[66]
jsr convuc ;[81] convert to upper case
ora #$80 ;[66] Make sure this is negative ascii
sta fcb1,y ;[66] ...
iny ;[66] Up the buffer index once
cpy #mxfnl+1 ;[66] Done?
bmi opnup1 ;[66]
pla ;[66] restore acc
rts ;[66]
opnpfn lda fnflag ;[66] should we print file name?
beq prook3 ;[66] no
lda #erlocv ;[66] put it at the start or the retries
sta cv ;[66]
lda #0 ;[66] at the start
sta ch ;[66]
jsr vtab ;[66] position for the print
ldx #fcb1\ ;[66] name is here null terminated
ldy #fcb1^ ;[66] convienient right
lda nfcb1 ;[66] get the number of chs to print
jsr prstrn ;[66]
dec fnflag ;[66] only once
prook3 rts ;[66]
coutl jsr cout ;[79] print ch followed by crlf
jmp prcrlf ;[79]
prbytl jsr prbyte ;[79] pr byte & crlf
jmp prcrlf ;[79]
prbydc tay ;[87] print byte in a in ascii
lda #0 ;[87] no cr
tax ;[87]
jmp cv3prn ;[87] let it do the rts
prbydr tay ;[87] print byte in a in ascii
lda #0 ;[87] cr
tax ;[87]
jmp cv3prr ;[87] let it do the rts
prntal jsr prntax ;[79] pr a,x & crlf
jmp prcrlf ;[79]
;praxdc pha ;[87] cvt ax to ascii print no cr
; txa ;[87]
; tay ;[87] lsb
; pla ;[87]
; tax ;[87]
; lda #0 ;[87] msb
; jmp cv5prn ;[87] cvt
;praxdr pha ;[87] cvt ax to ascii print cr
; txa ;[87]
; tay ;[87] lsb
; pla ;[87]
; tax ;[87]
; lda #0 ;[87] msb
; jmp cv5prr ;[87] cvt
prchrr jsr prchr ;[79] print ch (special) followed by crlf
jmp prcrlf ;[79]
prstrl jsr prstr ;[79] print string terminated with $0
jmp prcrlf ;[79] and let it do the rts
prstrn stx saddr ;[66] setup page 0
sty saddr+1 ;[66]
tax ;[66] get the count
beq prook3 ;[66] nothing to do
ldy #0 ;[66]
prstr1 lda (saddr),y ;[66] get a ch
ora #$80 ;[66] make sure we have high bit on
jsr dely ;[66] so one can see it
iny ;[66]
dex ;[66]
bne prstr1 ;[66] are we thru, no
rts ;[66] yes
prncfm sta kwrk01 ;[87] now for show format
inx ;[87] address is one more
bne .+3 ;[87] carry? no
iny ;[87] yup msb
jsr prstrn ;[87] first print the count
lda #lensh ;[87] length of show line
sec ;[87] less whats already there
sbc kwrk01 ;[87]
ldx #shin2o\ ;[87]
ldy #shin2o^ ;[87]
jmp prstrn ;[87]
;[59]opnsiw: lda #$00 ; Set the index to zero
;[59] sta dsbind ; ...
;[59] lda #mxdb-1 ;[59] The end of buffer should be set to
;[59] sta dsbend ; half the length of a DOS buffer
;[59] lda #true ; Then return true
;[59] rts ; ...
;
; Lookup - searches for a filename in a directory. It is used to
; support file warning during the opening of a file.
;
lookup:
lda dosflg ;[59] prodos?
beq looku1 ;[59] no
jsr filenf ;[86] fix up file name
jsr prodos ;[59] get file info
.byte gfilin ;[59]
.word gsinfo ;[59] get/set par list
bcc looku2 ;[59] we got this file name
cmp #nofile ;[59] did we get the nofile ans?
beq locfnf ;[59] yes
ldx fcb1 ;[85] lets check for a leading alpha
cpx #'A ;[85]
blt looku0 ;[85] no, make it an A
cpx #'Z+1 ;[85]
blt looku7 ;[85] yes, a leading alpha
;[87]looku0 ldx #'A ;[85]
looku0 ldx #'X ;[87]
stx fcb1 ;[85] make it alpha
jmp lookup ;[85]
looku7 ;[85]
jsr perror ;[59] sigh
looku1 ;[59]
;[84] jsr lookop ;[60] Go move in default slot and drive
lda #fncopn ;[84] open
; sta doscmi ;[84] so init will set x non 0 properly
jsr initpo ;[84] set the parameters up
;[84] lda #fcb1\ ; Get the address of the filename buffer
;[84] sta fnadrl ; and stuff it where it will be found
;[84] lda #fcb1^ ; by the 'locate' routine
;[84] sta fnadrh ; ...
;[84] jsr locent ; Go try to locate that file
ldx #1 ;[84] make it non 0 so no file allocation
jsr dosfmg ;[84] use the file manager, hope we dont need close
bcs locfnf ; File not found? We are in good shape
lda #errfae ; Store the error code
sta errcod ; ...
looku2 jmp rskp ; Return with skip, we have to alter filename
locfnf: rts ; Return without a skip
;[84]lookop lda defdrv ;[60] default drive
;[84] sta cdisk ;[60] fmgr parm list
;[84] lda defslt ;[60] slot
;[84] sta cslot ;[60]
;[84] lda defvol ;[60] volume number
;[84] sta cvol ;[60]
;[84] ldx #fncopn ;[60] open for fmgr
;[84] stx opcod ;[60] into param list
;[84] stx doscmi ;[60] tell it to ignore file type
;[84] jsr dosfmn ;[60] fmgr
;[84] jsr dosfmg ;[84] x non 0 is what we want
;[84] rts ;[60] return
;
; 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.
;
alterp ;[59]
ldy nfcb1 ;[59] get # chs in name
cpy #mxpfn-2 ;[59] <=12 chs
bmi altera ;[59] yes there is room for our 3 chs
;[86] lda #'/+$80 ;[59] look for start of file name
lda #'/ ;[86] look for start of file name
alter2 cmp fcb1-1,y ;[59] got the start?
beq alter4 ;[59] yes
dey ;[59] no
bne alter2 ;[59] try again
jmp alterc ;[59] we are at the start
alter4 sty kwrk01 ;[59] now find the size of the file name
lda nfcb1 ;[59] first the # chs in path
sec ;[59] necessary for subtract
sbc kwrk01 ;[59] now we have the size of the name
cmp #mxpfn-2 ;[59] room for version?
bpl alterc ;[59] no
ldy nfcb1 ;[59]
cpy #mxppth-2 ;[59] room in the path ?
bmi altera ;[59] yes
cmp #4 ;[59] <=3 chs in filename?
bmi altng ;[59] yes we cant do it
alterc jsr dbloc ;[59] position screen for debug area
ldx #erms1e\ ;[59] tell we have to change tail of filename
ldy #erms1e^ ;[59]
;[79] jsr prstr ;[59]
;[79] jsr prcrlf ;[59]
jsr prstrl ;[79]
ldy nfcb1 ;[59] # chs in name
dey ;[59] now ready for
dey ;[59] the modification
dey ;[59]
jmp altigy ;[59]
altera ;[59]
tya ;[59] save this
iny ;[59] tell prodos about more chs
iny ;[59]
iny ;[59]
sty nfcb1 ;[59] now you have +3
tay ;[59] restore original pointer
alter6 ;[59] null terminate string
jmp altigy ;[59]
;[84]alterf: jsr movdds ;[40] Go move in default slot and drive
alterf ;[84]
lda dosffm ; Get the 'first mod' flag
;[59] cmp #on ; Is it on?
beq altsm ; If it is, do an initial modification
;[59] jmp altsm ; Otherwise, just increment the version
lda #off ; Shut the 'first mod' flag off
sta dosffm ; ...
lda dosflg ;[59]prodos?
bne alterp ;[59] yes
ldy #mxfnl ; Stuff the maximum filename length in y
altgnc: lda fcb1,y ; Get the character from the buffer
cmp #hspace ; Is it a space?
bne altco ; If not, we can continue with the alteration
dey ; Down the index once
bpl altgnc ; Get the next character
ldy #$00 ; There is no filename, so use 0 as the index
altco: sty dosfni ; Save the filename index
iny ; Increment it twice
iny ; ...
cpy #mxfnl ; Does this exceed the filename length?
bpl altng ; Cannot do the alterations
;[59] ora #$80 ; Make it negative ascii
ldy dosfni ; Get the original index back
iny ; Up it once
altigy lda #'.+$80 ; [59]Get the dot
sta fcb1,y ; Store the dot
lda #$00 ; Zero the version count
sta dosfvn ; ...
iny ; Up the index again
sty dosfni ; This will be saved for future alterations
jsr altstv ; Go store the version in the filename
iny ;[66] got to keep count correct
sty nfcb1 ;[66]
rts ; and return
altsm: inc dosfvn ;[59] Get the file version number
;[59] inx ; Increment it
ldx dosfvn ;[59] Save the new version number
beq altng ; Cannot alter name
txa ; Get the version number in the AC
jsr altstv ; Go store the version
rts ; And return
altng: lda #$09 ; Store the error code
sta errcod ; ...
ldx kerosp ; Get the old stack pointer
txs ; and restore it
jmp kermit ; Go back to top of loop
filenf ldy #0 ;[86] lets fix the file name
altfix lda fcb1,y ;[86] with legal characters
and #$7f ;[86] drop high bits for prodos
cmp #'. ;[86] one sp ch, the period
beq altok ;[86] its ok
cmp #'0 ;[86] now for numbers
blt alterr ;[86] malo fix this one
cmp #'9+1 ;[86]
blt altok ;[86] its a number
;[87] and #$df ;[86] now upper case all the rest must
cmp #'A ;[86] be alpha
blt alterr ;[86] malo
cmp #'Z+1 ;[86]
blt altok ;[86] its alpha
cmp #'a ;[87] be alpha
blt alterr ;[87] malo
cmp #'z+1 ;[87]
blt altok ;[87] its alpha
;[87]alterr lda #'. ;[86] replace illegal ch
alterr lda #'X ;[87] replace illegal ch
;[87]altok sta fcb1,y ;[86] now replace this ch in case it changed
sta fcb1,y ;[87] now replace this ch
altok ;[87] keep lower case
iny ;[86] now
cpy nfcb1 ;[86] check the end
bne altfix ;[86] theres more
rts ;[86]
;
; Altstv - stores the version number passed to it into the filename
; buffer at whatever position dosfni is pointing to.
;
altstv: ldy dosfni ; Get the filename index
pha ; Save the value
lsr a ; Shift out the low order nibble
lsr a ; ...
lsr a ; ...
lsr a ; ...
jsr altstf ; Stuff the character
pla ; Grab back the original value
and #$0f ; Take the low order nibble
iny ; Increment the filename index
jsr altstf ; Stuff the next character
rts ; and return
altstf: ora #$b0 ; Make the character printable
cmp #$ba ; If it is less than '9'
bcc altdep ; then go depisit the character
adc #$06 ; Put the character in the proper range
altdep: sta fcb1,y ; Stuff the character
rts ; and return
;
; Closef - closes the file which was open for transfer. If it was
; an output file, it will go write the last buffer if neccessary.
;
closef
ldx dosflg ;[59] is this prodos?
beq closep ;[59] no
tax ;[59] were there errors?
bne close3 ;[59] yes
jsr clowlb ;[59] empty out the buffer
jsr prodos ;[59] set eof
.byte getmk ;[59]
.word pmark ;[59] par list
bcc .+5 ;[59] any good?
jsr perror ;[59] no sigh
jsr prodos ;[59] now ste eof
.byte seteof ;[59] with the mark
.word pmark ;[59] par list
bcc .+5 ;[59] error?
jsr perror ;[59] yes sigh
close3 jsr prodos ;[59] finally close it
.byte clofl ;[59]
.word pclose ;[59]
bcc .+5 ;[59]
jsr perror ;[59]
lda #true ;[59] give a good return
rts ;[59]
closep ;[59]
;[84] jsr movdds ;[40] Go move in default slot and drive
cmp #$00 ; If there were errors
bne clonlb ; don't write the last buffer
jsr clowlb ; Otherwise, write last buffer if non-empty
;[84]clonlb: ldy #$00 ; Clear index
;[84]clomfn: lda fcb1,y ; Move the filename to the primary filename
;[84] ora #$80 ;[19] buffer in negative ascii format
;[84] cmp #$80 ;[19] Was the character null?
;[84] bne cloms ;[19] If it wasn't, move it in.
;[84] lda #hspace ;[19] Otherwise, replace it with a space
;[84]cloms: sta primfn,y ;[19] format
;[84] iny ; Increment the buffer index once
;[84] cpy #mxfnl+1 ; Done?
;[84] bpl clofil ; If so, go close the file
;[84] jmp clomfn ; Continue to move the filename in
;[84]clofil: lda filmod ; Fetch the file type
;[84] jsr dosclo ; Close it
clonlb lda #fncclo ;[84]
sta doscmi ;[84] non 0
jsr initfm ;[84] now init fm and close
lda #true ; If we return to here, the close worked
rts
clowlb: lda dsbind ; Get the index
beq clowlr ; Nothing in buffer, just return
lda dosflg ;[59] is this prodos
beq clowl1 ;[59] no
lda dsbind ;[59] number of bytes in buffer
sta prdwr+4 ;[59] only lsb since size<256
jsr prodos ;[59] write out the last
.byte wrfil ;[59]
.word prdwr ;[59]
bcc .+5 ;[59]
jsr perror ;[59]
rts ;[59]
clowl1 ;[59]
lda #fncwrt ; Get the 'write' function code
sta opcod ; and stuff it in the file manager parms
lda #$00 ; Make the range length
sta rnglnh ; look like the buffer length less one
;[84] dec dsbind ; ...
;[84] lda dsbind ; ...
;[84] sta rnglnl ; ...
ldx dsbind ;[84]
dex ;[84]
stx rnglnl ;[84]
lda #sfntrn ; Subfunction is 'transfer range' of bytes
sta subcod ; ...
lda #dosbuf\ ;[3] Load the address of the DOS buffer
sta fnadrl ;[3] into the appropriate location in the
;[84] lda #dosbuf^ ;[3] file manager parameter list.
;[84] sta fnadrh ;[3] ...
;[84] jsr dosfmn ; Call the file manager
ldx #dosbuf^ ;[84] file manager parameter list.
stx fnadrh ;[84] x must be non 0 ...
jsr dosfmg ;[84] Call the file manager
bcc clowlr ;[84] no error
;[85] lda fmrcod ;[84] Get the return code
;[84] cmp #dsener ; No errors?
;[84] beq clowlr ; No errors, return
;[85] ora #$80 ; Set H.O. bit since it is a DOS error
;[85] sta errcod ; Store that
jmp nonftl ;[85]
clowlr: rts ; Return
;
; Bufill - takes characters from the file, does any neccesary quoting,
; and then puts them in the packet data buffer. It returns the size
; of the data in the AC. If the size is zero and it hit end-of-file,
; it turns on eofinp.
;
bufill: lda #$00 ; Zero
sta lgfcol ;[87] needed for fgetc get filename
sta datind ; the buffer index
bufil1: jsr fgetc ; Get a character from the file
jmp bffchk ; Go check for actual end-of-file
sta kerchr ; Got a character, save it
lda dosflg ;[59] prodos?
bne bufceb ;[59] yes, we have a good byte
lda filmod ;[6] Get the file-type
beq bufcet ;[6] Text file, go check for end of text
;[87] sec ;[6] Set the carry for subtraction
;[87] lda fillen ;[6] Get the remaining file length
;[87] sbc #$01 ;[6] Decrement it once
;[87] sta fillen ;[6] Put it back
;[87] lda fillen+1 ;[6] Do the High order byte
;[87] sbc #$00 ;[6] ...
;[87] sta fillen+1 ;[6] ...
;[87] cmp #$ff ;[6] Did this just go below zero?
;[59] beq bufcfl ;[6] If so, check the low order byte
;[59] jmp bufceb ;[6] Otherwise, continue filling buffer
;[87] bne bufceb ;[59] no
;[87]bufcfl: lda fillen ;[6] Get the low order byte of the file length
;[87] cmp #$ff ;[6] If this is also -1 we are at eof
;[87] bne bufceb ;[6] No, continue processing
dec fillen ;[87] see if were thru
lda #$ff ;[87] did we carry on lsb
cmp fillen ;[87]
bne bufceb ;[87] not thru so carry on
dec fillen+1 ;[87] how about msb
cmp fillen+1 ;[87]
bne bufceb ;[87] not thru so carry on
ldx dsbend ;[6] Make sure fgetc fails next time through
stx dsbind ;[6] and shows eof.
lda #on ;[6] Set the end-of-data flag on
sta eodind ;[6] ...
jmp bffret ;[6] Go return with the length of the buffer
bufcet: lda kerchr ;[6] Get the character
and #$7f ;[6] Make sure we are only working with 7-bits
bne bufceb ;[6] If it's not null, there's still more text
ldx dsbend ;[6] Otherwise, make sure fgetc fails and
stx dsbind ;[6] returns eof next time
jmp bffchk ;[6] Go return with the buffer length
;[81]bufceb: lda ebqmod ; Check if 8-bit quoting is on
bufceb: jsr ctrlck ;[81] controlify if necessary
;[59] cmp #on ; ...
;[59] beq bufil2 ; If it is, see if we have to use it
;[59] jmp bffqc ; Otherwise, check normal quoting only
;[81] beq bffqc ;[59] check normal quoting only
;[81]bufil2: lda kerchr ; Get the character
;[72] and #$80 ; Mask everything off but H.O. bit
;[72] beq bffqc ; H.O. bit was not on, so continue
;[81] bpl bffqc ;[72]
;[81] lda sebq ; H.O. bit was on, get 8-bit quote
;[81] ldy datind ; Set up the data index
;[81] sta (kerbf1),y ; Stuff the quote character in buffer
;[81] iny ; Up the data index
;[81] sty datind ; And save it
;[81] lda kerchr ; Get the original character saved
;[81] and #$7f ; Shut H.O. bit, we don't need it
;[81] sta kerchr ; ...
;[81]bffqc: lda kerchr ; Fetch the character
;[81] and #$7f ;[2] When checking for quoting, use only 7 bits
; bpl bffqc0 ;[2] If >0, check against space w/o H.O. bit on
; cmp #hspace ;[2] Greater than space (H.O. bit on)
; bpl bffqc1 ;[2] If so, no quoting needed
; jmp bffctl ;[2] Check next possibility
;[81]bffqc0: cmp #sp ; Is the character less than a space?
;[81] bpl bffqc1 ; If not, try next possibility
;[81] ldx filmod ;[8] Get the file-type
;[81] bne bffctl ;[8] If it is not text, ignore <cr> problem
;[81] cmp #cr ;[8] Do we have a <cr> here?
;[81] bne bffctl ;[8] Nope, continue processing
;[81] ldx #on ;[8] Set flag to add a <lf> next time through
;[81] stx addlf ;[8] ...
;[81] jmp bffctl ; This has to be controlified
;[81]bffqc1: cmp #del ; Is the character a del?
;[81] bne bffqc2 ; If not, try something else
;[81] jmp bffctl ; Controlify it
;[81]bffqc2: cmp squote ; Is it the quote character?
;[81] bne bffqc3 ; If not, continue trying
;[81] jmp bffstq ; It was, go stuff a quote in buffer
;[81]bffqc3: lda ebqmod ;[11] Is 8-bit quoting turned on?
;[72] cmp #on ;[11] ...
;[72] bne bffstf ;[11] If not, skip this junk
;[81] beq bffstf ;[72]
;[81] lda kerchr ;[11] otherwise, check for 8-bit quote char.
;[81] cmp sebq ; Is it an 8-bit quote?
;[81] bne bffstf ; Nope, just stuff the character itself
;[81] jmp bffstq ; Go stuff a quote in the buffer
;[81]bffctl: lda kerchr ;[2] Get original character back
;[81] eor #$40 ; Ctl(AC)
;[81] sta kerchr ; Save the character again
;[81]bffstq: lda squote ; Get the quote character
;[81] ldy datind ; and the index into the buffer
;[81] sta (kerbf1),y ; Store it in the next location
;[81] iny ; Up the data index once
;[81] sty datind ; Save the index again
;[81]bffstf: inc schr ; Increment the data character count
;[81] bne bffsdc ; ...
;[81] inc schr+1 ; ...
;[81]bffsdc: lda kerchr ; Get the saved character
;[81] ldy datind ; and the data index
;[81] sta (kerbf1),y ; This is the actual char we must store
;[81] iny ; Increment the index
;[81] sty datind ; And resave it
;[81] tya ; Take this index, put it in AC
;[81] clc ; Clear carry for addition
;[81] adc #$06 ; Adjust it so we can see if it
;[81] cmp spsiz ; is >= spsiz-6
;[75] bpl bffret ; If it is, go return
bcs bffret ;[75] 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
;
; controlify ch if necessary
;
; destroys a,y
;
ctrlch sta kerchr ;[81] alternate entry
lda #true ;[81] this is for text only
bne ctrlci ;[81]
ctrlck: lda #false ;[81] check file type
ctrlci sta kwrk02 ;[81]
lda prtcl ;[83] xmodem
beq ctrlcj ;[83] no
lda kerchr ;[83]
jmp ctrqc4 ;[83] yes
ctrlcj ;[83]
lda ebqmod ;[81] Check if 8-bit quoting is on
beq ctrqc ;[81] check normal quoting only
lda kerchr ;[81] Get the character
bpl ctrqcb ;[81]
lda sebq ;[81] H.O. bit was on, get 8-bit quote
ldy datind ;[81] Set up the data index
sta (kerbf1),y ;[81] Stuff the quote character in buffer
iny ;[81] Up the data index
sty datind ;[81] And save it
lda kerchr ;[81] Get the original character saved
and #$7f ;[81] Shut H.O. bit, we don't need it
sta kerchr ;[81] ...
ctrqc: lda kerchr ;[81] Fetch the character
ctrqcb and #$7f ;[81] When checking for quoting, use only 7 bits
ctrqc0: cmp #sp ;[81] Is the character less than a space?
bpl ctrqc1 ;[81] If not, try next possibility
ldy kwrk02 ;[81]
bne ctrqca ;[81] is this text only, yes
ctrqc4 ;[83]
ldy filmod ;[81] Get the file-type
bne ctrctl ;[81] If it is not text, ignore <cr> problem
ldy xcrlf+1 ;[84] check for send xlate cr<->cr,lf
beq ctrctl ;[84] its off
ctrqca cmp #cr ;[81] Do we have a <cr> here?
bne ctrctl ;[81] Nope, continue processing
sta addlf ;[81] ...
beq ctrctl ;[81] This has to be controlified
;[83]ctrqc1: cmp #del ;[81] Is the character a del?
ctrqc1: ;[83]
;[84] ldy prtcl ;[83] xmodem?
;[84] bne ctrstf ;[83] yes
cmp #del ;[81] Is the character a del?
;[83] bne ctrqc2 ;[81] If not, try something else
;[83] jmp ctrctl ;[81] Controlify it
beq ctrctl ;[83][81] Controlify it
ctrqc2: cmp squote ;[81] Is it the quote character?
bne ctrqc3 ;[81] If not, continue trying
jmp ctrstq ;[81] It was, go stuff a quote in buffer
ctrqc3: lda ebqmod ;[81] Is 8-bit quoting turned on?
beq ctrstf ;[81]
lda kerchr ;[81] otherwise, check for 8-bit quote char.
cmp sebq ;[81] Is it an 8-bit quote?
bne ctrstf ;[81] Nope, just stuff the character itself
;[87] jmp ctrstq ;[81] Go stuff a quote in the buffer
beq ctrstq ;[87] Go stuff a quote in the buffer
;[83]ctrctl: lda kerchr ;[81] Get original character back
ctrctl: ;[83]
lda prtcl ;[83] xmodem?
bne ctrstf ;[83] yes
lda kerchr ;[83] Get original character back
eor #$40 ;[81] Ctl(AC)
sta kerchr ;[81] Save the character again
ctrstq: lda squote ;[81] Get the quote character
ldy datind ;[81] and the index into the buffer
sta (kerbf1),y ;[81] Store it in the next location
iny ;[81] Up the data index once
sty datind ;[81] Save the index again
ctrstf: inc schr ;[81] Increment the data character count
bne ctrsdc ;[81] ...
inc schr+1 ;[81] ...
bne ctrsdc ;[84] larger size
inc schr+2 ;[84]
ctrsdc: lda kerchr ;[81] Get the saved character
ldy datind ;[81] and the data index
sta (kerbf1),y ;[81] This is the actual char we must store
iny ;[81] Increment the index
sty datind ;[81] And resave it
tya ;[81] Take this index, put it in AC
ldy prtcl ;[83] xmmodem?
beq ctrsd3 ;[83] no
cmp #sfxmd ;[83] all the data?
rts ;[83]
ctrsd3 ;[83]
clc ;[81] Clear carry for addition
adc #$06 ;[81] Adjust it so we can see if it
cmp spsiz ;[81] is >= spsiz-6
rts ;[81]
bffchk:
lda dosflg ;[59] prodos?
beq bufil4 ;[59] no
lda eofinp ;[59] eof?
beq bufil4 ;[59] no
sta eodind ;[59] yes, set end of data
lda #0 ;[59] and reset eof
sta eofinp ;[59] so fgetc likes it
bufil4 ;[59]
lda datind ; Get the data index
; cmp #$00 ; Is it zero?
bne bffne ; Nope, just return
ldy #true ;[59] yes we have eof
sty eofinp ;[59]
;[59] tay ; Yes, this means the entire file has
;[59] lda #true ; been transmitted so turn on
;[59] sta eofinp ; the eofinp flag
;[59] tya ; Get back the size of zero
bffne: rts ; Return
;
; Bufemp - takes a full data buffer, handles all quoting transforms
; and writes the reconstructed data out to the file using calls to
; FPUTC.
;
abufmt ldy #true ;[81]
bne bfet7 ;[81] say this is a text process
;[81]bufemp: lda #$00 ; Zero
bufemp: ldy #false ;[81]
bfet7 sty putcut ;[81] the flag
lda #$00 ; Zero
sta datind ; the data index
bfetol: lda datind ; Get the data index
cmp pdlen ; Is it >= the packet data length?
;[75] bmi bfemor ; No, there is more to come
bcc bfemor ;[75] 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
ldy prtcl ;[83] xmodem
bne bfeout ;[83] yes
cmp rebq ; Is it the 8-bit quote?
bne bfeqc ; No, go check for normal quoting
lda ebqmod ; Is 8-bit quoting on?
;[72] cmp #on ; ...
;[72] bne bfeout ; No quoting at all, place char in file
;[72] lda #true ; Set H.O.-bit-on flag to true
beq bfeout ;[72] quoting? no
sta chebo ; ...
inc datind ; Increment the data index
ldy datind ; Fetch it into Y
lda (kerbf1),y ; Get the next character from buffer
sta kerchr ; Save it
bfeqc: cmp rquote ; Is it the normal quote character
bne bfeceb ; No, pass this stuff up
inc datind ; Increment the data index
ldy datind ; and fetch it in the Y-reg
lda (kerbf1),y ; Get the next character from buffer
sta kerchr ; Save it
and #$7f ;[2] Check only 7 bits for quote
cmp rquote ; Were we quoting a quote?
beq bfeceb ; Yes, nothing has to be done
cmp rebq ;[2] Check for eight-bit quote char as well
beq bfeceb ;[2] Skip the character adjustment
lda kerchr ;[2] Fetch back the original character
eor #$40 ; No, so controlify this again
sta kerchr ; Resave it
bfeceb: lda chebo ; Is the H.O.-bit-on flag lit?
;[59] cmp #true ; ...
;[59] bne bfeout ; Just output the character to the file
beq bfeout ;[59]
lda kerchr ; Fetch the character
ora #$80 ; Light up the H.O. bit
sta kerchr ; Resave it
;[81]bfeout: lda filmod ;[8] Check if this is a text file
bfeout: lda putcut ;[81] is this a text process?
bne bfeou7 ;[81] yes
; lda ascii ;[82]
; bne bfeou7 ;[82] is this 7bit text, yes
lda filmod ;[8] Check if this is a text file
bne bfefpc ;[8] If not, continue normal processing
lda dosflg ;[82]
beq bfeou7 ;[82]
lda kerchr ;[82] prodos text uses 8 bits
jmp bfeou9 ;[82]
bfeou7 ;[81]
lda kerchr ;[8] Get a copy of the character
and #$7f ;[8] Make sure we test L.O. 7-bits only
bfeou9 ;[82]
ldx xcrlf ;[84] should we xlate cr<->cr,lf
beq bfefpc ;[84] no, its off
cmp #cr ;[8] Do we have a <cr>?
bne bfeclf ;[8] No, then check for <lf>
;[81] lda #on ;[8] Yes, set the 'Delete <lf>' flag
sta dellf ;[8] ...
;[81] jmp bfefpc ;[8] And then continue
beq bfefpc ;[81] And then continue
bfeclf: cmp #lf ;[8] Do we have a <lf>?
bne bfenlf ;[8] Nope, We must go shut the Dellf flag.
lda dellf ;[8] We have a <lf>, is the flag on?
;[81] cmp #on ;[8] ...
;[81] bne bfefpc ;[8] If not, continue normally
beq bfefpc ;[81] If not, continue normally
lda #off ;[8] Flag is on, <lf> follows <cr>, ignore it
sta dellf ;[8] Start by zeroing flag
;[81] jmp bfeou1 ;[8] Now go to end of loop
beq bfeou1 ;[81] Now go to end of loop
bfenlf: lda #off ;[8] Zero Dellf
sta dellf ;[8] ...
bfefpc: lda kerchr ;[8] Get the character once more
ldy putcut ;[81] is this a text process?
beq bfefp7 ;[81] no
ora #$80 ;[81] neg ascii
jsr cout ;[81]
; jsr keyprs ;[85] allow them to hold screen
jmp bfeou1 ;[81] next
bfefp7 ;[81]
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 ; ...
bne bfeou1 ;[84] larger size
inc rchr+2 ;[84]
bfeou1: inc datind ; Up the buffer index once
jmp bfetol ; Return to the top of the loop
bfeerr: sta errcod ; Store the erro code where it belongs
and #$7f ; Shut off H.O. bit
tay ; Save the error code here
lda #kerdel ; Get the disk error message length
pha ; Push that parameter
dey ; Decrement the error code twice to make
dey ; it correct for the disk error table
tya ; Fetch it back
pha ; Push that as an argument to genmad
lda #dskers\ ; Get L.O. byte of base address
sta kermbs ; and stuff it where it is expected
lda #dskers^ ; Do the same for the H.O. byte address
sta kermbs+1 ; ...
jsr genmad ; Genereate the message address
jsr prstr ; Go print that error message
lda #false ; Indicate failure
getnf7 ;[81]
rts ; and return
;
; Getnfl - returns the next filename to be transferred. Currently
; it always return true/false to indicate there are no other files to
; process.
;
;[81]getnfl: lda #eof ; No more files (return eof)
getnfl: lda wcpres ;[81] is this wildcd search?
beq getnf7 ;[81] no quit
lda #0 ;[81] start from 0
sta gfcol ;[81] collumn
sta lgfcol ;[81] last non blank col in filename
sta match ;[81] assume no wildcd
sta catlin ;[81] current line in the catalog
sta stix ;[81] init stack pointer
sta kersft ;[81] init real dos 3.3 flag
ldx #gfcout\ ;[81] and give our cout routine
ldy #gfcout^ ;[81]
jsr svcout ;[81]
lda catext ;[81] interupt the catalog return
pha ;[81]
lda #$60 ;[81] and make it rtn from jsr
sta catext ;[81]
lda dosflg ;[81]
bne getnf3 ;[81] if dos 3.3
lda dosrdk ;[81] got to disable
cmp #$20 ;[81] test for jsr
beq getnf2 ;[81] is this 3.3?, yes
inc kersft ;[81] its not vanila
ldx #erms1m\ ;[81] now tatle
ldy #erms1m^ ;[81]
jsr prstr ;[81]
jsr prcrlf ;[81]
jmp getnf3 ;[81] ought to be interesting
getnf2 ;[81]
pha ;[81] the pause
lda dosrdk+1 ;[81] in catalog
pha ;[81]
lda dosrdk+2 ;[81]
pha ;[81]
lda #$ea ;[81] this is
sta dosrdk ;[81] a nop
sta dosrdk+1 ;[81]
sta dosrdk+2 ;[81]
getnf3 ;[81]
lda #fcb1\ ;[81] setup name for wildcd
sta name ;[81]
lda #fcb1^ ;[81]
sta name+1 ;[81]
lda #patbuf\ ;[81] setup patern for wildcd
sta pat ;[81]
lda #patbuf^ ;[81]
sta pat+1 ;[81]
jsr catlog ;[81] this should activate our cout proc
lda dosflg ;[81] restore dos read key call?
bne getnf5 ;[81] no
lda kersft ;[81] really?
bne getnf5 ;[81] no
pla ;[81] restore the wait for keypress
sta dosrdk+2 ;[81]
pla ;[81]
sta dosrdk+1 ;[81]
pla ;[81]
sta dosrdk ;[81]
getnf5 ;[81]
pla ;[81] first restore all
sta catext ;[81] the exits
jsr rscout ;[81]
lda nfcb1 ;[81] is this the end of catalog
beq getnf8 ;[81] yes, same as no match
lda match ;[81] now did we get a match?
getnf8 ;[81]
rts
svcout pla ;[81] get around the return
sta svcour+1 ;[81] and save on the stack
pla ;[81]
sta svcour+2 ;[81]
lda cswl ;[81]
pha ;[81] save the current cout entry
lda cswh ;[81]
pha ;[81]
stx cswl ;[81]
sty cswh ;[81]
inc svcour+1 ;[81] now fix up the return
bne svcour ;[81]
inc svcour+2 ;[81]
svcour jmp $ffff ;[81]
rscout pla ;[81]
sta rscour+1 ;[81]
pla ;[81] get around the return
sta rscour+2 ;[81]
pla ;[81]
sta cswh ;[81] restor cout address
pla ;[81]
sta cswl ;[81]
inc rscour+1 ;[81]
bne rscour ;[81]
inc rscour+2 ;[81]
rscour jmp $ffff ;[81]
gfcout pha ;[81] save regs
sta kwrk01 ;[81] we will need this shortly
lda match ;[81]
bne gfco33 ;[81] have we found one already? yes
txa ;[81]
pha ;[81]
tya ;[81]
pha ;[81] regs saved
lda kwrk01 ;[81] now what did we get?
and #$7f ;[81] make sure its ascii
cmp #cr ;[81]
beq gfcou7 ;[81] end of line, now process it
inc gfcol ;[81] bump col number
ldy gfcol ;[81]
ldx dosflg ;[81] which op system
bne gfco10 ;[81] its prodos
cpy #8 ;[81] before the start of the name?
bcs gfcou3 ;[81] no
gfcou2 ldx #0 ;[81] setup start of search
stx nfcb1 ;[81]
beq gfco30 ;[81] and exit
gfcou3 cpy #38 ;[81] are we past the name?
bcs gfco30 ;[81] yes
gfcou5 ldy nfcb1 ;[81]
sta fcb1,y ;[81] save the filename
sta dosbuf,y ;[87] need it both places
;[87] inc nfcb1 ;[81] keep track of the count
iny ;[87]
sty nfcb1 ;[87]
sty getfln ;[87]
cmp #sp ;[81] do we have a space
beq gfco30 ;[81] yes, may be trailing spaces
;[87] iny ;[81] save the current size
sty lgfcol ;[81] in case its last non blank
gfco30 pla ;[81] restore regs
tay ;[81]
pla ;[81]
tax ;[81]
gfco33 pla ;[81]
rts ;[81] thats all folks
gfco10 ;[81] now for prodos
cpy #2 ;[81] how about the start
bcc gfcou2 ;[81] not yet
cpy #17 ;[81] past the filename?
bcs gfco30 ;[81] yes
bcc gfcou5 ;[81] handle this character
gfcou7 inc catlin ;[81] count lines
lda lgfcol ;[81] first calculate the actual filename length
sta nfcb1 ;[81]
sta getfln ;[87] need it hr also
lda #0 ;[81]
sta lgfcol ;[81]
sta gfcol ;[81]
lda filect ;[81] are we skipping files
cmp catlin ;[81]
bcs gfco30 ;[81] yes
lda nfcb1 ;[81]
bne gfcou8 ;[81] end of catalog?
lda dosflg ;[86] maybe, wish the catalog listing was consistent
beq gfcou6 ;[86] maybe dos is consistant
lda catlin ;[86]
cmp #7 ;[86] Must be coordinated with sfilec *********
beq gfco30 ;[86] is this blank line before catalog listing, yes
gfcou6 ;[86]
inc match ;[81] just so we skip the rest
bne gfco30 ;[81] always branch
gfcou8 jsr wildcd ;[81] ought to be interesting
beq gfco30 ;[81] match? no
lda catlin ;[81] save this line number
sta filect ;[81]
jmp gfco30 ;[81]
;***************************************************************
;
; PART 5: CHECKING CATALOG ENTRY FOR WILDCARD MATCH
;
; This routine calls itself recursively with varying
; approaches to selecting the version of pattern and
; name to be used in the next recursion. It saves
; the start addresses and lengths of the current name
; and pattern on a bottomless stack which starts at
; the end of kermit's com routine.
; As far as I know, this is a robust
; routine--literally anything matching the multiple
; and single tokens will generate a match decision.
;
;***************************************************************
;
.SBTTL Where the action is
wildcd lda fnl ;[81]Do we still have a fname?
bne wldc04 ;[81]
lda patl ;[81]NO NAME, do we have pattern?
beq suceed ;[81]OK! NAME and PATTERN ran out simultaneously
ldy #$00 ;[81]No name but have pattern--OK as long as only
wldc03 lda (pat),y ;[81] chars left in pattern are multi-wild-cards
cmp #wcmult ;[81]
bne fail ;[81]There's a non-multi-wild card--fail!
iny ;[81]Still OK -- check next pattern char
cpy patl ;[81] (if any are left)
bmi wldc03 ;[81]
bpl suceed ;[81]Only multi wild cards, we're OK
wldc04 lda patl ;[81]HAVE NAME, do we have pattern?
beq fail ;[81]Pattern ran out before name, failure
ldy #$00 ;[81]HAVE NAME and PATTERN--
lda (pat),y ;[81] the pattern determines next step
cmp #wcsing ;[81]Is it a single-char wildcard?
beq wldc05 ;[81]If so, call it a match.
cmp #wcmult ;[81]Is it a multiple-char wildcard?
beq wldc06 ;[81] If so, check that situation out.
cmp (name),y ;[81]If not, PATTERN FIXED: does it match name?
bne fail ;[81]MISMATCH IN FIXED PATTERN: branch has failed
wldc05 lda #remnp ;[81]MATCH IN FIXED PATTERN: try the remainder of
jsr recurs ;[81] the pattern on the remainder of the name
jmp pasbak ;[81]No more options--pass success/failure back
wldc06 lda #remnp ;[81]WILDCARD CHAR: try the remainder of the pattern
jsr recurs ;[81] on the remainder of the name
lda match ;[81]Did it work?
beq wldc07 ;[81]
jmp pasbak ;[81]MATCH! somewhere out there it did.
wldc07 lda #samef ;[81]No match--try defining wild card as NO chars:
jsr recurs ;[81] strip it from PATT and apply to current name
lda match ;[81]Did this work?
beq wldc08 ;[81]
jmp pasbak ;[81]MATCH! The no-char wild-card worked.
wldc08 lda fnl ;[81]No match--we will next try expanding the role
cmp #$01 ;[81] of the wildcard by using the same pattern on
beq pasbak ;[81] the REST of the name, if the REST exists.
lda #samep ;[81]Keep the initial wildcard
jsr recurs ;[81] and attack the rest of the name.
jmp pasbak ;[81]Maybe it worked, maybe not--pass results back
suceed lda #true ;[81]
bne return ;[81]
fail lda #false ;[81]
return sta match ;[81]If a final result was obtained, set it
pasbak rts ;[81] passing back the results
;
.SBTTL Check whether the pattern any fixed chars left
chkpat ldy #$00 ;[81]We're at the end of the name. If there are
chkpt1 lda (pat),y ;[81] any fixed chars left in pattern, match fails.
cmp #wcmult ;[81]
bne chkpt2 ;[81]A non-wildcard! fail!
iny ;[81]Wild, get another
cpy patl ;[81]
bmi chkpt1 ;[81]
lda #true ;[81]Only wild cards, OK
jmp return ;[81]
chkpt2 lda #false ;[81]Failed
jmp return ;[81]
;
.SBTTL Do the recursion
recurs sta wchpat ;[81]Note whether full pattern or remainder of patrn
;[85] jsr setrec ;[81]Save the current values of parameters
lda fnl ;[85]File name parms
pha ;[85] ;
lda name ;[85]
pha ;[85]
lda name+1 ;[85]
pha ;[85]
lda patl ;[85]Pattern parms
pha ;[85]
lda pat ;[85]
pha ;[85]
lda pat+1 ;[85]
pha ;[85]
jsr nxtprm ;[81]Set the values to be passed in recursion
jsr wildcd ;[81]Do the recursion
;[85] jsr clrrec ;[81]Recover original values
pla ;[85]
sta pat+1 ;[85]
pla ;[85]
sta pat ;[85]
pla ;[85]
sta patl ;[85]
pla ;[85]
sta name+1 ;[85]
pla ;[85]
sta name ;[85]
pla ;[85]
sta fnl ;[85]
rts ;[81]
;
.SBTTL Prepare the version of name and pattern for next recurs
nxtprm lda wchpat ;[81]Do we want to change either NAME or PATTERN?
bmi nxtpr1 ;[81]SAMEF says leave fname alone
dec fnl ;[81]Otherwise, knock one off the start of the name
inc name ;[81]
bne nxtpr1 ;[81]
inc name+1 ;[81]
nxtpr1 lda wchpat ;[81]Are we going with same or remaining pattern?
beq nxtpr2 ;[81]SAMEP says leave pattern alone
dec patl ;[81]Otherwise, take CDR
inc pat ;[81]
bne nxtpr2 ;[81]
inc pat+1 ;[81]
nxtpr2 rts ;[81]
;
.SBTTL Prepare for recursion--save current values
;[85]setrec lda fnl ;[81]File name parms
;[85] jsr push ;[81]
;[85] lda name ;[81]
;[85] jsr push ;[81]
;[85] lda name+1 ;[81]
;[85] jsr push ;[81]
;[85] lda patl ;[81]Pattern parms
;[85] jsr push ;[81]
;[85] lda pat ;[81]
;[85] jsr push ;[81]
;[85] lda pat+1 ;[81]
;[85] jsr push ;[81]
;[85] rts ;[81] and return there
;
.SBTTL Recover local values of parms after recursion
;[85]clrrec jsr pull ;[81]Pattern parms
;[85] sta pat+1 ;[81]
;[85] jsr pull ;[81]
;[85] sta pat ;[81]
;[85] jsr pull ;[81]
;[85] sta patl ;[81]
;[85] jsr pull ;[81]Filename parms
;[85] sta name+1 ;[81]
;[85] jsr pull ;[81]
;[85] sta name ;[81]
;[85] jsr pull ;[81]
;[85] sta fnl ;[81]
;[85] rts ;[81] and return there
;
.SBTTL Simulated stack routines
;[85]push ldy stix ;[81]
;[85] sta (stack),y ;[81]
;[85] inc stix ;[81]
;[85] bne push1 ;[81]
;[85] inc stack+1 ;[81]
;[85]push1 rts ;[81]
;
;[85]pull dec stix ;[81]
;[85] ldy stix ;[81] we will work up towards end of memory
;[85] cpy #$ff ;[81] did we carry?
;[85] bne pull1 ;[81]
;[85] dec stack+1 ;[81]
;[85]pull1 ;[81]
;[85] lda (stack),y ;[81]
;[85] rts ;[81]
;[86]sfilec ldy #7 ;[81]
sfilec ldy #6 ;[86] Must be coordinated with gfcou6 *******
lda dosflg ;[81] which os
bne .+4 ;[81] prosos
ldy #4 ;[81] dos
sty filect ;[81] line on catalog to start looking for file names
rts ;[81]
;
; 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
;[59] cmp #on ; Is it on
beq getfl1 ; If not, keep what we have in the fcb
sta fgetgn ;[87] tell fputc were filename
jsr clrfcb ;[43] Clear fcb, else things get messed up
ldy #$00 ; Initialize the y reg
sty nfcb1 ;[87] # chs in fcb1
;[87]getfl0: lda (kerbf1),y ; Get a character from the packet buffer
;[87] ora #$80 ; Turn on H.O. bit
;[87] sta fcb1,y ; Stuff it in the fcb
;[87] iny ; Up the index once
;[87] cpy pdlen ; Are we finished?
;[87] bmi getfl0 ; Nope, go do next byte
;[87] sty nfcb1 ;[59] just in case of prodos
jsr bufemp ;[87]empty the buf and let fputc handle
lda #0 ;[87]
sta fgetgn ;[87] turn off fputc
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.
;
;[87]fgetc: lda addlf ;[8] Get the 'add a lf' flag
fgetc: ;[87]
lda fgetgn ;[87] are we getting file name
beq fgetc0 ;[87] no
ldy lgfcol ;[87] are we thru?
inc lgfcol ;[87]
cpy getfln ;[87]
bge getfl1 ;[87] yes
lda dosbuf,y ;[87] it was put here
jmp rskp ;[87] and say we got one
fgetc0 ;[87]
lda addlf ;[87] Get the 'add a lf' flag
beq fgetc1 ;[59] not on
;[59] cmp #on ;[8] Is it on?
;[59] bne fgetc1 ;[8] No, continue with normal processing
lda #off ;[8] Zero the flag first
sta addlf ;[8] ...
;[82] lda #hlf ;[8] Get a <lf>
lda #lf ;[82] Get a <lf>
jmp fgtgn1 ;[8] and return that as the next character
fgetc1: ldx dsbind ;[8] Get the file buffer index
cpx dsbend ; Are we passed the last character?
bpl fgetc2 ;[6] Yes, go read next sector
jmp fgtgnc ;[6] No, get next character
fgetc2: lda eodind ;[6] Check for end-of-data first
beq fgtc2a ;[59] no
;[59] cmp #on ;[6] Is it on?
;[59] bne fgtc2a ;[6] No, go read next sector
fgtc20 jmp fgteof ;[6] It was on so there is no data to read
fgtc2a:
lda dosflg ;[59] prodos?
beq fget22 ;[59] no
jsr prodos ;[59] yes read from file
.byte prdfil ;[59]
.word prdwr ;[59]
beq fget24 ;[59] good read? yes
cmp #peof ;[59] did we get an eof?
beq fgtc20 ;[59] yes
jsr perror ;[59] que passo?
fget24 lda pnrdwr ;[59] get # read
jmp fget33 ;[59] and save some code
fget22 ;[59] do the dos thing
lda #fncrea ;[6] Load the file manager opcode (read)
sta opcod ; ...
lda #$00 ; Make the range length one sector
sta rnglnh ; ...
lda #mxdb-1 ; ...
sta rnglnl ; ...
lda #sfntrn ; Subfunction is transfer 'range of bytes'
sta subcod ; ...
lda #dosbuf\ ; Get the dos buffer and stuff that parm into
sta fnadrl ; DOS' parm list
;[84] lda #dosbuf^ ; ...
;[84] sta fnadrh ; ...
;[84] jsr dosfmn ; Do the read
ldx #dosbuf^ ;[84] ...
stx fnadrh ;[84] x must be non 0 ...
jsr dosfmg ;[84] Do the read
lda fmrcod ; Get the return code
;[84] cmp #dsener ; Do we have an error?
beq fgtset ; If not, go set up the pointers
cmp #dseeod ; Did we hit 'End-of-data'?
beq fgetc3 ;[6] Yes, just handle the eof condition
cmp #dsewpr ;[60]
beq fgetc3 ;[60] we can read a write protected diskette
jmp fgtcan ;[6] No, this is a serious error, fail
fgetc3: lda #mxdb-2 ;[6] If range length returned is 2 less than
sec ; the DOS buffer size we are using
sbc rnglnl ; then there is NO data left and it
beq fgteof ; is a real EOF, go set the flag
fget33 ;[59]
sta dsbend ; There is some data left to transmit
lda #$00 ; Zero the index
sta dsbind ; ...
jmp fgtgnc ; Go return the next character
;[59] jmp fgtgnc ; Skip the normal index and end reset
fgtset: lda #$00 ; No errors, zero
sta dsbind ; the index
lda #mxdb-1 ; Stuff (max_buflen - 1) into end-of-buffer ptr
sta dsbend ; ...
lda fetfl ;[6] Get the 'fetch file-length' flag
beq fgtgnc ;[59]
;[59] cmp #on ;[6] Is it on?
;[59] bne fgtgnc ;[6] If not, continue processing normally
ldx #$00 ;[6] The length should be first
lda filmod ;[6] Unless...
cmp #$04 ;[6] This is a binary file
bne fgtst1 ;[6] If not, continue
ldx #2 ;[59] get len from bytes 2 & 3
;[59] inx ;[6] Otherwise get length from bytes 2 and 3
;[59] inx ;[6] instead of bytes 0 and 1
fgtst1: lda dosbuf,x ;[6] Get the L.O. byte
sta fillen ;[6] Stuff it in the file length word
;[59] inx ;[6] Point at H.O. byte
lda dosbuf+1,x ;[59][6] Fetch it
sta fillen+1 ;[6] Store that in the file length word
ldx #$02 ;[6] We have to adjust the length
lda #4 ;[59] what is the file type
cmp filmod ;[59]
;[59] lda filmod ;[6] by either 2 or 4 depending on the
;[59] cmp #$04 ;[6] file type...
bne fgtst2 ;[6] If it's not binary, 2 will do
tax ;[59] else adj by 4
;[59] inx ;[6] Otherwise we have to adjust up by 4
;[59] inx ;[6]
fgtst2: stx kwrk01 ;[6] Store it here for now
clc ;[6] Clear carry for addition
lda fillen ;[6] Fetch L.O. byte of file length
adc kwrk01 ;[6] Add in the adjustment
sta fillen ;[6] ...
lda fillen+1 ;[6] Do H.O. byte
adc #$00 ;[6] ...
sta fillen+1 ;[6] ...
lda #off ;[6] Finally, make sure we turn off the flag
sta fetfl ;[6] ...
fgtgnc: ldx dsbind ; Fetch the current index
lda dosbuf,x ; Get the character at that point
inc dsbind ; Increment the index
fgtgn1:
; ldx ascii ;[82] is this 7bit text
; bne fgtgn2 ;[82] yes
ldx dosflg ;[82]
bne fgtexi ;[82] prodos text uses all 8 biits
ldx filmod ;[63] is this text file?
;[65] beq fgtgn2 ;[63] yes
;[65] ldx fbsize ;[8] Get the file-byte-size
;[65] cpx #fbsbit ; Is it seven-bit?
bne fgtexi ; If not, leave with the character intact
;[65]fgtgn2 ;[63]
fgtgn2 ;[82]
and #$7f ; Shut off the H.O. byte
beq fgteof ;[86] null is dos text file eof
fgtexi: jmp rskp ; Do a skip return
fgteof: lda #true ; Set the eof indicator on
sta eofinp ; ...
lda #$00 ; Return nul for a character
rts
fgtcan: jmp fatal ; Just go give an error
;
; Fputc - takes a character passed to it in the AC and writes it
; to the file being transferred in.
;
fputc:
ldx fgetgn ;[87] is this a filename?
beq fputc3 ;[87] no
ldx nfcb1 ;[87] where to put it
sta fcb1,x ;[87] unchared ... filename
inc nfcb1 ;[87]
jmp rskp ;[87]
fputc3 ;[87]
ldx dosflg ;[82]
; beq fputc3 ;[82] its dos
bne fptstc ;[82] its prodos
; ldx ascii ;[82] is this 7bit text
; beq fptstc ;[82] no,prodos text uses all 8 bits
; and #$7f ;[82] make sure its only 7bits
; jmp fptstc ;[82]
;fputc3 ;[82]
ldx filmod ;[63] is this text file?
;[65] beq fputc1 ;[63]
;[65] ldx fbsize ; Get the file-byte-size
;[65] cpx #fbsbit ; Is it seven-bit?
bne fptstc ; If not, just go store the character
;[65]fputc1 ;[63]
ora #$80 ; This should be negative ascii
fptstc: ldx dsbind ; Fetch the buffer index
sta dosbuf,x ; Stuff the character in the buffer
inx ;[59]dsbind ; Up the index once
stx dsbind ;[59] Get the current index
cpx #mxdb ;[59]If that is equal to the DOS buffer length...
beq fptwrt ; We just filled last position, write buffer
lda #$00 ; Clear AC, no error
jmp rskp ; Do a skip return
fptwrt:
lda logfg ;[56] are we logging this?
bpl fptwr0 ;[56] no
lda flowfg ;[57] do we have flow control ?
bpl fptwr0 ;[57] no
lda #hxoff ;[57] yes tell remote to stop
jsr tl0cmd ;[57]
lda flowdl ;[57] and wait for it to take effect
sta kwrk01 ;[57] work space
fptwr3: jsr telcp ;[57] check port for input and save it
lda kwrk01 ;[57] are we thru waiting ?
beq fptwr0 ;[57] yes
;[78] lda #2 ;[57] 2 ms
;[82] lda #25 ;[78] 2 ms
;[85] lda #17 ;[78] 1 ms
lda timect ;[85] 1 ms
jsr wait ;[57]
dec kwrk01 ;[57] waited long enough ?
;[82] jmp fptwr3 ;[57] no
bne fptwr3 ;[82] no
fptwr0:
lda dosflg ;[59] is this prodos?
beq fpwr2 ;[59] no
jsr prodos ;[59]
.byte wrfil ;[59]
.word prdwr ;[59]
bcc .+5 ;[59]
jsr perror ;[59]
jmp fpwr3 ;[59]
fpwr2 ;[59]
lda #fncwrt ; Get the 'write' function code
sta opcod ; and stuff it in the file manager parms
lda #$00 ; Make the range length
sta rnglnh ; look like the buffer length less one
lda #mxdb-1 ; ...
sta rnglnl ; ...
lda #sfntrn ; Subfunction is 'transfer range' of bytes
sta subcod ; ...
lda #dosbuf\ ; Get the dos buffer and stuff that parm into
sta fnadrl ; DOS' parm list
;[84] lda #dosbuf^ ; ...
;[84] sta fnadrh ; ...
;[84] jsr dosfmn ; Call the file manager
ldx #dosbuf^ ;[84] ...
stx fnadrh ;[84] x must be non 0 ...
jsr dosfmg ;[84] Call the file manager
fpwr3 ;[59]
lda logfg ;[56] was this from logging ?
bpl fptwr1 ;[56] no
lda flowfg ;[57] do we have flow control ?
bpl fptwr1 ;[57] no
lda #hxon ;[57] yes tell remote to resume
jsr tl0cmd ;[57]
fptwr1:
lda dosflg ;[59] is this prodos?
bne fptrst ;[59] yes
lda fmrcod ; Fetch the return code from the last call
;[84] cmp #dsener ; No errors?
beq fptrst ; No errors! reset everything
jmp fatal ; The error was probably bad, handle it
fptrst: lda #mxdb-1 ; Set last character to one less than actual
sta dsbend ; buffer size
lda #$00 ; Clear
sta dsbind ; the buffer index
jmp rskp ; Do a skip return
.endc
.SBTTL Utility routines
;
; The following routines are short low-level routines which help
; shorten the code and make it more readable
;
;
; Incn - increment the packet sequence number expected by this
; Kermit. Then take that number Mod $3f.
; Edit 16 adds the function of incrementing the total packet
; count for display during transmission
;
;[87]incn: pha ; Save AC
incn: ;[87]
lda prtcl ;[83] xmodem
beq incn1 ;[83] no
inc n ;[83] simple for xmodem
jmp incn2 ;[83]
incn1 ;[83]
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
;[59] clc ;[16] Clear carry again
;[59] lda tpak ;[16] Increment L.O. byte of
;[59] adc #$01 ;[16] total packet count
;[59] sta tpak ;[16] ...
;[59] lda tpak+1 ;[16] Do H.O. byte
;[59] adc #$00 ;[16] ...
;[59] sta tpak+1 ;[16] ...
incn2 ;[83]
inc tpak ;[59] bump it the easy way
bne incn3 ;[59]
inc tpak+1 ;[59]
incn3 ;[59]
;[87] pla ; Restore the AC
rts ; and return
;
; Movdds - This routine moves the default slot and drive for
; file transfers into the appropriate locations for DOS to
; find them.
;
;[84]movdds:
;[84] pha ;[40] Save the AC across this call
;[84] lda dosflg ;[59] prodos?
;[84] bne movdd1 ;[59] yes
;[84] lda defslt ;[40] Move the slot
;[84] sta kdslot ;[40] to where it belongs
;[84] lda defdrv ;[40] Move the drive
;[84] sta kddisk ;[40] to where it belongs
;[84] lda defvol ;[60]
;[84] sta kdvol ;[60]
;[84]movdd1 pla ;[40] Restore the AC
;[84] rts ;[40] and return
;
; Prcerp - Process error packet. Moves the Remote Kermit error
; text into a save area, notes that there was an error received
; from the remote Kermit in Errcod (set H.O. bit), and displays
; the text on the screen.
;
prcerp: lda ptype ;[38] Reload the packet type
cmp #'E ;[38] Is it an error packet?
beq prcer1 ;[38] Yes, continue processing
lda #false ;[67] tattle its no error pkt
rts ;[38] No, return
prcer1: lda #pdbuf\ ;[38] Set up from-address
sta kerfrm ;[38] ...
lda #pdbuf^ ;[38] ...
sta kerfrm+1 ;[38] ...
lda #errrkm\ ;[38] Set up the to-address
sta kerto ;[38] ...
lda #errrkm^ ;[38] ...
sta kerto+1 ;[38] ...
ldy pdlen ;[38] Get packet data length
sty kwrk01 ;[38] Store for the copy routine
lda #$00 ;[38] Start by storing a null at the end
sta (kerto),y ;[38] ...
jsr kercpy ;[38] Copy the error text
lda errcod ;[38] Set the bit in the error code
ora #eprflg ;[38] saying that the remote Kermit sent us
sta errcod ;[38] an error packet.
ldx #erin02\ ;[59]
ldy #erin02^ ;[59]
jsr prstr ;[59] say its from the remote
ldx #errrkm\ ;[38] Finally, display the error packet
ldy #errrkm^ ;[38] ...
jsr prrstr ;[38] Print string
jsr prcrlf ;[38] Make it look neat, add a crlf
jsr bell ;[59] get someones attention
lda #true ;[67] tattle its an error pkt
rts ;[38] Return to caller
;
; Prrstr - print a string from a remote source (i.e. there may
; be lower case or special characters in it.
;
prrstr: stx saddr ;[38] Save Low order byte
sty saddr+1 ;[38] Save High order byte
ldy #$00 ;[38] Clear Y reg
prrst1: lda (saddr),y ;[38] Get the next byte of the string
beq prrsrt ;[38] If it is null, we are done
pha ;[38] Hold the AC
;[85] lda #$32 ;[38] Set delay
lda timect ;[85] Set delay
rol a ;[85] just double it
;[78] jsr $fca8 ;[38] Do the delay
jsr wait ;[78] Do the delay
pla ;[38] Fetch the character back
jsr dspchr ;[38] Print the character
iny ;[38] Up the index
bne prrst2 ;[38] If zero, the string is <256, continue
inc saddr+1 ;[38] Increment page number
prrst2: jmp prrst1 ;[38] Go back to print next byte
prrsrt: rts ;[38] Return
comint lda #0 ;[81]
sta kerins ;[81] force initialization
jsr tlinit ;[81] initilize the com card
bne prrsrt ;[81] unable to use the com port
jsr u2icc ;[81] tattle
pla ;[81] keep stack straight
pla ;[81]
jmp kermit ;[81] failure
;
; Gobble - snarfs a line of characters from the port up to
; the receive end-of-line character. If it sees a keyboard
; interupt, it punts and does not skip.
;
gobble: lda #$00
sta pdtend ; Zero the index pointing to end of line buffer
lda kbd ;[58][21] Try to make sure we don't get an
lda kbdstr ;[58][21] unwarranted keyboard interupt
gobb: jsr getc ;[27] Get a character
jmp gobb2 ;[27] Got a keyboard interupt
;[82] cmp #soh ;[27] Is it a start-of-header?
ldx prtcl ;[83] xmodem?
beq gobba ;[83] no
cmp #'C ;[83] crc request?
beq gobbc ;[83] yes
cmp #eot ;[83] end of file?
beq gobbc ;[83] yes
cmp #nak ;[83] bad pkt
beq gobbc ;[83] yes
cmp #ack ;[83] ok?
bne gobba ;[83] no
gobbc ldx #0 ;[83]
inc pdtend ;[83] tell how many
jmp gobb33 ;[83]
gobba ;[83]
cmp sop ;[82] Is it a rec start-of-header?
bne gobb ;[27] No, flush until first SOH
;[83] jmp gobbst ;[27] Ok, now we can start
beq gobbst ;[83] Ok, now we can start
gobb0: jsr getc ; Get a character
jmp gobb2 ; Got a keyboard interupt
;[82] cmp #soh ;[27] If this not an SOH
ldx prtcl ;[83] xmodem?
bne gobbst ;[83] yes
cmp sop ;[82] If this not a rec SOH
bne gobb1 ;[27] continue here
;[75] tax ;[27] Hold the character here
;[75] lda #$00 ;[27] Rezero the index pointing to end of buf
;[75] sta pdtend ;[27] ...
;[75] txa ;[27] Get the SOH back
ldx #$00 ;[75][27] Rezero the index pointing to end of buf
stx pdtend ;[75][27] ...
;[83] jmp gobbdb ;[27] Go stuff the character in the buffer
beq gobbdb ;[83] Go stuff the character in the buffer
gobb1: cmp reol ; Is it the end-of-line character?
beq gobb3 ; Yes, finish up
gobbst: ldx pdtend ;[27] Get the index we need
gobbdb: sta plnbuf,x ;[27] Stuff the character at the buffer
inc pdtend ; Increment the index once
;[83] jmp gobb0 ; Loop for another character
lda prtcl ;[83] xmodem?
beq gobb0 ;[83] no
cpx #sfxmd+3 ;[83] data plus rest
beq gobb4 ;[83] were thru
bne gobb0 ;[83] next
gobb2: rts ; Just return, no skip
gobb3: ldx pdtend ;[27] Get end pointer again
gobb33 ;[83]
sta plnbuf,x ;[27] Store the End-of-line before we leave
gobb4 ;[83]
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?
;[75] bmi getpl1 ; If so, go return the next character
bcc getpl1 ;[75] If so, go return the next character
rts ; Return without a skip
getpl1: lda plnbuf,x ; Get the next character from the buffer
inc pdtind ; Up the index once
jmp rskp ; Return with a skip!
;
; Putplc - puts a character to the port line buffer.
;
putplc: ldx pdtind ;[25] Get the current index
;[75] inx ;[25] Check if we are at end of buffer
;[75] bne putpl1 ;[25] No, continue
;[75] rts ;[25] Return without a skip
;[75]putpl1: dex ;[25] Set index back to what it was
sta plnbuf,x ;[25] Get the next character from the buffer
inc pdtind ;[25] Up the index once
rts ;[25] Return
.ifeq <ftcom-ftappl>
;
; 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: ;[64]
lda #$ff ;[64]
sta twrk1 ;[64] setup fuzzy timer for timeout
lda lpcycl ;[64] get receive timeout lsb
sta twrk1+1 ;[64]
lda lpcycl+1 ;[64] get receive timeout msb
sta twrk1+2 ;[64]
getc3 lda timer ;[64] is timer on?
beq getc9 ;[64] no
lda twrk1 ;[64]
bne getc6 ;[64] is lsb 0?,no
lda twrk1+1 ;[64] how about middle byte
bne getc7 ;[64] no
lda twrk1+2 ;[64]
beq getc5 ;[64] has timer expired? yes
dec twrk1+2 ;[64] now dec msb
getc7 dec twrk1+1 ;[64] middle byte
getc6 dec twrk1 ;[64] decrement lsb
getc9 jsr telck ; No character from keyboard?
;[59] cmp #false ; ...
beq getc1 ; If not try port
lda kbd ; Get the key
bit kbdstr ;[59] dont leave it hanging
;[87] and #$7f ; Shut H.O. bit
;[87] cmp #'Q ; Was it an 'abort' interupt?
ora #$20 ;[87] make it lower case, leave upper bit on
cmp #'q+$80 ;[87] Was it an 'abort' interupt?
bne getc0 ; Nope, continue
lda #1 ;[84] so close wont write
jsr closef ;[84] now close the file
lda #$08 ; Error code for 'file trans abort'
sta errcod ; Stuff it here
ldx kerosp ; Get the old stack pointer back
txs ; Restore it
jmp kermit ; Warmstart kermit
getc5 lda #11 ;[64] setup timeout error
sta errcod ;[64]
getc0: ;[59] bit kbdstr ; and reset the strobe
rts ; Keyboard interupt, return
getc1: jsr telcp ; Check the port
beq getc3 ;[64] go back to the top of the loop
jsr telgpc ; Go get the port character
ldx parity ;[75] should we keep 8th bit?
beq getc2 ;[75] yes, now dont lie to me!!!!!
and #$7f ;[65] what if we have parity,turn it off
getc2 ;[75]
jmp rskp ; and return skip!
;
; Telck - checks the keyboard for a character. It returns
; false if none is present, otherwise it returns true.
; It does NOT return the character.
;
telck: bit kbd ; Check the keyboard
bpl telckf ; No character
lda #true ; There is a character there
rts ; Return true
telckf: lda #false ; No character, failure return
rts ; Go back
.endc
;
; Prson - parses an 'on' or an 'off' keyword and passes
; the result back to the calling routine in the x-index
; register. If there is an error, it pops the return
; address off the stack and transfers control to kermt2
; to issue the error message.
;
prson: lda #oncmd\ ; L.O. byte of command table
sta cminf1 ; Store that
lda #oncmd^ ; Get H.O. byte of command table address
sta cminf1+1 ; Stuff that parameter
lda #shon\ ;[13] Set up default string for parse
sta cmdptr ;[13] ...
lda #shon^ ;[13] ...
sta cmdptr+1 ;[13] ...
ldy #cmfdff ;[13] Show there is a default
lda #cmkey ; Code for keyword
jsr comnd ; Go do it
rts ; The command was not recognized
nop ; ...
nop ; ...
jmp rskp ; Good, skip return
;
; prcfm - parses for a confirm, then transfers control directly
; to the top of the main loop
;
prcfm: lda #cmcfm ; Load token for confirm
jsr comnd ; Parse a confirm
jmp kermt3 ; No confirm, give an error
;[73] lda #hcr ; Print a crlf
;[73] jsr cout ; ...
;[79] jsr prcrlf ;[73] might as well use it
jmp prcrlf ;[79][73] might as well use it & let it rts
;[79] rts ; Return
;
; Pron - checks the value in the AC and prints either 'ON' or
; 'OFF'. (on=1, off=0).
;
pron: ;[59] cmp #on ; Should we print 'on'?
beq pron1 ;[59] No, go print 'off'
ldx #shon\ ; Point to the 'on' string
ldy #shon^ ; ...
;[79]pron0: jsr prstr ; Print it
;[79] jsr prcrlf ; Add a crelf at the end
pron0 jmp prstrl ;[79] let it rts
;[79] rts ; And return
pron1: ldx #shoff\ ; Point to the 'off' string
ldy #shoff^ ; ...
jmp pron0 ; Go print it
pronnr: ;[81] print on /off without the cr
beq pronn1 ;[81] No, go print 'off'
ldx #shon\ ;[81] Point to the 'on' string
ldy #shon^ ;[81] ...
pronn0 jmp prstr ;[81] let it rts
pronn1: ldx #shoff\ ;[81] Point to the 'off' string
ldy #shoff^ ;[81] ...
jmp pronn0 ;[81] 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
nonft0 ;[84]
ora #$80 ; Make sure H.O. bit is on (DOS error)
sta errcod ; Save that here
ldx kerosp ; Get the old stack pointer back
txs ; Restore it
jmp stat07 ;[62] lets print the error and handle server
;[62] jmp kermit ; Warmstart kermit
;
; Fatal - closes and deletes a file on which a bad error
; has occured (most likely a 'disk full' error). It then
; restores the old stack pointer and warmstarts Kermit.
;
fatal: lda fmrcod ; Get the DOS return code
ora #$80 ; Set H.O. bit to indicate DOS error
sta errcod ; Store the error code
lda #$01 ; Make sure 'closef' knows there was an error
jsr closef ; Close the file
;[84] jsr dosdel ; Now, delete the useless file
lda #fncdel ;[84] the delete command
sta doscmi ;[84] should be non 0
jsr initfm ;[84] use the file manager to delete
ldx kerosp ; Get the old stack pointer
txs ; Restore it
jmp stat07 ;[62] lets print the error and handle server
;[62] jmp kermit ; Warmstart kermit
;
; Clrfcb - clears the area FCB1 so the filename placed there
; will not be corrupted.
;
clrfcb: ldx #$1f-1 ;[57] not quite so much[29] Load max filename length
lda #hspace ;[29] We will be filling with spaces
clrfc1: sta fcb1,x ;[29] Stuff the space
dex ;[29] Decrement our pointer
bpl clrfc1 ;[29] Not done, go back
kercrt ;[78]
kerflr ;[78]
rts ;[29] Return
;
; Kercpy - copies the string pointed to by Kerfrm to the
; block of memory pointed to by Kerto for Kwrk01 characters.
;
kercpy: ldy kwrk01 ;[13] Get the length of the string
kerclp: dey ;[13] One character less
bmi kercrt ;[13] If this went negative, we're done
lda (kerfrm),y ;[13] Get the next character
sta (kerto),y ;[13] And put it where it belongs
jmp kerclp ;[13] Go back for next char
;[78]kercrt: rts ;[13] Job is done, return
kercph: ldy kwrk01 ;[59] Get the length of the string
kerclh: dey ;[59] One character less
bmi kercrt ;[59] If this went negative, we're done
lda (kerfrm),y ;[59] Get the next character
ora #$80 ;[59] set high bit on
sta (kerto),y ;[59] And put it where it belongs
jmp kerclh ;[59] Go back for next char
;
; Kerflm - fills the buffer pointed to by Kerto with the
; character in kwrk02 for Kwrk01 characters.
;
kerflm: ldy kwrk01 ;[13] Get the length of the string
lda kwrk02 ;[13] Get the fill character
kerflp: dey ;[13] One character less
bmi kerflr ;[13] If this went negative, we're done
sta (kerto),y ;[13] And put it in the next position
jmp kerflp ;[13] Go back to do next char
;[78]kerflr: rts ;[13] Job is done, return
;
; Prchr - takes a character from the AC and prints it. It
; echos control characters as '^<chr>' and escape as '$'.
;
prchrl jsr logput ;[76] log the ch and then print everything
prchr: ora #$80 ; Make sure it's in range
cmp #$a0 ;[26] Less than escape??
bpl prchr1 ; If not, continue
tax ; Hold the character
;[75] lda #'^ ; Load the up-arrow for cntrl characters
;[76] lda #'^+$80 ;[75] Load the up-arrow for cntrl characters
;[75] ora #$80 ; Put it in printable range
lda #si+$80 ;turn on invers video
jsr cout ; Print the character
lda textfm ;[76] just in case it 40 col II/II+
pha ;[76] save it
lda #$3f ;[76] this makes it inverse
sta textfm ;[76]
txa ; Get the character back
clc ; Clear carry for add
adc #$40 ; Put this in the alphabetic range
jsr cout ;[76] put out shifted cntl ch
pla ;[76] restore textfm
sta textfm ;[76]
lda #so+$80 ;[76] turn off the invers video
prchr1: jmp cout ;[70][26] Normal character, just dump it
;[70] rts ; and go back
;
; Genmad - takes a message base, offset and size and calculates
; the address of the message leaving it in the X and Y registers
; ready for a call to PRSTR. The size and offset are taken from
; the stack and the base address is found in kermbs.
;
genmad: pla ; Get return address
sta kerrta ; and save it till later
pla ; ...
sta kerrta+1 ; ...
pla ; Get message offset
tax ; Hold it here for a while
pla ; Get the message length
tay ; and put it here
lda #$00 ; H.O. byte of message offset for mul16
pha ;[87] msb
pha ; ...
txa ; L.O. byte of message offset
pha ; ...
lda #$00 ; H.O. byte of message size for mul16
pha ;[87] msb
pha ; ...
tya ; L.O. byte of message size
pha ; ...
;[87] jsr mul16 ; Calculate the actual offset in table
jsr mul24 ;[87] 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
pla ;[87] msb of product
lda kerrta+1 ; Replace the return address on the stack
pha ; ...
lda kerrta ; ...
pha ; ...
rts ; Return
.SBTTL Spar and Rpar routines
;
; Spar - This routine loads the data buffer with the init parameters
; requested for this Kermit.
;
; Input: NONE
;
; Output: @Kerbf1 - Operational parameters
;
; Registers destroyed: A,Y
;
spar: ldy #$00 ; Clear Y
sty datind ; Clear datind
lda rpsiz ; Fetch receive packet size
cmp #mxpack+1 ;[75] are we in extended len
bcc .+4 ;[75] no, hate to do this
lda #mxpack ;[75] in case other cant do extended
clc ; Clear the carry flag
adc #$20 ; Characterize it
sta (kerbf1),y ; Stuff it in the packet buffer
iny ; Increment the buffer index
lda rtime ; Get the timeout interval
clc ; ...
adc #$20 ; Make that a printable character
sta (kerbf1),y ; and stuff it in the buffer
iny ; Advance the index
lda rpad ; Get the amount of padding required
clc ; ...
adc #$20 ; Make that printable
sta (kerbf1),y ; Put it in the buffer
iny ; Advance index
lda rpadch ; Get the padding character expected
eor #$40 ; Controlify it
sta (kerbf1),y ; And stuff it
iny ; Up the packet buffer index
lda reol ; Get the end-of-line expected
clc ; ...
adc #$20 ; Characterize it
sta (kerbf1),y ; Place that next in the buffer
iny ; Advance the index
lda rquote ; Get the quote character expected
sta (kerbf1),y ; Store it as-is last in the buffer
iny ; Advance index
lda #'Y ;[11] Send 'Y' - I will support 8-bit quoting
; ldx ascii ;[82]
; bne spar3 ;[82] ascii is only 7bits
ldx dosflg ;[82]
bne spar2 ;[82] prodos text uses all 8 bits
ldx filmod ;[75] do we really need ebq
beq spar3 ;[75] no just send a 'y
spar2 ;[82]
ldx parity ;[75] do we have a 8 bit path?
beq spar3 ;[75] yes
lda rebq ;[72] tell other kermit what ch to use
spar3 sta (kerbf1),y ; Stuff it into the data area
iny ;[75] ready for the crc field
lda #'1 ;[75] only 1 crc byte
sta (kerbf1),y ;[75]
iny ;[75] now for the repeat
lda #' ;[75]
sta (kerbf1),y ;[75]
iny ;[75] now for the capacity
;[87] lda #'" ;[75] should be the 2 bit (1 bit if starting from 0)
lda #$2a ;[87] file attr & extended len
ldx rpsiz ;[75] do we really want to support extended len
cpx #mxpack+1 ;[75]
bcs .+4 ;[75] got to be a better way
;[87] lda #sp ;[75] say no extended len
lda #$28 ;[87] say no extended len
sta (kerbf1),y ;[75]
iny ;[75] now for the window
lda #' ;[75]
sta (kerbf1),y ;[75]
iny ;[75] now for the extended length
sty ksavey ;[75] need this later
lda #0 ;[75] msb
pha ;[75]
pha ;[87]
lda rpsiz ;[75] lsb
pha ;[75]
lda #0 ;[75] msb
pha ;[75]
pha ;[87]
;[84] lda #95 ;[75] lsb
lda #dpakln+1 ;[84] lsb
pha ;[75]
;[87] jsr div16 ;[75] get q and rem
jsr div24 ;[87] get q and rem
bcc .+3 ;[75] always good it says here
brk ;[75] got to do something better
ldy ksavey ;[75] restore y
pla ;[75]
clc ;[75]
adc #' ;[75] char it
sta (kerbf1),y ;[75] xl1
iny ;[75]
pla ;[75] msb got to be 0
pla ;[87] msb got to be 0
pla ;[75] lsb of rem
clc ;[75]
adc #' ;[75] char it
; lda #maxxdl/95+$20 ;[75]
; sta (kerbf1),y ;[75] xl1
; iny ;[75] rest of extended length
; lda #maxxdl%95+$20 ;[75] should be remainder
sta (kerbf1),y ;[75] xl2
pla ;[75] msb of rem
pla ;[87] msb of rem
raparz ;[87]
rts ;[75]
;
; Rapar - This routine sets file attributes from the other kermit
; from the init packet data buffer.
;
; Input: @Kerbf1 - Operational parameters
;
; Output: parameters set
;
; Registers destroyed: A,Y,x
;
rapar: ldy #$00 ;[87] Start the data index at 0
rapar0 lda (kerbf1),y ;[87] so what attribute do we have?
tax ;[87] we shall test in x
jsr despa ;[87] get the len in a
sta ksavea ;[87] this is the len of this attribute
cpx #'! ;[87] this is size in k
bne rapar3 ;[87] no
jsr asc2bn ;[87] need a binary #
lda #0 ;[87] msb
pha ;[87]
lda #1024^ ;[87] its in k remember
pha ;[87]
lda #1024\ ;[87]
pha ;[87]
lda lcurfl+2 ;[87] msb of size
pha ;[87]
lda lcurfl+1 ;[87]
pha ;[87]
lda lcurfl ;[87] lsb
pha ;[87]
jsr mul24 ;[87]
pla ;[87] now its in bytes
sta lcurfl ;[87]
pla ;[87]
sta lcurfl+1 ;[87]
pla ;[87]
sta lcurfl+2 ;[87]
ldy ksavey ;[87]
rapar2 iny ;[87]
cpy pdlen ;[87] out of data?
bge raparz ;[87] yes
blt rapar0 ;[87] more
rapar3 cpx #'" ;[87] how abt file type
bne rapar7 ;[87] no
iny ;[87]
lda (kerbf1),y ;[87] next
cmp #'A ;[87] ascii?
bne rapar6 ;[87] no
lda #0 ;[87] set file mode to text
sta filmod ;[87] probably will be trouble
dec ksavea ;[87] more?
beq rapar2 ;[87] no
iny ;[87]
lda (kerbf1),y ;[87] lets see what the terminator is
cmp #'M ;[87] cr?
beq rapar5 ;[87] yes
rapa33 dec ksavea ;[87]
rapar4 tya ;[87] skip rest of attr data
clc ;[87]
adc ksavea ;[87]
tay ;[87]
jmp rapar2 ;[87]
rapar5 dec ksavea ;[87]
beq rapar2 ;[87]
iny ;[87]
lda (kerbf1),y ;[87]
cmp #'J ;[87] crlf?
bne rapar4 ;[87] que passo?
sta xcrlf ;[87] this is receive crlf->cr
bne rapa33 ;[87]
rapar6 cmp #'B ;[87] binary?
bne rapa33 ;[87] cant handle others
lda #4 ;[87] make file mode binary
sta filmod ;[87] someone probably wont like this
bne rapa33 ;[87]
rapar7 cpx #'1 ;[87] exact # of bytes?
bne rapar9 ;[87] no, forget this subfield try next
jsr asc2bn ;[87] yes, put it in lcurfl
jmp rapar4 ;[87]
rapar9 cpx #'# ;[87] how abt date & time
bne rapar4 ;[87] no
ldx #0 ;[87] index into getln
rapara iny ;[87] get a ch
lda (kerbf1),y ;[87]
cmp #' ;[87] space is end of date
beq raparc ;[87] yes
dey ;[87] its smaller this way
jsr tasc2b ;[87] 2 asc chs to bin
jmp rapara ;[87] next
raparc dec ksavea ;[87] account for the space
txa ;[87] any?
beq rapar4 ;[87] no, que passo quit
lda getln-2,x ;[87] this is mo
asl a ;[87] shift it 5
asl a ;[87]
asl a ;[87]
asl a ;[87]
asl a ;[87]
ora getln-1,x ;[87] this is day
sta pcrdat ;[87] part of mo & day
lda getln-3,x ;[87] yr
rol a ;[87] get carry from mo
sta pcrdat+1 ;[87]
jsr tasc2b ;[87] now for the time
sta pcrtim+1 ;[87] first the hr
iny ;[87] skip :
dec ksavea ;[87]
jsr tasc2b ;[87]
sta pcrtim ;[87] & min
jmp rapar4 ;[87]
tasc2b iny ;[87] next ch
lda (kerbf1),y ;[87]
dec ksavea ;[87] got to keep track
sec ;[87]
sbc #'0 ;[87] make it binary
sta getln,x ;[87] save it
iny ;[87]
lda (kerbf1),y ;[87] next
dec ksavea ;[87]
sec ;[87]
sbc #'0 ;[87] binary
pha ;[87] for later
lda getln,x ;[87] times 10
asl a ;[87]
asl a ;[87]
asl a ;[87]
clc ;[87]
adc getln,x ;[87]
adc getln,x ;[87]
sta getln,x ;[87]
pla ;[87]
adc getln,x ;[87] finally
sta getln,x ;[87]
inx ;[87]
rts ;[87]
asc2bn lda #0 ;[87]
sta lcurfl ;[87] convert from ascii to bin
sta lcurfl+1 ;[87] & put it in lcurfl
sta lcurfl+2 ;[87]
lda ksavea ;[87] any in the subfield?
beq asc2br ;[87] no
rapar1 sty ksavey ;[87] got to save it
lda lcurfl+2 ;[87] msb
pha ;[87]
lda lcurfl+1 ;[87]
pha ;[87]
lda lcurfl ;[87] lsb
pha ;[87]
lda #0 ;[87] msb
pha ;[87]
pha ;[87]
lda #10 ;[87] lsb, its times 10
pha ;[87]
jsr mul24 ;[87] 24 bit mul
pla ;[87]
sta lcurfl ;[87]
pla ;[87]
sta lcurfl+1 ;[87]
pla
sta lcurfl+2 ;[87]
inc ksavey ;[87] restore
ldy ksavey ;[87]
lda (kerbf1),y ;[87]
sec ;[87]
sbc #'0 ;[87] better be decimal #
clc ;[87] now add it to lcurfl
adc lcurfl ;[87]
sta lcurfl ;[87]
bcc asc2b3 ;[87] no carry
inc lcurfl+1 ;[87] yes
bcc asc2b3 ;[87] more?
inc lcurfl+2 ;[87] yes
asc2b3 dec ksavea ;[87] count of chs
bne rapar1 ;[87] more
asc2br rts ;[87]
;
; sapar - set up the attribute pak
;
sapar ldy #0 ;[87] just the index
lda #'" ;[87] type
sta (kerbf1),y ;[87]
iny ;[87]
sty kwrk01 ;[87] place for len
iny ;[87]
lda filmod ;[87]
bne sapar3 ;[87]
lda #'A ;[87] its ascii
sta (kerbf1),y ;[87]
iny ;[87]
lda #'M ;[87] term by at least a cr
sta (kerbf1),y ;[87]
iny ;[87]
lda xcrlf+1 ;[87] see what the crlf<->cr says
beq sapar2 ;[87]
lda #'J ;[87] it crlf
sta (kerbf1),y ;[87]
iny ;[87]
bne sapar2 ;[87] always
sapar3 lda #'B ;[87] rest are binary
sta (kerbf1),y ;[87]
iny ;[87]
lda #'8 ;[87] we only know abt 8 bits
sta (kerbf1),y ;[87]
iny ;[87]
sapar2 jsr satfll ;[87] and the len
sapar7 lda #'. ;[87] who we are
sta (kerbf1),y ;[87]
iny ;[87]
sty kwrk01 ;[87] new place for len
iny ;[87]
lda #'A ;[87] were an apple
sta (kerbf1),y ;[87]
iny ;[87]
lda #'1 ;[87] 2
sta (kerbf1),y ;[87]
iny ;[87]
jsr satfll ;[87] agn set the len
lda lcurfl ;[87] see if 0 len
ora lcurfl+1 ;[87]
ora lcurfl+2 ;[87]
beq sapar9 ;[87] yes
lda #'1 ;[87] len of file
sta (kerbf1),y ;[87]
iny ;[87]
lda lcurfl+2 ;[87]
pha ;[87]
lda lcurfl+1 ;[87]
pha ;[87]
lda lcurfl ;[87]
pha ;[87]
tya ;[87]
clc ;[87] now for place to store it
adc kerbf1 ;[87] lsb
sta kwrk01 ;[87]
lda kerbf1+1 ;[87] msb
adc #0 ;[87]
pha ;[87] msb of where to store it
lda kwrk01 ;[87]
pha ;[87] lsb
sty kwrk01 ;[87] place for len
jsr bn2asc ;[87] convert lcurfl to ascii
lda kwrk01 ;[87] place of bin len from bn2asc
tay ;[87]
clc ;[87]
adc (kerbf1),y ;[87] len of ascii number
tax ;[87]
inx ;[87] one more for the len
clc ;[87]
lda #32 ;[87] tochar the len
adc (kerbf1),y ;[87]
sta (kerbf1),y ;[87]
txa ;[87]
tay ;[87]
sapar9 sty pdlen ;[87]
rts ;[87]
satfll sty kwrk02 ;[87]
dey ;[87] len field not counted
tya ;[87]
sec ;[87]
sbc kwrk01 ;[87]
clc ;[87]
adc #32 ;[87] tochar
ldy kwrk01 ;[87] place to put len
sta (kerbf1),y ;[87]
ldy kwrk02 ;[87]
rts ;[87]
;
; 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!
sty ebqmod ;[75] start without 8 bit quoting
sty exfg ;[75] turn off extended length packet
sty flatr ;[87] start out wid no file attr
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
;[75] iny ; Increment the buffer index
;[75] lda (kerbf1),y ; Get the next item
;[75] sec ; ...
;[75] sbc #$20 ; Uncharacterize that
jsr despa ;[75] get ch and unchar
sta stime ; Other Kermit's timeout interval
;[75] iny ; Up the index once again
;[75] lda (kerbf1),y ; Get next char
;[75] sec ; ...
;[75] sbc #$20 ; Restore to original value
jsr despa ;[75] get ch and unchar
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 qoute character
jmp rpar6 ; Otherwise, give him what he wants
rpar5: lda #'# ; Load # sign
rpar6: sta squote ; Make that the other Kermit's quote character
iny ; Advance the index
lda pdlen ;[11] Check the data length to see
;[75] cmp #$09 ;[11] if the 8-bit quote is there
cmp #7 ;[75] if the 8-bit quote is there
;[75] bmi rpar8 ;[52][11] If not, return
bcc rpar8 ;[75] pdlen may be - [52][11] If not, return
lda (kerbf1),y ;[11] Fetch the 8-bit quote
cmp #'N ;[11] Is it 'N'
beq rpar8 ;[15][11] Yes, leave.(he doesn't support 8-bit)
cmp #'Y ;[11] Does he support 8-bit quoting?
;[72] beq rpar8 ;[15][11] If so, leave. (we don't need it.)
;[75] beq rpar72 ;[72][15][11] If so, leave. (we don't need it.)
bne rpard ;[75]
; lda ascii ;[82]
; bne rpar9 ;[82] this is 7bit text
lda dosflg ;[82]
bne rpar67 ;[82] prodos text uses all 8 bits
lda filmod ;[75] is this text file?
beq rpar9 ;[75] yes turn off ebq
rpar67 ;[82]
lda parity ;[75] do we really need it?
bne rpar72 ;[75] yes
beq rpar9 ;[75] no par so 8 bit not req
rpard ;[75]
cmp #'! ;[11] Now, it should be a real character
bmi rpar8 ;[52][11] Check if it is in range.
cmp #'? ;[11] If so, we set the 8-bit quote char
bmi rpar7 ;[11] and set 8-bit quoting on.
cmp #$60 ;[11] If not, just leave.
;[75] bmi rparrt ;[11] ...
bmi rpar8 ;[75]
cmp #del ;[11] ...
;[75] bpl rpar8 ;[52][11] ...
beq rpar8 ;[75]
rpar7: sta sebq ;[11] Stuff the character here
rpar72 lda #on ;[11] Set 8-bit quoting on
sta ebqmod ;[11] ...
;[75] rts ;[15] Return
bne rpar9 ;[75] next field
;[72]rpar8: sta sebq ;[15] Make sure this parm is stored
rpar8: ;[75]
; lda ascii ;[82]
; bne rpar9 ;[82] this is 7bit text
lda dosflg ;[82]
bne rpar87 ;[82] prodos text uses all 8 bits
lda filmod ;[75] is this text file?
beq rpar9 ;[75] yes dont need 8bq
rpar87 ;[82]
lda parity ;[75] do we really need it?
beq rpar9 ;[75] no par so 8 bit not req
tya ;[75] save y
pha ;[75]
jsr u2s8b ;[75] problems unable to send 8 bits
pla ;[75] restore y
tay ;[75]
;[75] lda #off ;[15] AND that 8-bit quoting is off.
;[75] sta ebqmod ;[15] ...
rpar9 lda pdlen ;[75]
cmp #10 ;[75] is capacity byte there?
bcc rparrt ;[75] no, pdlen may be -
iny ;[75]
iny ;[75]
iny ;[75] position to cap byte
lda (kerbf1),y ;[75]
pha ;[87]
and #8 ;[87] file attributes?
sta flatr ;[87] just non zero
pla ;[87]
and #2 ;[75] is xlength there?
beq rparrt ;[75] no
lda rpsiz ;[75] should we use extended len
;[84] cmp #95 ;[75] > 94 means yes
cmp #dpakln+1 ;[84] > 94 means yes
bcc rparrt ;[75] no
sta exfg ;[75] turn on extended length
rpara lda (kerbf1),y ;[75]
iny ;[75] ready for next byte
and #1 ;[75] is there more cap bytes?
bne rpara ;[75] yes
tya ;[75] see if xl1 & xl2 are there
clc ;[75]
adc #2 ;[75]
cmp pdlen ;[75] well?
bcs tobig ;[75] not there and default of 500 is too big
lda #0 ;[75] ready for the mult
pha ;[75] msb
pha ;[87]
jsr despa ;[75] get lsb
pha ;[75]
lda #0 ;[75]
pha ;[75]
pha ;[87]
;[84] lda #95 ;[75] its 95 times
lda #dpakln+1 ;[84] its 95 times
pha ;[75]
;[87] jsr mul16 ;[75] mult 2 16 bit quantities
jsr mul24 ;[87][75] mult 2 16 bit quantities
pla ;[75] get ans
sta spsiz ;[75] this is senders packet size
pla ;[75] now for msb
beq rparc ;[75] it may be small enough
pla ;[87] msb of prod
tobig lda #maxxdl ;[75] set our max
sta spsiz ;[75]
jmp rparrt ;[75] thats all
;[87]rparc jsr despa ;[75]
rparc pla ;[87] msb of prod
jsr despa ;[87]
clc ;[75]
adc spsiz ;[75]
sta spsiz ;[75]
bcs tobig ;[75]
lda #maxxdl ;[75]
cmp spsiz ;[75] is it too big?
bcs rparrt ;[75] no
sta spsiz ;[75] yes use ours
rparrt: rts ;[11] Return
despa iny ;[75] Increment the buffer index
lda (kerbf1),y ;[75] Get the next item
sec ;[75] ...
sbc #$20 ;[75] Uncharacterize that
rts ;[75]
;
; 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 ; ...
;[81] jsr spak ; Now, send it
;[81] rts ; Return
jmp spak ;[81] Now, send it & return
.SBTTL Message text
.ifeq <ftcom-ftappl>
versio: nasc <NOSC/SI/CU-APPLE ][ KERMIT-65 VER 3.87> 1
.endc
.SBTTL Command tables and help text
.nlst
modmco nasc <CONOOKRIER> 0 ;[78] hayes responses 1st 2 chs
modmwc .blkb 5 ;[78] 1 for each pair of modmco
;[85]lmodmc = .-modmco ;[78] length of above
lmodmc = .-modmwc ;[85] length of modmwc
;[85] dials nasc <PRESS 0-9 MODEM CMD, M MORE OR Q QUIT> 1 ;[78]
dials .byte si+$80 ;[85] start hilite
nasc <PRESS 0-9 MODEM CMD, M-MORE OR Q-QUIT> 0 ;[85]
.byte so+$80,0 ;[85] stop hilite & string
morem .byte si+$80 ;[85] start hilite
nasc <M-MORE, Q-QUIT OR T-TOP> 0 ;[85]
.byte so+$80,0 ;[85] stop hilite and string
;dialf nasc <CONNECTION FAILED, TRY AGAIN> 1 ;[78]
dialnm nasc <KERMIT.MODEM> 1 ;[78]
dialms nasc <READING MODEM FILE > 1 ;[78]
;[83]kerinm nasc <INITIALIZING BY READING FILE > 1 ;[78]
kerinm nasc <READING COMMANDS> 1 ;[78]
hlpfn nasc <KERMIT.HELP> 0 ;[85]
hlpfne ;[85]
kerinn nasc <KERMIT.INIT> 1 ;[78] kermit initialization file - 1 of 2
kercmd: .byte 27 ;[87][85][83][81][78][62][56][14]Table len - 2 of 2
.byte $03 ;[14] Keyword length
.asciz /BYE/ ;[14] Keyword terminated with a null
;[82] .byte $1E,$1E ;[14] Two bytes of data
.word bye ;[82]
catsz .byte 7 ;[78] add the catalog command
.asciz /CATALOG/ ;[78]
;[82] .byte kercat-kermtb,kercat-kermtb ;[78]
.word catlog ;[82]
.byte 2 ;[87] unix current directory
.asciz /CD/ ;[87]
.word stcd ;[87]
.byte $07
.asciz /CONNECT/
;[82] .byte $00,$00
.word telnet ;[82]
delsz .byte 6 ;[78] add the file delete command
.asciz /DELETE/ ;[78]
;[82] .byte kerdlf-kermtb,kerdlf-kermtb ;[78]
.word deletf ;[82]
.byte $04
.asciz /EXIT/
;[82] .byte $03,$03
.word exit ;[82]
.byte $06 ;[14] New command
.asciz /FINISH/ ;[14]
;[82] .byte $21,$21 ;[14]
.word finish ;[82]
.byte $03 ;[14] New commnad
.asciz /GET/ ;[14]
;[82] .byte $24,$24 ;[14]
.word getfrs ;[82]
.byte $04
.asciz /HELP/
;[82] .byte $06,$06
.word help ;[82]
locksz .byte 4 ;[86] add the lock file-name cmd
.asciz /LOCK/ ;[86]
.word lock ;[86]
shin28
.byte $03
.asciz /LOG/
;[82] .byte $09,$09
.word log ;[82]
.byte 2 ;[87] how about a unix cmd
.asciz /LS/ ;[87]
.word catlog ;[87]
.byte 5 ;[78] add the modem command
.asciz /MODEM/ ;[78]
;[82] .byte kerdil-kermtb,kerdil-kermtb ;[78]
.word modem ;[82]
; .byte $04 ;[87] read a text file to screen
; .asciz /MORE/ ;[87]
; .word help ;[87] use help rtn
; .byte 2 ;[87] add the rename file-name cmd
; .asciz /MV/ ;[87]
; .word rename ;[87]
.byte 3 ;[87] unix show prefix
.asciz /PWD/ ;[87]
.word shpwd ;[87]
.byte $04
.asciz /QUIT/
;[82] .byte $0C,$0C
.word exit ;[82]
; .word quit ;[87]
.byte $07
.asciz /RECEIVE/
;[82] .byte $0F,$0F
.word receve ;[82]
.byte 6 ;[81] add the remote command
.asciz /REMOTE/ ;[81]
;[82] .byte kerrmt-kermtb,kerrmt-kermtb ;[81]
.word remote ;[82]
renmsz .byte 6 ;[86] add the rename file-name cmd
.asciz /RENAME/ ;[86]
.word rename ;[86]
.byte 2 ;[87] unix
.asciz /RM/ ;[87]
.word deletf ;[87]
.byte $04
.asciz /SEND/
;[82] .byte $12,$12
.word send ;[82]
.byte $6 ;[62] server mode
.asciz /SERVER/ ;[62]
;[82] .byte $27,$27 ;[62]
.word server ;[82]
.byte $03
.asciz /SET/
;[82] .byte $15,$15
.word setcom ;[82]
.byte $04
.asciz /SHOW/
;[82] .byte $18,$18
.word show ;[82]
.byte $06
.asciz /STATUS/
;[82] .byte $1B,$1B
.word status ;[82]
.byte 4 ;[83]
.asciz /TAKE/ ;[83]
.word take ;[83]
.byte $04 ;[85] read a text file to screen
.asciz /TYPE/ ;[85]
.word help ;[85] use help rtn
unlksz .byte 6 ;[86] add the unlock file-name cmd
.asciz /UNLOCK/ ;[86]
.word unlock ;[86]
remcmd: .byte 1 ;[81] remote subcommands
.byte 6 ;[81] remote kermit command
.asciz /KERMIT/ ;[81]
.byte remker-remcmb,remker-remcmb ;[81] offset into jump table
setcmd: .byte 24 ;[35] Edit 12, 21, 35, 40 46 ,47,65,68,72,73,83,85,87
; new commands
shin2f ;[87]
.byte 16 ;[81] Add the 'SET KEYPAD-APP...' command.
.asciz /APPLICATION-MODE/ ;[81]
;[82] .byte setcka-setcmb,setcka-setcmb ;[81]
.word stkpa ;[82]
shin25 ;[87]
.byte 4 ;[47] baud rate
.asciz /BAUD/ ;[47]
;[65] .byte $30,$30 ;[47] offset into jump table
;[82] .byte setcba-setcmb,setcba-setcmb ;[65] offset into jump table
.word stbaud ;[82]
setcs .byte 12 ;[87] Add the 'SET CLEAR-SCREEN ...
.asciz /CLEAR-SCREEN/ ;[87]
.word stcs ;[87]
shin2g ;[87]
.byte 17 ;[80] Add the 'SET CURSOR ...' command.
.asciz /CURSOR-KEYS-VT100/ ;[80]
;[82] .byte setckc-setcmb,setckc-setcmb ;[80]
.word stcko ;[82]
shin00 ;[87]
.byte $09
.asciz /DEBUGGING/
;[68] .byte $18,$18
;[82] .byte setdb-setcmb,setdb-setcmb ;[68] offset into jump table
.word stdb ;[82]
shin22 ;[87]
.byte $0C ;[40] Add the 'SET DEFAULT-DISK' command
.asciz /DEFAULT-DISK/ ;[40] ...
;[65] .byte $2a,$2a ;[40] ...
;[82] .byte setcdd-setcmb,setcdd-setcmb ;[65] ...
.word stddsk ;[82]
shin24 ;[87]
.byte $07 ;[46] Add the 'SET DISPLAY' command
.asciz /DISPLAY/ ;[46] ...
;[65] .byte $2d,$2d ;[46] ...
;[82] .byte setcds-setcmb,setcds-setcmb ;[65] ...
.word stdspy ;[82]
;[72] .byte $11
;[72] .asciz /EIGHT-BIT-QUOTING/
;[68] .byte $15,$15
;[72] .byte seteb-setcmb,seteb-setcmb ;[68] offset into jump table
shin06 ;[87]
.byte $06
.asciz /ESCAPE/
;[82] .byte $00,$00
.word stesc ;[82]
;[65] .byte $0e
;[65] .asciz /FILE-BYTE-SIZE/
;[65] .byte $1e,$1e
shin16 ;[87]
.byte $09
.asciz /FILE-TYPE/
;[68] .byte $1b,$1b
;[82] .byte setmod-setcmb,setmod-setcmb ;[68] offset into jump table
.word stmod ;[82]
shin05 ;[87]
.byte $0C
.asciz /FILE-WARNING/
;[68] .byte $12,$12
;[82] .byte setfw-setcmb,setfw-setcmb ;[68] offset into jump table
.word stfw ;[82]
shin27 ;[87]
.byte 4 ;[57] flow control
.asciz /FLOW/ ;[57]
;[65] .byte $36,$36 ;[57]
;[82] .byte setcfl-setcmb,setcfl-setcmb ;[65]
.word stflow ;[82]
;[68] .byte $03 ;[21] ibm-mode switch
;[68] .asciz /IBM/ ;[21]
;[68] .byte $03,$03 ;[21]
shin21 ;[87]
.byte $08 ;[35] Add the 'SET KEYBOARD' command.
.asciz /KEYBOARD/ ;[35]
;[65] .byte $27,$27 ;[35]
;[82] .byte setckb-setcmb,setckb-setcmb ;[65]
.word stkbd ;[82]
;[87] .byte 6 ;[80] Add the 'SET KEYPAD' command.
;[87] .asciz /KEYPAD/ ;[80]
;[82] .byte setckp-setcmb,setckp-setcmb ;[80]
;[87] .word stkp ;[82]
; .byte 23 ;[80] Add the 'SET KEYPAD-APP...' command.
; .asciz /KEYPAD-APPLICATION-MODE/ ;[80]
; .byte setcka-setcmb,setcka-setcmb ;[80]
shin03 ;[87]
.byte $0A
.asciz /LOCAL-ECHO/
;[68] .byte $06,$06
;[82] .byte setle-setcmb,setle-setcmb ;[68] offset into jump table
.word stle ;[82]
shin20 ;[87]
.byte $06 ;[86] Add the 'SET PARITY' option
.asciz /PARITY/ ;[86]
.word stpari ;[86]
.byte $06 ;[59] Add the 'SET prefix' option
.asciz /PREFIX/ ;[59]
;[65] .byte $39,$39 ;[59]
;[82] .byte setcpf-setcmb,setcpf-setcmb ;[65]
.word stpre ;[82]
;[86] .byte $06 ;[21] Add the 'SET PARITY' option
;[86] .asciz /PARITY/ ;[21]
;[86];[65] .byte $24,$24 ;[21]
;[86];[82] .byte setcpa-setcmb,setcpa-setcmb ;[65]
;[86] .word stpari ;[82]
shin26 ;[87]
.byte $07 ;[55] Add the 'SET PRINTER' option
.asciz /PRINTER/ ;[55]
;[65] .byte $33,$33 ;[55]
;[82] .byte setcpr-setcmb,setcpr-setcmb ;[65]
.word stprn ;[82]
shin2i ;[87]
.byte 8 ;[83] Add the 'SET protocol' option
.asciz /PROTOCOL/ ;[83]
.word stprt ;[83]
.byte $07
.asciz /RECEIVE/
;[68] .byte $9,$9
;[82] .byte setrc-setcmb,setrc-setcmb ;[68] offset into jump table
.word strc ;[82]
.byte $04
.asciz /SEND/
;[68] .byte $0C,$0C
;[82] .byte setsn-setcmb,setsn-setcmb ;[68] offset into jump table
.word stsn ;[82]
shin18 ;[87]
.byte $04 ;[12] Add the 'SET SLOT' option
.asciz /SLOT/ ;[12] ...
;[65] .byte $21,$21 ;[12] ...
;[82] .byte setcsl-setcmb,setcsl-setcmb ;[65] ...
.word stslot ;[82]
shin2c ;[87]
.byte 15 ;[73] swap bs & del keypress
.asciz /SWAPKEYS-BS&DEL/ ;[73]
;[82] .byte setcsw-setcmb,setcsw-setcmb ;[73]
.word stswp ;[82]
shin01 ;[87]
.byte 8 ;[76] add the 'set terminal' option
.asciz /TERMINAL/ ;[76]
;[82] .byte setvt-setcmb,setvt-setcmb ;[65] offset into set table
.word stvt ;[82]
shin2b ;[87]
.byte $05 ;[64] Add the 'SET timer' option
.asciz /TIMER/ ;[64]
;[65] .byte $3C,$3C ;[64] offset into set table
;[82] .byte setctm-setcmb,setctm-setcmb ;[65] offset into set table
.word sttmr ;[82]
shin2k ;[87]
.byte 6 ;[85] Add the 'SET timing' constant option
.asciz /TIMING/ ;[85]
.word sttmct ;[85]
;[76] .byte $0E
;[76] .asciz /VT52-EMULATION/
;[76];[68] .byte $0F,$0F
;[76] .byte setvt-setcmb,setvt-setcmb ;[65] offset into set table
shocmd: .byte 28 ;[40][35] Edit 12, 21, 35, 40,46,47,65,68,72,73,83,85,87
; new commands
.byte $03
shodef: .asciz /ALL/ ;[13] Default option for 'SHOW' command
;[82] .byte $00,$00
.word shall ;[82]
.byte 16 ;[87] Add 'SHOW KEYPAD-APP...' command.
.asciz /APPLICATION-MODE/ ;[87]
.word shkp ;[87]
.byte 4 ;[47]
.asciz /BAUD/ ;[47]
;[65] .byte $a2,$a2 ;[47] ofset into jmp table
;[82] .byte shocud-shocmb,shocud-shocmb ;[65] ofset into jmp table
.word shbaud ;[82]
.byte 12 ;[87] Add the 'SHOW CLEAR-SCREEN ...
.asciz /CLEAR-SCREEN/ ;[87]
.word shcs ;[87]
.byte 17 ;[80] Add 'SHOW CURSOR-KEY...' command.
.asciz /CURSOR-KEYS-VT100/ ;[80]
;[82] .byte shokco-shocmb,shokco-shocmb ;[80]
.word shcko ;[82]
.byte $09
.asciz /DEBUGGING/
;[68] .byte $51,$51
;[82] .byte shodb-shocmb,shodb-shocmb ;[68] ofset into jmp table
.word shdb ;[82]
.byte $0C ;[40] Add the 'SHOW DEFAULT-DISK' option
.asciz /DEFAULT-DISK/ ;[40] ...
;[65] .byte $90,$90 ;[40] ...
;[82] .byte shocsk-shocmb,shocsk-shocmb [65] ...
.word shddsk ;[82]
shin19 ;[87]
.byte $0D ;[12] Add the 'SHOW DEVICE-DRIVER' option
.asciz /DEVICE-DRIVER/ ;[12] ...
;[65] .byte $75,$75 ;[12] ...
;[82] .byte shocdr-shocmb,shocdr-shocmb ;[65] ...
.word shddr ;[82]
.byte $07 ;[46] Add the 'SHOW DISPLAY' command
.asciz /DISPLAY/ ;[46] ...
;[65] .byte $99,$99 ;[46] ...
;[82] .byte shocpy-shocmb,shocpy-shocmb ;[65] ...
.word shdspy ;[82]
;[72] .byte $11
;[72] .asciz /EIGHT-BIT-QUOTING/
;[68] .byte $48,$48
;[72] .byte shoeb-shocmb,shoeb-shocmb ;[68] ofset into jmp table
.byte $06
.asciz /ESCAPE/
;[68] .byte $09,$09
;[82] .byte shoesc-shocmb,shoesc-shocmb ;[68] ofset into jmp table
.word shesc ;[82]
;[65] .byte $0e
;[65] .asciz /FILE-BYTE-SIZE/
;[65] .byte $63,$63
.byte $09
.asciz /FILE-TYPE/
;[68] .byte $5a,$5a
;[82] .byte shomod-shocmb,shomod-shocmb ;[68] ofset into jmp table
.word shmod ;[82]
.byte $0C
.asciz /FILE-WARNING/
;[68] .byte $3f,$3f
;[82] .byte shofw-shocmb,shofw-shocmb ;[68] ofset into jmp table
.word shfw ;[82]
.byte 4 ;[57] flow control
.asciz /FLOW/ ;[57]
;[65] .byte $b4,$b4 ;[57]
;[82] .byte shocow-shocmb,shocow-shocmb ;[65]
.word shflow ;[82]
;[68] .byte $03 ;[21] Add Ibm mode option
;[68] .asciz /IBM/ ;[21]
;[68] .byte $12,$12 ;[21]
.byte $08 ;[35] Add 'SHOW KEYBOARD' command.
.asciz /KEYBOARD/ ;[35]
;[65] .byte $87,$87 ;[35]
;[82] .byte shocbd-shocmb,shocbd-shocmb ;[65]
.word shkbd ;[82]
;[87] .byte 6 ;[80] Add 'SHOW KEYPAD' command.
;[87] .asciz /KEYPAD/ ;[80]
;[82] .byte shokp-shocmb,shokp-shocmb ;[80]
;[87] .word shkp ;[82]
; .byte 23 ;[80] Add 'SHOW KEYPAD-APP...' command.
; .asciz /KEYPAD-APPLICATION-MODE/ ;[80]
; .byte shokpa-shocmb,shokpa-shocmb ;[80]
.byte $0A
.asciz /LOCAL-ECHO/
;[68] .byte $1b,$1b
;[82] .byte shole-shocmb,shole-shocmb ;[68] ofset into jmp table
.word shle ;[82]
.byte $3 ;[56]
.asciz /LOG/ ;[56]
;[65] .byte $bd,$bd ;[56]
;[82] .byte shocog-shocmb,shocog-shocmb ;[65]
.word shlog ;[82]
.byte $06 ;[21] Add 'SHOW PARITY' command
.asciz /PARITY/ ;[21]
;[65] .byte $7e,$7e ;[21]
;[82] .byte shocri-shocmb,shocri-shocmb ;[65]
.word shpari ;[82]
prefsz .byte $06 ;[59] Add the 'SHOW DEFAULT-DISK' option
shin2a = prefsz ;[87]
.asciz /PREFIX/ ;[59] prefix same as default-disk
;[68] .byte $90,$90 ;[59] ...
;[82] .byte shocsk-shocmb,shocsk-shocmb ;[68] ofset into jmp table
.word shddsk ;[82]
.byte $07 ;[55] Add the 'SHOW PRINTER' option
.asciz /PRINTER/ ;[55]
;[65] .byte $ab,$ab ;[55]
;[82] .byte shocrn-shocmb,shocrn-shocmb ;[65]
.word shprn ;[82]
.byte 8 ;[83] Add the 'SHOW protocol' option
.asciz /PROTOCOL/ ;[83]
.word shprt ;[83]
.byte $07
.asciz /RECEIVE/
;[68] .byte $24,$24
;[82] .byte shorc-shocmb,shorc-shocmb ;[68] ofset into jmp table
.word shrc ;[82]
.byte $04
.asciz /SEND/
;[68] .byte $2d,$2d
;[82] .byte shosn-shocmb,shosn-shocmb ;[68] ofset into jmp table
.word shsn ;[82]
.byte $04 ;[12] Add the 'SHOW SLOT' option
.asciz /SLOT/ ;[12] ...
;[64] .byte $6c,$6c ;[12] ...
;[82] .byte shocot-shocmb,shocot-shocmb ;[65] ...
.word shslot ;[82]
.byte 15 ;[73]
.asciz /SWAPKEYS-BS&DEL/ ;[73]
;[82] .byte shoswp-shocmb,shoswp-shocmb ;[73]
.word shswp ;[82]
.byte 8 ;[76]
.asciz /TERMINAL/ ;[76]
;[82] .byte shovt-shocmb,shovt-shocmb ;[76] ofset into jmp table
.word shvt ;[82]
.byte $5 ;[64]
.asciz /TIMER/ ;[64]
;[65] .byte $c6,$c6 ;[64] offset into shocmb table
;[82] .byte shocmr-shocmb,shocmr-shocmb ;[65] offset into shocmb table
.word shtmr ;[82]
.byte 6 ;[85]
.asciz /TIMING/ ;[85]
.word shtmct ;[85]
.byte 7 ;[87]
.asciz /VOLUMES/ ;[87]
.word shvols ;[87]
;[76] .byte $0E
;[76] .asciz /VT52-EMULATION/
;[76];[68] .byte $36,$36
;[76] .byte shovt-shocmb,shovt-shocmb ;[68] ofset into jmp table
;[82]stscmd: .byte $07
stscmd: .byte 9 ;[84][82] number in table
.byte 10 ;[84]
.byte "CR<->CR,LF",0 ;[84]
.byte 24,24 ;[84] offset for jump table
shin08 ;[87]
;[87] .byte $14
;[87] .asciz /EIGHT-BIT-QUOTE-CHAR/
.byte 15 ;[87]
.asciz /EIGHT-BIT-QUOTE/ ;[87]
.byte $06,$06
shin09 ;[87]
.byte $0B
.asciz /END-OF-LINE/
.byte $09,$09
shin10 ;[87]
.byte $0D
.asciz /PACKET-LENGTH/
.byte $0C,$0C
shin11 ;[87]
.byte $08
.asciz /PAD-CHAR/
.byte $00,$00
shin12 ;[87]
.byte $07
.asciz /PADDING/
.byte $03,$03
shin13 ;[87]
.byte $0A
.asciz /QUOTE-CHAR/
.byte $0F,$0F
shin2h ;[87]
.byte 15 ;[82] number of chs
.asciz /START-OF-PACKET/ ;[82]
.byte 21,21 ;[82] offset for jump table
shin14 ;[87]
.byte $07
.asciz /TIMEOUT/
.byte $12,$12
;[78]ftcmd: .byte $04
ftcmd: .byte $05
;ftcmd: .byte 6 ;[82]
.byte $09
.asciz /APPLESOFT/
;[82] .byte $02,$02
.byte $02,0 ;[82] turn ascii off
; .byte 5 ;[82] define ascii as special text
; .asciz /ASCII/ ;[82]
; .byte 0,1 ;[82]
.byte $06
.asciz /BINARY/
;[82] .byte $04,$04
.byte $04,0 ;[82]
.byte $07
.asciz /INTEGER/
;[82] .byte $01,$01
.byte $01,0 ;[82]
.byte 5 ;[78]
.asciz /OTHER/ ;[78]
;[82] .byte $ff,$ff ;[78]
.byte $ff,0 ;[82]
.byte $04
ftcdef: .asciz /TEXT/ ;[13] Default for File-type
.byte $00,$00
prcmd: .byte 2 ;[83]
.byte 6 ;[83]
prcdef .asciz /KERMIT/ ;[83]
.byte 0,0 ;[83]
.byte $06 ;[83]
prclen = .-prcdef ;[83] allow for 1 trailing nul
.asciz /XMODEM/ ;[83]
.byte 0,1 ;[83]
baukey: .byte 13 ;[47] entries in this table
.byte 3 ;[47] bytes long
.asciz /110/ ;[47]
.byte 3,3 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /1200/ ;[47]
.byte 8,8 ;[47] ssc entry for the baud
.byte 5 ;[47] bytes long
.asciz /134.5/ ;[47]
.byte 4,4 ;[47] ssc entry for the baud
.byte 3 ;[47] 3 bytes long
.asciz /150/ ;[47]
.byte 5,5 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /1800/ ;[47]
.byte 9,9 ;[47] ssc entry for the baud
.byte 5 ;[47] bytes long
.asciz /19200/ ;[47]
.byte 15,15 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /2400/ ;[47]
.byte 10,10 ;[47] ssc entry for the baud
.byte 3 ;[47] bytes long
.asciz /300/ ;[47]
.byte 6,6 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /3600/ ;[47]
.byte 11,11 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /4800/ ;[47]
.byte 12,12 ;[47] ssc entry for the baud
.byte 3 ;[47] bytes long
.asciz /600/ ;[47]
.byte 7,7 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /7200/ ;[47]
.byte 13,13 ;[47] ssc entry for the baud
.byte 4 ;[47] bytes long
.asciz /9600/ ;[47]
.byte 14,14 ;[47] ssc entry for the baud
parkey: .byte $05 ;[21] Length of this table is 5
.byte $04 ;[21]
.asciz /EVEN/ ;[21]
.byte $04,$04 ;[21]
.byte $04 ;[21]
.asciz /MARK/ ;[21]
.byte $02,$02 ;[21]
.byte $04 ;[21]
.asciz /NONE/ ;[21]
.byte $00,$00 ;[21]
.byte $03 ;[21]
.asciz /ODD/ ;[21]
.byte $03,$03 ;[21]
.byte $05 ;[21]
.asciz /SPACE/ ;[21]
.byte $01,$01 ;[21]
debkey: .byte $03 ;[26] Length of this table is 3
.byte $03 ;[26]
.asciz /OFF/ ;[26]
.byte $00,$00 ;[26]
.byte $05 ;[26]
.asciz /TERSE/ ;[26]
.byte $01,$01 ;[26]
.byte $07 ;[26]
.asciz /VERBOSE/ ;[26]
.byte $02,$02 ;[26]
;[78]terkey .byte 4 ;[76] 4 entries
terkey .byte 5 ;[78] 4 entries
.byte 7 ;[76] length is 7
terstr .asciz /MONITOR/ ;[76] make sure all are same len
.byte 0,0 ;[76] no terminal emulation
.byte 7 ;[76] length is 7
terlen = .-terstr ;[76] length of string
.asciz /NONE / ;[76]
.byte 0,1 ;[76] no terminal emulation
.byte 7 ;[76]
.asciz /VT100 / ;[76]
.byte 0,2 ;[76] vt100 flag will be 2
.byte 7 ;[76]
.asciz /VT52 / ;[76]
.byte 0,3 ;[76] vt52 flag will be 3
.byte 7 ;[78]
.asciz /WRAP / ;[78]
.byte 0,4 ;[78] wraparound
kbkey: .byte $02 ;[35] Entries in keyboard type table.
.byte $02 ;[35]
.asciz /2E/ ;[35] Apple 2E keyboard
.byte $03,kbap2e ;[35]
.byte $02 ;[35]
.asciz /2P/ ;[35] Apple 2/2+ keyboard
.byte $00,kbap2p ;[35]
; These must be in alpa order ;[49]
dspkey: .byte $03 ;[49] [46] display type entries
.byte 12 ;[49] [46] 2e/2c full display, 40 columns
.asciz /2E-40-COL / ;[46]
.byte $03,ds40mx ;[46]
.byte 12 ;[49] [46] loosing, 2/2+ 40 columns
.asciz /2P-40-COL / ;[46]
.byte $0,ds40up ;[46]
.byte 12 ;[49] 2e/2c full display, 80 columns
.asciz /80-COL-SLOT / ;[49]
.byte $6,ds80mx ;[49]
; These must be in alpa order ;[55]
prnkey: .byte $03 ;[55] printer entries
.byte 3 ;[55]
.asciz /OFF/ ;[55]
.byte $0,0 ;[55]
.byte 2 ;[55]
.asciz /ON/ ;[55]
.byte $03,0 ;[55]
.byte 4 ;[55]
prnslm: .asciz /SLOT/ ;[55]
.byte $6,0 ;[55]
flokey: .byte 3 ;[57]
.byte 3 ;[57]
.asciz /OFF/ ;[57]
.byte 0,0 ;[57]
.byte 8 ;[57]
floxon: .asciz /XON&XOFF/ ;[57]
.byte 3,1 ;[57]
.byte 5 ;[57]
flodly: .asciz /DELAY/ ;[57]
.byte 6,2 ;[57]
;[65]fbskey: .byte $02
;[65] .byte $09
;[65] .asciz /EIGHT-BIT/
;[65] .byte $00,$00
;[65] .byte $09
;[65] .asciz /SEVEN-BIT/
;[65] .byte $01,$01
oncmd: .byte $02
.byte $02
.asciz /ON/
.byte $01,$01
.byte $03
.asciz /OFF/
.byte $00,$00
yescmd: .byte $02
.byte $02
.asciz /NO/
.byte $00,$00
.byte $03
.asciz /YES/
.byte $01,$01
ddskey: .byte $03 ;[60] [40] Two options for now
.byte $05 ;[40] Length
.asciz /DRIVE/ ;[40] Keyword
.byte $00,$00 ;[40] Data
.byte $04 ;[40] Length
.asciz /SLOT/ ;[40] Keyword
.byte $03,$03 ;[40] Data
.byte 3 ;[60]
.asciz /VOL/ ;[60]
.byte 6,6 ;[60]
kerehr: .byte cmcfm ;[13] Tell them they can also confirm
.byte nul ;[13] End Help command string
.ifeq 1 ;[85] help now in file kermit.help
kerhlp: .byte hcr
.ifeq akhelp ;[78] use alans help
nasc < [USE <CNTL-S> 0 ;[78]
.byte '> ;[78]
nasc < TO PAUSE]> 0 ;[78]
.byte hcr ;[78]
nasc <? GIVE OPTIONS AT ANY POINT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <SET ? GIVE 'SET' OPTIONS> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
;[81] nasc <SHOW ALL SHOW ALL PRESENTLY 'SET'> 0 ;[78]
nasc <SHOW ALL SHOWS ALL PRESENTLY 'SET'> 0 ;[81]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <<ESC> 0 ;[78]
.byte '> ;[78]
nasc < COMPLETES COMMAND> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <STATUS LAST FILE TRANSFER INFO> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <--> 0 ;[78]
.byte '>,' ,'-,'-,'> ;[78]
nasc < [II+ ONLY] SHIFT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <---IN/OUT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <FROM KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
;[81] nasc < YOU CANNOT TALK TO DOS> 0 ;[78]
nasc < YOU CAN TALK TO OS & MODEM AS FOLLOWS:> 0 ;[81]
.byte hcr ;[78]
;[81] nasc <(TO CATALOG OR> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < BSAVE ALTERED.KERMIT,A$1000,L$6900)> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc <AND, YOU CANNOT TALK TO YOUR MODEM> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc <(TO DIAL AND TALK TO MAINFRAME).> 0 ;[78]
;[81] .byte hcr ;[78]
.byte hcr ;[78]
;[81] nasc <GET BACK & FORTH WITH:> 0 ;[78]
;[81] .byte hcr ;[78]
.byte hcr ;[78]
nasc <EXIT [TO DOS/PRODOS]> 0 ;[78]
.byte hcr ;[78]
nasc <CALL4096 [TO KERMIT-65]> 0 ;[78]
.byte hcr ;[78]
nasc <BRUN KERMIT384 [SOMETIMES-TO KERMIT-65]> 0 ;[81]
.byte hcr ;[81]
.byte hcr ;[78]
nasc <CONNECT [TO MODEM]> 0 ;[78]
.byte hcr ;[78]
nasc <<CNTL-@> 0 ;[78]
.byte '> ;[78]
nasc <C [TO KERMIT-65]> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <---UP/DOWN LOAD SEQUENCE> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <[PROMPT YOU SEE]> 0 ;[78]
.byte hcr ;[78]
nasc <. [WHAT YOU TYPE]> 0 ;[78]
.byte hcr ;[78]
;[81] nasc < [COMMENT]> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc <. . .> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc <. . .> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
nasc < CONNECT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <NO PROMPT> 0 ;[78]
.byte hcr ;[78]
nasc < ATD555-1234> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [HAYES DIAL]> 0 ;[78]
nasc < [HAYES DIAL]> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <% [MAINFRAME PROMPT-USE LOWER CASE]> 0 ;[78]
.byte hcr ;[78]
nasc < LOGIN> 0 ;[78]
.byte hcr ;[78]
nasc < PASSWORD> 0 ;[78]
.byte hcr ;[78]
;[81] nasc < KERMIT R> 0 ;[78]
nasc < KERMIT R [HOST DEPENDENT]> 0 ;[81]
.byte hcr ;[78]
nasc < <CNTL-@> 0 ;[78]
.byte '>,'C ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
nasc < SEND FOO> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [UPLOAD FILE NAMED "FOO"]> 0 ;[78]
nasc < [UPLOAD FILE NAMED "FOO"]> 0 ;[78]
.byte hcr ;[78]
;[81] nasc < EXIT> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] .byte hcr ;[78]
;[81] nasc <] [DOS PROMPT]> 0 ;[78]
;[81] .byte hcr ;[78]
nasc <KERMIT-65> 0 ;[81]
.byte '> ;[81]
.byte hcr ;[81]
nasc < CATALOG> 0 ;[78]
.byte hcr ;[78]
;[81] nasc < CALL4096> 0 ;[78]
;[81] .byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
nasc < CONNECT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <%> 0 ;[78]
.byte hcr ;[78]
;[81] nasc < KERMIT S FOO> 0 ;[78]
nasc < KERMIT S FOO [HOST DEPENDENT]> 0 ;[81]
.byte hcr ;[78]
;[81] nasc < [DOWNLOAD]> 0 ;[78]
;[81] .byte hcr ;[78]
nasc < <CNTL-@> 0 ;[78]
.byte '>,'C ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
nasc < RECEIVE> 0 ;[78]
nasc < [DOWNLOADS FILE NAMED "FOO"]> 0 ;[81]
.byte hcr ;[78]
nasc < CONNECT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <%> 0 ;[78]
.byte hcr ;[78]
nasc < +++ATH0> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [HAYES HANGUP]> 0 ;[78]
nasc < [HAYES HANGUP]> 0 ;[78]
.byte hcr ;[78]
nasc < <CNTL-@> 0 ;[78]
.byte '>,'C ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <---LOG TO DISK> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
.byte hcr ;[78]
nasc < LOG FOO> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [OPEN LOG: "FOO"]> 0 ;[78]
nasc < [OPEN LOG: "FOO"]> 0 ;[78]
.byte hcr ;[78]
nasc < CONNECT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <%> 0 ;[78]
.byte hcr ;[78]
nasc < CAT FOO> 0 ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [MAINFRAME PRINTS "FOO"]> 0 ;[78]
nasc < [MAINFRAME PRINTS "FOO"]> 0 ;[81]
.byte hcr ;[78]
nasc < <CNTL-@> 0 ;[78]
.byte '>,'C ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
nasc <KERMIT-65> 0 ;[78]
.byte '> ;[78]
;[81] .byte hcr ;[78]
;[81] nasc < [LOG ENDS]> 0 ;[78]
nasc < [LOG ENDS]> 0 ;[78]
.byte hcr ;[78]
nasc < CONNECT> 0 ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
;[81] nasc <%> 0 ;[78]
nasc <% ...> 0 ;[81]
.byte hcr ;[78]
.byte hcr ;[78]
.byte hcr ;[78]
.endc ;[78]
.ifne akhelp ;[78]
nasc <KERMIT COMMANDS FOR THIS VERSION ARE:> 0
.byte hcr
.byte hcr
nasc <BYE SHUT DOWN AND LOG OUT A> 0 ;[14] New command
.byte hcr ;[14]
nasc < REMOTE KERMIT SERVER, THEN> 0 ;[14]
.byte hcr ;[14]
nasc < EXIT.> 0 ;[14]
.byte hcr ;[14]
.byte hcr ;[14]
nasc <CONNECT ALLOW USER TO TALK TO REMOTE> 0
.byte hcr
nasc < KERMIT DIRECTLY.> 0
.byte hcr
.byte hcr
nasc <EXIT EXIT FROM KERMIT BACK TO> 0
.byte hcr
nasc < THE HOST OPERATING SYSTEM.> 0
.byte hcr
.byte hcr
nasc <FINISH SHUT DOWN REMOTE KERMIT> 0 ;[14] New command
.byte hcr ;[14]
nasc < SERVER BUT DO NOT LOG OUT> 0 ;[14]
.byte hcr ;[14]
nasc < REMOTE JOB. DO NOT EXIT FROM> 0 ;[14]
.byte hcr ;[14]
nasc < LOCAL KERMIT.> 0 ;[14]
.byte hcr ;[14]
.byte hcr ;[14]
nasc <GET FETCH A FILE FROM A REMOTE> 0 ;[14] New command
.byte hcr ;[14]
nasc < SERVER KERMIT. THE FILENAME> 0 ;[14]
.byte hcr ;[14]
nasc < IS VALIDATED BY THE REMOTE> 0 ;[14]
.byte hcr ;[14]
nasc < SERVER.> 0 ;[14]
.byte hcr ;[14]
.byte hcr ;[14]
nasc <HELP PRINT INSTRUCTIONS ON> 0
.byte hcr
nasc < VARIOUS COMMANDS AVAILABLE> 0
.byte hcr
nasc < IN KERMIT.> 0
.byte hcr
.byte hcr
nasc <LOG COPY REMOTE SESSION TO DISK> 0
.byte hcr
.byte hcr
nasc <QUIT SAME AS EXIT.> 0
.byte hcr
.byte hcr
nasc <RECEIVE RECEIVE A FILE OR FILE GROUP> 0
.byte hcr
nasc < FROM THE REMOTE HOST.> 0
.byte hcr
.byte hcr
nasc <SEND SENDS A FILE FROM THE M6502> 0
.byte hcr
nasc < BASED COMPUTER TO THE REMOTE> 0
.byte hcr
nasc < HOST.> 0
.byte hcr
.byte hcr
nasc <SERVER USE AS A FILE SERVER ETC.> 0
.BYTE hcr
.byte hcr
nasc <SET ESTABLISH VARIOUS PARAMETERS,> 0
.byte hcr
nasc < SUCH AS DEBBUGING MODE, EOL> 0
.byte hcr
nasc < CHARACTER, AND TRANSMISSION> 0
.byte hcr
nasc < DELAY.> 0
.byte hcr
.byte hcr
nasc <SHOW DISPLAY VARIOUS PARAMETERS> 0
.byte hcr
nasc < ESTABLISHED BY THE SET> 0
.byte hcr
nasc < COMMAND.> 0
.byte hcr
.byte hcr
nasc <STATUS GIVE INFORMATION ABOUT THE> 0
.byte hcr
nasc < LAST FILE TRANSFER.> 0
.endc ;[78]
.byte hcr,nul
.endc ;[85]
inthlp: nasc <CHOSE ONE OF THE FOLLOWING:> 0
.byte hcr
;[80] nasc < ? - THIS HELP MESSAGE> 0
;[80] .byte hcr
;[85] nasc < 0 - NULL CHAR> 0
;[87] nasc < 0-NULL CHAR> 0 ;[85]
nasc < 0-NULL CHAR> 0 ;[87]
.byte hcr
;[85] nasc < B - BREAK SIGNAL> 0
;[87] nasc < B-BREAK SIGNAL> 0 ;[85]
nasc < B-BREAK SIGNAL> 0 ;[87]
.byte hcr
;[85] nasc < C - CLOSE CONNECTION> 0
;[86] nasc < C-CLOSE CONNECTION> 0 ;[85]
;[87] nasc < C-COMMAND MODE> 0 ;[86]
nasc < C-COMMAND MODE> 0 ;[87]
.byte hcr ;[48]
;[85] nasc < D - DROP LINE> 0 ;[48]
;[87] nasc < D-DROP LINE> 0 ;[48] ;[85]
nasc < D-DROP LINE> 0 ;[87]
.byte hcr ;[48]
;[85] nasc < E - R(E)STORE SCREEN> 0 ;[83]
;[86] nasc < E-R(E)STORE SCREEN> 0 ;[83] ;[85]
;[87] nasc < E-ERASE SCREEN> 0 ;[86][85][83]
nasc < E-ERASE SCREEN> 0 ;[87]
.byte hcr ;[83]
;[85] nasc < K - KEYPAD APPLICATION TOGGLE> 0 ;[81]
;[87] nasc < K-KEYPAD APPLICATION TOGGLE> 0 ;[81] ;[85]
nasc < K-KEYPAD APPLICATION TOGGLE> 0 ;[87]
.byte hcr ;[81]
;[87] nasc < M-MODEM COMMAND> 0 ;[86]
nasc < M-MODEM COMMAND> 0 ;[87]
.byte hcr ;[86]
;[81] nasc < P - PRINTER TOGGLE ON/OFF> 0 ;[55]
;[85] nasc < P - PRINTER TOGGLE> 0 ;[81]
;[87] nasc < P-PRINTER TOGGLE> 0 ;[81] ;[85]
nasc < P-PRINTER TOGGLE> 0 ;[87]
.byte hcr
;[87] nasc < Q-QUIT> 0 ;[86]
nasc < Q-QUIT> 0 ;[87]
.byte hcr ;[86]
;[85] nasc < R - P(R)INT SCREEN> 0 ;[80]
;[87] nasc < R-P(R)INT SCREEN> 0 ;[80] ;[85]
nasc < R-P(R)INT SCREEN> 0 ;[87]
.byte hcr ;[80]
;[85] nasc < S - STATUS> 0
;[87] nasc < S-STATUS> 0 ;[85]
nasc < S-STATUS> 0 ;[87]
.byte hcr ;[87]
nasc < V-CURSOR-KEYS-(V)T100 TOGGLE> 0 ;[87]
.byte hcr
;[85] nasc < W - S(W)AP BS & DEL KEYS> 0 ;[76]
;[87] nasc < W-S(W)AP BS & DEL KEYS> 0 ;[76] ;[85]
nasc < W-S(W)AP BS & DEL KEYS> 0 ;[87]
.byte hcr ;[76]
;[87] nasc < ESCAPE-CHAR - TRANSMIT THE ESCAPE CHAR> 0
nasc < ESCAPE-CHAR - TRANSMIT THE ESCAPE CHAR> 0
.byte hcr,nul
.SBTTL Message text
ermes1: .byte hcr
nasc <?UNRECOGNIZED COMMAND> 1
ermes2: .byte hcr
nasc <?ILLEGAL CHARACTER> 1
ermes3: .byte hcr
nasc <?NOT CONFIRMED> 1
ermes4: .byte hcr
nasc <?INTEGER OUT OF RANGE> 1
ermes5: .byte hcr
nasc <?ASCII CHARACTER IS NOT IN PROPER RANGE> 1
ermes6: .byte hcr
nasc <?EXPECTING KEYWORD> 1
ermes7: .byte hcr
nasc <?EXPECTING FILE SPEC> 1
ermes8: .byte hcr
nasc <?EXPECTING INTEGER> 1
ermes9: .byte hcr
nasc <?EXPECTING SWITCH> 1
ermesa: .byte hcr
nasc <?DEVICE DRIVER NOT LOADED> 1
ermesb: .byte hcr ;[13]
nasc <?NULL STRING FOUND WHILE LOOKING FOR TEXT> 1 ;[13]
ermesc: .byte hcr ;[14]
nasc <?COULD NOT SEND GENERIC LOGOUT/FINISH PACKET> 1 ;[67][14]
;[67]ermesd: .byte hcr ;[14]
;[67] nasc <?COULD NOT SEND GENERIC FINISH PACKET> 1 ;[14]
ermese: .byte hcr ;[40]
nasc <?SLOT NUMBER OUT OF RANGE> 1 ;[40]
ermesf: .byte hcr ;[40]
nasc <?DRIVE NUMBER OUT OF RANGE> 1 ;[40]
;[59] these messages must be kept in order ****** begin
erms0a: nasc < > 1
erms10: nasc <CANNOT RECEIVE INIT > 1
erms11: nasc <CANNOT RECEIVE FILE-HEAD> 1
erms12: nasc <CANNOT RECEIVE DATA > 1
erms14: nasc <MAX RETRY COUNT EXCEEDED> 1
erms15: nasc <BAD CHKSUM:PACK, ACTUAL > 1
erms16: nasc <PROGRAM ERROR IN RPAK > 1
erms17: nasc <8-BIT QUOTING REFUSED > 1
erms18: nasc <TRANSFER ABORTED BY USER> 1
erms19: nasc <CANNOT ALTER FILENAME > 1
erms1a: nasc <FILE ALREADY EXISTS > 1
nasc <FILE TRANSFER TIMEOUT > 1 ;[64]
;[59] last of the error msgs but start of dos msgs
.ifeq <ftcom-ftappl>
dskers: nasc < > 1
nasc <BAD CALL TYPE > 1
nasc <BAD SUB-CALL TYPE > 1
nasc <WRITE PROTECTED > 1
nasc <END OF DATA > 1
nasc <FILE NOT FOUND > 1
nasc <VOLUME MISMATCH > 1
nasc <DISK I/O > 1
nasc <DISK FULL > 1
nasc <FILE LOCKED > 1
nasc <INVALID PATHNAME > 1
nasc <INCOMPATIBLE FILE FORMAT> 1
nasc <FILE ALREADY OPEN > 1
;[59] these messages must be kept in order ****** end
.ifeq funkey ;[73]
sfkls .byte '0 ;[73]
.byte '1 ;[73]
.byte '2 ;[73]
.byte '3 ;[73]
.byte '4 ;[73]
.byte '5 ;[73]
.byte '6 ;[73]
.byte '7 ;[73]
.byte '8 ;[73]
.byte '9 ;[73]
.byte 'y ;[73]
.byte 'u ;[73]
.byte 'i ;[73]
.byte 'o ;[73]
.byte 'h ;[73]
.byte 'j ;[73]
.byte 'k ;[73]
.byte 'l ;[73]
.byte 'n ;[73]
.byte 'm ;[73]
.byte 'Y ;[73]
.byte 'U ;[73]
.byte 'I ;[73]
.byte 'O ;[73]
.byte 'H ;[73]
.byte 'J ;[73]
.byte 'K ;[73]
.byte 'L ;[73]
.byte 'N ;[73]
.byte 'M ;[73]
.byte ', ;[73]
.byte '. ;[73]
.byte sp ;[73]
.byte '0 ;[73]
.byte '- ;[73]
.byte ctrlu ;[76] right arrow
.byte bs ;[76] left arrow
;[80] .byte $7f ;[76] del since swap may be on
.byte ctrlk ;[76] up arrow
.byte lf ;[76] down arrow
efkls ;[73]
.word zrfks ;[73]
.word onfks ;[73]
.word twfks ;[73]
.word trfks ;[73]
.word fufks ;[73]
.word fvfks ;[73]
.word sxfks ;[73]
.word svfks ;[73]
.word egfks ;[73]
.word nnfks ;[73]
.word yfks ;[73]
.word ufks ;[73]
.word ifks ;[73]
.word ofks ;[73]
.word hfks ;[73]
.word jfks ;[73]
.word kfks ;[73]
.word lfks ;[73]
.word nfks ;[73]
.word mfks ;[73]
.word yfks ;[73]
.word ufks ;[73]
.word ifks ;[73]
.word ofks ;[73]
.word hfks ;[73]
.word jfks ;[73]
.word kfks ;[73]
.word lfks ;[73]
.word nfks ;[73]
.word mfks ;[73]
.word comfks ;[73]
.word perfks ;[73]
.word spfks ;[73]
.word cufks ;[73]
.word bsfks ;[73]
.word lfks ;[76]
.word perfks ;[76]
;[80] .word perfks ;[76]
.word ckfks ;[76]
.word cjfks ;[76]
zrfks .byte $1b,'~,0 ;[73]
onfks .byte $1b,'S,0 ;[73]
twfks .byte $1b,'T,0 ;[73]
trfks .byte $1b,'U,0 ;[73]
fufks .byte $1b,'V,0 ;[73]
fvfks .byte $1b,'W,0 ;[73]
sxfks .byte $1b,'P,0 ;[73]
svfks .byte $1b,'Q,0 ;[73]
egfks .byte $1b,'R,0 ;[73]
nnfks .byte $1b,'A,0 ;[73]
yfks .byte $1b,'?,'w,0 ;[73]
ufks .byte $1b,'?,'x,0 ;[73]
ifks .byte $1b,'?,'y,0 ;[73]
ofks .byte $1b,'B,0 ;[73]
hfks .byte $1b,'?,'t,0 ;[73]
jfks .byte $1b,'?,'u,0 ;[73]
kfks .byte $1b,'?,'v,0 ;[73]
lfks .byte $1b,'C,0 ;[73]
nfks .byte $1b,'?,'q,0 ;[73]
mfks .byte $1b,'?,'r,0 ;[73]
comfks .byte $1b,'?,'s,0 ;[73]
perfks .byte $1b,'D,0 ;[73]
spfks .byte $1b,'?,'p,0 ;[73]
cufks .byte $1b,'?,'n,0 ;[73]
bsfks .byte $1b,'?,'M,0 ;[73]
ckfks .byte $1b,'A,0 ;[73]
cjfks .byte $1b,'B,0 ;[73]
sfklsc ;[76] one to one correspondence to efklsc
.byte ctrlu ;[76] right arrow
.byte bs ;[76] left arrow
.byte ctrlk ;[76] up arrow
.byte lf ;[76] down arrow
;[80] .byte $7f ;[76] del since swap may be on
.byte '6 ;[76]
.byte '7 ;[76]
.byte '8 ;[76]
.byte '9 ;[76]
.byte 'y ;[76]
.byte 'u ;[76]
.byte 'i ;[76]
.byte 'o ;[76]
.byte 'h ;[76]
.byte 'j ;[76]
.byte 'k ;[76]
.byte 'l ;[76]
.byte 'n ;[76]
.byte 'm ;[76]
.byte ', ;[76]
.byte '. ;[76]
.byte sp ;[76]
.byte '0 ;[76] this is the . sigh!
.byte 'Y ;[76] repeat these for upper case also
.byte 'U ;[76] "
.byte 'I ;[76]
.byte 'O ;[76]
.byte 'H ;[76]
.byte 'J ;[76]
.byte 'K ;[76]
.byte 'L ;[76]
.byte 'N ;[76]
.byte 'M ;[76]
;[80] .byte ', ;[76]
;[80] .byte '. ;[76]
;[80] .byte sp ;[76]
;[80] .byte ctrlu ;[76] right arrow
;[80] .byte bs ;[76] left arrow
;[80] .byte $7f ;[76] del since swap may be on
;[80] .byte ctrlk ;[76] up arrow
;[80] .byte lf ;[76] down arrow
efklsc ;[76] one to one correspondence to sfklsc
.word cufksc ;[80]
.word bsfksc ;[80]
.word ckfksc ;[80]
.word cjfksc ;[80]
.word sxfksc ;[76]
.word svfksc ;[76]
.word egfksc ;[76]
.word nnfksc ;[76]
.word yfksc ;[76]
.word ufksc ;[76]
.word ifksc ;[76]
.word ofksc ;[76]
.word hfksc ;[76]
.word jfksc ;[76]
.word kfksc ;[76]
.word lfksc ;[76]
.word nfksc ;[76]
.word mfksc ;[76]
.word comfkc ;[80]
.word perfkc ;[80]
.word spfksc ;[80]
.word zrfksc ;[76] one to one correspondence to sfklsc
.word yfksc ;[76]
.word ufksc ;[76]
.word ifksc ;[76]
.word ofksc ;[76]
.word hfksc ;[76]
.word jfksc ;[76]
.word kfksc ;[76]
.word lfksc ;[76]
.word nfksc ;[76]
.word mfksc ;[76]
;[80] .word comfkc ;[76]
;[80] .word perfkc ;[76]
;[80] .word spfksc ;[76]
;[80] .word cufksc ;[76]
;[80] .word bsfksc ;[76]
;[80] .word bsfksc ;[76]
;[80] .word ckfksc ;[76]
;[80] .word cjfksc ;[76]
zrfksc .byte $1b,'O,'n,0 ;[76] period key aux keypad code
sxfksc .byte $1b,'O,'P,0 ;[76]
svfksc .byte $1b,'O,'Q,0 ;[76]
egfksc .byte $1b,'O,'R,0 ;[76]
nnfksc .byte $1b,'O,'S,0 ;[76]
yfksc .byte $1b,'O,'w,0 ;[76]
ufksc .byte $1b,'O,'x,0 ;[76]
ifksc .byte $1b,'O,'y,0 ;[76]
ofksc .byte $1b,'O,'m,0 ;[76] should be - key pad
hfksc .byte $1b,'O,'t,0 ;[76]
jfksc .byte $1b,'O,'u,0 ;[76]
kfksc .byte $1b,'O,'v,0 ;[76]
lfksc .byte $1b,'O,'l,0 ;[76]
nfksc .byte $1b,'O,'q,0 ;[76]
mfksc .byte $1b,'O,'r,0 ;[76]
comfkc .byte $1b,'O,'s,0 ;[76]
perfkc .byte $1b,'O,'M,0 ;[76] the enter key
spfksc .byte $1b,'O,'p,0 ;[76]
;[84]cufksc .byte $1b,'O,'C,0 ;[76]
;[84]bsfksc .byte $1b,'O,'D,0 ;[76]
;[84]cjfksc .byte $1b,'O,'B,0 ;[76]
;[84]ckfksc .byte $1b,'O,'A,0 ;[76]
cufksc .byte $1b,'[,'C,0 ;[84] make the default reset
bsfksc .byte $1b,'[,'D,0 ;[84]
cjfksc .byte $1b,'[,'B,0 ;[84]
ckfksc .byte $1b,'[,'A,0 ;[84]
sfklsk ;[80] one to one correspondence to efklsc
.byte ctrlu ;[80] right arrow
.byte bs ;[80] left arrow
.byte ctrlk ;[80] up arrow
.byte lf ;[80] down arrow
efkckk ;[80] end of cursor keys
.byte $18 ;[80] clear is really CAN
.byte '= ;[80]
.byte '/ ;[80]
.byte '* ;[80]
.byte '7 ;[80]
.byte '8 ;[80]
.byte '9 ;[80]
.byte '+ ;[80]
.byte '4 ;[80]
.byte '5 ;[80]
.byte '6 ;[80]
.byte '- ;[80]
.byte '1 ;[80]
.byte '2 ;[80]
.byte '3 ;[80]
.byte 13 ;[80] the enter (carrage return)
.byte '0 ;[80]
.byte '. ;[80] this is the . sigh!
efklsk ;[80]
.endc ;[73]
vtcoct ;[76] one ch table
.byte '[ ;[76] one to one correspondence to vtcoca
.byte 'H ;[76]
.byte 'D ;[76]
.byte 'E ;[76]
.byte 'M ;[76]
.byte esc ;[76]
.byte '= ;[76]
.byte '> ;[76]
.byte 'Z ;[76] this is vt52 identify request
.byte '7 ;[76]
.byte '8 ;[76]
.byte '< ;[76]
.byte '\ ;[76]
.byte '( ;[76]
.byte ') ;[76]
.byte 'c ;[76]
.byte '# ;[79]
vtcoca
.word vtcpsq ;[76] vt100 param seq
.word vtlh ;[76]
.word vtld ;[76]
.word vtle ;[76]
.word vtlm ;[76]
.word vtlesc ;[76] 2 esc in a row
;[80] .word vtccom ;[77][76] ignore alt keypad stuf
;[80] .word vtccom ;[77][76] "
.word vtc9 ;[80] keypad application mode
.word vtca ;[80] keypad numeric mode
.word vtc2lc ;[76] tell who we are
.word vtc7 ;[76] save cursor etc
.word vtc8 ;[76] restore cursor etc
.word vtccom ;[77][76] ignore ansi
.word vtccom ;[77][76] what is this ? exit hold screen mode???
.word vtcglp ;[76] sigh the graphics stuff ;[76]
.word vtcgrp ;[76] sigh the graphics stuff ;[76]
.word vtlc ;[76]
.word vtclb ;[79] sigh ignore line size stuff
vtctct ;[76]
.byte '; ;[76]
.byte 'B ;[76]
.byte 'D ;[76]
.byte 'C ;[76]
.byte 'H ;[76]
.byte 'f ;[76]
.byte 'A ;[76]
.byte 'J ;[76]
.byte 'K ;[76]
.byte 'g ;[76]
.byte 'm ;[76]
.byte '? ;[76]
.byte 'l ;[76]
.byte 'h ;[76]
.byte 'r ;[76]
.byte 'R ;[76]
.byte 'c ;[76]
.byte 'q ;[77]
.byte 'i ;[87]
vtctca .word vtc2bp ;[76] bump param #
.word vtc2b ;[76]
.word vtc2d ;[76]
.word vtc2c ;[76]
.word vtc2h ;[76]
.word vtc2h ;[76] same as above
.word vtc2a ;[76]
.word vtc2j ;[76]
.word vtc2k ;[76]
.word vtc2g ;[76]
.word vtc2m ;[76]
.word vtcqmk ;[76]
.word vtc2ll ;[76]
.word vtc2lh ;[76]
.word vtc2lr ;[76] lower case r
.word vtc2r ;[76]
.word vtc2lc ;[76] lower case c
.word vtccom ;[77] lower case q, just ignore it
.word vtc2i ;[87] vt102 printer on/off
vtcid .byte esc,'[,'?,'1,';,'0,'c,0 ;[76] term with a 0
vtcg1 ; G1 character set
.byte ' ,'*,'#,'.,'.,'.,'.,'`,'+,'.,'.,'+,'+,'+,'+,'+ ;[76]
.byte '~,'-,'-,'-,'_,'+,'+,'+,'+,'|,'<,'>,'P,'!,'$,'.,$7f ;[76]
erms1b: nasc <NOT SUPPORTED BY THIS DEVICE DRIVER> 1 ;[48]
erms1c: .byte hcr ;[57]
nasc <WARNING FLOW CONTROL PROBABLY REQUIRED> 1 ;[57]
erms1d: nasc <ERROR > 1 ;[59]
erms1e: nasc <TAIL OF FILE NAME CHANGED BECAUSE OF FILE WARNING > 1 ;[59]
;[65]erms1f: .byte hcr ;[59]
;[65] nasc <WARNING FILE-BYTE-SIZE OF EIGHT PROBABLY REQUIRED> 1 ;[59]
erms1g nasc <PRODOS ERROR & CALL ADDRESS:> 1 ;[59]
lerm1g = .-erms1g-1 ;[62] forget about the null
erms1h nasc <SERVER COMMAND UNKNOWN => 1 ;[62]
erms1i nasc <GENERIC KERMIT COMMAND OPERAND UNKNOWN => 1 ;[62]
erms1j nasc <UNABLE TO INITIALIZE COM CARD> 1 ;[62]
erms1k nasc <UNABLE TO SEND/RECEIVE 8 BITS> 1 ;[72]
erms1l nasc < MAX SIZE IS > 1 ;[75]
erms1m nasc <NOT DOS 3.3, WILDCARDS?? KEYPRESS(S)??> 1 ;[81]
kbds: nasc <2P > 1 ;[35] keyboard type strings
nasc <2E > 1 ;[35]
dsps: nasc <2P-40-COL > 1 ;[49] [46] Display type strings
nasc <2E-40-COL > 1 ;[49] [46]
nasc <80-COL-SLOT > 1 ;[49]
kerftp: nasc <TEXT > 1
nasc <INTEGER > 1
nasc <APPLESOFT > 1
nasc <OTHER = $> 1 ;[78]
nasc <BINARY > 1
kerprs: nasc <NONE > 1 ;[21] Parity strings
nasc <SPACE> 1 ;[21]
nasc <MARK > 1 ;[21]
nasc <ODD > 1 ;[21]
nasc <EVEN > 1 ;[21]
kerdms: nasc <OFF > 1 ;[26] Debug mode strings
nasc <TERSE > 1 ;[26]
nasc <VERBOSE > 1 ;[26]
.endc
kerrts: nasc <SPAK: SENDING - > 1
kerrns = .-kerrts ;[64] Routine name and action string length
nasc <SPAKCH: SEND COMPLETE - > 1
nasc <RPAK: TRYING TO RECEIVE - > 1
nasc <RPKFLS: FAILED TO RECEIVE - > 1
nasc <RPKRET: RECEIVED - > 1
;[64]kerbal = 6 ;[47] string length of following table
kerbau: nasc <110 > 1 ;[47]
kerbal = .-kerbau ;[64][47] string length of following table
nasc <134.5> 1 ;[47]
nasc <150 > 1 ;[47]
nasc <300 > 1 ;[47]
nasc <600 > 1 ;[47]
nasc <1200 > 1 ;[47]
nasc <1800 > 1 ;[47]
nasc <2400 > 1 ;[47]
nasc <3600 > 1 ;[47]
nasc <4800 > 1 ;[47]
nasc <7200 > 1 ;[47]
nasc <9600 > 1 ;[47]
nasc <19200> 1 ;[47]
debms1: nasc <ADDITIONAL DATA> 1
;[87]debms2: nasc < SEQ NUMBER > 1
debms2: nasc <SEQ NUMBER > 1 ;[87]
;[87]debms3: nasc < NUMBER OF DATA CHARS > 1
debms3: nasc <NUMBER OF DATA CHARS > 1 ;[87]
;[87]debms4: nasc < PACKET CHECKSUM > 1
debms4: nasc <PACKET CHECKSUM> 1 ;[87]
;[84]snin01: nasc <SENDING... PACKET NUMBER > 1
;[84]rcin01: nasc <WAITING... PACKET NUMBER > 1
;[87]snin01: nasc <SENDING NUMBER OF BYTES> 1
;[87]rcin01: nasc <RECEIVING NUMBER OF BYTES> 1
snin01: nasc <SENDING % NUMBER OF BYTES> 1 ;[87]
rcin01: nasc <RECEIVING % NUMBER OF BYTES> 1 ;[87]
;[87]erin01 nasc <RETRYS 0000> 1 ;[59]
erin01 nasc <RETRYS > 1 ;[87]
erin02 nasc <REMOTE MESSAGE > 1 ;[59]
;[87]shin00: nasc <DEBUGGING IS > 1
;[87]shin00: nasc <DEBUGGING IS > 1 ;[87]
;[76]shin01: nasc <VT52-EMULATION IS > 1
;[87]shin01: nasc <TERMINAL-EMULATION IS > 1
;[87]shin01: nasc <TERMINAL-EMULATION IS > 1 ;[87]
;[68]shin02: nasc <IBM-MODE IS > 1
;[87]shin03: nasc <LOCAL-ECHO IS > 1
;[87]shin03: nasc <LOCAL-ECHO IS > 1 ;[87]
;[72]shin04: nasc <EIGHT-BIT-QUOTING IS > 1
;[87]shin05: nasc <FILE-WARNING IS > 1
;[87]shin05: nasc <FILE-WARNING IS > 1 ;[87]
;[87]shin06: nasc <ESCAPE CHARACTER IS > 1
;[87]shin06: nasc <ESCAPE CHARACTER IS > 1 ;[87]
;[87]shin07: nasc <SEND> 1
;[87]shin08: nasc < EIGHT-BIT-QUOTING CHAR IS > 1
;[87]shin08: nasc <EIGHT-BIT-QUOTING CHAR IS > 1 ;[87]
;[87]shin09: nasc < END-OF-LINE CHAR IS > 1
;[87]shin09: nasc <END-OF-LINE CHAR IS > 1 ;[87]
;[87]shin10: nasc < PACKET-LENGTH IS > 1
;[87]shin10: nasc <PACKET-LENGTH IS > 1 ;[87]
;[87]shin11: nasc < PADDING CHAR IS > 1
;[87]shin11: nasc <PADDING CHAR IS> 1 ;[87]
;[87]shin12: nasc < AMOUNT OF PADDING IS > 1
;[87]shin12: nasc <AMOUNT OF PADDING IS > 1 ;[87]
;[87]shin13: nasc < QUOTE CHAR IS > 1
;[87]shin13: nasc <QUOTE CHAR IS > 1 ;[87]
;[87]shin14: nasc < TIMEOUT IN SECONDS IS > 1 ;[64]
;[87]shin14: nasc <TIMEOUT IN SECONDS IS> 1 ;[87]
;[87]shin2h: nasc < START-OF-PACKET CHAR IS > 1 ;[82]
;[87]shin2h: nasc <START-OF-PACKET CHAR IS > 1 ;[87]
;[87]shin2j: nasc < TRANSLATE CR<-> 0 ;[84]
shin2j: nasc <TRANSLATE CR<-> 0 ;[87]
.byte $80!'> ;[84] so we get the >
nasc <CR,LF IS > 1 ;[84]
;[87]shin15: nasc <RECEIVE> 1
;[87]shin16: nasc <FILE-TYPE MODE IS > 1
;[87]shin16: nasc <FILE-TYPE MODE IS > 1 ;[87]
;[65]shin17: nasc <FILE-BYTE-SIZE IS > 1
;[87]shin18: nasc <SLOT FOR I/O IS > 1 ;[12] Add for 'SHOW SLOT'
;[87]shin18: nasc <SLOT FOR I/O IS > 1 ;[87] Add for 'SHOW SLOT'
;[87]shin19: nasc <DEVICE-DRIVER IS > 1 ;[12] For 'SHOW DEVICE-DRIVER'
;[87]shin19: nasc <DEVICE-DRIVER IS > 1 ;[87] For 'SHOW DEVICE-DRIVER'
;[87]shin20: nasc <PARITY IS > 1 ;[21] For 'SHOW PARITY'
;[87]shin20: nasc <PARITY IS > 1 ;[87] For 'SHOW PARITY'
;[87]shin21: nasc <KEYBOARD TYPE IS > 1 ;[35] For 'SHOW KEYBOARD'.
;[87]shin21: nasc <KEYBOARD TYPE IS > 1 ;[87] For 'SHOW KEYBOARD'.
;[87]shin2a: nasc <DEFAULT PREFIX IS > 1 ;[59] For 'SHOW prefix'.
;[87]shin2a: nasc <DEFAULT PREFIX IS > 1 ;[87] For 'SHOW prefix'.
;[87]shin22: nasc <DEFAULT DRIVE SLOT= > 1 ;[40] Default drive
;[87]shin22: nasc <DEFAULT DRIVE SLOT= > 1 ;[87] Default drive
;[87]shin23: nasc < DRIVE= > 1 ;[40] messages
shin23: nasc < DRIVE= > 1 ;[87] messages
;[87]shi231: nasc < VOL= > 1 ;[60] messages
shi231: nasc < VOL= > 1 ;[87] messages
;[87]shin24: nasc <DISPLAY TYPE IS > 1 ;[46] For 'SHOW DISPLAY'.
;[87]shin24: nasc <DISPLAY TYPE IS > 1 ;[87] For 'SHOW DISPLAY'.
;[87]shin25: nasc <BAUD RATE IS > 1 ;[47] FOR SHOW
;[87]shin25: nasc <BAUD RATE IS > 1 ;[87] FOR SHOW
;[87]shin26: nasc <PRINTER IS > 1 ;[55] FOR SHOW
;[87]shin26: nasc <PRINTER IS > 1 ;[87] FOR SHOW
;[87]shin27: nasc <FLOW IS > 1 ;[57] FOR SHOW
;[87]shin27: nasc <FLOW IS > 1 ;[87] FOR SHOW
;[87]shin28: nasc <LOG IS > 1 ;[56] FOR SHOW log
;[87]shin28: nasc <LOG IS > 1 ;[87] FOR SHOW log
shin29: nasc <FILE=> 1 ;[56] for show log
;[87]shin2b: nasc <TIMER IS > 1 ;[64]
;[87]shin2b: nasc <TIMER IS > 1 ;[87]
;[87]shin2c nasc <SWAP KEYS BS & DEL IS > 1 ;[73]
;[87]shin2c nasc <SWAP KEYS BS & DEL IS > 1 ;[87]
shin2d nasc < WRAP-AROUND > 1 ;[78]
;[87]shin2e nasc <KEYPAD EXISTS? ON=YES > 1 ;[80]
;[87]shin2e nasc <KEYPAD EXISTS? ON=YES > 1 ;[87]
;shin2f nasc <KEYPAD-APPLICATION-MODE > 1 ;[80]
;[87]shin2f nasc <APPLICATION-MODE > 1 ;[81]
;[87]shin2g nasc <CURSOR-KEYS-VT100 > 1 ;[80]
;[87]shin2g nasc <CURSOR-KEYS-VT100 > 1 ;[87]
;[87]shin2i nasc <PROTOCOL IS > 1 ;[83]
;[87]shin2i nasc <PROTOCOL IS > 1 ;[87]
;[87]shin2k nasc <TIMING CONSTANT IS > 1 ;[85]
;[87]shin2k nasc <TIMING CONSTANT IS > 1 ;[87]
shin2l nasc <SLOT X,DRIVE X,> 0 ;[87] 1 of 2
shin2m nasc <VOLUME 123456789abcdef> 1 ;[87] 2 of 2
shin2o nasc < IS > 1 ;[87]
shoff: nasc <OFF > 1
shon: nasc <ON > 1
shsm01 nasc <SERVER MODE> 1 ;[75]
;[65]shsbit: nasc <SEVEN-BIT> 1
;[65]shebit: nasc <EIGHT-BIT> 1
sstrng: nasc <SENDING: > 1 ;[26] For Terse debug
rstrng: nasc <RECEIVED: > 1 ;[26] ...
stin00: nasc <NUMBER OF DATA CHARS SENT IS > 1
stin01: nasc <NUMBER OF DATA CHARS RECV'ED IS > 1
stin02: nasc <TOTAL NUMBER OF CHARS SENT IS > 1
stin03: nasc <TOTAL NUMBER OF CHARS RECV'ED IS > 1
stin04: nasc <OVERHEAD FOR SEND PACKETS IS > 1
stin05: nasc <OVERHEAD FOR RECEIVE PACKETS IS > 1
stin06: nasc <LAST ERROR ENCOUNTERED IS > 1
;[86]inf01a: nasc <[CONNECTING TO HOST: TYPE > 1
;[86]inf01b: nasc <C TO RETURN]> 1 ;[4] Second half of connect message
inf01a: nasc <[TERMINAL MODE:TYPE > 1 ;[86]
inf01b: nasc <C FOR COMMAND MODE]> 1;[86][4] Second half of connect message
endker: .byte ;[54] end of main kermit
.list
.SBTTL End of Kermit-65 Source