Trailing-Edge
-
PDP-10 Archives
-
bb-m780d-sm
-
monitor-sources/cthsrv.mac
There are 17 other files named cthsrv.mac in the archive. Click here to see a list.
; 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, 1988.
; 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. TERMINAL TYPE TRANSLATION TABLE . . . . . . . . . . . 92
; 13. STOCK MESSAGES . . . . . . . . . . . . . . . . . . . . 93
; 14. PERMANENT CTERM DATA BASE . . . . . . . . . . . . . . 94
; 15. End of CTHSRV . . . . . . . . . . . . . . . . . . . . 95
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
JRST 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.
>)
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 T1,CBNUM,(T1) ; and get the remote node address
STOR T1,CHRID,(CDB) ; so we can now store it away
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.
>)
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
MSGUB1: SETZM MSGBLW ;Else 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.
RETSKP ;Can't send - forget it.
RETSKP ;Done.
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
CAIN T3,10 ;*** Is it TOPS20?
SETONE CHRTI,(CDB) ;Yes, We like remote TEXTI%s
CAIE T3,7 ;*** Are we VMS?
IFNSK.
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
MOVE T1,[POINT 8,CTMMSG] ;Point to it.
MOVEI T2,CTMMSZ ;Get size of it.
CALL MSGOUT ;(T1,T2,CDB) Send it
RETSKP ;On error, link is gone.
;Send initial characteristics
MOVE T1,[POINT 8,CTMMS1] ;Point to it.
MOVEI T2,CTMMZ1 ;Get size of it.
CALL MSGOUT ;(T1,T2,CDB) Send it
RETSKP ;On error, link is gone.
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
CALL FNDOUT ;(T2,CDB) Send it out
RETSKP ;Failed - CDB is gone
SETZRO CHCLI,(CDB) ;Clear clear input flag.
MOVE T2,Q1 ;Restore TDB
ENDIF.
TMNN CHCOC,(CDB) ;Send CCOC words ?
IFSKP.
CALL CTMSCC ;Yes.
RET ;Failed - CDB is gone
SETZRO CHCOC,(CDB) ;Clear CCOC flag
MOVE T2,Q1 ;Restore TDB
ENDIF.
TMNN TTOTP,(T2) ;Send output ?
IFSKP.
CALL CTMSOT ;(T2,CDB) Send output.
RET ;More to send.
MOVE T2,Q1 ;Restore TDB
ENDIF.
TMNN CHASR,(CDB) ;Send another START-READ ?
IFSKP.
LOAD T1,CHRFL,(CDB) ;Get flags
LOAD T2,CHRLN,(CDB) ;Get length
; SETZ T3, ;No ^R buffer this time.
LOAD T3,CHRBL,(CDB) ;Get length of ^R buffer
CALL CTMSTR ;(T1,T2,T3,CDB) Issue the START-READ.
TMNE CHASR,(CDB) ;Need to send another START-READ ?
RET ;Yes.
MOVE T2,Q1 ;No. Restore TDB
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
SKIPN P3 ;Is there anything in there ?
IFSKP.
MOVE T2,Q3 ;Yes. Get count of bytes left in buffer.
CALL FNDOUT ;(T2) Send message out.
RETSKP ;Failure, link is gone.
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)
RETSKP
TMNN CHTCI,(CDB)
RETSKP
RET
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
;Currently only generates messages to change the following in the server:
;
; TT%LIC - lower case (1==convert to upper)
XNENT (CTHSPR,G) ;[7.1024]CTHSPR::, XCTHSP::
IFN FTCOUN,<
AOS %CTPAR ;COUNT ANOTHER STPAR
>
MOVE T3,T1 ;Get copy of flags
XOR T3,TTFLGS(T2) ;Get changes
ANDI T3,TT%LIC ;[7183] 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>
MOVE Q1,T3 ;Get safe copy of changes
MOVE Q2,T1 ;Get safe copy of flags
MOVE P2,T2 ;Get TDB in safe place.
SKIPN CDB,TTDEV(P2) ;Get CDB
RET ;None. Done.
TMNN CHLWI,(CDB) ;[7183] Does server support line width setting?
RET ;[7183] No. Done.
CALL LOKCDB ;(T2,CDB) Get control of CTERM.
RET ;Failed.
CALL GETCHM ;(/T1,T2) Get characteristics message buffer
TXNN Q2,TT%LIC ;Yes. Want to raise lower case ?
TDZA T3,T3 ;No.
MOVEI T3,1 ;Yes.
MOVX T4,CH%RAI ;Get characteristic type.
CALL SETCHR ;(T1,T2,T3,T4/T1,T2) Set it in the message.
NOP ;Ignore failure
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.
TMNN CHLWI,(CDB) ;Does this server support line width setting?
RET ;No. Done.
MOVE Q1,T1 ;Save width
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
;Returns +1 always
;If pause/unpause characters are ^S, ^Q, set the CTERM output flow control true.
;Otherwise, set the characters to be out of band, with no echo.
;Don't send to VMS, since it blows up on this msg.
XNENT (CTHPPC,G) ;[7.1024]CTHPPC::, XCTHPP::
SAVEAC <T1,T2,CDB,Q1,Q2,Q3>
SKIPN CDB,TTDEV(T2) ;Get CDB address
RET ;None. Done
TMNN CHLWI,(CDB) ;Does this server support line width setting?
RET ;No. Done.
MOVE Q2,T1 ;Preserve new pause/unpause characters
CALL LOKCDB ;(T2,CDB) Grab control of CTERM
RET ;Failed.
MOVE Q3,T2 ;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 ;(T1,T2,T3,T4,Q1/T1,T2,T3,T4,Q1) Clear old unpause
JRST CTMSPX ;Failure.
LOAD T3,TTUPC,(P2) ;Get old unpause character
CALL CTMPEC ;(T3,Q1/T3,Q1) Set echo up.
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 ;Get 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: CALLRET ULKCDB ;Let go of CTERM
;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%DED+SR%RAN+SR%XEC ;Disable editing, 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.
>)
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: If 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>
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
LOAD T3,CHRID,(T3) ;GET DECNET ADDRESS
OKSKED
MOVEM T3,.NWNNU(T1) ;SAVE IT AWAY
JUMPE T3,CHRRH4 ;IF ZERO - NO HOST NAME
MOVE T1,T3 ;PUT ADDRESS WHERE SCTA2N WANTS IT
CALL <XENT SCTA2N> ;[7.1024]CONVERT # TO SIXBIT NAME
IFNSK.
CHRRH4: MOVE T3,UAB ;GET ARG BLOCK ADDRESS
MOVE T2,.NWNNP(T3) ;GET BYTE POINTER
SETZ T3, ;NO KNOWN NODE NAME FLAG
JRST CHRRH2 ;COULDN'T
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
CHRRH2: SETZ T1,
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 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