Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11J-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]
	PROLOG(OPRQSR)
	ERRSET				;INITIALIZE ERROR TABLES
	PARSET				;SETUP PARSER ENTRIES


;Version numbers

	QSRMAN==:145			;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
	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]

	$DATA	OBJTYP,1		;[125]TYPE OF OBJECT IN MESSAGE
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.

\   ;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

Q$SHUT:: $CALL	BLDOBJ			;BUILD THE OBJECT
	JUMPF	SHUT0			;[141]GO CHECK KEYWORD
	MOVE	S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;[141]Get the object type
;**;[144]At Q$SHUT:+3L add 3 lines JYCW Oct-18-88
	TXNN	S1,.DQLPT		;[144]DQS?
	TXNE	S1,.CLLPT		;[144cluster printer?
	JRST	SHUT1			;[144]yes, check for /cluster-node	
	TXNN	S1,.LALPT		;[141]Is it a LAT?
;**;[144]At Q$SHUT:+7L change 1 line JYCW Oct-18-88
	JRST	SHUT			;[141][144]No,
	$CALL	P$SWIT			;[141] IS THERE ANOTHER SWITCH
	JUMPF	CMDEND			;[141]NO GO SEND COMMAND
	CAIE	S1,.SWTTC		;[141]WAS IT TTY CHARACTERISTIC
;**;[144]At Q$SHUT:+11L change 1 line JYCW Oct-18-88
	JRST	SHUT2			;[144]NO
	$CALL	P$SIXF			;[141]GET SIXBIT FIELD
	$RETIF				;[141]NO GOOD

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

	MOVEM	S1,T4			;[141]SAVE THE TTY CHARACTERISTIC
	MOVEI	S2,2			;[141] TWO WORDS
	MOVEI	S1,T3			;[141]POINT TO THE ARG DATA
	MOVX	T1,.ORTCR		;[141]TTY CHARACT BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;[141]SAVE THE TYPE
	HRLM	S2,ARG.HD(S1)		;[141]SAVE THE TYPE
	$CALL	MOVARG			;[141]MOVE THE BLOCK AND RETURN
;**;[144]At SHUT0:-1L add 1 line JYCW Oct-18-88
	JRST	SHUT1			;[144]FINISH OFF COMMAND

SHUT0:	$CALL	P$KEYW			;[141]CHECK FOR KEYWORD
	JUMPF	E$IFC			;ERROR..RETURN
	CAIE	S1,.KYNOD		;WAS IT A NODE
	$RETF				;BAD COMMAND
	MOVE	S1,OBJTYP		;[125]PICK UP THE OBJECT TYPE
	CAIN	S1,.OTLPT		;[125]A PRINTER?
	$RETF				;[125]YES, RETURN NOW
	$CALL	CNODSW			;ADD THE NODE NAME TO THE MESSAGE
	$RETIF				;CAN'T
	PJRST	CMDEND			;END THE COMMAND
;**;[144]At SHUT0:+10L add routine SHUT: JYCW Oct-18-88
;S1/CONTAINS THE OBJECT TYPE
SHUT:	LOAD	S2,.MSTYP(MO),MS.TYP	;[144]Get the message type
	CAIN 	S2,.OMSHT		;[144]Is this shutdown
	JRST	SHUT1			;[144]Yes, check for /cluster-node
	CAIN	S1,.OTLPT		;[144]IS IT A PRINTER?
	JRST	CMDEND			;[144]Yes, must be a line printer

SHUT1:	$CALL	P$SWIT			;[144]Get a switch
	JUMPF	CMDEND			;[144]None all done
SHUT2:	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.POPJ			;[144]NOT A CLUSTER-NODE SWITCH
	SKIPN	G$CLUN			;[144]REMOTE NODE SPECIFIED?
	JRST	CMDEND			;[144]NO, TREAT AS LOCAL
	PJRST	SNDCLU			;[144]SEND THE MESSAGE TO NEBULA

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.


Q$STAR:: $CALL	Q$SHUTDN		;PROCESS THE!FIRST PART
	$RETIT				;O.K..COMMAND FINISHED
	MOVE	S1,ARG.DA+.OHDRS+OBJ.TY(MO) ;GET THE OBJECT TYPE
	TLNE	S1,LHMASK		;[125]A REMOTE PRINTER?
	$RET				;[125]YES, RETURN THE ERROR
	CAIE	S1,.OTLPT		;IS IT A PRINTER?
	$RETF				;NO..INVALID MESSAGE
	$CALL	P$SWIT			;IS THERE A SWITCH?
	$RETIF				;NO..INVALID COMMAND
	CAIE	S1,.SWDEV		;WAS IT DEVICE?
;**;[144] Q$STAR:+10L change 1 line JYCW Oct-18-88
	JRST	Q$STA			;[144]No, how about /cluster-node
	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	Q$STA1			;[131]NO GO SEND COMMAND
	CAIE	S1,.SWTTC		;[131]WAS IT TTY CHARACTERISTIC
;**;[144]At Q$STAR:+19L change 1 libne JYCW Oct-18-88
	JRST	Q$STA			;[144]NO,WAS IT /CLUSTER-NODE
	$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

;**;[144]At Q$STAR:+29L add 6 lines JYCW Oct-18-88
	$CALL	P$SWIT			;[144]CHECK FOR A SWITCH
	JUMPF	CMDEND			;[144]NONE, SO SEND THE MESSAGE
Q$STA:	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.POPJ			;[144]NOT A CLUSTER-NODE SWITCH
;**;[145]At Q$STA:+2L change 1 line  JCR  10/5/89
	SKIPE	G$CLUN			;[145]Remote node specified?
	PJRST	SNDCLU			;[144]SEND THE MESSAGE TO NEBULA
Q$STA1:	PJRST	CMDEND			;NO CHECK FOR END AND RETURN

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
	$RETT				;O.K...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]Since the /CLUSTER-NODE switch is the last switch, check for that before
;checking for CONFIRM.  This way we don't have to change all the routines to
;check for /CLUSTER-NODE.
;**;[144]At CMDEND:+0L add 9 lines JYCW Oct-18-88
CMDEND:	$CALL	P$SWIT			;[144]Get a switch
	JUMPF	CMDEN1			;[144]None CHECK FOR CONFIRM
	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	CMDEN			;[144]NOT A CLUSTER-NODE SWITCH
	SKIPE	G$CLUN			;[144]REMOTE NODE SPECIFIED?
	PJRST	SNDCLU			;[144]YES, SEND THE MESSAGE TO NEBULA
	SKIPA				;[144]

CMDEN:	$CALL	P$PREV			;[144]Back up one switch

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
	MOVEM	S1,OBJTYP		;[125]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
	SKIPT				;[125]A NUMBER?
	PJRST	LPTTYP			;[125]NO, CHECK FOR A REMOTE LPT
	TLNE	S1,-1			;Ligit number? (Fit in half word)
	PJRST	E$IRS			;No - fake user with illeg. range
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.LRG	;SAVE AS LOW RANGE
	MOVE	P1,S1			;SAVE THE LOW RANGE
	$CALL	P$TOK			;CHECK FOR TOKEN AND RANGE
	JUMPF	BLDO.2			;NO..CHECK FOR NODE
;IGNORE TOKEN
	$CALL	P$NUM			;GET THE OTHER NUMBER
	$RETIF				;INVALID FIELD..NUMBER NEEDED
	CAML	P1,S1			;CHECK FOR VALID RANGE
	PJRST	E$IRS			;UNITS OUT OF RANGE
	TLNE	S1,-1			;Ligit number? (Fit in half word)
	PJRST	E$IRS			;No - fake user with illeg. range
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.HRG	;SAVE THE HIGH RANGE
BLDO.2:	ZERO	ARG.DA+OBJ.ND(P3)	;INITIALIZE NODE FIELD
	$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
	MOVX	S1,.OROBJ		;TYPE OF DATA ELEMENT..OBJ BLOCK
	MOVX	S2,.OBJLN		;SIZE OF THE BLOCK
	PJRST	ARGRTN			;SETUP HEADER,COUNT, POINTER..RETT
BLDO.6:	$CALL	P$PREV			;POSITION TO THE PREVIOUS ONE
	$RETF				;RETURN FALSE
	SUBTTL	LPTTYP	Process a LPT object

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

LPTTYP:CAIE	P1,.OTLPT		;IS THIS A LPT OBJECT?
	$RET				;PRESERVE THE ERROR AC

;CHECK THE TYPE OF LPT

	$CALL	P$KEYW			;PICK UP THE PRINTER TYPE
	$RETIF				;ILLEGALLY FORMATTED COMMAND
LPTTY0:	CAIN	S1,.KYDQS		;IS THIS A DQS LPT?	
	JRST	LPTTY3			;YES, GO PROCESS
	CAIN	S1,.KYLAT		;IS THIS A LAT LPT?
	JRST	LPTTY4			;YES, GO PROCESS
	CAIN	S1,.KYCLU		;[127]IS THIS A CLUSTER LPT?
	JRST	LPTTY1			;[127]YES, GO PROCESS
	CAIE	S1,.KYLOC		;[127]IS THIS A LOCAL LPT?
	$RETF				;NO, INDICATE AN ERROR

;THE LPT OBJECT IS A LOCAL LPT (FROM SHOW STATUS OR SHOW PARAMETER COMMAND)

	MOVX	S1,.LOLPT		;[127]PICK UP THE LOCAL LPT TYPE
	IORM	S1,ARG.DA+OBJ.TY(P3)	;[127]INDICATE IN THE MESSAGE TO QUASAR
	MOVE	S1,G$HOST		;[127]PICK UP THE LOCAL NODE NAME
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;[127]PLACE IN THE OBJECT BLOCK
	$CALL	P$NUM			;[127]CHECK FOR A UNIT NUMBER
	JUMPF	LPTTY5			;[127]NONE, GO INDICATE IN OBJECT BLOCK
	TLNE	S1,-1			;[127]IS THE UNIT NUMBER TOO LARGE?
	PJRST	E$IRS			;[127]YES, INFORM THE OPR
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.LRG ;[127]SAVE THE LOWER UNIT NUMBER
	MOVE	P1,S1			;[127]SAVE THE LOWER UNIT NUMBER
	$CALL	P$TOK			;[127]CHECK FOR THE ":" TOKEN
	JUMPF	LPTTY6			;[127]IF NONE, THEN UPDATE THE BLOCK
	$CALL	P$NUM			;[127]PICK UP THE HIGHER UNIT NUMBER
	$RETIF				;[127]NO NUMBER, INDICATE AN ERROR
	CAMLE	S1,P1			;[127]LOW UNIT NUMBER LESS THAN HIGH?
	TLNE	S1,-1			;[127]YES, IS HIGH UNIT # TOO LARGE?
	PJRST	E$IRS			;[127]YES, INDICATE ILLEGAL RANGE
	STORE	S1,ARG.DA+OBJ.UN(P3),OU.HRG ;[127]SAVE THE HIGHER UNIT NUMBER
	JRST	LPTTY6			;[127]UPDATE THE BLOCK TYPE/LENGTH

;THE LPT OBJECT IS A CLUSTER LPT

LPTTY1:	MOVX	S1,.CLLPT		;[127]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:	$CALL	NOSNAM			;PICK UP THE NODE NAME
	$RET				;RETURN TO THE CALLER

;THE OBJECT IS A DQS LPT

LPTTY3:	MOVX	S2,.DQLPT		;PICK UP THE DQS LPT BIT
	IORM	S2,ARG.DA+OBJ.TY(P3)	;INDICATE IN THE TYPE FIELD
	$CALL	BLDBLK			;FILL IN REST OF THE OBJECT
	$RET				;RETURN TO THE CALL

;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
	$CALL	BLDBLK			;FILL IN REST OF THE OBJECT
	$RET				;PRESERVE ERROR FLAG

;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
LPTTY6:	MOVEI	S1,.OROBJ		;[127]PICK UP THE OBJECT DESCRIPTOR ADR
	MOVEI	S2,.OBJLN		;[127]PICK UP THE OBJECT DESCRIPTOR LEN
	$CALL	ARGRTN			;[127]UPDATE THE BLOCK TYPE/LENGTH
	$RET				;[127]RETURN PRESERVING TRUE/FALSE FLAG
	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
	$RETT				;RETURN TRUE
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
	$RETIF				;ERROR..RETURN
	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
	$RETIF				;ERROR..RETURN
	MOVE	S1,S2			;PLACE TYPE IN S1
	MOVEI	S2,1			;LENGTH OF ARGUMENT IN S2
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH 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
	JUMPF	CMDEND			;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
	JUMPF	CMDEND			;ERROR..CHECK FOR END
ABOR.3:	MOVEI	S2,ABODSP		;ABORT TABLE ADDRESS
	$CALL	TABSRC			;SEARCH THE TABLE
	JUMPT	ABOR.4			;O.K..CONTINUE ON
	CAIN	S1,.SWRSN		;/REASON SWITCH
	JRST	ABOR.5			;PROCESS REASON SWITCH
;**;[144]At ABOR.3:+5L replace 1 line with 5 JYCW Oct-18-88
	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.POPJ			;[144]NOT A CLUSTER-NODE SWITCH
;**;[145]At ABOR.3:+8L change 1 line  JCR  10/5/89
	SKIPE	G$CLUN			;[145]Remote node specified?
	PJRST	SNDCLU			;[144]SEND THE MESSAGE TO NEBULA
	PJRST	CMDEND			;[144]CHECK FOR COMMAND END AND RETURN

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
ABOR.5:	$CALL	PREASN			;PROCESS THE REASON SWITCH
	$RETIF				;NO...ERROR..RETURN
	PJRST	CMDEND			;CHECK FOR COMMAND END AND RETURN

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

PUSER:	MOVX	S1,.CMUSR		;Get user block
	SKIPA				;Skip other entry point
PUSERS:	MOVX	S1,.LSUSR		;List user switch
	PUSH	P,S1			;Save it a sec

;Common work

	$CALL	P$USER			;GET USER DATA
	JUMPF	[POP P,(P)		;ERROR,,PHASE STACK
		 $RETF ]		;AND RETURN
	MOVEM	S1,ARG.DA(P3)		;SAVE THE DATA
	POP	P,S1			;GET USER TYPE
	MOVX	S2,ARG.SZ		;SIZE OF THE ARGUMENT
	PJRST	ARGRTN			;SAVE THE ARGUMENT
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
	JRST	REQU.7			;CHECK FOR A CONFIRM
REQU.5:	CAIN	P1,.OTBAT		;CHECK FOR BATCH
	JRST	REQU.7			;YES..CHECK FOR A CONFIRM
	$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
	JUMPF	REQU.7			;CHECK FOR CONFIRM
	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
;**;[144]At REQU.6:+13L add 3 lines JYCW Oct-18-88
REQU.7:	SKIPN	G$CLUN			;[144]EMOTE NODE SPECIFIED?
	PJRST	CMDEND			;[144]FINISH THE COMMAND
	PJRST	SNDCLU			;[144]YES, SEND THE MESSAGE TO NEBULA
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
	MOVX	S1,.RTETO		;GET THE BLOCK TYPE
	MOVX	S2,.OBJLN+LPTNLN	;[126]GET THE BLOCK LENGTH
	$CALL	ARGRTN			;UPDATE THE MESSAGE

ROUT.3:	$CALL	CMDEND			;Send it off
	$RET				;Return preserving previous return
;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
	$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.
	$RETF				;It isn't!
	$CALL	P$NODE			;GET THE SOURCE NODE if any
	JUMPT	ROUT10			;[125]Go to set node name

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

ROUT.9:	MOVE	S1,G$OPRA		;[125]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

ROUT10:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;[125]AND SAVE THE SOURCE NODE
	$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

;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
	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.
	$RETF				;It isn't!
	$CALL	P$NODE			;GET THE DESTINATION NODE NAME
	JUMPT	ROUT.2			;Go join the common code for
					;  processng the destination node info

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

ROUT14:	MOVE	S1,G$OPRA		;[125]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
	$CALL	LPTTY0			;[126]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
	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
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			;[JW]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
	JUMPF	CMDEND			;NO..CHECK END OF COMMAND
;**;[144]At CANC.2:+2L replace 1 line with 9 JYCW Oct-18-88
	CAIN	S1,.SWRSN		;[144]Was it /REASON: ??
	JRST	CANC.3			;[144]Yes
	$CALL	CHCLUN			;[144]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.POPJ			;[144]NOT A CLUSTER-NODE SWITCH
;**;[145]At CANC.2:+7L change 1 line  JCR  10/5/89
	SKIPE	G$CLUN			;[145]]Remote node specified?
	PJRST	SNDCLU			;[144]SEND THE MESSAGE TO NEBULA
	PJRST	CMDEND			;[144]FINISH OFF COMMAND

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
	MOVE	P2,S1			;SAVE KEYWORD IN P2
	$CALL	P$CFM			;COMMAND HAVE CONFIRM?
	JUMPF	SETJ.1			;TRY CLASS SETTING
	SETO	T2,			;SET A FLAG
	CAIN	P2,.KYNOI		;WAS IT NO OPERATOR INTERVENTION
	MOVEI	T2,.OBNWR		;SET NO OPR INTERVENTION
	CAIN	P2,.KYOIA		;OPR INTERVENTION ALLOWED
	MOVEI	T2,.OBALL		;YES SET OPR INTERVENTION ALLOWED
	JUMPL	T2,.RETF		;INVALID FIELD..RETURN
TOPS10 <
	MOVE	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 <
	MOVE	S1,P1			;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	<
SETJ.1:	CAIE	P2,.KYCLS		;WAS IT CLASS?
	$RETF				;NO..INVALID COMMAND
	$CALL	P$NUM			;GET THE CLASS VALUE
	$RETIF				;ERROR..RETURN
	MOVE	T3,S1			;PLACE CLASS IN BLOCK
	MOVEM	T3,G$ARG2		;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
	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
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
	JUMPT	CMDEND			;END THE COMMAND AND SEND TO 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
	CAIE	T1,.DVUAV		;UNAVAILABLE??
	$RETT				;NO..RETURN TRUE
	$CALL	PREASN			;PROCESS THE REASON
	$RET				;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
	$RETIF				;RETURN IF NOT A DEVICE
	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
	JUMPT	CMDEND			;O.K.. FINISH THE COMMAND
	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
	$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
	MOVEM	S1,ARG.DA(P3)		;SAVE THE USER
	JRST	SETD.2			;FINISH BLOCK AND CONTINUE


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
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPF	PROS.3			;[130]NO, CHECK FOR A NODE SWITCH
	$CALL	ADDOBJ			;[130]ADD THE OBJECT BLOCK TO THE MSG
	JRST	CLUN.1			;[130]GO SEND THE MESSAGE
PROS.3:	CAIE	S1,.SWNOD		;[130]NODE?
	 JRST	[$CALL	PROSHT		  ;PROCESS SHORT IF THERE
		 $RETIF			  ;ERROR..RETURN
		 $CALL	ADDOBJ		  ;[130]ADD THE OBJECT BLOCK TO THE MSG
		 $CALL	P$SWIT		  ;[130]CHECK FOR A CLUSTER NODE SWITCH
		 JUMPF	SNDQSR		  ;[130]IF NONE, SEND THE MSG TO QUASAR
		 JRST	CLUN.1 ]	  ;[130]ELSE DETERMINE WHERE TO SEND TO
	$CALL	P$NODE			;GET THE NODE
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;SAVE NODE IN BLOCK
	$CALL	ADDOBJ			;[130]FINISH BUILDING THE OBJECT BLOCK
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	SNDQSR			;[130]IF NONE, THEN SEND THE MESSAGE
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPT	CLUN.1			;[130]YES, GO SEND THE MESSAGE
	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
	PJRST	SNDQSR			;[130]SEND THE MESSAGE TO QUASAR
PROS.4:	$CALL	FINOBJ			;FINISH OBJECT BLOCK
	$RETIF				;NO..ERROR..RETURN
	$CALL	P$SWIT			;SWITCH THERE?
	JUMPF	CMDEND			;CHECK FOR THE END
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPT	CLUN.1			;[130]YES, GO SEND THE MESSAGE
	CAIE	S1,.SWNOD		;[127]IS IT A NODE SWITCH?
	JRST	PROS.5			;[127]NO, THEN /SHORT SWITCH
	$CALL	P$NODE			;[127]PICK UP THE NODE NAME
	$RETIF				;[127]IF AN ERROR, THEN RETURN
	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;[127]PLACE IN THE MESSAGE
	$CALL	P$SWIT			;[127]CHECK FOR A SWITCH
	JUMPF	CMDEND			;[127]NO, CHECK FOR THE END
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPT	CLUN.1			;[130]YES, GO SEND THE MESSAGE
PROS.5:	$CALL	PROSHT			;[127]PROCESS /SHORT IF THERE
	$RETIF				;ERROR...RETURN
	PJRST	CLUNOD			;[130]GO CHECK FOR A CLUSTER-NODE SWITCH
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
	MOVEI	S1,.OHDRS		;JUST THE HEADER
	STORE	S1,.MSTYP(MO),MS.CNT	;SAVE THE COUNT
	$CALL	P$SWIT			;[130]IS THERE A SWITCH?
	JUMPF	SNDQSR			;[130]NO, SEND THE MESSAGE TO QUASAR
	MOVEI	P3,.OHDRS(MO)		;[130]POINT TO THE NODE BLOCK
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPF	.POPJ			;[130]NO, INDICATE AN ERROR
	SKIPN	G$CLUN			;[130]LOCAL NODE NAME SPECIFIED?
	PJRST	SNDQSR			;[130]YES, SEND THE MESSAGE TO QUASAR
	PJRST	SNDCLU			;[130]SEND THE MESSAGE TO NEBULA
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
	PJRST	CLUNOD			;[130]CHECK FOR CLUSTER-NODE BLOCK
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?
	JUMPF	CMDEND			;NO..FINISH OFF COMMAND
	MOVEI	S2,TAPSWI		;TAPE SWITCHES
SHWTAB:	$CALL	TABSRC			;SEARCH THE TABLE
	JUMPF	SHWT.3			;[142]Not here, could be /CLUSTER
	MOVE	S2,(S2)			;GET THE DATA
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAGS
	$CALL	P$SWIT			;[142]Is there a switch?
	JUMPF	CMDEND			;[142]No end the command

;[142] before we come to here, s1/switch block type from P$SWIT

SHWT.3:	$CALL	CHCLUN			;[142]IS THIS A CLUSTER-NODE SWITCH?
	JUMPT	CLUN.1			;[142]YES, GO SEND THE MESSAGE
	$RETF				;[142]No, back 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
	JUMPF	CMDEND			;NO SWITCH CHECK IF END
	$CALL	CHCLUN			;[130]IS THIS A CLUSTER-NODE SWITCH?
	JUMPT	SHWD.2			;[130]YES, GO SEND THE MESSAGE
	MOVEI	S2,DSKDSP		;GET DSK TABLE ADDRESS
	$CALL	SHOWTB			;[130]DO THE TABLE LOOKUP
	JUMPF	.POPJ			;[130]RETURN ON A MESSAGE FORMAT ERROR
	SKIPA				;[130]CHECK FOR A /CLUSTER-NODE SWITCH

SHWD.1:	$CALL	PSTRRE			;[130]CHECK FOR A STRUCTURE
	$CALL	P$SWIT			;[130]CHECK FOR A SWITCH
	JUMPF	CMDEND			;[130]NONE, SO SEND THE MESSAGE
	$CALL	CHCLUN			;[130]CHECK FOR A CLUSTER-NODE SWITCH
	JUMPF	.POPJ			;[130]NOT A CLUSTER-NODE SWITCH
SHWD.2:	SKIPN	G$CLUN			;[130]REMOTE NODE SPECIFIED?
	JRST	CMDEND			;[130]NO, TREAT AS LOCAL
	PJRST	SNDCLU			;[130]SEND THE MESSAGE TO NEBULA

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
	$CALL	CHCLUN			;[130]Is this a CLUSTER-NODE switch?
	JUMPT	CLUN.1			;[130]Yes, go send the message
	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
	MOVEM	.MSFLG(MO)		;[136]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
	PJRST	CMDEND			;[136]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
	PJRST	CMDEND			;[136]SEND THE MESSAGE TO NEBULA
	SUBTTL	CLUNOD - Send the message as determined by CLUSTER-NODE switch

CLUNOD:	$CALL	P$SWIT			;[130]IS THERE A SWITCH BLOCK?
	JUMPF	CMDEND			;[130]NO, SEND THE MESSAGE TO QUASAR
	$CALL	CHCLUN			;[130]DETERMINE WHERE MSG IS TO BE SENT
	JUMPF	.POPJ			;[130]INDICATE ILLEGAL FORMAT
CLUN.1:	SKIPN	G$CLUN			;[130]LOCAL NODE SPECIFIED?
	JRST	CMDEND			;[130]YES, TREAT AS LOCAL
	PJRST	SNDCLU			;[130]SEND THE MESSAGE AS INDICATED
	SUBTTL	CHCLUN - Modify message for NEBULA

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

	INTERN	CHCLUN			;[135]Make it global

CHCLUN::CAIE	S1,.SWCLN 		;[135]IS IT A CLUSTER-NODE SWITCH?
;**;[144]At CHCLUN:+1L change 1 line JYCW Oct-18-88
	JRST	CHCL.4			;[144]NO, INDICATE SO

	PUSH	P,S1			;[136]SAVE THE SWITCH TYPE
	$CALL	P$CURR			;[130]PICK UP CLUSTER NODE BLOCK ADR
	MOVE	S2,PFD.D1(S1)		;[130]PICK UP THE SWITCH DATA
	CAMN	S2,[-1]			;[130]FOR ALL NODES IN THE CLUSTER?
	JRST	[SETOM	G$CLUN		;[130]INDICATE FOR ALL NODES
		 JRST CHCL.1 ]		;[130]GO MODIFY THE MSG FOR NEBULA
	CAMN	S2,G$HOST		;[130]LOCAL NODE SPECIFIED?
	JRST	CHCL.2			;[130]YES, POINT TO NEXT BLOCK
	MOVEM	S2,G$CLUN		;[130]SAVE THE CLUSTER NODE NAME
CHCL.1:	DMOVE	S1,PFD.HD(S1)		;[130]PICK UP THE CLUSTER NODE BLOCK
	DMOVEM	S1,G$CBLK		;[130]]SAVE FOR LATER
CHCL.2:	$CALL	P$NEXT			;[130]POINT TO THE CONFIRM BLOCK
	POP	P,S1			;[136]RESTORE THE SWITCH TYPE
;**;[144]At CHCL.2:+2L add 5 lines JYCW Oct-18-88
	SKIPN	G$NOFG			;[144]DO WE HAVE /NODE:
	JRST	CHCL.3			;[144]NO ALL DONE
	MOVX	S2,.RMLPT		;[144]GET THE BIT 
	IORM	S2,ARG.DA+.OHDRS+OBJ.TY(MO) ;[144]SET IT IN THE OBJECT BLOCK
	SETZM	G$NOFG			;[144]lCLEAR /NODE: SWITCH FLAG
CHCL.3:	$RETT				;[130]RETURN TO THE CALLER

;**;[144]AT CHCL.3+1L add 2 lines JYCW Oct-18-88
CHCL.4:	SETZM	G$NOFG			;[144]CLEAR /NODE: SWITCH FLAG
	$RETF				;[144]ALL DONE
	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.

SNDCLU:	$CALL	P$CFM			;[130]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
	$CALL	SNDNEB			;[130]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
	JUMPF	CMDEND			;CAN'T
	$CALL	CHCLUN			;[133]CHECK FOR CLUSTER NODE SWITCH
	JUMPT	CLUN.1			;[133]GO SEND THE MSG IF CLUSTER SWITCH
	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
MOUN.1:	PJRST	CLUNOD			;[133]CHECK FOR A /CLUSTER-NODE SWITCH
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
	$RETIF				;ERROR..RETURN
	CAIE	S1,.KYNOD		;BETTER BE NODE
	$RETF				;NO..RETURN FALSE
	$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
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
	$CALL	PSTAPE			;PROCESS A TAPE BLOCK
	PJRST	CMDEND			;TRY TO FINISH COMMAND IN ANY CASE
>;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