Google
 

Trailing-Edge - PDP-10 Archives - BB-M081Y-SM - monitor-sources/cthsrv.mac
There are 17 other files named cthsrv.mac in the archive. Click here to see a list.
; Edit= 9148 to CTHSRV.MAC on 21-Feb-90 by GSCOTT
;Update copyright date. 
; Edit= 9091 to CTHSRV.MAC on 17-May-89 by JROSSELL
;If a terminal is set to width 0 and the server is a VMS system, then don't
;send a CHARACTERISTICS message. VMS reports a QIO error. 
; Edit= 9076 to CTHSRV.MAC on 6-Mar-89 by JROSSELL
;VMS servers do not support lower case input control (TT%LIC) so always insure
;that this bit is not set when sending a CHARACTERISTICS message to a VMS
;server. 
; Edit= 9065 to CTHSRV.MAC on 30-Jan-89 by JROSSELL, for SPR #21562
;If MSGOUT returns failure don't assume that the link has gone away. Instead,
;also check if the message may have been blocked. 
; Edit= 9044 to CTHSRV.MAC on 20-Dec-88 by RASPUZZI
;Make accommodations for cretinous operating systems (like VMS 4.7 or less)
;and strip out trailing spaces in the username that comes in the CTERM connect
;intiate message.
; Edit= 9041 to CTHSRV.MAC on 13-Dec-88 by RASPUZZI
;Finish off some of the security features that were started at one time (like
;password expiration). Also, add new features to help a system manager secure
;the system.
; Edit= 9024 to CTHSRV.MAC on 8-Nov-88 by LOMARTIRE
;Merge Production changes to BUG text
; Edit= 8986 to CTHSRV.MAC on 28-Oct-88 by JROSSELL, for SPR #21549
;Correct some problems with SET TERMINAL characteristics 
; Edit= 8977 to CTHSRV.MAC on 4-Oct-88 by JROSSELL, for SPR #21689
;Add support for optionally not flushing NULs when a terminal is in ASCII
;mode. 
; Edit= 8963 to CTHSRV.MAC on 6-Sep-88 by JROSSELL, for SPR #21696
;Correct edit 8961 to update the duplex mode only if such a request was made. 
; Edit= 8961 to CTHSRV.MAC on 3-Sep-88 by JROSSELL, for SPR #21696
;Cause routine CTHSRV to also check for duplex mode changes. 
; Edit= 8878 to CTHSRV.MAC on 10-Aug-88 by RASPUZZI
;Update BUG. documentation. 
; UPD ID= 8497, RIP:<7.MONITOR>CTHSRV.MAC.5,   9-Feb-88 12:18:46 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8467, RIP:<7.MONITOR>CTHSRV.MAC.4,   9-Feb-88 11:14:01 by MCCOLLUM
;TCO 7.1209 - Fix LOKWAI scheduler test to wake up if link is not .NSSRN
; UPD ID= 51, RIP:<7.MONITOR>CTHSRV.MAC.3,  27-Jul-87 16:14:16 by MCCOLLUM
;TCO 7.1024 - Move CTHSRV code to section XCDSEC
; *** Edit 7392 to CTHSRV.MAC by WADDINGTON on 17-Nov-86, for SPR #21329
; Fix bug caused by improper interpretation of CCOC value for CR. This cause
; EDT20 to drop the linefeeds after leaving change mode.
; *** Edit 7200 to CTHSRV.MAC by MELOHN on 18-Nov-85 (TCO 6.1.1560)
; Make CTERM respond faster to ^O 
; *** Edit 7199 to CTHSRV.MAC by MELOHN on 18-Nov-85 (TCO 6.1.1559)
; Make ^C at the end of a multi-line TEXTI% clear the host input buffer
; *** Edit 7183 to CTHSRV.MAC by MELOHN on 5-Nov-85 (TCO 6-1-1550)
; Rewrite routine CTHSPR to send only JFN mode word flags related to lowercase
; UPD ID= 2294, SNARK:<6.1.MONITOR>CTHSRV.MAC.56,  15-Jul-85 15:02:55 by PALMIERI
;TCO 6.1.1481  When releasing CTERM buffer at MSGPE3 wrong AC is used for
;pointer to CBD 
; UPD ID= 2268, SNARK:<6.1.MONITOR>CTHSRV.MAC.55,  21-Jun-85 20:46:12 by NICHOLS
;Fix to 2267
; UPD ID= 2267, SNARK:<6.1.MONITOR>CTHSRV.MAC.54,  21-Jun-85 17:35:40 by MELOHN
;TCO 6.1.1470 - Don't request a read if there's no room for more input
; UPD ID= 2260, SNARK:<6.1.MONITOR>CTHSRV.MAC.53,  21-Jun-85 11:23:41 by WAGNER
;TCO 6.1.1449 - **PERFORMANCE** Prevent CTERM HOST output from hogging system
; UPD ID= 2255, SNARK:<6.1.MONITOR>CTHSRV.MAC.52,  20-Jun-85 21:49:39 by MELOHN
; More of last edit; fix case where DOS gets bad RBFLEN (T3 clobbered)
; UPD ID= 2251, SNARK:<6.1.MONITOR>CTHSRV.MAC.51,  19-Jun-85 20:49:06 by MELOHN
;TCO 6.1.1465 - Fix DECNET-DOS related problems in LOKCDB and GETIMG
;TCO 6.1.1464 - Add routines to support ^R buffer on remote texti
; UPD ID= 2014, SNARK:<6.1.MONITOR>CTHSRV.MAC.50,  28-May-85 11:44:39 by MCCOLLUM
;TCO 6.1.1238 - Fix CTDPRR documentation.
; UPD ID= 1980, SNARK:<6.1.MONITOR>CTHSRV.MAC.48,  15-May-85 19:25:32 by MELOHN
;Fix LOKCDB to always return T2 (TDB address) intact.
;TCO 6.1.1390 - more of TCO 6.1.1370 - don't EVER lock or unlock the TDB.
; UPD ID= 1918, SNARK:<6.1.MONITOR>CTHSRV.MAC.47,   7-May-85 17:58:38 by MELOHN
;TCO 6.1.1371 - put dead CDBs in .STDEL state and let CTMFRK deallocate them.
;TCO 6.1.1370 - don't unlock the TDB in LOKCDB
; UPD ID= 1812, SNARK:<6.1.MONITOR>CTHSRV.MAC.46,  24-Apr-85 14:51:49 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1811, SNARK:<6.1.MONITOR>CTHSRV.MAC.45,  24-Apr-85 14:37:08 by MELOHN
;TCO 6.1.1317 - Put CTHOOE in RESCD, since it can be called from sched level.
; Give CTERM fork system priority - when it's gotta go, it's gotta go.
;TCO 6.1.1316 - Break CTMMSG into two seperate foundation msgs for VMS.
; UPD ID= 1591, SNARK:<6.1.MONITOR>CTHSRV.MAC.44,   5-Mar-85 18:03:46 by GLINDELL
;TCO 6.1.1233 - do the right things when logins are not allowed
; UPD ID= 1393, SNARK:<6.1.MONITOR>CTHSRV.MAC.43,  22-Jan-85 20:58:58 by MELOHN
; TCO 6.1.1150 - Add sched test CTMTST called by CTMLOP instead of 100ms DISMS%
; UPD ID= 1208, SNARK:<6.1.MONITOR>CTHSRV.MAC.42,  13-Dec-84 16:31:49 by MELOHN
;TCO 6.1.1089 - Remove call to ULKTTY at LOKCD1.
; UPD ID= 1140, SNARK:<6.1.MONITOR>CTHSRV.MAC.41,   3-Dec-84 17:27:48 by GLINDELL
;D36COM is now in XCDSEC
; UPD ID= 1114, SNARK:<6.1.MONITOR>CTHSRV.MAC.40,  20-Nov-84 16:02:14 by PRATT
;TCO 6.1.1040 - Fix pause/unpause char echoing, don't use the smashed AC
; UPD ID= 1098, SNARK:<6.1.MONITOR>CTHSRV.MAC.39,  19-Nov-84 15:30:55 by MELOHN
;TCO 6.1.1058 - Fix CTHNGU to accept tty line number instead of TDB address.
;Replace TDCALL CTHLGO with CTHNGU - called from TTYSRV on hangup.
;Make FNDSHU send unbind request msg to server when shutting down line.
; UPD ID= 1019, SNARK:<6.1.MONITOR>CTHSRV.MAC.38,   9-Nov-84 15:56:28 by PRATT
;More TCO 6.1.1022 - More of last edit
;  Fix bad byte pointer when no host number
;  Set no known node name when SCTA2N fails or no host number
; UPD ID= 982, SNARK:<6.1.MONITOR>CTHSRV.MAC.37,   7-Nov-84 08:18:01 by PRATT
;More TCO 6.1.1022 - Fix problem with bad byte pointer if SCTA2N fails
; UPD ID= 937, SNARK:<6.1.MONITOR>CTHSRV.MAC.36,  29-Oct-84 01:38:29 by PRATT
;More TCO 6.1.1022 - Remove unnecessary ENDSV. in previous edit
; UPD ID= 931, SNARK:<6.1.MONITOR>CTHSRV.MAC.35,  28-Oct-84 11:28:44 by PRATT
;TCO 6.1.1022 - Read connect info, save the remote node addr for NTINF
; UPD ID= 842, SLICE:<6.1.MONITOR>CTHSRV.MAC.31,  28-Sep-84 15:22:43 by WEISBACH
;In CTMWRI, set flags to always do transparent output since TT%DAM is not
; always set to the desired data mode (e.g. if TTY is opened with bytes size
; of 8,; the monitor does binary output irrespective of the TT%DAM setting.)
; All translation should have been done by now anyway.
; UPD ID= 748, SNARK:<6.1.MONITOR>CTHSRV.MAC.29,  20-Aug-84 17:40:56 by WEISBACH
;Add ability to selectively send line width characteristics message based on
; server id since VMS for example does not like it (QIO error with bad
; parameter message).
; UPD ID= 727, SNARK:<6.1.MONITOR>CTHSRV.MAC.28,   3-Aug-84 18:04:38 by WEISBACH
;In START READ message flags, if SR%XEC (no echo) is set, do not set SR%TEC
;(terminator echo): make sure the test of TT%ECO is done before test for
;binary mode.
; UPD ID= 711, SNARK:<6.1.MONITOR>CTHSRV.MAC.27,  26-Jul-84 08:30:09 by MCINTEE
;Add CTERM - NRT support
; UPD ID= 704, SNARK:<6.1.MONITOR>CTHSRV.MAC.26,  24-Jul-84 15:29:04 by MCINTEE
;Linked terminals
;Register bug in CTHCKI
; UPD ID= 687, SNARK:<6.1.MONITOR>CTHSRV.MAC.25,  16-Jul-84 14:12:26 by MCINTEE
;Preserve T2 in CTHSTO
;Implement page stop, width, length, and terminal type.
;
;Rewrite.

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
        SEARCH	PROLOG
	SALL
	TTITLE	CTHSRV,,< - CTERM Host Terminal Support>
	SEARCH	TTYDEF		;TTY SYMBOLS
	SEARCH	CTERMD		;CTERM SYMBOLS
	SEARCH	SCPAR,D36PAR	;DECNET SYMBOLS

	EXTERN TTPSI2,GPSICD
	Subttl	Table of Contents

;		     Table of Contents for CTHSRV
;
;				  Section		      Page
;
;
;    1. MACROS . . . . . . . . . . . . . . . . . . . . . . . .   6
;    2. DEFINITIONS  . . . . . . . . . . . . . . . . . . . . .   7
;    3. CTERM HOST FORK START UP . . . . . . . . . . . . . . .   8
;    4. CTERM SCHEDULER TEST . . . . . . . . . . . . . . . . .   9
;    5. CTERM HOST FORK  . . . . . . . . . . . . . . . . . . .  10
;    6. CLOCK LEVEL
;        6.1    HANDLE QUEUED CTERM LINES  . . . . . . . . . .  11
;        6.2    HANDLE THE QUEUED DECNET LINKS . . . . . . . .  12
;    7. DECNET LAYER
;        7.1    SERVICE QUEUED LINK  . . . . . . . . . . . . .  13
;            7.1.1    EASY STATES  . . . . . . . . . . . . . .  14
;            7.1.2    RUN STATE  . . . . . . . . . . . . . . .  15
;            7.1.3    CONNECT RECEIVED STATE . . . . . . . . .  16
;        7.2    RELEASE CDB STORAGE  . . . . . . . . . . . . .  17
;        7.3    ATTENTION INTERRUPT FROM DECNET  . . . . . . .  18
;        7.4    SEND FOUNDATION MESSAGE  . . . . . . . . . . .  19
;        7.5    INTERFACE TO DECNET-36 . . . . . . . . . . . .  20
;        7.6    SET UP NEW LISTENER  . . . . . . . . . . . . .  21
;        7.7    SET UP CONNECT BLOCK . . . . . . . . . . . . .  22
;        7.8    ATTEMPT TO UNBLOCK THE BLOCKED LINK  . . . . .  23
;        7.9    INITIALIZE THE SAB . . . . . . . . . . . . . .  24
;        7.10   RELEASE LINK . . . . . . . . . . . . . . . . .  25
;    8. FOUNDATION LAYER
;        8.1    SHUTTING DOWN  . . . . . . . . . . . . . . . .  26
;        8.2    CONNECTION ESTABLISHED . . . . . . . . . . . .  27
;        8.3    GET A FREE CTERM LINE  . . . . . . . . . . . .  28
;        8.4    GET MESSAGE BUFFER FOR CTERM . . . . . . . . .  29
;        8.5    SEND COMMON DATA MESSAGE . . . . . . . . . . .  30
;        8.6    MESSAGE RECEIVED . . . . . . . . . . . . . . .  31
;            8.6.1    BIND ACCEPT  . . . . . . . . . . . . . .  32
;            8.6.2    COMMON/MODE DATA . . . . . . . . . . . .  33
	Subttl	Table of Contents (page 2)

;		     Table of Contents for CTHSRV
;
;				  Section		      Page
;
;
;    9. CTERM LAYER
;        9.1    INITIALIZE A CTERM CONNECTION  . . . . . . . .  34
;        9.2    RUN STATE  . . . . . . . . . . . . . . . . . .  35
;        9.3    SEND OUTPUT MESSAGE NOW  . . . . . . . . . . .  36
;        9.4    HEADER FOR CTERM WRITE MESSAGE . . . . . . . .  38
;        9.5    RECEIVED MESSAGE . . . . . . . . . . . . . . .  39
;            9.5.1    INITIATE MESSAGE . . . . . . . . . . . .  40
;            9.5.2    INPUT STATE MESSAGE  . . . . . . . . . .  41
;            9.5.3    READ DATA MESSAGE  . . . . . . . . . . .  42
;                9.5.3.1    UPDATE POSITION  . . . . . . . . .  44
;            9.5.4    OUT-OF-BAND MESSAGE  . . . . . . . . . .  46
;            9.5.5    DISCARD STATE MESSAGE  . . . . . . . . .  47
;        9.6    TDCALL
;            9.6.1    SET UP TERMINAL BUFFERS  . . . . . . . .  48
;            9.6.2    GET INPUT BUFFER COUNT . . . . . . . . .  49
;            9.6.3    HANGUP ROUTINE . . . . . . . . . . . . .  50
;            9.6.4    SEND OUT-OF-BAND SETTINGS  . . . . . . .  51
;            9.6.5    OUTPUT OR ECHO ? . . . . . . . . . . . .  52
;            9.6.6    CHANGE MODE TO ASCII . . . . . . . . . .  53
;            9.6.7    CHANGE MODE TO BINARY  . . . . . . . . .  54
;            9.6.8    STTYP% JSYS  . . . . . . . . . . . . . .  55
;            9.6.9    STPAR% JSYS  . . . . . . . . . . . . . .  56
;            9.6.10   SFMOD% JSYS  . . . . . . . . . . . . . .  57
;            9.6.11   CFIBF% JSYS  . . . . . . . . . . . . . .  58
;            9.6.12   MTOPR% JSYS
;                9.6.12.1   SET/CLEAR PAGE STOP  . . . . . . .  59
;                9.6.12.2   SET TERMINAL SPEED . . . . . . . .  60
;                9.6.12.3   SET TERMINAL WIDTH . . . . . . . .  61
;                9.6.12.4   SET TERMINAL LENGTH  . . . . . . .  62
;                9.6.12.5   SET BREAK MASK . . . . . . . . . .  63
;            9.6.13   CHANGE TERMINAL PAUSE/UNPAUSE CHARACTERS  64
;            9.6.14   START OUTPUT . . . . . . . . . . . . . .  65
;            9.6.15   ENABLE/DISABLE XON/XOFF RECOGNITION  . .  66
;            9.6.16   FORCE OUTPUT . . . . . . . . . . . . . .  67
;            9.6.17   GET INPUT  . . . . . . . . . . . . . . .  68
;            9.6.18   GET INPUT FOR NRT  . . . . . . . . . . .  69
;        9.7    MTOPR% JSYS
;            9.7.1    ENABLE REMOTE EDITING  . . . . . . . . .  70
;        9.8    SEND START READ
;            9.8.1    ENTRY  . . . . . . . . . . . . . . . . .  71
;            9.8.2    SET UP MAXIMUM LENGTH  . . . . . . . . .  72
;            9.8.3    SET UP TERMINATOR SET  . . . . . . . . .  73
;            9.8.4    PUT ^R BUFFER IN MESSAGE . . . . . . . .  74
;            9.8.5    SEND UNREAD MESSAGE  . . . . . . . . . .  75
;        9.9    CHECK CCOC WORDS . . . . . . . . . . . . . . .  76
	Subttl	Table of Contents (page 3)

;		     Table of Contents for CTHSRV
;
;				  Section		      Page
;
;
;   10. SYSTEM INITIALIZATION
;       10.1    ENTRY  . . . . . . . . . . . . . . . . . . . .  78
;       10.2    CTERM DATA BASE  . . . . . . . . . . . . . . .  79
;       10.3    SWAP TABLE . . . . . . . . . . . . . . . . . .  80
;   11. UTILITY ROUTINES
;       11.1    SET UP FOR CHARACTERISTIC MESSAGE  . . . . . .  81
;       11.2    SEND CHARACTERISTIC  . . . . . . . . . . . . .  82
;       11.3    SET ATTRIBUTE  . . . . . . . . . . . . . . . .  83
;       11.4    SET CHARACTER ATTRIBUTE  . . . . . . . . . . .  84
;       11.5    PROTOCOL ERROR . . . . . . . . . . . . . . . .  85
;       11.6    REQUEST DELETE CDB . . . . . . . . . . . . . .  86
;       11.7    REQUEST SERVICE  . . . . . . . . . . . . . . .  87
;       11.8    Identify CTERM terminal type (.MOCTM)  . . . .  88
;       11.9    Get prompt string from user byte pointer . . .  89
;       11.10   LOCK CDB . . . . . . . . . . . . . . . . . . .  90
;   12. Fetch User from DECnet Connect Message . . . . . . . .  93
;   13. Get ACJ Blessing For Incoming CTERM Connection . . . .  94
;   14. TERMINAL TYPE TRANSLATION TABLE  . . . . . . . . . . .  96
;   15. STOCK MESSAGES . . . . . . . . . . . . . . . . . . . .  97
;   16. PERMANENT CTERM DATA BASE  . . . . . . . . . . . . . .  98
;   17. End of CTHSRV  . . . . . . . . . . . . . . . . . . . .  99
	SUBTTL MACROS
;Get one byte from a message, with error check
;PTR - byte pointer to current byte of message
;COUNT - number of bytes left in the message
;REG - register where next byte is to go.
;Updates PTR, COUNT, and REG
DEFINE GET1BY (PTR,COUNT,REG)<
	SOSGE COUNT
	JRST CTMPER
	ILDB REG,PTR
>;END GET1BY

;Get a two byte value (PDP-11 style) from a message, with error check
;PTR - byte pointer to current byte of message
;COUNT - number of bytes left in the message
;REG - register where next byte is to go.
;Updates PTR, COUNT, and REG
;Uses CX
DEFINE GET2BY (PTR,COUNT,REG)<
	SOS COUNT
	SOSGE COUNT
	JRST CTMPER
	ILDB CX,PTR
	ILDB REG,PTR
	LSH REG,10
	IOR REG,CX
>;END GET2BY

;Put a 2 byte value (PDP-11 style) into a message.
;PTR - byte pointer
;REG - register where value resides
DEFINE PUT2BY (PTR,REG)<
	IDPB REG,PTR
	LSH REG,-10
	IDPB REG,PTR
>;END PUT2BY
	SUBTTL DEFINITIONS
DEFAC (CDB,P1)			;Address of CTERM data block

FTCOUN==1			;Feature test - KEEP COUNT OF THINGS
	SUBTTL CTERM HOST FORK START UP 

	XRESCD			;[7.1024]

;Create CTERM host fork
;CALL CTMRUN with no arguments
;Returns +1 always
CTMRUN: MOVX T1,CR%CAP		;Create a fork
	CFORK%			;Do it
	 ERJMP CTMRNX		;Couldn't.
	XMOVEI T2,CTMLOP	;Where to proceed
	MSFRK%			;Continue things below
	 ERJMP CTMRNX		;Failed.
	RET
CTMRNX:	BUG.(CHK,CTDFRK,MEXEC,SOFT,<Cannot create CTERM fork>,,<

Cause:	The CTERM system fork could not be created and started at system
	startup.
>)
	RET
	SUBTTL CTERM SCHEDULER TEST

	RESCD			;[7.1024]SCHEDULER TESTS ALWAYS IN RESCD

; Scheduler test that wakes up whenever the CTERM fork has something
; useful to do.

CTMTST:	SKIPG MSGCWL		;Is there anyone listening ?
	RETSKP			;Yes.
	SKIPE MSGBLW		;Is there a link blocked on output ?
	RETSKP			;Yes.
	SKIPE CTMATN		;Are there queued CTERM lines ?
	RETSKP			;Yes.
	SKIPE MSGATN		;Are there queued DCN links?
	RETSKP			;Yes.
	RET
	SUBTTL CTERM HOST FORK

	XSWAPCD			;[7.1024]

; Opens another listener if needed.
; Tries to unblock the blocked link, if there is one.
; Services the output requests
; Services the queued DECnet requests

CTMLOP: MOVX T1,USRCTX		;Start with user context set
	MOVEM T1,FFL
	MCENTR			;Start a new process
	MOVX T1,<JP%SYS!1B35>	; GET THE SYS BIT
	MOVEM T1,JOBBIT		; MAKE SURE WE CAN GO FAST
	MOVE T1,FORKX		;GET FORK NUMBER
	MOVEM T1,CTMFRK		;RECORD IT
	UNLOCK CTMLOK		;Initialize CTERM system lock
        DO.			;Infinite loop
	  MOVEI T1,CTMTST	;Set up addr of scheduler test
	  MDISMS
	  LOCK CTMLOK		;Get CTERM lock
	  CSKED			;High priority
	  SKIPG MSGCWL		;Is there anyone listening ?
	  CALL MSGPAS		;No. Start up a listener.
	  SKIPE MSGBLW		;Is there a link blocked on output ?
	  CALL MSGUBK		;Yes. Attempt to unblock it.
	  SKIPN MSGBLW		;Can output be done ?
	  CALL CTMOUT		;Yes. Service queued output requests.
	  CALL MSGDCN		;Service the queued DECnet events.
	  UNLOCK CTMLOK		;Release CTERM lock
	  ECSKED		;End high priority
	  LOOP.			;Continue.
	ENDDO.
	SUBTTL CLOCK LEVEL -- HANDLE QUEUED CTERM LINES
;Handle all queued output requests until one gets blocked or all are serviced.
;CALL CTMOUT with no arguments
;Returns +1 always
CTMOUT:	SAVEAC <Q1,Q2,Q3,CDB,P2> ;Use the Qs for scanning the table,
	SETZM CTMATN		;Clear scheduler test word
CTMOU0:	MOVSI Q1,-CHSQWD	;Set up number of words to check
CTMOU1:	SKIPE Q2,CHSOQ(Q1)	;Any queued lines in this word?
CTMOU2:	JFFO Q2,CTMOU3		;Yes - Get it (index is in Q3)
	AOBJN Q1,CTMOU1		;Loop through all words
	RET			;Done.

;Here when there is a service request for a CTERM line.
CTMOU3:	TDZ Q2,BITS(Q3)		;Clear this request for this pass.
 	HRRZ T3,Q1		;Compute 
	IMULI T3,^D36		; the
	MOVE T2,Q3		; real
	ADD T2,T3		; line
	ADD T2,TT1LIN+TT.CTH	; number
	MOVE T1,BITS(Q3)	;Clear the output request for 
	ANDCAM T1,CHSOQ(Q1) 	; this line.  (will be set if needed later)
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Is this line active ?
	 JRST CTMOU2		;No. Continue scan
	SKIPN CDB,TTDEV(T2)	;Yes. Is there a CTERM data block ?
	JRST CTMOU2		;No. Continue scan
	LOAD T1,CHSTA,(CDB)	;Yes. Get CTERM state.                  
	CALL @CTMDTB(T1)	;(CDB) Dispatch on state.
	IFNSK.
          MOVE T1,BITS(Q3)	;Didn't complete. Set the output request for 
	  IORM T1,CHSOQ(Q1) 	; this line.  (Avoid race this way)
	ENDIF.
	SKIPN MSGBLW		;Did output block ?
	JRST CTMOU2		;No. Continue scan of output request table
	RET			;Yes. Exit the scan now.

CTMDTB:	XADDR. FNDMAK		;[7.1024]0 .STINI - "initializing"
	XADDR. CTMINI		;[7.1024]1 .STFND - "foundation started"
	XADDR. CTMRNG		;[7.1024]2 .STRUN - "running"
	XADDR. FNDSHU		;[7.1024]3 .STSHU - "shutting down"
	XADDR. MSGREL		;[7.1024]4 .STDEL - "Deleting the CDB"
CTMDTL==.-CTMDTB		;Length of table
	SUBTTL CLOCK LEVEL -- HANDLE THE QUEUED DECNET LINKS

;Scan CTERM's DECnet queue & dispatch on channel status to handle the request
;CALL MSGDCN with no arguments, with CTERM locked
;Returns +1 always
MSGDCN:	SAVEAC <CDB,P2>		;P2/ CTERM SAB address
	SETZM MSGATN		;Clear scheduler test word
	CALL INISAB		;(/T1) Get SAB
	MOVE P2,T1    		;Point to the CTERM SAB.
	DO.
          LOAD T1,SASJB,(P2)	;Point to the CTERM SJB.
	  CALL <XENT SCTPSQ>	;[7.1024](T1/T1,T2) Read a request off the queue.
	   RET           	;None left. Done.
	  LOAD CDB,PSCHN,+T1	;Get address 
	  ADD CDB,CTHCHP	; of this 
	  SKIPN CDB,(CDB)	; channel's CDB.
	  RET			;None, done.
	  LOAD T1,PSSTS,+T1	;Get the status.
	  STOR T1,CHSTS,(CDB)	;Stash it in the CDB.
	  LOAD T3,NSSTA,+T1	;Get the link's state.
	  CALL @MSGTBL(T3)	;(T1,CDB) Dispatch according DECnet link state.
	  LOOP.      		;Continue processing.
	ENDDO.
	SUBTTL DECNET LAYER -- SERVICE QUEUED LINK

;Macro to define the dispatch table entries
;The link status .NSPxx corresponds to the dispatch address MSGDxx
DEFINE DSPADR(CODE),<
	IFN .-MSGTBL-.NSS'CODE,<PRINTX MSGTBL is in the wrong order>
	XADDR. MSGD'CODE	;;[7.1024]
>
MSGTBL:	XADDR. MSGDIL		;[7.1024]Illegal state	(BUG)
	DSPADR CW		;Connect wait		(NOOP)
	DSPADR CR		;Connect received	
	DSPADR CS		;Connect sent		(BUG)
	DSPADR RJ		;Connect rejected	(BUG)
	DSPADR RN		;Running	
	DSPADR DR		;Disconnect received	(RELEASE)
	DSPADR DS		;Disconnect sent	(NOOP)
	DSPADR DC		;Disconnect confirmed	(RELEASE)
	DSPADR CF		;No confidence		(RELEASE)
	DSPADR LK		;No link		(RELEASE)
	DSPADR CM		;No communication	(RELEASE)
	DSPADR NR		;No resources		(RELEASE)
DCNTLN==.-1-MSGTBL		;Length of dispatch table
	SUBTTL DECNET LAYER -- SERVICE QUEUED LINK -- EASY STATES

;Here for buggy states: illegal state, connect sent, connect rejected
MSGDIL:
MSGDCS:
MSGDRJ:	BUG.(CHK,CTDILS,CTHSRV,SOFT,<CTERM link is in an unexpected state>,,<

Cause:	A CTERM link is in one of these states: Connect Sent, Connect
	Rejected; or some illegal state.

Action:	The DOB% facility should produce a dump for this bug. If not,
	then you have to change the BUGCHK to a BUGHLT to get a
	dump before submitting an SPR.
>)
	RET			;DONE

;Here for noop states: connect wait, disconnect sent
MSGDCW:
MSGDDS:	RET			;Just keep waiting

;Here for states where the link or the server has gone away:
;disconnect received, disconnect confirmed, no confidence,
;no link, no communication, no resources.
;Detach the TOPS-20 terminal and release the link.
MSGDDR:
MSGDDC:
MSGDCF:
MSGDLK:
MSGDCM:
MSGDNR:	CALL CDBDEL		;(CDB) Blow link away.
	RET			;Done
	SUBTTL DECNET LAYER -- SERVICE QUEUED LINK -- RUN STATE
;Here when link was queued for attention and state is run state.
;Receive and process incoming messages.
;CALL MSGDRN
;	CTERM locked
;	T1/ DECnet status word for this link
;	CDB/ CDB address 
;Returns +1, Always
MSGDRN:	TXNN T1,NSNDA		;Is there data to read?
	RET			;No - just return.
	CALL INISAB		;(/T1) Get SAB
	LOAD T2,CHSSZ,(CDB)	;Max size of this link's CTERM buffer.
	LOAD T3,CHINC,(CDB) 	;Number of bytes currently in that buffer.
	SUB T2,T3               ;Compute the maximum length of the message
	JUMPLE T2,CTMPER	;If no room, then protocol error.
	STOR T2,SAAA1,(T1)	;Put max length in the SAB
	LOAD T4,CHIMB,(CDB) 	;Byte pointer to start of input message buffer.
	ADJBP T3,T4		;Byte pointer to start of free area in buffer.
	STOR T3,SAAA2,(T1)	;Store byte pointer in SAB
	SETZRO SAEOM,(T1)	;Can't insist on getting whole message  
				;(Lower layer requirement - see MONUSR document)
	MOVX T2,.NSFDR		;DECnet function code.
	MOVEI T3,4		;Passing 4 arguments.
	CALL MSGNSF		;(T1,T2,T3,CDB) Call DECnet
	 RET           		;Failure. Return now.
	CALL INISAB		;(/T1) Get SAB
	LOAD T2,CHSSZ,(CDB)	;Compute total number 
	OPSTR <SUB T2,>,SAAA1,(T1) ; of bytes now in buffer
	STOR T2,CHINC,(CDB)	; and remember it.
	TMNN SAEOM,(T1) 	;End of message ?
	IFSKP.
	  LOAD T1,CHIMB,(CDB)	;Yes. Point to the buffer.
	  SETZRO CHINC,(CDB)	;Clear byte count in buffer.
	  CALL FNDGET           ;(T1,T2,CDB) Call the foundation layer.
	   RET			;Failure, done.
	ENDIF.
	LOAD T1,CHSTS,(CDB)	;Get the link status.
	JRST MSGDRN 		;Try again.
	SUBTTL DECNET LAYER -- SERVICE QUEUED LINK -- CONNECT RECEIVED STATE
;Here when a connect is received.
;Call the foundation layer.
;CALL MSGDCR with:
;	CDB/ CDB address
;Returns +1 always
MSGDCR:	MOVE T1,FACTSW		;Get system switches
	TXNE T1,SF%MCB		;Allowed to log in over DECnet?
	IFSKP.			; -no,
	  MOVX T1,RSNACR	;  Get reject reason "access not permitted"
	  JRST MSGDC1		;   and go to reject routine (T1/)
	ENDIF.
	CALL FNDCON		;(CDB) Allocate foundation resources
	IFNSK.			; - failed to get resources
	  MOVX T1,RSNRES	;   so tell remote 'resource failure'
	  JRST MSGDC1		;    and go reject connect
	ENDIF.
;Successful allocation
	SETZRO CHRID,(CDB)	;Clear out remote host field
	CALL INISAB		;(/T1) Allocation succeeded. Get SAB
	MOVX T2,.NSFRI		;Read connect data
	STOR T2,SAAFN,(T1)	; is the function code
	MOVEI T2,2		;Function code and channel
	STOR T2,SANAG,(T1)	; are the arguments
	LOAD T2,CHCHL,(CDB)	;Channel number
	STOR T2,SAACH,(T1)	; is stored in SAB
	CALL <XENT SCTNSF>	;[7.1024](T1)Call lower layer
IFN FTCOUN,<
	AOS %CTMGS		;Count another DECnet call
>
	MOVE T1,CTHSAP		;Get pointer to SAB again
	OPSTR <SKIPN T1,>,SACBP,(T1) ;Try to get connect block pointer
	IFSKP.			; -yes, there was a connect block
	  LOAD T2,CBNUM,(T1)	;  and get the remote node address
	  STOR T2,CHRID,(CDB)	;   so we can now store it away
	  CALL FETUSR		;[9041](T1,CDB/) Now get NODE::USER in CH block
	  ECSKED		;[9041] Don't be a hog when waiting for ACJ
	  CALL CTMGOK		;[9041](CDB/) Now ask ACJ for a yes sir
	  IFSKP.		;[9041] If succeeded
	    CSKED		;[9041] High priority again, and go on
	  ELSE.			;[9041] ACJ said no way
	    CSKED		;[9041] Big boost
	    MOVX T1,RSNACR	;[9041] Say access denied
	    JRST MSGDC1		;[9041] And cleanup mess
	  ENDIF.		;[9041]
	ENDIF.			;The INISAB will deallocate the connect block
	CALL INISAB		;(/T1) Get SAB
	SETZRO SAAA1,(T1)	;Set no message string
	MOVEI T2,CTHMGL*CTHBPW	;Set up maximum 
	STOR T2,SAAA2,(T1)	; message size
	MOVX T2,NSF.C0		;Elect no flow control 
	STOR T2,SAAA3,(T1)	; for input
	MOVX T2,.NSFAC		;Accept the connection
	MOVEI T3,5		;Number of arguments
	CALL MSGNSF		;(T1,T2,T3,P3) Call lower layer.
	 RET              	;Failure.
	CALL INISAB		;(/T1) Get SAB
	MOVX T2,.NSFRS		;Read the link status function
	MOVEI T3,3		;Number of arguments
	CALL MSGNSF 		;(T1,T2,T3,P3) Call lower layer
	 RET            	;Failure.
	CALL INISAB		;(/T1) Point to SAB
	LOAD T2,SAAA1,(T1)	;Get the link's segment size
	CAILE T2,CTHMGL*CTHBPW	;Longer than ours?
	MOVEI T2,CTHMGL*CTHBPW	;Yes - use the minimum
	STOR T2,CHSSZ,(CDB)	;Store maximum size in the CDB
	MOVEI T2,.STINI		;Set state to 
	STOR T2,CHSTA,(CDB)	; "initializing"
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALLRET CTMSRV		;(T2) Request service.

;MSGDC1 - reject the connection.
;
; Enter with T1/ reject reason code
MSGDC1:	SAVEAC <P2>
	MOVE P2,T1		;Save reason code
	CALL INISAB		;(/T1) Allocation failed. Get SAB
	SETZRO SAAA1,(T1)	;No optional data
	STOR P2,SAAA2,(T1)	;Store reject reason code
	MOVX T2,.NSFRJ		;Reject function code.
	MOVEI T3,4		;Number of arguments
	CALL MSGNSF		;(T1,T2,CDB)
	 RET            	;Failed, done.
	CALLRET MSGGON		;(CDB) Release CDB storage
	SUBTTL DECNET LAYER -- RELEASE CDB STORAGE
;CALL MSGGON with
;	CDB/ CDB address
;Returns +1 always
MSGGON:	CALL INISAB		;(/T1) Initialize SAB
	MOVX T2,.NSFRL		;Function code - release the connection
	STOR T2,SAAFN,(T1)	;Function code
	MOVEI T3,2		;Number of arguments
	STOR T3,SANAG,(T1)	;Number of arguments
	LOAD T2,CHCHL,(CDB)	;Channel number
	STOR T2,SAACH,(T1)
	CALL <XENT SCTNSF>	;[7.1024](T1) Yes. Call lower layer
	OPSTR <SKIPG T1,>,CHCHL,(CDB) ;Get channel, if there is one.
	IFSKP.
	  ADD T1,CTHCHP		;Clear channel 
	  SETZM (T1)		; table entry
	ENDIF.
	LOAD T1,CHIMB,(CDB)	;Get pointer to input buffer
	TXZ T1,<OWGP. 8,0>	;Address only
	CALL DNFWDS		;[7.1024](T1) Release it.
	MOVE T1,CDB		;[7.1024](T1) Release the CDB.
	CALL DNFWDS		;[7.1024] ...
	CAMN CDB,MSGBLW		;Is this the blocked link ?
	SETZM MSGBLW		;Yes. Clear the blockage flag.
	HRLI CDB,77		;Trash the CDB.
	RET			
	SUBTTL DECNET LAYER -- ATTENTION INTERRUPT FROM DECNET

	XRESCD			;[7.1024]Can be called from any context.

;DECnet interrupt. Called when:
;{ [ A status bit changes from 0 to 1] OR [The logical link state changes ] }
;  AND [ The logical link is not already on the DECnet attention queue ]
;CALL MSGINT with:
;	T1/ XWD Old-status,,Psi-mask
;	T2/ XWD New-status,,DECnet channel number
;	T4/ Link identifier (from lower layer)
;	T5/ XOR of old and new status (NOTE: T5 == Q1)

MSGINT:	HRRZ T1,T2		;Get the channel number
	ADD T1,CTHCHP		;Find right entry in the CTERM channel table
	MOVE T1,(T1)		;Get CDB address.
	HLRZS T2		;Get new status
	STOR T2,CHSTS,(T1)	;Update the CDB with it.
	LOAD T2,NSSTA,+T2	;Get the state
	CAIN T2,.NSSCR		;Is it connect received ?
	SOS MSGCWL		;Yes. One less listener.
	MOVE T1,T4		;Put the link identifier in T1
	CALL <XENT SCTWKQ>	;[7.1024](T1) Queue the request
	SETOM MSGATN		;Set Scheduler attn flag.
	RET			

;ROUTINE CALLED ON A HIBERNATE INTERRUPT
MSGHBR:	BUG.(HLT,CTDCHB,CTHSRV,SOFT,<CTERM hibernate routine called>,,<

Cause:	The CTERM hibernate routine was called by a misguided DECnet.
	It should never be called.

>)
	SUBTTL DECNET LAYER -- SEND FOUNDATION MESSAGE 

	XSWAPCD			;[7.1024]

;Send FOUNDATION message
;CALL MSGOUT with :
;	CTERM locked
;	CHSTS field in CDB has NSNDR on.				       
;	CDB/ address of CDB
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;Returns +1 on failure - link down or output blocked
;Returns +2 on success
MSGOUT:	SAVEAC <Q1,Q2>
	DMOVE Q1,T1		;Save pointer and count
	CALL INISAB		;(/T1) Initialize the CTERM SAB
	STOR Q2,SAAA1,(T1)	;Byte count of message
	STOR Q1,SAAA2,(T1)	;Byte pointer to message
	MOVX T2,.NSFDS		;Function code - send data
	MOVEI T3,5		;Number of arguments
	SETONE SAEOM,(T1)	;Set end-of-message
	CALL MSGNSF		;Do it.
	 RETBAD ()		;Failure. 
	CALL INISAB		;(/T1) Initialize the CTERM SAB
  	OPSTR <SKIPN T2,>,SAAA1,(T1) ;Get bytes left to send.
	RETSKP			;Success.
;Here when failure, this becomes the blocked link.
MSGOU1:	MOVEM T2,MSGBLC		;Byte count
	LOAD T2,SAAA2,(T1)	;Byte 
	MOVEM T2,MSGBLP		; pointer
	MOVEM CDB,MSGBLW	;CDB address
	RET
	SUBTTL DECNET LAYER -- INTERFACE TO DECNET-36

;Do a DECnet function
;CALL MSGNSF with:
;	CTERM locked
;	T1/ address of SAB
;	T2/ function code
;	T2/ number of arguments
;	CDB/ CDB address
;Returns +1 on failure with link gone and all cleaned up.
;Returns +2 on success
MSGNSF:	STOR T2,SAAFN,(T1)	;Function code
	STOR T3,SANAG,(T1)	;Number of arguments
	LOAD T2,CHCHL,(CDB)	;Channel number
	STOR T2,SAACH,(T1)
	CALL <XENT SCTNSF>	;[7.1024](T1)Call lower layer
IFN FTCOUN,<
	AOS %CTMGS		;Count another DECnet call
>
	CALL INISAB		;(/T1) Initialize the CTERM SAB
	LOAD T2,SAAST,(T1)	;Update status
	STOR T2,CHSTS,(CDB)	; in CDB
	TMNN SAERR,(T1) 	;Error ?
	RETSKP			;No. Success.
	CALLRET CDBDEL		;Yes. Blow link away.
	SUBTTL DECNET LAYER -- SET UP NEW LISTENER
;Set up new CTERM listener
;CALL MSGPAS with:
;	CTERM locked
;Returns +1 always
MSGPAS:	SAVEAC <CDB>
	STKVAR <CONBLK>
	SKIPE MSGCWL		;Are there links already waiting?
	RET			;Yes - don't do another one.
	MOVEI T1,CH.LEN		;Get storage for CDB
	CALL DNGWDZ		;[7.1024](/T1)
	 JSP CX,MSGPE1		;Failed. Release storage
	MOVE CDB,T1		;Set up its address
	MOVEI T1,CTHMGL*CTHBPW	;Get length of a CTERM buffer
	STOR T1,CHSSZ,(CDB)	;Save as maximum message length
	MOVEI T1,CTHMGL		;Get length of buffer in words
	CALL DNGWDS		;[7.1024](/T1) Get free space for input bfr
	 JSP CX,MSGPE2		;Failed. Release storage
	TXO T1,<OWGP. 8,0>	;Make it a byte pointer.
	STOR T1,CHIMB,(CDB)	;Save that pointer
	CALL MSGCBK		;(/T1) Allocate and set up the connect block
	 JSP CX,MSGPE3		;Failed. Release storage
	MOVEM T1,CONBLK		;Save it.
	CALL INISAB		;(/T1) Get SAB
	MOVE T2,CONBLK		;Store connect 
	STOR T2,SACBP,(T1)	; block pointer in SAB
	MOVX T2,.NSFEP		;Function code - enter passive
	MOVEI T3,3		;Number of arguments
	CALL MSGNSF		;(T1,T2,T3,CDB) Invoke DECnet
	 RET              	;Error. Done.
	LOAD T2,SAACH,(T1)	;Get the new channel number
	STOR T2,CHCHL,(CDB)	;Store it in the CDB
	ADD T2,CTHCHP		;Store address of CDB
	MOVEM CDB,(T2)		; In channel table entry for this channel
	AOS T1,CTMUID		;Get next CDB unique ID
	STOR T1,CHUID,(CDB)	;Put into CDB.
	AOS MSGCWL		;Bump count of passive links outstanding
	RET			;Done

;Here when DECnet had an error doing the enter passive
;Release the space already got, and give a BUGINF,
MSGPE3:	LOAD T1,CHIMB,(CDB)	;Get pointer to input buffer
	TXZ T1,<OWGP. 8,0>	;Address only
	CALL DNFWDS		;[7.1024](T1) Release it.
MSGPE2:	MOVE T1,CDB		;Release the CDB
	CALL DNFWDS		;[7.1024](T1)

MSGPE1:	BUG.(INF,CTDEPF,CTHSRV,SOFT,<CTERM host enter passive failed>,,<

Cause:	There was a free space allocation failure during an enter passive 
	for a CTERM host.

Action:	Go into SYSDPY's RE display and see which freespace pool is
	being used up. If this happens frequently, there may be a
	software bug loosing the freespace. However, there may be
	insufficient freespace in the pool that has run out. You
	could try to increase that pool's size in your monitor.
>)
	RET
	ENDSV.
	SUBTTL DECNET LAYER -- SET UP CONNECT BLOCK
;Allocate and set up a connect block.
;CALL MSGCBK with:
;Returns +1 on failure
;Returns +2 on success with T1/ address of connect block
MSGCBK:	MOVEI T1,CB.LEN		;Get free space for the connect block
	CALL DNGWDZ		;[7.1024](/T1)
	 RET			;Failed
	SETZRO CBNUM,(T1)	;Clear the node number
	MOVEI T2,PB.LEN		;Set up size of process block
	STOR T2,PBSIZ,+CB.SRC(T1) ;In source and dest parts of connect block
	STOR T2,PBSIZ,+CB.DST(T1)
	SETZ T2,		;Set up format type 0 for both process blocks
	STOR T2,PBFOR,+CB.SRC(T1)
	STOR T2,PBFOR,+CB.DST(T1)
	MOVX T2,CTHOBJ		;Likewise, set up CTERM object type
	STOR T2,PBOBJ,+CB.SRC(T1)
	STOR T2,PBOBJ,+CB.DST(T1)
	RETSKP			;Done - give success return
	SUBTTL DECNET LAYER -- ATTEMPT TO UNBLOCK THE BLOCKED LINK
;CALL MSGUBK with:
;	CTERM locked
;	MSGBLW/ Address of CDB of blocked link
;	MSGBLC/ Count of bytes left to send
;	MSGBLP/ Byte pointer to data to send
;Returns +1 always with:
;	MSGBLW/ CDB address if blockage is not freed, 
;		0 otherwise.
MSGUBK:	SAVEAC <CDB>
	SKIPN CDB,MSGBLW	;Get address of BLOCKED CDB.
	JRST MSGUB1		;None. Done.
 	LOAD T2,CHSTS,(CDB)	;Get the flags+state field from CDB
	LOAD T1,NSSTA,+T2	;Get the state
	CAIN T1,.NSSRN		;Is the link running ?
	IFSKP.
	  SETZM MSGBLW		;No. Clear the blockage flag.
	  CALLRET CDBDEL	;(CDB) Get rid of the link.
	ENDIF.			
IFN FTCOUN,<
	AOS %CTMBU 		;COUNT ANOTHER UNBLOCK ATTEMPT
>
	TXNN T2,NSNDR		;Is the link ready for normal data?
	RET   			;No - can't unblock.
	CALL INISAB		;(/T1) Initialize SAB
	MOVE T2,MSGBLC		;Get count of bytes to send
	STOR T2,SAAA1,(T1)	;Put it into SAB
	MOVE T2,MSGBLP		;Get pointer to data
	STOR T2,SAAA2,(T1)	;Put it into SAB
	SETONE SAEOM,(T1)	;Set end-of-message flag
	MOVX T2,.NSFDS		;send normal data function code
	MOVEI T3,4		;Number of arguments.
	CALL MSGNSF		;(T1,T2,T3,CDB) Send the message
	 RET        		;Failed. Done.
	CALL INISAB		;(/T1) Initialize the CTERM SAB
	LOAD T2,SAAA1,(T1)	;Get count of bytes left to send
       	JUMPN T2,MSGOU1		;(T1,T2,CB3) If any, block again
	TMNE CHRCB,(CDB)	;[9065]Is the CDB to be deleted?
	CALL CDBDEL		;[9065]Yes, set its state to deleted
MSGUB1:	SETZM MSGBLW		;[9065]Note that the blockage is clear.
	RET   			
	SUBTTL DECNET LAYER -- INITIALIZE THE SAB
;Subroutine to initialize the CTERM SAB 
;CALL INISAB
;Returns +1 always with T1/ address of CTERM SAB
INISAB:	MOVE T1,CTHSAP		;Get address of SAB
	OPSTR <SKIPE T1,>,SASBP,(T1) ;Get string block pointer, if any.
	CALL DNFWDS		;[7.1024]Release it
	MOVE T1,CTHSAP		;Get address of SAB
	OPSTR <SKIPE T1,>,SACBP,(T1) ;Get connect block pointer, if any.
	CALL DNFWDS		;[7.1024]Release it
	MOVE T1,CTHSAP		;Get address of SAB
	SETZRO SASBP,(T1)   	;Clear string block pointer in SAB
	SETZRO SACBP,(T1)       ;Clear connect block pointer in SAB
	RET			;Return success
	SUBTTL DECNET LAYER -- RELEASE LINK
;Release DECnet link, and clean up CTERM data
;CALL MSGREL with
;	CDB/ CDB address 
;	CTERM locked
;Returns +1 always
MSGREL:	LOAD T2,CHLIN,(CDB)	;Get line number
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	 JRST MSGGON		;(CDB) Gone. Get rid of CDB storage
	SETZM TTDEV(T2)		;Got it. Lose pointer to CDB.
	SETZRO TTPRM,(T2)     	;TDB no longer permanent
	CALLX (MSEC1,TTCBF9)	;[7.1024]Flush output.
	SETZRO TTOTP,(T2) 	;Clear output active
	LOAD T2,CHLIN,(CDB)	;Get line number
	CALLX (MSEC1,NTYCOF)	;[7.1024](T2/T2) Do carrier off event
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	IFSKP.
	  LOAD T3,TCJOB,(T2) 	;Get controlling job
	  CAIE T3,-1		;Is there a controlling job?
	  IFSKP.
	    LOAD T2,CHLIN,(CDB) ;No. Get line number
	    CALLX (MSEC1,TTYDE0) ;[7.1024](T2) and deallocate dynamic data.
	     NOP
	  ENDIF.
	ENDIF.
	CALLRET MSGGON		;(CDB) Get rid of CDB storage
	SUBTTL FOUNDATION LAYER -- SHUTTING DOWN
;Shut down the connection, releasing all resources
;CALL FNDSHU with
;	CDB/ CDB address
;Returns +2 on success (which is always)
FNDSHU:	LOAD T1,CHSTS,(CDB)	;Is this link allowed 
	TXNN T1,NSNDR		; to send ?
	RET         		;No. Try later.
	MOVE T1,[POINT 8,CTMUNB];Point to unbind message.
	MOVEI T2,.UBNSZ		;Size of message.
	CALL MSGOUT		;(T1,T2,CDB) Send it out.
	 SKIPN MSGBLW		;[9065]Is the output blocked?
	IFSKP.			;[9065]
	  SETONE CHRCB,(CDB)	;[9065]Yes, indicate must delete the CDB
	  RETSKP		;[9065]Don't release the link yet
	ENDIF.			;[9065]
	CALL CDBDEL		;Release the link.
	RETSKP
	SUBTTL FOUNDATION LAYER -- CONNECTION ESTABLISHED
;Establish foundation level connection
;CALL FNDMAK with
;	CTERM locked
;	MSGBLW = 0
;	CDB/ CDB address
;Returns +1 to try again
;Returns +2 on success, or impossible to try again
FNDMAK:	LOAD T1,CHSTS,(CDB)	;Is this link allowed 
	TXNN T1,NSNDR		; to send ?
	RET         		;No. Try later.
	MOVE T1,[POINT 8,BNDMSG] ;Yes to both. Point to BIND message.
	MOVEI T2,BNDMSZ		;Size of it.
	CALL MSGOUT		;(T1,T2,CDB) Send it out.
	 RETSKP			;Ignore error, link is gone now.
	RETSKP			;Done.
	SUBTTL FOUNDATION LAYER -- GET A FREE CTERM LINE
;Find and set up the next available CTERM line
;CALL FNDCON with:
; 	CTERM locked
;	CDB/ address of CB
;Returns: +1 on failure
;   	  +2 on success.
FNDCON:	SAVEAC <Q1,Q2>
	MOVEI Q2,NTTCTH		;Get number of CTERM lines
	MOVE Q1,TT1LIN+TT.CTH	;Get first CTERM line
FNDCO1:	MOVE T2,Q1		;Try this line.
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Is it available ?
	 JUMPE T2,FNDCO3	;Yes. No data block assigned.
FNDCO2:	SOJE Q2,RTN		;No. If run out, fail.
        AOJA Q1,FNDCO1		;Try next line.
FNDCO3:	MOVE T2,Q1		;Get back line number
	CALLX (MSEC1,TTYASC)	;[7.1024](T2/T2) Assign TDB.
	 JRST FNDCO2		;Couldn't. Try another line
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get dynamic data
	 RET          		;This is strange..
	STOR Q1,CHLIN,(CDB) 	;Save the line number.
	MOVEM CDB,TTDEV(T2)	;Save the CDB address
	SETONE TCJOB,(T2)	;There is no controlling job at the moment.
	SETONE TTPRM,(T2)	;Make line permanent until link is released,
	RETSKP			; since there is a pointer to it in the CDB.
				; The control-C will be sent later.
	SUBTTL FOUNDATION LAYER -- GET MESSAGE BUFFER FOR CTERM
;Get COMMON DATA message buffer for CTERM layer
;CALL FNDCOM with
;	CTERM locked
;	NSNDR in CHSTS in CDB nonzero
;	CDB/ CDB address
;Returns +1 always with
;	T1/ byte pointer to buffer
;	T2/ byte count of buffer
FNDCOM:	MOVE T1,MSGOMP		;Point to buffer
	AOS T1			;Step past foundation header space
	LOAD T2,CHSSZ,(CDB)	;Get size
	SUBI T2,.COMLN		;Account for foundation header
	RET
	SUBTTL FOUNDATION LAYER -- SEND COMMON DATA MESSAGE
;CALL FNDOUT with
;	T2/ count of space left in buffer
;	CDB/ address of CDB
;	CTERM locked
;Returns +1 on failure
;Returns +2 on success
FNDOUT:	MOVE T1,MSGOMP		;Point to buffer
	MOVEI T3,.FNCDT		;Common data type
	IDPB T3,T1
	SETZ T3,		;Flags
	IDPB T3,T1
	MOVNS T2		;Compute size of 
	OPSTR <ADD T2,>,CHSSZ,(CDB) ; buffer
	MOVEI T4,-.COMLN(T2)	;Get size of CTERM message
	PUT2BY T1,T4
	MOVE T1,MSGOMP		;Point to message
	CALL MSGOUT		;(T1,T2,CDB) Send it off
	 RET			;Failure
	RETSKP			;Success
	SUBTTL FOUNDATION LAYER -- MESSAGE RECEIVED
;Here when a foundation message has been received.
;CALL FNDGET with 
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ Address of CDB
;Returns +2 if CDB still exists
;Returns +1 if CDB does not exist
FNDGET:	GET1BY T1,T2,T3		;Get one byte and account for it.
	CAIL T3,FNDGTL		;Range check.
	JRST CTMPER		;Failed. Illegal message type.
	JRST @FNDGTB(T3)	;Dispatch on foundation message type

FNDGTB:	XADDR. CTMPER		;[7.1024]0 Illegal message type.
	XADDR. CTMPER		;[7.1024]1 Bind - never received
	XADDR. CDBDEL		;[7.1024]2 Unbind - destroy link and CDB
	XADDR. CTMPER		;[7.1024]3 Illegal message type
	XADDR. FNDBAC		;[7.1024]4 Bind accept 
	XADDR. CTMPER		;[7.1024]5 Enter mode - not used
	XADDR. CTMPER		;[7.1024]6 Exit mode - not used
	XADDR. CTMPER		;[7.1024]7 Confirm mode - not used
	XADDR. CTMPER		;[7.1024]8 No mode - not used
	XADDR. FNDCTM		;[7.1024]9 Common data
	XADDR. FNDCTM		;[7.1024]10 Mode data
FNDGTL==.-FNDGTB		;Length of table
	SUBTTL FOUNDATION LAYER -- MESSAGE RECEIVED -- BIND ACCEPT
;Here when a bind accept message was received from the server
;CALL FNDBAC with
;	T1/ Byte pointer to message
;	T2/ Byte count
;	CDB/ CDB address
;Returns +1 always
FNDBAC:	LOAD T3,CHSTA,(CDB)	;Get state.
	CAIE T3,.STINI		;Is it "initializing" ?
	CALLRET CDBDEL		;No, Blow the link away.
	SUBI T2,3		;*** Get past revision field
	ILDB T3,T1		;*** 
	ILDB T3,T1		;***
	ILDB T3,T1		;***
	GET2BY T1,T2,T3		;*** Get operating system type
	STOR T3,CHOST,(CDB)	;[9076]Save the OS type for STPAR%
	CAIN T3,.FBT20		;[9076]Is it a TOPS-20 system?
	SETONE CHRTI,(CDB)	;[9076]Yes, remote TEXTI% is supported
	CAIE T3,.FBVMS		;[9076]Is it A VMS system?
	IFSKP.			;[9076]
	  LOAD T2,CHLIN,(CDB)	;[9076]Yes, pick up the line number
	  CALLX (MSEC1,STADYN)	;[9076]Pick up the TDB
	   JFCL			;[9076]Ignore any error	   
	  SETZRO TT%LIC,TTFLGS(T2) ;[9076]VMS doesn't handle raise input only
	ELSE.			;[9076]
	  SETONE CHLWI,(CDB)	;No. Remember we can set terminal line width
	  SETONE CHEDT,(CDB)	; and that
	ENDIF.			; the server can do input editing. Currently,
				; VMS does not support continuation reads,
				; setting line width, or a bunch of other stuff
	MOVEI T3,.STFND         ;Set state to 
	STOR T3,CHSTA,(CDB)	; "foundation initialized"
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALL CTMSRV		;Request service (send CTERM INITIATE)
	RETSKP
	SUBTTL FOUNDATION LAYER -- MESSAGE RECEIVED -- COMMON/MODE DATA
;Here when a common data or mode data message was received from the server
;CALL FNDCTM with
;	T1/ Byte pointer to message
;	T2/ Byte count
;	CDB/ CDB address
;Returns +2 if CDB still exists
;Returns +1 if CDB does not exist
FNDCTM:	STKVAR <PTR,COUNT>
       	GET1BY T1,T2,T3		;FLAG field
	DO.
       	  GET2BY T1,T2,T3	;LENGTH
	  CAMLE T3,T2		;Is LENGTH larger than message length ?
	  JRST CTMPER		;Yes. Fail.
	  MOVE T4,T3		;No. Find pointer past 
	  ADJBP T4,T1		; this CTERM message
	  MOVEM T4,PTR		; and save it.
	  EXCH T2,T3		;T2/ LENGTH of this CTERM message
	  SUB T3,T2		;T3/ remaining bytes after this CTERM message
	  MOVEM T3,COUNT 	;Save remainder
	  CALL CTMGET		;(T1,T2,CDB) Give it to CTERM layer
	   RET			;CDB is gone.
	  SKIPN COUNT		;Any other CTERM messages packed in here ?
	  RETSKP		;No. Done.
	  MOVE T1,PTR		;Yes. Get the pointer to it.
	  MOVE T2,COUNT		; and the count
	  LOOP.      		;Continue.
	ENDDO.

	ENDSV.			;END STKVAR
	SUBTTL CTERM LAYER -- INITIALIZE A CTERM CONNECTION

	XRESCD			;[7.1024]TTCHI needs NOSKED

;Here to send a CTERM initiate message to the server in response to
;a received CTERM initiate message
;CALL CTMINI with
;	CTERM locked
;	MSGBLW = 0 
;	CDB/ address of CDB
;Returns +1 on failure, to try again.
;Returns +2 on success, or impossible to try again.
CTMINI:	LOAD T1,CHSTS,(CDB)	;Is this link allowed 
	TXNN T1,NSNDR		; to send ?
	RET           		;No. Try later.
;Send message
	LOAD T1,CHFLG,(CDB)	;[9065]Pick up the flag word
	TXZE T1,CH%SCM		;[9065]INITIATE message previously blocked?
	JRST CTMI.1		;[9065]Yes, now send the CHARACTERISTICS message
	TXZE T1,CH%IIC		;[9065]CHARACTERISTICS message previously blocked?
	JRST CTMI.2		;[9065]Yes, finish initializing
	MOVE T1,[POINT 8,CTMMSG] ;[9065]Point to the INITIATE message
	MOVEI T2,CTMMSZ		;[9065]Get size of it.
	CALL MSGOUT		;[9065](T1,T2,CDB) Send it
	IFNSK.			;[9065]
	  SKIPN MSGBLW		;[9065]Is the link blocked?
	  RETSKP		;[9065]No, the link is gone
	  SETONE CHSCM,(CDB)	;[9065]Indicate send CHARACTERISTICS message
	  RET			;[9065]Send CHARACTERISTICS message later
	ENDIF.			;[9065]
	TRNA			;[9065]On success, don't update the flag word
;Send initial characteristics
CTMI.1: STOR T1,CHFLG,(CDB)	;[9065]Store the updated flag word
	MOVE T1,[POINT 8,CTMMS1] ;[9065]Point to the CHARACTERISTICS message
	MOVEI T2,CTMMZ1		;Get size of it.
	CALL MSGOUT		;(T1,T2,CDB) Send it
	IFNSK.			;[9065]
	  SKIPN MSGBLW		;[9065]Is the output blocked?
	  RETSKP		;[9065]No, the link is gone
	  SETONE CHIIC,(CDB)	;[9065]Indicate initialization is incomplete
	  RET			;[9065]Try later
	ENDIF.			;[9065]
	TRNA			;[9065]On success, don't update the flag word
CTMI.2:	STOR T1,CHFLG,(CDB)	;[9065]Store the updated flag word
	MOVEI T1,.STRUN		;Set state to 
	STOR T1,CHSTA,(CDB)	; "running"
	LOAD T2,CHLIN,(CDB)	;Get line number
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	IFSKP.
	  MOVE T4,TTFLG1(T2)	;Get the terminal's flags
	  TXO T4,TT%WKC		;Force break set 
	  MOVEM T4,TTFLG1(T2)	; to be sent
	  MOVE T3,FCMOD1(T2)	;Get first CCOC word
	  STOR T3,CHCO1,(CDB)	;Stash into CDB.
	  MOVE T3,FCMOD2(T2)	;Get second CCOC word
	  STOR T3,CHCO2,(CDB)	;Stash into CDB.
	  MOVEI T1,.CHCNC	;Get control-C
	  LOAD T2,CHLIN,(CDB)	;Get line number
	  NOSKED		;Needed for TTCHI
	  SETONE CHTCI,(CDB)	;Say we are doing input.
	  CALLX (MSEC1,TTCHI)	;[7.1024](T1,T2) Send it to start up job.
	  IFSKP.
	    SETZRO CHTCI,(CDB)	;Done doing input.
	    OKSKED		;Success,
	    RETSKP		; done.
	  ENDIF.
	  SETZRO CHTCI,(CDB)	;Done doing input.
	  OKSKED		;Failed.
	ENDIF.
	CALL CDBDEL		;(CDB) Failure. Get rid of link.
	RETSKP
	SUBTTL CTERM LAYER -- RUN STATE

	XSWAPCD			;[7.1024]

;Here from the CTERM fork when attention bit is lit and state is run
;Check for :
;  clear input buffer
;  send CCOC words
;  output to send
;  send another start-read
;CALL CTMRNG with 
;	CTERM locked
;	T2/ TDB address
;	CDB/ CDB address
;Returns +2 if functions accomplished, or CDB is gone.
;Returns +1 if not.
CTMRNG:	SAVEAC <Q1>
        MOVE Q1,T2		;Save TDB address in a permanent place.
	TMNN CHCLI,(CDB) 	;Clear input buffer ?
	IFSKP.
	  CALL FNDCOM		;(/T1,T2) Yes. Get buffer
	  SUBI T2,2		;Account for message type and flags
	  MOVEI T3,.CLRIN	;Message type
	  IDPB T3,T1		; into message
	  SETZ T3,		;Flags
	  IDPB T3,T1
	  SETZRO CHCLI,(CDB)	;[9065]Clear the clear input flag.
	  CALL FNDOUT		;[9065](T2,CDB) Send it out
	  IFNSK.		;[9065]
	    SKIPE MSGBLW	;[9065]Is the output blocked?
	    RET			;[9065]Yes, check this line later
	    RETSKP		;[9065]No, so the CDB is gone
	  ENDIF.		;[9065]	
	  MOVE T2,Q1		;Restore TDB
     	ENDIF.
	TMNN CHCOC,(CDB) 	;Send CCOC words ?
	IFSKP.
  	  SETZRO CHCOC,(CDB)	;[9065]Yes, clear the CCOC flag
	  CALL CTMSCC		;[9065]Check the CCOC words for any changes
	  IFNSK.		;[9065]
	    SKIPE MSGBLW	;[9065]Is the output blocked?
	    RET			;[9065]Yes,check this line later
	    RETSKP		;[9065]No, so the CDB is gone
	  ENDIF.		;[9065]
	  MOVE T2,Q1		;Restore TDB
	ENDIF.
	TMNN TTOTP,(T2) 	;Send output ?
	IFSKP.		 	
	  CALL CTMSOT		;(T2,CDB) Send output.
	   RET			;More to send.
	ENDIF.
	TMNN CHASR,(CDB) 	;Send another START-READ ?
	IFSKP.
  	  LOAD T1,CHRFL,(CDB)	;Get flags
	  LOAD T2,CHRLN,(CDB)	;Get length
	  LOAD T3,CHRBL,(CDB)	;Get length of ^R buffer
	  CALL CTMSTR		;(T1,T2,T3,CDB) Issue the START-READ.
	  TMNN CHASR,(CDB)	;[9065]Need to send another START-READ ?
	  SKIPE MSGBLW		;[9065]No, is the output blocked?
	  RET			;[9065]Yes, send it later
	ENDIF.
	RETSKP			;Everything done.
	SUBTTL CTERM LAYER -- SEND OUTPUT MESSAGE NOW

;If possible, send a CTERM write message that contains all the 
;characters that are in TTYSRV's output buffer. 
;Force the message to be sent NOW.
;CALL CTMSOT with 
;	CTERM locked							       
;	T2/ TDB ADDRESS 
;	CDB/ CDB ADDRESS 
;Returns +2 on success, or link gone.
;Returns +1 to try again later
CTMSOT:	SAVEAC <Q1,Q2,Q3,P2,P3,P4>
	MOVE P2,T2		;Save TDB address in a permanent place.
CTMSO1: LOAD T1,CHSTS,(CDB)	;Is this link
	TXNE T1,NSNDR		; allowed to send ?
	SKIPE MSGBLW		;Yes. Can anyone send ?
	RET			;No to either. Try later.
	CALL FNDCOM		;(CDB/T1,T2) Get byte pointer and count.
       	CALL CTMWRI		;(T1,T2,CDB,P2/T1,T2) Insert WRITE message header.
	MOVE P3,T2    		;Save the size for later computation
	MOVE Q2,T1		;Put pointer into message in a permanent place.
	MOVE Q3,T2        	;Put size in a permanent place.
	SETO P4,		;The TTYSRV buffer has not been emptied.
	MOVE T2,P2		;TDB
	CALL CTMSOX		;(T1,T2,Q2,Q3) Chars: TTYSRV to DECnet.
	 SETZ P4,		;The TTYSRV buffer has been emptied

;Here when TTYSRV buffer has been emptied, or DECnet buffer is full

	SUB P3,Q3     		;Compute number of characters
   IFN FTCOUN,<
	ADDM P3,%CTCOU		;Count them.
	SKIPE P3		;Is there really one ?
	AOS %CTMSG+.WRITE	;Yes. Count another CTERM write message
   >;END IFN FTCOUN
	IFN. P3			;[9065]Is there anything in there?
	  MOVE T2,Q3		;Yes. Get count of bytes left in buffer.
	  CALL FNDOUT  		;(T2) Send message out.
	  IFNSK.		;[9065]
	    SKIPE P4		;[9065]Any more characters in the TTYSRV buffer?
	    SKIPN MSGBLW	;[9065]Yes, is the link blocked?
  	    RETSKP              ;[9065]No, the link is gone or empty buffer
	    RET			;[9065]Indicate more messages need to be sent
	  ENDIF.		;[9065] 
	ENDIF.
	JUMPN P4,CTMSO1		;If TTYSRV buffer is not empty, continue.
	RETSKP
	XRESCD			;[7.1024]TTSND needs NOSKED & CHNOFF

;Here to get characters from TTYSRV output buffer and put into CTERM buffer
;CALL CTMSOX with
;	T2/ TDB
;	CDB/ CDB ADDRESS 
;	Q2/ byte pointer to CTERM buffer
;	Q3/ byte count left of CTERM buffer
;Returns +1 if TTYSRV buffer was emptied, +2 if not, (DECnet buffer full)
;	Q2,Q3/ updated in either case

CTMSOX:	NOSKED
	CHNOFF DLSCHN		;TTSND needs this
	DO.			;Move chars from TTYSRV buffer to CTERM message
       	  CALLX (MSEC1,TTSND)	;[7.1024](T2/T1,T2) Get a character from output buffer.
	  IFSKP.
	    CAIE T1,TTOASC	;Is this a marker (binary to ascii mode)?
	    IFSKP.
	      SETZRO CHBIN,(CDB);Yes, set mode to ascii for next message
	      OKSKED
	      RETSKP.		;and terminate the current message now.
	    ENDIF.
	    CAIE T1,TTOBIN	;Is this a marker (ascii to binary mode)?
	    IFSKP.
	      SETONE CHBIN,(CDB);Yes, set mode to binary for next message
	      OKSKED
	      RETSKP.		;and terminate the current message now.
	    ENDIF.
;	    ANDI T1,177		;Got it. Truncate the character to 7 bits
	    JUMPE T1,TOP.  	;Don't send nulls
	    IDPB T1,Q2		;Save it in the CTERM message
	    SOJG Q3,TOP.  	;Loop to get another character, until full
	    CHNON DLSCHN	;DECnet buffer full.
	    OKSKED
	    RETSKP
	  ELSE.
	    SETZRO TTOTP,(T2)	;Output is no longer in progress
	    CHNON DLSCHN	;Match the CHNOFF
	    OKSKED		;Match the NOSKED
	    RET     		;The TTYSRV buffer has been emptied.
	  ENDIF.
	ENDDO.
	SUBTTL CTERM LAYER -- HEADER FOR CTERM WRITE MESSAGE 

	XSWAPCD			;[7.1024]

;Construct the header for a CTERM write message
;CALL CTMWRI with
;	CDB locked
;	T1/ byte pointer to CTERM buffer
;	T2/ size of buffer in bytes
;	CDB/ CDB address
;	P2/ TDB	address
;Returns +1, always with T1 and T2 updated.

CTMWRI:	SUBI T2,.WRHLN		;Account for header.
	JUMPL T2,RTN		;If no room, done
	MOVEI T4,.WRITE		;CTERM message type is WRITE.
	IDPB T4,T1		
	MOVX T3,WR%BMS+WR%EMS+WR%BKT ;Set flags: begin/end message, breakthrough
	LOAD T4,CHFLG,(CDB)	;Get flags from CDB
	TXZE T4,CH%SSD		;Want to tell server to turn off discard?
	TXO T3,WR%SOD		;Yes - do so
	TXNE T4,CH%BIN		;Last message in transparent binary mode?
	TXO T3,WR%TPT		;Yes - out this one in binary mode also.
	STOR T4,CHFLG,(CDB)	;Save the possibly adjusted CTERM flags
	ROT T3,BYTSIZ		;Get the first flag byte
	IDPB T3,T1   		;Put it 
	ROT T3,BYTSIZ		;Get the second flag byte
	IDPB T3,T1   		;Put it 
	SETZ T4,		;Say no prefix or postfix values
	IDPB T4,T1  
	IDPB T4,T1  
	RET
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE
;Here when a CTERM message has been received.
;CALL CTMGET with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +2 if CDB still exists
;Returns +1 if CDB does not still exist.
CTMGET:	GET1BY T1,T2,T3		;Get CTERM message type
	CAIL T3,CTMDSL		;Range check
	JRST CTMPER		;Failed.
	JRST @CTMDSP(T3) 	;Do it.

;Dispatch table for received CTERM message
CTMDSP:	XADDR. CTMPER		;[7.1024]0  Illegal message
	XADDR. CTMINT		;[7.1024]1  Initiate 
	XADDR. CTMPER		;[7.1024]2  Start-read (Illegal)
	XADDR. CTMRDD		;[7.1024]3  Read
	XADDR. CTMOOB		;[7.1024]4  Out-of-band
	XADDR. CTMPER		;[7.1024]5  Unread (Illegal)
	XADDR. CTMPER		;[7.1024]6  Clear input (Illegal)
	XADDR. CTMPER		;[7.1024]7  Write (Illegal)
	XADDR. CTMPER		;[7.1024]8  Write-completion (Illegal)
	XADDR. CTMDSS		;[7.1024]9  Discard-state
	XADDR. CTMPER		;[7.1024]10 Read-characteristics (Illegal)
	XADDR. CTMPER		;[7.1024]11 Characteristics (Illegal)
	XADDR. CTMPER		;[7.1024]12 Check-input (Illegal)
	XADDR. CTMPER		;[7.1024]13 Input-count (Illegal)
	XADDR. CTMIST		;[7.1024]14 Input-state
CTMDSL==.-CTMDSP
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- INITIATE MESSAGE
;Here when a CTERM initiate message has been received.
;CALL CTMINT with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +2 on success
CTMINT:	STKVAR <PTYPE,COUNT1,COUNT2>
	TMNE CHCTM,(CDB)	;Have we already received an INITIATE message ?
	JRST CTMPER		;Yes. Protocol error
	SETONE CHCTM,(CDB)	;No. Set bit saying we have.
	SUBI T2,14  		;Step past 
	JUMPL T2,CTMPER		; fields that 
	MOVEI T3,^D12		; are not 
	ADJBP T3,T1		; of 
	MOVE T1,T3		; interest
	DO.
	  JUMPE T2,ENDLP.	;Exit loop if no more fields
	  GET1BY T1,T2,T3 	;Get PARMTYPE.
	  MOVEM T3,PTYPE	;Save it
	  GET1BY T1,T2,T4	;Get count byte
	  CAIL T4,5		;no fields that fit in a word
	  JRST CTMPER		;Failed.
	  MOVEM T4,COUNT1	;Store byte count
	  MOVEM T4,COUNT2	;store it here too
	  DO.
	    SOSGE COUNT1	;Done?
	    EXIT.		;Yes.
	    GET1BY T1,T2,T4	;get a byte
	    IOR T3,T4		;Accumulate it in result
	    ROT T3,-10		;Shift result over 1 byte's worth
	    LOOP.		;continue
	  ENDDO.
	  MOVE T4,COUNT2	;Retrieve count to shift by
	  IMULI T4,10		;multiply by byte size
	  ROT T3,(T4)		;Rotate result.
	  MOVE T4,PTYPE		;Get back parameter type
	  CAIG T4,MAXPRM	;In range ?
	  CALL @PRMTBL(T4)	;(T1,T2,T3/T1,T2)Yes. Handle it.
	  LOOP.			;Continue looping.
	ENDDO.
	RETSKP			;Done.
	ENDSV.			;End STKVAR

;Dispatch on parameter type
;T3/ parameter value
;T1 & T2 preserved
;Returns +1 always
PRMTBL:	IFIW RTN
	XADDR. CTMIN1		;[7.1024]
	XADDR. CTMIN2		;[7.1024]

MAXPRM==.-PRMTBL-1 		;Max parameter type

;Handle the max message size parameter.
;T3/  parameter value
;Preserves T1 & T2
;Returns +1 always
CTMIN1:	LOAD T4,CHSSZ,(CDB) 	;Get my max message size
	CAML T4,T3		;Is mine larger ?
	MOVE T4,T3		;Yes. Use server's size
	STOR T4,CHSSZ,(CDB) 	;Update max message size
	RET

;Handle the max input buffer size parameter.
;T3/  parameter value
;Preserves T1 & T2
;Returns +1 always
CTMIN2:	STOR T3,CHMAX,(CDB) 	;Store max input buffer size.
    	RET
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- INPUT STATE MESSAGE
;Here when an input state message is received
;CALL CTMIST with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +2 always
CTMIST:	GET1BY T1,T2,T3		;Get flag
	STOR T3,CHMRD,(CDB)	;Put into the CDB
	JUMPE T3,RSKP		;Done if the buffer became empty
	MOVX T1,1B<.TICTI>	;Otherwise, check for PSI
	LOAD T2,CHLIN,(CDB)	;Get 
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) TDB
	 RETSKP			;None. Done.
	TDNN T1,TTPSI(T2)	;PSI on buffer nonempty desired ?
	RETSKP			;No - done
	MOVX T3,.TICTI		;Yes - terminal code
	LOAD T2,CHLIN,(CDB)	;TTY #
	CALLX (MSEC1,TTPSRQ)	;[7.1024](T2,T3) Request the interrupt.
	RETSKP
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- READ DATA MESSAGE
;Here when a read data message is received,
;Store characters received from the server in this terminal's input buffer,
;Perhaps issue another read.
;CALL CTMRDD with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +2 always
CTMRDD:	SAVEAC <Q1,Q2,Q3>	
	GET1BY T1,T2,Q1		;Get flags
	SUBI T2,6		;Step past rest of header, 
	JUMPL T2,CTMPER		; since
	MOVEI T3,6		; we 
	ADJBP T3,T1		; ignore
	MOVE T1,T3		; it.
	SETZ T4,		;Assume no typeahead data
	TXNE Q1,RD%MTY   	;Is there any ?
	MOVEI T4,1		;Yes.
	STOR T4,CHMRD,(CDB)	;Save typeahead data flag
	ANDI Q1,RD%CCD   	;Get completion code
	CAIN Q1,RD%CUR		;Was it unread ?
	IFSKP.
	  SETZRO CHRDA,(CDB)	;No. The read request is no longer active
	ENDIF.
	CAIE Q1,RD%COB		;Is completion code out of band termination ?
	IFSKP.
	  LOAD T2,CHLIN,(CDB)	;[7199] Get line number
	  CALLX (MSEC1,STADYN)	;[7.1024][7199] Get TDB.
	  RETSKP		;[7199] None, done.
	  CALLX (MSEC1,TTCIB0)	;[7.1024][7199] (T2/T2) Clear input buffer
	  RETSKP		;Yes.  Discard input.
 	ENDIF.
	SETZ Q3,		;Initialize local continuation read flag
	CAIE Q1,RD%CUF		;Is completion code terminate on underflow ?
	IFSKP.
	  MOVEI Q1,1		;Yes. Give a DELETE 
	  MOVE Q2,[POINT 8,[BYTE (8).CHDEL,0]] ; to TTYSRV.
	ELSE.
	  CAIN Q1,RD%CBF	;No. Is it input buffer full ?
	  SETO Q3,		;Yes. Set continuation read flag.
	  MOVE Q1,T2		;Put count in Q1
	  MOVE Q2,T1		;Put pointer in Q2
	ENDIF.
	JUMPE Q1,RTN		;If no characters, done.
	LOAD T2,CHLIN,(CDB)	;Get line number
	CALL CTMRDO		;(T1,T2,Q1,Q2/T1,T2) No. Handle the loop.
	TMNN CHRCX,(CDB) 	;Was CR-LF forced on in server's break mask ?
	IFSKP.
 	  CAIE T1,.CHCRT	;Yes. Was last character CR
	  CAIN T1,.CHLFD	; or LF ?
	  IFNSK.
	    SETO Q3,         	;Yes. Force continuation read.
	  ENDIF.
	ENDIF.
	JUMPE Q3,RSKP           ;Need to do another read ?
	SETONE CHASR,(CDB)      ;Yes. Flag another start-read & 
	SETONE CHCOC,(CDB)	; CCOC words.
	LOAD T2,CHLIN,(CDB)
	CALL CTMSRV		;(T2,CDB) Request service.
	RETSKP			;Done.
	XRESCD			;[7.1024]TTCHI needs NOSKED

;This feeds the characters to TTYSRV
;CALL CTMRDO with
;	Q1/ count of bytes
;	Q2/ byte pointer
;	T2/ TTY #
;Returns +1 always with T1/ last character

CTMRDO:	JUMPLE Q1,RTN		;If none, done.
	NOSKED			;Needed for TTCHI
	SETONE CHTCI,(CDB)	;Say we are doing input.
	DO.  
	  ILDB T1,Q2		;Get a character
	  CALLX (MSEC1,TTCHI)	;[7.1024](T1,T2/T2) Store character.
	   NOP			
	  SOJG Q1,TOP.  	;If no more characters, done.
	ENDDO.
	SETZRO CHTCI,(CDB)	;Done doing input.
	OKSKED
	LDB T1,Q2		;Get last character
	RET

REPEAT 0,<
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- READ DATA MESSAGE -- UPDATE POSITION
;Here to update local line and column positions for a character. 
;CALL CTMSDP with
;	T1/ character
;	T2/ TDB
;Returns +1 always
;Preserves T1 & T2.
CTMSDP:	TMNN TTECO,+TTFLGS(T2) 	;Is echoing on ?
	RET			;No. Nothing to do.
	CAIGE T1,.CHSPC		;Printing character ?
	IFSKP.                         
	  INCR TLNPS,(T2)	;Yes. Update column position.
	  RET
	ENDIF.
	MOVE T3,FCMOD1(T2)	;No. Get control-echo words
	MOVE T4,FCMOD2(T2)
	ROTC T3,(T1)		;Position 
	ROTC T3,2(T1)		; the bits.
	ANDI T4,3		;Mask out irrelevant bits.
	JRST @CTMSDD(T4)	;Dispatch according to control-echo type

CTMSDD:	IFIW RTN		;Ignore.
	XADDR. CTMSD2		;[7.1024]^X
	XADDR. CTMSDI		;[7.1024]Image 
	XADDR. CTMSDS		;[7.1024]Simulate

;Here when control echo bits say ^X
CTMSD2:	INCR TLNPS,(T2)		;Update column position by two.
	INCR TLNPS,(T2)
	RET

;Here when control echo bits say echo character as self.
;Only backspace, tab, line feed, form feed, and carriage return affect position
CTMSDI:	CAIGE T1,.CHBSP		;Within
	CAIG T1,.CHCRT		; range ?
	JRST @CTMSDE-.CHBSP(T1)	;Yes. Dispatch on character
	RET			;No. Done.

;Here when control echo bits say simulate format action.
CTMSDS:	CAIE T1,.CHESC		;Is it ESCAPE ?
	JRST CTMSDI     	;No. Do as self.
	INCR TLNPS,(T2)		;Yes. Update horziontal position
	RET

;Dispatch table for format control charaters
CTMSDE:	XADDR. CTMSDB		;[7.1024] ^H (backspace)
	XADDR. CTMSDT		;[7.1024] ^I (tab)
	XADDR. CTMSDL		;[7.1024] ^J (line feed)
	IFIW RTN   		; ^K 
	XADDR. CTMSDF		;[7.1024] ^L (form feed)
	XADDR. CTMSDC		;[7.1024] ^M (carriage return)
;Here for backspace. decrement column position unless at left margin
CTMSDB:	LOAD T4,TLNPS,(T2)	;Get current column
	JUMPE T4,RTN		;If zero, nothing to do.
	DECR TLNPS,(T2)		;It isn't. Decrement column.
	RET			;Done.

;Here for tab - update column number to next multiple of 8
CTMSDT:	MOVEI T3,7		
	LOAD T4,TLNPS,(T2)
	IOR T4,T3
	AOS T4
	STOR T4,TLNPS,(T2)
	RET

;Here for line feed - update vertical position, check for page length
CTMSDL:	INCR TPGPS,(T2)		;Increment line position on page
	AOS T3,TTLINE(T2)	;Increment line counter
	CAMLE T3,TTLMAX(T2)	;New maximum?
	MOVEM T3,TTLMAX(T2)	;Yes, remember it
	LOAD T3,TPLEN,(T2)	;Get page length
	JUMPE T3,RTN   		;No check if length 0
	LOAD T4,TPGPS,(T2)	;Get current page position
	CAMGE T4,T3		;Page full?
	RET			;No.
	SETZRO TPGPS,(T2) 	;Yes. Reset to top of page
	RET

;Here for form feed - zero vertical position.
CTMSDF:	SETZRO TPGPS,(T2)
	RET

;Here for carriage return - zero column position
CTMSDC:	SETZRO TLNPS,(T2)

	RET
>;END REPEAT 0
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- OUT-OF-BAND MESSAGE
;Here when an out-of-band message is received,
;store the character in this terminal's input buffer.
;CALL CTMOOB with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +2 always
;Out-of-band characters can be either the user's psi's or the terminal pause
;and unpause characters.
CTMOOB:	SAVEAC <Q1,Q2>
	GET1BY T1,T2,Q1		;Get discard flag
	IFN. Q1			;Is it "set output discard state to discard" ?
	  SETONE CHDSO,(CDB)	;Yes. Do so.
	ENDIF.
	GET1BY T1,T2,Q1		;Get character
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	 RETSKP			;Failed.
	MOVE T1,Q1		;Get character 
	CALLX (MSEC1,GPSICD)	;[7.1024](T1/T1) Convert to interrupt code
	MOVE T3,T1		;Get code
	MOVE T4,BITS(T3)	;Convert code to mask
	MOVE Q2,T2		;Save TDB.
	NOSKED			;Needed for TTPSI2 and TTCHI, and TTPSI changing
	SKIPL T3		;Is there really a code ?
	TDNN T4,TTPSI(T2)	;Yes. Is it enabled ?
	IFSKP.
	  CALLX (MSEC1,TTPSI2)	;[7.1024](T2,T3) Yes. Issue interrupt.
	ELSE.
	  MOVE T1,Q1		;No. Get character
 	  LOAD T2,CHLIN,(CDB)	;Get TTY #
	  SETONE CHTCI,(CDB)	;Say we are doing input.
 	  CALLX (MSEC1,TTCHI)	;[7.1024](T1,T2) Store character in the input buffer
 	   NOP
	  SETZRO CHTCI,(CDB)	;Done doing input.
	ENDIF.
 	OKSKED			;Match NOSKED above.
	RETSKP			;No - done.
	SUBTTL CTERM LAYER -- RECEIVED MESSAGE -- DISCARD STATE MESSAGE

	XSWAPCD			;[7.1024]

;Here when a discard state message is received,
;CALL CTMDSS with
;	T1/ Byte pointer to message
;	T2/ Byte count of message
;	CDB/ CDB address
;Returns +1 always
CTMDSS:	GET1BY T1,T2,T3		;Get the flag
	MOVEI T4,1		;Complement
	SUBM T4,T3		; it.
	STOR T3,CHDSO,(CDB)	;Update local flag in CDB.
	IFE. T3			;Is flag "do not discard" ?
	  SETONE CHSSD,(CDB)    ;Yes. Set "do not discard" in next write message
	ENDIF.
	RETSKP
	SUBTTL CTERM LAYER -- TDCALL -- SET UP TERMINAL BUFFERS

;CTERM-DEPENDENT CODE FOR SETTING UP THE TERMINAL BUFFERS.
;THINGS WHICH HAVE CHANGED WHICH THE SERVER CARES ABOUT.
;CALL WITH:
;	T1/ TDB address
;	T2/ TTY #
;RETURNS +1 ALWAYS

XNENT	(CTHSOF,G)		;[7.1024]CTHSOF::, XCTHSO::

	MOVE T4,IBFRC1		;SET UP CTERM'S NUMBER OF OUTPUT BUFFERS
	MOVEM T4,TTBFRC(T1)
	RET			;DONE
	SUBTTL CTERM LAYER -- TDCALL -- GET INPUT BUFFER COUNT
;Get the number of characters in the server's input buffer
;CALL CTHCKI WITH:
;	T1/ THE CHARACTER COUNT SO FAR
;	T2/ TDB address
;Note that we don't get the actual count, just an estimate (0 or 1)
;Returns +1, always

XNENT	(CTHCKI,G)		;[7.1024]CTHCKI::, XCTHCK::

	SKIPN T3,TTDEV(T2)	;Get CDB
	RET		 	;None. Done.
        TMNE CHMRD,(T3) 	;More data in server ?
	AOS T1       		;Yes - say so.
	RET
	SUBTTL CTERM LAYER -- TDCALL -- HANGUP ROUTINE
;Here when hanging up a TTY 
;CALL CTHNGU with:
;	T2/ Line Number
;Returns +1 always

XNENT	(CTHNGU,G)		;[7.1024]CTHNGU::, XCTHNG::

	SAVEAC <T2,CDB>        	
	CALLX (MSEC1,STADYN)	;[7.1024]
	 RET			;No TDB.
	SKIPN CDB,TTDEV(T2)	;Get CDB address.
	RET			;None. Done.
	MOVEI T1,.STSHU		;Set state to 
	STOR T1,CHSTA,(CDB)	; "shutting down",
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALLRET CTMSRV		;(T2) and request service.
	SUBTTL CTERM LAYER -- TDCALL -- SEND OUT-OF-BAND SETTINGS
;Send the immediate and deferred out-of-band settings to the server
;CALL CTHOBS with		;[7.1024]CHANGE ROUTINE NAME FROM CTHSPS
;	T1/ Old setting of immediate mask
;	T2/ TDB
;	T3/ Old setting of deferred mask

XNENT	(CTHOBS,G)		;[7.1024]CTHOBS::, XCTHOB::

IFN FTCOUN,<
	AOS %CTOOB		;COUNT ANOTHER OOB  
>
	CAMN T3,TTDPSI(T2)	;Quick check - Has anything changed ?
	CAME T1,TTPSI(T2)	
	TRNA           		;Yes. do the work
	RET			;No. Done.
IFN FTCOUN,<
	AOS %CTOBS		;COUNT ANOTHER OOB SENT.
>
       	SAVEAC <T2,Q1,Q2,Q3,CDB,P2,P3>
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	MOVE Q3,T2		;Save TDB
	MOVE Q1,T1		;Get the old settings
	MOVE Q2,T3
	MOVE P2,TTPSI(Q3)	;Get the new settings
	MOVE P3,TTDPSI(Q3)	
	XOR Q1,P2		;Get changes
	XOR Q2,P3
	IOR Q2,Q1
	TRZ Q2,77		;KEEP ONLY THE CHARACTER BITS
	JUMPE Q2,RTN		;IF NO CHANGES AFTER ALL THIS, DO NOTHING
	CALL LOKCDB		;(T2,CDB) Grab control of CTERM 
	 RET			;Failed. 
	CALL GETCHM		;(/T1,T2) Set up for characteristics message
	SETZ T3,		;Character
	MOVX T4,CAOOB+CACEC	;Out of band mask and echo.
	DO.
       	  TLNN Q2,400000	;Has this character's setting changed?
	  IFSKP.
	    TLNN P3,400000	;Yes. Deferred ?
	    IFSKP.
	      MOVX Q1,.CAOOD 	;Deferred, no echo.
	    ELSE.
	      TLNN P2,400000	;Immediate ?
	      IFSKP.
	        MOVX Q1,.CAOOH	;Immediate translates to hello, no echo.
	      ELSE.
	        OPSTR <CAMN T3,>,TTUPC,(Q3) ;None. Is this the unpause character ?
	 	IFSKP.      	;Yes. Skip
	          OPSTR <CAMN T3,>,TTPPC,(Q3) ;No. Is this the pause character ?
		  ANSKP.
		    CALL CTHSPY	;(T3,Q1,Q3/T3,Q1) No. Set up echo char'tics
	 	    TXO Q1,.CAOOX ;Not out of band.
		ELSE.
		  MOVX Q1,.CAOOH  ;Yes. This is pause or unpause. Make it hello, no echo.
 	        ENDIF.
	      ENDIF.
	    ENDIF.
	    CALL SETCHA		;(T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Set it.
	     JRST CTHSPX        ;Failure.
       	  ENDIF.
          AOS T3 		;Step to next character.
	  LSH Q2,1		;Move to next bit in the changes word
	  LSHC P2,1		;Move to next bits in the new settings
	  JUMPN Q2,TOP.  	;Loop if more bits are set
	ENDDO.
	CALL FNDOUT		;(T2,CDB) Send the message
	 NOP			;Ignore error
CTHSPX:	CALLRET ULKCDB		;Let go of CTERM

;Subroutine to set up echo for character which has become not out of band
;CALL CTHSPY with 
;	T3/ character 
;	Q1/ characteristics
;	Q3/ TDB
;Returns +1 always with 
;	Q1/ echo characteristic
;All other registers unchanged.
CTHSPY:	MOVE Q1,T3              ;Copy character
	ADJBP Q1,[POINT 2,FCMOD1(Q3)] ;Point to code for this word
	ILDB Q1,Q1		;Get code
	CALLRET CTHSC1		;(T3,Q1/Q1) Convert to CTERM echo characteristic
	SUBTTL CTERM LAYER -- TDCALL -- OUTPUT OR ECHO ?

;	XRESCD			;[7.1024]

;This is called from the depths of TTYSRV to determine if the character
;should really be output or whether this is the echo of a character
;which has already been echoed by the server.  The reason things are done
;this way, rather than turning off TT%ECO in the TDB, is so that linked
;terminals will work properly
;
;CALL CTHOOE with
;	T2/ address of TDB
;Returns +1 if output is not to be done
;Returns +2 if output is to be done

XRENT	(CTHOOE,G)		;[7.1024]CTHOOE::, XCTHOO::

	SAVEAC <CDB>
	SKIPN CDB,TTDEV(T2)	;[8986]Pick up the CTERM data block
	RETSKP			;[8986]If none, then quit now
	TMNN CHTCI,(CDB)	;[8986]Doing output?
	RETSKP			;[8986]Yes, then output the character
	TMNN CHRTI,(CDB)	;[8986]Is the server a TOPS-20 system?
	RET			;[8986]No, so don't echo
	LOAD T3,TT%DUM,TTFLGS(T2) ;[8986]Pick up the duplex mode
	CAIE T3,.TTHDX		;[8986]Is it HALFDUPLEX?
	RET			;[8986]No, so don't echo
	CAIL T1,.CHSPC		;[8986]Is it a control character?
	RET			;[8986]No, don't echo
	RETSKP			;[8986]Yes, so echo 
	SUBTTL CTERM LAYER -- TDCALL -- CHANGE MODE TO ASCII
;CALL CTHASC with
;	T1/ CHARACTER
;	T2/ TDB
;Returns +1 always 

XRENT	(CTHASC,G)		;[7.1024]CTHASC::, XCTHAS::

	SAVEAC <T1>		;Save original character
	TMNN TTBIN,(T2)		;Are we in binary mode now?
	RET			;No, no change to be made.
	SETZRO TTBIN,(T2)	;Yes, change mode to ascii (non-binary)
	MOVEI T1,TTOASC		;Get marker BINARY to ASCII mode
	CALLX (MSEC1,TCOUM)	;[7.1024]Put marker in output stream.
	RET
	SUBTTL CTERM LAYER -- TDCALL -- CHANGE MODE TO BINARY
;CALL CTHBIN with
;	T1/ CHARACTER
;	T2/ TDB
;Returns +1 always 

XRENT	(CTHBIN,G)		;[7.1024]CTHBIN::, XCTHBI::

	SAVEAC <T1>		;Save original character
	TMNE TTBIN,(T2)		;Are we in Ascii mode now?
	RET			;No, no change to be made.
	SETONE TTBIN,(T2)	;Yes, change mode to binary
	MOVEI T1,TTOBIN		;Get marker ASCII to BINARY mode
	CALLX (MSEC1,TCOUM)	;[7.1024]Put marker in output stream.
	RET
	SUBTTL CTERM LAYER -- TDCALL -- STTYP% JSYS

;	XSWAPCD			;[7.1024]

;CALL CTHTYP with
;	T2/ TDB
;Returns +1 always 

XNENT	(CTHTYP,G)		;[7.1024]CTHTYP::, XCTHTY::

	SAVEAC <CDB,P2>
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	MOVE P2,T2		;Put TDB in safe place.
	CALL LOKCDB		;(T2,CDB) Get control of CTERM
	 RET			;Failed.
	CALL GETCHM		;(/T1,T2) Get characteristics message buffer
	LOAD T3,TPLEN,(P2)	;Get the length
	MOVX T4,CH%PLN		;Get characteristic type
	CALL SETCHR  		;(T1,T2,T3,T4/T1,T2) Set it in the message
	 NOP			;Ignore failure
	TMNN CHLWI,(CDB)	;Does this server support line width setting?
	IFSKP.
	  LOAD T3,TPWID,(P2)	;Get the width
	  MOVX T4,CH%WID	;Get characteristic type
	  CALL SETCHR   	;(T1,T2,T3,T4/T1,T2) Set it in the message
	   NOP			;Ignore failure
	ENDIF.
	MOVE T3,TTFLGS(P2)	;Is the pause-on-command 
	TXNN T3,TT%PGM		; bit set ?
	TDZA T3,T3		;No.
	MOVEI T3,1		;Yes.
	MOVX T4,CH%FLW		;Get characteristic type.
	CALL SETCHR		;(T1,T2,T3,T4/T1,T2) Set it in the message.
	 NOP			;Ignore failure
	LOAD T3,TTTYP,(P2)	;Get terminal type
	CAIL T3,MAXTYP		;Legal ?
	IFSKP.
	  MOVE T3,TTYPE(T3)	;Yes. Get byte pointer to terminal type string.
	  MOVX T4,CH%TTY	;Get characteristic type.
	  CALL SETCHR		;(T1,T2,T3,T4/T1,T2) Set it in the message
	   NOP
	ENDIF.
	CALL FNDOUT		;Send it off.
	 NOP			;Ignore failure
	CALL ULKCDB		;Release CTERM
	MOVE T2,P2		;Get TDB back.
	RET
	SUBTTL CTERM LAYER -- TDCALL -- STPAR% JSYS

;CALL CTHSPR with
;	T1/ new settings
;	T2/ TDB
;Returns +1 always with T1/ new settings (poss. altered)
;			T2/ TDB
;[8961]Generates a message to change the following in the server:
;[8961]
;[8961]TT%LIC - lower case  (1==convert to upper)
;[8961]and/or
;[8961]TT%DUM - duplex mode (00==convert to full duplex
;[8961]                     (10==convert to character half duplex
;[8961]                     (11==convert to line half duplex)

XNENT	(CTHSPR,G)		;[7.1024]CTHSPR::, XCTHSP::

IFN FTCOUN,<
	AOS %CTPAR		;COUNT ANOTHER STPAR
>
	TXNN T1,TT%LIC		;[9076]Turn on "raise input only"?
	IFSKP.			;[9076]
	  SKIPN T3,TTDEV(T2)	;[9076]Yes, pick up the CDB address
	  RET			;[9076]Return if none
	  LOAD T3,CHOST,(T3)	;[9076]Pick up the server's OS type
	  CAIN T3,.FBVMS	;[9076]Is the server a VMS system?
	  TXZ T1,TT%LIC		;[9076]Yes, it can't support raise input only
	ENDIF.			;[9076]
	MOVE T3,T1		;Get copy of flags
	XOR T3,TTFLGS(T2)	;Get changes
	AND T3,[TT%LIC!TT%DUM!TT%LCA] ;[7183][8961][8986]Get only bits of interest
	JUMPE T3,RTN		;Done if nothing has changed
IFN FTCOUN,<
	AOS %CTPRS		;COUNT ANOTHER STPAR SENT
>
	SAVEAC <T2,CDB,Q1,Q2,Q3,P2>
	SKIPN CDB,TTDEV(T2)	;[8961]Get CDB 
	RET			;[8961]None, quit now
	MOVE Q1,T3		;[8961]Get safe copy of changes
	MOVE Q2,T1		;[8961]Get safe copy of flags
	MOVE P2,T2		;[8961]Get TDB in safe place.
	CALL LOKCDB		;[8961](T2,CDB) Get control of CTERM.
	 RET			;[8961]Failed. 
	CALL GETCHM		;[8961](/T1,T2) Get characteristics message buffer
	TXNN Q1,TT%LIC!TT%LCA	;[8961][8986]Has a case change request occurred?
	IFSKP.			;[8961]
	  TXC Q2,TT%LCA		;[8986]Yes, Complement "has lower case"
	  TXNN Q2,TT%LIC!TT%LCA	;[8961][8986]Want to raise lower case?
	  TDZA T3,T3 		;[8961]No
	  MOVEI T3,1		;[8961]Yes
	  MOVX T4,CH%RAI	;[8961]Get characteristic type
	  CALL SETCHR   	;[8961](T1,T2,T3,T4/T1,T2) Set it in the message
	   NOP			;[8961]Ignore any failure
	  TXC Q2,TT%LCA		;[8986]Restore original "has lower case" value
	ENDIF.			;[8961]
	TXNN Q1,TT%DUM		;[8963]Duplex mode change?
	IFSKP.			;[8963]
	  TXNE Q2,TT%DUM	;[8963]Yes, Half duplex requested?
	  TDZA T3,T3		;[8963]Yes, indicate so
	  MOVEI T3,1		;[8963]No, indicate so
	  MOVX T4,CH%NEC	;[8963]Get characteristic type
	  CALL SETCHR		;[8963](T1,T2,T3,T4/T1,T2) Set it in the message
	   NOP			;[8963]Ignore any errors
	ENDIF.			;[8963]
	CALL FNDOUT		;Send it off.
	 NOP			;Ignore error
	CALL ULKCDB		;Release CTERM
	MOVE T1,Q2		;Get flags back
	RET
	SUBTTL CTERM LAYER -- TDCALL -- SFMOD% JSYS

;	XRESCD			;[7.1024]Called NOSKED.

;CALL CTHSFM with
;	T1/ new settings
;	T2/ TDB
;Returns +1 always with T1/ new settings (poss. altered)
;			T2/ TDB
;Currently only changes the following in the server:
;
;  TT%OSP - Output Supress (1==supress output)

XRENT	(CTHSFM,G)		;[7.1024]CTHSFM::, XCTHSF::

	MOVE T3,T1		;Get copy of flags
	XOR T3,TTFLGS(T2)	;Get changes
	AND T3,[TT%OSP]		;Get only bits of interest
	JUMPE T3,RTN		;Done if nothing has changed
	TXNE T1,[TT%OSP]	;Do we want to no longer supress output?
	IFSKP.
	  SAVEAC <T1,T2,CDB>	;Yes, save important ACs
	  SKIPN CDB,TTDEV(T2)	;Get CDB 
	  RET			;None. Done.
	  SETONE CHSSD,(CDB)	;Set "do not discard" in next write msg
	ENDIF.
	RET			;All done.
	SUBTTL CTERM LAYER -- TDCALL -- CFIBF% JSYS
;Clear the server's input buffer 
;CALL CTHCLI with
;	T2/ TDB
;Returns +1
;Preserves all ACs
;Note that since this is called NOSKED, a request must be queued up and handled
;by clock level.

XRENT	(CTHCLI,G)		;[7.1024]CTHCLI::, XCTHCL::
				;[7.1024]Called NOSKED.

	SAVEAC <T2,T3,CDB>        	
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	SETONE CHCLI,(CDB)	;Flag it.
	LOAD T2,CHLIN,(CDB)	;Get line number
	CALLRET CTMSRV		;(T2) Call attention to it.

	XSWAPCD			;[7.1024]

;Here to actually send the message out
CTMCLI:	CALL LOKCDB		;(T2,CDB) Grab control of CTERM
	 RET			;Failed. 
IFN FTCOUN,<
	AOS %CTMSG+.CLRIN	;COUNT ONE MORE OF THIS FLAVOR MESSAGE OUTPUT
>
	CALL FNDCOM		;(CDB/T1,T2) Get output buffer
	SUBI T2,2		;Account for message type and flags
	IFGE. T2
	  MOVEI T3,.CLRIN	;Message type
	  IDPB T3,T1		; into message
	  SETZ T3,		;Flags
	  IDPB T3,T1
    	  CALL FNDOUT		;(T1,T2,CDB) Send it.
	   NOP			;Ignore error
     	ENDIF.
	CALLRET ULKCDB		;Let go of CTERM
	SUBTTL CTERM LAYER -- TDCALL -- MTOPR% JSYS -- SET/CLEAR PAGE STOP
;CALL CTHXON with:
;	T2/ TDB
;Returns +1 always, preserves T2

XNENT	(CTHXON,G)		;[7.1024]CTHXON::, XCTHXO::

	SAVEAC <CDB,P2>
	SKIPN CDB,TTDEV(T2)	;CDB present ?
	RET			;No. Done
	CALL LOKCDB		;(T2,CDB) Get control.
	 RET			;Failed
	MOVE P2,T2		;Save TDB
	MOVX T1,CH%PGS		;Get characteristic type
	LOAD T2,TTNXO,(P2)	;Get page stop bit
	CALL SNDCHR		;(T1,T2) Send the message
	 NOP              	;Ignore failure.
       	CALL ULKCDB		;Release CTERM
	MOVE T2,P2		;Restore TDB
	RET
	SUBTTL CTERM LAYER -- TDCALL -- MTOPR% JSYS -- SET TERMINAL SPEED
;CALL CTHSSP WITH:
;	T2/ TTY # 
;	T3/ input speed,,output speed
;Returns +1 always. doesn't need to preserve T2.
;Checks CTHSAP because it's called for all lines during system start-up

XNENT	(CTHSSP,G)		;[7.1024]CTHSSP::, XCTHSS::

	SKIPN CTHSAP		;HAS CTERM BEEN INITIALIZED YET?
	RET			;NO - CAN'T DO ANYTHING, THEN
IFN FTCOUN,<
	AOS %CTSPD		;COUNT ANOTHER STSPD
>
	SAVEAC <CDB,P2,P3>	;SAVE CTERM'S AC'S
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB.
	 RET			;Failed.
	MOVE P2,T2		;Put TDB in safe placee.
	MOVEM T3,TTSPWD(P2)	;Save the speeds in the TDB
	SKIPN CDB,TTDEV(T2)	;Get CDB.
	RET			;None. Done.
	CALL LOKCDB		;(T2,CDB) Get control of CTERM
	 RET	           	;Failed.
	CALL GETCHM		;(/T1,T2) Set up characteristics message buffer.
	HLRZ T3,TTSPWD(P2)	;Get input speed
	MOVX T4,CH%ISP		;Get characteristic type
	CALL SETCHR		;(T1,T2,T3,T4/T1,T2)
	 JRST CTHSSX		;Failed
	HRRZ T3,TTSPWD(P2)	;Get output speed
	MOVX T4,CH%OSP		;Get characteristic type
	CALL SETCHR		;(T1,T2,P3/P4)
	 JRST CTHSSX		;Failed.
	CALL FNDOUT		;Send the message
	 NOP			;Ignore failure
CTHSSX:	CALL ULKCDB		;Release CTERM
	RET
	SUBTTL CTERM LAYER -- TDCALL -- MTOPR% JSYS -- SET TERMINAL WIDTH
;CALL CTHSWD with:
;	T1/ new width
;	T2/ TDB
;Returns +1 always

XNENT	(CTHSWD,G)		;[7.1024]CTHSWD::, XCTHSW::

	SAVEAC <T2,CDB,Q1>
IFN FTCOUN,<
	AOS %CTWID		;COUNT ANOTHER STWID
>
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	SKIPE Q1,T1		;[9091]Save the width
	IFSKP. 			;[9091]Is the width zero?
	  LOAD T1,CHOST,(CDB)	;[9091]Yes, pickup the server's OS type
	  CAIN T1,.FBVMS	;[9091]Is it a VMS system?
	  RET			;[9091]Yes, don't send a CHARACTERISTICS update
	ENDIF.	  	 	;[9091]
	CALL LOKCDB		;(T2,CDB) Get control of CTERM
	 RET			;Failed
	MOVE T2,Q1		;Get value
	MOVX T1,CH%WID		;Get type
	CALL SNDCHR		;(T1,T2,CDB) Send it.
	 NOP			;Ignore failure
	CALLRET ULKCDB		;Release CTERM
	SUBTTL CTERM LAYER -- TDCALL -- MTOPR% JSYS -- SET TERMINAL LENGTH

;.MOSLL MTOPR FUNCTION - SET TERMINAL LENGTH
;CALLED FROM TTMSLN; SENDS A CHARACTERISTIC MESSAGE TO SERVER
;CALL WITH:
;	T1/ NEW LENGTH
;	T2/ TTY DYNAMIC DATA ADDRESS

XNENT	(CTHSLN,G)		;[7.1024]CTHSLN::, XCTHSL::

	SAVEAC <T2,CDB,Q1>
IFN FTCOUN,<
	AOS %CTLEN		;COUNT ANOTHER STLEN
>
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	MOVE Q1,T1		;Save length
	CALL LOKCDB		;(T2,CDB) Get control of CTERM
	 RET			;Failed
	MOVE T2,Q1		;Get value
	MOVX T1,CH%PLN		;Get characteristic type
	CALL SNDCHR		;(T1,T2,CDB) Send it.
	 NOP			;Ignore failure
	CALLRET ULKCDB		;Release CTERM
	SUBTTL CTERM LAYER -- TDCALL -- MTOPR% JSYS -- SET BREAK MASK
;CALL CTHSBM with
;	T1/ address of new break mask
;	T2/ TDB
;Returns +1 always, preservers T1, T2

XNENT	(CTHSBM,G)		;[7.1024]CTHSBM::, XCTHSB::

	SAVEAC <CDB>
        SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done
        DMOVE T3,(T1)      	;Get first two words of TDB break mask
	CAMN T3,CH.BR1(CDB)	;Same as last sent to server ?
	CAME T4,CH.BR2(CDB)
	IFSKP.
	  DMOVE T3,2(T1)     	;Yes. Check last two words
	  CAMN T3,CH.BR3(CDB)	;Same as last sent to server ?
	  CAME T4,CH.BR4(CDB)
	  IFSKP.
	    MOVE T3,TTFLG1(T2)	;Break set 
	    TXZ T3,TT%WKC	; is the 
	    MOVEM T3,TTFLG1(T2)	; same
	    RET
	  ENDIF.
	ENDIF.
	MOVE T3,TTFLG1(T2)	;Break set
	TXO T3,TT%WKC		; is
	MOVEM T3,TTFLG1(T2)	; different
	RET
	SUBTTL CTERM LAYER -- TDCALL -- CHANGE TERMINAL PAUSE/UNPAUSE CHARACTERS
;CALL CTHPPC with:
;	T1/ new pause character ,, new unpause character
;	T2/ TDB
;[8986]Returns +1 Either the pause or the unpause character or both are illegal
;[8986]           (Only control characters are legal. This restriction is
;[8986]            necessary since the pause and unpause characters are treated
;[8986]            as OUT-OF-BAND characters and OUT-OF-BAND characters can 
;[8986]            only be control characters.)
;[8986]Returns +2 The pause and unpause characters are both legal

XNENT	(CTHPPC,G)		;[7.1024]CTHPPC::, XCTHPP::

	SAVEAC <T1,T2,CDB,Q1,Q2,P2> ;[8986]
	SKIPN CDB,TTDEV(T2)	;Get CDB address
	RETSKP			;[8986]None, done
	MOVE Q2,T1		;[8986]Preserve new pause/unpause characters
	HRRZS T1		;[8986]Isolate the new unpause character
	CAIE T1,.CHNUL		;[8986]Is this character in
	CAIL T1,.CHSPC		;[8986] the proper range?
	RET			;[8986]No, indicate so
	HLRZ T1,Q2		;[8986]Pick up the new pause character
	CAIE T1,.CHNUL		;[8986]Is this character in
	CAIL T1,.CHSPC		;[8986] the proper range?
	RET			;[8986]No, indicate so
	LOAD T3,TTPPC,(T2)	;[8986]Pick up the old pause character
	LOAD T4,TTUPC,(T2)	;[8986]Pick up the old unpause character
	HRL T4,T3		;[8986]Old pause,,old unpause
	SUB T4,Q2		;[8986]Subtract the new from the old
	JUMPE T4,RSKP		;[8986]Return if no new characters specified
	CALL LOKCDB		;(T2,CDB) Grab control of CTERM
	 RETSKP			;[8986]Failed.
	MOVE P2,T2		;[8986]Put TDB in permanent place
	CALL GETCHM		;(/T1,T2) Set up for characteristic msg
	MOVEI T4,377		;Get change mask
	LOAD T3,TTPPC,(P2)	;Get old pause character
	MOVX Q1,<FLD(.CAOOX,CAOOB)> ;Not out of band, 
	CALL CTMPEC		;(T3,Q1/T3,Q1) Set echo up.
	CALL SETCHA		;[8986](T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Clear old pause
	 JRST CTMSPX          	;Failure.
	LOAD T3,TTUPC,(P2)	;Get old unpause character 
	MOVX Q1,<FLD(.CAOOX,CAOOB)> ;[8986]Not out of band, 
	CALL CTMPEC 		;(T3,Q1/T3,Q1) Set echo up.
	CALL SETCHA		;[8986](T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Clear old unpause
	 JRST CTMSPX		;[8986]Failure, release control of CTERM
	HLRZ T3,Q2		;Get new pause character.
	MOVX Q1,<FLD(.CAOOH,CAOOB)> ;Hello out of band, no echo.
	CALL SETCHA		;(T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Set it.
	 JRST CTMSPX          	;Failure.
	HRRZ T3,Q2		;[8986]Get new unpause character
	CALL SETCHA		;(T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Set it.
	 JRST CTMSPX          	;Failure.
	CALL FNDOUT		;(T1,T2,CDB) Send message.
	 NOP			;Ignore error.

CTMSPX: CALL ULKCDB		;[8986]Let go of CTERM
	RETSKP

;Routine to set the echo characteristic
;T3/ character
;Q1/ characteristic so far
;P2/ TDB
;Returns +1 always with Q1 updated
;All other ACs preserved
CTMPEC:	SAVEAC <T1,T2>  
	MOVE T1,FCMOD1(P2)	;Get control character echo words
	MOVE T2,FCMOD2(P2)
	ROTC T1,2(T3)		;Position it
	ANDI T2,3		;Mask off irrelevancies
	EXCH T2,Q1		;set up for call, save current characteristics
	CALL CTHSC1		;(T3,Q1/Q1) Get CTERM echo code
	IOR Q1,T2		;Restore other characteristic.
	RET
	SUBTTL CTERM LAYER -- TDCALL -- START OUTPUT

;	XRESCD			;[7.1024]

;Start output for a CTERM terminal
;CALL CTHSTO with
;	T2/ TDB address
;Returns +1 always
;Preserves T2.

XRENT	(CTHSTO,G)		;[7.1024]CTHSTO::, XCTHST::

	JN TTOTP,(T2),RTN	;If already in progress, done.
	SAVEAC <T2>
	SKIPN T1,TTDEV(T2)	;Get CDB
	RET			;None.
	SETONE TTOTP,(T2)	;Say output in progress
        LOAD T2,CHLIN,(T1)	;Get line number
        CALLRET CTMSRV		;(T2) Request service
	SUBTTL CTERM LAYER -- TDCALL -- ENABLE/DISABLE XON/XOFF RECOGNITION

;	XSWAPCD			;[7.1024]

;Here to enable/disable XON-XOFF recognition in server
;CALL CTHEXF WITH:
;	T2/ TDB
;Returns +1 always; preserves all ACs

XNENT	(CTHEXF,G)		;[7.1024]CTHEXF::, XCTHEX::

	SAVEAC <T1,T2,T3,T4,CDB> 
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	CALL LOKCDB		;(T2,CDB) Grab control of CTERM
	 RET			;Failed.
	MOVE T1,TTFLGS(T2)	;Get flags
	TXNN T1,TT%PGM		;Turning on XOFF-XON?
	TDZA T2,T2		;No - turn it off
	MOVEI T2,1		;Yes - turn it on
	MOVX T1,CH%FLW 		;Characteristic is output flow control
	CALL SNDCHR		;(T1,T2,CDB) Send it.
	 NOP			;Ignore failure
	CALLRET ULKCDB		;Let go of CTERM
	SUBTTL CTERM LAYER -- TDCALL -- FORCE OUTPUT 
;CALL CTHFOU with:
;	T2/ TDB
;Returns +1 always
;Preserves T2

XNENT	(CTHFOU,G)		;[7.1024]CTHFOU::, XCTHFO::

	SAVEAC <T2,CDB>            
	SKIPN CDB,TTDEV(T2)	;Get CDB address
	RET			;None. Done.
	CALL LOKCDB		;(T2,CDB) Get control of CTERM
	 RET			;Failed.
	CALL CTMSOT		;(T2,CDB) Force out output.
	 JRST CTHFOX            ;Failed.
IFN FTCOUN,<
	AOS %CTOSF		;OUTPUT DONE - COUNT ONE MORE FROM BUFFER-FULL
>
CTHFOX:	CALLRET ULKCDB		;Let go of CTERM
	SUBTTL CTERM LAYER -- TDCALL -- GET INPUT
;Get input from server with editing characters turned off.
;CALL CTHTCI with:
;	T2/ TDB
;Returns +1 always with T2 preserved

XNENT	(CTHTCI,G)		;[7.1024]CTHTCI::, XCTHTC::

	SAVEAC <T2,CDB>
        SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
  	CALL CTMSCC		;(T2,CDB) Send CCOC words, if changed.
	 RET
	MOVX T1,SR%DED		;Flags - disable editing chars.
	SETZ T2,		;No max length imposed
	SETZ T3,		;No ^R buffer
	CALLRET CTMSTR		;(T1,T2,T3,CDB) Do work.
	SUBTTL CTERM LAYER -- TDCALL -- GET INPUT FOR NRT
;Post read to server with all control characters turned off, no raise,
;echoing off, and input buffer length of one.
;CALL CTHNRT with:
;	T2/ TDB
;Returns +1 always with T1,T2 preserved
;T1 contains character in some cases.

XNENT	(CTHNRT,G)		;[7.1024]CTHNRT::, XCTHNR::

	SAVEAC <T1,T2,CDB>
        SKIPN CDB,TTDEV(T2)	;Get CDB
	RET			;None. Done.
	MOVX T1,<SR%DCC+SR%XEC+SR%RAN> ;Disable control, no echo, no raise
	MOVEI T2,1		;Length of one.
	SETZ T3,		;No ^R buffer
	CALLRET CTMSTR		;(T1,T2,CDB) Do work.
	SUBTTL CTERM LAYER -- MTOPR% JSYS -- ENABLE REMOTE EDITING 
;.MOTXT MTOPR%
;T2/ TDB
;USER AC3/ flags,,length
;Returns +1 on failure with T2/ TDB
;Returns +2 on success with T2/ TDB

XNENT	(CTHTXT,G)		;[7.1024]CTHTXT::, XCTHTX::

	SKIPLE TTICT(T2)	;Characters in input buffer already ?
	RETSKP			;Yes. Nothing to do.
	TMNE TTRFG,(T2)		;No. Has BKJFN% been done ?
	RETSKP			;Yes.  There is some character waiting.      
	LOAD T1,TT%DAM,+TTFLGS(T2) ;No. Get mode and
	LOAD T3,TYLCH,(T2)	; last character.
	CAIE T1,.TTBIN		;Is translation in effect and
	CAIE T3,.CHCRT		; is last character CR ?
	TRNA
	RETSKP			;No. There is a LF waiting.
	SKIPN T1,RSCNPT		;Rescan ptr set?
	IFSKP.
	  ILDB T1,T1		;Yes. Get character.
	  JUMPN T1,RSKP		;If it is null, it doesn't really exist.
	ENDIF.
 	SAVEAC <T2,CDB>
	SKIPN CDB,TTDEV(T2)	;Get CDB
	RETBAD (TTYX01)		;None.
  	CALL CTMSCC		;(T2,CDB) Send CCOC words, if changed.
	 RET
 	XCTU [HLRZ T3,3]	;Get flags
	XCTU [HRRZ T2,3]	;Get length
	SETZ T1,		;Initialize CTERM flags
	TXNE T3,RD%RIE		;Terminate on buffer empty ?
	TXO T1,SR%TIM		;Yes. Set "timeout field present".
	TXNE T3,RD%RAI		;Raise ?
	TXO T1,SR%RAE		;Yes. Set raise
	TMNE CHEDT,(CDB) 	;Does server support continuation read ?
	TXNE T3,RD%NED		;Yes. Editing characters in effect ?
	IFSKP.
	  TXO T1,<SR%UFT+SR%CTN+SR%DUR> ;Yes to both. Set up continuation read,
				; terminate on underflow, and
				; disable control-U and control-R.
	  TMNE CHRTI,(CDB)	;Does the server want ^R buffer? (T20 only)
	  IFSKP.
	    SETZ T3,		;No, clear prompt length
	  ELSE.
	    CALL GETPRO		;Yes, get ^R buffer, if any (User AC 4/T3)
	  ENDIF.
	ELSE.
	  SETZ T3,		;No prompt for VMS
	  TXO T1,SR%DED		;No to either. Disable them all.
	ENDIF.
	CALLRET CTMSTR		;(T1,T2,T3,CDB) Request data from the server
	SUBTTL CTERM LAYER -- SEND START READ -- ENTRY
;CALL CTMSTR with
;	T1/ flags
;	T2/ max length of read
;	T3/ length of ^R buffer
;	CDB/ CDB address
;Returns +1 always
CTMSTR:	SAVEQ
	STKVAR <RBFLEN>		;^R buffer length
	MOVE Q1,T1		;Save flags
	MOVE Q2,T2		;Save max length
	MOVEM T3,RBFLEN		;Save length of ^R buffer
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	 RET			;Failed.
	CALL LOKCDB		;(T2,CDB) Grab control of CTERM 
	 RET			;Failed.
	MOVE Q3,T2		;Save pointer to TDB.
	LOAD T1,TIMAX,(Q3)	;Get max input length
	SUB T1,TTICT(Q3)	;Subtract amount now in use
	TMNN TTOTP,(Q3) 	;Output in progress ?
	CAIGE T1,5		;No, is there too little input buffer left
	IFNSK.                  ;     to be worth a read?
 	  TMNE CHASR,(CDB)	;Yes, no read now.  Already have a queued read?
	  IFSKP.
	    TMNE CHRDA,(CDB)	;No. Is there a read active ?
	    IFSKP.
              SETONE CHASR,(CDB)  ;No. Defer read 
	      STOR Q1,CHRFL,(CDB) ;Save length and flags
	      STOR Q2,CHRLN,(CDB) ; in CDB
	      MOVE T3,RBFLEN      ;Get ^R buffer length
	      STOR T3,CHRBL,(CDB) ;Save ^R buffer length
	      LOAD T2,CHLIN,(CDB) ;Request
	      CALL CTMSRV         ;(T2) service.
	    ENDIF.
	  ENDIF.
	  CALLRET ULKCDB	;Unlock CTERM and done.
        ENDIF.
	TMNN CHRDA,(CDB) 	;Is there a read active ?
	IFSKP.
	  MOVE T3,TTFLG1(Q3)	;Yes. 
	  TXNN T3,TT%WKC	;Has break mask changed ?
	  JRST ULKCDB		;(CDB) No. Done.
	  CALL CTMURD		;(CDB) Yes. Issue UNREAD.
 	  LOAD T1,CHSTS,(CDB)	;Get status
	  TXNE T1,NSNDR		;Allowed to send ?
	  SKIPE MSGBLW		;Yes. Message buffer available ?
	  IFNSK.
	    SETONE CHASR,(CDB)	;No to one. Defer read.
	    STOR Q1,CHRFL,(CDB)	;Save length and flags
	    STOR Q2,CHRLN,(CDB)	; in CDB
	    MOVE T3,RBFLEN	;Get ^R buffer length
	    STOR T3,CHRBL,(CDB)	;Save in CDB also
	    LOAD T2,CHLIN,(CDB)	;Request
	    CALL CTMSRV		;(T2) service.
	    JRST ULKCDB		;Unlock CTERM and done.
	  ENDIF.
	ENDIF.
	SETZRO CHASR,(CDB)	;Read is longer deferred.
	MOVE T3,TTFLG1(Q3)	;Has break mask 
	TXNN T3,TT%WKC		; changed ?
	IFSKP.
	  TXZ Q1,SR%XDT		;Yes. Clear terminator set field.
      	  TXO Q1,SR%XDR		;Set "terminator set included in this read".
	ENDIF.
	MOVE T3,TTFLGS(Q3)	;Get flags.
	TXNN T3,TT%ECO		;Echo on ?
	IFSKP.
	  TXO Q1,SR%TEC		;Yes. Set "terminator echo"
	ELSE.
	  TXO Q1,SR%XEC		;No. Set "no echo" in message.
	ENDIF.
	TMNE TYLMD,(Q3)		;Binary mode ?
	IFSKP.
	  TMNE TTNUS,(Q3)	;Yes.  Outgoing NRT ?
	  IFSKP.
	    TXZ Q1,SR%DCD+SR%RAI+SR%TEC	;No. Clear disable control, raise fields, and terminator echo.
	    TXO Q1,SR%DCC+SR%RAN+SR%XEC ;[8977]Disable control characters, no raise and no echo.
	  ENDIF.
	ENDIF.
	CALL FNDCOM		;(/T1,T2) Set up message buffer
	SUBI T2,.SRHLN		;Header length (up to, not incl. term. set)
	JUMPL T2,RTN		;If not enough room, punt.
	MOVX T3,.SREAD		;Message type
	IDPB T3,T1		;Put into message
	MOVE T4,[POINT 8,Q1] 	;Point to flags
	ILDB T3,T4		;Get them and put them into message
	IDPB T3,T1
	ILDB T3,T4
	IDPB T3,T1
	ILDB T3,T4
	IDPB T3,T1
	CALL CTMLEN		;(T1,T2,Q2,Q3,CDB/T1,T2) Set up max length
	SETZ T3,
	MOVE T4,RBFLEN		;Restore ^R buffer length
	PUT2BY T1,T4		;Put Rbuf length into END-OF-DATA
	PUT2BY T1,T3		;Zero TIMEOUT
	MOVE T4,RBFLEN		;Restore ^R buffer length
	PUT2BY T1,T4		;Rbuf length as END-OF-PROMPT
	PUT2BY T1,T3		;ZERO START-OF-DISPLAY
	MOVE T4,RBFLEN		;Restore ^R buffer length
	PUT2BY T1,T4		;Rbuf length as LOW-WATER
	CALL CTMSTS		;(T1,T2,Q3,CDB/T1,T2) Set up terminator set
	SKIPE RBFLEN		;Is there a prompt string to send?	
	CALL CTMRBF		;Yes,(T1,T2,CDB/T1,T2) Put ^R buffer in message
	CALL FNDOUT		;No,(T2,CDB) Send message
	IFSKP.
	  SETONE CHRDA,(CDB)	;Succeeded. Say a read is active
	  SETZRO CHDSO,(CDB)	;[7180] Server is no longer discarding output.
	ENDIF.
	CALLRET ULKCDB		;Let go of CTERM
	SUBTTL CTERM LAYER -- SEND START READ -- SET UP MAXIMUM LENGTH
;CALL CTMLEN with
;	Q3/ TDB address
;	CDB/ CDB address
;	T1/ byte pointer to message
;	T2/ count of space left in message
;Returns +1 always with T1,T2 updated
CTMLEN:	LOAD T3,CHMAX,(CDB)	;Get server's max input buffer count
	LOAD T4,TTFCNT,(Q3)	;Get the terminal's field width
	CAIE T4,0		;If zero, use server's max.
	CAMLE T4,T3		;Else, use minimum of field width and 
	MOVE T4,T3		; server's max.
	LOAD T3,TIMAX,(Q3)	;Get max input length
	SUB T3,TTICT(Q3)	; minus length we've used
	CAMLE T4,T3		;Is remaining space smaller?
	MOVE T4,T3		;Yes. Use that for size.
	IFN. Q2  		;Caller's length meaningful ?
	  CAMGE Q2,T4		;Yes. Is caller's length smaller ?
	  MOVE T4,Q2		;Yes. Use it
	ENDIF.
	PUT2BY T1,T4		;Put max length into message
 	RET
	SUBTTL CTERM LAYER -- SEND START READ -- SET UP TERMINATOR SET
;CALL CTMSTS with
;	Q3/ TDB address
;	CDB/ CDB address
;	T1/ byte pointer to message
;	T2/ count of space left in message
;Returns +1 always with T1,T2 updated
CTMSTS:	SAVEAC <Q1,Q2>
	MOVE T3,TTFLG1(Q3) 	;Get flags
	TXZE T3,TT%WKC     	;Break set same as last sent to server ?
	IFSKP.
	  SETZ T3,		;Yes. No terminator set needed, since server
	  IDPB T3,T1		; remembers.
	  SOS T2
	  RET
	ENDIF.
	MOVEM T3,TTFLG1(Q3)	;Update flags
	DMOVE T3,TTCHR1(Q3)	;Update terminator set in CDB
	DMOVEM T3,CH.BR1(CDB)
	DMOVE T3,TTCHR3(Q3)	
	DMOVEM T3,CH.BR3(CDB)	
	SUBI T2,^D17		;Account for break mask (terminator set) 
	MOVEI Q2,^D16		;Always send whole break mask.
	IDPB Q2,T1		;Put in size.
	MOVE Q1,TTCHR1(Q3)	;Get first word of break mask
	TXNN Q1,1B<.CHLFD>	;Is line feed on ?
	IFSKP.
	  SETZRO CHRCX,(CDB)    ;Yes. 
	ELSE. 
	  SETONE CHRCX,(CDB)	;No. CR-LF forced on in server's break mask.
	ENDIF.
	TXO Q1,<1B<.CHCRT>+1B<.CHLFD>> ;Always set CR and LF
	EXCH Q1,TTCHR1(Q3)	;Save first (poss. altered) word of break mask
	XMOVEI T3,TTCHR1(Q3)  	;Point to 
	TXO T3,<OWGP. 8,0>	; terminator set
	DO.
	  ILDB T4,T3		;Get byte
	  ADD T4,SWPTBL		;Point into swap table
	  MOVE T4,(T4)          ;Swap it around.
	  IDPB T4,T1		;Put into message
	  SOJG Q2,TOP.		;Continue.
	ENDDO.
	MOVEM Q1,TTCHR1(Q3)	;Restore first word of break mask
	RET
	SUBTTL CTERM LAYER -- SEND START READ -- PUT ^R BUFFER IN MESSAGE
;CALL CTMRBF with
;	CDB/ CDB address
;	T1/ byte pointer to message
;	T2/ count of space left in message
;Returns +1 always with T1,T2 updated
CTMRBF:	MOVX T3,<POINT 7,CH.RBF(CDB)> ;Get pointer to ^R buffer
RBFLOP:	ILDB T4,T3		;Get a byte from the buffer
	JUMPE T4,RTN		;end of message? Done.
	IDPB T4,T1		;Put it in the message
	SOJG T2,RBFLOP		;Decrement message count and get some more
	RET			;done.
	SUBTTL CTERM LAYER -- SEND START READ -- SEND UNREAD MESSAGE

;CALL CTMURD with
;          CDB/ CDB address
;	   CDB locked
;Returns +1 always
CTMURD:
IFN FTCOUN,<
	AOS %CTMSG+.UREAD	;COUNT ONE MORE OF THIS FLAVOR MESSAGE OUTPUT
>
	CALL FNDCOM		;(/T1,T2) Get message buffer
	SUBI T2,2		;Account for message type and flags
	JUMPL T2,RTN		;If no room, done
	MOVEI T3,.UREAD		;Message type
	IDPB T3,T1		;Into message
	SETZ T3,		;Flags
	IDPB T3,T1		;Into message
	CALL FNDOUT		;(T2,CDB) Send it
	 NOP			;Ignore failure
	RET
	SUBTTL CTERM LAYER -- CHECK CCOC WORDS
;Here to check the CCOC words. Send any changes to the server.
;CALL CTMSCC with 
;	CDB/ CDB address
;	T2/  TDB address
;Returns +1 on failure, +2 on success
;Preserves T2
CTMSCC:	LOAD T1,CHCO1,(CDB)	;Get first word
	LOAD T3,CHCO2,(CDB)	;Get second word
	CAME T1,FCMOD1(T2)	;Unchanged ?
	IFSKP.
	  CAMN T3,FCMOD2(T2)	;Unchanged ?
	  RETSKP        	;Yes. Done.
	ENDIF.
;There are some changes.
	SAVEAC <T2,Q1,Q2,Q3,P2,P3,P4>
	MOVE P2,T1		;Get old CCOC
	MOVE P3,T3		; words
	CALL LOKCDB		;(T2,CDB) grab control of CTERM
	 RET			;Failed.
	MOVE Q2,FCMOD1(T2)	;Get new CCOC
	MOVE Q3,FCMOD2(T2)	; words
	STOR Q2,CHCO1,(CDB)	;Update
	STOR Q3,CHCO2,(CDB)	; CCOC words in CDB
	XOR P2,Q2		;Get 
	XOR P3,Q3		; changes
	CALL GETCHM		;(/T1,T2) Set up characteristics message.
	MOVSI P4,-^D32		;Loop control
	MOVX T4,CACEC		;Get echo mask
	DO.
	  TLNN P2,600000	;Any changes ?
	  IFSKP.
	    LDB Q1,[POINT 2,Q2,1] ;Yes. Get new CCOC field
	    HRRZ T3,P4		;Get character
	    CALL CTHSC1		;(T3,Q1/Q1) Convert to CTERM echo field
	    CALL SETCHA		;(T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Set it.
	     JRST ULKCDB	;Failed, unlock CDB
	  ENDIF.
	  LSHC Q2,2		;Position new CCOC words
	  LSHC P2,2		;Position the changes
	  AOBJN P4,TOP.		;Loop.
	ENDDO.
	CALL FNDOUT		;(T2) Send out the message
	 JRST ULKCDB		;Failed, unlock CDB
	CALL ULKCDB		;Success, unlock CDB
	RETSKP		
;Subroutine to convert TOPS20 CCOC code to CTERM echo field
;CALL CTHSC1 with
;	T3/ character
;	Q1/ TOPS20 CCOC code
;Returns +1 always with
;	Q1/ CTERM echo field
;All other registers preserved.
CTHSC1: CAIE T3,.CHLFD		;Is it line feed or
        CAIN T3,.CHCRT		; or carriage return ?
        IFNSK.
          CAIGE Q1,2		;[7392]Yes. Is CCOC "as is" or field format ?
          ANSKP.
            MOVEI Q1,2_4	;Yes. Special case.
        ELSE.
          CAIN Q1,3		;No. Is CCOC field format ?
          CAIE T3,.CHESC	;Yes. Is it escape ?
          IFSKP.
            MOVEI Q1,2_4	;Yes to both. special case.
	  ELSE.
            MOVE Q1,CNVTAB(Q1) 	;No to either. The usual case - use the table
	  ENDIF.
        ENDIF.
	RET

;Conversion table from TOPS20 CCOC field to CTERM echo field for out of bands
;The shift by 4 is to position for insertion into characteristic message
CNVTAB:	0_4			;Ignore
	2_4			;^X (doesn't work for CR, LF, ESC - CTERM deficiency)
	1_4			;Echo as self
	1_4			;Format (CR & LF handled differently)
	SUBTTL SYSTEM INITIALIZATION -- ENTRY

;Initialize the CTERM system 
;CALL CTHINI with no arguments.
;Returns +1 always 

XNENT	(CTHINI,G)		;[7.1024]CTHINI::, XCTHIN::

	SETZM MSGCWL		;No connections are outstanding
	CALL MSGINS		;() Initialize CTERM data base
	CALL CTHBIT		;() Initialize swap table
	CALL CTMRUN		;() Start up CTERM clock level fork
	RET
	SUBTTL SYSTEM INITIALIZATION -- CTERM DATA BASE
;Initialize: 
;CTHCHP - Channel table address
;CTHSAP - CTERM SAB address
;The CTERM SAB is also initialized.
;CALL MSGINS with no arguments
;Returns +1 always
MSGINS:	MOVEI T1,NTTCTH+1	;GET LENGTH OF CHANNEL TABLE
	CALL DNGWDZ		;[7.1024](/T1) GET ZEROED FREE SPACE TO STORE IT IN
	 JSP CX,MSGINE		;ERROR - FATAL BUG
	MOVEM T1,CTHCHP		;SAVE ADDRESS OF CHANNEL TABLE
	
	MOVEI T1,CTHMGL       	;Size of output message buffer in words
	CALL DNGWDS		;[7.1024]get free space
	 JSP CX,MSGINE		;Fatal error
	TXO T1,<OWGP. 8,0>	;Make byte pointer
	MOVEM T1,MSGOMP		;Save it.

	MOVX T1,SA.LEN		;Get length of an SAB
	CALL DNGWDS		;[7.1024](/T1) Get the free space for it
	 JSP CX,MSGINE		;ERROR - FATAL BUG
	MOVEM T1,CTHSAP		;Store address of SAB

	MOVE T1,[FLD(^D9,PDGOL) ! FLD(^D16,PDDQT) ! FLD(^D50,PDIPR)]
	CALL <XENT MAKSJB>	;[7.1024](T1/T1) MAKE SJB (GOAL:11 QUOTA:16, INPUT %:50)
	 JSP CX,MSGINE		;ERROR - FATAL BUG
	MOVE T2,CTHSAP		;Get back SAB address
	STOR T1,SASJB,(T2)	;SAVE SJB POINTER IN SAB
	SETZRO <SAFLG>,(T2) 	;Clear all MONUSR flags.
	SETONE SAEVA,(T2)	;except the "EXEC VIRTUAL SPACE" bit.
	XMOVEI T1,MSGHBR	;Set up address of hibernate routine
	STOR T1,SAHBA,(T2)	; in the SAB
	XMOVEI T1,MSGINT	;Set up address of hibernate routine
	STOR T1,SAWKA,(T2)	; in the SAB
	MOVEI T1,400		;Set up address of swap bit table
	CALL DNGWDS		;[7.1024]
	JSP CX,MSGINE		;[7.1024]
	MOVEM T1,SWPTBL
	RET

;Here if error trying to get free space while initializing
MSGINE:	 BUG.(CHK,CTDFSA,CTHSRV,SOFT,<Can't get free space for CTERM>,,<

Cause:	During system startup CTERM couldn't get enough free space.

Action:	Go into SYSDPY's RE display and see which freespace pool is
	being used up. If this happens frequently, there may be a
	software bug loosing the freespace. However, there may be
	insufficient freespace in the pool that has run out. You
	could try to increase that pool's size in your monitor.
>)
	SUBTTL SYSTEM INITIALIZATION -- SWAP TABLE

;Initialize the swap table needed for when bits in an 8 bit byte are in the
;wrong order.
;Call CTHBIT with no arguments
;Returns +1 always with SWPTBL set up.
CTHBIT:	SAVEAC <Q1>
	SETZ T2,		;Initialize current number
	MOVE T1,SWPTBL		;Initialize pointer into table.
	DO.			;Outer loop -
       	  MOVEI T3,1		;initialize current bit to look at.
	  MOVEI T4,200		;initialize mirror bit.
	  SETZ Q1,		;initialize result.
	  DO.			;inner loop -
       	    TRNE T2,(T3)	;Is this bit set ?
	    TRO Q1,(T4)		;Yes. Set the mirror bit in the result.
	    LSH T3,1		;Update current bit.
	    LSH T4,-1		;Update mirror bit.
	    JUMPN T4,TOP.   	;Continue inner loop.
	  ENDDO.
	  MOVEM Q1,(T1)         ;Put result into table.
	  AOS T2		;Update current number.
	  AOS T1		;Update pointer into table.
	  CAIGE T2,400		;Done ?
	  LOOP.      		;No. Continue outer loop
	ENDDO.
	RET			;Done.
	SUBTTL UTILITY ROUTINES -- SET UP FOR CHARACTERISTIC MESSAGE
;CALL GETCHM with 
;	CDB/ CDB address
;       CTERM locked.
;Returns +1 always with
;	T1/ byte pointer to message buffer
;	T2/ byte count of spcae left in buffer
GETCHM:	CALL FNDCOM		;(CDB/T1,T2)
	SUBI T2,2		;Account for message type and flags 
	JUMPL T2,RTN		;No room
	MOVEI T3,.CHARS		;Characteristic message type
	IDPB T3,T1
	SETZ T3,		;Flags
	IDPB T3,T1
	RET
	SUBTTL UTILITY ROUTINES -- SEND CHARACTERISTIC
;Send one characteristic to the server
;CALL SNDCHR with
;	T1/ characteristic identifier
;	T2/ value
;	CDB/ address of CDB
;	CTERM locked
;Returns +1 on failure
;Returns +2 on success
SNDCHR:	STKVAR <TYPE,VALU>
	MOVEM T1,TYPE		;Save arguments
	MOVEM T2,VALU
	CALL GETCHM		;(/T1,T2) Set up header
	MOVE T3,VALU		;Set up value
	MOVE T4,TYPE		;Set up type
	CALL SETCHR		;(T1,T2,T3,T4)
	 RET
	CALL FNDOUT		;(T1,T2,CDB) Call foundation layer to send it out.
	 RET			;Failure
	RETSKP			;Success
	ENDSV.			;END STKVAR
	SUBTTL UTILITY ROUTINES -- SET ATTRIBUTE
;Set up a characterstic in a CTERM characteristic message
;CALL SETCHR with:
;T1/ pointer
;T2/ count
;T3/ value
;T4/ characteristic type 
;Returns +1 on failure, 
;Returns +2 on success with T1,T2 updated.
;Intended for using multiple times 
SETCHR:	IDPB T4,T1		;Insert char. ident.
	ROT T4,-10
	IDPB T4,T1		;Insert char. type
	ROT T4,10		;Get flags back.
	SUBI T2,2		;Update count
	LOAD T4,CHTYP,+T4	;Get the value type.
	CALLRET @SETCHT(T4)	;(T1,T2,T3/T1,T2) Dispatch

SETCHT:	XADDR. SETCHB		;[7.1024]Boolean
	XADDR. SETCHV		;[7.1024]Integer
	XADDR. SETSTG		;[7.1024]String 
	IFIW RTN   		;Character attribute - use routine SETCHA

;Set boolean value
SETCHB:	SOJL T2,RTN		;If no room, fail.
	IDPB T3,T1		;Put value
	RETSKP			;Done.

;Set integer value 
SETCHV:	SUBI T2,2		;Update count
	JUMPL T2,RTN		;If no room, fail.
	PUT2BY T1,T3		;Put into message
	RETSKP

;Set string value
;T3/ byte pointer to ASCIZ string
SETSTG:	SAVEAC <Q1,Q2>
	SETZ Q1,		;Accumlate string byte count.
	MOVE Q2,T1		;Save byte pointer for inserting count.
	IDPB Q1,T1		;Advance byte pointer.
	SOSG T2			;Account for it
	RET			;No room.
	DO.
	  ILDB T4,T3		;Get byte
	  JUMPE T4,ENDLP.	;If null, done.
	  SOJL T2,RTN		;Update count, if no room, quit.
	  IDPB T4,T1		;Put byte
	  AOJA Q1,TOP.		;Update string byte count, and continue.
	ENDDO.
	IDPB Q1,Q2		;Insert count
	RET
	SUBTTL UTILITY ROUTINES -- SET CHARACTER ATTRIBUTE
;Set up a character attribute in a CTERM characteristic message
;CALL SETCHA with:
;T1/ pointer
;T2/ count
;T3/ character
;T4/ change mask
;Q1/ new value
;Returns +1 on failure, 
;Returns +2 on success with T1,T2 updated and all other ACs unchanged.
;Intended for using multiple times.
SETCHA:	SAVEAC <Q2>
	SUBI T2,5		;Number of bytes to insert.
	JUMPL T2,RTN		;No room.
	MOVX Q2,CH%CAT		;Get ident.
	IDPB Q2,T1		;Insert it
	LSH Q2,-10		;Get type
	IDPB Q2,T1		;Insert
	IDPB T3,T1		;Insert character
	IDPB T4,T1		;Insert change mask
	IDPB Q1,T1		;Insert value
	RETSKP			;Done.
	SUBTTL UTILITY ROUTINES -- PROTOCOL ERROR
;Here on a protocol error, aborts the link.
;Returns +1 always
CTMPER:	LOAD T4,CHIMB,(CDB)	;Get pointer to beginning of DECnet message
	BUG.(INF,CTDPRR,CTHSRV,SOFT,<CTERM protocol error>,<<T2,COUNT>,<T4,BEGIN>,<CDB,CDB>>,<

Cause:	A server has sent TOPS-20 a message which it does not like.

Action:	The DOB% facility should have taken a dump of this BUG. If
	not and this BUGINF persists, change it to a BUGHLT. Examine the
	message in the dump to determine the problem.

Data:	COUNT - The current byte count
	BEGIN - The pointer to the beginning of the message
	CDB - The CDB
>)
	CALLRET CDBDEL 		;Release resources.
	SUBTTL UTILITY ROUTINES -- REQUEST DELETE CDB
;Change state to "Deleting the CDB" and request service
;CALL CDBDEL with
;	CDB/ CDB address
;Returns +1 always
CDBDEL:	MOVEI T3,.STDEL         ;Set state to 
	STOR T3,CHSTA,(CDB)	; "Deleting the CDB"
	LOAD T2,CHLIN,(CDB)	;Get TTY #
	CALL CTMSRV		;Request service (CALL MSGREL)
	RET
	SUBTTL UTILITY ROUTINES -- REQUEST SERVICE

	XRESCD			;[7.1024]Called from CTHSTO - called from scheduler

;Request service for a CTERM line
;CALL CTMSRV with
;	T2/ line number
;Returns +1 always
;TRASHES T2
CTMSRV:	SUB T2,TT1LIN+TT.CTH	;Make it relative to the first CTERM line
	IDIVI T2,^D36		;Compute bit position in queue
	MOVE T3,BITS(T3)	;Set the terminal's bit
	IORM T3,CHSOQ(T2)	; to request service from scheduler.
	SETOM CTMWAG		;Flag to scheduler 20 mS cycle to pay attention
	RET
	SUBTTL UTILITY ROUTINES -- Identify CTERM terminal type (.MOCTM)
;CTHTID - Identify CTERM terminal type (.MOCTM)
;Call:	T2/ TDB
;RETURNS +1 Always, with T3/ 1 =TTY is CTERM TTY 2=TTY is VMS CTERM TTY

XRENT	(CTHTID,G)		;[7.1024]CTHTID::, XCTHTI::

	SKIPN T1,TTDEV(T2)	;Get CDB
	RET			;Failed
	MOVEI T3,1		;Assume TTY is CTERM
 	TMNN CHEDT,(T1)		;Does server support continuation read?
	MOVEI T3,2		;No, Must be VMS CTERM
	RET			;Yes, must be regular CTERM
	SUBTTL UTILITY ROUTINES -- Get prompt string from user byte pointer
;GETPRO - Get User ASCIZ String
;Call:	T1/ User's ASCIZ Pointer
;	T3/ Maximum string count permitted
;RETURNS +1 always
;	T3/ Actual string count

GETPRO:	SAVEAC <Q1,T1>
	MOVX Q1,<POINT 7,CH.RBF(CDB)>
	XCTU [MOVE T1,4]	;Get pointer to ^R buffer
	SETZ T3,		;Clear the string count
	TLC T1,-1		;Make an ASCII pointer to the
	TLCN T1,-1		; user's buffer
	HRLI T1,(<POINT 7,0>)	; if necessary.
GTPRO1:	XCTBU [ILDB T4,T1]	;Get a character from his string.
	IDPB T4,Q1		;Deposit character in ^R buffer storage
	JUMPE T4,RTN		;Null found so string ended
	CAML T3,RBFCNT		;If we are at the maximum, read no more.
	RET
	AOJA T3,GTPRO1		;Increment string count
	ENDSV.
	SUBTTL UTILITY ROUTINES -- LOCK CDB

	RESCD			;[7.1024]SCHEDULER TESTS ALWAYS IN RESCD

;Scheduler test for output-blocked
;T1/ TTY #
;Returns +2 if link can now send or if link is in a bad state
;Returns +1 if link cannot send and is still in run state.
LOKWAI:	SKIPE MSGBLW		;Is output blocked ?
	RET			;Yes. Wait some more.
	MOVE T2,T1		;No.
	CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get TDB
	 RETSKP			;Failed. Done waiting
	SKIPN T1,TTDEV(T2)	;Get CDB.
	RETSKP			;Failed. Done waiting
	LOAD T1,CHSTS,(T1)	;Get status.
	TXNE T1,NSNDR		;Allowed to send ?
	RETSKP			;Yes. Done waiting.
	ANDI T1,NSSTA		;Get state.
	CAIE T1,.NSSRN		;[7.1209]Is it run ?
	RETSKP			;No. Done waiting.
	RET			;Yes. Wait some more.

	XRESCD			;[7.1024]BACK TO XRESCD

;Lock CDB, waiting if needed.
;Clock level never waits.
;CALL LOKCDB with 
;	CDB/ CDB address.
;	T2/ TDB address, TTY locked.
;Returns +2, on success, with T2 & CDB preserved.
;Returns +1 on failure
;To unlock CDB, call ULKCDB
;Uses T1,T3,T4
LOKCDB:	MOVE T1,FORKX		;The 
	CAMN T1,CTMFRK		; CTERM background fork ?
	IFSKP.
	  LOCK CTMLOK		;No. Must get lock. 
	ENDIF.
	DO.
	  LOAD T4,CHSTS,(CDB)	;Can 
	  TXNE T4,NSNDR		; this link send ?
	  SKIPE MSGBLW		;Yes. Is it OK to output ?
	  IFSKP.		 
	    MOVEM T1,LKFRK	;Yes to both. Save fork index
	    MOVE T1,(P)		;and caller's PC
	    MOVEM T1,LOKPC
	    RETSKP		;Done.
	  ENDIF.
	  CAMN T1,CTMFRK	;No sending. Is this the background fork ?
	  RET			;Yes.  Fail.
	  ANDI T4,NSSTA		;Get state
	  CAIE T4,.NSSRN	;Is it run ?
	  JRST LOKCD0		;No. Blow it away
	  LOAD T3,CHUID,(CDB)	;No. Block. Get CDB unique id.
	  UNLOCK CTMLOK		;Give back control. 
	  LOAD T1,CHLIN,(CDB)	;Get TTY #
	  HRL T1,T1
	  HRRI T1,LOKWAI	;Address of block routine
	  MDISMS		;Wait until available.
	  LOCK CTMLOK		;Grab control.
	  LOAD T2,CHLIN,(CDB)	;Get line number
	  CALLX (MSEC1,STADYN)	;[7.1024](T2/T2) Get the TDB.
	   JRST LOKCD2		;Failed
	  MOVE T1,TTDEV(T2)	;Get the CDB.
	  CAME T1,CDB		;Same as old one ?
	   JRST LOKCD2		;Failed
	  OPSTR <CAME T3,>,CHUID,(CDB) ;Check the unique id.
	   JRST LOKCD2		;Failed
	  LOOP.			;Passed all revalidation checks. Try for lock.
	ENDDO.
LOKCD0:	CALL CDBDEL		;(CDB) Release link
LOKCD2:	UNLOCK CTMLOK		;Let go of lock
	RET

;Unlock a CDB
;CALL ULKCDB with
;	CDB/ CDB address 
;	T2/ TDB address
;Returns +1 always
;Preserves all ACs
ULKCDB:	SAVEAC <T1>
	MOVE T1,FORKX			;Is this clock level ?
	CAMN T1,CTMFRK
	RET				;Yes. Done.
	UNLOCK CTMLOK
	SETZM LOKPC
	SETZM LKFRK
	RET

;CHRRH - CTERM device dependent "return remote host" code
;
; Given the line #, returns the originating hostname, line and
; network type. Places this info in the users NTINF% .NWRRH 
; argument block.  NTINF has already checked the user arguments 
; for validity.
;
; Call with T1/ address of internal arg block
;
;   ARG+.NWABC/ # of bytes available for host name
;   ARG+.NWFNC/ not used
;   ARG+.NWNNP/ byte pointer to store hostname string
;   ARG+.NWLIN/ address of dynamic data for line
;   ARG+.NWTTF/ flags, and network and terminal types
;   ARG+.NWNNU/ node # word 1
;   ARG+.NWNU1/ node # word 2
;
; Returns + 1 on error with T1/ error code
;	  + 2 on success

XRENT	(CHRRH,G)		;[7.1024]CHRRH::, XCHRRH::

	SASUBR <UAB>
	SAVEQ			;[9041] Can't be bashing these now
	MOVEM T1,UAB		;SAVE OUTPUT POINTER
	MOVX T4,NW%DNA		;SET NETWORK TYPE
	DPB T4,[POINT 9,.NWTTF(T1),17] ;STORE NETWORK TYPE
	MOVE T2,.NWLIN(T1)	;GET DYNAMIC DATA ADR
	NOSKED
	SKIPN T3,TTDEV(T2)	;GET LINK INDEX
	JRST CHRRH3		;IN CASE ALREADY GONE
	XMOVEI Q1,CH.USR(T3)	;[9041] Get address of username string
	LOAD Q3,CHRID,(T3)	;[9041] Get DECnet address 
	OKSKED	
	MOVEM Q3,.NWNNU(T1)	;[9041] Save it away
	IFE. Q3			;[9041] Have an address at all?
	  MOVE T3,UAB		;[9041] Get argument block address
	  MOVE T2,.NWNNP(T3)	;[9041] Get byte pointer
	  SETZ T3,		;[9041] No known node name flag
	  JRST CHRRH2		;[9041] And say no node at all
	ENDIF.			;[9041]
	MOVE T1,Q3		;[9041] Put address where SCTA2N wants it
	CALL <XENT SCTA2N>	;[7.1024]CONVERT # TO SIXBIT NAME
	IFNSK.
	  MOVE T3,UAB		;[9041] Get argument block address
	  MOVE T1,.NWNNP(T3)	;[9041] Get byte pointer to output string
	  MOVE T2,Q3		;[9041] Get node address back
	  IDIVI T2,^D1024	;[9041] Get area number
	  PUSH P,T3		;[9041] Save machine number for later
	  MOVX T3,<FLD(^D10,NO%RDX)> ;[9041] Output in decimal please
	  NOUT%			;[9041] Slam area number in string
	   ERJMP .+1
	  MOVEI T2,"."		;[9041] Get area/machine seperator
	  IDPB T2,T1		;[9041] And drop it in the string
	  POP P,T2		;[9041] Retrieve the machine number
	  MOVX T3,<FLD(^D10,NO%RDX)> ;[9041] Output it in decimal
	  NOUT%			;[9041] Put it in
	   ERJMP .+1
	  MOVE T2,T1		;[9041] Get byte pointer in correct AC
	  SETZ T3,		;[9041] But say no node name (even though number was given)
	  JRST CHRR15		;[9041] And continue
	ENDIF.
	MOVE T3,UAB		;GET ARG BLOCK ADDRESS
	MOVE T2,.NWNNP(T3)	;GET POINTER TO OUTPUT STRING
	CALLX (MSEC1,GETSIX)	;[7.1024]CONVERT SIXBIT TO ASCII
	;..
	;..
;[9041] - Here when node name or AREA.NUMBER has been determined. Now
;try to put in the username string if we have one.
CHRR15:	SKIPN (Q1)		;[9041] Is there a username?
	JRST CHRRH2		;[9041] No, don't bother with "::"
	MOVEI T1,":"		;[9041] Get node and user seperator
	IDPB T1,T2		;[9041] Insert it once
	IDPB T1,T2		;[9041] And a second time to be sure
	TXO Q1,<OWGP. 7>	;[9041] Make this a one word global byte pointer
	DO.			;[9041] Now copy in username
	  ILDB T1,Q1		;[9041] Get a username byte
	  JUMPE T1,ENDLP.	;[9041] All out, get out of loop
	  IDPB T1,T2		;[9041] Put username byte into string
	  JRST TOP.		;[9041] And do more
	OD.			;[9041]

CHRRH2:	MOVEI T1,.CHNUL		;[9041] Get a null
	IDPB T1,T2		;DEPOSIT A NULL
	MOVE T1,UAB		;GET POINTER TO USER ARG BLOCK
	MOVX T2,NW%NNN		;GET "NO NODE NAME KNOWN" FLAG
	SKIPN T3 		;GOT A NODE NAME ?
	IORM T2,.NWTTF(T1)	;NO - SET THE "NO NODE NAME KNOWN" FLAG
	RETSKP

CHRRH3:	OKSKED
	MOVE T1,UAB		;GET POINTER TO ARG BLOCK
	MOVE T2,.NWNNP(T1)	;GET POINTER TO OUTPUT STRING
	SETZ T3,		;NO NODE NAME
	CALLRET CHRRH2		;UPDATE HOSTNAME STRING, AND RETURN
	SUBTTL Fetch User from DECnet Connect Message
;[9041]
;FETUSR - This routine is called when a connect initiate message
;is received for CTERM. The remote username string is extracted
;out of the connect initiate message and slammed into the CDB.
;
; Call with:
;	T1/ Address of connect block from SCLINK
;	CDB/ Address of CDB (CH block)
;	CALL FETUSR
;
; Returns:
;	+1 - Always, with the remote username in CHUSR

	XSWAPCD			;Called by CTERM fork

FETUSR:	SAVET			;These are used
	ADDI T1,<CB.SRC+2>	;Remote username string starts here
	TXO T1,<OWGP. 8>	;Make one word global byte pointer
	XMOVEI T2,CH.USR(CDB)	;Get address of place to put username string
	TXO T2,<OWGP. 7>	;Make it a one word global byte pointer
	MOVEI T4,MAXLC		;Don't let malicious nodes get us
	DO.			;Loop over all characters
	  ILDB T3,T1		;Get a byte from connect initiate message
;[9044]
;This horrible addition was put in because certain cretinous operating
;systems like VMS pad usernames with spaces (version 4.7 of VMS or less).
	  CAIN T3,.CHSPC	;[9044] Is it a space?
	  JRST TOP.		;[9044] Yes, ignore it
	  IDPB T3,T2		;Stash byte in CDB
	  JUMPE T3,R		;If it was a null, then we are done
	  SOJG T4,TOP.		;Still possible to do more?
	OD.

;At this point, the remote node has given us more than the maximum number
;of characters in a username. We truncate after 39 characters.

	MOVEI T3,.CHNUL		;Get null
	IDPB T3,T2		;Slam it in the string
	RET			;And we are done
	SUBTTL Get ACJ Blessing For Incoming CTERM Connection
;[9041]
;CTMGOK - Routine called by the CTERM fork when a connect initiate
;message for CTERM has been received. The CTERM fork will now ask
;the ACJ if the connection is allowed.
;
; Called with:
;	CDB/ CH block
;	CALL CTMGOK
;
; Returns:
;	+1 - ACJ said no way
;	+2 - Go ahead and allow connection

	XSWAPCD			;Called by fork

CTMGOK:	TRVAR <NODSTR,NODADR,MACNUM> ;String for ACJ to go here
	ACSAV			;Don't destroy any registers
	NOINT			;Satisfy the freespace routines
	HRRZI T1,MAXLC+1	;Get this many words
	HRLI T1,.RESP3		;Lock down if there isn't any space
	MOVEI T2,.RESGP		;From the general pool
	CALLX (MSEC1,ASGRES)	;(T1,T2/T1) Get some freespace
	 RETBAD (,OKINT)	;If none, too bad
	MOVEM T1,NODSTR		;Save freespace address
	MOVEI T2,MAXLC+1	;Get freespace size
	MOVEM T2,.GOSIZ(T1)	;It goes here
	LOAD T1,CHRID,(CDB)	;Get node address
	MOVEM T1,NODADR		;Save for later
	CALL <XENT SCTA2N>	;(T1/T1) Get node name in SIXBIT
	IFSKP.			;If we got node name,
	  MOVE T2,NODSTR	;Get freespace address
	  XMOVEI T2,<.GEWHO+1>(T2) ;Get freespace block where string goes
	  TXO T2,<OWGP. 7>	;Make it one word global byte pointer
	  CALL <XENT GETSIX>	;(T1,T2/T2) Translate node name
	  MOVE T1,T2		;Put byte pointer in good place
	ELSE.			;Node name not good, time to do it long hand
	  MOVE T1,NODSTR	;Get freespace address
	  XMOVEI T1,<.GEWHO+1>(T1) ;Get freespace block address where string goes
	  TXO T1,<OWGP. 7>	;Make it one word global byte pointer
	  MOVE T2,NODADR	;Get node address back
	  IDIVI T2,^D1024	;Get area number
	  MOVEM T3,MACNUM	;Save machine number for later
	  MOVX T3,<FLD(^D10,NO%RDX)> ;Output in decimal please
	  NOUT%			;Slam area number in string
	   ERJMP .+1
	  MOVEI T2,"."		;Get area/machine seperator
	  IDPB T2,T1		;And drop it in the string
	  MOVE T2,MACNUM	;Retrieve the machine number
	  MOVX T3,<FLD(^D10,NO%RDX)> ;Output it in decimal
	  NOUT%			;Put it in
	   ERJMP .+1
	ENDIF.
	;..
	;..
	SKIPN CH.USR(CDB)	;Do we have a username?
	JRST CTMGK1		;No, just pass in node name
	MOVEI T2,":"		;Add 1 seperator
	IDPB T2,T1		;Put in the colon
	IDPB T2,T1		;Again
	XMOVEI T2,CH.USR(CDB)	;Get address of username string
	TXO T2,<OWGP. 7>	;Here we go again
	DO.			;Now insert username into string
	  ILDB T3,T2		;Get character
	  IDPB T3,T1		;And put it in ACJ string
	  JUMPN T3,TOP.		;If not null, keep going
	OD.
CTMGK1:	MOVE T1,NODSTR		;Get address of freespace
	S1XCT <GTOKM (.GOCTM,<T1>,CTMGK2)> ;Ask ACJ
	CALLX (MSEC1,RELRES)	;(T1/) Give it back
	OKINT			;And interrupts are OK now
	RETSKP			;ACJ said to go ahead

	SWAPCD			;This has to be in section 1!!!

CTMGK2:	MOVE T1,NODSTR		;Now return that freespace
	CALLX (MSEC1,RELRES)	;(T1/) Give it back
	OKINT			;And interrupts are OK now
	RET			;ACJ said no can do

	ENDTV.			;And of TRVAR

	XSWAPCD			;Continue in section 6 again
	SUBTTL TERMINAL TYPE TRANSLATION TABLE
;Indexed by TOPS20 terminal type
TTYPE:  POINT 7,[ASCIZ\LT33\]
	POINT 7,[ASCIZ\LT35\]
	POINT 7,[ASCIZ\LT37\]
	REPEAT 7,<0>
	POINT 7,[ASCIZ\VT05\]
	POINT 7,[ASCIZ\VT50\]
	POINT 7,[ASCIZ\LA30\]
	POINT 7,[ASCIZ\GT40\]
	POINT 7,[ASCIZ\LA36\]
	POINT 7,[ASCIZ\VT52\]
	POINT 7,[ASCIZ\VT100\]
	POINT 7,[ASCIZ\LA38\]
	POINT 7,[ASCIZ\LA120\]
	REPEAT <.TT125-.TT120-1>,<0>
	POINT 7,[ASCIZ\VT125\]
	POINT 7,[ASCIZ\VK100\]
MAXTYP==.-TTYPE 		;Length of table
	SUBTTL STOCK MESSAGES
;Foundation  bind request message & size
BNDMSG:	BYTE (8).FNBNR,.CFVER,.CFECO,.CFMOD ;FOUND-TYPE,FOUND-VERSION,FOUND-ECO,FOUND-MOD
	BYTE (8).FBT20,0,20,0	;OS-TYPE(2), SUPPORT(2)
BNDMSZ==10

;CTERM initiate message & size (including foundation header)
;Followed by the initial characteristic message.
;which turns off control-O and control-X special functions
;and sets up ^G and ^I to echo as self
;and turns off escape sequence recognition.
;and sets up ^A as out of band for pause/unpause character
;and sets the input count state to NO-READ-SEND
CTMMSG:	BYTE (8).FNCDT,0,24,0	;FOUND-TYPE,FLAGS,LENGTH(2)
	BYTE (8).BIND,0,.CHVER,.CHECO ;CTERM-TYPE,FLAGS,CTERM-VERSION,CTERM-ECO
	BYTE (8).CHMOD,0,0,0 	;CTERM-MOD,REVISION(3)
	BYTE (8)0,0,0,0		;REVISION(4)
	BYTE (8)0,.BNDPL,1,377	;REVISION(1),MAXSIZE-PARAMETER(3)
	BYTE (8).BNDPM,2,377,77 ;SUPPORT-BITMAP(4)
CTMMSZ==^D24			;SIZE IN BYTES.

CTMMS1:	BYTE (8).FNCDT,0,45,0	;FOUND-TYPE,FLAGS,LENGTH(2)
	BYTE (8).CHARS,0,2,2	;CTERM-TYPE,FLAGS,CHAR-TYPE,CHAR-ID
	BYTE (8).CHCNX,100,0,2	;CHARACTER,MASK,VALUE,CHAR-TYPE
	BYTE (8)2,.CHCNO,100,0	;CHAR-ID,CHARACTER,MASK,VALUE
	BYTE (8)2,2,.CHBEL,60	;CHAR-TYPE,CHAR-ID,CHARACTER,MASK
	BYTE (8)20,2,2,.CHTAB	;VALUE,CHAR-TYPE,CHAR-ID,CHARACTER
	BYTE (8)60,20,6,2	;MASK,VALUE,CHAR-TYPE, CHAR-ID

	BYTE (8)0,7,2,0		;FALSE, CHAR-TYPE,CHAR-ID, FALSE
	BYTE (8)2,2,.CHCNA,377	;CHAR-TYPE,CHAR-ID,CHARACTER, MASK
	BYTE (8)3,10,2,2	;VALUE. CHAR-TYPE,CHAR-ID,
	BYTE (8)0,0		;VALUE(2)
CTMMZ1==^D41			;SIZE IN BYTES.
;CTERM Foundation Unbind request.
;
CTMUNB: BYTE (8).FNUBN,.UBNRQ,0 ; User unbind request.
	SUBTTL PERMANENT CTERM DATA BASE

;These two are global for NODE% jsys reasons.
RS (CTHSAP,1)      	;Address of CTERM SAB
RS (CTHCHP,1)      	;DECnet channel to CDB address translation table

RS (CTMLOK,1)		;CTERM lock
RS (LOKPC,1)		;The PC at the time of the current lock.
RS (LKFRK,1)		;The current owner of the lock, 0 if none.
RS (CTMUID,1)		;The next CDB unique ID.
RS (CTMATN,1)         	;CTERM line service requested at sched level
RS (CTMWAG,1)		;Cell to defer CTMATN to next 20mS sched cycle (global)
RS (MSGATN,1)         	;Decnet event service requested at sched level
RS (MSGCWL,1)         	;Count of passive links in CI state (0 or 1).

MSGSIZ==400		;Maximum message size
RS (MSGOMP,1)		;Byte pointer to CTERM output message buffer.
RS (MSGBLW,1)         	;CDB address of blocked link
RS (MSGBLC,1)         	;Count of bytes still to send
RS (MSGBLP,1)         	;Pointer to blocked data

;The bits in the bytes in the terminator set in the START-READ message are
;numbered opposite from the bits in the bytes in the TOPS20 break mask 
RS (SWPTBL,1)		;Address of swap table

IFN FTCOUN,<
%CTSTT:			;START OF COUNTERS
RS (%CTMSG,20)	        ;COUNT OF EACH TYPE OF MESSAGE OUTPUT
RS (%CTOIN,1)	        ;COUNT OF OUTPUTS DONE FROM INPUT ROUTINE
RS (%CTOSC,1)	       	;COUNT OF OUTPUTS DONE FROM SCHEDULER
RS (%CTOSF,1)	       	;COUNT OF OUTPUTS FROM SCHEDULER WITH BUFFER FULL
RS (%CTCIN,1)	       	;COUNT OF TOTAL CHARACTERS INPUT
RS (%CTCOU,1)	       	;COUNT OF TOTAL CHARACTERS OUTPUT
RS (%CTMGC,1)	       	;COUNT OF TOTAL TIMES A CTERM MESSAGE WAS SENT
RS (%CTMGX,1)	       	;COUNT OF TOTAL TIMES A CTERM MESSAGE WAS NOT SENT
RS (%CTMGS,1)	       	;COUNT OF TOTAL DECNET CALLS
RS (%CTMGT,1)	       	;COUNT OF COMMAND-LEVEL MESSAGES SENT
RS (%CTMBU,1)	       	;COUNT OF ATTEMPTS TO SEND REST OF MESSAGE (UNBLOCK)
RS (%CTSCC,1)	       	;COUNT OF TIMES CCOC WORDS WERE SENT
RS (%CTCOC,1)	       	;COUNT OF TOTAL SFCOCs DONE
RS (%CTPAR,1)	       	;COUNT OF TOTAL STPARs DONE
RS (%CTPRS,1)		;COUNT OF STPARs SENT
RS (%CTMOD,1)	       	;COUNT OF TOTAL SFMODs DONE
RS (%CTSPD,1)	        ;COUNT OF TOTAL STSPDs DONE
RS (%CTLEN,1)	       	;COUNT OF TOTAL STLENs DONE
RS (%CTWID,1)	       	;COUNT OF TOTAL STWIDs DONE
RS (%CTOOB,1)		;COUNT ANOTHER OOB
RS (%CTOBS,1)		;COUNT ANOTHER OOB SENT.
>
	SUBTTL End of CTHSRV
	TNXEND

	END