Google
 

Trailing-Edge - PDP-10 Archives - tops20_v6_1_tcpip_distribution_tp_ft6 - galaxy-sources/oprqsr.mac
There are 40 other files named oprqsr.mac in the archive. Click here to see a list.
	TITLE	OPRQSR	ORION MODULE TO PROCESS QUASAR MESSAGES
	SUBTTL	Preliminaries

;
;		COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	     1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
;     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  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	GLXMAC,ORNMAC,QSRMAC,ACTSYM
	PROLOG(OPRQSR)
	ERRSET				;INITIALIZE ERROR TABLES
	PARSET				;SETUP PARSER ENTRIES


;Version numbers

	QSRMAN==:74			;Maintenance edit number
	QSRDEV==:114			;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 SNDQSR			;SEND TO QUASAR
TOPS10<	EXTERNAL SNDACT>		;SEND TO ACTDAE
	EXTERNAL GETPAG			;ROUTINE TO SETUP MO
	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
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.

\   ;End of Revision History
	SUBTTL	Table of Contents


;		Table of Contents for OPRQSR
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Revision history . . . . . . . . . . . . . . . . . . .    2
;   3. Table of Contents. . . . . . . . . . . . . . . . . . .    3
;   4. Q$SHUT . . . . . . . . . . . . . . . . . . . . . . . .    4
;   5. Q$CONT . . . . . . . . . . . . . . . . . . . . . . . .    4
;   6. Q$STAR . . . . . . . . . . . . . . . . . . . . . . . .    4
;   7. Q$PAUS . . . . . . . . . . . . . . . . . . . . . . . .    4
;   8. Q$NEXT - NEXT COMMAND PROCESSOR. . . . . . . . . . . .    5
;   9. ARGRTN . . . . . . . . . . . . . . . . . . . . . . . .    6
;  10. CMDEND . . . . . . . . . . . . . . . . . . . . . . . .    7
;  11. BLDOBJ . . . . . . . . . . . . . . . . . . . . . . . .    8
;  12. FINOBJ . . . . . . . . . . . . . . . . . . . . . . . .    8
;  13. Q$FSPA . . . . . . . . . . . . . . . . . . . . . . . .    9
;  14. Q$BSPA . . . . . . . . . . . . . . . . . . . . . . . .    9
;  15. LPTOBJ . . . . . . . . . . . . . . . . . . . . . . . .    9
;  16. Q$ALGN . . . . . . . . . . . . . . . . . . . . . . . .   10
;  17. Q$SUPP . . . . . . . . . . . . . . . . . . . . . . . .   11
;  18. Q$ABOR . . . . . . . . . . . . . . . . . . . . . . . .   12
;  19. PREQNM . . . . . . . . . . . . . . . . . . . . . . . .   13
;  20. PREASN . . . . . . . . . . . . . . . . . . . . . . . .   13
;  21. PUSER/PUSERS . . . . . . . . . . . . . . . . . . . . .   13
;  22. Q$REQU . . . . . . . . . . . . . . . . . . . . . . . .   14
;  23. Q$ROUT . . . . . . . . . . . . . . . . . . . . . . . .   15
;  24. Q$RELE . . . . . . . . . . . . . . . . . . . . . . . .   17
;  25. Q$HOLD . . . . . . . . . . . . . . . . . . . . . . . .   17
;  26. PQTYPE . . . . . . . . . . . . . . . . . . . . . . . .   17
;  27. PNODSW . . . . . . . . . . . . . . . . . . . . . . . .   18
;  28. CNODSW . . . . . . . . . . . . . . . . . . . . . . . .   18
;  29. GNODSW . . . . . . . . . . . . . . . . . . . . . . . .   18
;  30. Q$CANC . . . . . . . . . . . . . . . . . . . . . . . .   19
;  31. CHKRMT . . . . . . . . . . . . . . . . . . . . . . . .   20
;  32. Q$MODI . . . . . . . . . . . . . . . . . . . . . . . .   21
;  33. Q$SET. . . . . . . . . . . . . . . . . . . . . . . . .   22
;  34. SETUSG . . . . . . . . . . . . . . . . . . . . . . . .   23
;  35. SETJOB . . . . . . . . . . . . . . . . . . . . . . . .   24
;  36. SETxxx . . . . . . . . . . . . . . . . . . . . . . . .   25
;  37. SETONL . . . . . . . . . . . . . . . . . . . . . . . .   26
;  38. SETSCH . . . . . . . . . . . . . . . . . . . . . . . .   27
;  39. SCHED. . . . . . . . . . . . . . . . . . . . . . . . .   27
;  40. SCHBAT . . . . . . . . . . . . . . . . . . . . . . . .   28
;  41. SCHCLS . . . . . . . . . . . . . . . . . . . . . . . .   29
;  42. SETNOD . . . . . . . . . . . . . . . . . . . . . . . .   30
;  43. SETDSK . . . . . . . . . . . . . . . . . . . . . . . .   31
;  44. SETTAP . . . . . . . . . . . . . . . . . . . . . . . .   32
;  45. PSTAPE . . . . . . . . . . . . . . . . . . . . . . . .   33
;  46. PSTRUC . . . . . . . . . . . . . . . . . . . . . . . .   33
;  47. PVOLID . . . . . . . . . . . . . . . . . . . . . . . .   33
;  48. PSDEVI . . . . . . . . . . . . . . . . . . . . . . . .   33
;  49. SETINI . . . . . . . . . . . . . . . . . . . . . . . .   34
;  50. SETDEN . . . . . . . . . . . . . . . . . . . . . . . .   35
;  51. SETLBT . . . . . . . . . . . . . . . . . . . . . . . .   35
;  52. SETOVR . . . . . . . . . . . . . . . . . . . . . . . .   35
;  53. SETOWN . . . . . . . . . . . . . . . . . . . . . . . .   36
;  54. SETPRO . . . . . . . . . . . . . . . . . . . . . . . .   36
;  55. SETCNT . . . . . . . . . . . . . . . . . . . . . . . .   36
;  56. SETINC . . . . . . . . . . . . . . . . . . . . . . . .   36
;  57. SETSVI . . . . . . . . . . . . . . . . . . . . . . . .   36
;  58. SETTDP . . . . . . . . . . . . . . . . . . . . . . . .   36
;  59. SETVID . . . . . . . . . . . . . . . . . . . . . . . .   37
;  60. TABSRC . . . . . . . . . . . . . . . . . . . . . . . .   38
;  61. GETDES . . . . . . . . . . . . . . . . . . . . . . . .   39
;  62. GETTAP . . . . . . . . . . . . . . . . . . . . . . . .   40
;  63. SETSTR . . . . . . . . . . . . . . . . . . . . . . . .   41
;  64. SETPOR . . . . . . . . . . . . . . . . . . . . . . . .   42
;  65. Q$SHWS . . . . . . . . . . . . . . . . . . . . . . . .   43
;  66. Q$SHWP . . . . . . . . . . . . . . . . . . . . . . . .   43
;  67. PROSHW . . . . . . . . . . . . . . . . . . . . . . . .   44
;  68. SHWNOD . . . . . . . . . . . . . . . . . . . . . . . .   45
;  69. SHWTAP . . . . . . . . . . . . . . . . . . . . . . . .   46
;  70. SHWSTR . . . . . . . . . . . . . . . . . . . . . . . .   47
;  71. SHWDSK . . . . . . . . . . . . . . . . . . . . . . . .   48
;  72. Q$SHWQ . . . . . . . . . . . . . . . . . . . . . . . .   49
;  73. Q$SHWC . . . . . . . . . . . . . . . . . . . . . . . .   51
;  74. Q$DISM . . . . . . . . . . . . . . . . . . . . . . . .   52
;  75. Q$RECO . . . . . . . . . . . . . . . . . . . . . . . .   52
;  76. Q$UNLO . . . . . . . . . . . . . . . . . . . . . . . .   52
;  77. Q$ESTR . . . . . . . . . . . . . . . . . . . . . . . .   53
;  78. Q$ETAP . . . . . . . . . . . . . . . . . . . . . . . .   54
;  79. Q$DTAP . . . . . . . . . . . . . . . . . . . . . . . .   54
;  80. Q$LOCK . . . . . . . . . . . . . . . . . . . . . . . .   55
;  81. Q$ULOC . . . . . . . . . . . . . . . . . . . . . . . .   55
;  82. Q$MOUN . . . . . . . . . . . . . . . . . . . . . . . .   56
;  83. Q$IDEN . . . . . . . . . . . . . . . . . . . . . . . .   57
;  84. Q$DEFI . . . . . . . . . . . . . . . . . . . . . . . .   58
;  85. Q$SWIT . . . . . . . . . . . . . . . . . . . . . . . .   59
;  86. Q$MODS . . . . . . . . . . . . . . . . . . . . . . . .   60
;  87. Q$SLST . . . . . . . . . . . . . . . . . . . . . . . .   61
;  88. Q$SALC . . . . . . . . . . . . . . . . . . . . . . . .   62
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
	JUMPT	CMDEND			;FINISH OFF COMMAND
	$CALL	P$KEYW			;CHECK FOR KEYWORD
	JUMPF	E$IFC			;ERROR..RETURN
	CAIE	S1,.KYNOD		;WAS IT A NODE
	$RETF				;BAD COMMAND
	$CALL	CNODSW			;YES, TACK IT ON
	$RETIF				;CAN'T
	PJRST	CMDEND			;END THE COMMAND

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
	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?
	$RETF				;NO..ERROR
	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
	PJRST	CMDEND			;NO CHECK FOR END AND RETURN

SUBTTL	Q$PAUS	Process the PAUSE command

Q$PAUS:: $CALL	BLDOBJ			;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

CMDEND:	$CALL	P$CFM			;CHECK FOR CONFIRM
	$RETIF				;NO..INVALID MESSAGE
	ANDI	P3,777			;GET MESSAGE LENGTH
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE MESSAGE SIZE IN MESSAGE
	PJRST	SNDQSR			;SEND THE MESSAGE TO QUASAR
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
	$RETIF				;NOT A KEYWORD..INVALID..RETURN	
	CAILE	S1,.OTMAX		;LESS THAN OR EQUAL VALID OBJECT
	JRST	BLDO.6			;INVALID TYPE..RETURN
	CAIE	S1,.OTBAT		;WAS IT A BATCH BLOCK
	JRST	BLDO.1			;NO..IGNORE CHECK
	MOVE	P1,S1			;SAVE THE NUMBER
	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
	$RETIF				;RETURN FALSE..PASSING RETURN UP
	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
	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	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)		;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
	$RETF				;INVALID COMMAND
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
	MOVE	P1,OBJ.TY(T1)		;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
	$RETF				;INVALID COMMAND..RETURN
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
	$RETF				;RETURN FALSE
	JRST	REQU.4			;PROCESS THE REASON SWITCH
REQU.7:	PJRST	CMDEND			;FINISH THE COMMAND
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
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,OBJ.SZ+1		;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,OBJ.SZ+1		;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.6			;YES,,CONTINUE
ROUT.5:	$CALL	P$KEYW			;GET A KEYWORD
	$RETIF				;NOT THERE,,THATS AN ERROR
	CAXE	S1,.KYALL		;IS IT 'ALL' ???
	$RETF				;NO,,THATS AN ERROR
	SETOM	S1			;Make this all units
ROUT.6:	MOVEM	S1,ARG.DA+OBJ.UN(P3)	;SAVE IT IN THE OBJECT BLOCK
	$CALL	P$SWIT			;Get the node switch
	JUMPF	ROUT.7			;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	ROUT.8			;Go to set node name

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

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

ROUT.8:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;AND SAVE THE SOURCE NODE
	$CALL	OPRENB			;Check OPR's privs
	$RETIF				;NO,,RETURN
	MOVX	S1,.RTEFM		;GET THE BLOCK TYPE
	MOVX	S2,OBJ.SZ+1		;AND THE BLOCK LENGTH
	$CALL	ARGRTN			;AND UPDATE THE MESSAGE

;Get destination information

	$CALL	P$NUM			;Get the destination unit number
	JUMPF	[$CALL	P$KEYW		;Try to get a keyword
		JUMPF	ROUT.3		;None -- check for delete function
		CAXE	S1,.KYALL	;Is it "ALL"?
		$RETF			;No - return bad
		SETOM	S1		;Make it all units
		JRST	ROUT.A]		;Continue
ROUT.A:	CAXLE	S1,77			;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	ROUT.9			;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

ROUT.9:	MOVE	S1,G$OPRA		;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	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
	PJRST	CMDEND			;CHECK FOR THE END
HOLD.3:	$CALL	PUSER			;PROCESS USER FIELD
	JUMPF	HOLD.4			;CHECK OUT * OR /NODE
	PJRST	CMDEND			;END THE MESSAGE
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
	$RETIF				;ERROR .. RETURN
	PJRST	CMDEND			;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)		;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
	CAIE	S1,.SWRSN		;WAS IT /REASON: ??
	$RETF				;NO..RETURN FALSE
	$CALL	PREASN			;PROCESS THE REASON
	JUMPT	CMDEND			;O.K  FINISH OFF MESSAGE
	$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
	MOVX	T1,.STRDV		;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
	$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:: MOVX	S1,.OMSHC		;GET THE SHOW CONFIGURATION CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE CODE
	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:: MOVX	S1,.OMSHS		;GET THE SHOW STATUS CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE CODE
	PJRST	PROSHW			;PROCESS SHOW MESSAGE


SUBTTL	Q$SHWP	Process SHOW PARAMETERS command

;THIS ROUTINE WILL SEND A SHOW PARAMETERS MESSAGE TO QUASAR

Q$SHWP:: MOVX	S1,.OMSHP		;GET SHOW PARAMTERS CODE
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE TIE TYPE CODE
	PJRST	PROSHW			;PROCESS SHOW MESSAGE
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.5			;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
	$CALL	P$CFM			;END OF COMMAND?
	JUMPT	PROS.5			;FINISH OFF BLOCK
PROS.2:	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	PROS.4			;NO..TRY OBJECT BLOCK REMAINDER
	CAIE	S1,.SWNOD		;NODE?
	 JRST	[$CALL	PROSHT		;PROCESS SHORT IF THERE
		$RETIF			;ERROR..RETURN
		PJRST	PROS.5]		;FINISH OFF THE BLOCK
	$CALL	P$NODE			;GET THE NODE
	$RETIF				;ERROR..RETURN
PROS.3:	MOVEM	S1,ARG.DA+OBJ.ND(P3)	;SAVE NODE IN BLOCK
	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	PROS.5			;NO..JUST SAVE OBJECT BLOCK
	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
	JRST	PROS.5			;SAVE THE BLOCK AND FINISH
PROS.4:	$CALL	FINOBJ			;FINISH OBJECT BLOCK
	$RETIF				;NO..ERROR..RETURN
	$CALL	P$SWIT			;SWITCH THERE?
	JUMPF	CMDEND			;CHECK FOR THE END
	$CALL	PROSHT			;PROCESS /SHORT IF THERE
	$RETIF				;ERROR...RETURN
	PJRST	CMDEND			;CHECK FOR END AND SEND IT
PROS.5:	MOVX	S1,.OROBJ		;BLOCK TYPE
	MOVX	S2,.OBJLN		;BLOCK SIZE
	$CALL	ARGRTN			;SAVE THE BLOCK
	ANDI	P3,777			;GET LENGTH OF MESSAGE
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE THE COUNT
	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

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
	PJRST	SNDQSR			;SEND TO QUASAR
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	CMDEND			;END THE COMMAND AND SEND IT
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
	$RETIF				;ERROR..RETURN
	MOVE	S2,(S2)			;GET THE DATA
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAGS
	PJRST	CMDEND			;END THE COMMAND

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

TOPS10 <
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE THE TYPE
	$CALL	PSTRUC			;PROCESS THE STRUCTURE
	$CALL	P$SWIT		;IS THERE A SWITCH?
	JUMPF	CMDEND			;NO, BETTER BE CONFIRM
	CAIE	S1,.SWUSR		;IS IT /USER?
	$RETF				;NO!?
	MOVX	S1,ST.USR		;YES, GET FLAG BIT
	IORM	S1,.OFLAG(MO)		;LIGHT IN MESSAGE TO QUASAR
	PJRST	CMDEND			;END THE COMMAND AND SEND TO QUASAR
> ; End of TOPS10
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
	MOVEI	S2,DSKDSP		;GET DSK TABLE ADDRESS
	JRST	SHWTAB			;DO THE TABLE LOOKUP
SHWD.1:	$CALL	P$PREV			;BACKUP TO DEVICE AND GET DISK
	$CALL	PSTRUC			;CHECK FOR A STRUCTURE
	PJRST	CMDEND			;NOW TRY END AND RETURN

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

	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$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
	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	CMDEND			;CHECK FOR END..AND SEND TO QUASAR
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