Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11i-bm_tops20_v7_0_atpch_1-22 - autopatch/oprqsr.x20
There is 1 other file named oprqsr.x20 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==:144			;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.

\   ;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
	SKIP	G$CLUN			;[144]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
	SKIP	G$CLUN			;[144]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
	SKIP	G$CLUN			;[144]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