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