Google
 

Trailing-Edge - PDP-10 Archives - BB-JR93K-BB_1990 - 10,7/galaxy/operat/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	Murray Berkowitz/PJT/LWS	12-SEP-85

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

	SEARCH	GLXMAC,ORNMAC,QSRMAC,ACTSYM
	PROLOG(OPRQSR)

	ERRSET				;INITIALIZE ERROR TABLES
	PARSET				;SETUP PARSER ENTRIES


	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

	OPRVRS==:OPRVRS			;LET LINK CATCH VERSION SKEWS
	%%.OPR==:%%.OPR

	ENTRY	BLDOBJ			;BUILD OBJECT BLOCK
	ENTRY	ARGRTN			;SETUP ARGUMENT IN MESSAGE
	ENTRY	CMDEND			;COMMAND END PROCESSING

SUBTTL	Table of Contents

;               TABLE OF CONTENTS FOR OPRQSR
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. Q$SHUT  Process SHUTDOWN command..........................   3
;    3. Q$CONT  Process CONTINUE command..........................   3
;    4. Q$STAR  Process START command.............................   3
;    5. Q$PAUS  Process the PAUSE command.........................   3
;    6. ARGRTN  Setup an argument header..........................   4
;    7. CMDEND  Process end of command and send the message.......   5
;    8. BLDOBJ  Build an object block.............................   6
;    9. FINOBJ  Finish object block after type field..............   6
;   10. Q$FSPA  Process FORWARDSPACE command......................   7
;   11. Q$BSPA  Process BACKSPACE command.........................   7
;   12. LPTOBJ  Setup printer object block........................   7
;   13. Q$ALGN  Process ALIGN command.............................   8
;   14. Q$SUPP  Process suppress command..........................   9
;   15. Q$ABOR  Process ABORT command.............................  10
;   16. PREQNM  Process /REQUEST switch...........................  11
;   17. PREASN  Process /REASON switch............................  11
;   18. PUSER   Process USER block................................  11
;   19. Q$REQU  Process REQUEUE command...........................  12
;   20. Q$ROUT  Process ROUTE command.............................  13
;   21. Q$RELE  Process RELEASE command...........................  15
;   22. Q$HOLD  Process HOLD command..............................  15
;   23. PQTYPE  Process QUEUE type field..........................  15
;   24. PNODSW  Process /NODE switch..............................  16
;   25. CNODSW  Validate a /NODE switch...........................  16
;   26. GNODSW  Get /NODE argument if present.....................  16
;   27. Q$CANC  Process CANCEL command............................  17
;   28. CHKRMT  Check for remote node input.......................  18
;   29. Q$MODI  Process MODIFY command............................  19
;   30. Q$SET   Process the SET command...........................  20
;   31. SETUSG  Process SET USAGE command.........................  21
;   32. SETJOB  Set operator values for a job.....................  22
;   33. SETxxx  Process SET PARAMETERS............................  23
;   34. SETONL  Process SET ONLINE command (TOPS20)...............  24
;   35. SETSCH  Process SET SCHEDULER command (TOPS20)............  25
;   36. SCHED   Do the SKED% JSYS (TOPS20)........................  25
;   37. SCHBAT  Process SET SCHEDULER BATCH command (TOPS20)......  26
;   38. SCHCLS  Process SET SCHEDULER CLASS command (TOPS20)......  27
;   39. SETNOD  Process SET NODE command (DN60)...................  28
;   40. SETDSK  Process SET DISK command (TOPS20).................  29
;   41. SETTAP  Process SET TAPE command (TOPS20).................  30
;   42. PSTAPE  Process tape drive argument.......................  31
;   43. PSTRUC  Process structure argument........................  31
;   44. PVOLID  Process volume-id argument........................  31
;   45. PSDEVI  Process a device argument.........................  31
;   46. SETINI  Process SET TAPE INITIALIZE command...............  32
;   47. SETDEN  Process /DENSITY switch...........................  33
;   48. SETLBT  Process /LABEL switch.............................  33
;   49. SETOVR  Process /OVERIDE switch...........................  33
;   50. SETOWN  Process /OWNER switch.............................  34
;   51. SETPRO  Process /PROTECTION switch........................  34
;   52. SETCNT  Process /COUNT switch.............................  34
;   53. SETINC  Process /INCREMENT switch.........................  34
;   54. SETSVI  Process /START switch.............................  34
;   55. SETTDP  Process /TAPE-DISPOSITION switch..................  34
;   56. SETVID  Process /VOLUME-ID switch.........................  35
;   57. TABSRC  Table search routine..............................  36
;   58. GETDES  Get device designator word........................  37
;   59. GETTAP  Get a tape device.................................  38
;   60. SETSTR  Process SET STRUCTURE command (TOPS20)............  39
;   61. Q$SHWS  Process SHOW STATUS command.......................  40
;   62. Q$SHWP  Process SHOW PARAMETERS command...................  40
;   63. PROSHW  Process SHOW STATUS and SHOW PARAMETERS...........  41
;   64. SHWNOD  Process node for SHOW STATUS/PARAMETERS command...  42
;   65. SHWTAP  Process SHOW STATUS TAPE command..................  43
;   66. SHWSTR  Process SHOW STATUS STRUCTURES command............  44
;   67. SHWDSK  Process SHOW STATUS DISK command..................  45
;   68. Q$SHWQ  Process SHOW QUEUES command.......................  46
;   69. Q$SHWC  Process SHOW CONTROL-FILE command.................  47
;   70. Q$DISM  Process DISMOUNT command (TOPS20).................  48
;   71. Q$RECO  Process RECOGNIZE command (TOPS10)................  48
;   72. Q$UNLO  Process UNLOAD command............................  48
;   73. Q$ESTR  Process ENABLE AUTOMATIC-STRUCTURE-RECOGNITION....  49
;   74. Q$ETAP  Process ENABLE TAPE command.......................  50
;   75. Q$DTAP  Process DISABLE TAPE command......................  50
;   76. Q$LOCK  Process LOCK command..............................  51
;   77. Q$ULOC  Process UNLOCK command............................  51
;   78. Q$MOUN  Process MOUNT TAPE and DISK command...............  52
;   79. Q$IDEN  Process IDENTIFY command..........................  53
;   80. Q$DEFI  Process DEFINE command (DN60 or LAT)..............  54
;   81. Q$SWIT  Process SWITCH command (TOPS20)...................  55
;   82. Q$MODS  Process MODIFY SYSTEM-LISTS command (TOPS10)......  56
;   83. Q$SLST  Process SHOW SYSTEM-LISTS command (TOPS10)........  57
;   84. Q$SALC  Process SHOW ALLOCATION command (TOPS10)..........  58
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
;**;[76] Change EDIT 75. Would cause to much grief. 2-Nov-83
	TXNN	S1,DV.DSK		;[75][76] DISK ON /DEVICE: ?
	PJRST	CMDEND			;NO,,CHECK FOR END AND RETURN
	PJRST	E$IDS			;[75] YES,,INVALID DEVICE SPECIFIED

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	Event queuing -- EVTMSG - Build message


; This routine will build the appropriate Event Queue request
; by parsing the OPR data.  Note that the only switches handled
; here are switches defined in EVTSWT in OPRCMD. Event dependent
; switches should be defined to preceed the event independent
; switches in EVTSWT. The switch processor's address for the event
; dependent switches should be passed in S2. This event dependent
; switch processor should IORM any bit flags into EVTSWD or build
; the appropriate message blocks. If the event dependent switch
; processor fails to parse a switch encountered, P$PREV should be
; called before returning TRUE. Event dependent switches are parsed
; FIRST.
;
; "Generic" event command syntax:
;
;  <command keywords> <date/time field> <dependent switches> <independent switches>
;
; EVTMSG should be called with the <date/time field> as the next field to
; parse, unless "flag" is lit. (see below)
;
; Call:	MOVE	S1, Flag,,Event type code (.EVxxx)
;	MOVE	S2, event dependent switch processor address or zero
;	PUSHJ	P,EVTMSG
;
; Where "Flag" (the sign bit) is set to indicate an auto file
; parse is being done.

EVTMSG::SETZM	EVTSWD			;CLEAR TEMP SWITCH STORAGE
	SETZM	EVTSWI
	MOVEM	S1,G$ARG1		;SAVE EVENT TYPE CODE
	MOVEM	S2,G$ARG2		;SAVE OPTIONAL SWITCH PROCESSOR ADDRESS
	MOVE	S1,G$HOST		;GET HOST NAME
	PUSHJ	P,OPRENB		;CHECK OPR PRIVS
	JUMPF	.POPJ			;GIVE UP
	MOVEI	S1,.QOCQE		;MESSAGE TYPE IS SHORT CREATE
	STORE	S1,.MSTYP(MO),MS.TYP	;STORE IT
	MOVX	S1,MF.ACK		;GET THE ACK BIT
	IORM	S1,.MSFLG(MO)		;WANT A RESPONSE FROM QUASAR

; Queue type
	MOVEI	S1,.OTEVT		;OBJECT TYPE "EVENT"
	MOVEM	S1,ARG.DA(P3)		;SAVE
	MOVEI	S1,.QCQUE		;BLOCK TYPE
	MOVEI	S2,ARG.SZ		;BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE BLOCK HEADER

; Event type
	HRRZ	S1,G$ARG1		;GET EVENT TYPE CODE
	MOVEM	S1,ARG.DA(P3)		;SAVE
	MOVEI	S1,.QBEVT		;BLOCK TYPE
	MOVEI	S2,ARG.SZ		;BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE BLOCK HEADER

; Possible auto file check
	SKIPL	G$ARG1			;FLAG SET?
	JRST	EVTM.0			;NO
	PUSHJ	P,EVTFIL		;PARSE FILESPEC
	JUMPF	.POPJ			;RETURN

; Time arguments
EVTM.0:	PUSHJ	P,EVTTIM		;PARSE ALL TIME RELATED ARGUMENTS
	JUMPF	.POPJ			;PROPAGATE ERRORS BACK

; Event dependent switches
EVTM.1:	SKIPN	G$ARG2			;EVENT DEPENDENT SWITCH PROCESSOR?
	JRST	EVTM.2			;NO, GO LOOK FOR INDEPENDENT SWITCHES
	PUSHJ	P,@G$ARG2		;YES, CALL PROCESSOR
	JUMPF	.POPJ			;JUST RETURN IF PROBLEMS

; Event independent switches
EVTM.2:	PUSHJ	P,P$SWIT		;LOOK FOR INDEPENDENT SWITCHES
	JUMPF	EVTM.3			;CONTINUE IF NONE FOUND
	MOVEI	S2,EVTSTB		;GET SWITCH TABLE ADDRESS
	PUSHJ	P,TABSRC		;LOOK FOR SWITCH PROCESSOR
	JUMPF	.POPJ			;RETURN IF NOT FOUND
	PUSHJ	P,(S2)			;PROCESS SWITCH
	JUMPT	EVTM.2			;LOOK FOR MORE INDEPENDENT SWITCHES

EVTM.3:	PUSHJ	P,P$CURR		;SET PARSER STRAIGHT
	SKIPE	EVTSWD			;ANY SWITCHES SPECIFIED?
	JRST	EVTM.4			;YES, PUT THEM IN MESSAGE
	SKIPN	EVTSWI
	$RETT				;NO, ALL DONE

EVTM.4:	DMOVE	S1,EVTSWD		;GET SWITCHES (DEPENDENT AND INDEPENDENT)
	DMOVEM	S1,ARG.DA(P3)		;PUT IN MESSAGE
	MOVEI	S1,.QBESW		;GET BLOCK TYPE
	MOVEI	S2,ARG.SZ+.QBESI	;GET BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE BLOCK HEADER
	$RETT				;RETURN

	INTERN	EVTSWD			;MAKE IT GLOBAL

EVTSWD:	BLOCK	1			;EVENT DEPENDENT SWITCH STORAGE
EVTSWI:	BLOCK	1			;EVENT INDEPENDENT SWITCH STORAGE

EVTSTB:	$STAB
	.SWFIL,,EVTFIL			;FILESPEC PROCESSOR
	.SWFSF,,EVTFSF			;FAILSOFT SWITCH PROCESSOR
	.SWRSN,,EVTRSN			;REASON SWITCH PROCESSOR
	$ETAB
SUBTTL	Event queuing -- EVTTIM - Parse date/time

; Routine to parse:
;	DAILY (AT) time
;	EVERY weekday (AT) time
;	NOW
;	date/time

EVTTIM:	SETZM	G$ARG3			;CLEAR REPEAT FLAGS

; EVERY weekday (AT) time
	PUSHJ	P,P$KEYW		;GET A KEYWORD
	JUMPF	EVTT.2			;TRY FOR A DATE/TIME
	CAIE	S1,.KYWKY        	;WAS IT SET KSYS "EVERY"
	JRST	EVTT.1			;NO--TRY "DAILY"
	PUSHJ	P,P$KEYW		;GET DAY-OF-WEEK
	JUMPF	.POPJ			;RETURN IF DON'T HAVE IT
	CAIL	S1,0			;RANGE CHECK
	CAILE	S1,6			;..
	$RETF				;BAD WEEKDAY INDEX
	TXO	S1,QB.WKY		;LITE "EVERY" FLAG
	MOVEM	S1,G$ARG3		;SAVE TEMPORARILY
	JRST	EVTT.2			;GO GET TIME

; DAILY (AT) time
EVTT.1:	CAIE	S1,.KYDLY		;WAS IT SET KSYS "DAILY"?
	JRST	EVTT.3			;NO,,GO CHECK FOR "NOW"
	MOVX	S1,QB.DLY		;YES,,GET DAILY FLAG
	MOVEM	S1,G$ARG3		;SAVE TEMPORARILY

; Parse time field used by EVERY and DAILY syntax
EVTT.2:	PUSHJ	P,P$TIME		;GET TIME
	JUMPF	.POPJ			;IT'S NOT THERE
	JRST	EVTT.4			;GO FINISH UP

; NOW
EVTT.3:	CAIE	S1,.KYNOW		;IS IT "NOW"
	$RETF				;NOPE
	MOVX	S1,QB.NOW		;YES,,GET NOW FLAG
	MOVEM	S1,G$ARG3		;SAVE TEMPORARILY
	MOVEI	S1,-1			;GET A RH -1

; Save expiration date/time
EVTT.4:	MOVEM	S1,ARG.DA(P3)		;SAVE
	MOVEI	S1,.QBAFT		;BLOCK TYPE
	MOVEI	S2,ARG.SZ		;BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE BLOCK HEADER

; Save repeat flags
EVTT.5:	MOVE	S1,G$ARG3		;GET REPEAT FLAGS
	MOVEM	S1,ARG.DA(P3)		;SAVE
	MOVEI	S1,.QBREP		;BLOCK TYPE
	MOVEI	S2,ARG.SZ		;BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE BLOCK HEADER
	$RETT				;AND RETURN
SUBTTL	Event queuing -- Event independent switch parsing

; Here to parse /FILE
EVTFIL:	PUSHJ	P,P$IFIL		;GET INPUT FILESPEC
	JUMPF	.POPJ			;RETURN ON ERRORS
	MOVEI	TF,.QBFIL		;FILESPEC BLOCK
	STORE	TF,ARG.HD(S1),AR.TYP	;SAVE
	PUSHJ	P,MOVARG		;COPY FD INTO MESSAGE

	MOVEI	S1,.FPFAS		;ASCII FILE FORMAT
	MOVEM	S1,ARG.DA(P3)		;SAVE
	MOVEI	S1,.QBPTP		;BLOCK TYPE
	MOVEI	S2,ARG.SZ		;BLOCK SIZE
	PUSHJ	P,ARGRTN		;WRITE THE BLOCK HEADER
	$RETT				;RETURN

; Here to process /REASON
EVTRSN:	PUSHJ	P,P$TEXT		;GET A TEXT
	JUMPF	.POPJ			;PROPAGATE ERRORS BACK
	MOVEI	T1,.QBMSG		;BLOCK TYPE
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE CORRECT TYPE IN HEADER
	PUSHJ	P,MOVARG		;COPY INTO MESSAGE
	$RETT				;AND RETURN

; Here to process /FAILSOFT

EVTFSF:	MOVX	S1,QB.FSF		;GET FAILSOFT BIT
	IORM	S1,EVTSWI		;LITE IN TEMP FLAG WORD
	$RETT				;RETURN
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:	LOAD	S1,ARG.DA+OBJ.UN(P3),OU.LRG ;GET LOW END OF RANGE
	LOAD	S2,ARG.DA+OBJ.UN(P3),OU.HRG ;GET HIGH END OF RANGE
	SKIPN	S2			;IF NO HIGH END,
	MOVE	S2,S1			;USE LOW END AS HIGH END
	SUB	S2,S1			;GET NUMBER OF OBJECTS IN RANGE
	CAXLE	S2,MXUNIT		;WITHIN REASON?
	PJRST	E$IRS			;NO, GIVE AN ERROR
	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			;CHECK FOR VALID OBJECT TYPE
	CAILE	S1,.OTMAX
	$RETF				;NOT AN OBJECT TYPE
	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

NOFLAG:	BLOCK	1			;NON-ZERO IF "NO" KEYWORD

Q$SET::	SETZM	NOFLAG			;HAVEN'T SEE "NO" YET
	$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
	PUSHJ	P,P$KEYW##		;GET A KEYWORD
	$RETIF				;RETURN ON ERRORS
	CAIE	S1,.KYNO		;"NO"?
	JRST	SET.1A			;NO
	SETOM	NOFLAG			;REMEMBER FOR LATER
	PUSHJ	P,P$KEYW##		;GET A KEYWORD
	$RETIF				;RETURN ON ERRORS
SET.1A:	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
	XWD	.KYPLT,[-PLTCNT,,PLTDSP] ;PLT
	XWD	.KYNQC,[-NQCCNT,,NQCDSP] ;NETWORK-QUEUE-CONTROLLER
SETOBJ:	XWD	.KYFAL,[-FALCNT,,FALDSP] ;FAL-STREAM
	XWD	.KYJOB,SETJOB		;PROCESS JOB SETTING OPTIONS
	XWD	.KYTAP,SETTAP		;SET TAPE COMMAND
TOPS10< XWD	.KYKSY,SETKSY		;SET KSYS COMMAND
	XWD	.KYUSG,SETUSG		;SET USAGE
	XWD	.KYSYS,SETSYS		;SET SYSTEM PARAMETER (LOGMAX, ETC.)
>;END TOPS10
TOPS20 <
	XWD	.KYSCH,SETSCH		;SET BIAS COMMAND
	XWD	.KYDSK,SETDSK		;SET DISK COMMAND
	XWD	.KYSTR,SETSTR		;SET STRUCTURE 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	.KYSOI,[[1,,.STSOI],,SETSOI]	;SYSTEM-OPR-INTERVENTION
	XWD	.KYTIM,[[ARG.SZ+1,,.STTIM],,SETTIM] ;SET TIME LIMITS
BATCNT==.-BATDSP

CDPDSP:!
LPTDSP:!
PLTDSP:!
PTPDSP:!
OUTDSP:	XWD	.KYFOT,[[ARG.SZ,,.STFRM],,SETFRM]   ;FORMS-TYPE
	XWD	.KYLEA,[[ARG.SZ,,.STLEA],,SETLEA]   ;LIMIT-EXCEED-ACTION
	XWD	.KYLP2,[[ARG.SZ+1,,.STLP2],,SETLP2] ;LP20-SIMULATION
	XWD	.KYMTA,[[ARG.SZ,,.STMTA],,SETMTA]   ;MAGTAPE
	XWD	.KYOPL,[[ARG.SZ+1,,.STOPL],,SETOPL] ;OUTPUT-LIMITS
	XWD	.KYPGL,[[ARG.SZ+1,,.STPGL],,SETPGL] ;PAGE-LIMITS
	XWD	.KYPRL,[[ARG.SZ+1,,.STPRI],,SETPRI] ;PRIORITY-LIMITS
	XWD	.KYUTY,[[ARG.SZ+1,,.STUTY],,SETUTY] ;UNIT-TYPE
CDPCNT==.-CDPDSP
LPTCNT==.-LPTDSP
PLTCNT==.-PLTDSP
PTPCNT==.-PTPDSP

;FAL-STREAM Dispatch Table

FALDSP:	XWD	.KYNET,[[ARG.SZ,,.STNTY],,SETNTY] ;NETWORK-TYPE
	FALCNT==.-FALDSP

;NETWORK-QUEUE-CONTROLLER dispatch table
NQCDSP:	XWD	.KYATR,[[ARG.SZ+1,,.STATR],,SETNQX] ;ATTRIBUTE
NQCCNT==.-NQCDSP
SUBTTL	Q$CLOSE	Process the CLOSE LOG command

;THIS ROUTINE WILL PROCESS THE CLOSE COMMAND AND CLOSE THE LOG FILE

Q$CLOSE::
	MOVX	S1,FWMASK		;POINT TO ALL NODES
	$CALL	OPRENB			;MUST BE SYSTEM OPR
	$RETIF
	PUSHJ	P,P$NEXT		;POINT PAST 'LOG' KEYWORD
	MOVEI	S1,.EVOPR		;GET LOG FILE CLOSURE EVENT CODE
	SETZM	S2			;NO SWITCH PROCESSOR
	PUSHJ	P,EVTMSG		;GO BUILD THE EVENT MESSAGE
	JUMPF	.POPJ			;RETURN IF PROBLEMS
	PJRST	CMDEND			;SEND MESSAGE TO QUASAR

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
	MOVE	S1,S2			;COPY EVENT TYPE TO S1
	SETZM	S2			;ASSUME BILLING CLOSURE
	CAIE	S1,.EVBIL		;WAS IT?
	MOVEI	S2,USGSWT		;NO, NEED DEPENDENT SWITCH PROCESSOR
	PUSHJ	P,EVTMSG		;CALL EVENT MESSAGE ROUTINE
	JUMPF	.POPJ			;RETURN IF PROBLEMS
	PJRST	CMDEND			;ELSE PARSE CONFIRM AND TELL QUASAR

USGSWT:	$CALL	P$SWITCH		;LOOK FOR A SWITCH
	JUMPF	.RETT			;NONE,,MIGHT STILL BE OK
	CAXE	S1,.SWNOS		;IS IT /NO-SESSION-ENTRIES ???
	JRST	[PUSHJ P,P$PREV		;NO, BACKUP PARSER AND RETURN
		 $RETT]
	MOVX	S1,US.NOS		;YES, NO SESSION ENTRY FLAG
	IORM	S1,EVTSWD		;   AND LIGHT IT
	$RETT				;RETURN

USGTBL:	$STAB
	.KYUBC,,.EVBIL			;BILLING-CLOSURE
	.KYUFC,,.EVUSG			;FILE-CLOSURE
	$ETAB

SUBTTL	SETKSY	Set KSYS command to stop timesharing

SETKSY:	MOVEI	S1,.EVKSY		;EVENT TYPE IS KSYS
	MOVEI	S2,KSYSWT		;SPECIAL SWITCH PROCESSOR
	PUSHJ	P,EVTMSG		;BUILD AN EVENT CREATE MESSAGE
	JUMPF	.POPJ			;FAILED
	PJRST	CMDEND			;CONFRM SEND SEND MESSAGE TO QUASAR

KSYSWT:	PUSHJ	P,P$SWIT		;GET A SWITCH
	JUMPF	.RETT			;IF NOT GIVE UP
	MOVEI	S2,KSWTAB		;GET ADDRESS OF CANNED STRING TABLE
	PUSHJ	P,TABSRC		;LOOK FOR CANNED REASON STRINGS
	JUMPF	[PUSHJ P,P$PREV		;BACKUP PARSER FOR EVENT SWITCH PARSER
		 $RETT]			;RETURN
	MOVE	S1,S2			;GET ADDRESS OF FAKE TEXT BLOCK
	HLRZ	S2,(S2)			;GET LENGTH OF FAKE TEXT BLOCK
	PUSHJ	P,MOVARG		;COPY REASON TEXT TO MESSAGE
	$RETT				;AND RETURN

;Canned reason switch text table

KSWTAB:	$STAB
	.SWCM,,[XWD 7,.QBMSG
		ASCIZ\Corrective system maintenance\]
	.SWNEW,,[XWD 5,.QBMSG
		ASCIZ\New monitor\]
	.SWPM,,[XWD 7,.QBMSG
        	ASCIZ\Preventive system maintenance\]
	.SWSA,,[XWD 7,.QBMSG
		ASCIZ\System will be stand alone\]
	.SWSCH,,[XWD ^D8,.QBMSG
		 ASCIZ\Scheduled system shutdown\]
	$ETAB
SUBTTL	SET SYSTEM PARAMETER COMMAND

SETSYS:	PUSHJ	P,P$KEYW		;GET NEXT KEYWORD
	JUMPF	E$IFC			;BOMB IF NO KEYWORD FOUND
	MOVEI	S2,SETTAB		;GET TABLE TO SEARCH
	PUSHJ	P,TABSRC		;LOOK FOR PROCESSING ROUTINE
	JUMPF	E$IFC			;COMPLAIN IF NOT FOUND
	PJRST	(S2)			;JUMP TO PROCESSING ROUTINE

SETTAB:	$STAB
	.KYBMX,,SETBMX			;SET SYSTEM BATMAX
	.KYBMN,,SETBMN			;SET SYSTEM BATMIN
	.KYCMX,,SETCMX			;SET SYSTEM CORMAX
	.KYCMN,,SETCMN			;SET SYSTEM CORMIN
	.KYDAT,,SETDAT			;SET SYSTEM DATE
	.KYDAY,,SETDAY			;SET SYSTEM DAYTIME
	.KYLMX,,SETLMX			;SET SYSTEM LOGMAX
	.KYSCD,,SETSCD			;SET SYSTEM SCHEDULE
	.KYCSZ,,SETCSZ			;SET SYSTEM DISK-CACHE-SIZE
	$ETAB
SUBTTL	SET BATMAX, BATMIN, and LOGMAX Commands

;Process SET BATMAX

SETBMX:	PUSHJ	P,SETCOM		;EXECUTE SOME COMMON CODE
	$RETIF				;SOME PROBLEMS
	MOVE	T1,S2			;SAVE JOBMAX
	MOVEI	S2,[ASCIZ\BATMAX\]	;GET SOME TEXT FOR TYPEOUT
	PUSHJ	P,BATCOM		;DO COMMON RANGE CHECK
	JUMPF	.RETT			;JUS RETURN IT ERROR
	CAILE	S1,(T1)			;GREATER THAN JOBMAX??
	JRST	[MOVEI	S2,SETIBN	;BATMAX TOO BIG
		 JRST	SETX.1]
	HRLI	S1,.STBMX		;NO, BUILD AC FOR UUO
	PJRST	SETXCT			;GO DO THE SETUUO

;Process SET BATMIN

SETBMN:	PUSHJ	P,SETCOM		;EXECUTE THE COMMON CODE
	$RETIF				;RETURN IF PROBLEMS
	MOVE	T1,S2			;SAVE JOBMAX
	MOVEI	S2,[ASCIZ\BATMIN\]	;GET SOME TEXT FOR TYPEOUT
	PUSHJ	P,BATCOM		;DO COMMON RANGE CHECK
	JUMPF	.RETT			;RETURN IF ERROR
	CAILE	S1,-1(S2)		;MUST BE LESS THAN JOBMAX-1
	JRST	[MOVEI	S2,SETIBN	;INVALID BATMIN VALUE
		 JRST	SETX.1]
	HRLI	S1,.STBMN		;GET SET BATMIN FUNCTION CODE
	PJRST	SETXCT			;GO DO THE SETUUO

SETIBN:	ITEXT	(< ^T/@G$ARG1##/ must be less than current JOBMAX of ^D/G$ARG3##/ ^0>)

;Common BATMAX, BATMIN code

BATCOM:	MOVEM	S2,G$ARG1##		;SAVE IT
	CAIL	S1,0			;RANGE CHECK
	CAIL	S1,INPMAX		; QUASAR'S MAXIMUM
	SKIPA	S2,[SETIBV]		;GET ADDRESS OF ERROR ITEXT
	$RETT
	PUSHJ	P,SETX.1		;GO COMPLAIN
	$RETF

SETIBV:	ITEXT	(< Specified ^T/@G$ARG1##/ value, ^D/G$ARG2##/, out of range 0:^D/[INPMAX-1]/ ^0>)

;Process SET LOGMAX

SETLMX:	PUSHJ	P,SETCOM		;EXECUTE THE COMMON CODE
	$RETIF				;RETURN IF FALSE
	MOVEI	T1,[ASCIZ\LOGMAX\]	;GET SOME TEXT FOR TYPEOUT
	MOVEM	T1,G$ARG1##		;SAVE IT
	CAIL	S1,1			;RANGE CHECK
	CAILE	S1,(S2)
	JRST	[MOVEI	S2,SETLIR	;GET ITEXT ADDRESS
		 JRST	SETX.1]
	HRLI	S1,.STLMX		;GET SET LOGMAX FUNCTION CODE
					;FALL INTO CODE TO DO SETUUO

;Common code to do SETUUO for SET BATMAX, BATMIN, and LOGMAX commands.

SETXCT:	SETUUO	S1,			;DO THE SETUUO
	SKIPA	S2,SETERR(S1)		;GET ERROR ITEXT ADDRESS
	MOVEI	S2,SETAOK		;LOAD ADDRESS OF SET OK TEXT
SETX.1:	MOVEI	S1,^D50			;50 WORDS ENOUGH FOR BUFFER
	PJRST	GENACK			;GO ACK THE OPR

SETLIR:	ITEXT	(< LOGMAX must be in range 1:^D/G$ARG3##/ (JOBMAX) ^0>)

;Common subroutine for SET BATMAX, BATMIN, and LOGMAX commands.
;
;RETURNS TRUE	S1/ Command argument (integer)
;		S2/ Number of jobs monitor built for (JOBN)
;RETURNS FALSE	If invalid command format or OPR not priv'd

SETCOM:	MOVE	S1,G$HOST		;GET HOST NAME
	PUSHJ	P,OPRENB		;CHECK PRIVS
	$RETIF				;TOO BAD
	PUSHJ	P,P$NUM			;GET THE ARGUMENT
	JUMPF	E$IFC			;COMPLAIN IF BAD COMMAND
	MOVEM	S1,G$ARG2##		;SAVE FOR TYPEOUT
	PUSHJ	P,P$CFM			;VALIDATE LAST PART OF COMMAND
	JUMPF	E$IFC			;COMPLAIN IF BAD COMMAND
	MOVE	S2,[EXP %CNSJN]		;GET MAXIMUM NUMBER OF JOBS
	GETTAB	S2,
	PJRST	E$IFC			;SHOULD NOT HAPPEN
	MOVEI	S2,-1(S2)		;KEEP RH ONLY (ONE LESS FOR NULL JOB)
	MOVEM	S2,G$ARG3##		;SAVE FOR TYPEOUT
	MOVE	S1,G$ARG2##		;GET COMMAND ARG BACK
	$RETT				;RETURN TO CALLER
SUBTTL	SETCMX/SETCMN - Process SET SYSTEM CORMAX and SET SYSTEM CORMIN Commands

SETCMX:	SKIPA	P1,[EXP .STCXP]		;GET SET CORMAX (PAGES) FUNCTION CODE
SETCMN:	MOVEI	P1,.STCNP		;GET SET CORMIN (PAGES) FUNCTION CODE
	MOVE	S1,G$HOST		;CHECK OPR PRIVS
	PUSHJ	P,OPRENB
	$RETIF
	PUSHJ	P,CORWDS		;GET USER ARG IN NUMBER OF WORDS
	JUMPF	E$IFC			;COMPLAIN IF PROBLEMS
	MOVEM	S1,G$ARG2##		;SAVE 
	MOVEM	S2,G$ARG3##		;SAVE "K" OR "P"
	PUSHJ	P,P$CFM			;SEE IF CONFIRMED
	JUMPF	E$IFC			;COMPLAIN IF NOT
	CAIE	P1,.STCXP		;SETTING CORMAX?
	JRST	SETC.1			;NO, GO DO SOME CORMIN CHECKS
	MOVEI	S2,[ASCIZ\CORMAX\]	;GET TEXT FOR ERROR TYPEOUT
	MOVEM	S2,G$ARG1##		;SAVE IT
	MOVE	S2,[%VMRMC]		;ASK MONITOR FOR MAXIMUM VALUE
	JRST	SETC.2			;JUMP TO COMMON CODE AGAIN
SETC.1:	MOVEI	S2,[ASCIZ\CORMIN\]	;GET TEXT FOR TYPEOUT
	MOVEM	S2,G$ARG1##		;SAVE IT
	MOVE	S2,[%NSCMX]		;CORMIN CAN'T BE GREATER THAN CORMAX
SETC.2:	GETTAB	S2,			;GET MAXMAX OR CORMAX
	MOVE	S2,[<^D512*^D512>-1]	;SIGH, USE A REASONABLE DEFAULT
	MOVE	S1,G$ARG2##		;GET VALUE OPR REQUESTED
	CAMLE	S1,S2			;ASKING FOR TOO MUCH?
	SOS	S1,S2			;YES, SET TOO MAXIMUM ALLOWED
	ADR2PG	S1			;CONVERT FROM WORDS TO PAGES
	CAIN	P1,.STCXP		;SETTING CORMAX?
	TRO	S1,400000		;WANT "SOFT" CORMAX
	HRL	S1,P1			;SET UP AC FOR UUO
	SETUUO	S1,			;DO THE UUO
	JRST	SETC.3			;MUST BE NO PRIVS
	CAIE	P1,.STCXP		;SET CORMAX?
	SKIPA	S1,[%NSCMN]		;NO, GET INDEX FOR CORMIN
	MOVE	S1,[%NSCMX]		;YES, GET INDEX FOR CORMAX
	GETTAB	S1,			;ASK THE MONITOR
	MOVE	S1,G$ARG2##		;ASSUME IT SET WHAT WAS ASKED FOR
	MOVNI	S2,^D9			;GET WORDS TO PAGES LSH ARG
	MOVEI	TF,"P"			;ASSUME PAGES
	CAME	TF,G$ARG3##		;WAS IT?
	SOS	S2			;NO, BETTER BE "K"
	LSH	S1,(S2)			;CONVERT TO SAME UNITS AS ENTERED
	MOVEM	S1,G$ARG2##		;SAVE CURRENT VALUE AGAIN
	SKIPA	S2,[[ITEXT(< Set accepted, ^T/@G$ARG1##/ is now ^D/G$ARG2##/^7/G$ARG3##/ ^0>)]]
	MOVEI	S2,NOPRVS
 	TRNA
SETC.3:	MOVE	S2,SETERR(S1)		;GET SETUUO ERROR CODE ITEXT ADDRESS
	MOVEI	S1,^D50			;250 CHARS SHOULD BE ENOUGH FOR TEXT
	PJRST	GENACK			;GO SETUP ACK AND RETURN
SUBTTL	CORWDS - Parse Core Argument in SET SYSTEM CORMAX/CORMIN Commands

;CORWDS - Routine used by SETCMX and SETCMN to parse OPR core argument
;specified in the SET SYSTEM CORMAX/CORMIN commands.
;
;	Returns: S1/	amount of core in words
;		 S2/	"K" or "P" (for pretty typeout)
;
;	Returns FALSE if parse fails

CORWDS:	PUSHJ	P,P$FLD			;GET ARG USER TYPED
	$RETIF
	AOS	S1			;BUMP PAST TEXT HEADER WORD
	HRLI	S1,(POINT 7,0)		;BUILD A BYTE POINTER
	MOVEI	S2,^D10			;GET RADIX
	PUSHJ	P,S%NUMI		;READ THE NUMBER
	$RETIF				;RETURN IF PROBLEMS
	PUSHJ	P,.SAVE1		;SAVE P1
	EXCH	S1,S2			;S1=NUMBER, S2=UPDATED BYTE POINTER
	LDB	TF,S2			;GET CHAR THAT TERMINATED NUMBER SCAN
	MOVEI	P1,^D9			;GET PAGES TO WORDS LSH ARG
	JUMPE	TF,CORW.1		;IF JUST NUMBER, ASSUME ARG IS IN "K"
	ILDB	S2,S2			;GET ANOTHER CHAR, IF THERE
	JUMPN	S2,.RETF		;ONLY 1 CHAR CAN FOLLOW NUMBER
	CAIE	TF,"P"			;CHECK FOR "P"AGES
	CAIN	TF,"p"
	JRST	CORW.2			;HE DID SAY "P"
	CAIE	TF,"K"			;HOW 'BOUT "K"
	CAIN	TF,"k"
CORW.1:	AOSA	P1			;HE SAID "K", NEED TO SHIFT ONE MORE
	$RETF
CORW.2:	LSH	S1,(P1)			;CONVERT ARGUMENT TO WORDS
	MOVE	S2,TF			;GET "K" OR "P"
	JUMPE	S2,CORW.3		;IF NONE, ASSUME "K"
	CAILE	S2,"P"			;UPPER CASE?
	SUBI	S2," "			;NO, MAKE IT UPPER CASE
	$RETT				;RETURN
CORW.3:	MOVEI	S2,"K"			;ASSUME "K"
	$RETT				;RETURN
SUBTTL	SETDAT - Process SET SYSTEM DATE Command

SETDAT:	PUSHJ	P,P$TIME		;GET DATE IN UDT FORMAT
	JUMPF	E$IFC			;COMPLAIN IF PROBLEMS
	MOVE	P1,S1			;SAVE UDT
	PUSHJ	P,P$CFM			;MAKE SURE CONFIRMED
	JUMPF	E$IFC
	MOVEI	S1,[ASCIZ\DATE\]	;GET TEXT FOR ERROR TYPEOUT
	MOVEM	S1,G$ARG1##		;SAVE IT
	MOVE	S1,P1			;GET UDT BACK
	PUSHJ	P,S%U2DT		;GET DATE IN PROPER FORMAT
	HRLI	S2,.STDAT		;GET SET DATE CODE
	SETUUO	S2,			;SET THE DATE
	SKIPA	S2,SETERR(S2)		;GET ERROR TEXT
	MOVEI	S2,[ITEXT(< Set accepted, current date is now ^H9/[-1]/ ^0>)]
	MOVEI	S1,^D50			;GET 50 WORDS FOR BUFFER
	PJRST	GENACK			;GENERATE ACK AND RETURN
SUBTTL	SETDAY - Process SET SYSTEM DAYTIME Command

SETDAY:	PUSHJ	P,P$TIME		;GET UDT OF TIME
	JUMPF	E$IFC			;LEAVE IF NOT THERE
	MOVE	P1,S1			;COPY UDT
	PUSHJ	P,P$CFM			;SEE IF CONFIRMED
	JUMPF	E$IFC
	MOVEI	S1,[ASCIZ\DAYTIME\]	;GET ADDRESS OF SOME TYPEOUT TEXT
	MOVEM	S1,G$ARG1##		;SAVE IT
	HRRZ	S1,P1			;JUST GET TIME-PAST-MIDNIGHT
	PUSHJ	P,.UD2SC##		;CONVERT TO SECONDS
	HRLI	S1,.STTMS		;GET SET TIME PAST MIDNIGHT CODE
	SETUUO	S1,			;SET THE TIME
	SKIPA	S2,SETERR(S1)		;GET THE ERROR ITEXT
	MOVEI	S2,[ITEXT(< Set accepted, current time is now ^C/[-1]/ ^0>)]
	MOVE	P1,S1			;COPY ERROR CODE, IF ONE AT ALL
	MOVEI	S1,^D50			;GET 50 WORDS FOR BUFFER
	PJRST	GENACK			;GENERATE ACK FOR OPR AND RETURN
SUBTTL	SETSCD - Process SET SYSTEM SCHEDULE Command

SETSCD:	PUSHJ	P,P$NUM			;GET SCHEDULE BITS FROM OPR
	JUMPF	E$IFC			;COMPLAIN IF PROBLEM
	MOVE	P1,S1			;SAVE NUMBER
	PUSHJ	P,P$CFM			;LOOK FOR CONFIRM
	JUMPF	E$IFC
	MOVEI	S1,[ASCIZ\SCHEDULE\]	;GET TEXT ADDRESS FOR TYPEOUT
	MOVEM	S1,G$ARG1##		;SAVE IT
	TDNE	P1,[777777,,776060]	;LOOK FOR INVALID BITS
	JRST	SETS.1			;THERE WERE, GO COMPLAIN
	MOVE	S1,P1			;COPY ARG BACK
	HRLI	S1,.STSCH		;GET SET SCHEDULE CODE
	SETUUO	S1,			;SET SCHED
	SKIPA	S2,SETERR(S1)		;GET ITEXT ADDRESS FOR ERROR
	MOVEI	S2,[ITEXT(< Set accepted, SCHEDULE is now ^O6R0/P1/ ^0>)]
	TRNA
SETS.1:	MOVEI	S2,[ITEXT(< Illegal SCHEDULE bits in ^O/P1/, command ignored ^0>)]
	MOVEI	S1,^D50			;GET 50 WORDS FOR BUFFER
	PJRST	GENACK			;GENERATE ACK TEXT AND RETURN
SUBTTL	SETCSZ - Process SET SYSTEM DISK-CACHE-SIZE Command

SETCSZ:	PUSHJ	P,P$CFM			;SEE IF CONFIRM
	JUMPT	[MOVX	P1,%LDOCS	;<CR> HERE MEANS USE CONFIGURED SIZE
		 GETTAB	P1,		;ASK MONITOR
		   JRST	E$IFC		;HUH?
		 JRST	SETCS1]		;CONTINUE
	PUSHJ	P,P$NUM			;GET NEW CACHE SIZE
	JUMPF	E$IFC			;COMPLAIN IF PROBLEM
	MOVE	P1,S1			;SAVE NUMBER
	PUSHJ	P,P$CFM			;LOOK FOR CONFIRM
	JUMPF	E$IFC
SETCS1:	MOVEI	S1,[ASCIZ\DISK-CACHE-SIZE\] ;GET TEXT ADDRESS FOR TYPEOUT
	MOVEM	S1,G$ARG1##		;SAVE IT
	MOVE	S1,P1			;COPY ARG BACK
	HRLI	S1,.STCSZ		;GET SET CACHE SIZE CODE
	SETUUO	S1,			;SET CACHE SIZE
	SKIPA	S2,SETERR(S1)		;GET ITEXT ADDRESS FOR ERROR
	MOVEI	S2,[ITEXT(< Set accepted, DISK-CACHE-SIZE is now ^D/P1/ blocks ^0>)]
	MOVEI	S1,^D50			;GET 50 WORDS FOR BUFFER
	PJRST	GENACK			;GENERATE ACK TEXT AND RETURN
SUBTTL	GENACK - Generate ACK Text for ORION Processed OPR Commands

;GENACK - Routine to copy generate ACK text to be sent to OPR using
;the new way, i.e. putting address of ASCIZ text in G$ERR and setting
;up G$APBF and G$APFG.
;
;	Call:	S1/	Number of words text will need (less than a page)
;		S2/	Address of ITEXT for ACK text

GENACK:	PUSH	P,S2			;SAVE ADDRESS OF ITEXT
	PUSHJ	P,M%GMEM		;ASK GLXMEM FOR MEMORY REQUESTED
	HRLM	S1,G$APBF##		;SAVE NUMBER OF WORDS TO BE RETURNED
	HRRM	S2,G$APBF##		;SAVE ADDRESS OF ABOVE WORDS
	MOVEM	S2,G$ERR##		;SAVE ADDRESS OF BUFFER
	POP	P,S1			;GET ITEXT ADDRESS BACK
	$TEXT	(<-1,,(S2)>,<^I/(S1)/^A>) ;COPY ACK TEXT TO BUFFER
	MOVEI	S1,'ACK'		;A NONDESCRIPT SUFFIX
	MOVEM	S1,G$APFG##		;SET IT FOR SPECIAL PROCESSING
	$RETT				;RETURN, ACKING THE OPR

;Error messages

SETAOK:	ITEXT	(< Set accepted, ^T/@G$ARG1##/ is now ^D/G$ARG2##/ ^0>)
SETERR:	[ITEXT	(< Insufficient privileges to set ^T/@G$ARG1##/ ^0>)]
NOPRVS:	[ITEXT	(< Insufficient privileges to set ^T/@G$ARG1##/ ^0>)]
	[ITEXT  (< This error, code 2, should not happen trying to set ^T/@G$ARG1##/ ^0>)]
	[ITEXT  (< Illegal time specified ^0>)]
>;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


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

SETLP2:	MOVE	S1,[.OFLNO,,.OFLYE]	;SET LP20 SIMULATION
	SKIPE	NOFLAG			;"NO" TYPED?
	MOVSS	S1			;YES
	HRRZM	S1,ARG.DA(P3)		;SAVE SIMULATION TYPE IN MESSAGE
	ADDI	P3,ARG.SZ		;BUMP TO NEXT LOCATION
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	PJRST	CMDEND			;END THE COMMAND


;HERE TO SET UNIT-TYPE
SETUTY:!

;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

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

;Here to handle NETWORK-TYPE
SETNTY:	PUSHJ	P,P$KEYW		;GET THE KEYWORD
	$RETIF
	MOVEI	S2,NTYTAB		;GET KEYWORD TABLE ADDRESS
	PUSHJ	P,TABSRC		;LOOK FOR KEYWORD
	$RETIF
	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

NTYTAB:	$STAB
	.KYANF,,ST.ANF			;FAL-STREAM TYPE
	.KYDCN,,ST.DCN
	$ETAB
;SET MAGTAPE PARAMETERS
SETMTA:	ADDI	P3,ARG.SZ		;ADVANCE TO FIRST SWITCH STORAGE
	AOS	.OARGC(MO)		;ACCOUNT FOR NULL BLOCK
SETMT1:	PUSHJ	P,P$SWIT##		;GET A SWITCH
	JUMPF	CMDEND			;PROBABLY EOL
	MOVSI	S2,-MTALEN		;AOBJN POINTER
SETMT2:	HLRZ	TF,MTATAB(S2)		;GET BLOCK TYPE
	CAIN	TF,(S1)			;MATCH?
	JRST	SETMT3			;YES
	AOBJN	S2,SETMT2		;LOOP
	$RETF				;BAD MESSAGE
SETMT3:	STORE	S1,ARG.HD(P3),AR.TYP	;SAVE SWITCH BLOCK TYPE IN MESSAGE
	MOVEI	S1,ARG.SZ		;ASSUME STANDARD TWO WORD BLOCK
	STORE	S1,ARG.HD(P3),AR.LEN	;SAVE IN MESSAGE
	HRRZ	S1,MTATAB(S2)		;GET DISPATCH ADDRESS
	PUSHJ	P,(S1)			;PROCESS SWITCH
	JUMPT	SETMT1			;LOOP BACK FOR ANOTHER
	$RETF				;ELSE GIVE UP

MTATAB:	.SWMDN,,MTAMDN			;/DENSITY
	.SWMDI,,MTAMDI			;/DIRECTORY-FILE
	.SWMLT,,MTAMLT			;/LABEL-TYPE
	.SWMRL,,MTAMRL			;/MULTI-REEL
	.SWMPR,,MTAMPR			;/PARITY
	.SWMTK,,MTAMTK			;/TRACKS
	.SWMVS,,MTAMVS			;/VOLUME-SET
MTALEN==.-MTATAB			;LENGTH OF TABLE


;DENSITY
MTAMDN:	JSP	S1,MTAXXX		;SET DENSITY
	$STAB
	  .KYDFL,,.TFD00		;DEFAULT
	  .KY800,,.TFD80		;800
	  .KY200,,.TFD20		;200
	  .KY556,,.TFD55		;556
	  .KY800,,.TFD80		;800
	  .KY160,,.TFD16		;1600
	  .KY625,,.TFD62		;6250
	$ETAB

;DIRECTORY-FILE
MTAMDI:	MOVEI	S1,MTADNY		;SET DIRECTORY-FILE
	PJRST	MTAXXX			;ENTER COMMON CODE

;LABEL-TYPE
MTAMLT:	JSP	S1,MTAXXX		;SET LABEL TYPE
	$STAB
	  .KYDFL,,-1			;DEFAULT
	  .KYANS,,%TFANS		;ANSI LABELS
	  .KYEBC,,%TFEBC		;EBCDIC 
	  .KYUNL,,%TFUNL		;UNLABELED TAPE
	$ETAB

;MULTI-REEL
MTAMRL:	MOVEI	S1,MTADNY		;SET MULTI-REEL
	PJRST	MTAXXX			;ENTER COMMON CODE

;PARITY
MTAMPR:	JSP	S1,MTAXXX		;SET PARITY
	$STAB
	  .KYDFL,,.OBMPD		;DEFAULT
	  .KYODD,,.OBMPO		;ODD
	  .KYEVN,,.OBMPE		;EVEN
	$ETAB

;TRACKS
MTAMTK:	JSP	S1,MTAXXX		;SET TRACKS
	$STAB
	  .KYDFL,,.TMDRD		;DEFAULT
	  .KY7TK,,%TRK7			;7-TRACKS
	  .KY9TK,,%TRK9			;9-TRACKS
	$ETAB

;VOLUME-SET
MTAMVS:	PUSHJ	P,P$QSTR##		;GET A QUOTED STRING
	SKIPT				;CHECK FOR ERRORS
	PUSHJ	P,P$FLD##		;MAYBE JUST A FIELD
	$RETIF				;RETURN IF NO QUOTED STRING OR FIELD
	MOVSI	S2,ARG.DA(S1)		;START OF TEXT
	HRRI	S2,ARG.DA(P3)		;WHERE TO PUT IT
	LOAD	S1,ARG.HD(S1),AR.LEN	;GET BLOCK LENGTH
	ADDI	S1,ARG.DA		;PLUS OVERHEAD
	STORE	S1,ARG.HD(P3),AR.LEN	;SET BLOCK SIZE IN MESSAGE
	ADDI	S1,(P3)			;COMPUTE END OF BLT
	BLT	S2,-1(S1)		;COPY TEXT
	AOS	P3,S1			;BUMP THE POINTER
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	$RETT				;RETURN

; COMMON MAGTAPE SET ROUTINE
MTAXXX:	PUSH	P,S1			;SAVE TABLE ADDRESS
	PUSHJ	P,P$KEYW##		;FETCH KEYWORD
	POP	P,S2			;GET TABLE ADDRESS BACK
	$RETIF				;CHECK FOR ERRORS
	PUSHJ	P,TABSRC		;LOOK FOR KEYWORD
	$RETIF
	MOVEM	S2,ARG.DA(P3)		;SAVE IN THE MESSAGE
	ADDI	P3,ARG.SZ		;BUMP THE POINTER
	AOS	.OARGC(MO)		;BUMP THE ARGUMENT COUNT
	$RETT				;RETURN

;DEFAULT/NO/YES TABLE
MTADNY:	$STAB
	  .KYDFL,,.OBMRD		;DEFAULT
	  .KYNO ,,.OBMRN		;NO
	  .KYYES,,.OBMRY		;YES
	$ETAB
;SET NETWORK-QUEUE-CONTROLLER

SETNQX:	PUSHJ	P,P$KEYW		;GET THE KEYWORD
	$RETIF
	MOVEI	S2,NQXTAB		;GET KEYWORD TABLE ADDRESS
	PUSHJ	P,TABSRC		;LOOK FOR KEYWORD
	$RETIF
	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

NQXTAB:	$STAB
	.KYNQI,,%NQINP			;INPUT-STREAM
	.KYNQO,,%NQOUT			;OUTPUT-STREAM
	$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
	$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

>;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				;BETTER BE DRIVE NUMBER
	CAIE	S1,.KYDRV		;IS IT?
	$RETF				;NO..RETURN FALSE
	$CALL	P$NUM			;GET DRIVE NUMBER
	$RETIF				;NO..ERROR..RETURN
	MOVEM	S1,ARG.DA+1(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,3			;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

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%DTA		;DECTAPE?
	TXNE	S2,DV%MTA		;MAGTAPE?
	SKIPA				;LET EITHER THROUGH
	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:	SKIPN	ARG.DA(S1)		;[77] DEVICE BETTER NOT BE ZERO!!!!
	STOPCD	(PBI,HALT,,<P$DEV blew it>)	;[77] (SIGH) SOME PARSER
	$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
	MOVE	S1,T1			;[75] RESTORE ARGUMENTS	AND SAVE
	EXCH	S2,T2			;[75]  DEVCHR BITS
	MOVX	T1,.CMDEV		;TAPE DEVICE BLOCK
	STORE	T1,ARG.HD(S1),AR.TYP	;SAVE THE TYPE
	$CALL	MOVARG			;[75] MOVE THE BLOCK
	MOVE	S1,T2			;[75] GET DEVCHR BITS
	$RET				;[75] 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 S1/	SIXBIT DEVICE NAME (TOPS10)
;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 <
	INTERN	GETDES
GETDES:	HRROI	S1,ARG.DA(S1)		;GET STRING ADDRESS
	HRRZM	S1,G$ARG1		;SAVE STRING POINTER
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	MOVE	S1,S2			;COPY SIXBIT DEVICE NAME
	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
	.KYFOR,,S.FORN			;FOREIGN
	.KYREG,,S.REGU			;REGULATED
	.KYUAV,,S.UAVL			;UNAVAILABLE
	.KYURG,,S.UREG			;UNREGULATED
	.KYIGN,,S.IGNO			;IGNORE
	$ETAB
>;END TOPS20
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

Q$SHQN::MOVX	S1,.OMSQN		;SHOW QUEUE-NAMES
	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
	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
SUBTTL	SHWDSK	Process SHOW STATUS DISK command

;THIS ROUTINE WILL DO SHOW STATUS OF DISK DRIVES

SHWDSK:	MOVEI	S1,.ODSHD		;SHOW STATUS COMMAND
	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

	LS.XXX==LS.FST!LS.ALL!LS.SUM	;Contradictory list control switches

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

	MOVEI	S2,SHQSWT		;Point at switch table
	$CALL	TABSRC			;Check for a match
	$RETIF				;If an error
	MOVE	S2,(S2)			;Get the bit for the switch
	MOVX	S1,LS.XXX		;Get the listing control bits
	TDNE	S2,S1			;Did they specify a control switch?
	TDNN	S1,.OFLAG(MO)		;Yes, don't allow contradictions here
	SKIPA				;All is goodness, skip
	$RETF				;Contradictory switch, error
	IORM	S2,.OFLAG(MO)		;Light it
	JRST	SHWQ.3			;Try for another switch

;  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


;  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

;Switches for the SHOW QUEUES command

SHQSWT:	$STAB
	.SWALL,,[LS.ALL]		;/ALL
	.SWSHT,,[LS.FST]		;/SHORT
	.SWSUM,,[LS.SUM]		;/SUMMARY
	.SWRMT,,[LS.RMT]		;/REMOTE
	$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
DISM.0:	$CALL	P$SWIT			;TRY FOR A SWITCH
	JUMPF	CMDEND			;NO SWITCH, BETTER CONFIRM
	SETZM	S2			;INDICATE NO SWITCH MATCH YET
	CAIN	S1,.SWREM		;IS IT /REMOVE?
	MOVX	S2,.DMRMV		;YES, SET THAT BIT
TOPS10<	CAIN	S1,.SWNCK		;IS IT /NOCHECK?
	MOVX	S2,.DMNCK		;YES, SET THAT BIT
>;END TOPS10
	JUMPE	S2,.RETF		;IF NO LEGAL SWITCH, ERROR
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAG BITS
	JRST	DISM.0			;TRY FOR ANOTHER SWITCH

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$ETSR - ENABLE TIMESHARING


TOPS10	<

Q$ETSR::MOVE	S1,G$HOST		;GET LOCAL HOST
	PUSHJ	P,OPRENB		;CHECK OPR PRIVS
	JUMPF	.POPJ			;GIVE UP
	JUMPN	P1,ETSR.1		;JUMP IF DISABLE
	MOVEI	S1,.OMETS		;CODE FOR ENABLE TIMESHARING
	STORE	S1,.MSTYP(MO),MS.TYP	;SAVE IN MESSAGE
	PJRST	CMDEND			;SEND TO QUASAR AND RETURN

ETSR.1:	MOVE	S1,[XWD .STKSY,-1]	;TURN OF TIMESHARING
	SETUUO	S1,
	TRNA
	PJRST	E$TSD
	MOVEM	S1,G$ARG1		;SAVE ERROR CODE
	PJRST	E$DTF
> ;END TOPS-10 CONDITIONAL
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
	CAIN	S1,.SWOSN		;WAS IT /OVERRIDE-SET-NUMBER?
	MOVX	S2,.DMOSN		;YES
	JUMPE	S2,.RETF		;ERROR IF NO SWITCH SPECIFIED
	IORM	S2,.OFLAG(MO)		;SAVE THE FLAG BITS
	JRST	MOUN.1			;TRY FOR MORE

>;END TOPS10
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, DQS, or LAT)

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

IFN FTUUOS!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
> ;END IFN FTUUOS!FTDN60

TOPS10 <
	CAIN	S1,.KYFAL		;IS IT DEFINE FILE-ACCESS?
	JRST	DEFFAL			;YES, GO DO THAT
	CAIN	S1,.KYQNM		;IS IT DEFINE QUEUE-NAME?
	JRST	DEFQNM			;YES, GO DO THAT
>

	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,.KYLAT		;WAS IT LAT-SERVER?
	MOVX	T1,DF.LAT		;LAT
IFN FTDN60,<
	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
>; END IFN FTDN60
	CAIN	S1,.KYSRV		;WAS IT SERVER?
	MOVX	T1,DF.SRV		;SERVER
	JUMPE	T1,.RETF		;ERROR..RETURN FALSE
	STORE	T1,DEF.TY(P3),DF.TPP	;Save the type
	CAIE	S1,.KYLAT		;Was is LAT-server?
	JRST	DEFI.1			;No, keep checking
	PUSHJ	P,DEFLAT		;Process the LAT switches
	JUMPT	DEFI.2			;No errors: finish message
	$RET				;
DEFI.1:					;
IFN FTDN60,<
	CAIN	S1,.KYSRV		;WAS IT SERVER?
	JRST	DEFI.2			;YES, END OF MESSAGE
	PUSHJ	P,DEFD60		;PROCESS DN60 SWITCHES
	$RETIF				;ERROR..RETURN
>; END IFN FTDN60
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

;  GET LAT SWITCHES

DEFLAT:	$CALL	.SAVE1			;Save P1
DEFL.1:	$CALL	P$SWIT			;Look for a switch
	JUMPF	.RETT			;None: finished
	MOVEI	S2,LATDSP		;Address of table
	$CALL	TABSRC			;Search the table
	$RETIF				;Error: return
	ADD	S2,P3			;Convert offset to address
	MOVEM	S2,P1			;
	$CALL	P$FLD			;Get the text string
	$RETIF				;Error: return
	HRLI	S1,1(S1)		;Source,,0
	HRR	S1,P1			;Source,,destination
	ADD	S2,P1			;Calculate ending address
	BLT	S1,-2(S2)		;Copy the text string
	JRST	DEFL.1			;Look for another switch

LATDSP:	$STAB				;
	.SWSVR,,DEF.LA+0		;Server
	.SWSVC,,DEF.LA+4		;Service
	.SWPOR,,DEF.LA+10		;Port
	$ETAB

;  GET DN60 SWITCHES

IFN FTDN60,<
DEFD60:	$CALL	P$SWIT			;Get the switch for signon/no- required
	SETZ	T1,			;Start at none
	JUMPF	DEFD.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

DEFD.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$KEYW			;SEE IF CPU KEYWORD
	JUMPF	DEFD.2			;IF NOT, MUST BE OLD STYLE CMD
	$CALL	P$NUM			;GET CPU NUMBER
	$RETIF				;IF NONE, BAD COMMAND
	CAIL	S1,0			;RANGE CHECK
	CAILE	S1,5
	$RETF				;BAD NUMBER
	SETZM	T4			;INIT PORT ARGUMENT
	STORE	S1,T4,C1.1CN		;SAVE CPU NUMBER
	$CALL	P$KEYW			;GET PORT TYPE
	$RETIF				;BAD COMMAND
	MOVEI	S2,PRTDSP		;PORT TYPE TABLE
	$CALL	TABSRC			;SEARCH THE TABLE
	$RETIF				;PASS ERROR UP
	STORE	S2,T4,C1.1TY		;CONTINUE BUILDING PORT DESGINATION
	$CALL	P$NUM			;GET PORT NUMBER
	$RETIF
	CAIL	S1,0			;RANGE CHECK
	CAILE	S1,7
	$RETF
	STORE	S1,T4,C1.1PN		;COMPLETE NEW STYLE PORT
	HLRZM	T4,DEF.PT(P3)		;STORE IN MESSAGE
	$CALL	P$KEYW			;GET LINE KEYWORD (BETTER BE THERE!)
	$RETIF
	JRST	DEFD.4			;JOIN COMMON CODE

PRTDSP:	$STAB
	.KYD10,,.C11DL			;DL-10 PORT TYPE
	.KYD20,,.C11DT			;DTE-20
	$ETAB

DEFD.2:	$CALL	P$NUM			;GET THE PORT NUMBER
	$RETIF				;ERROR..RETURN
	CAIG	S1,7			;DL10 PORT?
	JRST	[MOVEM S1,DEF.PT(P3)	;YES, STORE IT AND GET LINE NUMBER
		 JRST  DEFD.4]
	MOVS	T4,S1			;GET ARG IN LH FOR NEW TYPE ARG BUILD
	ANDX	T4,C1.1PN		;NO, KEEP ONLY DTE NUMBER
	MOVX	S1,.C11DT		;GET DTE PORT TYPE CODE
	STORE	S1,T4,C1.1TY		;STORE IT (CPU NUMBER IS ZERO)
	HLRZM	T4,DEF.PT(P3)		;SAVE THE PORT NUMBER
DEFD.4:	$CALL	P$NUM			;GET THE LINE NUMBER
	$RETIF				;ERROR..RETURN
	MOVEM	S1,DEF.LN(P3)		;SAVE THE LINE NUMBER
	$RETT				;NO..ERROR..RETURN
>; END IFN FTDN60

TOPS10 <

;PROCESS THE DEFINE FILE-ACCESS COMMAND

DEFFAL:	MOVX	S1,.OMODB		;GET THE OBJECT DATA MESSAGE TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;STORE IN THE MESSAGE HEADER
	MOVX	S1,.OTFAL		;GET THE OBJECT TYPE FOR FAL
	MOVEM	S1,ARG.DA(P3)		;STORE THE OBJECT TYPE
	MOVX	S1,.ORTYP		;GET THE OBJECT TYPE ARGUMENT BLOCK
	MOVX	S2,ARG.SZ		;GET THE LENGTH OF THE BLOCK
	$CALL	ARGRTN			;SAVE THE ARGUMENT
	$CALL	P$KEYW			;GET THE NEXT KEYWORD
	$RETIF				;ERROR..RETURN
	CAIN	S1,.KYREJ		;REJECTION LIST?
	JRST	DEFFRJ			;YES, GO READ THAT
	CAIE	S1,.KYDPP		;NO, DEFAULT PPN?
	$RETF				;NO. RETURN ERROR
	$CALL	P$USER			;GET THE DEFAULT PPN
	$RETIF				;ERROR..RETURN
	MOVEM	S1,ARG.DA(P3)		;STORE IN THE DATA BLOCK
	MOVX	S1,.ORDPP		;GET THE BLOCK TYPE
	MOVX	S2,ARG.SZ		;GET THE LENGTH OF THE BLOCK
	$CALL	ARGRTN			;FINISH OFF THE BLOCK
	PJRST	CMDEND			;FINISH THE COMMAND AND SEND IT

DEFFRJ:	MOVX	T4,<<1000-.OHDRS-ARG.SZ-ARG.DA>/<REJ.SZ-ARG.DA>> ;NUMBER OF REJECTION SPECS
	MOVE	T3,P3			;COPY THE STORAGE POINTER

;LOOP HERE FOR EACH REJECTION SPECIFICATION IN THE LIST

DEFRJ0:	$CALL	P$NODE			;GET THE NODE NAME
	SKIPT				;DID WE GET ANYTHING?
	SETZ	S1,			;NO, DON'T SET ANYTHING THEN
	MOVEM	S1,REJ.ND(T3)		;STORE THE REJECTED NODE NAME
	SETZM	REJ.PP(T3)		;CLEAR THE
	SETZM	REJ.MK(T3)		; REJECTED PPN
	$CALL	P$USER			;GET THE REJECTED PPN
	JUMPF	DEFRJ1			;NONE, SKIP THIS
	MOVEM	S1,REJ.PP(T3)		;STORE THE PPN WORD
	MOVE	S1,PFD.D2(S2)		;GET THE PPN MASK WORD
	MOVEM	S1,REJ.MK(T3)		;STORE IT TOO

DEFRJ1:	MOVEI	T3,REJ.SZ-ARG.DA(T3)	;POINT TO THE NEXT SUBBLOCK
	$CALL	P$CFM			;SEE IF END OF COMMAND YET
	JUMPT	DEFRJ2			;YES, GO FINISH UP
	$CALL	P$COMMA			;NO, HOW ABOUT A COMMA?
	$RETIF				;NO, JUST BLOW IT OFF
	SOJG	T4,DEFRJ0		;YES, TRY ANOTHER ONE
	PJRST	E$IFC			;DONE TOO MANY.  SAY BAD COMMAND

DEFRJ2:	MOVE	S2,T3			;COPY THE STORAGE POINTER
	SUBI	S2,-ARG.DA(P3)		;COMPUTE BLOCK LENGTH
	MOVX	S1,.ORREJ		;GET THE BLOCK TYPE
	$CALL	ARGRTN			;SETUP THE ARG BLOCK
	ANDI	P3,777			;GET LENGTH OF MESSAGE
	STORE	P3,.MSTYP(MO),MS.CNT	;SAVE THE COUNT
	PJRST	SNDQSR			;SEND THE COMMAND

DEFQNM:	MOVX	S1,.OMDQN		;GET THE DEFINE REMOTE QUEUE TYPE
	STORE	S1,.MSTYP(MO),MS.TYP	;STORE IN THE MESSAGE HEADER
	$CALL	P$FLD			;PROCESS QUEUE NAME
	$RETIF
	MOVSI	S2,ARG.DA(S1)		;SOURCE
	HRRI	S2,DFQ.QN(P3)		;DESTINATION
	LOAD	S1,ARG.HD(S1),AR.LEN	;LENGTH OF BLOCK
	SUBI	S1,ARG.DA		;SUBTRACT LENGTH OF HEADER
	CAILE	S1,QNMLEN		;CHECK LENGTH
	MOVEI	S1,QNMLEN		;ADJUST
	ADDI	S1,(S2)			;COMPUTE END OF OF BLT
	BLT	S2,-1(S1)		;COPY THE QUEUE NAME STRING
	$CALL	P$CFM			;SEE IF DELETING DEFINITION
	JUMPF	DEFQN1			;MUST BE (RE)DEFINING
	$CALL	P$PREV			;BACKUP SO COMMON CMD EXIT WORKS
	JRST	DEFQN4			;FINISH UP

DEFQN1:	$CALL	P$KEYW			;GET THE QUEUE TYPE
	$RETIF
	MOVEM	S1,DFQ.TY(P3)		;SAVE IT
	$CALL	P$NODE			;GET NODE NAME
	$RETIF
	MOVEM	S1,DFQ.ND(P3)		;SAVE IT
	$CALL	P$KEYW			;GET THE OBJECT TYPE
	$RETIF
	MOVEM	S1,DFQ.OT(P3)		;SAVE IT
	$CALL	P$CFM			;SEE IF ANY UNIT IS VALID
	JUMPF	DEFQN2			;NO
	SETOM	DFQ.UN(P3)		;FLAG IT
	$CALL	P$PREV			;BACKUP SO COMMON CMD EXIT WORKS
	JRST	DEFQN4			;FINISH UP
DEFQN2:	$CALL	P$NUM			;GET THE UNIT NUMBER
	JUMPF	DEFQN3			;MAYBE NO UNIT NUMBER GIVEN
	MOVEM	S1,DFQ.UN(P3)		;SAVE UNIT NUMBER
	JRST	DEFQN4			;ONWARD
DEFQN3:	$CALL	P$SIXF			;GET SIXBIT UNIT TYPE
	$RETIF				;NEED EITHER UNIT NUMBER OR TYPE
	MOVEM	S1,DFQ.UT(P3)		;SAVE UNIT TYPE
DEFQN4:	MOVX	S1,.DFQNM		;BLOCK TYPE
	MOVX	S2,DFQ.SZ		;LENGTH OF THE MESSAGE
	PUSHJ	P,ARGRTN		;SAVE THE ARGUMENT
	PJRST	CMDEND			;FINISH UP AND SEND THE COMMAND
> ;END TOPS10
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 LISTS OR SHOW SYSTEM PARAMETERS
;COMMANDS. SHOW SYSTEM LISTS IS FORWARDED TO QUASAR

TOPS10<
Q$SLST::
	PUSHJ	P,P$KEYW		;GET NEXT KEYWORD
	JUMPF	E$IFC			;BETTER BE THERE
	MOVEI	S2,SSYTAB		;GET TABLE ADDRESS
	PUSHJ	P,TABSRC		;GET PROCESSOR ADDRESS
	JUMPF	E$IFC			;COMPLAIN IF NOT FOUND
	PJRST	(S2)			;GO DO THE WORK

;Here for SHOW SYSTEM PARAMETERS

SHOPRM:	PUSHJ	P,.SAVET		;SAVE T1-T4
	MOVX	S1,.OMDSP		;OPR DISPLAY MESSAGE
	STORE	S1,.MSTYP(MO),MS.TYP	;PUT IT IN THE MESSAGE
	MOVEI	S1,PRMHDR		;GET ADDRESS OF HEADER TEXT BLOCK
	PUSHJ	P,SHWMTX##		;USE ROUTINE IN ORION TO COPY INTO MSG
	PUSHJ	P,OPRSPT##		;USE ROUTINE IN ORION TO SETUP POINTERS

;Display CPU schedulabilty

	MOVE	S1,[%CNCPU]		;GET NUMBER OF CPUS MONITOR BUILT FOR
	GETTAB	S1,
	JRST	SHOP.4			;DON'T EVEN BOTHER GUESSING
	MOVNI	T1,(S1)			;GET NEGATIVE COUNT
	SOJLE	S1,SHOP.4		;IF JUST ONE, DON'T BOTHER EITHER
	HRLZS	T1			;MAKE AOBJN COUNTER
SHOP.1:	$TEXT	(SHWDEP,<CPU^O/T1,RHMASK/ is ^A>) ;1ST PART OF TYPEOUT
	HRRZ	S1,T1			;GET CPU NUMBER TO CHECK
	PUSHJ	P,VALCPU##		;SEE IF CPU IS RUNNING 
	MOVE	T2,S1			;SAVE VALUE IN S1
	MOVE	S1,RUNTBL##(T1)		;GET GETTAB INDEX FOR THIS CPU
	GETTAB	S1,			;GET %CVRUN WORD FOR THIS CPU
	TXO	S1,CV%RUN		;ASSUME NOT SCHEDULABLE
	JUMPT	SHOP.2			;IF CPU IS RUNNING, SKIP SOME CHECKS
	SETZM	S2
	TXNE	S1,CV%RMV		;CPU REMOVED?
	MOVEI	S2,[ITEXT(<removed>)]	;YES
	TXNE	S1,CV%DET		;CPU DETACHED?
	MOVEI	S2,[ITEXT(<detached>)]	;YES
	TXNE	S1,CV%SPD		;CPU SUSPENDED?
	MOVEI	S2,[ITEXT(<supended>)]	;YES
	JUMPN	S2,SHOP.3		;IF WE FOUND A BIT, GO DEPOSIT TEXT
	MOVEI	S2,[ITEXT(<not running>)];ELSE CPU IS NOT RUNNING
	JRST	SHOP.3
SHOP.2:	TXNE	S1,CV%RUN		;SCHEDULABLE?
	SKIPA	S2,[[ITEXT (<running but not scheduling jobs>)]] ;NO
	MOVEI	S2,[ITEXT (<running and scheduling jobs>)] ;YES
SHOP.3:	$TEXT	(SHWDEP,<^I/(S2)/^M^J^A>) ;PUT TEXT IN BUFFER
	AOBJN	T1,SHOP.1		;LOOP FOR ALL CPUS
	MOVEI	S1,.CHCRT		;GET CARRIAGE RETURN
	PUSHJ	P,SHWDEP		;PUT IT IN BUFFER
	MOVEI	S1,.CHLFD		;LINEFEED
	PUSHJ	P,SHWDEP

;Display LOGMAX

SHOP.4:	MOVE	S1,[%CNSJN]		;GET MAX NUMBER OF JOBS
	GETTAB	S1,
	MOVEI	S1,^D513		;ASSUME BIG DEFAULT
	MOVEI	S1,-1(S1)		;GET RID OF NEGATIVE NUMBER OF HISEGS
					;DON'T COUNT NULL JOB
	MOVE	S2,[%CNLMX]		;GET LOGMAX
	GETTAB	S2,
	MOVEI	S2,^D512
	$TEXT	(SHWDEP,<LOGMAX: ^D/S2/ jobs out of ^D/S1/^M^J^J^A>)

;Display SCHEDULE bits

	MOVE	S1,[%CNSTS]		;GET STATUS WORD FOR SCHED BITS
	GETTAB	S1,
	SETZM	S1
	TLZ	S1,777777		;KEEP ONLY SCHED BITS
	MOVE	T1,S1			;SAVE THEM
	$TEXT	(SHWDEP,<SCHEDULE: ^O6R0/S1/^M^J^A>)
	SKIPN	T1			;ANY BITS SET?
	$TEXT	(SHWDEP,<   No restrictions^M^J^A>) ;NO
	JUMPE	T1,SHOP.5		;IF NO BITS SET, SKIP SOME STUFF
	TXNE	T1,ST%NDL		;NO DOWN-LINE LOADING?
	$TEXT	(SHWDEP,<   No automatic network down-line loading^M^J^A>) ;YES
	TXNE	T1,ST%NOP		;OPERATOR ON BREAK?
	$TEXT	(SHWDEP,<   No operator coverage^M^J^A>) ;YES, AREN'T THEY ALWAYS
	TXNE	T1,ST%NSP		;NON-PRIV'D UNSPOOLING ALLOWED?
	$TEXT	(SHWDEP,<   Device unspooling allowed without privilege^M^J^A>) ;YES
	TXNE	T1,ST%ASS		;CAN USERS ASSIGN RESTRICTED DEVICES
	$TEXT	(SHWDEP,<   Restricted devices can be assigned^M^J^A>) ;YES
	TXNE	T1,ST%NRT		;REMOTE TERMINALS DISALLOWED?
	$TEXT	(SHWDEP,<   No remote terminals^M^J^A>) ;YES
	TXNE	T1,ST%BON		;CAN ONLY BATCH JOBS LOGIN?
	$TEXT	(SHWDEP,<   Batch jobs only^M^J^A>) ;YES
	TXNE	T1,ST%NRL		;NO REMOTE LOGINS?
	$TEXT	(SHWDEP,<   No remote logins^M^J^A>) ;YES
	TXNE	T1,ST%NLG		;ONLY LOGINS AT CTY?
	$TEXT	(SHWDEP,<   Logins from CTY only^M^J^A>) ;YES

;Display BATMAX and CORMAX

SHOP.5:	MOVE	S1,[%CNBMX]		;GET BATMAX
	GETTAB	S1,
	MOVEI	S1,^D13
	CAIN	S1,1			;PLURAL OR SINGULAR (0 IS PLURAL)
	SKIPA	S2,[BYTE (7) "j","o","b"," ",0]
	MOVE	S2,[BYTE (7) "j","o","b","s",0]	;MUST BE PRETTY
	MOVE	T1,[%NSCMX]		;GET CORMAX
	GETTAB	T1,
	SKIPA	T1,[^D512]
	LSH	T1,-^D9			;CONVERT WORDS TO PAGES
	$TEXT	(SHWDEP,<^JBATMAX: ^D2R/S1/ ^T/S2/			        CORMAX: ^D4R/T1/ pages^M^J^A>)

;Display BATMIN and CORMIN

	MOVE	S1,[%CNBMN]		;GET BATMIN
	GETTAB	S1,
	SETZM	S1
	CAIN	S1,1			;PLURAL OR SINGULAR (0 IS PLURAL)
	SKIPA	T1,[BYTE (7) "j","o","b"," ",0]
	MOVE	T1,[BYTE (7) "j","o","b","s",0]	;MUST BE PRETTY
	MOVE	S2,[%NSCMN]		;GET CORMIN
	GETTAB	S2,
	SKIPA	S2,[^D512]
	LSH	S2,-^D9			;CONVERT WORDS TO PAGES
	$TEXT	(SHWDEP,<BATMIN: ^D2R/S1/ ^T/T1/				CORMIN: ^D4R/S2/ pages^M^J^J^A>)

;Display disk cache size

	MOVX	S1,%LDCSZ		;ASK FOR CACHE SIZE
	GETTAB	S1,
	SETZ	S1,			;THAT'S ODD
	MOVX	S2,%LDOCS		;ASK FOR ORIGINAL (CONFIGURED) SIZE
	GETTAB	S2,
	SETZ	S2,			;THAT'S ALSO ODD
	$TEXT	(SHWDEP,<Disk cache size: ^D/S1/ blocks		Configured size: ^D/S2/ blocks^M^J^J^A>)

;CUSTOMER ADDITIONS TO SHOW SYSTEM PARAMETERS MAY BE DONE HERE

	MOVX	S1,%NSKTM		;GET KSYS TIME
	GETTAB	S1,			; FROM MONTOR
	  SETZ	S1,			;ODD
	JUMPE	S1,SHOP.6		;JUMP IF NOT SET
	SKIPG	S1			;TIMESHARING OVER ???
	$TEXT	(SHWDEP,<* Timesharing is over^M^J^J^A>)
	JUMPL	S1,SHOP.6		;YES,,TELL OPR AND RETURN
	IMULI	S1,^D60			;CONVERT TO SECONDS
	CAIGE	S1,^D24*^D60*^D60	;WITHIN 24 HOURS?
	PUSHJ	P,EXPTIM		;YES, EXPAND TIME INTO READABLE TEXT
SHOP.6:	SETZ	S2,			;GET A ZERO
	IDPB	S2,WTOPTR##		;TERMINATE THE MESSAGE
	HRRZ	S2,WTOPTR##		;GET ENDING ADDRESS
	SUBI	S2,-1(P3)		;GET LENGTH OF TEXT BLOCK GENERATED
	MOVX	S1,.CMTXT		;GET BLOCK TYPE
	PUSHJ	P,ARGRTN		;COPY TEXT TO MESSAGE
	PJRST	FINSHW##		;GO LOG MSG AND THEN SEND IT TO OPR

PRMHDR:	XWD	PRMLEN,.ORDSP		;SIZE AND TYPE OF TEXT BLOCK
	BLOCK	1			;ROOM FOR TIME STAMP
	ASCIZ\		-- System Parameters --

\
PRMLEN==.-PRMHDR			;SIZE OF THE BLOCK

SHWDEP:	IDPB	S1,WTOPTR##		;PUT BYTE IN BUFFER
	POPJ	P,			;RETURN
SUBTTL	EXPTIM - Expand time


; Expand time from seconds to hours and minutes
; CALL:	MOVE	S1,time in seconds
;	PUSHJ	P,EXPTIM
;
; On return, some pretty text will be generated
;
EXPTIM:	$SAVE	<T1,T2,T3>		;SAVE SOME ACS
	IDIVI	S1,^D60*^D60		;S1:= HOURS
	IDIVI	S2,^D60			;S2:= MINUTES
	CAIN	S1,0			;HOURS?
	MOVEI	T1,[ITEXT (<>)]		;NO
	CAIN	S1,1			;1 HOUR?
	MOVEI	T1,[ITEXT (<^D/S1/ hour >)] ;YES
	CAILE	S1,1			;MORE THAN ONE HOUR?
	MOVEI	T1,[ITEXT (<^D/S1/ hours >)] ;YES
	SKIPE	S1			;HAVE HOURS?
	SKIPN	S2			;HAVE MINUTES?
	SKIPA	T2,[[ASCIZ ||]]		;JUST ONE OR THE OTHER
	MOVEI	T2,[ASCIZ |and |]	;HAVE BOTH
	CAIN	S2,0			;MINUTES?
	MOVEI	T3,[ITEXT (<>)]		;NO
	CAIN	S2,1			;1 MINUTE?
	MOVEI	T3,[ITEXT (<^D/S2/ minute>)] ;YES
	CAILE	S2,1			;MORE THAN 1 MINUTE?
	MOVEI	T3,[ITEXT (<^D/S2/ minutes>)] ;YES
	$TEXT	(SHWDEP,<* Timesharing will cease in ^I/(T1)/^T/(T2)/^I/(T3)/^M^J^J^A>)
	POPJ	P,			;RETURN
;Here for SHOW SYSTEM LISTS

SHOSSL:	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

SSYTAB:	$STAB
	.KYLST,,SHOSSL
	.KYPRM,,SHOPRM
	$ETAB
>;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
	END