;*************************** AMUS Program Label ******************************
; Filename: KERMIT.M68                                      Date: 5/12/91
; Category: COMM         Hash Code: 006-140-356-372      Version: 1.0(14)        
; Initials: BOB/AM       Name: BOB RUBENDUNST
; Company: SOFT MACHINES                           Telephone #: 
; Related Files: NONE
; Min. Op. Sys.:                               Expertise Level: BEG
; Special: 
; Description: KERMIT telecommunications program
; 
; 
;*****************************************************************************
; Kermit.m68 - a telecommunications & error free file transfer program
; Version 1.0 - basic version to bridge the gap
; Author:	robert p. rubendunst, soft machines

; Based on kermit.c from Columbia University. Some obvious code optimization 
; and routine consolidation COULD have been done, but was not done to make
; conversion and documentation easier. However, this version of KERMIT does
; support eight-bit data paths, while kermit.c does not.

; Copyright 1984, 1991  Robert P. Rubendunst. All rights reserved. In
; addition, anthology copyrights prohibited without written permission from
; the author.

; Edit History:
; 	started 09-07-84 rpr
; 	first non-alpha communication 10/5/84 with ibm pc.
; 	added 7 bit mode to allow use with ELS... 10/23/84 rpr
;	AMUS release (clean-up same TRMDEF use) 12/3/84 rpr
;	fixed QBIN not defined on short received SINIT packet 4/24/85 rpr
;	fixed 255 to 255. in max retries entry code 6/27/85 rpr
; RELEASE 1.0(4)
;       straightened out 8-bit quoting problem in RPAR 5/12/86
;	updated INUSE bit to use new bit under 1.3B 5/12/86
;	transformed SET BINQUOTE feature into SET PARITY feature 5/12/86
;	(does not set parity, but info is used to determine 7 or 8 bit modes.)
;	corrected checksum size detection problem when used with unix c
;	where ACK to F contained new filename under c. Alpha-Kermit thought
;	this was an ACK to an I packet and used the wrong checksum type.
;	fix requires keeping track of the ACKing of the I packet via RIACK(A0)
; RELEASE 1.0(5)
;	change Kermit to accept running under AMOS/32. rpr
; RELEASE 1.0(6)
;	tidied up SHOW command, added dot for every packet of data sent or
;	rec'd, SET ? now shows SET list. 7/29/86 rpr
; RELEASE 1.0(7)
; changed CONNEC routine to properly set T.DAT bit and T.XLT bits so nulls
; can be sent from keyboard. 10/24/86 rpr
;
; RELEASE 1.0(8)
; started compatibility with AM3000 systems. 5/88
; RELEASE 1.0(9)
; completed basic compatibility with AM3000 systems 6/29/88
; RELEASE 1.0(10)
; Changed handling of port busy bit so that REMOTE users do not monitor or
; change the terminal busy bit. Defines new SY$ symbols for 68020 & 68030
; if not already defined. 11/9/88
; RELEASE 1.0(11)
; made compare for ESCAPE character 7 bits instead of 8 bits 12/2/88 rpr
; added BLOCKSIZE to SET command
;[012] 06 February 1990 09:23	Edited by Bob Rubendunst
;	Corrected a few bugs in checking for previous or next packet
;	needing to be ACKed. Also fixed parameter display to display
;	active END-OF-LINE caharcter, rather than default end-of-line.
;[013] 28 March 1991 12:08	Edited by Bob Rubendunst
;	Corrected problems with received filenames being expanded to 6 & 3
;	even if they were shorter.
;	Fixed problem in edit 12 with max packetsize not being defaulted
;	at startup.
;[014] 28 March 1991 12:38	Edited by Bob Rubendunst
;	Added routine to adjust sleep value for faster baud rates.
;	Note that this does improve performance at higher baud rates,
;	especially for file transfers. Due to limitations in TTYIN monitor
;	call, Kermit can still lose characters at higher baud rates.
;	Fixed bug on effective baud rate calculation when calculating
;	date rollover at midnight.

; Permission is granted to any individual or institution to copy or use this
; software and the routines described in it, except for explicitly commercial
; purposes. This software must not be sold to any person or institution.

;;;;;;;;;;;;;;;;;;;;;;;;;;;; D I S C L A I M E R ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; No warranty of the software or of the accuracy of the documentation     ;;
;; surrounding it is expressed or implied, and neither the authors,        ;;
;; Columbia University, Soft Machines, or AMUS acknowledge any liability   ;;
;; resulting from program or documentation errors.                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; usage format:
;	KERMIT <TRMDEF-NAME> <escape character>
; then enter ? or HELP for use hints.

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

IF	NDF,SY$M20, SY$M20 = ^O20000	; supply missing symbols [010]
IF	NDF,SY$M30, SY$M30 = ^O100000	; supply missing symbols [010]


; supplementary symbols for finding file type & size
D.LEN=D.WRK
D.ACT=D.LEN+4
D.1ST=D.ACT+10



; symbol definitions
TRUE	=	-1
FALSE	=	1


PAKSIZ	=	94.		; max packet size
SOH	=	1.		; default MARK character
CR	=	13.		; ASCII carriage return
SPACE	=	32.		; ASCII SP
DEL	=	127.		; ASCII DEL
ESCCHR	=	'^		; default escape character

TRIES	=	10.		; number of packet tries
MYQUOT	=	'#		; control-quoting
MYPAD	=	0		; number of pad chars
MYPCHR	=	0		; the pad character I need
MYEOL	=	0		; my end of line character
MYTIME	=	08.		; seconds before timeout
MYBIN	=	'Y		; binary qoute mode
MYCHK	=	'2		; try to use 2 byte cheksums
MAXTIM	=	60.		; maximum timeout
MINTIM	=	2		; minimum timeout period

; This macro is used to read a packet
DEFINE	RPACK	LEN,SEQ,PACKET,TYPE
	LEA	A3,PACKET
	CALL	RECPAK
	SSTS	D7
	MARG	MOVB,	D2,LEN
	MARG	MOVB,	D3,SEQ
	MARG	MOVB,	D4,TYPE
	LCC	D7
	ENDM

; This macro sends a packet to the REMOTE
DEFINE	SPACK	TYPE,SEQ,SIZE,PACKET
	LEA	A3,PACKET
	CCLR	SIZE,D2
	CCLR	SEQ,D3
	CCLR	TYPE,D4
	MARG	MOVB,	SIZE,D2
	MARG	MOVB,	SEQ,D3
	MARG	MOVB,	TYPE,D4
	CALL	SNDPAK
	ENDM

; This macro assembles argument linkage opcodes only where the default
; argument is not used. This provides more readable code without adding
; unnecessary instructions.
; For example, if D2 is the standard data link register, the macro
;	MARG	MOVW	D2,D2
; will not produce an assembly line, but
;	MARG	MOVW	D2,D3
; will assemble the line MOVW D2,D3	
DEFINE	MARG	OPCODE, SRC, DST
	NTYPE	...X,SRC
	NTYPE	...Y,DST
	IF	NE,...X-...Y,OPCODE	SRC,DST
	ENDM
	ASECT


; This macro is used to pre-clear result variables before a packet call
; IF they are not registers.
DEFINE	CCLR	ARG,REG
	NTYPE	...D,ARG
	NTYPE	...E,REG
	IF	NE,...D-...E,CLR REG
	ENDM

	.=0
; define the impure area for KERMIT.
	NOSYM
; CONNECT command variables and general REMOTE/LOCAL channel variable
TNAME:	BLKW	2			; terminal name packed RAD50
SAVTDV:	BLKL	1			; address of saved TDV
PSEUDO:	BLKL	1			; address of PSEUDO driver
SAVJTP:	BLKW	1			; saved job status
SAVSTS:	BLKW	1			; saved TRMDEF status
SAVJCB:	BLKL	1			; saved attached job index
REMOTE:	BLKL	1			; index to remote TRMDEF
LOCAL:	BLKL	1			; index to local TRMDEF
STIME:	BLKL	1			; start time of event
FSIZE:	BLKL	1			; size of file in bytes
KMETA:	BLKB	1			; escape character
DONE:	BLKB	1			; done with kermit flag
NOTALK:	BLKB	1			; flag that remote TRMDEF is job's.
ECHO:	BLKB	1			; duplex flag 0 for full, 377 for half
CCOUNT:	BLKB	1			; control-c count
ATERM:	BLKB	7			; terminal name in ASCII
	EVEN
FIO:	BLKB	D.DDB			; file I/O ddb area
; KERMIT packet receiver variables
CSUM:	BLKW	1		; checksum storage
RTOUT:	BLKL	1		; time's up flag
TIMINT:	BLKL	1		; # of seconds for timeout on sends
; Global variables for file section
LOGIC:	BLKB	1		;  1=false, -1=true
LDATA:	BLKB	1		; size of present data
SPSIZ:	BLKB	1		; max send packet size
PAD:	BLKB	1		; # of padding chars to send
PADCHR:	BLKB	1		; pad character
EOL:	BLKB	1		; EOL character to send
N:	BLKB	1		; packet number
MAXTRY:	BLKB	1		; max # of tries
NUMTRY:	BLKB	1		; times this packet retried
OLDTRY:	BLKB	1		; times previous packet retried
BUFCNT:	BLKB	1		; # of data bytes for packet
DEBUGO:	BLKB	1		; level of debug output (0=none)
DING:	BLKB	1		; ding after each command flag (#0=yes)
DF.EOL:	BLKB	1		; default EOL character
DF.CHK:	BLKB	1		; default check type character
PARITY:	BLKB	1		; parity mode (None, Odd, Even, Space.)
STATE:	BLKB	1		; present state of file transfer automaton
QUOTE:	BLKB	1		; incoming quote char
QBIN:	BLKB	1		; incoming QBIN char
CHKT:	BLKB	1		; checksum method as ascii character
CHKNOW:	BLKB	1		; checksum in use for this packet
REPT:	BLKB	1		; repeat byte (not implemented yet)
FLLEN:	BLKB	1		; filename length
RMARK:	BLKB	1		; the MARK character
RIACK:	BLKB	1		; flag we got an ACK to an I packet
MXPKSZ:	BLKB	1		; maximum packet size allowed
STLCHR:	BLKB	1		; stall character time in 100ths of a second
RECPKT:	BLKB	PAKSIZ		; buffer for receiving packets
PACKET:	BLKB	PAKSIZ		;  another one
NFILNM:	BLKB	4		; room for MARK,LEN,SEQ,TYPE
FILNAM:	BLKB	60.		; current filename
	BLKB	20.
COPY:	BLKB	60.		;	; copied filename
	BLKB	PAKSIZ-80.
	EVEN
SLPVAL:	BLKL	1		; sleep value in ticks for GETREM routine
KSIZE=.
	.=0
; definition of KERMIT packet offsets
MARK:	BLKB	1		; the MARK character
LEN:	BLKB	1		; received LEN
SEQ:	BLKB	1		; received sequence
TYPE:	BLKB	1		; received type
DATA:	BLKB	1		; beginning of DATA
	.=0
	EVEN
	SYM


REMMOD = T$IMI!T$ECS!T$DAT	; IMAGE, NOECHO mode bits


; The following macros define character tranlation functions needed to
; implement the KERMIT protocol.
; MACROs to perform CHAR, UNCHAR & CTL functions via register argument.


; C H A R  - change control character to printable character
DEFINE	CHAR	DST
	ADDB	#SPACE,DST
	ENDM

; U N C H A R  -change CHARed control character back into a control character
DEFINE	UNCHAR	DST
	SUBB	#SPACE,DST
	ENDM

; CTL - UNCONTROLIFY a CHARACTER. CTL(CTL(CHAR)) leaves CHAR unchanged.
DEFINE	CTL	DST
	XORB	#64.,DST
	ENDM


	PSECT


;  K E R M I T
; Main Kermit routine. The first three calls are performed the first time
; KERMIT is executed and establish the impure area, remote TRMDEF & meta char.
; The remaining calls comprise the get command -> process command loop.
; 
	VMAJOR =1
	VMINOR =0
	VSUB = 0
	VEDIT = 014.
	VWHO =0

	RADIX	8.

KERMIT:	PHDR	-1,PV$RSM!PV$WSM!PV$RPD!PV$WPD,PH$REE!PH$REU
	CALL	KERTTL			; show title and version
; make sure we are running under an OS that supports TTYOUT.
	MOV	SYSTEM,D5		; get system word
	AND	#SY$M20!SY$M30,D5	; mask to just AMOS/32
	BNE	10$			;  we are on AMOS/32, has TTYOUT
	CMPB	PH.VER+1,#1		; MAJOR higher than 1?
	BHI	10$			;  yes-use new value
	MOVB	PH.VER,D5		;  no- get sub release
	ANDB	#17,D5			; strip out VWHO in top 4 bits
	CMPB	D5,#2			; is this 1.2 or later?
	BHIS	10$			;  yes- we can execute
					;  no- time to update the system!
	TYPECR	<%This software requires AMOS 1.2 or later OS.>
	EXIT

10$:	CALL	INIMEM			; initial memory area
	 BNE	EXEUNT			;  need more memory-abort
	 BMI	20$			; TRMDEF already assigned
; first time entry. Check for CONNECT TRMDEF argument
	BYP				; scan past blanks
	CALL	FNDASN			; find and assign user supplied TRMDEF
	 BNE	EXEUNT			;  no match
	ORW	#FIL!LOK,-10(A0)	; set file and locked in memo flags
20$:	JOBIDX
	ANDW	#^C<J.CCC>,@A6		; clear control-c
	CALL	CHOICE			; get user's command choice
	BNE	20$
	CALL	PROCES			; perform user's command
	TSTB	DONE(A0)		; done ?
	 BNE	40$			;  yes
	TSTB	DING(A0)		; wake the user up?
	BEQ	20$			;  no
	TTYI				;  yes
	BYTE	7,0
	EVEN
	BR	20$

40$:	CLRB	DONE(A0)

; E X E U N T  - exit back to AMOS
EXEUNT:	EXIT

; I N I M E M 
; This routine builds, clears and initializes the user's impure area.
INIMEM:	LEA	A6,IMPNAM		; index impure module name
	SRCH	@A6,A0,F.USR		; search user area for kermit
	BEQ	10$			; already present-done
	GETIMP	KSIZE,A0,100$		; allocate impure area
	CLEAR	@A0,KSIZE		; clear it
	LEA	A6,IMPNAM
	MOV	(A6)+,-6(A0)		; SET MODULE NAME TO KERMIT
	MOVW	@A6,-2(A0)		;  EXTENSION TO IMP
; do first time-only inits
	CALL	INI2
	CALL	INIXFR			; init xfer section once.
	MOVB	#ESCCHR,KMETA(A0)	; set CONNECT ESCAPE character
	MOVB	#PAKSIZ,MXPKSZ(A0)	; set maximum packet size allowed [13]
	MOV	#100.,SLPVAL(A0)	; set sleep ticks for GETREM [14]
	LCC	#PS.Z
	RTN

; finish re-entry inits
10$:	CALL	INI2
	LCC	#PS.N!PS.Z		; set N and Z if impure already there
	RTN

; not enough memory, so depart
100$:	TYPECR	<?Insufficient memory for KERMIT.>
	LCC	#0			; flag no memory
	RTN

; These values are inited every time KERMIT is executed.
INI2:	JOBIDX	A6
	MOVW	JOBTYP(A6),SAVJTP(A0)	; save job type word
	MOV	JOBTRM(A6),LOCAL(A0)
	RTN

; I N I X F R
; Initialize the the file transfer area
INIXFR:	MOVB	#CR,DF.EOL(A0)		; set default EOL
	MOVB	#MYCHK,DF.CHK(A0)	; set default check type
	MOVB	#'N,PARITY(A0)		; set parity to NONE.
	MOVB	#PAKSIZ,SPSIZ(A0)		; set max send size
;
	MOVB	#SOH,RMARK(A0)		; define start of packet byte
	MOVB	#MYQUOT,QUOTE(A0)	; set quote char
	MOV	LOCAL(A0),A5		; set index
	MOVB	#MYPAD,PAD(A0)		; pad count
	MOVB	#MYPCHR,PADCHR(A0)	; & character
	MOVB	#TRIES,MAXTRY(A0)	; set max tries
	MOVB	#'1,CHKT(A0)		; checksum type
	MOV	#08.,TIMINT(A0)		; set timeout period
	RTN	

;  F N D A S N
; FNDASN finds the user specified TRMDEF, and assigns it to this job if found.
; "assigning" is done by setting bit 11 (^O4000). A TRMDEF is "busy" if this 
; bit is already set.
FNDASN:	JOBIDX	A6
	MOV	JOBTRM(A6),A5		; index our own TRMDEF as default
	LIN				; user provide TRMDEF name?
	BEQ	25$			;  no-use our TRMDEF
	LEA	A1,TNAME(A0)		; index terminal name storage
	PUSH	A1			; save for unpack
	PACK
	PACK				; pack the terminal name RAD50
	POP	A1
	LEA	A2,ATERM(A0)		; then unpack it for later
	UNPACK
	UNPACK
	CLRB	@A2			; save ASCII version for SHOW.
	MOV	TNAME(A0),D6		; D6 gets whole RAD50 terminal name
	LEA	A3,TRMDFC		; index the head of the TRMDEF chain
10$:	MOV	@A3,D7			; get link to next entry
	JEQ	100$			;  no matching TRMDEF            [010]
	MOV	D7,A3			; A3 indexs next element
20$:	CMPL	D6,4(A3)		; compare to this entry
	BNE	10$			;  try next one if no match
; TRMDEF is found. Check for prior use
	LEA	A6,10(A3)		; index A6 to remote TRMDEF      [010]
	CMP	A5,A6			; using specified own terminal?  [010]
	BNE	22$			;  no
	CLRB	ATERM(A0)		;  yes-clear name of terminal to [010]
					;  to flag comm port & user's    [010]
					;  port are the same.            [010]
22$:	MOV	A6,A5			; index A5 to comm port          [010]
25$:	MOVW	@A5,SAVSTS(A0)		; save the TRMDEF status      
	CALL	INUSE			; get proper in-use bits
	TSTB	ATERM(A0)		; user & comm port the same?     [010]
	BEQ	250$			;  yes-leave busy bit as is      [010]
	BSET	D6,1(A5)		; set "assigned" bit
	BNE	110$			;  already set by prior use-.
250$:	MOV	A5,REMOTE(A0)		; save pointer to remote TRMDEF  [010]
	MOV	T.TDV(A5),SAVTDV(A0)	; save old TDV address
; find address of PSEUDO TRMDEF in memory for data transfer use.
	MOV	SAVTDV(A0),PSEUDO(A0)	; preset any TDV in case PSEUDO is gone!
	MOV	TRMTDC,A6		; get base of tdv chain
	MOV	#[PSE]_16.+[UDO],D7	; D7 gets PSEUDO in RAD50 notation
30$:	CMP	D7,4(A6)		; match ?
	BEQ	40$			;  yes
	MOV	@A6,A6			;  no-get next link
	MOV	A6,D6			; set flags
	BNE	30$			;  keep trying
	BR	50$ 			; give up
40$:	ADD	#10,A6			; add offset size of link word and name
	MOV	A6,PSEUDO(A0)		; save address of PSEUDO driver
50$:	CMP	A5,LOCAL(A0)		; TRMDEF same as job's ?
	SETEQ	NOTALK(A0)		;  yes-flag KERMIT owns the data TRMDEF
	BEQ	60$			;   and bypass TDV swap.
; swap in PSEUDO TRMDEF instead of normal TDV because some TDVs will
; use multi-byte capture sequences or other translate routines, which will
; mess up incoming or outgoing data.
	MOV	PSEUDO(A0),T.TDV(A5)	; substitute PSEUDO driver on remote
; unless TRMDEF is owned by KERMIT job, detach TRMDEF & JCB.
60$:	MOV	T.JLK(A5),A6		; get JCB link
	MOV	A6,SAVJCB(A0)		; save the JCB address for EXIT
	BEQ	70$			;  TRMDEF already detached-done
	TSTB	NOTALK(A0)		; TRMDEF owned by KERMIT job?
	BNE	70$			;  yes-leave it attached
	CLR	JOBTRM(A6)		;   else detach TRMDEF from job
	CLR	T.JLK(A5)		;    and job from TRMDEF
70$:	LCC	#PS.Z
	RTN

100$:	TYPECR	<?No matching TRMDEF.>
	LCC	#0
	RTN
110$:	TYPECR	<?TRMDEF is assigned to another job.>
	LCC	#0
	RTN

; INUSE - routine to determine the proper INUSE bit values for this OS.
; trashes D5, delivers status bit value for BTST to D6
INUSE:	PUSH	D5
	MOV	#1+8.,D6		; D6 gets INUSE bit value
	MOV	SYSTEM,D5		; get system word
	AND	#SY$M20!SY$M30,D5	; mask to just AMOS/32
	BNE	20$			; always use new bits under AMOS/32
	CMPB	PH.VER+1,#1		; MAJOR higher than 1?
	BHI	20$			;  yes-use new value
	MOVB	PH.VER,D5		;  no- get sub release
	ANDB	#17,D5			; strip out VWHO in top 4 bits
	CMPB	D5,#3			; is this 1.3?
	BLO	10$			;  no-1.2 or older, use old value
	BHI	20$			;  no-1.4 or higher - use new value
	MOVB	PH.VER+3,D5		;  exactly 1.3 - check for B
	LSRB	D5,#4.			; bring it to ground zero.
	CMPB	D5,#'B-'@		; is it B or higher?
	BHIS	20$			;  yes-use new value
10$:	MOV	#3.+8.,D6		; set old INUSE bit
20$:	POP	D5
	RTN


; R A W T R M  - set datacomm TRMDEF to pass all data intact, character mode.
RAWTRM:	MOV	REMOTE(A0),A5		; get index to the TRMDEF
	MOVW	#REMMOD,D1		; remote mode bits
	CALL	SETSTS			; set the status
	RTN

; L I N T R M  -  set datacomm TRMDEF for normal AMOSL line mode.
; except echo is supressed if same TRMDEF for comm & commands
LINTRM:	TSTB	NOTALK(A0)		; same TRMDEF for comm and job?
	BEQ	10$			;  no-just return
; enable line input mode so user can enter commands
	MOV	REMOTE(A0),A5		;  yes-get index to the TRMDEF
	MOVW	#^C<REMMOD>,D1		; clear remote mode bits
	CALL	SETSTS			; clear the status
10$:	RTN

; P S E T D V  - assign pseudo driver if data TRMDEF is owned by KERMIT job.
PSETDV:	TSTB	NOTALK(A0)		; TRMDEF owned by KERMIT job?
	BEQ	10$			;  no-no need to swap
	MOV	PSEUDO(A0),T.TDV(A5)	; swap in PSEUDO driver
10$:	RTN

; O R G T D V  - set normal terminal driver if data TRMDEF is owned by KERMIT job.
ORGTDV:	TSTB	NOTALK(A0)		; TRMDEF owned by KERMIT job?
	BEQ	10$			;  no-no need to swap
	MOV	SAVTDV(A0),T.TDV(A5)	; swap back real terminal driver
10$:	RTN

; S E T S L P  - set SLEEP delay time based on serial baud rate
; added in edit [14]
SETSLP:	MOV	#100.,D6		; set default value
	CLR	D7
	MOVW	T.BAU(A5),D7		; get baud rate code
	CMPW	D7,#^O23		; is it defined in our table?
	BHI	10$			;  no, use default
	LSLW	D7			; double index value
	MOVW	SLPTBL[D7],D7		; get table value in D7
	BEQ	10$	
	MOV	D7,D6
10$:	MOV	D6,SLPVAL(A0)	; set sleep value
	RTN
; sleep time in ticks for one character at all defined alpha baud rates
SLPTBL:	WORD	100000./50.
	WORD	100000./75.
	WORD	100000./110.
	WORD	100000./134.
	WORD	100000./150.
	WORD	100000./200.
	WORD	100000./300.
	WORD	100000./600.
	WORD	100000./1200.
	WORD	100000./1800.
	WORD	100000./2000.
	WORD	100000./2400.
	WORD	100000./3600.
	WORD	100000./4800.
	WORD	100000./7200.
	WORD	100000./9600.
	WORD	100000./19200.
	WORD	100000./38400.
	WORD	100000./57600.
	WORD	100000./76800.
; end [14] additions for SETSLP

; S N O O Z E - delay if data TRMDEF owned by KERMIT job. This gives user
; time to escape back to the other KERMIT and enter REC.
SNOOZE:	TSTB	NOTALK(A0)		; data TRMDEF same as KERMITs?
	BEQ	10$			;  no - do not wait.
	SLEEP	#15.*10000.		;  yes - wait 15 seconds
10$:	RTN

;  E V L C H R
; EVLCHR evaluates the next non-blank character indexed by A2 and
; returns its value in D1.
; At exit, A2 is updated, and D1 contains the new character or 0.
; The Z flag is set if a character was encountered, else Z is clear.
EVLCHR:	CLR	D1			; pre-clear
	BYP
	LIN				; end of line?
	BEQ	100$			;  yes-no characters to process
	NUM				;  else check for numeric
	BNE	10$			;   not numeric
	GTDEC				;   get the value
	BR	40$			;    and use it

; process non-numeric
10$:	MOVB	(A2)+,D1
	CMPB	D1,#'^			; control character prefix ?
	BNE	20$			;  no-use straight ASCII.
	LIN				;  yes-check again for end of line
	BEQ	100$			;   no argument error.
	MOVB	(A2)+,D1		;   else get next character
	AND 	#37,D1			;   mask to control character
	BR	40$			;   and exit

20$:	CMPB	D1,#SPACE		; compare to ASCII space
	BLO	100$			;  invalid argument
40$:	LCC	#PS.Z			;  arg ok, value in D1
	RTN

100$:	LCC	#0			; arg is bad.
	RTN

; P R O M P T  displays the KERMIT command prompt.
PROMPT:
	MOV	#15,D1
	TTY				; move to start of the line
	TSTB	ATERM(A0)		; is this kermit the REMOTE?
	BNE	10$			;  no
	TYPE	<REMOTE >		;  yes-give user different prompts
10$:	TTYI				;  for local & remote kermies.
	ASCII	/Alpha-Kermit >/
	BYTE	0
	EVEN
	RTN

; C H O I C E - prompts the user for command & gets the command.
CHOICE:	CALL	PROMPT			; prompt the user
	KBD	25$			; get a command line in line mode
	BYP				; scan past blanks
	LIN				; end of line?
	BEQ	CHOICE			;  ignore blank lines
	LEA	A1,KERCOM		; index argument list
	CALL	COMAND			; match the command
	BEQ	30$			;  command matched
;  no match - show user bad news.
	TYPE<? >			
10$:	LIN
	BEQ	20$			; end of line.
	MOVB	(A2)+,D1		;  else
	TTY				;  type the
	BR	10$			; character and loop
20$:	TYPECR	<? - undefined command.>; end error display
25$:	LCC	#0			; flag no command
	RTN				; return
30$:	LCC	#PS.Z			; flag valid command
	RTN				; return

; C O M A N D - This subroutine compares the user's command string to the command
; list indexed by A1 (e.g. KERCOM).
; If a match is found, A1 will index the command offset for a tabled call.
; At entry, A1 indexs the command/subcommand list. A2 indexs user's string.
; At exit, Z is set to indicate the command was valid.
; If Z is set, A1 indexs the command offset word.
;
; This routine will match the entire command, or to a valid and unique subset
; of the command name as defined in the table structure.
; e.g. The string CON will match the command name CONNECT.

COMAND:	SUB	#2,A1			; adjustment for first entry
	BYP				; scan past seperators
	PUSH	A2			; save string address for compares
	LIN				; end of line?
	BEQ	CHO.5			;  no command-exit.
; calculate address of next entry and place in A1.
CHO.1:	MOV	@SP,A2			; restore string pointer
	LEA	A3,2(A1)		; A3 indexs next entry
	TSTW	@A3			;  end of table ?
	BEQ	CHO.5			;   yes-no match.
	MOV	A3,A1			;   no-get address of command size word
	ADDW	(A3)+,A1		;  and index to next command.
	CLR	D5
	MOVB	(A3)+,D5		; D5 gets qualifier size in bytes

CHO.2:	TRM				; check for end of word
	BEQ	CHO.4			;  yes-check match count
	TSTB	@A3			;  check for end of table entry
	BEQ	CHO.1			;  must be wrong if so.
CHO.3:	MOVB	@A2,D1
	UCS				; convert to upper case
	CMPB	D1,(A3)+		; compare strings
	BNE	CHO.4			;  until no match
	ADD	#1,A2			; advance A2
	TST	D5			; check for minimum match length
	BEQ	CHO.2			;  made it-stop counting
	SUB	#1,D5			; decrement byte count
	BR	CHO.2			;  keep testing till line is terminated

CHO.4:	TST	D5			; good match has zero count
	BNE	CHO.1			;  no good-try next
	TRM				; good match has no more data
	BNE	CHO.1
	POP				; toss old A2
	LCC	#PS.Z			; flag command match found
	RTN

; undefined command - Clear Z flag
CHO.5:	POP	A2
	LCC	#0
	RTN

; P R O C E S
; Process performs the process defined by the user command.
; At Entry, A1 indexs the word offset (from A1) of the command address
PROCES:	ADDW	@A1,A1			; do a tabled called by adding
	CALL	@A1			; offset @A1 to A1 and executing at
	RTN				; that new address.

; S E N D sends a file to the remote KERMIT using the KERMIT protocol.
SEND:	BYP
	CALL	GFILNM			; get the filename
	BNE	100$			; no filename
	CALL	STARTT			; set start time
	LOOKUP	FIO(A0)			; does the file exist?	
	BEQ	10$			;  yes-ok, proceed
	BR	90$			;  no-abort with error

10$:	CALL	GTSIZE			; save file size in bytes
	TSTW	FIO+D.ACT+2(A0)		; random file ?
	BMI	80$			;  yep-not allowed
	OPENI	FIO(A0)			; open for input
	BNE	90$			;  abort & display error
	CALL	RAWTRM			; put remote in data mode
	CALL	SNOOZE			; delay if TRMDEF owned by KERMIT
	CALL	PSETDV			; swap in PSEUDO driver if needed
	CALL	SETSLP			; set sleep parameter
	CALL	SENDSW			; else send the file
	CALL	LINTRM			; put remote in line mode
	CALL	ORGTDV			; put back real TDV if PSEUDO used
	TSTB	LOGIC(A0)		; did it work?
	BMI	20$			;  yes
	TYPECR	<?SEND failed>		;  no
	RTN
	
20$:	CALL	ENDTM			; show how long it took.
	RTN				; back to main routine.

; display a file error, like file type mismatch.
80$:	MOVB	#D$ETYP,FIO+D.ERR(A0)	; set file mismatch error
90$:	
100$:	CALL	LFERR
	RTN

; L F E R R
; LFERR displays local file errors on the user's CRT
LFERR:	TSTB	NOTALK(A0)		; do we have a user terminal?
	BNE	10$			;  no-do not print message.
	TYPE	<Local file error, >
	PFILE	FIO(A0)			; show filename
	ERRMSG	FIO+D.ERR(A0), OT$TRM!OT$LSP	; and error message
	CRLF
10$:	RTN

; R E C E I V - receive a file from remote KERMIT using the KERMIT protocol.
RECEIV:	MOV	#60.,TIMINT(A0)		; 60 second timeout
	CALL	STARTT			; get start time for stats.
	CALL	SETSLP			; set sleep parameter
	CALL	PSETDV			; use pseudo if needed
	CALL	RAWTRM			; remote trmdef to character mode
	CALL	RECSW			; call receive state manager/switcher
	CALL	LINTRM			; remote trmdef to line mode
	CALL	ORGTDV			; return to real TDV if pseudo used
	TSTB	LOGIC(A0)		;  test for sucess
	BMI	10$			;   it worked
	TYPECR	<?RECEIVE failed.>	;   it didn't work
	RTN

10$:	LOOKUP	FIO(A0)			; do file lookup
	CALL	GTSIZE			; to get file size
	CALL	ENDTM			; show elapsed time & speed
	RTN

; G F I L N M
; This routine gets a filename and places it in FILNAM(A0)
; On exit, FLLEN(A0) contains the length in bytes.
; Z is set if the filename was valid.
GFILNM:	LIN				; end of line?
	BEQ	100$			; no filename, abort
	INIT	FIO(A0)			; init the ddb
	FSPEC	FIO(A0),LST		; load the ddb with filespec
; now convert the name to KERMIT standard form which is NAME.EXT.		
; We must delete all spaces from the filespec.
	LEA	A2,FILNAM(A0)		; index the target area
	PUSH	A2			;  and save the index
	LEA	A1,FIO+D.FIL(A0)	; index the filname in the ddb
	UNPACK
	UNPACK				; put the ASCII filename @A1
	MOVB	#'.,(A2)+		; add the comma
	UNPACK
	CLRB	@A2			; terminate it
; clean up the filespec by deleting space & other illegal characters.
	POP	A2			; restore pointer to filnam
	MOV	A2,A1			; A1 will be write pointer
	CLR	D0			; D0 counts valid chars we found
10$:	MOVB	@A2,D1			; get current char in D7
	BEQ	20$			;  end of line
	UCS				; convert to upper case
	CMPB	D1,#'.			; current char a dot?
	BEQ	20$			;  yes -it is ok
	ALF				; is it alpha ?
	BEQ	20$			;  yes-use it.
	NUM				; or numeric ?
	BNE	25$			;  yes-use it

20$:	MOVB	D1,(A1)+
	BEQ	30$			; end of string
	ADD	#1,D0			; count how many we found
25$:	ADD	#1,A2			; bump pointer
	BR	10$			; continue scan

30$:	CMP	D0,#3			; got at least x.x?
	BLO	100$			; no-invalid filename
	MOVB	D0,FLLEN(A0)		; save the length
	LCC	#PS.Z			; valid filename received
	RTN

100$:	LCC	#0			; bad filename given.
	RTN
	
; R F I L N M
; This routine gets the remote filename from NFILNM(A0) 
; and places it in the FIO(A0) DDB.
; It then opens the file for input and returns the OPEN condition codes
; to the caller. Z is set if the open was succesful.
; [13] revised to not extend filenames or extensions rpr
RFILNM:	LEA	A2,FILNAM(A0)		; index the filnam
	LEA	A1,COPY(A0)		; index copy buffer
	CLR	D2
	MOVB	LDATA(A0),D2		; d2 gets total length of filename
					; from remote kermit
	CMP	D2,#30.-1		; compare to max allowed by definition
	BLOS	10$
	MOV	#30.-1,D2		; set max
; terminate filename part to 6 characters
10$:	MOV	#6,D0			; set limit for filename
20$:	ALF
	BEQ	30$			; letters ok
	NUM
	BEQ	30$			; numbers ok, too.
	CMPB	@A2,#'.			; period?
	BEQ	60$			;  yes-end of filename!
	BNE	40$			;  no-toss bad char & continue

30$:	MOVB	@A2,(A1)+		; save good character
40$:	ADD	#1,A2			; advance pointer
	SUB	#1,D2			; count down total filename size
	BEQ	100$			;  end of filename (use .KMT extension)
	SUB	#1,D0			; adjust allowed filename chars
	BNE	20$			;  more allowed
					;  else wait for a period.
; trancate file names longer than 6 characters by waiting for a period
; wait for a period
50$:	CMPB	@A2,#'.			; period
	BEQ	60$			;  yes-ok.
	ADD	#1,A2			;  no-advance ptr
	SUB	#1,D2			; count down total filename size
	BNE	50$			;  until period or end of file
	BR	100$			;  no period found
; we found the period (and truncated a long filename)
60$:	ADD	#1,A2			;  no-advance
	SUB	#1,D2			; count down original filename size
	BEQ	100$			;  no more filename, use default ext!
	MOVB	#'.,(A1)+		; buffer a period
	MOV	#3.,D0			; max size of extension.
70$:	ALF
	BEQ	80$			; ok
	NUM
	BNE	90$			; not ok
80$:	MOVB	@A2,(A1)+		; buffer o.k. character
90$:	ADD	#1,A2			; advance pointer
	SUB	#1,D2			; count down original filename size
	BEQ	100$			; until a period
	SUB	#1,D0			; count down
	BNE	70$			;  yes
100$:	CLRB	(A1)+			;  no- end with a null
	LEA	A2,COPY(A0)		; index the new filename
	INIT	FIO(A0)			; init the ddb
	FSPEC	FIO(A0),KMT		; load the ddb with filespec
	LOOKUP	FIO(A0)			; does file already exist?
	BNE	110$			;  no
	DSKDEL	FIO(A0)			;  yes-erase the old one
110$:	OPENO	FIO(A0)			; open it sequentially
	RTN				; Z is set if file found

; C O N N E C
; CONNEC is the local terminal <--> remote terminal conversational routine.
; User keypresses are sent (except the ESCAPE or KMETA character) to the
; remote computer & incoming characters form the remote are displayed on 
; the user's CRT screen.
CONNEC:	TSTB	NOTALK(A0)		; using same TRMDEF for in & out?
	BEQ	4$			;  no-ok.
	TTYL	NONONO			;  tell user it is a no-no
	RTN

4$:	CALL	RAWTRM			; set remote in "raw" mode.
	CALL	SETSLP			; set sleep parameter
	CALL	SHOESC			; show the escape character in effect.
	MOV	LOCAL(A0),A5		; A5 indexs local TRMDEF
;;	MOV	#REMMOD!T$XLT,D1	; allow function key xlation
	MOV	#REMMOD,D1		; allow function key xlation
	CALL	SETSTS			; set them via breakpoint
	MOV	A5,A4			; A4 will be the local TRMDEF pointer
	MOV	REMOTE(A0),A5		; now A5 indexs REMOTE 
10$:	CTRLC	15$			;  user entered control-c?
	TST	T.ICC(A4)		; LOCAL chars present ?
	BNE	20$			;  something to do
	TST	T.ICC(A5)		; REMOTE chars present ?
	BNE	20$			;  something to do
	SLEEP	SLPVAL(A0)		; take a one character nap. [14]
	BR	10$			; see if the store needs minding now.

; handle control-c's by trapping them, unflagging them and sending them out.
15$:	JOBIDX
	ANDW	#^C<J.CCC>,@A6		; clear control-c flag
	MOV	#3,D1			; get ASCII equivalent
	BR	37$			; send it out

; enter here when we have some communications data to move
20$:	TST	T.ICC(A5)		; have remote input ?
	BEQ	30$			;  no
	TTYIN				;  yes-grab a character
	TTY				; print it
30$:	TCKI				; have LOCAL input ?
	BNE	40$			;  no local input
	KBD				;  yes-get local input via KBD
35$:	MOVB	D1,D7
	ANDB	#127.,D7		; mask character to seven bits
	CMPB	D7,KMETA(A0)		; escape character ?
	BEQ	100$			;  yes-leave
; check for half duplex echoing
	TSTB	ECHO(A0)		; got echoing?
	BEQ	37$			;  no-full duplex
	CMPB	D7,#SPACE		; printable?
	BHIS	36$			; yes-echo it
	CMPB	D7,#15			; CR?
	BEQ	36$ 			; yes-echo
	CMPB	D7,#08.			; backspace?
	BEQ	36$ 			; yes-echo
	CMPB	D7,#12			; line feed ?
	BNE	37$			;   ignore other ctl chars
36$:	TTY				;  yes-half duplex, so echo the character
; transmit a character to the remote site.
37$:	TTYOUT				; send byte to REMOTE
40$:	BR	10$			; loop	

; exit back to main routine, since user entered ESCAPE character.
100$:	MOV	LOCAL(A0),A5		; index user's TRMDEF.
	MOV	#^C<REMMOD!T$XLT>,D1	; get char mode bits
	CALL	SETSTS				; clear them via breakpoint
;;	CALL	LINTRM			; reset remote TRMDEF to line mode.
	RTN

; H E L P - inform user as to how KERMIT works.
HELP:	TTYL	HLP1
	LEA	A1,KERCOM		; index argument list
	CALL	COMAND			; see if we have an argument
	BNE	100$			;  no-show the whole list.
; show the selected help line by backing up to the start of it
4$:	TSTB	-(A1)			; backup to non-null
	BEQ	4$
10$:	MOVB	-(A1),D1		; look for null byte between command
	BNE	10$			;  and help strings.
	CRLF
	TTYL	1(A1)			; show the help message
	CRLF
	RTN

; Show help lines for all commands
100$:	LEA	A2,KERCOM		; index table
110$:	MOV	A2,A1
	CLR	D7
	MOVW	@A1,D7			; get offset to end
	BEQ	140$			; null is end of table
	MOV	A1,A2			
	ADDW	(A1)+,A2		; A2 indexs the address field
	ADD	#2,A2			; A2 now indexs the next entry
	ADD	#1,A1			; ignore size byte
	CALL	PTRTYP			; type command name
	TSTB	@A1
	BNE	120$
	ADD	#1,A1
120$:	TAB
	CALL	PTRTYP			; type the help text
	CRLF
	BR	110$

140$:	CRLF
	CRLF
	RTN

; S H O W  - Show user the current optional settings & some packet info.
SHOW:	CALL	KERVER			; show kermit version
	TTYL	SH1.1			; type modem line:
	LEA	A1,ATERM(A0)		; index trmdef name	
	TSTB	@A1			; do we have remote? [1]
	BNE	10$			;  yes
	LEA	A1,SH.DAS		;  else index dashes
10$:	TTYL	@A1			; show name or dashes
	TTYL	SH1.2			; then type duplex label
; show duplex
	LEA	A6,SH.FUL		; assume FULL
	TSTB	ECHO(A0)		; check duplex 0=full, -1=half
	BEQ	20$
	LEA	A6,SH.HAL		; o.k., then, HALF.
20$:	TTYL				; type string @A6
	TTYL	SH1.3			; type parity label
	MOVB	PARITY(A0),D1
	CALL	SHOCHR
	TTYL	SH2.1			; do end of line 1 & BELL label
	LEA	A6,SH.OF
	TSTB	DING(A0)
	BEQ	30$
	LEA	A6,SH.ON
30$:	TTYL				; show on or off
	TTYL	SH2.2			; show DEBUG label
	LEA	A6,SH.OF
	TSTB	DEBUGO(A0)
	BEQ	40$
	LEA	A6,SH.ON
40$:	TTYL
	TTYL	SH2.3			; show ESCAPE label
	CLR	D1			; preclear D1
	MOVB	KMETA(A0),D1
	CALL	SHOCHR			; show escape character
	TTYL	SH3.1			; do end of line 2, packet parms.
	CLR	D1
	MOVB	SPSIZ(A0),D1		; get packet size
	DCVT	2,OT$TRM
	TTYL	SH3.2			; show pad char label			
	MOVB	PADCHR(A0),D1		; default to 1 char checksum
	CALL	SHOCHR
	TTYL	SH4.1			; end of line 3, ENDLINE label
;[012] display end-of-line character in use, rather than default
	MOVB	EOL(A0),D1		; set end of line char
	BNE	50$
	TTYL	NONE
50$:	CALL	SHOCHR
60$:	TTYL	SH4.2			; number of pads label
	MOVB	PAD(A0),D1		; 
	DCVT	0,OT$TRM
	TTYL	SH5.1			; show retries label
	MOVB	MAXTRY(A0),D1
	DCVT	3,OT$TRM!OT$ZER
	TTYL	SH5.2			; blockcheck selected label
	MOVB	DF.CHK(A0),D1
	TTY
	TTYL	SH6.1			; show timeout label
	MOV	TIMINT(A0),D1		; default to 1 char checksum
	DCVT	3,OT$TRM!OT$ZER
	TTYL	SH6.2
	MOVB	CHKT(A0),D1
	TTY
	TTYL	SH7.0
	RTN

; S E T  - allow user to change some parameters.
; SET command accepts a sub-command (or argument) to define the action.
; If no sub-command is given, a short expansion of the subcommands is given.
SET:	BYP
	LIN				; end of line?
	BEQ	100$			;  yes-show user what can be set.
	CMPB	@A2,#'?			; user wants some help?
	BEQ	100$			;  yes-show user what he can set.
	LEA	A1,SETCOM		; index set command list
	CALL	COMAND			; see if we have an argument
	BNE	10$			;  no-show user no can do.
; perform the desired function. Each function does its own error-checking.
	CALL	PROCES			; do the set
	RTN

10$:	TYPE<? >			;  no match - show user bad news.
15$:	LIN				; end of line?
	BEQ	20$			;  yes-done typing user's entry
	MOVB	(A2)+,D1
	TTY				; type a character
	BR	15$			; until the end of line
20$:	TYPECR	<? - undefined command.>
25$:	RTN

; Show explanation for all set commands
100$:	TTYL	SET1
	LEA	A2,SETCOM		; index table
110$:	MOV	A2,A1
	CLR	D7
	MOVW	@A1,D7			; get offset to end
	BEQ	140$			; null is end of table
	MOV	A1,A2			
	ADDW	(A1)+,A2		; A2 indexs the address field
	ADD	#2,A2			; A2 now indexs the next entry
	ADD	#1,A1			; ignore size byte
	CALL	PTRTYP			; type command name
	TSTB	@A1
	BNE	120$
	ADD	#1,A1
120$:	TAB
	CALL	PTRTYP			; type the help text
	CRLF
	BR	110$

140$:	CRLF
	CRLF
	RTN

;;		S E T   S U B C O M M A N D S

; B E L L - set bell after each command completeion flag.
BELL:	LEA	A1,ONOFF		; index option list
	CALL	GETOPT			; process option
	BNE	10$			;  no good
	MOVB	D1,DING(A0)		; set bell option
10$:	RTN

; D U P L E X - set half or full duplex.
DUPLEX:	LEA	A1,EPLEX		; index echoplex options
	CALL	GETOPT			; process option
	BNE	10$			;  no good
	MOVB	D1,ECHO(A0)		; set duplex option
10$:	RTN


; B L O C K - set default check type. 1 or 2 byte checksum
BLOCK:	LEA	A1,ONETWO		; index check-type options
	CALL	GETOPT
	BNE	10$			; no good
	MOVB	D1,DF.CHK(A0)		; set default check type
10$:	RTN

; D E B U G - Set debug message print flag.
DEBUG:	LEA	A1,ONOFF		; allow YES or NO.
	CALL	GETOPT
	BNE	10$
	MOVB	D1,DEBUGO(A0)		; set debug option
10$:	RTN

; E N D L I N - set optional end of packet character. (normally CR.)
ENDLIN:	CALL	EVLCHR			; get the character
	BNE	10$		
	MOVB	D1,DF.EOL(A0)		; set default EOL
10$:	RTN

; E S C A P E - set the escape from CONNECT mode character.
ESCAPE:	CALL	EVLCHR
	BNE	10$			; no good
	ANDB	#127.,D1		; strip to ASCII
	MOVB	D1,KMETA(A0)		; set escape character
10$:	RTN

; T I M E R - set the timeout period used in packet transmission.
TIMER:	BYP
	GTDEC				; get decimal number
	CMP	D1,#MINTIM		; compare to minimum time
	BHIS	10$			; allow 2 or more
	MOV	#MINTIM,D1		;  force minimum
10$:	MOV	D1,TIMINT(A0)		; set time interval period
	RTN

; N E W T R Y   - sets the maximum # of tries for a packet.
NEWTRY:	BYP
	GTDEC
	TST	D1			; test new value
	BEQ	20$			; zero is too few!
	CMP	D1,#255.		; this is max was ^O255
	BHI	20$			;  too high-leave as is
	MOVB	D1,MAXTRY(A0)		; set max value
	RTN
20$:	TTYI
	ASCII	/?value out of range?/
	BYTE	7,15,0
	EVEN
	RTN

; P A K M A X - set maximum packet size supported
PAKMAX:	BYP
	GTDEC
	TST	D1
	BEQ	20$
	CMP	D1,#PAKSIZ		; compare to max size allowed
	BHI	20$			;  too high-leave as is
	MOVB	D1,MXPKSZ(A0)		; set max value
	RTN
20$:	TTYI
	ASCII	/?value out of range?/
	BYTE	7,15,0
	EVEN
	RTN

; S E T P A R - set the parity type (already in use) by the remote
SETPAR:	CALL	EVLCHR			; get the character
	BNE	10$		
	UCS				; force to upper case
	MOVB	D1,PARITY(A0)		; set parity
	CMPB	D1,#'N			; no parity?
	BEQ	10$
	SETB	QBIN(A0)
	TTYL	NOSET			; tell user limitations
10$:	RTN

; S T L V A L  - set # of 100ths of seconds to stall between output
; characters for file transfers.
STLVAL:	BYP
	GTDEC
	TST	D1			; test new value
	BEQ	20$			; zero is too few!
	CMP	D1,#255.		; this is max was ^O255
	BHI	20$			;  too high-leave as is
	MOVB	D1,STLCHR(A0)		; set max value
	RTN
20$:	TTYI
	ASCII	/?value out of range?/
	BYTE	7,15,0
	EVEN
	RTN


; G E T O P T  - compares the input option @A2 to the option list @A1.
; If there is a match, the match number is returned in D1 and Z is set.
; No match returns Z clear and displays the error message at  the end of the
; option list.
GETOPT:	SUB	#2,A1			; adjustment for first entry
	BYP				; scan past seperators
	PUSH	A2			; save string address for compares
; calculate address of next entry and place in A1.
OPT.1:	MOV	@SP,A2			; restore string pointer
	LEA	A3,2(A1)		; A3 indexs next entry
	TSTW	@A3			;  end of table ?
	BEQ	OPT.5			;   yes-no match.
	MOV	A3,A1			;   no-get address of command size word
	ADDW	(A3)+,A1		;  and index to next command.
	CLR	D5
	MOVB	(A3)+,D5		; D5 gets qualifier size in bytes

OPT.2:	TRM				; check for end of word
	BEQ	OPT.4			;  yes-check match count
	TSTB	@A3			;  check for end of table entry
	BEQ	OPT.1			;  must be wrong if so.
OPT.3:	MOVB	@A2,D1
	UCS				; convert to upper case
	CMPB	D1,(A3)+		; compare strings
	BNE	OPT.4			;  until no match
	ADD	#1,A2			; advance A2
	TST	D5			; check for minimum match length
	BEQ	OPT.2			;  made it-stop counting
	SUB	#1,D5			; decrement byte count
	BR	OPT.2			;  keep testing till line is terminated

OPT.4:	TST	D5			; good match has zero count
	BNE	OPT.1			;  no good-try next
	TRM				; good match has no more data
	BNE	OPT.1
	POP				; toss old A2
	CLR	D1
	MOVB	@A1,D1			; D1 gets argument value
	LCC	#PS.Z			; flag command match found
	RTN

; undefined command - Clear Z flag
OPT.5:	POP	A2
	TTYL	2(A3)			; display error message at end of list
	LCC	#0
	RTN				; return with Z clear

; P T R T Y P  - print the string indexed by A1 until a null is found.
PTRTYP:	MOVB	(A1)+,D1
	BEQ	10$
	TTY
	BR	PTRTYP
10$:	RTN

; G O O D B Y  - exit from KERMIT to AMOS for good.
; re-attach comm TRMDEF to its former job, if any.
GOODBY:	ANDW	#^C<FIL!LOK>,-10(A0)	; clear file and locked in mem flags
	JOBIDX	A6
	MOVW	SAVJTP(A0),JOBTYP(A6)	; save job type word
	MOV	REMOTE(A0),A5
	MOV	#^C<REMMOD>,D1		; clear bits we set (except OIP)
	CALL	INUSE			; get in-use bit
	TSTB	ATERM(A0)		; user & comm port the same?     [010]
	BEQ	4$			;  yes-leave busy bit as is      [010]
	BCLR	D6,D1			; clear it for bit clear mask
4$:	CALL	SETSTS			; clear all those bits
	CLR	D1
	MOVW	SAVSTS(A0),D1		; get saved status
	AND	#^CT$OIP,D1		;  less OIP bit which hangs output!
	CALL	SETSTS			; set the saved bits
	MOV	SAVJCB(A0),A6
	MOV	A6,T.JLK(A5)		; restore any attached job
	BEQ	10$
	MOV	A5,JOBTRM(A6)		; and JCB, if there was one
10$:	MOV	SAVTDV(A0),T.TDV(A5)	; restore TDV
	SETB	DONE(A0)		; set the we are done flag
	RTN

; A M O S - move to AMOS level temporarily.
AMOS:	SETB	DONE(A0)		; set the we are done flag	
	RTN

; S E T S T S
; This routine sets or clears status bits in D1.
; If D1 is minus, the bits are cleared. If they are +, the bits are set
; This routine works by using the breakpoint feature of the 68000, to
; avoid using the vaporware SUPVR call, which alpha warns may disappear
; any day now.

; This routine is used to set and reset TRMSER status word bits without
; getting T$OIP fouled up and hanging the job's output.
SETSTS:	SAVE	A3,A4			; get some work regs
	JOBIDX	A3			; index our JCB
	PUSH	JOBBPT(A3)		; save any pending BPT vector
	LEA	A4,SETBIT		; index the bit fiddling routine.
	MOV	A4,JOBBPT(A3)		; make it our breakpoint routine.
	BPT				; execute this
	POP	JOBBPT(A3)		; restore old breakpoint
	REST	A3,A4			;  and workspace regs
	RTN				; done.

; This routine is called as a breakpoint routine, and runs in SUPVR mode
; Used to change TRMSER status bits.
SETBIT:	SVLOK				; prevent interrupts
	TSTW	D1			; set or clear bits?
	BMI	10$			;  clear is negative
	ORW	D1,@A5			; set bits if + or 0.
	BR	20$			; done setting...
10$:	ANDW	D1,@A5			; clear those bits
20$:	SVUNLK				; allow other processes
	RTE				; done with this exceptional routine.

;;;		 F I L E   T R A N S F E R   R O U T I N E S

; S E N D S W
; SENDSW is the state table switch for file transfers. It loops either
; until it finishes, or an error is encountered. The routines called
; by SENDSW change the automaton state.
SENDSW:	MOVB	#'S,STATE(A0)		; start with SEND INIT
	CLRB	N(A0)			; clear the seq number
	CLRB	NUMTRY(A0)		;  and the retry count
	CLRB	LOGIC(A0)		; CLEAR LOGIC
	CLRB	RIACK(A0)		; clear the I is ACKed flag
10$:	TSTB	LOGIC(A0)		; test logic flag
	BNE	100$			;  we are done
	CTRLC	ABORT			; exit on control-C
	TSTB	DEBUGO(A0)		; debug on ?
	BEQ	20$			;   no
	TYPE	<SENDSW state >
	MOVB	STATE(A0),D1
	TTY
	CRLF
	CRLF
20$:	LEA	A6,SWSTAT-4		; index the state table
	MOVB	STATE(A0),D7		; D7 gets the current state
30$:	ADD	#4,A6			; pre-advance
	MOVB	@A6,D6
	BEQ	100$			; undefined state - so exit
	CMPB	D6,D7			;  matching state ?
	BNE	30$			;   no
	ADD	#2,A6			; yes - advance to offset
	ADDW	@A6,A6			; calc address of new routine
	CALL	@A6			; execute it
	BR	10$			; loop till we exit
100$:	RTN

ABORT:	MOVB	#'A,STATE(A0)		; flag it as bad.
	MOVB	#FALSE,LOGIC(A0)
	RTN

COMPLT:	MOVB	#TRUE,LOGIC(A0)		; flag complete o.k.
	RTN


; S I N I T
; Send (I) Initiate Packet & receive REMOTEs reply

SINIT:	ADDB	#1,NUMTRY(A0)		; bump # of tries
	CMMB	NUMTRY(A0),MAXTRY(A0)	; beyond the max?
	BNE	20$
	MOVB	#'A,STATE(A0)
	RTN

20$:	LEA	A3,PACKET(A0)		; index the packet area
	CALL	SPAR			; load default data for S packet
	CALL	FLUSH			; flush pending input
	MOVB	DF.EOL(A0),EOL(A0)	; use default EOL
	SPACK	#'S,N(A0),#PARSIZ,PACKET(A0)	; send an S packet
; just in case host requires an EOL character, send the default EOL value.
	MOVB	DF.EOL(A0),D1
	CALL	OUTBYT			; output the EOL to get remote going
;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,RECPKT(A0),D4	; receive a packet
	BNE	1000$			; no packet received ; timeout
					;  or damaged packet
	CMPB	D4,#'N			; NAK, try again
	JEQ	1000$			;  just return, leave state as is.
	CMPB	D4,#'Y			; ACK ?
	BNE	30$			;  no ACK
	CMPB	D3,N(A0)		;  yes-same # as I sent?
	BNE	1000$			;   no-return, same state
; get other side's init info.
	SETB	RIACK(A0)		; flag we got ACK to I packet
	LEA	A3,RECPKT(A0)		; index work area
	CALL	RPAR			; load parameters from work area
	CMPB	QUOTE(A0),#SPACE	; check for space or null
	BHI	32$
	MOVB	#MYQUOT,QUOTE(A0)	; reset to #
32$:	CLRB	NUMTRY(A0)		; clear retries
	CALL	BUMPP			; bump N mod 64.
	MOVB	#'F,STATE(A0)		; move to state F
	JMP	1000$			; done
30$:	CMPB	D4,#'E			; error packet received ?
	BNE	40$			;  no
	CALL	PRTERR			; show error
; move to abort state on any undefined TYPEs
40$:	MOVB	#'A,STATE(A0)		; move to abort state.
1000$:	RTN

; S F I L E sends the file header.
SFILE:	INCB	NUMTRY(A0)		; bump the count
	CMMB	NUMTRY(A0),MAXTRY(A0)	; beyond the max?
	BLOS	10$			;  no
	MOVB	#'A,STATE(A0)		; set state to abort
	RTN

10$:	CLR	D2
	MOVB	FLLEN(A0),D2
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'F,N(A0),D2,NFILNM(A0)	; send the F packet

; 	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,RECPKT(A0),D4		; wait for reply
	BNE	1000$				; no reply
; compare received sequence # to expected #
	CMPB	D4,#'N			; NAK ?
	BNE	30$			;  no NAK here
;;[012] correction
;; correct this code to check to see if NAK is for next block, which we will
;; interpret as being an ACK for this block.
;;[012]	MOVB	N(A0),D1
;;[012]	CALL	PREVP			; D1 gets previous packet #
	CALL	NEXTN			; D1 gets NEXT packet #
;;[012] end correction
	CMPB	D1,D3			; NAK for next block ?
	BNE	1000$			;  no-return with state unchanged
	BR	35$			;  yes-treat as ACK for this block

30$:	CMPB	D4,#'Y			; ACK ?
	BNE	40$			;  no
	MOVB	N(A0),D1		; D1 gets current SEQ #
	CMPB	D3,D1			;  yes-is it expected SEQ?
	BNE	1000$			;   no-return state unchanged
35$:	CLRB	NUMTRY(A0)		;   yes-clear retries count
	CALL	BUMPP
	LEA	A3,PACKET(A0)
	CALL	BUFFIL			; fill a buffer @A3
	MOVB	#'D,STATE(A0)		; goto Data state
	JMP	1000$
40$:	CMPB	D4,#'E			; Error packet received
	BNE	50$
	CALL	PRTERR			; show the error
; if any other case, move to abort case
50$:	MOVB	#'A,STATE(A0)		; move to abort state
1000$:	RTN

; S D A T A  - sends file data. (e.g. filename.)
SDATA:	INCB	NUMTRY(A0)		; bump try count
	CMMB	NUMTRY(A0),MAXTRY(A0)	; maxxed out ?
	BLOS	10$			;  no	
	MOVB	#'A,STATE(A0)		;  yes-move to abort state
	RTN

10$:	
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'D,N(A0),BUFCNT(A0),PACKET(A0)	; send data packet
;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,RECPKT(A0),D4	; receive a packet
	BNE	1000$			;  no data received
	CMPB	D4,#'N			; NAK ?
	BNE	20$			;  no
	CALL	NEXTN			; D1 gets N
	CMPB	D1,D3			; NAK for N+1?
	BEQ	30$			;  yes-treat as lost ACK for N
	JMP	1000$			; else exit state unchanged
20$:	CMPB	D4,#'Y			; ACK ?
	BNE	50$			; no
	CMPB	D3,N(A0)		; right SEQ of ACK?
	BNE	1000$			;  no-state unchanged
	CALL	SHODOT			; tell user we moved some data
30$:	CALL	BUMPP			; bump packet count
	CLRB	NUMTRY(A0)		; clear the try count
	LEA	A3,PACKET(A0)		; index the Packet
	CALL	BUFFIL			; get a buffer
	TSTB	BUFCNT(A0)		; any data to send ?
	BNE	40$	
	MOVB	#'Z,STATE(A0)		; move to Z state (end of file)
	JMP	1000$
40$:	MOVB	#'D,STATE(A0)		; stay in D state
	JMP	1000$
50$:	CMPB	D4,#'E			; Error packet ?
	BNE	1000$
	CALL	PRTERR
	MOVB	#'A,STATE(A0)		; move to A state.
1000$:	RTN
	
; S E O F  - send the end of file packet.
SEOF:	INCB	NUMTRY(A0)
	CMMB	NUMTRY(A0),MAXTRY(A0)
	BLOS	10$
	MOVB	#'A,STATE(A0)
	RTN

10$:	
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Z,N(A0),#0,PACKET(A0)	; send a Z packet
;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,RECPKT(A0),D4	; get a reply
	BNE	1000$			; 
	CMPB	D4,#'N			; NAK ?
	BNE	20$
	CALL	NEXTN			; D1 gets next N mod 64.
	CMPB	D1,D3			; NAK for SEQ+1?
	BEQ	30$			; yes-treat as ACK.
	JMP	1000$			; return as is
20$:	CMPB	D4,#'Y			; ACK ?
	BNE	40$			;  no
	CMPB	D3,N(A0)		; matching SEQ #?
	BNE	1000$			;  no-return as is
30$:	CALL	BUMPP			; bump the N value
; add check for multiple files here when we get some "free time"!
	MOVB	#'B,STATE(A0)		; goto Break state
	JMP	1000$
40$:	CMPB	D4,#'E			; error packet ?
	BNE	50$			;  no
	CALL	PRTERR			;  yes-print erorrrr.
	JMP	1000$
50$:	MOVB	#'A,STATE(A0)		; abort on undefined types
1000$:	RTN

;  S B R E A K -  sends a break frame.
SBREAK:	INCB	NUMTRY(A0)		; bump the try count
	CMMB	NUMTRY(A0),MAXTRY(A0)	; maxxed out?
	BLOS	10$			;  no
	MOVB	#'A,STATE(A0)		;  yes-abort state
	RTN

10$:	
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'B,N(A0),#0,PACKET(A0)	; send a B packet
;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,RECPKT(A0),D4	; get a reply
	BNE	1000$			; no reply
	CMPB	D4,#'N			; NAK ?
	BNE	20$
	CALL	NEXTN			; D1 gets next N mod 64.
	CMPB	D1,D3			; NAK for SEQ+1?
	BEQ	30$			; yes-treat as ACK.
	JMP	1000$			; return as is
20$:	CMPB	D4,#'Y			; ACK ?
	BNE	40$			;  no
	CMPB	D3,N(A0)		; matching SEQ #?
	BNE	1000$			;  no-return as is
30$:	CALL	BUMPP			; bump the N value
; add check for multiple files here when we get some "free time"!
	MOVB	#'C,STATE(A0)		; goto Complete state
	JMP	1000$
40$:	CMPB	D4,#'E			; error packet ?
	BNE	50$			;  no
	CALL	PRTERR			;  yes-print erorrrr.
	JMP	1000$
50$:	MOVB	#'A,STATE(A0)		; abort on undefined types
1000$:	RTN

; R E C S W  - is the state table switch for receiving files.
RECSW:	MOVB	#'R,STATE(A0)		; start with RECV INIT state
	CLRB	N(A0)			; clear the seq number
	CLRB	NUMTRY(A0)		;  and the retry count
	CLRB	LOGIC(A0)		; clear logic
	CLRB	RIACK(A0)		; clear the I is ACKed flag
10$:	TSTB	LOGIC(A0)		; test logic flag
	BNE	100$			;  we are done
	CTRLC	RABOR			;  or user wants out
	TSTB	DEBUGO(A0)		; debug on ?
	BEQ	20$			;   no
	TYPE	<RECSW state >
	MOVB	STATE(A0),D1
	TTY
	CRLF
20$:	LEA	A6,RCSTAT-4		; index the state table
	MOVB	STATE(A0),D7		; D7 gets the current state
30$:	ADD	#4,A6			; pre-advance
	MOVB	@A6,D6
	BEQ	100$			; undefined state - so exit
	CMPB	D6,D7			;  matching state ?
	BNE	30$			;   no
	ADD	#2,A6			; yes - advance to offset
	ADDW	@A6,A6			; calc address of new routine
	CALL	@A6			; execute it
	BR	10$			; loop till we exit
100$:	RTN

RABOR:	MOVB	#'A,STATE(A0)		; flag transfer as bad
	MOVB	#FALSE,LOGIC(A0)
	RTN

RCOMP:	MOVB	#TRUE,LOGIC(A0)		; flag complete o.k.
	RTN

; R I N I T - is the receive init routine
RINIT:
	ADDB	#1,NUMTRY(A0)		; count the tries
	CMMB	NUMTRY(A0),MAXTRY(A0)	; beyond the max?
	BNE	20$
	MOVB	#'A,STATE(A0)
	RTN

20$:	

;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,PACKET(A0),D4	; receive a packet
	BNE	50$			;  no packet received ; timeout
	CMPB	D4,#'S			;  got an S packet ?
	BNE	30$			;   no S packet
; get other side's init data
	LEA	A3,PACKET(A0)		; index data packet address
	CALL	RPAR			; get parameters
	LEA	A3,PACKET(A0)		; index data packet address
	CALL	SPAR			;  send our parameters
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,N(A0),#PARSIZ,PACKET(A0); send ACK with reply
	SETB	RIACK(A0)		; flag ACK to I has been sent
	MOVB	NUMTRY(A0),OLDTRY(A0)	; save try count
	CLRB	NUMTRY(A0)		; clear count
	CALL	BUMPP			; bump packet #
	MOVB	#'F,STATE(A0)		; bump state
	JMP	1000$			; end

30$:	CMPB	D4,#'E			; error received ?
	BNE	40$
	CALL	PRTERR			; display the error.
	MOVB	#'A,STATE(A0)
	JMP	1000$			; done
; all others default to A state
40$:	MOVB	#'A,STATE(A0)		; received junk-abort
	JMP	1000$
; no packet received - send a NAK
50$:	SPACK	#'N,N(A0),#0,NFILNM(A0)	; send a NAK packet
					; return without state change
1000$:	RTN

; R F I L E  - receive a file header frame with the filename.
RFILE:	ADDB	#1,NUMTRY(A0)		; count the tries
	CMMB	NUMTRY(A0),MAXTRY(A0)	; beyond the max?
	BNE	20$
	MOVB	#'A,STATE(A0)
	RTN

20$:	

;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,NFILNM(A0),D4	; receive a packet (expecting filename)
	JNE	500$			;  no packet received ; timeout
	CMPB	D4,#'S			;  got an S packet ?
	BNE	50$			;   no
; SEND-INIT received, maybe ACK was lost.
	CALL	NEXTO			; D1 gets next OLDTRY value
	CMPB	D1,MAXTRY(A0)		;  time to give up?
	BLOS	30$			;   no
	MOVB	#'A,STATE(A0)
	JMP	1000$			; yes-goto abort state.

30$:	MOVB	N(A0),D1		; D1 gets current packet #
	CALL	PREVP			; get previous packet #
	CMPB	D1,D3			; previous packet ?
	BNE	40$			;  no
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,D3,#PARSIZ,PACKET(A0)	;   yes-ack again with SEND-INIT
	CLRB	NUMTRY(A0)		; clear retry count
	JMP	1000$			;  stay in state.
40$:	MOVB	#'A,STATE(A0)		; goto abort
	JMP	1000$			;  done
50$:	CMPB	D4,#'Z			; end of file?
	BNE	80$			;  no
	CALL	NEXTO			; D1 gets next oldtry
	CMPB	D1,MAXTRY(A0)		;  time to give up?
	BLOS	60$			;   no
	MOVB	#'A,STATE(A0)		;   yes-abort
	JMP	1000$			; done
60$:	MOVB	N(A0),D1		; get N
	CALL	PREVP			; calc previous packet # to D1
	CMPB	D1,D3			;  same ?
	BNE	70$			;  no
;	SPACK	TYPE,SEQ,SIZE,PACKET
; perhaps this should not be PACKET, but some other area!!!!
	SPACK	#'Y,D3,#0,PACKET(A0)	;   yes-ack again with SEND-INIT
	CLRB	NUMTRY(A0)		; reset tries
	JMP	1000$			;  done

70$:	MOVB	#'A,STATE(A0)		; goto ABORT otherwise.
	JMP	1000$
80$:	CMPB	D4,#'F			; is the the blessed file header yet?
	JNE	200$			;  no	
	CMPB	D3,N(A0)		;  yes-is the packet # correct?
	BNE	70$			;   no-move to abort state.
	CALL	RFILNM			; process the filename & open.
	BEQ	90$			; it opened ok
	CALL	LFERR			; show local file error
	MOVB	#'A,STATE(A0)		; move to abort state
	JMP	1000$			; done
90$:	TSTB	NOTALK(A0)		; do we have a user terminal?
	BNE	120$			;  no-bypass message
	TYPE	<Receiving >
	CLR	D0
	MOVB	LDATA(A0),D0
	LEA	A1,FILNAM(A0)
	BR	110$
100$:	MOVB	(A1)+,D1
	TTY
110$:	DBF	D0,100$
	TYPE	< as >
	PFILE	FIO(A0)
	CRLF
120$:
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,N(A0),#0,PACKET(A0)	;   send ACK for the F packet
	MOVB	NUMTRY(A0),OLDTRY(A0)	; reset try counters
	CLRB	NUMTRY(A0)
	CALL	BUMPP			; get next packet #
	MOVB	#'D,STATE(A0)		; move to data state
	JMP	1000$
200$:	CMPB	D4,#'B			; break ?
	BNE	300$			;  no
	CMPB	D3,N(A0)		;  yes-is packet # correct?
	BNE	310$	
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,N(A0),#0,PACKET(A0)	;   send ACK for the B packet
	MOVB	#'C,STATE(A0)		; and move to Complete state
	JMP	1000$			; end
300$:	CMPB	D4,#'E			; error frame ?
	BNE	400$			;  no
	CALL	PRTERR			;  show it
310$:	MOVB	#'A,STATE(A0)		; move to abort
	JMP	1000$
400$:	MOVB	#'A,STATE(A0)		; goto abort state
	JMP	1000$
; didnt get a packet
500$:
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'N,N(A0),#0,PACKET(A0)	;   send NAK 
1000$:	RTN

; R D A T A -  receives the data packets that make up the file.
RDATA:	ADDB	#1,NUMTRY(A0)		; count the tries
	CMMB	NUMTRY(A0),MAXTRY(A0)	; beyond the max?
	BNE	20$
	MOVB	#'A,STATE(A0)
	RTN

20$:	
;	RPACK	LEN,SEQ,PACKET,TYPE
	RPACK	D2,D3,PACKET(A0),D4	; receive a packet (expecting filename)
	JNE	500$			;  no packet received ; timeout
	CMPB	D4,#'D			; got a Data packet ?
	JNE	60$			;  no
	CMPB	D3,N(A0)		;  yes-is it right packet # ?
	BEQ	50$			;   YES
	CALL	NEXTO			;   NO-get next OLDTRY value in D1
	CMPB	D1,MAXTRY(A0)		;  
	BLOS	25$
	MOVB	#'A,STATE(A0)		; abort -retries exceeded
	JMP	1000$			;  done

25$:	MOVB	N(A0),D1		; D1 gets current packet #
	CALL	PREVP			; get previous packet #
	CMPB	D1,D3			; previous packet ?
	BNE	40$			;  no
;	SPACK	TYPE,SEQ,SIZE,PACKET	
	SPACK	#'Y,D3,#6,PACKET(A0)	;   yes-re-ack.
	CLRB	NUMTRY(A0)		; clear retry count
	JMP	1000$			;  stay in state.
40$:	MOVB	#'A,STATE(A0)		; goto abort
	JMP	1000$			;  done
; received valid data frame - output it
50$:	CALL	BUFEMP			; empty the buffer to disk
;	SPACK	TYPE,SEQ,SIZE,PACKET	
	SPACK	#'Y,N(A0),#0,PACKET(A0)	;   ack the data
	MOVB	NUMTRY(A0),OLDTRY(A0)	; reset the try counters
	CLRB	NUMTRY(A0)		; clear retry count
	CALL	BUMPP			; bump the packet #
	MOVB	#'D,STATE(A0)		; stick in D state.
	CALL	SHODOT			; tell user we moved some data
	JMP	1000$			;  stay in state.

60$:	CMPB	D4,#'F			; file header?
	BNE	80$			;  no
	CALL	NEXTO			; D1 gets next oldtry
	CMPB	D1,MAXTRY(A0)		;  time to give up?
	BLOS	70$			;   no
65$:	MOVB	#'A,STATE(A0)		;   yes-abort
	JMP	1000$			; done
70$:	MOVB	N(A0),D1		; get N
	CALL	PREVP			; calc previous packet # to D1
	CMPB	D1,D3			;  same ?
	BNE	65$			;  no
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,D3,#0,PACKET(A0)	;   yes-ack again
	CLRB	NUMTRY(A0)		; reset tries
	JMP	1000$			;  done

80$:	CMPB	D4,#'Z			; end of file?
	BNE	200$			;  no	
	CMPB	D3,N(A0)		;  yes-is the packet # correct?
	BNE	65$			;   no-move to abort state.
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'Y,D3,#0,PACKET(A0)	;   ack the Z

	CLOSE	FIO(A0)			;   yes-close the file
	CALL	BUMPP			; bumpthepacket#
	MOVB	#'F,STATE(A0)		; return the F state
	BR	1000$

200$:	CMPB	D4,#'E			; error frame ?
	BNE	400$			;  no
	CALL	PRTERR			;  show it
	MOVB	#'A,STATE(A0)		; move to abort
	JMP	1000$
400$:	MOVB	#'A,STATE(A0)		; goto abort state
	JMP	1000$
; didnt get a packet
500$:
;	SPACK	TYPE,SEQ,SIZE,PACKET
	SPACK	#'N,N(A0),#0,PACKET(A0)	;   send NAK 
1000$:	RTN

;;;		       P A C K E T   U T I L I T I E S

; B U M P P - bumps the current packet mod 64. The new N is returned in D1,
; and is also updated in N(A0).
BUMPP:	BCALL	NEXTN
	MOVB	D1,N(A0)
	RTN

; N E X T N - returns the next N(A0) value in D1. It does NOT update N(A0).
NEXTN:	MOVB	N(A0),D1
	ADD	#1,D1
	AND	#63.,D1
	RTN

; N E X T O - returns the next OLDTRY(A0) value in D1. It does not update OLDTRY(A0).
NEXTO:	MOVB	OLDTRY(A0),D1
	ADD	#1,D1
	AND	#63.,D1
	RTN

; P R E V P - returns the prior packet to D1 in D1. ( D1-1 mod 64. )
PREVP:	SUB	#1,D1
	AND	#63.,D1
	RTN

; P R T E R R - prints the error message contained in the Error packet
PRTERR:	CLR	D0			; 
	MOVB	LDATA(A0),D0		; get length of data field
	LEA	A1,DATA(A3)
	TTYL	ABTTTL
	BR	30$
20$:	MOVB	(A1)+,D1
	TTY
30$:	DBF	D0,20$
	CRLF
	RTN


; S P A R  - fill data area with send-init parameters
SPAR:	LEA	A1,DATA(A3)	; index payload area
	CLR	D1
	MOVB	MXPKSZ(A0),D1		; get max packet size
	CHAR	D1
	MOVB	D1,(A1)+		; 1 max packet size
	MOV 	TIMINT(A0),D1
	CHAR	D1
	MOVB	D1,(A1)+		; 2 # of seconds to my timeout
	MOV	#MYPAD,D1
	CHAR	D1
	MOVB	D1,(A1)+		; 3 # of padding characters
	MOV	#MYPCHR,D1
	CTL	D1			; the pad character translated
	MOVB	D1,(A1)+		; 4
	MOV	#0,D1			; we do not need an EOL this end.
	CHAR	D1
	MOVB	D1,(A1)+		; 5 end of line character
	MOV	#MYQUOT,D1
	MOVB	D1,(A1)+		; 6 control quoting character
; handle QBIN
	MOVB	QBIN(A0),D1		; get QBIN
	BEQ	10$			; use the character we have
	CMPB	D1,#177			; are we set to 7 bit no quoting?
	BNE	20$			;  no
10$:	MOVB	#'Y,D1			; default to quoting on request
20$:	MOVB	D1,(A1)+		; 7 the optional binary quoter
	MOVB	DF.CHK(A0),(A1)+	; 8 the optional checksum type
	PARSIZ	=8.
;;;	MOVB	#'~,(A1)+		; 9 repeat prefix (~)
	RTN

; R P A R  -  get the REMOTE's send-init parameters.
; At entry, A3 indexs the packet area
RPAR:
	MOVB	#'1,CHKT(A0)		; default to 1 char checksum
	MOVB	#SPACE,REPT(A0)		; and no repeat
	CLRB	QBIN(A0)		; default to no quoting [5/12/86 rpr]	
	CMPB	PARITY(A0),#'N		; do we have 8 data bits?
	BEQ	5$			;  yes- QBIN 0 is correct default
	SETB	QBIN(A0)		;  no- preset QBIN to 7 bit ascii
5$:	LEA	A1,DATA(A3)		; index the payload area
	CLR	D1
	MOVB	(A1)+,D1		; get MAXL byte
	AND	#177,D1			; strip to ASCII in case of parity
	UNCHAR	D1
	CMPB	D1,MXPKSZ(A0)		; MAXL can be as high as 94.
	BHI	7$			;  but no higher
	CMPB	D1,#10.			; MAXL should be at least 10.
	BHIS	8$
7$:	MOV	#80.,D1			; default MAXL is 80.
8$:	MOVB	D1,SPSIZ(A0)		; set send packet size
	MOVB	(A1)+,D1 		; get TIME byte
	UNCHAR	D1
	MOV	D1,TIMINT(A0)		; set when I should time out
	MOVB	(A1)+,D1		; get NPAD byte
	UNCHAR	D1
	MOVB	D1,PAD(A0)		; set pad count.
	MOVB	(A1)+,D1		; get PADC byte
	CTL	D1
	MOVB	D1,PADCHR(A0)		; set pad character
	MOVB	(A1)+,D1		; get EOL byte
	UNCHAR	D1
	MOVB	D1,EOL(A0)		; set end of line char
	MOVB	(A1)+,D1		; get QCTL byte
	CMPB	D1,#SPACE
	BHI	9$
	MOV	#MYQUOT,D1		; default it
9$:	MOVB	D1,QUOTE(A0)		; set control-quote.
	CLR	D2
	MOVB	LDATA(A0),D2		; get size of data area
	SUB	#6,D2			; have more than basic 6 bytes?
	BLOS	100$			; no more data
; get QBIN
	MOVB	(A1)+,D1		; get QBIN byte
	AND	#177,D1			; strip to ASCII
	CMPB	D1,#'Y			; will do it only if we request?
	BEQ	25$			;  yes-we will not quote
	CMPB	D1,#'N			; other side does not support quoting?
	BEQ	25$			;  no-other side requires quoting
; allowable ranges are decimal 33-62 & 96-126. Reject all others.
	CMPB	D1,#SPACE		; was it a space through null?
	BLOS	30$			;  yes-can not do 8bit!
	CMPB	D1,#62.			; ASCII 33-62?
	BLO	40$			;  yes-use it
14$:	CMPB	D1,#126.		; check high boundary of 2nd range
	BHI	25$			;  not legal value (DEL)
	CMPB	D1,#96.			; check lower bound of 2nd range
	BHIS	40$			;  legal
25$:	CLR	D1			;  eight bit quoting not required
	CMPB	PARITY(A0),#'N		; do we have NO parity?
	BEQ	40$			;  yes-WE DON'T NEED 8 BIT QUOTES!
30$:	MOV	#-1,D1			;  NO-use of parity forces control-quotes
40$:	MOVB	D1,QBIN(A0)		; set QBIN
	SUB	#1,D2
	BEQ	100$			; no more
; get CHKT
	MOVB	(A1)+,D1		; get CHKT byte
	CMPB	D1,#'2			; higher than 2?
	BHI	50$			;  yes-force to one
	BEQ	60$			;  no-exactly two-allow it
	CMPB	D1,#1			; do not allow zero
	BEQ	60$
50$:	MOV	#'1,D1			; force to 1 if not 1 or 2
60$:	MOVB	D1,CHKT(A0)		; set checksum method
	SUB	#1,D2
	BEQ	100$
; get REPT
	MOVB	(A1)+,D1		; get REPT byte
	UNCHAR	D1
	MOVB	D1,REPT(A0)		; set repeat prefix
100$:	CMPB	QUOTE(A0),#SPACE	; quote undefined ?
	BNE	110$			;  no-defined
	MOVB	#'#,QUOTE(A0)		;  yes-use default
110$:	RTN

; FLUSH deletes all pending input from the input buffer
FLUSH:	MOV	REMOTE(A0),A5
	CLR	T.ICC(A5)
	RTN

; B U F F I L  -  fills a packet @A3 with data.
; we will limit data size to 3 less than actual size to allow the last
; character to be control and 8bit quoted, without look-ahead schemes.
; the worst cases are '# = &## and '& = &#&.
; data count goes to BUFCNT(A0).
; At entry, 	A3 must index the data packet area to be filled,
;		CHKNOW(A0) must contain the binary checksum size
BUFFIL:	CLR	D0
	MOVB	SPSIZ(A0),D0		; D0 gets max msg size to remote
	SUBB	CHKNOW(A0),D0		; less size of checksum
	SUB	#<3>,D0			;  less overhead bytes	
	LEA	A1,DATA(A3)		; index the data area
10$:	FILINB	FIO(A0)			; get a data byte
	TST	FIO+D.SIZ(A0)		; end of file ?
	BEQ	100$			;  yes
; test for high bit
	BTST	#7,D1			;  no-test for eighth bit set.
	BEQ	30$			;   bit 7 is clear
; handle high bit prefixing, if any
	MOVB	QBIN(A0),D7		; get 8bit quote character.
	BMI	20$			;  no high bit can be used
	BEQ	30$			;  no 8 bit quoting needed!
	MOVB	D7,(A1)+		; buffer the 8bit quote
	SUB	#1,D0			; decrement the count
20$:	AND	#177,D1			; strip to ascii
30$:	MOVB	D1,D2		
	AND	#177,D2			; D2 gets stripped version
	CMPB	D2,#DEL			; is it a DEL
	BEQ	35$			;   this is non-printable.
; also prefix the prefix, and the high bit prefix with the prefix!
	CMPB	D2,QUOTE(A0)		; is this character the prefix?
	BNE	32$			;   no
	MOVB	D2,(A1)+		;   yes-prefix it with itself
	SUB	#1,D0
32$:	TSTB	QBIN(A0)		; check 8 bit quoting
	BLE	34$			;  none
	CMPB	D2,QBIN(A0)		; matching?
	BNE	34$			;  no-      [10/23/84 rpr]
	MOVB	QUOTE(A0),(A1)+		;  yes-quote it first
	SUB	#1,D0			; less one for quote
34$:	CMPB	D2,#SPACE		; is it control ?
	BHIS	50$			;  no-prinatble
; unctrol-ify the character, while preserving possible bit7.
35$:	CTL	D1			; uncontrol-ify
40$:	MOVB	QUOTE(A0),(A1)+
	SUB	#1,D0
50$:	MOVB	D1,(A1)+
	SUB	#1,D0
	BGT	10$			; loop till filled up
100$:	LEA	A6,DATA(A3)
	MOV	A1,D1
	SUB	A6,D1			; D1 gets outgoing data size
	MOVB	D1,BUFCNT(A0)		; set data count
	RTN

; B U F E M P  -  empties the incoming data contents of the packet @A3 to
; the FIO(A0) file.
BUFEMP:	LEA	A1,DATA(A3)		; index the data area
	CLR	D0
	MOVB	LDATA(A0),D0		; D0 gets the count
10$:	CALL	GETBYT			; get an input byte [10/23/84]
; doing 8bit quoting?
	MOVB	QBIN(A0),D2		; get 8bit quote character
	BLE	100$			;  no binary quoting
	CMPB	D2,D1			; is it binary quote ?
	BNE	100$			;  no
; 8bit quote received. Evaluate following characters.
	MOV	#200,D3			; set high bit flag
	CALL	GETBYT			; get next byte
	CALL	EVALQ			; evaluate this & next chars
	ORB	D3,D1			; combine evaluated char & top bit
	BR	500$

100$:	CLR	D3			; clear high bit flag
	CALL	EVALQ			; evaluate
500$:	FILOTB	FIO(A0)			; output the data byte
	TST	D0
	BGT	10$			; output all bytes
	RTN

; E V A L Q  - evaluates the byte in D1. Expands quoted control characters,
; quoted quotes, and eighth bit quotes and quoted eighth bit quotes.
EVALQ:	CMPB	D1,QUOTE(A0)		; is it a quote ?
	BNE	100$			;  no-just return with value
	CALL	GETBYT			;  yes - get next byte
	MOVB	D1,D7
	AND	#177,D7			; get stripped version of character
	CMPB	D7,QUOTE(A0)		; is it double qoute ?
	BEQ	100$			; yes-pass it literally
	TSTB	QBIN(A0)		; test for 8 bit quote active
	BLE	10$			;  no-sending binaries
	CMPB	D1,QBIN(A0)		; 8bit quote prefixed by ctl quote?
	BEQ	100$			;  yes-use literally.
10$:	CTL	D1			; turn it to control
100$:	RTN		

; G E T B Y T - gets the next data byte for BUFEMP.
GETBYT:	MOVB	(A1)+,D1		; get a byte	
	TSTB	QBIN(A0)		; allowing binaries?
	BEQ	10$			;  yes
	AND	#177,D1			;  no-strip to seven	
10$:	SUB	#1,D0			;  adjust count
	RTN

; R E C P A K  -  receives a data packet from the remote computer.
; This routine simply inputs a single packet, without performing
; packet checking or other details.
; On Entry,	A3 indexs the packet destination

; On exit,	D0 is the received checksum
;		D1 is the calculated checksum
;		D2 is the LEN
;		D3 is the SEQ
;		D4 is the TYPE
;		Z is set if a packet is received
; 		CHKNOW(A0) contains binary 1,2, or 3 for checksum size
RECPAK:	
; initialize packet receiver
	CALL	SETEND			; set timer ending time
	MOV	REMOTE(A0),A5		; index the remote TRMDEF
10$:	CALL	GETREM			; get remote character
	JNE	100$			;  timeout, no data
; syncronize the packet to the mark byte (usually ^A)
	AND	#177,D1			; strip parity here, always
	CMPB	D1,RMARK(A0)		; start of packet ?
	BNE	10$			;  no-keep looking
20$:	MOV	A3,A1			; use A1 as work register.
	MOVB	D1,(A1)+		;  yes-store it
; get the length from the next byte
	CALL	GETREM			;   get LEN
	JNE	100$			; timeout, no data
	CMPB	D1,RMARK(A0)		; start of packet ?
	BEQ	20$			;  yes-resync.
	MOVB	D1,(A1)+		;  else save the LEN
	MOVW	D1,CSUM(A0)		; start checksum with LEN
	UNCHAR	D1			; convert to binary
	MOV	D1,D2			; save the LEN
; receive the SEQ byte
30$:	CALL	GETREM			;   get SEQ
	JNE	100$			; timeout, no data
	CMPB	D1,RMARK(A0)		; start of packet ?
	BEQ	20$			;  yes-resync.
	MOVB	D1,(A1)+		;  else save the SEQ
	ADDW	D1,CSUM(A0)		; update checksum
	MOV	D1,D3
	UNCHAR	D3			; D3 is sequence #
; receive the TYPE byte
	CALL	GETREM			;   get TYPE
	JNE	100$			; timeout, no data
	CMPB	D1,RMARK(A0)		; start of packet ?
	BEQ	20$			;  yes-resync.
	MOVB	D1,(A1)+		;  else save the TYPE
	ADDW	D1,CSUM(A0)		; update checksum
	MOV	D1,D4			; D4 gets the type
; calc the data area size.
	MOV	D2,D1			; D1 gets the binary length
	CALL	CALCHK			; calculate checksum size
	CLR	D0
	MOVB	CHKNOW(A0),D0		; get checksum size
	ADD	#2,D0			; D0 gets size of SEQ,TYPE
	SUB	D0,D1			;  D1 gets size of data area
	MOVB	D1,LDATA(A0)		; save length of data
	MOV	D1,D0			; D0 gets length
	CMPB	D0,#94.-3.		;  is it legal ?
	JHI	100$			;   no-crap out
	BR	45$			; use DBF to control buffering of
					; 0 or more characters.
; buffer the data bytes
40$:	CALL	GETREM			; get a byte
	JNE	100$			;  timeout
	CMPB	D1,RMARK(A0)		; start of packet ?
	BEQ	20$			;  yes-resync.
	MOVB	D1,(A1)+		; store data
	ADDW	D1,CSUM(A0)		; update checksum
45$:	DBF	D0,40$			;  gather packet.
; now get the checksum
	CALL	GETREM			;   get CHECK
	JNE	100$			; timeout, no data
	CMPB	D1,RMARK(A0)		; start of packet ?
	JEQ	20$			;  yes-resync.
	UNCHAR	D1			; convert CHECK
	MOV	D1,D0			; D0 gets checksum byte #1
	CMPB	CHKNOW(A0),#2		; two character checksum?
	BNE	60$			;  no-leave CHECK type as normal
	CALL	GETREM			;  yes- get second byte
	UNCHAR	D1			; convert it
	LSL	D0,#6.			; shift 1st byte to bits 11-6
	ORW	D1,D0			; D0 gets bits 11-0
	MOVW	CSUM(A0),D1		; D1 gets calculated csum
	ANDW	#^B0000111111111111,D1	; mask it to 12 bits only
	BR	90$

60$:	CLR	D1
	MOVB	CSUM(A0),D1		; get calculated sum
	MOV	D1,D7			;  twice
	LSR	D7,#6			; move bits 7-6 to 1-0
	AND	#3,D7			; toss all other bits
	ADD	D7,D1			; add to sum
	AND	#77,D1			; strip to 6 bits.
90$:	TSTB	DEBUGO(A0)		; debug mode ?
	JEQ	95$			;  no
	PUSH	D1
	CLR	D1
	TYPE	<==Received Packet # >
	MOV	D3,D1				
	DCVT	2,OT$TRM!OT$TSP		; output as 2 characters
	TYPE	<, Type >	
	MOV	D4,D1
	TTY
	TYPE	< Length: >
	MOV	D2,D1
	DCVT	2,OT$TRM
	CRLF
	TYPE	<Checksums >	
	MOV	@SP,D1			; get calced sum
	CMPW	D0,D1			; do they match ?
	BNE	93$			;  no
	TYPE	<match (>
	DCVT	0,OT$TRM
	TYPE	<)>
	BR	94$

93$:	TYPE	<calculated = >
	DCVT	0,OT$TRM
	TYPE	<, received = >
	MOV	D0,D1
	DCVT	0,OT$TRM
94$:	CRLF
	CRLF
	POP	D1
95$:	CMPW	D0,D1			; compare checksums
100$:	RTN


; S N D P A K  -  sends a packet.
; On Entry,	A3 indexs the packet destination
;		D2 is the LEN
;		D3 is the SEQ
;		D4 is the TYPE
; At exit,	CHKNOW(A0) contains the checksum size used.
SNDPAK:	TSTB	DEBUGO(A0)
	BEQ	30$
	TYPE	<Sending ">
	MOVB	D4,D1
	TTY
	TYPE	<" packet # >
	CLR	D1	
	MOVB	D3,D1
	DCVT	0,OT$TRM
	TYPE	< of length >
	MOVB	D2,D1
	DCVT	0,OT$TRM
	CRLF
	TYPE	<Data =">
	SAVE	A2,D0
	LEA	A2,DATA(A3)
	MOV	D2,D0
	SUB	#1,D0
	BMI	20$
10$:	MOVB	(A2)+,D1
	TTY
	DBF	D0,10$
20$:	REST	A2,D0
	TYPECR	<">
	CRLF
; send a packet to the remote KERMIT
30$:	MOV	REMOTE(A0),A5		; index remote TRMDEF
	CLR	D0
	MOVB	PAD(A0),D0		; get pad count
	BEQ	50$			; no pad characters needed
	SUB	#1,D0			; adjust
	MOVB	PADCHR(A0),D1
40$:	TTYOUT				; send the pad character
	CALL	STALL			; stall, if needed
	DBF	D0,40$			; 
50$:	MOV	A3,A1			; A1 is work pointer
	MOVB	RMARK(A0),(A1)+		; buffer MARK character
	MOV	D2,D1			; D1 gets LEN
	CALL	CALCHK			; calculate checksum size
	ADDB	CHKNOW(A0),D1		; add size of checksum
	ADD	#2,D1			; plus SEQ & TYPE
	CHAR	D1			; make it printable
	MOVB	D1,(A1)+		; store LEN	
	MOVW	D1,CSUM(A0)		; initialize the checksum
	CHAR	D3
	MOVB	D3,(A1)+		; store SEQ
	ADDW	D3,CSUM(A0)		; 
	MOVB	D4,(A1)+		; store TYPE	
	ADDW	D4,CSUM(A0)		; 
; data (if any) is already in buffer. Add it to checksum
	CLR	D1
	BR	70$			
60$:	MOVB	(A1)+,D1		; get a byte
	ADDW	D1,CSUM(A0)		; add to checksum
70$:	DBF	D2,60$			; loop till all data checked
; handle checksum translation
	CMPB	CHKNOW(A0),#2		; two character checksum ?
	BNE	90$			;  no - must be one character
; two character checksum
	MOVW	CSUM(A0),D1		; get all bits
	MOV	D1,D7			;  in two regs
	LSR	D7,#6.			; position bits D11-D6
	AND	#77,D7			; strip to 6 bits
	CHAR	D7			; make it printable
	MOVB	D7,(A1)+		; store D11-D6
	AND	#77,D1			; strip to 6 bits
	CHAR	D1			; make it printable
	MOVB	D1,(A1)+		; store checksum bits D5-D0
	BR	100$

90$:	MOVB	CSUM(A0),D1		; D1 gets low eight of sum
	MOV	D1,D7			; D7 gets same
	AND	#300,D7			; take just bits 7-6.
	LSR	D7,#6.			; shift to bits 1-0
	ADD	D7,D1			; D1 gets sum
	AND	#63.,D1			; make it six bits again.
	CHAR	D1			; make it prinatble
	MOVB	D1,(A1)+		; store checksum
; check for EOL character
100$:	MOVB	EOL(A0),D7		; need any EOL ?
	BEQ	110$			;  no
	MOVB	D7,(A1)+		;  yes-store it
; calculate size of buffered packet from pointer displacement
110$:	MOV	A1,D0			; current position
	SUB	A3,D0			;  less start is length
	SUB	#1,D0
120$:	MOVB	(A3)+,D1		; get a byte
	TTYOUT				; output it to REMOTE
	CALL	STALL			; stall ,if needed
	DBF	D0,120$			;  till packet is sent
	RTN
; O U T B Y T   - This routine outputs the byte in D1 to the remote.
OUTBYT:	MOV	REMOTE(A0),A5		; get TCB pointer for remote
	TTYOUT				; send the byte out
	RTN

; S T A L L - stalls a certain amount of time after output in progress
; is lowered. At entry, A5 must index the output TCB.
STALL:	TSTB	STLCHR(A0)		; do we need to stall?
	BEQ	20$			;  no
10$:	CTRLC	20$			; abort - CTS must be low
	TSTB	@A5
	BMI	10$			; wait for OIP to drop
	CLR	D7
	MOVB	STLCHR(A0),D7
	MUL	D7,#10000./100.		; trasform to ticks
	SLEEP	D7
20$:	RTN

; C A L C H K  -  determines the current checksum size.
; This routine unifies the logic needed to force 1 byte checksums on SEND-INIT
; fields and their ACKS.
; At entry,
;	D2 contains the LEN in binary
;	D4 contains the packet type
; At exit, CHKNOW(A0) contains the binary value of the current checksum size.
CALCHK:	CLR	D7
	MOVB	CHKT(A0),D7		; get checksum type
	SUBB	#'0,D7			;  less ASCII bias
; force check type 1 for S packets
	CMPB	D4,#'S			; Send Init ?
	BNE	10$			;  no
	MOV	#1,D7			;  yes-force check 1
; force check type 1 for Y responses to S packets.
10$:	CMPB	D4,#'Y			; ACK ?
	BNE	20$			;  no
	TSTB	RIACK(A0)		;  yes-has I been acked yet?
	BNE	30$			;   yes-selected checksum is ok
	MOV	#1,D7			;   no-force checksum type 1
; if NAK, we can deduce packet size from LEN
; this is useful if the 1st packet after changing checksum types is damaged.
; The other side will NAK, and we can recover the right length from the LEN
; of the NAK packet. (ACK packets may have filenames appended, and their size
; is not reliable.
20$:	CMPB	D4,#'N			; is it a NAK?
	BNE	30$			;  no- use selected type
	MOVB	D2,D6			;  yes-get LEN
	SUBB	#2,D6			; less 2 gives checksum size
	CMPB	D6,#2			; compare to largest supported type	
	BHI	30$			;  out of range - ignore bad advice	
	MOVB	D6,D7			; well
	ADDB	#'0,D6
	MOVB	D6,CHKT(A0)
30$:	MOVB	D7,CHKNOW(A0)		; save current checksum choice
	RTN

; G E T R E M  -  gets a single character from the remote computer. 
; At entry, A5 must index the REMOTE TRMDEF.
; At exit, D1 will contain the character, or a -1 for no character.
; Z will be set if a character was available for input.
GETREM:	MOV	#-1,D1			; preset for no data
	BR	20$
10$:	SLEEP	SLPVAL(A0)		; wait for more data [14]
; wait 1 character time for more date for higher throughput [14]
	CTRLC	100$
	GTIMEI	D7
	CMP	D7,RTOUT(A0)		; EXPIRED?
	BHIS	200$			;  YES
20$:	TST	T.ICC(A5)		; any data to input ?
	BEQ	10$			;  no input
	CLR	D1			; pre-clear D1
	TTYIN				; get a character
	TSTB	QBIN(A0)		; are we allowing 8 data bits?
	BEQ	30$			;  yes
	AND	#177,D1			;  no-strip parity bit
30$:	CMPB	D1,#3.			; control-c?
	BNE	40$			; no
	COMB	CCOUNT(A0)		; yes-toggle /2 counter
	BNE	50$			; only one detected
	JOBIDX
	ORW	#J.CCC,@A6		; two detected - set control-c flag
40$:	CLRB	CCOUNT(A0)		; clear control-c count
50$:	LCC	#PS.Z
	RTN
100$:	LCC	#0
	RTN
200$:	LCC	#PS.V			; flag overflow for timeout
	RTN

; S E T E N D  -  calculates and stores the value of the timeout point in internal
; format.
SETEND:	GTIMEI	D7			; D6 gets internal format time.
	ADD	TIMINT(A0),D7
	MOV	#24.*60.*60.,D6		; D6 gets highest internal time+1
	CMP	D7,D6
	BLO	10$ 			; o.k. - no wraparound
	SUB	D6,D7			; handle wrap-around
10$:	MOV	D7,RTOUT(A0)		; SET TIME-OUT TIME
	RTN


; G T S I Z E  -  gets file size in bytes. Destroys D6,D7. Assumes file 
; has been looked up on FIO(A0). FSIZE(A0) contains the size on exit.
GTSIZE:	MOV	FIO+D.SIZ(A0),D7	; D7 gets record size
	MOV	FIO+D.LEN(A0),D6	; D6 gets # of blocks
	TSTW	FIO+D.ACT+2(A0)		; random file ?
	BMI	10$			;  yep-straight multiply
	SUB	#2,D7			;  no-subtract pointer bytes.
	SUB	#1,D6			;   and less last block
10$:	MUL	D7,D6			; block payload size * blocks
	TSTW	FIO+D.ACT+2(A0)		; random file ?
	BMI	20$			;  yep.
	ADD	FIO+D.ACT(A0),D7	;  sequential-add last block's count
	SUB	#2,D7			; less link word in last block
20$:	MOV	D7,FSIZE(A0)		; size of the file
	RTN

; S T A R T T  - gets the current time and saves it in STIME(A0).
; Used to determine the elapsed time in file transfers.
STARTT:	GTIMEI	STIME(A0)		; save the start time
	RTN

; E N D T M  - calculate and display the elapsed time & effective baud rate
; for a file transfer.
; At entry, FSIZE must contain the file size in bytes.
ENDTM:	TSTB	NOTALK(A0)		; do we have a user terminal?
	JNE	30$
	GTIMEI	D2			; get current time
	SUB	STIME(A0),D2		; less start time
	BCC	10$			;  no midnight wraparound
	ADD	#24.*60.*60.,D2		;  else add 24 hours of seconds [14]
10$:	MOV	D2,D4			; save for effective baud rate
	CRLF
	TYPE	<Elapsed time was >
	CLR	D1
	DIV	D2,#60.*60.		; convert to hours
	MOVW	D2,D1
	DCVT	2,OT$TRM!OT$ZER		; display hours
	TYPE	:
	CLRW	D2
	SWAP	D2			; remainder to lower 16 bits
	DIV	D2,#60.			; make it minutes
	MOVW	D2,D1
	DCVT	2,OT$TRM		; display minutes
	TYPE	:
	CLRW	D2
	SWAP	D2			; seconds remiander to low 16
	MOV	D2,D1
	DCVT	2,OT$TRM		; display seconds
	TYPE	<, effective baud rate was >
	MOV	FSIZE(A0),D1		; get characters
; multiply by 10 by adding 2*D1 and 8*D1
	MOV	D1,D7			; duplicate
	ADD	D1,D1			;  double
	LSL	D7,#3.			;   shift to make 8* old D1
	ADD	D7,D1			;    add to make 10 * old D1
	DIV	D1,D4			;  divided by seconds
	AND	#177777,D1		; strip off remainder
	DCVT	0,OT$TRM			; display it
	TYPECR	<.>			; new line
30$:	RTN

; S H O E S C  displays the current escape from connect mode character.
SHOESC:	TYPE	<Escape character is >
	MOVB	KMETA(A0),D1
	CALL	SHOCHR
	CRLF
	RTN

; S H O C H R  -  displays in printable form the character in D1.
SHOCHR:	PUSH	D1
	BTST	#7,D1
	BEQ	10$
	TYPE	<%>
10$:	AND	#177,D1
	CMPB	D1,#SPACE
	BHIS	20$
	TYPE	^
	CTL	D1			; un-controlify it
20$:	TTY	
	POP	D1
	RTN

; show the notice & title & version
KERTTL:	TTYL	TITLE		; show the title
; show the program name & version
KERVER:	TTYL	TITL2
	VCVT	KERMIT+PH.VER,OT$TRM	; show the version #
	CRLF
	RTN

; S H O D O T  - print a dot on user's terminal whenever a packet has been
; sent or recvd. (But don't do it when using user's terminal for I/O.)
SHODOT:	TSTB	NOTALK(A0)		; TRMDEF owned by KERMIT job?
	BNE	10$			;  yes - do not type dot!
	TYPE	<.>			;  no-go ahead & show user kermit
10$:	RTN				;  is working

IMPNAM:	RAD50	/KERMITIMP/		; name of user's variables module.

; This table defines the KERMIT commands and the subroutine address
DEFINE	KCOM	NAME, KSIZE, ADDR, HELP
	WORD	10$$-.
	BYTE	KSIZE
	ASCII	/NAME/
	BYTE	0
	EVEN
	ASCII	/HELP/
	BYTE	0
	EVEN
10$$:	WORD	ADDR-.
	ENDM

; K E R C O M   is the main commands table for KERMIT.
KERCOM:	
KCOM	AMOS,1,AMOS,<Execute an AMOS command.>
KCOM	CONNECT,1,CONNEC,<Connects your terminal to the remote KERMIT site.>
KCOM	EXIT,1,GOODBY,<Exit from KERMIT to AMOS.>
KCOM	HELP,1,HELP,<Types a summary of KERMIT commands and what they do.>
KCOM	RECEIVE,1,RECEIV,<receive {filespec} receives a file from the remote KERMIT.>
KCOM	SEND,1,SEND,<{filename} sends a filename to the remote KERMIT.>
KCOM	SET,3,SET,<Set allows nonstandard parameters such as escape character.>
KCOM	SHOW,2,SHOW,<Show displays the current SET options.>
KCOM	?,1,HELP,<The shorthand version of HELP.>
	WORD	0

; S E T C O M  is the SET subcommands table for SET.
SETCOM:	
KCOM	BELL,2,BELL,<Beep after each command option.>
KCOM	BLOCKCHECK,2,BLOCK,<Block-check type, 1 or 2 byte checksum.>	
KCOM	DEBUG,2,DEBUG,<Debug option on or off.>
KCOM	DUPLEX,2,DUPLEX,<Set FULL or HALF duplex.>
KCOM	ENDLINE,2, ENDLIN,<Packet terminator character.>
KCOM	ESCAPE,2,ESCAPE,<Escape character for CONNECT.>
KCOM	PACKETSIZE,6,PAKMAX,<Maximum packet size.>
KCOM	PARITY,2,SETPAR,<Denote parity type for NON-alpha remotes.>
KCOM	RETRIES,1,NEWTRY,<Number of failed packet attempts that cause abort.>
KCOM	STALL,1,STLVAL,<Number of hundreths of seconds to pause between characters.>
KCOM	TIMEOUT,1,TIMER,<Packet time-out value.>
	WORD	0

; This table defines the GETOPT list for options arguments.
DEFINE	OPT	NAME, KSIZE, VALUE
	WORD	10$$-.
	BYTE	KSIZE
	ASCII	/NAME/
	BYTE	0
	EVEN
10$$:	WORD	VALUE
	ENDM

; This defines the format of the end of the options list.
DEFINE	OMSG	STRING
	WORD	0
	ASCII	/STRING/
	BYTE	0
	ENDM

; options list for logical options (YES, NO, 1,0, TRUE, FALSE are valid)
ONOFF:
YESNO:	OPT	YES,1,377
	OPT	NO,1,0
	OPT	ON,2,377
	OPT	OFF,2,0
	OPT	TRUE,1,377
	OPT	FALSE,1,0
	OPT	1,1,377
	OPT	0,1,0
	OMSG	<%Use YES or NO, ON or OFF, TRUE or FALSE, 1 or 0.>
	EVEN	

; options list for block check size
ONETWO:	OPT	1,1,'1
	OPT	2,1,'2
	OPT	ONE,1,'1
	OPT	TWO,2,'2
	OMSG	<%Use 1, 2, ONE or TWO to set check value size.>
	EVEN

; options for echoplex (see DUPLEX:)
EPLEX:	OPT	FULL,1,0
	OPT	HALF,1,377
	OMSG	<%Use FULL or HALF to set duplex options.>
	EVEN


; S W C A S E - macro to define the switcher state table

DEFINE	SWCASE	STATE, ROUTE
	BYTE	STATE
	EVEN
	OFFSET	ROUTE
	ENDM

; S W S T A T  is the table of valid SEND FILE states for KERMIT,
; and the offsets to the corresponding next routines.
SWSTAT:	SWCASE	'S,SINIT
	SWCASE	'F,SFILE
	SWCASE	'D,SDATA
	SWCASE	'Z,SEOF
	SWCASE	'B,SBREAK
	SWCASE	'C,COMPLT
	SWCASE	'A,ABORT
	BYTE	0

	EVEN

; R C S T A T  is the table of valid RECEIVE FILE states for KERMIT,
; and the offsets to the corresponding next routines.
RCSTAT:	SWCASE	'R,RINIT			; receive init
	SWCASE	'F,RFILE			; receive file
	SWCASE	'D,RDATA			; receive data
	SWCASE	'C,RCOMP			; receive complete
	SWCASE	'A,RABOR			; receieve abort
	BYTE	0


HLP1:	ASCII	/          ========== Alpha-Kermit help ==========/
	BYTE	15,15,0	

ABTTTL:	ASCII	/KERMIT aborting with the following error from REMOTE host:/
	BYTE	15,0

; tables for GETOPT subroutine

DEFINE	OPT	CHAR,CODE = BYTE	CHAR,CODE


SET1:	ASCII	/ SET allows you to change the following parameters./
	BYTE	15,15,0

NONONO:	ASCII	/%You cannot CONNECT to your own terminal!/
	BYTE	15
	ASCII	/You must specify the communications TRMDEF when KERMIT is invoked:/
	BYTE	15,11
	ASCII	/e.g.  KERMIT MODEM uses the MODEM TRMDEF./
	BYTE	15,0

TITLE:
	ASCII	'(C) 1984 Bob Rubendunst. All rights reserved.'
	BYTE	15	
	ASCII	'Alpha-Kermit was written by Soft Machines.'
	BYTE	15
	ASCII	'Permission is granted to use this software at no charge'
	BYTE	15
	ASCII	'provided that this message is not changed or deleted from'
	BYTE	15
	ASCII	'any copy of this software.'
	BYTE	15,0
TITL2:	BYTE	15
	ASCII	'Alpha-Kermit version '
	BYTE	0

SH1.1:	BYTE	15
	ASCIZ	/Modem Line: /
SH1.2:	ASCIZ	/  Duplex: /
SH1.3:	ASCIZ	/ Parity: /
SH2.1:	BYTE	15
	ASCIZ	/Bell: /
SH2.2:	ASCIZ	/          Debug: /
SH2.3:	ASCIZ	/ Escape: /
SH3.1:	BYTE	15,15
	ASCII	/             Packet Parameters/
	BYTE	15
	ASCIZ	/Maximum Size: /
SH3.2:	ASCIZ	/           Pad character: /
SH4.1:	BYTE	15
	ASCIZ	/Endline: /
NONE:	ASCIZ	/none/	;[012]
SH4.2:	ASCIZ	/               Number of pads: /
SH5.1:	BYTE	15
	ASCIZ	/Retries: /
SH5.2:	ASCIZ	/         Blockcheck selected: /   
SH6.1:	BYTE	15
	ASCIZ	/Timeout: /
SH6.2:	ASCIZ	/ seconds   Blockcheck in use: /
SH7.0:	BYTE	15,15,0
SH.DAS:	ASCIZ	/------/
SH.HAL:	ASCIZ	/HALF /
SH.FUL:	ASCIZ	/FULL /
SH.ON:	ASCIZ	/ON   /
SH.OF:	ASCIZ	/OFF  /

NOSET:	BYTE	15
	ASCII	/%Kermit cannot change the TRMDEF parity, but setting is noted./
	BYTE	15,0

	END END END

.