Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11M-BM_1990 - galsrc/orion.mac
There are 38 other files named orion.mac in the archive. Click here to see a list.
	TITLE	ORION - DRIVER FOR THE OPERATOR INTERFACE PROGRAM
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 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 GLXMAC,ORNMAC,QSRMAC,NEBMAC	;[6004]
	SEARCH MACSYM				;[6044]
	PROLOG(ORION)
	ERRSET				;SETUP ALL ERROR ROUTINES EXTERNAL
	PARSET				;PARSER ROUTINES

IFN	FTDN60,<
	.REQUIR	OPRCMD			;IF DN60 LOAD SYNTAX TABLES
	.REQUIR OPRSCM
> ;End FTDN60

	.OBSOP==1			;SYSTEM OPERATOR PRIVS

	EXTERNAL TABSRC			;TABLE SEARCH
	EXTERNAL ARGRTN			;SETUP ARGUMNET IN MESSAGE
	EXTERNAL BLDOBJ			;BUILD AN OBJECT
	EXTERNAL CMDEND			;FINISH COMMAND AND SEND TO QUASAR
	EXTERNAL NEBMSG			;[6005]NEBULA MESSAGE PROCESSOR
	EXTERNAL N$BLDP			;[6005]REMOTE DISPLAY BLOCK BUILDER
	EXTERNAL N$SNEB			;[6005]SEND A MESSAGE TO NEBULA
	EXTERNAL BLDHDR			;[6005]BUILD REMOTE SHOW ACK MSG HEADER
	EXTERNAL CHCLUN			;[6007]Return arg for /CLUSTER-NODE
	EXTERNAL SAVNOD			;[6011]BUILD A NODE BLOCK
;**;[6030]At EXTERNAL SAVNOD add 1 line JYCW Oct-18-88
;**;[6032]At EXTERNAL SNDCL0 change 1 line  JCR  11/29/89
	EXTERNAL SNDCLU			;[6032]Send to NEBULA
;**;[6043]At EXTERNAL SNDCLU:+1L add 4 lines  PMM  6/3/90
	EXTERNAL CHRNME			;[6043]Compare printer queue name
	EXTERNAL N$FBLK			;[6043]Find the node block
	EXTERNAL HDRAKA,AKAOBJ		;[6043]Alias printer data 
	EXTERNAL LSTAKA,FINDPR,FINDAK,FINNUM,LPTTY7  ;[6043]Alias printer
	INTERNAL QSRNAM			;[6005]ASCIZ QUASAR NAME TEXT
	INTERNAL NEBNAM			;[6005]ASCIZ NEBULA NAME TEXT
	INTERNAL MDANAM			;[6005]ASCIZ MOUNTR NAME TEXT
	INTERNAL CHKWHL			;[6005]CHECK FOR WHEEL ROUTINE
	INTERNAL SNDCGP			;[6005]CLUSTER GALAXY PROCESSING
	INTERNAL FNDNOD			;[6005]FIND A NODE
	INTERNAL OPRENB			;[6005]CHECK OPERATOR'S PRIVILEGES
	INTERNAL SHDPBK			;[6005]DISPLAY TEXT BLOCK
	INTERNAL SHWMTX			;[6005]BUILD DISPLAY TEXT BLOCK
	INTERNAL SHODBK			;[6005]SHOW OPERATORS HEADER
	INTERNAL SPGOUT			;[6005]COPY SHOW ACK MSG TO OUTGOING PAGE
	INTERNAL CHKMSG			;[6005]CHECK FOR A MESSAGE AT A NODE
	INTERNAL BLDDPY			;[6005]MOVE A TEXT BLOCK TO OUTGOING MSG
	INTERNAL FNDMSG			;[6005]SEARCH ALL NODES FOR A MESSAGE
	INTERNAL MSGNOD			;[6005]BUILD A DISPLAY BLOCK FOR A NODE
	INTERNAL OPRLST			;[6005]BUILD A DISPLAY BLOCK FOR AN OPR
	INTERNAL W$ASND			;[6015]SEND A MESSAGE TO AN OPERATOR
	INTERNAL .JBVER			;AVAILABLE FOR OPRLOG
	INTERNAL GETJOB			;GET JOB INFO
	INTERNAL SNDAOP			;SEND MESSAGE TO ALL OPRS
;**;[6030]At internal SNDAOP add 2 lines JYCW Oct-18-88
	INTERNAL W$WTO,COMMAN,W$WTOR,W$ACKM,W$SHOW,W$LOGM,NOTIFY,TAKEND ;[6030]
	INTERNAL MANTAB,COMMAN			;[6030]
;**;[6032]At INTERNAL W$WTO add 1 line  JCR  11/29/89
	INTERNAL WDANHD			;[6032]Node where request originated
;**;[6035]At INTERNAL WDANHD add 1 line  JCR  1/15/90
	FNDBLK				;[6035]Find a block in an IPCF message
;**;[6040]At INTERNAL WDANHD add 1 line  JCR  2/22/90
	INTERNAL BLDRAK			;[6040]Build an ACK message
	ENTRY	OPRENB			;OPR ENABLED FOR NODE
;**;[6043]At ENTRY OPRENB:+1L add 3 lines   6/3/90
	INTERNAL FASNEB			;[6043]Send to NEBULA
	INTERNAL SAKHDR			;[6043]SHOW ALIAS remote message header
	INTERNAL W$NODE			;[6043]Make it global
	INTERNAL LSTENT			;[6043]SHOW ALIAS last printer type
	SUBTTL	Edit vector and Version numbers

ORNVEC:	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(ORNMAC,OMC,L)
	BLDVEC	(QSRMAC,QMC,L)
	BLDVEC	(ORION,ORN,L)
	BLDVEC	(OPRPAR,PAR)
	BLDVEC	(OPRQSR,QSR)
	BLDVEC	(OPRLOG,LOG)
	BLDVEC	(OPRERR,ERR)
	BLDVEC	(OPRNET,NET)
	BLDVEC	(OPRNEB,NEB)

	ORNMAN==:6046			;Maintenance edit number
	ORNDEV==:6027			;Development edit number
	VERSIN (ORN)			;Generate edit number

	ORNWHO==0
	ORNVER==6
	ORNMIN==0

	EXTERNAL PAREDT,QSREDT,LOGEDT,ERREDT,NETEDT,NEBEDT
	ORNVRS==<VRSN.(ORN)>+GMCEDT+OMCEDT+QMCEDT+PAREDT+QSREDT+
		LOGEDT+ERREDT+NETEDT+NEBEDT

	.JBVER==137

	LOC	.JBVER
	EXP	ORNVRS
	RELOC
	SUBTTL	Table of Contents


;		Table of Contents for ORION
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Edit vector and Version numbers. . . . . . . . . . . .    2
;   3. Table of Contents. . . . . . . . . . . . . . . . . . .    3
;   4. Revision history . . . . . . . . . . . . . . . . . . .    4
;   5. Constants and declarations . . . . . . . . . . . . . .    5
;   6. Global Storage . . . . . . . . . . . . . . . . . . . .    6
;   7. Main Data Storage. . . . . . . . . . . . . . . . . . .    7
;   8. WTO storage. . . . . . . . . . . . . . . . . . . . . .    8
;   9. Interrupt vector definitions . . . . . . . . . . . . .    9
;  10. Initialization block . . . . . . . . . . . . . . . . .   10
;  11. ORION. . . . . . . . . . . . . . . . . . . . . . . . .   11
;  12. MAIN . . . . . . . . . . . . . . . . . . . . . . . . .   12
;  13. I$SYSV - Get system variables. . . . . . . . . . . . .   14
;  14. REQTIM . . . . . . . . . . . . . . . . . . . . . . . .   15
;  15. PROIPC . . . . . . . . . . . . . . . . . . . . . . . .   16
;  16. IPCCMS . . . . . . . . . . . . . . . . . . . . . . . .   17
;  17. GOPHMS . . . . . . . . . . . . . . . . . . . . . . . .   18
;  18. GOPFLG . . . . . . . . . . . . . . . . . . . . . . . .   19
;  19. ORNINT . . . . . . . . . . . . . . . . . . . . . . . .   20
;  20. MSGCHK . . . . . . . . . . . . . . . . . . . . . . . .   21
;  21. RETMSG . . . . . . . . . . . . . . . . . . . . . . . .   22
;  22. OPRHEL . . . . . . . . . . . . . . . . . . . . . . . .   23
;  23. APLHEL . . . . . . . . . . . . . . . . . . . . . . . .   24
;  24. CHKNOD . . . . . . . . . . . . . . . . . . . . . . . .   25
;  25. GETNOD . . . . . . . . . . . . . . . . . . . . . . . .   26
;  26. OPRSET . . . . . . . . . . . . . . . . . . . . . . . .   27
;  27. SNDSET . . . . . . . . . . . . . . . . . . . . . . . .   28
;  28. TEXT . . . . . . . . . . . . . . . . . . . . . . . . .   29
;  29. SPGOUT . . . . . . . . . . . . . . . . . . . . . . . .   30
;  30. W$WTOR . . . . . . . . . . . . . . . . . . . . . . . .   31
;  31. W$KWTO . . . . . . . . . . . . . . . . . . . . . . . .   32
;  32. W$NODE . . . . . . . . . . . . . . . . . . . . . . . .   33
;  33. W$KMES . . . . . . . . . . . . . . . . . . . . . . . .   34
;  34. W$WTO. . . . . . . . . . . . . . . . . . . . . . . . .   35
;  35. W$CHEK . . . . . . . . . . . . . . . . . . . . . . . .   36
;  36. W$LOGM . . . . . . . . . . . . . . . . . . . . . . . .   37
;  37. W$VALID. . . . . . . . . . . . . . . . . . . . . . . .   38
;  38. WTONHD - Validate a remote display block . . . . . . .   39
;  39. WTOTXT, WTOTYP, WTOANS and WTOACD routines . . . . . .   40
;  40. WTOJOB,WTOERR,WTORTE and WTODES  routines. . . . . . .   41
;  41. WTOOBJ . . . . . . . . . . . . . . . . . . . . . . . .   42
;  42. WTOOCD . . . . . . . . . . . . . . . . . . . . . . . .   43
;  43. WTODTY . . . . . . . . . . . . . . . . . . . . . . . .   43
;  44. W$MTXT . . . . . . . . . . . . . . . . . . . . . . . .   44
;  45. W$CRLF . . . . . . . . . . . . . . . . . . . . . . . .   45
;  46. OPRMSG . . . . . . . . . . . . . . . . . . . . . . . .   46
;  47. W$MESS . . . . . . . . . . . . . . . . . . . . . . . .   47
;  48. NEBBLK - Build a Remote Display block. . . . . . . . .   48
;  49. MSGFIN . . . . . . . . . . . . . . . . . . . . . . . .   49
;  50. W$JOBH . . . . . . . . . . . . . . . . . . . . . . . .   50
;  51. GETJOB/GETJBT. . . . . . . . . . . . . . . . . . . . .   51
;  52. GLOC . . . . . . . . . . . . . . . . . . . . . . . . .   52
;  53. GETUSR . . . . . . . . . . . . . . . . . . . . . . . .   53
;  54. GETNAM . . . . . . . . . . . . . . . . . . . . . . . .   54
;  55. W$SHOW . . . . . . . . . . . . . . . . . . . . . . . .   55
;  56. W$ASND . . . . . . . . . . . . . . . . . . . . . . . .   55
;  57. W$ACKM . . . . . . . . . . . . . . . . . . . . . . . .   56
;  58. TXTMOV . . . . . . . . . . . . . . . . . . . . . . . .   56
;  59. CMDMES . . . . . . . . . . . . . . . . . . . . . . . .   57
;  60. COMMAN . . . . . . . . . . . . . . . . . . . . . . . .   58
;  61. FNDAPL . . . . . . . . . . . . . . . . . . . . . . . .   59
;  62. Dispatch Table for Command Messages. . . . . . . . . .   60
;  63. TAKCMD . . . . . . . . . . . . . . . . . . . . . . . .   61
;  64. TAKEND . . . . . . . . . . . . . . . . . . . . . . . .   61
;  65. TAKABT . . . . . . . . . . . . . . . . . . . . . . . .   61
;  66. GETPAG . . . . . . . . . . . . . . . . . . . . . . . .   62
;  67. RELPAG . . . . . . . . . . . . . . . . . . . . . . . .   62
;  68. ERRALL . . . . . . . . . . . . . . . . . . . . . . . .   63
;  69. DISABLE/ENABLE commands. . . . . . . . . . . . . . . .   64
;  70. ENAODP . . . . . . . . . . . . . . . . . . . . . . . .   65
;  71. MAPBIT . . . . . . . . . . . . . . . . . . . . . . . .   66
;  72. ENALOG . . . . . . . . . . . . . . . . . . . . . . . .   68
;  73. CLSLOG . . . . . . . . . . . . . . . . . . . . . . . .   68
;  74. ENACLS . . . . . . . . . . . . . . . . . . . . . . . .   69
;  75. ENARET . . . . . . . . . . . . . . . . . . . . . . . .   70
;  76. ENARCF - REPORT-CONNECTION-FAILURES. . . . . . . . . .   71
;  77. ENALSP - LOGFILES-TO-SPECIFIC-PRINTERS . . . . . . . .   72
;  78. ENALFS - LOGFILES. . . . . . . . . . . . . . . . . . .   73
;  79. ENALSP - LOGFILES-TO-SPECIFIC-PRINTERS . . . . . . . .   74
;  80. NOTIFY . . . . . . . . . . . . . . . . . . . . . . . .   75
;  81. SEND . . . . . . . . . . . . . . . . . . . . . . . . .   76
;  82. SNDALL . . . . . . . . . . . . . . . . . . . . . . . .   77
;  83. DEFNOD . . . . . . . . . . . . . . . . . . . . . . . .   77
;  84. TTYNOD . . . . . . . . . . . . . . . . . . . . . . . .   78
;  85. SENDOP . . . . . . . . . . . . . . . . . . . . . . . .   79
;  86. BLDSND . . . . . . . . . . . . . . . . . . . . . . . .   80
;  87. BLDALL . . . . . . . . . . . . . . . . . . . . . . . .   80
;  88. SNDALX . . . . . . . . . . . . . . . . . . . . . . . .   81
;  89. GCNFIG  Do CONFIG to find out what systems are out there   82
;  90. SNDTTY . . . . . . . . . . . . . . . . . . . . . . . .   83
;  91. SHOW . . . . . . . . . . . . . . . . . . . . . . . . .   84
;  92. SHWOPR . . . . . . . . . . . . . . . . . . . . . . . .   85
;  93. SHWSCH . . . . . . . . . . . . . . . . . . . . . . . .   86
;  94. SHWLOC - SHOW SCHEDULER for the local node . . . . . .   87
;  95. SHWMSG . . . . . . . . . . . . . . . . . . . . . . . .   88
;  96. FASNEB - Finish message to NEBULA and then send it . .   89
;  97. SWITYP - Determine the /CLUSTER-NODE: value. . . . . .   90
;  98. FINSHW . . . . . . . . . . . . . . . . . . . . . . . .   91
;  99. MSGNOD . . . . . . . . . . . . . . . . . . . . . . . .   92
; 100. BLKDPY . . . . . . . . . . . . . . . . . . . . . . . .   92
; 101. GETMSG . . . . . . . . . . . . . . . . . . . . . . . .   93
; 102. FNDMSG . . . . . . . . . . . . . . . . . . . . . . . .   94
; 103. CHKMSG . . . . . . . . . . . . . . . . . . . . . . . .   95
; 104. NXTMSG . . . . . . . . . . . . . . . . . . . . . . . .   95
; 105. REPORT . . . . . . . . . . . . . . . . . . . . . . . .   96
; 106. CHKWTO . . . . . . . . . . . . . . . . . . . . . . . .   97
; 107. OPRLST . . . . . . . . . . . . . . . . . . . . . . . .   98
; 108. OPRDPY . . . . . . . . . . . . . . . . . . . . . . . .   99
; 109. RESPON . . . . . . . . . . . . . . . . . . . . . . . .  100
; 110. Operator privilege checking routines . . . . . . . . .  101
; 111. GETPRV . . . . . . . . . . . . . . . . . . . . . . . .  102
; 112. OPRENB . . . . . . . . . . . . . . . . . . . . . . . .  103
; 113. O$REMOTE/O$HOST/O$SYSTEM/CHKWHL Routs. to check privs.  104
; 114. TOPS20 Privilege checking routines . . . . . . . . . .  105
; 115. G$ACK. . . . . . . . . . . . . . . . . . . . . . . . .  106
; 116. G$ACKN - Send an Ack message due to a NEBULA message .  107
; 117. BLDACK . . . . . . . . . . . . . . . . . . . . . . . .  108
; 118. BDNACK - Build a Remote ACK message. . . . . . . . . .  109
; 119. ADDNOD . . . . . . . . . . . . . . . . . . . . . . . .  110
; 120. LOCNOD . . . . . . . . . . . . . . . . . . . . . . . .  111
; 121. DELNOD . . . . . . . . . . . . . . . . . . . . . . . .  112
; 122. NODONL . . . . . . . . . . . . . . . . . . . . . . . .  113
; 123. ADDOPR . . . . . . . . . . . . . . . . . . . . . . . .  114
; 124. EXPTAB . . . . . . . . . . . . . . . . . . . . . . . .  115
; 125. VALOPR . . . . . . . . . . . . . . . . . . . . . . . .  116
; 126. CHKOPR . . . . . . . . . . . . . . . . . . . . . . . .  116
; 127. DELOPR . . . . . . . . . . . . . . . . . . . . . . . .  117
; 128. SNDLST . . . . . . . . . . . . . . . . . . . . . . . .  118
; 129. RSDPID . . . . . . . . . . . . . . . . . . . . . . . .  119
; 130. MOVARG . . . . . . . . . . . . . . . . . . . . . . . .  120
; 131. MOVAR2 . . . . . . . . . . . . . . . . . . . . . . . .  120
; 132. SNDAOP . . . . . . . . . . . . . . . . . . . . . . . .  121
; 133. SNDOPR . . . . . . . . . . . . . . . . . . . . . . . .  122
; 134. CHKOSD . . . . . . . . . . . . . . . . . . . . . . . .  123
; 135. MOVBLK . . . . . . . . . . . . . . . . . . . . . . . .  124
; 136. REQMSG . . . . . . . . . . . . . . . . . . . . . . . .  125
; 137. RSDMSG . . . . . . . . . . . . . . . . . . . . . . . .  126
; 138. REQNST . . . . . . . . . . . . . . . . . . . . . . . .  127
; 139. ADDSFL . . . . . . . . . . . . . . . . . . . . . . . .  128
; 140. DELSPL . . . . . . . . . . . . . . . . . . . . . . . .  129
; 141. CHKSFL . . . . . . . . . . . . . . . . . . . . . . . .  129
; 142. CLRSFL . . . . . . . . . . . . . . . . . . . . . . . .  130
; 143. SNDQSR . . . . . . . . . . . . . . . . . . . . . . . .  131
; 144. SNDACT . . . . . . . . . . . . . . . . . . . . . . . .  131
; 145. SQSD60 . . . . . . . . . . . . . . . . . . . . . . . .  131
; 146. SNDMSG . . . . . . . . . . . . . . . . . . . . . . . .  132
; 147. SPDOPR . . . . . . . . . . . . . . . . . . . . . . . .  133
; 148. SNDPID . . . . . . . . . . . . . . . . . . . . . . . .  134
; 149. Interrupt Handler. . . . . . . . . . . . . . . . . . .  135
; 150. Default PDBs for OPRCMD. . . . . . . . . . . . . . . .  136
; 151. SETOUT . . . . . . . . . . . . . . . . . . . . . . . .  137
; 152. SNDOUT . . . . . . . . . . . . . . . . . . . . . . . .  137
; 153. OUTRTN . . . . . . . . . . . . . . . . . . . . . . . .  137
; 154. SETPTR . . . . . . . . . . . . . . . . . . . . . . . .  137
; 155. LOGNSE - Setup to log a NEBULA send error. . . . . . .  138
; 156. FNDBLK - Routine to find any block in an IPCF message.  139
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

342	4.2.1528	9-Nov-82
	Fix copyright.

344	4.2.1608	15-Nov-85
	Allow device attributes of greater than zero to be valid when 
analyzing WTO object blocks.

*****  Release 5.0 -- begin development edits  *****

360	5.1003		30-Dec-82
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

361	5.1010		8-Feb-83
	Rearrange the channel table (CHNTAB).

362	5.1026		6-May-83
	Add support for QUEUE% JSYS.  Add support for new argument block
type .WTDTY for display type.  Add support for new ENABLE/DISABLE output
types.

363	5.1046		21-Oct-83
	Change version number from 4 to 5.

364	5.1071 		30-Jan-84
	Modify support for QUEUE% JSYS. Change way of determining if
	from QUEUE% by using function code .IPCCG

365	5.1080		5-Feb-84
	Add support for UNDEFINE STRUCTURE command with a dispatch entry
to routine Q$UNDE.

366	5.1092		13-Feb-84
	Make ORION a system process by setting IB.SYS in IB.

367	5.1099		16-Feb-84
	In GOPHMS, pick up job number from ACK word in QUEUE% message and
store in the corresponding MDB.

370	5.1111		1-Mar-84
	Add support for MOUNT STRUCTURE alias:/STRUCTURE-ID:structure name
command with a dispatch address to routine Q$MOUNT.

371	5.1152		12-July-84
	Add error message on SEND failure.

372	5.1155		16-Aug-84
	Add acknowledgement message after DISABLE/ENABLE OUTPUT BUGxxx.

373	5.1179		20-Nov-84
	Add support for new argument block .QBDFG to allow formatting flags
to be passed.

374	5.1184		3-Dec-84
	Add support for new applications type LCPTAB.

375	5.1186		5-Dec-84
	Add a data block for the NI% JSYS.

376	5.1197		5-Feb-85
	Determine if ORION is a system process or not via a GALGEN optionl

377	5.1198		5-Feb-85
	Do not insert TABS in blank lines when formatting WTO and ACK messages.

400	5.1200		6-Feb-85
	Turn bit IB.NAC on so as to restrict access to JFNs.

401	5.1203		28-Feb-85
	Add support for SHOW CONFIGURATION DISK-DRIVE command.

402	5.1215		9-May-85	QAR 838193
	In routine CHKOSD, check both OPR.OF and OPR.DP before refusing to send
the message to the operator.

403	5.1220		29-May-85	QAR 838417
	Edit 402 incorrectly tests OPR.DP in routine CHKOSD.

404	5.1223		24-June-85
	Prevent ORION from building to two SHOW message responses and then only
releasing one page. This causes ORION to eventually crash when no more free
pages are available.

*****  Release 5.0 -- begin maintenance edits  *****
410	Increment maintenance edit level for GALAXY 5.

*****  Release 6.0 -- begin development edits  *****

6000	6.1017		13-Oct-87
	Move to release 6.0 development area, update the TOC and change
routine name Q$PAUS to Q$STOP.

6001	6.1021		19-Oct-87
	Modify ORION's handling of WTOx messages to handle the new WTO
blocks .WTDQS, .WTPOR, .WTSER that describe remote LPTs.

6002	6.1034		23-Oct-87
	Create new routine, ENASEM, to process the ENABLE/DISABLE SEMI-OPR
command.  Include SEMI-OPR information for the SHOW OPERATOR command.  Check
for SEMI-OPR privilege when checking for privileges.

6003	6.1035		25-Oct-87
	Change routine CHKOSD to pick up only the right-half of the object
type word so that WTO and WTOR messages dealing with remote LPTs will
pass the range check.


6004	6.1078		15-Nov-87
	Add support for the /CLUSTER-NODE: switch to the SHOW MESSAGES
and SHOW OPERATORS commands.

6005	6.1094		20-Nov-87
	Add support for processing messages that are sent to a remote node
in the cluster, that are processed on a remote node in the cluster, and that
come back from a remote node in the cluster.

6006	6.1095		20-Nov-87
	Add .WTNHD,,WTONHD to routine's W$VALID message block validation
dispatch table. Also, have routine WTONHD pick up the next message block
correctly.

6007	6.1078		25-Nov-87
	Modify SEND ALL /NODE command to SEND ALL /CLUSTER-NODE.

6010	6.1109		1-Dec-87
	Add the new flag bit F.WNBK to indicate that a .WTNHD block is present
in a .OMACK or .OMWTO message. 

6011	6.1114		3-Dec-87
	Add support for the OPR commands SHOW CLUSTER-GALAXY-LINK-STATUS,
ENA/DIS REPORT-CONNECTION-FAILURES and ENA/DIS DECNET-CONNECTION-ATTEMPTS.

6012	6.1115		3-Dec-87
	Remove the definition of the SEMI-OPR flag, SEMIFG, from ORNMAC
and define it in ORION as G$SEMF.

6013	6.1129		7-Dec-87
	Implement SHOW SCHEDULER/CLUSTER-NODE command

6014	6.1133		7-Dec-87
	Indicate in the REPORT-CONNECTION-FAILURES and DECNET-CONNECTION-
ATTEMPTS messages whether an ENABLE or DISABLE is to be performed by NEBULA.

6015	6.1138		13-Dec-87
	Fix bugs found while debugging NEBULA.

6016	6.1142		17-Dec-87
	Fix bugs found while debugging remote SHOW messages.

6017	6.1169		21-Jan-88
	Lift the restriction that a .OMACK message to be routed remotely
must have a .WTTYP block immediately succeeding a .WTNHD block.

6020	6.1177		11-Feb-88
	Add support for the commands LOGFILES-TO-SPECIFIC-PRINTERS and
PRINT-LOGFILES.

6021	6.1181		15-Feb-88
	Add routine ENAUNP in support of the ENABLE/DISABLE UNPRIVILEGED-
USER-ENTIRE-REMOTE-OUTPUT-DISPLAY commands.

6022	6.1183		16-Feb-88
	Ensure that an OPR has the same value of the Cluster GALAXY option
as ORION does. If it does not, then reject its HELLO.

6023	6.1187		17-Feb-88
	Change the check from routine SWITYP to correctly distinguish if
a /NODE: switch has been specified or if a /CLUSTER-NODE: switch has been
specified with the local node's name. 

6024	6.1196		27-Feb-88
	For .OMDSP messages that are to be forwarded to a remote cluster node,
include block .ORRFG that contains the contents of words WDAOBT and WDAFLG.
The remote node will copy these values into its WDAOBT and WDAFLG words.

6025	6.1204		1-Mar-88
	Have routine PROIPC check if the IPCF message has a length greater
than zero. Messages that contain a message length of zero in their .MSFLG
word can lead to BPN crashes.

6026	6.1214		3-Mar-88
	Align the JOB/USER header with the job and user entries in the SHOW
OPERATORS display.

6027	6.1225		8-Mar-88
	Update copyright notice.

6030	6.1269		18-Oct-88
	Fix wrong AC in SNDNEB:  Clear G$NOFG (/NODE: flag) on beginning of
IPCF processing. Make W$WTOR:, W$WTO, W$LOGM, W$SHOW, W$ACKM AND COMMAN global
routines.

6031	6.1283		3-Oct-89
	Send to the local operators WTO messages that result from a request
from a remote node. Indicate the node where the request originated.

6032	6.1289		29-Nov-89
	Add support for the RESPOND/CLUSTER-NODE command.

6033	6.1292		16-Dec-89
	Add support for processing Kill WTORs that resulted from a remote
request.

6034	6.1297		31-Dec-89
	Replace routine SWITYP with routine CHCLUN.

6035	6.1301		15-Jan-90
	Add the Original Command Text block (.OCTXT) to operator
command messages that are sent to NEBULA. This block will be used
by the remote ORION (L$NEB) to include in its log file the text
typed by the operator.

6036	6.1307		1-Feb-90
	Add support for the CLOSE LOG/CLUSTER-NODE: command.

6037	6.1311		14-Feb-90
	Add support for the REPORT/CLUSTER-NODE: command.

6040	6.1312		22-Feb-90
	Add support for the /CLUSTER-NODE: switch to the ENABLE/DISABLE
CLASS-SCHEDULER, FILE-RETRIEVAL-WAITS, LOGGING and SEMI-OPR commands.

6041	6.1312		1-Mar-90
	Add support for the /CLUSTER-NODE: switch to the ENABLE/DISABLE
REPORT-CONNECTION-FAILURES and DECNET-CONNECTION-ATTEMPTS commands.

6042	6.1315		27-Apr-90
	Add support for remote broadcast of WTOs and WTORs.

6043	6.1318		3-Jun-90
	Add support for Alias Printers.

6044	6.1317		8-June-90
	Add support for /CLUSTER-NODE SEND and SET command

6045	6.1317		11-June-90
	Calculate the SEND OPERATOR message length correctly.

6046	6.1320		6-Jul-90
	Change routine BLDNHD to only insert one leading tab before
the underlining of the SHOW BROADCAST-MESSAGES header display.

\   ;End of Revision History
COMMENT \

THIS MODULE IS THE MAIN LOOP FOR ORION. IT RECEIVES ALL IPCF MESSAGES
AND DISPATCHES TO THE CORRECT PROCESSING ROUTINE. IT ALSO CONTAINS
ALL THE CODE TO INITIALIZE THE NEEDED GLX MODULES.

\

SUBTTL	Constants and declarations

	XP	PDLEN,^D200		;Size or our PDL
;**;[6042]At PDLEN,^D200 add 1 line  JCR  4/27/90
	XP	LINELN,^D80		;[6042]Line length
SUBTTL	Global Storage

	$DATA	PDL,PDLEN		;OUR PDL

	$DATA	G$STAD,0		;START OF DATA AREA
	$GDATA	G$HOST,1		;NODE NAME OF CENTRAL SITE
	$GDATA	G$HSTN,1		;NODE NUMBER OF CENTRAL SITE
	$GDATA	G$NOW,1			;CURRENT TIME OF DAY
	$GDATA	G$OPR,1			;T/F FOR OPR ON DUTY

	$GDATA	G$ERR,1			;ERROR CODE FOR ACK'ING THIS MESSAGE
	$GDATA	G$FERR,1		;[6004]FIRST MESSAGE ERROR INDICATOR
	$GDATA	G$CBLK,2		;[6004]CLUSTER NODE BLOCK
	$GDATA	G$NEBD,2		;[6005]NEBULA PROCESSOR ADDRESS HOLDER
	$GDATA	G$NACK,1		;[6005]NEBULA ACK REQUEST FLAG
	$GDATA	G$NSHW,1		;[6005]REMOTE SHOW ACK MESSAGE
	$GDATA	G$NERR,1		;[6005]NEBULA ACK ERROR
	$GDATA	G$SEMF,1		;[6012]SEMI-OPR FLAG
	$GDATA	G$SEQ,1			;GLOBAL SEQUENCE NUMBER FOR
					;OPR DISPLAYS.
	$GDATA	G$FLAG,1		;SENDER'S FLAGS (FROM IPCF MESSAGE)
	$GDATA	G$SND,1			;SENDER'S PID
	$GDATA	G$PRVS,1		;SENDER'S PRIVS (FROM IPCF MESSAGE)
	$GDATA	G$SID,1			;SENDER'S ID
	$GDATA	G$JOB,1			;SENDER'S JOB NUMBER
	$GDATA	G$NODE,1		;SENDER'S NODE NAME (SIXBIT)
	$GDATA	G$NODX,2		;SENDER'S NODE NAME (ASCII)
	$GDATA	G$CLUN,1		;[6004]CLUSTER NODE BLOCK FLAG
	$GDATA	G$PRIV,1		;SENDER'S PRIVS

	$GDATA	G$NODL,1		;NODE LIST NUMBER
	$GDATA	G$OPRA,1		;OPR ADDRESS ORIGINATING REQUEST
	$GDATA	G$ASND,1		;FLAG TO FORCE SENDS OF MESSAGE
	$GDATA	G$JDAT,1		;BATCH-STREAM..WTO BITS
	$GDATA	G$OUTP,1		;OUTPUT MESSAGE PAGE FLAG

	$GDATA	G$ARG1,1		;ERROR ARGUMENT 1
	$GDATA	G$ARG2,1		;ERROR ARGUMENT 2
	$GDATA	G$ARG3,1		;ERROR ARGUMENT 3

	$GDATA	G$SNDF,1		;COUNT OF SEND FAILURES
	$GDATA	G$RSDL,1		;LIST NUMBER FOR RESEND ENTRIES
	$GDATA	G$NSNT,1		;COUNT OF MESSAGES NOT SENT YET
	$GDATA	G$SNDL,1		;LIST FOR MESSAGES NOT SENT YET
	$GDATA	G$RSDC,1		;NUMBER OF MESSAGES TO RESEND COUNT
	$GDATA	G$CHKM,1		;WTOR MESSAGE CHECK REQUESTED
	$GDATA	G$MSGC,1		;NUMBER OF THE MESSAGE BEING PROCESSED
	$GDATA	G$SFPD,1		;SEND FAILURE PID
	$GDATA	G$MJOB,1		;ORIONS JOB NUMBER
	$GDATA	G$MAXP,1		;MAXIMUM PACKET SIZE
;**;[6030]At $GDATA G$MAXP add 1 line JYCW Oct-18-88
	$GDATA	G$NOFG,1		;[6030]/NODE: switch flag
TOPS20<
	$GDATA	G$NETL,1		;NETWORK SERVER LIST
>;END TOPS20

	$GDATA	G$2SCR,2		;2 WORD GENERIC SCRATCH SPACE
;**;[6042]At $GDATA G$2SCR,2 add 4 lines  JCR  4/27/90
	$GDATA	BWLIST,1		;[6042]Broadcast message display queue
	$GDATA	CLSTYP,1		;[6042]Broadcast message class
	$GDATA	MSGARG,2		;[6042]Display message /w object
	$GDATA	DISARG,2		;[6042]Display message /w no object
SUBTTL	Main Data Storage

;TEMPORARY STORAGE FOR TEXT MOVER

	$DATA	TXTPTR,1		;SAVE AREA FOR BYTE POINTER
	$DATA	PARBLK,PAR.SZ		;PARSER CALL BLOCK
	$DATA	PARBUF,1		;PARSER BUFFER POINTER
	$GDATA	SNDBLK,SAB.SZ		;[6005]SEND BLOCK FOR MESSAGES
	$DATA	SNDPTR,1		;SEND ROUTINE POINTER
	$DATA	TABADR,1		;OPR DATA BASE ADDRESS
	$DATA	TABFRE,1		;OPR DATA BASE FREE COUNT
	$DATA	TABCNT,1		;OPR DATA BASE AVAILABLE COUNT

;BYTE POINTER AND COUNTER FOR COMMON TEXT STORAGE ROUTINE

	$DATA	STRBP,1			;BYTE POINTER WORD
	$DATA	STRCT,1			;BYTE COUNT WORD

TOPS10<
;PLACE FOR OPERATORS PPN
	$DATA	OPRPPN,1		;OPR PPN ON -10
	$DATA	FRCLIN,1		;LINE NUMBER OF 'FRCLIN'
	$DATA	SNDTXT,^D15		;TEXT BUFFER FOR 'SEND ALL' (72 CHR MAX)
>;END TOPS10
SUBTTL	WTO storage

	$DATA	WDATXT,1		;WTO TEXT DATA ADDRESS
	$DATA	WDAOBJ,1		;WTO OBJECT BLOCK ADDRESS
	$DATA	WDAOBT,1		;WTO OBJECT TYPE
	$DATA	WDADES,1		;WTO DESTINATION VALUE
	$DATA	WDAJOB,1		;WTO JOB NUMBER
	$DATA	WDAERR,1		;WTO ERROR CODE
	$DATA	WDARTE,1		;WTO ROUTE CODE
	$DATA	WDATYP,1		;WTO TYPE CODE
	$DATA	WDANHD,1		;[6005]WTO REMOTE HEADER LINE
;**;[6031]AT $DATA WDANHD,1  add 1 line  JCR  10/3/89
	$DATA	WDALEN,1		;[6031]WTO remote display block length
	$DATA	WDAANS,1		;WTO ANSWER BLOCK
	$DATA	WDAFLG,1		;WTO FLAG WORD
	$DATA	WDAACD,1		;WTO APPLICATION CODE BLOCK
	$DATA	WDADTY,1		;WTO display type
;**;[6032]At $DATA WDADTY,1  add 1 line  JCR  11/29/89
	$DATA	WDAPID,1		;[6032]PID block
;**;[6042]At $DATA WDAPID,1  replace 1 line with 2 lines JCR  4/27/90
	$DATA	WDARND,1		;[6042]Remote node where WTO processed
;**;[6043]At $DATA WDARND,1 replace 1 line with 2 lines   PMM  6/3/90
	$DATA	WDAAKA,1		;[6043]Alias block
	WDAEND==WDAAKA			;[6043]End of WTO fields

	$DATA	WTOCNT,1		;COUNT OF OUTPUT BYTES IN MESSAG
	$GDATA	WTOPTR,1		;Output byte pointer
	$DATA	DESPTR,1		;DESTINATION POINTER
	$DATA	DESCNT,1		;DESTINATION COUNT
	$DATA	RSDCNT,1		;RESEND COUNT OF OPRS TO SEND TO
	$DATA	MSGCNT,1		;COUNT OF OPRS RECIEVING THIS MESSAGE
	$DATA	OPRRCT,1		;COUNT OF ENTRIES IN RESEND LIST
	$DATA	OPRRSL,1		;OPR RESEND LIST NUMBER
	$DATA	PAGFLG,1		;PAGE MESSAGE TO BE SENT
;**;[6044]At $DATA PAGFLG+1 change 1 line  JYCW  6/8/90
	$GDATA	NOALTN,1		;[6044]NO ALTERNATE NODES ON SEND FLAG
	$DATA	SCRWRD,1		;SCRATCH WORD FOR EACH COMMAND

;JOB RELATED DATA FOR LOG AND DISPLAY

	$GDATA	JOBNUM,1		;JOB NUMBER
	$GDATA	JOBTTY,1		;JOB TERMINAL NUMBER
	$GDATA	JOBNOD,1		;Job's node
	$GDATA	JOBLIN,1		;Job's line
	$GDATA	JOBUSN,2		;JOB USER NAME
	$GDATA	JOBNAM,1		;JOB PROGRAM NAME
	$GDATA	JOBJLT,1		;JOB LOGGED IN TIME
	$GDATA	JOBID,1			;JOB NUMBER OR PPN

	$GDATA	JOBTER,1		;ITEXT ADDRESS FOR TERMINAL DATA
	$GDATA	JOBTXT,1		;ITEXT FOR JOB HEADER LINE

	$DATA	SFLADR,1		;ADDRESS OF SEND FAIL PIDS TABLE
	$DATA	SFLCNT,1		;NUMBER OF POSSIBLE ENTRIES IN TABLE
	$DATA	SFLFRE,1		;NUMBER OF FREE ENTRIES

;NSP DATA FOR LINKS

TOPS20<
	$DATA	LEV1PC,1		;PC FOR LEVEL 1 INTERRUPT
	$DATA	LEV2PC,1		;PC FOR LEVEL 2 INTERRUPT
	$DATA	LEV3PC,1		;PC FOR LEVEL 3 INTERRUPT
	$GDATA	TRMFRK,1		;FORK TERMINATION FLAG
	$GDATA	NSPCON,1		;CONNECT INTERRUPT FLAG -1..CONNECT
	$GDATA	NSPACT,1		;FLAG FOR NSP SETUP -1..ACTIVE
	$GDATA	NODNAM,2		;NODE NAME FOR CURRENT CONNECT
	$GDATA	SRVDAT,2		;STORAGE FOR SERVER DATA CHECK
	$GDATA	SRVTBL,SRV.SZ*NUMSRV	;ALLOCATE TABLE SPACE
	$GDATA	SRVACS,20		;BLOCK FOR THE ACS
	$GDATA	NIJBLK,.EIBMX		;Data block for the NI% JSYS
	$DATA	NFYDIR,1		;NOTIFY DIRECTORY BLOCK
	$DATA	NFYSUB,1		;SUBJECT POINTER
	$DATA	NFYTXT,1		;TEXT POINTER
	$DATA	SCHBLK,10		;SCHEDULER DATA WORDS
;**;[6043]At $DATA SCHBLK add 7 lines   PMM   6/3/90
	$GDATA	AKAOUT,1		;[6043]SHOW ALIAS entry counter
	$DATA	LSTENT,1		;[6043]SHOW ALIAS last entry address
	$DATA	CRLFLG,1		;[6043]Set when last ASCII string was CRLF
	$DATA	NOROOM,1		;[6043]Indicates output page is full
	$DATA	BYTPTR,1		;[6043]Byte pointer for $TEXT routine.
	$DATA	BYTCNT,1		;[6043]# of bytes available in buffer
	$DATA	DATADR,1		;[6043]Page address for SHOW ALIAS data
;**;[6044]At $DATA DATADR+1 add 2 lines  JYCW  6/8/90
	$DATA	SENDMS			;[6044]Address of msg for SEND command
	$DATA	JOBNO			;[6044]Job number for SET JOB

>;END TOPS20

	$DATA	DATEND,0		;END OF THE DATA AREA

	DATASZ==G$STAD-DATEND		;SIZE OF THE DATA AREA

FNDXCT:: CAMN	P1,MSL.ID(S2)		;[6005]MATCH INSTRUCTION
NULTXT:: ITEXT	(<>)

QSRNAM:	ASCIZ/QUASAR/			;[6005]
NEBNAM:	ASCIZ/NEBULA/			;[6005]
MDANAM:	ASCIZ/MOUNTR/			;[6005]
;**;[6042]At MDANAM:+1L add 3 lines  JCR  4/27/90
MAXNOD==7				;[6042]Maximum number of remote nodes
PNDENM:	0,,.NDENM			;[6042]Proto remote node block
	BLOCK	MAXNOD			;[6042]Remote node list
SUBTTL	Interrupt vector definitions


TOPS20<

LEVTAB:: EXP	LEV1PC
	EXP	LEV2PC
	EXP	LEV3PC

;  Interrupt channel table

CHNTAB::
	BLOCK	6			; 0- 5 -- Reserved for SERVER links
	BLOCK	3			; 6- 8 -- Fixed interrupts, not used
	BLOCK	1			;    9 -- .ICPOV - PDL overflow;
					;	  Enabled by library
	BLOCK	5			;10-14 -- Fixed interrupts, not used
	BLOCK	1			;   15 -- .ICILI - illegal instruction
					;	  Enabled by library
	BLOCK	1			;   16 -- .ICIRD - illegal memory read
					;	  Enabled by library
	BLOCK	1			;   17 -- .ICIWR - illegal memory write
					;	  Enabled by library
	BLOCK	1			;   18 -- Reserved for DEC
	BLOCK	1			;   19 -- .ICIFT - inferior fork term.
					;	  May be set to support DN200
	BLOCK	3			;20-22 -- Fixed interrupts, not used
	XWD	IPCLEV,INT		;   23 -- Set for IPCF interrupts
	BLOCK	^D12			;24-35 -- Not currently used
>;END TOPS20

TOPS10<
INTVEC:
IPCINT:	$BUILD	.PSVIS+1
	$SET(.PSVNP,,INT)
	$EOB
>;END TOPS10
SUBTTL	Initialization block

IPBBLK::$BUILD	IB.SZ
	$SET(IB.FLG,IP.STP,1)		;SET FOR STOPCODES TO CATCH ANY CRASHES
	$SET(IB.FLG,IB.SYS,ORN.JP)	;Set system process
	$SET(IB.FLG,IB.NAC,1)		;Restrict access to JFNs
	$SET(IB.PRG,,%%.MOD)		;PROGRAM NAME
IFN	FTDN60,<
	$SET(IB.OUT,,OUTRTN)		;NO DEFAULT SETUP
>;END FTDN60
IFE	FTDN60,<
	$SET(IB.OUT,,.RETT)		;NULL OUTPUT ROUTINE
>;END FTDN60
TOPS20<
	$SET(IB.INT,,<LEVTAB,,CHNTAB>)
>;END TOPS20
TOPS10<
	$SET(IB.INT,,INTVEC)
>;END TOPS10
	$SET(IB.PIB,,PIBBLK)		;ADDRESS OF PID BLOCK
	$EOB


PIBBLK:	$BUILD	PB.MXS			;SIZE OF BLOCK
	$SET(PB.HDR,PB.LEN,PB.MXS)	;MAXIMUM SIZE OF BLOCK
	$SET(PB.SYS,IP.MNP,^D10)	;ALLOW FOR 10. PIDS
	$SET(PB.SYS,IP.BQT,-1)		;SEND AND RECEIVE TO MAX.
	$SET(PB.FLG,IP.RSE,1)		;RETURN ON SEND ERRORS
	$SET(PB.FLG,IP.PSI,1)		;CONNECT PID TO PSI
	$SET(PB.FLG,IP.SPB,1)		;SET IF IPCF SENDER WAS PRIVILEGED
	$SET(PB.FLG,IP.JWP,1)		;GET JOB WIDE PID
	$SET(PB.INT,IP.SPI,SP.OPR)	;SYSTEM ORION
TOPS10<	$SET(PB.INT,IP.CHN,<IPCINT-INTVEC>)> ;OFFSET FOR IPCF BLOCK
TOPS20<	$SET(PB.INT,IP.CHN,^D23)>	;CHANNEL FOR IPCF
	$SET(PB.LOC,,<-1,,G$NODX>)	;SPACE FOR LOCATION STRING
	$EOB


;DEFINE THE OBJECT BLOCK

	DEFINE	X(A,B),<$SET(.OT'B,,.ZZ)
		.ZZ==.ZZ+1>

OBJBLK:	$BUILD	.OTMAX+1		;MAXIMUM NUMBER OF OBJECTS
	.ZZ==1				;SETUP ENTRIES
	OBJORN				;EXPAND ENTRIES
	$EOB				;END OF BLOCK
SUBTTL	ORION	Main entry and initialization

ORION:	RESET				;RESET THE WORLD
	MOVE	P,[IOWD PDLEN,PDL]	;SET UP STACK POINTER
	MOVX	S1,IB.SZ		;GET THE SIZE OF THE IPB
	MOVEI	S2,IPBBLK		;GET ADDRESS OF THE IPB
	$CALL	I%INIT##		;INITIALIZE THE IPCF INTERFACE
	MOVEI	S1,DATASZ		;SIZE OF THE DATA BASE
	MOVEI	S2,G$STAD		;START OF DATA BASE
	$CALL	.ZCHNK			;ZERO THE DATA BASE
	$CALL	I%NOW			;GO GET THE DATE/TIME
	MOVEM	S1,G$NOW		;SAVE AS THE CURRENT TIME
	SETZM	G$SEQ			;CLEAR GLOBAL SEQUENCE NUMBER
	$CALL	L%CLST			;CREATE NODE LIST
	MOVEM	S1,G$NODL		;SAVE THE NUMBER
	$CALL	L%CLST			;CREATE A LIST
	MOVEM	S1,G$RSDL		;SAVE AS RESEND LIST
	$CALL	L%CLST			;CREATE A LIST
	MOVEM	S1,G$SNDL		;SAVE AS UNSENT LIST
	$CALL	L$INIT##		;INIT LOG ROUTINE
	SKIPE	LOGINT##		;LOGGING ENABLED?
	$CALL	L$OPNL##		;OPEN ORIONS LOG FILE
	$CALL	EXPTAB			;SETUP OPR TABLE AND OPR RESEND TABLE
	$CALL	I%ION			;LIBRARY TURN ON INTERRUPTS
	$CALL	ORNINT			;SETUP ORION NEEDED DATA
	$CALL	N$BLDP			;[6005]BUILD THE REMOTE DISPLAY BLOCK
;**;[6043]Add 2 lines at ORION:+24L   PMM  6/3/90
	SETZM	HDRAKA			;[6043]Initialize linked list
	$CALL	QSRHEL			;[6043]Send HELLO message to QUASAR
	JRST	MAIN			;NOW GO ENTER MAIN LOOP
SUBTTL	MAIN	IPCF message processing loop

;THIS ROUTINE RECEIVES THE NEXT IPCF MESSAGE FROM THE QUEUE WHEN IT IS
;AVAILABLE, CHECKS ITS FORMAT, AND DISPATCHS ON ITS TYPE

MAIN:	$CALL	I$SYSV			;GET SYSTEM VARIABLES
	$CALL	C%RECV			;CHECK FOR MESSAGE
	JUMPT	MAIN.0			;IF A MESSAGE, PROCESS IT
TOPS20<
	SKIPE	NSPCON			;DID WE GET A CONNECT
	$CALL	N$CONN##		;PROCESS THE CONNECT
	SKIPE	TRMFRK			;FORK TERMINATIONS?
	$CALL	N$TERM##		;TERMINATE FORK AND LINKS
>;END TOPS20
	MOVEI	S1,0			;SLEEP UNTIL SOMETHING TO DO
	$CALL	I%SLP			;SLEEP AND/OR PROCESS TIMERS
	JRST 	MAIN			;GO TO MAIN

;  Here when there is a message

MAIN.0:	SETZM	G$ERR			;CLEAR ERROR FLAG
	MOVE	P1,S1			;COPY MDB ADDR TO P1
	LOAD	MI,MDB.MS(P1),MD.ADR	;GET MESSAGE ADDRESS
	MOVE	S1,MDB.SP(P1)		;GET THE PID
	MOVEM	S1,G$SND		;SAVE THE PID
	LOAD	S1,MDB.FG(P1),IP.CFC	;GET SYSTEM SENDER WORD

;  Determine where the message is from

	JUMPE	S1,MAIN.1		;FROM A GALAXY COMPONENT
	CAIE	S1,.IPCCC		;FROM [SYSTEM]INFO
	JRST	[			
		CAIE  S1,.IPCCG	           ;FROM [SYSTEM]GOPHER?
		JRST  MAIN.2		   ;NO, SOME KIND OF ERROR
		MOVE  S2,P1                ;SAVE ADDRESS OF MDB FOR LATER USE
		$CALL GOPHMS		   ;GO PROCESS
		JUMPF MAIN.2		   ;ERROR, GO CLEAN UP
		JRST  MAIN.1		   ;CONVERTED, CONTINUE PROCESSING
		]
	LOAD	S1,MDB.FG(P1),IP.CFE	;LOAD ERROR CODE
	SKIPE	S1			;ERROR CODE PRESENT?
	JRST	MAIN.2			;YES, PITCH MESSAGE
	$CALL	IPCCMS			;PROCESS SYSTEM MESSAGE
	JRST	MAIN.2			;GO TO FINISH
MAIN.1:	LOAD	S1,MDB.FG(P1),IP.CFM	;LOOK AT PACKET HEADER
	CAXN	S1,.IPCFN		;IS IS A RETURNED MESSAGE?
	JRST	MAIN.6			;[6005]CHECK FOR OPR AND THEN PITCH
	MOVE	S2,P1			;AIM AT THE MDB
	$CALL	PROIPC			;CALL DISPATCH AND CHECKING AS SUBROUTINE
	MOVE	S1,.MSFLG(MI)		;GET MESSAGE FLAGS
	MOVEM	S1,G$FLAG		;SAVE THE MESSAGE FLAGS
	LOAD	S1,G$FLAG,MF.ACK	;ACK REQUESTED?
	JUMPN	S1,MAIN.3		;[6005]YES, GO SEND ACK
;  Here to clean up

MAIN.2:	SKIPE	G$NERR			;[6005]NEBULA MESSAGE ACK ERROR?
	JRST	MAIN.5			;[6005]YES, GO PROCESS IT
	SKIPE	G$NACK			;[6005]DOES NEBULA REQUEST AN ACK?
	JRST	MAIN.4			;[6005]NO, SO DON'T SEND ONE	
	SKIPN	G$ERR			;[6005]ALWAYS SEND ACK ON ERROR
	SKIPA				;DON'T SEND AN ACK
MAIN.3:	$CALL	G$ACK			;[6005]ACKNOWLEDGE THE MESSAGE
MAIN.4:	SKIPE	G$ERR			;[6005]WAS THERE AN ERROR
	$CALL	L$ERR##			;LOG THE ERROR
	SKIPA				;[6005]RELEASE THE MESSAGE PAGE
MAIN.5:	$CALL	G$ACKN			;[6005]PROCESS THE NEBULA ACK MESSAGE
	$CALL	C%REL			;[6005]RELEASE THE MESSAGE
	JRST	MAIN			;AND LOOK FOR MORE MESSAGES

;Here on a returned message

MAIN.6:	MOVE	S1,MDB.SP(P1)		;[6005]GET THE SENDERS PID
	$CALL	VALOPR			;CHECK IS IT WAS AN OPR
	JUMPF	MAIN.2			;RELEASE IT AND CONTINUE ON
	MOVE	S1,MDB.SP(P1)		;GET THE SENDERS PID
	$CALL	DELOPR			;DELETE THE OPR
	JRST	MAIN.2			;CONTINUE ON
	SUBTTL	I$SYSV - Get system variables

;This routine fetchs the system variables that may be changing.
;Currently there are:
;	G$NOW/		current UDT
;	G$OPR/		true/false for operator on duty
;(routine name and most code borrowed from I$SYSV in QSRTxx)

I$SYSV:	$CALL	I%NOW			;GET CURRENT TIME
	MOVEM	S1,G$NOW		;SAVE FOR THE WORLD TO KNOW
TOPS10 <
	SETOM	G$OPR			;ASSUME OPERATOR ON DUTY
	MOVX	S1,%CNSTS		;GETTAB ARGS
	GETTAB	S1,			;GET THE MONITOR'S STATES WORD
	  SETZ	S1,			;SICK MONITOR
	TXNE	S1,ST%NOP		;CHECK
	SETZM	G$OPR			;NO OPERATOR ON DUTY
>
TOPS20 <
	SETOM	G$OPR			;ASSUME OPERATOR ON DUTY
	MOVX	S1,.SFOPR		;GET FUNCTION CODE
	TMON				;ASK MONITOR FOR OPR IN ATTENDANCE
	SKIPN	S2			;ANYONE AROUND ???
	SETZM	G$OPR			;NO
>
	$RET				;AND RETURN
SUBTTL	REQTIM	Routine to put a request on the event queue

;ACCEPTS	S1/ UDT or 0,,Milliseconds
;		S2/ PC of routine to be called

;The routine will be called at the appropriate time from I%SLP


REQTIM::STKVAR <<TIMBLK,.TIMPC+1>>	;Get request block
	MOVEM	S1,.TITIM+TIMBLK	;Save request time
	MOVEM	S2,.TIMPC+TIMBLK	;Save the event PC
	MOVEI	S2,.TIMEL		;Assume elapsed time
	TLNE	S1,700000		;Unless date is present
	MOVEI	S2,.TIMDT		;Request UDT
	MOVEM	S2,.TIFNC+TIMBLK	;Save the function
	SETZM	.TIPSI+TIMBLK		;Clear PSI word
	MOVEI	S1,.TIMPC+1		;Get length of request
	MOVEI	S2,TIMBLK		;Get address of block
	$CALL	I%TIMR			;Place on the timer queue
	$RET				;Return true/false per timer

;**;[6043]After routine REQTIM add routine QSRHEL  PMM  6/3/90
SUBTTL	QSRHEL  ORION HELLO Message to QUASAR

;[6043]QSRHEL formats and sends a HELLO message for QUASAR. This
;[6043] HELLO message tells QUASAR to delete all alias names from
;[6043]its object queue and routing table.

QSRHEL:	$CALL	GETPAG			;[6043]Get a page
	MOVEI	S1,.OMHEL		;[6043]Get ORION hello code
	HRLI	S1,PAGSIZ		;[6043]Get message length 
	MOVEM	S1,.MSTYP(MO)		;[6043]Save the length in the message
	$CALL	SNDQSR			;[6043]Send to QUASAR
	$RET				;[6043]And return
SUBTTL	PROIPC	Process an IPCF message

;CALL -
;	S2/	MDB ADDRS
;	MI/	INCOMING MESSAGE ADRS

PROIPC:	$SAVE	<P1>			;PRSERVE SOME SPACE
	MOVE	P1,S2			;COPY THE MDB POINTER
	AOS	G$MSGC			;BUMP COUNT OF MESSAGES
	SETZM	G$OPRA			;CLEAR OPERATOR ADDRESS WORD
	SETZM	G$ASND			;ALWAYS SEND FLAG OFF
	SETZM	G$NACK			;[6005]ASSUME NEBULA REQUESTS AN ACK
	SETZM	G$NERR			;[6005]ASSUME NO ERROR IN REMOTE SHOW ACK
;**;[6030]At PROIPC:+6L add 1 line JYCW Oct-18-88
	SETZM	G$NOFG			;[6030]ASSUME NO /NODE: SWITCH
	LOAD	S1,MDB.PV(P1)		;GET THE SENDER'S PRIVS
	STORE	S1,G$PRVS		;SAVE FOR ALL
	LOAD	S1,S1,MD.PJB		;GET THE JOB NUMBER
	STORE	S1,G$JOB		;SAVE FOR ALL
	MOVEI	S2,JI.TLC		;GET PHYSICAL LOCATION
	$CALL	I%JINF
	MOVEM	S2,G$NODE		;SAVE FOR ALL TO SEE
	LOAD	S1,MDB.SD(P1)		;GET SENDER'S ID
	STORE	S1,G$SID		;SAVE FOR ANYONE
	SKIPN	G$SND			;CHECK FOR ZERO PID
	  PJRST  E$IPS			;INVALID PID SPECIFIED
	LOAD	S1,.MSTYP(MI),MS.CNT	;GET THE LENGTH FROM THE HEADER
	LOAD	S2,MDB.MS(P1),MD.CNT	;AND FROM THE MDB
	CAMG	S1,S2			;[6025]SENDER'S LENGTH BETTER BE CORRECT
	CAIG	S1,0			;[6025]GREATER THAN 0?
	JRST	E$BML			;BAD MESSAGE LENGTH
	LOAD	T1,.MSTYP(MI),MS.TYP	;GET MESSAGE TYPE
	MOVEM	T1,G$ARG1		;SAVE MESSAGE TYPE
	CAIG	T1,.OMOFF		;VALID ORION MESSAGE
	JRST	PROI.2			;CHECK QUASAR MESSAGES
	CAIN	T1,.OMCMD		;IS IT A COMMAND
	JRST	PROI.1			;BYPASS MSGCHK AND CONTINUE
	MOVE	S2,P1			;COPY OVER THE MDB POINTER
	$CALL	MSGCHK			;CONSISTENCY CHECK THE MESSAGE
	JUMPT	PROI.1			;[6016]PICK UP MESSAGE TYPE ON SUCCESS
	MOVX	S1,MF.NEB		;[6016]PICK UP THE NEBULA BIT
;**;[6032]At PROI.1:-3L change 1 line  JCR  11/29/89
	TDNE	S1,.MSFLG(MI)		;[6032]Is this from a remote node?
	SETOM	G$NERR			;[6016]YES, INDICATE SO
	$RET				;[6016]PRESERVE THE T/F INDICATOR
PROI.1:	LOAD	S1,.MSTYP(MI),MS.TYP	;GET THE MESSAGE TYPE
	CAIL	S1,.NBMSG		;[6005]IS THIS A NEBULA MESSAGE?
	PJRST	NEBMSG			;[6005]YES, GO PROCESS IT
	MOVEI	S2,MANTAB		;ENABLE DISPATCH TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	JUMPF	E$IMT			;ERROR..IGNORE THE MESSAGE
	PUSHJ	P,(S2)			;Process the routine
	$RET				;Return, preserving the return
PROI.2:	CAIE	T1,.QONWA		;NODE WENT AWAY
	$RETF				;RETURN FALSE
	PJRST	DELNOD			;DELETE NODE ROUTINE

MANTAB:	$STAB
	.OMWTO,,W$WTO			;WRITE TO OPERATOR
	.OMCMD,,COMMAN			;COMMAND MESSAGE(FROM OPR PARSER PROGRAM)
	.OMWTR,,W$WTOR			;WTOR FOR NOW
	.OMACK,,W$ACKM			;WTO FOR NOW
	.OMACS,,W$SHOW			;SHOW ACK RESPONSE FROM QUASAR
	.OMOHL,,OPRHEL			;OPR HELLO MESSAGE
	.OMOSR,,OPRSET			;OPR SETUP REPLY
	.OMAHL,,APLHEL			;APPLICATION HELLO MESSAGE
	.OMLOG,,W$LOGM			;LOG MESSAGE
	.OMNFY,,NOTIFY			;NOTIFY CODE
	.OMTKE,,TAKEND			;END OF TAKE COMMAND
IFN	FTDN60,<
	.OMD60,,CMDMES			;COMMAND MESSAGE FROM CDRIVE
>;END FTDN60
	.OMDSP,,RETMES			;RETURNED DN60 DISPLAY MESSAGE
;**;[6032]At MANTAB:+15L add 1 line  JCR  11/29/89
	.OMNAK,,NULACK			;[6032]NULL ACK message
	$ETAB
SUBTTL	IPCCMS	Process messages from [SYSTEM]IPCC

;CALL -
;	MI/	INCOMING MESSAGE FROM IPCC

	SYSPRM	LOGMSK,RHMASK,RHMASK	;MASK TO GET JOB NUMBER
	SYSPRM	OB.BSN,OB.BSN,OB%BSN	;BATCH STREAM NUMBER FIELD

IPCCMS:	LOAD	S1,LGO.HD(MI),LOGMSK	;GET FUNCTION CODE
	CAIN	S1,.IPCSL		;LOGOUT MESSAGE
	JRST	IPCC.0			;YES, HANDLE IT
	$RET				;NO, FLUSH IT

;HERE ON A LOGOUT MESSAGE
IPCC.0:	$SAVE	<P1,P2,P3>
	LOAD	S1,LGO.JB(MI),LG.JOB	;GET THE JOB NUMBER
	STORE	S1,G$PRVS,MD.PJB	;SAVE THE JOB NUMBER
	STORE	S1,G$JOB		;DITTO
	MOVX	S2,MSL.JB		;MATCH ON JOB NUMBER
	HRRM	S2,FNDXCT		;SAVE IN COMPARE
	$CALL	FNDMSG			;FIND THE MESSAGE
	JUMPF	IPCC.2			;NONE..TRY ANY OPRS TO DELETE
IPCC.1:	SETZ	P1,			;CLEAR P1 FOR SCRATCH
	EXCH	P1,G$ERR		;SAVE ERROR CODE
	MOVX	S1,E$JLO		;JOB LOGGED OUT
	$CALL	W$KMES			;KILL THE MESSAGE
	$CALL	L$KMJB##		;LOG THE MESSAGE
	MOVEM	P1,G$ERR		;RESTORE THE ERROR CODE
	LOAD	S1,G$JOB		;GET JOB NUMBER
	$CALL	NXTMSG			;GET THE NEXT MESSAGE
	JUMPT	IPCC.1			;KILL OTHER MESSAGES ALSO
IPCC.2:	LOAD	P3,G$JOB		;GET JOB NUMBER
	MOVE	P1,TABADR		;GET THE TABLE ADDRESS
	MOVE	P2,TABCNT		;MAXIMUM NUMBER OF ENTRIES
	SUB	P2,TABFRE		;GET ACTIVE OPRS
	SKIPN	P2			;ANY OPRS RUNNING?
	$RET				;NONE SETUP SO FAR..RETURN
IPCC.3:	SKIPN	T2,TOP.OA(P1)		;GET OPR ENTRY ADDRESS
	JRST 	IPCC.5			;ZERO..TRY NEXT ONE
	CAME	P3,OPR.JB(T2)		;CHECK JOB FOR MATCH
	JRST	IPCC.4			;MATCH..SETUP FOR RETURN
	MOVE	S1,OPR.PD(T2)		;GET THE PID
	$CALL	DELOPR			;DELETE THE OPR
IPCC.4:	ADDI	P1,TOP.SZ		;BUMP TO NEXT ENTRY
	SOJG	P2,IPCC.3		;LOOP THROUGH ALL ENTRIES
	$RET				;NO SUCH OPR, ALL DONE WITH LOGOUT
IPCC.5:	ADDI	P1,TOP.SZ		;BUMP TO NEXT ENTRY
	JRST	IPCC.3			;TRY NEXT ONE
SUBTTL	GOPHMS	Process messages from [SYSTEM]GOPHER

;CALL -
;	MI/	INCOMING MESSAGE FROM THE GOPHER
;	S2/	MDB ADRS
;RETURNS -
;	TRUE/	MESSAGE PROCESSED - continue processing converted message
;	FALSE/	THE MESSAGE WAS BAD

GOPHMS:	LOAD	S1,.MSCOD(MI),MD.PJB	;GET THE JOB NUMBER
	STORE	S1,MDB.PV(S2),MD.PJB	;STORE JOB NUMBER IN THE MDB
	LOAD	S1,.MSTYP(MI),MS.TYP	;GET THE FUNCTION TYPE
	CAIN	S1,.QUWTO		;WRITE TO OPERATOR?
	JRST	[
		MOVX  S1,.OMWTO		   ;YES, CONVERT
		JRST  GOPHM1
		]
	CAIE	S1,.QUWTR		;WRITE TO OPERATOR WITH REPLY?
	PJRST	E$IFC##			;NO, AN ERROR
	MOVX	S1,.OMWTR		;YES, CONVERT
GOPHM1:	STORE	S1,.MSTYP(MI),MS.TYP	;STORE THE CONVERTED FUNCTION TYPE
	$SAVE	<P1,P2>
	$CALL	MSGCHK			;MAKE SURE THE MESSAGE LOOKS REASONABLE
	$RETIF				;IT DOESN'T, QUIT
	MOVEI	S1,.OHDRS(MI)		;AIM AT THE START OF THE BLOCKS
	$CALL	P$SETU##		;START THE BLOCK GETTER
	SKIPG	P1,.OARGC(MI)		;GET THE ARGUMENT BLOCK COUNT
	PJRST	E$ICS##			;NO GOOD, QUIT
GOPH.1:	$CALL	P$NARG##		;GET THE NEXT ARGUMENT BLOCK ADRS
	MOVSI	P2,-GOPHLN		;# OF ENTRIES TO  CHECK
	LOAD	S1,ARG.HD(S2),AR.TYP	;GET THIS BLOCK TYPE
GOPH.2:	HLRZ	TF,GOPHMP(P2)		;GET THIS CODE
	CAIE	TF,0(S1)		;IS THIS THE RIGHT BLOCK TYPE?
	AOBJN	P2,GOPH.2		;NO, TRY THE NEXT TYPE
	JUMPGE	P2,E$IFC##		;NO MATCH, GIVE UP
	CAIN	TF,.QBDFG		;Is this a display flags block?
	$CALL	GOPFLG			;Yes, go fix the flags
	HRRZ	TF,GOPHMP(P2)		;GET OUR BLOCK TYPE
	STORE	TF,ARG.HD(S2),AR.TYP	;CONVERT TO OUR TYPE
	$CALL	P$NEXT##		;STEP TO THE NEXT BLOCK
	SOJG	P1,GOPH.1		;CONVERT EACH BLOCK
	$RETT				;INDICATE MORE PROCESSING REQUIRED

;Conversion table for mapping user argument block types
; Into 'old' style WTO blocks

GOPHMP:	XWD	.QBNOD,.WTDES		;NODE BLOCK -- DESTINATION NODE
	XWD	.QBTYP,.WTTYP		;TYPE BLOCK -- MAP IT!
	XWD	.QBMSG,.WTTXT		;MESSAGE BLOCK -- MAKE IT A TEXT BLOCK
	XWD	.QBDTY,.WTDTY		;Display type
	XWD	.QBDFG,.WTNOP		;Flags (set then process as noop)
	GOPHLN==.-GOPHMP		;NUMBER OF ENTRIES
SUBTTL	GOPFLG	Gopher display flag processing

;  This routine takes the flags argument block and maps the flags into
;  the normal flag word of the message.

;  AC usage:
;	S1 / trashed with intermediate flags
;	S2 / contains address of the current argument block (preserved)
;	MI / contains incomming message (preserved)

GOPFLG:	$SAVE	P1			;Need an ac
	MOVE	P1,ARG.DA(S2)		;Get the data (flags indicated)
	SETZ	S1,			;Zero out the target flag word
	TXNE	P1,QU%SJI		;Suppress job info indicated?
	TXO	S1,WT.SJI		;Yes, set it
	TXNE	P1,QU%NFO		;No format indicated?
	TXO	S1,WT.NFO		;Yes, set it
	TXNE	P1,QU%NDA		;No dashed indicated?
	TXO	S1,WT.NDA		;Yes, set it

	MOVEM	S1,.OFLAG(MI)		;Set the flag word for the message
	$RET
SUBTTL	ORNINT	Initialization routines

;THIS ROUTINE WILL GET THE REQUIRED MONITOR INFORMATION NEEDED
;BY ORION FOR PROCESSING.

ORNINT:	$CALL	I%HOST			;GET HOST NAME/NUMBER
	MOVEM	S1,G$HOST		;SAVE THE HOST NAME IN SIXBIT.
	MOVEM	S2,G$HSTN		;SAVE THE HOST NUMBER
	$CALL	C%MAXP			;GET MAXIMUM PACKET SIZE
	MOVEM	S1,G$MAXP		;SAVE MAXIMUM PACKET SIZE

TOPS10<
;FIND THE OPERATOR PPN
	MOVX	S1,%LDFFA		;GETTABB THE FAILSAFE PPN
	GETTAB	S1,			;...
	  $STOP(CFO,Cannot GETTAB operator PPN)
	MOVEM	S1,OPRPPN		;SAVE FOR LATER
	MOVX	S1,%CNFLN		;Gettab the FRCLIN line number
	GETTAB	S1,			;...
	  $STOP	(CGF,Cannot GETTAB FRCLIN line number)
	ADDI	S1,.UXTRM		;Make it a UDX
	MOVEM	S1,FRCLIN		;Store it
>;END TOPS10

	MOVE	S1,G$HOST		;NODE OF CENTRAL SITE
	$CALL	CHKNOD			;CHECK THE NODE
	JUMPT	ORNI.1			;ADD THE NODE
	MOVE	S1,G$HOST		;GET THE CENTRAL SITE
	SETZ	S2,			;ZERO THE NODE NUMBER
ORNI.1:	$CALL	ADDNOD			;SETUP THE NODE
	MOVX	T1,ND.SYS		;MARK AS SYSTEM OPERATOR
	IORM	T1,NOD.FL(S1)		;S1 ADDRESS OF NODE LIST ENTRY
	SETOM	S1			;SET FOR MY JOB
	MOVX	S2,JI.JNO		;GET MY JOB NUMBER
	$CALL	I%JINF			;GET THE JOB INFO
	MOVEM	S2,G$MJOB		;SAVE MY JOB NUMBER
TOPS20<
	SKIPN	DEBUGW			;ARE WE DEBUGGING?
	$CALL	N$INIT##		;NO..SETUP THE NSP SRV IF CAN
	SKIPE	S1,G$MJOB		;ARE WE RUNNING UNDER JOB 0
	$RETT				;NO..JUST RETURN
	SETZB	T3,T4			;CLEAR T3 AND T4
	MOVE	T1,[POINT 6,G$HOST]	;GET THE LOCATION
	MOVE	T2,[POINT 7,T3]		;PLACE TO STORE STRING
	MOVEI	P1,6			;MAXIMUM LENGTH
ORNI.2:	ILDB	S2,T1			;GET A BYTE
	JUMPE	S2,ORNI.3		;O.K. SET THE LOCATION
	ADDI	S2,40			;CONVERT TO ASCII CHARACTER
	IDPB	S2,T2			;SAVE THE BYTE
	SOJG	P1,ORNI.2		;CHECK NUMBER OF CHARACTERS
ORNI.3:	MOVX	S2,.SJLLO		;SETUP LOCATION
	HRROI	T1,T3			;GET STRING
	SETJB				;SET IT UP
	ERJMP	.+1			;IGNORE ERROR FOR NOW
>;END TOPS20
	$RET				;RETURN
SUBTTL	MSGCHK	Message length and header validation

;THIS ROUTINE WILL CHECK OUT THE LENGTH AND HEADER INFO FOR
;THE MESSAGE AND ALL ARGUMNET BLOCKS SPECIFIED
;CALL -
;	S2/	MDB ADRS
;	MI/	ADRS OF INCOMING MESSAGE

MSGCHK:	$SAVE	<P1>
	MOVE	P1,S2			;COPY THE MDB ADRS OVER
	LOAD	S2,MDB.MS(P1),MD.CNT	;GET THE SIZE OF THE MESSAGE
	MOVE	T1,MI			;SAVE START ADDRESS IN T1
	ADDI	T1,(S2)			;COMPUTE ENDING ADDRESS OF MESSAGE
	LOAD	T2,.MSTYP(MI),MS.CNT	;GET THE COUNT FROM MESSAGE
	ADDI	T2,(MI)			;COMPUTE LENGTH OF MESSAGE
	CAMLE	T2,T1			;WITHIN ACTUAL LIMITS
	PJRST	E$MTS			;MESSAGE TO SHORT
	MOVEI	S1,.OHDRS(MI)		;GET ADDRESS OF FIRST ARGUMENT
	CAMLE	S1,T1			;LENGTH WITHIN BOUNDS
	PJRST	E$MTS			;MESSAGE TO SHORT
	SKIPN	T2,.OARGC(MI)		;ANY ARGUMENTS IN MESSAGE
	JRST	MSGC.3			;YES..CHECK THEM OUT
MSGC.1:	SKIPG	T2			;VALID COUNT FIELD
	PJRST	E$ICS			;INVALID COUNT SPECIFIED
	SKIPA				;SKIP OVER INCREMENT FIRST TIME
MSGC.2:	ADDI	S1,1			;POINT TO NEXT HEADER
	MOVEI	T3,ARG.HD(S1)		;ADDRESS OF ARGUMENT HEADER
	CAMLE	T3,T1			;ADDRESS IN MESSAGE
	PJRST	E$BML			;BAD MESSAGE LENGTH SPECIFIED
	LOAD	S2,ARG.HD(S1),AR.LEN	;GET THE LENGTH
	SKIPG	S2			;MAKE SURE POSITIVE
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH
	ADDI	S1,-1(S2)		;COMPUTE ADDRESS OF NEXT ARGUMENT
	CAMLE	S1,T1			;STILL WITHIN BOUNDS
	JRST	E$BML			;BAD MESSAGE LENGTH
	SOJG	T2,MSGC.2		;PROCESS ALL ARGUMENTS
MSGC.3:	SUBI	S1,1			;DECREMENT BY 1
	CAMLE	S1,T1			;SHOULD BE EXACT OR LESS
	JRST	E$BML			;BAD MESSAGE LENGTH
	$RETT				;RETURN TRUE
SUBTTL	RETMSG	Returned DN60 or remote display message display

;This routine will resend the Display message that was sent to
;Quasar to the Central Site Operator

RETMES:	$CALL	SPGOUT			;SETUP PAGE FOR OUTPUT
	MOVE	S1,.MSFLG(MO)		;[6005]PICK UP THE FLAG WORD
	TXNE	S1,MF.NEB		;[6005]IS THIS A REMOTE MESSAGE?
	JRST	RETM.1			;[6005]YES, TREAT DIFFERENTLY
	MOVE	S1,G$HOST		;GET CENTRAL SITE NODE ENTRY
;**;[6042]At RETMES:+4L add 1 line  JCR  4/27/90
	MOVEM	S1,WDARND		;[6042]Consider as local origin
	$CALL	FNDNOD			;FIND THE NODE
	JUMPT	SNDAOP			;SEND TO ALL OPERATOR AND RETURN
	JRST	S..CNE			;NO CENTRAL SITE NODE

;**;[6042]At RETM.1:+0L replace 1 line with 2 lines  JCR  4/27/90
RETM.1:	MOVE	S1,.OHDRS+ARG.DA(MO)	;[6042]Pick up where message originated
	MOVEM	S1,WDARND		;[6042]Save for later
	MOVE	S1,G$NOW		;[6005]PICK UP THE TIME
	MOVEM	S1,.OHDRS+ARG.DA(MO)	;[6005]PLACE IN THE 1ST DISPLAY BLOCK
	MOVE	S1,.MSFLG(MO)		;[6015]PICK UP THE FLAG WORD
	TXNE	S1,MF.WTO		;[6005]WAS THIS A WTO MESSAGE?
	JRST	RETM.2			;[6005]YES, TREAT DIFFERENTLY
;**;[6032]At RETM.1:+4L add 2 lines  JCR  11/29/89
	TXNE	S1,MF.WTR		;[6032]Was this a WTOR message?
	JRST	RETM2A			;[6032]Yes, treat differently

	$CALL	L$LACK##		;[6005]NO, WAS ORIGINALY AN ACK MSG
	$CALL	W$ASND			;[6005]SEND THE MESSAGE TO THE OPR
	$RETT				;[6005]RETURN TO THE CALLER

;**;[6032]At RETM.2:-1L add 5 lines  JCR  11/29/89
RETM2A:	$CALL	L$LWTR##		;[6032]Log the original WTOR message
	SETZM	.OFLAG(MI)		;[6032]In case WT.SND may be set
	MOVX	S1,.OMWTR		;[6032]Get the display type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6032]Save type in message
	SKIPA				;[6032]Don't log again
RETM.2:	$CALL	L$LWTO##		;[6005]LOG THE ORIGINAL WTO MESSAGE
	MOVEI	S1,.ORRFG		;[6024]REMOTE FLAGS WORD BLOCK
	SETZM	WDAOBT			;[6024]ZERO THE OBJECT WORD
	SETZM	WDAFLG			;[6024]ZERO THE FLAG WORD
;**;[6042]At RETM.2:+4L add 1 line  JCR  4/27/90
	SETZM	WDADTY			;[6042]Zero the WTO display word
	$CALL	FNDBLK			;[6024]FIND THE REMOTE FLAGS WORD BLOCK
	JUMPF	RETM.3			;[6024]IF NO REMOTE BLOCK, GET NODE LIST
	MOVE	S2,WD.OBT(S1)		;[6024]PICK UP THE WDAOBT WORD
	MOVEM	S2,WDAOBT		;[6024]SAVE FOR ROUTINE CHKOSD
	MOVE	S2,WD.FLG(S1)		;[6024]PICK UP THE WDAFLG WORD
	MOVEM	S2,WDAFLG		;[6024]SAVE FOR ROUTINE CHKOSD
;**;[6042]At RETM.2:+11L add 2 lines  JCR  4/27/90
	MOVE	S2,WD.DTY(S1)		;[6042]Pick up the WDADTY word
	MOVEM	S2,WDADTY		;[6042]Save for routine CHKOSD
RETM.3:	$CALL	WTNO.1			;[6024]PICK UP LOCAL NODE LIST ENTRY ADR
	$CALL	SNDAOP			;[6005]SEND TO THE LOCAL OPERATORS
	$RET				;[6005]RETURN TO THE CALLER

;**;[6032]At RETMES:+32L add routine NULACK  JCR  11/29/89
SUBTTL	NULACK NULL ACK message for NEBULA

;[6032]Routine NULACK logs and forwards a NULL ACK message to NEBULA
;[6032]
;[6032]Call is: MI/NULL ACK message address
;[6032]Returns true:  The message has been sent to NEBULA
;[6032]Returns false: The message cannot be sent to NEBULA

NULACK:	$CALL	SPGOUT			;[6032]Copy the message to output page
	$CALL	L$NULL##		;[6032]Log the message
	$CALL	N$SNEB			;[6032]Send the message to NEBULA
	$RETIT				;[6032]Return on success
	$CALL	LOGNSE			;[6032]Indicate an error occurred
	$RET				;[6032]Preserve the error indicator
SUBTTL	OPRHEL	Hello message from OPR

;THIS MESSAGE IS SENT BY OPR TO SIGNON TO ORION
;IF SUCCESSFUL ORION WILL CREATE THE APPROPRIATE NODE AND
;OPR ENTRIES AND SEND A SETUP TO THE OPR OF THE CURRENT
;RUNTIME VALUES.

OPRHEL:	SKIPG	T2,.OARGC(MI)		;VALID ARGUMENT COUNT
	PJRST	E$ICS			;INVALID COUNT SPECIFIED
	LOAD	T1,.OHDRS+ARG.HD(MI),AR.TYP ;GET THE TYPE
	CAIE	T1,.OPHEL		;HELLO BLOCK?
	PJRST	E$ITM			;INVALID TYPE IN MESSAGE
	SOJG	T2,E$ICS		;INVALID ARGUMENT COUNT
	MOVE	S1,.OHDRS+OPH.CG(MI)	;[6022]PICK UP OPR'S CLUSTER GALAXY VALUE
	CAIE	S1,C.GALA		;[6022]SAME AS ORION'S?
	PJRST	E$COC##			;[6022]NO, INDICATE MISMATCH
	$CALL	GETPRV			;AND GET THIS OPR'S PRIVILEGES
	JUMPF	E$IPE			;NONE!, GIVE 'EM THE GONG!
	MOVE	P3,S1			;SAVE THE PRIVS
TOPS10<
	CAXE	P3,OP.HST		;HOST OPR?
	CAXN	P3,OP.SYS		;SYSTEM OPR?
	SKIPA	S1,G$HOST		;YES, THEY LIVE AT CENTRAL!
>;END TOPS10
	$CALL	GETNOD			;FIND OUT WHERE THIS OPR LIVES
	JUMPF	E$CLO			;Can't?  Can't locate operator
	MOVEM	S1,G$ARG1		;Save node name for any errors ahead
	TXNE	P3,OP.REM		;Are we remote and
	CAME	S1,G$HOST		;  connected to the host?
	SKIPA				;No
	PJRST	E$IPE			;Yes, bad combination...
	$CALL	CHKNOD			;MAKE SURE IT'S FOR REAL!
	JUMPF	E$ION			;IT'S A PHONY!
	DMOVE	P1,S1			;SAVE NAME AND NUMBER
	DMOVE	S1,P1			;RESTORE NODE VALUES
	MOVE	T1,P3			;AND GET BACK OPR CAPABILITY BITS
	$CALL	ADDOPR			;ADD OPR TO DATA BASE
	JUMPF	E$OPD			;OPR PID ALREADY DEFINED
	PJRST	SNDSET			;SEND SETUP AND RETURN
SUBTTL	APLHEL	Hello message from application (NCP)

;THIS MESSAGE IS SENT BY AN APPLICATION TO SIGNON TO ORION
;THIS ROUTINE WILL CHECK OUT THE NAME AND IF VALID ASSIGN AN
;IDENTIFIER TO THE APPLICATION AND RETURN THE VALUE TO THE
;APPLICATION.

APLHEL:	$CALL	CHKWHL			;PRIVILEGE CHECK
	JUMPF	E$IPE			;INSUFFICIENT PRIVILEGES ENABLED
	SKIPG	T2,.OARGC(MI)		;ARGUMENT COUNT GREATER THAN 0
	PJRST	E$ICS			;INVALID COUNT SPECIFIED
	CAIE	T2,1			;BETTER BE JUST ONE ARGUMENT
	PJRST	E$ICS			;INVALID COUNT SPECIFIED
	LOAD	T1,.OHDRS+ARG.HD(MI),AR.TYP ;GET THE ARGUMENT TYPE
	CAIE	T1,.AHNAM		;APPLICATION HELLO NAME
	PJRST	E$ITM			;INVALID TYPE IN MESSAGE
	LOAD	T1,.OHDRS+ARG.HD(MI),AR.LEN ;GET LENGTH OF BLOCK
	CAIGE	T1,1			;BETTER BE GREATER THAN 1
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH SPECIFIED
	HRROI	S2,.OHDRS+ARG.DA(MI)	;ADDRESS OF TEST STRING
	MOVEI	S1,APLTAB		;TABLE HEADER
	$CALL	S%TBLK			;LOOKUP ENTRY IN TABLE
	TXNN	S2,TL%EXM		;EXACT MATCH ON STRING
	JRST	E$ANI			;INVALID APPLICATION NAME
	MOVEI	S2,APLTAB+1		;ADDRESS OF FIRST ENTRY
	HLRZM	S2,G$ARG1		;SAVE NAME FOR MESSAGES
	SUB	S1,S2			;GET TABLE OFFSET
	MOVE	T1,S1			;SAVE THE OFFSET
	MOVE	S2,G$SND		;GET SENDERS PID
	MOVEM	S2,APLPID(T1)		;SAVE PID IN TABLE
	$CALL	GETPAG			;GET MESSAGE OUT PAGE..MO SET ON RETURN
	MOVX	S1,.OMHAC		;HELLO ACKNOWLEDGMENT
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE
	MOVE	S1,.MSCOD(MI)		;[321] GET USERS ACK CODE
	MOVEM	S1,.MSCOD(MO)		;[321] RETURN IT TO HIM...
	AOS	.OARGC(MO)		;BUMP ARGUMENT COUNT
	MOVX	S1,.AHTYP		;APPLICATION HELLO TYPE CODE
	STORE	S1,.OHDRS+ARG.HD(MO),AR.TYP ;SAVE TYPE IN HEADER
	MOVX	S1,ARG.SZ		;MINIMUM SIZE OF BLOCK
	STORE	S1,.OHDRS+ARG.HD(MO),AR.LEN ;SAVE LENGTH OF BLOCK
	MOVE	S1,APLCOD(T1)		;GET APPLICATION CODE
	STORE	S1,.OHDRS+ARG.DA(MO)	;SAVE DATA IN BLOCK
	MOVEI	S1,.OHDRS+ARG.SZ	;SIZE OF THE MESSAGE
	STORE	S1,.MSTYP(MO),MS.CNT	;SAVE COUNT IN MESSAGE
	MOVE	P3,T1			;SAVE TABLE OFFSET
	MOVE	S1,G$SND		;GET SENDERS PID
	MOVEI	S2,PAGSIZ		;SEND THE PAGE
	$CALL	SNDPID			;SEND THE MESSAGE
	$RETIT				;RETURN
	SETZM	APLPID(P3)		;CLEAR TABLE ENTRY
	$CALL	RELPAG			;RETURN THE PAGE
	PJRST	E$AHF			;APPLICATION HELLO FAILURE

	DEFINE	X(A,B,C,D),<ORNDSP(,<A>,<B>)>

APLTAB:	$STAB
	TABAPL				;EXPAND APPLICATION TABLES
	$ETAB

APLPID: BLOCK	NUMAPL			;PID TABLE OF APPLICATIONS

	DEFINE	X(A,B,C,D),<EXP	.KY'B>

APLCOD:	TABAPL				;EXPAND THE APPLICATION SYMBOLS

	DEFINE	X(A,B,C,D),<
	IFB  <D>,<EXP 0>
	IFNB <D>,<
		EXTERN	D
		.REQUIR	D
		EXP D>>		      ;Generate request for application module

APLHLR:	TABAPL			      ;Expand internal application table

; Generate requests for the application tables
;
DEFINE	X (A,B,C,D),<
	EXTERN	C
	.REQUIR	C
>
	TABAPL
SUBTTL	CHKNOD	Validate the OPR node data

;THIS ROUTINE WILL VALIDATE THE OPR NODE IN MESSAGE WITH
;THE NODE THE OPR SIGNED ON WITH TO INSURE NODE IS VALID
;ON RETURN TRUE:
;		S1/ NODE NAME IN SIXBIT
;		S2/ NODE NUMBER (IF APPLICABLE)

TOPS10<
CHKNOD:	MOVE	T1,[XWD .NDRNN,T2]	;CONVERT THE NODE NAME/NUM IN T2
	HRRZI	T2,2			;2 ARGS SPECIFIED..LENGTH
	MOVE	T3,S1			;NODE NUMBER TO CONVERT,,RIGHT HALF
	NODE.	T1,			;ISSUE NODE UUO
	 JRST	[CAME T1,[XWD .NDRNN,T2] ;LOST BECAUSE NO NETWORKS?
		$RETF			;NO, A REAL ERROR
		PJRST	I%HOST]		;YES, JUST RETURN HOST NAME
	TLNN	T1,770000		;SIXBIT ANSWER..NODE NAME
	JRST	CHKN.1			;SET UP NODE NUMBER
	MOVE	S2,S1			;PUT NUMBER IN S2
	MOVE	S1,T1			;PUT NAME IN S1
	$RETT				;RETURN TRUE
CHKN.1:	MOVE	S2,T1			;PUT NUMBER IN S2
	$RETT				;RETURN S1,,NODE NAME
>;END TOPS10

TOPS20<
CHKNOD:	MOVE	T3,S1			;HOLD THE NODE NAME
	CAMN	S1,G$HOST		;IS IT CENTRAL SITE?
	JRST	CHKN.1			;YES..RETURN
	MOVX	S1,.NDVFY		;NODE VERIFY FUNCTION
	MOVEI	S2,T1			;ADDRESS OF THE BLOCK
	HRROI	T1,G$NODX		;GET THE NODE
	SETZM	T2			;CLEAR THE FLAGS
	NODE				;DO THE NODE JSYS
	ERJMP	.RETF			;ERROR..RETURN FALSE
	TXNN	T2,ND%EXM		;DID IT MATCH
	$RETF				;RETURN FALSE
CHKN.1:	MOVE	S1,T3			;GET NODE NAME BACK IN SIXBIT
	SETZ	S2,			;CLEAR AC 2
	$RETT				;RETURN TRUE
>;END TOPS20
SUBTTL	GETNOD	Extract located node of message sender

;This routine will find out where the sender is located.
;On the -20, this information comes as part of the IPCF descriptor.
;On the -10, the location of the job's terminal is returned
;Call
;		G$JOB/	Job number of the sender
;		MI/	incoming message address
;Returns
;	 True	S1/	Sixbit node name
;	 False 	Can't find the node name

TOPS20<
GETNOD:	SKIPN	S1,.OHDRS+OPH.ND(MI)	;GET THE NODE NODE FROM THE MESSAGE ITSELF
	MOVE	S1,G$HOST		;NONE GIVEN , ASSUME CENTRAL
	MOVEM	S1,G$NODE		;SAVE FOR THIS MESSAGE
	$RETT
>;END TOPS20
TOPS10<
GETNOD:	$SAVE	<P1>
	LOAD	S1,G$JOB		;GET THE JOB NUMBER
	LOAD	P1,G$JOB		;Get it again
GETN.1:	CTLJOB	P1,			;Try for a controlling job
	 $RETF				;Job number must be illg.
	CAMN	P1,[-1]			;Are we done?
	JRST	GETN.2			;Yes
	MOVE	S1,P1			;There is one
	JRST	GETN.1			;Go try for another
GETN.2:	TRMNO.	S1,			;GET THIS JOB'S TERMINAL #
	 $RETF				;CAN'T?? GIVE UP
	GTNTN.	S1,			;FIND OUT WHERE THAT TTY LIVES
	 $RETF				;ITS DEAD, QUIT
	HLRZS	S1			;GET JUST THE TERM #
	MOVE	P1,S1			;SAVE FOR RETURN
	MOVEI	TF,2			;1 ARGUMENT, 2 WORDS IN LIST
	MOVE	S2,[XWD .NDRNN,TF]	;AIM AT THE ARGUMENT BLOCK
	NODE.	S2,			;CONVERT TO SIXBIT NAME
	 JRST	[CAME	S2,[XWD .NDRNN,TF] ;LOST BECAUSE FTNET OFF?
		$RETF			;NO, A REAL GARBAGE NODE!
		PJRST	I%HOST]		;YES, JUST SAY OPR AT HOST NODE
	MOVE	S1,S2			;MOVE IT INTO PLACE
	MOVE	S2,P1			;AND PUT BACK THE NODE NUMBER
	$RETT
>;END TOPS10
SUBTTL	OPRSET	Process setup reply from OPR

;THIS ROUTINE WILL PROCESS A SETUP REPLY FROM OPR AND
;ENABLE OPR FOR APPROPRIATE MESSAGES

OPRSET:	SKIPG	.OARGC(MI)		;VALID ARGUMENT COUNT
	PJRST	E$ICS			;INVALID COUNT SPECIFIED
	MOVE	S1,G$SND		;GET SENDERS PID
	$CALL	VALOPR			;VALIDATE THE NODE
					;RETURNS TRUE S2 OPR ENTRY ADDRESS
	JUMPF	E$ISM			;INVALID SETUP MESSAGE
	MOVEM	S2,G$OPRA		;SAVE THE OPR ADDRESS
	LOAD	T1,.OHDRS+ARG.HD(MI),AR.TYP ;GET TYPE CODE
	CAIN	T1,.ORFAL		;FAILURE RETURN
	PJRST	OPRS.1			;FIX OPR DATA BASE
	CAIE	T1,.ORSUC		;SUCCESSFUL??
	PJRST	E$ITM			;INVALID TYPE IN MESSAGE
	MOVX	S1,OP.NST		;OPR NOT SETUP
	TDNN	S1,OPR.FL(S2)		;WAS OPR ALREADY SETUP
	PJRST	OPRS.3			;YES..ERROR
	ANDCAM	S1,OPR.FL(S2)		;MARK AS SETUP
	SKIPG	G$NSNT			;ANY UNSENT MESSAGES
	$RETT				;NO JUST RETURN
	MOVE	S1,G$OPRA		;Get OPR data base address
	$CALL	O$HOST			;System or host?
	JUMPF	.RETT			;No.. don't send outstanding msgs
	MOVX	S1,R.SOPR		;ONLY SENDS TO OPR
	$CALL	SNDLST			;TRY SENDING THE MESSAGES
	$RETT				;RETURN TRUE

OPRS.1:	SOSG	.OARGC(M)		;ANY ARGUMNETS LEFT
	  JRST	OPRS.2			;NO..IGNORE TEXT LOGGING
	LOAD	T1,.OHDRS+ARG.HD(MI),AR.LEN ;GET THE LENGTH
	ADDI	T1,.OHDRS(M)		;POSITION TO NEXT ARGUMENT
	LOAD	S1,ARG.HD(T1),AR.TYP	;GET ARGUMENT TYPE
	CAIE	S1,.CMTXT		;TEXT ??
	  JRST	OPRS.2			;NO..IGNORE TEXT
	MOVEI	S1,ARG.DA(T1)		;ADDRESS OF THE TEXT
	$CALL	L$SETF##		;LOG SETUP FAILURE
OPRS.2:	MOVE	S1,G$SND		;GET THE SENDERS PID
	$CALL	DELOPR			;DELETE THE OPR BLOCK
	$RETT				;RETURN TRUE
OPRS.3:	MOVE	S1,G$SND		;GET THE SENDERS PID
	$CALL	DELOPR			;DELETE THE OPR
	PJRST	E$OAS			;OPR ALREADY SETUP..OPR DELETED
SUBTTL	SNDSET	Send setup reply to OPR

;THIS ROUTINE SEND THE CURRENT SETTINGS TO OPR IN RESPONSE TO
;THE HELLO MESSAGE

SNDSET:	$CALL	GETPAG			;PAGE FOR OUTPUT IN MO
	MOVX	S1,.OMOST		;OPR SETUP CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE IN MESSAGE
;**;[6043]At SNDSET:+3L replace 2 lines with 6 lines   PMM   6/3/90
	MOVEI	S1,1			;[6043]Get argument count
	MOVEM	S1,.OARGC(MO)		;[6043]Save the argument count
	MOVEI	S1,.OHDRS+ARG.HD(MO)	;[6043]Get address for alias list
	$CALL	LSTAKA			;[6043]Add alias list block to message
	MOVEI	S1,PAGSIZ		;[6043]Get page size
	STORE	S1,.MSTYP(MO),MS.CNT	;[6043]Save as length of message
	MOVE	S1,G$SND		;GET OPR PID
	MOVEM	S1,G$ARG1		;SAVE THE PID
	MOVX	S2,PAGSIZ		;SEND A PAGE
	$CALL	SPDOPR			;SEND THE MESSAGE
	 $RETIT				;OK..RETURN
	PJRST	E$OSF			;OPR SETUP FAILURE
	$RETF				;RETURN FALSE FROM SEND
SUBTTL	TEXT	Routine to Process a TEXT Message

;THIS ROUTINE JUST SHIPS THE MESSAGE ON TO THE APPROPRIATE OPERATOR
;IF MF.NOM IS SET, THE MESSAGE IS THROWN AWAY

TEXT:	LOAD	S1,.MSCOD(MI)		;GET THE CODE TO LOOK FOR
	$CALL	VALOPR			;FIND THE OPR ENTRY
	JUMPF	E$ODE			;OPR NO LONGER EXISTS
	LOAD	S1,.MSFLG(MI)		;GET FLAG WORD
	TXNE	S1,MF.NOM		;NO MESSAGE..IN ACK
	$RETT				;YES..JUST RETURN
	$CALL	SPGOUT			;SETUP OUTPUT PAGE
	AOS	OPR.OC(S2)		;BUMP MESSAGE OUT COUNT
	MOVE	S1,OPR.PD(S2)		;GET THE PID TO SEND TO
	MOVEI	S2,PAGSIZ		;GET SIZE OF MESSAGE
	$CALL	SPDOPR			;SEND PID TO OPR
	$RETT				;RETURN TRUE ALWAYS
SUBTTL	SPGOUT	Setup output page to send

;This Routine will make an Output Page to Send where
;we wish to send the input message out

SPGOUT:	$CALL	GETPAG			;GET A PAGE
	HRLI	S1,(MI)			;SOURCE ADDRESS
	HRRI	S1,(MO)			;DESTINATION
	BLT 	S1,PAGSIZ-1(MO)		;MOVE THE DATA
	$RETT				;RETURN
SUBTTL	W$WTOR	Process a WTOR Message

W$WTOR::MOVE	P1,.OFLAG(MI)		;GET FLAG WORD
	TXNE	P1,WT.KIL		;CHECK FOR KILL MESSAGE
	PJRST	W$KWTO			;PROCESS KILL MESSAGE
	$CALL	W$VALID			;VALIDATE A WTO MESSAGE
	$RETIF				;FAILS...RETURN
	$CALL	W$CHEK			;CHECK IF USER ALLOWED TO SEND
	$RETIF				;ERROR..RETURN
;**;[6032]At W$WTOR:+6L add 1 line  JCR  11/29/89
	TXZ	FLAG,F.WNEB		;[6032]Assume only for local node
	$CALL	OPRMES			;SETUP THE MESSAGE
	MOVX	S1,.OMWTR		;GET THE DISPLAY TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE TYPE IN MESSAGE
	AOS	G$SEQ			;ASSIGN A SEQUENCE NUMBER
	MOVEI	T1,[ITEXT(< ^7/[74]/^D/G$SEQ/^7/[76]/	>)]
	$CALL	W$MESS			;BUILD OUTPUT MESSAGE
	JUMPT	WTOR.1			;O.K. CONTINUE ON
	SOS	G$SEQ			;DECREMENT MESSAGE COUNT FROM FAILURE
	PJRST	WTERRO			;WT ERROR RETURN
WTOR.1:	$CALL	L$WTOR##		;LOG THE WTOR MESSAGE
	$CALL	W$NODE			;GET THE NODE TO SEND TO
	MOVE	T1,S1			;SAVE THE ENTRY ADDRESS
	LOAD	S1,NOD.ML(T1)		;GET MESSAGE LIST NUMBER
	$CALL	L%LAST			;POSITION TO THE END
	LOAD	S1,NOD.ML(T1)		;GET MESSAGE LIST NUMBER
	LOAD	S2,ARG.HD+.OHDRS(MO),AR.LEN ;GET LENGTH OF ARGUMENT
	MOVE	T3,S2			;SAVE SIZE IN T3
	ADDI	S2,MSL.SZ		;GET SIZE OF TOTAL ENTRY
	$CALL	L%CENT			;CREATE AN ENTRY
	JUMPF	WTERRO			;Shouldn't happen, but quit this.
	MOVE	T2,S2			;SAVE ADDRESS OF THE ENTRY
	HRLI	S1,ARG.HD+.OHDRS(MO)	;GET START OF BLT
	HRRI	S1,MSL.SZ(T2)		;ADDRESS OF DESTINATION
	ADDI	T3,MSL.SZ(T2)		;GET ENDING ADDRESS
	BLT	S1,-1(T3)		;MOVE THE DATA
	MOVE	S1,G$SND		;SENDERS PID
	MOVEM	S1,MSL.PD(T2)		;SAVE IN MESSAGE BLOCK
	MOVEM	T1,MSL.ND(T2)		;SAVE NODE ADDRESS IN MESSAGE LIST
	AOS	NOD.CT(T1)		;BUMP THE NODE COUNT
	MOVE	S1,.MSCOD(MI)		;GET MESSAGE HEADER CODE
	MOVEM	S1,MSL.CD(T2)		;SAVE THE MESSAGE CODE
	MOVE	S1,G$SEQ		;GET THE SEQUENCE NUMBER
	MOVEM	S1,MSL.ID(T2)		;SAVE SEQUENCE NUMBER
	SKIPN	S1,WDAJOB		;WAS THERE A JOB NUMBER
	LOAD	S1,G$JOB		;GET SENDERS JOB NUMBER
	MOVEM	S1,MSL.JB(T2)		;SAVE JOB NUMBER
	MOVX	T3,MS.TER		;TERMINAL NOTIFY ON FAILURE
	MOVX	S2,WT.NFY		;GET THE NOFITFY TERMINAL FLAG
	TDNN	S2,.OFLAG(MI)		;WAS IT SET?
	JRST	WTOR.2			;NO..BYPASS SETTING LOGGED IN TIME
	IORM	T3,MSL.FL(T2)		;SAVE THE FLAG BIT WITH MESSAGE
	MOVX	S2,JI.JLT		;GET LOGGED IN TIME FOR JOB
	$CALL	I%JINF			;GET LOGGED IN TIME
	MOVEM	S2,MSL.JT(T2)		;SAVE THE VALUE FOR LATER
WTOR.2:	SKIPN	G$CHKM			;NEED TO REQUEST MESSAGE CHECK?
	$CALL	REQMSC			;YES..GO DO IT
	MOVE	S1,T1			;NODE ENTRY
	$CALL	SNDAOP			;Send to all operators
;**;[6032]At WTOR.2:+4L replace 1 line with 20 lines  JCR  4/27/90
	$RETIF				;[6042]Return now on an error
	LOAD	S1,.MSFLG(MI),MF.NEB	;[6042]Pick up the NEBULA bit
	SKIPE	S1			;[6042]Check for all nodes?
	MOVE	S1,WDANHD		;[6042]No, pick up the remote node name
	$CALL	BLDNDL			;[6042]Build the list of elgible nodes
	$RETIF				;[6042]Quit now if no nodess to send to
	MOVX	S1,F.WNEB		;[6042]Pick up NEBULA flag bit
	IORM	S1,FLAG			;[6042]Indicate in the flag word
	MOVX	S1,MF.NEB!MF.WTR	;[6042]Pick up the .MSFLG bits to set
	MOVEI	T1,[ITEXT(< ^7/[74]/^D/G$SEQ/^7/[76]/	>)] ;[6042]	
	$CALL	BLDRWT			;[6042]Build the remote .OMDSP message
	MOVE	S1,WDAPID		;[6042]Pick up PID expected by NEBULA
	MOVEM	S1,.MSCOD(MO)		;[6042]Place in the message
	MOVE	S1,.MSCOD(MI)		;[6042]Pick up the sequence number
	MOVEM	S1,.OFLAG(MO)		;[6042]Place in the message
	$CALL	N$SNEB			;[6042]Send the message to NEBULA
	$RETIT				;[6042]Return now on success
	$CALL	LOGNSE			;[6042]Indicate an error has occurred
	$CALL	WTERRO			;[6042]Release the page
	$RET				;[6042]Preserve the error indicator
SUBTTL	W$KWTO	Kill a WTOR request by code

;THIS ROUTINE WILL KILL A WTOR REQUEST BY CODE AND INFORM
;ALL OPRS OF THE DELETED MESSAGE

W$KWTO:	MOVEI	S2,[ITEXT(< by user ^U/G$SID/ job ^D/G$JOB/>)]
	MOVEM	S2,G$ARG3		;SAVE USER INFO FOR KILL
	TXNN	P1,WT.SJI		;DID USER WISH TO SUPPRESS JOB INFO
	JRST	WTOK.0			;NO..LOOK FOR MESSAGE NOW
	$CALL	CHKWHL			;CHECK IF PRIVILEGED
	JUMPF	E$IPE			;INSUFFICIENT PRIVILEGES
	MOVEI	S2,NULTXT		;SETUP NULL TEXT
	MOVEM	S2,G$ARG3		;SAVE THE ARGUMENT
WTOK.0:	MOVX	S1,MSL.CD		;GET THE CODE FIELD
	MOVE	P3,.MSCOD(MI)		;GET THE ACK CODE TO CHECK FOR
	TXNE	P1,WT.KAL		;KILL ALL FOR THE JOB
	   JRST [MOVX	S1,MSL.JB	;SETUP JOB NUMBER FOR THE MATCH
		LOAD P3,G$JOB		;GET THE JOB NUMBER
		JRST 	.+1]		;CONTINUE ON
	HRRM	S1,FNDXCT		;SAVE FOR COMPARE
	MOVE	S1,P3			;GET THE MESSAGE CODE
	MOVEM	S1,G$ARG1		;SAVE CODE FOR POSSIBLE ERROR
	SETZM	G$ARG2			;CLEAR MESSAGE KILLED COUNT
	$CALL	FNDMSG			;TRY TO FIND A MESSAGE
	JUMPF	E$NMC			;NO MESSAGES WITH CODE
;**;[6033]At WTOK.1:-1L add 2 lines  JCR  12/16/89
	$CALL	RMKWTO			;[6033]Check if remote request
	$RETIF				;[6033]Quit on an error
WTOK.1:	SETZ	P1,			;CLEAR P1 FOR scratch
	EXCH	P1,G$ERR		;SAVE ERROR CODE
	MOVEI	S1,E$CWM		;SETUP USER CANCEL MESSAGE
	$CALL	W$KMES			;KILL THE MESSAGE
	$CALL	L$KMES##		;LOG THE MESSAGE 
	MOVEM	P1,G$ERR		;RESTORE THE ERROR CODE
WTOK.2:	MOVE	S1,P3			;GET THE CODE AGAIN
	$CALL	NXTMSG			;GET NEXT MESSAGE
	JUMPT	WTOK.1			;PROCESS SECOND MESSAGE
	SETZM	G$ERR			;CLEAR ERROR CODE
	SKIPE	G$ARG2			;ANY MESSAGES KILLED
	JRST	WTOK.3			;CHECK FOR ACK
	MOVE	S1,P3			;GET THE CODE
	MOVEM	S1,G$ARG1		;SAVE THE CODE
	PJRST	E$NMC			;NO MESSAGE CANCELED
WTOK.3:	LOAD	S1,.MSFLG(MI),MF.ACK	;ACK REQUESTED?
	SKIPN	S1			;USER WANT AN ACK
	$RETT				;NO..JUST RETURN
	PJRST	E$MCJ			;MESSAGES CANCELED FOR JOB
SUBTTL	W$NODE	Determine destination node for message

W$NODE:	SKIPN	S1,WDADES		;ANY DESTINATION SET
	JRST	WTNO.1			;NO..USE CENTRAL SITE
	$CALL	FNDNOD			;CHECK THIS NODE
	$RETIT				;O.K...FOUND IT
WTNO.1:	MOVE	S1,G$HOST		;GET CENTRAL SITE NODE
	$CALL	FNDNOD			;LOCATE THIS ONE
	$RETIT				;BETTER SUCCEED
	$STOP(CNE,Central site node not present)
SUBTTL	W$KMES	Kill a message and notify OPR


W$KMES:	$CALL	(S1)			;SETUP MESSAGE
	MOVE	S1,MSL.ID(S2)		;GET SEQUENCE NUMBER
	MOVEM	S1,G$ARG1		;SAVE THE NUMBER
	MOVE	S1,MSL.ND(S2)		;GET NODE MESSAGE FOUND AT
	PUSH	P,S1			;SAVE NODE LIST ADDRESS
	SOS	NOD.CT(S1)		;DECREMENT MESSAGE NODE COUNT
	MOVE	S1,NOD.ML(S1)		;GET MESSAGE LIST NUMBER
	$CALL	L%DENT			;DELETE THE MESSAGE
;**;[6033]At W$KMES:+8L replace 1 lines with 4 lines  JCR  12/16/89
	SKIPN	FLAG			;[6033]Request originate remotely?
	$CALL	BLDACK			;[6033]No, build ACK message as local
	SKIPE	FLAG			;[6033]Request originate remotely?
	$CALL	BLDRAK			;[6033]Yes, build ACK message as remote
	POP	P,S1			;GET NODE ADDRESS
	$CALL	SNDAOP			;SEND IT TO ALL OPRS AT NODE
	AOS	G$ARG2			;BUMP KILLED COUNT
	$RETT				;RETURN TRUE
;**;[6033]At W$KMES:+12L add routine RMKWTO
SUBTTL	RMKWTO	Determine if a KWTOR Request is Remote or Not

;[6033]RMKWTO is called while processing a Kill WTOR request. RMKWTO determines
;[6033]if the request to kill the WTOR originated from a remote node. If so,
;[6033]then it sets bit F.WNEB in FLAG and places the remote node name in 
;[6033]WDANHD.
;[6033]
;[6033]Call is:       MI/Address of the Kill WTOR message
;[6033]Returns true:  Word FLAG set up to indicate if request is remote or not
;[6033]               WDANHD contains the remote node name if request is remote
;[6033]Returns false: Illegally formatted message

RMKWTO:	SETZ	FLAG,			;[6033]Assume the request is local
	LOAD	S1,.MSFLG(MI),MF.NEB	;[6033]Pick up the remote bit
	JUMPE	S1,.RETT		;[6033]Return now if request is local
	SKIPG	.OARGC(MI)		;[6033]Valid argument count?
	PJRST	E$ICS			;[6033]No, indicate so
	LOAD	S1,.OHDRS+PFD.HD(MI),PF.TYP ;[6033]Pick up the argument type
	CAIE	S1,.WTNHD		;[6033]A remote node block?
	PJRST	E$ITM			;[6033]No, indicate so
	MOVE	S1,.OHDRS+ARG.DA(MI)	;[6033]Pick up the remote node name
	MOVEM	S1,WDANHD		;[6033]Save for later
	TXO	FLAG,F.WNEB		;[6033]Indicate remote in the flag word
	$RETT				;[6033]Return to the caller

;**;[6042]At RMKWTO:+11L rewrite routine W$WTO
SUBTTL	W$WTO	Process a WTO message

;[6042]W$WTO processes WTO messages. If the request that resulted in the WTO
;[6042]originated from the local node then the processed WTO message (.OMDSP)
;[6042]is sent to all the local operators. Next, the Broadcast-WTO list is
;[6042]checked to determine if the .OMDSP message should be sent to any remote
;[6042]nodes in the cluster.
;[6042] If the request that resulted in the WTO originated from a remote node
;[6042]in the cluster, then the resulting .OMDSP message is first sent to all
;[6042]the local operators. Next, the Broadcast-WTO list is checked to detemine
;[6042]if the .OMDSP message should be sent to any remote nodes in the cluster.
;[6042]The .OMDSP message will always be sent to the remote node where the
;[6042]request originated.

W$WTO::	$CALL	W$CHEK			;[6042]Check if user allowed to send
	$RETIF				;[6042]Error..return
	$CALL	W$VALID			;[6042]Validate the message
	$RETIF				;[6042]Error..return
	$CALL	OPRMES			;[6042]Build the output message
	$CALL	W$MESS			;[6042]Setup output text
	JUMPF	WTERRO			;[6042]Quit on an error
	TXNE	FLAG,F.WNEB		;[6042]Is this a remote message?
	JRST	W$WT.1			;[6042]Yes, treat differently
	$CALL	L$WTO##			;[6042]Log the WTO message
	$CALL	WTOSND			;[6042]Send the message locally

;[6042]Check if need to also send the message remotely

	TXO	FLAG,F.WNEB		;[6042]Indicate a remote message
	SETZ	S1,			;[6042]Check all the remote nodes
	JRST	W$WT.2			;[6042]Finish and send the message

W$WT.1:	$CALL	L$NWTO##		;[6042]Log the ACK
	$CALL	WTOSND			;[6042]Send the display msg locally
	TXZ	FLAG,F.WLOC		;[6042]Already processed the local msg
	MOVE	S1,WDANHD		;[6042]Pick up the remote node name
W$WT.2:	$CALL	BLDNDL			;[6042]Build list of eligable nodes
	$RETIF				;[6042]Return if no nodes to send to
	MOVX	S1,MF.NEB!MF.WTO	;[6042]Pick up remote WTO bits
	$CALL	BLDRWT			;[6042]Build the remote .OMDSP message
	$CALL	N$SNEB			;[6042]Send the message to NEBULA
	$RETIT				;[6042]Return on a success
	$CALL	LOGNSE			;[6042]Setup to log the send error

WTERRO:	$CALL	RELPAG			;[6042]Return the page
	$RETF				;[6042]Return false

WTOSND:	$CALL	W$NODE			;[6042]Get the node for message
	$CALL	SNDAOP			;[6042]Send the message
	$RET				;[6042]Return preserving AC0

;**;[6032]At WTOSND:+3L add routine BLDRWF  JCR  11/29/89
SUBTTL	BLDRWF	Build a Remote WTO Flags Block

BLDRWF:	LOAD	S1,.MSTYP(MO),MS.CNT	;[6032]Pick up the message length
	ADD	S1,MO			;[6032]Point to the end of the msg
	MOVE	S2,[.WDLEN,,.ORRFG]	;[6032]Pick up remote flags block header
	MOVEM	S2,ARG.HD(S1)		;[6032]Place in the remote flag block
	MOVE	S2,WDAOBT		;[6032]Pick up the object type word
	MOVEM	S2,WD.OBT(S1)		;[6032]Place in the remote flag block
	MOVE	S2,WDAFLG		;[6032]Pick up the flags word
	MOVEM	S2,WD.FLG(S1)		;[6032]Place in the remote flag block
;**;[6042]At BLDRWF:+7L add 2 lines  JCR  4/27/90
	MOVE	S2,WDADTY		;[6042]Pick up WTO display types
	MOVEM	S2,WD.DTY		;[6042]Place in the remote flag block
	MOVSI	S1,.WDLEN		;[6032]Pick up remote flag block length
	ADDM	S1,.MSTYP(MO)		;[6032]Update the message length
	AOS	.OARGC(MO)		;[6032]Update the block count
	$RET				;[6032]Return to the caller

;**;[6042]After routine BLDRWF add routines BLDNDL and BLDRWT  JCR  4/27/90
SUBTTL	BLDNDL	Build A Node List

;[6042]BLDNDL is called to build a list of eligible nodes to send a WTO
;[6042]or WTOR to.
;[6042]
;[6042]Call is:       S1/Node name to always include or 0
;[6042]Returns true:  The Proto-.NDENM block has been built
;[6042]Returns false: No remote nodes to send the WTO or WTOR to

BLDNDL:	SKIPE	S1			;[6042]Check all nodes?
	JRST	BLDL.1			;[6042]No, always include the input
	SKIPE	BWLIST			;[6042]Broadcast node entry list empty?
	JRST	BLDL.2			;[6042]No, go build the proto-.NDEMN blk
	$RETF				;[6042]Yes, indicate so
BLDL.1:	SKIPE	BWLIST			;[6042]Broadcast node entry list empty?
	JRST	BLDL.2			;[6042]No, initialize countesrs
	MOVEM	S1,PNDENM+ARG.DA	;[6042]Place node name in proto-.NDENM
	MOVEI	S1,ARG.DA+1		;[6042]Pick up proto-.NDENM block size
	HRLM	S1,PNDENM		;[6042]Place in proto-.NDENM blk header
	$RETT				;[6042]Return to the caller

BLDL.2:	$SAVE	<P1,P2,P3,P4>		;[6042]Save some scratch ACs
	SETZ	P1,			;[6042]No nodes match so far
	MOVE	P2,S1			;[6042]Save the input
	HRRZ	P3,BWLIST		;[6042]Pick up the first entry address
	MOVEI	P4,PNDENM+ARG.DA	;[6042]Point to the first node entry
	JUMPE	P2,BLDL.3		;[6042]Check every node?
	MOVEM	P2,0(P4)		;[6042]Place in the message
	AOS	P4			;[6042]Point to the next word
	AOS	P1			;[6042]Increment the number of nodes

BLDL.3:	MOVE	S1,OPR.NN(P3)		;[6042]Pick up this entry's node name
	CAMN	S1,P2			;[6042]Check this node?
	JRST	BLDL.4			;[6042]No, check the next entry
	MOVE	S1,P3			;[6042]Point to the current entry
	$CALL	CHKO.1			;[6042]OK to send to this node?
	JUMPF	BLDL.4			;[6042]No, try another node
	MOVE	S2,OPR.NN(P3)		;[6042]Pick up the node name
	MOVEM	S2,0(P4)		;[6042]Place in the proto-.NDENM block
	AOS	P4			;[6042]Point to the next word
	AOS	P1			;[6042]Increment the number of nodes
BLDL.4:	LOAD	P3,0(P3),OPR.PT		;[6042]Pick up the next entry
	JUMPN	P3,BLDL.3		;[6042]Check the next entry
	SKIPG	P1			;[6042]Any nodes to send to?
	$RETF				;[6042]No, indicate so
	ADDI	P1,ARG.DA		;[6042]Add the proto-.NDENM blk hdr size
	HRLM	P1,PNDENM		;[6042]Place in the proto-.NDENM block
	$RETT				;[6042]Indicate nodes to send to
SUBTTL	BLDRWT	Build A Remote WTO Display Message

;[6042]BLDRWT is called to build a display message that is to be
;[6042]sent to a remote node or nodes
;[6042]Call is: S1/.MSFLG bits to set
;[6042]Returns: The remote WTO/WTOR display message has been built

BLDRWT:	$SAVE	<P1>			;[6042]Save a scratch AC
	MOVE	P1,S1			;[6042]Save the .MSFLG bits to set
	$CALL	OPRMES			;[6042]Set up the first argument block
	IORM	P1,.MSFLG(MO)		;[6042]Set the flag bits
	HLRZ	S1,PNDENM		;[6042]Pick up proto-.NDENM blk length
	ADDI	S1,.WDLEN		;[6042]Add remote WTO flag block length
	IMULI	S1,5			;[6042]Convert to bytes
	MOVNS	S1			;[6042]Negate the number of bytes
	ADDM	S1,WTOCNT		;[6042]Update available bytes
	SETZM	.OFLAG(MI)		;[6042]Don't process any flags
	$CALL	W$MESS			;[6042]Setup output text
	$CALL	BLDRWF			;[6042]Build remote WTO flags block
	LOAD	P3,.MSTYP(MO),MS.CNT	;[6042]Pick up the message length
	ADD	P3,MO			;[6042]Point to the end of the msg
	MOVEI	S1,PNDENM		;[6042]Pick up proto-.NDENM blk address
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6042]Get its length
	$CALL	MOVARG			;[6042]Append to the message
	ANDI	P3,777			;[6042]Isolate the message length
	STORE	P3,.MSTYP(MO),MS.CNT	;[6042]Place in the message
	MOVE	S1,G$HOST		;[6042]Pick up the local node name
	MOVEM	S1,.OHDRS+ARG.DA(MO)	;[6042]Place in the message
	$RETT				;[6042]Return to the caller
SUBTTL	W$CHEK	Check if WTO/WTOR allowed for this job

W$CHEK:	SKIPE	S1,WDAJOB		;WTO/WTOR IN SOMEONE'S BEHALF ?
	JRST	CHEK.1			;YES
	$CALL	CHKWHL			;CHECK IF PRIVILEGED
	$RETIT				;O.K.. IGNORE THE CHECK
	LOAD	S1,G$JOB		;GET THE JOB NUMBER

CHEK.1:	MOVX	S2,JI.BAT		;GET BATCH DATA AND OPR FIELDS
	$CALL	I%JINF			;GET THE DATA
	LOAD	S1,S2,OB.WTO		;GET THE WTO FLAGS
	SKIPN	S1			;ANY VALUE SET
	$RETT				;NO..ITS O.K...RETURN
	CAIN	S1,.OBNOM		;NO MESSAGES ALLOWED
	JRST	CHEK.2			;NOT ALLOWED - CHECK FOR BATCH
	LOAD	S1,.MSTYP(MI),MS.TYP	;GET MESSAGE TYPE
	CAIE	S1,.OMWTR		;WAS IT A WTOR
	$RETT				;NO - RETURN TRUE

CHEK.2:	TXNN	S2,OB.BSS		;BATCH STREAM ?
	PJRST	E$WNA			;NO - A TIMESHARING JOB
	$CALL	M%GPAG			;GET A PAGE
	MOVE	MO,S1			;SAVE ADDRESS
	HRLI	S1,CANMSG		;SET UP BLT
	BLT	S1,CANSIZ-1(MO)		;COPY INTO IPCF PAGE
	LOAD	S1,S2,OB.BSN		;GET BATCH STREAM NUMBER
	MOVEM	S1,.OARGC+2+OBJ.UN(MO)	;STORE IT
	MOVE	S1,G$HOST		;GET NODE NUMBER
	MOVEM	S1,.OARGC+2+OBJ.ND(MO)	;STORE IT
	SETZM	G$SND			;TO MAKE ACK CODE ZERO
	PUSHJ	P,SNDQSR		;CANCEL THE BATCH JOB
	$RETF				;ENOUGH OF THIS 


; Prototype message block
; This block contains the information that would noramlly be generated by an
; "ABORT BATCH-STREAM nnn /ERROR-PROCESSING /REASON:No operator intervention
; allowed." command to OPR.
;
CANMSG:	XWD	CANSIZ,.OMCAN		;(.MSTYP) MESSAGE LENGTH AND TYPE
	XWD	0,0			;(.MSFLG) FLAGS
	XWD	0,0			;(.MSCOD) ACK CODE
	XWD	0,0			;(.OFLAG) FLAGS
	XWD	0,3			;(.OARGC) ARGUMENT COUNT
	XWD	4,.OROBJ		;OBJECT BLOCK HEADER
	XWD	0,.OTBAT		;BATCH
	XWD	0,0			;STREAM
	XWD	0,0			;NODE NUMBER
	XWD	2,.CANTY		;ERROR PROCESSING BLOCK HEADER
	XWD	0,.CNERR		;/ERROR-PROCESSING
	XWD	7,.ORREA		;REASON BLOCK HEADER
	ASCIZ	|No operator intervention allowed.| ;/REASON TEXT
CANSIZ==.-CANMSG			;LENGTH OF MESSAGE
IFG <CANSIZ-24>,<PRINTX ? Cancel message size too big; change WDACAN>
SUBTTL	W$LOGM	Log a message

;THIS MESSAGE IS A WTO/WTOR/ACK TYPE MESSAGE JUST PLACING INFO IN LOG
;AND NOT SENDING IT.. IF THERE IS NO LOG THE MESSAGE WILL BE IGNORED

W$LOGM::SKIPN	LOGINT			;LOGGING ENABLED
	$RETT				;NO..JUST RETURN..IGNORE IT
	$CALL	W$VALID			;VALIDATE THE MESSAGE
	$RETIF				;ERROR..RETURN
	$CALL	OPRMES			;BUILD OUTPUT MESSAGE
	$CALL	W$MESS			;SETUP OUTPUT TEXT
	JUMPF	WTERRO			;WT ERROR RETURN
	$CALL	L$LOG##			;LOG WTO MESSAGE
	PJRST	RELPAG			;RELEASE PAGE AND RETURN
SUBTTL	W$VALID	Validate WTO, WTOR and ACK Messages

;THIS ROUTINE WILL TAKE THE FREE FORMATTED WTO, WTOR
;AND ACK MESSAGES AND MAP THEM INTO THE FIXED FORMATED MESSAGE
;CURRENTLY USED BY OPR AND ORION. THE ROUTINE WILL VALIDATE
;THE FIELDS AND PRIVILEGE CHECK APPROPRIATE FIELDS. ERRORS WILL
;BE GENERATED FOR ALL DUPLICATION OF ENTRIES IN THE MESSAGE.

W$VALID:LOAD	S1,.MSTYP(MI),MS.CNT	;GET THE MESSAGE LENGTH
	MOVEM	S1,G$ARG1		;SAVE MESSAGE LENGTH IN ARGUMENT
	CAILE	S1,WTOMAX		;CHECK IF WITHIN BOUNDS
	PJRST	E$WTL			;WTO MESSAGE TO LARGE
	SKIPG	P2,.OARGC(MI)		;GET THE ARGUMENT COUNT
	PJRST	E$ICS			;INVALID ARGUMENT COUNT SPECIFIED
	TXZ	FLAG,F.WFLG		;CLEAR WTO FLAGS
	MOVE	S1,[WDATXT,,WDATXT+1]	;WTO TEXT DATA POINTER
	SETZM	WDATXT			;CLEAR FIRST WORD
	BLT	S1,WDAEND		;CLEAR THE DATA WORDS
	MOVX	S1,WO.JOB		;JOB MESSAGE FLAG
	MOVX	S2,WT.JOB		;JOB MESSAGE FLAG FROM MESSAGE
	TDNE	S2,.OFLAG(MI)		;WAS IT SET
	IORM	S1,WDAFLG		;SET THE FLAG
	MOVX	S1,WO.OAC		;OPERATOR ACTION MESSAGE
	LOAD	S2,.MSTYP(MI),MS.TYP	;GET MESSAGE TYPE
	CAIN	S2,.OMWTR		;WAS IT WTOR
	IORM	S1,WDAFLG		;SET THE FLAG
	MOVEI	S1,.OHDRS(MI)		;ADDRESS OF FIRST ARGUMENT
	$CALL	P$SETU			;SETUP THE PARSER POINTER
	MOVX	S1,WO.EVM		;CHECK IF OTHER MESSAGE
	SKIPN	WDAFLG			;ANYTHING SET?
	IORM	S1,WDAFLG		;TURN ON OTHER FLAG
	LOAD	S1,.MSFLG(MI),MF.NEB	;[6005]PICK UP THE NEBULA BIT
	JUMPE	S1,VALW.1		;[6005]JUMP IF NOT TURNED ON
	MOVX	S1,F.WNEB		;[6005]PICK UP NEBULA FLAG BIT
;**;[6031]At W$VID:+26L add three lines  JCR  10/3/89
	LOAD	S2,.MSTYP(MI),MS.TYP	;[6031]Pick up the message type
	CAIN	S2,.OMWTO		;[6031]Is it a WTO?
	MOVX	S1,F.WNEB!F.WLOC	;[6031]Yes, this will be the local copy
	IORM	S1,FLAG			;[6005]MSG IN BEHALF OF A REMOTE NODE
VALW.1:	$CALL	P$NARG			;GET THE NEXT ARGUMENT
	MOVE	P1,S2			;SAVE ARGUMENT ADDRESS
	LOAD	P3,ARG.HD(S2),AR.LEN	;SAVE THE ARGUMENT LENGTH
	CAILE	S1,.WTLST		;VALID ARGUMENT TYPE
	PJRST	E$ITM			;INVALID TYPE..ERROR AND RELEASE
					;PAGE
	HRRZ	S2,WTODSP(S1)		;GET THE PROCESSING ROUTINE
	$CALL	(S2)			;PROCESS THE ARGUMENT
	$RETIF				;BAD RETURN..RETURN
	$CALL	P$NEXT			;POSITION TO THE NEXT ONE
	SOJG	P2,VALW.1		;PROCESS THE REST OF THE ARGUMENTS
;**;[6042]At VALW.1:+10L add 2 lines  JCR  4/27/90
	MOVE	S1,G$HOST		;[6042]Pick up the local node name
	MOVEM	S1,WDARND		;[6042]WTO(R) originated at this node
	TXNN	FLAG,F.WNEB		;[6010]IS THE NEBULA BIT SET?
	$RETT				;[6010]NO, SO RETURN NOW
	TXNN	FLAG,F.WNBK		;[6010]IS THERE A REMOTE BLOCK?
	PJRST	E$IFM			;[6010]NO, ILLEGALLY FORMATTED MESSAGE
	$RETT				;[6010]NOW RETURN TO THE CALLER

;DISPATCH TABLE FOR WTO WTOR AND ACK PROCESSING

WTODSP:	.WTTXT,,WTOTXT			;PROCESS MAIN TEXT STRING
	.WTOBJ,,WTOOBJ			;PROCESS OBJECT BLOCK
	.WTDES,,WTODES			;PROCESS DESTINATION NODE
	.WTJOB,,WTOJOB			;PROCESS JOB NUMBER
	.WTERR,,WTOERR			;PROCESS ERROR CODE
	.WTRTE,,WTORTE			;PROCESS ROUTE CODE
	.WTTYP,,WTOTYP			;PROCESS TYPE TEXT
	.WTANS,,WTOANS			;PROCESS ANSWER BLOCK
	.WTACD,,WTOACD			;PROCESS APPLICATION CODE BLOCK
	.WTOCD,,WTOOCD			;PROCESS OBJECT TYPE BLOCK
	.WTNOP,,.RETT			;NOOP FOR MONITOR WTO MESSAGES
	.WTDTY,,WTODTY			;DISPLAY TYPE INFO
	.WTDQS,,.RETT			;[6001]WTOOBJ CHECKS THIS BLOCK
	.WTPOR,,.RETT			;[6001]WTOOBJ CHECKS THIS BLOCK
	.WTSER,,.RETT			;[6001]WTOOBJ CHECKS THIS BLOCK
	.WTNHD,,WTONHD			;[6006]REMOTE NODE NAME BLOCK
;**;[6032]At WTODSP:+15L add 1 line  JCR  11/29/89
	.WTPID,,WTOPID			;[6032]PID block
	SUBTTL	WTONHD - Validate a remote display block

WTONHD:	TXOE	FLAG,F.WNBK		;[6010]PROCESSED THIS BLOCK TYPE BEFORE?
	PJRST	E$DTM			;[6005]YES, DUPLICATE TYPE IN MESSAGE
	TXNN	FLAG,F.WNEB		;[6010]WAS THE NEBULA BIT SET IN .MSFLG?
	PJRST	E$IMB			;[6010]NO, INDICATE INVALID MESSAGE BLK
	$CALL	CHKWHL			;[6005]CHECK FOR PRIVILEGES
	JUMPF	E$IPE			;[6005]INSUFFICIENT PRIVILEGES
	MOVE	S1,ARG.DA(P1)		;[6005]PICK UP NODE NAME
	MOVEM	S1,WDANHD		;[6005]STORE FOR LATER

	$RETT				;[6005]RETURN TO THE CALLER
;**;[6032]At WTONHD:+9L add routine WTOPID  JCR  11/29/89
	SUBTTL	WTOPID - Validate a PID block

WTOPID:	TXOE	FLAG,F.WPID		;[6032]Processed this block type before?
	PJRST	E$DTM			;[6032]Yes, duplicate type in message
	$CALL	CHKWHL			;[6032]Check for privileges
	JUMPF	E$IPE			;[6032]Insufficient privileges
	MOVE	S1,ARG.DA(P1)		;[6032]Pick up the PID
	MOVEM	S1,WDAPID		;[6032]Store for NEBULA
	$RET				;[6032]Return to the caller
  
SUBTTL	WTOTXT, WTOTYP, WTOANS and WTOACD routines

;THESE ROUTINES WILL SETUP DATA POINTER TO FIELDS AND VALIDATE
;FIELDS FOR PRIVILEGES WHERE REQUIRED

WTOTXT:	TXOE	FLAG,F.WTXT		;HAVE WE PROCESSED TEXT BEFORE
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	MOVEI	S1,ARG.DA(P1)		;POINTER TO ACTUAL TEXT
	MOVEM	S1,WDATXT		;TEXT POINTER FIELD
	$RETT				;RETURN TRUE

WTOTYP:	TXOE	FLAG,F.WTYP		;TYPE MESSAGE SEEN
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	$CALL	CHKWHL			;IS THE SENDER PRIVILEGED?
	SKIPT				;YES
	SKIPA	S1,[ARG.DA+[XWD	7,.WTTYP
			ASCIZ |Message from timesharing user|]]
	MOVEI	S1,ARG.DA(P1)		;POINTER TO ACTUAL TEXT
	MOVEM	S1,WDATYP		;TYPE DATA FIELD
	$RETT				;RETURN TRUE

WTOANS:	TXOE	FLAG,F.WANS		;ANSWER BLOCK SPECIFIED SO FAR
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	LOAD	S1,.MSTYP(MI),MS.TYP	;GET MESSAGE TYPE
	CAIE	S1,.OMWTR		;WTOR MESSAGE
	PJRST	E$IWF			;INVALID WTO FIELD
	MOVEI	S1,ARG.DA(P1)		;POINTER TO ACTUAL TEXT
	MOVEM	S1,WDAANS		;SAVE ANSWER DATA POINTER
	$RETT				;RETURN TRUE
WTOACD:	TXOE	FLAG,F.WACD		;CODE SPECIFIED SO FAR
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	TXNE	FLAG,F.WOBJ!F.WOCD	;WAS THERE AN OBJECT BLOCK
	PJRST	E$AON			;APPLICA AND OBJECT NOT ALLOWED	TOGETHER
	MOVE	S1,ARG.DA(P1)		;GET THE CODE TYPE
	MOVEM	S1,G$ARG1		;SAVE THE ARGUMENT
	$CALL	FNDAPL			;FIND THE APPLICATION
	JUMPF	E$ACI			;APPLICATION CODE INVALID
	MOVEM	S1,WDAOBT		;SAVE APPLICATION OBJECT TYPE
	MOVE	T1,APLTAB+1(S2)		;GET COMMAND TABLE ENTRY
	HLRZM	T1,WDAACD		;SAVE THE NAME
	HLRZM	T1,G$ARG1		;SAVE NAME FOR POSSIBLE ERRORS
	SKIPN	S1,APLPID(S2)		;IS THERE A PID THERE
	PJRST	E$ANS			;APPLICATION NOT SIGNED ON
	CAME	S1,G$SND		;BETTER BE FOR SAME JOB
	PJRST	E$CPM			;CODE PID MISMATCH FOR APPLICATION
	$RETT				;RETURN TRUE
SUBTTL	WTOJOB,WTOERR,WTORTE and WTODES  routines



WTOJOB:	TXOE	FLAG,F.WJOB		;JOB NUMBER SEEN SO FAR
	PJRST	E$DTM			;YES..DUPLICATE TYPE IN MESSAGE
	$CALL	CHKWHL			;PRIVILEGE CHECK JOB FIELD
	JUMPF	E$WJP			;WTO JOB FIELD REQUIRES PRIVILEGES
	LOAD	S1,ARG.DA(P1)		;GET JOB NUMBER
	MOVEM	S1,WDAJOB		;SAVE THE JOB NUMBER
	CAIE	P3,ARG.SZ		;PROPER SIZE FIELD
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH
	$RETT				;RETURN TRUE





WTOERR:	TXOE	FLAG,F.WERR		;ERROR CODE SEEN BEFORE
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	LOAD	S1,ARG.DA(P1)		;GET DATA FIELD
	MOVEM	S1,WDAERR		;SAVE ERROR CODE
	CAIE	P3,ARG.SZ		;PROPER SIZE FIELD
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH
	$RETT				;RETURN TRUE


WTORTE:	TXOE	FLAG,F.WRTE		;ROUTE CODE SEEN BEFORE
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	LOAD	S1,ARG.DA(P1)		;GET THE ROUTE CODE
	MOVEM	S1,WDARTE		;SAVE THE ROUTE CODE
	CAIE	P3,ARG.SZ		;PROPER SIZE FIELD
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH
	$RETT				;RETURN TRUE


WTODES:	TXOE	FLAG,F.WDES		;DESTINATION CODE SPECIFIED
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	LOAD	S1,ARG.DA(P1)		;GET DESTINATION CODE
	MOVEM	S1,WDADES		;SAVE DESTINATION DATA
	CAIE	P3,ARG.SZ		;PROPER SIZE FIELD
	PJRST	E$IAL			;INVALID ARGUMENT LENGTH
	CAME	S1,[-1]			;IS IT FOR ALL NODES
	$RETT				;RETURN TRUE
	$CALL	CHKWHL			;IS IT A WHEEL?
	$RETIT				;OK..RETURN
	PJRST	E$IPE			;INSUFFICIENT PRIVILEGES
SUBTTL	WTOOBJ	Process WTO object block

;THIS ROUTINE WILL ANALYZE AN OBJECT BLOCK AND PLACE THE
;DATA IN THE OUTPUT MESSAGE

WTOOBJ:	TXOE	FLAG,F.WOBJ		;OBJECT BLOCK PROCESSED
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	$CALL	CHKWHL			;PRIVILEGES REQUIRED FOR OBJECT
	JUMPF	E$WOP			;OBJECT BLOCK REQUIRES PRIVILEGES
	TXNE	FLAG,F.WACD!F.WOCD	;APPLICATION CODE SET
	PJRST	E$AON			;APPLIC AND OBJECT NOT ALLOWED TOGETHER
	$CALL	WTOC.1			;PROCESS THE CODE
	$RETIF				;PASS FALSE UP
;**;[6043]At WTOOBJ:+8L add 6 lines   PMM   6/3/90
;[6043]]Clear the object block data
	MOVEI	S2,AKAOBJ		;[6043]Get address of object block
	SETZM	AKAOBJ			;[6043]Clear first word of object block
	HRLI	T1,AKAOBJ		;[6043]Get source address
	HRRI	T1,AKAOBJ+1		;[6043]Get second word
	BLT	T1,AKAOBJ+OBJ.SQ+7	;[6043]Clear the entire object block

	MOVE	S2,OBJ.TY+ARG.DA(P1)	;[6001]GET OBJECT WORD
	HRRZ	S1,S2			;[6001]ISOLATE THE OBJECT TYPE
	CAIE	S1,.OTLPT		;[6001]IS THIS A LPT OBJECT?
	JRST	WTOO.3			;[6001]NO, CHECK FOR MDA OBJECT

	HLRZS	S2			;[6001]ISOLATE THE LPT TYPE
;**;[6043]At WTOOBJ:+21L replace 3 lines with 6 lines  PPM  6/3/90
	CAIE	S2,(.CLLPT)		;[6043]A Cluster LPT?
	SKIPN	S2			;[6043]No, a local LPT?
	JRST	WTOO.4			;[6043]Yes, check the unit number
	HRLI	T1,OBJ.TY+ARG.DA(P1)	;[6043]Get source address,,x
	HRRI	T1,AKAOBJ+OBJ.TY	;[6043]Get source,,destination address
	BLT	T1,AKAOBJ+OBJ.AK	;[6043]Move the entire object block
	LOAD	S2,OBJ.TY+ARG.DA(P1),LHMASK	;[6043]Get LPT type
	CAIE	S2,(.DQLPT)		;[6001]IS THIS A DQS LPT?
	JRST	WTOO.1			;[6001]NO, IT IS A LAT LPT

	MOVEI	S1,OBJ.SZ+ARG.DA(P1)	;[6001]PICK UP THE NAME BLOCK HEADER ADR
	LOAD	S2,ARG.HD(S1),AR.TYP	;[6001]GET THE TYPE OF NAME 
	CAIE	S2,.WTDQS		;[6001]IS THIS A DQS VMS QUEUE NAME BLK?
	PJRST	E$ITM			;[6001]NO, THEN IT IS INVALID
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6001]PICK UP THE BLOCK LENGTH
	CAIGE	S2,2			;[6001]IS IT AT LEAST THE MIN LENGTH?
	PJRST	E$IAL			;[6001]NO, IT HAS AN INVALID LENGTH
	MOVEI	S2,.KYDQS		;[6001]PICK UP BLOCK TYPE $TEXT EXPECTS
	STORE	S2,ARG.HD(S1),AR.TYP	;[6001]PLACE IT IN THE NAME BLOCK
	$CALL	P$NEXT			;[6001]SKIP OVER THE NAME BLOCK
	SOS	P2			;[6001]DECREMENT THE REMAINING BLOCKS
	JRST	WTOO.5			;[6001]GO PICK UP THE NODE NAME

WTOO.1:	MOVEI	S1,OBJ.SZ+ARG.DA(P1)	;[6001]PICK UP THE NAME BLOCK HEADER ADR
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6001]GET THE LENGTH OF THE BLOCK
	CAIGE	S2,2			;[6001]IS IT AT LEAST THE MIN LENGTH?
	PJRST	E$IAL			;[6001]NO, IT HAS AN INVALID LENGTH
	LOAD	S2,ARG.HD(S1),AR.TYP	;[6001]PICK UP THE NAME TYPE
	CAIN	S2,.WTPOR		;[6001]IS IT A PORT NAME?
	JRST	WTOO.2			;[6001]YES, GO CHANGE ITS NAME TYPE
	CAIE	S2,.WTSER		;[6001]IS IT A SERVICE NAME?
	PJRST	E$ITM			;[6001]NO, IT IS AN INVALID BLOCK TYPE
	MOVEI	S2,.KYSER		;[6001]PICK UP BLOCK TYPE $TEXT EXPECTS
	SKIPA				;[6001]GO PLACE IT IN THE NAME BLOCK
WTOO.2:	MOVEI	S2,.KYPOR		;[6001]PICK UP BLOCK TYPE $TEXT EXPECTS
	STORE	S2,ARG.HD(S1),AR.TYP	;[6001]UPDATE THE NAME TYPE BLOCK
	$CALL	P$NEXT			;[6001]SKIP OVER THE NAME BLOCK
	SOS	P2			;[6001]DECREMENT THE NUMBER OF BLOCKS
	JRST	WTOO.5			;[6001]GO PICK UP THE NODE NAME
WTOO.3:	CAIN	S1,.OTMNT		;WAS IT A MOUNT MESSAGE
	JRST	WTOO.5			;[6001]BYPASS UNIT CHECK
;**;[6043]At WTOO.4:+0L add 3 lines   PMM 6/3/90
WTOO.4:	HRLI	T1,OBJ.TY+ARG.DA(P1)	;[6043]Get source address
	HRRI	T1,AKAOBJ+OBJ.TY	;[6043]Get source,,destination address
	BLT	T1,AKAOBJ+OBJ.ND	;[6043]Move the entire object block
	LOAD	T1,OBJ.UN+ARG.DA(P1),OU.LRG ;GET LOW RANGE NUMBER
	SKIPGE	T1			;MUST BE .GEQ. 0
	PJRST	E$IOU			;ILLEGAL RANGE UNIT
	LOAD	T2,OBJ.UN+ARG.DA(P1),OU.HRG ;GET HIGH RANGE
	SKIPGE	T2			;Better be .GEQ. 0
	PJRST	E$RIW			;RANGE INVALID IN WTO OBJECT BLOCK
WTOO.5:	MOVEI	S1,ARG.DA(P1)		;ADDRESS OF OBJECT BLOCK
	MOVEM	S1,WDAOBJ		;SAVE IN OBJECT WORD
	LOAD	T1,OBJ.ND+ARG.DA(P1)	;GET NODE NAME FROM BLOCK
	SKIPN	WDADES			;DESTINATION SET
	MOVEM	T1,WDADES		;SAVE NODE NAME FOR DESTINATION
;**;[6043]At WTOO.5:+4L replace one line with 5 lines   PMM  6/3/90
	MOVEI	S1,AKAOBJ		;[6043]Get address of object block
	$CALL	FINDPR			;[6043]Does it have an alias?
	JUMPF	WTOO.6			;[6043]No, just return
	MOVE	S1,OBJAKA(S2)		;[6043]Get alias name
	MOVEM	S1,OBJ.AK+AKAOBJ	;[6043]Save in object block
WTOO.6:	$RETT
SUBTTL	WTOOCD	Object block type

;THIS ROUTINE WILL SETUP THE OBJECT TYPE FOR SCREENING AND
;MAKE SURE THAT NO OBJECT OR APPLICATION WERE SPECIFIED

WTOOCD:	TXOE	FLAG,F.WOCD		;OBJECT TYPE PROCESSED
	PJRST	E$DTM			;DUPLICATE TYPE IN MESSAGE
	$CALL	CHKWHL			;PRIVILEGES REQUIRED FOR OBJECT
	JUMPF	E$WTP			;OBJECT BLOCK REQUIRES PRIVILEGES
	TXNE	FLAG,F.WACD!F.WOBJ	;APPLICATION CODE SET
	PJRST	E$AON			;APPLIC AND OBJECT NOT ALLOWED TOGETHER
WTOC.1:	MOVE	S1,OBJ.TY+ARG.DA(P1)	;GET OBJECT TYPE
	MOVEM	S1,G$ARG1		;SAVE THE OBJECT TYPE IN CASE OF ERROR
	MOVEM	S1,WDAOBT		;SAVE THE OBJECT TYPE
	CAILE	S1,0			;WITHIN RANGE?
	CAILE	S1,.OTMAX
	CAMN	S1,[.CLLPT!.OTLPT]	;[6001]IS IT A CLUSTER LPT?
	SKIPA				;[6001]YES, GO INDICATE SUCCESS
	CAMN	S1,[.DQLPT!.OTLPT]	;[6001]IS IT A DQS LPT?
	SKIPA				;[6001]YES, GO INDICATE SUCCESS
	CAMN	S1,[.LALPT!.OTLPT]	;[6001]IS IT A LAT LPT?
	$RETT				;[6001]YES, INDICATE SUCCESS
	PJRST	E$IOT			;NO..INVALID OBJECT TYPE
	$RETT				;RETURN

SUBTTL	WTODTY	Process a Display TYpe block

;  This routine fetches the display type from the argument block.

WTODTY:	TXOE	FLAG,F.WDTY		;Set and check for this type argument
	PJRST	E$DTM			;Duplicate, error

;  Need to check here somehow for some types to come from the monitor...

	SKIPLE	S1,ARG.DA(P1)		;Get the argument type
	CAILE	S1,.QBDMX		;Check for legit type
	PJRST	E$ITM			;No good

	MOVEM	S1,WDADTY		;Save the type
	$RETT				;  and return
SUBTTL	W$MTXT	Get the text into the message

;THIS ROUTINE WILL GET THE WTO,WTOR AND ACK TEXT INTO THE
;MESSAGE FOR OUTPUT AND LOGGING
;	Call with nonzero P1 to suppress output of 2 tabs preceeding lines.
;AC usage:
;	S2/ current character
;	T1/ input byte pointer
;	T2/ output byte pointer
;	T3/ flag: -1 if at beginning of line
;	T4/ count of free space in output area
;	P1/ -1 if WT.NFO, 0 if inserting tabs

W$MTXT:	MOVE	T1,WDATXT		;ADDRESS OF THE TEXT
	HRLI	T1,(POINT 7,0)		;MAKE A BYTE POINTER
	MOVE	T2,WTOPTR		;DESTINATION POINTER IN T2
	MOVE	T4,WTOCNT		;GET COUNT OF SPACE IN MESSAGE
MTXT.0:	SETO	T3,			;Start of the line
MTXT.1:	ILDB	S2,T1			;Load a byte of input
	JUMPE	S2,MTXT.5		;Jump if at end of the data
	CAIN	S2,.CHCRT		;Carriage return?
	JRST	MTXT.1			;Yes, and ignore
	CAIE	S2,.CHLFD		;Line feed?
	JRST	MTXT.2			;No, set to output character
	$CALL	W$CRLF			;Yes, output CRLF now
	JUMPF	MTXT.6			;Jump if no room in buffer
	JRST	MTXT.0			;Pick up the next character
MTXT.2:	AOJN	T3,MTXT.3		;Jump if not at beginning of line
	JUMPN	P1,MTXT.3		;Jump if not formatting
	MOVEI	S1,.CHTAB		;Load a tab
	IDPB	S1,T2			;And save in destination buffer
	SOJL	T4,MTXT.6		;Quit if no more room
	IDPB	S1,T2			;Save second tab in destination
	SOJL	T4,MTXT.6		;Quit if no more room
MTXT.3:	IDPB	S2,T2			;Store the character
	SOJG	T4,MTXT.1		;Loop for more characters
	JRST	MTXT.6			;Buffer overflow, tie it off
MTXT.5:	PUSHJ	P,W$CRLF		;END THE LINE
MTXT.6:	MOVEI	S2,0			;GET A NULL
	IDPB	S2,T2			;SAVE BYTE IN MESSAGE
	MOVEM	T4,WTOCNT		;RESTORE COUNT FOR MESSAGE
	MOVEM	T2,WTOPTR		;RESTORE DESTINATION POINTER
	$RETT				;RETURN TRUE
SUBTTL	W$CRLF	Terminate line with CRLF

;THIS ROUTINE WILL PUT CRLF ON LINE FROM W$MTXT

W$CRLF:	MOVEI	S2,.CHCRT		;GET A CARRIAGE RETURN
	IDPB	S2,T2			;SAVE IN DESTINATION
	SOJL	T4,.RETF		;NO MORE ROOM RETURN FALSE
	MOVEI	S2,.CHLFD		;GET A LINE FEED
	IDPB	S2,T2			;SAVE IN DESTINATION
	SOJL	T4,.RETF		;NO MORE ROOM.RETURN FALSE
	$RETT				;RETURN TRUE
SUBTTL	OPRMSG	Build a message for OPR

;THIS ROUTINE WILL BUILD THE TEXT MESSAGE FOR OPR AND TO BE USED
;BY LOGGING IF ENABLED

OPRMES::$CALL	GETPAG			;GET THE OUTPUT MESSAGE IN MO
OPRMS::	MOVX	S1,.OMDSP		;GET THE DISPLAY TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE TYPE IN MESSAGE
	MOVEI	S1,<<PAGSIZ-1>-<ARG.DA+2+.OHDRS>>*5 ;NUMBER OF BYTES AVAILABLE
					;Page size -1 (so 777 works)
					;Minus size of header of argument block
					;  and message header
					;SAVE ROOM FOR TRUNCATING
	MOVEM	S1,WTOCNT		;SAVE IN WTOCNT
	MOVSI	S1,(POINT 7,0)		;SETUP BYTE POINTER
	HRRI	S1,ARG.DA+1+.OHDRS(MO)	;ADDRESS TO SAVE TEXT
	MOVEM	S1,WTOPTR		;SAVE THE BYTE POINTER
	MOVE	S1,G$NOW		;GET THE TIME
	MOVEI	P3,ARG.HD+.OHDRS(MO)	;ADDRESS OF FIRST ARGUMENT
	MOVEM	S1,ARG.DA(P3)		;SAVE THE TIME-STAMP
	MOVX	S1,.ORDSP		;OPR DISPLAY BLOCK
	STORE	S1,ARG.HD(P3),AR.TYP	;SAVE THE TYPE
	TXNN	FLAG,F.WNEB		;[6005]IS THIS A REMOTE MESSAGE?
	$RETT				;[6005]NO, RETURN NOW

	DMOVE	S1,.MSFLG(MI)		;[6005]PICK UP .MSFLG/.MSCOD
	DMOVEM	S1,.MSFLG(MO)		;[6005]PLACE IN OUTGOING MESSAGE
	$RETT				;[6005]RETURN NOW

;**;[6043]After routine OPRMS add routine SAKHDR  PMM  6/3/90

SUBTTL	SAKHDR	Set Up The Display Message For Remote processing

;[6043]Routine SAKHDR sets up the .OMDSP message for the remote processing
;[6043]of the SHOW ALIAS message.

SAKHDR::MOVEI	S1,.OMDSP		;[6043]Get the display type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6043]Save type in message
	MOVEI	S1,SHADBK		;[6043]Addr of block to add to message
	$CALL	SHWMTX			;[6043]SHOW message text pointer
	$CALL	OPRSPT			;[6043]Set up the pointers
	$RET				;[6043]Return to the caller
SUBTTL	W$MESS	Setup a WTO/WTOR/ACK message

W$MESS:	SKIPN	S2,.OFLAG(MI)		;ANY FLAGS SET IN MESSAGE
	JRST	WTOM.1			;NO..PROCESS MESSAGE
	TXNN	S2,WT.PRV		;ANY PRIVILEGED BITS LIT
	JRST	WTOM.1			;NO..CONTINUE ON
	$CALL	CHKWHL			;WAS USER PRIVILEGED??
	JUMPF	E$IPE			;INSUFFICIENT PRIVILEGE
	TXZ	S2,WT.JOB		;JOB MESSAGE FLAG
	JUMPE	S2,WTOM.1		;NONE ON..PASS CHECK
;**;[6032]At WTOM.1:+0L change 7 lines  JCR  11/29/89
WTOM.1:	TXNE	FLAG,F.WNEB		;[6032]Is this a remote message?
	$CALL	NEBBLK			;[6032]Build the remote display block
	LOAD	S1,.MSTYP(MI),MS.TYP	;[6032]Get the message type
	CAIE	S1,.OMWTR		;[6032]Is it a WTOR?
	MOVEI	T1,[ITEXT(	)]	;[6032]No, save a tab for first field
	MOVEI	T2,[ITEXT()]		;[6032]Save null object pointer
	MOVEI	T3,[ITEXT()]		;[6032]Save null type pointer
	TXNN	FLAG,F.WOBJ		;WAS THERE AN OBJECT BLOCK
	JRST	WTOM.2			;CHECK OUT TYPE
;**;[6043]At WTOM.1:+8L replace 1 line with 12 lines  PMM  6/3/90
	SKIPN	AKAOBJ+OBJ.AK		;[6043]Does it have an alias?
	JRST	WTOM.A			;[6043]No, just get object block
	HLLZ	S1,AKAOBJ		;[6043]Get the printer type
	SKIPN	S1			;[6043]Is it a local printer?
	MOVEI	T2,[ITEXT(<Local printer ^WL/AKAOBJ+OBJ.AK/>)]   ;[6043]Yes
	TXNE	S1,.DQLPT			;[6043]Is it a DQS printer?	
	MOVEI	T2,[ITEXT(<DQS printer ^WL/AKAOBJ+OBJ.AK/>)]   ;[6043]Yes
	TXNE	S1,.CLLPT			;[6043]Is it a CLUSTER printer?	
	MOVEI	T2,[ITEXT(<Cluster printer ^WL/AKAOBJ+OBJ.AK/>)]   ;[6043]Yes
	TXNE	S1,.LALPT			;[6043]Is it a LAT printer?	
	MOVEI	T2,[ITEXT(<LAT printer ^WL/AKAOBJ+OBJ.AK/>)]   ;[6043]Yes
	JRST	WTOM.2				;[6043]Continue on

WTOM.A:	MOVEI	T2,[ITEXT(<^B/@WDAOBJ/>)];GET OBJECT BLOCK
	MOVE	S1,@WDAOBJ+OBJ.TY	;GET TYPE FIELD
	CAIE	S1,.OTBAT		;WAS IT BATCH?
	JRST	WTOM.2			;NO..CONTINUE ON
	SKIPE	WDAJOB			;WAS THERE A JOB NUMBER
	MOVEI	T2,[ITEXT(<^B/@WDAOBJ/ JOB #^D/WDAJOB/ >)]
WTOM.2:	TXNE	FLAG,F.WACD		;WAS THERE AN APPLICATION  CODE
	MOVEI	T2,[ITEXT(<^T/@WDAACD/>)];SETUP APPLICATION CODE LINE
					;*** SET LENGTH ON APPLICATION CODE
	TXNN	FLAG,F.WTYP		;TYPE FIELD PRESENT
	JRST	WTOM.3			;NO SKIP OVER
	MOVEI	T3,[ITEXT(<  -- ^T/@WDATYP/ -->)]
	MOVX	S1,WT.NDA		;NO DASHES ON TYPE
	TDNE	S1,.OFLAG(MI)		;WAS IT SPECIFIED
	MOVEI	T3,[ITEXT(<  ^T/@WDATYP/>)]
WTOM.3:	$TEXT	(WTORTN,<^I/(T1)/^I/(T2)/^I/(T3)/^A>)
	TXNE	FLAG,F.WOBJ!F.WACD	;OBJECT OR APPLICATION BLOCK
	JRST	WTOM.4			;YES..BYPASS W$JOBH
	MOVX	S1,WT.SJI		;SUPPRESS JOB INFO
	TDNN	S1,.OFLAG(MI)		;WAS IT SET?
	$CALL	W$JOBH			;SETUP W$JOBH FIELD
WTOM.4:	$TEXT	(WTORTN,<>)		;OUTPUT CR,LF
	SKIPN	WDATXT			;CHECK IF ANY TEXT DATA
	JRST	MSGFIN			;NO..FINISH THE MESSAGE
	MOVX	S1,WT.NFO		;NO FORMATTING OF MESSAGE
	TDNN	S1,.OFLAG(MI)		;WANT TO FORMAT THE MESSAGE?
	TDZA	P1,P1			;YES
	SETO	P1,			;CLEAR FORMATTING FLAG
	PUSHJ	P,W$MTXT		;GET THE TEXT FOR WTO
	JRST	MSGFIN			;FINISH THE MESSAGE
	SUBTTL	NEBBLK - Build a Remote Display block

;**;[6032]At NEBBLK:+0L replace 6 lines with 6 lines  JCR  11/29/89
NEBBLK:	LOAD	S1,.OFLAG(MI)		;[6032]Pick up the flag word
	TXNE	S1,WT.SUP		;[6032]Suppress remote origin display?
	$RETT				;[6032]Yes, return now
	MOVEI	T3,[ITEXT(< Received message from ^N/G$HOST/::>)] ;[6032]
	TXZE	FLAG,F.WLOC		;[6032]The WTO to be sent locally?
	MOVEI	T3,[ITEXT(< Processed request in behalf of ^N/WDANHD/::>)] ;[6032]Yes
	$TEXT	(WTORTN,<^I/(T3)/^0>) 	;[6016]PLACE IN THE BLOCK
	HRRZ	S1,WTOPTR		;[6005]PICK UP THE LAST ADDRESS
	ANDI	S1,777			;[6005]ISOLATE THE MESSAGE LENGTH
	SUBI	S1,.OHDRS-1		;[6005]SUBTRACT OUT HEADER LENGTH
	STORE	S1,ARG.HD(P3),AR.LEN	;[6005]STORE THE DISPLAY BLOCK LENGTH
;**;[6031]At NEBBLK:+10L change 1 line  JCR  10/3/89
	MOVEM	S1,WDALEN		;[6031]Save the length for later

	ADD	P3,S1			;[6005]ADDRESS OF THE NEXT BLOCK
	MOVEI	S2,.ORDSP		;[6005]PICK UP DISPLAY BLOCK CODE
	STORE	S2,ARG.HD(P3),AR.TYP	;[6005]PLACE IN THE DISPLAY BLOCK
	MOVE	S2,G$NOW		;[6005]PICK UP THE TIME
	MOVEM	S2,ARG.DA(P3)		;[6005]PLACE IN THE DISPLAY BLOCK

	MOVEI	S1,ARG.DA+1(P3)		;[6005]ADDRESS OF FIRST TEXT WORD
	HRLI	S1,(POINT 7,)		;[6005]MAKE INTO A POINTER
	MOVEM	S1,WTOPTR		;[6005]SAVE FOR MOVING THE TEXT
	AOS	.OARGC(MO)		;[6015]INCREMENT THE ARGUMENT COUNT
	$RET				;[6005]RETURN TO THE CALLER
SUBTTL	MSGFIN	Finish DISPLAY message

MSGFIN::SETZ	S1,			;SETUP A NULL
	IDPB	S1,WTOPTR		;SAVE A NULL ON THE END
	HRRZ	S1,WTOPTR		;GET LAST ADDRESS
	ADDI	S1,1			;BUMP IT BY 1
	ANDI	S1,777			;GET MESSAGE LENGTH
	STORE	S1,.MSTYP(MO),MS.CNT	;SAVE THE COUNT
	SUBI	S1,.OHDRS		;SIZE OF ARGUMENT BLOCK
	TXNE	FLAG,F.WNEB		;[6005]IS THIS A REMOTE MESSAGE?
;**;[6031]At MSGFIN:+8L change 1 line  JCR  10/3/89
	SUB	S1,WDALEN		;[6031]Yes, subtract first display blk
	STORE	S1,ARG.HD(P3),AR.LEN	;SAVE ARGUMENT LENGTH
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	$RETT				;RETURN

WTORTN::SOSGE	WTOCNT			;ROOM IN MESSAGE
	$RETF				;FALSE RETURN..TRUNCATE MESSAGE
	IDPB	S1,WTOPTR		;SAVE THE BYTE
	$RETT				;RETURN TRUE


;**;[6043]Add Routine CRLF at WTRTN::+4L   PMM   6/3/90
SUBTTL	CRLF	Insert a Carriage Return, Line Feed in a WTO Message

;[6043]Call is:       No arguments
;[6043]Returns True:  A carriage return is replaced in the WTO buffer.  The
;[6043]		     byte pointer WTOPTR and the space keeper WTOCNT are
;[6043]               updated
;[6043]Returns False: The carriage return is saved in the WTO buffer.  The 
;[6043]		     byte pointer and the space keeper are updated.  A false
;[6043]		     return indicates that the message must be truncated 
;[6043]		     because there is no more space in the WTO buffer.

CRLF:	$SAVE	<T4>			;[6043]Save a scratch AC
	MOVEI	T4,.CHCRT		;[6043]Get a carriage return
	IDPB	T4,WTOPTR		;[6043]Save in destination
	SOSGE	WTOCNT			;[6043]Room in message?
	$RETF				;[6043]False return..truncate message
	MOVEI	T4,.CHLFD		;[6043]Get a line feed
	IDPB	T4,WTOPTR		;[6043]Save in destination
	SOSGE	WTOCNT			;[6043]Room in message?
	$RETF				;[6043]False return..truncate message
	$RETT				;[6043]Return true
SUBTTL	W$JOBH	Setup a job header message

;THIS ROUTINE WILL SETUP THE JOB INFORMATION FOR WTO/WTOR
;MESSAGES

W$JOBH:	LOAD	S1,G$JOB		;GET THE JOB NUMBER
	$CALL	GETJOB			;GET THE JOB INFO
	TXNE	FLAG,F.WTYP		;WAS THERE A TYPE BLOCK
	SKIPA	S1,[[ITEXT (<^M^J		>)]] ;<CRLF> <TAB> <TAB>
	MOVEI	S1,[ITEXT (<-- Message from timesharing user --^M^J		>)]
	$TEXT	(WTORTN,<^I/(S1)/^I/@JOBTXT/^A>) ;OUTPUT THE JOB DATA
	$RETT				;RETURN
SUBTTL	GETJOB/GETJBT	Get job information

;THIS ROUTINE WILL OBTAIN JOB INFORMATION ABOUT A USER GIVEN
;THE JOB NUMBER
;GETJBT is the same as GETJOB but tries to include node (location) info.
;CALL	S1/	JOB NUMBER
;
;	S1 PRESERVED

GETJBT:: SETOM	S2			;Set a temp flag
	SKIPA
GETJOB:: SETZM	S2			;set a temp flag
	STKVAR <TRMFLG>		;Get a variable for tty desc.
	MOVEM	S2,TRMFLG		;Save the terminal flag
	MOVEM	S1,JOBNUM		;SAVE THE JOB NUMBER
	MOVX	S2,JI.PRG		;GET PROGRAM NAME
	$CALL	I%JINF			;GET THE INFO
	JUMPF	GETJ.3			;ERROR..RETURN
	MOVEM	S2,JOBNAM		;PROGRAM NAME
	MOVX	S2,JI.USR		;GET USER # OR PPN
	$CALL	I%JINF			;GET VALUE
	JUMPF	GETJ.3			;ERROR..SETUP DEFAULT
	SKIPN	S2			;VALID USER NUMBER
	JRST	GETJ.3			;NO..USE DEFAULT
	MOVEM	S2,JOBID		;SAVE THE ID
TOPS10<
	$CALL	GETNAM			;GET THE USER NAME
>;END TOPS10
	MOVX	S2,JI.TNO		;GET THE TERMINAL NUMBER
	$CALL	I%JINF			;GET THE DATA
	JUMPF	GETJ.3			;ERROR..RETURN
	SKIPGE	S2			;VALID TERMINAL?
	  JRST	[MOVEI	T1,-2		;Detached indicator
		MOVEM	T1,JOBTTY	;Set it
		MOVEI	T1,[ITEXT (<detached>)] ;NO DETACHED
		JRST	GETJ.1]		;SAVE VALUE AND CONTINUE
	MOVEM	S2,JOBTTY		;SAVE THE TERMINAL NUMBER
	SKIPN	TRMFLG			;Do we want to do node location of term?
	JRST	GETJ.0			;No
	$CALL	GLOC			;Get the physical location of TTY
	JUMPF	GETJ.0			;No can do... just give terminal number
	MOVEM	S1,JOBNOD		;Remember the job's node
	MOVEM	S2,JOBLIN		;and the line on that node
	MOVE	S1,JOBNUM		;Restore job number to S1
	MOVEI	T1,[ITEXT (<at ^N/JOBNOD/_^O/JOBLIN/ TTY^O/JOBTTY/>)]
	SKIPA				;Don't do it again
GETJ.0:	MOVEI	T1,[ITEXT (<at terminal ^O/JOBTTY/>)]
GETJ.1:	MOVEM	T1,JOBTER		;SAVE JOB TERMINAL DATA
	MOVX	S2,JI.BAT		;GET BATCH INFO
;*** 7.01 DEPENDENT CODE
	$CALL	I%JINF			;GET JOB INFO
	JUMPF	GETJ.2			;ERROR..RETURN
	TXNN	S2,OB.BSS		;BATCH STREAM NUMBER SET?
	JRST	GETJ.2			;NO..CONTINUE ON
	MOVEM	S2,G$JDAT		;JOB DATA FLAG
	MOVEI	S2,[ITEXT (<in batch-stream ^D/G$JDAT,OB.BSN/>)]
	MOVEM	S2,JOBTER		;SAVE TERMINAL DATA
GETJ.2:	MOVEI	T1,[ITEXT (<job ^D/JOBNUM/ ^P/JOBID/ ^I/USRNAM/^I/@JOBTER/>)]
	MOVEM	T1,JOBTXT		;SAVE JOB TEXT POINTER
	$RETT				;RETURN TRUE
GETJ.3:	MOVEI	T1,[ITEXT (<job ^D/JOBNUM/ ^P/G$SID/>)]
	MOVEM	T1,JOBTXT		;SAVE AS JOBTXT
	SETOM	JOBTTY			;NO JOB FLAG
	MOVEI	T1,NULTXT		;NULL TEXT
	MOVEM	T1,JOBTER		;NO TERMINAL DATA
	$RETT				;RETURN TRUE

TOPS20<
USRNAM==NULTXT
>;END TOPS20
TOPS10<
USRNAM:	ITEXT	(<^W6/JOBUSN/^W/JOBUSN+1/ >)
>;END TOPS10
	SUBTTL	GLOC	Get physical location of TTY

;  This routine determines the physical location of a TTY.  It should
;  be a part of the I%JINF but the answer needs 2 words not one.

;  Accepts	S1 / Job number

;  Returns	False if the routine fails.
;		Possible failures include:
;			Not yet implemented
;			Invalid job number

;		True
;		S1 / Node name/number
;		S2 / Terminal line number

GLOC:
TOPS20<	$RETF				;Not yet implemented >
TOPS10<
	MOVEI	S2,JI.TNO		;Terminal number function
	$CALL	I%JINF			;get it
	$RETIF				;Failures are unacceptable
	ADDI	S2,.UXTRM		;Make it UDX
	GTNTN.	S2,			;Get the node number,,line number
	 $RETF				;Couldn't get it
	HLRZ	S1,S2			;Move the node number
	HRRZS	S2,S2			;Only the line number
	$RETT				;Return happy
> ; End of TOPS10
SUBTTL	GETUSR	Get user info for notify

;THIS ROUTINE WILL GET EXTRA INFO REQUIRED BY NOTIFY AND USE
;GET JOB TO GET THE REST

;CALL	S1/	JOB NUMBER

GETUSR:: $CALL	GETJOB			;GET JOB INFO
	SKIPL	JOBTTY			;HAVE VALID TERMINAL
	JRST	GETU.1			;O.K. CONTINUE ON
	SETOM	S2			;Get -1
	CAME	S2,JOBTTY		;Invalid, or not attached?
	PJRST	E$NJD			;NOTIFY JOB DETACHED
	PJRST	E$JDE			;NOTIFY JOB INVALID
GETU.1:	MOVX	S2,JI.JLT		;JOB LOGGED IN TIME
	$CALL	I%JINF			;GET THE DATA
	MOVEM	S2,JOBJLT		;SAVE JOB LOGGED IN TIME
	$RETT				;O.K..RETURN TRUE
SUBTTL	GETNAM	Get user name

;THIS ROUTINE WILL GET USER NAME FOR A  GIVEN JOB
;CALL S1/	JOB NUMBER

TOPS10<
GETNAM:	HRLZ	S2,S1			;PLACE JOB NUMBER IN LEFT HALF
	HRRI	S2,.GTNM1		;GET THE USER NAME
	GETTAB	S2,			;GETTAB IT
	  JRST	GETJ.3			;ERROR..RETURN
	MOVEM	S2,JOBUSN		;SAVE IN USER NAME
	HRLZ	S2,S1			;JOB NUMBER IN LEFT HALF
	HRRI	S2,.GTNM2		;SECOND HALF OF NAME
	GETTAB	S2,			;GET IT
	  JRST	GETJ.3			;ERROR..RETURN
	MOVEM	S2,JOBUSN+1		;SAVE THE USER NAME SECOND PART
	$RET				;RETURN
>;END TOPS10
SUBTTL	W$SHOW	Show ACK message from QUASAR

;THIS MESSAGE IS AN ANSWER TO A SHOW COMMAND FROM QUASAR
;AND IS ALREADY FORMATED.

W$SHOW::$CALL	CHKWHL			;CHECK IF WHEEL
	JUMPF	E$ARP			;ERROR..RETURN
	LOAD	T1,.MSFLG(MI)		;[6005]GET FLAG WORD
	TXNE	T1,MF.NOM		;[6005]NULL ACK
	PJRST	ACKM.1			;LOG THE NULL ACK AND RETURN
	$CALL	SPGOUT			;SETUP PAGE FOR OUTPUT
	TXNN	T1,MF.NEB		;[6005]MESSAGE FROM A REMOTE NODE?
	JRST	W$SH.1			;[6005]NO, TREAT AS A LOCAL SHOW ACK
	MOVE	S1,G$NOW		;[6005]PICK UP THE CURRENT TIME
	MOVEM	S1,.OHDRS+ARG.DA(MO)	;[6005]PLACE IN THE REMOTE DISPLAY BLOCK
;**;[6032]At W$SHOW::+10L delete 2 lines  JCR  11/29/89
W$SH.1:	$CALL	L$SHWA##		;[6005]LOG THE MESSAGE
	$CALL	W$ASND			;SEND THE ACK
	$RETT				;RETURN

SUBTTL	W$ASND	Send an ACK to OPR

;THIS ROUTINE WILL SEND THE MESSAGE TO THE APPROPRIATE OPR
;AND UPDATE THE COUNTS

W$ASND:	SKIPN	S1,.MSCOD(MI)		;GET THE ACK CODE
	PJRST	WTOSND			;ZERO - CHANGE INTO WTO INSTEAD
	CAMN	S1,[-1]			;IS IT A -1 CODE
	PJRST	RELPAG			;YES..THEN DO NOT SEND TO ANYONE
	$CALL	VALOPR			;VALIDATE OPR
	JUMPF	ASND.1			;OPR NOT VALID..RELEASE PAGE AND RETURN
	MOVEM	S2,G$OPRA		;SAVE THE OPR ADDRESS
	AOS	OPR.OC(S2)		;BUMP OUTPUT COUNT
	MOVE	S1,OPR.PD(S2)		;GET OPR PID
	MOVEI	S2,PAGSIZ		;GET SIZE OF MESSAGE
	PJRST	SPDOPR			;SEND THE MESSAGE
ASND.1:	$CALL	RELPAG			;RELEASE THE PAGE
	PJRST	E$ODE			;OPR DOESN'T EXIST ERROR
SUBTTL	W$ACKM	Process an ACK message

;THIS ROUTINE WILL VALIDATE AND THEN PROCESS AN
;ACKNOWLEDGEMENT MESSAGE

W$ACKM::$CALL	CHKWHL			;CHECK IF PRIVILEGED
	JUMPF	E$ARP			;ACK REQUIRES PRIVILEGES
	LOAD	S1,.MSFLG(MI)		;GET FLAG WORD
	TXNE	S1,MF.NOM		;NULL ACK
	JRST	ACKM.2			;YES..LOG AND RETURN
	$CALL	W$VALID			;VALIDATE THE WTO MESSAGE
	$RETIF				;FALSE RETURN...RETURN
	SETZM	WDAFLG			;CLEAR THE FLAGS FOR ACKS
	$CALL	OPRMES			;BUILD THE MESSAGE
	$CALL	W$MESS			;SETUP THE DATA
	JUMPF	WTERRO			;WT ERROR RETURN
	TXNE	FLAG,F.WNEB		;[6005]A REMOTE MESSAGE?
	JRST	ACKM.1			;[6005]YES, TREAT DIFFERENTLY
	$CALL	L$ACK##			;LOG THE ACK MESSAGE
	$CALL	W$ASND			;SEND THE ACK
	$RETT				;RETURN

ACKM.1:	$CALL	L$RACK##		;[6005]LOG THE ACK
	$CALL	N$SNEB			;[6005]SEND THE MESSAGE TO NEBULA
	$RETIT				;[6005]RETURN ON A SUCCESS
	PJRST	LOGNSE			;[6005]SETUP TO LOG THE SEND ERROR

ACKM.2:	$CALL	L$NACK##		;LOG NULL ACK
	$RETT				;RETURN


SUBTTL	TXTMOV	Text Move Routine

;CALLED WITH
;	S1/	ADDRESS OF THE DESTINATION
;	S2/	ADDRESS OF THE SOURCE
;
;RETURNS
;	S1/	UPDATED BYTE POINTER


TXTMOV:	HRLI	S2,(POINT 7,0)		;MAKE A BYTE POINTER
	HRLI	S1,(POINT 7,0)		;BYTE POINTER FOR DESTINATION
	MOVEM	S2,TXTPTR		;SAVE THE SOURCE POINTER
TXTM.1:	ILDB	S2,TXTPTR		;GET FIRST BYTE OF DATA
	JUMPE	S2,TXTM.2		;NULL BYTE ..EXIT
	IDPB	S2,S1			;SAVE THE BYTE
	JRST	TXTM.1			;GET NEXT BYTE
TXTM.2:	IDPB	S2,S1			;SAVE THE NULL FOR ASCIZ
	$RETT				;RETURN
SUBTTL	CMDMES	Process a DN60 command message

;THIS ROUTINE WILL PROCESS A COMMAND PASSED IN THE MESSAGE AND
;PASS IT ON TO THE APPROPRIATE OPR (DN60 ONLY)
	PPPLLL==777000			;PORT /LINE MASK

IFN	FTDN60,<
CMDMES:	$CALL	CHKWHL			;BETTER BE WHEEL OR OPERATOR
	$RETIF				;ERROR..RETURN
	MOVEI	S1,.OHDRS(MI)		;GET THE START OF THE BLOCKS
	$CALL	P$SETU			;SETUP THE POINTER
	$CALL	P$NFLD			;GET NEXT FIELD
	JUMPF	E$ITM			;INVALID TYPE ARGUMENT
	CAIE	S1,.ORNOD		;WAS IT A NODE BLOCK
	PJRST	E$ITM			;INVALID TYPE ARGUMENT
	MOVE	T3,ARG.DA(S2)		;GET THE NODE NAME IN SIXBIT
	$CALL	P$NFLD			;GET THE NEXT FIELD
	JUMPF	E$ITM			;INVALID TYPE MESSAGE
	CAIE	S1,.ORD60		;WAS IT A DN60 BLOCK
	PJRST	E$ITM			;INVALID BLOCK TYPE
	DMOVE	P1,ARG.DA(S2)		;GET THE DATA WORDS
	HLRZ	S1,P1			;GET THE PORT NUMBER
	HRRO	S2,P1			;SETUP -1,, LINE NUMBER
	STORE	S1,S2,PPPLLL		;SAVE  AS -1,,PPPLLL
	MOVEM	S2,.MSCOD(MI)		;SAVE ACK CODE
	EXCH	S2,G$SND		;SAVE AS THE SENDER
	MOVE	S1,G$SND		;GET THE HANDLE
	$CALL	VALOPR			;VALIDATE THE OPR
	JUMPF	E$ONS			;OPR NOT SETUP
	MOVEM	S2,G$OPRA		;SAVE OPR ADDRESS
	$CALL	P$TEXT			;CHECK FOR A TEXT BLOCK
	JUMPF	E$ITM			;INVALID TYPE BLOCK
	MOVEI	S1,ARG.DA(S1)		;ADDRESS OF THE STRING
	MOVEM	S1,PARBLK+PAR.SR	;SAVE THE TEXT ADDRESS
	MOVEI	S1,INITCM##		;ADDRESS OF THE TABLES
	MOVEM	S1,PARBLK+PAR.TB	;SAVE THE TABLE ADDRESS
	MOVEI	S1,PAR.SZ		;SIZE OF THE BLOCK
	MOVEI	S2,PARBLK		;ADDRESS OF THE BLOCK
	$CALL	PARSER##		;PROCESS THE MESSAGE
	JUMPT	CMDM.1			;O.K..
	MOVE	T1,PRT.EM(S2)		;ADDRESS OF THE MESSAGE
	MOVEM	T1,G$ARG1		;SAVE THE MESSAGE
	PJRST	E$PER			;PARSER ERROR RETURN
CMDM.1:	MOVE	MI,PRT.CM(S2)		;GET MESSAGE ADDRESS
	JRST	COMMAN			;PROCESS THE COMMAND
>;END FTDN60
SUBTTL	COMMAN	Process an OPR command message (ala OPRPAR)

;THIS ROUTINE TAKES THE MESSAGE SENT BY THE PARSER AS THE RESULT OF A
;VALID COMMAND AND DISPATCHES TO THE APPROPRIATE ACTION ROUTINE BASED
;ON THE COMMAND TYPE
;IT IS CALLED WITH MI POINTING TO THE PAGE CONTAINING THE MESSAGE

COMMAN::MOVE	S1,G$SND		;GET THE SENDERS PID
	$CALL	VALOPR			;VALIDATE THE OPERATOR
	JUMPF	E$ONS			;OPR NOT SETUP
	MOVEM	S2,G$OPRA		;SAVE OPR ENTRY ADDRESS
TOPS20<
	MOVX	T1,MD.PWH!MD.POP	;GET WHEEL AND OPR FLAGS
	MOVX	S1,OP.REM		;IS IT REMOTE OPERATOR
	TDNE	S1,OPR.FL(S2)		;CHECK THE FLAG
	ANDCAM	T1,G$PRVS		;YES..CLEAR PRIVILEGES FOR MESSAGES
>;END TOPS20
	MOVE	T1,OPR.FL(S2)		;GET THE FLAGS
	TXNE	T1,OP.NST		;CHECK IF SETUP?
	PJRST	E$ONS			;OPERATOR NOT SETUP
	TXNE	T1,OP.ABT		;WAS ABORT SET
	$RETT				;YES..EXIT NOW
	$CALL	L$CMD##			;LOG THE COMMAND
	SKIPG	T1,.OARGC(MI)		;GET THE ARGUMENT COUNT
	JRST	E$ICS			;INVALID COUNT SPECIFIED
	CAILE	T1,COM.AL		;LESS THAN MAX SIZE
	JRST	E$ICS			;WRONG COUNT SPECIFIED
	MOVX	T2,CM.NPR		;NO PROCESSING REQUIRED
	TDNE	T2,.OFLAG(MI)		;CHECK IF SET??
	$RETT				;YES..RETURN TRUE
COMM.1:	SKIPN	S2,COM.PB(MI)		;WAS PARSER BLOCK FILLED IN
	PJRST	E$CMI			;COMMAND MESSAGE INVALID
	SKIPE	S1,COM.TY(MI)		;CHECK FOR APPLICATION MESSAGE
	JRST	COMM.6			;YES..SEND TO APPLICATION
	ADDI	S2,(MI)			;POINT PB AT THE BLOCK
	MOVE	S1,S2			;GET THE BLOCK POINTER
	$CALL	P$SETU			;SETUP THE POINTER
	$CALL	P$KEYW			;GET THE FIRST KEYWORD
	JUMPF	COMM.3			;INVALID COMMAND
	MOVSI	T1,-COMLEN		;GET NEGATIVE TABLE LENGTH FOR AOBJN
COMM.2:	HLRZ	T2,COMTAB(T1)		;GET THE CODE FOR THIS INDEX
	CAME	T2,S1			;MATCH?
	AOBJN	T1,COMM.2		;LOOP 'TILL COUNT EXPIRES OR MATCH IS FOUND
	JUMPGE	T1,E$IFC		;ILLEGALLY FORMATTED COMMAND
	HRRZ	T1,COMTAB(T1)		;GET DISPATCH ADDRESS FROM TABLE
	HRRZ	T2,@T1			;GET THE ROUTINE ADDRESS IN T2
	SETZM	G$CLUN			;[6004]NO CLUSTER NODE BLOCKS SEEN YET
	$CALL	GETPAG			;OUTPUT PAGE IN MO
	HLRZ	S1,@T1			;PLACE CODE TYPE IN S1
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE TYPE IN MESSAGE
	MOVEI	P3,.OHDRS(MO)		;FREE POINTER FOR OUTPUT
	SETZM	G$OUTP			;[6004]MESSAGE PAGE RELEASE FLAG
	$CALL	(T2)			;DISPATCH TO CORRECT ROUTINE
	SKIPE	G$ERR			;[6001]ANY ERROR CODES SET?
	JRST	COMM.5			;[6001]YES, PRESERVE THE CODE
	SKIPF				;[6001]ANY ERROR OCCURR?
	$RET				;[6001]NO, RETURN SUCCESS
COMM.3:	$CALL	E$IFC			;ILLEGALLY FORMATTED COMMAND
COMM.5:	CAME	MO,G$OUTP		;WAS PAGE RELEASE ALREADY
	$CALL	RELPAG			;[6001]NO, RELEASE PAGE 
	$RETF				;[6001]INDICATE AN ERROR OCCURRED
COMM.6:	$CALL	FNDAPL			;FIND THE APPLICATION
	JUMPF	E$IFC			;INVALID FIELD IN COMMAND
COMM.7:	MOVE	T1,APLTAB+1(S2)		;GET COMMAND TABLE ENTRY
	HLRZM	T1,G$ARG1		;SAVE THE NAME
	SKIPN	T2,APLPID(S2)		;IS THERE A PID THERE
	  JRST	COMM.8			;INVALID APPLICATION SPECIFIED
	MOVE	T1,G$SND		;GET SENDERS PID
	MOVEM	T1,.MSCOD(MI)		;SAVE IN CODE WORD
	$CALL	SPGOUT			;SETUP THE OUTPUT PAGE
	MOVEI	S2,PAGSIZ		;SEND A PAGE
	MOVE	S1,T2			;GET THE PID
	$CALL	SNDPID			;SEND THE MESSAGE
	$RETIT				;OK..RETURN
	$CALL	RELPAG			;RELEASE THE PAGE
	PJRST	TAKABT			;DO TAKE FILE ABORT
COMM.8:	SKIPN	T2,APLHLR(S2)		;No PID, an internal application?
	JRST	TAKABT			;No, invalid application specified
	PJRST	(T2)			;Go do application
SUBTTL	FNDAPL	Find an application

;THIS ROUTINE WILL FIND THE APPLICATION
;
;S1/	CODE OF APPLICATION
;
;RETURN TRUE:	S1/	CODE OF APPLICATION
;		S2/	OFFSET INTO CODE TABLE

FNDAPL:	MOVSI	S2,-NUMAPL		;GET NUMBER OF ENTRIES
	SKIPN	S2			;ANY ENTRIES
	$RETF				;NONE..RETURN FALSE
FNDA.1:	MOVE	T1,APLCOD(S2)		;GET THE FIRST ENTRY
	CAMN	S1,T1			;DOES IT MATCH
	$RETT				;MATCH..RETURN TRUE
	AOBJN	S2,FNDA.1		;TRY NEXT ENTRY
	$RETF				;NOT FOUND..RETURN FALSE
SUBTTL	Dispatch Table for Command Messages


;EACH ENTRY HERE HAS THE APPROPRIATE KEYWORD CODE IN THE LH AND
;THE ADDRESS OF THE ROUTINE FOR THAT COMMAND IN THE RIGHT HALF

COMTAB:
	.KYALI,,[.OMALI,,Q$ALGN##]	;ALIGN COMMAND
	.KYBKS,,[.OMBKS,,Q$BSPACE##]	;BACKSPACE COMMAND
	.KYCNC,,[.OMCAN,,Q$ABORT##]	;ABORT COMMAND
	.KYCLO,,[0,,CLSLOG]		;CLOSE COMMAND
	.KYCNT,,[.OMCON,,Q$CONTIN##]	;CONTINUE COMMAND
IFN	FTDN60,<
	.KYDEF,,[.OMDEF,,Q$DEFINE##]	;DEFINE COMMAND
>;END FTDN60
	.KYDEL,,[.OMDEL,,Q$CANCEL##]	;CANCEL COMMAND
	.KYDIS,,[.OMDIS,,DISABLE]	;DISABLE MESSAGE
	.KYDSM,,[.ODDSM,,Q$DISMOUNT##]	;DISMOUNT COMMAND
	.KYENA,,[.OMENA,,ENABLE]	;ENABLE MESSAGE
	.KYFWS,,[.OMFWS,,Q$FSPACE##]	;FORWARDSPACE COMMAND
	.KYHLD,,[.OMHLD,,Q$HOLD##]	;HOLD
	.KYIDN,,[.ODIDN,,Q$IDENTIFY##]	;IDENTIFY COMMAND
TOPS10<	.KYLOC,,[.ODLOC,,Q$LOCK##]>	;LOCK COMMAND
	.KYMOD,,[.OMMOD,,Q$MODIFY##]	;MODIFY COMMAND
	.KYMTN,,[.ODMTS,,Q$MOUNT##]	;MOUNT COMMAND FOR STRUCTURES
	.KYNXT,,[.OMNXT,,Q$NEXT##]	;[NXT] NEXT COMMAND
	.KYPAU,,[.OMPAU,,Q$STOP##]	;STOP COMMAND
TOPS10<	.KYREC,,[.ODREC,,Q$RECOGNIZE##] >;RECOGNIZE COMMAND
	.KYREL,,[.OMREL,,Q$RELEASE##]	;RELEASE, PROCESSED LIKE HOLD
	.KYREQ,,[.OMREQ,,Q$REQUE##]	;REQUEUE COMMAND
	.KYRPT,,[0,,REPORT]		;REPORT COMMAND
	.KYRTE,,[.OMRTD,,Q$ROUTE##]	;DEVICE ROUTE COMMAND
	.KYRSP,,[.OMRSP,,RESPON]	;RESPOND COMMAND
	.KYSND,,[.OMDSP,,SEND]		;SEND COMMAND
	.KYSET,,[.OMSET,,Q$SET##]	;SET COMMAND
	.KYSHW,,[.OMSHS,,SHOW]		;SHOW COMMAND ..DEFAULT TYPE OF STATUS
	.KYSHD,,[.OMSHT,,Q$SHUTDN##]	;SHUTDOWN COMMAND
	.KYSTA,,[.OMSTA,,Q$START##]	;START COMMAND
	.KYSUP,,[.OMSUP,,Q$SUPPRE##]	;SUPPRESS COMMAND
TOPS20 <.KYSWI,,[.ODSWI,,Q$SWITCH##]>	;SWITCH COMMAND
	.KYTAK,,[0,,TAKCMD]		;TAKE COMMAND
	.KYUDF,,[0,,Q$UNDE##]		;Undefine command
COMLEN==.-COMTAB
SUBTTL	TAKCMD	Setup for a TAKE command

;THIS COMMAND WILL SETUP THE OPR AS IN A TAKE COMMAND
;BY TURNING ON A FLAG IN THE OPR DATA BASE

TAKCMD:	$CALL	RELPAG			;RETURN THE PAGE
	MOVE	S1,G$OPRA		;GET OPR ADDRESS
	MOVX	S2,OP.TAK		;GET TAKE FLAG
	IORM	S2,OPR.FL(S1)		;SAVE THE FLAG
	$RETT				;AND RETURN


SUBTTL	TAKEND	Reset effects of TAKE command

;THIS ROUTINE WILL CLEAR TAKE FILE FLAGS IN OPR DATA BASE

TAKEND:	MOVE	S1,G$SND		;GET THE SENDER
	$CALL	VALOPR			;VALIDATE THE OPERATOR
	JUMPF	E$ONS			;OPR NOT SETUP
	MOVEM	S2,G$OPRA		;SAVE OPR ADDRESS
	MOVX	S1,OP.TAK!OP.ABT	;GET TAKE FLAG
	ANDCAM	S1,OPR.FL(S2)		;CLEAR THE FLAG
	$RETT				;RETURN

SUBTTL	TAKABT	Abort current TAKE command

;THIS ROUTINE WILL GENERATE ERROR FOR TAKE FILE ABORT
;WHERE G$ARG1 ALREADY CONTAINS THE ADDRESS OF THE STRING
;FOR THE ERROR MESSAGE

TAKABT:	MOVE	S2,G$OPRA		;GET OPR ADDRESS
	MOVE	S1,OPR.FL(S2)		;GET THE FLAGS
	TXNN	S1,OP.TAK		;WAS IT A TAKE COMMAND
	PJRST	E$IAP			;INVALID PROCESS..NOT RUNNING
	TXOE	S1,OP.ABT		;WAS ABORT SET
	$RETT				;YES...JUST RETURN
	MOVEM	S1,OPR.FL(S2)		;RESET THE FLAGS
	MOVE	S1,COM.CM(MI)		;GET OFFSET FOR TEXT
	ADDI	S1,ARG.DA(MI)		;POINTER TO TEXT
	MOVEM	S1,G$ARG2		;SAVE THE ADDRESS
	MOVE	S2,S1			;GET THE ADDRESS
	HRLI	S2,(POINT 7,0)		;MAKE A POINTER
TAKA.1:	ILDB	S1,S2			;GET A BYTE
	JUMPE	S1,TAKA.2		;NULL EXIT
	CAIE	S1,.CHCRT		;IS IT A CARRIAGE RETURN
	JRST	TAKA.1			;TRY NEXT ONE
	SETZ	S1,0			;MAKE A NULL
	DPB	S1,S2			;REPLACE WITH A NULL
TAKA.2:	PJRST	E$TAB			;TAKE ABORT
SUBTTL	GETPAG	Setup MO with address of output message

;THIS ROUTINE WILL GET A PAGE ADDRESS SETUP IN MO BY GETTING A NEW PAGE.

GETPAG:: $CALL	M%GPAG			;GET A PAGE
	MOVE	MO,S1			;SAVE ADDRESS IN MO
	$RETT				;RETURN TRUE





SUBTTL	RELPAG	Release output page

;SETS UP SAVED WORD G$OUTP WITH ADDRESS OF PAGE

RELPAG:: MOVE	S1,MO			;get the current page pointer
	$CALL	M%RPAG			;RELEASE THE PAGE
	SETZM	MO			;clear pointer to minimize confusion
	$RETT				;RETURN TRUE
SUBTTL	ERRALL	Error Message to All


;This routine will Build the ACK for an error and send it to
;all Operators on the system


ERRALL:: LOAD	S1,G$JOB		;GET JOB NUMBER
	$CALL	GETJOB			;GET JOB INFO
	$CALL	BLDACK			;BUILD THE ACK
	SETOM	S1			;SEND TO ALL
	SETZM	G$ERR			;CLEAR ERROR WORD
	SETOM	G$ASND			;FORCE MESSAGE OUT
	PJRST	SNDAOP			;SEND TO ALL OPERATOR
SUBTTL	DISABLE/ENABLE commands

;THE ENABLE AND DISABLE COMMANDS ARE COMPLEMENTS OF EACH OTHER
;FOR ALL ACTIONS

ENABLE:	TDZA	P1,P1			;Clear flag for enable
DISABL:	SETOM	P1			;Set flag for disable
	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..CHECK OTHER OPTIONS
	MOVEI	S2,ENADSP		;ENABLE DISPATCH TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;ERROR..RETURN
	MOVE	S1,G$SND		;GET SENDER'S PID
	PJRST	(S2)			;PROCESS ROUTINE AND RETURN


ENADSP:	$STAB
	.KYAVR,,Q$ETAPE##		;ENABLE AVR
	.KYQUE,,ENAQUE			;ENABLE QUEUE REQUESTS
	.KYLGG,,ENALOG			;ENABLE LOGGING
	.KYOPD,,ENAODP			;ENABLE OUTPUT-DISPLAY
TOPS20<	.KYCLS,,ENACLS>			;ENABLE CLASS SCHEDULER
TOPS20<	.KYRET,,ENARET>			;ENABLE FILE-RETREVIAL WAITS
TOPS10<	.KYASR,,Q$ESTR##>		;ENABLE ASR
	.KYSEM,,ENASEM			;[6002]ENABLE/DISABLE SEMI-OPR
	.KYDCA,,ENADCA			;[6011]E/D DECNET-CONNECTION-ATTEMPTS
	.KYRCF,,ENARCF			;[6011]E/D REPORT-CONNECTION-FAILURES
	.KYLFS,,ENALFS			;[6020]E/D LOGFILES
	.KYLSP,,ENALSP			;[6020]E/D LOGFILES-TO-SPECIFIC-PRINTERS
	.KYUNP,,ENAUNP			;[6021]UNPRIV USERS REMOTE I/O DISPLAY
;**;[6042]At ENADSP:+13L add 1 line  JCR  4/27/90
	.KYBCM,,ENABCW			;[6042]ENABLE BROADCAST-MESSAGES
	$ETAB

ENAQUE:	$CALL	VALOPR			;INSIST ON OPR
	JUMPF	E$IPE			;NOT OPR, QUIT
	MOVE	S1,G$HOST		;Get host node name
	$CALL	OPRENB			;Must be system or host
	$RETIF				;Return on failure
	PJRST	CMDEND			;FINISH COMMAND AND SEND
SUBTTL	ENAODP	ENABLE OUTPUT display command

;**;[6042]At ENAODP:+0L rewrite routine ENAODP  JCR  4/27/90
ENAODP:	$SAVE	<T1,T2>			;[6042]Save some scratch ACs
	$CALL	MTDETM			;[6042]Set up the message type
	$RETIF				;[6042]Illegally formatted message
	MOVEM	S1,CLSTYP		;[6042]Save message class indicator
	$CALL	P$KEYW			;[6042]Get a keyword
	JUMPF	ENAO.1			;[6042]None, assume local node
	CAIE	S1,.KYNOD		;[6042]Is it a node keyword?
	$RETF				;[6042]No, illegally formatted message
	$CALL	P$CURR			;[6042]Pick up current block pointer
	MOVE	S2,PFD.D1(S1)		;[6042]Pick up the node name
	$CALL	P$NEXT			;[6042]Point to the next block
	SKIPA
ENAO.1:	MOVE	S2,G$HOST		;[6042]Pick up the local node name
	MOVEM	S2,G$ARG1		;[6042]Save the node name
	$CALL	P$CFM			;[6042]Check for confirm
	$RETIF				;[6042]Illegally formatted message

	MOVE	S1,G$ARG1		;[6042]Pick up the node name
	CAMN	S1,[-1]			;[6042]For all nodes?
	JRST	ENAO.2			;[6042]Yes, do differently
	MOVE	S2,G$OPRA		;[6042]Pick up OPR base address
	MOVEI	S2,OPR.MH(S2)		;[6042]Pick up msg display queue hdr adr
	$CALL	UPDENT			;[6042]Update the queue entry
	PJRST	E$ODM			;[6042]Return to the caller

ENAO.2:	MOVEI	S1,CNFSIZ		;[6042]Size of CNFIG% block 
	MOVEM 	S1,NAMBLK+.CFNND 	;[6042]Store it in the argument block
	MOVEI 	S1,.CFCND		;[6042]Pick up the function code
	MOVEI	S2,NAMBLK		;[6042]Pick up the argument block adr
	CNFIG%				;[6042]Pick up the node names
	 ERJMP	S..CCN			;[6042]Shouldn't fail
	HLRZ	T1,NAMBLK+.CFNND	;[6042]Pick up the number of nodes

	MOVEI	T2,.CFBP1-1		;[6042]Pick up node name offset-1
ENAO.3:	AOS	T2			;[6042]Pick up remote node name offset
	MOVE	S1,NAMBLK(T2)		;[6042]Pick up the ASCIZ name pointer
	$CALL	S%SIXB			;[6042]Convert to SIXBIT
	MOVE	S1,S2			;[6042]Place node name where expected
	MOVE	S2,G$OPRA		;[6042]Pick up OPR base address
	MOVEI	S2,OPR.MH(S2)		;[6042]Pick up msg display queue hdr adr
	$CALL	UPDENT			;[6042]Update the queue entry 
	SOJG	T1,ENAO.3		;[6042]Get the next remote node name
	PJRST	E$ODM			;[6042]Return to the caller

;**;[6042]At ENAO.3:+8L add routines  ENABCW, MTDETM, UPDENT, MTQFND, MTQCRE,
;**;[6042] UPDOMG and UPDNMG  JCR  4/27/90
SUBTTL	ENABCW - ENABLE BROADCAST-MESSAGES Command

ENABCW:	$SAVE	<T1,T2>			;[6042]Save some scratch ACs
	$CALL	MTDETM			;[6042]Set up the message type
	$RETIF				;[6042]Illegally formatted message
	MOVEM	S1,CLSTYP		;[6042]Save message class indicator
	$CALL	P$KEYW			;[6042]Get a keyword
	$RETIF				;[6042]Illegally formatted message
	CAIE	S1,.KYNOD		;[6042]Is it a node keyword?
	$RETF				;[6042]No, illegally formatted message
	$CALL	P$CURR			;[6042]Pick up current block pointer
	MOVE	S2,PFD.D1(S1)		;[6042]Pick up the node name
	MOVEM	S2,G$ARG1		;[6042]Save the node name
	$CALL	P$NEXT			;[6042]Point to the next block

	$CALL	P$SWIT			;[6042]Is there a /CLUSTER-NODE switch?
	JUMPF	ENAB.1			;[6042]No, process locally
	$CALL	CHCLUN			;[6042]Pick up the /CLUSTER-NODE value
	$RETIF				;[6042]Illegally formatted message
	SKIPN	S1,G$CLUN		;[6042]Local node specified?
	JRST	ENAB.1			;[6042]Yes, so ignore the switch
	CAME	S1,[-1]			;[6042]All nodes?
	JRST	ENAB.6			;[6042]No, send remotely
	MOVE	S1,G$ARG1		;[6042]Pick up the node name
	CAME	S1,G$HOST		;[6042]Local node specified?
	JRST	ENAB.2			;[6042]No, check for all nodes
	$CALL	E$IND			;[6042]Yes, indicate an error
	JRST	ENAB.3			;[6042]Continue on

ENAB.1::MOVE	S1,G$ARG1		;[6042]Pick up the node name
	CAMN	S1,G$HOST		;[6042]Local node specified?
	PJRST	E$IND			;[6042]Yes, that's an error
ENAB.2:	CAMN	S1,[-1]			;[6042]All nodes?
	JRST	ENAB.3			;[6042]Yes, treat differently
	MOVEI	S2,BWLIST		;[6042]Pick up the queue header address
	$CALL	UPDENT			;[6042]Update the queue entry
	JRST	ENAB.5			;[6042]Check if need to send remotely

ENAB.3:	MOVEI	S1,CNFSIZ		;[6042]Size of CNFIG% block 
	MOVEM 	S1,NAMBLK+.CFNND 	;[6042]Store it in the argument block
	MOVEI 	S1,.CFCND		;[6042]Pick up the function code
	MOVEI	S2,NAMBLK		;[6042]Pick up the argument block adr
	CNFIG%				;[6042]Pick up the node names
	 ERJMP	S..CCN			;[6042]Shouldn't fail
	HLRZ	T1,NAMBLK+.CFNND	;[6042]Pick up the number of nodes
	SOSG	T1			;[6042]Ignore the local node
	PJRST	E$NRN			;[6042]Quit if no reachable nodes

	MOVEI	T2,.CFBP1		;[6042]Pick up (local) node name offset
ENAB.4:	AOS	T2			;[6042]Pick up remote node name offset
	MOVE	S1,NAMBLK(T2)		;[6042]Pick up the ASCIZ name pointer
	$CALL	S%SIXB			;[6042]Convert to SIXBIT
	MOVE	S1,S2			;[6042]Place node name where expected
	MOVEI	S2,BWLIST		;[6042]Pick up the queue header address
	$CALL	UPDENT			;[6042]Update the queue entry 
	SOJG	T1,ENAB.4		;[6042]Get the next remote node name

ENAB.5:	SKIPN	G$CLUN			;[6042]Send remotely?
	PJRST	E$BMD			;[6042]No, indicate display modified

ENAB.6:	MOVEI	S1,NEB%MS!.OMEBM	;[6042]Assume enable
	SKIPE	P1			;[6042]Skip if enable
	MOVEI	S1,NEB%MS!.OMDBM	;[6042]Message is disable
	HRLI	S1,.OHDRS+.BMLEN+.NDESZ	;[6042]Pick up the message size
	MOVEM	S1,.MSTYP(MO)		;[6042]Place in the message
	AOS	.OARGC(MO)		;[6042]Set the argument count to one

	MOVEI	S1,.BMPAR		;[6042]Pick up the block type
	HRLI	S1,.BMLEN		;[6042]Pick up the block length
	MOVEM	S1,ARG.HD(P3)		;[6042]Place in the message
	MOVE	S1,G$ARG1		;[6042]Pick up the node name
	MOVEM	S1,BMC.ND(P3)		;[6042]Place in the message
	MOVE	S1,CLSTYP		;[6042]Pick up the message class type
	MOVEI	S2,.BMOTM		;[6042]Assume object type message
	CAIE	S1,MSGARG		;[6042]Is it?
	MOVEI	S2,.BMNTM		;[6042]No, non-object type message
	MOVEM	S2,BMC.CL(P3)		;[6042]Place type in the message
	DMOVE	T1,MSGARG		;[6042]Assume object type message
	CAIE	S1,MSGARG		;[6042]Is it?
	DMOVE	T1,DISARG		;[6042]No, non-object type message
	DMOVEM	T1,BMC.A1(P3)		;[6042]Place in the message
	ADDI	P3,.BMLEN		;[6042]Point to the next argument block
	$CALL	FASNEB			;[6042]Send the message to NEBULA
	MOVE	S1,G$CLUN		;[6042]Pick up the node name
	CAMN	S1,[-1]			;[6042]For all nodes?
	$CALL	E$BMD			;[6042]Yes, indicate display modified	
	$RET				;[6042]Return to the caller
SUBTTL	MTDETM - Determine the Message Type

;[6042]MTDETM is called to determine the WTO message types that are
;[6042]to be enabled or disabled for operator displays and for broadcasting
;[6042]
;[6042]Call is:       MI/Command Message from an operator
;[6042]Returns true:  S1/Pointer to message class:
;[6042]		        MSGARG - message associated with a GALAXY object
;[6042]		        DISARG - message not associated with a GALAXY object
;[6042]Returns false: Illegally formatted message

MTDETM:	$CALL	P$KEYW			;[6042]Get a keyword
	$RETIF				;[6042]Illegally formatted message

	MOVEI	S2,DSPTYP		;[6042]Get address of table
	$CALL	TABSRC			;[6042]Search for the keyword
	JUMPT	MTDE.3			;[6042]Not object, go check keywords
	$SAVE	<P1,P2>			;[6042]Save some scratch ACs
	MOVE	P2,S1			;[6042]Save the keyword type
	SETZ	P1,			;[6042]No switches seen

MTDE.1:	$CALL	P$SWIT			;[6042]Check for a switch
	JUMPF	MTDE.2			;[6042]Finished on last switch
	CAIN	S1,.SWJOB		;[6042]Is it job messages
	IORX	P1,WO.JOB		;[6042]Yes
	CAIN	S1,.SWOAM		;[6042]Operator action messages?
	IORX	P1,WO.OAC		;[6042]Yes
	CAIN	S1,.SWOTH		;[6042]Was it other?
	IORX	P1,WO.EVM		;[6042]Yes
	JRST	MTDE.1			;[6042]Try for another switch

MTDE.2:	CAIN	P1,0			;[6042]Any switches seen?
	MOVX	P1,WO.ALL		;[6042]No, setup all
	DMOVEM	P1,MSGARG		;[6042]Save for later
	MOVEI	S1,MSGARG		;[6042]Indicate the message class type
	$RETT				;[6042]Indicate success

MTDE.3:	MOVE	S1,S2			;[6042]Get the value
	$CALL	MAPBIT			;[6042]Map it to a bit
	DMOVEM	S1,DISARG		;[6042]Save for later
	MOVEI	S1,DISARG		;[6042]Indicate the message class type
	$RETT				;[6042]Indicate success

DSPTYP:	$STAB
	.KYCHK,,.QBCHK			;[6042]BUGCHK type of message
	.KYINF,,.QBINF			;[6042]BUGINF type of message
	.KYEVT,,.QBEVT			;[6042]DECNET EVENT type of message
	.KYDLK,,.QBDLK			;[6042]DECNET LINK type of message
	.KYSYM,,.QBSYS			;[6042]General system message
	$ETAB
SUBTTL	UPDENT - Update Message Type Entry

;[6042]UPDENT is called to update the enable/disable displays of a 
;[6042]message type entry.
;[6042]
;[6042]Call is:       S1/SIXBIT node name
;[6042]               S2/Message type display queue header
;[6042]               CLSTYP/Argument block address
;[6042]Returns true:  Message type queue entry updated
;[6042]Returns false: Illegally formatted message

UPDENT:	$SAVE	<P2>			;[6042]Save a scratch AC
	MOVE	P2,S2			;[6042]Save the queue header address
	$CALL	MTQFND			;[6042]Find the queue entry
	JUMPT	UPDE.1			;[6042]Found the entry
	MOVE	S2,P2			;[6042]Pick up the queue header address
	$CALL	MTQCRE			;[6042]Create an entry
UPDE.1:	MOVE	S2,CLSTYP		;[6042]Pick up argument block address
	CAIE	S2,MSGARG		;[6042]Object message update?
	JRST	UPDE.2			;[6042]No, then non-object msg update
	$CALL	UPDOMG			;[6042]Update the queue entry
	$RET				;[6042]Preserve the return indicator
UPDE.2:	$CALL	UPDNMG			;[6042]Update the queue entry
	$RETT				;[6042]Indicate success
SUBTTL	MTQFND	Find an Entry in a Message Type Queue

;[6042]MTQFND finds an entry in a message type queue
;[6042]
;[6042]Call is:       S1/SIXBIT node name
;[6042]		     S2/Queue header address
;[6042]Returns true:  S1/Queue entry address
;[6042]Returns false: S1/SIXBIT node name

MTQFND:	LOAD	S2,OPR.HD(S2),OPR.PT	;[6042]Pick up next entry address
	JUMPE	S2,.RETF		;[6042]Indicate entry not present
	CAME	S1,OPR.NN(S2)		;[6042]Is this the entry?
	JRST	MTQFND			;[6042]No, check the next entry
	MOVE	S1,S2			;[6042]Place address in expected place
	$RETT				;[6042]Indicate success
SUBTTL	MTQCRE	Create a Message Type Queue Entry

;[6042]MTQCRE is called to create a message type queue entry and link
;[6042]the entry into the indicated message type queue. The queue entries
;[6042]are ordered alphanumerically with the restriction that the queue
;[6042]entry corresponding to the local node is always the first entry.
;[6042]The queue entry is initialized to DISABLE ALL-MESSAGES.
;[6042]MTQCRE assumes that the queue entry does not exist.
;[6042]
;[6042]Call is: S1/SIXBIT node name
;[6042]         S2/Message type queue header address
;[6042]Returns: S1/Message type queue entry address
;[6042]	       Number of queue entries in the message type queue is
;[6042]         incremented by one.

MTQCRE:	$CALL	.SAVET			;[6042]Save some scratch ACs
	DMOVE	T1,S1			;[6042]Save node name and queue header
	MOVEI	S1,OPR.SI		;[6042]Size of block wanted
	$CALL	M%GMEM			;[6042]Pick up the block
	MOVEM	T1,OPR.NN(S2)		;[6042]Place the node name in entry

	LOAD	S1,OPR.HD(T2),OPR.PT	;[6042]Pick up first entry address
	MOVE	T3,T2			;[6042]Remember previous entry address

MTQC.1:	JUMPE	S1,MTQC.2		;[6042]Add now if no more entries
	CAMG	T1,OPR.NN(S1)		;[6042]Greater than current entry?
	JRST	MTQC.2			;[6042]No, insert entry 
	MOVE	T3,S1			;[6042]Remember this entry address
	LOAD	S1,OPR.HD(S1),OPR.PT	;[6042]Get the next entry
	JRST	MTQC.1			;[6042]Yes, check the next one

MTQC.2:	LOAD	S1,OPR.HD(T3),OPR.PT	;[6042]Get prev entry forward pointer
	STORE	S1,OPR.HD(S2),OPR.PT	;[6042]Save in the new entry
	STORE	S2,OPR.HD(T3),OPR.PT	;[6042]Save new entry adr in prev entry

	MOVSI	S1,1			;[6042]One new entry
	ADDM	S1,OPR.HD(T2)		;[6042]Increment entry count
	MOVE	S1,S2			;[6042]Place entry adr in expected place
	$RETT				;[6042]Return to the caller
SUBTTL	MTQDES	Destroy a Message Type Queue Entry

;[6042]MTQDES is called to destroy an OPR message type queue as part of
;[6042]deleting an OPR.
;[6042]Call is: S1/Message type queue header address
;[6042]Returns: The message type queue has been destroyed

MTQDES:	$SAVE	<P1>			;[6042]Save a scratch AC
	LOAD	P1,0(S1),OPR.PT		;[6042]Pick up the first entry address
MTQD.1:	JUMPE	P1,.POPJ		;[6042]Quit when finished
	MOVE	S2,P1			;[6042]Place address where expected
	MOVEI	S1,OPR.SI		;[6042]Pick up entry size
	LOAD	P1,0(P1),OPR.PT		;[6042]Pick up the next address
	$CALL	M%RMEM			;[6042]Release the entry
	JRST	MTQD.1			;[6042]Check for another entry
SUBTTL	UPDOMG - Update Object Type Message Displays

;[6042]UPDOMG is called to update object type message displays
;[6042]
;[6042]Call is: S1/Entry Address
;[6042]         S2/Argument block address
;[6042]         P1/Enable/Disable flag
;[6042]Returns: The entry has been updated

UPDOMG:	$CALL	.SAVET			;[6042]Save some scratch ACs
	MOVE	T4,S1			;[6042]Save the entry address
	DMOVE	T2,0(S2)		;[6042]Save switch/message types
	CAIE	T3,.KYALM		;[6042]Want all message types?
	JRST	UPDO.2			;[6042]No, process a single msg type
	MOVSI	T3,-<.OTMAX+NUMAPL+1>	;[6042]Yes, do for all types
	MOVSI	S1,-.OPDMX		;[6042]Get number of words to change
	HRR	S1,T4			;[6042]Pick up the entry address
UPDO.1:	SETOM	OPR.DP(S1)		;[6042]Default to enable all
	SKIPE	P1			;[6042]Test to set or clear
	SETZM	OPR.DP(S1)		;[6042]Disable - clear
	AOBJN	S1,UPDO.1		;[6042]Go back for more

UPDO.2:	HRRZ	S1,T3			;[6042]Get keyword type
	MOVE	S2,T2			;[6042]Get flags to set or clear
UPDO.3:	SKIPN	P1			;[6042]Want to Enable
	$CALL	SETODP			;[6042]Yes, do it
	SKIPE	P1			;[6042]No, want to disable?
	$CALL	CLRODP			;[6042]Yes,  do it
	$RETIF				;[6042]Return on failure
	AOBJN	T3,UPDO.2		;[6042]Repeat for all types
	$RET				;[6042]Return to the caller
SUBTTL	UPDNMG - Update Non-object Type Message Displays

;[6042]UPDNMG is called to update non-object type message displays
;[6042]
;[6042]Call is: S1/Entry Address
;[6042]         S2/Argument block address
;[6042]         P1/Enable/Disable flag
;[6042]Returns: The entry has been updated

UPDNMG:	$SAVE	<P2,P3>			;[6042]Save some scratch ACs
	DMOVE	P2,0(S2)		;[6042]Pick up word number/bit number

	ADD	P2,S1			;[6042]Add the entry base address
	MOVE	S1,OPR.DP(P2)		;[6042]Get the word to be changed
	SKIPE	P1			;[6042]Test to set or clear
	TDZA	S1,P3			;[6042]Disable - clear
	TDO	S1,P3			;[6042]Enable - set
	MOVEM	S1,OPR.DP(P2)		;[6042]Return the value
	$RET				;[6042]Return to the caller

SUBTTL	MAPBIT	MAP BIT based on value

;  This routine, given a value returns the word and bit number for that
;  value, where the value 1 maps to bit 0 and value 37 maps to bit 0
;  word 1.

;  Accepts	S1 / Value (assumed to be positive, non-zero number)

;  Returns	S1 / Word number
;		S2 / Bit mask (one bit set)

;  Uses T1

MAPBIT:	SUBI	S1,1			;Adjust to start with 0 for word count
	IDIVI	S1,^D36			;Get word count and remainder
	MOVN	T1,S2			;Set up rotation value
	HRLZI	S2,400000		;Get a bit
	ROT	S2,(T1)			;Rotate
	$RET
;SETODP	Set flags to ENABLE output display
;CLRODP Clear flags to DISABLE output display

;Accepts	S1/ Object type
;		S2/ Flags
;**;[6042]At SETODP:-1L add 1 line  JCR  4/27/90
;		T4/Entry address	;[6042]

SETODP:	MOVE	TF,[IORM T1,OPR.OF(S1)]	;Set the flags
	SKIPA
CLRODP:	MOVE	TF,[ANDCAM T1,OPR.OF(S1)] ;Clear the flags
;**;[6042]At CLRODP:+1L add 1 line  JCR  4/27/90
	$SAVE	<T1>			;[6042]Save a scratch AC
	MOVE	T1,S2			;Save the flags
	CAILE	S1,APLBEG		;Application object type?
	SUBI	S1,APLBEG-.OTMAX	;Yes..compute object offset
	CAIL	S1,.KYUSR		;Check range
	CAILE	S1,NUMAPL+.OTMAX
	PJRST	E$IFC			;Bad command message
	IDIVI	S1,<^D36/<WID(WO.ALL)>>	;Compute word offset
	IMULI	S2,<WID(WO.ALL)>	;Compute bit offset
	MOVNS	S2			;Force shift right
	LSH	T1,0(S2)		;Position the mask
;**;[6042]At CLRODP:+11L change 1 line  JCR  4/27/90
	ADDI	S1,0(T4)		;Add base entry address
	XCT	TF			;Set/Clear the flag
	$RETT				;Return to caller
SUBTTL	ENALOG	ENABLE/DISABLE LOG command

;THIS ROUTINE WILL EITHER OPEN OR CLOSE THE LOG FILE WHERE POSSIBLE
;ELSE GENERATE AN ERROR

ENALOG:	MOVX	S1,FWMASK		;POINT TO ALL NODES
	$CALL	OPRENB			;MUST BE SYSTEM
	$RETIF
;**;[6040]At ENALOG:+3L replace 15 lines with 37 lines  JCR  2/22/90
	$CALL	P$SWIT			;[6040]Is there a switch?
	JUMPF	ENAL.0			;[6040]No, check for a confirm
	$CALL	CHCLUN			;[6040]CLUSTER-NODE: switch?
	$RETIF				;[6040]Illegally formatted message
ENAL.0:	$CALL	P$CFM			;[6040]Confirm?
	$RETIF				;[6040]Illegally formatted message
	SKIPN	S1,G$CLUN		;[6040]Local node specified?
	JRST	ENAL.1			;[6040]Yes, check for disable
	CAME	S1,[-1]			;[6040]All nodes?
	JRST	ENAL.6			;[6040]No, send to NEBULA
ENAL.1:	$CALL	RELPAG			;[6040]In case of an L$xxx routine error
	SKIPN	P1			;[6040]Disabling?
	JRST	ENAL.2			;[6040]No, go ENABLE LOG
	$CALL	L$REL##			;[6040]Release the log file
	JUMPF	ENAL.5			;[6040]Check if need to send remotely
	SETZM	LOGINT##		;[6040]Logging disabled
	$CALL	E$LFC			;[6040]Set log file closed
	JRST	ENAL.4			;[6040]Tell the local operators
ENAL.2:	SETOM	LOGINT##		;[6040]Assume success
	$CALL	L$OPNL##		;[6040]Open the log file
	JUMPT	ENAL.3			;[6040]Go tell the operators
	SKIPN	LOGOPN##		;[6040]Log file already open?
	SETZM	LOGINT##		;[6040]No, so couldn't open it
	JRST	ENAL.5			;[6040]Check if need to send to NEBULA
ENAL.3:	$CALL	E$OLO			;[6040]ORION log file open
ENAL.4:	$CALL	ERRALL			;[6040]Tell all operators what happened
ENAL.5:	SKIPN	G$CLUN			;[6040]Local only?
	$RETT				;[6040]Yes, return to the caller
	$CALL	GETPAG			;[6040]Pick up a page for NEBULA
	MOVEI	P3,.OHDRS(MO)		;[6040]Needed by routine FASNEB
ENAL.6:	MOVEI	S1,NEB%MS!.OMELG	;[6040]Assume enabling
	SKIPE	P1			;[6040]Enabling?
	MOVEI	S1,NEB%MS!.OMDLG	;[6040]No, disabling
	HRLI	S1,.OHDRS+.NDESZ	;[6040]Pick up the message size
	MOVEM	S1,.MSTYP(MO)		;[6040]Place in the message
	$CALL	FASNEB			;[6040]Send the message to NEBULA
	$RET				;[6040]Return to the caller

SUBTTL	CLSLOG	Process the CLOSE LOG command

;THIS ROUTINE WILL PROCESS THE CLOSE COMMAND AND CLOSE THE LOG FILE

CLSLOG:	MOVX	S1,FWMASK		;POINT TO ALL NODES
	$CALL	OPRENB			;MUST BE SYSTEM OPR
	$RETIF
;**;[6036]At CLSLOG:+3L replace 2 lines with 20 lines  JCR  2/1/90
	$CALL	P$NEXT			;[6036]Skip over the LOG keyword
	$CALL	P$SWIT			;[6036]Check for a switch
	JUMPF	CLSL.1			;[6036]None, just close the log file
	$CALL	CHCLUN			;[6036]Check if a /CLUSTER-NODE switch
	$RETIF				;[6036]Illegally formatted message
	SKIPN	G$CLUN			;[6036]Local node specified?
	JRST	CLSL.1			;[6036]Yes, just close the log file
	MOVX	S1,NEB%MS!.OMCLO	;[6036]Pick up the message type
	MOVEM	S1,.MSTYP(MO)		;[6036]Place in the message header
	MOVEI	S1,.OHDRS+.NDESZ	;[6036]Pick up the message length
	HRLM	S1,.MSTYP(MO)		;[6036]Place in the message header	
	MOVE	S1,G$CLUN		;[6036]Pick up the remote node name
	CAMN	S1,[-1]			;[6036]For all nodes?
	$CALL	L$CLOS##		;[6036]Yes, close the local log
	$CALL	FASNEB			;[6036]Send the message to NEBULA
	$RET				;[6036]Return to the caller

CLSL.1:	$CALL	L$CLOS##		;[6036]Close the local log
	$CALL	RELPAG			;[6036]Return the message page
	$RET				;[6036]Return to the caller
SUBTTL	ENACLS	ENABLE CLASS-SCHEDULING commands (TOPS20)


;CLASS SCHEDULER SETTING FOR THE -20

TOPS20<
ENACLS:	MOVX	S1,FWMASK		;POINT TO ALL NODES
	$CALL	OPRENB			;MUST BE SYSTEM
	$RETIF
	SETZM	P2			;SCHEDULER VALUES
ENAC.1:	$CALL	P$CFM			;END OF COMMAND
;**;[6040]At ENAC.1:+1L change 1 line  JCR  2/22/90
	JUMPT	ENAC.4			;[6040]Do the function
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	$RETIF				;ERROR..RETURN
	CAIE	S1,.SWCAS		;WAS IT CLASS ASSIGNMENTS
	JRST	ENAC.2			;NO..TRY WINDFALL
	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	SETZM	T2			;CLEAR INDICATOR WORD
	CAIN	S1,.KYACT		;IS IT BY ACCOUNT?
	MOVX	T2,SK%ACT		;GET THE ACCOUNT FLAG
	IOR	P2,T2			;PLACE VALUES IN P2
	JRST	ENAC.1			;CHECK FOR END
ENAC.2:	CAIE	S1,.SWWFL		;WINDFALL?
;**;[6040]At ENAC.2:+1L change 1 line  JCR  2/22/90
	JRST	ENAC.3			;[6040]Check for a /CLUSTER-NODE switch
	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	SETZM	T2			;CLEAR THE VALUE
	CAIN	S1,.KYWHD		;WAS IT WITHHELD
	MOVX	T2,SK%WDF		;WITHHOLD WINDFALL
	IOR	P2,T2			;PLACE VALUE IN P2
	JRST	ENAC.1			;CHECK FOR THE END
;**;[6040]At ENAC.3:+0L replace 3 lines with 9 lines  JCR  2/22/90
ENAC.3:	$CALL	CHCLUN			;[6040]/CLUSTER-NODE: switch?
	$RETIF				;[6040]Illegally formatted message
ENAC.4:	SKIPE	P1			;[6040]ENABLE command?
	MOVX	P2,SK%STP		;[6040]No, turn off the scheduler
	SKIPN	S1,G$CLUN		;[6040]Local node specified?
	JRST	ENAC.5			;[6040]Yes, treat as local
	CAME	S1,[-1]			;[6040]All nodes specified?
	JRST	ENAC.7			;[6040]No, just send to the remote node
ENAC.5:	MOVX	S1,.SKICS		;[6040]Get the function
	MOVEI	S2,T1			;BLOCK IN T1
	MOVEI	T1,2			;LENGTH OF THE BLOCK
	MOVE	T2,P2			;GET THE DATA
	SKED%				;DO THE FUNCTION
;**;[6040]At ENAC.4:+5L change 1 line  JCR  2/22/90
	  ERJMP	ENAC.6			;[6040]Trap the error
	MOVEI	S1,[ASCIZ/enabled/]	;ENABLED
	SKIPE	P1			;ENABLING?
	MOVEI	S1,[ASCIZ/disabled/]	;DISABLED
	MOVEM	S1,G$ARG1		;SAVE THE ERROR
;**;[6040]At ENAC.4:+11L replace 3 lines with 19 lines JCR  2/22/90
	SKIPN	G$CLUN			;[6040]Local node only?
	PJRST	E$CSE			;[6040]Yes, scheduler enabled/disabled
	$CALL	E$CSE			;[6040]Save for later
	JRST	ENAC.7			;[6040]Send remotely
ENAC.6:	MOVE	S1,[EXP -2]		;[6040]Last -20 error
	MOVEM	S1,G$ARG1		;[6040]Save the argument
	SKIPN	G$CLUN			;[6040]Local node only?
	PJRST	E$CSF			;[6040]Yes, class scheduler error
	$CALL	E$CSF			;[6040]Save for later
ENAC.7:	MOVEI	S1,NEB%MS!.OMECS	;[6040]Assume enabling
	SKIPE	P1			;[6040]Enabling?
	MOVEI	S1,NEB%MS!.OMDCS	;[6040]No, disabling
	HRLI	S1,.OHDRS+2+.NDESZ	;[6040]Message size
	MOVEM	S1,.MSTYP(MO)		;[6040]Place in the message
	MOVEI	S1,.SCBLK		;[6040]Pick up the block type
	MOVE	S2,P2			;[6040]Pick up the block data
	$CALL	MOVAR2			;[6040]Add the block to the message
	$CALL	FASNEB			;[6040]Send the message to NEBULA
	$RET				;[6040]Return to the caller
>;END TOPS20
SUBTTL	ENARET	ENABLE FILE-RETRIEVAL commands (TOPS20)

TOPS20<
ENARET:	MOVE	S1,G$HOST		;GET LOCAL HOST
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVEI	T1,[ASCIZ/enable/]	;GET THE ENABLE
	SKIPE	P1			;ENABLE OR DISABLE?
	MOVEI	T1,[ASCIZ/disable/]	;DISABLING
	MOVEM	T1,G$ARG1		;SAVE THE VALUE
;**;[6040]At ENARET:+7L replace 1 line with 9 lines  JCR  2/22/90
	$CALL	P$SWIT			;[6040]Check for a switch
	JUMPF	ENAR.1			;[6040]Local only
	$CALL	CHCLUN			;[6040]/CLUSTER-NODE: switch?
	$RETIF				;[6040]Illegally formatted message
	SKIPN	S1,G$CLUN		;[6040]Local node specified?
	JRST	ENAR.1			;[6040]Yes, treat as local
	CAME	S1,[-1]			;[6040]All nodes?
	JRST	ENAR.3			;[6040]No, send to NEBULA
ENAR.1:	MOVE	S2,P1			;[6040]Same as ENABLE/DISABLE value
	MOVEI	S1,.SFRTW		;SET FUNCTION CODE
	SMON				;SET THE VALUE
;**;[6040]At ENAR.1:+3L replace 2 lines with 16 lines  JCR  2/22/90
	ERJMP	ENAR.2			;[6040]Trap the error and generate a msg
	SKIPN	G$CLUN			;[6040]Local only?
	PJRST	E$FRW			;[6040]Yes, file retrieval waits modified
	$CALL	E$FRW			;[6040]Save for later
	JRST	ENAR.3			;[6040]Build a message for NEBULA
ENAR.2:	SKIPN	G$CLUN			;[6040]Local only?
	PJRST	E$RWF			;[6040]Yes, indicate to the operator
	$CALL	E$RWF			;[6040]Save for later

ENAR.3:	MOVEI	S1,NEB%MS!.OMEFI	;[6040]Assume enabling
	SKIPE	P1			;[6040]Enabling?
	MOVEI	S1,NEB%MS!.OMDFI	;[6040]No, disabling
	HRLI	S1,.OHDRS+.NDESZ	;[6040]Pick up the message size
	MOVEM	S1,.MSTYP(MO)		;[6040]Place in the message
	$CALL	FASNEB			;[6040]Send the message to NEBULA
	$RET				;[6040]Return to the caller
>;END TOPS20

;**;[6040]At ENAR.3:+9L replace routine ENASEM with routines ENASEM and DELSOP
;**;[6040]  JCR  2/22/90
SUBTTL	ENASEM	ENABLE SEMI-OPR commands 

;[6040]ENASEM sets (ENABLE) or clears (DISABLE) the SEMI-OPR allowed flag
;[6040]G$SEMF. In the case of DISABLE, any existing SEMI-OPRs are
;[6040]deleted.
;[6040]
;[6040]Call is:      MI/ENABLE or DISABLE SEMI-OPR message address
;[6040]              MO/Outgoing IPCF message
;[6040]Returns true: Always

ENASEM:	$CALL	CHKWHL			;[6040]Check for wheel or operator privs
	JUMPF	E$IPE			;[6040]Insufficient privileges
	$CALL	P$SWIT			;[6040]Check for a switch
	JUMPF	ENAS.1			;[6040]Check for a confirm
	$CALL	CHCLUN			;[6040]/CLUSTER-NODE: switch?
	$RETIF				;[6040]Illegally formatted message
ENAS.1:	$CALL	P$CFM			;[6040]Is there a confirm?
	$RETIF				;[6040]No, illegally formatted message
	SKIPN	S1,G$CLUN		;[6040]Local node specified?
	JRST	ENAS.2			;[6040]Yes, treat as local	
	CAME	S1,[-1]			;[6040]All nodes specified?
	JRST	ENAS.4			;[6040]No, send message to NEBULA
ENAS.2:	JUMPN	P1,ENAS.3		;[6040]Go do DISABLE SEMI-OPR command
	MOVEI	T1,[ASCIZ/enable/]	;[6040]Get the ENABLE
	MOVEM	T1,G$ARG1		;[6040]Save the value
	SETZM 	G$SEMF			;[6040]Assume ENABLED
	SKIPN	G$CLUN			;[6040]Need to send remotely?
	PJRST	E$SMO			;[6040]No, tell result of command
	$CALL	E$SMO			;[6040]Save for later
	JRST	ENAS.4			;[6040]Send message to NEBULA

;[6040]Do DISABLE SEMI-OPR command

ENAS.3:	MOVEI	T1,[ASCIZ/disable/]	;[6040]Disabling
	MOVEM	T1,G$ARG1		;[6040]Save the value
	SETOM 	G$SEMF			;[6040]Disable SEMI-OPR flag
	$CALL	E$SMO			;[6040]Tell result of command
	$CALL	DELSOP			;[6040]Delete the SEMI-OPRs
	SKIPN	G$CLUN			;[6040]Need to send remotely?
	$RET				;[6040]No, return now
ENAS.4:	MOVEI	S1,NEB%MS!.OMESO	;[6040]Assume enabling
	SKIPE	P1			;[6040]Enabling?
	MOVEI	S1,NEB%MS!.OMDSO	;[6040]No, disabling
	HRLI	S1,.OHDRS+.NDESZ	;[6040]Pick up the message size
	MOVEM	S1,.MSTYP(MO)		;[6040]Place in the message
	$CALL	FASNEB			;[6040]Send the message to NEBULA
	$RET				;[6040]Return to the caller

	SUBTTL	DELSOP - Delete SEMI-OPRs

;[6040]DELSOP is called as part of processing the DISABLE SEMI-OPR message
;[6040]to delete any existing SEMI-OPRs
;[6040]Call is:      No arguments
;[6040]Returns true: Always

DELSOP::$SAVE	<P1,P2>			;[6040]Save some scratch ACs
	MOVE	S1,G$NODL		;[6040]Get node list number
	$CALL	L%FIRST			;[6040]Get first entry
	$RETIF				;[6040]Quit now if none
	MOVE	P2,S1			;[6040]Save it
DELS.1:	LOAD	S1,NOD.OP(S2)		;[6040]Get OPR list number
	$CALL 	L%FIRST			;[6040]Get the first OPR
	JUMPF	DELS.4			;[6040]None for this node, try next
	MOVE	P1,S1			;[6040]Save the node list number
DELS.2:	MOVE	S1,OPR.FL(S2)		;[6040]Get the flag word
	TXNN	S1,OP.SEM		;[6040]SEMI-OPR?
	JRST	DELS.3			;[6040]No, get next OPR block
	MOVE	S1,OPR.PD(S2)		;[6040]Get PID
	$CALL	DELOPR			;[6040]Delete
DELS.3:	MOVE	S1,P1			;[6040]Copy OPR list 
	$CALL	L%NEXT			;[6040]Get the next 
	JUMPT	DELS.2			;[6040]Loop for all OPRs
DELS.4:	MOVE	S1,P2			;[6040]Get node list number
	$CALL	L%NEXT			;[6040]Get the next node
	JUMPT	DELS.1			;[6040]Go back and delete all SEMI-OPRs
	$RETT				;[6040]Return to the caller
	SUBTTL	ENARCF - REPORT-CONNECTION-FAILURES

ENARCF:	$CALL	CHKWHL			;[6011]IS THE REQUESTOR PRIVILEGED?
	JUMPF	E$IPE			;[6011]NO, REJECT THIS REQUEST
	MOVEI	S1,.NDRCF		;[6011]PICK UP THE MESSAGE CODE
	JRST	DCA.1			;[6011]GO STORE IT IN THE MESSAGE

ENADCA:	$CALL	CHKWHL			;[6011]IS THE REQUESTOR PRIVILEGED?
	JUMPF	E$IPE			;[6011]NO, REJECT THIS REQUEST
	MOVEI	S1,.NDDCA		;[6011]PICK UP THE MESSAGE CODE

DCA.1:	STORE	S1,.MSTYP(MO),MS.TYP	;[6011]PLACE MSG CODE IN THE MESSAGE
	$CALL	P$SWIT			;[6011]IS THERE A SWITCH?
;**;[6041]At DCA.1:+2L replace 13 lines with 24 lines  JCR  3/1/90
	JUMPF	DCA.3			;[6041]No, check for ENABLE or DISABLE
	CAIE	S1,.SWNOD		;[6041]Is this a node switch?
	JRST	DCA.2			;[6041]No, check fo a /CLUSTER-NODE:
	$CALL	P$NODE			;[6041]Pick up the node name
	$RETIF				;[6041]Return on an error
	$CALL	SAVNOD			;[6041]Build the node block
	$CALL	P$SWIT			;[6041]Is there a switch?
	JUMPF	DCA.3			;[6041]No, check for ENABLE or DISABLE
DCA.2:	$CALL	CHCLUN			;[6041]/CLUSTER-NODE: switch
	$RETIF				;[6041]Return on an error
DCA.3:	SETZ	S1,			;[6041]Assume DISABLE
	SKIPN	P1			;[6041]Is it disable?
	MOVX	S1,ND%ENA		;[6041]No, pick up enable bit
	MOVEM	S1,.OFLAG(MO)		;[6041]Place in the flag word
	SKIPE	G$CLUN			;[6041]Remote node specified?
	JRST	DCA.4			;[6041]Yes, finish differently
	ANDI	P3,777			;[6041]The message length
	STORE	P3,.MSTYP(MO),MS.CNT	;[6041]Place in the message
	PJRST	SNDNEB			;[6041]Send the message to NEBULA
DCA.4:	MOVE	S1,P3			;[6041]Pick up the ending address
	ANDI	S1,777			;[6041]The message length
	ADDI	S1,.NDESZ		;[6041]Account the the cluster node blk
	STORE	S1,.MSTYP(MO),MS.CNT	;[6041]Place in the message header
	PJRST	FASNEB			;[6041]Finish the message and send it
	SUBTTL	ENALSP - LOGFILES-TO-SPECIFIC-PRINTERS

ENALSP:	$CALL	CHKWHL			;[6020]IS THE REQUESTOR PRIVILEGED?
	JUMPF	E$IPE			;[6020]NO, REJECT THIS REQUEST
	MOVEI	S1,.OMELP		;[6020]PICK UP THE MESSAGE CODE
	SKIPE	P1			;[6020]IS IT ENABLE?
	MOVEI	S1,.OMDLP		;[6020]NO, PICK UP EXPECTED MESSAGE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;[6020]PLACE MSG CODE IN THE MESSAGE
	PJRST	CMDEND			;[6020]GO SEND THE MESSAGE
SUBTTL	ENALFS - LOGFILES

ENALFS:	$CALL	CHKWHL			;[6020]IS THE REQUESTOR PRIVILEGED?
	JUMPF	E$IPE			;[6020]NO, REJECT THIS REQUEST
	MOVEI	S1,.OMELT		;[6020]PICK UP THE MESSAGE CODE
	SKIPE	P1			;[6020]IS IT ENABLE?
	MOVEI	S1,.OMDLT		;[6020]NO, PICK UP EXPECTED MESSAGE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;[6020]PLACE MSG CODE IN THE MESSAGE

	$CALL	P$NUM			;[6020]GET A NUMBER
;**;[6043]At ENALFS:+7L add two lines  PMM  6/3/90
	CAIN	S1,.AKANM		;[6043]Is it an alias name?
	JRST	ENLF.2			;[6043]Yes process the object block
	$RETIF				;[6020]INDICATE AN ERROR IF NO NUMBER
	TLNE	S1,-1			;[6020]NUMBER FIT IN HALF WORD?
	PJRST	E$IRS			;[6020]NO, INDICATE ILLEGAL RANGE
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.LRG	;[6020]SAVE AS LOW RANGE
	MOVE	P1,S1			;[6020]SAVE THE LOW RANGE
	$CALL	P$TOK			;[6020]CHECK FOR TOKEN AND RANGE
	JUMPF	ENLF.1			;[6020]IF NO TOKEN, PICK UP NODE NAME
	$CALL	P$NUM			;[6020]GET THE OTHER NUMBER
	$RETIF				;[6020]INVALID FIELD, NUMBER NEEDED
	CAML	P1,S1			;[6020]CHECK FOR VALID RANGE
	PJRST	E$IRS			;[6020]UNITS OUT OF RANGE
	TLNE	S1,-1			;[6020]NUMBER FIT IN HALF WORD?
	PJRST	E$IRS			;[6020]NO, INDICATE ILLEGAL RANGE
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.HRG	;[6020]SAVE THE HIGH RANGE
ENLF.1:	MOVE	S1,G$HOST		;[6020]PICK UP THE LOCAL NODE NAME
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;[6020]PLACE IN THE MESSAGE
	MOVEI	S1,.OTLPT		;[6020]PICK UP THE OBJECT TYPE
	MOVEM	S1,ARG.DA+OBJ.TY(P3)	;[6020]PLACE IN THE MESSAGE
	MOVE	S1,[.OBJLN,,.OROBJ]	;[6020]PICK UP HEADER WORD
	MOVEM	S1,ARG.HD(P3)		;[6020]PLACE IN THE DESCRIPTOR BLOCK
	ADDI	P3,.OBJLN		;[6020]INCREMENT THE MESSAGE LENGTH
	AOS	.OARGC(MO)		;[6020]INCREMENT THE ARGUMENT COUNT	
	PJRST	CMDEND			;[6020]SEND THE MESSAGE TO QUASAR
;**[6043]At ENLF.1:+9L add 5 lines  PMM   6/3/90
ENLF.2:	$CALL	LPTTY7			;[6043]Yes, put object block in message
	MOVE	S1,.OHDRS+ARG.DA+OBJ.TY(MO)  ;[6043]Get printer type
	CAIE	S1,.OTLPT		;[6043]Is it a local printer?
	PJRST	E$MBL			;[6043]No, must be a local printer
	PJRST	CMDEND			;[6043]Send the message to QUASAR
	SUBTTL	ENALSP - LOGFILES-TO-SPECIFIC-PRINTERS

ENAUNP:	$CALL	CHKWHL			;[6021]IS THE REQUESTOR PRIVILEGED?
	JUMPF	E$IPE			;[6021]NO, REJECT THIS REQUEST
	MOVEI	S1,.OMEUP		;[6021]PICK UP THE MESSAGE CODE
	SKIPE	P1			;[6021]IS IT ENABLE?
	MOVEI	S1,.OMDUP		;[6021]NO, PICK UP EXPECTED MESSAGE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;[6021]PLACE MSG CODE IN THE MESSAGE
	PJRST	CMDEND			;[6021]GO SEND THE MESSAGE
SUBTTL	NOTIFY	Write message to terminal for quasar

;OUTPUT TO TERMINAL FOR QUASAR

NOTIFY:	$CALL	CHKWHL			;MUST BE WHEEL
	JUMPF	E$NRW			;NOTIFY REQUIRES WHEEL
	MOVEI	S1,.OHDRS(MI)		;SETUP POINTER TO BLOCK
	$CALL	P$SETU			;SETUP THE PARSER POINTER
	MOVX	S1,NT.MLU		;NOTIFY VIA MAIL
	TDNE	S1,.OFLAG(MI)		;IS IT SET?
	JRST	NOTI.1			;YES..DO MAIL
	$CALL	L$NTFY##		;LOG THE NOTIFY
	$CALL	P$NARG			;GET THE NEXT ARGUMENT
	MOVE	P1,S2			;SAVE THE BLOCK ADDRESS
	CAIE	S1,.JOBID		;JOB ID BLOCK
	PJRST	E$IFC			;BAD MESSAGE
	LOAD	S1,JBI.JB(P1)		;GET THE JOB NUMBER
	$CALL	GETUSR			;GET USER INFO
	$RETIF				;NOT THERE..RETURN
	LOAD	S1,JBI.LI(P1)		;GET LOGGED IN TIME
	CAME	S1,JOBJLT		;SAME JOB
	PJRST	E$JDE			;JOB TO NOTIFY NOT THERE
	$CALL	P$NEXT			;GET TO NEXT FIELD
	$CALL	P$TEXT			;TEXT BLOCK
	JUMPF	E$IFC			;BAD MESSAGE
	MOVEI	S2,ARG.DA(S1)		;POINT TO THE DATA
	PUSHJ	P,NOTCHK		;CHECK TO SEE IF USER WANTS MESSAGE
	  SKIPF				;DOESN'T WANT IT
	MOVE	S1,JOBTTY		;GET LINE NUMBER
	$CALL	SNDTTY			;SEND THE MESSAGE
	$RETT				;RETURN
NOTI.1:
TOPS10<
	$RETT				;RETURN FOR NOW
>;END TOPS10
TOPS20<
	$CALL	P$TEXT			;GET THE TEXT
	JUMPF	E$IFC			;ILLEGALLY FORMATTED COMMAND
	HRROI	S2,ARG.DA(S1)		;POINTER TO TEXT
	MOVEM	S2,NFYTXT		;NOTIFY TEXT POINTER
	$CALL	P$DIR			;GET THE DIRECTORY
	JUMPF	E$IFC			;BAD COMMAND
	MOVEM	S1,NFYDIR		;NOTIFY DIRECTORY
	$CALL	P$NFLD			;GET NEXT FIELD DATA
	JUMPF	E$IFC			;SHOULDN'T FAIL
	CAIE	S1,.NTSUB		;IS IT THE SUBJECT
	PJRST	E$IFC			;BAD COMMAND
	HRROI	S1,ARG.DA(S2)		;GET THE DATA POINTER
	MOVEM	S1,NFYSUB		;NOTIFY SUBJECT
	$CALL	MLINIT##		;INIT THE CALL
	MOVEI	S1,NFYDIR		;GET ADDRESS OF BLOCK
	MOVEI	S2,1			;DEC MAIL
	$CALL	MLTOWN##		;MAIL IT
	$CALL	MLDONE##		;FINISHED IT..
	$RETT				;RETURN
>;END TOPS20


; Check to see if a user wants notify junk to come out on his/hers/its TTY
; Call:	PUSHJ	P,NOTCHK
;
; TRUE return:	user wants notify
; FALSE return:	user doesn't want notify
;
NOTCHK:
TOPS10	<				;TOPS-10 ONLY
	MOVN	TF,JOBNUM		;GET NEGATIVE JOB NUMBER
	JOBSTS	TF,			;READ JOB STATUS
	  $RETF				;NOT THERE
	TXNE	TF,JB.UML		;AT MONITOR LEVEL ?
	$RETT				;YES - OK TO SEND
	$SAVE	<T1,T2>			;SAVE SOME ACS
	MOVE	TF,[2,,T1]		;SET UP UUO
	MOVX	T1,.TOSND		;LOAD FUNCTION CODE
	MOVE	T2,JOBTTY		;LOAD TTY NUMBER
	TXO	T2,.UXTRM		;OFFSET BY UNIVERSAL DEVICE INDEX
	TRMOP.	TF,			;READ TTY GAG SETTING
	  MOVEI	TF,.-.			;CAN'T - ASSUME GAGGED
	JUMPE	TF,.RETF		;TTY GAGGED ?
	$RETT				;NO
>					;END OF TOPS-10 CONDITIONAL

TOPS20	<				;TOPS-20 ONLY
	$RETT				;RETURN
>					;END OF TOPS-20 CONDITIONAL
SUBTTL	SEND	Process the SEND command

SEND:	$CALL	P$KEYW			;Get the KEYWORD
	$RETIF				;Return on failure
	MOVEI	S2,SNDDSP		;Point to the possibles
	$CALL	TABSRC			;Find the right one
	$RETIF				;Return on failure
	PJRST	0(S2)			;Dispatch to processor

SNDDSP:	$STAB
	.KYALL,,SNDALL			;SEND ALL
	.KYBAT,,SNDBAT			;SEND BATCH-STREAM
	.KYJOB,,SNDJOB			;SEND JOB
	.KYOPR,,SENDOP			;SEND OPERATOR
	.KYTRM,,SNDTRM			;SEND TERMINAL
	$ETAB

SNDBAT:	$CALL	P$PREV			;Point parse before keyword
	$CALL	BLDOBJ			;Build the object block
	 $RETIF

;**;[6044]At SNDBAT:+3 add 13 lines  JYCW  6/8/90
	SETZM	G$CLUN			;[6044]Clear Cluster node indicator
	$CALL	P$SWIT			;[6044]Is there a switch?
	JUMPF	SNDBA1			;[6044]No, build message
	$CALL	CHCLUN			;[6044]CLUSTER-NODE: switch?
	$RETIF				;[6044]Illegally formatted message
SNDBA1:	$CALL	BLDSND			;[6044]Build the message to send
	$RETIF				;[6044]Return on failure
	MOVX	S1,.OMSND		;[6044]Set the message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6044]STORE IN THE MESSAGE
	SKIPN	S1,G$CLUN		;[6044]Get the node argument
	JRST	SNDQSR			;[6044]Local
	JRST	SNDCLU			;[6044]

;**;[6044]At SNDJOB:+0 rewrite SNDJOB  JYCW  6/8/90
SNDJOB:	$SAVE	<P1>			;[6044]Preserve an AC
	$CALL	P$NUM			;[6044]Get Job number
	$RETIF				;[6044]Return on failures
	MOVEM	S1,JOBNO		;[6044]Save the job #
	$CALL	P$SWIT			;[6044]Is there a switch?
	JUMPF	SNDJO			;[6044]No, must be local
	$CALL	CHCLUN			;[6044]CLUSTER-NODE: switch?
	$RETIF				;[6044]Illegally formatted message
SNDJO:	$CALL	BLDSND			;[6044]Build the message to send
	MOVEI	S2,ARG.DA(S1)		;[6044]Point to message
	MOVEM	S2,SENDMS		;[6044]Save it
	SKIPN	S1,G$CLUN		;[6044]Get the node argument
	JRST	SNDJO1			;[6044]Local 
	MOVEM	S1,G$ARG1		;[6044]Save it for error text

;We have a /CLUSTER-NODE switch.  Find out if it's for all/local/remote
;If it's just for local then jump to SNDJO1.
;If it's just for a remote node then setup S1/SIXBIT node name and call GCNFIG
;to get the CI node number.  Do INFO% to get remote tty number for remote job.
;Jump to SNDJO3 to do TTMSG% for remote send.
;If it's for all then get all the CI node numbers.  Convert each job on a
;particular node to its correpsonding tty number and TTMSG% the message.

	$CALL	GCNFIG			;[6044]Get the CI node numbers
	MOVE	S2,G$CLUN		;[6044]get the switch 
	CAMN	S2,[-1]			;[6044]All nodes?
	IFSKP.				;[6044]No
	  MOVSS	S1			;[6044]CI node number in right half
	  HRLM	S1,JOBNO		;[6044]Save CI node number
	  HRRZ	S2,JOBNO		;[6044]Job number in S2
	  $CALL CGETJI			;[6044]Convert job to tty number
	  JUMPF	E$CSU			;[6044]Yes..Can't send to user
	  HLL	S1,JOBNO		;[6044]Put CI node number in S1
	  TXO	S1,TT%REM		;[6044]Say it's a remote message
	  JRST	SNDJO3			;[6044]Send the message
	ENDIF.
	HLRZ 	T1,NUMBLK+.CFLEN 	;[6044]Get number of words returned
	SOS	T1			;[6044]Don't count the first word
	MOVEI	P1,NUMBLK+1		;[6044]Address of CI node numbers
SNDJON:	HLRZ	S1,(P1)			;[6044]Get the CI number
	HRLM	S1,JOBNO		;[6044]Save CI node number	
	HRRZ	S2,JOBNO		;[6044]Job number in S2
	$CALL 	CGETJI			;[6044]cluster
	JUMPF	SNDJO0			;[6044]An error
	HLL	S1,JOBNO		;[6044]Put CI node number in S1
	TXO	S1,TT%REM		;[6044]Say it's a remote message
	$CALL	SNDJO3			;[6044]Send the message
SNDJO0:	AOS	P1			;[6044]Next Node
	SOJN	T1,SNDJON		;[6044]Send to next Node
	$RETT
SNDJO1::MOVE	S1,JOBNO		;[6044]Restore the job number	
	MOVX	S2,JI.TNO		;[6044]Get terminal number
	$CALL	I%JINF			;[6044]Get the job information
	JUMPF	E$CSU			;[6044]Can't send to user
	CAMN	S2,[EXP -1]		;[6044]Detatched?
	PJRST	E$CSU			;[6044]Yes..Can't send to user
	MOVE	S1,S2			;[6044]TTY in S1
SNDJO3:	MOVE	S2,SENDMS		;[6044]Address of text
	$CALL	SNDTTY			;[6044]Send it off
	JUMPF	E$CSU			;[6044]Can't send to user
	PJRST	E$SCC			;[6044]Say send complete

CGTJSZ==:1				;[6044]Size
CGTJIB:: BLOCK CGTJSZ			;[6044]GETJI Block

;Accepts:  S1/CI node #  S2/Job number
;return S1/TTY number
CGETJI:	MOVEM	S1,INFOBK+.INCID	;[6044]Put CI number in INFO% blk.
	MOVE	S1,[.INGJI,,5]		;[6044]Get function.,,length
	MOVEM	S1,INFOBK+.INFUN	;[6044]Put it in the INFO% blk.
	MOVEM	S2,INFOBK+.INAC1	;[6044]Put Job number into INFO% blk.
	MOVE	S1,[-1,,CGTJIB]		;[6044]GETJI arg block
	MOVEM	S1,INFOBK+.INAC2	;[6044]Put it in the INFO% blk.
	MOVEI	S1,.JITNO		;[6044]Offset into tty
	MOVEM	S1,INFOBK+.INAC3	;[6044]Put it in the INFO% blk.
	MOVEI	S1,INFOBK		;[6044]Address of INFO% block
	INFO%				;[6044]Get it from INFO%
	 ERJMP	.RETF			;[6044]Error
	TXNE	S1,IN%RER		;[6044]Any remote errors?
	PJRST	E$CSU			;[6044]Can't send to this job
	MOVE	S1,CGTJIB		;[6044]Get the remote tty number
	CAMN	S1,[EXP -1]		;[6044]Detatched?
	PJRST	E$CSU			;[6044]Yes..Can't send to user
	$RETT
;**;[6044]At SNDTRM rewrite SNDTRM  JYCW  6/8/90

SNDTRM:	$CALL	P$NUM			;[6044]Get Terminal number
	$RETIF				;[6044]Return on failure
	$SAVE	<P1>			;[6044]Preserve an AC
	MOVE	P1,S1			;[6044]Save the number
	$CALL	P$SWIT			;[6044]Is there a switch?
	JUMPF	SNDTR1			;[6044]No, must be local
	$CALL	CHCLUN			;[6044]CLUSTER-NODE: switch?
	$RETIF				;[6044]Illegally formatted message
	MOVE	S1,G$CLUN		;[6044]Get the node argument
	MOVEM	S1,G$ARG1		;[6044]Save it for error text
SNDTR1:	$CALL	BLDSND			;[6044]Build the message to send
	MOVEI	S2,ARG.DA(S1)		;[6044]Point to message
	SKIPN	S1,G$CLUN		;[6044]Local
	JRST	SNDTR2			;[6044]Yes
	CAMN	S1,[-1]			;[6044]All
	IFSKP.				;[6044]no
	  PUSH P,S2			;[6044]Save text address
	  $CALL	GCNFIG			;[6044]No, get the CI number
	  POP	P,S2			;[6044]Restore the text address	
	  JUMPF	.RETF			;[6044]Had an error
	  TXO	S1,TT%REM		;[6044]Set remote TTMSG
	ELSE.				;[6044]
	  MOVX	S1,TT%REM!.CSALL	;[6044]Set remote TTMSG
	ENDIF.				;[6044]

SNDTR2:	HRR	S1,P1			;Restore terminal numbre
	$CALL	SNDTTY			;Send it off
	JUMPF	E$CSU			;Can't send to user
	PJRST	E$SCC			;Say send complete
SUBTTL	SNDALL	Process SEND ALL command

SNDALL:	$SAVE	<P1>			;Preserve an AC
	$CALL	DEFNOD			;Get default node for OPR
	MOVE	P1,S1			;Store in P1
SNDAL1:	$CALL	P$SWITCH		;Check for switches
	JUMPF	SNDAL2			;None there..use default
	$CALL	CHCLUN			;[6007]Is it a /CLUSTER-NODE
	JUMPF	.RETF			;[6007]No, bad message
	MOVE	S1,G$CLUN		;[6007]Get the node argument
	MOVEM	S1,G$ARG1		;[6007]Save it for error text
SNDAL2:	$CALL	OPRENB			;Check the privs
	$RETIF				;Return on failure
	$CALL	BLDALL			;Build the message
	$RETIF				;Return on failure
	$CALL	SNDALX			;Do the send
	$CALL	RELPAG			;Release the page
	PJRST	E$SCC			;Ack the operator


SUBTTL	DEFNOD	Routine to return default node for OPR

;DEFNOD return the default node to associate with this OPR.
;If the OPR has system privs the default is All nodes [-1]
;else the physically located node is the default

;Accepts	G$OPRA setup from received message

;Returns	S1/ Physically located node or [-1] for all


DEFNOD:	MOVE	S1,G$OPRA		;Get OPR address
	$CALL	O$SYSTEM		;System OPR?
	JUMPT	[MOVX	S1,FWMASK	;Yes..default to ALL
		 JRST	DEFND1]		;Go return
	MOVE	S1,G$OPRA		;No..get OPR address
	MOVE	S1,OPR.ND(S1)		;Get Node data address
	MOVE	S1,NOD.NM(S1)		;Get OPR's default
DEFND1:	$RET
SUBTTL	TTYNOD	Check for terminals on node

;  This routine checks for any terminals on a node specified.

;  For TOPS-10, it checks for any terminals on the node.
;  For TOPS-20, it checks that the node specified is the host
;  node since there is no terminal concentration currently.

;  Calls:	None
;  Needs:	None
;  Uses:	T regs.  (TOPS-10 only)
;  Args:	S1 / Node name/number
;  Returns:	True if terminals exist, false otherwise.

TTYNOD:
TOPS10<

;  Need to set up an argument block for NODE. uuo using the T registers

	MOVEI	T1,4			;Length of argument block
	MOVE	T2,S1			;Get the node name
	SETZM	T3			;For no good reason, this MUST be 0!
	HRRZI	T4,.TYTTY		;Check for terminal lines
	MOVE	S1,[XWD .NDRCI,T1]	;Set it up
	NODE.	S1,			;Try it out
	  $RETF				;Someone's lying
	HLRZ	S1,T4			;Get the number of terminals
	SKIPLE	S1			;Do we have any?
	$RETT				;Yes
	$RETF				;No
> ; End of TOPS10

TOPS20<
	CAME	S1,G$HOST		;Only allow the system name as node
	$RETF				;Confused operator
	$RETT
> ; End of TOPS20
SUBTTL	SENDOP	Send to operator command

;THIS ROUTINE WILL BUILD AND QUEUE UP A MESSAGE TO OPRS
;BASED ON THE SEND COMMAND
;**:[6044]Rewrite SENDOP  JYCW  6/8/90
SENDOP:	SETOM	G$ASND			;FORCE MESSAGE TO OPRS
	SETZ P2,			;[6044]No /NODE yet
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	SENO.0			;[6044]No switch

	CAIN	S1,.SWNOD		;[6044]WAS IT A NODE
	IFSKP.				;[6044]No,
	  $CALL	CHCLUN			;[6044]Check for /CLUSTER
	  JUMPF	.RETF			;[6044]No, bad message
	  SKIPN	S1,G$CLUN		;[6044]Get the /Cluster argument
	  IFSKP.
	    MOVEM S1,G$ARG1		;[6044]Save it for error text
	    JRST  SENOCL		;[6044]Send it to NEBULA
	  ELSE.				;[6044]Local
	    JRST SENO.0			;[6044]Do it as if it was local
	  ENDIF.
	ELSE.				;[6044]We have a /NODE switch
	  $CALL	P$NODE			;[6044]GET THE NODE
	  $RETIF			;[6044]ERROR ..RETURN
	  MOVE	P2,S1			;[6044]SAVE THE NODE VALUE
	  MOVEM	P2,G$ARG1		;[6044]SAVE THE NODE NAME
	  $CALL	P$SWIT			;[6044]Check for a switch	  
	  JUMPF SENO.2			;[6044]No switch
	  $CALL CHCLUN			;[6044]/CLuster-Node ?
	  JUMPF	.RETF			;[6044]No, bad message
	  SKIPE	G$CLUN			;[6044]For this node
	  JRST	SENOCL			;[6044]No, Send it to NEBULA
	ENDIF.				;[6044]	

SENO.2: MOVE	S1,P2			;GET NODE NAME
	$CALL	FNDNOD			;FIND THE NODE
	JUMPF	E$NNK			;[6023]THE NODE IS NOT KNOWN
	MOVE	P2,S2			;GET NODE ENTRY ADDRESS
	$CALL	BLDSND			;BUILD THE SEND MESSAGE
	$RETIF				;ERROR..ABORT NOW
	SETOM	NOALTN			;NO ALTERNATE NODES
	MOVE	S1,P2			;GET NODE ENTRY ADDRESS
	$CALL	SNDNAL			;SEND TO ALL OPERATORS NO ALTERNATES
	JUMPF	E$NON			;NO OPERATORS AT NODE AND RETURN
	JRST	SENO.3			;[6044]

;[6044]Add label
;[6044]Local 
SENO.0:	MOVE	S1,G$OPRA		;[6044]GET OPERATOR ADDRESS
	MOVE	S2,OPR.ND(S1)		;GET NODE ADDRESS
	MOVE	P2,NOD.NM(S2)		;GET NODE NAME
	CAME	P2,G$HOST		;IS IT CENTRAL SITE?
	JRST	SENO.2			;NO..USE LOCAL NODE
	$CALL	BLDSND			;BUILD THE SEND
	$RETIF				;ERROR RETURN
	SETOM	S1			;SEND TO ALL OPERATORS
	$CALL	SNDAOP			;SEND TO ALL
SENO.3:	PJRST	E$SCC			;Send command complete and return

;[6044]S1/Cluster-node argumant

SENOCL:	$CALL	BLDSND			;[6044]Build the send
	$RETIF				;[6044]Error return
;**;[6045]At SENOCL+2L add 2 lines  JYCW  6/11/90
	LOAD	P3,.MSTYP(MO),MS.CNT	;[6045]Pick up the message length
	ADD	P3,MO			;[6045]Point to the end of the msg
	MOVE	S1,G$CLUN		;[6044]Get the /Cluster switch
	CAME	S1,[-1]			;[6044]For all nodes?
	IFSKP.				;[6044]Yes,
	  MOVEM MO,SENDMS		;[6044]Save the output page for local
	  $CALL GETPAG			;[6044]Get a new output page for NEBULA
	  MOVE S1,MO			;[6044]Get the destination
	  HRL S1,SENDMS			;[6044]Sources,, destination
	  MOVE S2,SENDMS		;[6044]Get the message address
	  LOAD S2,.MSTYP(S2),MS.CNT	;[6044]Get the length
	  ADD S2,MO			;[6044]Calculate the block length
	  BLT S1,-1(S2)			;[6044]Copy the message
	  EXCH MO,SENDMS		;[6044]Exchange the address
  	  PUSH	P,P2			;[6044]Save the /NODE value 
  	  SKIPE	P2			;[6044]Do we have a /NODE
	  IFSKP.			;[6044]No
	    $CALL SENOC1		;[6044]Send it local 
	  ELSE.				;[6044]Yes
	    $CALL SENOC2		;[6044]Send it remote and the cluster
	  ENDIF.
	  POP P,P2			;[6044]Restore the /NODE value 
	  SKIPE MO			;[6044]Was page release already
	  $CALL	RELPAG			;[6044]No, release page 
	  MOVE MO,SENDMS		;[6044]Get the message address
	  LOAD P3,.MSTYP(MO),MS.CNT	;[6044]Get the length
	  ADD P3,MO			;[6044]Point to end of output message
	ENDIF.
	HRRZ	S1,G$CBLK		;[6044]Node name block
	MOVE	S2,G$CBLK+1		;[6044]Node name
	$CALL	MOVAR2			;[6045]Add it to the message
;**;[6045]At SENOCL+33L add 3 lines  JYCW  6/11/90
	ANDI	P3,777			;[6045]Isolate the message length
	STORE	P3,.MSTYP(MO),MS.CNT	;[6045]Place in the message
	SKIPN	S2,P2			;[6044]Do we have a /NODE?
	IFSKP.				;[6044]Yes
;**;[6045]At SENOCL+37L replace 2 lines with 6 JYCW  6/11/90
	  LOAD	P3,.MSTYP(MO),MS.CNT	;[6045]Pick up the message length
	  ADD	P3,MO			;[6045]Point to the end of the msg
	  MOVX	S1,.ORNOD		;[6044]Node block
	  $CALL	MOVAR2			;[6044]Save it
	  ANDI	P3,777			;[6045]Isolate the message length
	  STORE	P3,.MSTYP(MO),MS.CNT	;[6045]Place in the message
	ENDIF.
	MOVX	S1,.OMSOP+NEB%MS	;[6044]Message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6044]Store it in message
	MOVX	S1,MF.NEB		;[6034]Pick up the remote origin bit
	IORM	S1,.MSFLG(MO)		;[6034]Set in the message
	$CALL	SNDNEB			;[6044]Send it to NEBULA
	SETZM	MO			;[6044]Page should be gone
	PJRST	E$SCC			;Send command complete and return

SENOC1: MOVE	S1,G$OPRA		;[6044]GET OPERATOR ADDRESS
	MOVE	S2,OPR.ND(S1)		;GET NODE ADDRESS
	MOVE	P2,NOD.NM(S2)		;GET NODE NAME
	CAME	P2,G$HOST		;IS IT CENTRAL SITE?
	JRST	SENOC2			;Yes
	SETOM	S1			;SEND TO ALL OPERATORS
	$CALL	SNDAOP			;SEND TO ALL
	$RET

SENOC2: MOVE	S1,P2			;GET NODE NAME
	$CALL	FNDNOD			;FIND THE NODE
	JUMPF	E$NNK			;[6023]THE NODE IS NOT KNOWN
	MOVE	P2,S2			;GET NODE ENTRY ADDRESS
	SETOM	NOALTN			;NO ALTERNATE NODES
	MOVE	S1,P2			;GET NODE ENTRY ADDRESS
	$CALL	SNDNAL			;SEND TO ALL OPERATORS NO ALTERNATES
	JUMPF	E$NON			;NO OPERATORS AT NODE AND RETURN
	$RET
SUBTTL	BLDSND	Build the SEND text

; Here to build the SEND text for all types of sends except TOPS-10
; SEND ALL commands.
;
TOPS20	<BLDALL:>			;TOPS-20 only
BLDSND:	$CALL	BLDINI			;SETUP FOR BUILDING SEND TEXT STRING
	$RETIF				;PROPAGATE ERROR BACK TO CALLER
;[6007]
	$TEXT	(BLDRTN,<^M^J^C/G$NOW/ From operator ^I/(S2)/ on node ^W/G$HOST/::
	=^7/[76]/^T/1(S1)/
^0>)
	JRST	BLDFIN			;FINISH UP

NODTXT:	ITEXT	(<^N/NOD.NM(T1)/>)
TTYTXT:	ITEXT	(<terminal ^O/OPR.TN(T2)/>)


SUBTTL	BLDALL	Build the TOPS-10 SEND ALL text


TOPS10	<				;TOPS-10 only
; Here to build the SEND text for TOPS-10 SEND ALL commands.
;
BLDALL:	$CALL	BLDINI			;Setup text pointers
	$RETIF				;Propagate error back to caller
	$TEXT	(BLDRTN,<^T/1(S1)/>)	;Store the string
	$RETT				;Go finish up
>;END of TOPS-10 conditional


; Setup building of the SEND text string
;
BLDINI:	$CALL	P$TEXT			;GET THE TEXT
	$RETIF				;NO TEXT..RETURN
	HRLI	T1,(POINT 7,0)		;SETUP BYTE POINTER
	HRRI	T1,ARG.DA(P3)		;ADDRESS FOR THE TEXT
	MOVEM	T1,SNDPTR		;SAVE THE SEND BYTE POINTER
	MOVE	T2,G$OPRA		;GET OPR ADDRESS
	MOVE	T1,OPR.ND(T2)		;GET NODE ADDRESS
	MOVE	T3,G$HOST		;GET NODE OF CENTRAL SITE
	MOVEI	S2,TTYTXT		;ASSUME TTYTXT
	CAME	T3,NOD.NM(T1)		;CENTRAL SITE
	MOVEI	S2,NODTXT		;NO..USE NODE TEXT
	$RETT				;RETURN


; Here to finish up the building of SEND text strings
;
BLDFIN:	HRRZ	S2,SNDPTR		;GET THE ADDRESS
	AOS	S1,S2			;BUMP AND SAVE IN S1
	SUB	S2,P3			;COMPUTE THE BLOCK SIZE
	MOVEI	S1,.CMTXT		;GET BLOCK TYPE
	MOVE	T4,P3			;GET TEXT ADDRESS
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	ANDI	P3,777			;GET THE MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE THE MESSAGE COUNT
	MOVE	S1,T4			;GET TEXT ADDRESS
	$RETT				;RETURN TRUE

BLDRTN:	IDPB	S1,SNDPTR		;SAVE THE BYTE
	$RETT				;RETURN TRUE
SUBTTL	SNDALX	Send message to all terminals



; TOPS-10 SEND ALL command support
;
TOPS10	<				;TOPS-10 only
SNDALX:	MOVE	S1,[POINT 7,SNDTXT]	;Byte pointer to store SEND ALL text
	MOVEM	S1,STRBP		;Store it
	MOVEI	S1,^D72			;# characters maximum
	MOVEM	S1,STRCT		;Store byte count
	MOVEI	T1,[ITEXT (<^O/P1/_>)]	;Assume node number
	TLNE	P1,770000		;Is it?
	MOVEI	T1,[ITEXT(<^W/P1/_>)]	;No - a node name
	CAMN	P1,[-1]			;Was it ALL?
	MOVEI	T1,[ITEXT (<ALL:>)]	;Yes - message to all nodes
	$TEXT	(SNDCHR,<SEND ^I/@T1/^T/ARG.DA(P3)/^M^A>) ;Monitor SEND command
	MOVX	S1,.TOTYP		;TRMOP. to stuff text down TTY's throat
	MOVE	S2,FRCLIN		;Send text to FRCLIN
	MOVEI	S2+1,SNDTXT		;Point to text
	MOVX	TF,<3,,S1>		;Set up for CALLI
	TRMOP.	TF,			;Do SEND ALL command
	  $RETF				;Can't
	$RETT				;Return sucessful

SNDCHR:	SOSG	STRCT			;Count bytes
	MOVX	S1,.CHCRT		;Load a carriage return to end buffer
	IDPB	S1,STRBP		;Store character
	CAXE	S1,.CHCRT		;End of line ?
	$RETT				;No - return
	MOVX	S1,.CHNUL		;Get a <NUL>
	IDPB	S1,STRBP		;Make sure text is properly terminated
	$RETF				;Stop $TEXT
>;END of TOPS-10 conditional



; TOPS-20 SEND ALL command support
;  G$CLUN will contain what node(s) to send to..
;	        G$CLUN/0		The message is to be processed locally
;	        G$CLUN/SIXBIT node name  The message is to be forwarded
;	        G$CLUN/-1                The message is to be processed by 
;                                        all the cluster nodes

TOPS20	<				;TOPS-20 only
SNDALX:	HRROI	S2,ARG.DA(S1)		;This gets the text as remembered
					; from BLDFIN
	MOVE	S1,G$CLUN		;[6007]Get the node argument
	JUMPE	S1,SNDLOC		;[6007]Go send it for local

;  This is a cluster send.  Check for all nodes or just one node.

	CAMN	S1,[-1]			;[6007]Every node?
	JRST 	SNDCTS			;[6007]Yes, cluster send all

;  Send it to just one node.  Get the CI node number for the node.
	PUSH	P,S2			;[6007]Save address of text
	$CALL	GCNFIG			;[6007]Get the CI node number
	JUMPF	.RETF			;[6013]error 
	POP	P,S2			;[6007]Get the message back
	TXO	S1,TT%REM		;[6007]Say it is a remote SEND
	HLLOS	S1			;[6007]For all terminals
	JRST	SNDIT			;[6007]Go send it

SNDLOC:	SETOM	S1			;[6007]Send to all terminals
	SKIPA				;[6007]Go send it
SNDCTS:	HLLO	S1,[TT%REM+.CSALL]	;[6007]Setup AC 1 for all TTY and node
SNDIT:	TTMSG				;SEND THE TEXT
	ERJMP	.RETF			;FAILED RETURN FALSE
	$RETT				;RETURN TRUE
>;END of TOPS-20 conditional
SUBTTL	GCNFIG  Do CONFIG to find out what systems are out there

;[6007]Beginning of edit 6007
;GCNFIG - returns the number of nodes in the cluster.
;Accepts G$CLUN/SIXBIT node name
;Returns +1 S1/CI Node number,,0
;	    NAMBLK/Node name block
;   	    NUMBLK/CI node number block

CNFSIZ==:30			;CNFIG block size
CFGBLK:: BLOCK 30		;CNFIG Block
NUMBLK:: BLOCK 31		;Return CNFIG block for CI-node number
NAMBLK:: BLOCK 31		;Return CNFIG block for CI-node name

GCNFIG:	MOVEI	S1,CNFSIZ	;Size of CNFIG block 
	MOVEM 	S1,NAMBLK+.CFNND ;Store it in the arg block
	MOVEI 	S1,.CFCND	;Get function code
	MOVEI	 S2,NAMBLK	;Get the arg address
	CNFIG%			;Get the node name
	 ERJMP	CNFIGS		;Shouldn't fail

	MOVEI 	S1,CNFSIZ	;Size of CNFIG block 
	MOVEM 	S1,NUMBLK+.CFLEN ;Store it in the arg block
	MOVEI 	S1,.CFCSE	;Get function code
	MOVEI 	S2,NUMBLK	;Get the arg address
	CNFIG%			;Get the node number
	 ERJMP 	CNFIGS		;Shouldn't fail
	HLRZ 	S2,NUMBLK+.CFLEN ;Get number of words returned
	SOS	S2		;Don't count the first word
	HLRZ 	S1,.CFNND+NAMBLK ;Get number of node in the cluster
	CAME 	S1,S2		;Number of CI nodes=number of names?
	JRST	GCNFIG		;No, try again

	MOVE	T1,G$CLUN	;[6013]Get the node arg
	CAMN	T1,[-1]		;[6013]For all nodes
	JRST	CNFRET		;[6013]Yes all done
	MOVE	T1,S1		;Get the number of nodes 	
GCNFI1:	MOVE	S1,NAMBLK(T1)	;Get pointer to ASCIZ name
	$CALL	S%SIXB		;Convert it to SIXBIT
	CAMN	S2,G$CLUN	;Are they the same?
	JRST	CNFEXT		;Found it
	SOJG	T1,GCNFI1	;Get the next
CNFERR:	$RETF			;[6013]Not here error

CNFEXT:	HLLZ	S1,NUMBLK(T1)	;Get the CI node number
CNFRET:	$RETT			;[6013]Success return 

CNFIGS:	  $STOP(CCN,Cannot CNFIG node name for SEND ALL)
;[6007]End of 6007
SUBTTL	SNDTTY	Send a message to a terminal

;THIS ROUTINE WILL SEND A MESSAGE  TO A TERMINAL
;
;CALL	S1/	TERMINAL NUMBER
;	S2/	ADDRESS OF TEXT


;CHECK IF TERMINAL WANTS MESSAGES

SNDTTY:

TOPS10<	$CALL	.SAVET			;SAVE AC'S
	TXO	S1,.UXTRM		;MAKE SURE IT IS A UDX
	MOVX	T1,<3,,T2>		;SET UP ARG POINTER
	MOVX	T2,.TODSP		;LOAD OUTSTR FUNCION
	MOVE	T3,S1			;GET TERMINAL NUMBER
	MOVE	T4,S2			;GET MESSAGE ADDRESS
	TRMOP.	T1,			;OUTPUT THE STRING
	  PJRST	E$CSU			;GIVE AN ERROR
	$RETT				;RETURN TRUE
>;END TOPS10

TOPS20<	TRO	S1,400000		;FLAG IT AS A TERMINAL NUMBER
	HRRO	S2,S2			;POINT AT THE TEXT
	TTMSG				;SEND THE TEXT
	ERJMP	.RETF			;FAILED ..RETURN FALSE
	$RETT				;RETURN TRUE
>;END TOPS20
SUBTTL	SHOW	SHOW Command

SHOW:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;MUST BE A KEYWORD..ELSE RETURN
	MOVSI	S2,-SHWLEN		;MAKE AOBJN POINTER TO DISPATCH TABLE
SHOW.1:	HLRZ	T1,SHWDSP(S2)		;GET AN ENTRY FROM TABLE
	CAMN	T1,S1			;DOES THIS ENTRY MATCH?
	JRST	SHOW.2			;YES, GO PROCESS IT
	AOBJN	S2,SHOW.1		;NO, LOOK AT NEXT
	$RETF				;NO MATCH, BAD COMMAND
SHOW.2:	HRRZ	S2,SHWDSP(S2)		;GET THE ADDRESS TO DISPATCH TO
	JRST	(S2)			;EXECUTE THE ROUTINE

SHWDSP:
	.KYSTS,,Q$SHWS##		;SHOW STATUS
	.KYCFG,,Q$SHCF##		;SHOW CONFIGURATION
	.KYMSG,,SHWMSG			;SHOW MESSAGES
	.KYQUE,,Q$SHWQ##		;SHOW QUEUES
	.KYPRM,,Q$SHWP##		;SHOW PARAMETERS
	.KYOPR,,SHWOPR			;SHOW OPERATORS
	.KYCGL,,Q$SHCL##		;[6011]SHOW CLUSTER-GALAXY-LINK-STATUS
	.KYRTE,,Q$SHWR##		;SHOW ROUTE TABLES
	.KYCTL,,Q$SHWC##		;SHOW CONTROL-FILE
TOPS20<	.KYSCH,,SHWSCH >		;SHOW SCHEDULER
TOPS10<	.KYSLS,,Q$SLST## >		;SHOW SYSTEM LISTS
TOPS10<	.KYALC,,Q$SALC## >		;SHOW ALLOCATION
;**;[6042]At SHWDSP:+13L add 1 line  JCR  4/27/90
	.KYBCM,,SHWBCM			;[6042]SHOW BROADCAST-MESSAGES
;**;[6043]At SHWDSP:+14L add 1 line  PMM  6/3/90
	.KYAKA,,SHWAKA	 		;[6043]SHOW ALIAS
SHWLEN==.-SHWDSP
SUBTTL	SHWOPR	Show operators command

;THIS ROUTINE WILL DISPLAY OPR ON SYSTEM TO OPR ISSUING THE COMMAND

SHWOPR:	SETZM	G$ARG1			;NO NODE NAME SEEN
;**;[6042]At SHWOPR:+1L add 1 line  JCR  4/27/90
	SETZM	G$ARG3			;[6042]No /ALL switch detected
	SETOM	G$FERR			;[6004]ASSUME FIRST MESSAGE SENT O.K.
	MOVX	S1,.OMDSP		;SETUP OPR DISPLAY MESSAGE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	SHWO.3			;MUST BE CRLF
;**;[6042]At SHWOPR:+7L replace 7 lines with 13 lines  JCR  4/27/90
	CAIE	S1,.SWALL		;[6042]/ALL switch detected?
	JRST	SHWO.0			;[6042]No, check for /CLUSTER-NODE
	SETOM	G$ARG3			;[6042]Yes, indicate so
	$CALL	P$SWIT			;[6042]Check for another switch
	JUMPF	SHWO.3			;[6042]None, must be a CRLF
SHWO.0:	$CALL	CHCLUN			;[6042]Check for a CLUSTER-NODE switch
	JUMPF	SHWO.1			;[6042]None, check if a /NODE switch
	SKIPE	S1,G$CLUN		;[6042]Local node specified?
	CAMN	S1,[-1]			;[6042]No, all nodes specified?
	JRST	SHWO.3			;[6042]Yes, treat as a <CR>
	JRST	SHWO.8			;[6042]No, remote node specified

SHWO.1:	CAIE	S1,.SWNOD		;[6042]Was it a /NODE switch?
	$RETF				;[6004]ILLEGAL MESSAGE FORMAT
	$CALL	P$NODE			;GET THE NODE VALUE
	$RETIF				;INVALID MESSAGE
	MOVEM	S1,G$ARG1		;SAVE NODE NAME
	$CALL	P$SWIT			;[6023]CHECK FOR A SWITCH
	JUMPF	SHWO.2			;[6023]JUMP IF NO SWITCH
;**;[6034]At SHWO.1:+7L replace 3 lines with 8 lines  JCR  12/31/89
	$CALL	CHCLUN			;[6034]Check for a CLUSTER-NODE switch
	JUMPF	SHWO.2			;[6034]None, validate the node name
	SKIPE	S1,G$CLUN		;[6034]Local node specified?
	CAMN	S1,[-1]			;[6034]No, all nodes specified?
	JRST	SHWO.2			;[6034]Validate the node name
	JRST	SHWO.8			;[6034]Send a message to NEBULA

SHWO.2:	MOVE	S1,G$ARG1		;[6004]PICK UP THE NODE NAME
	$CALL	FNDNOD			;VALIDATE THE NODE
	JUMPF	[MOVEI S1,E$NNK		  ;[6004]NODE NOT KNOWN
		 JRST  SHWO.5 ]		  ;[6004]GO PROCESS THE ERROR
	MOVE	P1,S1			;SAVE THE NODE ADDRESS
	MOVEI	S1,SHODBK		;SHOW OPERATOR TEXT
	$CALL	SHWMTX			;SHOW MESSAGE TEXT POINTER
	MOVE	S2,P1			;PUT NODE ADDRESS IN S2
	$CALL	OPRLST			;OPERATORS AT NODE
	JUMPF	[MOVEI	S1,E$NON	  ;[6004]NO MESSAGES FOR THE NODE
		 JRST	SHWO.5 ]	  ;[6004]GO PROCESS THE ERROR
	$CALL	FINSHW			;[6004]HAVE SOME..SEND IT
	JUMPF	SHWO.6			;[6004]CHECK IF NEED TO SEND TO NEBULA
	JRST	SHWO.9			;[6004]CHECK IF NEED TO SEND TO NEBULA

SHWO.3:	MOVEI	S1,SHODBK		;SHOW OPERATOR TEXT
	$CALL	SHWMTX			;SHOW MESSAGE TEXT
	SETZM	P1			;CLEAR MESSAGES FLAG
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%FIRST			;GET FIRST ENTRY
	JUMPF	[MOVEI	S1,E$NOD	  ;[6004]PICK UP ERROR ROUTINE ADDRESS
		 JRST	SHWO.5 ]	  ;[6004]GO RELEASE THE MESSAGE
SHWO.4:	$CALL	OPRLST			;OPERATORS AT NODE
	SKIPF				;NO MESSAGES SKIP FLAG SETTING
	SETOM	P1			;MESSAGES FOUND
	MOVE	S1,G$NODL		;GET NODE LIST NUMER
	$CALL	L%NEXT			;GET NEXT ENTRY
	JUMPT	SHWO.4			;PROCESS MESSAGES
	JUMPE	P1,[MOVE S1,E$NOD	  ;[6004]PICK UP ERROR ROUTINE ADDRESS
		    JRST SHWO.5 ]	  ;[6004]GO RELEASE THE MESSAGE PAGE
	$CALL	FINSHW			;YES..SEND MESSAGE
	JUMPF	SHWO.6			;[6004]CHECK IF NEED TO SEND TO NEBULA
	JRST	SHWO.9			;[6004]CHECK IF NEED TO SEND TO NEBULA

SHWO.5:	SKIPN	G$CLUN			;[6004]NEED TO SEND A MESSAGE TO NEBULA?
	PJRST	0(S1)			;[6004]NO, GO INDICATE ERROR TYPE
	$CALL	0(S1)			;[6004]YES, SET UP G$ERR
	JRST	SHWO.7			;[6004]GO INDICATE AN ERROR HAS OCCURRED

SHWO.6:	SKIPN	G$CLUN			;[6004]NEED TO SEND A MESSAGE TO NEBULA?
	$RETF				;[6004]NO, RETURN NOW

SHWO.7:	SETZM	G$FERR			;[6004]INDICATE AN ERROR HAS OCCURRED
	JRST	SHWO10			;[6004]GO SETUP REMOTE MESSAGE PAGE

SHWO.8:	$CALL	P$CFM			;[6004]CHECK FOR A CARRAIGE RETURN
	JUMPF	.POPJ			;[6004]QUIT NOW IF THERE IS NONE
	JRST	SHWO10			;[6004]GO SETUP REMOTE MESSAGE PAGE

SHWO.9:	SKIPN	G$CLUN			;[6004]SEND A MESSAGE TO REMOTE NODES?
	$RET				;[6004]NO, RETURN NOW
	$CALL	GETPAG			;[6004]PICK UP A MESSAGE PAGE

SHWO10:	MOVE	S1,[.OHDRS+.NDESZ,,.NSHOP] ;[6004]PICK UP THE MESSAGE HDR WORD
	MOVEM	S1,.MSTYP(MO)		;[6004]PLACE IN THE MESSAGE
	MOVEI	P3,.OHDRS(MO)		;[6004]POINT TO THE CURRENT BLOCK
	SKIPN	S1,G$ARG1		;[6004]A NODE BLOCK IN THE MESSAGE?
	JRST	SHWO11			;[6004]NO, ADD THE CLUSTER NODE BLOCK
	MOVEM	S1,ARG.DA(P3)		;[6004]PLACE NODE NAME IN THE MESSAGE
	MOVE	S1,[2,,.CMNOD]		;[6004]PICK UP BLOCK HEADER WORD
	MOVEM	S1,ARG.HD(P3)		;[6004]PLACE IN THE MESSAGE
	MOVSI	S1,2			;[6004]PICK UP BLOCK SIZE
	ADDM	S1,.MSTYP(MO)		;[6004]ADD TO TOTAL MESSAGE LENGTH
	ADDI	P3,2			;[6004]POINT TO THE NEXT BLOCK
	AOS	.OARGC(MO)		;[6004]INCREMENT THE ARGUMENT COUNT

;**;[6042]At SHWO11:+0L replace 1 line with 4 lines  JCR  4/27/90
SHWO11:	MOVX	S1,OP.ALL		;[6042]Pick up the /ALL switch flag
	SKIPE	G$ARG3			;[6042]/ALL switch specified?
	IORM	S1,.OFLAG(MO)		;[6042]Yes, indicate in the message
	$CALL	FASNEB			;[6042]Finish the msg and send it
	JUMPF	.POPJ			;[6004]RETURN NOW ON AN ERROR
	SKIPE	G$FERR			;[6004]ERROR ON THE FIRST MSG SEND?
	$RET				;[6004]NO, RETURN NOW
	MOVEM	MO,G$OUTP		;[6004]INDICATE MESSAGE PAGE RELEASED
	$RETF				;[6004]INDICATE AN ERROR OCCURRED

SHWMTX:	MOVE	T1,G$NOW		;GET CURRENT TIME
	MOVEM	T1,ARG.DA(S1)		;SAVE TIME IN THE BLOCK
	MOVS	T1,S1			;SOURCE TEXT ADDRESS
	HRR	T1,P3			;DESTINATION ADDRESS
	LOAD	T2,(S1),AR.LEN		;LENGTH OF THE BLOCK
	ADD	P3,T2			;GET END ADDRESS
	BLT	T1,-1(P3)		;MOVE THE TEXT
	AOS	.OARGC(MO)		;BUMP ARGUMENT COUNT
	$RETT				;RETURN

SHDPBK:	XWD	SHLTXT,.ORDSP		;[6005]TEXT BLOCK
	BLOCK	1			;ROOM FOR TIME STAMP
	ASCIZ/		-- System messages outstanding --
/
SHLTXT==.-SHDPBK			;SIZE OF THE BLOCK
SHODBK:	XWD	SHOTLN,.ORDSP		;TEXT BLOCK
	BLOCK	1			;ROOM FOR TIME STAMP
	ASCIZ/		-- Operators --

    Node      Type   Terminal    Job             User
-----------  ------  --------    ---  ----------------------------
/
SHOTLN=.-SHODBK				;SIZE OF THE BLOCK

;[6043]At SHOTLN= +1L add 4 lines  PMM  6/3/90
SHADBK:	XWD	SHATLN,.ORDSP		;[6043]Text block
	BLOCK	1			;[6043]Room for the time stamp
	ASCIZ/	-- Alias Printer Mappings --
/
SHATLN=.-SHADBK				;[6043]Size of the block
SUBTTL	SHWSCH	Show scheduler information

;THIS COMMAND IS TO DUMP THE SCHEDULER INFORMATION ON THE -20

INFOBK:	BLOCK	4

TOPS20<
SHWSCH:
	
	$CALL	P$SWITCH		;[6013]Check for switches
	JUMPF	SHWLOC			;[6013]None there. Must be local

;  We have a /CLUSTER-NODE switch.  Now lets find out what it is

	$CALL	CHCLUN			;[6013]Is it a /CLUSTER-NODE
	JUMPF	.RETF			;[6013]No, bad message
	MOVE	S1,G$CLUN		;[6013]Get the node argument
	MOVEM	S1,G$ARG1		;[6013]Save it for error text
	JUMPE	S1,SHWLOC		;[6013]Go do it for the local node

	$CALL	P$CFM			;[6013]End of command?
	$RETIF				;[6013]Error..return
	$CALL	RELPAG			;[6013]Release given page
	$CALL	OPRMES			;[6013]Setup the message

;  This is a cluster send.  Either for all nodes or just one node.
;  Lets setup NAMBLK and NUMBLK.

	$CALL	GCNFIG			;[6013]Get the CI node number
	JUMPF	.RETF			;[6013]Error

	MOVE	S2,G$CLUN		;[6013]Get the node arg
	CAMN	S2,[-1]			;[6013]For all nodes
	JRST	SCHALL			;[6013]Yes

;  S1/CI node name  S2/SIXBIT node name

	$CALL	SCHONE			;[6013]No, just one
	JRST	SCHAL4			;[6013]All done

;  Process SHOW SCHEDULER /CLUSTER-NODE * command

SCHALL:	MOVE	S1,G$HOST		;[6013]Get the host name
	MOVEM	S1,G$ARG1		;[6013]Save it
	$CALL	SHWLO1			;[6013]Do local nade first
	JUMPF	.RETF			;[6013]Failed

	HLRZ 	T1,.CFNND+NAMBLK	;[6013]Get number of node in the cluster
	SOJE	T1,SCHAL3		;[6013]Don't count local node
	MOVEI	T2,2			;[6013]Start 
SCHAL2:	MOVE	S1,NAMBLK(T2)		;[6013]Get pointer to ASCIZ name
	$CALL	S%SIXB			;[6013]Convert it to SIXBIT
	MOVEM	S2,G$ARG1		;[6013]Save it
	HLLZ	S1,NUMBLK(T2)		;[6013]Get the CI node number
	$CALL	SCHONE			;[6013]Show Scheduler info
	AOS	T2			;[6013]Next node
	SOJG	T1,SCHAL2		;[6013]Get the next

SCHAL4:	$CALL	MSGFIN			;[6013]Finish the message
	$CALL	L$SHWM##		;[6013]Log the message
	MOVE	S1,G$SND		;[6013]Get senders pid
	MOVEI	S2,PAGSIZ		;[6013]Page message
	$CALL	SPDOPR			;[6013]Send to OPR
SCHAL3:	$RETT				;[6013]All done

;  This is for one node.  S1 will contain the CI node number in the left half
;  from GCNFIG.  G%ARG1 contains the SIXBIT node name.

SCHONE:	$CALL	.SAVET			;[6013]Save T ACs
	MOVE	S2,[.INSKD,,4]		;[6013]Get function.,,length
	MOVEM	S2,INFOBK+.INFUN	;[6013]Put it in the INFO% blk.
	MOVSM	S1,INFOBK+.INCID	;[6013]Put CI number in INFO% blk. 
	MOVEI	S1,.SKRBC		;[6013]Read BIAS control
	MOVEM	S1,INFOBK+.INAC1	;[6013]Put SKED% function in INFO% blk.
	MOVEI	S1,SCHBLK		;[6013]SKED% arg block
	MOVEM	S1,INFOBK+.INAC2	;[6013]Put it in the INFO% blk.
	MOVEI	S1,2			;[6013]Length is 2
	MOVEM	S1,SCHBLK		;[6013]Save it for INFO%
	MOVEI	S1,INFOBK		;[6013]Address of INFO% block
	INFO%				;[6013]Get it from INFO%
	 ERJMP	SCHERR			;[6013]Error
	TXNE	S1,IN%RER		;[6013]Any remote errors?
	JRST	SCHERR			;[6013]Yes
	MOVE	P1,SCHBLK+.SAKNB	;[6013]Save the value
	MOVEI	S1,.SKRCV		;[6013]Get scheduler data
	MOVEM	S1,INFOBK+.INAC1	;[6013]Put SKED% function in INFO% blk.
	MOVEI	S1,SCHBLK		;[6013]Get SKED% block
	MOVEM	S1,INFOBK+.INAC2	;[6013]Save it in INFO% block
	MOVEI	S1,2			;[6013]Length is 2
	MOVEM	S1,SCHBLK		;[6013]Save it for INFO%
	MOVEI	S1,INFOBK		;[6013]INFO% block
	INFO%				;[6013]Get it from INFO%
	 ERJMP	SCHERR			;[6013]Error
	TXNE	S1,IN%RER		;[6013]Any remote errors?
	JRST	SCHERR			;[6013]Yes
	MOVE	P2,SCHBLK+.SACTL	;[6013]Save scheduler info
	MOVEI	S1,[ASCIZ/on/]		;[6013]Assume on
	TXNE	P2,SK%STP		;[6013]Check if off
	MOVEI	S1,[ASCIZ/off/]		;[6013]Yes..
	$TEXT	(WTORTN,<		-- System scheduler information --
		           For node ^W/G$ARG1/::
		Class scheduler: ^T/(S1)/		Bias control: ^D/P1/>)
	MOVEI	P1,[ITEXT(<none set>)]	;[6013]Assume none-set
	TXNE	P2,SK%DRG		;[6013]Batch on dregs queue?
	MOVEI	P1,[ITEXT(<background>)] ;[6013]Yes.. setup background
	TXNE	P2,SK%STP		;[6013]Check if on
	JRST	SCHON1			;[6013]No..bypass class scheduler batch

	MOVEI	S1,.SKBCR		;[6013]Read batch class settings
	MOVEM	S1,INFOBK+.INAC1	;[6013]Put SKED% function in INFO% blk.
	MOVEI	S1,SCHBLK		;[6013]Get address of SKED% block
	MOVEM	S1,INFOBK+.INAC2	;[6013]Save it in INFO% block
	MOVEI	S1,2			;[6013]Length is 2
	MOVEM	S1,SCHBLK		;[6013]Save it for INFO%
	MOVEI	S1,INFOBK		;[6013]INFO% block
	INFO%				;[6013]Get it from INFO%
	 ERJMP	SCHERR			;[6013]Error
	TXNE	S1,IN%RER		;[6013]Any remote errors?
	JRST	SCHERR			;[6013]Yes
	SKIPL	T2,SCHBLK+.SABCL	;[6013]Any set(-1=none)
	MOVEI	P1,[ITEXT(<^D/T2/>)]	;[6013]Get the number
SCHON1:	$TEXT	(WTORTN,<						Batch class: ^I/(P1)/>)
	TXNE	P2,SK%STP		;[6013]Class scheduler on
	JRST	SCHON4			;[6013]No..finish off command
	MOVEI	T3,0			;[6013]Start with class 0
	$TEXT	(WTORTN,<
					    ------Load averages-------
		CLASS    SHARE(%)   USE(%)  1-MIN     5-MIN     15-MIN>)
SCHON2:	MOVEI	S1,.SKRCS		;[6013]Read class information
	MOVEM	S1,INFOBK+.INAC1	;[6013]Put SKED% function in INFO% blk.
	MOVEI	S2,SCHBLK		;[6013]Scheduler block
	MOVEM	S2,INFOBK+.INAC2	;[6013]Put it in the INFO% block
	MOVEI	T1,7			;[6013]Length of block
	MOVEM	T1,SCHBLK+.SACNT	;[6013]Save the length
	MOVEM	T3,SCHBLK+.SACLS	;[6013]Save the class
	MOVEI	S1,INFOBK		;[6013]INFO% block
	INFO%	
	  ERJMP	SCHERR			;[6013]No more..done now
	TXNE	S1,IN%RER		;[6013]Any remote errors?
	JRST	SCHON3			;[6013]Yes
	SKIPN	T4,SCHBLK+.SASHR	;[6013]Any share?
	AOJA	T3,SCHON2		;[6013]No..try Next one
	MOVE	S1,.SASHR+SCHBLK	;[6013]Get the share
	FMPRI	S1,(100.)		;[6013]Get whole number
	FIXR	S1,S1			;[6013]Get interger number
	MOVEM	S1,.SASHR+SCHBLK	;[6013]Save the number
	MOVE	S1,.SAUSE+SCHBLK	;[6013]Get the use
	FMPRI	S1,(100.)		;[6013]Make a whole number
	FIXR	S1,S1			;[6013]Make interger number
	MOVEM	S1,.SAUSE+SCHBLK	;[6013]Save the number
	MOVE	S1,.SA1ML+SCHBLK	;[6013]Get the 1 minute load
	FMPRI	S1,(100.)		;[6013]Get whole number
	FIXR	S1,S1			;[6013]Get interger number
	IDIVI	S1,^D100		;[6013]Now get number and fraction
	HRL	S2,S1			;[6013]Place in left half
	MOVEM	S2,.SA1ML+SCHBLK	;[6013]Save numbers back
	MOVE	S1,.SA5ML+SCHBLK	;[6013]Get the 5 minute load
	FMPRI	S1,(100.)		;[6013]Get whole number
	FIXR	S1,S1			;[6013]Get interger number
	IDIVI	S1,^D100		;[6013]Now get number and fraction
	HRL	S2,S1			;[6013]Place in left half
	MOVEM	S2,.SA5ML+SCHBLK	;[6013]Save numbers back
	MOVE	S1,.SA15L+SCHBLK	;[6013]Get the 15 minute load
	FMPRI	S1,(100.)		;[6013]Get whole number
	FIXR	S1,S1			;[6013]Get interger number
	IDIVI	S1,^D100		;[6013]Now get number and fraction
	HRL	S2,S1			;[6013]Place in left half
	MOVEM	S2,.SA15L+SCHBLK	;[6013]Save numbers back
	$TEXT	(WTORTN,<		  ^D/SCHBLK+.SACLS/       ^D3R/SCHBLK+.SASHR/       ^D3R/SCHBLK+.SAUSE/    ^D3R/SCHBLK+.SA1ML,LHMASK/.^D2R0/SCHBLK+.SA1ML,RHMASK/    ^D3R/SCHBLK+.SA5ML,LHMASK/.^D2R0/SCHBLK+.SA5ML,RHMASK/    ^D3R/SCHBLK+.SA15L,LHMASK/.^D2R0/SCHBLK+.SA15L,RHMASK/>)
	AOJA	T3,SCHON2		;[6013]No..try next one
SCHON3:	MOVEI	S1,[ASCIZ/allocated/]	;[6013]Default for windfall
	MOVEI	S2,[ASCIZ/policy program/];[6013]Default for class assignments
	TXNE	P2,SK%WDF		;[6013]Withhold windfall?
	MOVEI	S1,[ASCIZ/withheld/]	;[6013]Yes
	TXNE	P2,SK%ACT		;[6013]Class by accounts
	MOVEI	S2,[ASCIZ/account/]	;[6013]Yes
	$TEXT	(WTORTN,<
		Windfall: ^T/(S1)/		Classes by ^T/(S2)/^M^J>)
SCHON4:	$RETT				;[6013]Return O.K.
SUBTTL	SHWLOC - SHOW SCHEDULER for the local node

SHWLOC:	$CALL	P$CFM			;[6013]End of command?
	$RETIF				;ERROR..RETURN
	$CALL	RELPAG			;RELEASE GIVEN PAGE
	$CALL	OPRMES			;SETUP THE MESSAGE
	MOVE	S1,G$HOST		;[6013]Local node name
	MOVEM	S1,G$ARG1		;[6013]Save it
	$CALL	SHWLO1			;[6013]Do local scheduler info
	JUMPF	.RETF			;[6013]Failed

	$CALL	MSGFIN			;FINISH THE MESSAGE
	$CALL	L$SHWM##		;LOG THE MESSAGE
	MOVE	S1,G$SND		;GET SENDERS PID
	MOVEI	S2,PAGSIZ		;PAGE MESSAGE
	$CALL	SPDOPR			;SEND TO OPR
	$RETT				;RETURN O.K.

; SHWLO1 - Since we are doing this locally, just use SKED% instead of INFO%

SHWLO1:	MOVEI	S1,.SKRBC		;READ BIAS CONTROL
	MOVEI	S2,T1			;BLOCK IN T1
	MOVEI	T1,2			;LENGTH OF  BLOCK
	SKED%				;GET THE DATA
	   ERJMP SCHERR			;SCHEDULER ERROR
	MOVE	P1,T2			;SAVE THE VALUE
	MOVEI	S1,.SKRCV		;GET SCHEDULER DATA
	SKED%				;GET THE VALUE
	  ERJMP SCHERR			;SCHEDULER ERROR
	MOVE	P2,T2			;SAVE SCHEDULER INFO
	MOVEI	S1,[ASCIZ/on/]		;ASSUME ON
	TXNE	P2,SK%STP		;CHECK IF OFF
	MOVEI	S1,[ASCIZ/off/]		;YES..
	$TEXT	(WTORTN,<		-- System scheduler information --
		           For node ^W/G$ARG1/::
		Class scheduler: ^T/(S1)/		Bias control: ^D/P1/>)
	MOVEI	P1,[ITEXT(<none set>)]	;ASSUME NONE-SET
	TXNE	P2,SK%DRG		;BATCH ON DREGS QUEUE?
	MOVEI	P1,[ITEXT(<background>)]	;YES.. SETUP BACKGROUND
	TXNE	P2,SK%STP		;CHECK IF ON
	JRST	SCHS.1			;NO..BYPASS CLASS SCHEDULER BATCH READ
	MOVEI	S1,.SKBCR		;READ BATCH CLASS SETTINGS
	MOVEI	S2,T1			;ADDRESS OF THE BLOCK
	MOVEI	T1,2			;LENGTH OF THE BLOCK
	SKED%				;GET THE VALUE
	  ERJMP  SCHERR			;ERROR..RETURN
	SKIPL	T2			;ANY SET(-1=NONE)
	MOVEI	P1,[ITEXT(<^D/T2/>)]	;GET THE NUMBER
SCHS.1:	$TEXT	(WTORTN,<						Batch class: ^I/(P1)/>)
	TXNE	P2,SK%STP		;CLASS SCHEDULER ON
	JRST	SCHS.4			;NO..FINISH OFF COMMAND
	MOVEI	T3,0			;START WITH CLASS 0
	$TEXT	(WTORTN,<
					    ------Load averages-------
		CLASS    SHARE(%)   USE(%)  1-MIN     5-MIN     15-MIN>)
SCHS.2:	MOVEI	S1,.SKRCS		;READ CLASS INFORMATION
	MOVEI	S2,SCHBLK		;SCHEDULER BLOCK
	MOVEI	T1,7			;LENGTH OF BLOCK
	MOVEM	T1,SCHBLK+.SACNT	;SAVE THE LENGTH
	MOVEM	T3,SCHBLK+.SACLS	;SAVE THE CLASS
	SKED%				;GET THE DATA
	  ERJMP	SCHS.3			;NO MORE..DONE NOW
	SKIPN	T4,SCHBLK+.SASHR	;ANY SHARE?
	AOJA	T3,SCHS.2		;NO..TRY NEXT ONE
	MOVE	S1,.SASHR+SCHBLK	;GET THE SHARE
	FMPRI	S1,(100.)		;GET WHOLE NUMBER
	FIXR	S1,S1			;GET INTERGER NUMBER
	MOVEM	S1,.SASHR+SCHBLK	;SAVE THE NUMBER
	MOVE	S1,.SAUSE+SCHBLK	;GET THE USE
	FMPRI	S1,(100.)		;MAKE A WHOLE NUMBER
	FIXR	S1,S1			;MAKE INTERGER NUMBER
	MOVEM	S1,.SAUSE+SCHBLK	;SAVE THE NUMBER
	MOVE	S1,.SA1ML+SCHBLK	;GET THE 1 MINUTE LOAD
	FMPRI	S1,(100.)		;GET WHOLE NUMBER
	FIXR	S1,S1			;GET INTERGER NUMBER
	IDIVI	S1,^D100		;NOW GET NUMBER AND FRACTION
	HRL	S2,S1			;PLACE IN LEFT HALF
	MOVEM	S2,.SA1ML+SCHBLK	;SAVE NUMBERS BACK
	MOVE	S1,.SA5ML+SCHBLK	;GET THE 5 MINUTE LOAD
	FMPRI	S1,(100.)		;GET WHOLE NUMBER
	FIXR	S1,S1			;GET INTERGER NUMBER
	IDIVI	S1,^D100		;NOW GET NUMBER AND FRACTION
	HRL	S2,S1			;PLACE IN LEFT HALF
	MOVEM	S2,.SA5ML+SCHBLK	;SAVE NUMBERS BACK
	MOVE	S1,.SA15L+SCHBLK	;GET THE 15 MINUTE LOAD
	FMPRI	S1,(100.)		;GET WHOLE NUMBER
	FIXR	S1,S1			;GET INTERGER NUMBER
	IDIVI	S1,^D100		;NOW GET NUMBER AND FRACTION
	HRL	S2,S1			;PLACE IN LEFT HALF
	MOVEM	S2,.SA15L+SCHBLK	;SAVE NUMBERS BACK
	$TEXT	(WTORTN,<		  ^D/SCHBLK+.SACLS/       ^D3R/SCHBLK+.SASHR/       ^D3R/SCHBLK+.SAUSE/    ^D3R/SCHBLK+.SA1ML,LHMASK/.^D2R0/SCHBLK+.SA1ML,RHMASK/    ^D3R/SCHBLK+.SA5ML,LHMASK/.^D2R0/SCHBLK+.SA5ML,RHMASK/    ^D3R/SCHBLK+.SA15L,LHMASK/.^D2R0/SCHBLK+.SA15L,RHMASK/>)
	AOJA	T3,SCHS.2		;NO..TRY NEXT ONE
SCHS.3:	MOVEI	S1,[ASCIZ/allocated/]	;DEFAULT FOR WINDFALL
	MOVEI	S2,[ASCIZ/policy program/];DEFAULT FOR CLASS ASSIGNMENTS
	TXNE	P2,SK%WDF		;WITHHOLD WINDFALL?
	MOVEI	S1,[ASCIZ/withheld/]	;YES
	TXNE	P2,SK%ACT		;CLASS BY ACCOUNTS
	MOVEI	S2,[ASCIZ/account/]	;YES
	$TEXT	(WTORTN,<
		Windfall: ^T/(S1)/		Classes by ^T/(S2)/^M^J>)
SCHS.4:	$RETT				;[6013]All done
SCHERR:	PJRST	E$SFF			;SCHEDULER FUNCTION FAILED

>;END TOPS20
SUBTTL	SHWMSG	Show messages command

;THIS ROUTINE WILL BUILD A MESSAGE FOR OPR WITH OUTSTANDING
;WTOR MESSAGES

SHWMSG:	MOVEI	S1,.OMDSP		;SETUP OPR DISPLAY MESSAGE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE COUNT
	SETZM	G$ARG1			;[6004]NO NODE BLOCK SEEN
	SETZM	G$ARG2			;[6004]NO NUMBER BLOCK SEEN
	SETZM	G$NSHW			;[6005]REMOTE SHOW ACK MESSAGE NOT SEEN
	SETOM	G$FERR			;[6004]ASSUME FIRST MSG SENT SUCCESSFULLY
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	SHWM.3			;NO..TRY FOR A NUMBER
;**;[6034]At SHWMSG:+8L replace 7 lines with 8 lines  JCR  12/31/89
	$CALL	CHCLUN			;[6034]Check for a CLUSTER-NODE switch
	JUMPF	SHWM.1			;[6034]None, check for a /NODE switch
	SKIPE	S1,G$CLUN		;[6034]Local node specified?
	CAMN	S1,[-1]			;[6034]No, all nodes specified?
	JRST	SHWM.5			;[6034]Yes, treat as a <CR>
	JRST	SHWM10			;[6034]Send a message to NEBULA

SHWM.1:	CAIE	S1,.SWNOD		;[6034]Was it a /NODE switch?
	$RETF				;[6004]INVALID MESSAGE SPECIFIED
	$CALL	P$NODE			;GET THE NODE VALUE
	$RETIF				;INVALID MESSAGE
	MOVEM	S1,G$ARG1		;SAVE NODE NAME
	$CALL	P$SWIT			;[6023]CHECK FOR A SWITCH
	JUMPF	SHWM.2			;[6023]JUMP IF NO SWITCH
;**;[6034]At SHWM.1:+7L replace 3 lines with 7 lines  JCR  12/31/89
	$CALL	CHCLUN			;[6034]Check for a CLUSTER-NODE switch
	JUMPF	SHWM.2			;[6034]None, validate the node name
	SKIPE	S1,G$CLUN		;[6034]Local node specified?
	CAMN	S1,[-1]			;[6034]No, all nodes specified?
	JRST	SHWM.2			;[6034]Yes, validate the node name
	JRST	SHWM10			;[6034]Send a message to NEBULA

SHWM.2:	MOVE	S1,G$ARG1		;[6004]PICK UP THE NODE NAME
	$CALL	FNDNOD			;VALIDATE THE NODE
	JUMPF	[MOVEI	S1,E$NNK	  ;[6004]PICK UP ERROR ROUTINE ADDRESS
		 JRST	SHWM.7 ]	  ;[6004]GO RELEASE MESSAGE PAGE
	MOVE	P1,S1			;SAVE THE NODE ADDRESS
	MOVE	S1,NOD.NM(S1)		;GET THE NODE NAME
	$CALL	OPRENB			;CHECK IF ENABLED FOR NODE
	JUMPF	SHWM.8			;[6004]INVALID NODE
	MOVEI	S1,SHDPBK		;[6005]SHOW MESSAGE  TEXT
	$CALL	SHWMTX			;SHOW MESSAGE TEXT POINTER
	MOVE	S2,P1			;PUT NODE ADDRESS IN S2
	$CALL	MSGNOD			;OUTPUT THE MESSAGES
	JUMPF	SHWM.7			;[6004]GO RELEASE THE MESSAGE PAGE
	$CALL	FINSHW			;[6004]HAVE SOME..SEND IT
	JUMPF	SHWM.8			;[6004]AN ERROR OCCURRED
	JRST	SHWM11			;[6004]CHECK FOR A REMOTE SEND

SHWM.3:	$CALL	P$NUM			;GET A NUMBER
	JUMPF	SHWM.5			;MUST BE CRLF
	MOVEM	S1,G$ARG2		;[6004]SAVE THE MESSAGE NUMBER
	$CALL	P$SWIT			;[6004]CHECK FOR A /CLUSTER-NODE SWITCH
	JUMPF	SHWM.4			;[6004]NO /CLUSTER-NODE SWITCH
;**;[6034]At SHWM.3:+5L replace 6 lines with 7 lines  JCR  12/31/89
	$CALL	CHCLUN			;[6034]Check for /CLUSTER-NODE value
	$RETIF				;[6034]Illegally formatted message
	SKIPE	S1,G$CLUN		;[6034]Local node specified?
	CAMN	S1,[-1]			;[6034]No, all nodes specified?
	JRST	SHWM.4			;[6034]Yes, go pick up the message
	JRST	SHWM10			;[6034]Send a message to NEBULA

SHWM.4:	MOVE	S1,G$ARG2		;[6004]PICK UP THE MESSAGE NUMBER
	$CALL	GETMSG			;GET THE MESSAGE
	JUMPF	[MOVEI	S1,E$NSM	  ;[6004]PICK UP THE MESSAGE ROUTINE ADR
		 JRST	SHWM.7 ]	  ;[6004]GO RELEASE THE MESSAGE PAGE
	MOVEI	S1,SHDPBK		;SHOW MESSAGE  TEXT
	$CALL	SHWMTX			;SHOW MESSAGE TEXT
	$CALL	BLDDPY			;MOVE THE MESSAGE
	$CALL	FINSHW			;[6004]FINISH OFF THE MESSAGE
	JUMPF	SHWM.8			;[6004]RELEASE MESSAGE PAGE ON AN ERROR
	JRST	SHWM11			;[6004]CHECK IF NEED SEND NEBULA A MSG

;Here if just SHOW MESSAGES <cr>
;If system OPR, show all messages, otherwise, just messages
; for this OPRs node

SHWM.5:	MOVEI	S1,SHDPBK		;[6005]SHOW MESSAGE  TEXT
	$CALL	SHWMTX			;SHOW MESSAGE TEXT
	MOVE	S1,G$OPRA		;GET THE OPR ADDRESS
	MOVE	S2,OPR.ND(S1)		;GET THE NODE ADDRESS
	MOVE	S2,NOD.NM(S2)		;GET THE NAME
	$CALL	O$SYSTEM		;IS THIS A SYSTEM OPR?
	JUMPF	SHWM7A			;NO ..DO JUST THIS NODE
	SETZM	P1			;CLEAR MESSAGES FLAG
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%FIRST			;GET FIRST ENTRY
	JUMPF	[MOVEI	S1,E$NOM	  ;[6004]PICK UP ERROR ROUTINE ADDRESS
		 JRST	SHWM.7 ]	  ;[6004]GO RELEASE THE MESSAGE PAGE
SHWM.6:	$CALL	MSGNOD			;GET MESSAGES FOR THIS NODE
	SKIPF				;NO MESSAGES SKIP FLAG SETTING
	SETOM	P1			;MESSAGES FOUND
	MOVE	S1,G$NODL		;GET NODE LIST NUMER
	$CALL	L%NEXT			;GET NEXT ENTRY
	JUMPT	SHWM.6			;PROCESS MESSAGES
	JUMPE	P1,[MOVEI S1,E$NOM	  ;[6004]PICK UP ERROR ROUTINE ADDRESS
		    JRST  SHWM.7 ]	  ;[6004]GO RELEASE THE MESSAGE PAGE
	$CALL	FINSHW			;[6004]SEND THE MESSAGE
	JUMPF	SHWM.8			;[6004]RELEASE MESSAGE PAGE ON AN ERROR
	JRST	SHWM11			;[6004]CHECK IF NEED SEND NEBULA A MSG

;Here for a non-system OPR

SHWM7A:	MOVE	S2,OPR.ND(S1)		;GET THE OPR DATA BASE ENTRY
	$CALL	MSGNOD			;OUTPUT THE MESSAGES
	JUMPF	SHWM.7			;[6004]GO RELEASE THE MESSAGE PAGE
	$CALL	FINSHW			;[6004]FINISH OFF THE MESSAGE
	JUMPF	SHWM.8			;[6004]RELEASE MESSAGE PAGE ON AN ERROR
	JRST	SHWM11			;[6004]CHECK IF NEED SEND NEBULA A MSG

SHWM.7:	SKIPN	G$CLUN			;[6004]NEED TO SEND A MESSAGE TO NEBULA?
	PJRST	0(S1)			;[6004]NO, GO INDICATE ERROR TYPE
	$CALL	0(S1)			;[6004]YES, SET UP G$ERR
	JRST	SHWM.9			;[6004]GO INDICATE AN ERROR HAS OCCURRED

SHWM.8:	SKIPN	G$CLUN			;[6004]NEED TO SEND A MESSAGE TO NEBULA?
	$RETF				;[6004]NO, RETURN NOW

SHWM.9:	SETZM	G$FERR			;[6004]INDICATE AN ERROR HAS OCCURRED
	JRST	SHWM13			;[6004]GO SETUP REMOTE MESSAGE PAGE

SHWM10:	$CALL	P$CFM			;[6004]CHECK FOR A CARRAIGE RETURN
	JUMPF	.POPJ			;[6004]QUIT NOW IF THERE IS NONE
	JRST	SHWM13			;[6004]GO SETUP REMOTE MESSAGE PAGE

SHWM11:	SKIPN	G$CLUN			;[6004]SEND A MESSAGE TO REMOTE NODES?
	$RET				;[6004]NO, RETURN NOW
	$CALL	GETPAG			;[6004]PICK UP A MESSAGE PAGE

SHWM13:	MOVE	S1,[.OHDRS+.NDESZ,,.NMESS] ;[6004]PICK UP THE TYPE WORD
	SETZM	.OARGC(MO)		;[6016]NO ARGUMENT BLOCKS AT THIS TIME
	MOVEM	S1,.MSTYP(MO)		;[6004]PLACE IN THE MESSAGE
	MOVEI	P3,.OHDRS(MO)		;[6004]POINT TO THE CURRENT BLOCK
	SKIPN	S1,G$ARG1		;[6004]A NODE BLOCK IN THE MESSAGE?
	JRST	SHWM14			;[6004]NO, CHECK FOR A NUMBER BLOCK
	MOVEM	S1,ARG.DA(P3)		;[6004]PLACE NODE NAME IN THE MESSAGE
	MOVE	S1,[2,,.CMNOD]		;[6004]PICK UP BLOCK HEADER WORD
	JRST	SHWM15			;[6004]GO FINISH BLOCK
SHWM14:	SKIPN	S1,G$ARG2		;[6004]A NUMBER SPECIFIED IN THE MSG?
	JRST	SHWM16			;[6004]NO, PICK UP CLUSTER-NODE BLOCK
	MOVEM	S1,ARG.DA(P3)		;[6004]PLACE NUMBER IN THE MESSAGE
	MOVE	S1,[2,,.CMNUM]		;[6004]PICK UP THE BLOCK HEADER WORD
SHWM15:	MOVEM	S1,ARG.HD(P3)		;[6004]PLACE IN THE MESSAGE
	MOVSI	S1,2			;[6004]PICK UP BLOCK SIZE
	ADDM	S1,.MSTYP(MO)		;[6004]ADD TO TOTAL MESSAGE LENGTH
	ADDI	P3,2			;[6004]POINT TO THE NEXT BLOCK
	AOS	.OARGC(MO)		;[6004]INCREMENT THE ARGUMENT COUNT
SHWM16:	$CALL	FASNEB			;[6004]FINISH THE MSG AND SEND IT
	JUMPF	.POPJ			;[6004]RETURN NOW ON AN ERROR
	CAMN	TF,G$FERR		;[6004]ERROR ON THE FIRST MESSAGE?
	$RET				;[6004]NO, RETURN NOW
	MOVEM	MO,G$OUTP		;[6004]INDICATE MESSAGE PAGE RELEASED
	$RETF				;[6004]INDICATE AN ERROR OCCURRED

;**;[6042]At SHWM16:+5L add routines SHWBCM, BLDDMH, BLDNOH, BLDDMB, BLDOAD and
;**;[6042]BLDNOD  JCR  4/27/90
SUBTTL	SHWBCM - SHOW BROADCAST-MESSAGES

SHWBCM:	$CALL	P$KEYW			;[6042]Get a keyword
	JUMPF	SHWB.1			;[6042]If none, check for a switch
	CAIE	S1,.KYNOD		;[6042]Is it a node keyword?
	$RETF				;[6042]No, illegally formatted message
	$CALL	P$CURR			;[6042]Pick up current block pointer
	MOVE	S2,PFD.D1(S1)		;[6042]Pick up the node name
	MOVEM	S2,G$ARG1		;[6042]Save the node name
	$CALL	P$NEXT			;[6042]Point to the next block
	SKIPA				;[6042]Don't reset for which node

SHWB.1:	SETOM	G$ARG1			;[6042]Indicate for all nodes
	$CALL	P$SWIT			;[6042]Is there a /CLUSTER-NODE switch?
	JUMPF	SHWB.2			;[6042]No, process locally
	$CALL	CHCLUN			;[6042]Pick up the /CLUSTER-NODE value
	$RETIF				;[6042]Illegally formatted message
	SKIPN	S1,G$CLUN		;[6042]Local node specified?
	JRST	SHWB.2			;[6042]Yes, so ignore the switch
	CAME	S1,[-1]			;[6042]All nodes?
	JRST	SHWB.4			;[6042]No, send remotely
	MOVE	S1,G$ARG1		;[6042]Pick up the node name
	CAME	S1,G$HOST		;[6042]Local node specified?
	JRST	SHWB.3			;[6042]No, check for all nodes
	$CALL	E$IND			;[6042]Yes, indicate an error
	JRST	SHWB.6			;[6042]Continue on

SHWB.2::MOVE	S1,G$ARG1		;[6042]Pick up the node name
	CAMN	S1,G$HOST		;[6042]Local node specified?
	PJRST	E$IND			;[6042]Yes, that's an error
SHWB.3:	MOVEI	S2,BWLIST		;[6042]Pick up the queue header adr
	$CALL	BLDDMH			;[6042]Build the display header
	JUMPF	SHWB.4			;[6042]Check if need to send remotely
	$CALL	BLDDMB			;[6042]Build the display body
	HRRZ	S2,WTOPTR		;[6042]Get the  last address
	SUBI	S2,-1(P3)		;[6042]Get the length
	MOVEI	S1,.CMTXT		;[6042]Get the argument type
	$CALL	ARGRTN			;[6042]Save the argument
	MOVE	S1,.MSFLG(MI)		;[6042]Pick up the flag word
	TXNE	S1,MF.NEB		;[6042]Message originate remotely?
	$RETT				;[6042]Yes, so quit now
	$CALL	FINSHW			;[6042]Finish the message and send
	SETZ	MO,			;[6042]Indicate page has been released
SHWB.4:	SKIPN	G$CLUN			;[6042]Need to send remotely?
	$RET				;[6042]No, so quit now
	JUMPE	MO,SHWB.5		;[6042]Need to get a page?
	MOVE	S1,MO			;[6042]No, pick up the page address
	$CALL	.ZPAGA			;[6042]Zero the page
	SKIPA				;[6042]Set up the page pointer
SHWB.5:	$CALL	GETPAG			;[6042]Yes, pick up a new output page
	MOVEI	P3,.OHDRS(MO)		;[6042]Point to the first argument blk

SHWB.6:	MOVEI	S1,NEB%MS!.OMSBM	;[6042]Pick up the message type
	HRLI	S1,.OHDRS+ARG.DA+1+.NDESZ ;[6042]Pick up the message size
	MOVEM	S1,.MSTYP(MO)		;[6042]Save in the message
	AOS	.OARGC(MO)		;[6042]Set up the argument count
	MOVEI	S1,.ORNOD		;[6042]Pick up the block type
	HRLI	S1,ARG.DA+1		;[6042]Pick up the block length
	MOVEM	S1,ARG.HD(P3)		;[6042]Place in the message
	MOVE	S1,G$ARG1		;[6042]Pick up the node name
	MOVEM	S1,ARG.DA(P3)		;[6042]Place in the message
	ADDI	P3,ARG.DA+1		;[6042]Point to the cluster node block
	$CALL	FASNEB			;[6042]Send the message to NEBULA
	$RET				;[6042]Return to the caller
SUBTTL	BLDDMH - Build the Display Message Header

;[6042]BLDDMH builds the output display message header
;[6042]
;[6042]Call is:       S1/Node name or *
;[6042]               S2/Display message queue header address
;[6042]Returns true:  The output display message header has been built
;[6042]		     S1/The first entry address
;[6042]Returns false: The display message queue is empty

BLDDMH:	$SAVE	<P1,P2>			;[6042]Save some scratch ACs
	DMOVE	P1,S1			;[6042]Save the input arguments
	MOVEI	S1,.OMDSP		;[6042]Pick up the message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6042]Save in the message
	MOVEI	S1,SHODMH		;[6042]Adr of display message header
	$CALL	SHWMTX			;[6042]Place in the message
	DMOVE	S1,P1			;[6042]Pick up the input arguments
	$CALL	BLDNDH			;[6042]Include the node names	
	$RET				;[6042]Return to the caller

SHODMH:	XWD	SHODLN,.ORDSP		;[6042]Display block header
	BLOCK	1			;[6042]Room for the time stamp
	ASCIZ/		-- Broadcast Messages --

	/
SHODLN=.-SHODMH				;[6042]Size of the block
SUBTTL	BLDNDH - Build the Output Display Node Name Header

;[6042]BLDNDH is called to build the node name header for output display
;[6042]SHOW commands.
;[6042]
;[6042]Call is:       S1/Node name or *
;[6042]               S2/Display message queue header address
;[6042]Returns true:  The output display message header built
;[6042]               S1/The output display entry address
;[6042]		     G$ARG2/Number of nodes to be displayed
;[6042]Returns false: The output display message queue is empty

BLDNDH:	$CALL	.SAVET			;[6042]Save some scratch ACs
	DMOVE	T1,S1			;[6042]Save the input arguments
	$CALL	OPRSPT			;[6042]Set up the byte pointer
	CAMN	T1,[-1]			;[6042]For all nodes?
	JRST	BLDN.1			;[6042]Yes, do differently
	DMOVE	S1,T1			;[6042]Pick up the input arguments
	$CALL	MTQFND			;[6042]Pick up the queue entry
	JUMPF	E$BDS			;[6042]Not there, disabled by default
	MOVE	T2,S1			;[6042]Save the queue entry address
	MOVE	T4,T2			;[6042]And here also
	MOVEI	T3,1			;[6042]Only a single node
	JRST	BLDN.2			;[6042]Build the node name header
BLDN.1:	MOVE	T2,S2			;[6042]Save the queue entry address
	LOAD	T3,OPR.HD(T2),OPR.NM	;[6042]Pick up the number of entries
	JUMPE	T3,E$BDD		;[6042]None, so all disabled by default
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the first entry
	MOVE	T4,T2			;[6042]Save for the return
BLDN.2:	MOVEM	T3,G$ARG2		;[6042]Save the number of nodes
BLDN.3:	$TEXT	(OPRRTN,<^N6R/OPR.NN(T2)/  ^A>);[6042]Place node name in the msg
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the next entry
	SOJG	T3,BLDN.3		;[6042]Pick up the next node name
	$TEXT	(OPRRTN,<Message type	>) ;[6042]Finish the line
	MOVE	T3,G$ARG2		;[6042]Pick up the number of nodes
	MOVE	T2,T4			;[6042]Pick up the first entry address
;[6046]At BLDN.4:-2L remove 1 line  JCR  7/6/90
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab
BLDN.4:	$TEXT	(OPRRTN,<------  ^A>)	;[6042]Underline the next node
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the next entry	
	SOJG	T3,BLDN.4		;[6042]Go underline the next entry
	$TEXT	(OPRRTN,<------------	>) ;[6042]Finish the line
	MOVE	S1,T4			;[6042]Return the first entry address
	$RETT
SUBTTL	BLDDMB - Build the Output Display Message Body

;[6042]BLDDMB is called to build the output display message body.
;[6042]
;[6042]Call is:      S1/Address of the first output display message queue entry
;[6042]              G$ARG2/Number of nodes to display
;[6042]Returns true: The output display message body has been built

BLDDMB:	$SAVE	<P1>			;[6042]Save a scratch AC
	MOVE	P1,S1			;[6042]Save the entry address
	MOVEI	S2,MWOTBL		;[6042]Pick up the table address
	$CALL	BLDOAD			;[6042]Include object displays in msg

	MOVE	S1,P1			;[6042]Pick up the entry address
	$CALL	BLDNOD			;[6042]Include non-object displays

IFG NUMAPL,<
	MOVE	S1,P1			;[6042]Pick up the entry address
	MOVEI	S2,APLTBL		;[6042]Pick up the table address
	$CALL	BLDOAD			;[6042]Include the application displays
	$RETT				;[6042]Return to the caller
>;[6042]End of NUMAPL
SUBTTL	BLDOAD - Build the Object and Applications Displays

;[6042]BLDOAD is called to build the output displays associated with an
;[6042]object or an application
;[6042]
;[6042]Call is: S1/Address of the first output display message queue entry
;[6042]         S2/Table of keywords address
;[6042]         G$ARG2/Number of nodes to display
;[6042]Returns: The output display message body has been built


BLDOAD:	$CALL	.SAVET			;[6042]Save some scratch ACs
	$SAVE	<P1,P2,P4>		;[6042]And then some
	MOVE	T1,S1			;[6042]Pick up the entry address
	MOVE	P4,T1			;[6042]Save the entry address
	MOVE	T2,G$ARG2		;[6042]Pick up the number of nodes
	MOVE	P1,S2			;[6042]Save the table address
	HLL	P2,0(P1)		;[6042]Pick up negative entry number
	HRR	P2,0(P1)		;[6042]Pick up ASCIZ string table adr
BLDO.1:	AOS	P1			;[6042]Point to the next table entry
	$CALL	CHKRM			;[6042]Check for room for this line
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab
	MOVE	T3,0(P1)		;[6042]Pick up the object type
	IDIVI	T3,<^D36/<WID(WO.ALL)>>	;[6042]Compute the word offset
	IMULI	T4,<WID(WO.ALL)>	;[6042]Compute the LSH factor
BLDO.2:	MOVEI	S2,OPR.OF(T1)		;[6042]Address of the flag word
	ADD	S2,T3			;[6042]Add in the word offset
	MOVE	S2,0(S2)		;[6042]Pick up the flag word contents
	LSH	S2,0(T4)		;[6042]Shift to beginning of the word
	TXNE	S2,WO.ALL		;[6042]Enabled?
	$TEXT	(OPRRTN,<  Ena   ^A>)	;[6042]Yes
	TXNN	S2,WO.ALL		;[6042]Disabled?
	$TEXT	(OPRRTN,<  Dis   ^A>)	;[6042]Yes
	LOAD	T1,OPR.HD(T1),OPR.PT	;[6042]Point to the next entry	
	SOJG	T2,BLDO.2		;[6042]Get the next node
	$TEXT	(OPRRTN,<^T/@(P2)/>) 	;[6042]Output the message type
	MOVE	T1,P4			;[6042]Pick up the first entry adr
	MOVE	T2,G$ARG2		;[6042]Pick up the number of nodes
	AOBJN	P2,BLDO.1		;[6042]Pick up the next object
	$TEXT	(OPRRTN,<>)		;[6042]Add a blank line
	$RET				;[6042]Return to the caller

MWOTBL:	-MWOLEN,,ODMDSP
	0,,.KYBAT				
	0,,.KYCDP
	0,,.KYBIN
	0,,.KYRET
	0,,.KYMNT
	0,,.KYPTP
	0,,.KYPLT
	0,,.KYLPT
	0,,.KYRDR
	0,,0
MWOLEN==.-MWOTBL-1

ODMDSP:	[ASCIZ/BATCH-MESSAGES/]		;[6042].KYBAT
	[ASCIZ/CARD-PUNCH-MESSAGES/]	;[6042].KYCDP
	[ASCIZ/CARD-READER-INTERPRETER-MESSAGES/] ;[6042].KYBIN
	[ASCIZ/FILE-RETRIEVAL-MESSAGES/];[6042].KYRET
	[ASCIZ/MOUNT-MESSAGES/]		;[6042].KYMNT
	[ASCIZ/PAPER-TAPE-PUNCH-MESSAGES/] ;[6042].KYPTP
	[ASCIZ/PLOTTER-MESSAGES/]	;[6042].KYPLT
	[ASCIZ/PRINTER-MESSAGES/]	;[6042].KYLPT
	[ASCIZ/READER-MESSAGES/]	;[6042].KYRDR
	[ASCIZ/USER-MESSAGES/]		;[6042].KYUSR

IFG	NUMAPL,<

	DEFINE	X(A,B,C,D),<0,,.OTMAX+1+B>
APLTBL:	-APLLEN,,APLDSP
	TABAPL
APLLEN==.-APLTBL-1

	DEFINE	X(A,B,C,D),<[ASCIZ/A'-MESSAGES/]>
APLDSP:	TABAPL
>;END NUMAPL
SUBTTL	BLDNOD - Build the Non-object Displays

;[6042]BLDNOD is called to build the output displays not associated with an
;[6042]object
;[6042]
;[6042]Call is: S1/Address of the first output display message queue entry
;[6042]         G$ARG2/Number of nodes to display
;[6042]Returns: The output display message body has been built

BLDNOD:	$CALL	.SAVET			;[6042]Save some scratch ACs
	$SAVE	<P1,P2,P4>		;[6042]And then some
	MOVE	T1,S1			;[6042]Pick up the entry address
	MOVE	P4,T1			;[6042]Save the entry address
	MOVE	T2,G$ARG2		;[6042]Pick up the number of nodes
	MOVEI	P1,MNOTBL		;[6042]Pick up the table address
	HLL	P2,0(P1)		;[6042]Pick up negative entry number
	HRR	P2,0(P1)		;[6042]Pick up ASCIZ string table adr

BLDNO1:	AOS	P1			;[6042]Point to the next object
	$CALL	CHKRM			;[6042]Check for room for this line
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab
	MOVE	T3,0(P1)		;[6042]Pick up the message type
	IDIVI	T3,^D36			;[6042]Compute word count and remainder

BLDNO2:	MOVEI	S2,OPR.DP(T1)		;[6042]Address of the flag word
	ADD	S2,T3			;[6042]Add in the word offset
	MOVE	S2,0(S2)		;[6042]Pick up the flag word contents
	LSH	S2,0(T4)		;[6042]Shift to beginning of the word
	SKIPGE	S2			;[6042]Enabled?
	$TEXT	(OPRRTN,<  Ena   ^A>) 	;[6042]Yes
	SKIPL	S2			;[6042]Disabled?
	$TEXT	(OPRRTN,<  Dis   ^A>) 	;[6042]Yes
	LOAD	T1,OPR.HD(T1),OPR.PT	;[6042]Point to the next entry	
	SOJG	T2,BLDNO2		;[6042]Get the next node
	$TEXT	(OPRRTN,<^T/@(P2)/>) 	;[6042]Output the message type
	MOVE	T1,P4			;[6042]Pick up the first entry adr
	MOVE	T2,G$ARG2		;[6042]Pick up the number of nodes
	AOBJN	P2,BLDNO1		;[6042]Pick up the next object
	$TEXT	(OPRRTN,<>)		;[6042]Add a blank line
	$RET				;[6042]Return to the caller

MNOTBL:	-MNOLEN,,NDMDSP			;[6042]
	0,,.QBCHK-1			;[6042]BUGCHK-MESSAGES
	0,,.QBINF-1			;[6042]BUGINF-MESSAGES
	0,,.QBEVT-1			;[6042]DECNET-EVENT-MESSAGES
	0,,.QBDLK-1			;[6042]DECNET-LINK-MESSAGES
	0,,.QBSYS-1			;[6042]SYSTEM-MESSAGES
MNOLEN==.-MNOTBL-1			;[6042]

NDMDSP:	[ASCIZ/BUGCHK-MESSAGES/]	;[6042]
	[ASCIZ/BUGINF-MESSAGES/]	;[6042]
	[ASCIZ/DECNET-EVENT-MESSAGES/]	;[6042]
	[ASCIZ/DECNET-LINK-MESSAGES/]	;[6042]
	[ASCIZ/SYSTEM-MESSAGES/]	;[6042]

;**;[6043]At NDMDSP:+5L add routines SHWAKA,SHWDQS,SHWLAT,SHLOCL,SHOWIN,
;**;[6043]OBJOUT, GETNDE, CHKQN and UNICHK  PMM  6/3/90
SUBTTL	SHWAKA - SHOW ALIAS Message Processor

;[6043]SHWAKA processes the SHOW ALIAS message
;[6043]
;[6043]Returns True:  The SHOW ALIAS message has been successfully processed
;[6043]Returns False: Illegally formatted message


SHWAKA:	$SAVE	<T1,T2,T3,T4,P2,P3,P4>

;[6043]First initialize akaobj to -1 

	SETZM	AKAOUT			;[6043]Initialize output counter
	SETOM	AKAOBJ			;[6043]Set first word of object block
	HRLI	T1,AKAOBJ		;[6043]Get source address
	HRRI	T1,AKAOBJ+1		;[6043]Get second word
	BLT	T1,AKAOBJ+OBJ.SQ+7	;[6043]Clear the entire object block
	MOVEI	P4,AKAOBJ		;[6043]Get address of object block
	SETZM	G$NSHW			;[6043]Indicate local processing
	SETZM	LSTENT			;[6043]Initialize last entry

;[6043]Read in alias name or printer specification	

	$CALL	P$KEYW			;[6043]Get the next keyword
	JUMPF	SHWA.2			;[6043]No keyword, alias name or confirm
	CAIN	S1,.KYDQS		;[6043]Is it a DQS printer?
	$CALL	SHWDQS			;[6043]Yes, read in specification
	CAIN	S1,.KYLAT		;[6043]Is it a LAT printer?
	$CALL	SHWLAT			;[6043]Yes, read in specification
	CAIN	S1,.KYCLU		;[6043]Is it a CLUSTER printer?
	$CALL	SHWCLU			;[6043]Yes, read in specification
	CAIN	S1,.KYLOC		;[6043]Is it a LOCAL printer?
	$CALL	SHLOCL			;[6043]Yes, read in specification
	$RETIF				;[6043]Return if invalid message
	$CALL	P$SWIT			;[6043]Check for a switch
	JUMPF	SHWA.1			;[6043]None, check for a CR
	$CALL	CHCLUN			;[6043]Is it a /CLUSTER-NODE switch?
	$RETIF				;[6043]If not, then illegally formatted
SHWA.1:	$CALL	P$CFM			;[6043]Is there a CR?
	$RETIF				;[6043]If not, then illegally formatted
	SKIPN	S1,G$CLUN		;[6043]Local node specified
	JRST	SHWA.6			;[6043]Yes, search the linked list
	CAME	S1,[-1]			;[6043]For all nodes?
	JRST	SHWA10			;[6043]No, send remotely
	JRST	SHWA.6			;[6043]Search linked list

;[6043]Determine if it's an alias name or a confirm

SHWA.2:	CAIE	S1,.AKANM		;[6043]Is it an alias?
	JRST	SHWA.4			;[6043]No, search ORION's list
	MOVEI	P4,AKAOBJ		;[6043]Get address for model obj block
	$CALL	SHWALI			;[6043]Read in alias name
	$CALL	P$SWIT			;[6043]Check for a switch
	JUMPF	SHWA2A			;[6043]None, pick up model obj blk adr
	$CALL	CHCLUN			;[6043]Is it a /CLUSTER-NODE switch?
	$RETIF				;[6043]If not, then illegally formatted
	$CALL	P$CFM			;[6043]Check for a CR
	$RETIF				;[6043]Quit now if illegally formatted
	SKIPN	S1,G$CLUN		;[6043]Local node specified?
	JRST	SHWA.3			;[6043]Yes, process as locally
	CAME	S1,[-1]			;[6043]For all nodes?
	JRST	SHWA10			;[6043]No, send remotely
	JRST	SHWA.3			;[6043]Pick up model object block adr
SHWA2A:	$CALL	P$CFM			;[6043]Check for a CR
	$RETIF				;[6043]Quit now if illegally formatted

SHWA.3::MOVEI	P4,AKAOBJ		;[6043]Get address for model obj block
	MOVE	S1,OBJ.AK(P4)		;[6043]Get alias name
	$CALL	FINDAK			;[6043]Find its mapping in linked list
	JUMPT	SHWA3A			;[6043]Found the mapping
	MOVEM	S1,G$ARG3		;[6043]Place alias name where expected
	PJRST	E$AKI			;[6043]Set up the error
SHWA3A:	MOVE	P4,S2			;[6043]Save address
	$CALL	SAKHDR			;[6043]Set up pointers & display hdr
	MOVE	S1,G$HOST		;[6043]Get host
	MOVEM	S1,G$ARG1		;[6043]Save it
	MOVE	S2,P4			;[6043]Get address of printer
	$CALL	SHOWIN			;[6043]Include this entry in display
	$CALL	SHWDON			;[6043]Send message to OPR
	$RET				;[6043]Return to the caller

SHWA.4: $CALL	P$SWIT			;[6043]Check for /CLUSTER-NODE switch
	JUMPF 	SHWA.5			;[6043]Check for confirm
	$CALL	CHCLUN			;[6043]Check for /CLUSTER-NODE value
	$RETIF				;[6043]Invalid message
	SKIPN	S1,G$CLUN		;[6043]Is it a local command?
	JRST	SHWA.5			;[6043]Yes, process locally
	CAME	S1,[-1]			;[6043]Is it for all nodes?
	JRST	SHWA10			;[6043]No, process remotely

SHWA.5:	$CALL	P$CFM			;[6043]Read in the confirm
	$RETIF				;[6043]Return if not there

;[6043]Search ORION's linked list for valid entries 

SHWA.6::$CALL	SAKHDR			;[6043]Set up the message
	MOVEI	P4,AKAOBJ		;[6043]Get address for model obj block
	MOVE	S1,G$HOST		;[6043]Get host
	MOVEM	S1,G$ARG1		;[6043]Save it

	MOVE	T1,OBJ.TY(P4)		;[6043]Get model's object type
	MOVE	T2,OBJ.ND(P4)		;[6043]Get model's object node
	MOVE	T3,OBJ.UN(P4)		;[6043]Get model's unit number
	MOVE	T4,OBJ.QN(P4)		;[6043]Get model's queue name
	SKIPA	S2,HDRAKA		;[6043]Get the linked list header
SHWA.7:	LOAD	S2,.QELNK(S2),QE.PTN	;[6043]Get the next entry
	SKIPN	S2			;[6043]End of list?
	JRST	SHWDON			;[6043]Yes 
	SKIPGE	T1			;[6043]Is it ALL entry types?
	JRST	SHWA.9			;[6043]Yes, add entry
	CAME	T1,OBJTYP(S2)		;[6043]Same object type?
	JRST	SHWA.7			;[6043]No, check the next entry

	TXNE	T1,.LALPT		;[6043]Is it a LAT printer?
	JRST	SHWA.8			;[6043]Yes, check queue name

	CAME	T1,[.OTLPT]		;[6043]A local printer?
	JRST	SHWA7B			;[6043]No, check the node type
	SKIPGE	T3			;[6043]Was a unit or units specified?
	JRST	SHWA7A			;[6043]No, check the node type
	CAMN	T3,OBJUNI(S2)		;[6043]Are the units equal?
	JRST	SHWA7A			;[6043]Yes, check the nodes
	$CALL	UNICHK			;[6043]Check if a range was specified
	JUMPF	SHWA.7			;[6043]No match, process the next entry
SHWA7A:	CAMN	T2,[-1]			;[6043]Is it for 'ALL' nodes?
	JRST	SHWA.9			;[6043]Yes, add the entry
	CAME	T2,OBJNOD(S2)		;[6043]Same node name?
	JRST	SHWA.7			;[6043]No, process the next entry
	JRST	SHWA.9			;[6043]Add this entry

SHWA7B:	CAMN	T2,[-1]			;[6043]Is it for 'ALL' nodes?
	JRST	SHWA.9			;[6043]Yes, add entry
	CAME	T2,OBJNOD(S2)		;[6043]Same node name?
	JRST	SHWA.7			;[6043]No, process next entry

	SKIPGE	T3			;[6043]Is it for 'ALL' units?
	JRST	SHWA.9			;[6043]Yes, add entry
	CAMN	T3,OBJUNI(S2)		;[6043]Are the units equal?
	JRST	SHWA.8			;[6043]Yes, check the queue names

	$CALL	UNICHK			;[6043]Check if a range was specified
	JUMPF	SHWA.7			;[6043]No match, process the next entry
	JRST	SHWA.9			;[6043]Add this entry

SHWA.8:	CAMN	T4,[-1]			;[6043]Is it for all queue names?
	JRST	SHWA.9			;[6043]Yes add entry
	CAME	T4,OBJ.QN+1(S2)		;[6043]Same type of queue?
	JRST	SHWA.7			;[6043]No, loop to the next entry
	MOVE	S1,OBJ.QN+1(P4)		;[6043]Get first word of the queue name
	CAMN	S1,[-1]			;[6043]For all queue names?
	JRST	SHWA.9			;[6043]Yes, add this entry

;[6043]Compare queue names:

	MOVE	P2,S2			;[6043]Preserve current entry
	AOS	S2			;[6043]Bump address of current entry
	MOVE	S1,P4			;[6043]Get model object block address
	$CALL	CHKQN			;[6043]Are queue names equal?
	MOVE	S2,P2			;[6043]Restore address of current entry
	JUMPF	SHWA.7			;[6043]No, loop to next entry

	TXNN	T1,.LALPT		;[6043]A LAT printer?
	JRST	SHWA.9			;[6043]No, so add the entry now
	CAME	T2,OBJNOD(S2)		;[6043]Same SERVER name?
	JRST	SHWA.7			;[6043]No, loop to the next entry

SHWA.9:	$CALL	SHOWIN			;[6043]Yes, add entry to list
	JRST	SHWA.7			;[6043]Process next entry

;[6043]Remote processing of SHOW ALIAS

SHWA10:	SKIPN	MO			;[6043]Need an output page?
	$CALL	GETPAG			;[6043]Yes, get a page
	HRLI	S1,0(MO)		;[6043]Source
	HRRI	S1,1(MO)		;[6043]Source,,destination
	SETZM	0(MO)			;[6043]Zero the source
	BLT	S1,.OARGC(MO)		;[6043]Zero the message header
	MOVEI	S1,NEB%MS!.OMSAK	;[6043]Get message type
	HRLI	S1,.OHDRS+AKBSIZ+.NDESZ	;[6043]Get length of message
	MOVEM	S1,.MSTYP(MO)		;[6043]Save in message
	MOVEI	P3,.OHDRS(MO)		;[6043]Point at first argument
	AOS	.OARGC(MO)		;[6043]Increment argument count
	HRLI	T1,AKAOBJ		;[6043]Source address of object block
	HRRI	T1,ARG.DA(P3)		;[6043]Destination address 
	BLT	T1,ARG.DA+OBJ.SQ-1(P3)	;[6043]Put object block in message
	MOVEI	S1,.OROBJ		;[6043]Get object block type
	HRLI	S1,AKBSIZ		;[6043]Get object block size
	MOVEM	S1,ARG.HD(P3)		;[6043]Save in message
	ADDI	P3,AKBSIZ		;[6043]Point at next object block
	$CALL	FASNEB			;[6043]Send to NEBULA
	$RET				;[6043]Return

SHWDON:	SKIPN	AKAOUT			;[6043]Were there any eligible entries?
	JRST	SHWD.1			;[6043]No, check for remote processing
	HRRZ	S2,WTOPTR		;[6043]Get the last address
	SUBI	S2,-1(P3)		;[6043]Get the length
	MOVEI	S1,.CMTXT		;[6043]Get the argument type
	$CALL	ARGRTN			;[6043]Save the argument
	SKIPE	G$NSHW			;[6043]Message originate remotely?
	$RETT				;[6043]Yes, return now
	$CALL	FINS.1			;[6043]Finish and send the message
	SETZ	MO,			;[6043]Indicate page has been released
	SKIPA				;[6043]Do not issue message
SHWD.1:	$CALL	E$NAD			;[6043]Issue 'no aliases'  message
	SKIPN	G$CLUN			;[6043]Is it a local command?
	$RET				;[6043]Yes return
	JRST	SHWA10			;[6043]No, process remotely

;[6043]Routine SHWALI reads in the alias name.

SHWALI:	$CALL 	P$CURR			;[6043]Pick up the .AKANM header
	$CALL	P$NEXT			;[6043]Bump to the next field
	AOS	S1			;[6043]Bump to address of SIXBIT alias 
	MOVE	S2,(S1)			;[6043]Get SIXBIT alias 
	MOVEM	S2,OBJ.AK(P4)		;[6043]Save alias in model object block
	$RET				;[6043]Return

SHWDQS:	MOVX	S1,.DQLPT!.OTLPT	;[6043]Get printer object type
	MOVEM	S1,OBJ.TY(P4)		;[6043]Indicate in model type
	$CALL	P$FLD			;[6043]Pick up the name
	JUMPF	.RETT			;[6043]Return now if no queue name
	AOS	S1			;[6043]Bypass the parser header block
	MOVSS	S1			;[6043]Prepare the source of the blt
	MOVEI	T1,OBJ.QN+1(P4)		;[6043]Point at queue name
	HRRI	S1,(T1)			;[6043]Source,,destination of the blt
	ADD	T1,S2			;[6043]End address + 2
	BLT	S1,-2(T1)		;[6043]Move name into message
	MOVEI	S2,.KYDQS		;[6043]Pick up the block type
	HRLI	S2,LPTNLN		;[6043]Pick up block length

	MOVEM	S2,OBJ.QN(P4)		;[6043]Save the block header
	SETZM	OBJ.UN(P4)		;[6043]Always 0 for DQS LPTs

	$CALL	GETNDE			;[6043]Pick up the node name
	$RET				;[6043]Preserve the T/F indicator


SHWCLU:	$SAVE	<P1,P3>			;[6043]Smashed by routine FINNUM
	MOVX	S1,.CLLPT!.OTLPT	;[6043]Get printer object type
	MOVEM	S1,OBJ.TY(P4)		;[6043]Indicate in model type
	$CALL	P$NUM			;[6043]Is there a number?
	JUMPF	.RETT			;[6043]No, so return now
	MOVEI	P3,-1(P4)		;[6043]Get address of AKAOBJ
	$CALL 	FINNUM			;[6043]Read in number or range
	$RETIF				;[6043]Return on an error
	SKIPL	S1,OBJ.UN(P4)		;[6043]Pick up the unit field
	JRST	SHWC.1			;[6043]A range was specified
	TXZ	S1,LHMASK		;[6043]Change upper unit from -1 to 0
	MOVEM	S1,OBJ.UN(P4)		;[6043]Save updated unit field
SHWC.1:	$CALL	GETNDE			;[6043]Pick up the node name
	$RET				;[6043]Preserve the T/F indicator

SHWLAT:	MOVX	S1,.LALPT!.OTLPT	;[6043]Get printer object type
	MOVEM	S1,OBJ.TY(P4)		;[6043]Indicate in model type
	$CALL	P$KEYW			;[6043]Is there a keyword?
	JUMPF	.RETT			;[6043]No, so return now
	CAIE	S1,.KYPOR		;[6043]Is it PORT keyword?
	CAIN	S1,.KYSER		;[6043]or a SERVER keyword?
	SKIPA				;[6043]Legal keyword specified
	$RETF				;[6043]Illegally formatted message
	HRLI	S1,LPTNLN		;[6043]Pick up the block length
	MOVEM	S1,OBJ.QN(P4)		;[6043]Save the type of name
	$CALL	P$FLD			;[6043]Pick up the name if specified
	JUMPF	.RETT			;[6043]Not specified, return now
	AOS	S1			;[6043]Bypass the parser header block
	MOVSS	S1			;[6043]Prepare the source of the BLT
	HRRI	S1,OBJ.QN+1(P4)		;[6043]Source,,destination of the BLT
	ADDI	S2,OBJ.QN-1(P4)		;[6043]End address
	BLT	S1,(S2)			;[6043]Move name into message
	MOVEI	S2,LPTNLN		;[6043]Pick up block length
	STORE	S2,OBJ.QN(P4),AR.LEN	;[6043]Save the length of this block
	SETZM	OBJ.UN(P4)		;[6043]Always zero for LAT printers
	$CALL	GETNDE			;[6043]Pick up node or server name
	$RET				;[6043]Preserve the T/F indicator

SHLOCL:	$SAVE	<P1,P3>			;[6043]Smashed by routine FINNUM
	MOVEI	S1,.OTLPT		;[6043]Get printer object type
	MOVEM	S1,OBJ.TY(P4)		;[6043]Indicate in model type
	$CALL	P$SWIT			;[6043]Is there a Switch?
	JUMPT	SHLO.2			;[6043]Yes, go check the type
	$CALL	P$NUM			;[6043]No, check for a unit number
	JUMPF	.RETT			;[6043]If none, then return
	MOVEI	P3,-ARG.DA(P4)		;[6043]Model address expected by FINNUM
	$CALL	FINNUM			;[6043]Set up the unit field
	$RETIF				;[6043]Quit if illegally formatted
	SKIPL	S1,OBJ.UN(P4)		;[6043]Pick up the unit field
	JRST	SHLO.1			;[6043]A range was specified
	TXZ	S1,LHMASK		;[6043]Change upper unit from -1 to 0
	MOVEM	S1,OBJ.UN(P4)		;[6043]Save updated unit field
SHLO.1:	$CALL	P$SWIT			;[6043]Is there a switch?
	JUMPT	SHLO.2			;[6043]Yes, check its type
	$RETT				;[6043]Return to the caller
SHLO.2:	CAIE	S1,.SWNOD		;[6043]Was it a node?
	JRST	SHLO.3			;[6043]No, it may be a /CLUSTER-NODE
	$CALL	P$NODE			;[6043]Pick up the node name
	$RETIF				;[6043]Pass on any error
	MOVEM	S1,OBJ.ND(P4)		;[6043]Save the node name
	SETOM	G$NOFG			;[6043]Indicate /NODE switch specified	
	$RET				;[6043]Return to the caller
SHLO.3:	$CALL	CHCLUN			;[6043]Check for a /CLUSTER-NODE
	$RET				;[6043]Preserve the T/F indicator

SHOWIN:	$CALL	.SAVET			;[6043]Save these ACs
	SKIPN	T1,LSTENT		;[6043]Is this the first entry?
	JRST	SHWN.1			;[6043]Yes, set up headers
	CAME	T1,OBJTYP(S2)		;[6043]Same as current entry?
	JRST	SHWN.1			;[6043]No, set up headers

	MOVX	T4,.LALPT!.OTLPT	;[6043]Get LAT printer type
	CAME	T4,T1			;[6043]Is this a LAT printer?

	JRST	SHWN.2			;[6043]No, no need to check queue type
	LOAD	T2,.QELNK(S2),QE.PTP	;[6043]Pick up the previous entry's adr
	LOAD	T1,OBJNAM(T2),AR.TYP	;[6043]Get queue type of last entry
	LOAD	T2,OBJNAM(S2),AR.TYP	;[6043]Get queue type of current entry
	CAME	T1,T2			;[6043]Are they the same?
SHWN.1:	$CALL	OBJOUT			;[6043]No, set up headers
SHWN.2:	MOVE	T1,OBJTYP(S2)		;[6043]Get current object type
	MOVX	T2,.CLLPT!.OTLPT	;[6043]Get Cluster printer type
	CAME	T2,T1			;[6043]Is this a CLUSTER printer?
	JRST	SHWN.3			;[6043]No, check for LAT printer
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT(OPRRTN,<  ^W6R/OBJAKA(S2)/    ^D4R/OBJUNI(S2)/  ^W6R/OBJNOD(S2)/^A>)
	JRST	SHWN.6			;[6043]Update counters

SHWN.3:	MOVX	T2,.LALPT!.OTLPT	;[6043]Get LAT printer type
	CAME	T2,T1			;[6043]Is this a LAT printer?
	JRST	SHWN.4			;[6043]Skip $TEXT macro
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT(OPRRTN,<  ^W6R/OBJAKA(S2)/    ^T16R/OBJNAM+ARG.DA(S2)/    ^N6R/OBJNOD(S2)/  ^A>)
	JRST	SHWN.6			;[6043]Update counters

SHWN.4:	MOVX	T2,.DQLPT!.OTLPT	;[6043]Get DQS printer type
	CAME	T2,T1			;[6043]Is this a DQS printer?	
	JRST	SHWN.5			;[6043]Skip $TEXT 
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT(OPRRTN,<  ^N6R/OBJAKA(S2)/   ^T31R/OBJNAM+ARG.DA(S2)/  ^N6R/OBJNOD(S2)/^A>)

	JRST	SHWN.6			;[6043]Update counters

SHWN.5:	moveI	T2,.OTLPT		;[6043]Get printer type
	CAME	T2,T1			;[6043]Is this a LOCAL printer?	
	JRST	SHWN.6			;[6043]Skip $TEXT macro
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT(OPRRTN,<  ^W6R/OBJAKA(S2)/    ^D4R/OBJUNI(S2)/  ^W6R/OBJNOD(S2)/^A>)

SHWN.6:	$CALL	CRLF			;[6043]Output a CRLF	
	MOVE	T1,OBJTYP(S2)		;[6043]Get object type of last entry
	MOVEM	T1,LSTENT		;[6043]Save current as last entry
	AOS	AKAOUT			;[6043]Update entry counter
	$RET				;[6043]Return

OBJOUT:	$SAVE	<T1>			;[6043]Save AC
;[6043]Don't smash AC S2!!!	
	$CALL	CRLF			;[6043]Output a carriage return	
	MOVE	T1,OBJTYP(S2)		;[6043]Get object type of entry
	MOVX	T2,.LALPT!.OTLPT	;[6043]Get LAT printer type
	CAMN	T2,T1			;[6043]Is this a LAT printer?
	JRST	OBJO.3			;[6043]Yes, set up LAT header

	MOVX	T2,.CLLPT!.OTLPT	;[6043]Get CLUSTER printer type
	CAMN	T2,T1			;[6043]Is it a CLUSTER printer?
	JRST	OBJO.1			;[6043]Yes, set up CLUSTER header

	MOVX	T2,.DQLPT!.OTLPT	;[6043]Get DQS printer type
	CAMN	T2,T1			;[6043]Is it a DQS printer?
	JRST	OBJO.2			;[6043]Yes, set up DQS header

	MOVEI	T2,.OTLPT		;[6043]Get printer type
	CAME	T2,T1			;[6043]Is this a LOCAL printer?	
	$RETF				;[6043]BIG PROBLEM!!

	$TEXT	(OPRRTN,<Local printers>)	;[6043]Indicate local printers
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  Alias     Unit   Node  >)	
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  ------    ----  ------  >) ;[6043]Underline the fields

	$RET				;[6043]Return

OBJO.1:	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<Cluster printers>)	;[6043]Output the printer type
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  Alias     Unit   Node  >)	
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  ------    ----  ------  >) ;[6043]Underline the fields
	$RET				;[6043]And return

OBJO.2:	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<DQS printers>)	;[6043]Output the printer type
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  Alias              DQS queue name          Node  >) 
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  ------    ------------------------------  ------  >) 					;[6043]
	$RET

OBJO.3:	LOAD	S1,OBJNAM(S2),AR.TYP	;[6043]Pick up name type
	CAIE	S1,.KYPOR		;[6043]Is it a LAT PORT?
	JRST	OBJO.4			;[6043]No, it is a LAT SERVICE
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<LAT PORT printers>)	;[6043]Indicate the LAT TYPE
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  Alias        Port name        Server  >) 
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  ------    ----------------    ------  >)
	$RET	

;LAT SERVICE printer status

OBJO.4:	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<LAT SERVICE printers>) ;[6043]Indicate the lat type
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  Alias       Service name      Server  >) ;[6043]
	$CALL	CHKRM			;[6043]Check for room for this line
	$TEXT	(OPRRTN,<  ------    ----------------    ------  >)
	$RET
	SUBTTL	GETNDE - Pick up a Node or Server Name

;[6043]GETNDE is called to check if the next field of a command message
;[6043](.OMCMD) is a keyword of type node (.KYNODE) or type server (.KYSRV). 
;[6043]If the keyword is found, then the node (server) name is placed in 
;[6043]the node field of the object block pointed to by P4.
;[6043]
;[6043]Call is:	     P4/Address of an object block
;[6043]Returns true:  The node (server) name is placed in the object block
;[6043]Returns false: The next field is not a keyword or is a keyword but
;[6043]               not of type node or server

GETNDE:	$CALL	P$KEYW			;[6043]Pick up the keyword
	$RETIF				;[6043]Indicate msg illegally formatted
	CAIE	S1,.KYNOD		;[6043]A node keyword?
	CAIN	S1,.KYSRV		;[6043]A server keyword?
	SKIPA
	$RETF				;[6043]No, message illegally formatted
	$CALL	P$NODE			;[6043]Pick up the NODE (SERVER) name
	$RETIF				;[6043]Pass on any error
	MOVEM	S1,OBJ.ND(P4)		;[6043]Save the NODE (SERVER) name
	$RETT				;[6043]Return to the caller
	SUBTTL	CHKQN - Compare Remote Printer Queue Names

;[6043]CHKQN is called to compare DQS VMS queue names, LAT PORT names, LAT 
;[6043]SERVICE names, or LAT SERVER names.
;[6043]
;[6043]Call is:       S1/Address of the first object block
;[6043]               S2/Address of the second object block
;[6043]Returns true:  The names are the same and of the same type
;[6043]Returns false: The names are different or not of the same type
;[6043]In both cases: S1/Flags from the compare


CHKQN:	$SAVE	<P1,P2>			;[6043]Save these ac
	DMOVE	P1,S1			;[6043]Save the addresses
	LOAD	S1,OBJ.QN(P1),AR.TYP	;[6043]Pick up the name type
	LOAD	S2,OBJ.QN(P2),AR.TYP	;[6043]Pick up the name type
	CAME	S1,S2			;[6043]Are they the same?
	$RETF				;[6043]No, indicate to the caller

	HRROI	S1,OBJ.QN+1(P1)		;[6043]Point to the name
	HRROI	S2,OBJ.QN+1(P2)		;[6043]Point to the name
	$CALL	S%SCMP			;[6043]Compare the names
	TXNE	S1,SC%LSS!SC%SUB!SC%GTR	;[6043]Are they the same?
	$RETF				;[6043]No, indicate to the caller
	$RETT				;[6043]Yes, indicate to the caller
	SUBTTL	UNICHK - Check the Unit Fields

;[6043]UNICHK is called  after it has been determined that the unit fields
;[6043]of the model object block and that of the current alias entry do
;[6043]not match. It is possible that the model object block may contain
;[6043]a range of units. UNICHK determines if this is the case, and if it is,
;[6043]then a check is made to determine if the current alias entry unit
;[6043]field is within the specified range.
;[6043]
;[6043]Call is:       P4/Address of the model object block
;[6043]               S2/Address of the current alias name list entry
;[6043]Returns true:  The units match
;[6043]Returns false: The units do not match

UNICHK:	LOAD	S1,OBJ.UN(P4),OU.HRG	;[6043]Get the high range
	JUMPE	S1,.RETF		;[6043]Fail if no range 
	CAMGE	S1,OBJUNI(S2)		;[6043]Within the high range?
	$RETF				;[6043]No, indicate no match
	LOAD	S1,OBJ.UN(P4),OU.LRG	;[6043]Get the low range
	CAMLE	S1,OBJUNI(S2)		;[6043]Within the low range?
	$RETF				;[6043]No, indicate no match
	$RETT				;[6043]Indicate a match
	SUBTTL	FASNEB - Finish message to NEBULA and then send it

;**;[6034]At FASNEB:+0L replace 6 lines with 4 lines  JCR  12/31/89
;**;[6032]At FASNEB:+0L change 1 line  JCR  11/29/89
FASNEB:	DMOVE	S1,G$CBLK		;[6034]Pick up the remote node block
	DMOVEM	S1,ARG.HD(P3)		;[6034]Place in the message
	MOVX	S1,MF.NEB		;[6034]Pick up the remote origin bit
	IORM	S1,.MSFLG(MO)		;[6034]Set in the message
	AOS	.OARGC(MO)		;[6004]INCREMENT THE ARGUMENT COUNT

	$CALL	SNDNEB			;[6004]SEND THE MESSAGE TO NEBULA
	$RET				;[6004]PRESERVE T/F INDICATOR

;**;[6034]At FASNEB:+8L remove routine SWITYP  JCR  12/31/89
	SUBTTL	FINSHW	Finish a SHOW message

;This Routine will finish off a SHOW OPERATOR or SHOW MESSAGES
;command and LOG it.

FINSHW:	$CALL	P$CFM			;END OF MESSAGE
	$RETIF				;ERROR..RETURN
FINS.1:	ANDI	P3,777			;GET MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE LENGTH IN MESSAGE
	$SAVE	<T1,T2>			;WE KNOW L$SHWM SMASHES THESE
	$CALL	L$SHWM##		;LOG THE SHOW MESSAGE
	MOVE	S1,G$SND		;GET THE SENDERS PID
	MOVEI	S2,PAGSIZ		;SEND A PAGE
	$CALL	SPDOPR			;SEND THE MESSAGE
	$RETT				;RETURN TRUE
SUBTTL	MSGNOD	 Routine to Build Display Blocks for a Node

;CALLED WITH S2 CONTAINING THE ADDRESS OF AN ENTRY IN THE NODE LIST
;MO MUST POINT AT A OPERATOR DISPLAY MESSAGE

MSGNOD:	LOAD	S1,NOD.ML(S2)		;GET THIS NODE'S MESSAGE LIST NUMBER
	MOVE	T1,S1			;SAVE MESSAGE LIST NUMBER
	$CALL	L%FIRST			;FIND THE FIRST MESSAGE
	JUMPF	[MOVEI	S1,E$NMN	  ;[6023]INDICATE NO MESSAGE
		 $RET ]			  ;[6005]RETURN TO THE CALLER
MSGN.1:	$CALL	BLDDPY			;GO BUILD A DISPLAY BLOCK
MSGN.2:	MOVE	S1,T1			;COPY MESSAGE LIST NUMBER TO S1
	$CALL	L%NEXT			;FIND NEXT ENTRY
	JUMPT	MSGN.1			;LOOP FOR ALL MESSAGES
	$RETT				;LOOP IF NO MORE


SUBTTL	BLKDPY	Build message into output

;THIS ROUTINE WILL MOVE TEXT BLOCK FROM MESSAGE LIST TO OUTPUT MESSAGE MO
;CALLED WITH:	S2	ADDRESS OF MESSAGE ENTRY

BLDDPY:	MOVSI	T3,MSL.SZ(S2)		;ADDRESS OF MESSAGE TEXT
	HRR	T3,P3			;FIRST FREE OUTPUT ADDRESS
	LOAD	T4,MSL.SZ(S2),AR.LEN	;LENGTH OF THE BLOCK
	ADD	P3,T4			;COMPUTE ENDING ADDRESS
	CAIL	P3,777(MO)		;MAKE SURE WILL FIT IN MESSAGE
	PJRST	BLDD.1			;NO..SEND AND CONTINUE ON
	BLT	T3,-1(P3)		;MOVE THE BLOCK
	AOS	.OARGC(MO)		;CLEAR THE ARGUMENT COUNT
	$RETT				;RETURN TRUE
BLDD.1:	PUSH	P,S2			;SAVE MESSAGE ADDRESS
	MOVX	S1,WT.MOR		;SET MORE COMING FLAG
	IORM	S1,.OFLAG(MO)		;TURN ON THE FLAG
	SKIPE	G$NSHW			;[6005]DID THIS MSG ORIGINATE REMOTELY?
	JRST	BLDD.2			;[6005]YES, TREAT DIFFERENTLY
	$CALL	FINS.1			;SEND THE MESSAGE
	$CALL	GETPAG			;GET A PAGE FOR OUTPUT
	MOVX	S1,.OMDSP		;SETUP DISPLAY MESSAGE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE
	MOVEI	P3,.OHDRS(MO)		;GET FIRST FREE ADDRESS
	JRST	BLDD.3			;[6005]GO PICK UP THE NEXT MESSAGE

;A SHOW MESSAGES THAT ORIGINATED FROM A REMOTE NODE

BLDD.2:	ANDI	P3,777			;[6005]DETERMINE MESSAGE SIZE
	STORE	P3,.MSTYP(MO),MS.CNT	;[6005]SAVE THE MESSAGE SIZE
	$CALL	L$NRSW##		;[6005]LOG THE MESSAGE
	$CALL	N$SNEB			;[6005]SEND THE MESSAGE TO NEBULA
	PJRST	LOGNSE

	$CALL	GETPAG			;[6005]PICK UP A PAGE FOR NEXT MSG
	MOVEI	S1,.OMACS		;[6005]PICK UP THE MESSAGE CODE
	$CALL	BLDHDR			;[6005]BUILD THE MESSAGE HEADER
	MOVEI	S1,SHDPBK		;[6005]PICK UP DISPLAY BLOCK ADDRESS
	$CALL	SHWMTX			;[6005]PLACE IN THE MESSAGE

BLDD.3:	POP	P,S2			;[6005]RESTORE S2
	JRST	BLDDPY			;[6005]TRY THIS ONE AGAIN
SUBTTL	GETMSG	Get a message given the number

;THIS ROUTINE WILL BE CALLED WITH THE MESSAGE NUMBER IN S1
;AND RETURN TRUE WITH MESSAGE ENTRY ADDRESS IN S2

GETMSG:	$SAVE	<P1>			;[6005]SAVE THIS AC
	MOVE	P1,S1			;[6005]SAVE THE MESSAGE NUMBER
	MOVE	S2,G$OPRA		;GET THE OPR ENTRY ADDRESS
	MOVE	S2,OPR.ND(S2)		;GET NODE ENTRY ADDRESS
	MOVEI	T1,MSL.ID		;GET MESSAGE ID
	HRRM	T1,FNDXCT		;SAVE FOR COMPARE
	$CALL	CHKMSG			;CHECK FOR MESSAGE..THIS NODE
	$RETIT				;O.K. FOUND..SEND ANSWER
	MOVE	S1,G$OPRA		;GET OPR ADDRESS
	$CALL	O$SYSTEM		;SYSTEM OPR?
	$RETIF				;Return on failure
	MOVE	S2,OPR.ND(S1)		;GET NODE ENTRY
	MOVE	S1,P1			;GET NUMBER OF ANSWER
	MOVEI	T1,MSL.ID		;GET MESSAGE ID
	HRRM	T1,FNDXCT		;SAVE FOR COMPARE
	PJRST	FNDMSG			;CHECK FOR MESSAGE AND RETURN
SUBTTL	FNDMSG	Find a message for node

;THIS ROUTINE WILL SEARCH ALL NODES AND CHECK FOR MESSAGE
;
;CALL	S1/	MESSAGE NUMBER
;
;RETURN	TRUE	S2/ ADDRESS OF MESSAGE ENTRY


FNDMSG:	$CALL	.SAVE2			;SAVE P1 AND P2
	MOVE	P1,S1			;RELOCATE SEQUENCE NUMBER
FNDM.1:	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%FIRST			;FIND THE FIRST ONE
	$RETIF				;EMPTY NODE LIST
FNDM.2:	MOVE	S1,P1			;MESSAGE TO SEARCH FOR
	$CALL	CHKM.1			;CHECK NODE FOR MESSAGE
	JUMPT	FNDM.3			;FOUND ..RETURN
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER AGAIN
	$CALL	L%NEXT			;LOOK FOR THE NEXT NODE
	JUMPT	FNDM.2			;LOOP
	$RETF				;FAILURE
FNDM.3:	MOVE	P1,S2			;SAVE THE ENTRY
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%RENT			;REMEMBER THE ENTRY
	$RETIF				;Can't remember???
	MOVE	S2,P1			;RESTORE MESSAGE ADDRESS
	$RETT				;RETURN TRUE
SUBTTL	CHKMSG	Search node for a message

;THIS ROUTINE WILL CHECK FOR THE MESSAGE AT A NODE
;
;CALL	S1/	MESSAGE NUMBER
;	S2/	NODE ADDRESS
;
;RETURN	TRUE:	S2/	MESSAGE ADDRESS

CHKMSG:	$CALL	.SAVE2			;SAVE P1 AND P2
CHKM.1:	DMOVE	P1,S1			;SAVE THE MESSAGE ID AND NODE ADDRESS
	LOAD	S1,NOD.ML(P2)		;GET THE MESSAGE LIST NUMBER
	$CALL	L%FIRST			;FIND THE FIRST MESSAGE
	$RETIF				;RETURN..IF NONE THERE
CHKM.2:	XCT	FNDXCT			;EXECUTE THE MATCH
	JRST	CHKM.4			;SAVE THE ENTRY
CHKM.3:	MOVE	S1,NOD.ML(P2)		;GET MESSAGE LIST NUMBER AGAIN
	$CALL	L%NEXT			;FIND NEXT MESSAGE IN THE LIST
	JUMPT	CHKM.2			;CHECK THIS ENTRY
	$RETF				;NO..RETURN FALSE
CHKM.4:	HRRZ	S1,FNDXCT		;GET THE COMPARE TYPE
	CAIE	S1,MSL.CD		;WAS IT THE CODE
	JRST	CHKM.5			;IGNORE NEXT CHECK
	MOVE	S1,G$SND		;GET SENDERS PID
	CAME	S1,MSL.PD(S2)		;IS IT SAME PID
	JRST	CHKM.3			;NO..GET NEXT ENTRY
CHKM.5:	MOVE	P1,S2			;SAVE THE MESSAGE ADDRESS
	MOVE	S1,NOD.ML(P2)		;GET MESSAGE LIST NUMBER
	$CALL	L%RENT			;REMEMBER THIS ENTRY
	$RETIF				;Can't remember???
	MOVE	S2,P1			;RESTORE MESSAGE ADDRESS
	$RETT				;RETURN TRUE


SUBTTL	NXTMSG	Get the next message

;THIS ROUTINE WILL GET NEXT MESSAGE AFTER FNDMSG HAS FOUND ONE
;
;	S1/	MESSAGE NUMBER  OR ID

NXTMSG:	$CALL	.SAVE2			;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE MESSAGE ID
	MOVE	S1,G$NODL		;GET NODE LIST
	$CALL	L%PREM			;GET REMEMBERED ENTRY
	JUMPF	FNDM.1			;SEARCH THE LIST
	MOVE	P2,S2			;SAVE NODE ADDRESS
	MOVE	S1,NOD.ML(P2)		;GET MESSAGE LIST ADDRESS
	$CALL	L%PREM			;GET REMEMBERED ENTRY
	JUMPF	NXTM.1			;NONE SET..CHECK ALL MESSAGES AT NODE
	$STOP(REI,<Remembered entry ^O/S2/ in list ^D/S1/ invalid>)
NXTM.1:	MOVE	S2,P2			;GET NODE ADDRESS
	JRST	FNDM.2			;PROCESS MESSAGE NOW
SUBTTL	REPORT	Log messages in SYSERR file

;THIS COMMAND WILL LOG THE ENTRY TO SYSERR

					;NEEDED SYMBOLS

	SLMTTY==0			;JOB#,,TTY#
	SLMPPN==1			;PPN OR POINTER TO BLOCK
	SLMWHO==2			;REPORTED BY FIELD
	SLMDEV==3			;DEVICE TO REPORT
	SLMMSG==4			;POINTER TO REASON

	ER.SLM==16			;TOPS-10 ERROR TYPE
	SEC%SL==116			;TOPS-20 ERROR TYPE
	SYSCOD==777000,,0		;MASK FOR STORING CODE ON -20
;**;[6037]At REPORT:-1L add 2 lines  JCR  2/14/90
	ARGSIZ==<PAGSIZ-<.OHDRS+2*ARG.DA+.NDESZ>>/2 ;[6037]Max remote SYERR 
                                                    ;[6037] argument size
REPORT:	MOVE	S1,G$OPRA		;Get OPR address
	MOVE	S1,OPR.ND(S1)		;Get Node address
	MOVE	S1,NOD.NM(S1)		;Get Node name
	$CALL	OPRENB			;Must have remote privs
	$RETIF
	MOVEI	P1,.OARGC(MO)		;GET POINTER TO DATA AREA
	$CALL	P$SIXF			;GET THE REPORTER NAME
	$RETIF				;NOT THERE..ERROR
	MOVEM	S1,SLMWHO(P1)		;SAVE THE ID
	$CALL	P$DEV			;GET THE DEVICE NAME
	$RETIF				;ERROR..RETURN
	HRROI	S1,ARG.DA(S1)		;Setup pointer to device name
	$CALL	S%SIXB			;convert device name to sixbit
	MOVEM	S2,SLMDEV(P1)		;SAVE DEVICE NAME
	LOAD	S1,G$JOB		;GET JOB NUMBER
	HRLM	S1,SLMTTY(P1)		;SAVE JOB NUMBER
	$CALL	GETJOB			;GET JOB INFO OF SENDER
	MOVE	S1,JOBTTY		;GET TERMINAL NUMBER
	HRRM	S1,SLMTTY(P1)		;SAVE TERMINAL NUMBER

TOPS10<
REPO.1:	SKIPN	S1,G$SID		;GET SENDERS ID
	PJRST	E$IUM			;INVALID USER IN MESSAGE
	MOVEM	S1,SLMPPN(P1)		;SAVE THE PPN
	MOVEI	P2,SLMMSG+1		;OFFSET FOR TEXT START
>;END TOPS10

TOPS20<
REPO.1:	MOVE	S2,G$SID		;GET SENDERS ID
	HRROI	S1,SLMMSG+1		;GET PLACE TO STORE IT
	MOVEM	S1,SLMPPN(P1)		;SAVE THE POINTER
	ADDI	S1,(P1)			;ADD IN ACTUAL DISPLACEMENT
	DIRST				;MAKE A STRING FROM NUMBER
	  JRST	E$IUM			;INVALID USER IN MESSAGE
	IBP	S1			;INCREMENT THE BYTE POINTER
	HRRZ	P2,S1			;GET LAST ADDRESS
	ADDI	P2,1			;POINT TO NEXT FREE LOCATION
	SUB	P2,P1			;GET RELATIVE OFFSET
>;END TOPS20
;**;[6037]At REPO.1:+11L replace 1 line with 5 lines  JCR  2/14/90
	$CALL	P$SWIT			;[6037]Is there a switch?
	JUMPF	REPO2A			;[6037]No, pick up the text
	$CALL	CHCLUN			;[6037]Check for a /CLUSTER-NODE switch
	$RETIF				;[6037]Illegally formatted message
REPO2A:	$CALL	P$TEXT			;[6037]Get the explanation
	$RETIF				;ERROR..RETURN
	SUBI	S2,1			;DECREMNT COUNT BY HEADER SIZE
	MOVN	T1,S2			;GET SIZE OF BLOCK
	MOVS	T2,T1			;PLACE COUNT IN LEFT HALF
	HRR	T2,P2			;GET ADDRESS FOR DATA
	MOVEM	T2,SLMMSG(P1)		;SAVE POINTER IN BLOCK
	MOVEI	S2,ARG.DA(S1)		;GET ADDRESS OF TEXT
	MOVE	S1,P2			;GET ADDRESS OF DESTINATION
	ADD	S1,P1			;GET ACTUAL LOCATION
	$CALL	TXTMOV			;MOVE THE TEXT
	HRRZ	S1,S1			;GET ENDING ADDRESS

TOPS10<
REPO.2:	SUBI	S1,-1(P1)		;GET THE LENGTH
	ADDI	S1,2			;SIZE OF HEADER
	MOVE	T1,S1			;SAVE LENGTH IN T1
	MOVX	S1,ER.SLM		;GET TYPE OF SYERR ENTRY
	STORE	S1,.OFLAG(MO)		;SAVE IN MESSAGE
	MOVX	S1,.DMERR		;DAEMON FUNCTION CODE
	STORE	S1,.MSCOD(MO)		;SAVE IN MESSAGE
	MOVS	T2,T1			;PLACE LENGTH IN LEFT HALF
	HRRI	T2,.MSCOD(MO)		;GET STARTING ADDRESS
	DAEMON	T2,			;DO THE FUNCTION
	  PJRST	E$SUF			;SYSERR UPDATE FAILED
>;END TOPS10

TOPS20<
REPO.2:	SUBI	S1,-1(P1)		;GET THE LENGTH
	ADDI	S1,4			;ADD 4 WORD HEADER
	MOVE	T1,S1			;SAVE THE LENGTH
	MOVX	S1,SEC%SL		;GET FUNCTION CODE
	STORE	S1,.MSTYP(MO),SYSCOD	;SAVE THE CODE
;**;[6037]At REPO.2:+5L replace 4 lines with 39 lines JCR  2/14/90
	SKIPN	S1,G$CLUN		;[6037]/CLUSTER-NODE: switch specified?
	JRST	REPO.3			;[6037]No, do the SYSERR update
	CAME	S1,[-1]			;[6037]For all nodes?
	JRST	REPO.4			;[6037]No, send to NEBULA
REPO.3:	MOVEI	S1,.MSTYP(MO)		;[6037]Start of function
	MOVE	S2,T1			;[6037]Length of the block
	SYERR%				;[6037]Do the SYSERR update
	ERJMP	[SKIPN G$CLUN		;[6037]Send remotely also?
		 PJRST E$SUF		;[6037]No, SYSERR update failed
		 $CALL E$SUF		;[6037]Set up the error code
		 JRST REPO.4 ]		;[6037]Prepare to send remotely
	SKIPN	G$CLUN			;[6037]Send the message to NEBULA?
	PJRST	E$SEM			;[6037]No, return now
REPO.4:	EXCH	MO,P1			;[6037]Save SYERR block address
	$CALL	GETPAG			;[6037]Pick up a page for NEBULA
	HRL	S1,P1			;[6037]Source
	HRRI	S1,.OHDRS+ARG.DA(MO)	;[6037]Source,,Destination
	BLT	S1,PAGSIZ-1(MO)		;[6037]Move the SYERR block
	CAILE	T1,ARGSIZ		;[6037]Enough room for the text?
	MOVEI	T1,ARGSIZ		;[6037]No, delete some text
	MOVEI	P3,.OHDRS(MO)		;[6037]Point to the first argument block
	MOVEI	S1,.SYBLK		;[6037]Pick up the block type
	HRLI	S1,ARG.DA(T1)		;[6037]Pick up the block length
	MOVEM	S1,ARG.HD(P3)		;[6037]Place block header in the message
	AOS	.OARGC(MO)		;[6037]Increment the argument count
	ADDI	P3,ARG.DA(T1)		;[6037]Point to the node block
	ADDI	T1,.OHDRS+ARG.DA+.NDESZ	;[6037]Pick up the message size
	MOVSS	T1			;[6037]Place where expected
	HRRI	T1,NEB%MS!.OMREP	;[6037]Pick up the message code
	MOVEM	T1,.MSTYP(MO)		;[6037]Place in the message
	EXCH	MO,P1			;[6037]Pick up the original page address
	$CALL	RELPAG			;[6037]Don't need it anymore
	MOVE	MO,P1			;[6037]Pick up the message address
	$CALL	FASNEB			;[6037]Send the message to NEBULA
	MOVE	S1,G$CLUN		;[6037]Pick up the remote node flag
	CAME	S1,[-1]			;[6037]For all nodes?
	$RET				;[6037]No, it was for a remote node 
	SKIPE	G$ERR			;[6037]Any errors occur?
	$RETF				;[6037]Yes, indicate so	
>;END TOPS20
	PJRST	E$SEM			;SYSERR ENTRY MADE
SUBTTL	CHKWTO	Routine to check for outstanding WTORS for all nodes

;This routine is a TIMER event and as such will be called from I%SLP
;when any WTOR's are outstanding

CHKWTO:	SETZM	G$CHKM			;Clear request flag
	MOVE	S1,G$NODL		;Get the node list
	$CALL	L%FIRST			;Get the first node
	 JUMPF	E$NOM			;Strange..

CHKWT0:	MOVE	T2,NOD.NM(S2)		;Get the node name
	MOVE	S1,NOD.ML(S2)		;Point to the message list
	$CALL	L%FIRST			;Any messages?
	 JUMPF	CHKWT2			;No..try the next
	SKIPT	G$OPR			;Yes..OPR around to see it?
	 JRST	CHKWT3			;No..dont bother outputing
	MOVEI	T1,0			;Yes..init the count

CHKWT1:	$CALL	L%NEXT			;Count the messages
	ADDI	T1,1			;Bump the count
	JUMPT	CHKWT1			;Loop back
	$WTO(<^D/T1/ outstanding message(s)^T/WTBELL/>,,,<$WTNOD(T2),$WTFLG(WT.SJI)>)
CHKWT3:	SETOM	G$CHKM			;Request another check

CHKWT2:	MOVE	S1,G$NODL
	$CALL	L%NEXT			;Check the next node
	JUMPT	CHKWT0
	SKIPN	G$CHKM			;Want another check?
	$RETT				;No..just return

REQMSC:	MOVX	S1,<^D5*^D60*^D1000>	;Wait 5 minutes
	MOVEI	S2,CHKWTO		;Same routine
	$CALL	REQTIM			;Make the request
	SETOM	G$CHKM			;Remember we made it
	$RETT

WTBELL:	BYTE (7) .CHBEL,.CHBEL,.CHBEL
SUBTTL	OPRLST	 Routine to Build Display Blocks for an Operator

;CALLED WITH S2 CONTAINING THE ADDRESS OF AN ENTRY IN THE NODE LIST
;MO MUST POINT AT A OPERATOR DISPLAY MESSAGE

OPRLST:	$CALL	OPRSPT			;OPR SETUP POINTERS
	LOAD	S1,NOD.OP(S2)		;GET THE OPERATOR LIST NUMBER
	MOVE	T1,S1			;SAVE OPERATOR LIST NUMBER
	$CALL	L%FIRST			;FIND THE FIRST MESSAGE
	$RETIF				;NONE FOR THIS NODE,RETURN
OPRL.1:	MOVE	S1,OPR.ND(S2)		;GET NODE ENTRY ADDRESS
	$CALL	OPRDPY			;GO BUILD A DISPLAY BLOCK
OPRL.2:	MOVE	S1,T1			;COPY MESSAGE LIST NUMBER TO S1
	$CALL	L%NEXT			;FIND NEXT ENTRY
	JUMPT	OPRL.1			;LOOP FOR ALL MESSAGES
	SKIPN	G$SEMF			;[6012]SEMI-OPR ENABLED?
	$TEXT	(OPRRTN,<^M^J**** SEMI-OPR is enabled ****>) ;[6005]
	HRRZ	S2,WTOPTR		;GET LAST ADDRESS
	SUBI	S2,-1(P3)		;GET THE LENGTH
	MOVEI	S1,.CMTXT		;GET ARGUMENT TYPE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	$RETT				;LOOP IF NO MORE
SUBTTL	OPRDPY	Build Operator Info

;THIS ROUTINE WILL PLACE TEXT IN THE MESSAGE
;CALLED WITH:	S1	NODE ENTRY ADDRESS
;		S2	ADDRESS OF OPERATOR ENTRY

OPRDPY:	$SAVE	<P1,P2>
	DMOVE	P1,S1			;SAVE THE NODE AND OPR ADRSSES
	MOVE	S1,OPR.FL(S2)		;GET OPERATOR FLAGS
	MOVEI	S2,[ASCIZ/user    /]	;[6002THE DEFAULT
	TXNE	S1,OP.HST		;IS THIS A HOST OPERATOR?
	MOVEI	S2,[ASCIZ/host    /]	;[6002]YES
	TXNE	S1,OP.REM		;IS IT REMOTE?
	MOVEI	S2,[ASCIZ/remote  /]	;[6002]YES
	TXNE	S1,OP.SYS		;IS IT SYSTEM OPR?
	MOVEI	S2,[ASCIZ/system  /]	;[6002]YES, SAY SO
	TXNE	S1,OP.SEM		;[6002]IS IT SEMI-OPR?
	MOVEI	S2,[ASCIZ/semi-opr/]	;YES, SAY SO
	$TEXT	(OPRRTN,<^N11/NOD.NM(P1)/  ^T/0(S2)/     ^O3R/OPR.TN(P2)/    ^D3R/OPR.JB(P2)/  ^I/OPRUSN/^U/OPR.US(P2)/>)
;**;[6042]At OPRDPY:+12L add 5 lines  JCR  4/27/90
	SKIPN	G$ARG3			;[6042]/ALL switch specified?
	$RET				;[6042]No, return now
	MOVE	S1,P2			;[6042]Pick up the operator address
	$CALL	INCDSP			;[6042]Include the output-display settings
	$RET				;[6042]Return

TOPS20<
OPRUSN==NULTXT
>;END TOPS20
TOPS10<
OPRUSN:	ITEXT	(<^W6/OPR.UN(P2)/^W/OPR.UN+1(P2)/ >)
>;END TOPS10

;**;[6042]At OPRRTN:+0L rewrite routines OPRRTN and OPRR.1  JCR  4/27/90
OPRRTN:	SOS	WTOCNT			;[6042]Decrement the byte count
	IDPB	S1,WTOPTR		;[6042]Save the byte
	$RETT				;[6042]Return to the caller

;**;[6042]S2 must be preserved!!

OPRR.1:	$SAVE	<T1,T2>			;[6042]For the OPRLOG routines
	PUSH	P,S2			;[6042]Save this AC
	MOVX	S1,WT.MOR		;[6042]Set more coming flag
	IORM	S1,.OFLAG(MO)		;[6042]Turn on the flag
	DMOVE	S1,.MSFLG(MI)		;[6042]Pick up flag and ACK code words
	DMOVEM	S1,.MSFLG(MO)		;[6042]Place in the outgoing message
	MOVX	S1,MF.MOR		;[6042]Pick up the more flag
	IORM	S1,.MSFLG(MO)		;[6042]Set in the outgoing message
	HRRZ	S2,WTOPTR		;[6042]Get the last address
	SUBI	S2,-1(P3)		;[6042]Get the length
	MOVEI	S1,.CMTXT		;[6042]Get the argument type
	$CALL	ARGRTN			;[6042]Save the argument
	ANDI	P3,777			;[6042]Get the message length
	STORE	P3,.MSTYP(MO),MS.CNT	;[6042]Save length in message
	MOVE	S2,.MSFLG(MI)		;[6042]Pick up the flag word
	TXNN	S2,MF.NEB		;[6042]Message originated remotely?
	$CALL	L$SHWM##		;[6042]No, log the SHOW message
	TXNE	S2,MF.NEB		;[6042]Message originated remotely?
	$CALL	L$NRSW##		;[6042]Yes, log differently
	MOVE	S1,G$SND		;[6042]Get the sender's PID
	MOVEI	S2,PAGSIZ		;[6042]Send a page
	$CALL	SPDOPR			;[6042]Send the message
	$CALL	GETPAG			;[6042]Get a page for output
	MOVX	S1,.OMDSP		;[6042]Setup display message
	STORE	S1,.MSTYP(MO),MS.TYP	;[6042]Save the type
	MOVEI	P3,.OHDRS(MO)		;[6042]Get first free address
	MOVE	S2,.MSFLG(MI)		;[6042]Pick up the flag word
	TXNN	S2,MF.NEB		;[6042]Message originated remotely?
	JRST	OPRR.2			;[6042]No, so don't build a remote hdr
	$CALL	BLDHDR			;[6042]Yes, build the remote header
OPRR.2:	$CALL	OPRSPT			;[6042]OPR set pointer
	$TEXT	(OPRRTN,<>)		;[6042]Add a blank line	
	POP	P,S2			;[6042]Restore the contents of S2
	$RET				;[6042]Return to the caller

;S2 MUST BE PRESERVED

;**;[6042]At OPRSPT:+0L replace 1 line with 2 lines  JCR  4/27/90
OPRSPT:	$CALL	.SAVE1			;[6042]Save a scratch AC
	MOVEI	S1,ARG.DA(P3)		;[6042]Free location in message
	HRLI	S1,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	S1,WTOPTR		;SAVE THE POINTER
	MOVEI	S1,ARG.DA(P3)		;GET THE POINTER
;**;[6042]At OPRSPT:+4L replace 5 lines with 5 lines JCR  4/27/90
	MOVEI	P1,PAGSIZ		;[6042]Size of a page
	ANDI	S1,777			;[6042]Make as offset
	SUBI	P1,-1(S1)		;[6042]Get number of free words
	IMULI	P1,NCHPW		;[6042]Number of characters per word
	SUBI	P1,LINELN		;[6042]Subtract out final line
	MOVEM	P1,WTOCNT		;[6042]Count of space remaining
	$RET				;RETURN

;**;[6042]At OPRSPT:+13L add routines CHKRM and INCDSP  JCR  4/27/90

SUBTTL		CHKRM	Check if Room for Another Line in the Current Page

CHKRM:	SKIPLE	WTOCNT			;[6042]Enough room for this line?
	$RET				;[6042]Yes, so nothing to do
	$CALL	OPRR.1			;[6042]No, so send the message now
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab
	$RET				;[6042]Return to the caller
SUBTTL	INCDSP	Include Output Display Settings

;[6042]INCDSP is called by the SHOW OPERATORS processor if the /ALL switch
;[6042]was specified. INCDSP includes the output-display settings as part
;[6042]of the operator information.
;[6042]
;[6042]Call is: S1/Operator entry adress
;[6042]Returns: Operator Output Display settings have been included as part
;[6042]         of the operator information

INCDSP:	$CALL	.SAVET			;[6042]Save some scratch ACs
	MOVEI	T2,OPR.MH(S1)		;[6042]Message display queue header adr
	MOVE	T4,T2			;[6042]Save for later
	LOAD	T3,OPR.HD(T2),OPR.NM	;[6042]Pick up the number of entries
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the first entry
	$CALL	CHKRM			;[6042]Check for room for this line
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab

INCD.1:	$TEXT	(OPRRTN,<^N6R/OPR.NN(T2)/  ^A>);[6042]Place node name in the msg
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the next entry
	SOJG	T3,INCD.1		;[6042]Pick up the next node name
	$TEXT	(OPRRTN,<Message type	>) ;[6042]Finish the line
	LOAD	T3,OPR.HD(T4),OPR.NM	;[6042]Pick up the number of nodes
	$CALL	CHKRM			;[6042]Check for room for this line
	$TEXT	(OPRRTN,<	^A>)	;[6042]Insert a leading tab
INCD.2:	$TEXT	(OPRRTN,<------  ^A>)	;[6042]Underline the next node
	LOAD	T2,OPR.HD(T2),OPR.PT	;[6042]Point to the next entry	
	SOJG	T3,INCD.2		;[6042]Go underline the next entry
	$TEXT	(OPRRTN,<------------	>) ;[6042]Finish the line

	LOAD	T3,OPR.HD(T4),OPR.NM	;[6042]Pick up the number of entries
	MOVEM	T3,G$ARG2		;[6042]Place where expected
	LOAD	S1,OPR.HD(T4),OPR.PT	;[6042]Point to the first entry
	$CALL	BLDDMB			;[6042]Include the output-displays
	$RET				;[6042]Return to the caller
SUBTTL	RESPON	Respond command

;THIS ROUTINE WILL PROCESS A RESPOND MESSAGE TO A WTO AND PASS
;THE ANSWER TO THE REQUESTOR

RESPON:	$CALL	P$NUM			;GET THE NUMBER FROM MESSAGE
	$RETIF				;NO..INVALID MESSAGE..RETURN
	MOVE	P1,S1			;SAVE MESSAGE NUMBER IN P1
;**;[6032]At RESPON:+2L replace 1 line with 9 lines  JCR  11/29/89
	$CALL	P$SWIT			;[6032]Check for a switch
	JUMPF	RESP.0			;[6032]No switch, look for the message
	$CALL	CHCLUN			;[6032]Check for a /CLUSTER-NODE:
	$RETIF				;[6032]Not a /CLUSTER-NODE: switch
	SKIPN	S1,G$CLUN		;[6032]Local node specified?
	JRST	RESP.0			;[6032]Yes, treat as no /CLUSTER-NODE:
	CAME	S1,[-1]			;[6032]CLUSTER-NODE:* specified?
	JRST	RES.10			;[6032]No, remote node specified
RESP.0:	MOVE	S1,P1			;[6032]Restore the message number
	$CALL	GETMSG			;GET THE MESSAGE
					;O.K..IN S2
	JUMPF	RESP.5			;NO..GIVE ERROR
RESP.1:	MOVE	P2,S2			;SAVE THE MESSAGE ADDRESS
	MOVE	S1,MSL.ND(P2)		;GET THE NODE MESSAGE FOUND OUT
	MOVE	S1,NOD.NM(S1)		;GET THE NODE NAME
	$CALL	OPRENB			;SEE IF OPR ENABLED FOR NODE
	JUMPF	RESP.6			;NO..SETUP ERROR
;**;[6032]At RESP.1:+4L replace 1 line with 6 lines  JCR  11/29/89
	SETZM	G$NSHW			;[6032]Assume message originated locally

;[6032]REMRSP is the entry point for processing a RESPOND message that 
;[6032]originated from a remote node in the cluster. It is called from N$RSPD.
;[6032]P4 contains the remote node name.
REMRSP::MOVEI	T1,MSL.SZ(P2)		;[6032]Get start of message
	LOAD	S1,MSL.CD(P2)		;GET SENDERS CODE
	STORE	S1,.MSCOD(MO)		;SAVE IN MESSAGE
RESP.2:	$CALL	P$CURR			;GET THE CURRENT POINTER
	MOVE	T4,S1			;SAVE THE BLOCK POINTER
	$CALL	P$TEXT			;GET THE TEXT ADDR AND LEN
	$RETIF				;NOT TEXT..ERROR..RETURN
	$CALL	MOVARG			;BUILD TEXT ARGUMENT
	MOVE	S1,G$SND		;GET PID OF OPR SENDING IT
	MOVEM	S1,ARG.DA(P3)		;SAVE THE PID IN BLOCK
;**;[6032]At RESP.2:+6L add 2 lines  JCR  11/29/89
	SKIPE	G$NSHW			;[6032]Message originated remotely?
	JRST	RESP2A			;[6032]Yes, use the remote node name
	MOVE	S1,G$OPRA		;GET THE OPR ADDRESS
	MOVE	T1,OPR.TN(S1)		;GET THE TERMINAL NUMBER
	MOVE	S2,OPR.ND(S1)		;GET THE NODE ENTRY
	MOVE	S2,NOD.NM(S2)		;GET THE NODE NAME
	CAME	S2,G$HOST		;SAME AS OUR NODE.. USE TERMINAL
	MOVE	T1,S2			;GET THE NODE NAME
;**;[6032]At RESP.2:+12L add 2 lines  JCR  11/29/89
	SKIPA				;[6032]Don't update with the remote name
RESP2A:	MOVE	T1,P4			;[6032]Remote message, use remote node
	MOVEM	T1,ARG.DA+1(P3)		;SAVE THE DATA
	MOVEI	S1,.ACKID		;GET ACK ID
	MOVEI	S2,ARG.SZ+1		;SIZE OF BLOCK
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	ANDI	P3,777			;GET MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE MESSAGE LENGTH
	LOAD	S1,MSL.PD(P2)		;PID OF THE SENDER
	MOVEI	S2,PAGSIZ		;PAGE MODE MESSAGE
	$CALL	SNDPID			;SEND THE MESSAGE
	JUMPT	RESP.4			;O.K. RELEASE MESSAGE AND RETURN
	MOVX	S1,MS.TER		;NOTIFY ANYWAY?
	TDNE	S1,MSL.FL(P2)		;CHECK IF SET
	JRST	RESP.7			;YES.. OUTPUT TO USER TERMINAL
	MOVEM	P1,G$ARG1		;SAVE THE NUMBER
RESP.3:	$CALL	E$MNV			;MESSAGE NO LONGER VALID..
	$CALL	RELPAG			;RELEASE THE PAGE
RESP.4:	MOVE	S2,MSL.ND(P2)		;NODE MESSAGE FOUND AT
	SOS	NOD.CT(S2)		;DECREMENT THE COUNT
	MOVE	S1,NOD.ML(S2)		;GET THE LIST NUMBER
	$CALL	L%DENT			;DELETE THE ENTRY
;**;[6032]At RESP.4:+4L change 4 lines  JCR  11/29/89
	JRST	RESP.9			;[6032]Check if need to send to NEBULA
RESP.5:	MOVEM	P1,G$ARG2		;[6032]Save the number
	$CALL	E$NSM			;[6032]No such message
	JRST	RESP.9			;[6032]Check if need to send to NEBULA
RESP.6:	MOVEM	P1,G$ARG1		;SAVE THE MESSAGE NUMBER ARG1
	MOVE	S1,MSL.ND(P2)		;GET NODE ADDRESS
	MOVE	S1,NOD.NM(S1)		;GET NODE NAME
	MOVEM	S1,G$ARG2		;SAVE ARG2
;**;[6032]At RESP.6:+4L replace 1 line with 2 lines  JCR  11/29/89
	$CALL	E$ONE			;[6032]OPR not enabled for node
	JRST	RESP.9			;[6032]Check if need to send to NEBULA
RESP.7:	MOVE	S1,MSL.JB(P2)		;GET THE JOB NUMBER
	$CALL	GETUSR			;GET THE USER INFO
	JUMPT	RESP.8			;O.K.. CONTINUE ON
	SETZM	G$ERR			;CLEAR ERROR CODE
	MOVEM	P1,G$ARG1		;SAVE THE MESSAGE NUMBER
	JRST	RESP.3			;GENERATE AN ERROR
RESP.8:	MOVE	S1,MSL.JT(P2)		;GET THE JOB LOGGED IN TIME
	CAME	S1,JOBJLT		;SAME JOB?
	JRST	RESP.3			;NO..GENERATE AN ERROR
	MOVE	S1,T4			;GET THE CURRENT PARSER POINTER
	$CALL	P$SETU			;SETUP THE PARSER POINTER
	MOVEI	P3,.OHDRS(MO)		;OUTPUT POINTER
	$CALL	BLDSND			;BUILD THE SEND
	MOVEI	S2,ARG.DA(S1)		;POINT TO THE DATA
	MOVE	S1,JOBTTY		;GET TERMINAL NUMBER
	$CALL	SNDTTY			;SEND THE MESSAGE
	$CALL	RELPAG			;RELEASE THE PAGE
	JRST	RESP.4			;AND RELEASE THE MESSAGE
;**;[6032]At RESP.8:+11L add 28 lines  JCR  11/29/89

RESP.9:	SKIPE	G$NSHW			;[6032]Message originated remotely?
	$RETT				;[6032]Yes, return now
	SKIPN	G$CLUN			;[6032]Message for all nodes?
	$RETT				;[6032]No, return now
	SKIPN	MO			;[6032]Need to get a page?
	$CALL	GETPAG			;[6032]Yes, pick up a page for NEBULA
	MOVEI	P3,.OHDRS(MO)		;[6032]Free pointer for output

;[6032]Build an "in behalf of" RESPOND message to be sent to NEBULA.

RES.10:	MOVE	S1,COM.PB(MI)		;[6032]Pick up parser block pointer
	ADDI	S1,(MI)			;[6032]Point to the first parser block
	$CALL	P$SETU			;[6032]Set up the parser
	$CALL	P$NEXT			;[6032]Skip over the msg type keyword
	$CALL	P$CURR			;[6032]Pick up the number block address
	LOAD	S2,(S1),PF.LEN		;[6032]Pick up the number block length
	$CALL	MOVARG			;[6032]Copy the number block 
	$CALL	P$NEXT			;[6032]Skip over the number block
	$CALL	P$NEXT			;[6032]Skip over the switch block
	$CALL	P$NEXT			;[6032]Skip over the /CLUSTER-NODE block
	$CALL	P$TEXT			;[6032]Point to the text block
	$RETIF				;[6032]Return on an error
	$CALL	MOVARG			;[6032]Copy over to the message
	MOVEI	S1,.OMRSP		;[6032]Pick up the message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6032]Place in the message to NEBULA
	SETZM	G$CLUN			;[6032]Send only to NEBULA	
	PJRST	SNDCLU			;[6032]Finish building the message and
					;[6032] send it to NEBULA
SUBTTL	Operator privilege checking routines

;The routines on the following pages are called to check various
;operator capabilities from Orions command processing level.  The
;following capabilies are defined:


;WHEEL capability

;	OPR can do anything to any node.  This also includes
;	full file access.  For TOPS10  the full file
;	access PPN implies wheel.

;SYSTEM capability

;	OPR can do anything to any node with this capabilility.

;HOST capability

;	OPR can do anything to the host node.

;REMOTE capability

;	OPR can do anything to the node where the terminal is
;	physically connected. (Excluding the host system)
SUBTTL	GETPRV	Find out if the sender could be an OPR of sorts

;This routine is called to determine if the sender has any operator
;capability.

;Accepts	G$PRVS and G$SID set up from received message

TOPS20<
GETPRV:	$CALL	CHKWHL			;Check for wheel or operator
	JUMPF	GETPR1			;[6002]Not a wheel, how about semi-opr
	MOVX	S1,OP.SYS		;[6002]Wheel, claim to be a system OPR
	MOVE	TF,.OFLAG(MI)		;Get the flag bits from the hello msg.
	TXNE	TF,OP.RMT		;Does it claim to be remote?
	MOVX	S1,OP.REM		;Yes, set the privs to say so
	$RETT
> ; End of TOPS20
GETPR1:	MOVX	TF,MD.SEM		;[6002]GET SEMI-OPR PRIV BIT
	SKIPN	G$SEMF			;[6012]SEMI-OPR ENABLED?
	TDNN	TF,G$PRVS		;[6002]YES, USER HAS SEMI-OPR PRIV	
	$RETF				;[6002]NO
	MOVX	S1,OP.SEM		;[6002]GET FLAG BIT 
	$RETT				;[6002]

TOPS10<
GETPRV:	MOVX	TF,TRUE			;Set for true return
	MOVX	S1,OP.SYS		;Assume system OPR
	SKIPT	DEBUGW			;Debugging or Wheel?
	$CALL	CHKWHL
	$RETIT				;Yes..allow system privs
	LOAD	S1,G$JOB		;GET THE JOB NUMBER
	MOVX	S2,JI.BAT		;GET BATCH DATA AND OPR FIELDS
	$CALL	I%JINF			;GET THE DATA
	LOAD	S1,S2,OB.OPR		;GET THE OPERATOR BITS
	MOVEI	S2,PRVTAB		;ADRS OF PRIVILEGE BIT CONVERSION TABLE
	$CALL	TABSRC			;MAP IT
	$RETIF				;Return on failure
	MOVE	S1,0(S2)		;GET THE PRIV BIT
	$RETT				;AND RETURN

PRVTAB:	$STAB
	XWD	.OBSOP,[EXP OP.SYS]	;SYSTEM OPERATOR
	XWD	.OBHOP,[EXP OP.HST]	;HOST ONLY OPERATOR
	XWD	.OBROP,[EXP OP.REM]	;REMOTE ONLY OPERATOR
	$ETAB

> ; End of TOPS10
SUBTTL	OPRENB	Operator enabled for a node

;This routine checks to see if an OPR has sufficient privileges
;to perform a function for a specified node.

;Accepts	S1/ Node name or number or -1 for all nodes


;Returns TRUE	OPR has sufficient privileges
;	 FALSE	OPR doesn't have enough privs

;If all nodes are specifed [-1] then system privs are required.
;If the specified node is the host then host or system privs are required.
;If the specified node is not the host, then the operator must be
;physically connected to the node and have remote privileges.

OPRENB:	MOVE	S2,S1			;Save the node name
	MOVE	S1,G$OPRA		;Get the OPR data base address
	CAME	S2,[-1]			;All nodes?
	JRST	OPRE.2			;No, try for host or remote

;Need system privs.

OPRE.1:	$CALL	O$SYSTEM		;Check for privs
	JUMPF	E$OSY			;Failed, do not return
	$RET				;Return passing true up

;Here to try for host privs.

OPRE.2:	CAME	S2,G$HOST		;On the host name or
	CAMN	S2,G$HSTN		;  number
	SKIPA				;Yes
	JRST	OPRE.3			;Go try for remote

;Need host privs.

	$CALL	O$HOST			;Check for privs.
	JUMPF	E$OHS			;Failed, do not return
	$RET				;Return passing true up

;Here to try for remote

OPRE.3:	$SAVE	<P1>			;Need an ac here
	MOVE	P1,OPR.ND(S1)		;Get node data address
	CAME	S2,NOD.NM(P1)		;On node name or
	CAMN	S2,NOD.NU(P1)		;  number?
	SKIPA
	JRST	OPRE.1			;Try for system just for grins

;Need remote privs.

	$CALL	O$REMOTE		;Check for privs
	JUMPF	E$ORS			;Failed, do not return
	$RET				;Return passing true up
	SUBTTL	O$REMOTE/O$HOST/O$SYSTEM/CHKWHL Routs. to check privs.

;Accepts	S1/ OPR data base address (not needed for CHKWHL)

;Returns TRUE	OPR has privs needed
;	 FALSE	Opr is not privy

O$REMOTE:
	MOVX	TF,OP.REM		;Get remote capability
	TDNE	TF,OPR.FL(S1)		;Have it?
	$RETT				;Yes
	PJRST	O$SYSTEM		;No, try for system

TOPS10 <

O$HOST:
	MOVX	TF,OP.HST		;Get Host capability
	TDNE	TF,OPR.FL(S1)		;Have it?
	$RETT				;Yes
	PJRST	O$SYSTEM		;No..Check for system and return

O$SYSTEM:
	MOVX	TF,OP.SYS		;Get system capability
	TDNE	TF,OPR.FL(S1)		;Have it?
	$RETT				;Yes..we have a winner

	;Fall through

>; End of TOPS10

CHKPRV:	MOVX	TF,OP.D60		;Get the OPR is a DN60 bit.
	TDNE	TF,OPR.FL(S1)		;Is this an on the behalf of?
	$RETF				;Yes, he is not a WHEEL!
					;Continue checking
CHKWHL:	SKIPE	DEBUGW			;DEBUGGING ???
	$RETT				;YES,,THEN OK
	MOVX	TF,MD.PWH!MD.POP	;CHECK FOR WHEEL OR OPERATOR
	TDNN	TF,G$PRVS		;WAS SENDER PRIVILEGED
	$RETF				;NO..RETURN FALSE
	$RETT				;YES..RETURN TRUE
SUBTTL	TOPS20 Privilege checking routines

TOPS20<
O$HOST:
O$SYSTEM:
	MOVX	TF,OP.SEM		;[6002]GET FLAG WORD
	TDNE	TF,OPR.FL(S1)		;[6002]SEMI-OPR?
	$RETT				;[6002]MUST BE O.K IF HE GOT THIS FAR	
	PJRST	CHKPRV			;Go for privs
>;END TOPS20
SUBTTL	G$ACK	Send an ACK to sender if requested

;THIS ROUTINE SENDS AN ACKNOWLEDGEMENT MESSAGE IF ONE WAS REQUESTED.
;IF THERE WAS NO ERROR, A FLAG IS SET IN THE MESSAGE HEADER

G$ACK:	$CALL	BLDACK			;BUILD AN ACK MESSAGE
	LOAD	S1,.MSCOD(MI)		;GET CODE FROM ORIGINAL MESSAGE
	STORE	S1,.MSCOD(MO)		;AND SAVE IT IN ACK MESSAGE
	SKIPN	S1,G$SND		;PID TO SEND TO
	  PJRST	RELPAG			;INVALID PID, SKIP SEND AND RELEASE PAGE
	MOVEI	S2,PAGSIZ		;GET PAGE SIZE
	$CALL	SNDPID			;SEND THE MESSAGE
	$RETIT				;O.K. RETURN
	PJRST	RELPAG			;RELEASE PAGE AND RETURN
	SUBTTL	G$ACKN - Send an Ack message due to a NEBULA message

;G$ACKN builds an ACK message as the result of a message originating from
;a remote node in the cluster that has encountered an error in its processing.

G$ACKN:	$CALL	BDNACK			;[6005]BUILD THE ACK MESSAGE
	$CALL	L$NERR##		;[6005]LOG THE ACK MESSAGE
	$CALL	N$SNEB			;[6005]SEND THE ACK MESSAGE TO NEBULA
	$RETIT				;[6005]RETURN ON SUCCESS

	$CALL	RELPAG			;[6005]RELEASE THE MESSAGE PAGE
	MOVEI	S1,NEBNAM		;[6005]PICK UP NEBULA'S NAME ADRESS
	MOVEM	S1,G$ARG1		;[6005]SAVE FOR THE ERROR LOG PROCESSOR
	$CALL	L$ERR##			;[6005]LOG THE ERROR
	$RET				;[6005]RETURN TO THE CALLER
SUBTTL	BLDACK	Build an ACK message

;THIS ROUTINE WILL BUILD AN ACK MESSAGE TO BE SENT ON ERROR
;OR FOR MESSAGES TO OPR FROM ORION

BLDACK:	$CALL	GETPAG			;GET PAGE FOR OUTPUT
	MOVX	S1,MT.TXT		;GET MESSAGE TYPE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE MESSAGE TYPE
	SKIPE	G$ERR			;WAS THERE AN ERROR??
	JRST	BLDA.1			;YES, NEED TO BUILD TEXT MESSAGE
	MOVX	S1,MF.NOM		;FLAG THIS AS JUST AN ACK
	IORM	S1,.MSFLG(MO)		;SAVE IN MESSAGE HEADER
	MOVX	S1,.OHDRS		;ACK HEADER SIZE
	STORE	S1,.MSTYP(MO),MS.CNT	;SAVE IN HEADER
	$RETT				;RETURN
BLDA.1:	MOVE	S1,G$ERR		;GET THE ERROR CODE
	MOVE	S2,STSTBL(S1)		;GET STATUS FLAGS
	MOVEM	S2,.MSFLG(MO)		;SAVE THE FLAGS IN MESSAGE
	SKIPGE	S1,G$ERR		;GET ERROR CODE
	JRST	BLDA.3			;NO..PROCESS AS ITEXT
	MOVE	S2,TXTTBL(S1)		;ADDRESS OF MESSAGE
	MOVEI	S1,ARG.DA+.OHDRS(MO)	;ADDRESS TO STORE DATA
	$CALL	TXTMOV			;MOVE THE DATA
;**;[6033]At BLDA.1:+7L replace 10 lines with 1 line  JCR  12/16/89
	PJRST	FINMSG			;[6033]Finish the message
BLDA.3:	MOVEI	S2,ARG.DA+.OHDRS(MO)	;GET PLACE TO STORE TEXT
	HRLI	S2,(POINT 7,0)		;MAKE A POINTER
	MOVEM	S2,TXTPTR		;SAVE THE POINTER
	$TEXT	(ACKERR,<^I/@TXTTBL(S1)/^0>)	;PLACE TEXT IN MESSAGE
	MOVE	S1,TXTPTR		;GET TXTPTR
;**;[6033]At BLDA.3:+4L change 1 line
	PJRST	FINMSG			;[6033]Finish the message
ACKERR:	IDPB	S1,TXTPTR		;SAVE THE CHARACTER
	$RETT				;RETURN TRUE
;[6033]At ACKERR:+2L add routines FINMSG and BLDRAK  JCR  12/16/89
	SUBTTL	FINMSG	Finish Building an ACK Message

;[6033]FINMSG is called to finish the building of an ACK message
;[6033]
;[6033]Call is:      S1/Byte pointer to last byte of the message
;[6033]              MO/Address of the ACK message
;[6033]Returns true: The ACK message has been completed

FINMSG:	HRRZS	S1			;[6033]Get ending address
	ADDI	S1,1			;[6033]Bump it by 1
	ANDI	S1,777			;[6033]Get message length
	STORE	S1,.MSTYP(MO),MS.CNT	;[6033]Save count in message
	SUBI	S1,.OHDRS		;[6033]Get size of block
	STORE	S1,ARG.HD+.OHDRS(MO),AR.LEN ;[6033]Save argument length
	MOVX	S1,.CMTXT		;[6033]Get text code
	STORE	S1,ARG.HD+.OHDRS(MO),AR.TYP ;[6033]Save argument type
	AOS	.OARGC(MO)		;[6033]Bump argument count
	$RETT				;[6033]Return
	SUBTTL	BLDRAK	Build an ACK for a Kill WTOR Requested Remotely

;[6033]BLDRAK is called to build an ACK message for a Kill WTOR request
;[6033]that is due to a remote request.
;[6033]Call is: G$ERR/Error code
;[6033]         WDANHD/Remote node name where request originated
;[6033]Returns: The ACK message has been built

BLDRAK:	$CALL	GETPAG			;[6033]Pick up a page for the ACK
	MOVEI	S1,MT.TXT		;[6033]Pick up message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[6033]Save in the message
	MOVEI	S1,ARG.DA+.OHDRS(MO)	;[6033]Beginning address of the text
	HRLI	S1,(POINT 7,)		;[6033]Make it into a pointer
	MOVEM	S1,TXTPTR		;[6033]Save where expected by ACKERR
	$TEXT	(ACKERR,<Request originated from node ^N/WDANHD/^0>);[6033]
	MOVE	S1,TXTPTR		;[6033]Pick up the updated byte pointer
	$CALL	FINMSG			;[6033]Finish the message for this block
	MOVE	S1,G$ERR		;[6033]Pick up the error code
	MOVE	S2,STSTBL(S1)		;[6033]Pick up the status flags
	MOVEM	S2,.MSFLG(MO)		;[6033]Place in the message
	LOAD	S2,.MSTYP(MO),MS.CNT	;[6033]Pick up the message length so far
	ADDI	S2,(MO)			;[6033]Address of the second text block
	MOVEM	S2,G$2SCR		;[6033]Save this address for later
	ADDI	S2,ARG.DA		;[6033]Where to place the text
	HRLI	S2,(POINT 7,)		;[6033]Make into a pointer
	MOVEM	S2,TXTPTR		;[6033]Place where ACKERR expects it
	$TEXT	(ACKERR,<^I/@TXTTBL(S1)/>^0) ;[6033]Place text in message
	
	MOVE	S1,TXTPTR		;[6033]Pick up updated byte pointer
	HRRZS	S1			;[6033]Isolate the address
	AOS	S1			;[6033]Increment for correct length
	ANDI	S1,PAGSIZ-1		;[6033]The new message length
	LOAD	S2,.MSTYP(MO),MS.CNT	;[6033]Get the old message length
	STORE	S1,.MSTYP(MO),MS.CNT	;[6033]Place new length in the message
	SUB	S1,S2			;[6033]Length of the new text block
	MOVE	S2,G$2SCR		;[6033]Get address of the new text blk
	STORE	S1,ARG.HD(S2),AR.LEN	;[6033]Store the block length
	MOVEI	S1,.CMTXT		;[6033]Text block type
	STORE	S1,ARG.HD(S2),AR.TYP	;[6033]Place in the text block
	AOS	.OARGC(MO)		;[6033]Increment the argument count
	$RET				;[6033]And return to the caller
	SUBTTL	BDNACK - Build a Remote ACK message

;BDNACK builds an ACK message that will be sent to a remote node.

BDNACK:	$SAVE	<P1>			;[6005]SAVE THIS AC
	$CALL	GETPAG			;[6015]GET A PAGE FOR OUTPUT
	MOVEI	S1,MT.TXT		;[6015]PICK UP THE MESSAGE TYPE
	$CALL	BLDHDR			;[6005]BUILD THE MESSAGE HEADER
	MOVE	S2,G$NOW		;[6015]PICK UP THE TIME
	MOVEM	S2,ARG.DA(P3)		;[6015]PLACE IN THE DISPLAY BLOCK
	SKIPL	S1,G$ERR		;[6005]ERROR TEXT CONTAINS ITEXT?
	JRST	BDNA.1			;[6005]NO, GO MOVE THE TEXT

	MOVEI	S2,ARG.DA+1(P3)		;[6015]PICK UP THE DATA BLOCK ADDRESS
	HRLI	S2,(POINT 7,)		;[6015]MAKE INTO A POINTER
	MOVEM	S2,TXTPTR		;[6005]SAVE FOR $TEXT
	$TEXT	(ACKERR,<^I/@TXTTBL(S1)/^0>) ;[6005]BUILD THE TEXT STRING
	MOVE	S1,TXTPTR		;[6005]PICK UP THE UPDATED POINTER
	JRST	BDNA.2			;[6005]GO COMPLETE THE MESSAGE

BDNA.1:	MOVE	S2,TXTTBL(S1)		;[6005]PICK UP THE SOURCE ADDRESS
	MOVEI	S1,ARG.DA+1(P3)		;[6005]PICK UP THE DESTINATION ADDRESS
	$CALL	TXTMOV			;[6005]MOVE THE TEXT TO THE MESSAGE

BDNA.2:	HRRZS	S1			;[6005]PICK UP THE END ADDRESS
	ADDI	S1,3			;[6005]ACCOUNT FOR HEADER AND UDT WORDS
	SUB	S1,P3			;[6005]GET THE DISPLAY BLOCK LENGTH
	MOVE	S2,S1			;[6015]SAVE THE BLOCK LENGTH
	MOVSS	S1			;[6005]PLACE LENGTH IN EXPECTED PLACE
	HRRI	S1,.ORDSP		;[6005]PICK UP THE BLOCK TYPE
	MOVEM	S1,ARG.HD(P3)		;[6005]PLACE IN THE HEADER WORD

	ADD	P3,S2			;[6015]GET THE PAGE NUMBER + MSG LENGTH
	ANDI	P3,777			;[6005]ISOLATE THE MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;[6005]PLACE IN THE MESSAGE
	AOS	.OARGC(MO)		;[6005]INCREMENT THE ARGUMENT COUNT
	$RETT				;[6005]RETURN TO THE CALLER
SUBTTL	ADDNOD	Add a node to the list

COMMENT	\
ROUTINE TO SEE IF NODE IS ENTERED IN THE NODE LIST. IF NOT
ONE IS ENTERED AND THE MESSAGE AND OPR PID LISTS ARE GENERATED.

ON ENTRY:  S1=SIXBIT NODE NAME TO SEARCH FOR
	  S2/NODE NUMBER
TRUE RETURN: S1=ADR OF NODE BLOCK
\

ADDNOD:	$CALL	FNDNOD			;LOCATE THE NODE BLOCK
	$RETIT				;OK..RETURN
	MOVE	S1,G$NODL		;GET LIST NUMBER AGAIN
	$CALL	L%LAST			;POSITION TO END OF LIST
	MOVE	S1,G$NODL		;GET LIST NUMBER AGAIN
	MOVEI	S2,NOD.SZ		;NUMBER OF WORDS
	$CALL	L%CENT			;CREATE THE ENTRY
	SKIPT				;Skip this if true
	$STOP(CCE,Can't create list entry)
	STORE	T1,NOD.NM(S2)		;PLANT THE NODE NAME
	STORE	T2,NOD.NU(S2)		;SAVE NODE NUMBER
	MOVE	T1,S2			;COPY ENTRY ADDRESS TO T1
	$CALL	L%CLST			;CREATE A MESSAGE LIST
	STORE	S1,NOD.ML(T1)		;STORE MESSAGE LIST NUMBER
	SETZM	NOD.CT(T1)		;CLEAR MESSAGE COUNT
	SETZM	NOD.TM(T1)		;AUTO DISPLAY TIME
	$CALL	L%CLST			;CREATE A PID LIST
	STORE	S1,NOD.OP(T1)		;STORE THE OPR LIST NUMBER
	MOVE	S1,T1			;COPY ENTRY ADDRESS TO T1
	$RETT				;RETURN TRUE
SUBTTL	LOCNOD	Locate a node in the list

;THIS ROUTINE WILL LOCATE A GIVEN NODE IN THE NODE LIST
;AND RETURN TRUE IF FOUND WITH S2 ADDRESS OF ENTRY

;LOCNOD:	$CALL	CHKNOD		;CHECK THE NODE
;	$RETIF				;BAD NODE..RETURN
FNDNOD:	DMOVE	T1,S1			;COPY OUR ARG TO T1,T2
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%FIRST			;POSITION TO FIRST
	$RETIF				;NONE..RETURN FALSE
LOCN.1:	TLNN	T1,770000		;WAS IT SIXBIT?
	JRST	LOCN.3			;TRY NODE NUMBER
	CAME	T1,NOD.NM(S2)		;IS THIS THE NODE WE WANT?
	JRST	LOCN.4			;NOT THIS ONE, GO LOOK AT NEXT
LOCN.2:	MOVE	S1,S2			;COPY ENTRY ADDRESS TO S1
	$RETT				;AND RETURN
LOCN.3:	CAMN	T1,NOD.NU(S2)		;MATCH NODE NUMBER?
	JRST	LOCN.2			;SET NODE AND RETURN
LOCN.4:	MOVE	S1,G$NODL		;GET NOD LIST NUMBER
	$CALL	L%NEXT			;STEP TO NEXT ENTRY
	JUMPT	LOCN.1			;SEE IF ITS THE ONE
	DMOVE	S1,T1			;RESTORE NODE VALUES
	$RET				;NO..PASS FALSE UP
SUBTTL	DELNOD	Delete a node from the list

;This Routine will Delete a Node entry (Oprs at the Node).

DELNOD:	LOAD	S1,.OHDRS+ARG.HD(MI),AR.TYP	;GET THE MESSAGE TYPE
	CAIE	S1,.OROBJ		;OBJECT BLOCK?
	$RETF				;ERROR..RETURN
	LOAD	T1,.OHDRS+ARG.DA+OBJ.ND(MI)	;GET THE NODE NAME
	MOVX	S1,%ONLINE		;GET THE ONLINE FLAG
	TDNE	S1,.MSFLG(MI)		;WAS IT ONLINE?
	JRST	NODONL			;NODE ONLINE PROCESSING
	MOVE	S1,G$NODL		;GET THE NODE LIST
	$CALL	L%FIRST			;GET THE FIRST
	SKIPT				;O.K.. SKIP
	$STOP(NDE,Node database empty)
DELN.1:	MOVX	T2,ND.D60		;DN60 NODE
	TDNN	T2,NOD.FL(S2)		;IS IT A DN60 NODE?
	JRST	DELN.3			;NO..GET NEXT NODE
	CAME	T1,NOD.NM(S2)		;CHECK THE NODE NAME
	JRST	DELN.3			;NO.. TRY NEXT ONE
	MOVE	T2,S2			;SAVE NODE LIST ENTRY
DELN.2:	MOVE	S1,NOD.OP(T2)		;GET THE OPR LIST NUMBER
	$CALL	L%FIRST			;POSITION TO FIRST
	JUMPF	DELN.4			;O.K..EXIT NOW
	MOVE	S1,OPR.PD(S2)		;GET THE PID
	$CALL	DELOPR			;DELETE THE OPR
	JRST	DELN.2			;TRY AGAIN
DELN.3:	MOVE	S1,G$NODL		;GET THE NODE LIST
	$CALL	L%NEXT			;GET THE NEXT ONE
	JUMPT	DELN.1			;TRY IT
	$RETT				;RETURN
DELN.4:	MOVE	S1,G$NODL		;GET THE NODE LIST NUMBER
	$CALL	L%DENT			;DELETE THE ENTRY
	$RETIT				;O.K. RETURN
	$STOP	(DDF,Delete DN60 node failed)
SUBTTL	NODONL	Node on line for DN60

;This Routine will create the Opr and Node for a Dn60 Operator

NODONL:	SKIPN	P1,.OFLAG(MI)		;PORT ,,LINE MEANS DN60 ?
	$RETT				;NO ...RETURN
	HLRZ	S1,P1			;GET THE PORT NUMBER
	HRRO	S2,P1			;SETUP -1,, LINE NUMBER
	STORE	S1,S2,PPPLLL		;SAVE  AS -1,,PPPLLL
	EXCH	S2,G$SND		;SAVE AS THE SENDER
	MOVE	S1,.OHDRS+ARG.DA+OBJ.ND(MI) ;GET THE NODE NAME
	MOVEM	S1,G$ARG1		;SAVE THE NODE
	SETZ	S2,			;CLEAR NODE NUMBER
	TLNN	S1,700000		;Is it a real node name?
	MOVE	S2,S1			;No - set the real node number
	MOVX	T1,OP.REM!OP.D60	;REMOTE, AND DN60 OPR
	$CALL	ADDOPR			;ADD THE OPERATOR
	JUMPF	E$OAE			;OPR ALREADY EXISTS
	MOVE	S1,OPR.ND(S2)		;GET THE NODE ADDRESS
	MOVX	T1,ND.D60		;SET AS DN60 NODE
	IORM	T1,NOD.FL(S1)		;SET THE FLAG
	MOVX	T1,OP.NST		;CLEAR OPR NOT SETUP STATUS
	ANDCAM	T1,OPR.FL(S2)
	$RETT				;O.K. RETURN
SUBTTL	ADDOPR	Add an OPR to data base and node list

;THIS ROUTINE WILL CREATE AN ENTRY IN THE OPR TABLE AS WELL AS
;THE NODE-OPR LIST
;CALL -
;	S1/	NODE NAME
;	S2/	NODE NUMBER
;	T1/	OPERATOR PRIVILEGE BITS
;RETURN TRUE:	S2/ ADDRESS OF OPR ENTRY

ADDOPR:	$CALL	.SAVE3			;SAVE P1 AND P2 AND P3
	DMOVE	P1,S1			;SAVE THE NODE DATA
	MOVE	P3,T1			;SAVE THE OPERATOR FLAGS
TOPS10< $CALL	CHKOPR	>		;Check for duplicate OPR's
	MOVE	S1,G$SND		;GET THE OPRS PID
	$CALL	VALOPR			;CHECK IF SETUP
	JUMPT	.RETF			;FOUND...ERROR
	DMOVE	S1,P1			;RESTORE NODE DATA
	$CALL	ADDNOD			;LOCATE THE NODE OR CREATE NODE
					;S1 HAS NODE ENTRY ADDRESS ON RETURN
	MOVE	T1,S1			;SAVE NODE ADDRESS IN T1
	MOVE	S1,NOD.OP(T1)		;NODE LIST OF OPRS FOR NODE
	MOVE	T2,S1			;SAVE OPR LIST NUMBER IN T2
	MOVEI	S2,OPR.SZ		;SIZE OF OPR ENTRY
	$CALL	L%CENT			;CREATE AN ENTRY
	SKIPT				;Skip this if true
	PUSHJ	P,S..CCE		;Can't create entry, go STOP
	MOVE	S1,G$SND		;GET THE PID OF OPR..
	STORE	S1,OPR.PD(S2)		;SAVE PID IN ENTRY
	AOS	NOD.OC(T1)		;BUMP THE ACTIVE OPERATOR COUNT
	MOVX	S1,OP.NST		;NOT SETUP FLAG
	IORM	S1,OPR.FL(S2)		;SAVE IN OPR ENTRY FLAGS
	STORE	T1,OPR.ND(S2)		;SAVE NODE ENTRY ADDRESS IN OPR ENTRY
	STORE	T2,OPR.LS(S2)		;SAVE OPR LIST NUMBER IN LIST
ADDO.2:	MOVE	P1,S2			;SAVE OPR LIST ADDRESS IN P1
	SKIPN	TABFRE			;ANY FREE ENTRIES IN LIST
	$CALL	EXPTAB			;EXPAND THE OPR TABLE
	MOVE	S1,TABADR		;ADDRESS OF TABLE
ADDO.3:	SKIPN	TOP.PD(S1)		;IS THIS A FREE ENTRY
	JRST	ADDO.4			;FOUND ENTRY..PROCESS IT
	ADDI	S1,TOP.SZ		;TABLE ENTRY SIZE
	JRST	ADDO.3			;TRY NEXT ONE
ADDO.4:	MOVE	T1,S1			;SAVE CURRENT ADDRESS IN T1
	SOS	TABFRE			;DECREMENT FREE COUNT
	MOVE	T2,G$SND		;GET THE PID
	STORE	T2,TOP.PD(T1)		;SAVE PID IN TABLE
	STORE	P1,TOP.OA(T1)		;SAVE OPR ENTRY ADDRESS IN TABLE
	STORE	T1,OPR.TP(P1)		;SAVE TABLE ADDRESS IN OPR ENTRY
	MOVEM	P1,G$OPRA		;SAVE OPR ADDRESS
	$CALL	L$AOPR##		;ADD THE OPERATOR LOGGING
	MOVE	S1,G$SID		;GET USER NUMBER OR PPN
	MOVEM	S1,OPR.US(P1)		;SAVE USER IN OPR BLOCK
TOPS10<
	LOAD	S1,G$JOB		;GET THE JOB NUMBER
	$CALL	GETNAM			;GET THE USER NAME
	DMOVE	S1,JOBUSN		;GET USER NAME
	DMOVEM	S1,OPR.UN(P1)		;SAVE THE NAME
>;END TOPS10
	LOAD	S1,G$JOB		;GET JOB NUMBER
	MOVEM	S1,OPR.JB(P1)		;SAVE OPR JOB NUMBER
	MOVX	S2,JI.TNO		;GET TERMINAL NUMBER
	$CALL	I%JINF			;GET JOB INFO
	JUMPF	ADDO.5			;IGNORE IF FALSE***
	MOVEM	S2,OPR.TN(P1)		;SAVE TERMINAL NUMBER
;**;[6042]At ADDO.5:+0L replace 1 line with 5 lines  JCR  4/27/90
ADDO.5:	MOVE	S1,G$HOST		;[6042]Pick up the local node name
	MOVEI	S2,OPR.MH(P1)		;[6042]Pick up msg display queue hdr adr
	$CALL	MTQCRE			;[6042]Create and link an entry
	IORM	P3,OPR.FL(P1)		;[6042]Save the flags
	MOVE	P1,S1			;[6042]Save the entry address
	ADD	P1,[POINT <WID(WO.ALL)>,OPR.OF]
	MOVX	P2,.RTJST(-1,WO.ALL)	;GET ALL FLAGS
	MOVEI	P3,.OTMAX+NUMAPL+1	;GET NUMBER OF FIELDS

ADDO.6:	IDPB	P2,P1			;REQUEST DISPLAY FOR ALL
	SOJG	P3,ADDO.6

;**;[6042]At ADDO.6:+2L add 2 lines  JCR  4/27/90
	MOVSI	P3,-<.OPDMX-1>		;[6042]Get number of OPR display words
	HRR	P3,S1			;[6042]Start at beginning of DB entry
ADDO.7:	SETOM	OPR.DP(P3)		;Set the word to indicate all
	AOBJN	P3,ADDO.7		;Go back for more

	$RETT				;RETURN TRUE
SUBTTL	EXPTAB	Expand OPR table

;THIS ROUTINE WILL EXPAND THE OPR TABLE TO MAKE ROOM
;FOR MORE ENTRIES
;AS WELL AS THE OPR RESEND TABLE LENGTH

EXPTAB:	MOVE	S1,TABCNT		;GET COUNT OF ENTRIES NOW
	ADDI	S1,^D10			;INCREMENT TABLE BY 10 ENTRIES
	IMULI	S1,TOP.SZ		;OPR TABLE SIZE
	$CALL	M%GMEM			;GET THE MEMORY
	EXCH	S2,TABADR		;SAVE NEW ADDRESS AND GET OLD
	JUMPE	S2,EXPT.1		;FIRST TIME..NO TABLE SO FAR
	MOVE	T1,S2			;SAVE ADDRESS IN T1
	HRL	S2,S2			;SOURCE ADDRESS IN LEFT HALF
	HRR	S2,TABADR		;DESTINATION ADDRESS IN RIGHT
	MOVE	S1,TABCNT		;NUMBER OF ENTRIES
	IMULI	S1,TOP.SZ		;MULTIPLY BY ENTRY SIZE
	ADD	S1,TABADR		;ADD IN TABLE ADDRESS
	BLT	S2,-1(S1)		;MOVE THE TABLE
	MOVE	S2,T1			;PUT OLD ADDRESS IN S2
	MOVE	S1,TABCNT		;NUMBER OF ENTRIES
	IMULI	S1,TOP.SZ		;SIZE OF TABLE
	$CALL	M%RMEM			;RELEASE THE MEMORY
EXPT.1:	MOVE	S1,OPRRCT		;GET OPR COUNT
	ADDI	S1,^D10			;GET INCREMENT SIZE
	$CALL	M%GMEM			;GET SOME MEMORY
	EXCH	S1,OPRRCT		;GET THE OLD COUNT AND REPLACE WITH NEW
	EXCH	S2,OPRRSL		;RESEND LIST ADDRESS
	JUMPE	S2,EXPT.2		;FIRST TIME..=0 GO TO EXPT.1
	$CALL	M%RMEM			;RETURN THE OLD LIST
EXPT.2:	MOVEI	S1,^D10			;NUMBER OF ENTRIES TO INCREMENT
	ADDM	S1,TABCNT		;SAVE TABLE ENTRIES
	ADDM	S1,TABFRE		;SAVE FREE ENTRY COUNT
	MOVE	S1,TABADR		;GET THE TABLE ADDRESS
	MOVE	S2,TABCNT		;GET THE TABLE COUNT
EXPT.3:	SKIPN	T1,TOP.OA(S1)		;VALID ENTRY?
	$RETT				;NO..END OF LIST
	MOVEM	S1,OPR.TP(T1)		;RESET THE ADDRESS
	ADDI	S1,TOP.SZ		;GET NEXT ADDRESS
	SOJG	S2,EXPT.3		;TRY THE NEXT ONE
	$RETT				;ALL DONE..RETURN
SUBTTL	VALOPR	Validate the OPR

;THIS ROUTINE WILL CHECK TO SEE IF A GIVEN OPR PID IS VALID
;TO SEND COMMANDS TO ORION

;RETURNS S2/ ADDRESS OF OPR LIST ENTRY

VALOPR:	MOVE	S2,TABADR		;GET THE TABLE ADDRESS
	SKIPN	T1,TABCNT		;MAXIMUM NUMBER OF ENTRIES
	$RETF				;NONE SETUP SO FAR..RETURN
VALO.1:	CAMN	S1,TOP.PD(S2)		;CHECK PID FOR MATCH
	JRST	VALO.2			;MATCH..SETUP FOR RETURN
	ADDI	S2,TOP.SZ		;BUMP TO NEXT ENTRY
	SOJG	T1,VALO.1		;LOOP THROUGH ALL ENTRIES
	$RETF				;OPR NOT HERE..RETURN FALSE
VALO.2:	MOVE	S2,TOP.OA(S2)		;OPR LIST ENTRY ADDRESS
	$RETT				;RETURN TRUE

TOPS10 <
	SUBTTL	CHKOPR	Check if previously OPR

;  The purpose of this routine is to determine if the job trying
;  to start OPR has previously had OPR running and had ^Cd out.
;  If this is the case, then delete the previous OPR entry.
;  T1 contains Operator priv. bits (inc. DN60)

;	preserves all ACs except S1 and S2

CHKOPR:	TXNE	T1,OP.D60		;Is this a DN60 (from QUASAR)?
	$RET				;Yes - don't want any deleting

	$SAVE	<T1>
	MOVE	S2,TABADR		;Get table address
	SKIPN	T1,TABCNT		;Maximum number of entries
	$RET				;None - quit without prejudice
; LOOP

CHKO.1:	MOVE	S1,TOP.OA(S2)		;Get address of OPR entry
	MOVE	S1,OPR.JB(S1)		;Get the job number of this entry
	CAMN	S1,G$JOB		;Is this from the same job
	JRST	CHKO.2			;Yes, go get rid of it
	ADDI	S2,TOP.SZ		;Bump to next entry
	SOJG	T1,CHKO.1		;Loop on all entries
	$RET				;Done - quit without prejudice

CHKO.2:	MOVE	S1,TOP.PD(S2)		;Get the PID for the duplicate OPR
	$CALL	DELOPR			;Delete the OPR
	$RET				;and finish
> ;End of TOPS10
SUBTTL	DELOPR	Delete an OPR entry from table and node list

;THIS ROUTINE WILL REMOVE AN OPR ENTRY FROM THE TABLE
;OF OPRS AS WELL AS FROM THE NODE LIST OF OPRS.


DELOPR:	$CALL	.SAVET			;SAVE T REGS
	$CALL	VALOPR			;VALIDATE THE OPR
	SKIPT				;O.K...SKIP
	$RETF				;JUST RETURN FALSE
	MOVE	T1,OPR.TP(S2)		;ADDRESS OF OPR TABLE ENTRY
	AOS	TABFRE			;BUMP FREE ENTRY COUNT
	MOVE	T2,OPR.PD(S2)		;OPR PID
	SETZM	TOP.OA(T1)		;CLEAR ADDRESS OF ENTRY
	SETZM	TOP.PD(T1)		;CLEAR PID
	MOVE	S1,OPR.LS(S2)		;OPR LIST NUMBER
	$CALL	L%FIRST			;POSITION TO FIRST
	SKIPT				;OPR DELETE FATAL ERRO
	$STOP(ODE,OPR delete entry error)
DELO.1:	CAMN	T2,OPR.PD(S2)		;FOUND THE ENTRY
	JRST	DELO.2			;YES...DELETE ENTRY
	MOVE	S1,OPR.LS(S2)		;GET LIST NUMBER FROM ENTRY
	$CALL	L%NEXT			;GET NEXT ENTRY
	JUMPT	DELO.1			;CHECK OUT ENTRY
	$CALL	S..ODE			;FATAL ERROR EXIT
DELO.2:	MOVE	T1,OPR.ND(S2)		;GET NODE ADDRESS
	SOS	NOD.OC(T1)		;REDUCE OPRS AT NODE COUNT
	MOVEM	S2,G$OPRA		;SAVE OPR ADDRESS
	$CALL	L$DOPR##		;DELETE THE OPERATOR LOGGING
;**;[6042]At DELO.2:+3L add 3 lines  JCR  4/27/90
	MOVE	S1,G$OPRA		;[6042]Get the OPR address
	MOVEI	S1,OPR.MH(S1)		;[6042]Pick up the msg type queue hdr
	$CALL	MTQDES			;[6042]Destroy the message display queue
	MOVE	S2,G$OPRA		;GET OPR ADDRESS
	MOVE	S1,OPR.LS(S2)		;LIST NUMBER
	$CALL	L%DENT			;DELETE THE ENTRY
	JUMPF	S..ODE			;OPR DELETE ERROR
	$RET				;RETURN

;***NODE COUNT OF OPRS GOES TO ZERO..NODE NOT THERE..DELETE NODE
SUBTTL	SNDLST	Send unsent messages to OPR and OBJECTS

;THIS ROUTINE WILL TRY TO SEND THE UNSENT MESSAGES TO THE
;APPROPRIATE OPR OR OBJECT

;CALL	S1/	MESSAGES TO SEND

SNDLST:	$CALL	.SAVE1			;SAVE AN AC
	MOVE	P1,S1			;SAVE THE FLAGS
	MOVE	S1,G$SNDL		;GET SEND LIST
	$CALL	L%FIRST			;POSITION TO THE FIRST
	JUMPF	.RETT			;NONE..RETURN
SNDL.1:	TDNN	P1,RSD.FL(S2)		;CHECK FLAGS FOR OBJECT
	JRST	SNDL.2			;NO MATCH..TRY NEXT ONE
	MOVE	S1,G$SND		;GET SENDERS PID(OBJECT)
	$CALL	RSDPID			;RESEND TO PID AND DELETE IF O.K.
	JUMPF	.RETT			;ERROR..STOP SENDING
SNDL.2:	MOVE	S1,G$SNDL		;GET SEND LIST
	$CALL	L%NEXT			;POSITION TO THE NEXT ENTRY
	JUMPT	SNDL.1			;O.K...TRY NEXT ONE
	$RETT				;RETURN O.K.
SUBTTL	RSDPID	Resend messages to a specific PID

;CALL 	S1/	PID TO RESEND TO

RSDPID:	$CALL	.SAVE1			;SAVE 1 FOR SCRATCH
	MOVE	MO,RSD.MS(S2)		;GET MESSAGE ADDRESS
	ADDI	MO,(S2)			;GET ACTUAL ADDRESS
	MOVE	P1,S2			;SAVE ENTRY ADDRESS
	LOAD	S2,.MSTYP(MO),MS.CNT	;GET MESSAGE SIZE
	$CALL	CHKSFL			;CHECK FOR SEND FAILURES
	JUMPT	RSDP.3			;YES..JUST REQUEUE
	$CALL	SNDMSG			;SEND THE MESSAGE
	JUMPF	RSDP.2			;FAIL..QUEUE UP FOR RESEND
RSDP.1:	SOS	G$NSNT			;DECREMENT NOT SENT COUNT
	MOVE	S1,G$SNDL		;GET SEND LIST
	PJRST	L%DENT			;DELETE THE ENTRY AND RETURN
RSDP.2:	MOVE	S1,SNDBLK+SAB.PD	;GET THE PID
	$CALL	ADDSFL			;ADD THE SEND FAILURE
	MOVE	S1,G$RSDL		;QUEUE UP FOR RESEND
	$CALL	L%LAST			;POSTION TO THE END
	LOAD	S2,RSD.HD(P1),RS.LEN	;GET THE LENGTH OF ENTRY
	MOVE	S1,G$RSDL		;GET LIST NUMBER
	$CALL	L%CENT			;CREATE AN ENTRY
	SKIPT				;Skip this if true
	PUSHJ	P,S..CCE		;Can't create entry, go STOP
	MOVE	S1,G$SND		;GET SENDERS PID
	MOVE	T1,RSD.PD(P1)		;GET PID OFFSET
	ADDI	T1,(P1)			;POINT TO PID AREA
	MOVEM	S1,(T1)			;SAVE THE PID
	AOS	RSD.CT(P1)		;BUMP COUNT OF PIDS
	MOVE	S1,P1			;OLD ENTRY
	$CALL	MOVBLK			;MOVE THE BLOCK TO OTHER LIST
	SKIPN	G$RSDC			;FIRST MESSAGE TO RESEND?
	$CALL	REQRSD			;YES..REQUEST RESEND
	AOS	G$RSDC			;BUMP THE RESEND COUNT
	SETZM	RSDCNT			;CLEAR THE RESEND COUNT
	JRST	RSDP.1			;NOW DELETE OLD ONE
RSDP.3:	MOVEM	S1,SNDBLK+SAB.PD	;SAVE THE PID
	JRST	RSDP.2			;REQUEUE THE MESSAGE
SUBTTL	MOVARG	Setup argument in output message

;THIS ROUTINE WILL MOVE AN ARGUMENT BLOCK FROM INPUT TO OUTPUT
;MESSAGE
;
;CALL	S1/	ADDRESS OF SOURCE TEXT
;	S2/	LENGTH IN WORDS OF TEXT
;
;RETURN	P3/ UPDATED TO NEXT FREE OUTPUT LOCATION

MOVARG:: HRL	T1,S1			;ADDRESS OF TEXT SOURCE
	HRRI	T1,ARG.HD(P3)		;DESTINATION ADDRESS
	ADD	P3,S2			;GET ENDING ADDRESS
	BLT	T1,-1(P3)		;MOVE TEXT TO MESSAGE
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	$RETT				;RETURN TRUE

SUBTTL	MOVAR2	Add a 2 word argument to the message

;ADDS A 2 WORD BLOCK TO THE MESSAGE
;CALL -
;	S1/	BLOCK TYPE
;	S2/	ARGUMENT DATA
;RETURNS -
;	TRUE

MOVAR2:: HRLI	S1,ARG.DA+1		;LENGTH
	MOVEM	S1,G$2SCR+ARG.HD	;SAVE IN TEMP
	MOVEM	S2,G$2SCR+ARG.DA	;SAVE DATA
	DMOVE	S1,[EXP G$2SCR,ARG.DA+1] ;AIM AT BLOCK, AND LENGTH
	PJRST	MOVARG			;MOVE IT IN


;*** CHECK FOR NULL ANSWER...
SUBTTL	SNDAOP	Send a message to all OPRs

;THIS ROUTINE WILL SEND A MESSAGE TO ALL OPRS AT A GIVEN NODE
;OR TO SYSTEM NODE IF NO OPRS AT THAT NODE
;OR IF -1 IS SET IN NODE ADDRESS TO ALL OPRS AT ALL NODES

SNDAOP:	SETZM	NOALTN			;ALTERNATE NODE IF NODE FAILS

;THIS ENTRY IS FOR NO ALTERNATES AND CALLER AS MADE NOALTN -1 TO
;PREVENT SEARCH OF OTHER NODES IF FAILS
;**;[6044]At SNDNAL+0L make it global  JYCW  6/8/90
SNDNAL::$CALL	.SAVE1			;GET AN AC FOR SCRATCH
	MOVE	P1,S1			;SAVE THE NODE LIST ENTRY
	SETZM	MSGCNT			;CLEAR COUNT OF SENDS
	SETZM	RSDCNT			;SET RESEND COUNT INDICATOR
	CAMN	P1,[-1]			;IS IT -1
	JRST	SNDA.8			;YES..SEND TO ALL NODES
	$CALL	SNDOPR			;SEND TO THE OPRS AT NODE
	MOVX	S1,WT.SND		;GET 'SEND TO CENTRAL AND REMOTE' BIT
	TDNE	S1,.OFLAG(MI)		;WANT THIS?
	JRST	SNDA.1			;YES
	JUMPT	SNDA.5			;SENT O.K. CHECK RESENDS
	SKIPE	NOALTN			;SEND TO ALTERNATES ON FAILURE?
	$RET				;NO..RETURN..PASSING FALSE UP
SNDA.1:	MOVE	T1,NOD.FL(P1)		;GET ENTRIES FLAGS
	TXNE	T1,ND.SYS		;WAS IT THE SYSTEM NODE
	JRST	SNDA.5			;YES..CHECK RESEND AND RETURN
	MOVE	S1,G$NODL		;GET NODE LIST ENTRY
	$CALL	L%FIRST			;GET THE FIRST ENTRY
	JUMPF	SNDA.5			;No entries, skip this
SNDA.2:	MOVE	T1,NOD.FL(S2)		;CHECK FLAGS OF ENTRY
	TXNE	T1,ND.SYS		;SYSTEM OPR?
	JRST	SNDA.4			;YES..SEND TO ALL AT THIS NODE
SNDA.3:	MOVE	S1,G$NODL		;GET THE NODE LIST
	$CALL	L%NEXT			;GET THE NEXT ENTRY
	JUMPT	SNDA.2			;O.K. TRY NEXT ENTRY
	JRST	SNDA.5			;CHECK SEND AND RESEND INFO
SNDA.4:	MOVE	P1,S2			;GET THE ENTRY ADDRESS
	$CALL	SNDOPR			;SEND TO ALL OPRS
					;CHECK RESEND AND SEND AFTER RETURN
SNDA.5:	SKIPG	RSDCNT			;ANY RESENDS?
	JRST	SNDA.6			;YES.. REQUEUE THE MESSAGE
	SKIPN	G$RSDC			;FIRST MESSAGE TO BE RESENT?
	$CALL	REQRSD			;YES..REQUEST RESEND
	AOS	G$RSDC			;BUMP THE RESEND COUNT
	MOVX	S1,R.SOPR		;RESENDS FOR OPR
	MOVE	S2,G$RSDL		;RESENDS..(SEND FAILURE LIST)
	JRST	SNDA.7			;REQUEUE AND RELEASE
SNDA.6:	SKIPLE	S1,MSGCNT		;SENT MESSAGE TO ANYONE??
	PJRST	RELPAG			;YES..RELEASE PAGE AND RETURN
	AOS	G$NSNT			;BUMP NOT SENT COUNT
	MOVX	S1,R.SOPR!R.NSNT	;OPR MESSAGE NOT SENT
	MOVE	S2,G$SNDL		;LIST FOR UNSENT MESSAGES
SNDA.7:	$CALL	REQMSG			;REQUEUE THE MESSAGE
	PJRST	RELPAG			;RELEASE THE PAGE AND RETURN
SNDA.8:	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%FIRST			;POSITION TO THE FIRST
	JUMPF	SNDA.5			;No entries, skip this
SNDA.9:	MOVE	P1,S2			;GET THE ADDRESS IN P1
	$CALL	SNDOPR			;SEND TO ALL OPRS AT NODE
	MOVE	S1,G$NODL		;GET NODE LIST NUMBER
	$CALL	L%NEXT			;GET THE NEXT ENTRY
	JUMPF	SNDA.5			;ANALYZE RESULTS AND RETURN
	JRST	SNDA.9			;TRY NEXT ONE
SUBTTL	SNDOPR	Send a message to at least one OPR

;THIS ROUTINE WILL SEND THE MESSAGE TO ALL OPRS AND RETURN FALSE
;IF NO OPRS AT NODE OTHERWISE WILL BE QUEUED UP FOR THE OPR


SNDOPR:	MOVE	T4,MSGCNT		;SAVE MESSAGE COUNT VALUE
	MOVE	T3,RSDCNT		;GET THE CURRENT RESEND COUNT
	LOAD	S1,NOD.OP(P1)		;GET OPR LIST NUMBER
	$CALL	L%FIRST			;POSITION TO FIRST ENTRY
	$RETIF				;RETURN FALSE
SNDO.1:	MOVEM	S2,G$OPRA		;SAVE OPR BASE ADDRESS
	MOVE	T2,OPR.FL(S2)		;GET THE OPRS FLAGS
	TXNE	T2,OP.NST		;IS OPR SETUP?
	JRST	SNDO.6			;IGNORE THIS OPR
	$CALL	CHKOSD			;CHECK IF OPR WANTS MESSAGE
	JUMPF	SNDO.5			;NO..BYPASS THIS OPR
SNDO.2:	MOVE	S2,G$OPRA		;GET THE OPR ADDRESS
	LOAD	S1,OPR.PD(S2)		;GET THE OPRS PID
	MOVE	T2,S1			;SAVE THE PID
;**;[6043]At SNDO.2:+2L add 1 line   PMM   6/3/90
	MOVEM	S1,.MSCOD(MO)		;[6043]Save PID in message
	$CALL	CHKSFL			;CHECK FOR SEND FAILURES ON PID
	JUMPT	SNDO.4			;MARK FOR RESEND
	LOAD	S2,.MSTYP(MO),MS.CNT	;GET THE MESSAGE LENGTH
	$CALL	SNDMSG			;SEND THE MESSAGE
	JUMPT	SNDO.5			;O.K. COUNT IT AND SEND TO OTHERS
	AOS	G$SNDF			;BUMP SEND FAILURE COUNT
	CAXE	S1,ERNSP$		;NO SUCH PID??
	JRST	SNDO.4			;MARK TO RESEND
SNDO.3:	MOVE	S1,T2			;GET THE BAD PID
	$CALL	DELOPR			;DELETE THE OPERATOR
	JRST	SNDO.6			;TRY NEXT OPERATOR
SNDO.4:	MOVE	S1,T2			;GET THE PID
	$CALL	ADDSFL			;ADD SEND FAILURE PID
	JRST	SNDO.6			;TRY NEXT OPR
SNDO.5:	AOS	MSGCNT			;BUMP THE SEND COUNT
SNDO.6:	LOAD	S1,NOD.OP(P1)		;GET OPR PID LIST
	$CALL	L%NEXT			;GET THE NEXT ENTRY
	JUMPT	SNDO.1			;TRY NEXT OPR
	CAML	T4,MSGCNT		;SEND ANY MESSAGES
	CAMGE	T3,RSDCNT		;REQUEUE ANY MESSAGES
	$RETT				;YES..RETURN TRUE
	$RETF				;NO..SENDS
SUBTTL	CHKOSD	Check message flags for OPR

;THIS ROUTINE WILL DETERMINE IF OPR WANTS TO SEE THE MESSAGE
;AND
;
;RETURN	TRUE:	OPR WANTS TO SEE IT
;RETURN FALSE:	OPR DOESN'T WANT TO SEE IT

CHKOSD:	SKIPE	G$ASND			;ALWAYS SEND MESSAGE?
	$RETT				;YES..MAKE OPR SEE IT
;**;[6042]At CHKOSD:+1L add 6 lines  JCR  4/27/90
	MOVE	S1,WDARND		;[6042]Pick up where originated
	MOVEI	S2,OPR.MH(S2)		;[6042]Pick up queue header address
	$CALL	MTQFND			;[6042]Find the queue entry
	$RETIF				;[6042]No entry, don't send
CHKO.1:	$SAVE	<P1>			;[6042]Save a scratch AC
	MOVE	P1,S1			;[6042]Save the queue entry address
	LOAD	S1,WDAOBT,AR.TYP	;[6003]GET OBJECT TYPE FROM MESSAGE
	MOVE	S2,WDAFLG		;GET THE FLAGS FROM MESSAGE

;  Here to setup for object display check

	MOVE	TF,S2			;Save the flags
	CAILE	S1,APLBEG		;Application object type?
	SUBI	S1,APLBEG-.OTMAX	;Yes..compute object offset
	CAILE	S1,.OTMAX+NUMAPL	;Check range
	$RETF

	IDIVI	S1,<^D36/<WID(WO.ALL)>>	;Compute word offset
	IMULI	S2,<WID(WO.ALL)>	;Compute bit offset
	MOVNS	S2			;Force shift right
	LSH	TF,0(S2)		;Position the flags
;**;[6042]At CHKOSD:+20L change 1 line  JCR  4/27/90
	ADD	S1,P1			;[6042]Add base of OPR entry
	MOVE	S2,OPR.OF(S1)		;Save the flag

;  Here to send or not based on message type and object type

	SKIPN	S1,WDADTY		;Get display type, any set?
	JRST	[TDNN	TF,S2		;No, how about object display flag?
		$RETF			;All flags were off, don't send msg
		$RETT]			;O.K to send
	$CALL	MAPBIT			;Go get bit to check
;**;[6042]At CHKOSD:+30L change 1 line  JCR  4/27/90
	ADD	S1,P1			;[6042]Add base of OPR entry
	MOVE	S1,OPR.DP(S1)		;Get the flag
	TDNN	S1,S2			;Is it ok?
	$RETF				;No
	$RETT				;Yes, allow it
SUBTTL	MOVBLK	Move a standard argument block

;THIS ROUTINE WILL MOVE A STANDARD GALAXY BLOCK FROM
;SOURCE ADDRESS TO DESTINATION ADDRESS
;THE LENGTH IS GOTTEN FROM SOURCE FIRST WORD..(HEADER)
;
;CALL	S1/	SOURCE ADDRESS
;	S2/	DESTINATION ADDRESS
;
;RETURN	S2/	UPDATED DESTINATION ADDRESS
;
;SCRATCH AC T1

MOVBLK:	HRL	T1,S1			;GET SOURCE ADDRESS IN LEFT HALF
	HRR	T1,S2			;AND DESTINATION IN RIGHT HALF
	LOAD	S1,ARG.HD(S1),AR.LEN	;GET THE LENGTH OF BLOCK
	ADD	S2,S1			;GET ENDING ADDRESS
	BLT	T1,-1(S2)		;MOVE THE BLOCK
	$RETT				;RETURN TRUE
SUBTTL	REQMSG	Reque a message to be sent later

;THIS ROUTINE WILL SETUP THE RESEND ENTRY FOR A MESSAGE
;
;CALL	S1/	FLAGS FOR REQUEUE
;	S2/	LIST NUMBER TO REQUEUE IN
;
;RETURN	S2/	ENTRY ADDRESS

REQMSG:	DMOVE	T3,S1			;SAVE S1 AND S2 IN T3 AND T4
	MOVE	S1,T4			;GET RESEND LIST ADDRESS
	$CALL	L%LAST			;POSITION TO THE END
	LOAD	S2,.MSTYP(MO),MS.CNT	;GET THE MESSAGE COUNT
	ADDI	S2,RSD.SZ		;GET SIZE OF BLOCK AND PID LIST HEADER
	SKIPG	S1,RSDCNT		;ANY RESENDS
	MOVEI	S1,1			;ALWAYS LEAVE 1
	ADD	S2,S1			;GET THE NEW COUNT
	MOVE	S1,T4			;GET RESEND LIST NUMBER
	MOVE	T1,S2			;SAVE SIZE OF ENTRY
	$CALL	L%CENT			;CREATE AN ENTRY
	SKIPT				;Skip this if true
	PUSHJ	P,S..CCE		;Can't create entry, go STOP
	STORE	T1,RSD.HD(S2),RS.LEN	;SAVE THE LENGTH
	MOVE	S1,G$NOW		;GET THE TIME
	MOVEM	S1,RSD.TM(S2)		;SAVE TIME IN ENTRY
	MOVE	T2,S2			;SAVE ENTRY ADDRESS
	MOVEI	S1,RSD.SZ		;GET RESEND BLOCK SIZE
	MOVEM	S1,RSD.PD(S2)		;SAVE AS PID OFFSET
	MOVEI	T1,RSD.SZ+1		;OFFSET FOR MESSAGE..LEAVE FOR 1 PID
	SKIPG	RSDCNT			;MOVE PID LIST IF ANY
	JRST	REQM.1			;ASSUME 1
	HRL	S1,OPRRSL		;ADDRESS OF RESEND LIST
	HRRI	S1,RSD.SZ(S2)		;START OF FREE AREA
	MOVEI	T1,RSD.SZ(S2)		;ADDRESS OF DESTINATION STARTING POINT
	ADD	T1,RSDCNT		;ADD IN NUMBER OF PIDS
	BLT	S1,-1(T1)		;MOVE THE PIDS
	SUB	T1,S2			;GET THE OFFSET
REQM.1:	MOVEM	T1,RSD.MS(S2)		;SAVE OFFSET FOR MESSAGE
	MOVE	T2,S2			;SAVE MESSAGE ADDRESS
	ADD	S2,T1			;POSITION TO TEXT
	MOVEI	S1,.MSTYP(MO)		;GET THE MESSAGE ADDRESS
	$CALL	MOVBLK			;MOVE THE BLOCK
	IORM	T3,RSD.FL(T2)		;NO..SAVE THE FLAGS
	MOVE	S2,T2			;SAVE THE ADDRESS
	SETZ	S1,			;CLEAR S1
	EXCH	S1,RSDCNT		;RESET AND GET RSDCNT
	MOVEM	S1,RSD.CT(S2)		;SAVE THE COUNT
	$RETT				;RETURN S2, ENTRY ADDRESS
SUBTTL	RSDMSG	Resend requed messages

;THIS ROUTINE WILL TRY TO SEND ANY MESSAGES QUEUED UP IN THE SYSTEM
;AND WILL DELETE FROM THE QUEUE WHEN SENT TO ALL PIDS OR RETRY COUNT
;EXHAUSTED

RSDMSG:	SKIPN	G$RSDC			;ANY MESSAGES TO RESEND
	$RETT				;NO..RETURN O.K.
	$CALL	RSDM.0			;YES..SEND WHAT WE CAN
	SKIPN	G$RSDC			;GET ALL OF THEM?
	$RETT				;YES..JUST RETURN
REQRSD:	MOVEI	S1,^D15*^D1000		;NO..RETRY IN 15 SECONDS
	MOVEI	S2,RSDMSG
	$CALL	REQTIM			;MAKE THE TIMER REQUEST
	$RETT

RSDM.0:	$CALL	CLRSFL			;CLEAR SEND FAILURE LIST
	SETZM	RSDCNT			;CLEAR THE RESEND COUNT
	$CALL	.SAVE3			;GET SOME SCRATCH ACS
	MOVE	S1,G$RSDL		;GET RESEND LIST NUMBER
	$CALL	L%FIRST			;POSITION TO THE FIRST ENTRY
	SKIPT				;SKIP IF THERE
	$STOP(RCO,G$RSDC off .. does not match list data)
	MOVE	P1,S2			;SAVE ADDRESS IN S2
RSDM.1:	MOVE	P2,RSD.CT(P1)		;GET COUNT OF PIDS
	MOVE	P3,RSD.PD(P1)		;GET PID OFFSET
	ADDI	P3,(P1)			;COMPUTE MESSAGE ADDRESS
RSDM.2:	SKIPN	S1,(P3)			;GET THE FIRST PID
	JRST	RSDM.4			;ZERO..GET NEXT ENTRY
	$CALL	CHKSFL			;CHECK FOR SEND FAILURE ON PID
	JUMPT	RSDM.4			;CHECK NEXT ONE
	MOVE	MO,RSD.MS(P1)		;GET MESSAGE ADDRESS
	ADDI	MO,(P1)			;GET ACTUAL ADDRESS
	LOAD	S2,.MSTYP(MO),MS.CNT	;GET MESSAGE LENGTH
	$CALL	SNDMSG			;SEND THE MESSAGE
	JUMPF	RSDM.7			;SEND FAILURE..UP COUNTS
	MOVX	S1,R.NSNT		;CLEAR THE NOT SENT FLAG
	ANDCAM	S1,RSD.FL(P1)		;CLEAR IT IN BLOCK
RSDM.3:	SETZM	(P3)			;CLEAR THE PID ENTRY
	SOSG	RSD.CT(P1)		;ANY MORE PIDS LEFT
	JRST	RSDM.5			;NO..REMOVE ENTRY
RSDM.4:	AOS	P3			;NEXT PID
	SOJG	P2,RSDM.2		;CHECK IF MORE
	JRST	RSDM.6			;GET NEXT ENTRY
RSDM.5:	MOVX	S1,R.NSNT		;GET THE NOT SENT FLAG
	TDNE	S1,RSD.FL(P1)		;WAS IT EVER SENT
	$CALL	REQNST			;REQUEUE FOR NOT SENT
	MOVE	S1,G$RSDL		;GET THE RESEND LIST
	$CALL	L%DENT			;DELETE THE ENTRY
	SOSGE	G$RSDC			;DECREMENT RESEND COUNT
	$STOP(RCN,G$RSDC is negative database confused)
RSDM.6:	MOVE	S1,G$RSDL		;GET THE LIST NUMBER
	$CALL	L%NEXT			;GET THE NEXT ENTRY
	JUMPF	.RETT			;DONE..RETURN
	SETZM	RSDCNT			;CLEAR THE RESEND COUNT
	MOVE	P1,S2			;SAVE THE MESSAGE ADDRESS
	JRST	RSDM.1			;TRY THIS ONE
RSDM.7:	AOS	G$SNDF			;BUMP SEND FAILURE COUNT
	AOS	RSD.RT(P1)		;BUMP THE RETRY COUNT...****
	CAXE	S1,ERNSP$		;NO SUCH PID??
	JRST	RSDM.8			;NO..RETRY LATER
	MOVE	S1,RSD.FL(P1)		;GET THE FLAGS
	TXNN	S1,R.SOPR		;WAS IT OPR RESEND
	JRST	RSDM.3			;DELETE PID FROM ENTRY
	MOVE	S1,(P3)			;GET THE PID
	$CALL	DELOPR			;DELETE THE OPR
	JRST	RSDM.3			;TRY NEXT ONE
RSDM.8:	MOVE	S1,(P3)			;GET THE PID
	$CALL	ADDSFL			;ADD THE SEND FAILURE
	JRST	RSDM.4			;FINISH OFF ENTRY
SUBTTL	REQNST	Reque unsent messages

;THIS ROUTINE WILL MOVE A RESEND BACK TO THE NEVER SENT QUEUE IF MESSAGE
;NOT SENT AND OPR INVALID

REQNST:	MOVE	S1,G$SNDL		;NOT SENT LIST
	$CALL	L%LAST			;POSITION TO LAST
	AOS	G$NSNT			;BUMP NOT SENT COUNT
	MOVE	S1,G$SNDL		;GET LIST NUMBER AGAIN
	LOAD	S2,RSD.HD(P1),RS.LEN	;GET LENGTH OF BLOCK
	$CALL	L%CENT			;CREATE AN ENTRY
	SKIPT				;Skip this if true
	PUSHJ	P,S..CCE		;Can't create entry, go STOP
	MOVE	S1,P1			;ADDRESS OF OLD ONE
	PJRST	MOVBLK			;MOVE THE BLOCK AND RETURN
SUBTTL	ADDSFL	Add a send failure to table
;
;S1/	PID TO ADD

ADDSFL:	MOVEM	S1,G$SFPD		;SAVE THE PID
	SKIPN	SFLFRE			;ANY AVAILABLE ENTRIES
	$CALL	ADDP.3			;NO...GET SOME MORE
	$CALL	.SAVE2			;GET A SCRATCH AC
	MOVE	S1,G$SFPD		;GET THE PID
	$CALL	CHKS.0			;CHECK IF IN LIST
	JUMPT	ADDP.5			;BUMP THE COUNT AND RETURN
	MOVE	S2,SFLADR		;GET ADDRESS OF TABLE
ADDP.1:	SKIPN	SFL.PD(S2)		;IS THE ENTRY AVAILABLE
	JRST	ADDP.2			;YES..USE IT
	ADDI	S2,SFL.SZ		;BUMP TO NEXT ONE
	JRST	ADDP.1			;TRY AGAIN
ADDP.2:	MOVE	S1,G$SFPD		;GET THE PID
	MOVEM	S1,SFL.PD(S2)		;SAVE PID IN TABLE
	AOS	SFL.CT(S2)		;BUMP COUNT OF MESSAGES
	SOS	SFLFRE			;DECREMENT FREE LOCATIONS
ADDRTY:	AOS	S2,RSDCNT		;BUMP RESEND COUNT AND PLACE IN S2
	ADD	S2,OPRRSL		;GET ADDRESS FOR ENTRY
	MOVEM	S1,-1(S2)		;SAVE THE PID
	$RETT				;RETURN
ADDP.3:	$CALL	.SAVE2			;SAVE P1
	MOVE	S1,SFLCNT		;GET NUMBER OF ENTRIES
	ADDI	S1,^D10			;INCREMENT COUNT
	IMULI	S1,SFL.SZ		;GET SIZE NEEDED FOR TABLE
	$CALL	M%GMEM			;GET THE MEMORY
	MOVE	P1,S2			;SAVE THE ADDRESS
	SKIPN	SFLCNT			;ZERO COUNT
	JRST	ADDP.4			;YES..UPDATE AND RETURN
	MOVE	P2,SFLCNT		;GET COUNT OF ENTRIES
	IMULI	P2,SFL.SZ		;COMPUTE LENGTH OF TABLE
	ADD	P2,S2			;GET ENDING ADDRESS OF NEW TABLE
	HRL	S1,SFLADR		;GET ADDRESS OF OLD TABLE
	HRR	S1,S2			;AND ADDRESS OF NEW TABLE
	BLT	S1,-1(P2)		;MOVE THE TABLE
	MOVE	S1,SFLCNT		;GET OLD COUNT
	IMULI	S1,SFL.SZ		;MULTIPLY BY ENTRY SIZE
	MOVE	S2,SFLADR		;GET OLD ADDRESS
	$CALL	M%RMEM			;RETURN THE MEMORY
ADDP.4:	MOVEM	P1,SFLADR		;SAVE NEW ADDRESS
	MOVEI	S1,^D10			;GET INCREMENT
	ADDM	S1,SFLCNT		;SAVE NEW COUNT
	ADDM	S1,SFLFRE		;SAVE NEW FREE COUNT
	$RETT				;RETURN
ADDP.5:	AOS	SFL.CT(P2)		;INCREMENT THE COUNT
	MOVE	S1,G$SFPD		;GET THE BAD PID
	PJRST	ADDRTY			;ADD TO RETRY LIST
	$RETT				;RETURN
					;P2 SET FROM CHKSFL(CHKS.0)
SUBTTL	DELSPL	Delete a send failure entry

;THIS ROUTINE WILL REMOVE ENTRY FROM SEND FAILURE PID TABLE

DELSPL:	$CALL	.SAVE2			;SAVE TWO ACS
	$CALL	CHKS.0			;CHECK AND GET ACS RETURNED
	SKIPT				;O.K. ENTRY ADDRESS IN T2
	$STOP(DSP,Delete send Failure pid table entry inconsistency)
	SETZM	SFL.PD(P2)		;CLEAR PID ENTRY
	SETZM	SFL.CT(P2)		;CLEAR THE COUNT ENTRY
	AOS	SFLFRE			;BUMP FREE COUNT
	$RETT				;RETURN



SUBTTL	CHKSFL	Check send failure entries

;THIS ROUTINE WILL CHECK FOR PID IN TABLE


;CALL	S1/	PID TO CHECK
;
;RETURN	 TRUE:	FOUND ENTRY
;RETURN FALSE: DIDN'T FIND ENTRY

CHKSFL:	$CALL	.SAVE2			;GET TWO SCRATCH ACS
CHKS.0:	MOVE	P1,SFLCNT		;GET NUMBER OF ENTRIES
	CAMN	P1,SFLFRE		;ARE ANY ENTRIES USED
	$RETF				;NO..RETURN FALSE
	MOVN	P1,P1			;SETUP AOBJN POINTER
	HRLZS	P1			;MAKE AOBJN POINTER
	MOVE	P2,SFLADR		;GET THE ADDRESS
CHKS.1:	CAMN	S1,SFL.PD(P2)		;CHECK FOR PID
	$RETT				;RETURN TRUE
	ADDI	P2,SFL.SZ		;GET TO NEXT ENTRY
	AOBJN	P1,CHKS.1		;TRY NEXT ONE
	$RETF				;COULDN'T FIND
SUBTTL	CLRSFL	Clear send failure list

;THIS ROUTINE WILL CLEAR TABLE SO WE CAN RECONSTRUCT IT

CLRSFL:	SKIPN	S1,SFLCNT		;ANY ENTRIES
	$STOP(SFI,Send failure table inconsistent)
	MOVEM	S1,SFLFRE		;RESET FREE COUNT
	IMULI	S1,SFL.SZ		;COMPUTE SIZE
	MOVE	S2,SFLADR		;GET THE ADDRESS
	PJRST	.ZCHNK			;CLEAR AND RETURN
SUBTTL	SNDQSR	Send a message to QUASAR

;THIS ROUTINE WILL SEND THE APPROPRIATE MESSAGE TO QUASAR


;**;[6035]At SNDQSR::+0L replace 3 lines with 4 lines  JCR  1/15/90

SNDNEB::$CALL	ADDTXT			;[6035]Add the command text block
	MOVX	T4,SP.NEB+SI.FLG	;[6035]Indicate message is for NEBULA
	SKIPA				;[6035]Don't send to QUASAR
SNDQSR::MOVX	T4,SP.QSR+SI.FLG	;[6035]Indicate message is for QUASAR
	MOVE	S1,G$SND		;GET THE SENDERS PID
	STORE	S1,.MSCOD(MO)		;SAVE IN MESSAGE
	STORE	T4,SNDBLK+SAB.SI	;[6004]IN SAB
	SETZM	SNDBLK+SAB.PD		;CLEAR PID WORD
	MOVEI	S2,PAGSIZ		;GET SIZE OF THE MESSAGE
	$CALL	SNDCGP			;[6005]SEND THE MESSAGE
	$RETIT				;OK..RETURN
	MOVEI	S1,QSRNAM		;[6005]GET QUASAR'S NAME
	CAME	T4,[SP.QSR+SI.FLG]	;[6004]MESSAGE INTENDED FOR QUASAR?
	MOVEI	S1,NEBNAM		;[6005]INDICATE INTENDED FOR NEBULA
	MOVEM	S1,G$ARG1		;SAVE STRING
;**;[6030]At SNDNEB:+12L change 1 line JYCW Oct-18-88
	CAME	T4,[SP.NEB+SI.FLG]	;[6030]MESSAGE INTENDED FOR NEBULA?
	PJRST	TAKABT			;[6004]NO, DO TAKE ABORT
	$CALL	TAKABT			;[6004]YES, RETURN BACK HERE
	$RETF				;[6004]RETURN TO CALLER
;**;[6035]At SNDQSR::+17L add routine ADDTXT  JCR  1/15/90
SUBTTL	ADDTXT	Add an Original Command Text Block to an IPCF Message

;[6035]Routine ADDTXT is called to add an Original Command Text (.OCTXT) 
;[6035]block to a message that is being sent to NEBULA. This block contains 
;[6035]the OPR command text that the operator typed. It will be logged by
;[6035]the remote ORION (L$NEB).
;[6035]
;[6035]Call is: MI/The address of the IPCF message received from OPR
;[6035]         MO/The address of the IPCF message that will be sent to NEBULA
;[6035]Returns: The .OCTXT block has been added to the outgoing message

ADDTXT:	$SAVE	<T1,T2>			;[6035]Save some scratch ACs
	LOAD	T1,.MSTYP(MO),MS.CNT	;[6035]Pick up the message length
	ADD	T1,MO			;[6035]Address of the .OCTXT block
	MOVEI	S1,ARG.DA(T1)		;[6035]Where to place the text
	HRLI	S1,(POINT 7,)		;[6035]Make into a pointer
	MOVE	S2,COM.CM(MI)		;[6035]Pick up the text offset
	ADDI	S2,ARG.DA(MI)		;[6035]The text address
	HRLI	S2,(POINT 7,)		;[6035]Make into a pointer

ADDT.1:	ILDB	T2,S2			;[6035]Pick up the next character
	IDPB	T2,S1			;[6035]Place in the outgoing message
	JUMPN	T2,ADDT.1		;[6035]Go pick up the next character

	HRRZS	S1			;[6035]Isolate the block end address
	SUBI	S1,-1(T1)		;[6035]Calculate the block length
	MOVSS	S1			;[6035]Place in the expected place
	ADDM	S1,.MSTYP(MO)		;[6035]Update the message length
	HRRI	S1,.OCTXT		;[6035]Pick up the block type
	MOVEM	S1,ARG.HD(T1)		;[6035]Set up .OCTXT block header
	AOS	.OARGC(MO)		;[6035]Update the argument count
	$RET				;[6035]Return to the caller

SUBTTL	SNDACT	Send a message to ACTDAE

TOPS10 <

SNDACT::MOVX	S1,SP.ACT+SI.FLG	;SEND TO ACCOUNT DAEMON
	STORE	S1,SNDBLK+SAB.SI
	SETZM	SNDBLK+SAB.PD
	MOVE	S1,G$SND		;GET SENDERS PID
	MOVEM	S1,.MSCOD(MO)		;STORE AS ACK CODE
	MOVEI	S2,PAGSIZ		;GET SIZE OF MESSAGE
	PJRST	SNDCGP			;[6005]SEND IT OFF

>;END TOPS10

SUBTTL	SQSD60	Send a message to QUASAR about DN60

IFN FTDN60,<
;This routine sends a DN60 message to QUASAR.  It differs from SNDQSR
;only because it sends a message size of 777.  This is because a message size
;of 1000 causes the page to be released twice since the main loop thinks
;it is sending messages to multiple operators.  UNDERSTAND?

SQSD60::MOVE	S1,G$SND		;GET THE SENDERS PID
	STORE	S1,.MSCOD(MO)		;SAVE IN MESSAGE
	MOVX	S1,SP.QSR+SI.FLG	;INDICATE TO QUASAR
	STORE	S1,SNDBLK+SAB.SI	;IN SAB
	SETZM	SNDBLK+SAB.PD		;CLEAR PID WORD
	MOVEI	S2,777			;Size that forces retention of page
	$CALL	SNDCGP			;[6005]SEND THE MESSAGE
	$RETIT				;OK..RETURN
	MOVEI	S1,[ASCIZ/QUASAR/]	;GET QUASARS NAME
	MOVEM	S1,G$ARG1		;SAVE STRING
	PJRST	TAKABT			;DO TAKE ABORT
>;end FTDN60
SUBTTL	SNDMSG	Send a message to a specific PID

;ON ENTRY S1=PID TO SEND TO
;	S2 = LENGTH OF MESSAGE (1000 IMPLIES A PAGE MODE SEND)
;	MO=ADDRESS OF MESSAGE BLOCK

SNDMSG:	STORE	S1,SNDBLK+SAB.PD	;SAVE IN ARG BLOCK
	SETZM	SNDBLK+SAB.SI		;NOT TO SPECIAL PID
SNDCGP:	STORE	S2,SNDBLK+SAB.LN	;[6005]SAVE LENGTH IN SAB
	STORE	MO,SNDBLK+SAB.MS	;SAVE ADDRESS IN ARG BLOCK

IFN	FTDN60,<
	HLRZ	T1,SNDBLK+SAB.PD	;GET THE PID
	CAIE	T1,-1			;CHECK FOR -1
	JRST	SNDM.2			;DN60 ACK/WTO
	MOVE	T1,G$OPRA		;GET THE OPR ADDRESS
	MOVX	S1,OP.D60		;GET D60 FLAG
	TDNN	S1,OPR.FL(T1)		;IS IT A DN60 MESSAGE?
	JRST	SNDM.2			;NO.. DO NORMAL IPCF SENDING
	MOVE	S1,OPR.ND(T1)		;GET NODE ADDRESS
	MOVE	S1,NOD.NM(S1)		;GET NODE NAME
;	MOVE	S1,OPR.PL(T1)		;GET THE PORT LINE WORD
	MOVEM	S1,G$SND		;SAVE AS RETURN CODE
	MOVEI	S1,.OMDSP		;MAKE SURE DISPLAY TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE
	PJRST	SQSD60			;SEND IT TO QUASAR
>;END FTDN60

SNDM.2:	SETZM	PAGFLG			;CLEAR A FLAG
	MOVE	T1,SNDBLK+SAB.LN	;GET THE LENGTH
	CAIE	T1,PAGSIZ		;GET THE PAGE SIZE
	JRST	SNDM.3			;NO..SEND AS IS
	LOAD	T1,.MSTYP(MO),MS.CNT	;GET MESSAGE LENGTH
	CAMLE	T1,G$MAXP		;CAN WE SEND A PACKET
	JRST	SNDM.3			;NO..
	SETOM	PAGFLG			;SET THE FLAG
	MOVEM	T1,SNDBLK+SAB.LN	;RESET THE LENGTH
SNDM.3:	MOVX	S1,SAB.SZ		;GET LENGTH IN S1
	MOVEI	S2,SNDBLK		;AND ADDRESS IN S2
	$CALL	C%SEND			;SEND THE MESSAGE
	 $RETIF				;ERROR..RETURN
	SKIPE	PAGFLG			;WAS IT A PAGE?
	$CALL	RELPAG			;YES..RELEASE THE PAGE
	$RETT
SUBTTL	SPDOPR	Send a message to an OPR

;THIS ROUTINE WILL SEND MESSAGE TO AN OPR AND REQUEUE ON A
;FAILURE

SPDOPR::SETZM	RSDCNT			;CLEAR RESEND COUNT
	$CALL	CHKSFL			;CHECK SEND FAILURES
	JUMPT	SPDO.0			;REQUEUE MESSAGE
	$CALL	SNDMSG			;SEND THE MESSAGE
	$RETIT				;O.K..JUST RETURN
	CAXN	S1,ERNSP$		;NO SUCH PID?
	JRST	SPDO.3			;YES..DELETE OPR AND RELEASE MESSAGE
	MOVE	S1,SNDBLK+SAB.PD	;GET THE PID
SPDO.0:	$CALL	ADDSFL			;ADD PID TO SEND FAILURE LIST
SPDO.1:	MOVX	S1,R.SOPR		;SETUP AS OPR RESEND
SPDO.2:	SKIPN	G$RSDC			;FIRST MESSAGE TO BE RESENT?
	JRST	[PUSH P,S1		;YES..PRESERVE S1
		 $CALL REQRSD		;REQUEST RESEND
		 POP P,S1
		 JRST .+1]
	AOS	G$RSDC			;BUMP THE RESEND COUNT
	MOVE	S2,G$RSDL		;GET THE RESEND LIST
	$CALL	REQMSG			;REQUEUE THE MESSAGE
	PJRST	RELPAG			;RELEASE THE PAGE AND RETURN
SPDO.3:	MOVE	S1,SNDBLK+SAB.PD	;GET THE PID
	$CALL	VALOPR			;VALIDATE THE OPR
	SKIPT				;CONTINUE
	$STOP(ODI,OPR database inconsistent)
	MOVE	S1,SNDBLK+SAB.PD	;GET THE PID
	$CALL	DELOPR			;DELETE THE OPR
	$CALL	RELPAG			;RELEASE THE PAGE
	$RETF				;AND RETURN FALSE
SUBTTL	SNDPID	Send a message to any PID (not OPR)

;THIS ROUTINE WILL SEND MESSAGE TO ANY PID AND REQUEUE ON FAILURE

SNDPID:	SETZM	RSDCNT			;CLEAR RSDCNT
	$CALL	CHKSFL			;CHECK SEND FAILURE TABLE
	JUMPT	SNDP.1			;REQUEUE THE MESSAGE
	$CALL	SNDMSG			;SEND THE MESSAGE
	$RETIT				;OK..RETURN
	CAXN	S1,ERNSP$		;NO SUCH PID
	$RETF				;RETURN FALSE..NO SUCH PID
	MOVE	S1,SNDBLK+SAB.PD	;GET THE PID
SNDP.1:	$CALL	ADDSFL			;ADD SEND FAILURE LIST
SNDP.2:	SETZ	S1,			;NO FLAGS
	PJRST	SPDO.2			;REQUEUE MESSAGE AND RETURN
SUBTTL	Interrupt Handler

INT:	$BGINT	IPCLEV
	$CALL	C%INTR			;SIGNAL THE INTERRUPT
	$DEBRK
SUBTTL	Default PDBs for OPRCMD

IFN	FTDN60,<

TXTLIN::MOVEI	S2,[ASCIZ/Multiple line text not allowed for remote operators/]
	$RETF
WAITAC:: MOVEI	S2,[ASCIZ/Wait command not allowed for remote operators/]
	$RETF
TAKOPR::
ENTFDB::
WAIOPR::
EXTFDB::$CRLF(<$PREFILL(BADFDB)>)

SETTRM::
SETRTN::
PUSHRT::
BADFDB:	MOVEI	S2,[ASCIZ/Command invalid for remote operators/]
	$RETF

CMDACT::$RETT

>;END FTDN60
SUBTTL	SETOUT	Setup output of data

;THIS ROUTINE WILL SETUP A DISPLAY MESSAGE FOR A DN60 OPERATOR

IFN	FTDN60,<
SETOUT:: $CALL	SETPTR			;SETUP THE POINTER
	MOVEM	S1,WTOPTR		;SAVE THE POINTER
	$TEXT	(,<^M^J^N/G$HOST/::^A>)	;OPR HEADER LINE
	$RET				;RETURN

SUBTTL	SNDOUT	Output routines for DN60

;THIS ROUTINE WILL SEND DATA TO QUASAR FOR OUTPUT TO DN60

SNDOUT:: MOVX	S1,0			;GET A NULL
	IDPB	S1,WTOPTR		;END WITH A NULL
	HRRZ	S1,WTOPTR		;GET END ADDRESS
	ADDI	S1,1			;BUMP IT BY 1
	ANDI	S1,777			;GET MESSAGE LENGTH
	STORE	S1,.MSTYP(MO),MS.CNT	;SAVE THE COUNT
	SUBI	S1,.OHDRS		;GET THE BLOCK SIZE
	STORE	S1,.OHDRS+ARG.HD(MO),AR.LEN	;SAVE THE BLOCK LENGTH
	MOVX	S1,.CMTXT		;GET TEXT TYPE
	STORE	S1,.OHDRS+ARG.HD(MO),AR.TYP	;SAVE THE TYPE
	MOVE	S1,G$SND		;PID TO SEND TO
	MOVEI	S2,PAGSIZ		;GET PAGE SIZE
	PJRST	SNDPID			;SEND TO QUASAR VIA PID
SUBTTL	OUTRTN	Output routine for links

;THIS IS THE TEXT DEFAULT OUTPUT ROUTINE AND WILL SETUP DATA FOR THE
;LINKS

OUTRTN:	SOSG	WTOCNT			;ROOM LEFT
	JRST	OUTR.1			;NO..SEND AND MAKE ROOM
	IDPB	S1,WTOPTR		;SAVE THE BYTE
	$RETT				;RETURN TRUE
OUTR.1:	PUSH	P,S1			;SAVE THE BYTE
	$CALL	SNDOUT			;SEND THE OUTPUT
	$CALL	SETPTR			;RESET THE POINTERS
	MOVEM	S1,WTOPTR		;SAVE THE POINTER
	POP	P,S1			;RESTORE THE VALUE
	JRST	OUTRTN			;SAVE THE CHARACTER NOW
SUBTTL	SETPTR	Setup pointers for output

;THIS ROUTINE WILL SETUP THE POINTERS AND RETURN WITH S1 CONTAINING
;THE NEW BYTE POINTER

SETPTR:	$CALL	GETPAG			;GET A PAGE
	MOVX	S1,.OMDSP		;GET MESSAGE TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	MOVEI	S1,<PAGSIZ-<.OHDRS+ARG.DA+1>>*5 ;GET ROOM FOR DATA
	MOVEM	S1,WTOCNT		;SAVE THE COUNT
	MOVE	S1,G$OPRA		;GET OPR ADDRESS
	MOVE	S1,OPR.ND(S1)		;GET THE PORT LINE DATA
	MOVE	S1,NOD.NM(S1)		;GET THE NODE NAME
	MOVEM	S1,.MSCOD(MO)		;SAVE THE CODE IN THE MESSAGE
	MOVSI	S1,(POINT 7,)		;SETUP THE BYTE POINTER
	HRRI	S1,.OHDRS+ARG.DA(MO)	;GET BUFFER ADDRESS
	$RET				;RETURN S1 BYTE POINTER

SHWDAY:: $CALL	SETOUT			;SETUP THE OUTPUT
	$TEXT	(,<^H/[-1]/>)
	$CALL	SNDOUT			;SEND THE OUTPUT
	PJRST	P$NPRO##		;NO PROCESSING REQUIRED

>;END FTDN60
	SUBTTL	LOGNSE - Setup to log a NEBULA send error

LOGNSE:	MOVEI	S1,NEBNAM		;[6005]PICK UP NEBULA'S NAME ADDRESS
	MOVEM	S1,G$ARG1		;[6005]SAVE FOR THE ERROR MESSAGE
	SETOM	G$NACK			;[6005]DON'T ACK THE SENDER
	MOVEI	S1,E$IAP		;[6005]PICK UP THE ERROR ROUTINE ADDRESS
	$RETF				;[6005]INDICATE A FAILURE
	SUBTTL	FNDBLK - Routine to find any block in an IPCF message

;[6024]Call is:  MI/The message address
;[6024]	         S1/The block type to search for
;[6024]
;[6024]Returns true:  S1/The block address
;[6024]Returns false: The block was not found

	INTERN	FNDBLK			;[6024]MAKE IT GLOBAL

FNDBLK:	$SAVE	<P1,P2>			;[6024]SAVE THESE AC
	LOAD	P1,.OARGC(MI)		;[6024]GET THE MESSAGE ARGUMENT COUNT
	MOVE	P2,S1			;[6024]SAVE THE BLOCK TYPE
	MOVEI	S1,.OHDRS(MI)		;[6024]POINT TO THE FIRST BLOCK
	LOAD	TF,.MSTYP(MI),MS.CNT	;[6024]GET THE MESSAGE LENGTH
	CAXLE	TF,PAGSIZ		;[6024]CAN'T BE GREATER THEN A PAGE
	$RETF				;[6024]ELSE THATS AN ERROR
	ADD	TF,MI			;[6024]POINT TO THE END OF THE MESSAGE

FNDB.1:	LOAD	S2,ARG.HD(S1),AR.TYP	;[6024]GET THIS BLOCK TYPE
	CAMN	S2,P2			;[6024]IS THIS THE DESIRED BLOCK TYPE?
	$RETT				;[6024]YES, INDICATE FOUND THE BLOCK
	LOAD	S2,ARG.HD(S1),AR.LEN	;[6024]NO, GET THIS BLOCK'S LENGTH
	ADD	S1,S2			;[6024]POINT TO THE NEXT BLOCK
	CAIG	TF,0(S1)		;[6024]STILL IN THE MESSAGE?
	$RETF				;[6024]NO, RETURN BLOCK NOT FOUND
	SOJG	P1,FNDB.1		;[6024]CONTINUE UNTIL FINISHED
	$RETF				;[6024]NOT FOUND
	$STOP(DBC,DeBug Crash - Keep this crash)
	END	ORION