.IIF NDF VERSON, .ERROR	COMDEF.MAC MODULE NOT PRESENT IN ASSEMBLY
	.IIF NDF VERSON, .END
VBAD=<VERSON-'H>!<SUBVER-'6>
.IIF NE VBAD, .ERROR WRONG COMDEF.MAC VERSION
	.IIF NE VBAD, .END
	.ENABL	LC
	.NLIST	BEX
;
;  Many hands have contributed to this program.  It is a descendant of
;  T. L. Starr's and L. T. Nieh's TSTE (DECUS Library #11-383).  Ideas and
;  inspiration were provided by members of the MNET11 Special Interest Group
;  on the CompuServe Information Service network.  Special thanks to
;  Chuck Sadoian, Sysop of that group, and improver of the breed through
;  another branch of the TSTE tree.
;
;  Problem reports and suggestions are welcome.
;
;	Steve Brecher
;	Software Supply
;	4618 E. 6th Street
;	Long Beach, CA, 90814
;	(213) 434-3723
;
;----------------------------------------------------------------------------
;
; The following values determine legal ranges for the serial device base
; address and interrupt vector address when they are input at runtime.
MINBAS=175610	;smallest allowed base (receiver CSR) address
MAXBAS=177550	;largest allowed base address
MINVEC=120	;smallest allowed receiver interrupt vector address
MAXVEC=370	;largest allowed receive interrupt vector address
;
	.CSECT	CONFIG
CONFIG:
; Align configuration data on block boundary so configuration can be
; easily transferred into new program version .SAV file from a previous
; version .SAV file; the data will occupy blocks 1 and 2 of the .SAV file.
;
; If the following user-patchable value is nonzero on program startup,
; XON/XOFF (Ctrl-Q/Ctrl-S) received from the keyboard will not
; be transmitted to remote, but instead will throttle output to the console;
; and the LF key will transmit XON or XOFF to the remote (the opposite of
; whichever sent last).  If not a buffered console, the value should be 0.
BUFTT:	.WORD	0	;default to non-buffered
;
; The following user-patchable value is the ASCII code to be substituted for
; received characters with parity error. (Software parity checking is runtime
; selectable).
PERRCH:	.WORD	7	;default is BEL
;
; User-patchable CRT escape sequences.  Default to VT-52.
;
CLRSCR:
; What to output to the console when a formfeed is received from remote:
FFESC:	.BYTE	ESC,'H,ESC,'J
	.BYTE	200,200,200,200,200,200,200	;leave some slack
;
CLRLIN:	.BYTE	CR
; clear to end-of-line sequence (used in CO mode only):
EOLESC:	.BYTE	<ESC>,'K
	.BYTE	200,200,200,200,200,200
;
; if RVEC is 0 at startup, program prompts for interface spec 
.RVEC:	.WORD	0	;serial interrupt vector address 
.RCSR:	.WORD	0	;base addr of serial interface
.RBUF:	.WORD	0
.XCSR:	.WORD	0
.XBUF:	.WORD	0
DL11E:	.WORD	0	;DL11E-type (modem control) interface flag 
CRTTYP:	.WORD	1	;0=unsupported, 1=VT52, 2=VT100
BPROT:	.WORD	1	;ID response:  0='A' protocol, nonzero='B' protocol
	.BLKW	36	;reserved for future use
;
SQUTBL:	;table of flags for control characters; 1=barred from PRINT1 processing
;
;		NUL    SOH    STX    ETX    EOT    ENQ    ACK    BEL
	.BYTE	0,     0,     0,     0,     0,     0,     0,     0
;
	;	BS     HT     LF     VT     FF     CR     SO     SI
	.BYTE	0,     0,     0,     0,     0,     0,     0,     0
;
	;	DLE    DC1    DC2    DC3/^S DC4    NAK/^U SYN    ETB
	.BYTE	0,     0,     0,     1,     0,     0,     0,     0
;
	;	CAN    EM     SUB    ESC    FS     GS     RS     US
	.BYTE	0,     0,     0,     0,     0,     0,     0,     0
;
CHUKLF:	.WORD	0	;flag, remote echos CR with LF in half-duplex
MSKPTR:	.WORD	0	;CTLMSK offst, 32-bit mask for cntl chr suppress
LFAFCR:	.WORD	-1	;= CR if send LF after CR, else -1
CMDCHR:	.WORD	16	;command character -- default to ^N
DUPLEX:	.WORD	1	;1 = full, 0 = half
COMODE:	.WORD	0	;flag: COnference mode
ALF:	.WORD	0	;flag: auto lf after cr
ANALYZ:	.WORD	0	;flag: display ctrl chars in octal
TTYPE:	.WORD	0	;throttle type index
PARFLG:	.WORD	0	;-1 = odd, 0 = none 1 = even
PARSAV:	.WORD	0	;save for PARFLG when DTR clear
INDENT:	.WORD	0	;indentation for COnference echo display
WIDTH:	.WORD	80.	;display width (default = 80.)
RATCOD:	.WORD	054000	;default to 300 baud if DL11E
	.GLOBL	RATCOD
DEL2BS:	.WORD	0	;flag, xlate DEL to BS for xmission to remote
PRMTCH:	.WORD	0	;prompt character for throttle option 4
PROTCH:	.WORD	ENQ	;ENQ: allow protocol mode; -1: don't allow
VIDTEX:	.WORD	1	;flag, interpret ESC sequences per Vidtex convention
FUNADR:	.WORD	0,0,0,0,0,0,0,0,0,0	;table of addresses of saved strings,
					; relative to #NXTFUN
FUNLEN:	.WORD	0,0,0,0,0,0,0,0,0,0 ;lengths of saved strings
NXTFUN:	.WORD	FUNCS	;pointer to start of next definition
USED=.-CONFIG
FUNCS:	.BLKB	1777-USED ;allow 1KB for config info (incl function defs)
	.BYTE	0	;get this block's bit set in CCB
ROOM=.-FUNCS-1		;show size of function definition storage on link map
	.GLOBL	ROOM
ENDFUN:
.PAGE
;
; Establish section ordering
;
	.CSECT	MAIN	
	.CSECT	MAINB		;supplied by BCOMM module
	.CSECT	MESAG
EMSG:	.ASCII	<CR><LF><BEL>/COMM-E-/<200>
IMSG:	.ASCII	<CR><LF>/COMM-I-/<200>
PRMT:	.ASCII	<CR><LF>/==>/<200>
	.CSECT	MESAGB		;supplied by BCOMM module
	.CSECT	MAIN
;
TYPMSG:	.PRINT
	.PRINT	@(SP)
	ADD	#2,(SP)
	MOV	@(SP)+,PC
;
TELL:	.PRINT
TELL2:	.PRINT	@(SP)
	ADD	#2,(SP)
	.RETURN
	.PAGE
;====================================================
;
; receiver interrupt service routine
;
RCVINT:	.INTEN	5		;lower priority to 5 and free R4,R5
	TSTB	@.RCSR		;received-data interrupt?
	BMI	DATINT		;br if so
	TST	DL11E
	BEQ	2$
	BIT	#10000,@.RCSR	;carrier detected?
	BEQ	1$		;br if not
	MOV	PARSAV,PARFLG	;start parity checking, if so configured
	MOV	SP,CARIER	;record that we had carrier
	.RETURN
;
1$:	TST	CARIER		;is it carrier changing state?
	BEQ	2$		;br if not
	CLR	PARFLG		;don't check parity on, e.g., Smartmodem msgs
	BIC	#140,@.RCSR	;disable further modem interrupts
	MOV	SP,CUTOFF	;set lost-carrier flag
2$:	.RETURN
;
DATINT:	MOV	@.RBUF,R4	;the char
1$:	MOVB	R4,@ADDR	;store char in ring buffer
	INC	ADDR		;bump addr of next free byte
	INC	BCOUNT		;bump count of unprocessed chars
	DEC	ICOUNT		;number of bytes to end of buffer
	BNE	2$
	MOV	RINGBF,ADDR	;reset pointers
	MOV	#BUFLEN,ICOUNT	;and counter
2$:	BIC	#^C177,R4	;strip parity
	CMP	R4,#XOFF	;XOFF?
	BNE	3$		;no
	BIT	#CSQTHR,STAT	;XOFF/XON throttle in effect?
	BEQ	3$		;no
	BIS	#WAIT,STAT	;yes, set flag for mainline
	BR	6$
3$:	CMP	R4,#LF		;linefeed? (count for COmode)
	BEQ	4$
	CMP	R4,#CR		;generate auto-LF?
	BNE	5$		;no
	TST	ALF
	BEQ	5$		;no
	TST	PROCOL
	BNE	6$		;no
	MOV	PARFLG,R4	;yes...
	BIC	#177,R4
	BIS	#LF,R4		;create LF with expected parity
	BR	1$
4$:	INC	MSGCNT		;increment messages-received count
5$:	.SYNCH	#SYNCBL		;allow .GTIM in interrupt service
	BR	6$		;.SYNCH error??
	.GTIM	#TAREA,#LCHTIM	;get time last character (this one) received
6$:	.RETURN
;
TAREA:	.BLKW	2
SYNCBL:	.WORD	0,0,0,0,0,-1,0	;note job# always 0 (background only)
	.PAGE
;
; console keyboard interrupt service
;
KBDINT:	.INTEN	5
	MOVB	@#TTRBUF,R4		;get char
	BIC	#^C177,R4
	CMPB	R4,#DEL			;del ends playback, if any
	BNE	2$
	MOV	#KBSP,KBSP
2$:	TST	BUFTT			;if buffered console...
	BEQ	3$
	CMP	R4,#XOFF		;...then ^S/^Q have only local effect
	BNE	3$
	MOV	R4,HOLDTT
	BR	6$
3$:	CMP	R4,#XON			;but ^Q always clears hold-flag
	BNE	4$
	CLR	HOLDTT
	TST	BUFTT
	BNE	6$
4$:	MOV	KBDNEW,R5
	MOVB	R4,(R5)+
	CMP	R5,#KBDEOB
	BLO	5$
	MOV	#KBDBUF,R5
5$:	MOV	R5,KBDNEW
	INC	KBDCNT
6$:	.RETURN
	.PAGE
;
QAREA:	.BLKW	12*<NBRBUF+1>		;rt11 i/o queue element(s)
PSTAT:	.WORD	0			;protocol status flags
PROCOL:	.WORD	0			;protocol mode flag
CSCHR:
TIMLIM:	.WORD	0			;current protocol timeout interval
RECNBR:
RRECNO:	.WORD	'0			;receive record#
NEWRNO:	.WORD	0			;temp for rcvd rcd#
RECHST:
XRECNO:	.WORD	'1			;xmit record#
CSMAX:
BLKSIZ:	.WORD	0			;block size of disk file
CSPNT:
DKPTR:	.WORD	0			;disk buffer pointer
CSBLK:
DKBLK:	.WORD	0			;disk block#
MSGLEN:
DKCNT:	.WORD	0			;disk buffer free byte count
PROBUF:	.BLKW	1			;addr of buffer for protocol data blocks
FILNAM:	.BLKW	1			;addr of 2nd word of protocol data buff
ESCSEQ:	.WORD	0			;vector for next char of ESC sequence
RESEND:	.BLKW	1			;address to resend last protocol msg
UPBLK:
GOOD:	.BLKW	1			;flag, last block rcvd was ok
CKSUM:
RETRYS:	.BLKW	1			;protocol retry count
TICKS:	.WORD	0
LSTPRT:	.WORD	0
MSGCNT:	.WORD	0
TABFRM:	.WORD	0
LCHTIM:	.WORD	0,0
CURTIM:	.WORD	0,0
.KBDLN:	.BLKW	1
.KBDDK:	.BLKW	1
KBDDSK:	.BLKW	1
KBDLIN:	.BLKW	1
CURBUF:	.BLKW	1		;pointer to current script file buffer
BUFAVL:	.WORD	NBRBUF		;number of script file buffers available
RCDING:	.WORD	0		;flag: recording in script file
FSPEC:	.BLKW	39.		;buffer for .csispc
DEFEXT:	.WORD	0,0,0,0		;default filename extensions (used by .csispc)
IBLKSZ:	.WORD	0		;block size of receiver file
INPNT:	.WORD	0		;receive buffer pointer
INBLK:	.WORD	0		;receive block count
INCHR:	.WORD	0		;receive character count
;
; Comm input ring buffer status--
;
ADDR:	.WORD	0		;address of next input character
ICOUNT:	.WORD	0		;bytes remaining until input wraps around
ADDR2:	.WORD	0		;address of next unprocessed character
OCOUNT:	.WORD	0		;bytes remaining until ADDR2 must wrap around
BCOUNT:	.WORD	0		;count of ring buffer characters not processed
;
CSAREA:
AREA2:
AREA:	.BLKW	10		;rt11 emt area
STAT:	.WORD	0		;assorted status flags
XOFSNT:	.WORD	0		;sent XOFF due to ring buffer almost full
COLUMN:	.WORD	0		;console column offset from left column
PARTLN:	.WORD	0		;flag, partial comm text line in progress (CO)
KBDCNT:	.WORD	0		;number of chars. in kbd input buffer
KBDOLD:	.WORD	0		;pointer to oldest char in kbd buffer
KBDNEW:	.WORD	0		;pointer to next free byte in kbd buffer
SVTVEC:	.WORD	0		;save area for rt-11 console keyboard vector
HOLDTT:	.WORD	0		;flag, XOFF received from buffered console
LFXON:	.WORD	0		;flag, send XON when LF typed (if false, XOFF)
PREVKB:	.WORD	0		;previous char from keyboard, buffered console
WAITCH:	.WORD	0		;character to wait for in throttle
GOTSI:	.WORD	0		;flag, SI received (and SO not received)
RCVBUF:	.BLKW	1		;addr of 1st script file buffer
DSKBUF:	.BLKW	1		;addr of disk block buffer
KBDBUF:	.BLKB	40		;console keyboard input buffer
KBDEOB:
	.BLKW	20.		;stack of word tuples for string playback
KBSP:	.WORD	.		;string playback stack pointer
LRBUFF:	.BLKB	LRBLEN		;last LRBLEN received characters
FREE:	.BLKW	1		;pointer to 1st unused addr; startup inits
CARIER:	.WORD	0		;flag: carrier present (DL11E)
CUTOFF:	.WORD	0		;flag: lost carrier (DL11E)
RINGBF:	.WORD	0		;start of comm input ring buffer and other buffs
	.PAGE
;
; Program entry point
;
START:	MOV	@#50,R0		;get program top
	TST	(R0)+		;first free addr
	MOV	R0,RINGBF	;start of ring buffer
START2:	MOV	@#42,SP		;restore SP in case this is restart
	.QSET	#QAREA,#<NBRBUF+1> ;allocate add'l RT11 Q elems for asynch i/o
	CLR	STAT		;assorted flags
	CLR	ESCSEQ		;not receiving escape sequence
	CLR	PROCOL		;not in protocol mode
	CLR	MSGCNT		;COmode line count
	CLRB	CHUKLF		;half-duplex discard-LF flag
	MOV	@#TTRVEC,SVTVEC	;save rt-11 keyboard vector
	MOV	#KBDBUF,KBDNEW	;init our keyboard input buffer
	MOV	#KBDBUF,KBDOLD
	CLR	KBDCNT
	MOV	#KBSP,KBSP	;init function playback stack
	MOV	#PRINT.,R5	;R5 always points to print routine
	.SERR			;prevent exit on serious errors
	.TRPSET	#AREA,#.TRAP	;set 4,10 trap vector
	MOV	#200,R0
	TST	BUFTT		;patched for buffered console?
	BEQ	1$		;no
	MOVB	#LF,R0		;yes, patch command table with LF command
	CLR	LFXON		;and first LF key translates to XOFF
1$:	MOVB	R0,LFCMND
	MOV	#'E,R0
	CMP	BPROCL,(PC)+	;B protocol module linked in?
	  .RETURN		;operand of above instruction
	BNE	2$		;yes
	MOV	#DEL,R0		;no -- invalidate EA and EB commands
	CLR	BPROT		;and use A protocol only
2$:	MOVB	R0,EABCMD
	MOV	#KBDINT,@#TTRVEC;take over keyboard
	MOV	RINGBF,R0	;start of ring buffer
	ADD	#BUFLEN,R0	;plus length of ring buffer
	MOV	R0,RCVBUF	;addr of 1st script file receive buffer
	ADD	#<1000+2>*NBRBUF,R0 ;each buffer is followed by ptr to next
	MOV	R0,DSKBUF	;addr of file data buffer
	ADD	#1000,R0
	MOV	R0,KBDDSK	;COnference script file line buffer
	ADD	#132.,R0
	MOV	R0,KBDLIN	;COnference current typing line buffer
	ADD	#132.,R0
	MOV	R0,PROBUF	;addr of protocol data buffer
	ADD	#2,R0
	MOV	R0,FILNAM	;addr of filename sent by FILTRN
	ADD	#1000-2-2,R0	;ptr to highest word used
	MOV	R0,R1
	.SETTOP	R0
	CMP	R0,R1
	.ON	LO,ERR,<Not enough free memory for COMM>,,.ELSE=MEMOK
QUIT:	MOV	SVTVEC,@#TTRVEC
	.EXIT
MEMOK:	TST	(R0)+		;point to first free addr
	MOV	R0,FREE		;save it
	MOV	RCVBUF,R0	;set pointer to next buff after each buff
	MOV	#NBRBUF,R1
1$:	ADD	#1000,R0
	MOV	R0,(R0)
	ADD	#2,(R0)+
	SOB	R1,1$
	MOV	RCVBUF,-(R0)	;except last pointer points back to first buff
	MOV	RINGBF,ADDR	;ring buffer store pointer
	MOV	#BUFLEN,ICOUNT	;count 'til store wraparound
	CLR	BCOUNT		;count of unprocessed characters
	MOV	RINGBF,ADDR2	;fetch pointer
	MOV	#BUFLEN,OCOUNT	;count 'til fetch wraparound
	.CALL	INITCO		;COnference setup in case SAVEd in CO mode
	.CALL	INISER		;initialize the serial interface
	MOV	#LRBUFF,R0	;addr of last-received string buffer
	MOV	#LRBLEN/2,R1
2$:	MOV	#-1,(R0)+	;init last-received buff
	SOB	R1,2$
	.PRINT	#INSTRC		;mini-help msg
	.PRINT	#MSGRDY		;"ready"
;
;====================================================
;
;  main program loop
;
READY:	TST	BUFAVL		;script file need closing?
	BPL	1$
	.CALL	.CLOS
1$:	.CALL	PRINT		;check comm input
	TST	PROCOL		;Protocol mode (if set here, "B" protocol)
	BEQ	2$		;No, continue
	.CALL	BPROCL		;Else go do "B" protocol
2$:	.CALL	TTINRC		;keyboard input ?
	BCC	READY		;br if not
;
	.ENABL	LSB
KEYHIT:	CMPB	R0,CMDCHR	;is it the program command character?
	BNE	1$		;br if not
	.CALL	TTYIN		;get command code
	CMPB	R0,CMDCHR	;if 2nd command char, send it
	BNE	5$
1$:	CMP	R0,#DEL		;DEL?
	BNE	3$		;no
	TST	COMODE		;if COnference mode...
	BNE	2$
	TST	DEL2BS		;or user commanded translation...
	BEQ	3$
2$:	MOV	#BS,R0		;...then translate DEL to BS
3$:	TST	DUPLEX		;half-duplex?
	BNE	4$		;no
	.CALL	ECHO		;yes, local echo
4$:	.CALL	SEND		;send it out
	CMP	R0,LFAFCR	;this is CR and must send LF after?
	BNE	READY		;no
	.CALL	SENDLF		;yes
	BR	READY
5$:	MOV	#CMDTBL,R1
	CMPB	#DEL,R0		;DEL is illegal, used to hide non-available cmds
	BEQ	7$
	.CALL	UPPCAS		;assure code is upper case
6$:	CMPB	R0,(R1)+	;look for command code in table of commands
	BEQ	8$		;br if found
	TSTB	(R1)		;end of table?
7$:	.ON	LE,ERR,<Invalid command code>,READY,.ELSE=6$
8$:	SUB	#CMDTBL+1,R1	;byte offset into table
	ASL	R1		;convert to word offset into jump table
	.CALL	@JTABLE(R1)	;dispatch
	BR	READY
	.DSABL	LSB
;
; trap thru 4 or 10 -- give keyboard back to RT-11 and trap again to abort
;
.TRAP:	MOV	SVTVEC,@#TTRVEC	;restore RT-11 keyboard vector
	BIC	#140,@.RCSR	;disable receiver interrupts
	MOV	(SP),1$		;for debug
	.WORD	007777		;illegal instruction -- RT-11 aborts us
1$:	.BLKW	1
	.PAGE
;
; initialize serial interface
;
	.ENABL	LSB
INISER:	TST	.RVEC
	BNE	1$		;br if addresses defined
	JMP	GETADR		;get addresses, then call INISER
1$:	.PROTEC	#AREA,.RVEC	;grab vector
	.ON	CS,ERR,<RT-11 failed to .PROTECT receiver vector>,QUIT
	MOV	.RVEC,R0	;vector addr
	MOV	#RCVINT,(R0)+	;load DL11 receiver interrupt vector
	MOV	#340,(R0)	;set interrupt priority to 7
	MOV	RATCOD,@.XCSR	;set baud rate in case DL11E
	CLR	CUTOFF		;clear lost-carrier flag
	TST	@.RBUF		;clear any pending receiver interrupt
	MOV	@.RCSR,R0	;clear pending modem interrupt and...
	BIC	#^C10000,R0	;clr all but state of carrier bit (DL11E)
	MOV	R0,CARIER	;save initial state of carrier bit
	BNE	2$		;br if carrier on now
	TST	DL11E
	BEQ	2$		;or if not DL11E		
	CLR	PARFLG		;don't check parity (until carrier interrupt)
2$:	MOV	#142,@.RCSR	;enable data and modem interrupts, set DTR
	.RETURN
	.DSABL	LSB
;
; set full or half duplex
;
	.ENABL	LSB
WAYS:	.CALL	GETDIG		;get digit value (binary)
	.ON	CS,ERR,<Must follow "W" (duplex) command with 0, 1, or 2>,2$
	CMP	R0,#2		;gotta be 0, 1, or 2
	.ON	HI,ERR,,2$
	MOV	#-1,CHUKLF	;chuklf < 0 implies no special lf handling
	TST	R0		;0 implies hdx except host sends lf after cr
	BNE	1$
	INC	R0		;as if user typed 1 (hdx)
	CLR	CHUKLF		;require special lf handling
1$:	DEC	R0		;now 0=half, 1=full duplex
	MOV	R0,DUPLEX
	BNE	2$
INITCO:	MOV	KBDLIN,.KBDLN
	MOVB	#200,@KBDLIN
	MOV	KBDDSK,.KBDDK
	MOV	#TIMOUT,TICKS
2$:	.RETURN
	.DSABL	LSB
;
; define function key
;
	.ENABL	LSB
FUNDEF:	.PROMPT	<Which function key? (digit, or CR to abort): >
	.CALL	GETDIG		;get digit value (binary)
	BCC	DIGIT
NODEF:	.CRLF
	.RETURN
DIGIT:	MOV	R0,R2
	BIS	#'0,R0
	.TTYOUT
	ASL	R2		;word offset
	MOV	FUNLEN(R2),R1	;already defined?
	BEQ	1$
	MOV	FUNADR(R2),R3	;old def addr
	.CALL	DSPDEF		;display existing definition
	.PROMPT <Do you wish to re-define the function?>
	.CALL	YESNO
	BEQ	NODEF
; delete the old definition
	MOV	R3,R4
	ADD	R1,R4		;add len of old def, addr just beyond old def
	MOV	#ENDFUN,R0	;first addr after end of function storage
	SUB	R4,R0		;number of bytes in storage beyond old def
	BEQ	102$		;none
100$:	MOVB	(R4)+,(R3)+	;move any defs beyond, down over deleted one
	SOB	R0,100$
102$:	MOV	#10.,R0		;check 10. addresses...
	MOV	#FUNADR,R3	;...in FUNADR for possible alteration
103$:	CMP	(R3)+,FUNADR(R2) ;def was moved down?
	BLOS	104$		;no
	SUB	R1,-2(R3)	;yes, subtr len of deleted def from its addr
104$:	SOB	R0,103$
	SUB	R1,NXTFUN	;adjust ptr to first unused byte
;
1$: .PROMPT <Enter definition on next line(s). End with DELETE, CTRL-U aborts-->
	.CRLF
	CLR	FUNLEN(R2)
	MOV	NXTFUN,R3	;R3 tracks next byte in new def
	MOV	#100000,R1	;if positive, length of sync string in progress
	MOV	#-1,R4		;previous char entered
	MOV	BUFTT,-(SP)
	CLR	BUFTT		;^S/^Q/LF treated normally during definition
	.DSABL	LSB
; keyboard input loop
	.ENABL	LSB
2$:	CMP	R3,#ENDFUN-1	;allow 1 in case ESC at last byte of buffer
	BLO	24$
	MOV	(SP),BUFTT
	.TELL	INFO,<Function key storage full, definition ended>
	BR	7$
24$:	.CALL	TTYIN
	CMP	R0,#NAK		;ctrl-U
	BNE	3$
	CLR	R3
	BR	8$
3$:	CMP	R0,#ESC
	BNE	4$
	CMP	R0,R4		;2nd consecutive ESC?
	BNE	34$		;no
	.PRINT	#BSECHO		;yes, erase $, just put 1 ESC in def
	MOV	#ESC,R0		;  .PRINT clobbered it
	MOV	#-1,R4		;  trash previous char, any 3rd ESC is new game
	BR	5$		;  treat ESC as normal part of def
34$:	MOV	R0,R4		;save ESC as prev char
	MOV	#'$,R0		;echo $ for ESC which is sync open or close...
	.CALL	DSPCHR		;...unless it's followed by another ESC
	BR	2$		;get next char
4$:	CMP	R0,#DEL		;end of def?
	BNE	41$		;no
	TST	R1		;unclosed sync string in progress?
	BMI	7$		;no
	BR	42$
41$:	CMP	R1,#LRBLEN	;exceeding max sync string length?
	BGE	42$		;yes
	CMP	R4,#ESC		;was previous char ESC?
	BEQ	43$		;yes
	BR	5$		;no
42$:	MOV	R0,-(SP)	
	MOV	#'$,R0		;simulate previous ESC
	.CALL	DSPCHR
	MOV	(SP)+,R0
43$:	TST	R1		;prev ESC was opening or closing sync string?
	BMI	44$		;opening
	MOV	R0,-(SP)	;save typed non-ESC
	MOV	R3,R0		;current definition pointer
	SUB	R1,R0		;addr of 1st char of sync string
	NEG	R1		;neg len of sync string
	MOVB	R1,-(R0)	;neg len byte prefixes sync string in definition
	MOV	(SP)+,R0	;restore char typed after ESC
	CMP	R0,#DEL		;typed DEL while sync string in progress?
	BEQ	7$		;yes
	MOV	#100000,R1	;re-init sync string length to not-valid
	BR	5$
44$:	CLR	R1		;init sync string length counter
	INC	R3		;over byte where sync len will be stored
5$:	MOVB	R0,(R3)+	;store char in definition
	INC	R1		;sync string length counter (if positive)
	MOV	R0,R4		;save as previous char
6$:	.CALL	DSPCHR		;display
	BR	2$		;loop
; put string dope in tables
7$:	MOV	NXTFUN,FUNADR(R2) ;addr of new def into addr table
	SUB	NXTFUN,R3	;R3 = len of new def
	MOV	R3,FUNLEN(R2)	;into len table
	ADD	R3,NXTFUN	;adjust ptr to next unused byte
8$:	MOV	(SP)+,BUFTT
	TST	R3
	.ON	EQ,INFO,<Function is now undefined>,9$
	CMP	R3,#ENDFUN-1
	.ON	LO,INFO,<Function definition complete>
9$:	.RETURN
	.DSABL	LSB
;
; Display char in R0; "^" prefix if ctrl-letter, octal if other control char.
;
DSPCHR:	CMPB	R0,#SPC		;displayable?
	BHIS	2$		;yes
	TSTB	R0		;null?
	BEQ	1$		;yes
	CMPB	R0,#26.		;^Z
	BHI	1$		;not a ctrl-letter
	MOV	R0,-(SP)	;save char
	MOV	#'^!100000,R0	;don't write "^" to disk
	.CALL	PRINT1		;display "^" prefix
	MOV	(SP)+,R0
	BIS	#100,R0		;convert to letter
	BR	2$
1$:	.CALL	TYPOCT
	.RETURN
2$:	BIS	#100000,R0	;don't write char to disk if we're scripting
	JMP	PRINT1
;
; Display function definition whose addr is in R3, length is in R1.
;
DSPDEF:	.CRLF
	MOV	R3,-(SP)	;preserve
	MOV	R1,-(SP)
1$:	MOVB	(R3)+,R0
	BPL	2$		;not a sync string len prefix
	MOV	#'$,R0		;display "$"
	.CALL	DSPCHR
	MOV	R2,-(SP)
	MOVB	-1(R3),R2	;neg length of sync string
	NEG	R2		;pos
	SUB	R2,R1		;adjust overall count remaining
14$:	MOVB	(R3)+,R0	;display sync string
	.CALL	DSPCHR
	SOB	R2,14$
	MOV	(SP)+,R2
	MOV	#'$,R0
2$:	.CALL	DSPCHR
	SOB	R1,1$
	MOV	(SP)+,R1
	MOV	(SP)+,R3
	.RETURN
;
; Prompt " (Y/N): ", get char from kbd; return nonzero in R0 if upper
; or lowercase Y, else return 0.  Z flag reflects R0 on return.
; Echo the char if displayable, but no CRLF.
;
YESNO:	.PRINT	#YN
	.CALL	TTYIN
	.CALL	UPPCAS
	CMP	R0,#SPC
	BLO	1$
	.TTYOUT
1$:	SUB	#'Y,R0
	BEQ	2$
	MOV	#-1,R0
2$:	COM	R0
	.RETURN
;
YN:	.ASCII	" (Y/N): "<200>
	.EVEN
;
;
; play back function key definition -- on entry R1 has 2*function#
;
	.ENABL	LSB
PLAYBK:	MOV	KBSP,R0		;software string dope stack
	CMP	R0,#KBSP-40.
	.ON	LOS,ERR,<Recursive function key -- playback aborted>,,.ELSE=1$
	MOV	#KBSP,R0
	BR	2$
1$:	MOV	FUNLEN(R1),-(R0);len of function definition
	BEQ	3$		;br if no string
	MOV	FUNADR(R1),-(R0);addr of function definition
2$:	MOV	R0,KBSP		;update software stack ptr
3$:	.RETURN
	.DSABL	LSB
;
; Get unsigned decimal or octal number from keyboard, convert to binary in R0.
; Input terminates with carriage return.
; Carriage return only returns 0.  No overflow test.
;
GETOCT:	MOV	#1,R1		;R1 = octal flag
	BR	GETNUM
GETDEC:	CLR	R1
GETNUM:	CLR	-(SP)		;init accumulator
	MOV	SP,GNSP		;save for comparison
1$:	.CALL	GETDIG		;next digit value
	BCS	4$		;br if not digit value
	TST	R1		;getting octal?
	BEQ	2$		;no
	CMP	R0,#7
	BHI	4$
2$:	MOV	(SP),-(SP)	;save accum in case DEL next
	ASL	(SP)		;multiply accumulator by 8
	ASL	(SP)
	ASL	(SP)
	TST	R1		;decimal?
	BNE	3$		;no
	ADD	2(SP),(SP)	;yes, make it by 10.
	ADD	2(SP),(SP)
3$:	ADD	R0,(SP)		;add this digit value
	ADD	#'0,R0		;back to ascii
	BR	6$
4$:	TST	R0
	BEQ	7$		;br if was cr
	CMPB	R0,#DEL		;rubout?
	BNE	5$
	CMP	SP,GNSP
	BHIS	1$
	.PRINT	#BSECHO
	TST	(SP)+		;restore prior accumulator
	BR	1$
5$:	MOV	#BEL,R0
6$:	.TTYOUT
	BR	1$
7$:	.CRLF
	MOV	(SP),R0		;result is latest accumulator
	MOV	GNSP,SP		;discard all intermediate accumulators
	TST	(SP)+		;discard original accumulator
	.RETURN
GNSP:	.BLKW	1
;
; Get keyboard character; if ascii digit, convert to binary in R0 and clear
; carry.  If carriage return, clear R0 and set carry.  If neither ascii digit
; nor carriage return, return character in R0 and set carry.
; No echo in any case.
;
GETDIG:	.CALL	TTYIN
	MOV	R0,-(SP)	;save char
	SUB	#'0,R0		;ascii to binary
	BLT	1$		;if input < '0', go check for cr
	CMP	#9.,R0
	BLT	3$		;if input > '9', go return char with carry set
	MOV	R0,(SP)
	BR	3$
1$:	CMP	#CR-'0,R0	;carriage return?
	BNE	2$		;if not, return char with carry set
	CLR	(SP)
2$:	SEC
3$:	MOV	(SP)+,R0
4$:	.RETURN
;
;===================================================
;
; get serial interface base and vector addresses, whether DL11E-type.
;
	.ENABL	LSB
GETADR:	.PROMPT	<Enter serial interface base address (RETURN >
	MOV	#TOABT,R0
	TST	.RCSR			;first startup?
	BEQ	1$
	MOV	#NOCHG,R0		;no, if CR only, just abort command
1$:	.PRINT
2$:	.CALL	GETOCT
	TST	R0			;CR only?
	BNE	3$			;no
	TST	.RCSR			;first startup?
	BNE	25$			;no, just exit routine
	JMP	QUIT			;yes, go exit program
25$:	.RETURN
3$:	CMP	R0,#170000
	.ON	LO,ERR,<Base address must be in form 17nnn0>,GETADR
	BIT	#7,R0
	.ON	NE,ERR,,GETADR
	CMP	R0,#MINBAS
	.ON	LO,ERR,<Base address not in legal range>,GETADR
	CMP	R0,#MAXBAS
	.ON	HI,ERR,,GETADR
	MOV	R0,R1
	.DSABL	LSB
	.ENABL	LSB
	.TRPSET	#AREA,#10$
	TST	(R1)			;is the device really there?
	.ON	CS,ERR,<No device present at that address>,GETADR
	MOV	#.RCSR,R3		;addr of table of register addresses
	TST	(R3)			;was address previously defined?
	BEQ	4$			;no
	.MTPS	#200
	BIC	#140,@0(R2)		;yes, disable previous device's interrpt
	.MTPS	#0
	.UNPROT	#AREA,.RVEC		;release vector to RT-11
4$:	MOV	#4,R2
5$:	MOV	R1,(R3)+		;set table of 4 register addresses
	ADD	#2,R1
	DEC	R2
	BNE	5$
	.TRPSET	#AREA,#.TRAP		;restore regular trap handler
6$:	.PROMPT	<Enter receiver interrupt vector address: >
	.CALL	GETOCT
	CMP	R0,#MINVEC
	.ON	LO,ERR,<Vector address is not in legal range>,6$
	CMP	R0,#MAXVEC
	.ON	HI,ERR,,6$
	MOV	R0,.RVEC
7$:	.PROMPT	<DL11-E (modem control) type inteface?>	
	.CALL	YESNO
	MOV	R0,DL11E
	.CRLF
	.CALL	INISER			;init interface
9$:	.RETURN
;
; Trap handler for non-existent device
;
10$:	BIS	#1,2(SP)		;set mainline's carry
	RTI
	.DSABL	LSB
NOCHG:	.ASCII	"for no change): "<200>
TOABT:	.ASCII	"to abort program): "<200>
	.EVEN
;
;===================================================
;
; parity checking select
;
	.ENABL	LSB
PARITY:	.CALL	TTYIN		;get parity code
	.CALL	UPPCAS		;assure upper case
	CLR	R1		;assume no parity
	CMP	R0,#'N
	BEQ	1$
	INC	R1		;assume even
	CMP	R0,#'E
	BEQ	1$
	NEG	R1		;assume odd
	CMP	R0,#'O
	.ON	NE,ERR,<Valid parity commands are PE, PO, or PN>,3$
1$:	MOV	R1,PARSAV
	TST	DL11E
	BEQ	2$
	BIT	#10000,@.RCSR	;carrier detected?
	BEQ	3$		;no
2$:	MOV	R1,PARFLG	;yes, start checking (if nonzero) immediately
3$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; set display width
;
	.ENABL	LSB
SETWID:	.PROMPT	<Enter column width of console (CR only for no wraparound): >
	.CALL	GETDEC		;get value
	TST	R0
	BNE	1$
	DEC	R0		;no right margin
1$:	MOV	R0,WIDTH
	.RETURN
	.DSABL	LSB
;
;====================================================
;
; set/clear COnference mode
;
	.ENABL	LSB
FLIPCO:	.PROMPT	<COnference mode during half-duplex?>
	.CALL	YESNO
	MOV	R0,COMODE
	BNE	1$
	.CRLF
	BR	2$
1$:	.PROMPT	<Enter indentation for your typing line (CR for none): >
	.CALL	GETDEC		;get value
	MOV	R0,INDENT
	TST	DUPLEX
	.ON	NE,INFO,<COnference mode awaits W0 or W1 command>,2$
	.CALL	INITCO
	.CALL	SPACES
	CLR	PARTLN
2$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; set baud rate
;
	.ENABL	LSB
SETRAT:	.PRINT	#RATMSG		;multi-line prompt
	.CALL	TTYIN		;get letter
	.CALL	UPPCAS		;assure upper case
	.TTYOUT			;echo
	SUB	#'A,R0		;adjust to 0..17 (octal)
	.ON	MI,ERR,<Response was not a letter from menu>,1$
	CMP	R0,#17
	.ON	HI,ERR,,1$
	ASL	R0
	INC	R0		;set baud-select enable bit
	SWAB	R0		;left-justify the 5-bit field...
	ASL	R0
	ASL	R0
	ASL	R0
	MOV	R0,RATCOD	;save in case pgm image saved
	MOV	R0,@.XCSR	;change the rate
	.CRLF
1$:	.RETURN
	.DSABL	LSB
;====================================================
;
; chgalf -- select/deselect auto-LF after received CR
;
	.ENABL	LSB
CHGALF:	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Must follow "A" (Auto-LF) command with 0 or 1>,1$
	CMP	R0,#1
	.ON	HI,ERR,,1$
	MOV	R0,ALF
1$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; select/deselect octal display of control characters
;
	.ENABL	LSB
CHGLYZ:	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Must follow "Z" command with 0 or 1>,1$
	CMP	R0,#1
	.ON	HI,ERR,,1$
	MOV	R0,ANALYZ
1$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; select A or B file transfer protocol
;
	.ENABL	LSB
ENBLAB:	.CALL	TTYIN		;get A or B
	.CALL	UPPCAS		;assure upper case
	CLR	R1		;assume A
	CMP	R0,#'A
	BEQ	1$
	INC	R1		;assume B
	CMP	R0,#'B
	.ON	NE,ERR,<Must follow "E" command with A or B>,2$
1$:	MOV	R1,BPROT
2$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; select/deselect Vidtex interpretation of ESCape sequences
;
	.ENABL	LSB
VIDESC:	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Must follow "V" command with 0 or 1>,1$
	CMP	R0,#1
	.ON	HI,ERR,,1$
	MOV	#-1,PROTCH		;assume deselect
	MOV	R0,VIDTEX
	BEQ	1$
	CLRB	SQUTBL+ESC		;select implies unsquelch ESC
	CLRB	SQUTBL+SI		;and SI
	CLRB	SQUTBL+SO		;and SO
	MOV	#ENQ,PROTCH		;and ENQ starts file xfer protocol
1$:	.RETURN
	.DSABL	LSB
;
;====================================================
;
; select/deselect automatic send of LF after CR
;
	.ENABL	LSB
LCOMMD:	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Must follow "L" command with 0 or 1>,2$
	CMP	R0,#1
	.ON	HI,ERR,,1$
	MOV	#-1,R1		;assume option 0 -- don't send LF after CR
	TST	R0		;right?
	BEQ	1$		;yes
	MOV	#CR,R1		;no, send LF after CR
1$:	MOV	R1,LFAFCR
2$:	.RETURN
	.DSABL	LSB
;
;===================================================
;
; help -- display valid command codes
;
HELP:	.PRINT	#HELP1
	CMP	BPROCL,3$	;B protocol module linked in?
	BEQ	1$	
	.PRINT	#HELP2		;yes, show EA and EB commands
1$:	.PRINT	#HELP3
	TST	BUFTT
	BEQ	2$
	.PRINT	#LFHELP
2$:	.PRINT	#SHOWCC
3$:	.RETURN
;
;===================================================
;
; set/reset DEL-->BS translation flag
;
	.ENABL	LSB
FLIPBS:	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Must follow "S" (DEL translate) command with 0 or 1>,1$
	CMP	R0,#1
	.ON	HI,ERR,,1$
	MOV	R0,DEL2BS
1$:	.RETURN
	.DSABL	LSB
;
;===================================================
;
; set/reset squelch of typeout of a received control character
;
	.ENABL	LSB
CHGCC:	.CALL	GETDIG
	.ON	CS,ERR,<Must follow "Q" command with 0 or 1>,3$
	MOV	R0,R1			;save
	ROR	R0
	.ON	NE,ERR,,3$
1$:	.PROMPT	<Type the control character to be >
	MOV	#SQUEL,R0
	TST	R1
	BNE	2$
	MOV	#UNSQU,R0
2$:	.PRINT
	.CALL	TTYIN
	CMP	R0,#SPC
	.ON	HIS,ERR,<That was not a control character, command aborted>,3$
	MOVB	R1,SQUTBL(R0)
	.CRLF
3$:	.RETURN
SQUEL:	.ASCII	"squelched: "<200>
UNSQU:	.ASCII	"unsquelched: "<200>
	.EVEN
	.DSABL	LSB
;
;===================================================
;
; change command character
;
	.ENABL	LSB
CHGCMD:	.PROMPT	<Enter new command prefix: >
	.CALL	TTYIN		;get new command character
	.ON	EQ,ERR,<Valid range is any CTRL character except CTRL-M>,1$
	CMP	R0,#26.		;ctrl-z
	.ON	HI,ERR,,1$
	CMP	R0,#CR		;CR = Ctrl-M
	.ON	EQ,ERR,,1$
	MOVB	R0,CMDCHR	;save it
	ADD	#'A-1,R0	;convert to letter
	MOVB	R0,CCLETR	;put into info message
1$:	.CRLF
	.RETURN
	.DSABL	LSB
	.PAGE
;====================================================
;
; prompt user for the type of filter to use when sending files to remote
;
	.ENABL	LSB
SUPRES:	.PRINT	#SUPMSG		;instructions
1$:	.PROMPT	<Enter filter option (0..7): >
	.CALL	GETDIG		;get option
	.ON	CS,ERR,<Response was not a menu selection digit>,1$
	CMP	R0,#SOPMAX	;check range
	.ON	HI,ERR,,1$
	ADD	#'0,R0		;back to ascii
	.TTYOUT			;echo it
	BIC	#^C17,R0	;back to binary
	ASL	R0		;4 bytes per mask table entry
	ASL	R0
	MOV	R0,MSKPTR	;save offset of 32-bit mask
	.CRLF
	.RETURN
	.DSABL	LSB
;
;====================================================
;
; prompt user for the type of "throttle" to use when sending files to remote
;
	.ENABL	LSB
THROTL:	.PRINT	#THRMSG		;instructions
1$:	.PROMPT	<Enter file transmission throttle option (0..5): >
	.CALL	GETDIG		;get option
	.ON	CS,ERR,,1$
	CMP	R0,#THRMAX	;check range
	.ON	HI,ERR,,1$
	ADD	#'0,R0		;back to ascii
	.TTYOUT			;echo it
	BIC	#^C17,R0	;back to binary
	ASL	R0		;convert to word offset
	MOV	R0,TTYPE	;save it
	CMP	R0,#4*2		;wait for prompt option?
	BNE	4$		;br if not
	.PROMPT	<Type the remote's prompt character: >
	.CALL	TTYIN		;get the char
	MOVB	R0,PRMTCH	;save it
	CMPB	R0,#' ;		;graphic char?
	BLOS	4$		;br if not
	.TTYOUT			;else echo it
4$:	.CRLF
	.RETURN
	.DSABL	LSB
	.PAGE
;
;====================================================
;
;
; Read a line of keyboard input into @FILNAM.  Terminating CR is stored.
; DEL and ^U have their expected effects.  Alphas translated to uppercase.
;
READLN:	MOV	FILNAM,R2
1$:	.CALL	TTYIN
	CMP	R0,#DEL
	BNE	2$
	CMP	R2,FILNAM
	BLOS	1$
	.PRINT	#BSECHO
	DEC	R2
	BR	1$
2$:	CMP	R0,#NAK		;^U
	BNE	4$
3$:	CMP	R2,FILNAM
	BLOS	1$
	.PRINT	#BSECHO
	DEC	R2
	BR	3$
4$:	.CALL	UPPCAS
	MOVB	R0,(R2)+
	.TTYOUT
	CMP	R0,#CR
	BNE	1$
	.CRLF
	.RETURN
;
;====================================================
;
;transmit local data file to remote computer
;
	.ENABL	LSB
TRANS:	MOV	R50DAT,DEFEXT+2	;use "dat" as default transmit filetype
PRMTTF:	.PROMPT	<Enter name of file to transmit (to abort, CR only): >
	.CALL	READLN
	CMPB	@FILNAM,#CR
	BNE	TPARSE
	.RETURN
TPARSE:	.CALL	PARSE		;CSISPC and fetch
	BCS	PRMTTF		;try again in case of error
	.PURGE	#TRANCH
	.LOOKUP	#AREA,#TRANCH,#FSPEC ;open transmit data file
	.ON	CS,ERR,<File open error>,PRMTTF
	CLR	TICKS		;No timeout on partial lines if COnference mode
	CLR	R2		;block no
	CLR	STAT		;init flags
	.DSABL	LSB
	.ENABL	LSB
1$:	MOV	DSKBUF,R4
	.READW	#AREA,#TRANCH,R4,#256.,R2 ;read a block
	BCS	5$		;br if read error or eof
2$:	MOVB	(R4)+,R0	;get char
	BIC	#^C<177>,R0	;mask ascii
	.CALL	SUPCHK		;do we suppress (filter) this character?
	BCS	3$		;yes, don't send it
	.CALL	TCHECK		;wait until "throttle" says it's ok to send
	.ON	CS,INFO,<File transmission aborted>,7$
	TST	DUPLEX		;half-duplex?
	BNE	SENDIT		;no
	.CALL	ECHO		;yes, local echo
SENDIT:	.CALL	SEND		;send character
3$:	.CALL	TTINRC		;see if a command was typed
	BCC	4$		;no, skip
	CMPB	R0,#CTRLC	;was it a ctrl-c?
	.ON	EQ,INFO,,7$
4$:	CMP	R4,KBDDSK	;loop until block done
	BLO	2$
	INC	R2		;next block
	BR	1$		;again
5$:	TSTB	@#ERRBYT	;eof ?
	.ON	NE,ERR,<File read error, file transmission aborted>,7$
	.CALL	TCHECK		;wait until we could send more before typing...
	TST	COLUMN
	BEQ	6$
	.CRLF
6$:	.TELL	,<COMM-I-File transmission complete>
7$:	.CLOSE	#TRANCH
	CLR	STAT		;clean up status word
	MOV	#TIMOUT,TICKS	;restore CO mode timeout value
	.RETURN
	.DSABL	LSB
;
;====================================================
; set carry if char in R0 is to be suppressed from file transmission;
; clear carry if ok to transmit it.
; (destroys R1 and R3)
;
SUPCHK:
	MOV	R0,-(SP)	;save R0 (the character)
	BIC	#^C177,R0	;mask ascii
	INCB	R0		;ascii+1
	BPL	1$		;br if char wasn't ascii del
	MOV	#US+1,R0	;change del to ascii us
1$:	CMPB	R0,#US+1	;is this a control character?
	BHI	5$		;no, don't filter it (carry clear on br)
	CLR	R1		;high order of mask
	MOV	#1,R3		;low order of mask
	BR	3$
2$:	ASL	R3		;shift bit left in double word
	ROL	R1
3$:	SOB	R0,2$
	MOV	MSKPTR,R0	;get offset into CTLMSK of 32-bit mask
	ADD	#CTLMSK,R0	;addr
	BIT	R3,(R0)+
	BNE	4$
	BIT	R1,(R0)
	BEQ	5$
4$:	SEC
5$:	MOV	(SP)+,R0
	.RETURN
	.PAGE
;====================================================
;
;  check if it is ok to send a character to the remote now
;
TCHECK:
	MOV	R0,-(SP)	;save character to transmit
1$:	.CALL	PRINT		;check for received data
	BIT	#WAIT,STAT	;ok to send a character?
	BEQ	4$		;yes, process character
	.CALL	TTINRC		;no, see if a command was typed
	BCC	1$		;no
	CMP	R0,#SPC		;yes, was it a space?
	BEQ	4$		;yes, end wait
2$:	CMP	R0,#CTRLC	;was it a <del>?
	BNE	1$		;no
	MOV	(SP)+,R0	;restore transmit character
	BR	5$		;and return with abort flag
4$:	MOV	TTYPE,R1	;get routine index...
	MOV	(SP)+,R0	;restore transmit character
	.CALL	@TTABLE(R1)	;...and call to appropriate routine
	.CALL	PRINT		;poll input buffer again
	TST	(PC)+		;clear carry and skip
5$:	SEC
	.RETURN
;
;
TTABLE:	NOTHRT			;0 no throttle
	WAIT1C			;1 wait each character echo
	W4CR			;2 wait for carriage-return echo after send cr
	W4LF			;3 wait for line-feed echo after send cr
	W4PRMT			;4 wait for user-specified prompt char after cr
	WCSCQ			;5 control-s/control-q (xoff/xon)
THRMAX=<.-TTABLE>/2 - 1
	.PAGE
;====================================================
;
; following are the various throttle routines
;
; no throttle
;
NOTHRT:	CLR	STAT		;status bits
	CLRB	WAITCH		;clear wait-for character
	.RETURN			;and return
;
;====================================================
;
; wait for one character to be echoed.
;
WAIT1C:
	CLR	STAT		;status bits
	MOVB	R0,WAITCH	;set the character we will wait for
	CMPB	R0,#HT		;is the character a tab?
	BNE	1$		;no, skip
	CLRB	WAITCH		;yes, now we will accept any echo
	BIS	#MATCHA,STAT	;match anything
1$:	BIS	#WAIT,STAT	;set "no-send" flag
	.RETURN			;and return
;
;====================================================
;
; control-s/control-q (xon/xoff)
;
WCSCQ:	MOV	#CSQTHR,STAT
	.RETURN			;return
	.PAGE
;====================================================
;
; send until we send a carriage return, then wait for the echoed
; carriage return (for w4cr) or line feed (for w4lf) or prompt char (w4prmt)
;
W4CR:
	MOVB	#CR,R3		;carriage return as a potential wait char
	BR	W4
W4LF:
	MOVB	#LF,R3		;line feed as a potential wait character
	BR	W4
W4PRMT:
	MOVB	PRMTCH,R3
W4:	CLR	STAT		;status bits
	CMP	R0,#CR		;are we about to send a carriage return?
	BNE	1$		;no, skip
	MOVB	R3,WAITCH	;yes, we'll wait for the appropriate echo
	MOV	#WAIT,STAT	;until the "WAIT" bit is cleared
1$:	.RETURN			;and return
	.PAGE
;====================================================
;
; record in script file
;
	.ENABL	LSB
RECORD:	TST	RCDING		;already active ?
	.ON	NE,ERR,<Recording file already open>,8$
	.PURGE	#SCRPCH
	MOV	R50RCV,DEFEXT+2	;use "rcv" as default receive filetype
2$:	.PROMPT	<Enter name of recording file (to abort, CR only): >
	.CALL	READLN
	CMPB	@FILNAM,#CR
	BEQ	8$
	.CALL	PARSE
	BCS	2$
	TST	FSPEC+2		;filename supplied?
	BNE	4$
	MOV	R50COM,FSPEC+2	;if not, supply one, don't clobber a disk
	MOV	R50TMP,FSPEC+4	;"COMTMP.RCV"
4$:	.LOOKUP	#AREA,#SCRPCH,#FSPEC ;file exists?
	BCS	6$		;no, create it
	.DSTATUS #AREA,#FSPEC	;get device info
	MOV	#-1,R0		;"block size" in case printer
	BIT	#30000,AREA	;non-directory structured, write-only (printer)?
	BNE	7$		;br if so
5$:	.PURGE	#SCRPCH		;clear channel
	.PROMPT	<File exists -- replace it?>
	.CALL	YESNO
	.ON	EQ,INFO,<File not opened>,8$
	.CRLF
6$:	.ENTER	#AREA,#SCRPCH,#FSPEC,#-1 ;open receiver file
	.ON	CS,ERR,<File open error -- not recording>,8$
7$:	MOV	R0,IBLKSZ	;save block size of file
	MOV	RCVBUF,INPNT	;buffer pointer
	MOV	RCVBUF,CURBUF
	CLR	INBLK		;block count
	MOV	#512.,INCHR	;character count
	MOV	SP,RCDING	;set flag
8$:	.RETURN
	.DSABL	LSB
	.PAGE
;====================================================
;
; logical close of script file
;
	.ENABL	LSB
CLOSE:	TST	RCDING		;active ?
	.ON	EQ,INFO,<No recording file was open>,3$
	MOV	CURBUF,R1	;start of working buffer
	SUB	INPNT,R1	;negative of #chars in buffer
	BNE	FLUSH		;br if must flush partial buffer
	.MTPS	#340		;lock out completion routine
	TST	RCDING		;still active?
	BEQ	2$		;br if not
	CLR	RCDING
	CMP	BUFAVL,#NBRBUF	;I/O outstanding?
	BLO	2$		;br if so
	MOV	#-1,BUFAVL	;else set must-close indication
2$:	.MTPS	#0
3$:	.RETURN
	.DSABL	LSB
;
FLUSH:	ADD	#1000,R1	;number of nulls to pad
	CLR	R0		;null
1$:	.CALL	CHR2DK		;put a null
	SOB	R1,1$
	CLR	RCDING		;shut off recording
	.RETURN
	.PAGE
;====================================================
;
; break: send a "break" to remote system
; delay: delay approx 233 ms.
;
BREAK:	CLRB	@.XBUF		;clear xmit buff first
	BIS	#1,@.XCSR	;start continuous space
DELAY:	CLR	-(SP)		;watchdog in case clock not on
	SUB	#4,SP		;temps for starting time
	.GTIM	#AREA,SP	;get start time
1$:	DEC	4(SP)		;watchdog
	BEQ	3$		;clock not running or VERY fast CPU
	MOV	#CURTIM,R1
	.GTIM	#AREA,R1	;get current time, double precision ticks
	SUB	2(SP),2(R1)	;convert current to interval since start
	SBC	(R1)
	SUB	(SP),(R1)
	TST	(R1)+		;hi order of time elapsed since started
	BEQ	2$
	ADD	#15000,(R1)	;hi order <>0, correct for midnight rollover
2$:	CMP	(R1),#TIMOUT	;timeout since started?
	BLO	1$		;no
3$:	BIC	#1,@.XCSR	;turn off continuous space
	ADD	#6,SP		;discard temps
	.RETURN
.PAGE
;
; send a LF
;
SENDLF:	MOV	#LF,R0		;fall thru to SEND
;====================================================
;
; transmit a character to the remote system
;
SEND:	TST	CUTOFF		;lost carrier?
	BEQ	1$		;no
	JMP	EXITNC
1$:	TSTB	@.XCSR		;wait for xmit ready
	BPL	SEND
	MOVB	R0,@.XBUF	;send char
	.RETURN
.PAGE
;
; half duplex echo routine
;
ECHO:	TST	COMODE		;COnference mode?
	BNE	ECHOCO		;yes
	BIS	#ELOCAL,STAT	;no, flag tells PRINT1 this is local echo
	JMP	PRINT1		;"vanilla" display
ECHOCO:	MOV	R0,-(SP)	;preserve original char
	CMP	R0,#SPC		;graphic char?
	BHIS	50$		;br if so
	CMP	R0,#CTRLU	;ctrl-u?
	BNE	3$		;br if not
1$:	CMP	.KBDLN,KBDLIN	;backspace to beginning of input
	BLOS	2$
	MOV	#BS,R0
	.TTYOUT
	DEC	.KBDLN
	BR	1$
2$:	MOV	COLUMN,-(SP)	;in case clrlin sequence contains graphic chars
	.PRINT	#CLRLIN+1	;clear to end of line
	MOV	(SP)+,COLUMN
	MOV	KBDDSK,.KBDDK	;init line in case saving to disk
	BR	ECHO95
3$:	CMP	R0,#CR		;cr?
	BNE	4$		;br if not
	MOVB	R0,CHUKLF	;set chuck-lf flag
	.CRLF
	.CALL	SPACES
	MOVB	#200,@.KBDDK	;terminate disk copy of line
	.CALL	KBD2DK		;write to disk if saving
	MOV	KBDLIN,.KBDLN	;init line buffer
	BR	ECHO95
4$:	CMP	R0,#BS		;bs?
	BEQ	45$		;br if so
	CMP	R0,#DEL		;del?  (echos same as BS)
	BNE	7$		;br if not
45$:	CMP	.KBDLN,KBDLIN	;line empty?
	BLOS	ECHO99		;br if so
	DEC	.KBDDK		;delete char from disk line
	MOV	#1,R3		;number of chars to back up
	CMPB	@.KBDDK,#HT	;deleting tab?
	BNE	5$		;br if not
	MOV	COLUMN,R3	;else adj delete count
	SUB	TABFRM,R3	;to go back to where tab was entered
5$:	TST	WIDTH		;is there a right margin?
	BMI	6$		;no
	CMP	COLUMN,WIDTH	;end of line?
	BLO	6$		;br if not
	MOV	#SPC,R0		;else just display space to delete
	.TTYOUT
	BR	65$
6$:	.PRINT	#BSECHO		;display bs-spc-bs
65$:	DEC	.KBDLN		;adjust pointer into line buffer
	SOB	R3,5$		;loop
	BR	ECHO95
7$:	CMP	R0,#HT		;tab?
	BNE	ECHO99		;br if not
	MOVB	R0,@.KBDDK	;put it in disk buffer
	INC	.KBDDK
	MOV	COLUMN,TABFRM	;save position of tab
	MOV	#SPC+100000,R0	;sign bit = don't put in kbddsk buffer
8$:	MOV	#9$,-(SP)
	MOV	R0,-(SP)
	BR	50$		;"call" our tail
9$:	BIT	#7,COLUMN
	BNE	8$		;loop until tab stop
	BR	ECHO99
50$:	TST	WIDTH		;right margin set?
	BMI	ECHO70		;no
	CMP	COLUMN,WIDTH	;end of line?
	BLO	ECHO70		;br if not
	CLR	TABFRM		;clear position of last tab
	.CRLF
	.CALL	SPACES
	MOV	(SP),R0		;restore char
	.CALL	ECHOCO		;recursive call to echo the char
	BR	ECHO99
ECHO70:	.TTYOUT			;echo the char
	MOVB	R0,@.KBDLN	;save char in buffer
	INC	.KBDLN
	TST	R0		;sign bit set?
	BMI	ECHO95		;br if so
	MOVB	R0,@.KBDDK	;else save char in disk line buffer
	INC	.KBDDK
ECHO95:	MOVB	#200,@.KBDLN	;terminator to buffer
ECHO99:	MOV	(SP)+,R0	;restore
	.RETURN
;
; if saving to  disk, xfer disk line buffer to disk output buffer
;
KBD2DK:	TST	RCDING		;saving script file?
	BEQ	3$		;br to exit if not
	MOV	KBDDSK,R3	;start of disk line buffer
1$:	TSTB	(R3)		;end of disk line?
	BMI	2$		;br if so
	MOVB	(R3)+,R0	;pick up char
	.CALL	CHR2DK		;disk output routine
	BR	1$
2$:	MOV	#LF*400+CR,R0	;cr,lf to disk output routine
	.CALL	CHR2DK
	SWAB	R0
	.CALL	CHR2DK
3$:	MOV	KBDDSK,.KBDDK	;re-init disk line buffer pointer
	.RETURN
	.PAGE
;====================================================
;
; check ring buffer status, send XOFF or XON to remote if necessary
;
BUFCHK:	TST	XOFSNT		;sent XOFF?
	BNE	10$		;yes
	CMP	BCOUNT,#BUFLEN-100 ;buffer almost full?
	BLO	30$		;no, ok
	MOV	R0,-(SP)
	MOV	#XOFF,R0
	MOV	R0,XOFSNT
	BR	20$
10$:	CMP	BCOUNT,#BUFLEN/2 ;ready for more data?
	BHI	30$		;no
	MOV	R0,-(SP)
	MOV	#XON,R0
	CLR	XOFSNT
20$:	.CALL	SEND
	MOV	(SP)+,R0
30$:	.RETURN
;
; display comm input char
;
PRINT:	TST	ESCSEQ		;escape sequence?
	BEQ	1$		;no
	JMP	@ESCSEQ
1$:	TST	COMODE		;dispatch to regular or COnference display
	BEQ	PRTREG
	TST	DUPLEX
	BNE	PRTREG
	JMP	PRTCO
;
; regular display of received char
;
PRTREG:	MOV	R0,-(SP)
1$:	.CALL	COMMIN
	BCS	2$
	.CALL	PRINT1
	BR	1$
2$:	MOV	(SP)+,R0
	.RETURN
;
; display octal value of byte in R0 inside angle brackets with leading 0's
; suppressed; preserve R0
;
MSB=100000
TYPOCT:	MOV	R0,-(SP)
	MOV	#'<!MSB,R0	;MSB to prevent write to disk
	.CALL	PRINT1
	MOV	(SP),-(SP)
	BIC	#^C7,(SP)
	BIS	#MSB,(SP)	;here MSB is flag saying print this digit
	MOV	2(SP),R0
	ASR	R0
	ASR	R0
	ASR	R0
	MOV	R0,-(SP)
	BIC	#^C7,(SP)
	ASR	R0
	ASR	R0
	ASR	R0
	BEQ	1$
	BIS	#MSB,(SP)	;ditto, not a leading 0
	.CALL	3$
1$:	MOV	(SP)+,R0
	BEQ	2$
	.CALL	3$
2$:	MOV	(SP)+,R0
	.CALL	3$
	MOV	#'>!MSB,R0
	.CALL	PRINT1
	MOV	(SP)+,R0
	.RETURN
;
3$:	BIS	#'0!MSB,R0
	;fall thru to PRINT1
.PAGE
;
;display character in R0; bit 15 set means don't write it to disk if scripting
;
PRINT1:	MOV	R0,-(SP)	;preserve original char
	CMPB	R0,#SPC		;control character?
	BHIS	3$		;br if not
	TST	ANALYZ		;display control chars in octal?
	BEQ	1$		;no
	.CALL	TYPOCT
	JMP	TSTDSK
1$:	TSTB	SQUTBL(R0)	;character squelched?
	BNE	2$		;yes
	MOV	R0,-(SP)
	ASL	(SP)		;make control char into word offset
	ADD	#PRTVEC,(SP)	;address in PRTVEC table
	MOV	@(SP)+,PC	;jmp to routine for this control char
2$:	TST	(SP)+
	.RETURN
3$:	BR	TSTEOL
PRTESC:	TST	VIDTEX		;Vidtex convention for ESC sequences?
	BEQ	TOOPUT		;no
	MOV	#DOESC,ESCSEQ	;set vector
	JMP	ENDPRT
PRTSI:	TST	VIDTEX
	BEQ	TOOPUT
	MOV	PARFLG,PARSAV
	CLR	PARFLG
	MOV	SP,GOTSI
	BR	ENDPRT
PRTSO:	CLR	GOTSI
	TST	VIDTEX
TOOPUT:	BEQ	OUTPUT
	MOV	PARSAV,PARFLG
	BR	ENDPRT
PRTFF:	.PRINT	#CLRSCR
	CLR	COLUMN
	MOV	(SP),R0
	BR	TSTDSK
PRTBS:	TST	COLUMN
	BEQ	TSTDSK		;no effect if at left margin
	TST	DUPLEX		;half duplex?
	BNE	OUTPUT		;no
	CMPB	LSTPRT,#HT	;yes, erasing tab?
	BNE	30$		;no
	MOV	COLUMN,-(SP)
	SUB	TABFRM,(SP)	;count of backups to erase tab
10$:	DEC	(SP)
	BMI	20$
	.TTYOUT			;back up one
	BR	10$
20$:	TST	(SP)+		;discard temp
	BR	TSTDSK
30$:	.PRINT	#BSECHO		;wasn't a tab, erase prior char
	MOV	#BS,R0		
	BR	TSTDSK
PRTHT:	MOV	COLUMN,TABFRM	;save pre-tab position in case deleted later
	MOV	#SPC+100000,R0	;sign bit means don't write to disk
10$:	MOV	#20$,-(SP)
	MOV	R0,-(SP)	;give it something to restore
	BR	TSTEOL		;call our tail to output a space for tab expand
20$:	BIT	#7,COLUMN	;until tab stop reached
	BNE	10$
	MOV	(SP),R0		;restore tab
	BR	TSTDSK
PRTCR:	TST	COMODE		;COnference mode?
	BNE	10$		;yes
	TST	DUPLEX		;full duplex?
	BNE	OUTPUT		;yes, just output the CR
	TSTB	CHUKLF+1	;HDX: remote sends LF after CR (Tymnet)?
	BEQ	OUTPUT		;yes, just output the CR
	BIT	#ELOCAL,STAT	;no, is this a local keyboard echo?
	BEQ	OUTPUT		;no, text from remote or ASCII file xfer display
	BIC	#ELOCAL,STAT	;yes, clear flag and...
	.TTYOUT			;output the CR...
	.CALL	CHR2DK
	MOV	#LF,R0		;...and then a LF
	BR	OUTPUT
10$:	TST	COLUMN		;COnference mode:  if at left margin...
	BEQ	OUTPUT		;leave CHUKLF flag alone
	CLRB	CHUKLF		;else clear flag, display next linefeed
	BR	OUTPUT		
PRTLF:	TST	CHUKLF		;special linefeed handling & chuck this one?
	BLE	10$		;no
	CLRB	CHUKLF		;chuck this one and clear chuck flag in lo byte
	BR	ENDPRT
10$:	TST	COLUMN
	BEQ	OUTPUT
	.CRLF
	MOV	(SP),R0		;restore original LF or CR 
	BR	TSTDSK
TSTEOL:	TST	WIDTH		;wrapping in effect?
	BMI	OUTPUT		;no
	CMP	COLUMN,WIDTH	;need horizontal wrap before output?
	BLO	OUTPUT		;no
	.CRLF			;yes
	MOV	(SP),R0		;restore char
OUTPUT:	.TTYOUT			;output the caller's char
TSTDSK:	TST	R0		;ok to write char to disk?
	BMI	ENDPRT
	.CALL	CHR2DK		;if receiver file active, record char
ENDPRT:	MOV	R0,LSTPRT	;save it in case tab, and delete is next
IGNORE:	MOV	(SP)+,R0	;restore char
	.RETURN
;
; table of vectors for control characters for PRINT1, if control character
; is not squelched via 0 byte in SQUTBL in configuration area.
;
;		NUL    SOH    STX    ETX    EOT    ENQ    ACK    BEL
PRTVEC:	.WORD	OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT
;
	;	BS     HT     LF     VT     FF     CR     SO     SI
	.WORD	PRTBS, PRTHT, PRTLF, OUTPUT,PRTFF, PRTCR, PRTSO, PRTSI
;
	;	DLE    DC1    DC2    DC3/^S DC4    NAK/^U SYN    ETB
	.WORD	OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT,OUTPUT
;
	;	CAN    EM     SUB    ESC    FS     GS     RS     US
	.WORD	OUTPUT,OUTPUT,OUTPUT,PRTESC,OUTPUT,OUTPUT,OUTPUT,OUTPUT
.PAGE
;
; COnference mode display routine --
; displays accumulated data in comm input buffer if
;     (linefeed terminator has been received)
;     or
;     (timeout on comm input and no keyboard line in progress)
;
PRTCO:	TST	CUTOFF		;lost carrier?
	BEQ	PRTCO1		;no
	JMP	EXITNC
PRTCO1:	MOV	R0,-(SP)
	TST	MSGCNT		;full line ready?
	BNE	2$		;br if so
	TST	BCOUNT		;partial line?
	BEQ	10$
	TSTB	@KBDLIN		;don't show partial line if typing in progress
	BGT	10$
	MOV	#CURTIM,R3
	.GTIM	#AREA,R3	;get current time, double precision ticks
	.MTPS	#340		;don't update last char time during calculation
	SUB	LCHTIM+2,2(R3)	;convert current to interval since last char
	SBC	(R3)
	SUB	LCHTIM,(R3)
	.MTPS	#0
	TST	(R3)+		;hi order of time elapsed since last chr rcvd
	BGT	4$		;if GT, more than 65535 ticks: timeout
	BEQ	1$		;fewer than 65536 ticks
	ADD	#15000,R3	;hi order<0, correct for midnight rollover
1$:	CMP	(R3),TICKS	;timeout since last char?
	BLO	10$		;no
2$:	TST	COLUMN
	BEQ	4$
	TSTB	@KBDLIN
	BGT	3$
	TST	PARTLN
	BNE	4$
3$:	.PRINT	#CLRLIN
	CLR	COLUMN		;in case clrlin sequence contains graphic chars
;
4$:	.CALL	COMMIN
	BCS	5$
	.CALL	PRINT1
	MOV	COLUMN,PARTLN
5$:	TST	MSGCNT
	BEQ	6$
	CMP	R0,#136		;"^"
	BNE	4$
	CMPB	@ADDR2,#'U
	BNE	4$
	CMP	BCOUNT,#3
	BLO	4$
	.CALL	COMMIN		;"U"
	.CALL	COMMIN
	CMP	R0,#CR
	BNE	55$
	.CALL	COMMIN		;lf
	.PRINT	#BSECHO		;erase "^"
	MOV	#BS,R0
	.CALL	CHR2DK
	BR	5$
55$:	MOV	R0,-(SP)	;undo...
	MOV	#'U,R0
	.CALL	PRINT1
	MOV	(SP)+,R0
	.CALL	PRINT1
	BR	4$
6$:	TST	COLUMN
	BNE	7$
	.CALL	SPACES
7$:	.PRINT	KBDLIN
10$:	MOV	(SP)+,R0
	.RETURN
;
SPACES:	MOV	#SPC,R0
1$:	CMP	COLUMN,INDENT
	BHIS	2$
	.TTYOUT
	BR	1$
2$:	.RETURN
.PAGE
; 
; have received ESC in Vidtex mode
;
DOESC:	.CALL	COMMIN		;char following ESC arrived yet?
	BCS	5$		;no
	CLR 	ESCSEQ		;clear vector/flag
	CMPB	R0,#'A		;ESC A ?
	BNE	1$
	TST	GOTSI		;SI received?
	BEQ	1$		;no
	JMP	APROCL		;yes, go do 'A' protocol
1$:	MOV	R1,-(SP)	;save reg
	CLR	R1
2$:	CMPB	R0,ESCTBL(R1)	;recognize?
	BEQ	3$		;yes
	INC	R1		;next offset in ESCTBL
	TSTB	ESCTBL(R1)	;end of table?
	BNE	2$		;no
	BR	4$		;yes, ignore
3$:	ASL	R1		;word index
	MOV	CRTTYP,R0	;CRT code
	ASL	R0		;word offset
	MOV	CRTTBL(R0),R0	;start of table for specific CRT
	ADD	R1,R0		;addr of vector
	.CALL	@(R0)+
4$:	MOV	(SP)+,R1	;restore reg
5$:	.RETURN
;
; ignore char(s) of unimplemented ESC sequence
;
THROW2:	MOV	#1$,ESCSEQ
	.RETURN
1$:	.CALL	COMMIN
	BCS	NOTIMP
THROW1:	MOV	#1$,ESCSEQ
	.RETURN
1$:	.CALL	COMMIN
	BCS	NOTIMP
	CLR	ESCSEQ
NOTIMP:	.RETURN
	.GLOBL	NOTIMP
;
ESCTBL:	.BYTE	ESC,'A,'B,'C,'D,'G,'H,'I,'J,'K,'Y,'b,'c,'e,'f,'j,'l,'m
	.BYTE	0		;terminator
	.EVEN
;
; CRT type vectors
;
CRTTBL:	.WORD	NOCRT,CRT52,CRT100
;
; unsupported CRT-type vectors
;
NOCRT:	.WORD	THROW1,NOTIMP,NOTIMP,NOTIMP
	.WORD	NOTIMP,THROW1,NOTIMP,ID52
	.WORD	NOTIMP,NOTIMP,THROW2,NOTIMP
	.WORD	NOTIMP,NOTIMP,NOTIMP,NOTIMP
	.WORD	NOTIMP,NOTIMP
;
;
; VT100 vectors
;
CRT100:	.WORD	THROW1,CUU100,CUD100,CUF100	;ESC,A,B,C
	.WORD	CUB100,THROW1,HOM100,ID100	;D,G,H,I
	.WORD	EOS100,EOL100,CUP100,NOTIMP	;J,K,Y,b
	.WORD	NOTIMP,NOTIMP,NOTIMP,CPG100	;c,e,f,j
	.WORD	NOR100,WID100			;l,m
;
CUU100:	MOV	#CUU.100,R0			;cursor up
	BR	OUT100
CUD100:	MOV	#CUD.100,R0			;cursor down
	BR	OUT100
CUF100:	INC	COLUMN				;cursor right
	MOV	#CUF.100,R0
	BR	OUT100
CUB100:	.TTYOUT	#BS				;cursor left
	.RETURN
HOM100:	CLR	COLUMN				;cursor home
	MOV	#HOM.100,R0
	BR	OUT100
EOS100:	MOV	#EOS.100,R0			;clear to end of screen
	BR	OUT100
EOL100:	MOV	#EOLESC,R0			;clear to end of line
	BR	OUT100
CPG100:	CLR	COLUMN
	MOV	#CLRSCR,R0			;home and clear screeen
	BR	OUT100
NOR100:	MOV	#NOR.100,R0			;normal width chars
	BR	OUT100
WID100:	MOV	#WID.100,R0			;wide chars
OUT100:	MOV	COLUMN,-(SP)
	CLR	COLUMN
	.PRINT
	MOV	(SP)+,COLUMN
	.RETURN
CUP100:	MOV	#CUP.100,R0			;position cursor
	MOV	#LIN100,ESCSEQ
	BR	OUT100
LIN100:	.CALL	COMMIN
	BCS	1$
	CLR	COLUMN
	.CALL	LCOUT
	.TTYOUT	#73
	MOV	#COL100,ESCSEQ
1$:	.RETURN
COL100:	.CALL	COMMIN
	BCS	1$
	MOV	R0,-(SP)
	.CALL	LCOUT
	.TTYOUT	#'H
	MOV	(SP)+,COLUMN
	SUB	#40,COLUMN
	CLR	ESCSEQ
1$:	.RETURN
;
CUU.100:.BYTE	ESC,'[,'A,200
CUD.100:.BYTE	ESC,'[,'B,200
CUF.100:.BYTE	ESC,'[,'C,200
HOM.100:.BYTE	ESC,'[,'H,200
EOS.100:.BYTE	ESC,'[,'J,200
NOR.100:.BYTE	ESC,'#,'5,200
WID.100:.BYTE	ESC,'#,'6,200
CUP.100:.BYTE	ESC,'[,200
	.EVEN
;
; R0 = n + 37, output n in ASCII
;
LCOUT:	SUB	#37,R0
	.CALL	DIV10
	TST	R0
	BEQ	1$
	ADD	#'0,R0
	.TTYOUT
1$:	MOV	R1,R0
	ADD	#'0,R0
	.TTYOUT	
	.RETURN
;
; divide R0 by 10., remainder in R1
;
DIV10:	MOV	R0,R1
	CLR	R0
1$:	SUB	#10.,R1
	BMI	2$
	INC	R0
	BR	1$
2$:	ADD	#10.,R1
	.RETURN

;
; VT52 vectors
;
CRT52:	.WORD	THROW1,CUU52,CUD52,CUF52	;ESC,A,B,C
	.WORD	CUB52,THROW1,HOM52,ID52		;D,G,H,I
	.WORD	EOS52,EOL52,CUP52,NOTIMP	;J,K,Y,b
	.WORD	NOTIMP,NOTIMP,NOTIMP,CPG52	;c,e,f,j
	.WORD	NOTIMP,NOTIMP			;l,m
;
CUU52:	MOV	#CUU.52,R0			;cursor up
	BR	OUT52
CUD52:	MOV	#CUD.52,R0			;cursor down
	BR	OUT52
CUF52:	INC	COLUMN				;cursor right
	MOV	#CUF.52,R0
	BR	OUT52
CUB52:	.TTYOUT	#BS				;cursor left
	.RETURN
HOM52:	CLR	COLUMN				;cursor home
	MOV	#HOM.52,R0
	BR	OUT52
EOS52:	MOV	#EOS.52,R0			;clear to end of screen
	BR	OUT52
EOL52:	MOV	#EOLESC,R0			;clear to end of line
	BR	OUT52
CPG52:	CLR	COLUMN
	MOV	#CLRSCR,R0			;home and clear screeen
OUT52:	MOV	COLUMN,-(SP)
	CLR	COLUMN
	.PRINT
	MOV	(SP)+,COLUMN
	.RETURN
CUP52:	MOV	#CUP.52,R0			;position cursor
	MOV	#LIN52,ESCSEQ
	BR	OUT52
LIN52:	.CALL	COMMIN
	BCS	1$
	CLR	COLUMN
	.TTYOUT
	MOV	#COL52,ESCSEQ
1$:	.RETURN
COL52:	.CALL	COMMIN
	BCS	1$
	MOV	R0,-(SP)
	.TTYOUT
	MOV	(SP)+,COLUMN
	SUB	#40,COLUMN
	CLR	ESCSEQ
1$:	.RETURN
;
CUU.52:	.BYTE	ESC,'A,200
CUD.52:	.BYTE	ESC,'B,200
CUF.52:	.BYTE	ESC,'C,200
HOM.52:	.BYTE	ESC,'H,200
EOS.52:	.BYTE	ESC,'J,200
CUP.52:	.BYTE	ESC,'Y,200
	.EVEN
;
;Send ID string to host
;
ID100:	MOV	ID100B,R1
	TST	BPROT
	BNE	SENDID
	BR	IDA
ID52:	MOV	ID52B,R1
	TST	BPROT
	BNE	SENDID
IDA:	MOV	#SYSIDA,R1
SENDID:	TSTB	(R1)
	BEQ	2$
	MOVB	(R1)+,R0
	.CALL	SEND
	BR	SENDID
2$:	.RETURN
;
SYSIDA:	.ASCIZ	"#DEC RT-11,CC,HC,PA,PL"<CR>

	.EVEN
;
; get next character from dlv11 input buffer into R0; set carry if no char
;
COMMIN:	TST	CUTOFF		;lost carrier?
	BEQ	1$		;no
	JMP	EXITNC
1$:	TST	BCOUNT		;anything in buffer?
	BEQ	14$		;no
	MOVB	@ADDR2,R0	;else get character from ring buffer
	INC	ADDR2		;bump pointer
	DEC	BCOUNT		;decrement unprocessed char count
	DEC	OCOUNT		;chars left 'til wraparound
	BNE	2$
	MOV	RINGBF,ADDR2	;wrap
	MOV	#BUFLEN,OCOUNT	;...
2$:	TST	PROCOL		;in protocol mode?
	BNE	11$		;Yes, skip all checks
	.CALL	BUFCHK		;check ring buffer status
	BIC	#200,R0		;clear parity bit
	CMPB	R0,PROTCH	;Protocol mode now?
	BNE	3$		;no
	TST	BCOUNT		;if anything after protocol char in buffer...
	BNE	3$		;then spurious protocol init char
	INC	PROCOL		;Set protocol mode
	BR	14$
3$:	TST	VIDTEX		;if not Vidtex mode
	BEQ	35$		;go check if requested; however...
	CMPB	R0,#SI		;CompuServe always sets parity bit on SI,SO
	BEQ	6$		;don't check SI; PRTSI will CLR PARFLG
35$:	TST	PARFLG		;test for parity?
	BEQ	6$		;br if not
	BPL	4$		;br if parflg indicates want even
	SWAB	R0		;char in hi byte, propagated parity in lo
	COMB	R0		;want odd, complement received parity
	SWAB	R0
4$:	MOV	R1,-(SP)	;save reg
	MOVB	R0,R1		;copy char
	SWAB	R0		;parity in lo byte
	CMPB	R0,EVNPAR(R1)
	BEQ	5$
	CMPB	R1,#LF
	BNE	45$
	DEC	MSGCNT		;interrupt service counted it as a LF
45$:	MOVB	PERRCH,R0	;replace char with parity-error char
	SWAB	R0
5$:	SWAB	R0
	MOV	(SP)+,R1	
6$:	BIC	#^C177,R0
	BIT	#MATCHA,STAT	;does any character whatever satisfy wait?
	BEQ	7$		;no
	BIC	#WAIT!MATCHA,STAT ;yes
	BR	8$
7$:	TSTB	WAITCH		;waiting for specific character?
	BEQ	8$		;no
	CMPB	R0,WAITCH	;this one?
	BNE	8$		;no
	CLRB	WAITCH		;yes
	BIC	#WAIT,STAT
	BIT	#TOSSM,STAT	;chuck this char?
	BEQ	8$		;no
	BIC	#TOSSM,STAT	;yes
	BR	COMMIN
8$:	BIT	#CSQTHR,STAT	;XON/XOFF throttle?
	BEQ	9$		;no
	BIT	#WAIT,STAT	;XOFF in buffer?
	BEQ	9$		;no
	BIS	#TOSSM,STAT	;yes, wait for then chuck...
	MOVB	#XON,WAITCH	;...the next received XON
	CMPB	R0,#XOFF	;is this the XOFF?
	BEQ	COMMIN		;yes, discard it
9$:	.CALL	LSTRCV		;save last received char
11$:	MOV	R0,-(SP)
	BIC	#^C177,(SP)
	CMP	(SP)+,#LF	;linefeed?
	BNE	12$		;no
	DEC	MSGCNT		;for COmode
12$:	BIC	#^C377,R0
	TST	(PC)+		;clear carry and skip
14$:	SEC
	.RETURN

LSTRCV:	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	#LRBUFF,R0
	MOV	#LRBLEN-1,R1
1$:	MOVB	1(R0),(R0)+
	SOB	R1,1$
	MOV	(SP)+,R1
	MOVB	(SP),(R0)
	MOV	(SP)+,R0
	.RETURN
.PAGE
;
; if script file active, record char contained in R0
;
	.ENABL	LSB
CHR2DK:	TST	RCDING		;active?
	BEQ	3$
	MOV	R0,-(SP)
	CMPB	(SP),#BS	;backspace?
	BNE	1$		;br if not
	CMP	INCHR,#512	;block empty?
	BEQ	2$		;br if so, can't get at prior character
	DEC	INPNT		;else delete prior character
	INC	INCHR
	BR	2$
1$:	TST	BUFAVL		;disk buffer available?
	BNE	GOTBUF		;yes
	.CALL	BUFCHK		;check comm input ring buffer status
	BR	1$		;wait for disk buffer
GOTBUF:	TST	RCDING		;available due to error?
	BEQ	2$		;br if so
	MOVB	(SP),@INPNT	;move character to buffer
	INC	INPNT		;advance pointer
	DEC	INCHR		;block full?
	BNE	2$		;no, skip
	.WRITC	#AREA,#SCRPCH,CURBUF,#256.,#4$,INBLK
	BCS	5$
	DEC	BUFAVL		;one less buffer available for stuffing
	MOV	#512.,INCHR
	MOV	@INPNT,INPNT	;switch buffers - pointer to next follows each
	MOV	INPNT,CURBUF
2$:	MOV	(SP)+,R0
3$:	.RETURN
;
; Completion routine
;
4$:	ASR	R0		;channel status word
5$:	.ON	CS,ERR,<File write error -- recording ended>,8$
6$:	INC	BUFAVL		;a buffer is available for stuffing
	TST	RCDING		;still want to record?
	BNE	7$		;br if so
	CMP	BUFAVL,#NBRBUF	;any I/O outstanding?
	BEQ	8$		;br if not
	BR	9$		;else wait for next completion
7$:	INC	INBLK		;block#
	CMP	INBLK,IBLKSZ	;file full?
	.ON	HIS,ERR,<Recording file full -- recording ended>,,.ELSE=9$
8$:	CLR	RCDING		;clear scripting flag
	MOV	#-1,BUFAVL	;tells pgm to close file
9$:	.RETURN
	.DSABL	LSB
.PAGE
;
; Physical close of script file
;
	.ENABL	LSB
.CLOS:	MOV	#NBRBUF,BUFAVL	;indicates no outstanding I/O
	.CLOSE	#SCRPCH		;attempt to close file (.SERR is in effect)
	.ON	CS,ERR,<Error closing recording file>,1$
	.TELL	INFO,<Recording file closed>
1$:	.RETURN
	.DSABL	LSB
;
; Disconnect (DL11-E) and restart pgm.
; 
DISCON:	.MTPS	#340
	CLR	@.RCSR		;disconnect
	.MTPS	#0
	.CALL	DELAY		;allow time for disconnect, restart will...
	.CALL	DELAY		;...set DTR again
	.CALL	DELAY		;
	BR	NC1
;
;  program exit
;
	.ENABL	LSB
EXITNC:	CLR	R2		;entry point if carrier-lost interrupt
	.TELL	BELL,<Communications carrier lost>
NC1:	CLR	R2		;indicates no carrier, so restart pgm
	BR	EXIT1		;isr already disabled modem interrupts
EXIT:	MOV	PC,R2		;entry point if user commanded exit
	.MTPS	#340
	BIC	#140,@.RCSR	;disable interface interrupts
	.MTPS	#0
EXIT1:	.UNPROT	#AREA,.RVEC
	TST	DL11E
	BEQ	CHKRCD
	TST	R2		;if lost carrier once...
	BEQ	CHKRCD		;ignore it now (may be modem poweroff garbage)
	BIT	#10000,@.RCSR	;carrier?
	BEQ	CLRDTR		;br if not
	.PROMPT	<Communications carrier present -- disconnect?>
	.CALL	YESNO
	BEQ	CHKRCD
CLRDTR:	CLR	@.RCSR		;hang up (clear DTR)
CHKRCD:	TST	RCDING		;script file going?
	BEQ	1$		;br if not
	.CALL	CLOSE		;start scripting shut down
1$:	CMP	BUFAVL,#NBRBUF	;script I/O status
	BHI	2$		;br if need to close script file
	BEQ	3$		;br if all shut down
	BR	1$		;else wait for I/O complete
2$:	.CALL	.CLOS		;close script file
3$:	MOV	SVTVEC,@#TTRVEC ;give back rt-11 keyboard vector
	.CLOSE	#CSCHAN		;save any interrupted download
	TST	R2		;exit by command or lost carrier?
	BNE	4$		;br if by command
	.SRESET
	JMP	START2		;else restart, may want to reconnect right away
4$:	MOV	RINGBF,R0
	TST	-(R0)		;original program top
	.SETTOP			;chuck handlers, ring buff in case SAVE command
	.EXIT
	.DSABL	LSB
	.PAGE
;
; 'A' protocol file transfer
;
	.ENABL	LSB
APROCL:	CLR	PSTAT		;Clear flags
	MOV	SP,PROCOL	;Set protocol flag
	.TELL	INFO,<Initializing for file transfer>
	MOV	#'0,RECNBR	;Init record number
	.CALL	GET1		;Get a command line
	BCS	6$		;Abort?
	CMPB	1(R3),#'A	;ASCII transfer?
	BEQ	2$		;Yes
	BIS	#BINARY,PSTAT	;Else set Binary transfer
2$:	CMPB	(R3),#'U	;Upload?
	BNE	4$		;no
	JMP	UPLOAD
4$:	CMPB	(R3),#'D	;Download?
	BNE	6$		;No, abort
	JMP	DNLOAD
6$:	JMP	ABORT		;we don't recognize host command
	.DSABL	LSB
;*****************************************************
;Routine to handle downloading
	.ENABL	LSB
DNLOAD:	.TELL	INFO,<Beginning download>
	.PURGE	#CSCHAN
	MOV	R50RCV,DEFEXT+2	;default extention is .RCV
	.CALL	PARSE		;Parse filespec
	BCC	2$		;Error?
	JMP	ABORT		;Yes
2$:	.LOOKUP	#CSAREA,#CSCHAN,#FSPEC	;See if file exists
	BCS	6$		;No
	.PURGE	#CSCHAN		;Purge channel first
	.PROMPT	<File exists -- rewrite it?>
	.CALL	YESNO
	BNE	4$
	JMP	ABORT		;No
4$:	.CRLF
6$:	MOV	FSPEC+8.,R1	;Get user-specified filesize (if any)
	.ENTER	#CSAREA,#CSCHAN,#FSPEC,R1 ;Open the file
	.ON	CS,ERR,<File open error>,ABORT
10$:	;TST	R0		;No room for file [TSX only]
	;.ON	EQ,ERR<No room for file>,ABORT
	MOV	R0,CSMAX	;Save size of file
	MOV	DSKBUF,CSPNT	;Set up buffer pointer
	MOV	#512.,CSCHR	;Character count
	CLR	CSBLK		;Block count
	.DSABL	LSB
	.ENABL	LSB
	BIS	#TRNSFR,PSTAT	;We are tranferring now
DOWN1:	.CALL	GETBLK		;Get a checksummed block of data
	BIT	#XABORT,PSTAT
	BEQ	2$
	JMP	ABORT
2$:	BIT	#EOTFLG,PSTAT	;End of transmission?
	BNE	10$		;Yes
	MOVB	(R3)+,@CSPNT	;Move character into buffer
	INC	CSPNT		;Increment pointer
	DEC	CSCHR		;Block full?
	BNE	8$		;No
	.WRITW	#AREA2,#CSCHAN,DSKBUF,#256.,CSBLK
3$:	.ON	CS,ERR,<File write error>,ABORT
4$:	INC	CSBLK		;Next block
	CMP	CSBLK,CSMAX	;Was that the last block?
	.ON	HIS,ERR,<File is full>,ABORT
	MOV	#512.,CSCHR	;Reset pointers
	MOV	DSKBUF,CSPNT
8$:	DEC	MSGLEN		;Message finished?
	BNE	2$		;No
	BR	DOWN1		;Else get another block
10$:	CMP	CSCHR,#512.	;partial last block?
	BEQ	12$		;no
11$:	CLRB	@CSPNT		;yes, Pad buffer with nulls
	INC	CSPNT
	DEC	CSCHR
	BNE	11$
	.WRITW	#AREA2,#CSCHAN,DSKBUF,#256.,CSBLK
	.ON	CS,ERR,<File write error on last disk block>
12$:	.CLOSE	#CSCHAN		;Close it
	MOVB	#'.,R0		;Tell host we got it
	.CALL	SEND
	JMP	ENDXFR
	.DSABL	LSB
;*****************************************************
;Routine to handle uploading
	.ENABL	LSB
UPLOAD:	.TELL	INFO,<Beginning upload>
	MOV	R50DAT,DEFEXT+2	;default extention is .DAT
	.CALL	PARSE		;Parse filespec
	BCC	2$		;Error?
	JMP	ABORT		;Yes
2$:	BIS	#TRNSFR,PSTAT	;We are transferring now
	.PURGE	#CSCHAN
	.LOOKUP	#CSAREA,#CSCHAN,#FSPEC	;Open file
	.ON	CS,ERR,<File not found>,ABORT
	BIC	#MSKFLG,PSTAT	;Allow normal masking
	CLR	UPBLK		;Block number to read
	MOVB	#'.,R0		;Tell host we are ready
	.CALL	SEND
	.CALL	HOSTIN		;Get character from host
	.DSABL	LSB
	.ENABL	LSB
	BCS	17$		;Abort?
	BIT	#XABORT,PSTAT
	BNE	17$
	CMPB	R0,#'.		;Right prompt?
	BNE	17$		;No, abort
6$:	.READW	#CSAREA,#CSCHAN,DSKBUF,#256.,UPBLK ;Read a block
	BCC	10$		;error or EOF?
	TSTB	@#ERRBYT	;EOF?
	.ON	NE,ERR,<File read error>,ABORT,.ELSE=16$
10$:	MOV	PROBUF,R3	;Point to start of CS buffer
	MOV	DSKBUF,R2	;Get address of input file buffer
	CLR	MSGLEN		;Init message length
12$:	MOVB	(R2)+,(R3)+	;Put data in buffer
	INC	MSGLEN		;bump counter
	TSTB	MSGLEN+1	;Buffer full?
	BEQ	12$		;No
	.CALL	SNDBLK		;Send a checksummed comm block
	BCS	17$
	MOV	PROBUF,R3	;Point to start of CS buffer
	CLR	MSGLEN		;Init message length
14$:	MOVB	(R2)+,(R3)+	;put second half of disk block in
	INC	MSGLEN
	TSTB	MSGLEN+1	;Buffer full?
	BEQ	14$		;No, back for more
	.CALL	SNDBLK		;send a checksummed comm block
	BCS	17$
	INC	UPBLK		;next disk block
	BR	6$
16$:	.CLOSE	#CSCHAN		;close input channel
	BIS	#MSKFLG,PSTAT	;don't mask EOT
	MOV	#1,MSGLEN	;Message length
	MOV	#EOT,@PROBUF	;send EOT
	.CALL	SNDBLK		;send checksummed comm block
	BCC	18$
17$:	JMP	ABORT
18$:	JMP	ENDXFR
	.RETURN
	.DSABL	LSB
;*****************************************************
;Send a checksummed block to remote
	.ENABL	LSB
SNDBLK:	TST	MSGLEN		;No message?
	BEQ	20$
	INC	RECNBR		;bump record number
	CMP	RECNBR,#'9	;Roll over?
	BLOS	2$		;No
	MOV	#'0,RECNBR	;Yes
2$:	MOV	PROBUF,R3	;point to buffer
	MOV	MSGLEN,R1	;message length
	CLR	CKSUM		;Clear checksum
	MOVB	#SOH,R0		;Start the message
	.CALL	SEND
	MOV	RECNBR,R0	;send record number
	.CALL	SEND
	.CALL	UPDATE		;update checksum
4$:	MOVB	(R3)+,R0	;Get data byte
	BNE	5$		;Not a null
	BIT	#BINARY,PSTAT	;ASCII xfer?
	BEQ	13$		;Yes, discard null
5$:	.CALL	UPDATE		;Update checksum
	BIT	#BINARY,PSTAT	;ASCII transfer?
	BNE	6$		;No
	.CALL	PRINT1		;Yes, display
6$:	BIT	#MSKFLG,PSTAT	;Ok to mask?
	BNE	12$		;No, if flag set
	CMPB	R0,#40		;Maybe to be masked?
	BHIS	12$		;not if 40 or higher
	TSTB	MSKTBL(R0)	;mask it?
	BPL	12$		;no
	MOV	R0,-(SP)	;save char
	MOV	#DLE,R0
	.CALL	SEND		;send DLE prefix
	MOV	(SP)+,R0
	BIS	#100,R0		;mask it
12$:	.CALL	SEND		;Send character
13$:	DEC	R1		;Buffer count exhausted?
	BNE	4$		;No
	MOV	#ETX,R0		;Send End Of Text
	.CALL	SEND
	CMP	CKSUM,#40	;Cksum <40?
	BHIS	14$		;no
	MOV	#DLE,R0		;yes, send it masked
	.CALL	SEND
	BIS	#100,CKSUM	;Mask it
14$:	MOV	CKSUM,R0	;send it
	.CALL	SEND
16$:	.CALL	HOSTIN		;Get host's reply
	BCS	22$		;Abort
	BIT	#XABORT,PSTAT
	BNE	22$
	BIT	#BINARY,PSTAT	;Binary transfer?
	BEQ	18$		;No
	.CALL	PRINT1		;Yes, display reply
18$:	CMPB	R0,#'.		;Transmission ok?
	BEQ	20$		;Yes, return
	CMPB	R0,#'/		;Invalid transmission?
	.ON	EQ,BELL,<Remote rejected block -- retransmitting it>,2$
	.ON	NE,BELL,<Non-protocol reply from remote -- retransmitting block>
19$:	.CALL	COMMIN		;flush comm input
	BCC	19$
	BR	2$		;go re-transmit
20$:	TST	(PC)+		;clear carry and skip
22$:	SEC			;Set abort flag
	.RETURN
	.DSABL	LSB
; Flag table for control characters that are to be masked when part of
; text.  B1t 7 is set if to be masked.  Bits 0..6 are
; not used, have corresponding ASCII value here for ease of inspection.
; Note that protocol spec says all control chars to be masked; to increase
; thruput, we cheat on those characters which are commonly sent to display
; terminals.
;
MSKTBL:	.BYTE	000,201,202,203,204,205,206,007
	.BYTE	010,011,012,013,014,015,216,217
	.BYTE	220,221,222,223,224,225,226,227
	.BYTE	230,231,232,033,234,235,236,237
;*****************************************************
;Routine to receive a checksummed block from remote
	.ENABL	LSB
GETBLK:	MOVB	#'.,R0		;Prompt remote for next record
	.CALL	SEND
	BIT	#BINARY,PSTAT	;Binary transfer?
	BEQ	GET1		;No
	.CALL	PRINT1		;Else display our request
GET1:	INC	RECNBR		;bump record number
	CMP	RECNBR,#'9	;Roll over?
	BLOS	2$		;No
	MOV	#'0,RECNBR	;Yes
2$:	MOV	PROBUF,R3	;Get start of buffer
	.CALL	HOSTIN		;Get a character from remote
	BCC	6$		;Abort
4$:	.RETURN			;carry is set
6$:	CMPB	R0,#SOH		;Start Of Heading?
	BEQ	8$		;Yes, start receiving the record
	CMPB	R0,#ETX		;ETX by itself is questionable
	BNE	2$
	MOVB	#'/,R0		;So send a logical nak
	.CALL	SEND
	BR	2$
8$:	CLR	CKSUM		;Clear checksum
	BIC	#EOTFLG,PSTAT	;Clear EOT bit
	CLR	MSGLEN		;and message length
10$:	.CALL	HOSTIN		;Get host's record number
	BCS	4$		;Abort
	MOVB	R0,RECHST	;Save host record number
	BR	24$		;and update checksum for rcd nbr
12$:	.CALL	HOSTIN		;Get a character
	BCS	4$
	CMPB	R0,#NAK		;A nak?
	BNE	14$
13$:	SEC			;Set for abort
	.RETURN
14$:	CMPB	R0,#ETX		;End of TeXt?
	BEQ	26$
	CMPB	R0,#EOT		;End Of Transmission?
	BNE	16$
	BIS	#EOTFLG,PSTAT	;set end of transmission flag
16$:	CMPB	R0,#DLE		;Masked character coming?
	BNE	20$		;No
18$:	.CALL	HOSTIN		;Else get next character
	BCS	4$
	BIC	#^C<37>,R0	;Unmask it
20$:	BIT	#TRNSFR,PSTAT	;Transfer in progress?
	BEQ	22$		;No, don't display
	BIT	#BINARY,PSTAT	;Binary transfer?
	BNE	22$		;Yes
	TSTB	R0		;Null byte?
	BEQ	22$		;Yes
	.CALL	PRINT1		;Display ASCII non-null
22$:	MOVB	R0,(R3)+	;Move character into buffer
	INC	MSGLEN		;Bump message length
24$:	.CALL	UPDATE		;Update checksum
	BR	12$		;And back for more
26$:	.CALL	HOSTIN		;Get checksum
	BCS	4$
	BIT	#XABORT,PSTAT
	BNE	4$
	CMPB	R0,#DLE		;Masked?
	BNE	30$
28$:	.CALL	HOSTIN		;Get masked character
	BCS	4$
	BIC	#^C<37>,R0	;Unmask character
30$:	CMPB	CKSUM,R0	;Checksum match?
 .ON	NE,BELL,<Block checksum error, requesting retransmission>,,.ELSE=34$
	MOVB	#'/,R0		;request retransmission
	.CALL	SEND
	BR	2$		;and start over
34$:	CMPB	RECNBR,RECHST	;Record numbers match?
	BEQ	GET38		;Yes
	.ON	HI,BELL,<Record numbers out of synch>,13$ ;higher is no good
	MOVB	RECNBR,R0
	DEC	R0		;previous record number
	CMPB	R0,#'0-1
	BNE	GET35
	MOV	#'9,R0
GET35:	CMPB	R0,RECHST	;Duplicate of last record?
	.ON	NE,BELL,,13$
	MOVB	#'.,R0		;Yes...
	.CALL	SEND		;Accept it, and try again
	BIT	#BINARY,PSTAT	;Binary transfer?
	BEQ	GET36		;No
	.CALL	PRINT1		;Else display host's reply
GET36:	JMP	2$
GET38:	MOV	PROBUF,R3	;Point to start of buffer
	.RETURN
	.DSABL	LSB
;*****************************************************
;Routine to update checksum
UPDATE:	MOVB	CKSUM,R4	;Get checksum, sign extend
	ASL	R4		;Rotate 1 bit left
	ADC	R4		;Add carry
	MOVB	R4,R4		;Sign extend it
	MOVB	R0,R0		;sign extend new char
	ADD	R0,R4		;Add new character
	ADC	R4		;Add carry
	MOVB	R4,CKSUM	;save new checksum
	.RETURN
;*****************************************************
;Routine to get character from Remote
HOSTIN:	.CALL	CKABRT		;Check keyboard for abort
	BIT	#GETOUT,PSTAT	;2nd Ctrl-C?
	BNE	4$
	.CALL	COMMIN
	BCS	HOSTIN
	CMPB	R0,#NAK		;Abort?
	BEQ	4$		;Yes
	TST	(PC)+		;No, clear carry and skip
4$:	SEC			;Else set abort flag
	.RETURN
;*****************************************************
;Abort CSEXEC mode here
	.ENABL	LSB
ABORT:	.TELL	BELL,<Aborting transfer>
	MOV	#NAK,R0		;Send a nak to host
	.CALL	SEND		;to kill transfer
	.CLOSE	#CSCHAN		;close file (no harm if wasn't open)
ENDXFR:	CLR	GOTSI		;CIS won't send SO after abort
	CLR	PROCOL
	MOV	PARSAV,PARFLG
	.RETURN			;and return to terminal mode
	.DSABL	LSB
;
; stub for "B" protocol in case object file not linked
;
	.CSECT	BPRO ;OVR
ID100B:	.WORD	SYSIDA
ID52B:	.WORD	SYSIDA
BPROCL:	.RETURN
	.CSECT	MAIN
;
; Check for Ctrl-C abort from keyboard
;
	.ENABL	LSB
CKABRT:	.CALL	TTINRC
	BCC	2$
	CMP	R0,#ETX		;Ctrl-C?
	BNE	CKABRT		;ignore non-Ctrl-C
	BIT	#XABORT,PSTAT	;2nd Ctrl-C?
	BEQ	1$		;no
	BIS	#GETOUT,PSTAT	;yes
	CLR	TIMLIM		;don't wait for remote timeout
	BR	2$
1$:	BIS	#XABORT,PSTAT
	.CRLF
	.TELL	BELL,<Transfer abort is pending>
	.CRLF
2$:	.RETURN
	.DSABL	LSB
;
; check filename, convert to filespec, fetch handler
;
	.ENABL	LSB
PARSE:	MOV	FILNAM,R1	;Point to filespec
2$:	CMPB	(R1)+,#SPC	;End of filespec?
	BHI	2$
4$:	MOV	FILNAM,R0
	ADD	#26,R0
	CMP	R1,R0		;filespec reasonable length (might incl [size])
	BLOS	6$		;yes
	SEC
	BR	7$
6$:	DEC	R1		;point to terminator
	MOVB	#'=,(R1)+	;replace it with "="
	CLRB	(R1)		;terminate with null
	MOV	SP,R1		;Save stack
	.CSISPC	#FSPEC,#DEFEXT,FILNAM ;process filename
	MOV	R1,SP		;Restore stack
7$:	.ON	CS,ERR,<Illegal filename>,9$
	.DSTATUS #AREA,#FSPEC
	BCS	8$
	TST	AREA+4		;handler loaded?
	BNE	11$		;yes
	MOV	FREE,R0
	ADD	AREA+2,R0
	TST	-(R0)
	MOV	R0,R1
	.SETTOP	R0
	CMP	R0,R1
	.ON	LO,ERR,<Insufficient free memory for handler>,9$
	.FETCH	FREE,#FSPEC	;get handler
8$:	.ON	CS,ERR,<Device handler fetch error>,,.ELSE=10$
9$:	SEC			;Abort transfer
	BR	12$
10$:	MOV	R0,FREE
11$:	MOV	@#54,R0		;RMON addr
	CLR	256(R0)		;force directory read
12$:	.RETURN
	.DSABL	LSB
;
; uppcas - if char in R0 is lower case, convert to upper
;
UPPCAS:	CMPB	R0,#'a
	BLO	1$
	CMPB	R0,#'z
	BHI	1$
	SUB 	#'a-'A,R0
1$:	.RETURN
;
; ttyin
;
TTYIN:	.CALL	TTINRC
	BCC	TTYIN
	.RETURN
;
; ttinrc: like .ttinr, except significance of carry is reversed
;
TTINRC:	TST	KBDCNT			;anything in kbd buffer?
	BNE	REALKB			;yes
	CMP	KBSP,#KBSP		;function definition playback going?
	BHIS	7$			;no, carry is clear on branch
	CLR	-(SP)			;temp area
1$:	MOV	KBSP,R0			;pointer to definition pointer
	MOVB	@0(R0),(SP)		;synch required?
	BPL	4$			;no
	NEGB	(SP)			;length of sync string
	ADD	(R0),(SP)		;addr of last byte in sync string
	MOV	#LRBUFF+LRBLEN,R0	;addr+1 of last char received
3$:	CMPB	-(R0),@0(SP)		;characters match?
	BNE	6$			;no, TTINRC returns empty-handed
	DEC	(SP)			;decr sync string addr
	CMP	(SP),@KBSP		;compared entire sync string?
	BHI	3$			;no
	MOV	#LRBUFF+LRBLEN+1,-(SP)
	SUB	R0,(SP)			;len of sync string + 1 for len byte
	MOV	KBSP,R0			;definition stack pointer
	ADD	(SP),(R0)+		;adjust defintion pointer on stack
	SUB	(SP)+,(R0)+		;and decr definition count on stack
	BGT	1$			;not end, go get char after sync string
	MOV	R0,KBSP			;pop software stack
	BR	6$			;and return no char
4$:	INC	(R0)+			;bump ptr
	DEC	(R0)+			;decr count
	BNE	5$			;if exhausted...
	MOV	R0,KBSP			;pop software string stack
5$:	MOV	(SP)+,R0		;the saved char
	SEC
	.RETURN
6$:	TST	(SP)+			;clears carry
7$:	.RETURN
REALKB:	DEC	KBDCNT
	MOVB	@KBDOLD,R0
	TST	BUFTT
	BEQ	20$
	CMP	PREVKB,CMDCHR		;previous char was command prefix?
	BEQ	10$			;yes, no LF translation
	CMP	R0,#LF			;else xlate to XON or XOFF for VT100
	BNE	10$
	MOV	#XON,R0
	COM	LFXON
	BEQ	10$
	MOV	#XOFF,R0
10$:	MOV	R0,PREVKB
20$:	INC	KBDOLD
	CMP	KBDOLD,#KBDEOB
	BLO	30$			;=bcs
	MOV	#KBDBUF,KBDOLD
	SEC
30$:	.RETURN
;
; output char in R0.  bs: dec column, but not to less than zero;
;		      cr: clr column; graphic: inc column, but not to > WIDTH;
;		      other: column unchanged.
TTYOUT:	CMPB	R0,#BS
	BNE	1$
	DEC	COLUMN
	BMI	2$
	BR	4$
1$:	CMPB	R0,#CR
	BNE	3$
2$:	CLR	COLUMN
	CLR	PARTLN
	BR	4$
3$:	CMPB	R0,#SPC
	BLT	4$
	CMPB	R0,#DEL
	BEQ	4$
	CMP	COLUMN,WIDTH
	BHIS	4$
	INC	COLUMN
4$:	TSTB	@#TTXCSR
	BPL	4$
	TST	HOLDTT
	BEQ	5$
	.CALL	BUFCHK
	BR	4$
5$:	MOVB	R0,@#TTXBUF
	.RETURN
;
PRINT.:	MOV	R1,-(SP)
	MOV	R0,R1
	BR	2$
1$:	.TTYOUT
2$:	MOVB	(R1)+,R0
	BMI	3$
	BNE	1$
	.PRINT	#CRLF
3$:	MOV	(SP)+,R1
	.RETURN
;
CRLF:	.BYTE	CR,LF,200
	.EVEN
	.PAGE
;====================================================
;
;  data area
;
;====================================================
;
;  rad50 constants
;
R50DAT:	.RAD50	/DAT/
R50RCV:	.RAD50	/RCV/
R50COM:	.RAD50	/COM/
R50TMP:	.RAD50	/TMP/
;
;  jump table used for dispatching on command characters typed by operator
;
JTABLE:		;entries for the 10 digits must be first in jtable
	PLAYBK		;0	function key playback
	PLAYBK		;1	function key playback
	PLAYBK		;2	function key playback
	PLAYBK		;3	function key playback
	PLAYBK		;4	function key playback
	PLAYBK		;5	function key playback
	PLAYBK		;6	function key playback
	PLAYBK		;7	function key playback
	PLAYBK		;8	function key playback
	PLAYBK		;9	function key playback
	HELP		;?	show valid command codes
	CLOSE		;D	close script file
	SUPRES		;F	select suppress option
	BREAK		;K	transmit break
	RECORD		;R	record in script file
	TRANS		;T	transmit file
	THROTL		;Y	select "throttle" type
	EXIT		;X	exit to monitor
	CHGCMD		;C	change command character
	PARITY		;P	change parity checking
	CHGALF		;A	change auto-lf after received cr flag
	FUNDEF		;N	define function key
	WAYS		;W	specify half/full duplex
	FLIPCO		;O	set/clear CO mode
	FLIPBS		;S	change DEL to BS translation mode
	SETWID		;M	set right margin
	CHGCC		;Q	squelch/unsquelch typeout of a control char
	VIDESC		;V	enable/disable Vidtex ESC sequence convention
	ENBLAB		;E	enable A or B protocol
	LCOMMD		;L	enable/disable auto send LF after CR
	GETADR		;I	specify serial interface addresses
	SETRAT		;B	set baud rate
	CHGLYZ		;Z	enable/disable octal display of control chars
	DELAY		;^I	<TAB> delay for approx. 233 ms.
	DISCON		;^Z	disconnect (DL11E only), restart pgm.
	SENDLF		;<LF>	send a linefeed (only valid if BUFTT true)
;
CMDTBL:	.BYTE	'0,'1,'2,'3,'4,'5,'6,'7,'8,'9
	.BYTE	'?,'D,'F,'K,'R,'T,'Y,'X,'C,'P
	.BYTE	'A,'N,'W,'O,'S,'M,'Q,'V
EABCMD:	.BYTE	DEL	;changed to 'E if B protocol module linked in
	.BYTE	'L,'I,'B,'Z,HT,26.
LFCMND:	.BYTE	200	;changed to LF if BUFTT true
	.BYTE	200
;
HELP1:	.BYTE	CR,LF
	.ASCII	"To configure program or invoke features, type command prefix "
	.ASCII	"followed by--"
	.ASCII	<CR><LF>"R  -- Record in file           T  -- Transmit file"
	.ASCII	" (Ctrl-C aborts)"
	.ASCII	<CR><LF>"D  -- Close recording file     X  -- Exit program"
	.ASCII	<CR><LF>"F  -- Select file filter       Y  -- Select file "
	.ASCII	"transmit throttle option"
	.ASCII	<CR><LF>"A1 -- Auto LF on received CR   A0 -- No auto LF "
	.ASCII	"on received CR"
	.ASCII	<CR><LF>"L1 -- Auto-send LF after CR    L0 -- No auto-send "
	.ASCII	"LF after CR"
	.ASCII	<CR><LF>"C  -- Change command prefix    K  -- Transmit 'break'"
	.ASCII	<CR><LF>"PE -- Check for even parity    PO -- Check for odd "
	.ASCII	"parity"
	.ASCII	<CR><LF>"PN -- No parity checking       M  -- Set right margin"
	.ASCII	<CR><LF>"W1 -- Set half duplex (HDX)    W2 -- Set full duplex"
	.ASCII	<CR><LF>"W0 -- HDX but CR echos LF      O  -- Enable/disable"
	.ASCII	" COnference mode"
	.ASCII	<CR><LF>"n  -- Invoke function key #n   N  -- Display and/or "
	.ASCII	"(re)define function key"
	.ASCII	<CR><LF>"S1 -- Send BS when DEL typed   S0 -- Send DEL when"
	.ASCII	" DEL typed"
	.ASCII	<CR><LF>"Q1 -- Squelch a rcvd CTRL char Q0 -- Unsquelch a "
	.ASCII	"received CTRL character"
	.ASCII	<CR><LF>"V1 -- Enable Vidtex emulation  V0 -- Disable Vidtex"
	.ASCII	" (trademark CompuServe, Inc.)"<200>
HELP2:	.ASCII	<CR><LF>'EB -- Enable "B" xfer protocol EA -- Enable "A" xfer'
	.ASCII	' protocol'<200>
HELP3:	.ASCII	<CR><LF>"I  -- Specify serial interface B  -- Set baud rate "
	.ASCII	"(DL11E-type interface only)"
	.ASCII	<CR><LF>"TAB-- Delay approx 233 ms.     ^Z -- (Ctrl-Z) "
	.ASCII	"Disconnect (DL11-E), restart pgm."
	.ASCII	<CR><LF>"Z1 -- Display ctrl chars octal Z0 -- Normal ctrl char"
	.ASCIZ	" handling"
LFHELP:	.ASCII	"[LF]- Send a linefeed"
	.ASCIZ	" (Typing [LF] without command prefix sends Ctrl-S/Ctrl-Q)"
	.EVEN
	.PAGE
;
; Table of control character filter masks, each 32 bits long.  Each bit set
; masks the corresponding ascii code, where LSB masks nul.  Exception: MSB
; (corresponding to ascii 31.) masks DEL (not US).  The selected mask
; controls filtering of control characters from uploaded files.
;

	.MACRO	.MAKMSK	.HOW,.CC1,.CC2,.CC3
	HI=0
	LO=0
	.IF NB	.CC1
	.IIF EQ	.CC1,	LO=LO!000001
	.ENDC
	.IF NB	.CC2
	.IIF EQ	.CC2,	LO=LO!000001
	.ENDC
	.IF NB	.CC3
	.IIF EQ	.CC3,	LO=LO!000001
	.ENDC
	.IIF EQ <.CC1-01>*<.CC2-01>*<.CC3-01>,	LO=LO!000002
	.IIF EQ <.CC1-02>*<.CC2-02>*<.CC3-02>,	LO=LO!000004
	.IIF EQ <.CC1-03>*<.CC2-03>*<.CC3-03>,	LO=LO!000010
	.IIF EQ <.CC1-04>*<.CC2-04>*<.CC3-04>,	LO=LO!000020
	.IIF EQ <.CC1-05>*<.CC2-05>*<.CC3-05>,	LO=LO!000040
	.IIF EQ <.CC1-06>*<.CC2-06>*<.CC3-06>,	LO=LO!000100
	.IIF EQ <.CC1-07>*<.CC2-07>*<.CC3-07>,	LO=LO!000200
	.IIF EQ <.CC1-10>*<.CC2-10>*<.CC3-10>,	LO=LO!000400
	.IIF EQ <.CC1-11>*<.CC2-11>*<.CC3-11>,	LO=LO!001000
	.IIF EQ <.CC1-12>*<.CC2-12>*<.CC3-12>,	LO=LO!002000
	.IIF EQ <.CC1-13>*<.CC2-13>*<.CC3-13>,	LO=LO!004000
	.IIF EQ <.CC1-14>*<.CC2-14>*<.CC3-14>,	LO=LO!010000
	.IIF EQ <.CC1-15>*<.CC2-15>*<.CC3-15>,	LO=LO!020000
	.IIF EQ <.CC1-16>*<.CC2-16>*<.CC3-16>,	LO=LO!040000
	.IIF EQ <.CC1-17>*<.CC2-17>*<.CC3-17>,	LO=LO!100000
	.IIF EQ <.CC1-20>*<.CC2-20>*<.CC3-20>,	HI=HI!000001
	.IIF EQ <.CC1-21>*<.CC2-21>*<.CC3-21>,	HI=HI!000002
	.IIF EQ <.CC1-22>*<.CC2-22>*<.CC3-22>,	HI=HI!000004
	.IIF EQ <.CC1-23>*<.CC2-23>*<.CC3-23>,	HI=HI!000010
	.IIF EQ <.CC1-24>*<.CC2-24>*<.CC3-24>,	HI=HI!000020
	.IIF EQ <.CC1-25>*<.CC2-25>*<.CC3-25>,	HI=HI!000040
	.IIF EQ <.CC1-26>*<.CC2-26>*<.CC3-26>,	HI=HI!000100
	.IIF EQ <.CC1-27>*<.CC2-27>*<.CC3-27>,	HI=HI!000200
	.IIF EQ <.CC1-30>*<.CC2-30>*<.CC3-30>,	HI=HI!000400
	.IIF EQ <.CC1-31>*<.CC2-31>*<.CC3-31>,	HI=HI!001000
	.IIF EQ <.CC1-32>*<.CC2-32>*<.CC3-32>,	HI=HI!002000
	.IIF EQ <.CC1-33>*<.CC2-33>*<.CC3-33>,	HI=HI!004000
	.IIF EQ <.CC1-34>*<.CC2-34>*<.CC3-34>,	HI=HI!010000
	.IIF EQ <.CC1-35>*<.CC2-35>*<.CC3-35>,	HI=HI!020000
	.IIF EQ <.CC1-36>*<.CC2-36>*<.CC3-36>,	HI=HI!040000
	.IIF EQ <.CC1-DEL>*<.CC2-DEL>*<.CC3-DEL>,	HI=HI!100000
	.IIF EQ	.HOW-FILTER,	.WORD	LO,HI
	.IIF EQ	.HOW-PASS,	.WORD	^C<LO>,^C<HI>
	.ENDM
FILTER=1
PASS=2

CTLMSK:	.MAKMSK	FILTER		;'0' - transmit all characters (mask none)
	.MAKMSK	FILTER,NUL,LF,DEL	;'1'
	.MAKMSK	FILTER,NUL,LF		;'2'
	.MAKMSK	FILTER,NUL,DEL		;'3'
	.MAKMSK	FILTER,LF,DEL		;'4'
	.MAKMSK	FILTER,LF		;'5'
	.MAKMSK	PASS,CR		;'6' - no control chars. except cr
	.MAKMSK	PASS,CR,LF	;'7' - no control chars. except cr, lf
SOPMAX=<.-CTLMSK>/4 - 1
	.PAGE
;
; parity table
;
P=377
	.MACRO	.PTMP1
	.BYTE	0,P,P,0,P,0,0,P
	.BYTE	P,0,0,P,0,P,P,0
	.BYTE	P,0,0,P,0,P,P,0
	.BYTE	0,P,P,0,P,0,0,P
	.ENDM
	.MACRO	.PTMP2
	.BYTE	P,0,0,P,0,P,P,0
	.BYTE	0,P,P,0,P,0,0,P
	.BYTE	0,P,P,0,P,0,0,P
	.BYTE	P,0,0,P,0,P,P,0
	.ENDM
EVNPAR:	.PTMP1
	.PTMP2
	.PTMP2
	.PTMP1
	.PAGE
;
; misc messages not assembled via macros
;
INSTRC:	.ASCII	<CR><LF>"COMM-I-For list of commands, enter command prefix then"
	.ASCII	' "?"'
SHOWCC:	.ASCII	<CR><LF>"COMM-I-Current command prefix is: Ctrl-"
CCLETR:	.BYTE	'N,0
MSGRDY:	.ASCII	"COMM-I-Version "
	.BYTE	VERSON,'.,SUBVER
	.ASCIZ	", Ready"
;
SUPMSG:	.ASCII	<CR><LF>"==>Specify which control characters"
	.ASCII	" to filter out when transmitting files--"<CR><LF>
	.ASCII	"==>0-none    1-NUL,LF,DEL  2-NUL,LF      3-NUL,DEL"<CR><LF>
	.ASCII	"==>4-LF,DEL  5-LF          6-all but CR  7-all but CR, LF"
	.BYTE	200
;
RATMSG:	.BYTE	CR,LF
	.ASCII	"==> A:  50     E:  150    I: 1800    M:  4800"<CR><LF>
	.ASCII	"==> B:  75     F:  300    J: 2000    N:  7200"<CR><LF>
	.ASCII	"==> C: 110     G:  600    K: 2400    O:  9600"<CR><LF>
	.ASCII	"==> D: 134.5   H: 1200    L: 3600    P: 19200"<CR><LF>
	.ASCII	"==>Enter letter for baud rate: "<200>
;
THRMSG:	.ASCII	<CR><LF>"==>"
	.ASCII	"           ---------------(after sending),"
	.ASCII	"(wait to receive)---------------"<CR><LF>
	.ASCII	"==>0-no wait  1-(each),(echo)  2-(CR),(CR)  "
	.ASCII	"3-(CR),(LF)  4-(CR),(prompt char)"<CR><LF>
	.ASCII	"==>5-controlled by receipt of XON/XOFF <ctrl-Q/ctrl-S>"<200>
;
BSECHO:	.BYTE	BS,SPC,BS,200
	.EVEN
;
	.END START