Google
 

Trailing-Edge - PDP-10 Archives - BB-PENEA-BM_1990 - galsrc/oprqsr.mac
There are 40 other files named oprqsr.mac in the archive. Click here to see a list.
	TITLE	OPRQSR	ORION MODULE TO PROCESS QUASAR MESSAGES
	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,ACTSYM,NEBMAC	;[130]
	SEARCH MACSYM			;[161]
	PROLOG(OPRQSR)
	ERRSET				;INITIALIZE ERROR TABLES
	PARSET				;SETUP PARSER ENTRIES


;Version numbers

	QSRMAN==:162			;Maintenance edit number
	QSRDEV==:143			;Development edit number
	VERSIN (QSR)			;Generate edit number
	EXTERNAL G$NOW			;TIME OF DAY
	EXTERNAL G$ARG1			;ARGUMENT 1
	EXTERNAL G$ARG2			;ARGUMENT 2
	EXTERNAL G$ARG3			;ARGUMENT 3
	EXTERNAL G$OPRA			;OPR ADDRESS
	EXTERNAL G$HOST			;HOST NODE NAME
	EXTERNAL G$ERR			;ERROR FLAG WORD
	EXTERNAL G$CLUN			;[130]CLUSTER NODE BLOCK
	EXTERNAL G$OUTP			;[130]RELEASE PAGE INDICATOR
	EXTERNAL G$FERR			;[130]FIRST MESSAGE ERROR FLAG
	EXTERNAL G$CBLK			;[130]CLUSTER NODE NAME BLOCK
;**;[144]At EXTERNAL G$CBLK +1L add 1 line JYCW Oct-18-88
	EXTERNAL G$NOFG			;[144]/NODE: SWITCH
;**;[160]At EXTERNAL G$NOFG +1L add 3 lines   PMM   6/3/90
	EXTERNAL SNDAOP			;[160]Send to all OPRS
	EXTERNAL FASNEB			;[160]Send to NEBULA
	EXTERNAL W$NODE			;[160]Find node
	EXTERNAL SNDQSR			;SEND TO QUASAR
	EXTERNAL SNDNEB			;[130]SEND TO NEBULA
TOPS10<	EXTERNAL SNDACT>		;SEND TO ACTDAE
	EXTERNAL GETPAG			;ROUTINE TO SETUP MO
	EXTERNAL RELPAG			;[130]ROUTINE TO RELEASE A PAGE
	EXTERNAL QRTONB			;[134]ORION TO NEBULA CODE TRANSLATION
	EXTERNAL OPRENB			;OPR ENABLED
	EXTERNAL MOVARG			;MOVE AN ARGUMENT
	EXTERNAL MOVAR2			;MOVE TWO WORD ARGUMENT
	ENTRY	BLDOBJ			;BUILD OBJECT BLOCK
	ENTRY	ARGRTN			;SETUP ARGUMENT IN MESSAGE
	ENTRY	CMDEND			;COMMAND END PROCESSING
;**;[144]At ENTRY CMDEND add 1 line JYCW Oct-18-88
	ENTRY	SNDCL0			;[144]
;**;[160]At $DATA OBJTYP:+1L replace 1 line with 7 lines   PMM   6/3/90
	$DATA	OBTYPE,1		;[160]Type of object in message
	$GDATA	HDRAKA,1		;[160]Alias linked list header
	$GDATA	AKAOBJ,OBJ.SQ+10	;[160]Object block storage for DEFAKA
	$GDATA	RELBLK,1		;[160]Designates that null RESPONSE
					;[160]to DEFINE ALIAS Command is 
					;[160]being sent.
	$DATA	REMLPT			;[160]Indicates message is from NEBULA
SUBTTL	Revision history

COMMENT \

74	4.2.1273	18-Mar-82
	Add support for MOUNT FOO:/WRITE-LOCKED.

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

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

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

101	5.1021		5-Apr-83
	Handle the new structure attributes EXCLUSIVE and SHARED.  Support
the new SET PORT CI OFFLINE/ONLINE command (SETPOR routine).

102	5.1027		10-May-83
	Change SET PORT CI OFFLINE/ONLINE to UNAVAILABLE/AVAILABLE.

103	5.1035		18-Jul-83
	Add processing for REMOVAL/NOREMOVAL to the DISMOUNT STRUCTURE
command processing in Q$DISM.

104	5.1069		23-Jan-84
	Add processing for new SHOW STATUS STRUCTURE command.

105	5.1080		6-Feb-84
	Add routine Q$UNDE to support undefine command.

106	5.1111		1-Mar-84
	Add routine Q$MOUNT to support MOUNT command.

107	5.1124		2-Apr-84
	Add support to SETDSK to handle controller number.

110	5.1162		21-Sep-84
	Add support for SNA Workstations

111	5.1170		19-Oct-84
	Correct /SPOOL on SET PRINTER DESTINATION so as not to cause
ORION Message Error.

112	5.1186		5-Dec-84
	Support the new SET PORT NI AVAILABLE/UNAVAILABLE command (SETPOR
routine).

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

114	5.1208		20-Mar-85
	Correct symbols used in NI% JSYS support.

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

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

125	6.1016		13-Oct-87
	Add support for remote printing commands.

126 	6.1020		19-Oct-87
	Change the format of the ROUTE message to always include a name
block. This block is used by QUASAR only for remote LPTs, but adds consistency
to QUASAR's route table's entries.

127	6.1041		29-Oct-87
	Add support for remote printer handling of the OPR SHOW STATUS PRINTER
and SHOW PARAMETERS PRINTER commands.

130	6.1078		15-Nov-87
	Add support for the /CLUSTER-NODE: switch of the OPR SHOW command.

131	6.1072		12-Nov-87
	In routine Q$STAR and LPTTY4, add the TERMINAL-CHARACTERISTIS block to
the start command.

132	6.1081		19-Nov-87
	In STRDSP: add keyword entries for DUMPABLE/NONDUMPABLE.

133	6.1098		22-Nov-87
	Add support for MOUNT STRUCTURE /CLUSTER-NODE

134	6.1099		22-Nov-87
	Change routine SNDCLU to change the message code to what NEBULA
expects.

135	6.1078		25-Nov-87
	Make routine CHCLUN:: global.

136	6.1114		3-Dec-87
	Add support for the SHOW CLUSTER-GALAXY-LINK-STATUS command.

137	6.1143		17-Dec-87
	Do not save and restore the switch type when calling routint
CHCLUN since it preserves the swithc type.

140	6.1225		8-Mar-88
	Update copyright notice.

141	6.1226		8-Mar-88
	Delete the check for /TERMINAL-CHAR in routine LPTTY4: and move it to
Q$SHUT:.  This will fix the /PURGE bug in the ABORT command.

142	6.1230		24-Mar-88
	SHOW STATUS TAPE /CHARACTERISTIC /CLUSTER-NODE: results in "illegally 
formatted message".

143	6.1226		5-Apr-88
	Edit 141 didn't delete the check for /TERMINAL-CHAR in LPTTY4 like it
suppose to.

144	6.1269		18-Oct-88
1. Implement the /CLUSTER-NODE: switch in the following commands:
START     SHUTDOWN     ABORT     REQUEUE     HOLD     CANCEL.
2. Change routine CMDEND: to look for the /CLUSTER-NODE switch before looking
for confirm.
3. If the object with are addressing is a remote (/NODE) include the .RMLPT
bit in the object block.
4. In routine SNDC.2:, if the message is not found in table QRTONB: and the
message is a cluster command, set bit NEB%MS in the GALAXY header to state
that this message is a command message in the new format, there is no
convertion needed before sending it to QUASAR and send it as is.

145	6.1285		5-October-89
	When checking if a CANCEL MOUNT or ABORT message should be sent
locally or remotely, use the SKIPE instruction rather than the SKIP instruction
so that messages to be sent locally will not be forwarded to NEBULA.

146	6.1289		29-November-89
	Make routine SNDCLU global.

147	6.1294		23-December-89
	Set bit .RMLPT only if a /NODE switch has been specified, the
message is being sent remotely, and the object type is not all (i.e., not 
"-1"). Also, set flag G$NOFG for all cases where a /NODE switch has been
specified in the SHOW STATUS and SHOW PARAMETERS commands.

150	6.1296		25-December-89
	Add support for the /NODE switch for the SHOW STATUS and SHOW 
PARAMETERS dealing with local printers.

151	6.1297		31-December-89
	Replace routine CHLUN with routine CMDEND.

152	6.1298		10-January-90
	Create a common routine to build the object block so that the START
doesn't have to call the SHUTDOWN code to do the work.  Change the SHUTDOWN
code to only process the shutdown command and not process any switches related
to the START command.

153	6.1300		12-January-90
	Change the order of the /REASON and /CLUSTER-NODE switches in the 
ABORT command so that it can be forwarded to the indicated remote node.

154	6.1301		15-January-90
	Correctly set the MF.NEB bit in the .MSFLG word for the SHOW CLUSTER
command.

155	6.1303		16-January-90
	Change routine Q$SWITCH to return an error after it detects an 
invalid tape drive designator.

156	6.1305		19-January-90
	Add /CLUSTER-NODE switch support to commands ALIGN, SUPPRESS and
ROUTE.

157	6.1306		31-January-90
	Change the argument value of .CMUSR and .LSUSR blocks from the
login directory number to the login directory name. This is in support
of those commands that can specify a /USER or /OWNER switch and in 
which a /CLUSTER-NODE switch has been specified whose node argument
has a different public structure than the local node.

160	6.1318		3-June-90
	Add support for alias printers.

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

162	6.1321		13-July-90
	Edit 161 did not handle the SET TAPE /CLUSTER command correctly.
\   ;End of Revision History
	Subttl	Table of Contents

;		     Table of Contents for OPRQSR
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   3
;    2. Q$SHUT Process SHUTDOWN command  . . . . . . . . . . .   6
;    3. Q$NEXT - NEXT COMMAND PROCESSOR  . . . . . . . . . . .   7
;    4. ARGRTN Setup an argument header  . . . . . . . . . . .   8
;    5. CMDEND Process end of command and send the message . .   9
;    6. BLDOBJ Build an object block . . . . . . . . . . . . .  10
;    7. LPTTYP Process a LPT object  . . . . . . . . . . . . .  11
;    8. BLDBLK . . . . . . . . . . . . . . . . . . . . . . . .  12
;    9. Q$FSPA Process FORWARDSPACE command  . . . . . . . . .  13
;   10. Q$ALGN Process ALIGN command . . . . . . . . . . . . .  14
;   11. Q$SUPP Process suppress command  . . . . . . . . . . .  15
;   12. Q$ABOR Process ABORT command . . . . . . . . . . . . .  16
;   13. PREQNM Process /REQUEST switch . . . . . . . . . . . .  17
;   14. Q$REQU Process REQUEUE command . . . . . . . . . . . .  18
;   15. Q$ROUT Process ROUTE command . . . . . . . . . . . . .  19
;   16. ROUBLK Build a remote printer object descriptor for RO  21
;   17. Q$RELE Process RELEASE command . . . . . . . . . . . .  22
;   18. PNODSW Process /NODE switch  . . . . . . . . . . . . .  23
;   19. Q$CANC Process CANCEL command  . . . . . . . . . . . .  24
;   20. CHKRMT Check for remote node input . . . . . . . . . .  25
;   21. Q$MODI Process MODIFY command  . . . . . . . . . . . .  26
;   22. Q$SET Process the SET command  . . . . . . . . . . . .  27
;   23. SETUSG Process SET USAGE command . . . . . . . . . . .  28
;   24. SETJOB Set operator values for a job . . . . . . . . .  29
;   25. SETxxx Process SET PARAMETERS  . . . . . . . . . . . .  30
;   26. SETONL Process SET ONLINE command (TOPS20) . . . . . .  31
;   27. SETSCH Process SET SCHEDULER command (TOPS20)  . . . .  32
;   28. SCHBAT Process SET SCHEDULER BATCH command (TOPS20)  .  33
;   29. SCHCLS Process SET SCHEDULER CLASS command (TOPS20)  .  34
;   30. SETNOD Process SET NODE command (DN60) . . . . . . . .  35
;   31. SETDSK Process SET DISK command (TOPS20) . . . . . . .  36
;   32. SETAVL Process set available/unavailable . . . . . . .  37
;   33. SETTAP Process SET TAPE command (TOPS20) . . . . . . .  38
;   34. PSTAPE Process tape drive argument . . . . . . . . . .  39
;   35. SETINI Process SET TAPE INITIALIZE command . . . . . .  40
;   36. SETDEN Process /DENSITY switch . . . . . . . . . . . .  41
;   37. SETOWN Process /OWNER switch . . . . . . . . . . . . .  42
;   38. SETVID Process /VOLUME-ID switch . . . . . . . . . . .  43
;   39. TABSRC Table search routine  . . . . . . . . . . . . .  44
;   40. GETDES Get device designator word  . . . . . . . . . .  45
;   41. GETTAP Get a tape device . . . . . . . . . . . . . . .  46
;   42. SETSTR Process SET STRUCTURE command (TOPS20)  . . . .  47
;   43. SETPOR Process SET PORt command  . . . . . . . . . . .  48
;   44. Q$SHCF Process SHOW CONFIGURATION command  . . . . . .  49
;   45. Q$SHWS Process SHOW STATUS command . . . . . . . . . .  50
;   46. PROSHW Process SHOW STATUS and SHOW PARAMETERS . . . .  51
;   47. SHWNOD Process node for SHOW STATUS/PARAMETERS command  52
	Subttl	Table of Contents (page 2)

;		     Table of Contents for OPRQSR
;
;				  Section		      Page
;
;
;   48. SHWTAP Process SHOW STATUS TAPE command  . . . . . . .  53
;   49. SHWSTR Process SHOW STATUS STRUCTURES command  . . . .  54
;   50. SHWCFG Process SHOW CONFIGURATION DISK-DRIVE command .  55
;   51. SHWDSK Process SHOW STATUS DISK command  . . . . . . .  56
;   52. Q$SHWQ Process SHOW QUEUES command . . . . . . . . . .  57
;   53. Q$SHWC Process SHOW CONTROL-FILE command . . . . . . .  59
;   54. Q$SHCL - SHOW CLUSTER-GALAXY-STATUS-LINK . . . . . . .  60
;   55. CLUNOD - Send the message as determined by CLUSTER-NOD  61
;   56. CHCLUN - Modify message for NEBULA . . . . . . . . . .  62
;   57. SNDCLU - Send a cluster message  . . . . . . . . . . .  63
;   58. Q$DISM Process DISMOUNT command (TOPS20) . . . . . . .  64
;   59. Q$ESTR Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION   65
;   60. Q$ETAP Process ENABLE TAPE command . . . . . . . . . .  66
;   61. Q$LOCK Process LOCK command  . . . . . . . . . . . . .  67
;   62. Q$MOUN Process MOUNT TAPE and DISK command . . . . . .  68
;   63. Q$IDEN Process IDENTIFY command  . . . . . . . . . . .  69
;   64. Q$DEFI Process DEFINE command (DN60) . . . . . . . . .  70
;   65. Q$SWIT Process SWITCH command (TOPS20) . . . . . . . .  71
;   66. Q$MODS Process MODIFY SYSTEM-LISTS command (TOPS10)  .  72
;   67. Q$SLST Process SHOW SYSTEM-LISTS command (TOPS10)  . .  73
;   68. Q$SALC Process SHOW ALLOCATION command (TOPS10)  . . .  74
;   69. Q$UNDE Process undefine command  . . . . . . . . . . .  75
SUBTTL	Q$SHUT	Process SHUTDOWN command

;THIS ROUTINE WILL SEND THE APPROPRIATE OBJECT BLOCK TO QUASAR
;FOR THE DESIRED FUNCTION..
;THE ROUTINE IS CALLED WITH S1 CONTAINING THE MESSAGE TYPE

;**;[152]At Q$SHUT Replace 23 lines with 15 lines  JYCW 1/8/90
Q$SHUT:: $CALL	STASHU			;[152]Process the first part
	$RETIF				;[152]Bad command
	JRST	CMDEND			;[152]End the command

STASHU:	$CALL	BLDOBJ			;[152]BUILD THE OBJECT
	$RETIT				;[152]All done
	$CALL	P$KEYW			;[152]CHECK FOR KEYWORD
	JUMPF	E$IFC			;[152]ERROR..RETURN
	CAIE	S1,.KYNOD		;[152]WAS IT A NODE
	$RETF				;[152]BAD COMMAND
;**;[160]At STASHU:+5L change 1 line  PMM  6/3/90
	MOVE	S1,OBTYPE		;[160]Pick up the object type
	CAIN	S1,.OTLPT		;[152]A PRINTER?
	$RETF				;[152]YES, RETURN NOW
	$CALL	CNODSW			;[152]ADD THE NODE NAME TO THE MESSAGE
	$RETIF				;[152]CAN'T
	$RETT				;[152]All done

;**;[151]At SHUT0:+10L remove routine SHUT  JCR  12/31/89
;**;[144]At SHUT0:+10L add routine SHUT: JYCW Oct-18-88

SUBTTL	Q$CONT	Process CONTINUE command

Q$CONT:: $CALL	BLDOBJ			;BUILD AN OBJECT BLOCK
	$RETIF				;RETURN FALSE BACK UP
	PJRST	CMDEND			;CHECK FOR END AND SEND MESSAGE


SUBTTL	Q$STAR	Process START command

;THE START COMMAND IS THE SAME AS THE SHUTDOWN, CONTINUE 
; COMMANDS EXCEPT THAT THE START COMMAND FOR PRINTERS
;CAN HAVE AN OPTIONAL DEVICE FIELD.


;**;[152]At Q$STAR+0L modify 7 lines JYCW 1/8/90
Q$STAR::$CALL	STASHU			;[152]Process the first part
	$RETIF				;[152]Bad command
	HRRZ	S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[152]Get the object type
	CAIE	S1,.OTLPT		;[152]IS IT A PRINTER?
	JRST	CMDEND			;[152]No, end the command
;**;[160]At Q$STAR::+4L replace 1 line with 11 lines  PMM  6/3/90
STAR.1:	$CALL	P$SWIT			;[160]Is there a switch?
	JUMPF	CMDEN1			;[160]No, end the command
	CAIE	S1,.SWDEV		;[160]Was it /DEVICE?
	JRST	STAR.2			;[160]No, how about /TERMINAL?
	MOVE	S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[160]Pick up the printer type
	TXNE	S1,.CLLPT		;[160]A Cluster printer?
	PJRST	E$ICD			;[160]Yes, /DEVICE is invalid
	TXNE	S1,.DQLPT		;[160]A DQS printer?
	PJRST	E$IQD			;[160]Yes, /DEVICE is invalid
	TXNE	S1,.LALPT		;[160]A LAT printer?
	PJRST	E$ILD			;[160]Yes, /DEVICE is invalid
	LOAD	S1,OBJ.UN+ARG.DA+.OHDRS(MO),OU.HRG	;GET HIGH RANGE
	SKIPE	S1			;CHECK IF THERE  IS ONE
	PJRST	E$RNA			;RANGE NOT ALLOWED IN START /DEVICE
	$CALL	PSDEVI			;PROCESS DEVICE BLOCK
	$RETIF				;RETURN ON ERROR
	$CALL	P$SWIT			;[131] IS THERE ANOTHER SWITCH
	JUMPF	CMDEN1			;[151]No, go send the command
;**;[160]At STAR.1:+17L replace 2 lines with 7 lines  PMM  6/3/90
STAR.2:	CAIE	S1,.SWTTC		;[160]Was it TTY characteristic?
	JRST	CMDEN			;[160]No, check for /CLUSTER-NODE
	MOVE	S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[160]Pick up the printer type
	TXNE	S1,.CLLPT		;[160]A Cluster printer?
	PJRST	E$ICT			;[160]Yes, /TERMINAL is invalid
	TXNE	S1,.DQLPT		;[160]A DQS printer?
	PJRST	E$IDT			;[160]Yes, /TERMINAL is invalid
	$CALL	P$SIXF			;[131]GET SIXBIT FIELD
	$RETIF				;[131]NO GOOD

;BUILD NEW BLOCK, /TERMINAL-CHARACTERISTIC BLOCK, .ORTCR.

	MOVEM	S1,T4			;[131]SAVE THE TTY CHARACTERISTIC
	MOVEI	S2,2			;[131] TWO WORDS
	MOVEI	S1,T3			;[131] POINT TO THE ARG DATA
	MOVX	T1,.ORTCR		;[131]TTY CHARACT BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;[131]SAVE THE TYPE
	HRLM	S2,ARG.HD(S1)		;[131]SAVE THE TYPE
	$CALL	MOVARG			;[131]MOVE THE BLOCK AND RETURN
;**;[160]At STAR.2:+18L change 1 line  PMM  6/3/90
	JRST	STAR.1			;[160]Check for a /DEVICE switch

SUBTTL	Q$PAUS	Process the STOP command

Q$STOP:: $CALL	BLDOBJ			;[125]BUILD AN OBJECT BLOCK
	$RETIF				;RETURN FALSE BACK UP
	$CALL	P$KEYW			;DO WE HAVE A KEYWORD ???
	JUMPF	STOP.1			;NO,,DEFAULT TO IMMEDIATE
	CAXN	S1,.KYIMM		;IS IT IMMEDIATELY ???
	JRST	STOP.1			;YES,,SAY SO
	CAXE	S1,.KYAFT		;NOT IMMEDIATE,,MUST BE AFTER !!!
	$RETF				;NO,,RETURN AN ERROR
	$CALL	P$KEYW			;GET THE NEXT KEYWORD
	$RETIF				;NOT THERE,,THATS AN ERROR
	MOVX	S2,ST.ACR		;DEFAULT TO CURRENT REQUEST
	CAXN	S1,.KYAER		;UNLESS IT IS EVERY REQUEST
	MOVX	S2,ST.AER		;THEN MAKE IT EVERY REQUEST
	SKIPA				;SKIP OVER IMMEDIATE STATUS
STOP.1:	MOVX	S2,ST.IMM		;GET IMMEDIATE STATUS BIT
	MOVEM	S2,.OFLAG(MO)		;SAVE FLAG BITS
	PJRST	CMDEND			;CHECK FOR END AND SEND MESSAGE
	SUBTTL	Q$NEXT - NEXT COMMAND PROCESSOR

Q$NEXT:: $CALL	BLDOBJ			;[NXT] BUILD AN OBJECT BLOCK
	$RETIF				;[NXT] RETURN FALSE BACK UP
	$CALL	P$KEYW			;[NXT] DO WE HAVE A KEYWORD ???
	$RETIF				;[NXT] ERROR..RETURN
	CAXE	S1,.KYRQN		;[NXT] MUST BE REQUEST-ID !!!
	$RETF				;[NXT] NO,,THATS AN ERROR
	$CALL	PREQNM			;[NXT] PROCESS REQUEST NUMBER
	$RETIF				;[NXT] ERROR..RETURN
	PJRST 	CMDEND			;[NXT] FINISH OFF COMMAND
SUBTTL	ARGRTN	Setup an argument header

;THIS ROUTINE WILL SETUP THE ARGUMENT HEADER FROM THE
;TYPE IN S1 AND THE LENGTH IN S2. IT WILL ALSO ADVANCE P3 TO NEXT 
;LOCATION IN MESSAGE AND BUMP ARGUMENT COUNT FOR MESSAGE

ARGRTN:	STORE	S1,ARG.HD(P3),AR.TYP	;SAVE THE TYPE FIELD
	STORE	S2,ARG.HD(P3),AR.LEN	;SAVE THE LENGTH
	AOS	.OARGC(MO)		;BUMP ARGUMENT COUNT
	ADD	P3,S2			;BUMP TO NEXT FREE LOCATION
;**;[160]Replace 1 line with 8 lines at ARGRTN:+3L     PMM   6/3/90
	LOAD	S1,ARG.HD(P3),AR.TYP	;[160]Get next block type
	CAIE	S1,.AKANM		;[160]Is next block an alias block?
	$RETT				;[160]No, return true
	LOAD	S1,ARG.HD(P3),AR.LEN	;[160]Get next block length
	AOS	.OARGC(MO)		;[160]Bump argument count	
	ADD	P3,S1			;[160]Bump to next location
	$RETT				;[160]Return true
SUBTTL	CMDEND	Process end of command and send the message

;THIS ROUTINE WILL CHECK FOR END OF COMMAND AND IF O.K
;PREPARE MESSAGE TO BE SENT TO QUASAR

;**;[144]At CMDEND:+0L add 9 lines JYCW Oct-18-88
;[144]Since the /CLUSTER-NODE switch is the last switch, check for that before
;[144]checking for CONFIRM.  This way we don't have to change all the routines
;[144]to check for /CLUSTER-NODE.
;**;[151]At CMDEND:-1L replace 9 lines  with 14 lines  JCR  12/31/89
;[151]Redefine entry point CMDEN and add entry point CMDEN0.
;[151]CMDEND is called when either a /CLUSTER-NODE switch  or a confirm
;[151]       is possible.
;[151]CMDEN  is called when either a /CLUSTER-NODE switch or another type
;[151]       of switch is possible followed by a confirm and in which the
;[151]       /CLUSTER-NODE switch has been detected.
;[151]CMDEN0 is called when a /CLUSTER-NODE switch has been detected but it
;[151]       is not the last switch in the command.

CMDEND:	$CALL	P$SWIT			;[151]Is there a /CLUSTER-NODE switch?
	JUMPF	CMDEN1			;[151]No, check for a confirm block
CMDEN:	$CALL	CHCLUN			;[151]Pick up the /CLUSTER-NODE value
	$RETIF				;[151]Quit on an error
CMDEN0:	SKIPE	G$CLUN			;[151]Remote or all nodes specified?
	PJRST	SNDCLU			;[144]YES, SEND THE MESSAGE TO NEBULA

CMDEN1:	$CALL	P$CFM			;[144]CHECK FOR CONFIRM
	$RETIF				;NO..INVALID MESSAGE
	ANDI	P3,777			;GET MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE MESSAGE SIZE IN MESSAGE
	SKIPN	G$CLUN			;[130]CLUSTER NODE BLOCK DETECTED?
	PJRST	SNDQSR			;[130]NO, SEND THE MESSAGE TO QUASAR
	PJRST	SNDNEB			;[130]YES, SEND TO NEBULA
SUBTTL	BLDOBJ	Build an object block
SUBTTL	FINOBJ	Finish object block after type field

;THIS ROUTINE WILL BUILD AN OBJECT BLOCK FOR A MESSAGE TO AN
;OBJECT PROCESSOR AND PLACE IT IN THE MESSAGE POINTED TO BY
;MO
BLDOBJ:	$CALL	P$KEYW			;GET A KEYWORD
;**;[160]At BLDOBJ:+1L change 1 line  PMM  6/3/90
	MOVEM	S1,OBTYPE		;[160]Save the object type
	$RETIF				;NOT A KEYWORD..INVALID..RETURN	
	CAILE	S1,.OTMAX		;LESS THAN OR EQUAL VALID OBJECT
	JRST	BLDO.6			;INVALID TYPE..RETURN
	MOVE	P1,S1			;[125]SAVE THE OBJECT TYPE
	CAIE	S1,.OTBAT		;WAS IT A BATCH BLOCK
	JRST	BLDO.1			;NO..IGNORE CHECK
	MOVE	S1,G$HOST		;GET THE HOST NAME
	$CALL	OPRENB			;MUST BE SYSTEM OR LOCAL
	JUMPF	E$BNR			;BATCH COMMANDS MUST BE LOCAL
	MOVE	S1,P1			;GET THE TYPE BACK
BLDO.1:	STORE	S1,ARG.DA+OBJ.TY(P3)	;SAVE THE TYPE
FINOBJ:	SETZM	ARG.DA+OBJ.UN(P3)	;ZERO THE UNIT NUMBER FIELDS
	$CALL	P$NUM			;GET A NUMBER
;**;[150]At FINOBJ:+1L replace 16 lines with 34 lines  JCR  12/25/89
	JUMPT	FINO.4			;[150]Go check for a valid number
	CAIE	P1,.OTLPT		;[150]Is this a LPT object?
	$RET				;[150]No, preserve the error AC
	$CALL	P$KEYW			;[150]Pick up the printer type
;**;[160]At FINOBJ:+7L add 2 lines   PMM   6/3/90
	CAIN	S1,.AKANM		;[160]Is this an alias name?
	PJRST	LPTTYP			;[160]Go process it
	$RETIF				;[150]Illegally formatted command
	CAIE	S1,.KYLOC		;[150]Is this a local LPT?
	PJRST	LPTTYP			;[150]No, process remote LPT

;[150]The LPT object is a local LPT (from SHOW STATUS or PARAMETER command)

	MOVX	S1,.LOLPT		;[150]Pick up the local LPT type
	IORM	S1,ARG.DA+OBJ.TY(P3)	;[150]Indicate in the message to QUASAR
	$CALL	P$NUM			;[150]Check for a unit number
	JUMPF	FINO.1			;[150]Check for a node switch
	$CALL	FINNUM			;[150]Process the number
	$RETIF				;[150]Return on an error
	SKIPA				;[150]Don't reset the units
FINO.1:	SETOM	ARG.DA+OBJ.UN(P3)	;[150]Indicate all units
	$CALL	P$SWIT			;[150]Check for a switch
	JUMPF	FINO.3			;[150]No switch, finish the block
	CAIE	S1,.SWNOD		;[150]A node switch?
	JRST	FINO.2			;[150]Back up and check later
	$CALL	P$NODE			;[150]Pick up the node name
	$RETIF				;[150]Return on an error
	MOVE	P1,S1			;[150]Save the node data
	SETOM	G$NOFG			;[150]Indicate node switch present
	PJRST	BLDO.5			;[150]Finish building the block

FINO.2:	$CALL	P$PREV			;[150]Back up a block
;**;[160]At FINO.3:+0L replace 2 lines with 7 lines   PMM 6/3/90
FINO.3:	MOVE	S1,ARG.DA(P3)		;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias?
	JUMPF 	FIN.3A			;[160]No...
	MOVE	S1,OBJAKA(S2)		;[160]Yes, add it...
	MOVEM	S1,ARG.DA+OBJ.AK(P3)	;[160]...to message
FIN.3A:	MOVEI	S1,.OROBJ		;[160]Pick up block type
	MOVEI	S2,.OBJLN+LPTNLN	;[160]Pick up block size 
	PJRST	ARGRTN			;[150]Finish building the block

FINO.4:	$CALL	FINNUM			;[150]Process the number block
	$RETIF				;[150]Return on an error

	$CALL	P$SWIT			;GET A SWITCH
	JUMPF	BLDO.4			;NOT A SWITCH,,CHECK CONFIRM
	CAIE	S1,.SWNOD		;WAS IT A NODE
	JRST	BLDO.3			;NO..SETUP NODE VALUE IN BLOCK
	$CALL	P$NODE			;GET THE NODE
	JUMPF	BLDO.3			;GET NODE FROM NODE ENTRY
	MOVE	P1,S1			;SAVE THE NODE DATA
;**;[144]at BLDO.2:+8L add 1 line JYCW  Oct-18-88
	SETOM	G$NOFG			;[144]We have a /NODE: switch
	PJRST	BLDO.5			;SAVE NODE AND RETURN
BLDO.3:	$CALL	P$PREV			;POSITION TO THE PREVIOUS ONE
					;ON INPUT
BLDO.4:	MOVE	T1,G$OPRA		;GET OPERATOR ENTRY ADDRESS
	MOVE	T1,OPR.ND(T1)		;GET NODE ADDRESS
	MOVE	P1,NOD.NX(T1)		;GET NODE NAME ON -20
BLDO.5:	STORE	P1,ARG.DA+OBJ.ND(P3)	;SAVE THE NODE NAME
	MOVE	S1,P1			;Copy affected node
	$CALL	OPRENB			;See if ok for this OPR
	$RETIF				;No..return the failure
;**;[160]At BLDO.5:+3L add 3 lines  PMM  6/3/90
	HRRZ	S1,ARG.DA+OBJ.TY(P3)	;[160]Pick up the object type
	CAIN	S1,.OTLPT		;[160]Is it a printer?
	JRST	BLDO5A			;[160]Yes, check for aliases
	MOVX	S1,.OROBJ		;TYPE OF DATA ELEMENT..OBJ BLOCK
	MOVX	S2,.OBJLN		;SIZE OF THE BLOCK
	PJRST	ARGRTN			;SETUP HEADER,COUNT, POINTER..RETT
;**;[160]At BLDO5A:+0L replace 5 lines with 20  PMM  6/3/90
BLDO5A:	LOAD	S1,ARG.DA+OBJ.UN(P3),OU.HRG ;[160]Get the high range
	SKIPE	S1			;[160]Is it a range?
	JRST 	BLDO5B			;[160]Yes, get all aliases
	MOVEI	S1,AKBSIZ		;[160]Get object length
	STORE	S1,ARG.HD(P3),AR.LEN	;[160]Save in object block header
	MOVEI	S1,ARG.DA+OBJ.TY(P3)	;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias mapping?
	JUMPF	BLDO5C			;[160]No...
	MOVE	S1,OBJAKA(S2)		;[160]Yes, get the alias...
	MOVEM	S1,ARG.DA+OBJ.AK(P3)	;[160]...and add to message
	SKIPA				;[160]Don't get all aliases
BLDO5B:	$CALL	RANGAK			;[160]Yes get all aliases
BLDO5C:	MOVEI	S1,.OROBJ		;[160]Pick up the block type
	STORE	S1,ARG.HD(P3),AR.TYP	;[160]...and add to message
	LOAD	S2,ARG.HD(P3),AR.LEN	;[160]Get argument length
	SKIPN	S2			;[160]Is argument length established?
	MOVEI	S2,.OBJLN		;[160]No, add size of block
	$CALL	ARGRTN			;[160]Setup header, count, pointer
	$RETT				;[160]Return true

BLDO.6:	$CALL	P$PREV			;POSITION TO THE PREVIOUS ONE
	$RETF				;RETURN FALSE
;**;[150]At BLDO.6:+1L add routine FINNUM  JCR  12/25/89
	SUBTTL	FINNUM	Parse A Number Block

;[150]FINNUM is called when parsing the number block of an object specified
;[150]in a message from OPR
;[150]
;[150]Call is:        S1/Number returned by P$NUM
;[150]                P3/Address of message object block that is being built
;[150]Returns true:   The number block has been successfully parsed and placed
;[150]                in the outgoing IPCF message
;[150]Returns false: Illegal number or illegally formatted message
;[150]Modifies:       P1

FINNUM::TLNE	S1,-1			;[150]Ligit number? (Fit in half word)
	PJRST	E$IRS			;[150]No - fake user with illeg. range
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.LRG	;[150]Save as low range
	MOVE	P1,S1			;[150]Save the low range
	$CALL	P$TOK			;[150]Check for token and range
	JUMPF	.RETT			;[150]If no token, return success
;[150]Ignore the token, check for a high range number
	$CALL	P$NUM			;[150]Pick up the high range number
	$RETIF				;[150]Illegally formatted message
	CAML	P1,S1			;[150]Check for valid range
	PJRST	E$IRS			;UNITS OUT OF RANGE
	TLNE	S1,-1			;[150]Ligit number? (Fit in half word)
	PJRST	E$IRS			;[150]No - fake user with illeg. range
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.HRG	;[150]Save the high range
	$RETT				;[150]Indicate success
	SUBTTL	LPTTYP	Process a LPT object

;**;[125]ROUTINE LPTTYP IS ADDED AS PART OF THIS EDIT

;CHECK THE TYPE OF LPT

;**;[150]At LPTTYP:+0L replace 37 lines with 10 lines  JCR  12/25/89
;**;[160]At LPTTYP:+0L add two lines   PMM   6/3/90
LPTTYP:	CAIN	S1,.AKANM		;[160]Is this an alias name?
	JRST	LPTTY7			;[160]Yes, go process
	CAIN	S1,.KYDQS		;[150]Is this a DQS LPT?	
	JRST	LPTTY3			;[150]Yes, go process
	CAIN	S1,.KYLAT		;[150]Is this a LAT LPT?
	JRST	LPTTY4			;[150]Yes, go process
	CAIE	S1,.KYCLU		;[150]Is this a cluster LPT?
	$RETF				;[150]No, illegally formatted message

;THE LPT OBJECT IS A CLUSTER LPT

	MOVX	S1,.CLLPT		;[150]Pick up the cluster LPT type
	IORM	S1,ARG.DA+OBJ.TY(P3)	;INDICATE IN THE MESSAGE TO QUASAR
	$CALL	P$NUM			;PICK UP THE LOWER UNIT NUMBER
	JUMPF	LPTTY5			;[127]IF NO NUMBER THEN FROM SHOW
	TLNE	S1,-1			;IS THE UNIT NUMBER TOO LARGE?
	PJRST	E$IRS			;YES, INFORM THE OPR
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.LRG ;SAVE THE LOWER UNIT NUMBER
	MOVE	P1,S1			;SAVE THE LOWER UNIT NUMBER
	$CALL	P$TOK			;CHECK FOR THE ":" TOKEN
	JUMPF	LPTTY2			;NO ":", CHECK FOR NODE SWITCH
	$CALL	P$NUM			;PICK UP THE HIGHER UNIT NUMBER
	$RETIF				;NO NUMBER, INDICATE AN ERROR
	CAMLE	S1,P1			;LOW UNIT NUMBER LESS THAN HIGH?
	TLNE	S1,-1			;YES, IS HIGH UNIT # TOO LARGE?
	PJRST	E$IRS			;YES, INDICATE ILLEGAL RANGE
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.HRG ;SAVE THE HIGHER UNIT NUMBER
LPTTY2:	MOVE	P1,P3			;[160]Save the object block address
	$CALL	NOSNAM			;PICK UP THE NODE NAME
;**;[160]At LPTTY2:+1L replace 3 lines with 32 lines  PMM  6/3/90
	$RETIF				;[160]Return, if problem
	LOAD	S1,ARG.DA+OBJ.UN(P1),OU.HRG	;[160]Get the high range
	SKIPE	S1			;[160]Is there a range?
	JRST 	LPTT2B			;[160]Yes, check for a range of aliases
	MOVE	S1,P1			;[160]Get address of object block
	AOS	S1			;[160]Bump past header
	$CALL	FINDPR			;[160]Does it have an alias mapping?
	JUMPF 	LPTT2A			;[160]No, return
	MOVE	S1,OBJAKA(S2)		;[160]Get alias name
	MOVEM	S1,ARG.DA+OBJ.AK(P1)	;[160]Yes, add to message
LPTT2A:	MOVEI	S1,AKBSIZ		;[160]Get size of object block
	HRLM	S1,ARG.HD(P1)		;[160]Save in message
	ADDI	P1,AKBSIZ		;[160]Get address of next argument
	MOVE	P3,P1			;[160]Save for later use
	$RETT				;[160]Return true

LPTT2B:	MOVE	P3,P1			;[160]Point at object block
	$CALL	RANGAK			;[160]Yes, get all alias names
	$RETT				;[160]Return


;[160]The object is a DQS LPT

LPTTY3:	MOVX	S2,.DQLPT		;[160]Pick up the DQS LPT bit
	IORM	S2,ARG.DA+OBJ.TY(P3)	;[160]Indicate in the type field
	MOVEI	P1,ARG.DA+OBJ.TY(P3)	;[160]Save object block address
	$CALL	BLDBLK			;[160]Fill in rest of the object
	$RETIF				;[160]Return if problem
	MOVE	S1,P1			;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias mapping?
	JUMPF	LPTT3A			;[160]No, return
	MOVE	S1,OBJAKA(S2)		;[160]Get alias name
	MOVEM	S1,OBJ.AK(P1)		;[160]Add to message
LPTT3A:	$RETT				;[160]Return true


;THE OBJECT IS A LAT LPT

LPTTY4:	MOVX	S1,.LALPT		;PICK UP THE LAT LPT BIT
	IORM	S1,ARG.DA+OBJ.TY(P3)	;INDICATE IN THE TYPE FIELD
	$CALL	P$KEYW			;PICK UP PORT OR SERVICE
	JUMPF	LPTTY5			;[127]IF NO KEYWORD, THEN SHOW
	CAIE	S1,.KYPOR		;PORT SPECIFIED?
	MOVEI	S1,.KYSER		;NO, INDCICATE A SERVICE
	MOVEI	P1,ARG.DA+OBJ.TY(P3)	;SAVE OBJECT BLOCK ADDRESS
	$CALL	BLDBLK			;FILL IN REST OF THE OBJECT
;**;[160]At LPTTY4:+7L add 7 lines   PMM 6/3/90
	$RETIF				;[160]Return if problem
	MOVE	S1,P1			;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias mapping?
	JUMPF	LPTT.4			;[160]No, return
	MOVE	S1,OBJAKA(S2)		;[160]Yes, get alias name
	MOVEM	S1,OBJ.AK(P1)		;[160]Add to message
LPTT.4:	$RETT				;[160]Return true


;Here to check for an alias mapping to the printer specificaton


;SHOW STATUS (OR PARAMETER) PRINTER COMMANDS MAY HAVE FORMATS:
; SHOW STATUS PRINTER CLUSTER
; SHOW STATUS PRINTER LAT

LPTTY5:	SETOM	ARG.DA+OBJ.UN(P3)	;[127]INDICATE FOR ALL
;**;[160]At LPTTY5:+0L replace 2 lines with 7 lines  PMM  6/3/90
LPTTY6:	MOVE	S1,ARG.DA+OBJ.TY(P3)	;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias?
	JUMPF	LPTT6A			;[160]Skip if no alias
	MOVE	S1,OBJAKA(S2)		;[160]Get alias name
	MOVEM	S1,ARG.DA+OBJ.AK(P3)	;[160]Update alias name in message
LPTT6A:	MOVEI	S1,.OROBJ		;[160]Pick up the object descriptor adr
	MOVEI	S2,.OBJLN+LPTNLN	;[160]Pick up the object descriptor len
	$CALL	ARGRTN			;[127]UPDATE THE BLOCK TYPE/LENGTH
	$RET				;[127]RETURN PRESERVING TRUE/FALSE FLAG

;**;[160]At LPTT6A:+3L  add 24 lines and routine RANGAK  PMM  6/3/90
;[160]Here to process an alias name

	INTERN	LPTTY7			;[160]Make it global

LPTTY7: $CALL	P$CURR			;[160]Pick up the alias header
	$CALL	P$NEXT			;[160]Point at alias name block
	AOS	S1			;[160]Point at the SIXBIT alias
	MOVE	S1,(S1)			;[160]Get SIXBIT alias name
	$CALL	FINDAK			;[160]Find address of mapped entry
	$RETIF				;[160]Problem, alias not found
	AOS	S2			;[160]Point at object block
	HRLI	S1,(S2)			;[160]Source address,,x
	HRRI	S1,ARG.DA+OBJ.TY(P3)	;[160]Source,,destination
	BLT	S1,ARG.DA+OBJ.AK(P3)	;[160]Move the object block 
	MOVEI	S1,.OROBJ		;[160]Pick up the object descriptor adr
	MOVEI	S2,.OBJLN+LPTNLN	;[160]Pick up the printer length
	MOVE	P1,P3			;[160]Save address of object block
	$CALL	ARGRTN			;[160]Update the block type/length
	MOVE	S2,OBJ.TY+ARG.DA(P1)	;[160]Get object type
	TXNN	S2,.DQLPT!.LALPT!.CLLPT	;[160]A DQS, LAT or Cluster printer?
	SETOM	G$NOFG			;[160]No, indicate to the remote ORION
					;[160] not to change the node name
	TXNN	S2,.DQLPT!.LALPT	;[160]Is this a LAT or DQS printer?
	$RETT				;[160]No, return now
	MOVEI	S2,.OBJLN		;[160]Get object descriptor length
	STORE	S2,ARG.HD(P1),AR.LEN	;[160]Store in message
	AOS	.OARGC(MO)		;[160]Bump argument count

	ADDI	P1,.OBJLN		;[160]Point to the name block
	MOVEI	S2,LPTNLN		;[160]Pick up its length
	STORE	S2,ARG.HD(P1),AR.LEN	;[160]Pick up its length
	$RETT				;[160]Return
	
	SUBTTL	RANGAK Set Up Multiple Aliases For Range

;[160]RANGAK will include aliases for each printer specified by a
;[160]range.
;[160]Call is:       S1/High range
;[160]               P3/address of the printer object block
;[160]Returns False: There is no high range
;[160]Returns True:  The alias name block is set up in the outgoing message 

RANGAB:: SETOM	REMLPT			;[160]Indicate message from NEBULA
	SKIPA				;[160]Don't reset the flag
RANGAK:	SETZM	REMLPT			;[160]Indicate local
	$SAVE	<T1,T2,P1,P2>		;[160]Save these ACs
	SKIPN	S1			;[160]Do we have a high range?
	$RETF				;[160]No, return false
	MOVEM	S1,P1			;[160]Save high range
	LOAD	T2,ARG.DA+OBJ.UN(P3),OU.LRG	;[160]Get the low range	
	MOVEM	T2,P2			;[160]Save low range
	SETZM	ARG.DA+OBJ.UN(P3)	;[160]Clear the unit numbers
	MOVE	T1,P3			;[160]Get address of object block
	MOVEI	T3,OBJ.SZ+1		;[160]Get length of object descriptor
	STORE	T3,ARG.HD(T1),AR.LEN	;[160]Store argument length in message

;[160]Get address of next available argument block in message.
;[160]The length not in yet.

	ADD	T1,T3			;[160]Point at next argument
	MOVEI	S1,.OTLPT		;[160]Get printer type
	HRRM	S1,ARG.DA+OBJ.TY(P3)	;[160]Save in object block
	MOVE	S1,P3			;[160]Get address of object block
	SKIPN	REMLPT			;[160]Is this a remote printer?
	JRST	RAN.G2			;[160]No, don't bother

	MOVE	T3,ARG.DA+OBJ.TY(S1)	;[160]Get printer object type
	TXZ	T2,.RMLPT		;[160]Clear the remote printer bit
	MOVEM	T3,ARG.DA+OBJ.TY(S1)	;[160]Save in object block
RAN.G2:	AOS	S1			;[160]Point at object block data
	MOVE	T3,P2			;[160]Get low range
	SETZM	T2			;[160]Initialize alias flag
	SETZM	OBJ.UN(S1)		;[160]Clear units in object block
RANG.1:	AOS	T1			;[160]Get address for alias name
	MOVEM	T3,OBJ.UN(S1)		;[160]Store unit number in object block
	$CALL	FINDPR			;[160]Does this printer have an alias?
	JUMPF	RANG.2			;[160]No, put in blank alias
	MOVE	S2,OBJAKA(S2)		;[160]Get alias name
	SETOM	T2			;[160]Set alias flag
	SKIPA
RANG.2:	SETZM	S2			;[160]Zero out alias name
	AOS	T3			;[160]Increment unit number
	MOVEM	S2,(T1)			;[160]Save in alias block
	CAML	P1,T3			;[160]Have we reached the last unit?
	JRST	RANG.1			;[160]No, check next printer
	STORE	P2,ARG.DA+OBJ.UN(P3),OU.LRG ;[160]Restore the low range	
	STORE	P1,ARG.DA+OBJ.UN(P3),OU.HRG ;[160]Restore the high range	
	SKIPN	REMLPT			;[160]Is this from a remote NEBULA?
	JRST	RANG.3			;[160]No
	MOVE	S1,OBJ.TY+ARG.DA(P3)	;[160]Get object type
	TXNE	S1,.CLLPT		;[160]Is it a CLUSTER printer?
	JRST	RANG.3			;[160]Yes, do not light .RMLPT bit
	MOVX	S1,.RMLPT		;[160]Pick up /NODE switch specified
	IORM	S1,ARG.DA+OBJ.TY(P3) 	;[160]Indicate in the message type


RANG.3:	LOAD	T1,ARG.HD(P3),AR.LEN	;[160]Get the argument length
	ADD	T1,P3			;[160]Point at next argument block
	SUB	P1,P2			;[160]Get the range diffference
	ADDI	P1,2			;[160]Get alias block length
	STORE	P1,ARG.HD(T1),AR.LEN	;[160]Save length in alias block
	MOVEI	T3,.AKANM		;[160]Get alias block header
	STORE	T3,ARG.HD(T1),AR.TYP	;[160]Save type in alias block

	MOVE	T1,ARG.DA+OBJ.TY(P3)	;[160]Get object type
	TXNN	T1,.CLLPT		;[160]Is this a CLUSTER printer?
	JRST	RANG.4			;[160]No, return now
	SKIPE	REMLPT			;[160]Did message originate remotely?
	JRST	RANG.4			;[160]Yes, return
	AOS	.OARGC(MO)		;[160]No, increment argument count
RAN.3A:	LOAD	S1,ARG.HD(P3),AR.LEN	;[160]Get argument length
	SKIPN	S1			;[160]Is it a non-zero length?
	JRST	RANG.4			;[160]No, return
	ADD	P3,S1			;[160]Update current address of message
	JRST	RAN.3A			;[160]Loop back for next argument

RANG.4:	SKIPN	T2			;[160]Were any aliases found?
	$RETF				;[160]No, indicate so
	$RETT				;[160]Yes, indicate so
	SUBTTL	BLDBLK	

;**;[125]ROUTINE BLDBLK IS ADDED AS PART OF THIS EDIT

BLDBLK:	MOVEI	T1,.OBJLN(P3)		;POINT TO THE NAME BLOCK
	STORE	S1,ARG.HD(T1),AR.TYP	;SAVE THE TYPE OF NAME
	$CALL	P$FLD			;PICK UP THE NAME
	JUMPF	NOSNA2			;[127]FROM A SHOW COMMAND IF NO NAME
	AOS	S1			;BYPASS THE PARSER HEADER BLOCK
	MOVSS	S1			;PREPARE THE SOURCE OF THE BLT
	HRRI	S1,ARG.DA(T1)		;SOURCE,,DESTINATION OF THE BLT
	ADD	T1,S2			;END ADDRESS + 1
	BLT	S1,-1(T1)		;MOVE NAME INTO MESSAGE
	MOVEI	S2,LPTNLN		;[127]PICK UP BLOCK LENGTH
	STORE	S2,.OBJLN(P3),AR.LEN	;SAVE THE LENGTH OF THIS BLOCK

	AOS	.OARGC(MO)		;INCREMENT THE NUMBER OF BLOCKS
	$CALL	NOSNAM			;INCLUDE THE NODE NAME IN THE MSG
	JUMPF	.POPJ			;PASS ON ANY ERROR
	ADDI	P3,LPTNLN		;[127]POINT TO THE NEXT BLOCK
	$RET				;PRESERVE THE TRUE INDICATION

;**;[125]ROUTINE NOSNAM IS ADDED AS PART OF THIS EDIT.
;PICK UP THE NODE (OR SERVER) NAME FOR A REMOTE LPT AND PLACE IN THE
;MESSAGE TO QUASAR.

NOSNAM:	$CALL	P$KEYW			;PICK UP THE KEYWORD
	$RETIF				;INDICATE MSG ILLEGALLY FORMATTED
	CAIN	S1,.KYNOD		;A NODE KEYWORD?
	JRST	NOSNA1			;YES, CONTINUE PROCESSING
	CAIE	S1,.KYSRV		;A SERVER KEYWORD?
	$RETF				;NO, MESSAGE ILLEGALLY FORMATTED
NOSNA1:	$CALL	P$NODE			;PICK UP THE NODE (SERVER) NAME
	$RETIF				;PASS ON ANY ERROR
	STORE	S1,ARG.DA+OBJ.ND(P3)	;SAVE THE NODE (SERVER) NAME
	JRST	NOSNA3			;[127]UPDATE THE OBJECT DESCRIPTOR BLK

;OPR SHOW STATUS (OR PARAMETERS) PRINTER COMMANDS CAN HAVE THE FOLLOWING
;FORMATS:
; SHOW STATUS PRINTER DQS
; SHOW STATUS PRINTER LAT PORT
; SHOW STATUS PRINTER LAT SERVICE

NOSNA2:	LOAD	S1,ARG.HD(T1),AR.TYP	;[127]PICK UP THE REMOTE NAME TYPE
	MOVE	S2,ARG.DA+OBJ.TY(P3)	;[127]PICK UP REMOTE LPT TYPE
	TXNE	S2,.DQLPT		;[127]IS IT A DQS LPT?
	SETO	S1,			;[127]INDICATE FOR ALL DQS LPT
	MOVEM	S1,ARG.DA+OBJ.UN(P3)	;[127]PLACE IN THE UNITS FIELD
NOSNA3:	MOVEI	S1,.OROBJ		;[127]PICK UP OBJECT DESCRIPTOR CODE
	MOVEI	S2,.OBJLN		;PICK UP OBJECT DESCRIPTOR LENGTH
	$CALL	ARGRTN			;UPDATE THE MESSAGE TO QUASAR
	$RET				;PRESERVER THE TRUE/FALSE FLAG
SUBTTL	Q$FSPA	Process FORWARDSPACE command
SUBTTL	Q$BSPA	Process BACKSPACE command

Q$FSPA::
Q$BSPA:: $CALL	LPTOBJ			;LINE PRINTER OBJECT SETUP
	$RETIF				;ERROR..RETURN
	$CALL	P$SWIT			;GET A SWITCH
	$RETIF				;ILLEGALLY FORMATTED COMMAND
	MOVEI	S2,FSPDSP		;GET TABLE ADDRESS
	$CALL	TABSRC			;GET THE VALUE
	$RETIF				;ERROR..RETURN
	MOVE	T2,S2			;PLACE TYPE IN T2
	$CALL	P$NUM			;GET A NUMBER
	 JUMPF	[CAIE	T2,.SPFIL	;WAS THIS /FILE?
		 $RETF			;NO..THEN RETURN FAILURE
		 MOVEI	S1,1		;YES..THEN THE NUMBER IS 1
		 JRST	.+1]		;CONTINUE
	STORE	S1,ARG.DA(P3)		;SAVE DATA IN MESSAGE
	MOVE	S1,T2			;GET TYPE IN S1
	MOVEI	S2,ARG.SZ		;SIZE OF THE BLOCK
	$CALL	ARGRTN			;ARG HEADER,COUNT ROUTINE
	PJRST	CMDEND			;CHECK FOR END AND SEND MESSAGE

FSPDSP:	$STAB
	.SWPAG,,.SPPAG			;PAGES
	.SWFIL,,.SPFIL			;FILES
	.SWCPY,,.SPCPY			;COPIES
	$ETAB

SUBTTL	LPTOBJ	Setup printer object block

;THIS ROUTINE WILL SETUP AN OBJECT BLOCK AND MAKE SURE
;THAT IT IS FOR A LINE PRINTER WITH ONLY ONE UNIT SPECIFIED.
;THE OBJECT BLOCK WILL BE BUILT IN THE OUTPUT MESSAGE

LPTOBJ:	$CALL	BLDOBJ			;AND AN OBJECT BLOCK
	$RETIF				;ERROR..PASS CODE UP
	MOVEI	T1,.OHDRS+ARG.DA(MO)	;POINT TO OBJECT BLOCK
	LOAD	S1,OBJ.UN(T1),OU.HRG	;SEE IF WE HAVE A NON-ZERO HIGH UNIT
	JUMPN	S1,.RETF		;LOSE IF SO
	LOAD	S1,OBJ.TY(T1),RHMASK	;[125]GET MESSAGE TYPE
	CAXE	S1,.OTLPT		;PRINTER?
	$RETF				;NO, LOSE
;**;[160]At LPTOBJ:+8L replace 1 line with 5 lines   PMM   6/3/90
	HLLZ	S1,OBJ.TY(T1)		;[160]Get printer type
	TXNN	S1,.LALPT		;[160]Is it a LAT printer?
	SKIPN	S1			;[160]No, is it a local printer?
	$RETT				;[160]Yes, to either
	PJRST	E$LOL			;[160]No, to either
SUBTTL	Q$ALGN	Process ALIGN command

;THIS ROUTINE WILL PROCESS AN ALIGN COMMAND FROM OPR

Q$ALGN:: $CALL	LPTOBJ			;SETUP LINE PRINTER OBJECT BLOCK
	$RETIF				;ERROR..RETURN
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	ALIG.3			;NO..CHECK FOR A FILE
	CAIE	S1,.SWSTP		;WAS IT A STOP
	JRST	ALIG.2			;NO..TRY OTHER VALUES
	MOVX	S1,.ALSTP		;GET THE STOP ARGUMENT TYPE
	MOVEI	S2,1			;SETUP FIELD LENGTH
	$CALL	ARGRTN			;SETUP ARGUMENT IN MESSAGE
	PJRST	CMDEND			;FINISH OFF THE COMMAND
ALIG.1:	$CALL	P$SWIT			;GET A SWITCH
	JUMPF	ALIG.3			;CHECK FOR A FILE
ALIG.2:	MOVEI	S2,ALIDSP		;GET ALIGN TABLE
	$CALL	TABSRC			;CHECK THE TABLE
;**;[156]At ALIG.2:+2L change 1 line  JCR  1/19/90
	JUMPF	CMDEN			;[156]Check for a /CLUSTER-NODE switch
	MOVE	T2,S2			;SAVE THE VALUE
	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;ERROR..RETURN
	STORE	S1,ARG.DA(P3)		;SAVE NUMBER IN ARGUMENT BLOCK
	MOVEI	S2,ARG.SZ		;GET ARGUMENT SIZE
	MOVE	S1,T2			;GET  FUNCTION TYPE
	$CALL	ARGRTN			;SAVE THE ARGUMENT AND UPDATE COUNTERS
	JRST	ALIG.1			;CHECK NEXT FIELD
ALIG.3:	$CALL	P$IFIL			;CHECK FOR INPUT FILE
	JUMPF	CMDEND			;NO..CHECK FOR END OF COMMAND
	$CALL	MOVARG			;YES..MOVE FD AND HEADER FOR OUTPUT
	JRST	ALIG.1			;CHECK THE NEXT FIELD

ALIDSP:	$STAB
	.SWRPT,,.ALRPT			;REPEAT COUNT
	.SWPAU,,.ALPAU			;PAUSE COUNT
	$ETAB
SUBTTL	Q$SUPP	Process suppress command

Q$SUPP:: $CALL	LPTOBJ			;SETUP LINE PRINTER OBJECT BLOCK
	$RETIF				;ERROR..RETURN
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	MOVEI	S2,SUPDSP		;ADDRESS OF THE TABLES
	SKIPT				;SKIP IF O.K.
	MOVEI	S1,.SWJOB		;ASSUME JOB AS DEFAULT
	$CALL	TABSRC			;SEARCH THE TABLE
;**;[156]At Q$SUPP::+7L replace 3 lines with 11 lines  JCR  1/19/90
	JUMPT	Q$SU.1			;[156]Set up the block
	$CALL	CHCLUN			;[156]Check for a /CLUSTER-NODE switch
	$RETIF				;[156]Not there, so an error
	MOVEI	S1,.SUPJB		;[156]Pick up JOB block type
	SKIPA				;[156]Avoid changing the job block
Q$SU.1:	MOVE	S1,S2			;[156]Place type in S1
	MOVEI	S2,1			;[156]Length of argument in S2
	$CALL	ARGRTN			;[156]Save the argument
	SKIPN	G$CLUN			;[156]Cluster Node switch detected?
	PJRST	CMDEND			;[156]Not yet, finish the command
	PJRST	SNDCLU			;[156]Yes, go send the command

SUPDSP:	$STAB
	.SWFIL,,.SUPFL			;FILE
	.SWJOB,,.SUPJB			;JOB
	.SWSTP,,.SUPST			;STOP
	$ETAB
SUBTTL	Q$ABOR	Process ABORT command

;THIS ROUTINE WILL PROCESS A ABORT COMMAND AND SEND THE 
;APPROPRIATE MESSAGE TO QUASAR

Q$ABOR:: $CALL	BLDOBJ			;GET AN OBJECT BLOCK SETUP
	$RETIF				;NO..RETURN..BAD MESSAGE
	MOVEI	T1,.OHDRS+ARG.DA(MO)	;ADDRESS OF ARGUMENT BLOCK
	LOAD	S1,OBJ.UN(T1),OU.HRG	 ;GET HIGH RANGE
	JUMPN	S1,.RETF		;NON-ZERO..RETURN FALSE
ABOR.1:	$CALL	P$SWIT			;GET A SWITCH IF ANY
;**;[151]At ABOR.1:+1L change 1 line  JCR  12/31/89
	JUMPF	CMDEN1			;[151]No, check for confirm and send
	CAIE	S1,.SWREQ		;/REQUEST NUMER SWITCH
	JRST	ABOR.3			;PROCESS SEQUENCE SWITCH
	$CALL	PREQNM			;PROCESS REQUEST NUMBER
	$RETIF				;ERROR RETURN
ABOR.2:	$CALL	P$SWIT			;CHECK FOR SWITCH
;**;[153]At ABOR.2:+1L replace 13 lines with 9 lines  JCR  1/12/90
	JUMPF	CMDEN1			;[153]Error, check for end
ABOR.3:	MOVEI	S2,ABODSP		;[153]Abort table address
	$CALL	TABSRC			;[153]Search the table
	JUMPT	ABOR.4			;[153]Success, process the switch
	$CALL	CHCLUN			;[153]Check for a /CLUSTER-NODE switch
	JUMPF	ABOR.5			;[153]Check fo a /REASON switch
	$CALL	P$SWIT			;[153]Check for a switch
	JUMPF	CMDEN0			;[153]If none, then send the message
	JRST	ABOR.5			;[153]Process the /REASON switch

ABOR.4:	MOVEM	S2,ARG.DA(P3)		;SAVE THE DATA FIELD
	MOVX	S1,.CANTY		;GET ABORT TYPE
	MOVX	S2,ARG.SZ		;GET ARGUMENT SIZE
	$CALL	ARGRTN			;SETUP ARGUMENT HEADER AND COUNTS
	JRST	ABOR.2			;GET NEXT FIELD
;**;[153]At ABOR.5:+0L replace 3 lines with 5 lines  JCR  1/12/90
ABOR.5:	CAIE	S1,.SWRSN		;[153]A /REASON switch?
	$RETF				;[153]No, illegally formatted message
	$CALL	PREASN			;[153]Process the /REASON switch
	$RETIF				;[153]No, illegally formatted message
	PJRST	CMDEN0			;[153]Send the message to QUASAR

ABODSP:	$STAB
	.SWPUR,,.CNPRG			;/PURGE
	.SWERR,,.CNERR			;/ERROR
	.SWNER,,.CNNER			;/NOERROR
	$ETAB
SUBTTL	PREQNM	Process /REQUEST switch


;PROCESS /REQUEST SWITCH

PREQNM:	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;NO..RETURN FALSE
PREQ.1:	STORE	S1,ARG.DA(P3)		;SAVE THE NAME IN MESSAGE
	MOVX	S1,.ORREQ		;GET JOBNAME TYPE
	MOVX	S2,ARG.SZ		;SIZE OF THE ARGUMENT
	PJRST	ARGRTN			;SETUP ARGUMENT HEADER AND COUNTS


SUBTTL	PREASN	Process /REASON switch
;PROCESS /REASON TEXT DATA


PREASN:	$CALL	P$TEXT			;GET A TEXT ARGUMENT
	$RETIF				;NO..RETURN
	MOVX	T1,.ORREA		;GET REASON TYPE
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE CORRECT TYPE IN HEADER
	$CALL	MOVARG			;BUILD TEXT ARGUMENT AND UPDATE COUNTS
	$RETT				;RETURN TRUE

SUBTTL	PUSER/PUSERS	Process USER block/switch

;**;[157]At PUSER:+0L replace 14 lines with 14 lines  JCR  1/31/90
PUSER:	TDZA	S1,S1			;[157]User keyword entry
PUSERS:	SETO	S1,			;[157]User switch entry
	MOVEM	S1,G$2SCR##		;[157]Save for header
	$CALL	P$USER			;[157]Get the user data
	$RETIF				;[157]Return on an error
	MOVE	S2,S1			;[157]Place user number where expected
	HRROI	S1,ARG.DA(P3)		;[157]Where to place the user name
	DIRST%				;[157]Map user number to user name
	 ERJMP	.RETF			;[157]Quit on an error
	MOVEI	S2,EQNMSZ		;[157]Pick up the block size
	MOVEI	S1,.CMUSR		;[157]Assume user keyword
	SKIPE	G$2SCR##		;[157]Is it?
	MOVEI	S1,.LSUSR		;[157]No, indicate user switch
	PJRST	ARGRTN			;[157]Add the argument to the message
SUBTTL	Q$REQU	Process REQUEUE command

;THIS ROUTINE WILL ANALYSZE A REQUEUE COMMAND AND SEND THE 
;APPROPRIATE MESSAGE TO QUASAR

Q$REQU:: $CALL	BLDOBJ			;SETUP OBJECT BLOCK
	$RETIF				;ERROR IF NOT SETUP..RETURN
	MOVEI	T1,.OHDRS+ARG.DA(MO)	;GET THE ARGUMENT BLOCK
	LOAD	S1,OBJ.UN(T1),OU.HRG	;GET HIGH VALUE
	JUMPN	S1,.RETF		;RANGE NOT ALLOWED
	LOAD	P1,OBJ.TY(T1),RHMASK	;[125]GET THE TYPE FIELD
REQU.1:	$CALL	P$SWIT			;GET A SWITCH
	JUMPF	REQU.5			;NO..CHECK FOR OTHER FIELDS
	CAIE	S1,.SWREQ		;CHECK FOR REQUEST
	JRST	REQU.3			;YES..PROCESS JOBNAME
	$CALL	PREQNM			;PROCESS REQUEST NUMBER
	$RETIF				;ERROR RETURN
REQU.2:	$CALL	P$SWIT			;CHECK FOR SWITCH
	JUMPF	REQU.5			;CHECK OTHER FIELDS
REQU.3:	CAIN	S1,.SWRSN		;CHECK FOR REASON 
	JRST	REQU.4			;PROCESS REASON SWITCH
;**;[144]At REQU.3:+2L change 1 line JYCW Oct-18-88
	JRST	REQU.9			;[144]CHECK FOR /CLUSTER-NODE
REQU.4:	$CALL	PREASN			;PROCESS THE REASON FLAG
	$RETIF				;ERROR..RETURN
;**;[151]At REQU.4:+2L change 3 lines  JCR  12/31/89
	PJRST	CMDEN0			;[151]Check if a remote node specified
REQU.5:	CAIN	P1,.OTBAT		;[151]Check for batch
	PJRST	CMDEN0			;[151]Check if a remote node specified
	$CALL	P$KEYW			;PRINTER..CHECK FOR KEYWORD
	SETOM	T1			;SETUP FLAG FOR SWITCHES
	JUMPF	REQU.8			;CHECK FOR END OF MESSAGE
	CAIE	S1,.KYBEG		;BEGINNING-OF KEYWORD
	JRST	REQU.6			;CHECK FOR CURRENT POSITION
	$CALL	P$KEYW			;GET BEGINNING OPRION
	$RETIF				;NOT..KEYWORD..ERROR
	CAIN	S1,.KYCPY		;IS IT COPY 
	MOVEI	T1,.RQBCP		;BEGINNING OF COPY
	CAIN	S1,.KYJOB		;IS IT JOB
	MOVEI	T1,.RQBJB		;BEGINNING OF JOB
	CAIN	S1,.KYFIL		;IS IT FILE
	MOVEI	T1,.RQBFL		;BEGINNING OF FILE
REQU.6:	CAIN	S1,.KYCUR		;CURRENT-POSITION
	MOVEI	T1,.RQCUR		;CURRENT  POSITION
	JUMPL	T1,.RETF		;INVALID KEYWORD
	STORE	T1,ARG.DA(P3)		;SAVE VALUE IN MESSAGE
	MOVX	S1,.REQTY		;KEY ARGUMNET BLOCK TYPE
	MOVX	S2,ARG.SZ		;GET ARGUMENT SIZE
	$CALL	ARGRTN			;SETUP ARGUMENT AND COUNTS
	$CALL	P$SWIT			;GET A SWITCH
;**;[151]At REQU.6:+8L change 1 line  JCR  12/31/89
	JUMPF	CMDEN0			;[151]Check if a remote node specified
	CAIE	S1,.SWRSN		;IS IT REASON
;**;[144]At REQU.6:+10L change 1 line JYCW Oct-18-88
	JRST	REQU.9			;[144]NO
	JRST	REQU.4			;PROCESS THE REASON SWITCH
;**;[151]At REQU.6:+13L remove 3 lines  JCR  12/31/89
;**;[144]At REQU.6:+13L add 3 lines JYCW Oct-18-88
REQU.8:	CAIE	S1,.CMCFM		;CHECK IF AT END OF COMMAND
	$RETF				;NO..RETURN FALSE
	MOVEI	S1,.KYCUR		;SET DEFAULT FOR CURRENT POSITION
	JRST	REQU.6			;FINISH COMMAND

;**;[144]At REQU.8:+4L add routine REQU.9: JYCW Oct-18-88
REQU.9:	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.RETF			;[144]NOT A CLUSTER-NODE SWITCH
	JRST	REQU.2			;[144]CHECK FOR MORE SWITCHES
SUBTTL	Q$ROUT	Process ROUTE command

	INTERN	Q$ROUTE			;MAKE IT GLOBAL

Q$ROUT:	STKVAR	(OBJDEV)		;CREATE SPACE FOR THE DEVICE TYPE
	$CALL	P$KEYW			;GET A KEYWORD !!!
	$RETIF				;NOT THERE,,THATS AN ERROR
	CAXE	S1,.KYALL		;DID HE SPECIFY ALL DEVICES ???
	CAXG	S1,.OTMAX		;NO,,IS IT A VALID OBJECT TYPE ???
	SKIPA				;YES TO EITHER,,SKIP
	$RETF				;NO,,RETURN
	CAXN	S1,.KYALL		;DID HE SPECIFY ALL ???
	SETOM	S1			;YES,,SET IT
	MOVEM	S1,ARG.DA+OBJ.TY(P3) 	;SAVE IT IN THE SOURCE OBJECT BLOCK
	MOVEM	S1,OBJDEV		;SAVE IT HERE FOR LATER
	JUMPGE	S1,ROUT.4		;Go to process routing for specific dev.


;Process ALL-DEVICE command

	SETOM	ARG.DA+OBJ.UN(P3)	;Set object block to all units
	$CALL	P$NODE			;Get the source node
	JUMPT	ROUT.1			;Go process the node name

;Maybe ALL-NODES was specified!

	$CALL	P$KEYW			;Try for th keyword
	$RETIF				;Must be there!
	CAXE	S1,.KYALL		;Is it ALL?
	$RETF				;No -- screwed up
	SETOM	S1			;Say all nodes

ROUT.1:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;Save source node info
	$CALL	OPRENB			;Check OPR's privs
	$RETIF				;NO,,RETURN
	MOVX	S1,.RTEFM		;GET THE BLOCK TYPE
	MOVX	S2,.OBJLN+LPTNLN	;[126]AND THE BLOCK LENGTH
	$CALL	ARGRTN			;AND UPDATE THE MESSAGE
	$CALL	P$NODE			;GET THE DESTINATION NODE NAME
	JUMPF	ROUT.3			;NOT THERE,,MIGHT BE 'DELETE' FUNCTION
	SETOM	ARG.DA+OBJ.UN(P3)	;Save all unit types

;Common completion code

ROUT.2:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;SAVE IT IN THE OBJECT BLOCK
	$CALL	OPRENB			;Check OPR's privs
	$RETIF				;NO,,RETURN
	MOVE	S1,OBJDEV		;Get the source device type
	MOVEM	S1,ARG.DA+OBJ.TY(P3)	;Save the object types
;**;[ppm]At ROUT.2:+4L add 1 line  PPM  6/2/90
	$CALL	FNDALS			;[ppm]Check for local printer alias
	MOVX	S1,.RTETO		;GET THE BLOCK TYPE
	MOVX	S2,.OBJLN+LPTNLN	;[126]GET THE BLOCK LENGTH
	$CALL	ARGRTN			;UPDATE THE MESSAGE

;**;[156]At ROUT.3:+0L replace 2 lines with 3 lines  JCR  1/19/90
ROUT.3:	SKIPN	G$CLUN			;[156]Seen a /CLUSTER-NODE switch?
	PJRST	CMDEND			;[156]No, check for one
	PJRST	SNDCLU			;[156]Yes, send message to NEBULA
;Process a route command for a specific device

ROUT.4:	$CALL	P$NUM			;GET THE UNIT NUMBER
	JUMPF	ROUT.5			;NOT THERE,,MIGHT HAVE SAID 'ALL'
	CAXLE	S1,77			;IS IT VALID ???
	$RETF				;NO,,RETURN
	JRST	ROUT.8			;[125]YES,,CONTINUE
ROUT.5:	$CALL	P$KEYW			;GET A KEYWORD
;**;[160]Add two lines at ROUT.5:+1L   PMM   6/3/90
	CAIN	S1,.AKANM		;[160]Is this an alias name?
	JRST	ROUT.6			;[160]Yes, process it
	$RETIF				;NOT THERE,,THATS AN ERROR
	CAIN	S1,.KYALL		;[125]IS IT 'ALL' 
	JRST	ROUT.7			;[125]YES, GO PROCESS IT
	CAIN	S1,.KYDQS		;[125]IS THIS A DQS LPT?
	JRST	ROUT.6 			;[125]YES, GO PROCESS
	CAIN	S1,.KYLAT		;[125]IS THIS A LAT LPT?
	JRST	ROUT.6			;[125]YES, GO PROCESS
	CAIE	S1,.KYCLU		;[125]IS THIS A CLUSTER LPT?
	$RETF				;[125]NO, INDICATE ERROR TO CALLER
ROUT.6:	MOVX	P2,.RTEFM		;[125]PICK UP THE BLOCK TYPE
	$CALL	ROUBLK			;[125]CHECK FOR A REMOTE PRINTER
	$RETIF				;[125]RETURN ON AN ERROR
	JRST	ROUT11			;[125]CHECK THE DESTINATION INFORMATION
ROUT.7:	SETOM	S1			;[125]Make this all units
ROUT.8:	MOVEM	S1,ARG.DA+OBJ.UN(P3)	;[125]SAVE IT IN THE OBJECT BLOCK
	$CALL	P$SWIT			;Get the node switch
	JUMPF	ROUT.9			;[125]No switch- thats ok
	CAIE	S1,.SWNOD		;It must be a node switch however.
;**;[156]At ROUT.8:+4L replace 10 lines with 14 lines  JCR  1/19/90
	JRST	ROUT9A			;[156]Check for a /CLUSTER-NODE switch
	$CALL	P$NODE			;[156]Get the source node if any
	JUMPT	ROUT10			;[156]Go set node name
	$RET				;[156]Illegally formatted message
ROUT9A:	$CALL	CHCLUN			;[156]/CLUSTER-NODE switch?
	$RETIF				;[156]No, illegally formatted message

;[156]Since no node was specified, get the OPR's node

ROUT.9:	MOVX	S1,RT.SND		;[156]Default source node
	IORM	S1,.OFLAG(MO)		;[156]Indicate in the message
	MOVE	S1,G$OPRA		;[156]Get the operator's address
	MOVE	S1,OPR.ND(S1)		;[156]The the address of the node info
	MOVE	S1,NOD.NM(S1)		;[156]Get the node name
ROUT10:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;[125]AND SAVE THE SOURCE NODE
	$CALL	OPRENB			;Check OPR's privs
	$RETIF				;NO,,RETURN
;**;[ppm]At ROUT10:+2L add 1 line  PPM  6/3/90
	$CALL	FNDALS			;[ppm]Check for local printer alias
	MOVX	S1,.RTEFM		;GET THE BLOCK TYPE
	MOVX	S2,.OBJLN+LPTNLN	;[126]AND THE BLOCK LENGTH
	$CALL	ARGRTN			;AND UPDATE THE MESSAGE
;**;[156]At ROUT10:+5L add 2 lines  JCR  1/19/90
	SKIPE	G$CLUN			;[156]/CLUSTER-NODE switch specified?
	PJRST	SNDCLU			;[156]Yes, go send to NEBULA

;Get destination information

ROUT11:	$CALL	P$NUM			;[125]Get the destination unit number
	JUMPT	ROUT13			;[125]GO VALIDATE THE NUMBER
	$CALL	P$KEYW			;[125]Attempt to get a keyword
;**;[160]At ROUT11:+3L add 2 lines   PMM 6/3/90
	CAIN	S1,.AKANM		;[160]Is it an alias name?
	JRST	ROUT12			;[160]Yes, process alias name
	JUMPF	ROUT.3			;[125]None, check for delete function
	CAIE	S1,.KYALL		;[125]Is it "ALL"?
	JRST	ROUT12			;[125]No, check for a remote printer
	SETOM	S1			;[125]Make it all units
	JRST	ROUT13			;[125]Go validate the number
ROUT12:	MOVE	S2,OBJDEV		;[125]PICK UP THE SOURCE OBJECT TYPE
	MOVEM	S2,ARG.DA+OBJ.TY(P3)	;[125]SAVE IN THE DESTINATION BLOCK
	MOVX	P2,.RTETO		;[125]PICK UP THE DESTINATION BLK TYPE
	$CALL	ROUBLK			;[125]CHECK FOR A REMOTE PRINTER
	$RETIF				;[125]RETURN ON AN ERROR
	JRST	ROUT.3			;[125]GO FINISH THE MESSAGE
ROUT13:	CAXLE	S1,77			;[125]Validate it
	$RETF				;NOT VALID,,RETURN AN ERROR
	MOVEM	S1,ARG.DA+OBJ.UN(P3)	;Save the unit number
	$CALL	P$SWIT			;Get the node switch
	JUMPF	ROUT14			;[125]No switch- thats ok
	CAIE	S1,.SWNOD		;It must be a node switch however.
;**;[156]At ROUT13:+6L replace 8 lines with 13 lines  JCR  1/19/90
	JRST	ROU13A			;[156]Check for /CLUSTER-NODE switch
	$CALL	P$NODE			;[156]Get the destination node name
	JUMPT	ROUT.2			;[156]Process destination node info
	$RET				;[156]Illegally formatted message
ROU13A:	$CALL	CHCLUN			;[156]/CLUSTER-NODE switch?
	$RETIF				;[156]No, illegally formatted message

;[156]Since no node was specified, get the OPR's node

ROUT14:	MOVX	S1,RT.DND		;[156]Default destination node
	IORM	S1,.OFLAG(MO)		;[156]Indicate in the message
	MOVE	S1,G$OPRA		;[156]Get the operator's address
	MOVE	S1,OPR.ND(S1)		;The the address of the node info
	MOVE	S1,NOD.NM(S1)		;Get the node name
	JRST	ROUT.2			;Go join the common code for completion
	SUBTTL	ROUBLK	Build a remote printer object descriptor for ROUTE

;ROUBLK is called to build a remote printer object descriptor block during
;the processing of a ROUTE command that specified a remote printer
;
;Call is: P2/ROUTE message block type code
;         P3/Address of object block being built in the ROUTE message

ROUBLK:	STKVAR	(OBJADR)		;[126]PLACE TO SAVE OBJECT BLOCK ADR
	SETZM	ARG.DA+OBJ.UN(P3)	;[126]ZERO THE UNITS FIELD
	MOVEM	P3,OBJADR		;[126]SAVE THE OBJECT BLOCK ADDRESS
;**;[150]At ROUBLK:+3L change 1 line  JCR  12/25/89
	$CALL	LPTTYP			;[150]Build the object descriptor block
	$RETIF				;[126]RETURN ON AN ERROR

	MOVE	S1,OBJADR		;[126]PICK UP THE OBJECT BLOCK ADDRESS
	STORE	P2,ARG.HD(S1),AR.TYP	;[126]SAVE THE DESTINATION BLOCK TYPE
;**;[160]At ROUBLK:+7L remove 10 lines     PMM 6/3/90
;	ADDI	S1,.OBJLN		;[126]POINT TO THE NAME BLOCK
;	LOAD	S2,ARG.HD(S1),AR.LEN	;[126]PICK UP ITS LENGTH
;	MOVNS	S2			;[126]MAKE IT NEGATIVE
;	SKIPN	S2			;[126]WAS THIS A CLUSTER LPT?
;	AOS	.OARGC(MO)		;[126]INCLUDE "NAME" BLOCK IN ARG COUNT
;	ADDI	S2,LPTNLN		;[126]AMOUNT TO ADD TO NEXT BLK POINTER
;	ADD	P3,S2			;[126]UPDATE POINTER TO NEXT BLOCK
;	MOVEI	S2,LPTNLN		;[126]PICK UP COMMON NAME BLOCK LENGTH
;	STORE	S2,ARG.HD(S1),AR.LEN	;[126]STORE THE NAME BLOCK LENGTH
;	MOVE	S1,OBJADR		;[126]PICK UP THE OJBECT BLOCK ADDRESS
	MOVE	S1,ARG.DA+OBJ.ND(S1)	;[126]PICK UP THE NODE NAME
	$CALL	OPRENB			;[126]VALIDATE THE OPERATOR
	$RET				;[126]PASS BACK THE TRUE/FALSE FLAG

;**;[ppm]After routine ROUBLK add routine FNDALS  PPM  6/3/90
	SUBTTL	FNDALS Check if a Local Printer Has an Alias

;[ppm]FNDALS is called by the ROUTE message processor to determine
;[ppm]if a local printer has an alias associated with it. If it does,
;[ppm]then it is included as part of the object descriptor block
;[ppm]
;[ppm]Call is: P3/Pointer to the object descriptor block header
;[ppm]Returns: If the object is a local printer and it has an alias
;[ppm]         then the alias has been added to its object descriptor

FNDALS:	MOVE	S1,ARG.DA+OBJ.TY(P3)	;[160]Pick up the object type
	CAIE	S1,.OTLPT		;[160]Is it a local LPT?
	$RET				;[ppm]No, so return now
	MOVEI	S1,ARG.DA+OBJ.TY(P3)	;[160]Get address of object block
	$CALL	FINDPR			;[160]Does it have an alias mapping?
	$RETIF				;[160]No, so return now
	MOVE	S1,OBJAKA(S2)		;[160]Pick up the alias name
	MOVEM	S1,ARG.DA+OBJ.AK(P3)	;[160]Add to the object descriptor
	$RET				;[ppm]Return to the caller
SUBTTL	Q$RELE	Process RELEASE command
SUBTTL	Q$HOLD	Process HOLD command

Q$RELE::
Q$HOLD:: $CALL	CHKRMT			;CHECK IF FROM REMOTE AND ADD
					; NODE BLOCK IF REMOTE OR LOCAL
	$CALL	OPRENB			;Check OPR Privs
	$RETIF				;Return on error
	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;NO..ERROR...RETURN
HOLD.1:	$CALL	PQTYPE			;PROCESS QUEUE TYPE
	JUMPF	E$IOT			;ERROR..INVALID QUEUE TYPE
HOLD.2:	$CALL	PREQNM			;PROCESS REQUEST NUMBER
	JUMPF	HOLD.3			;ERROR..TRY USER FIELD
	JRST	CMDEND			;CHECK FOR THE END
HOLD.3:	$CALL	PUSER			;PROCESS USER FIELD
	JUMPF	HOLD.4			;CHECK OUT * OR /NODE
	JRST	CMDEND			;CHECK FOR THE END
HOLD.4:	$CALL	P$TOK			;GET A TOKEN
	$RETIF				;ERROR ..RETURN
	SETOM	S1			;YES..ASSUME * -1 FOR REQUEST
	$CALL	PREQ.1			;SAVE ARGUMENT
	$CALL	PNODSW			;GET NODE SWITCH
;**;[144]At HOLD.4:+5L change 1 line JYCW Oct-18-88 
	JUMPF	HOLD.5			;[144]NOT /NODE BUT HOW ABOUT /CLUSTER
	PJRST	CMDEND			;FINISH OFF COMMAND
;**;[144]At HOLD.4:+8L add 2 lines JYCW Oct-18-88
HOLD.5:	$CALL	P$PREV			;[144]BACK UP ONE SWITCH
	PJRST	CMDEND			;[144]FINISH OFF COMMAND


SUBTTL	PQTYPE	Process QUEUE type field

;CALLED WITH S1 CONTAINING THE QUEUE TYPE

PQTYPE:	MOVEM	S1,G$ARG1		;SAVE THE OBJECT TYPE
	SKIPLE	S1			;VALID QUEUE TYPE?
	CAILE	S1,.OTPLT		;WITHIN RANGE
	$RETF				;NO..INVALID OBJECT TYPE
PQTY.1:	MOVEM	S1,ARG.DA(P3)		;SAVE THE OBJECT TYPE IN MESSAGE
	MOVX	S1,.ORTYP		;GET OBJECT TYPE
	MOVX	S2,ARG.SZ		;GET ARGUMENT SIZE
	PJRST	ARGRTN			;SAVE ARGUMENT AND RETURN
SUBTTL	PNODSW	Process /NODE switch
SUBTTL	CNODSW	Validate a /NODE switch

PNODSW:	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	.RETT			;RETURN O.K..CHECK NEXT FIELD
	CAIE	S1,.SWNOD		;WAS IT A NODE
	$RETF				;NO..RETURN FALSE
CNODSW:	$CALL	P$NODE			;GET THE NODE FIELD
	$RETIF				;ERROR..RETURN
	MOVE	P1,S1			;SAVE VALUE OF NODE
	$CALL	OPRENB			;IS OPR ENABLED FOR NODE
	$RETIF				;ERROR...RETURN
	MOVE	S1,P1			;PLACE IN S1
SAVNOD::MOVEM	S1,ARG.DA(P3)		;[136]SAVE THE VALUE
	MOVX	S1,.ORNOD		;GET THE NODE BLOCK TYPE
	MOVX	S2,ARG.SZ		;AND BLOCK SIZE
	PJRST	ARGRTN			;SAVE ARGUMENT AND RETURN

SUBTTL	GNODSW	Get /NODE argument if present

;THIS ROUTINE WILL GET NODE SWITCH IF PRESENT AND RETURN VALUE
;IN S1 OR  RETURN FALSE IF NOT THERE

GNODSW:	$CALL	P$SWIT			;CHECK FOR A SWITCH
	$RETIF				;NOT..RETURN FALSE
	CAIE	S1,.SWNOD		;WAS IT A NODE
	$RETF				;NO..RETURN FALSE
	$CALL	P$NODE			;GET THE NODE FIELD
	$RET				;RETURN..PASSING CODE OR VALUE
SUBTTL	Q$CANC	Process CANCEL command

Q$CANC:: $CALL	CHKRMT			;CHECK IF FROM REMOTE AND ADD
					; NODE BLOCK IF LOCAL OR REMOTE
	$CALL	OPRENB			;Check OPR privs
	$RETIF				;Return on error
	$CALL	P$KEYW			;GET THE QUEUE TYPE
	$RETIF				;ERROR...RETURN
	CAIN	S1,.KYMNT		;WAS IT A MOUNT REQUEST
	JRST	CANC.1			;PROCESS CANCEL OF MOUNT REQUESTS
	SETZM	P1			;SET FLAG FOR ALL DATA
	PJRST	HOLD.1			;FINISH OFF COMMAND
CANC.1:	MOVX	S1,.ODDMT		;SET CANCEL MOUNT REQUEST TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN HEADER
	$CALL	PREQNM			;WAS IT A REQUEST NUMBER
	JUMPT	CANC.2			;PROCESS THE REASON IF PRESENT
	$CALL	PSTRUC			;GET THE STRUCTURE NAME
	JUMPT	CANC.2			;WIN,,CHECK FOR REASON
	$CALL	P$TOK			;GET A TOKEN
	$RETIF				;ERROR ..RETURN
	SETOM	S1			;YES..ASSUME * -1 FOR ALL REQUESTS
	$CALL	PREQ.1			;SAVE ARGUMENT

CANC.2:	$CALL	P$SWIT			;WAS THERE A SWITCH
;**;[151]At CANC.2:+1L replace 10 lines with 4 lines  JCR  12/31/89
	JUMPF	CMDEN1			;[151]No, check for END OF COMMAND
	CAIN	S1,.SWRSN		;[151]Was it /REASON: ?
	JRST	CANC.3			;[151]Yes
	PJRST	CMDEN			;[151]Check for a /CLUSTER-NODE switch

CANC.3:	$CALL	PREASN			;[144]Process the REASON
	JUMPT	CANC.2			;[144]O.K check for /CLUSTER-NODE
	$RET				;OTHERWISE PASS ERROR BACK
SUBTTL	CHKRMT	Check for remote node input

;THIS ROUTINE WILL CHECK IF FROM REMOTE SITE AND ADD A .CMNOD
;BLOCK IF OPR IS REMOTE SO QUASAR CAN VALIDATE THE REQUEST

;Returns	S1/ Node Name


CHKRMT:	SETOM	S1			;System OPR?
	$CALL	OPRENB
	JUMPT	[MOVE	S1,G$HOST	;Yes..return host name
		 JRST	CHKR.2]
	SETZM	G$ERR			;Ignore errors
	MOVE	S1,G$HOST		;Local OPR?
	$CALL	OPRENB
	JUMPT	[MOVE	S1,G$HOST	;Yes..add central site block
		 JRST	CHKR.1]
	SETZM	G$ERR			;Ignore errors
	MOVE	S2,OPR.ND(S1)		;GET NODE ENTRY ADDRESS
	MOVE	S1,NOD.NX(S2)		;GET THE NAME
CHKR.1:	$SAVE	<S1>			;Preserve node
	$CALL	SAVNOD			;Include the node block
CHKR.2:	$RETT
SUBTTL	Q$MODI	Process MODIFY command

;THIS COMMAND WILL MODIFY AN ENTRY IN QUASARS QUEUES

Q$MODI:: $CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	$CALL	PQTYPE			;PROCESS QUEUE TYPE
	JUMPF	Q$MODS			;NOT A QUEUE TYPE, MAYBE A SYSTEM LIST
	$CALL	CHKRMT			;CHECK IF FROM REMOTE AND ADD
					; NODE BLOCK IF REMOTE OR LOCAL
	$CALL	OPRENB			;Check OPR privs
	$RETIF				;Return on failure
	$CALL	PREQNM			;PROCESS REQUEST NUMBER
	JUMPT	MODI.1			;O.K. PROCESS MODIFY OPTION
	$CALL	PUSER			;TRY USER FIELD
	JUMPT	MODI.1			;O.K.. PROCESS THE  FIELDS
	$CALL	P$TOK			;WAS THERE A TOKEN
	SETZM	G$ERR			;Ignore errors
	$RETIF				;NO..ERROR..RETURN
	SETOM	S1			;SET FOR ALL REQUESTS
	$CALL	PREQ.1			;SAVE REQUEST NUMBER
	$CALL	PNODSW			;WAS THERE A NODE SWITCH
	$RETIF				;ERROR..RETURN
MODI.1:	$CALL	P$KEYW			;PROCESS A KEYWORD
	$RETIF				;BAD COMMAND
	CAIE	S1,.KYPRI		;IS IT PRIORITY
	$RETF				;BAD COMMAND
	$CALL	P$NUM			;GET THE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA(P3)		;SAVE THE VALUE
	MOVX	S1,.MOPRI		;GET BLOCK TYPE
	MOVX	S2,ARG.SZ		;BLOCK SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH OFF COMMAND
SUBTTL	Q$SET	Process the SET command

;THIS ROUTINE WILL SEND THE APPROPRIATE SET MESSAGE TO
;QUASAR FOR PRINTERS, BATCH-STREAMS, AND PRIORITY. ALL OTHER 
;SET TYPES WILL BE PROCESSED BY ORION

Q$SET:: $CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ILLEGALLY FORMATTED COMMAND
	MOVSI	S2,-SETTX1		;PREPARE AOBJN POINTER
SET.1:	HLRZ	T1,SETDSP(S2)
	CAME	T1,S1			;MATCH?
	AOBJN	S2,SET.1		;CHECK THE REST IF ANY
	JUMPGE	S2,.RETF		;LOSE!
	MOVE	P2,SETDSP(S2)		;SAVE ENTRY DATA
	MOVEI	T1,SETDSP(S2)		;ADDRESS OF THE ENTRY
	CAILE	T1,SETOBJ		;SET FOR BAT OR LPT
	JRST	SET.3			;NO..GO PROCESS
	$CALL	P$PREV			;POSITION TO PREVIOUS BLOCK
	$CALL	BLDOBJ			;GET THE OBJECT BLOCK
	$RETIF				;RETURN
	$CALL	P$KEYW			;GET THE KEYWORD FOR SET
	$RETIF				;RETURN
	HRRZ	S2,P2			;GET THE PROPER TABLE ADDRESS
	MOVE	S2,(S2)			;GET DISPATCH POINTER
SET.2:	HLRZ	T1,(S2)			;GET THE FIELD TO CHECK
	CAME	T1,S1			;CHECK FOR MATCH??
	AOBJN	S2,SET.2		;NO..KEEP CHECKING
	JUMPGE	S2,.RETF		;NO MATCH..FAILED
	HRRZ	T1,(S2)			;GET ADDRESS OF HEADER
	HLRZ	T2,(T1)			;PLACE ADDRESS IN T1
	MOVE	T2,(T2)			;GET HEADER IN T1
	MOVEM	T2,ARG.HD(P3)		;SAVE THE ENTRY
SET.3:	HRRZ	S2,(T1)			;GET THE ROUTINE ADDRESS
	JRST	(S2)			;GO TO PROPER ROUTINE


;SET COMMAND DISPATCH TABLE
SETDSP:	XWD	.KYBAT,[-BATCNT,,BATDSP]	 ;BATCH
	XWD	.KYLPT,[-LPTCNT,,LPTDSP]	 ;LPT
	XWD	.KYCDP,[-CDPCNT,,CDPDSP]	;CDP
	XWD	.KYPTP,[-PTPCNT,,PTPDSP]	;PAPAR-TAPE-PUNCH
SETOBJ:	XWD	.KYPLT,[-PLTCNT,,PLTDSP]	;PLT
	XWD	.KYJOB,SETJOB		;PROCESS JOB SETTING OPTIONS
	XWD	.KYTAP,SETTAP		;SET TAPE COMMAND
TOPS10<	XWD	.KYUSG,SETUSG>		;SET USAGE
TOPS20 <
	XWD	.KYSCH,SETSCH		;SET BIAS COMMAND
	XWD	.KYDSK,SETDSK		;SET DISK COMMAND
	XWD	.KYSTR,SETSTR		;SET STRUCTURE COMMAND
	XWD	.KYPOR,SETPOR		;Set port command
	XWD	.KYONL,SETONL		;SET ONLINE COMMAND
>;END TOPS20
IFN	FTDN60,<
	XWD	.KYNOD,SETNOD		;SET NODE COMMAND
>;END FTDN60
SETTX1==.-SETDSP


;BATCH DISPATCH TABLE

BATDSP:	XWD	.KYATR,[[ARG.SZ+1,,.STATR],,SETATR] ;ATTRIBUTE
	XWD	.KYMEM,[[ARG.SZ+1,,.STMEM],,SETMEM] ;MEMORY LIMITS
	XWD	.KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
	XWD	.KYNOI,[[1,,.STNOI],,SETNOI]	;NOOPR-INTERVENTION
	XWD	.KYOIA,[[1,,.STOIA],,SETOIA]	;OPR-INTERVENTION
	XWD	.KYTIM,[[ARG.SZ+1,,.STTIM],,SETTIM] ;SET TIME LIMITS
BATCNT==.-BATDSP


;LINE PRINTER DISPATCH TABLE

LPTDSP: XWD	.KYDST,[[ARG.SZ,,.STDST],,SETDST] ;Destination
	XWD	.KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
	XWD	.KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
	XWD	.KYPGL,[[ARG.SZ+1,,.STPGL],,SETPGL] ;PAGE-LIMITS
	XWD	.KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
LPTCNT==.-LPTDSP

CDPDSP:	XWD	.KYDST,[[ARG.SZ,,.STDST],,SETDST] ;Destination
PLTDSP:
PTPDSP:	XWD	.KYFOT,[[ARG.SZ,,.STFRM],,SETFRM] ;FORMS-TYPE
	XWD	.KYLEA,[[ARG.SZ,,.STLEA],,SETLEA] ;LIMIT-EXCEED-ACTION
	XWD	.KYOPL,[[ARG.SZ+1,,.STOPL],,SETOPL] ;OUTPUT-LIMITS
	XWD	.KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
	CDPCNT==.-CDPDSP
	PTPCNT==.-PTPDSP
	PLTCNT=.-PLTDSP
SUBTTL	SETUSG	Process SET USAGE command

TOPS10 <

SETUSG:	SETOM	S1			;Get ALL nodes
	$CALL	OPRENB			;Check OPR privs
	$RETIF				;Return on failure
	$CALL	P$KEYW
	JUMPF	E$IFC
	MOVEI	S2,USGTBL		;POINT TO KEY TABLE
	$CALL	TABSRC			;FIND THE KEYWORD
	JUMPF	E$IFC			;BAD FORMAT
	STORE	S2,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	CAXE	S2,UGUFC$		;IS THIS FILE CLOSURE ???
	JRST	SETU.1			;NO,,FINISH UP !!!
	PUSHJ	P,P$KEYW		;GET THE NEXT KEYWORD
	JUMPF	SETU.1			;NOT A KEYWORD,,TRY FOR A TIME !!!
	CAXN	S1,.KYNOW		;IS IT NOW ???
	JRST	[MOVX  S1,US.NOW	;YES,,GET 'NOW' FLAG BIT
		 MOVEM S1,.OFLAG(MO)	;SAVE IT
		 PUSHJ P,I%NOW		;GET CURRENT TIME
		 JRST  SETU.2 ]		;AND CONTINUE
	CAXN	S1,.KYDLY		;IS IT DAILY ???
	JRST	[MOVX  S1,US.DLY	;YES,,GET 'DAILY' FLAG BIT
		 MOVEM S1,.OFLAG(MO)	;SAVE IT
		 JRST  SETU.1 ]		;AND CONTINUE
	CAXE	S1,.KYWKY		;IS IT WEEKLY ???
	JRST	E$IFC			;NO,,THATS AN ERROR
	PUSHJ	P,P$KEYW		;GET THE DAY OF THE WEEK
	JUMPF	E$IFC			;NOT THERE,,THATS AN ERROR
	CAIL	S1,0			;VALIDATE THE DAY - MUST BE BETWEEN
	CAILE	S1,6			;   ONE AND SEVEN...
	JRST	E$IFC			;NO,,THATS AN ERROR
	TXO	S1,US.WKY		;LITE 'WEEKLY' FLAG BIT
	MOVEM	S1,.OFLAG(MO)		;SAVE IT

SETU.1:	$CALL	P$TIME			;GET THE TIME
	JUMPF	E$IFC			;NOT THERE,,THATS AN ERROR !!!
SETU.2:	MOVEM	S1,ARG.DA(P3)		;SAVE THE UDT
	MOVX	S1,.ORTIM		;TIME BLOCK
	MOVEI	S2,ARG.SZ		;GET THE SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	$CALL	P$SWITCH		;LOOK FOR A SWITCH
	JUMPF	SETU.3			;NONE,,MIGHT STILL BE OK
	CAXE	S1,.SWNOS		;IS IT /NO-SESSION-ENTRIES ???
	JRST	E$IFC			;NO,,THATS AN ERROR
	MOVX	S1,US.NOS		;YES,,GET FLAG BIT
	IORM	S1,.OFLAG(MO)		;   AND LIGHT IT
SETU.3:	$CALL	P$CFM			;DO WE HAVE CONFIRM ???
	JUMPF	E$IFC			;NO,,THATS AN ERROR
	ANDI	P3,777			;GET MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE MESSAGE SIZE IN MESSAGE
	$CALL	SNDACT			;SEND THE MESSAGE OFF TO THE ACTDAE
	$RETIT				;WIN,,RETURN
	PJRST	E$SAF			;SAY IT FAILED

USGTBL:	$STAB
	.KYUBC,,UGEBC$			;BILLING-CLOSURE
	.KYUFC,,UGUFC$			;FILE-CLOSURE
	$ETAB

> ;END TOPS10
SUBTTL	SETJOB	Set operator values for a job

SETJOB:	MOVE	S1,G$HOST		;Get host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;NO..ERROR..RETURN
	MOVE	P1,S1			;SAVE NUMBER IN P1
	MOVEM	P1,G$ARG1		;SAVE THE JOB NUMBER
	$CALL	P$KEYW			;GET THE SETTING KEYWORD
	$RETIF				;ERROR...RETURN
;**;[161]At SETJOB+9L Replace 9 lines with 25 JYCW  6/8/90
	CAIN	S1,.KYCLS		;[161]WAS IT CLASS?
	JRST	SETJ.1			;[161]Yes
	SETO	T2,			;[161]SET A FLAG
	CAIN	S1,.KYNOI		;[161]WAS IT NO OPERATOR INTERVENTION
	MOVEI	P2,.OBNWR		;[161]SET NO OPR INTERVENTION
	CAIN	S1,.KYOIA		;[161]OPR INTERVENTION ALLOWED
	MOVEI	P2,.OBALL		;[161]YES SET OPR INTERVENTION ALLOWED
	JUMPL	P2,.RETF		;[161]INVALID FIELD..RETURN
TOPS10 <
	1OVE	S2,P1			;PLACE JOB NUMBER IN S2
	MOVE	S1,[2,,S2]		;SET UP THE BLOCK
	HRLI	T1,.STWTO		;SET WTO INFO FUNCTION
	HRR	T1,T2			;PLACE VALUE IN T1
	JBSET.	S1,			;PERFORM THE FUNCTION
	  PJRST	E$SJN			;SET JOB NOT IMPLEMENTED  
>;END TOPS10

TOPS20 <
	$CALL	P$SWIT			;[160]Check for a switch
	JUMPF	SETJ.W			;[161]None, do it locally
	$CALL	CHCLUN			;[161]Check if a /CLUSTER-NODE switch
	$RETIF				;[161]Illegally formatted message
	SKIPN	G$CLUN			;[161]Local node specified?
	JRST	SETJ.W			;[161]Yes, do it locally
	MOVE	S1,G$CLUN		;[161]Pick up the remote node name
	CAME	S1,[-1]			;[161]For all nodes?
	IFSKP.				;[161]Yes
	  $CALL	SETJ.W			;[161]Yes, Local first then
	ENDIF.				;[161]
	$CALL	RELPAG			;[161]Release the page
	$CALL	GETPAG			;[161]Get an output page
	MOVEI	P3,.OHDRS(MO)		;[161]FREE POINTER FOR OUTPUT
	SETZM	G$OUTP			;[161]MESSAGE PAGE RELEASE FLAG
	MOVEI	S1,.STJOB		;[161]Job info block
	HRR	S2,P1			;[161]Job number
	HRL	S2,P2			;[161]OPR/NOOPR 
	$CALL	MOVAR2			;[161]Add it to the message
	$CALL	RMSTMS			;[161]Build Remote Set message
	$CALL	SNDNEB			;[161]Only remote
	CAME	MO,G$OUTP		;[161]Was page release already
	$CALL	RELPAG			;[161]No, release the output page
	$RET				;[161]Return to the caller

SETJ.W::MOVE	S1,P1			;[160]GET THE JOB NUMBER
	MOVX	S2,.SJBAT		;UPDATE BATCH DATA
	SETZ	T1,			;CLEAR THE DATA WORD
	STORE	T2,T1,OB%WTO		;SAVE THE DATA
	SETJB				;SET THE INFO
	 ERJMP E$SJN			;NOTE THE ERROR
>;END TOPS20
	PJRST	E$SJM			;SET JOB MODIFIED
TOPS10 <
SETJ.1:	$RETF				;ILLEGAL COMMAND
>;END TOPS10

TOPS20	<

;**;[161]Needs Job number and Class number.
;P1/job number 
;P2/class number

;**;[161]At SETJ.1+0L delete 2 lines JYCW  6/8/90
SETJ.1:	$CALL	P$NUM			;GET THE CLASS VALUE
	$RETIF				;ERROR..RETURN
;**;[161]At SETJ.1+2L add 26 lines JYCW  6/8/90
	MOVEM	S1,P2			;[161]Save class
	$CALL	P$SWIT			;[161]Check for a switch
	JUMPF	SETJ.S			;[161]None, do it locally
	$CALL	CHCLUN			;[161]Check if a /CLUSTER-NODE switch
	$RETIF				;[161]Illegally formatted message
	SKIPN	G$CLUN			;[161]Local node specified?
	JRST	SETJ.S			;[161]Yes, do it locally
	MOVE	S1,G$CLUN		;[161]Pick up the remote node name
	CAME	S1,[-1]			;[161]For all nodes?
	IFSKP.				;[161]Yes
	  $CALL	SETJ.S			;[161]Yes, Local first then
	ENDIF.				;[161]
	$CALL	RELPAG			;[161]Release the page
	$CALL	GETPAG			;[161]Get an output page
	MOVEI	P3,.OHDRS(MO)		;[161]FREE POINTER FOR OUTPUT
	SETZM	G$OUTP			;[161]MESSAGE PAGE RELEASE FLAG
	MOVEI	S1,.STSCH		;[161]Job info block
	HRR	S2,P1			;[161]Job number
	HRL	S2,P2			;[161]Scheduler class
	$CALL	MOVAR2			;[161]Add it to the message
	$CALL	RMSTMS			;[161]Build Remote Set message
	$CALL	SNDNEB			;[161]Only remote
	CAME	MO,G$OUTP		;[161]WAS PAGE RELEASE ALREADY
	$CALL	RELPAG			;[161]No, release the output page
	$RET				;[161]Return to the caller

SETJ.S::MOVE	T3,P2			;[161]SAVE THE CLASS
	MOVEI	S1,.SKSCJ		;GET THE FUNCTION
	MOVEI	S2,T1			;BLOCK IN T1
	MOVEI	T1,3			;SIZE OF BLOCK
	MOVE	T2,P1			;GET THE JOB NUMBER
	MOVEM	T2,G$ARG1		;[161]Save it for reporting 
	SKED%				;DO THE FUNCTION
	  ERJMP	SETJ.2			;TRAP ERROR
	PJRST	E$SSJ			;SET SCHEDULER JOB O.K.
SETJ.2:	MOVE	S1,[EXP -2]		;GET LAST -20 ERROR
	MOVEM	S1,G$ARG1		;SAVE THE VALUE
	PJRST	E$SJF			;SET FAILED..RETURN

>;END TOPS20

;**;[161]At SETJ.2+3L add 12 lines  JYCW  6/8/90
;builds the remote SET JOB message header.

RMSTMS:	HRRZ	S1,G$CBLK		;[161]Node name block
	MOVE	S2,G$CBLK+1		;[161]Node name
	$CALL	MOVAR2			;[161]Add it to the message
	MOVX	S1,NEB%MS!.OMSJB	;[161]Pick up the message type
	STORE	S1,.MSTYP(MO),MS.TYP	;[161]Save the type in header
	MOVE	S1,P3			;[161]Get end address of message
	SUB	S1,MO			;[161]Subtract it from beginning
	STORE	S1,.MSTYP(MO),MS.CNT	;[161]Save the length of the message.
	SETZM	.OFLAG+.MSTYP(MO)	;[161]No flags
	MOVX	S1,MF.NEB		;[161]Nebula bit
	IORM	S1,.MSFLG(MO)		;[161]Say so in Galaxy header.
	$RET				;[161]
SUBTTL	SETxxx	Process SET PARAMETERS

SETTIM:
SETPGL:
SETOPL:
SETMEM:	$CALL	P$RNGE			;GET RANGE
	$RETIF				;ERROR..RETURN
SETM.1:	DMOVEM	S1,ARG.DA(P3)		;SAVE VALUES IN MESSAGE
	ADDI	P3,ARG.SZ+1		;BUMP TO NEXT FREE LOCATION
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	PJRST	CMDEND			;FINISH OFF COMMAND

SETPRI:	$CALL	P$RNGE			;GET RANGE
	$RETIF				;ERROR..RETURN
	MOVEM	S2,G$ARG1		;SAVE THE VALUE
	CAILE	S2,^D63			;IS IT IN RANGE
	PJRST	E$SPI			;INVALID PRIORITY SPECIFIED
	JRST	SETM.1			;FINISH OFF COMMAND


SETNOI:
SETOIA:	ADDI	P3,1			;BUMP TO NEXT LOCATION
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	PJRST	CMDEND			;FINISH OFF COMMAND

;HERE TO SET PRINTER PARAMETERS
SETFRM:	$CALL	P$SIXF			;GET A 6 BIT FIELD TYPE
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA(P3)		;SAVE FORMS NAME IN MESSAGE
	ADDI	P3,ARG.SZ		;BUMP TO NEXT LOCATION
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	PJRST	CMDEND			;END THE COMMAND

;HERE TO HANDLE THE PROCESSOR VERB

SETATR:	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	MOVEI	S2,PRODSP		;GET PROCESSOR TABLE
	$RETIF				;ERROR..RETURN
	PJRST	SETL.1			;HANDLE AS LIMITED EXCEEDED

;HERE TO HANDLE LIMIT-EXCEEDED-ACTION VERB
SETLEA:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	MOVEI	S2,LEADSP		;GET LIMIT-EXCEED ACTION TABLE
SETL.1:	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;ERROR..RETURN
	MOVEM	S2,ARG.DA(P3)		;SAVE IN THE MESSAGE
	ADDI	P3,ARG.SZ		;BUMP THE POINTER
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	PJRST	CMDEND			;FINISH OFF COMMAND

; Here to handle an SNA Destination Specification
SETDST:	$CALL	P$TEXT			;Get the specification
	$RETIF
	MOVEI	T1,.STDST		;"Destination" type
	STORE	T1,ARG.HD(S1),AR.TYP	;Save correct type in header
	$CALL	MOVARG			;Build argument and update counts
SETD.0:	$CALL	P$SWITCH		;Look for a switch
	JUMPF	CMDEND			;None there, finish up
	MOVEI	S2,DSTDSP		;Get dispatch table
	$CALL	TABSRC			;Search the table
	$RETIF				;Error, return
	MOVE	S1,S2			;Argument type to S1
	MOVEI	S2,1			;The argument size
	$CALL	ARGRTN			;Save the argument
	JRST	SETD.0			;Keep looking

LEADSP:	$STAB
	.KYCNC,,.STCAN			;CANCEL IT
	.KYASK,,.STASK			;ASK
	.KYIGN,,.STIGN			;IGNORE IT
	$ETAB

PRODSP:	$STAB
	.KYBAT,,%GENRC			;SET BATCON PROCESSOR
	.KYSIT,,%SITGO			;SET SITGO PROCESSOR
	$ETAB

DSTDSP:	$STAB
	.SWNTL,,.STNTL			;/NOTRANSLATE
	.SWSPL,,.STSPL			;/SPOOL
	$ETAB
SUBTTL	SETONL	Process	SET ONLINE command (TOPS20)

;THIS COMMAND IS TO INFORM SYSTEM OF A DEVICE THAT HAS BECOME
;AVAILABLE.

TOPS20 <
SETONL:	MOVE	S1,G$HOST		;Get host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVE	P3,MO			;GET OUTPUT POINTER
	MOVEI	S1,[ASCIZ//]		;NULL TEXT
	MOVEM	S1,G$ARG1		;SAVE THE ARGUMENT
	SETOM	T4			;SET THE FLAG
SETO.1:	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;BAD COMMAND
	MOVEM	S1,G$ARG2		;SAVE THE ARGUMENT
	SKIPGE	S1			;IS IT O.K.
	PJRST	E$SIC			;INVALID CHANNEL
	CAILE	S1,7			;IS IT IN RANGE
	PJRST	E$SIC			;SET INVALID CHANNEL
	AOS	P3			;BUMP THE FIELD
	MOVEM	S1,(P3)			;SAVE THE DATA
	$CALL	P$COMMA			;CHECK FOR A COMMA
	$RETIF				;ERROR..RETURN
	$CALL	P$NUM			;GET THE DEVICE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,G$ARG2		;SAVE DEVICE NUMBER
	SKIPGE	S1			;IS IT VALID?
	PJRST	E$SID			;INVALID DEVICE
	AOS	P3			;BUMP POINTER
	MOVEM	S1,(P3)			;SAVE THE VALUE
	$CALL	P$CFM			;CHECK IF DONE
	JUMPF	SETO.2			;TRY FOR COMMA
	AOS	P3			;BUMP FIELD
	SETOM	(P3)			;NO CONTROLLER -1 USED
	PJRST	SETO.3			;FINISH OFF COMMAND
SETO.2:	$CALL	P$COMMA			;WAS IT A COMMA?
	$RETIF				;BAD COMMAND
	$CALL	P$NUM			;GET CONTROLLER IF PRESENT
	$RETIF				;NO..ERROR..RETURN
	MOVEM	S1,G$ARG2		;SAVE THE VALUE
;JSYS WILL VERIFY
	AOS	P3			;BUMP POINTER
	MOVEM	S1,(P3)			;SAVE THE VALUE
	$CALL	P$CFM			;CONFIRMED??
	JUMPT	SETO.3			;PROCESS IT
	AOSE	T4			;CHECK FLAG
	$RETF				;INVALID COMMAND
	MOVEI	S1,[ASCIZ/Alternate /]	;GET ALTERNATE
	MOVEM	S1,G$ARG1		;SAVE THE VALUE
	JRST	SETO.1			;GET ALTERNATE DATA
SETO.3:	MOVX	S1,.DGPDL		;GET FUNCTION CODE
	MOVEM	S1,(MO)			;SAVE IN BLOCK
	HRRZ	S1,MO			;ADDRESS IN RIGHT HALF
	SUBI	P3,-1(MO)		;GET LENGTH OF BLOCK
	MOVN	P3,P3			;MAKE IT NEGATIVE
	HRL	S1,P3			;PUT LENGTH IN LEFT HALF
	DIAG				;DO THE JSYS
	  PJRST	SETO.4			;ERROR..CHECK IT OUT
	PJRST	E$SOA			;SET ONLINE ACCEPTED.. RELEASE THE PAGE
SETO.4:	MOVEM	S1,G$ARG1		;SAVE THE ERROR CODE
	PJRST	E$DJF			;DIAG JSYS FAILED

>;END TOPS20
SUBTTL	SETSCH	Process SET SCHEDULER command (TOPS20)


;THIS COMMAND WILL DO THE SKED% JSYS TO AFFECT THE SCHEDULER CONTROLS
;AND INFORM OPERATOR OF THE ACTION
TOPS20 <

SETSCH:	MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	MOVEI	S2,SCHDSP		;SCHEDULER DISPATCH TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;ERROR..RETURN
	HLRZ	P1,(S2)			;GET THE FUNCTION CODE
	HRRZ	S2,(S2)			;GET THE ROUTINE ADDRESS
	PJRST	(S2)			;PROCESS THE ROUTINE AND RETURN
SCHBIA:	$CALL	P$NUM			;GET THE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEI	T1,2			;BLOCK OF 2 WORDS
	MOVE	T2,S1			;GET THE NUMBER	
	PJRST	SCHED			;DO THE FUCNTION AND RETURN


SUBTTL	SCHED	Do the SKED% JSYS (TOPS20)

;THIS ROUTINE WILL DO THE SCHEDULE FUNCTION WITH P1 CONTAINING THE
;FUNCTION CODE

SCHED:	MOVEI	T1,2			;MINIMUM SIZE BLOCK
SCHED1:	MOVE	S1,P1			;GET THE FUNCTION
	MOVEI	S2,T1			;ADDRESS OF THE BLOCK
	SKED%				;DO THE JSYS
	  ERJMP	SCHED2			;SHOW ERROR
	PJRST	E$SSS			;BIAS SET ..RETURN AND RELEASE PAGE
SCHED2:	MOVE	S2,[EXP -2]		;LAST -20 ERROR CODE
	MOVEM	S2,G$ARG1		;SAVE THE CODE
	PJRST	E$SSF			;SET BIAS FAILED



SCHDSP:	$STAB
	.KYBAT,,[.SKBCS,,SCHBAT]	;SET SCHED BATCH
	.KYBIA,,[.SKSBC,,SCHBIA]	;SET SCHED BIAS
	.KYCLS,,[.SKSCS,,SCHCLS]	;SET SCHED CLASS
	$ETAB
>;END TOPS20
SUBTTL	SCHBAT	Process SET SCHEDULER BATCH command (TOPS20)

TOPS20 <

SCHBAT:	$CALL	P$NUM			;GET THE BATCH CLASS
	JUMPF	SCHB.1			;TRY KEYWORDS
	MOVE	T2,S1			;GET THE CLASS NUMBER
	PJRST	SCHED			;DO THE SCHED JSYS
SCHB.1:	$CALL	P$KEYW			;IS IT A KEYWORD?
	$RETIF				;ERROR..RETURN
	CAIE	S1,.KYNON		;NONE?
	JRST	SCHB.2			;TRY BACKGROUND
	SETOM	T2			;NON-ZERO VALUE
	$CALL	SCHED			;DO THE FUNCTION
	MOVEI	P1,.SKBBG		;CLEAR DREGS SETTING ALSO
	SETZM	T2			;CLEAR THE VALUE
	PJRST	SCHED			;DO THE FUNCTION AND RETURN
SCHB.2:	CAIE	S1,.KYBCK		;WAS IT BACKGROUND
	$RETF				;NO..RETURN FALSE
	MOVEI	P1,.SKBBG		;SET BACKGROUND
	SETOM	T2			;NON-ZERO..BACKGROUND
	PJRST	SCHED			;DO THE FUNCTION
>;END TOPS20
SUBTTL	SCHCLS	Process SET SCHEDULER CLASS command (TOPS20)


TOPS20 <
SCHCLS:	$CALL	P$NUM			;GET THE CLASS NUMBER
	$RETIF				;ERROR..RETURN
	MOVE	T2,S1			;SAVE THE VALUE
	$CALL	P$NUM			;GET THE PERCENT
	$RETIF				;ERROR..RETURN
	FLTR	S1,S1			;FLOAT THE NUMBER
	FDVRI	S1,(100.)		;CONVERT TO NUMBER FROM PERCENT
	MOVE	T3,S1			;SAVE THE SHARE
	MOVEI	T1,3			;GET THE LENGTH
	PJRST	SCHED1			;DO THE FUNCTION
>;END TOPS20
SUBTTL	SETNOD	Process SET NODE command (DN60)

;THIS COMMAND WILL PASS A PARTICULAR VALUE FOR A DN60 OPTION

IFN	FTDN60,<
SETNOD:	MOVE	S1,G$HOST		;Get host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	P$NODE			;BETTER HAVE NODE VALUE
	$RETIF				;ERROR..RETURN
	$CALL	SAVNOD			;SAVE THE NODE
	$CALL	P$KEYW			;CHECK FOR A KEYWORD
	$RETIF				;ERROR..RETURN
	MOVEI	S2,SETNDP		;GET TABLE ADDRESS
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;ERROR..RETURN
	HLRZ	P1,(S2)			;GET BLOCK VALUE IN P1
	HRRZ	S2,(S2)			;GET ROUTINE ADDRESS
	PJRST	(S2)			;PROCESS FUNCTION AND RETURN

SETNDP:	$STAB
	XWD	.KYBPM,[.STBPM,,SETBPM]	;BYTES PER MESSAGE
	XWD	.KYCSD,[.STCSD,,SETCSD]	;CLEAR-SEND-DELAY
	XWD	.KYDTR,[.STDTR,,SETDTR]	;DATA TERMINAL READY
	XWD	.KYRPM,[.STRPM,,SETRPM]	;RECORDS PER MESSAGE
	XWD	.KYSWL,[.STSWL,,SETSWL]	;SILO WARNING LEVEL
	XWD	.KYTOU,[.STTOU,,SETTOU]	;TIMEOUT CATEGORY
	XWD	.KYTRA,[.STTRA,,SETTRA]	;TRANSPARANCY
	XWD	.KYDAT,[.STDAT,,SETDAT]	;IBM logon data
	XWD	.KYLOM,[.STLOM,,SETLOM]	;IBM logon mode
	XWD	.KYPLU,[.STPLU,,SETPLU]	;IBM Application (PLU)
	XWD	.KYCIR,[.STCIR,,SETCIR]	;Circuit-ID
	XWD	.KYCHS,[.STCHS,,SETCHS]	;Translation file
	$ETAB


;ALL ROUTINES CALLED WITH FUNCTION CODE IN P1

;SET CLEAR TO SEND DELAY
SETBPM:
SETRPM:
SETSWL:
SETCSD:	$CALL	P$NUM			;GET THE VALUE
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA(P3)		;SAVE THE DATA
SETFIN:	MOVE	S1,P1			;GET THE BLOCK TYPE
	MOVX	S2,ARG.SZ		;BLOCK SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH AND SEND COMMAND

SETTRA:
SETDTR:	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	SETZ	T1,			;SET A FLAG
	CAIN	S1,.KYON		;WAS IT ON
	MOVX	T1,ST.ON		;SET ON
	CAIN	S1,.KYOFF		;WAS IT OFF
	MOVX	T1,ST.OFF		;SET OFF
	JUMPE	T1,.RETF		;NONE..ERROR..RETURN
	MOVEM	T1,ARG.DA(P3)		;SAVE THE VALUE
	PJRST	SETFIN			;FINISH SET COMMAND

SETTOU:	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	SETZ	T1,			;SET A FLAG
	CAIN	S1,.KYPRI		;WAS IT PRIMARY
	MOVX	T1,ST.PRI		;SET PRIMARY
	CAIN	S1,.KYSEC		;WAS IT SECONDARY
	MOVX	T1,ST.SEC		;SET SECONDARY
	JUMPE	T1,.RETF		;NONE..ERROR..RETURN
	MOVEM	T1,ARG.DA(P3)		;SAVE THE VALUE
	PJRST	SETFIN			;FINISH THE COMMAND


SETSON:
SETNSN:	MOVE	S1,P1			;GET THE FUNCTION CODE
	MOVEI	S2,1			;GET THE BLOCK SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH AND SEND COMMAND

SETCIR:					;Circuit-ID
SETDAT:					;IBM logon data
SETLOM:					;IBM logon mode
SETPLU:					;IBM Application
	$CALL	P$TEXT
	$RETIF
	JRST	SETCOM			;Join common code
SETCHS:
	$CALL	P$IFIL
	$RETIF
SETCOM:	STORE	P1,ARG.HD(S1),AR.TYP	;Save correct type in header
	$CALL	MOVARG			;Build text argument and update counts
	PJRST	CMDEND			;Finish and send command

	>;END FTDN60
SUBTTL	SETDSK	Process SET DISK command (TOPS20)

TOPS20 <
SETDSK:	MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVX	S1,.ODSDK		;SET DISK COMMAND FOR -20
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN HEADER
	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	CAIE	S1,.KYCHN		;WAS IT A CHANNEL
	$RETF				;NO..RETURN
	$CALL	P$NUM			;GET THE NUMBER
	$RETIF				;NO..ERROR
	MOVEM	S1,ARG.DA(P3)		;SAVE CHANNEL NUMBER
	MOVEM	S1,G$ARG1		;SAVE NUMBER FOR POSSIBLE ERROR
	SKIPGE	S1			;VALID CHANNEL NUMBER
	PJRST	E$ICN			;INVALID CHANNEL NUMBER

	$CALL	P$KEYW			;Get next item
	$RETIF				;Need something else at least
	CAIE	S1,.KYCON		;Controller?
	JRST	[SETOM ARG.DA+1(P3)	;No, set no controller
		JRST SETDS1]		;Go and make sure it is drive
	$CALL	P$NUM			;Get controller number
	$RETIF				;Where is it???
	MOVEM	S1,ARG.DA+1(P3)		;Save controller number

	$CALL	P$KEYW			;GET NEXT ITEM
	$RETIF				;BETTER BE DRIVE NUMBER
SETDS1:	CAIE	S1,.KYDRV		;IS IT?
	$RETF				;NO..RETURN FALSE
	$CALL	P$NUM			;GET DRIVE NUMBER
	$RETIF				;NO..ERROR..RETURN
	MOVEM	S1,ARG.DA+2(P3)		;SAVE THE DRIVE NUMBER IN BLOCK
	MOVEM	S1,G$ARG1		;SAVE NUMBER IN CASE OF ERROR
	SKIPGE	S1			;IS IT VALID
	PJRST	E$DDI			;DISK DRIVE INVALID
	MOVX	S1,.DSKDV		;DISK DRIVE BLOCK
	MOVEI	S2,4			;3 WORDS
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	$CALL	SETAVL			;GET SET AVALIABLE FUNCTION
;**;[162]At SETDS1+12 change 1 line  JYCW  7/13/90
	JUMPT	CMDEN0			;[162]Done, send it to NEBULA/QUASAR
	$RET				;RETURN PASSING ERROR UP

>;END TOPS20
SUBTTL SETAVL Process set available/unavailable

SETAVL:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	SETOM	T1			;FLAG FOR CHECKING VALUES
	CAIN	S1,.KYAVA		;AVAILABLE?
	MOVX	T1,.DVAVL		;SET DEVICE AVAILABLE BLOCK
	CAIN	S1,.KYUAV		;UNAVAILABLE?
	MOVX	T1,.DVUAV		;SET DEVICE UNAVAILABLE
	SKIPGE	T1			;IS ONE SET
	$RETF				;NO..ERROR..RETURN
	MOVE	S1,T1			;BLOCK TYPE IN 1
	MOVEI	S2,1			;BLOCK SIZE OF 1
	$CALL	ARGRTN			;SAVE THE BLOCK
;**;[162]At SETAVL+12 replace 18 lines with 8  JYCW 7/13/90
	$CALL	P$SWIT			;[162]Check for a switch
	JUMPF	SETAV0			;[162]None, check for un/av for reason
	$CALL	CHCLUN			;[162]Check if a /CLUSTER-NODE switch
	$RETIF				;[162]Illegally formatted message

SETAV0:	CAIN	T1,.DVUAV		;[162]UNAVAILABLE??
	$CALL	PREASN			;[162]Yes, process the reason
	$RETT				;[162]PASS THE RETURN BACK
SUBTTL	SETTAP	Process SET TAPE command (TOPS20)

SETTAP:	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB
	$RETIF
	MOVX	S1,.ODSTP		;SET TAPE COMMAND FOR -20
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN HEADER
	$CALL	P$DEV			;GET DEVICE BLOCK
	$RETIF				;RETURN FALSE
	DMOVE	T1,S1			;SAVE THE ARGUMENTS
	$CALL	GETDES			;GET DEVICE DESIGNATOR
;**;[157]At SETTAP:+9L change 1 line  JCR  1/31/90
	JUMPF	E$ITD			;[157]Quit on an illegal tape name
	TXNN	S2,DV%MTA		;TAPE DRIVE ???
	PJRST	E$ITD			;INVALID TAPE DRIVE
	DMOVE	S1,T1			;RESTORE S1 AND S2
	MOVX	T1,.TAPDV		;TAPE DEVICE BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE
	PUSHJ	P,MOVARG		;MOVE THE BLOCK AND DATA
	$CALL	SETAVL			;SETUP AVAILABLE,UNAVAILABLE BLOCK
;**;[162]At SETTAP+18 change 1 line  JYCW  7/13/90
	JUMPT	CMDEN0			;[162]Done, send it to NEBULA/QUASAR
	PJRST	SETINI			;TRY INITIALIZE
SUBTTL	PSTAPE	Process tape drive argument

;THIS ROUTINE WILL CHECK FOR A DEVICE AND A TAPE DRIVE AND
;SAVE A .TAPDV BLOCK IN THE MESSAGE

PSTAPE:	$CALL	P$DEV			;GET DEVICE BLOCK
	$RETIF				;RETURN FALSE
PSTA.1:	$CALL	GETTAP			;GET A TAPE DEVICE
	$RETIF				;NO..ERROR..RETURN
	MOVX	T1,.TAPDV		;TAPE DEVICE BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE
	PJRST	MOVARG			;MOVE THE BLOCK AND RETURN


SUBTTL	PSTRUC	Process structure argument

;THIS ROUTINE WILL SAVE A STRUCTURE BLOCK IN THE MESSAGE

PSTRUC:	$CALL	P$DEV			;GET THE DEVICE
	$RETIF				;ERROR..RETURN
PSTRRE:	MOVEI	T1,.STRDV		;[130]STRUCTURE TYPE
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE IN BLOCK
	PJRST	MOVARG			;MOVE THE BLOCK AND RETURN

SUBTTL	PVOLID	Process volume-id argument

;THIS ROUTINE WILL BUILD A VOLUME ID BLOCK

PVOLID:	$CALL	P$QSTR			;CHECK FOR QUOTED STRING
	JUMPT	PVOL.1			;YES..PROCESS IT
	$CALL	P$FLD			;CHECK FOR FIELD
	$RETIF				;ERROR..RETURN
PVOL.1:	MOVX	T1,.VOLID		;VOLUME ID
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE
	PJRST	MOVARG			;MOVE THE BLOCK AND RETURN



SUBTTL	PSDEVI	Process a device argument


PSDEVI:	$CALL	P$DEV			;GET DEVICE BLOCK
	$RETIF				;RETURN FALSE
	DMOVE	T1,S1			;SAVE THE ARGUMENTS
	$CALL	GETDES			;GET THE DEVICE DESIGNATOR
	JUMPF	E$IDS			;NO..ERROR..RETURN
	DMOVE	S1,T1			;RESTORE THE ARGUMENTS
	MOVX	T1,.CMDEV		;TAPE DEVICE BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE
	PJRST	MOVARG			;MOVE THE BLOCK AND RETURN
SUBTTL	SETINI	Process SET TAPE INITIALIZE command

;THIS COMMAND WILL BUILD A MESSAGE FOR THE TAPE PROCESSOR
;CONTAINING THE NECESSAY INFO FOR INITIALIZING TAPES

SETINI:	CAIE	S1,.KYINI		;WAS IT INITIALIZE
	$RETF				;NO..RETURN FALSE
	MOVEI	S1,.DVINI		;DEVICE INITIALIZE
	MOVEI	S2,1			;GET THE TYPE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
SETI.1:	$CALL	P$SWITCH		;GET A SWITCH
	JUMPF	CMDEND			;END THE COMMAND
	MOVEI	S2,SETIDP		;ADDRESS OF THE TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;PASS ERROR UP
SETI.3:	HLRZ	P1,(S2)			;GET BLOCK TYPE
	HRRZ	S2,(S2)			;GET ROUTINE ADDRESS
	JRST	(S2)			;PROCESS ROUTINE

SETIDP:	$STAB
TOPS10<	.KYCNC,,[0,,SETABO]		;/ABORT    >
	.SWDEN,,[.SIDEN,,SETDEN]	;/DENSITY
	.SWLBT,,[.SILBT,,SETLBT]	;/LABEL-TYPE
	.SWOVR,,[.SIOVR,,SETOVR]	;/OVERIDE-EXPIRATION
	.SWOWN,,[.SIOWN,,SETOWN]	;/OWNER
	.SWPRO,,[.SIPRO,,SETPRO]	;/PROTECTION
	.SWTDP,,[0,,SETTDP]		;/TAPE-DISPOSITION
	.SWCNT,,[.SICTR,,SETCNT]	;/COUNT
	.SWINC,,[.SIINC,,SETINC]	;/SET INCREMENT
	.SWSVI,,[.SISVI,,SETSVI]	;/STARTING-VOLUME-ID
	.SWVID,,[.VOLID,,SETVID]	;/VOLUME-ID
;**;[157]At SETIDP:+11L add 1 line  JCR  1/31/90
	.SWCLN,,[.SWCLN,,CMDEN]		;[157]/CLUSTER-NODE
	$ETAB
SUBTTL	SETDEN	Process /DENSITY switch



SETDEN:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;BAD COMMAND
	MOVEI	S2,DENTAB		;DENSITY TABLE
SETD.1:	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;NO MATCH..ELSE VALUE IN S2
	MOVEM	S2,ARG.DA(P3)		;SAVE THE DATA
SETD.2:	MOVE	S1,P1			;GET ARGUMENT TYPE
	MOVX	S2,ARG.SZ		;GET THE SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	JRST	SETI.1			;GET NEXT FIELD

DENTAB:	$STAB
	.KY160,,.TFD16			;1600
	.KY625,,.TFD62			;6250
	.KY800,,.TFD80			;800
	.KY556,,.TFD55			;556
	.KY200,,.TFD20			;200
	$ETAB


SUBTTL	SETLBT	Process /LABEL switch

SETLBT:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;BAD COMMAND
	MOVEI	S2,LBTTAB		;LABEL TYPE TABLE
	JRST	SETD.1			;PROCESS ARGUMENT

LBTTAB:	$STAB
	.KYANS,,%TFANS			;ANSI LABELS
	.KYEBC,,%TFEBC			;EBCDIC 
TOPS20<	.KYT20,,%TFT20>			;TOPS-20 LABELS
	.KYUNL,,%TFUNL			;UNLABELED TAPE
	$ETAB


SUBTTL	SETOVR	Process /OVERIDE switch


SETOVR:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;BAD COMMAND
	MOVEI	S2,OVRDSP		;OVERIDE TABLE
SETOV1:	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;PASS ERROR UP
	MOVE	S1,S2			;FUNCTION CODE
	MOVEI	S2,1			;ARGUMENT TYPE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	JRST	SETI.1			;GET THE NEXT ONE

OVRDSP:	$STAB
	.KYYES,,.SIOVR			;OVERIDE EXPIRATION
	.KYNO,,.SINOV			;NO OVERIDE
	$ETAB
SUBTTL	SETOWN	Process /OWNER switch

SETOWN:	$CALL	P$USER			;GET THE USER FIELD
	$RETIF				;ERROR..RETURN
;**;At SETOWN:+2L replace 2 lines with 8 lines  JCR  1/31/90
	MOVE	S2,S1			;[157]Place user number where expected
	HRROI	S1,ARG.DA(P3)		;[157]Where to place the user name
	DIRST%				;[157]Map user number to user name
	 ERJMP	.RETF			;[157]Quit on an error
	MOVE	S1,P1			;[157]Get the argument type
	MOVEI	S2,EQNMSZ		;[157]Pick up the block size
	$CALL	ARGRTN			;[157]Build the argument header
	JRST	SETI.1			;[157]Pick up the next field

SUBTTL	SETPRO	Process /PROTECTION switch
SUBTTL	SETCNT	Process /COUNT switch
SUBTTL	SETINC	Process /INCREMENT switch
SUBTTL	SETSVI	Process /START switch
SETCNT:
SETINC:
SETSVI:
SETPRO:	$CALL	P$NUM			;GET THE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA(P3)		;SAVE THE DATA
	JRST	SETD.2			;FINISH BLOCK AND RETURN


SUBTTL	SETTDP	Process /TAPE-DISPOSITION switch

SETTDP:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;BAD COMMAND
	MOVEI	S2,TDPDSP		;TAPE DISPOSITION TABLE
	JRST	SETOV1			;FINISH IT OFF

TDPDSP:	$STAB
	.KYHLD,,.SIHLD			;HOLD TAPE
	.KYUNL,,.SIUNL			;UNLOAD THE TAPE
	$ETAB

TOPS10<
SETABO:	MOVX	S1,.SIABO		;GET /ABORT BLOCK
	MOVEI	S2,1			;GET BLOCK LENGTH OF 1
	PUSHJ	P,ARGRTN		;SAVE THE BLOCK
	JRST	CMDEND			;FINISH AND SEND COMMAND OFF
> ;END TOPS10 CONDITIONAL
SUBTTL	SETVID	Process /VOLUME-ID switch


SETVID:	$CALL	PVOLID			;PROCESS VOLUME-ID
	JUMPT	SETI.1			;O.K.. GET NEXT BLOCK
	$RET				;PASS ERROR UP
	
SUBTTL	TABSRC	Table search routine

;THIS ROUTINE WILL SEARCH A TABLE FOR A SPECIFIED VALUE AND
;RETURN THE ASSOCIATED INFO
;THE TABLE ENTRIES SHOULD HAVE CODE IN LEFT HALF AND DATA IN RIGHT HALF
;AND USE $STAB TO START THE TABLE AND $ETAB TO END IT


;CALL	S1/	ITEM TO LOOK FOR 
;	S2/	ADDRESS OF TABLE
;
;
;RETURN	S1/	ITEM TO LOOK FOR
;	S2/	ITEM FOUND IN TABLE


;WILL USE T1 AND T2 FOR SCRATCH

TABSRC:: HLLZ	T1,(S2)			;GET THE NUMBER OF ENTRIES
	MOVN	T1,T1			;MAKE IT NEGATIVE
	HRRI	T1,1(S2)		;ADDRESS OF THE TABLE
TABS.1:	HLRZ	T2,(T1)			;GET THE ENTRY
	CAMN	S1,T2			;MATCH?
	JRST	TABS.2			;YES..
	AOBJN	T1,TABS.1		;TRY NEXT ONE
	$RETF				;ERROR..RETURN
TABS.2:	HRRZ	S2,(T1)			;GET THE DATA
	$RETT				;RETURN TRUE
SUBTTL	GETDES	Get device designator word

;THIS ROUTINE WILL RETURN THE DEVICE DESIGNATOR WORD FOR
;THE DEVICE BLOCK PASSED
;
;RETURN	S2/	DEVICE DESIGNATOR INFO

TOPS20 <
GETDES:	HRROI	S1,ARG.DA(S1)		;GET STRING ADDRESS
	HRRZM	S1,G$ARG1		;SAVE THE POINTER
	STDEV				;GET DESIGNATOR
	  $RETF				;RETURN FALSE
	TRNE	S2,400000		;CHECK NOT MT DEVICE
	  PJRST	E$ITD			;ERROR CODE
	HLRZS	S2			;CLEAR RIGHT HALF AND PLACE IN RIGHT
	SUBI	S2,.DVDES		;GET TO DEVICE TYPE
	$RETT				;RETURN DESIGNATOR IN S2
>;END TOPS20

TOPS10 <
GETDES:	HRROI	S1,ARG.DA(S1)		;GET STRING ADDRESS
	HRRZM	S1,G$ARG1		;SAVE STRING POINTER
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	DEVCHR	S2,			;DO THE DEVCHR
	SKIPN	S2			;ANY BITS
	$RETF				;RETURN FALSE
	$RETT				;RETURN TRUE
>;END TOPS10
SUBTTL	GETTAP	Get a tape device

;THIS ROUTINE WILL CHECK FOR A VALID TAPE DEVICE AND RETURN FALSE
;IF DEVICE IS NOT A TAPE DRIVE
;OTHERWISE
;	S1/	ADDRESS OF BLOCK
;	S2/	LENGTH OF BLOCK

GETTAP:
TOPS10	<$RETT>				;NOT NEEDED ON THE -10
TOPS20 <
	DMOVE	T1,S1			;SAVE THE ARGUMENTS
	$CALL	GETDES			;GET THE DESIGNATOR
	JUMPF	E$ITD			;ERROR ..RETURN
	CAIE	S2,.DVMTA		;IS IT MTA
	JRST	GETT.1			;SETUP ERROR RETURN
	DMOVE	S1,T1			;RESTORE S1 AND S2 FROM P$DEV RETURN
	$RETT				;RETURN TRUE
GETT.1:	DMOVE	S1,T1			;RESTORE DEVICE DATA
	$RETF				;RETURN FALSE
>;END TOPS20
SUBTTL	SETSTR	Process SET STRUCTURE command (TOPS20)

TOPS20 <
SETSTR:	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVX	S1,.ODSST		;SET STRUCTURE COMMAND FOR -20
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN HEADER
	$CALL	PSTRUC			;PROCESS A STRUCTURE BLOCK
	$RETIF				;ERROR..RETURN
	$CALL	P$KEYW			;GET THE OPTIONS
	$RETIF				;ERROR..RETURN
	MOVEI	S2,STRDSP		;STRUCTURE DISPATCH TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;ERROR..RETURN
	MOVEM	S2,ARG.DA(P3)		;SAVE VALUE IN BLOCK
	MOVX	S1,.STCHR		;STRUCTURE CHARACTERISTICS
	MOVEI	S2,2			;SIZE OF BLOCK
	$CALL	ARGRTN			;BUILD BLOCK
	PJRST	CMDEND			;CHECK FOR END AND SEND TO QUASAR

STRDSP:	$STAB
	.KYACK,,S.ACKN			;ACKNOWLEDGED
	.KYAVA,,S.AVAL			;AVAILABLE
	.KYDOM,,S.DOMS			;DOMESTIC
	.KYEXL,,S.EXCL			;Exclusive
	.KYFOR,,S.FORN			;FOREIGN
	.KYREG,,S.REGU			;REGULATED
	.KYSHR,,S.SHAR			;Shared
	.KYUAV,,S.UAVL			;UNAVAILABLE
	.KYURG,,S.UREG			;UNREGULATED
	.KYIGN,,S.IGNO			;IGNORE
	.KYDUM,,S.DUMP			;[132]Dumpable
	.KYNDM,,S.NODP			;[132]Nondumpable
	$ETAB
>;END TOPS20
SUBTTL	SETPOR	Process SET PORt command

;  Initially this command only supports CI as the keyword.  Eventually
;  however, it should also support NI and a channel number to be set
;  on/offline.

SETPOR:	MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB			;Check privs.
	$RETIF				;Not enough
	$CALL	P$KEYW			;Get a keyword
	$RETIF				;Error -- return
	CAIN	S1,.KYNI		;Set PORT NI?
	JRST	SETNI			;Yes, process it
	CAIE	S1,.KYCI		;No, SET PORT CI?
	$RETF				;No, error
	MOVX	S1,.ODSPO		;Set port
	STORE	S1,.MSTYP(MO),MS.TYP	;Save the type in the header	
	$CALL	P$KEYW			;Get a keyword
	$RETIF				;Error -- return
	SETO	S2,			;Set flag word
	TLZ	S2,-1			;Clear flag bits
	TXO	S2,DV.CI		;Set it as CI
	CAIN	S1,.KYUAV		;Unavailable?
	TXOA	S2,DV.UAV		;Yes, set it as unavailable
	SKIPA
	JRST	SETP.1			;Go to cleanup
	CAIE	S1,.KYAVA		;Available?
	$RETF				;No, bad message
	TXO	S2,DV.AVA		;Yes, set it as available
SETP.1:	MOVEM	S2,ARG.DA(P3)		;Save the argument
	MOVEI	S1,.PORDV		;Argument type
	MOVEI	S2,ARG.SZ		;Standard size
	$CALL	ARGRTN			;Set up the argument block
	PJRST	CMDEND			;Go clean-up

SETNI:	$CALL	.SAVE2			;Save P1
	$CALL	OPRMS##			;Setup OPR message
	$CALL	P$KEYW			;Get a keyword
	$RETIF				;Error, invalid message
	MOVE	P1,S1			;Save S1 for later
	$CALL	P$CFM			;Check for confirm
	$RETIF				;Error, invalid message
	MOVE	S1,[8,,.EIRCI]		;Going to check status of the NI
	MOVEI	S2,0			;Zero status word
	PUSHJ	P,SETBLK		;Set up the block
	NI%				;Pick up status of the NI
	ERJMPR	NIERR			;Quit if error
	MOVE	P2,NIJBLK##+.EISTA	;Save the status for later
	CAIN	P1,.KYUAV		;UNAVAILABLE?
	JRST	NIUNA			;Yes
	CAIN	P1,.KYAVA		;AVAILABLE?
	JRST	NIAVA			;Yes
	$RETF				;No, bad message
NIUNA:	TXNN	P2,EI%RUN		;Is the NI available?
	JRST	[ $TEXT(WTORTN##,<          -- Problem Setting Port --
		NI Port already set unavailable >)
		  JRST NIFIN ]			;And finish
	MOVE	S1,[4,,.EISCS]		;Set channel state
	MOVEI	S2,.EISOF		;To unavailable
	PUSHJ	P,SETBLK		;Set up the NI argument block
	NI%				;Do it
	ERJMPR	NIERR			;Notify if an error
	$TEXT(WTORTN##,<          -- NI PORT SET UNAVAILABLE -->)
	JRST	NIFIN			;Finish up the message
NIAVA:	TXNE	P2,EI%RUN		;Is the NI already set available?
	JRST	[ $TEXT(WTORTN##,<          -- Problem Setting Port --
		 NI Port already set available>)
		  JRST NIFIN ]			;And finish
	MOVE	S1,[4,,.EISCS]		;Set channel state
	MOVEI	S2,.EISRR		;To running
	PUSHJ	P,SETBLK		;Set up the argument block
	NI%				;Do it
	ERJMPR	NIERR			;Notify if an error
	$TEXT(WTORTN##,<        -- NI PORT SET AVAILABLE -->)
	JRST	NIFIN			;Finish up the message
NIERR:	$TEXT(WTORTN##,<        -- NI% JSYS Failure - Error: ^E/S1/ -->)
NIFIN:	$CALL	MSGFIN##		;Finish the message
	$CALL	L$SHWM##		;Log the message
	MOVE	S1,G$SND##		;Get the Sender's PID
	MOVEI	S2,PAGSIZ		;Page message size
	$CALL	SPDOPR##		;Send to OPR
	$RETT				;And return

SETBLK:	MOVEM	S1,NIJBLK##+.EILEN	;Set up the first word of the block
	SETZM	NIJBLK##+.EIFLG		;Zero the flags
	SETZM	NIJBLK##+.EICHN		;Zero the channel number
	SETZM	NIJBLK##+.EIPSI		;Zero the PSI channels
	STORE	S2,NIJBLK##+.EISTA,EI%SST ;Store the channel substate
	MOVEI	S1,NIJBLK##		;Pick up the block address
	$RET
SUBTTL	Q$SHCF	Process SHOW CONFIGURATION command

;THIS ROUTINE WILL SEND A SHOW CONFIGURATION MESSAGE TO QUASAR

Q$SHCF::SETOM	ARG.DA+OBJ.UN(P3)	;DEFAULT FOR ALL UNITS
	$CALL	P$CFM			;CHECK FOR CONFIRM
	JUMPT	SHCF0			;YES, NO GOOD
	$CALL	P$KEYW			;GET A KEYWORD..(TYPE)
	JUMPF	SHCF0			;NO KEYWORD, NO GOOD
	CAIN	S1,.KYDSK		;WAS IT A DISK?
	PJRST	SHWCFG			;PROCESS THE DISKS
SHCF0:	$RETF				;BAD COMMAND
SUBTTL	Q$SHWS	Process SHOW STATUS command

;THIS ROUTINE WILL SEND A SHOW STATUS MESSAGE  TO QUASAR

Q$SHWS::MOVEI	S1,.OMSHS		;[130]GET THE SHOW STATUS CODE
	SKIPA				;[130]PROCESS THE DISKS

SUBTTL	Q$SHWP	Process SHOW PARAMETERS command

;THIS ROUTINE WILL SEND A SHOW PARAMETERS MESSAGE TO QUASAR

Q$SHWP::MOVEI	S1,.OMSHP		;[130]GET SHOW PARAMTERS CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE TIE TYPE CODE
SUBTTL	PROSHW	Process SHOW STATUS and SHOW PARAMETERS


;COMMON CODE FOR SHOW STATUS AND SHOW PARAMETERS

PROSHW:	$CALL	CHKRMT			;See if this is a remote OPR
	SETOM	ARG.DA+OBJ.TY(P3)	;DEFAULT TO ALL TYPES
	SETOM	ARG.DA+OBJ.UN(P3)	;DEFAULT FOR ALL UNITS
	SETOM	ARG.DA+OBJ.ND(P3)	;DEFAULT FOR ALL NODES
	CAME	S1,G$HOST		;Did CHKRMT find the node to be host?
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;Save the node info
	$CALL	P$CFM			;CHECK FOR CONFIRM
	JUMPT	PROS.6			;SAVE BLOCK AND RETURN
	$CALL	P$KEYW			;GET A KEYWORD..(TYPE)
	JUMPF	PROS.2			;TRY FOR A SWITCH
	CAIG	S1,.OTMAX		;VALID OBJECT TYPE
	JRST	PROS.1			;YES..GOOD OBJECT
	CAIN	S1,.KYDSK		;WAS IT A DISK?
	PJRST	SHWDSK			;PROCESS THE DISKS
	CAIN	S1,.KYSTR		;WAS IT A STRUCTURE
	PJRST	SHWSTR			;PROCESS THE STRUCTURES
	CAIN	S1,.KYTAP		;ALL TAPES?
	PJRST	SHWTAP			;PROCESS THE TAPES
	CAIN	S1,.KYNOD		;CHECK FOR NETWORK NODE
	PJRST	SHWNOD			;SHOW NODE COMMAND
	$RETF				;BAD COMMAND

PROS.1:	MOVEM	S1,ARG.DA+OBJ.TY(P3)	;SAVE THE OBJECT TYPE
	MOVE	P1,S1			;[126]SAVE FOR FINOBJ LPT PROCESSING
	$CALL	P$CFM			;END OF COMMAND?
	JUMPT	PROS.6			;FINISH OFF BLOCK
PROS.2:	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	PROS.4			;NO..TRY OBJECT BLOCK REMAINDER
;**;[151]At PROS.2:+2L replace 11 lines  11 lines  JCR  12/31/89
	CAIN	S1,.SWNOD		;[151]A /NODE switch?
	JRST	PROS.3			;[151]Yes, go process it
	PUSH	P,S1			;[151]Preserve the switch type
	$CALL	ADDOBJ			;[151]Add the object block to the msg
	POP	P,S1			;[151]Restore the switch type
	CAIE	S1,.SWSHT		;[151]A /SHORT switch?
	JRST	CMDEN			;[151]No, a /CLUSTER-NODE switch
	$CALL	PROSHT			;[151]Process the /SHORT switch
	$RETIF				;[151]Return on an error
	PJRST	CMDEND			;[151]Finish the command
PROS.3:	$CALL	P$NODE			;[151]Get the node
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;SAVE NODE IN BLOCK
;**;[147]At PROS.3:+3L replace 3 lines with 4 lines  JCR  12/23/89
	SETOM	G$NOFG			;[147]Indicate node switch present
	$CALL	ADDOBJ			;[147]Finish building the object block
	$CALL	P$SWIT			;[147]Check for a switch
	JUMPF	CMDEN1			;[147]If none, then send the message
;**;[151]At PROS.3:+8L replace 19 lines with 12 lines  JCR  12/31/89
	CAIE	S1,.SWSHT		;[151]A /SHORT switch?
	PJRST	CMDEN			;[151]No, /CLUSTER-NODE switch
	MOVX	S1,LS.FST		;[151]Get the flags
	IORM	S1,.OFLAG(MO)		;[151]Save in the flag word
	PJRST	CMDEND			;[151]Finish the command
PROS.4:	$CALL	FINOBJ			;[151]Finish object block
	$RETIF				;[151]Quit on an error
	$CALL	P$SWIT			;[151]Switch there?
	JUMPF	CMDEN1			;[151]No, check for the confirm block
	$CALL	PROSHT			;[151]Process /SHORT if there
	JUMPF	CMDEN			;[151]Process the /CLUSTER-NODE switch
	PJRST	CMDEND			;[151]Finish the message
PROS.6:	$CALL	ADDOBJ			;[130]ADD THE OBJECT BLOCK
	PJRST	SNDQSR			;SEND THE COMMAND

PROSHT:	CAIE	S1,.SWSHT		;WAS IT SHORT
	$RETF				;NO..RETURN FALSE
	MOVX	S1,LS.FST		;GET THE FLAGS
	IORM	S1,.OFLAG(MO)		;SAVE IN FLAG WORD
	$RETT				;RETURN TRUE

ADDOBJ:	MOVX	S1,.OROBJ		;[130]BLOCK TYPE
	MOVX	S2,.OBJLN		;[130]BLOCK SIZE
	$CALL	ARGRTN			;[130]SAVE THE BLOCK
	ANDI	P3,777			;[130]GET LENGTH OF MESSAGE
	STORE	P3,.MSTYP(MO),MS.CNT	;[130]SAVE THE COUNT
	$RET				;[130]RETURN TO THE CALLER

Q$SHWR:: MOVX	S1,.OMSHR		;SHOW ROUTE TABLES
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
;**;[151]At Q$SHWR:+1L replace 10 lines with 1 line  JCR  12/31/89
	PJRST	CMDEND			;[151]Finish the command
SUBTTL	SHWNOD	Process node for SHOW STATUS/PARAMETERS command

;THIS ROUTINE WILL BUILD A NODE BLOCK FOR QUASAR TO IDENTIFY THE
;NODE TO BE EXAMINED.
;IF NO NODENAME IS SPECIFIED THE DEFAULT -1 WILL BE USED.

SHWNOD:	MOVX	S1,.OMSSN		;SHOW STATUS NODE
	LOAD	S2,.MSTYP(MO),MS.TYP	;GET THE TYPE BLOCK
	CAIE	S2,.OMSHS		;WAS IT SHOW STATUS
	MOVX	S1,.OMSPN		;NO..SHOW PARAMETERS NODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN BLOCK
	$CALL	P$NODE			;GET THE NODE DATA
	SKIPT				;O.K.. CONTINUE ON
	SETOM	S1			;ASSUME ALL NODES
	$CALL	SAVNOD			;SAVE THE VALUE
;**;[151]At SHWNOD:+9L change 1 line  JCR  12/31/89
	PJRST	CMDEND			;[151]Finish off the command
SUBTTL	SHWTAP	Process SHOW STATUS TAPE command

;THIS ROUTINE WILL SHOW THE STATUS OF THE TAPE DRIVE

SHWTAP:	MOVEI	S1,.ODSHT		;SHOW STATUS COMMAND
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	$CALL	P$DEV			;WAS IT A DEVICE
	JUMPT	SHWT.1			;YES.. BUILD DEVICE BLOCK
	MOVX	S1,.ALTAP
	MOVEI	S2,1			;BLOCK SIZE
	$CALL	ARGRTN			;SAVE THE BLOCK
	JRST	SHWT.2			;FINISH OFF THE COMMAND
SHWT.1:	$CALL	PSTA.1			;BUILD THE BLOCK
	$RETIF				;FAIL..RETURN
SHWT.2:	$CALL	P$SWIT			;IS THERE A SWITCH?
;**;[151]At SHWT.2:+1L replace 14 lines with 9 lines  JCR  12/31/89
	JUMPF	CMDEN1			;[151]No, finish off the command
	CAIN	S1,.SWCLN		;[151]A /CLUSTER-NODE switch?
	PJRST	CMDEN			;[151]Yes, go process it
	MOVEI	S2,TAPSWI		;[151]Check for a tape switch
	$CALL	TABSRC			;[151]Search the table
	$RETIF				;[151]Return on an error
	MOVE	S2,(S2)			;[151]Get the data
	IORM	S2,.OFLAG(MO)		;[151]Save the flags
	PJRST	CMDEND			;[151]Finish off the command

SHOWTB:	$CALL	TABSRC			;[130]SEARCH THE TABLE
	$RETIF				;[130]ERROR..RETURN
	MOVE	S2,(S2)			;[130]GET THE DATA
	IORM	S2,.OFLAG(MO)		;[130]SAVE THE FLAGS
	$RETT				;[130]RETURN TO THE CALLER

TAPSWI:	$STAB
	.SWALL,,[ST.ALL]		;ALL
	.SWCHR,,[ST.CHR]		;CHARACTERISTICS
	.SWFRE,,[ST.AVA]		;FREE(AVAILABLE)
	$ETAB
SUBTTL	SHWSTR	Process SHOW STATUS STRUCTURES command

;THIS COMMAND WILL SHOW STATUS OF STRUCTURES 

SHWSTR:	MOVEI	S1,.ODSTR		;GET MESSAGE TYPE
	PJRST	SHWD.0			;Join some common code in show disk
SUBTTL	SHWCFG	Process SHOW CONFIGURATION DISK-DRIVE command

;THIS COMMAND WILL SHOW CONFIGURATION OF DISK DRIVES 

SHWCFG:	MOVEI	S1,.ODSCD		;GET MESSAGE TYPE
	PJRST	SHWD.0			;Join some common code in show disk
SUBTTL	SHWDSK	Process SHOW STATUS DISK command

;THIS ROUTINE WILL DO SHOW STATUS OF DISK DRIVES

SHWDSK:	MOVEI	S1,.ODSHD		;SHOW STATUS COMMAND

SHWD.0:	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	$CALL	P$DEV			;CHECK FOR A DEVICE BLOCK
	JUMPT	SHWD.1			;CHECK OUT THE STRUCTURE
	MOVX	S1,.ALDSK		;FOR ALL DISK DRIVES
	MOVEI	S2,1			;ONE WORD
	$CALL	ARGRTN			;SAVE THE BLOCK
	$CALL	P$SWIT			;CHECK FOR A SWITCH
;**;[151]At SHWD.0:+7L replace 16 lines with 9 lines  JCR  12/31/89
	JUMPF	CMDEN1			;[151]No switch check if end
	CAIN	S1,.SWCLN		;[151]/CLUSTER-NODE switch?
	PJRST	CMDEN			;[151]Yes, go process
	MOVEI	S2,DSKDSP		;[151]Get dsk table address
	$CALL	SHOWTB			;[151]Do the table lookup
	$RETIF				;[151]Return on an error
	PJRST	CMDEND			;[151]Finish off the message
SHWD.1:	$CALL	PSTRRE			;[151]Check for a structure
	PJRST	CMDEND			;[151]Finish off the command

DSKDSP:	$STAB
	.SWALL,,[ST.ALL]		;ALL
	.SWAVA,,[ST.AVA]		;AVAILABLE
	.SWMNT,,[ST.MNT]		;MOUNTED
	$ETAB
SUBTTL	Q$SHWQ	Process SHOW QUEUES command

;THIS ROUTINE WILL FORMAT MESSAGE TO QUASAR FOR SHOW QUEUES

Q$SHWQ:: STKVAR	<NFLAG>			;Save a flag to indicate a node name
	MOVX	S1,.OMSHQ		;SHOW THE QUEUES
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE MESSAGE TYPE
	$CALL	P$KEYW			;GET A KEYWORD
	JUMPF	SHWQ.1			;No keyword -- assume all
	MOVEI	S2,QUETYP		;Get the queue type table
	$CALL	TABSRC			;Search the table
	JUMPT	[MOVE	S1,(S2)		;Get the data
		JRST	SHWQ.2]		;Continue at store
	CAIE	S1,.KYALL		;Was all specified?
	PJRST	E$IQS			;Invalid queue specified and return

SHWQ.1:	SETOM	S1			;Set for all

SHWQ.2:	STORE	S1,.OHDRS+ARG.DA(MO)	;Save type of queue
	MOVEI	S1,.LSQUE		;Get argument type
	MOVEI	S2,ARG.SZ		;	and size
	$CALL	ARGRTN			;Setup the argument
	SETZM	NFLAG			;We have no node name so far

;  Loop on switches till confirm

	SETZM	.OFLAG(MO)		;Initialize flag
SHWQ.3:	$CALL	P$CFM			;Check for confirm / C.R.
	JUMPT	SHWQ.8			;Go clean up.

	$CALL	P$SWIT			;Get a switch
	$RETIF				;Since no confirm, no switch is error
;**;[151]At SHWQ.3:+5L change 2 lines  JCR  12/31/89
	CAIN	S1,.SWCLN		;[151]Cluster node switch?
	PJRST	CMDEN			;[151]Yes, go process it
	CAIN	S1,.SWNOD		;Node switch?
	JRST	SHWQ.4			;Yes - go process node name

	CAIN	S1,.SWUSR		;User switch?
	JRST	SHWQ.5			;Yes - go process user name

	SKIPE	.OFLAG(MO)		;ALL or SHORT specified previously?
	$RETF				;Yes - quit bad

	CAIN	S1,.SWALL		;All specified?
	JRST	SHWQ.6			;Yes - go process all

	CAIN	S1,.SWSHT		;Short specified?
	JRST	SHWQ.7			;Yes - go process short

	$RETF				;No legal switch, return bad

;  Continued on next page
;  Continued from previous page

;  Process node name

SHWQ.4:	$CALL	P$NODE			;Check out the node name
	$RETIF				;Quit if bad
	$CALL	SAVNOD			;Save the stuff in the message
	SETOM	NFLAG			;We now have a node name
	JRST	SHWQ.3			;Try for another switch

;  Process user name

SHWQ.5:	$CALL	PUSERS			;Try to process the user name switch
	$RETIF				;Quit if none
	JRST	SHWQ.3			;Try for another switch

;  Process all switch

SHWQ.6:	MOVX	S1,LS.ALL		;Set for all listing
	MOVEM	S1,.OFLAG(MO)		;Remember it
	JRST	SHWQ.3			;Try for another switch

;  Process short switch

SHWQ.7:	MOVX	S1,LS.FST		;Set for fast (short) listing
	MOVEM	S1,.OFLAG(MO)		;Remember it
	JRST	SHWQ.3			;Try for another switch


;  Finish off the command

SHWQ.8:	SKIPN	NFLAG			;Already have a node name?
	$CALL	CHKRMT			;No, do this here
	ANDI	P3,777			;Get the message length
	STORE	P3,.MSTYP(MO),MS.CNT	;Save the count
	$CALL	SNDQSR			;Send the message
	$RETT				;Return true


	DEFINE	X(TYP),<
	.OT'TYP,,[LIQ'TYP] >
QUETYP:	$STAB
	DEVQUE
	$ETAB
SUBTTL	Q$SHWC	Process SHOW CONTROL-FILE command

;THIS ROUTINE DOES THE OLD BATCON EXAMINE FUNCTION FOR
;SHOWING THE OPERATOR LINES IN A BATCH CONTROL-FILE

Q$SHWC:: MOVX	S1,.OMSHC		;SHOW CONTROL-FILE TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE
	$CALL	BLDOBJ			;BUILD AN OBJECT BLOCK
	$RETIF				;ERROR..RETURN
	MOVEI	T1,.OHDRS+ARG.DA(MO)	;POINT TO OBJECT BLOCK
	LOAD	S1,OBJ.UN(T1),OU.HRG	;GET THE HIGH VALUE
	JUMPN	S1,.RETF		;NON-ZERO..ERROR
	LOAD	S1,OBJ.TY(T1)		;GET THE TYPE FIELD
	CAXE	S1,.OTBAT		;BETTER BE BATCH
	$RETF				;RETURN FALSE..ERROR
	$CALL	P$SWIT			;GET A SWITCH
	JUMPF	SHWC.2			;NO..SETUP DEFAULT LINES
	CAIE	S1,.SWLNS		;IS IT LINES
	$RETF				;INVALID COMMAND
	MOVEI	T2,.SHCLN		;YES..SETUP SHOW LINES TYPE
	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;ERROR..RETURN
SHWC.1:	STORE	S1,ARG.DA(P3)		;SAVE NUMBER IN BLOCK
	MOVE	S1,T2			;GET THE ARGUMENT TYPE
	MOVEI	S2,ARG.SZ		;SIZE OF THE BLOCK
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH OFF THE MESSAGE
SHWC.2:	MOVEI	S1,^D10			;DEFAULT TO 10 LINES
	MOVEI	T2,.SHCLN		;SHOW CONTROL FILE LINES
	JRST	SHWC.1			;FINISH OFF BLOCK AND MESSAGE
	SUBTTL	Q$SHCL - SHOW CLUSTER-GALAXY-STATUS-LINK

Q$SHCL::MOVE	S1,[.OHDRS,,.NSCLU]	;[136]PICK UP THE MESSAGE TYPE
	MOVEM	S1,.MSTYP(MO)		;[136]PLACE IN THE MESSAGE
	MOVX	S1,MF.NEB		;[136]PICK UP THE NEBULA BIT
;**;[154]At Q$SHCL:+2L change 1 line  JCR  1/15/90
	MOVEM	S1,.MSFLG(MO)		;[154]Place in the message

	$CALL	P$SWIT			;[136]IS THERE A SWITCH BLOCK?
	JUMPT	SHCL.1			;[136]YES, GO CHECK ITS TYPE
	$CALL	P$CFM			;[136]IS THERE A CARRIAGE RETURN?
	$RETIF				;[136]NO, ILLEGALLY FORMATTED MESSAGE
	PJRST	SNDNEB			;[136]GO SEND THE MESSAGE TO NEBULA

SHCL.1:	$CALL	CHCLUN			;[136]IS IT A CLUSTER-NODE SWITCH?
	JUMPT	SHCL.3			;[136]YES, ADD THE CLUSTER NODE BLOCK
	CAIE	S1,.SWNOD		;[136]IS IT A NODE SWITCH?
	$RETF				;[136]NO, ILLEGALLY FORMATTED MESSAGE
	$CALL	P$NODE			;[136]PICK UP THE NODE NAME
	$RETIF				;[136]RETURN ON AN ERROR
	$CALL	SAVNOD			;[136]BUILD THE NODE BLOCK IN THE MSG

	$CALL	P$SWIT			;[136]IS THERE ANOTHER SWITCH BLOCK?
	JUMPT	SHCL.2			;[136]YES, CHECK FOR CLUSTER-NODE
	SETOM	G$CLUN			;[136]NO, INDICATE SEND TO NEBULA
;**;[151]At SHCL.1:+11L change 1 line  JCR  12/31/89
	PJRST	CMDEN1			;[151]Send the message to NEBULA

SHCL.2:	$CALL	CHCLUN			;[136]IS THIS A CLUSTER-NODE SWITCH?
	$RETIF				;[136]IF NO, THEN INDICATE AN ERROR

SHCL.3:	DMOVE	S1,G$CBLK		;[136]PICK UP THE CLUSTER NODE BLOCK
	DMOVEM	S1,ARG.HD(P3)		;[136]PLACE IN THE MESSAGE
	SKIPE	G$CLUN			;[136]LOCAL NODE NAME SPECIFIED?
	JRST	SHCL.4			;[136]NO, GO SEND THE MESSAGE
	MOVE	S1,G$HOST		;[136]PICK UP THE LOCAL NODE NAME
	MOVEM	S1,ARG.DA(P3)		;[136]PLACE IN THE MESSAGE
	SETOM	G$CLUN			;[136]INDICATE SEND TO NEBULA

SHCL.4:	AOS	.OARGC(MO)		;[136]INCREMENT THE ARGUMENT COUNT
	ADDI	P3,.NDESZ		;[136]INCREMENT THE MESSAGE LENGTH
;**;[151]At SHCL.4:+2L replace 52 lines with 31 lines  JCR  12/31/89
	PJRST	CMDEN1			;[151]Send the message to NEBULA
	SUBTTL	CHCLUN - Modify message for NEBULA

;[151]Routine CHCLUN checks if a switch block is a cluster node switch block.
;[151]If it is, then CHCLUN determines if the message is to be processed
;[151]locally, remotely or both locally and remotely.
;[151]
;[151]Call is:       S1/Switch block type
;[151]		     G$CLUN/0
;[151]Returns true:  The block is a switch block
;[151]	             G$CLUN/0		      The message is to be processed
;[151]                                        locally
;[151]	             G$CLUN/SIXBIT node name  The message is to be forwarded
;[151]	             G$CLUN/-1                The message is to be processed 
;[151]                                        by all nodes in the cluster
;[151]Returns false: The block is not a switch block
;[151]               S1/Switch block type

	INTERN	CHCLUN			;[151]Make it global

CHCLUN::CAIE	S1,.SWCLN 		;[151]Is it a CLUSTER-NODE switch?
	$RETF				;[151]No, indicate so
	$CALL	P$CURR			;[151]Pick up cluster node block adr
	$CALL	P$NEXT			;[151]Point to the next block
	MOVE	S2,PFD.D1(S1)		;[151]Pick up the switch data
	CAMN	S2,G$HOST		;[151]Local node specified?
	$RETT				;[151]Yes, return now
	MOVEM	S2,G$CLUN		;[151]Save the data for the caller
	MOVEM	S2,G$CBLK+1		;[151]And place in the message block
	$RETT				;[151]Return to the caller
	SUBTTL	SNDCLU - Send a cluster message

;SNDCLU determines if a cluster message is to be sent to a particular node
;or to all the nodes in the cluster including the local node.

;**;[146]At SNDCLU:+0L change 1 line
SNDCLU::$CALL	P$CFM			;[146]Check for a confirm block
	$RETIF				;[130]INDICATE AN ERROR IF NO CONFIRM 
SNDCL0:	SETOM	G$FERR			;[130]ASSUME FIRST MESSAGE SENT O.K.
	ANDI	P3,777			;[130]ISOLATE THE MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;[130]STORE THE LENGTH
	MOVE	S1,G$CLUN		;[130]PICK UP DESTINATION FLAG
	CAME	S1,[-1]			;[130]SEND MESSAGE TO ALL THE NODES?
	PJRST	SNDC.2			;[130]NO, SEND MESSAGE TO NEBULA

	$SAVE	<P1>			;[130]SAVE THIS AC
	$CALL	M%GPAG			;[130]PICK UP A SECOND MESSAGE PAGE
	MOVE	P1,S1			;[130]SAVE ITS ADDRESS
	MOVE	S2,P3			;[130]PICK UP THE MESSAGE LENGTH
	ADD	S2,S1			;[130]POINT TO END OF MESSAGE + 1
	HRL	S1,MO			;[130]SOURCE,,DESTINATION
	BLT	S1,-1(S2)		;[130]COPY MESSAGE TO NEW PAGE

	$CALL	SNDQSR			;[130]SEND THE FIRST MESSAGE TO QUASAR
	JUMPT	SNDC.1			;[130]DON'T RELEASE PAGE ON SUCCESS
	$CALL	RELPAG			;[130]RELEASE THE MESSAGE PAGE
	SETZM	G$FERR			;[130]INDICATE FAILURE FOR MSG SEND

SNDC.1:	MOVE	MO,P1			;[130]PLACE MESSAGE ADR WHERE EXPECTED
SNDC.2:	ADDI	P3,.MSTYP(MO)		;[130]POINT TO THE CLUSTER NODE BLOCK
	DMOVE	S1,G$CBLK		;[130]PICK UP THE CLUSTER NODE BLOCK
	DMOVEM	S1,ARG.HD(P3)		;[130]PLACE IN THE MESSAGE
	AOS	.OARGC(MO)		;[130]INCREMENT THE ARGUMENT COUNT
	MOVSI	S1,.NDESZ		;[130]PICK UP SIZE OF CLUSTER NODE BLK
	ADDM	S1,.MSTYP(MO)		;[130]ADD TO THE TOTAL MESSAGE LENGTH
	LOAD	S1,.MSTYP(MO),MS.TYP	;[134]PICK UP THE MESSAGE TYPE
	MOVEI	S2,QRTONB		;[134]PICK UP THE CODE TRANSLATION TBL
	$CALL	TABSRC			;[134]TRANSLATE THE MESSAGE CODE
;**;[144]At SNDC.2:+9L change 1 line JYCW Oct-18-88
	JUMPF	[MOVX	S2,NEB%MS	;[144]GET NEBULA BIT
		 IORM	S1,S2		;[144]set it in the message code
		 JRST	.+1]		;[144]continue
	STORE	S2,.MSTYP(MO),MS.TYP	;[134]PLACE THE CODE IN THE MESSAGE
	MOVX	S1,MF.NEB		;[134]PICK UP THE NEBULA BIT
	CAIN	S2,.NTMTS		;[134]IS THIS A MOUNT MESSAGE?
	MOVX	S1,MF.NEB!MF.WTO	;[134]YES, TURN ON THE WTO EXPECTED BIT
	IORM	S1,.MSFLG(MO)		;[134]INDICATE IN THE MESSAGE
;**;[147]At SNDC.2:+18L replace 1 line with 11 lines  JCR  12/23/89
	SKIPN	G$NOFG			;[147]A node switch specified?
	JRST	SNDC.3			;[147]No, go send the message
	LOAD	S1,ARG.HD+.OHDRS(MO),AR.TYP ;[147]Pick up the block type
	CAIE	S1,.OROBJ		;[147]Is this an object block?
	JRST	SNDC.3			;[147]No, go send the message
	MOVE	S1,ARG.DA+OBJ.TY+.OHDRS(MO) ;[147]Pick up the object type
	CAMN	S1,[-1]			;[147]For all objects?
	JRST	SNDC.3			;[147]Yes, go send the message
	MOVX	S1,.RMLPT		;[147]Pick up /NODE switch specified
	IORM	S1,ARG.DA+OBJ.TY+.OHDRS(MO) ;[147]Indicate in the message type
SNDC.3:	$CALL	SNDNEB			;[147]Send the message to nebula
	JUMPF	.POPJ			;[130]LET COMMAN RELEASE THE PAGE
	SKIPE	G$FERR			;[130]ERROR SENDING THE FIRST MESSAGE?
	$RET				;[130]NO, RETURN TRUE
	MOVEM	MO,G$OUTP		;[130]INDICATE DON'T RELEASE MSG PAGE
	$RETF				;[130]INDICATE AN ERROR OCCURRED
	
SUBTTL	Q$DISM	Process DISMOUNT command (TOPS20)

Q$DISM::
	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	P$KEYW			;GET THE KEYWORD
	$RETIF				;ERROR..RETURN
	CAIE	S1,.KYSTR		;IS IT A STRUCTURE
	JRST	DISM.1			;NO..TRY TAPE
	$CALL	PSTRUC			;PROCESS THE STRUCTURE
	$RETIF				;NOT A STR OR A TAPE, QUIT

	$CALL	P$KEYW			;Look for optional KEYWORD
	JUMPF	CMDEND			;None there, return

	SETZ	S2,			;Clear word to set flags
	CAIN	S1,.KYREM		;Is it for removal?
	MOVX	S2,.DMRMV		;Yes, set the bit
	CAIN	S1,.KYNRM		;Is it for no removal?
	MOVX	S2,.DMNRV		;Yes, set the bit
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAG BITS
	JRST	CMDEND			;Go finish up

DISM.1:	CAIE	S1,.KYTAP		;CHECK FOR A TAPE
	$RETF				;NO..RETURN FALSE
	MOVEI	S1,.ODUNL		;GET THE UNLOAD TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;RESET THE MESSAGE TYPE
	JRST	UNLO.1			;PROCESS THE UNLOAD


SUBTTL	Q$RECO	Process RECOGNIZE command (TOPS10)
SUBTTL	Q$UNLO	Process UNLOAD command

TOPS10 <
Q$RECO::
>;END	TOPS10
Q$UNLO::MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB
	$RETIF
UNLO.1:	$CALL	PSTAPE			;SAVE THE TAPE BLOCK
	JUMPT	CMDEND			;O.K... FINISH OFF COMMAND
	$RET				;PASS THE ERROR BACK
SUBTTL	Q$ESTR	Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION

Q$ESTR::
	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVX	S1,.ODENA		;GET ENABLE CODE
	SKIPE	P1			;CHECK IF ENABLE OR DISABLE
	MOVX	S1,.ODDIS		;GET DISABLE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN MESSAGE
	MOVX	S1,.ASREC		;GET ASR TYPE
	MOVEI	S2,1			;GET THE LENGTH
	$CALL	ARGRTN			;ADD ARGUMENT TO MESSAGE
	$CALL	P$KEYW			;GET A KEYWORD
	JUMPF	CMDEND			;NO...CHECK END AND SEND
	CAIN	S1,.KYSTR		;WAS IT FOR ALL STRUCTURES
	JRST	ESTR.1			;YES SETUP FOR ALL STRUCTURES
	$CALL	PSTRUC			;PROCESS A STRUCTURE BLOCK
	JUMPT	CMDEND			;O.K.. FINISH AND SEND
	$RET				;ELSE RETURN WITH CURRENT FALSE STATE
ESTR.1:	MOVX	S1,.ALSTR		;ALL STRUCTURES
	MOVEI	S2,1			;LENGTH OF BLOCK
	$CALL	ARGRTN			;BUILD THE ARGUMENT
	PJRST	CMDEND			;FINISH OFF COMMAND
SUBTTL	Q$ETAP	Process ENABLE TAPE command
SUBTTL	Q$DTAP	Process DISABLE TAPE command

;THIS ROUTINE WILL HANDLE ENABLE AND DISABLE TAPE COMMANDS

Q$DTAP::
Q$ETAP::MOVE	S1,G$HOST		;Get local node
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	MOVX	S1,.ODENA		;GET ENABLE CODE
	SKIPE	P1			;CHECK IF ENABLE OR DISABLE
	MOVX	S1,.ODDIS		;GET DISABLE CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE IN MESSAGE
	MOVX	S1,.AVREC		;GET AVR TYPE
	MOVEI	S2,1			;GET THE LENGTH
	$CALL	ARGRTN			;ADD ARGUMENT TO MESSAGE
	$CALL	P$KEYW			;GET A KEYWORD
	CAIN	S1,.KYTAP		;WAS IT FOR ALL TAPES
	JRST	ETAP.1			;YES SETUP FOR ALL TAPES
	CAIN	S1,.KYDSK		;ALL DISKS
	JRST	ETAP.3			;YES.. ALL DISKS
	$CALL	PSTAPE			;PROCESS A TAPE BLOCK
	JUMPT	CMDEND			;O.K.. SEND AND RETURN
	SETZM	G$ERR			;CLEAR THE ERROR WORD
	$CALL	P$PREV			;POSITION TO PREVIOUS
	$CALL	PSTRUC			;PROCESS STRUCTURE BLOCK
	JUMPT	CMDEND			;O.K.. SEND AND RETURN
	$RET				;PASS FALSE BACK
ETAP.1:	MOVX	S1,.ALTAP		;ALL TAPES
ETAP.2:	MOVEI	S2,1			;LENGTH OF BLOCK
	$CALL	ARGRTN			;BUILD THE ARGUMENT
	PJRST	CMDEND			;FINISH OFF COMMAND
ETAP.3:	MOVX	S1,.ALDSK		;GET ALL STRUCTURES
	PJRST	ETAP.2			;FINISH AND RETURN
SUBTTL	Q$LOCK	Process LOCK command
SUBTTL	Q$ULOC	Process UNLOCK command
;THIS COMMAND WILL LOCK A STRUCTURE FROM FURTHER ACCESS
;NOW OR OPTIONALLY AT A SPECIFIED TIME
;THE MESSAGE TYPE DISTINGUISHES LOCK FROM UNLOCK

Q$LOCK::
Q$ULOC::
	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	PSTRUC			;GET THE STRUCTURE
	$RETIF				;INVALID COMMAND
	$CALL	P$TIME			;GET THE TIME
	MOVEM	S1,ARG.DA(P3)		;SAVE THE UDT
	MOVX	S1,.ORTIM		;TIME BLOCK
	MOVEI	S2,ARG.SZ		;GET THE SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	$CALL	P$SWIT			;GET OPTIONAL SWITCH
	JUMPF	CMDEND			;NONE,,END IT !!!
	CAXE	S1,.SWNUL		;WAS IT NO-UNLOAD ???
	$RETF				;NO,,THATS AN ERROR
	MOVX	S1,LC.NUL		;GET THE NO UNLOAD STATUS
	MOVEM	S1,.OFLAG(MO)		;SAVE IT
	PJRST	CMDEND			;END THE MSG
SUBTTL	Q$MOUN	Process MOUNT TAPE and DISK command


;THIS COMMAND WILL BUILD MESSAGE FOR MOUNTING STRUCTURES
TOPS10<

Q$MOUNT::
	MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB
	$RETIF
	$CALL	P$KEYW			;CHECK FOR A KEYWORD
	$RETIF				;NO..INVALID COMMAND
	CAIE	S1,.KYSTR		;IS IT A STRUCTURE
	$RETF				;NO..INVALID COMMAND
	$CALL	PSTRUC			;PROCESS THE STRUCTURE
	$RETIF				;ERROR..RETURN
	$CALL	P$DEV			;CHECK FOR ALIAS NAME
	JUMPF	MOUN.1			;ISN'T ONE, TRY FOR A SWITCH
	MOVX	T1,.STALS		;STRUCTURE ALIAS
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE CODE IN BLOCK
	$CALL	MOVARG			;MOVE THE BLOCK

MOUN.1:	PUSHJ	P,P$SWIT		;TRY TO PARSE A SWITCH
	JUMPF	CMDEND			;CAN'T
	SETZ	S2,			;DEFAULT TO NO SWITCH
	CAIN	S1,.SWWLK		;WAS IT /WRITE-LOCKED?
	MOVX	S2,.MTWLK		;YES
	JUMPE	S2,.RETF		;ERROR IF NO SWITCH SPECIFIED
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAG BITS
	PJRST	CMDEND			;CHECK FOR END..AND SEND TO QUASAR

>;END TOPS10

Q$MOUNT::
	MOVE	S1,G$HOST		;Get local host name
	$CALL	OPRENB
	$RETIF
	$CALL	P$KEYW			;CHECK FOR A KEYWORD
	$RETIF				;NO..INVALID COMMAND
	CAIE	S1,.KYSTR		;IS IT A STRUCTURE
	$RETF				;NO..INVALID COMMAND
	$CALL	P$DEV			;GET THE DEVICE
	$RETIF				;ERROR..RETURN
	MOVX	T1,.STALS		;STRUCTURE ALIAS
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE CODE IN BLOCK
	$CALL	MOVARG			;MOVE THE BLOCK	

	PUSHJ	P,P$SWIT		;TRY TO PARSE A SWITCH
;**;[151]At Q$MOUNT::+15L change 3 lines  JCR  12/31/89
	JUMPF	CMDEN1			;[151]None, finish off the command
	CAIN	S1,.SWCLN		;[151]CLUSTER-NODE switch?
	PJRST	CMDEN			;[151]Yes, go process it
	SETZ	S2,			;DEFAULT TO NO SWITCH
	CAIN	S1,.SWSID		;WAS IT /STRUCTURE-ID
	MOVX	S2,.MTSID		;YES
	JUMPE	S2,.RETF		;ERROR IF NO SWITCH SPECIFIED
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAG BITS
	$CALL	P$DEV			;CHECK FOR STRUCTURE NAME
	JUMPF	MOUN.1			;ISN'T ONE,ALL DONE
	MOVX	T1,.STRDV		;STRUCTURE NAME
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE CODE IN BLOCK
	$CALL	MOVARG			;MOVE THE BLOCK
;**;[151]At MOUN.1:+0L change 1 line  JCR  12/31/89
MOUN.1:	PJRST	CMDEND			;[151]Finish off the command
SUBTTL	Q$IDEN	Process IDENTIFY command

;THIS COMMAND WILL IDENTIFY A  TAPE DRIVE WITH A PARTICULAR TAPE 
;REQUEST  OR TAPE VOLUME

Q$IDENTIFY::
	MOVE	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	PSDEVI			;SAVE THE DEVICE BLOCK
	$RETIF				;ERROR..RETURN
	$CALL	P$KEYW			;CHECK FOR A KEYWORD
	$RETIF				;NO..ERROR..RETURN
	MOVEI	S2,IDNDSP		;USE THE DISPATCH
	$CALL	TABSRC			;CHECK THE TABLE
	$RETIF				;ERROR..RETURN
	PJRST	(S2)			;DO THE WORK

IDNDSP:	$STAB
	.KYRQN,,IDNRQN			;REQUEST NUMBER
	.KYSCR,,IDNSCR			;SCRATCH TAPE
	.KYVID,,IDNVID			;VOLUME-ID
	$ETAB

; VOLUME-ID FOR IDENTIFY

IDNVID:	$CALL	PVOLID			;PROCESS VOLUME ID
	JUMPT	CMDEND			;O.K.. FINISH OFF MESSAGE
	$RET				;ERROR.. PASS CODE UP

;  REQUEST NUMBER FOR IDENTIFY

IDNRQN:	$CALL	PREQNM			;PROCESS REQUEST NUMBER
	$RETIF				;ERROR..RETURN
	PJRST 	CMDEND			;FINISH OFF COMMAND


;  SCRATCH FOR IDENTIFY

IDNSCR:	MOVEI	S1,.SCRTP		;SCRATCH TAPE
	MOVEI	S2,1			;ONE WORD BLOCK
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH OFF THE COMMAND
SUBTTL	Q$DEFI	Process DEFINE command (DN60)

;THIS COMMAND WILL DEFINE A DN60 NODE  SO THAT PARAMETERS CAN BE SET

IFN	FTDN60,<
Q$DEFINE::
	MOVE	S1,G$HOST		;Get host name
	$CALL	OPRENB			;Check OPR privs
	$RETIF
	$CALL	P$KEYW			;GET THE KEYWORD
;**;[160]At Q$DEFINE::+4L replace 2 lines with 6 lines
	CAIN	S1,.KYNOD		;[160]Is it node?
	JRST	DEFNOD			;[160]Yes, process it
	CAIE	S1,.KYAKA		;[160]Is it alias? 
	$RETF				;[160]No..return false
	$CALL	DEFAKA			;[160]Yes, process it
	$RET				;[160]And return
;**;[160]At Q$DEFINE::+11L add label DEFNOD:   PMM    6/3/90
DEFNOD:	$CALL	P$NODE			;GET A NODE
	$RETIF				;ERROR RETURN
	$CALL	SAVNOD			;SAVE THE NODE
	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;ERROR..RETURN
	SETZ	T1,			;SET A FLAG
	CAIN	S1,.KY278		;WAS IT 2780
	MOVX	T1,DF.278		;2780
	CAIN	S1,.KY378		;WAS IT 3780
	MOVX	T1,DF.378		;3780
	CAIN	S1,.KYHSP		;WAS IT HASP
	MOVX	T1,DF.HSP		;HASP
	CAIN	S1,.KYSNA		;Was it SNA
	MOVX	T1,DF.SNA		;SNA
	JUMPE	T1,.RETF		;ERROR..RETURN FALSE
	STORE	T1,DEF.TY(P3),DF.TPP	;Save the type
	CAIN	S1,.KYSNA		;Was it SNA
	JRST	DEFI.3			;Yes, skip E/T processing
	$CALL	P$SWIT			;Get the switch for signon/no- required
	SETZ	T1,			;Start at none
	JUMPF	DEFI.1			;And we have none
	CAIN	S1,.SWNSN		;Is no signon required?
	MOVX	T1,DF.NSN		;Yes, remember it
	CAIN	S1,.SWSON		;Is signon required?
	MOVX	T1,DF.SON		;Yes, remember it

DEFI.1:	STORE	T1,DEF.TY(P3),DF.FLG	;Save it in any case
	$CALL	P$KEYW			;GET  MODE KEYWORD
	$RETIF				;ERROR..RETURN
	SETZ	T1,			;SET THE FLAG
	CAIN	S1,.KYTRM		;WAS IT TERMINATION
	MOVX	T1,DF.TRM		;TERMINATION
	CAIN	S1,.KYEMU		;WAS IT EMULATION
	MOVX	T1,DF.EMU		;EMULATION
	JUMPE	T1,.RETF		;ZERO..ERROR..RETURN
	MOVEM	T1,DEF.MD(P3)		;SAVE THE MODE
	$CALL	P$NUM			;GET THE PORT NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,DEF.PT(P3)		;SAVE THE PORT NUMBER
	$CALL	P$NUM			;GET THE LINE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,DEF.LN(P3)		;SAVE THE LINE NUMBER
DEFI.2:	MOVX	S1,.DFBLK		;DEFINE BLOCK
	MOVEI	S2,DEF.SZ		;DEFINE SIZE
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH COMMAND AND SEND IT
DEFI.3:					;Here when processing SNA type node
	SETZ	T1,			;Zero the Emulation/Termination fields
	STORE	T1,DEF.TY(P3),DF.FLG	;SIGNON flag
	MOVEM	T1,DEF.MD(P3)		;The mode
	MOVEM	T1,DEF.PT(P3)		;The port number
	MOVEM	T1,DEF.LN(P3)		;The line number
DEFI.4:	$CALL	P$KEYW			;Get a keyword
	JUMPF	DEFI.2			;Not a keyword, try to finish up
	CAIN	S1,.KYGWY		;Was it GATEWAY?
	JRST	DEFI.5			;Yes, go process it
	CAIE	S1,.KYACC		;Was it ACCESS-NAME?
	JRST	.RETF			;No, error
	$CALL	P$FLD			;Get the Access Name
	HRLI	S1,1(S1)		;Start of text
	HRRI	S1,DEF.AN(P3)		;Where to save it
	CAILE	S2,4			;Don't take more than 3 words of data
	JRST	.RETF			;Error if longer
	ADDI	S2,DEF.AN-2(P3)		;Last word of destination block
	BLT	S1,(S2)			;Save the access name
	JRST	DEFI.4			;Loop for another keyword
DEFI.5:					;Here to process GATEWAY
	$CALL	P$NODE			;Get a node
	$RETIF				;Error, return
	MOVEM	S1,DEF.GW(P3)		;Save the Gateway Node
	JRST	DEFI.4			;Loop for more

>;END FTDN60

;**;[160]At DEFI.5:+4L add routines DEFAKA, CHRNME, FINDAK, FORMAT, ADDAKA,
;**;[160]DELAKA, QSRAKA, LSTAKA and OPRRDA  PMM  6/3/90
SUBTTL	DEFAKA  Process the DEFINE ALIAS Message

;[160]DEFAKA updates ORION's alias linked list, sends to  OPR a RESPONSE TO 
;[160]DEFINE ALIAS message and sends QUASAR a new alias message.
;[160]Routine DEFAKA is called by Q$DEFINE to process a DEFINE ALIAS message.

DEFAKA:	SETZM	AKAOBJ			;[160]Clear first word of object block
	HRLI	T1,AKAOBJ		;[160]Get source address
	HRRI	T1,AKAOBJ+1		;[160]Get second word
	BLT	T1,AKAOBJ+OBJ.SQ+7	;[160]Clear the entire object block
	MOVEI	P2,AKAOBJ+1		;[160]Point at object block buffer
	$CALL 	P$CURR			;[160]Pick up the .AKANM header
	$CALL	P$NEXT			;[160]Bump to the next field
	AOS	S1			;[160]Bump to the alias string
	HRROI	S1,0(S1)		;[160]Get ASCII pointer to 'new' alias
	$CALL	S%SIXB			;[160]Convert 'new' alias to SIXBIT
	MOVEM	S2,G$ARG3		;[160]Preserve 'new' SIXBIT alias

	$CALL	P$SWIT			;[160]Is there a /CLUSTER-NODE switch?
	JUMPF	DEFA.1			;[160]No, process locally
	$CALL	CHCLUN			;[160]Pick up the /CLUSTER-NODE value
	$RETIF				;[160]Illegally formatted message
	SKIPN	G$CLUN			;[160]Local node specified?
	JRST	DEFA.1			;[160]Yes, so ignore the switch
	MOVE	S1,G$CLUN		;[160]Get node(s) specified
	CAME	S1,[-1]			;[160]Is it all nodes?
	JRST	DEFA.9			;[160]No, send remotely

DEFA.1:	$CALL	P$CFM			;[160]Is this an unDEFINE ALIAS?
	JUMPF	DEFA.2			;[160]No, process a DEFINE or reDEFINE
;Process the unDEFINE command
DEF.1B::MOVE	S1,G$ARG3		;[160]Set up input for routine FINDAK
	$CALL	FINDAK			;[160]Is 'new' alias in list?
	JUMPF	DEF.1C			;[160]No, complain
	MOVE	S1,G$ARG3		;[160]Yes, get 'new' alias
	MOVEM	S1,G$ARG2		;[160]Designate that it must be deleted
	MOVE	S1,S2			;[160]Get address of entry
	$CALL	DELAKA			;[160]Delete it from linked list
	$CALL	E$AKU			;[160]Issue alias undefined message
	JRST	DEFEND			;[160]Send messages to OPR and QUASAR

DEF.1C:	$CALL	E$AKI			;[160]No, complain alias not found
	MOVE	S1,G$CLUN		;[160]Get node(s) specified
	CAMN	S1,[-1]			;[160]Is it all nodes?
	JRST	DEF.9D			;[160]Yes, send remotely
	$RET				;[160]No, return now

;Here to read in a DEFINE or a reDEFINE alias command

DEFA.2:	MOVEI	P2,AKAOBJ		;[160]Get object block address
	SETZM	G$ARG2			;[160]Assume no need to delete an alias
	MOVE	S1,G$ARG3		;[160]Get 'new' alias
	$CALL	FINDAK			;[160]Alias already defined?
	JUMPF	DEFA.3			;[160]No, process the printer specification
	MOVE	T1,OBJAKA(S2)		;[160]Yes, get SIXBIT alias name
	MOVEM	T1,G$ARG2		;[160]and designate it for deletion

DEFA.3:	$CALL 	P$NUM			;[160]Is this a local printer?
	JUMPF	DEFA.5			;[160]No, process remote printer
;Read in the local printer specification
	CAXLE	S1,77			;[160]Is it valid?
	$RETF				;[160]No,,return
	AOS	P2			;[160]Point past object block header
	MOVEM	S1,OBJ.UN(P2)		;[160]Save it in the object block
	MOVEI	S1,.OTLPT		;[160]Pick up the printer type
	MOVEM	S1,OBJ.TY(P2)		;[160]Indicate in the object block
	$CALL	P$SWIT			;[160]Get the node switch
	JUMPT	DEFA3A			;[160]Go check the switch type
	MOVE	S1,G$HOST		;[160]Pick up the local node name
	JRST	DEFA3C			;[160]Go place in the object block
DEFA3A:	CAIN	S1,.SWNOD		;[160]Is it a node switch?
	JRST	DEFA3B			;[160]Yes, pick up the node name
	$CALL	CHCLUN			;[160]Is it a /CLUSTER-NODE switch?
	$RETIF				;[160]No, illegally formatted message
	MOVE	S1,G$HOST		;[160]Pick up the local node name
	MOVEM	S1,OBJ.ND(P2)		;[160]Save in the object block
	SKIPN	S1,G$CLUN		;[160]Local node specified?
	JRST	DEFA.4			;[160]Yes, treat as the local case
	CAMN	S1,[-1]			;[160]All nodes?
	JRST	DEFA.4			;[160]Yes, do the local case first
	MOVEI	S1,.OROBJ		;[160]Pick up the block type
	HRLI	S1,AKBSIZ		;[160]Pick up the block length
	MOVEM	S1,-ARG.DA(P2)		;[160]Place in the block header
	JRST	DEFA.9			;[160]Prepare to send to NEBULA
DEFA3B:	$CALL	P$NODE			;[160]Get the source node 
	$RETIF				;[160]No,,return
	SETOM	G$NOFG			;[160]Indicate /NODE switch specified
DEFA3C:	MOVEM	S1,OBJ.ND(P2)		;[160]And save the source node

DEFA.4:	MOVEI	S1,AKAOBJ+1		;[160]Get object block address
	$CALL	FINDPR			;[160]Is it in linked list?
	JUMPF	DEFA.6			;[160]No, set up object block header
	MOVE	S1,OBJAKA(S2)		;[160]Get the old alias
	MOVEM	S1,OBJ.AK(P2)		;[160]Save it in object block
	JRST	DEFA.6			;[160]Set up object block header

;Here to process a remote printer specification or an alias name

DEFA.5:	MOVEI	S1,.OTLPT		;[160]Pick up the printer type
	MOVEM	S1,OBJTYP(P2)		;[160]Indicate in the object block
	$CALL	P$KEYW			;[160]Pick up next keyword
	MOVEI	P3,AKAOBJ		;[160]Get the object block address
	$CALL	LPTTYP			;[160]Build the printer type
	$RETIF				;[160]Return if false
	MOVEI	P2,AKAOBJ+1		;[160]Get the object block address

;Here to add the object block header

DEFA.6:	MOVEI	T2,.OROBJ		;[160]Pick up the object block header
	HRLI	T2,AKBSIZ		;[160]Pick up the object block length
	MOVEM	T2,-1(P2)		;[160]Add in object block header

;CLUSTER-NODE next few lines:
	$CALL	P$SWIT			;[160]Is there a /CLUSTER-NODE switch?
	JUMPF	DEF.6D			;[160]No, process locally
	$CALL	CHCLUN			;[160]Pick up the /CLUSTER-NODE value
	$RETIF				;[160]Illegally formatted message
	SKIPN	S1,G$CLUN		;[160]Local node specified?
	JRST	DEF.6D			;[160]Yes, so ignore the switch
	CAME	S1,[-1]			;[160]All nodes?
	JRST	DEFA.9			;[160]No, send remotely
DEF.6D: $CALL	P$CFM			;[160]Is there a confirm?
	$RETIF				;[160]Invalid message
	JRST	DEF.6B			;[160]Process locally

DEF.6A::MOVEI	P2,AKAOBJ+1		;[160]Get address of object block
	MOVE	S1,G$ARG3		;[160]Get 'new' alias
	$CALL	FINDAK			;[160]Alias already defined?
	JUMPF	DEF.6C			;[160]No, check object block
	MOVE	T1,OBJAKA(S2)		;[160]Yes, get SIXBIT alias name
	MOVEM	T1,G$ARG2		;[160] and designate it for deletion

DEF.6C:	MOVE	S1,P2			;[160]Get address of object block
	SETZM	OBJ.AK(S1)		;[160]Clear alias name
	$CALL	FINDPR			;[160]Is it in linked list?
	JUMPF	DEF.6B			;[160]No, continue on
	MOVE	S1,OBJAKA(S2)		;[160]Get alias name
	MOVEM	S1,OBJ.AK(P2)		;[160]Place in object block

DEF.6B:	SKIPN	S1,G$ARG2		;[160]Alias to be deleted?
	JRST	DEFA.7			;[160]No, object block mapped to any alias?
	MOVE	S2,OBJ.AK(P2)		;[160]Yes, get old alias
	CAME	S1,S2			;[160]Is it the same mapping?
	JRST	DEF.6E			;[160]No, delete old alias mapping
	$CALL	E$AKM			;[160]Yes, notify operator
	MOVE	S1,G$CLUN		;[160]Get node(s) value
	CAMN	S1,[-1]			;[160]Is it all nodes?
	JRST	DEF.9D			;[160]Yes, process other nodes
	$RET				;[160]Return

;Here to delete old alias mapping from list

DEF.6E:	MOVE	S1,G$ARG2		;[160]Get old alias
	$CALL	FINDAK			;[160]Search for its address
	MOVE	S1,S2			;[160]Get the address
	$CALL	DELAKA			;[160]Delete old alias from list
	JRST	DEFA.7			;[160]Add 'new' alias entry to linked list

;Is this a redefinition?

DEFA.7:	SKIPN	S1,OBJ.AK(P2)		;[160]Really an old alias?
	JRST	DEFA.8			;[160]No, set up and link in new entry
	MOVE	S1,P2			;[160]Yes, get address of object block
	$CALL 	FINDPR			;[160]Get its entry in list
	MOVE	S1,G$ARG3		;[160]Get 'new' alias
	MOVEM	S1,OBJAKA(S2)		;[160]Add it to entry in list
	MOVEM	S1,OBJ.AK(P2)		;[160]Add 'new' alias to object block
	JRST 	DEFEND			;[160]Send OPR and QUASAR messages

DEFA.8:	$CALL	FORMAT			;[160]Format the mapped entry
	$RETIF
	$CALL	ADDAKA			;[160]Add the entry into list
	$RETIF

DEFEND:	$CALL	OPRRDA			;[160]Send RESPONSE TO DEFINE ALIAS 	
	$RETIF
	$CALL	QSRAKA			;[160]Send NEW ALIAS message to QUASAR
	$RETIF				;[160]Return if problem
	$CALL	E$AKD			;[160]Issue alias defined message

	MOVE	S1,G$CLUN		;[160]Get node(s) specified
	CAMN	S1,[-1]			;[160]Is it all nodes?
	JRST	DEF.9D			;[160]Yes, process for all nodes
	$RETT	

;Here to send command remotely
	
DEFA.9:	$CALL	RELOPR			;[160]Release OPR from block receive
	$RETIF				;[160]RETURN IF PROBLEM
DEF.9D:	$CALL	GETPAG			;[160]Pick up a page for NEBULA
	MOVEI	S1,NEB%MS!.OMAKA	;[160]Get message type
	HRLI	S1,.OHDRS+.AKASZ+.NDESZ	;[160]Assume the object block is empty
	SKIPN	AKAOBJ			;[160]Is the object block empty?
	JRST	DEF.9A			;[160]Yes, no need to include it
	HRLI	S1,.OHDRS+.AKASZ+AKBSIZ+.NDESZ  ;[160]Yes, include it in length

DEF.9A:	MOVEM	S1,.MSTYP(MO)		;[160]Save in message
	MOVEI	P3,.OHDRS(MO)		;[160]Get address of first argument
	MOVE	S1,G$ARG3		;[160]Get 'new' alias
	MOVEM	S1,ARG.DA(P3)		;[160]Save in message
	MOVEI	S1,.AKANM		;[160]Get argument type...
	HRLI	S1,.AKASZ		;[160]...and length
	MOVEM	S1,ARG.HD(P3)		;[160]Save argument header in message
	ADDI	P3,.AKASZ		;[160]Point at next argument block
	AOS	.OARGC(MO)		;[160]Increment argument count
	SKIPN	AKAOBJ			;[160]Is there a printer specification?
	JRST	DEF.9C			;[160]No, send message now

	SETZM	OBJ.AK(P2)		;[160]Zero out any old alias name

	MOVE	S1,OBJ.TY(P2)		;[160]Pick up the printer type
	CAME	S1,[.OTLPT]		;[160]A local printer?
	TXNE	S1,.CLLPT		;[160]No, a cluster printer?
	SKIPA				;[160]A local or cluster printer
	JRST	DEF.9B			;[160]No, no need to check for /NODE
	SKIPN	G$NOFG			;[160]Node switch specified?
	JRST	DEF.9B			;[160]Yes, no need to change remotely
	MOVX	S1,.RMLPT		;[160]Pick up no /NODE specified bit
	IORM	S1,OBJ.TY(P2)		;[160]Save in the printer type word

DEF.9B:	HRLI	T1,AKAOBJ		;[160]Get source address
	HRRI	T1,ARG.HD(P3)		;[160]Get source,,destination
	BLT	T1,ARG.HD+AKBSIZ(P3)	;[160]Move the entire object block
	AOS	.OARGC(MO)		;[160]Increment argument count
	ADDI	P3,AKBSIZ		;[160]Point at next block

DEF.9C:	$CALL	FASNEB			;[160]Send the message to NEBULA
	SETZ	MO,			;[160]Indicate page has been released
	$RET				;[160]Return to the caller
SUBTTL	FINDPR  Find An Alias Name Entry

;[160]FINDPR searches for the given printer object block in ORION's
;[160]alias printer name linked list
;[160]
;[160]Call is:       S1/Address of printer object block
;[160]Returns true:  S2/Address of mapped entry in ORION's list
;[160]Returns false: Signifies that printer object block was not found

FINDPR::$SAVE	<T1,P1,P2>		;[160]Save the AC
	MOVE	P1,S1			;[160]Preserve the printer object block
	SKIPA	S2,HDRAKA		;[160]Get the linked list header
FNDPR1:	LOAD	S2,.QELNK(S2),QE.PTN	;[160]Get the next entry
	SKIPN	S2			;[160]End of list?
	$RETF				;[160]Yes, return
	MOVE	T1,OBJ.TY(P1)		;[160]Get object type
	CAME	T1,OBJTYP(S2)		;[160]Same object type?
	JRST	FNDPR1			;[160]No, loop to next entry
	MOVE 	T1,OBJ.ND(P1)		;[160]Get node name
	CAME	T1,OBJNOD(S2)		;[160]Same node name?
	JRST	FNDPR1			;[160]No, loop to next entry
	MOVE	T1,OBJ.UN(P1)		;[160]Get unit value
	CAME	T1,OBJUNI(S2)		;[160]Are the units equal?
	JRST	FNDPR1			;[160]No, loop to next entry
	MOVE	T1,OBJ.TY(P1)		;[160]Get object type
	TXNN	T1,.DQLPT!.LALPT	;[160]Is this a LAT or DQS printer?
	$RETT				;[160]No, return true
	MOVEI	S1,OBJ.QN(P1)		;[160]Get object's queue name
	MOVE	P2,S2			;[160]Save S2
	MOVEI	S2,OBJNAM(S2)		;[160]Get current entry's queue name
	$CALL	CHRNME			;[160]Are the names equal?
	MOVE 	S2,P2			;[160]Restore current entry's address
	JUMPF	FNDPR1			;[160]No, loop to next entry
	$RETT				;[160]Yes, return true
SUBTTL	CHRNME  Compare Printer Names

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


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

	HRROI	S1,ARG.DA(P1)		;[160]Point to the name
	HRROI	S2,ARG.DA(P2)		;[160]Point to the name
	$CALL	S%SCMP			;[160]Compare the names
	TXNE	S1,SC%LSS!SC%SUB!SC%GTR	;[160]Are they the same?
	$RETF				;[160]No, indicate to the caller
	$RETT				;[160]Yes, indicate to the caller
SUBTTL	FINDAK - Search For an Alias

;[160]Routine FINDAK searches for the given alias name in ORION's
;[160]alias printer name linked list which is pointed to by HDRAKA.
;[160]
;[160]Call is:       S1/SIXBIT alias name
;[160]Returns true:  S2/Address of mapped entry in ORION's list
;[160]Returns false: Alias name is not defined 
;[160]               S1/SIXBIT alias name

FINDAK::$SAVE	<P1>			;[160]Save the AC
	MOVE	P1,S1			;[160]Preserve the alias
	SKIPA	S2,HDRAKA		;[160]Get the linked list header
FIND.1:	LOAD	S2,.QELNK(S2),QE.PTN	;[160]Get the next entry
	SKIPN	S2			;[160]End of the list?
	JRST	FIND.2			;[160]Alias name is not defined
	CAME	P1,OBJAKA(S2)		;[160]Is this the alias name
	JRST	FIND.1			;[160]No, loop to next entry
	$RETT				;[160]Yes, return

FIND.2:	MOVE	S1,P1			;[160]Place the alias name in S1
	$RETF				;[160]No, return now
SUBTTL	FORMAT - Formats an Alias Printer Name Entry

;[160]FORMAT sets up a mapped entry for ORION's alias printer name linked list.
;[160]FORMAT acquires memory space for the formatted mapped entry and BLTs
;[160]the printer object block which resides at address AKAOBJ into the
;[160]memory space.
;[160]
;[160]Call is:       AKAOBJ Object block to be copied
;[160]Returns true:  S1/ADDRESS OF THE FORMATTED MAPPED ENTRY
;[160]Returns false: Signifies that free space was not available

FORMAT:	$SAVE	<P1,P2>			;[160]Save these ACs
	MOVEI	S1,AKBSIZ		;[160]Get mapped entry size
	$CALL	M%GMEM			;[160]Get memory
	$RETIF				;[160]Memory not available
	MOVE	P1,S2			;[160]Get address of memory
	SETZM	.QELNK(P1)		;[160]Clear the pointers
	MOVEI	P2,AKAOBJ+1		;[160]Get source address
	MOVE	S1,G$ARG3		;[160]Get 'new' alias
	MOVEM	S1,OBJ.AK(P2)		;[160]Add 'new' alias to object block
	HRLI	S1,(P2)			;[160]Source address,,x
	HRRI	S1,OBJTYP(P1)		;[160]Source,,destination
	BLT	S1,OBJAKA(P1)		;[160]Move the object block 
	MOVE	S1,P1			;[160]Return address of formatted entry
	$RETT				;[160]Return
SUBTTL	ADDAKA - Add an Entry to the Alias Printer Name Linked List

;[160]ADDAKA links a formatted mapped entry into ORION's linked list
;[160]
;[160]Call is:	S1/Address of the mapped entry to be added into ORION's linked
;[160]		list
;[160]Returns:	S1/Address of the mapped entry that was added into ORION's 
;[160]		linked list

ADDAKA:	$SAVE	<T1,T2,P1,P2,P3>	;[160]Save these ACs
	MOVE	P2,S1			;[160]Preserve the object block address
	SKIPE	P1,HDRAKA		;[160]Get the list pointer
	JRST	ADDA.2			;[160]Not empty
	JRST	ADDA.4			;[160]Empty
ADDA.1:	LOAD	P1,.QELNK(P1),QE.PTN	;[160]Get next entry
	SKIPN	P1			;[160]Last entry?
	JRST	ADDA.6			;[160]Yes, add to end of list
ADDA.2:	MOVE	T1,OBJTYP(P2)		;[160]Get object type of new entry
	CAMLE	T1,OBJTYP(P1)		;[160]Object type too large?
	JRST	ADDA.1			;[160]Yes, check next entry
	CAME	T1,OBJTYP(P1)		;[160]Same object type?
	JRST	ADDA.5			;[160]No, link entry in here

	MOVX	T2,.LALPT!.OTLPT	;[160]Get LAT printer type
	CAME	T2,T1			;[160]Is new entry a LAT printer?
	JRST	ADDA.3			;[160]No, check node type
	LOAD	T1,OBJNAM(P1),AR.TYP	;[160]Get queue type of current entry
	LOAD	T2,OBJNAM(P2),AR.TYP	;[160]Get queue type of new entry
	CAMLE	T2,T1			;[160]Is the new entry smaller?
	JRST	ADDA.1			;[160]No, check next entry
	CAME	T2,T1			;[160]Same queue type?
	JRST	ADDA.5			;[160]No, link entry in here

ADDA.3:	MOVE	T1,OBJNOD(P2)		;[160]Get node type
	CAMLE	T1,OBJNOD(P1)		;[160]Object node too small?
	JRST	ADDA.1			;[160]Yes, check next entry
	CAME	T1,OBJNOD(P1)		;[160]Same node type?
	JRST	ADDA.5			;[160]No, link entry in here

	MOVE	T1,OBJUNI(P2)		;[160]Get unit block
	CAMLE	T1,OBJUNI(P1)		;[160]Unit too small?
	JRST	ADDA.1			;[160]Yes, check next entry
	CAME	T1,OBJUNI(P1)		;[160]Same unit type?
	JRST	ADDA.5			;[160]No, link entry in here

	MOVEI	S1,OBJNAM(P2)		;[160]Get object's queue name
	MOVEi	S2,OBJNAM(P1)		;[160]Get current entry's queue name
	$CALL	CHRNME			;[160]Compare strings
	TXNE	S1,SC%LSS		;[160]Name less than?
	JRST	ADDA.5			;[160]Yes, go link in here
	JRST	ADDA.1			;[160]No, check next entry


ADDA.4:	MOVEM	P2,HDRAKA		;[160]Point at first entry
	MOVEI	P1,HDRAKA		;[160]Get the list header address
	STORE	P1,.QELNK(P2),QE.PTP	;[160]Make it current entry's previous link
	SETZ	P1,			;[160]Clear P1
	STORE	P1,.QELNK(P2),QE.PTN	;[160]Store zero in next link
	$RETT

ADDA.5:	STORE	P1,.QELNK(P2),QE.PTN	;[160]Make current entry the next link
	LOAD	P3,.QELNK(P1),QE.PTP	;[160]Get previous entry
	STORE	P3,.QELNK(P2),QE.PTP	;[160]Make previous entry the previous link
	STORE	P2,.QELNK(P1),QE.PTP	;[160]Change current entry's previous link
	STORE	P2,.QELNK(P3),QE.PTN	;[160]Change prevvious entry's next link
	$RETT				;[160]Return

ADDA.6:	SKIPA 	P1,HDRAKA		;[160]Get pointer to list

ADDA.7:	LOAD	P1,.QELNK(P1),QE.PTN	;[160]Point at next entry
	LOAD	T1,.QELNK(P1),QE.PTN	;[160]Look at current entry's next entry
	SKIPE	T1			;[160]Is this the last entry?
	JRST	ADDA.7			;[160]No, get next entry
	STORE	P2,.QELNK(P1),QE.PTN	;[160]Make last entry point to new entry
	STORE	P1,.QELNK(P2),QE.PTP	;[160]Make new entry point to last entry
	SETZ	T1,			;[160]Get end of list marker
	STORE	T1,.QELNK(P2),QE.PTN	;[160]Make new entry point at it
	$RETT
SUBTTL	ADDAKA - Delete an Entry to the Alias Printer Name Linked List

;[160]DELAKA deletes an entry from ORION's alias printer name linked list.
;[160]
;[160]Call is:	S1/Address of the mapped entry to be deleted from ORION's 
;[160]		linked list
;[160]Returns:  The entry has been deleted

DELAKA:	$SAVE	<P1,P2,T1>		;[160]Save these ACs
	MOVE	P2,S1			;[160]Save address of entry
	LOAD	S2,.QELNK(S1),QE.PTP	;[160]Get previous entry
	CAMN	S1,HDRAKA		;[160]Is this the first entry in list?
	JRST	DELA.1			;[160]Yes, process first entry

	LOAD	T1,.QELNK(S1),QE.PTN	;[160]Next entry pointer
	STORE	T1,.QELNK(S2),QE.PTN	;[160]Make previous point to next entry
	JRST 	DELA.2			;[160]Get the next entry

DELA.1:	LOAD	P1,.QELNK(S1),QE.PTN	;[160]Get the next entry
	MOVEM	P1,HDRAKA		;[160]Make it first entry in list
	JUMPE	DELA.3			;[160]Release memory if no next entry
	MOVEI	T1,HDRAKA		;[160]Yes, get the pointer to list
	STORE	T1,.QELNK(P1),QE.PTP	;[160]Put in next entry's previous pointer
	JRST	DELA.3			;[160]No, release memory

DELA.2:	LOAD	P1,.QELNK(S1),QE.PTN	;[160]Get the next entry
	JUMPE	P1,DELA.3		;[160]Release memory if end of the list
	STORE	S2,.QELNK(P1),QE.PTP	;[160]Make next point to previous entry

DELA.3:	MOVE	S2,P2			;[160]Get address of entry
	MOVEI	S1,AKBSIZ		;[160]Get entry size
	$CALL	M%RMEM			;[160]Release the 'de-linked' entry
	$RET


;**;[160]Routine QSRAKA is added as part of this edit
;ROUTINE QSRAKA FORMATS UP THE NEW ALIAS MESSAGE AND SENDS IT TO QUASAR.
;
;CALL IS:	S1/SIXBIT ALIAS NAME (OR ZERO TO SIGNIFY THAT NO ALIAS NEEDS
;		TO BE DELETED
;		S2/ADDRESS OF THE OBJECT BLOCK (OR ZERO TO SIGNIFY THAT
;		NO ALIAS NEEDS TO BE ADDED

QSRAKA:	$SAVE	<T1,t2>			;[160]Save ACs
	$CALL	GETPAG			;[160]Get a page
	MOVX	T1,.OMNEW		;[160]Get new alias code
	STORE	T1,.MSTYP(MO),MS.TYP	;[160]Save the type in message
	MOVEI	T1,PAGSIZ		;[160]Get message length 
	STORE	T1,.MSTYP(MO),MS.CNT	;[160]SAVE THE LENGTH IN MESSAGE
	MOVEI	T1,2			;[160]Get the argument count
	MOVEM	T1,.OARGC(MO)		;[160]Save the argument count
	MOVEI	T1,.AKASZ		;[160]Get alias block length
	HRLI	T2,(T1)			;[160]Set in left half of word
	MOVEI	T1,.AKBLK		;[160]Get alias name type
	HRRI	T2,(T1)			;[160]Set in right half of word
	MOVEM	T2,ARG.HD+.OHDRS(MO)	;[160]Add alias name block header
	MOVE	S1,G$ARG2		;[160]Get Alias name to be deleted
	MOVEM	S1,ARG.DA+.OHDRS(MO)	;[160]Add alias name to message


	MOVEI	T2,.AKASZ+ARG.HD+.OHDRS(MO) ;[160]Point at second header data block
	MOVEI	S2,AKAOBJ		;[160]Get object block address
	HRLI	T1,(S2)			;[160]Source address
	HRRI	T1,(T2)			;[160]Destination
	BLT	T1,OBJ.AK+1(T2)		;[160]Move the object block into message
	$CALL	SNDQSR			;[160]Send to quasar
	SETZ	MO,			;[160]Indicate page has been released
	$RET				;[160]And return
SUBTTL	LSTAKA - Set Up the RESPONSE TO DEFINE ALIAS Message

;[160]LSTAKA sets up the RESPONSE TO DEFINE ALIAS Message by
;[160]Copying every alias from ORION's linked list
;[160]Call is:	S1/Address of the alias name block in outgoing message
;[160]Returns:	Alias list block pointed to by S1

LSTAKA::$SAVE	<P1,P2,P3>		;[160]Save these ACs
	SETZ	P1,			;[160]Initialize alias counter
	MOVEI	P2,(S1)			;[160]Point to alias name block
	MOVE	P3,P2			;[160]Save alias list header address
	AOS	P2			;[160]Point at first address in block
	SKIPA	S2,HDRAKA		;[160]Get address of first entry
LSTAK1:	LOAD	S2,.QELNK(S2),QE.PTN	;[160]Get the next object in the chain
	SKIPN	S2			;[160]Last entry?
	JRST	LSTAK3			;[160]Yes, add header
	MOVE 	T1,OBJAKA(S2)		;[160]Get alias
	MOVEM	T1,(P2)			;[160]Add its alias to list
	AOS	P1			;[160]Increment alias counter
	AOS	P2			;[160]Increment pointer
	JRST	LSTAK1			;[160]Loop to process next entry
	
LSTAK3:	AOS P1				;[160]Include header in block length
	HRLI	T1,(P1)			;[160]Get alias block length
	HRRI	T1,.AKBLK		;[160]Get alias block name
	MOVEM	T1,(P3)			;[160]Store in message
	MOVEI	T1,(P1)			;[160]Get alias block length
	ADD	P3,T1			;[160]Update message pointer
	MOVE	S1,.MSFLG(MI)		;[160]Pick up the flag word
	TXNN	S1,MF.NEB		;[160]Message originate remotely?
	$RET				;[160]No, so return now
	MOVX	S1,MF.NEB		;[160]Pick up the remote origin bit
	IORM	S1,.MSFLG(MO)		;[160]Indicate to OPR
	DMOVE	S1,G$CBLK		;[160]Pick up the remote node block
	DMOVEM	S1,ARG.HD(P3)		;[160]Place in the message
	$RET				;[160]And return
SUBTTL	LSTAKA - Set Up the RESPONSE TO DEFINE ALIAS Message

;[160]OPRRDA formats the RESPONSE TO DEFINE ALIAS message and sends it to OPR.
;
RELOPR:	SETOM	RELBLK			;[160]Set the release block flag
	SKIPA				;[160]Don't reset the flag
OPRRDA:	SETZM	RELBLK			;[160]Clear release block flag
	MOVEI	S1,.OHDRS+ARG.HD(MO)	;[160]Get address for alias list block
	SKIPL	RELBLK			;[160]Is this just to release OPR?
	$CALL 	LSTAKA			;[160]No, get alias list
	MOVE	T1,.OHDRS+ARG.HD(MO)	;[160]Get argument header	
	MOVEI	T1,PAGSIZ-1		;[160]Get message length
	HRLI	T2,(T1)			;[160]Set in left half of word 
	MOVEI	T1,.OMRDA		;[160]Get command code
	HRRI	T2,(T1)			;[160]Set in right half of word
	MOVEM	T2,.MSTYP(MO)		;[160]Add to outgoing message
	SETZ	S1,			;[160]Assume this is a release OPR
	SKIPL	RELBLK			;[160]Is the release block flag set?
	AOS	S1			;[160]No, get argument count
	MOVEM	S1,.OARGC(MO)		;[160]Store in outgoing message
	SKIPE	RELBLK			;[160]Is this RELOPR?
	JRST	OPRR.1			;[160]Yes, send to sender only
	SETOM	G$ASND##		;[160]Force message to all OPRs
	$CALL	W$NODE			;[160]Find node
	$CALL	SNDAOP			;[160]No, send the message to all OPRS
	$RET				;[160]And return

OPRR.1:	MOVE	S1,G$SND##		;[160]Get the Sender's PID
	MOVEM	S1,.MSCOD(MO)		;[160]Save PID in message
	MOVEI	S2,PAGSIZ-1		;[160]Page message size
	$CALL	SPDOPR##		;[160]Send to OPR
	$RET				;[160]And return
SUBTTL	Q$SWIT	Process SWITCH command (TOPS20)

;THIS COMMAND WILL SEND A MESSAGE TO MOUNTR (VIA QUASAR) TO
;SWITCH A GIVEN REQUEST TO ANOTHER VOLUME/DRIVE.

TOPS20 <
Q$SWITCH::
	MOVE	S1,G$HOST		;Get host name
	$CALL	OPRENB
	$RETIF
	$CALL	PREQNM			;PROCESS A REQUEST NUMBER
	$RETIF				;ERROR..RETURN
	$CALL	PVOLID			;PROCESS THE VOLUME ID
	$RETIF				;ERROR..RETURN
;**;[155]At Q$SWITCH::+8L replace 2 lines with 5 lines  JCR  1/16/90
	$CALL	P$DEV			;[155]Check for a device block
	JUMPF	CMDEND			;[155]None, finish the command
	$CALL	PSTA.1			;[155]Check for a tape device
	$RETIF				;[155]Not a tape, that's an error
	PJRST	CMDEND			;[155]Finich the command

>;END TOPS20
SUBTTL	Q$MODS	Process MODIFY SYSTEM-LISTS command (TOPS10)

;These routine are responsible for decoding the parse blocks
;Returned on a MODIFY <system-lists> command
;Call -
;	S1/	Current keyword in parse

Q$MODS:
TOPS20<	$RETF >				;ONLY FOR THE -10
TOPS10<
	$CALL	CNVLST			;CONVERT TO EXTERNAL FORM, ADD TO MESSAGE
	$RETIF				;CAN'T, SO QUIT
	MOVE	S1,G$HOST		;Get local node
	$CALL	OPRENB			;Check OPrR privs
	$RETIF
	MOVX	S1,.ODCSL		;NEW MESSAGE TYPE - CHANGE SYSTEM LISTS
	STORE	S1,.MSTYP(MO),MS.TYP	;SET IT
	$CALL	P$KEYW			;GET THE INCLUDE/EXCLUDE
	JUMPF	E$IFC			;CAN'T, SO QUIT
	SETO	S2,			;SAY NO MATCH SO FAR
	CAIN	S1,.KYINC		;IS IT INCLUDE?
	SETZ	S2,			;YES, CLEAR THE BIT
	CAIN	S1,.KYEXC		;IS IT EXCLUDE?
	MOVEI	S2,1			;YES, GET ONE BIT
	JUMPL	S2,E$IFC		;BETTER BE ONE OF THOSE
	STORE	S2,.OFLAG(MO),AD.REM	;LITE BIT IF APPROP. IN FLAGS
	$CALL	PSTRUC			;GET THE DEVICE (STR OR UNI) NAME
	$RETIF				;NOT A STR NEXT, STRANGE
	PJRST	CMDEND			;FINISH THE COMMAND

;THIS ROUTINE CONVERTS A LIST DESCRIPTOR KEYWORD INTO A 
; BLOCK IN THE MESSAGE WITH THE EXTERNAL DESCRIPTOR
;CALL -
;	S1/	.KYXXX KEYWORD SYMBOL
;RETURNS -
;	TRUE, WITH A 2-WORD BLOCK TACKED ON TO THE MESSAGE
;	FALSE - IF THE KEYWORD DIDN'T MATCH ANY KNOW KEYWORD

CNVLST:	MOVEI	S2,CLSTTB		;POINT TO THE MAPPING TABLE
	$CALL	TABSRC			;FIND THE CORRECT LIST HANDLE
	JUMPF	E$IFC			;VERY STRANGE
	MOVEI	S1,.SLSTY		;BLOCK TYPE - LIST DESCRIPTOR
	MOVE	TF,S2			;COPY THE CONVERTED LIST TYPE
	SETZ	S2,			;CLEAR THE DATA WORD
	STORE	TF,S2,SL.TCD		;STASH IN PROPER PLACE
	PJRST	MOVAR2			;ADD A 2-WORD ARG BLOCK

CLSTTB:	$STAB
	.KYSSL,,SL.SSL			;MAP FOR SYSTEM SEARCH LIST
	.KYCDL,,SL.CDL			;MAP FOR SYSTEM DUMP LIST
	.KYASL,,SL.ASL			;MAP FOR ACTIVE SWAP LIST
	$ETAB
>;END TOPS10
SUBTTL	Q$SLST	Process SHOW SYSTEM-LISTS command (TOPS10)

;THIS ROUTINE PROCESSES THE SHOW SYSTEM LIST MESSAGE AND
; ANY ATTACHED BLOCKS

TOPS10<
Q$SLST::
	MOVEI	S1,.ODSSL		;MESSAGE TYPE IS NOW SHOW SYS
	STORE	S1,.MSTYP(MO),MS.TYP	;CHANGE IT
SLST.1:	$CALL	P$KEYW			;IS THERE A KEYWORD?
	JUMPF	CMDEND			;NO, BETTER BE CONFIRM
	$CALL	CNVLST			;YES, CONVERT AND ADD TO MSG
	JRST	SLST.1			;TRY FOR ANOTHER
>;END TOPS10
SUBTTL	Q$SALC	Process SHOW ALLOCATION command (TOPS10)

TOPS10<
Q$SALC::
	MOVEI	S1,.ODSAL		;GET THE MESSAGE TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE IN THE OUTGOING MESSAGE
	$SAVE	<P1>			;SOME WORK SPACE
	$CALL	P$KEYW			;GET THE DESCRIPTOR
	JUMPF	E$IFC			;WHOOPS!
	MOVX	P1,.ORJNU		;ASSUME JOB NUMBER
	CAIN	S1,.KYBRQ		;IS IT ANYTHING OTHER THAN BATCH REQ?
	MOVX	P1,.ORREQ		;BATCH REQUEST. SAVE BLOCK TYPE
	CAIN	S1,.KYALL		;WAS IT 'ALL-REQUESTS'?
	JRST	SALC.1			;AND DON'T EXPECT A NUMBER
	$CALL	P$NUM			;GET THE JOB OR REQUEST NUMBER
	SKIPT				;WAS THERE A NUMBER?
SALC.1:	SETOM	S1			;NO, SAY -1 FOR JOB NUMBER
	MOVE	S2,S1			;DATA WORD - JOB OR REQUEST NUMBER
	MOVE	S1,P1			;BLOCK TYPE - FROM KEYWORD
	$CALL	MOVAR2			;ADD THE TWO WORDS
	PJRST	CMDEND			;AND FINISH UP
>;END TOPS10
SUBTTL Q$UNDE Process undefine command

Q$UNDE:: MOVE 	S1,G$HOST		;Get local host
	$CALL	OPRENB			;Check OPR privs
	$RETIF				;Must have at least host privs.

	$CALL	P$KEYW			;Get the next keyword
	$RETIF				;Must have the next keyword
	CAIE	S1,.KYSTR		;Is it structure?
	$RETIF				;No, bad keyword
	MOVX	S1,.ODUDS		;Get the message type
	STORE	S1,.MSTYP(MO),MS.TYP	;Save the type in the header
	$CALL	PSTRUC			;Process a structure block
	$RETIF				;Quit if bad
	PJRST	CMDEND			;Check for end and send to QUASAR
	END