Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93k-bb - 10,7/galaxy/quasar/qsrdsp.mac
There are 39 other files named qsrdsp.mac in the archive. Click here to see a list.
	TITLE	QSRDSP - OPERATOR DISPLAY ROUTINES.

;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,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	QSRMAC,GLXMAC,ORNMAC
	PROLOG	(QSRDSP)

	%%.QSR==:%%.QSR
	QSRVRS==:QSRVRS
	SUBTTL	LOCAL STORAGE AND BRANCH TABLES


	DEFINE	X(STR,A,B),<
	[ASCIZ/STR/] 
	>

	;NOW DEFINE THE OBJECT (DEVICE) STATUS STRINGS

OBJSTC:	STATUS			;DEFINE THE OBJECT STATUS STRINGS

STAPAR:	[ASCIZ/ Status:/]
	[ASCIZ/ Parameters:/]

LIMTYP:	[ASCIZ/Min:Max Lim./]	;UNDEFINED
	[ASCIZ/Min:Max Lim./]	;.OTRDR
	[ASCIZ/Min:Max Lim./]	;.OTNCU
	[ASCIZ/Page Limits /]	;.OTLPT
	[ASCIZ/  Minutes   /]	;.OTBAT
	[ASCIZ/Card Limits /]	;.OTCDP
	[ASCIZ/Min:Max Feet/]	;.OTPTP
	[ASCIZ/  Minutes   /]	;.OTPLT
	[ASCIZ/Min:Max Lim./]	;.OTTRM
	[ASCIZ/Min:Max Lim./]	;.OTJOB
	[ASCIZ/Min:Max Lim./]	;.OTOPR
	[ASCIZ/Min:Max Lim./]	;.OTIBM
	[ASCIZ/Min:Max Lim./]	;.OTMNT
	[ASCIZ/Min:Max Lim./]	;.OTXFR
	[ASCIZ/Min:Max Lim./]	;.OTBIN
	[ASCIZ/Min:Max Lim./]	;.OTRET 
	[ASCIZ/Min:Max Lim./]	;.OTNOT
	[ASCIZ//]		;.OTDBM
	[ASCIZ/Min:Max Lim./]	;.OTFAL
	[ASCIZ//]		;.OTEVT

	%UNLBL==1			;VOLUME IS UNLABELED
	%LABEL==2			;VOLUME IS LABELED
	SUBTTL ROUTINE DATA AREAS AND ITEXT STATEMENTS.

QUEBIT:	BLOCK	1		;SAVE AREA FOR THE QUEUE TYPES.
LSTUSR:	BLOCK	1		;AREA FOR THE USER ID.
LSTUSM:	BLOCK	1		;LSTUSR WILDCARD MASK
LSTJOB:	BLOCK	1		;JOB NAME TO LIST
LSTJBM:	BLOCK	1		;WILDCARD MASK FOR JOB NAME
LSTUNT:	BLOCK	1		;SPECIFIC UNIT TO LIST
LSTUTY:	BLOCK	1		;SPECIFIC UNIT TYPE TO LIST
LSTDND:	BLOCK	1		;DESTINATION NODE
LSTPND:	BLOCK	1		;PROCESSING NODE
LSTQNM:	BLOCK	QNMLEN		;LIST QUEUE NAME
LISFLG:	BLOCK	1		;FLAGS FROM LIST REQUEST
LISTYP:	BLOCK	1		;FLAG: 0=FAST, -1=NORMAL, 1=ALL
LSTSUM:	BLOCK	1		;SUMMARY FLAG (0=NO, 1=YES)
LSTSMH:	BLOCK	1		;SUMMARY HEADER FLAG
LSTSMQ:	BLOCK	10		;SUMMARY ASCIZ QUEUE NAME
LSTSMT:	BLOCK	1		;TOTAL RUNTIME, PAGES, MINUTES, ETC.
BLKADR:	BLOCK	1		;MESSAGE BLOCK ADDRESS.
OBTYPE:	BLOCK	1		;OBJECT TYPE
ACTIVE:	BLOCK	1		;ACTIVE JOB COUNT.
ATRIB:	BLOCK	1		;"STREAM/UNIT NEEDS ATTRIBUTES LISTED" FLAG
REMOTE:	BLOCK	1		;REMOTE SWITCH 0=NO, -1=YES
LIMIT:	BLOCK	1		;QUEUE LIMIT WORD.
LASTPT:	BLOCK	2		;LAST BYTPTR AND BYTCNT FOR QUEUE LISTINGS
NOROOM:	BLOCK	1		;FLAG TO INDICATE THE OUTPUT PAGE IS FULL.
ENTYPE:	BLOCK	1		;ENTRY TYPE (-1=OPERATOR, 0=QUEUE)
JOBNBR:	BLOCK	1		;JOB/DEVICE COUNT.
NODE6B:	BLOCK	1		;SIXBIT NODE NAME.
KLUDGE: BLOCK   1		;[1206]KLUDGE FLAG TO HANDLE SHO Q CONFLICTS
BYTPTR: BLOCK   1               ;BYTE POINTER FOR $TEXT ROUTINE.
BYTCNT:	BLOCK	1		;NUMBER OF BYTES AVAILABLE IN THE OUTPUT PAGE.
DATADR:	BLOCK	1		;PAGE ADDR WHERE .WTTXT DATA STARTS.
SHWTYP:	BLOCK	1		;DISPLAY TYPE: -1=PARAMETERS, 0=STATUS.
ACKCOD:	BLOCK	1		;OPERATOR ACK CODE.
TIME.:	BLOCK	3		;TIME IN HOURS, MINUTES, SECONDS.
JOBACT:	BLOCK	1		;JOB ACTIVE FLAG. (-1=YES, 0=NO)
QEMPTY:	BLOCK	1		;FLAG TO INDICATE IF THE QUEUES ARE EMPTY.
HDRSAV:	BLOCK	1		;QUEUE HEADER SAVE BLOCK.
CRLFLG:	BLOCK	1		;FLAG FOR INSERTING A CRLF
DEVICE:	BLOCK	1		;SIXBIT DEVICE NAME FOR TAPE MOUNTS
OBJADR:	BLOCK	1		;MSG OBJECT BLOCK ADDRESS

DEFINE	$ASCII(MSG),<
	PUSHJ	P,ASCOUI		;;CALL THE IN-LINE ASCII OUTPUTTER
	CAI	[ASCIZ+MSG+]		;;AIM AT THE MESSAGE
>;END $ASCII DEFINE

JS:	ITEXT	(<^W6L /.QEJOB(AP)/  ^D6R /.QERID(AP)/  >)
TIM:	ITEXT	(<^D2R0/TIME./:^D2R0/TIME.+1/:^D2R0/TIME.+2/>)

ONOFL:	[ASCIZ/Offline/]
	[ASCIZ/Online /]
	[ASCIZ/Active /]
	[ASCIZ/Server /]

IBMTYP:	[ASCIZ\     \]
	[ASCIZ\3780\]
	[ASCIZ\2780\]
	[ASCIZ\HASP\]

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

IBMODE:	[ASCIZ/    /]
	[ASCIZ/Termination/]
	[ASCIZ/Emulation/]
	[ASCIZ/Proto-termination/]

IBMDTR:	[ASCIZ/   /]
	[ASCIZ/ On/]
	[ASCIZ/Off/]

IBMTIM:	[ASCIZ/ /]
	[ASCIZ/Primary/]
	[ASCIZ/Secondary/]

IBMPOR:	[ASCIZ/DL10/]
	[ASCIZ/DTE/]

	    SYSPRM %OTLEN,^D48,^D48	;OUTPUT QUEUE LINE LENGTH
IFE INPCOR,<SYSPRM %INLEN,^D48,^D48 >	;INPUT QUEUE LINE LENGTH
IFN INPCOR,<SYSPRM %INLEN,^D55,^D48 >	;INPUT QUEUE LINE LENGTH WITH 'CORE'

QUENAM:	POINT	8, QNM.QN(AP)		;POINTER TO QUEUE NAME
QUEQUE:	POINT	8, .QEQNM(AP)		;DITTO FOR A QE
QNMTYP:	[ASCIZ	/Local/]
	[ASCIZ	/Remote/]
	;DEFINE THE MODULE ENTRY POINTS.

	INTERN	D$SHQS		;SHOW QUEUES PROCESSOR.
	INTERN	D$LIST		; ' ' ' ' ' 
	INTERN	D$SHST		;SHOW STATUS PROCESSOR.
	INTERN	D$SHPR		;SHOW PARAMETER PROCESSOR.
	INTERN	D$SHRT		;SHOW ROUTE TABLE PROCESSOR.
	INTERN	D$NPRM		;SHOW IBM NETWORK PARAMETERS
	INTERN	D$NSTS		;SHOW NETWORK STATUS (ONLINE/OFFLINE)

	EXTERN	USR		;USR IS AN ITEXT MACRO DEFINED IN QSRT10 & QSRT20.
				;IT DEFINES THE OWNER OF A PARTICULAR QUEUE ENTRY.
	EXTERN	MNTUSR		;SAME AS ABOVE EXCEPT FOR THE MOUNT QUEUES
	EXTERN	STRUCT		;STRUCT IS AN ITEXT MACRO DEFINED IN QSRT10 & QSRT20
				;IT DEFINES THE STRUCTURE NAME

	EXTERN	LABELS		;LABEL TYPE DISPATCH BLOCK
	EXTERN	G$MSG		;PLACE FOR MESSAGE GENERATION
	EXTERN	DENSTY		;DENSITY TRANSLATION TABLE IN QSRMDA
	EXTERN	TRK		;TRACK STATUS TABLE
	EXTERN	VOLQUE		;VOLUME QUEUE ID
TOPS10<	EXTERN	DEVNTB >	;DEVICE TRANSLATION TABLE

	SUBTTL	D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST.

D$SHQS:	SETZM	G$ACK##			;INDICATE WE DONT WANT AN ACK.
	SKIPA	S1,[-1]			;INDICATE 'OPERATOR' ENTRY POINT.
D$LIST:	SETZ	S1,			;INDICATE 'QUEUE' ENTRY POINT.
	MOVEM	S1,ENTYPE		;AND SET IT.
	PUSHJ	P,.SAVE3		;SAVE 3 AC'S
	SETZM	QEMPTY			;RESET THE QUEUES EMPTY FLAG.
	SETZM	ACTIVE			;ZERO THE JOB ACTIVE COUNT.
	SETZM	NOROOM			;CLEAR NO MORE ROOM INDICATOR
	SETZM	BYTPTR			;INDICATE NO OUTPUT PAGE YET ..
	SETOM	JOBNBR			;RESET THE NUMBER OF JOBS COUNT.
	SETOM	LSTSMH			;RESET SUMMARY HEADER FLAG
	SETZM	LSTSMT			;ZAP TOTAL RUNTIM, PAGES, MINUTES, ETC.
	PUSHJ	P,GETPARMS		;BREAK DOWN THE INCOMMING MESSAGE.
	JUMPF	E$MTS##			;IF AN ERROR OCCURED,,PROCESS IT.
	$COUNT	(MLST)			;BUMP LIST COUNT.
	SKIPN	P1,QUEBITS		;GET THE QUEUE BITS.
	PJRST	E$ILM##			;NO QUEUES,,NOT VALID.
	MOVX	S1,MF.NOM		;GET 'NO MESSAGE BITS'
	SKIPE	G$ACK##			;DOES HE WANT AN ACK ???
	PUSHJ	P,G$MSND##		;YES,,DO IT !!
	TXNE	P1,LIQMNT		;DO WE WANT THE TAPE/DISK MOUNT QUEUE ?
	PUSHJ	P,D$SMNT		;YES,,GO DO IT
	MOVEI	H,TBLHDR##		;GET THE POINTER TO THE FIRST QUEUE.
	MOVEI	P2,NQUEUE##		;GET THE NUMBER OF QUEUES.
LIST.1:	TDNE	P1,.QHLIS(H)		;DOES HE WANT THIS QUEUE.
	PUSHJ	P,SHOWQS		;YES,,DUMP IT.
	ADDI	H,QHSIZE		;POINT TO THE NEXT QUEUE.
	SOJG	P2,LIST.1		;AND TRY THE NEXT ONE.
	$COUNT	(NLAP)			;COUNT PAGES SENT
	PUSHJ	P,CHKRMQ		;SEE IF A REMOTE QUEUE LISTING NEEDED
	MOVE	P1,TF			;REMEMBER HERE
	SKIPE	QEMPTY			;ARE THE QUEUES EMPTY ???
	JRST	LIST.2			;NO
	SKIPE	ENTYPE			;WAS THIS AN USER REQUEST ???
	JRST	LIST.4			;NO
	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GENERATE THE ID
	PUSHJ	P,SETPAG		;GO SETUP THE PAGE
	MOVEI	S1,[ITEXT ()]		;NULL ITEXT STRING
	SKIPF	P1			;WILL WE ASK THE NET QUEUE CTLR?
	MOVEI	S1,[ITEXT (<local >)]	;YES, INDICATE THERE MIGHT BE MORE
	$TEXT	(DEPBYT,<[The ^I/0(S1)/queues are empty]^A>)
LIST.2:	JUMPF	P1,LIST.3		;SEND LAST MESSAGE IF NO REMOTE LISTING
	PUSHJ	P,CRLF			;ADD A CRLF
	PUSHJ	P,ASKNQC		;ASK NQC FOR THE QUEUE LISTING
	JUMPF	LIST.3			;WE TRIED AND FAILED
	PUSHJ	P,SNDMSG		;SEND LAST PAGE, BUT SET WT.MOR SINCE
					; NQC WILL BE SENDING TEXT
	$RETT				;AND RETURN

LIST.3:	PUSHJ	P,SENDIT		;SEND IT OFF
	$RETT				;AND RETURN

LIST.4:	MOVEI	S1,[ITEXT ()]		;NULL ITEXT STRING
	SKIPF	P1			;WILL WE ASK THE NET QUEUE CTLR?
	MOVEI	S1,[ITEXT (<local >)]	;YES, INDICATE THERE MIGHT BE MORE
	$ACK	(<The ^I/0(S1)/queues are empty>,,,ACKCOD) ;YES,,RESPOND !!
	JUMPF	P1,.RETT		;DONE IF WE DON'T NEED TO ASK NQC
	PUSHJ	P,ASKNQC		;ASK NQC FOR A REMOTE LISTING
	$RETT				;AND RETURN
; ROUTINES TO SUPPORT SUMMARY LISTINGS

LIST.S:	$TEXT	(<-1,,LSTSMQ>,<^T/(S1)/^0>) ;PRINT QUEUE NAME
	AOSN	LSTSMH			;OUTPUT SUMMARY HEADER YET?
	$TEXT	(DEPBYT,<^T/LIST.H/^A>)	;PRINT IT NOW
	MOVE	S1,JOBNBR		;GET COUNT
	SKIPE	(S2)			;HAVE SUMMARY QUANTITY TEXT?
	CAIN	S1,1			;YES--JUST ONE?
	TDZA	S1,S1			;SINGULAR
	MOVSI	S1,(ASCIZ/s/)		;PLURAL
	$TEXT	(DEPBYT,<^T11L /LSTSMQ/  ^D4R /JOBNBR/ ^T/(S2)/^T/S1/^A>)
	$RETT				;RETURN

LIST.X:	MOVE	S1,HDRSAV		;GET SAVED QUEUE HEADER
	SKIPE	.QHSUM(S1)		;CHECK
	PUSHJ	P,@.QHSUM(S1)		;GENERATE SUMMARY DATA
	MOVE	S1,HDRSAV		;GET SAVED QUEUE HEADER
	$TEXT	(DEPBYT,< ^T/@.QHSQT(S1)/^A>)
	$RETT				;RETURN
LIST.D::$TEXT	(DEPBYT,<; ^D/LSTSMT/^A>) ;OUTPUT TOTALS IN DECIMAL
	POPJ	P,			;RETURN

LIST.T::MOVE	S1,LSTSMT		;GET TOTAL TIME
	IDIVI	S1,^D60			;GET # OF SECONDS.
	MOVEM	S2,TIME.+2		;   AND SAVE IT.
	IDIVI	S1,^D60			;GET HOURS,MINUTES.
	MOVEM	S1,TIME.		;SAVE HOURS.
	MOVEM	S2,TIME.+1		;SAVE MINUTES.
	$TEXT	(DEPBYT,<; ^I/TIM/^A>)	;OUTPUT TIME
	POPJ	P,			;RETURN

LIST.H:	ASCIZ	/
   Queue               Totals
-----------  --------------------------
/
	SUBTTL	D$SHST - ROUTINE TO SHOW DEVICE STATUS.
	;	D$SHPR - ROUTINE TO SHOW PARAMETERS.

D$SHPR:	SKIPA	S1,[1]			;INDICATE THE PARAMETERS ENTRY POINT.
D$SHST:	SETZ	S1,			;INDICATE THE SHOW STATUS ENTRY POINT.
	MOVEM	S1,SHWTYP		;SAVE THE ENTRY STATUS.
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
 	PUSHJ	P,.SAVET		;SAVE THE T ACS.
	SETOM	ENTYPE			;INDICATE 'OPERATOR' MESSAGE
	SETZM	QEMPTY			;INDICATE NO OBJECTS FOUND
	SETZM	OBTYPE			;ZERO THE OBJECT TYPE.
	PUSHJ	P,GETPARMS		;GO BREAK DOWN THE MESSAGE
	SKIPN	OBJADR			;MAKE SURE WE GOT AN OBJECT BLOCK
	$RETT				;NONE THERE,,THATS AN ERROR
	LOAD	T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJ QUEUE ENTRY.

STPR.1:	JUMPE	T1,STPR.4		;NO MORE,,RETURN.
	LOAD	T2,OBJTYP(T1)		;GET THE OBJ TYPE.
	JUMPLE	T2,STPR.3		;NOT VALID,,TRY NEXT.
	PUSHJ	P,CHKOBJ		;DO WE WANT THIS OBJECT ???
	JUMPF	STPR.3			;NO,,TRY THE NEXT ONE
	MOVE	P1,S1			;SAVE THE NODE DB ENTRY ADDR IN S1
	CAME	T2,OBTYPE		;ARE WE PROCESSING A NEW QUEUE TYPE ???
	PUSHJ	P,CHKQUE		;YES,,GO SCAN FOR ACTIVE/REMOTE STATUS.
	SKIPE	NOROOM			;[1177]ROOM IN THE CURRENT BUFFER ?
	PUSHJ	P,PAGOVF		;[1177]NO,,SEND CURRENT AND CONTINUE
	$TEXT	(DEPBYT,<  ^D4R /OBJUNI(T1)/  ^A>) ;PUT OUT THE UNIT/STREAM #
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$TEXT	(DEPBYT,<^N10R /OBJNOD(T1)/  ^A>) ;PUT OUT THE NODE NAME

	SKIPN	SHWTYP			;IF THIS IS SHOW STATUS,
	PUSHJ	P,SHSTAT		;THEN GO GET THE STATUS.
	SKIPE	SHWTYP			;IF THIS IS SHOW PARAMETERS,, THEN
	PUSHJ	P,SHPARM		;GO GET THE PARAMETERS.
STPR.3:	LOAD	T1,.QELNK(T1),QE.PTN	;GET NEXT OBJ QUEUE ENTRY.
	JRST	STPR.1			;GO PROCESS IT.

STPR.4:	SKIPN	S1,QEMPTY		;WAS ANYTHING PUT OUT ???
	JRST	STPR.5			;NO,,TELL THE OPERATOR
	JUMPG	S1,.RETT		;JUST DN60 MSGS ??? - RETURN
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	SKIPE	SHWTYP			;IF 'SHOW PARM' THEN SEND
	PJRST	SENDIT			;   THE MESSAGE AND RETURN
	PUSHJ	P,I$SYSV##		;UPDATE THE SYSTEM VARIABLES
	SKIPN	S1,G$KSYS##		;IF NO KSYS IS PENDING,,THEN SEND
	PJRST	SENDIT			;   THE MESSAGE AND RETURN
	SKIPG	S1			;TIMESHARING OVER ???
	$TEXT(DEPBYT,<* Timesharing is over - no scheduling will be done^M^J>)
	JUMPL	S1,SENDIT		;YES,,TELL OPR AND RETURN
	CAIGE	S1,^D24*^D60*^D60	;WITHIN 24 HOURS?
	PUSHJ	P,EXPTIM		;YES, EXPAND TIME INTO READABLE TEXT
	PJRST	SENDIT			;SEND THE MESSAGE AND RETURN.

STPR.5:	MOVE	S1,OBJADR		;GET THE OBJECT BLOCK ADDRESS
	SKIPL	OBJ.UN(S1)		;   OR ALL UNITS ???
	JRST	STPR.6			;NO,,SEND A SPECIFIC MSG
	$ACK	(<There are no devices started>,,,ACKCOD) ;YES,,TELL THE OPR
	$RETT				;AND RETURN

STPR.6:	HRRZS	OBJ.UN(S1)		;Make certain there is no high range
	$ACK	(<Device unknown>,,0(S1),ACKCOD) ;SEND A SPECIFIC MSG
	$RETT				;AND 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(DEPBYT,<* Timesharing will cease in ^I/(T1)/^T/(T2)/^I/(T3)/^M^J>)
	POPJ	P,			;RETURN
	SUBTTL	CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS

	;CALL:	T1/ OBJECT BLOCK ADDRESS
	;
	;RET:	S1/ The Network Data Base Addr
	;	    False if no good

CHKOBJ:	MOVE	S1,OBJSCH(T1)		;GET THE SCHEDULING BITS
	TXNE	S1,OBSINV		;IS THIS AN INVISIBLE OBJECT ???
	$RETF				;YES,,RETURN NOW.
	TXNE	S1,OBSFRR		;CANT BE FREE-RUNNING AND
	SKIPN	SHWTYP			;    'SHOW PARAMATERS'
	JRST	CHKO.A			;IF NOT,, THEN HE WINS
	MOVE	S2,OBJTYP(T1)		;GET OBJECT TYPE
	CAIE	S2,.OTFAL		;FAL IS FREE RUNNING AND HAS PARMS
	$RETF				;ELSE TOUGH BREAKEEEEE
CHKO.A:	MOVE	S2,OBJADR		;GET THE MESSAGE OBJ BLOCK ADDRESS
	SKIPL	S1,OBJ.TY(S2)		;CHECK THE MSG OBJ TYPE,,-1 WINS
	CAMN	S1,OBJTYP(T1)		;COMPARE AGAINST OBJ Q ENTRY
	SKIPA				;WIN ON EITHER,,SKIP
	$RETF				;NO GOOD,,RETURN
	SKIPL	S1,OBJ.UN(S2)		;CHECK THE MSG UNIT #,,-1 WINS
	CAMN	S1,OBJUNI(T1)		;COMPARE AGAINST OBJ Q ENTRY
	JRST	CHKO.0			;We win, continue on

;Check for within the range.

	LOAD	S1,OBJ.UN(S2),OU.HRG	;Get the high range
	CAMGE	S1,OBJUNI(T1)		;Within the high range?
	$RETF				;No - return
	LOAD	S1,OBJ.UN(S2),OU.LRG	;Get the low range
	CAMLE	S1,OBJUNI(T1)		;Within low range?
	$RETF				;No again
CHKO.0:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	S1,OBJNOD(T1)		;GET THE OBJECTS NODE NAME
	PUSH	P,S2			;SAVE THE OBJECT ADDRESS FOR A SECOND
	PUSHJ	P,N$NODE##		;FIND ITS ENTRY IN OUR DATA BASE
	MOVE	P1,S2			;SAVE/RETURN THE ADDRESS IN P1
	POP	P,S2			;RESTORE THE OBJECT ADDRESS
	MOVE    S2,OBJ.ND(S2)           ;[1206]GET THIS OBJECT NODE
	CAMN    S2,[-1]                 ;[1206]IS IT ALL NODES?
	JRST    CHKO.1                  ;[1206]YES, SKIP THIS
	MOVE	S1,OBJNOD(T1)		;[1206]GET THE OBJECTS NODE NAME
	$CALL   N$MTCH                  ;[1206]CHECK FOR MATCH
	$RETIF                          ;[1206]QUIT IF NOT THIS ONE
CHKO.1:	MOVE	S1,OBJSCH(T1)		;GET THE SCHEDULING BITS
	TXNE	S1,OBSSIP!OBSSUP!OBSIGN	;IF SIP OR SETUP OR IGNORE
	SKIPN	OBJPID(T1)		;AND A PROCESSOR,,THEN
	TRNA
	JRST	CHKO.2			;   SKIP THIS CODE
	TXNE	S1,OBSSTA		;IF NOT STARTED,,THEN SKIP THIS CODE
	SKIPE	SHWTYP			;OR IF SHOWING PARAMETERS,,THEN
	JRST	CHKO.3			;   SKIP THIS CODE
	MOVE	S1,OBJTYP(T1)		;ELSE GET OBJECT TYPE
	LOAD	S2,OBJDAT(T1),RO.ATR	;AND GET STREAM OR UNIT ATTRIBUTES
	PUSHJ	P,A$LPSB##		;FIND PSB ASSOCIATED WITH STREAM OR UNIT
	JUMPT	CHKO.2			;ALL SET IF THERE WAS ONE
	MOVX	S1,%NOPRC		;GET "NO PROCESSOR" STATUS
	MOVEM	S1,OBJSTS(T1)		;ASSUME SO UNTIL WE KNOW BETTER
	MOVE	S1,OBJTYP(T1)		;GET OBJECT TYPE AGAIN
	LOAD	S2,OBJDAT(T1),RO.ATR	;AND GET STREAM OR UNIT ATTRIBUTES
	PUSHJ	P,I$GOPD##		;GET PROCESSOR'S CJB
	JUMPF	CHKO.3			;HMMM. JUST SAY NO PROCESSOR
	LOAD	S2,CJB.FL(S1),CJ.QSR	;GET OBJECT PROCESSOR TYPE
	MOVX	TF,%INACT		;GET INACTIVE STATUS
	CAXN	S2,%DEMND		;A DEMAND SPOOLER? 
	MOVEM	TF,OBJSTS(T1)		;YES, CHANGE STATUS
	JRST	CHKO.3			;CONTINUE

CHKO.2:	MOVE	S1,OBJSTS(T1)		;GET CURRENT STATUS WORD
	CAXE	S1,%NOPRC		;WAS IT "NO PROCESSOR" ?
	CAXN	S1,%INACT		;OR "INACTIVE"?
	TRNA				;YES, UPDATE THE STATUS
	JRST	CHKO.3			;NO - LEAVE IT ALONE
	MOVE	S1,T1			;GET OBJECT BLOCK ADDRESS
	PUSHJ	P,A$OBST##		;UPDATE STREAM OR UNIT STATUS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE


CHKO.3:	MOVE	S1,P1			;WE WANT TO RETURN NODE DB ADDR IN S1
	LOAD	S2,NETSTS(P1),NETIBM	;IS THIS A DN60 REMOTE STATION ???
	JUMPE	S2,.RETT		;NO,,RETURN NOW
	LOAD	S2,NETSTS(P1),NT.MOD	;YES,,GET ITS OPERATION MODE
	CAXE	S2,DF.EMU		;IS IT EMULATION MODE ???
	$RETT				;NO,,JUST RETURN
	SKIPN	SHWTYP			;[1231] YES,,IS THIS 'SHOW STATUS' ???
	SKIPN	OBJPID(T1)		;IS THE SPOOLER SIGN'D ON ???
	$RETT				;NO,,JUST RETURN

	;Here is we have to send the msg to the emulation spooler so that
	;	it can do the show status display...

	MOVE	S1,[G$SAB,,G$MSG]	;COPY THE SAB TO SOME
	BLT	S1,G$MSG+SAB.SZ-1	;   TEMP BUFFER WHILE IN THIS SECTION
	SKIPN	QEMPTY			;HAVE WE SETUP AN OUTPUT MSG YET ???
	AOS	QEMPTY			;NO,,INDICATE SOME DN60 ACTION
	PUSHJ	P,M%GPAG		;GET A PAGE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE THE MSG ADDRESS
	MOVX	S2,PAGSIZ		;GET THE TOTAL MSG LENGTH
	MOVEM	S2,G$SAB##+SAB.LN	;AND SAVE IT
	SETZM	G$SAB##+SAB.SI		;NO SPECIAL INDEX
	SETZM	G$SAB##+SAB.PB		;NO PIB EITHER
	MOVE	S2,OBJPID(T1)		;GET THE EMULATION SPOOLERS PID
	MOVEM	S2,G$SAB##+SAB.PD	;SAVE AS THE RECIEVERS PID
	LOAD	S2,.MSTYP(M),MS.CNT	;GET THE ORIGIONAL MSG LENGTH
	ADDI	S2,-1(S1)		;GET END ADDRESS -1
	HRL	S1,M			;GET SOURCE,,DEST
	BLT	S1,0(S2)		;COPY THE ORIGIONAL MSG OVER
	MOVE	S1,OBJADR		;GET THE PTR TO THE OBJ BLK IN THE MSG
	SUB	S1,M			;GET THE OFFSET TO THE OBJECT BLOCK
	ADD	S1,G$SAB##+SAB.MS	;POINT TO THE 2'OND MSG OBJECT BLOCK
	MOVE	S2,OBJNOD(T1)		;GET THIS OBJECTS NODE NAME
	MOVEM	S2,OBJ.ND(S1)		;AND SAVE IT IN THE MSG
	PUSHJ	P,C$SEND##		;SEND THE MSG OFF
	MOVE	S1,[G$MSG,,G$SAB]	;RESTORE THE ORIGIONAL
	BLT	S1,G$SAB+SAB.SZ-1	;   SAB FROM THE TEMP BUFFER
	$RETF				;MUST RETURN FALSE TO SKIP THIS OBJECT
	SUBTTL	SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE

STAHDR:	MOVEI	S1,[ASCIZ/ System Device Status /] ;GET THE MESSAGE HEADER.
	SKIPE	SHWTYP			;IF SHOW PARAMETERS,,SET UP HEADER.
	MOVEI	S1,[ASCIZ/ System Device Parameters /]
	PUSHJ	P,SETPAG		;SET UP THE PAGE FOR OUTPUT.
	SETOM	QEMPTY			;INDICATE AN OBJECT WAS FOUND
	$RETT				;AND RETURN
	SUBTTL	CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS

CHKQUE:	SKIPN	OBTYPE			;IS THIS THE FIRST TIME THROUGH ???
	PUSHJ	P,STAHDR		;YES,,GO SET UP THE OUTPUT PAGE HEADER
	MOVEM	T2,OBTYPE		;SAVE THE CURRENT OBJECT TYPE
	SETZM	ACTIVE			;INDICATE NO ACTIVE JOBS
	SETZM	REMOTE			;INDICATE NO REMOTE STATIONS
	SETZM	ATRIB			;INDICATE NO SPECIAL OBJECT ATTRIBUTES
	PUSH	P,T1			;SAVE THE CURRENT OBJECT ADDRESS

CHKQ.1:	MOVE	S1,OBJNOD(T1)		;GET THE OBJECTS LOCATION
	PUSHJ	P,N$LOCL##		;CHECK TO SEE IF LOCAL OR REMOTE
	SKIPT				;TRUE - ITS LOCAL
	SETOM	REMOTE			;ELSE ITS REMOTE
	MOVE	S1,OBJSCH(T1)		;GET THE SCHEDULING BITS
	TXC	S1,OBSBUS		;COMPLIMENT BUSY BIT
	TXNN	S1,OBSBUS+OBSFRR	;MUST BE BUSY AND NOT FREE RUNNING
	SETOM	ACTIVE			;YES,,SET ACTIVE FOR LATER
	MOVE	S2,OBJTYP(T1)		;GET OBJECT TYPE
	CAXN	S2,.OTFAL		;FAL? (FAL'S FREE-RUNNING)
	TXNE	S1,OBSBUS		;FAL BUSY? (N.B. OBSBUS WAS TXC'D)
	TRNA				;NOT FAL OR NOT BUSY
	SETOM	ACTIVE			;IT IS FAL AND IT'S BUSY, SAY SO
	CAXE	S2,.OTBAT		;IS IT BATCH ?
	JRST	CHK1.A			;NO

	LOAD	S1,OBJDAT(T1),RO.ATR	;GET ATTRIBUTE FIELD
	CAXN	S1,%SITGO		;SITGO ??
	SETOM	ATRIB			;YES

CHK1.A:	LOAD	T1,.QELNK(T1),QE.PTN	;GET THE NEXT OBJECT IN THE CHAIN
	JUMPE	T1,CHKQ.2		;NO MORE,,PUT OUT THE HEADER
	MOVE	S1,OBJTYP(T1)		;GET THIS OBJECTS TYPE CODE
	CAMN	S1,OBTYPE		;ARE THEY THE SAME ???
	JRST	CHKQ.1			;YES,,GO CHECK IT OUT

CHKQ.2:	POP	P,T1			;RESTORE T1 TO ORIGIONAL OBJ ADDRESS
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	MOVE	S1,SHWTYP		;GET THE 'SHOW' TYPE
	$TEXT	(DEPBYT,<^1/OBTYPE/^T/@STAPAR(S1)/>) ;GEN THE HEADING
	CAIN	T2,.OTFAL		;FAL?
	JRST	CHKQ.4			;YES, GO DO ITS THING
	CAIN	T2,.OTNQC		;NETWORK QUEUE CONTROLLER?
	JRST	CHKQ.6			;YES
	CAIE	T2,.OTBAT		;IS THIS BATCH ???
	JRST	CHKQ.3			;NO,,ASSUME ITS OUTPUT
	$ASCII	(<  Strm  >)		;START THE HEADING
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<   Node     >)	;YES,,PUT OUT A HEADING FOR THEM
	SKIPE	SHWTYP			;IS IT 'SHOW STATUS' ???
	JRST	CHK.2A			;NO,,MUST BE 'SHOW PARAMETERS' !!!

	;SET UP BATCH 'SHOW STATUS' HEADINGS

	$ASCII	(<    Status       >) 	;PUT OUT SOME MORE HEADING
	SKIPE	ACTIVE			;ANY ACTIVE JOBS ???
	$ASCII	(<Jobname   Req#              User>) ;YES,,PUT OUT A HEADING
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<  ----  >)
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<----------  >)	;YES,,UNDERLINE IT
	$ASCII	(<---------------  >) 	;UNDERLINE STATUS
	SKIPE	ACTIVE			;ANY ACTIVE ???
	$ASCII	(<-------  ------  ------------------------>)
	PUSHJ	P,CRLF			;START A NEW LINE
	$RETT				;AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;SET UP BATCH 'SHOW PARAMETERS' HEADINGS

CHK.2A:
IFE INPCOR,< $ASCII (<   Minutes      Prio  Opr-Intvn>)>
IFN INPCOR,< $ASCII (<   Minutes      Prio  Core limits  Opr-Intvn>)>
	SKIPE	ATRIB			;NEED TO LIST ATTRIBUTES ?
	$ASCII	(<  Attributes>)	;YES
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<  ----  >)		;UNDERLINE 'STRM'
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<----------  >)	;YES,,UNDERLINE IT
IFE INPCOR,< $ASCII (<-------------  -----  --------->)>
IFN INPCOR,< $ASCII (<-------------  -----  -----------  --------->)>
	SKIPE	ATRIB			;NEED TO LIST ATTRIBUTES ?
	$ASCII	(<  ---------->)	;YES
	PUSHJ	P,CRLF			;START A NEW LINE
	$RETT				;AND RETURN

	;OUTPUT QUEUE 'SHOW STATUS' HEADINGS

CHKQ.3:	$ASCII	(<  Unit  >)		;START THE HEADING
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<   Node     >)	;YES,,PUT OUT A HEADING FOR THEM
	SKIPE	SHWTYP			;IS THIS 'SHOW STATUS' ???
	JRST	CHK.3A			;NO,,MUST BE 'SHOW PARAMETERS' !!!
	$ASCII	(<    Status       >)	;STATUS HEADING
	SKIPE	ACTIVE			;ANY ACTIVE JOBS ???
	$ASCII	(<Jobname   Req#             User>) ;YES.....
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<  ----  >)		;UNIT UNDERLINE
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<----------  >)	;YES......
	$ASCII	(<---------------  >)	;OUTPUT STATUS UNDERLINE
	SKIPE	ACTIVE			;ANY ACTIVE JOBS ???
	$ASCII	(<-------  ------  ------------------------>) ;YES...
	PUSHJ	P,CRLF			;START A NEW LINE
	$RETT				;AND RETURN

	;OUTPUT QUEUE 'SHOW PARAMETERS' HEADING

CHK.3A:	MOVE	S1,OBTYPE		;GET THE OBJECT TYPE
	MOVE	S1,LIMTYP(S1)		;GET THE LIMIT DESCRIPTION ADDRESS
	PUSHJ	P,ASCOUT		;PUT IT OUT
	$ASCII	(<   Form    Prio  Lim  Ex  Dev-Chars>) ;REST OF HEADING
	PUSHJ	P,CRLF			;START NEXT LINE
	$ASCII	(<  ----  >)		;'UNIT' UNDERLINE
	SKIPE	REMOTE			;ANY REMOTE STATIONS ???
	$ASCII	(<----------  >)	;YES,,UNDERLINE ITS HEADING
	$ASCII	(<------------  ------  -----  -------  --------->) ;REST OF HDNG
	PUSHJ	P,CRLF			;START A NEW LINE
	$RETT				;AND RETURN

;SETUP SHOW STATUS FAL-STREAM DISPLAY HEADER

CHKQ.4:	SKIPE	SHWTYP			;SHOW STATUS?
	JRST	CHKQ.5			;NO, MUST BE SHOW PARAMTERS
	$ASCII	(<  Strm  >)		;START THE HEADING
	$ASCII	(<    Status       >) 	;PUT OUT SOME MORE HEADING
	SKIPE	ACTIVE			;ANY ACTIVE JOBS ???
	$ASCII	(< Node   Connect Time   Bytes>) ;YES, OUTPUT HEADING
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<  ----  ---------------  >) ;UNDERLINE STREAM AND STATUS
	SKIPE	ACTIVE			;ANY ACTIVE ???
	$ASCII	(<------  ------------  ------->)
	PJRST	CRLF			;START A NEW LINE AND RETURN

;SET SHOW PARAMTERS FAL-STREAM DISPLAY HEADER

CHKQ.5:	$ASCII	(<  Strm  Network>)
	PUSHJ	P,CRLF
	$ASCII	(<  ----  ------->)
	PJRST	CRLF


;SETUP SHOW STATUS NETWORK-QUEUE-CONTROLLER STREAM DISPLAY HEADER

CHKQ.6:	SKIPE	SHWTYP			;SHOW STATUS?
	JRST	CHKQ.7			;NO, MUST BE SHOW PARAMTERS
	$ASCII	(<  Strm  >)		;START THE HEADING
	$ASCII	(<    Status       >) 	;PUT OUT SOME MORE HEADING
	SKIPE	ACTIVE			;ANY ACTIVE JOBS ???
	$ASCII	(< Node    Link   Connect Time   Bytes>) ;YES, OUTPUT HEADING
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<  ----  ---------------  >) ;UNDERLINE STREAM AND STATUS
	SKIPE	ACTIVE			;ANY ACTIVE ???
	$ASCII	(<------  ------  ------------  ------->)
	PJRST	CRLF			;START A NEW LINE AND RETURN

;SET SHOW PARAMTERS NETWORK-QUEUE-CONTROLLER STREAM DISPLAY HEADER

CHKQ.7:	$ASCII	(<  Strm  Attribute>)
	PUSHJ	P,CRLF
	$ASCII	(<  ----  --------->)
	PJRST	CRLF
	SUBTTL	D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE.

	EXTERN	G$MSG			;MAKE THIS ACCESSABLE !!!

D$SHRT:	SETOM	ENTYPE			;INDICATE THIS IS AN OPERATOR REQUEST.
	LOAD	S1,.MSCOD(M)		;GET THE ACK CODE.
	STORE	S1,ACKCOD		;   AND SAVE IT.

	MOVE	S1,RTEQUE##		;GET THE ROUTE TABLE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JUMPF	SHRT.4			;NONE THERE,,THATS AN ERROR
	PUSH	P,S2			;SAVE THE FIRST ENTRY ADDRESS
	MOVEI	S1,[ASCIZ/ System Device Routing Table /] ;GET THE HEADING.
	PUSHJ	P,SETPAG		;SET UP AN OUTPUT PAGE.
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	POP	P,S1			;RESTORE THE FIRST ENTRY ADDRESS
	JRST	SHRT.2			;CONTINUE PROCESSING

SHRT.1:	MOVE	S1,RTEQUE##		;GET THE ROUTE TABLE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
	SKIPT				;SKIP IF THERE IS ANOTHER
	PJRST	SENDIT			;ELSE END THE ACK AND RETURN
	MOVE	S1,S2			;GET THE ENTRY ADDRESS IN S1
SHRT.2:	PUSHJ	P,N$RTAS##		;CONVERT THE ENTRY TO ASCIZ (IN G$MSG)
	$TEXT	(DEPBYT,<	^T/G$MSG/^M^J>) ;INSERT THE TEXT
	JRST	SHRT.1			;AND GET NEXT

SHRT.4:	$ACK	(<No routing has been performed>,,,ACKCOD) ;TELL OPR
	$RETT				;AND RETURN
	SUBTTL	D$SHQN - ROUTINE TO DISPLAY THE QUEUE NAMES

D$SHQN::MOVE	S1,.MSCOD(M)		;GET THE ACK CODE
	MOVEM	S1,ACKCOD		;SAVE IT
	$SAVE	<H,AP>			;FREE UP SOME AC'S
	MOVEI	H,HDRQNM##		;GET ADDRESS OF QUEUE HEADER
	LOAD	AP,.QHLNK(H),QH.PTF	;GET POINTER TO FIRST
	SETOM	JOBNBR			;SET COUNT TO -1

SHQN.1:	JUMPE	AP,SHQN.2		;DONE IF NOTHING ELSE
	AOSG	JOBNBR			;TIME FOR THE HEADER?
	PUSHJ	P,QNMHDR		;YES, PUT IT OUT
	LOAD	TF,QNM.RO+.ROBAT(AP),RO.ATR ;GET ATTRIBUTE
	MOVEI	S1,[ITEXT (<^T8L/(S2)/>)] ;ASSUME NOT PHYSICAL OR UNIT TYPE
	MOVE	S2,TF		;GET INDEX
	MOVE	S2,ATRBTB(S2)	;AND ASSOCIATED TEXT
	CAIN	TF,%GENRC	;GENERIC?
	SKIPN	QNM.RO+.ROBUT(AP) ;AND A UNIT TYPE?
	SKIPA			;NO
	PUSHJ	P,[MOVEI  S1,[ITEXT (< ^W6L/S2/ >)] ;UNIT TYPE TEXT
		   MOVE   S2,QNM.RO+.ROBUT(AP)	    ;UNIT TYPE NAME
		   POPJ   P,]
	CAIN	TF,%PHYCL	;PHYSICAL?
	PUSHJ	P,[MOVEI  S1,[ITEXT (<   ^D2R/S2/   >)] ;UNIT NUMBER TEXT
		   LOAD   S2,QNM.RO+.ROBAT(AP),RO.UNI	;UNIT NUMBER
		   POPJ   P,]
	MOVX	T1,QN.LCL	;SEE IF LOCAL DEFINITION
	TDNE	T1,QNM.FL(AP)	;...
	TDZA	T1,T1		;YES, GET A ZERO AND SKIP
	MOVEI	T1,1		;NO, GET A 1
	$TEXT	(DEPBYT,<^Q31L/QUENAM/  ^T6L/@QNMTYP(T1)/  ^116L/QNM.RO+.ROBTY(AP)/  ^W6L/QNM.RO+.ROBND(AP)/  ^I/(S1)/>)
	LOAD	AP,.QELNK(AP),QE.PTN	;GET POINTER TO NEXT ENTRY
	JRST	SHQN.1			;SEE IF MORE TO DO

SHQN.2:	AOSG	S1,JOBNBR		;GET CORRECT COUNT
	$ACK	(<There are no queue names defined>,,,ACKCOD)
	JUMPE	S1,.RETT		;ALL DONE IF NOTHING
	PJRST	SENDIT			;SEND THE ACK AND RETURN

QNMHDR:	MOVEI	S1,[ASCIZ / Network Queue Names /]
	PUSHJ	P,SETPAG		;SET UP OUTPUT PAGE
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<          Queue  Name             Type     Object Type      Node     Unit  >)
	PUSHJ	P,CRLF			;END THE LINE
	$ASCII	(<-------------------------------  ------  ----------------  ------  -------->)
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;FOR NOW
	SUBTTL	D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMETERS

D$NPRM:	PUSHJ	P,.SAVE2		;SAVE THE P ACS.
	PUSHJ	P,GETPARM		;GO BREAK DOWN THE INCOMMING MESSAGE
	SETOM	JOBNBR			;SET NODE COUNT TO -1
	LOAD	P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY

NPRM.1:	JUMPE	P1,NPRM.5		;NO MORE,,GO FINISH UP
	SKIPN	S1,NETCOL(P1)		;[1206]GET NODE NUMBER, IS IT 0 ???
	MOVE	S1,NETLOC(P1)		;[1512]GET THIS NODES NAME/NUMBER
	PUSHJ	P,CMPNOD		;IS IT ONE WE WANT ???
	JUMPF	NPRM.3			;NO,,TRY NEXT
	SKIPN	S1,NETCOL(P1)		;[1147]GET NODE NUMBER UNLESS 0
	MOVE	S1,NETLOC(P1)		;[1147]GET THE NODE NAME/NUMBER
	PUSHJ	P,N$NODE##		;FIND THAT NODE IN OUR DATA BASE
	MOVE	P2,S2			;SAVE THE ENTRY ADDRESS
	LOAD	S1,NETSTS(P2),NETIBM	;GET THIS ONES TYPE DESIGNATION
	JUMPE	S1,NPRM.3		;NOT IBM,,SKIP THIS STUFF
	AOSG	JOBNBR			;BUMP NODE COUNT.
	PUSHJ	P,NPRHDR		;FIRST TIME,,SET UP THE HEADER
	PUSHJ	P,CHKLIN		;Check to see if next line fits
	LOAD	T1,NETSTS(P2),NT.TYP	;GET THE NODE TYPE
	LOAD	T2,NETSTS(P2),NT.MOD	;GET THE NODE MODE
	$TEXT	(DEPBYT,<^T14/NETASC(P2)/ ^T/@IBMTYP(T1)/^A>)
	LOAD	T1,NETSTS(P2),NETONL	;Get the online bit
	SKIPN	T1			;Is it offline?
	CAIE	T2,DF.TRM		;Yes, is it a defined actual node?
	SKIPA				;No to either
	JRST	NPRM.2			;Yes to both, skip rest, continue loop
	LOAD	S1,NETPTL(P2),NT.PRT	;GET NEW STYLE CAL11. PORT ARGUMENT
	MOVS	T1,S1			;GET IN LH WHERE IT'S DEFINED
	LOAD	S1,T1,C1.1CN		;GET THE CPU NUMBER
	LOAD	S2,T1,C1.1TY		;GET PORT TYPE CODE
	LOAD	T1,T1,C1.1PN		;GET PORT NUMBER
	$TEXT	(DEPBYT,< ^O3R/S1/ ^T4R/@IBMPOR(S2)/^O2R/T1/^A>) ;DISPLAY THE STUFF
	LOAD	T3,NETSTS(P2),NT.TOU	;Get protocol timeout cat.
	LOAD	T4,NETSTS(P2),NT.TRA	;GET 'TRANSPARENCY'
	$TEXT	(DEPBYT,< ^D4/NETPTL(P2),NT.LIN/  ^T/@IBMDTR(T4)/  ^D5/NETCSD(P2)/ ^D5/NETRPM(P2)/ ^D5/NETBPM(P2)/ ^T/@IBMTIM(T3)/>)
	$TEXT	(DEPBYT,<   ^T/@IBMODE(T2)/^A>) ;DISPLAY TERMINATION OR WHATEVER
	LOAD	T1,NETSTS(P2),NETSGN	;GET 'SIGNON REQUIRED' BIT
	SKIPE	T1			;SIGNON REQUIRED?
	SKIPA	T1,[[ASCIZ\[Sign-on required]\]] ;YES
	MOVEI	T1,[ASCIZ\[Sign-on is not required]\] ;NO
	$TEXT	(DEPBYT,< ^T/(T1)/^A>)	;DISPLAY SIGN-ON INFO

NPRM.2:	PUSHJ	P,CRLF			;END THE LINE

NPRM.3:	LOAD	P1,.QELNK(P1),QE.PTN	;GET THE NEXT ENTRY
	JRST	NPRM.1			;AND CONTINUE

NPRM.5:	AOS	S1,JOBNBR		;GET THE NODE COUNT IN S1
	MOVE	S2,NODE6B		;GET THE NODE WE ASKED FOR
	JUMPG	S1,NPRM.6		;WE HAD A MATCH SOMEWHERE !!!
	CAMN	S2,[-1]			;DID WE ASK FOR ALL NODES ???
	$ACK	(<No IBM remotes in system network>,,,.MSCOD(M))
	CAME	S2,[-1]			;DID WE ASK FOR ALL NODES ???
	$ACK	(<Node ^N/NODE6B/ is not an IBM remote>,,,.MSCOD(M))
	$RETT				;JUST RETURN NOW

NPRM.6:	CAIN	S1,1			;IS THERE 1 NODE ???
	$ASCII	(<There is 1 IBM node defined in the network>)
	CAILE	S1,1			;IS THERE MORE THEN 1 ???
	$TEXT(DEPBYT,<There are ^D/JOBNBR/ IBM nodes defined in the network^A>)
	PUSHJ	P,CRLF			;END THE LINE
	PUSHJ	P,CRLF			;ONE MORE FOR GOOD LUCK
	PJRST	SENDIT
	SUBTTL	NPRHDR - NETWORK PARAMETER HEADER ROUTINE

NPRHDR:	MOVEI	S1,[ASCIZ/ IBM Network Parameters /] ;GET THE HEADING.
	PUSHJ	P,SETPAG		;SET UP AN OUTPUT PAGE.
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	$ASCII	(<  Node Name    Type CPU  Port  Line Trans  CSD   RPM   BPM  Timeout>) 
	PUSHJ	P,CRLF			;END THE LINE
	$ASCII	(<-------------- ---- --- ------ ---- ----- ----- ----- ----- ------->) 
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN
	SUBTTL	D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE)

D$NSTS:	$SAVE	<P1>			;Save P1 for a min.
	SETOM	JOBNBR			;NODE COUNT
	PUSHJ	P,GETPARM		;BREAK DOWN THE INCOMMING MESSAGE
	MOVE	S1,NODE6B		;GET THE NODE WE WANT
	CAME	S1,[-1]			;ALL NODES ???
	JRST	NSTS.5			;No, go do it different
	LOAD	P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST NODE DATA BASE ENTRY
	SKIPA				;SKIP THE FIRST TIME THROUGH
NSTS.0:	LOAD	P1,.QELNK(P1),QE.PTN	;GET THE NEXT NODE ENTRY ADDRESS
	JUMPE	P1,NSTS.3		;NO MORE,,JUST RETURN
	AOSG	JOBNBR			;BUMP NODE COUNT BY 1
	PUSHJ	P,NSTHDR		;FIRST ONE,,PUT OUT A HEADER
	PUSHJ	P,CHKLIN		;Check to see if next line fits
	MOVX	S1,NETNQC		;GET THE SERVER BIT
	TDNN	S1,NETSTS(P1)		;NETWORK QUEUE CONTROLLER?
	TDZA	S1,S1			;NO, GET A ZERO
	MOVEI	S1,3			;YES, GET OFFSET TO ONOFL TABLE
	JUMPN	S1,NSTS.1		;SKIP ONLINE/OFFLINE CHECK IF NET QUE
	LOAD	S1,NETSTS(P1),NETONL	;GET THE ONLINE BIT
	JUMPN	S1,NSTS.1		;If online, just put out the status
	LOAD	S1,NETSTS(P1),NETPRO	;Get the proto-actual online bit
	SKIPE	S1			;Still offline, skip
	MOVEI	S1,2			;Otherwise, set active status

NSTS.1:	$TEXT	(DEPBYT,<^T15/NETCLM(P1)/ ^T/@ONOFL(S1)/^A>) ;TYPE NAME(NBR)

	LOAD	S1,NETSTS(P1),NETIBM	;GET THE IBM REMOTE STATUS BIT
	JUMPE	S1,NSTS.2		;Not IBM, go finish up
	LOAD	S1,NETSTS(P1),NT.MOD	;IBM,,GET THE MODE
	$TEXT	(DEPBYT,< (IBM ^T/@IBMODE(S1)/)^A>)  ;PUT OUT IBM INDICATION
	CAIE	S1,DF.PRO		;Is it proto?
	JRST	NSTS.2			;No, go finish
	LOAD	S1,NETSTS(P1),NETPRO	;Get the proto-actual online bit
	JUMPE	S1,NSTS.2		;Not proto-actual online, go finish
	$TEXT	(DEPBYT,< as Station ^N/NETLOC(P1)/^A>)

NSTS.2:	PUSHJ	P,CRLF			;Add the end of the line
	JRST	NSTS.0			;Go for the next

NSTS.3:	AOSG	S1,JOBNBR		;GET CORRECT COUNT
	$ACK	(<There are no nodes in the network>,,,.MSCOD(M))
	JUMPE	S1,.RETT		;ALL DONE,,JUST RETURN
	CAIN	S1,1			;JUST 1 NODE
	$ASCII	(<There is 1 node in the network>)
	CAILE	S1,1			;MORE THEN 1 ???
	$TEXT	(DEPBYT,<There are ^D/JOBNBR/ nodes in the network^A>)
	PUSHJ	P,CRLF			;END THE LINE
	PUSHJ	P,CRLF			;ADD ONE MORE
	PJRST	SENDIT			;AND SEND THE ACK

NSTHDR:	MOVEI	S1,[ASCIZ/ System Network Status /] ;GET HEADING
	PUSHJ	P,SETPAG		;SET UP THE OUTPUT PAGE
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<    Node         Status >) ;SET UP HEADING
	PUSHJ	P,CRLF			;END THE LINE
	$ASCII	(<------------    -------->) ;UNDERLINE IT
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;  Here if Network status for a particular node

NSTS.5:
	$CALL	N$GNOD##			;Go get the node
	JUMPT	NSTS.6			;Found, go output
	$ACK	(<Node ^N/NODE6B/ does not exist>,,,.MSCOD(M))
	$RETT				;Nothing more to do

NSTS.6:	MOVE	P1,S2			;Get the node entry address
	LOAD	S1,NETSTS(P1),NETIBM	;GET THE IBM REMOTE STATUS
	LOAD	S2,NETSTS(P1),NETONL	;GET THE ONLINE BIT
	JUMPN	S1,NSTS.7		;IF AN IBM REMOTE,,SKIP THIS
	$ACK	(<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/>,,,.MSCOD(M))
	$RETT				;RETURN
NSTS.7:	LOAD	S1,NETSTS(P1),NT.MOD	;GET THE MODE
	JUMPN	S2,NSTS.8		;If online, skip this
	CAIE	S1,DF.PRO		;Is it prototype?
	JRST	NSTS.8			;No, skip this
	LOAD	S2,NETSTS(P1),NETPRO	;Get proto-actual online bit
	JUMPE	S2,NSTS.8		;Not actual online, continue
	MOVEI	S2,2			;Get active status
	$ACK	(<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,<  as Station ^N/NETLOC(P1)/>,,.MSCOD(M))
	$RETT				;Return
NSTS.8:	$ACK	(<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,,,.MSCOD(M))
	$RETT				;RETURN

	SUBTTL	D$STAP - SHOW STATUS OF TAPE DRIVES

TOPS10< INTERN	D$STAP			;SHOW STATUS TAPE DRIVES

D$STAP:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	SETOM	ENTYPE			;OPERATOR ENTRY POINT
	SETOM	JOBNBR			;DEVICE COUNT
	SETZM	ACTIVE			;ALLOCATED DEVICES
	SETZM	REMOTE			;PRESTAGED DEVICES
	PUSHJ	P,GETPARM		;BREAK DOWN THE INCOMMING MESSAGE
	MOVE	S1,.OFLAG(M)		;GET THE FLAG WORD
	MOVEM	S1,LISTYP		;SAVE FOR GETDSK ROUTINE

	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY
	SKIPT				;SKIP IF WE FOUND ONE
	PUSHJ	P,S..NUE##		;NULL UCB CHAIN !!!
STAP.1:	MOVE	P1,S2			;SAVE THE UCB ADDRESS
	SKIPE	S1,DEVICE		;A SPECIFIC DEVICE ???
	CAMN	S1,.UCBNM(P1)		;YES,,DO THEY MATCH ???
	SKIPA				;NO DEVICE OR THEY MATCH,,WIN
	JRST	STAP.2			;NO GOOD,,TRY NEXT DEVICE
	LOAD	S1,.UCBST(P1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%TAPE		;IS IT MAG TAPE ???
	JRST	STAP.2			;NO,,TRY NEXT DEVICE
	LOAD	TF,.UCBST(P1),UC.VSW	;GET VOLUME SWITCH BIT
	SKIPE	TF			;IN VOLUME SWITCH MODE ???
	SETOM	ACTIVE			;YES,,INDICATE WE HAVE AN OWNER
	SKIPN	S1,.UCBVL(P1)		;YES,,IS A VOLUME MOUNTED ???
	JRST	STAP.2			;NOT TAPE OR NO VOLUME,,TRY NEXT UCB
	SETOM	REMOTE			;INDICATE WE HAVE A STAGED VOLUME
	PUSHJ	P,D$VOWN##		;DOES ANYONE OWN THIS VOLUME ???
	SKIPF				;NO,,SKIP
	SETOM	ACTIVE			;YES,,INDICATE SO
	SKIPE	ACTIVE			;IS 'ACTIVE' SET
	SKIPN	REMOTE			;AND IS 'REMOTE' SET ???
	SKIPA				;BOTH NOT SET,,SKIP
	JRST	STAP.3			;BOTH SET,,STOP SCANNING
STAP.2:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
	JUMPT	STAP.1			;FOUND ONE,,GO CHECK IT OUT

STAP.3:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	SKIPT				;SKIP IF WE FOUND ONE
	PUSHJ	P,S..NUE##		;NULL UCB CHAIN !!!
STAP.4:	MOVE	P1,S2			;SAVE THE ENTRY ADDRESS
	SKIPE	S1,DEVICE		;A SPECIFIC DEVICE ???
	CAMN	S1,.UCBNM(P1)		;YES,,DO THEY MATCH ???
	SKIPA				;NO DEVICE OR THEY MATCH,,WIN
	JRST	STAP.6			;NO GOOD,,TRY NEXT DEVICE
	LOAD	S1,.UCBST(P1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%TAPE		;IS IT TAPE ???
	JRST	STAP.6			;NO,,TRY NEXT UCB
	MOVX	TF,ST.AVA		;GET AVAILABLE BIT (/FREE)
	TDNN	TF,LISTYP		;USER SPECIFY /FREE ?
	JRST	STAP.D			;NO - TRY TO LIST ALL
	MOVX	TF,UC.AVA		;GET 'AVAILABLE TO MDA' BIT
	SKIPN	.UCBVS(P1)		;'FREE' ONLY, SO CAN'T BE ASSIGNED
	TDNN	TF,.UCBST(P1)		;    OR SET UNAVAILABLE !!!
	JRST	STAP.6			;LOSE,,TRY ANOTHER DRIVE

STAP.D:	AOSG	JOBNBR			;BUMP DEVICE COUNT BY 1
	PUSHJ	P,TAPHDR		;FIRST TIME,,PUT OUT THE TAPE STATUS HDR
	LOAD	S1,.UCBST(P1)		;GET THE DEVICE STATUS BITS
	MOVEI	S2,[ASCIZ/Online /]	;DEFAULT TO 'ONLINE' STATUS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	TXNE	S1,UC.OFL		;IS IT OFFLINE ???
	MOVEI	S2,[ASCIZ/Offline/]	;YES,,SAY SO
	SKIPN	.UCBVL(P1)		;IS THERE A VOLUME ON THIS UCB ???
	MOVEI	S2,[ASCIZ/Free   /]	;NO,,MAKE THE STATUS 'FREE'
	TXNN	S1,UC.AVA		;IS IT 'UNAVAILABLE' ???
	MOVEI	S2,[ASCIZ/Unavailable/]	;YES,,SAY SO
	LOAD	TF,.UCBST(P1),UC.VSW	;GET THE VOLUME SWITCH BIT
	SKIPE	TF			;SWITCHING VOLUMES ???
	MOVEI	S2,[ASCIZ/Vol Switch/]	;YES,,SAY SO
	LOAD	TF,.UCBST(P1),UC.INI	;GET THE INITIALIZING BIT
	SKIPE	TF			;INITIALIZING LABELS?
	MOVEI	S2,[ASCIZ/Initializing/] ;YES, SAY SO
	MOVEI	S1,[ASCIZ/Yes/]		;DEFAULT AVR YES
	LOAD	TF,.UCBST(P1),UC.AVR	;GET THE AVR BIT
	SKIPN	TF			;IS IT LIT ???
	MOVEI	S1,[ASCIZ/No /]		;NO,,SAY NO AVR !!!
	LOAD	T1,.UCBST(P1),UC.TRK	;GET THE TRACK TYPE
	$TEXT	(DEPBYT,<^W6/.UCBNM(P1)/ ^W3/TRK(T1)/ ^T11/0(S2)/ ^T3/0(S1)/ ^A>) 
	SKIPE	S1,.UCBVL(P1)		;VOLUME ON DRIVE?
	JRST	STAP.T			;YES, MAKES THINGS A LITTLE EASIER
	MOVX	S1,UC.200		;GET 200 BPI BIT
	TDNE	S1,.UCBST(P1)		;IS IT LIT?
	JRST	STAP.S			;YES
	MOVX	S1,UC.800		;GET 800 BPI BIT
	TDNN	S1,.UCBST(P1)		;LIT?
	MOVX	S1,UC.6250		;NO, GET 6250 BIT
STAP.S:	TXNE	S1,UC.200		;200 BPI BIT IN S1?
	MOVEI	S2,[ASCIZ\200/556/800\]	;YES, ASSUME 556 AND 800 BPI TOO
	TXNE	S1,UC.800		;800 BPI BIT IN S1?
	MOVEI	S2,[ASCIZ\800/1600\]	;YES, ASSUME 1600 BPI TOO
	TXNE	S1,UC.6250		;6250 BPI BIT IN S1?
	MOVEI	S2,[ASCIZ\1600/6250\]	;YES, IT DOES 1600 BPI ALSO
	MOVX	T1,UC.6250		;GET 6250 BPI BIT
	TDNE	T1,.UCBST(P1)		;CHECK FOR ONE OF THEM FUNNY DRIVES
	TXNN	S1,UC.800		;THAT HAVE 800/1600/6250 BPI
	TRNA
	MOVEI	S2,[ASCIZ\800/1600/6250\] ;IT IS!!!
	$TEXT	(DEPBYT,<^T13/(S2)/ ^A>) ;DUMP THE TEXT
	JRST	STAP.U			;JOIN COMMON CODE
STAP.T:	LOAD	S2,.VLFLG(S1),VL.DEN	;GET VOLUME DENSITY
	$TEXT	(DEPBYT,<^T13L /@DENSTY(S2)/ ^A>) ;DUMP DENSITY OF VOLUME
STAP.U:	SKIPE	S1,.UCBVL(P1)		;ANY VOLUME ON THIS DRIVE ???
	JRST	STAP.Y			;YES,,GO PROCESS IT
	LOAD	TF,.UCBST(P1),UC.VSW	;GET THE VOLUME SWITCH BIT
	SKIPN	TF			;SWITCHING VOLUMES,,SKIP
	JRST	STAP.5			;NO,,GO FINISH UP
	SKIPE	REMOTE			;ARE ANY VOLS MOUNTED ???
	$ASCII	(<               >)	;YES,,PAD THE LINE
	JRST	STAP.Z			;AND CONTINUE

STAP.Y:	MOVEI	S2,[ASCIZ/Enabled/]	;DEFAULT TO WRITE ENABLED
	LOAD	TF,.UCBST(P1),UC.WLK	;GET THE WRITE LOCKED BIT
	SKIPE	TF			;IS IT LIT ???
	MOVEI	S2,[ASCIZ/Locked /]	;YES,,SAY WRITE LOCKED
	$TEXT	(DEPBYT,<^T7/0(S2)/ ^W6/.VLNAM(S1)/ ^A>) ;ADD SOME MORE TEXT

STAP.Z:	SKIPN	T1,.UCBVS(P1)		;[1173] GET VSL ADDRESS JUST IN CASE
	JRST	STAP.5			;NO OWNER,,SKIP THIS
	MOVE	AP,.VSMDR(T1)		;[1173] GET THE OWNER MDR ADDRESS
	LOAD	T2,.VSCVL(T1),VS.OFF	;GET OFFSET TO CURRENT VOLUME
	ADDI	T2,.VSVOL(T1)		;COMPUTE ADDRESS OF VOL BLOCK POINTER
	SKIPE	T2,(T2)			;GET VOL BLOCK ADDRESS
	LOAD	T2,.VLFLG(T2),VL.DEN	;GET VOLUME DENSITY
	LOAD	S1,.MRJOB(AP),MR.JOB	;GET THE OWNERS JOB NUMBER
	MOVE	S2,.MRQEA(AP)		;GET THE QE ADDRESS (MAY BE 0)
	TXNE	S1,BA%JOB		;OWNED BY A PSEUDO REQUEST ???
	$TEXT(DEPBYT,<^M^J	Mounted for request ^D/.QERID(S2)/ ^I/MNTUSR/ ^15/.VSRFL(T1),MR.QUE/^A>) ;[1173]
	TXNN	S1,BA%JOB		;OWNED BY A NORMAL REQUEST ???
	$TEXT(DEPBYT,<^M^J	Owned by job ^D/.MRJOB(AP),MD.PJB/ ^I/MNTUSR/^A>)

STAP.5:	PUSHJ	P,CRLF			;END THE LINE

STAP.6:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB
	JUMPT	STAP.4			;FOUND ONE,,GO CHECK IT OUT

	AOSG	S1,JOBNBR		;GET AND FIX DEVICE COUNT
	$ACK	(<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
	JUMPE	S1,.RETT		;THE END,,RETURN
	PUSHJ	P,CRLF			;ADD AN ENDING CRLF
	PUSHJ	P,SENDIT		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$SDSK - SHOW STATUS OF DISK DRIVES

TOPS10< INTERN	D$SDSK			;SHOW STATUS DISK DRIVES

D$SDSK:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	SETOM	ENTYPE			;OPERATOR ENTRY POINT
	SETOM	JOBNBR			;DEVICE COUNT
	SETZM	REMOTE			;CLEAR MOUNTED VOLUMES FLAG
	SETZM	ACTIVE			;CLEAR DUAL PORTED FLAG
	PUSHJ	P,GETPARM		;BREAK DOWN THE INCOMMING MESSAGE
	MOVE	S1,.OFLAG(M)		;GET THE FLAG WORD
	MOVEM	S1,LISTYP		;SAVE FOR LATER
	SETOM	LSTUSR			;SAY WE WANT TO START UCB SCAN

SDSK.1:	PUSHJ	P,GETDSK		;GET A DISK UCB
	JUMPF	SDSK.2			;NO MORE,,CONTINUE ONWARD
	SKIPE	.UCBVL(S1)		;IS A VOLUME MOUNTED ???
	SETOM	REMOTE			;YES,,SET THE FLAG
	SKIPE	.UCBAU(S1)		;IS IT DUAL PORTED ???
	SETOM	ACTIVE			;YES,,SET THE FLAG
	SKIPE	ACTIVE			;IS DUAL PORTED FLAG LIT ???
	SKIPN	REMOTE			;  AND IS A VOLUME MOUNTED ???
	JRST	SDSK.1			;BOTH NOT SET,,TRY AGAIN

SDSK.2:	SETOM	LSTUSR			;INDICATE WE WANT TO START UCB SCAN OVER

SDSK.3:	PUSHJ	P,GETDSK		;GET A DISK UCB
	JUMPF	SDSK.5			;NO MORE,,GO FINISH UP
	MOVE	P1,S1			;SAVE THE ENTRY ADDRESS
	AOSG	JOBNBR			;BUMP DEVICE COUNT BY 1
	PUSHJ	P,DSKHDR		;FIRST TIME,,PUT OUT THE DISK STATUS HDR
	SKIPE	S1,.UCBVL(P1)		;IS THERE A VOLUME MOUNTED ON IT ???
	LOAD	S1,.VLFLG(S1),VL.STA	;YES,,GET THE STRUCTURE STATUS BITS
	CAXE	S1,%STAMN		;IS IT MOUNTED ???
	JRST	SDSK.3			;NO,,SKIP IT AND TRY NEXT UCB
SDSK.4:	PUSHJ	P,SDSK.A		;PUT OUT STATUS INFO FOR THIS UCB
	LOAD	P1,.UCBVL(P1)		;GET THE MOUNTED VOLUME ADDRESS
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET THE PTR TO THE NEXT VOLUME
	JUMPE	P1,SDSK.3		;NO MORE,,GET NEXT UCB
	MOVE	P1,.VLUCB(P1)		;GET THAT VOL'S UNIT ADDRESS
	JRST	SDSK.4			;AND PUT IT OUT

SDSK.5:	SETOM	LSTUSR			;INDICATE RESCAN OF UCB QUEUE

SDSK.6:	PUSHJ	P,GETDSK		;GET A DISK UCB
	JUMPF	SDSK.7			;NO MORE,,FINISH UP
	MOVE	P1,S1			;SAVE THE UCB ADDRESS
	SKIPN	S1,.UCBVL(P1)		;IS THERE A VOLUME MOUNTED ON IT ???
	JRST	SDS.6B			;NO,,OUTPUT THE UNIT STATUS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

SDS.6A:	MOVE	S2,S1			;SAVE THE CURRENT VOL BLOCK ADDRESS
	LOAD	S1,.VLPTR(S2),VL.PRV	;FIND THE PRIMARY VOL BLOCK FOR THIS STR
	JUMPN	S1,SDS.6A		;NOT THERE YET,,KEEP TRYING
	LOAD	S1,.VLFLG(S2),VL.STA	;YES,,GET STRUCTURE STATUS BITS
	CAXN	S1,%STAMN		;IS IT MOUNTED ???
	JRST	SDSK.6			;YES,,SKIP IT AND TRY NEXT UCB

SDS.6B:	PUSHJ	P,SDSK.A		;PUT OUT THE UNIT STATUS DATA
	JRST	SDSK.6			;AND CONTINUE

SDSK.7:	AOSG	S1,JOBNBR		;GET AND FIX DEVICE COUNT
	JRST	SDSK.8			;NONE LISTED.. SEE WHY
	PUSHJ	P,CRLF			;ADD AN ENDING CRLF
	PUSHJ	P,SENDIT		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN

SDSK.8:	SKIPE	DEVICE			;WANTED A SPECIFIC DISK?
	JRST	[$ACK	(<Device ^W/DEVICE/ does not exist>,,,ACKCOD)
		$RETT]			;YES, SAY WE DIDN'T FIND IT
	$ACK	(<No free drives>,,,ACKCOD)
	$RETT

	;Here to output the disk device status

SDSK.A:	SKIPE	NOROOM			;ANY ROOM LEFT IN THE CURRENT BUFFER ???
	PUSHJ	P,PAGOVF		;NO,,SEND CURRENT AND CONTINUE
	$TEXT	(DEPBYT,<^W8/.UCBNM(P1)/^A>) ;PUT OUT THE UNIT NAME
	SKIPE	ACTIVE			;ANY DUAL PORTING ???
	$TEXT	(DEPBYT,<^W10/.UCBAU(P1)/^A>) ;YES,,DUMP OUT SECOND PORT
	LOAD	S1,.UCBST(P1),UC.RSN	;GET THE DEVICE RESOURCE NUMBER
	IMULI	S1,AMALEN		;CALC THE ENTRY OFFSET
	ADD	S1,AMATRX##		;GET THE 'A' MATRIX ENTRY ADDRESS
	LOAD	TF,.UCBST(P1)		;GET THE UCB STATUS BITS
	MOVEI	T2,[ASCIZ/Yes/]		;DEFAULT AVR TO YES
	TXNN	TF,UC.AVR		;IS AVR ENABLED ???
	MOVEI	T2,[ASCIZ/No /]		;NO,,SAY SO
	MOVEI	S2,[ASCIZ/Online /]	;DEFAULT TO ONLINE
	TXNE	TF,UC.OFL		;UNLESS ITS OFFLINE
	MOVEI	S2,[ASCIZ/Offline/]	;THEN SAY SO
	SKIPN	T1,.UCBVL(P1)		;IS THERE A VOLUME ON THIS UCB ???
	MOVEI	S2,[ASCIZ/Free   /]	;NO,,MAKE STATUS 'FREE'
	TXNN	TF,UC.AVA		;IS IT AVAILABLE ???
	MOVEI	S2,[ASCIZ/Unavailable/]	;NO,,MAKE IT UNAVAILABLE
	JUMPE	T1,SDSK.B		;NO VOLUME MOUNTED,,SKIP THIS
	LOAD	TF,.VLFLG(T1),VL.STA	;GET THE STRUCTURE STATUS BITS
	CAXN	TF,%STAMN		;IS IT MOUNTED ???
	MOVEI	S2,[ASCIZ/Mounted/]	;YES,,SAY SO

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	CAXN	TF,%STADM		;IS IT DISMOUNT ???
	MOVEI	S2,[ASCIZ/Dismount/]	;YES,,SAY SO
	CAXN	TF,%STAWT		;IS IT WAITING ???
	MOVEI	S2,[ASCIZ/Waiting/]	;YES,,SAY SO
	LOAD	TF,.VLPTR(T1),VL.PRV	;GET THE PREVIOUS VOL ADDRESS
	SKIPE	TF			;NONE THERE,,SKIP
	MOVEI	S2,[ASCIZ/ /]		;SECONDARY VOL BLK,,STATUS IS UNDEFINED

SDSK.B:	$TEXT	(DEPBYT,<^T6/@.AMNAM(S1)/^T13/0(S2)/^T5/0(T2)/^A>)
	JUMPE	T1,CRLF			;NO VOLUME,,OUTPUT CRLF AND RETURN
	LOAD	S2,.VLFLG(T1),VL.LUN	;GET THE LOGICAL UNIT NUMBER
	$TEXT	(DEPBYT,<^W7/.VLNAM(T1)/^W10/.VLVID(T1)/^O/S2/>)
	$RETT				;RETURN
	SUBTTL	GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADDRESS

	;CALL:	LSTUSR/ -1 for the first disk UCB, positive for the next
	;	LISTYP/ .OMFLG word of the requesting message
	;
	;RET:	S1/ The UCB Address

GETDSK:	AOSE	LSTUSR			;IS THIS THE FIRST TIME THROUGH ???
	JRST	GETD.1			;NO,,GET NEXT UCB
	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JUMPT	GETD.2			;JUMP IF OK
	PUSHJ	P,S..NUE##		;ELSE STOPCODE

GETD.1:	MOVE	S1,UCBQUE##		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB
	JUMPF	.RETF			;NO MORE,,RETURN FALSE

GETD.2:	SKIPN	S1,DEVICE		;A SPECIFIC DEVICE ???
	JRST	GETD.4			;NOPE
	CAME	S1,.UCBNM(S2)		;PRIMARY PORT MATCH?
	CAMN	S1,.UCBAU(S2)		;ALTERNATE PORT MATCH?
	SKIPA	S1,S2			;PUT THE UCB ADDRESS IN S1
	JRST	GETD.1			;NO GOOD,,TRY NEXT UCB

GETD.3:	MOVE	S2,S1			;COPY UCB ADDRESS
	SKIPN	S2,.UCBVL(S2)		;VOLUME MOUNTED?
	JRST	GETD.5			;NO
	LOAD	S2,.VLPTR(S2),VL.PRV	;GET BACKCHAIN POINTER TO LAST VOLUME
	JUMPE	S2,GETD.5		;HAVE A PREVIOUS VOLUME BLOCK?
	MOVE	S1,.VLUCB(S2)		;YES - POINT TO PREVIOUS UCB
	JRST	GETD.3			;KEEP SEARCHING BACKWARDS

GETD.4:	MOVE	S1,S2			;PUT THE UCB ADDRESS IN S1
GETD.5:	LOAD	S2,.UCBST(S1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S2,%DISK		;IS IT DISK ???
	JRST	GETD.1			;NO GOOD,,TRY NEXT UCB


;Now, check this UCB against the OPR's optional request switch

;If the OPR said /ALL, just give the world back
	MOVE	S2,LISTYP		;GET THE LIST OPTION FLAGS
	TXNE	S2,ST.ALL		;WANT TO SEE EVERYTHING?
	$RETT				;YES, GIVE THIS ONE TO CALLER

;Check for /MOUNTED from OPR
	TXNE	S2,ST.MNT		;WANT JUST MOUNTED UNITS?
	JRST	[SKIPN	.UCBVL(S1)	;YES, UNIT HAVE A VOLUME ON IT?
		 JRST	GETD.1		;NO, SKIP IT
		 $RETT]			;YES, RETURN  THIS UCB!

;For /FREE, or no option, don't list unavailable drives
	LOAD	TF,.UCBST(S1),UC.AVA	;GET 'AVAILABLE TO MDA' BIT
	JUMPE	TF,GETD.1		;IF UNIT NOT AVAILABLE,,TRY NEXT UCB
	TXNE	S2,ST.AVA		;WANT TO SEE JUST FREE UNITS?
	SKIPN	.UCBVL(S1)		;YES, IS THERE A VOLUME HERE?
	$RETT				;NOT /FREE, OR THIS IS A FREE UNIT!
	JRST	GETD.1			;WANT /FREE, BUT THIS UNIT MOUNTED

> ;END TOPS10 CONDITIONAL
	SUBTTL	D$SSTR - SHOW STATUS OF FILE STRUCTURE

TOPS10<	INTERN	D$SSTR			;SHOW STATUS FILE STRUCTURE(S)

D$SSTR:
	$SAVE	<P1,P2,P3,P4>		;SAVE SOME REGS
	STKVAR	<<NUMMTD>,<TOTFRE>>	;NUMBER OF MOUNTED STRS, TOTAL FREE
	SETZM	NUMMTD			;NONE SO FAR
	SETZM	TOTFRE			;GOTTA ADD IT UP
	PUSHJ	P,GETPARM		;GET OPTIONAL STRUCTURE BLOCK
	SETOM	JOBNBR			;NONE LISTED SO FAR
	SETZM	LSTUSR			;START AT FIRST STRUCTURE
	PUSHJ	P,GETSTR		;GET THE FIRST PRIMARY VOLUME BLOCK
	JUMPT	SSTR.0			;GOT ONE, GO LIST IT
	$ACK	(<No structures exist>,,,ACKCOD)	;VERY STRANGE
	$RETT

SSTR.0:	SKIPE	S2,DEVICE		;WANT TO SEE A PARTICULAR STRUCTURE?
	CAMN	S2,.VLNAM(S1)		;YES, IS THIS THE RIGHT ONE?
	SKIPA				;YES, OR OPR WANTS EVERYTHING
	JRST	SSTR.5			;INCORRECT STR, TRY THE NEXT ONE
	MOVE	P1,S1			;SAVE ADDR OF THIS STR BLOCK
	MOVE	P4,S1			;SAVE FOR SUMMARY LINE, TOO
	AOSN	JOBNBR			;FIRST ONE SHOWN?
	PUSHJ	P,STRHDR		;YES, TYPE THE HEADER
	SKIPE	NOROOM			;OVERFLOWED A PAGE?
	PUSHJ	P,PAGOVF		;YES, DUMP IT OUT
	$TEXT	(DEPBYT,<^W4L/.VLNAM(P1)/ ^A>) ;TYPE THE STR NAME
	LOAD	S2,.VLFLG(P1),VL.STA	;GET THE STATUS CODE
	SETZ	S1,			;NO TEXT YET
	CAXN	S2,%STADM		;IS IT DISMOUNTING?
	MOVEI	S1,[ASCIZ/Dismounting/]	;YES, SAY SO
	CAXN	S2,%STAWT		;IS IT WAITING?
	MOVEI	S1,[ASCIZ/Waiting to be mounted/]	;YES, SAY SO
	JUMPN	S1,[$TEXT(DEPBYT,< --^T/0(S1)/-->)
		JRST	SSTR.4]		;JUST PRINT THAT ON THE LINE
	AOS	NUMMTD			;ONE MORE STR MOUNTED
	MOVE	S1,.VLNAM(P1)		;GET THE STR NAME BACK
	PUSHJ	P,I$MNTC##		;FIND OUT HOW MANY USERS, FREE BLKS
	ADDM	S2,TOTFRE		;ACCUMULATE FREE BLOCKS ON ALL
	MOVE	P2,G$NOW##		;GET THE CURRENT TIME
	SUB	P2,.VLMTM(P1)		;CALC MOUNT TIME
	MULX	P2,^D<24*60>		; Get number of minutes in a day
	ASHC	P2,^D17			; Shift binary point between P2,P3
	IDIVI	P2,^D60			; Split to hours and minutes
	$TEXT	(DEPBYT,<^D3R/P2/:^D2R0/P3/ ^D8R/S2/ ^D5R/S1/ ^A>)
	MOVE	S1,P1			;GET VOL BLOCK ADDRESS
	PUSHJ	P,D$NREQ##		;GET NUMBER OF REQUESTS NEEDING STR
	$TEXT	(DEPBYT,<^D4R/S1/ ^A>)	;DISPLAY NUMBER OF REQUESTS
	MOVEI	P2,1			;WE'VE GOT ONE UNIT
	MOVE	S1,P1			;COPY ADR OF VOL BLOCK
SSTR.1:	LOAD	S1,.VLPTR(S1),VL.NXT	;STEP TO NEXT
	SKIPE	S1			;IS THERE A NEXT?
	AOJA	P2,SSTR.1		;YES, KEEP LOOKING
	MOVEI	P3,1			;SET FOR FIRST PACK IN STR
SSTR.2:	$TEXT	(DEPBYT,<^W6L/.VLVID(P1)/ ^D1/P3//^D1/P2/ ^A>)	;TYPE THE VOLUME ID
	SKIPN	S1,.VLUCB(P1)		;IS THIS VOLUME MOUNTED?
	JRST	SSTR.3			;NO, SKIP THIS STUFF
	LOAD	S2,.UCBST(S1),UC.RSN	;GET THE DEVICE RESOURCE NUMBER
	IMULI	S2,AMALEN		;CALC THE ENTRY OFFSET
	ADD	S2,AMATRX##		;GET THE 'A' MATRIX ENTRY ADDRESS
	$TEXT	(DEPBYT,<^T4/@.AMNAM(S2)/ ^W6/.UCBNM(S1)/ ^A>) ;PRINT DRIVE
	SKIPN	.VLOID(P1)		;HAVE AN OWNER PPN?
	JRST	SSTR.3			;NO
	HLRE	TF,.VLOID(P1)		;GET PROJECT NUMBER
	MOVEI	S1,[ITEXT (<^O6R /.VLOID(P1),LHMASK/>)] ;OCTAL PROJECT #
	CAMN	TF,[-1]			;WILD?
	MOVEI	S1,[ITEXT (<     *>)]	;YES
	HRRE	TF,.VLOID(P1)		;GET PROGRAMMER NUMBER
	MOVEI	S2,[ITEXT (<^O6L /.VLOID(P1),RHMASK/>)] ;OCTAL PROGRAMMER #
	CAMN	TF,[-1]			;WILD?
	MOVEI	S2,[ITEXT(<*     >)]	;YES
	$TEXT	(DEPBYT,<^I/(S1)/,^I/(S2)/^A>) ;PRINT POSSIBLY WILD PPN
SSTR.3:	PUSHJ	P,CRLF			;FINISH THE LINE
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET ADDR OF NEXT VOLUME IN STR
	JUMPE	P1,SSTR.4		;IF NO MORE UNITS, TRY NEXT STR
	$ASCII(<                                >) ;INDENT INFO FOR NEXT VOL
	AOJA	P3,SSTR.2		;GO DO THE NEXT UNIT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Here to type the summary for this structure
SSTR.4:	MOVX	S2,ST.USR		;GET THE /USER FLAG BIT
	MOVE	S1,P4			;GET BACK THE STRUCTURE BLOCK
	TDNE	S2,.OFLAG(M)		;DID THE OPR WANT TO SEE THE USERS?
	PUSHJ	P,D$SUSR		;YES, ADD THOSE TO THE MESSAGE
	MOVE	S1,P4			;GET BACK THE STRUCTURE BLOCK
	PUSHJ	P,D$SSTS		;ADD WRITE LOCK STATUS, ETC.
	LOAD	S1,.VLFLG(P4),VL.LCK	;GET THE LOCK STATE CODE
	CAXN	S1,%UNLCK		;IS IT UNLOCKED?
	JRST	SSTR.5			;YES, NOTHING TO SAY
	SKIPE	NOROOM			;IS THERE ENOUGH SPACE?
	PUSHJ	P,PAGOVF		;NO, GET A PAGE
	CAXN	S1,%LOCKD		;IS IT LOCKED?
	$TEXT	(DEPBYT,<	(Locked against new accesses)>)
	CAXN	S1,%LOCKP		;IS A LOCK PENDING?
	$TEXT	(DEPBYT,<	(Unlocked, Lock pending for ^H/.VLLTM(P4)/)>)
	CAXN	S1,%ULCKP		;IS AN UNLOCK PENDING?
	$TEXT	(DEPBYT,<	(Locked, Unlock pending for ^H/.VLLTM(P4)/)>)

;Here to try the next structure
SSTR.5:	PUSHJ	P,GETSTR		;GET THE NEXT STR BLOCK
	JUMPT	SSTR.0			;GOT ONE, CHECK IT OUT
	SKIPN	DEVICE			;WANT TO SEE A CERTAIN STRUCTURE?
	JRST	SSTR.6			;NO, TYPE THE SUMMARY
	AOSE	JOBNBR			;YES, DID WE LIST IT?
	JRST	SSTR.7			;YES, JUST FINISH UP
	$ACK	(<File structure ^W/DEVICE/ does not exist>,,,ACKCOD)
	$RETT

SSTR.6:	AOSN	P1,JOBNBR		;GET TOTAL THAT WE LISTED
	JRST	[$ACK	(<No file structures>,,,ACKCOD)
		$RETT]			;AND RETURN
	SOSN	P1			;EXACTLY ONE?
	$ASCII	(<One file structure>)
	SKIPLE	P1			;MORE THAN ONE?
	$TEXT	(DEPBYT,<  Total of ^D/JOBNBR/ file structures^A>)
	SKIPLE	P1			;SUMMARY ONLY IF MORE THAN ONE STR
	$TEXT	(DEPBYT,<, ^D/NUMMTD/ mounted; ^D/TOTFRE/ free blocks>)
	PUSHJ	P,CRLF			;END THE LINE
SSTR.7:	PUSHJ	P,SENDIT		;FIRE THE MESSAGE BACK
	$RETT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;A routine to show the users of a file structure.
;Call -
;	S1/	SIXBIT primary Structure VOL block
;Returns -
;	Always, adding descriptive text to the message

D$SUSR:	$SAVE	<P1,P2,P3,P4>
	$SAVE	<T1>			;[1173]
	MOVE	P1,S1			;SAVE THE VOL BLK ADRS
	$ASCII	(< Users:>)		;FIRST THE GREETING
	LOAD	P2,.VLOWN(P1),VL.CNT	;GET THE NUMBER OF REQUESTORS
	JUMPE	P2,SUSR.4		;NONE, SAY SO
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;TO LEFT HALF
	HRRI	P2,.VLVSL(P1)		;AIM AT THE LIST OF VSL POINTERS
	SETZ	P1,			;CLEAR COUNT OF USERS
SUSR.1:	MOVX	TF,VL.ASN		;GET THE 'MOUNTED' BIT
	TDNN	TF,0(P2)		;DOES THIS REQUESTOR (VSL) OWN IT?
	JRST	SUSR.3			;NO, TRY THE NEXT VSL
	AOS	P1			;COUNT THIS OWNER
	SKIPE	NOROOM			;IS THERE SOME SPACE?
	PUSHJ	P,PAGOVF		;NO, MAKE SOME MORE
	MOVE	T1,0(P2)		;[1173] AIM AT THE VSL
	SKIPN	S1,.VSMDR(T1)		;[1173] BACK UP TO THE MDR
	PUSHJ	P,S..IMV##		;OOPS!!

;handle pseudo mount requests (no job number but a req id)

	MOVE	P4,S1			;SAVE THE MDR ADDRESS
	SETZM	G$MSG			;Blank trailer
	MOVEI	P3,[ASCIZ/Job/]		;Get default headers
	LOAD	S2,.MRJOB(P4),MR.JOB	;Get the job number
	TXZN	S2,BA%JOB		;PSEUDO PROCESS ???
	JRST	SUSR.2			;NO,,SKIP THIS
	$TEXT	(<-1,,G$MSG>,< (^15/.VSRFL(T1),MR.QUE/^0)>) ;[1173] Get type for trailer
	MOVEI	P3,[ASCIZ/Req/]		;Get header

SUSR.2:	$TEXT	(DEPBYT,<	^T/(P3)/ ^D6/S2/ User ^W6/.MRNAM(P4)/^W6/.MRNAM+1(P4)/ ^U/.MRUSR(P4)/ ^T/G$MSG/>)
SUSR.3:	AOBJN	P2,SUSR.1		;CHECK ALL THE REQUESTORS
	JUMPN	P1,.RETT		;IF WE SAW SOME,, ALL DONE
SUSR.4:	$ASCII	(<	(None)
>)
	$RETT
;A routine to show the status of a file structure.
;Call -
;	S1/	SIXBIT primary Structure VOL block
;Returns -
;	Always, adding descriptive text to the message

D$SSTS:	$SAVE	<P1>
	$SAVE	<T1>
	MOVE	P1,S1			;SAVE THE VOL BLK ADRS
	DSKCHR	P1,			;ASK FOR DISK CHARACTERISTICS
	$RETF				;OOPS
	SKIPE	NOROOM			;IS THERE ENOUGH SPACE?
	PUSHJ	P,PAGOVF		;NO, GET A PAGE
	TXNE	P1,DC.HWP		;HARDWARE WRITE PROTECT?
	$TEXT	(DEPBYT,<	(Hardware write protected)>)
	TXNE	P1,DC.SWP		;SOFTWARE WRITE PROTECT?
	$TEXT	(DEPBYT,<	(Software write protected)>)
	TXNE	P1,DC.SAF		;SINGLE ACCESS?
	$TEXT	(DEPBYT,<	(Single access)>)
	TXNE	P1,DC.PRV		;PRIVATE?
	$TEXT	(DEPBYT,<	(Private structure)>)
	$RETT
>;END TOPS10
	SUBTTL	GETSTR - Get a primary file structure block

TOPS10<
;A routine to get the next primary file structure block
; Uses LSTUSR as a flag - 0 means get first file structure block
;Call -
;	With LSTUSR setup
;Returns -
;	S1/	addr of str block if TRUE
;	FALSE if no more str blocks

GETSTR:
	SKIPE	LSTUSR			;FIRST STRUCTURE BLOCK DESIRED?
	JRST	GTST.1			;NO, TRY THE NEXT
	SETOM	LSTUSR			;YES, NOTE WE'VE BEEN HERE
	MOVE	S1,VOLQUE		;GET THE HANDLE ON THE VOLUME LIST
	$CALL	L%FIRST			;TRY THE FIRST OF THOSE
	JRST	GTST.2			;ENTER THE SELECTION LOOP
GTST.1:	MOVE	S1,VOLQUE		;GET THE HANDLE ON THE VOLUME LIST
	$CALL	L%NEXT			;GET THE NEXT ITEM IN THE LIST
GTST.2:	JUMPF	.POPJ			;NO MORE IN THE LIST
	SKIPN	S1,.VLVSL(S2)		;IS THERE A VSL FOR THIS VOL?
	JRST	GTST.3			;NO, TRY FOR A UCB
	LOAD	S1,.VSFLG(S1),VS.TYP	;GET VSL TYPE
	CAXE	S1,%DISK		;IS IT A DISK OF ANY NAME?
	JRST	GTST.1			;NO, TRY THE NEXT VOLUME BLOCK
	JRST	GTST.4			;GOT A DISK VOLUME, SEE IF ITS PRIMARY

;Here if there is no VSL requesting this VOL
GTST.3:	SKIPN	S1,.VLUCB(S2)		;IS THERE A UCB (UNREQUESTED STR)
	STOPCD	(NUV,HALT,,<No UCB ptr and No VSL ptr from VOL>)
	LOAD	S1,.UCBST(S1),UC.DVT	;GET TYPE CODE FROM UCB
	CAXE	S1,%DISK		;IS IT A DISK OF ANY NAME?
	JRST	GTST.1			;NO, TRY THE NEXT VOLUME BLOCK
GTST.4:	SKIPN	.VLNAM(S2)		;IS THIS A PRIMARY DISK BLOCK?
	JRST	GTST.1			;NO, TRY THE NEXT
	MOVE	S1,S2			;YES, THIS IS THE NEXT STR BLOCK!
	$RETT
>;END TOPS10
	SUBTTL	STRHDR - Type a header line for SHOW STATUS STRUCTURES

TOPS10<

;This routine just dumps the header line into the message for the first
; output on a show structures message

STRHDR:	MOVEI	S1,[ASCIZ/ Disk File Structures /]
	PUSHJ	P,SETPAG		;SETUP THE OUTPUT PAGE
	PUSHJ	P,CRLF			;NEW LINE
	$ASCII	(<Name  Time    Free   Mount #Req   Volume   Type Drive    Owner PPN  >)
	PUSHJ	P,CRLF			;NEW LINE
	$ASCII	(<---- ------ -------- ----- ---- ---------- ---- ------ ------------->)
	PUSHJ	P,CRLF			;NEW LINE
	$RETT
>;END TOPS10
	SUBTTL	TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HEADER

TOPS10	<
TAPHDR:	MOVEI	S1,[ASCIZ/ Tape Drive Status /]
	PUSHJ	P,SETPAG		;SETUP THE OUTPUT PAGE
	PUSHJ	P,CRLF			;START A NEW LINE
	$ASCII	(<Drive  Trk  Status     AVR  Density     >) ;START THE HEADING
	SKIPE	REMOTE			;ANY VOLUMES MOUNTED ???
	$ASCII	(<  Write  Volume>)	;YES,,ADD TO THE HEADER
	PUSHJ	P,CRLF			;END THE LINE
	$ASCII	(<------ --- ----------- --- ------------->) ;START THE UNDERLINE
	SKIPE	REMOTE			;ANY VOLUMES MOUNTED ???
	$ASCII	(< ------- ------>)	;YES,,ADD TO THE UNDERLINE
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN
	SUBTTL	DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER

DSKHDR:	MOVEI	S1,[ASCIZ/ Disk Drive Status /] ;GET STATUS HEADER
	PUSHJ	P,SETPAG		;SETUP THE OUTPUT PAGE
	PUSHJ	P,CRLF			;ADD A CRLF
	$ASCII	(<Drive   >)		;BUILD THE HEADER
	SKIPE	ACTIVE			;ANY DUAL PORTED DRIVES ???
	$ASCII	(<Aux Port  >)		;YES,,SAY SO
	$ASCII	(<Type    Status     AVR>) ;FINISH UP
	SKIPE	REMOTE			;ANY VOLUMES MOUNTED ???
	$ASCII	(<   STR   Volume  Unit#>) ;YES,,SAY SO
	PUSHJ	P,CRLF			;END THE HEADER LINE
	$ASCII	(<------  >)		;UNDERLINE 'DRIVE'
	SKIPE	ACTIVE			;ANY DUAL PORTED DRIVES ???
	$ASCII	(<--------  >)		;YES,,UNDERLINE 'AUX PORT'
	$ASCII	(<----  -----------  --->)	;UNDERLINE 'TYPE - AVR'
	SKIPE	REMOTE			;ANY VOLUMES MOUNTED ???
	$ASCII	(<  -----  ------  ----->) ;YES,,UNDERLINE IT
	PUSHJ	P,CRLF			;END THE UNDERLINE
	$RETT				;AND RETURN
>
	SUBTTL	D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES

	;AC Usage:	AP --) MDR Entry
	;		P1 --) VSL Entry
	;		P2 --) VOL Entry
	;		P3 --) UCB Entry
	;		P4 --) VSL AOBJN AC

D$SMNT:	SETZM	LSTSMT			;ZAP ACCUMULATED TOTALS
	MOVE	S1,NODE6B		;GET THE NODE WE WANT
	PUSHJ	P,N$LOCL$$		;SEE IF ITS LOCAL 
	CAME	S1,[-1]			;IF ITS ALL NODES,,HE WINS
	JUMPF	.RETT			;NOT LOCAL,,SKIP THIS
	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	$SAVE	<T1>			;SAVE T1
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST VOL IN THE QUEUE
	JRST	SMNT.2			;JUMP THE FIRST TIME THROUGH

SMNT.1:	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VOLUME IN THE QUEUE
SMNT.2:	JUMPF	SMNT.7			;NO MORE,,GO FINISH UP...
	MOVE	P2,S2			;SAVE THE VOL ENTRY ADDRESS
	LOAD	P4,.VLOWN(P2),VL.CNT	;GET THE VOLUME REQUEST COUNT..
	JUMPE	P4,SMNT.1		;NO REQUESTORS,,SKIP IT..
	MOVNS	P4			;NEGATE THE REQUEST COUNT
	MOVSS	P4			;MOVE RIGHT TO LEFT
	HRRI	P4,.VLVSL(P2)		;CREATE VSL AOBJN AC
	MOVE	P3,.VLUCB(P2)		;GET THE UCB ADDRESS

SMNT.3:	MOVE	P1,0(P4)		;GET A VSL ADDRESS
	MOVE	S1,.VSFLG(P1)		;GET THE VSL FLAG BITS
	TXNE	S1,VS.ALC+VS.ABO	;JUST ALLOCATED OR ABORTED ???
	JRST	SMNT.6			;YES,,SKIP THIS
	MOVE	AP,.VSMDR(P1)		;GET THE MDR ADDRESS
	SKIPN	S1,.MRQEA(AP)		;CHECK AND LOAD THE .QE ADDRESS
	JRST	SMNT.4			;NO QE ADDRESS FOR THIS MDR
	PUSHJ	P,S$INPS##		;HAVE A QE,,CHECK SCHEDULABILITY
	JUMPF	SMNT.6			;NOT RUNNABLE,,SKIP IT
	MOVE	S1,.MRQEA(AP)		;GET QE ADDRESS AGAIN
	MOVX	S2,QE.HBO		;GET 'HELD BY OPERATOR' BIT
	TDNE	S2,.QESEQ(S1)		;IS IT?
	JRST	SMNT.6			;HELD JOBS CAN'T MOUNT THINGS

SMNT.4:	MOVE	S1,.MRUSR(AP)		;GET THE USER ID
	XOR	S1,LSTUSR		;MASK WITH QUEUE LIST REQUEST
	SKIPE	LSTUSR			;WAS USER ID SPECIFIED?
	 TDNN	S1,LSTUSM		;DOES IT MATCH?
	  CAIA				;OK
	   JRST	SMNT.6			;NO--GET NEXT VSL

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

TOPS10<	TXNE	P1,VL.ASN		;DOES HE OWN THE VOLUME ???
	JRST	SMNT.6			;YES,,SKIP IT...
>
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO HIS CUR VOL
	ADDI	S1,.VSVOL(P1)		;POINT TO HIS CURRENT VOL ADDR
	MOVE	S1,0(S1)		;PICK UP THE CURRENT VOL ADDRESS
	CAME	S1,P2			;IS THIS THE ONE HE WANTS ???
	JRST	SMNT.6			;NO,,GET NEXT
	MOVE	S2,.VLNAM(S1)		;ELSE GET VOLUME NAME
	XOR	S2,LSTJOB		;COMBINE WITH LIST REQUESTS
	 SKIPE	LSTJOB			;SEE IF LIST REQUEST VOLUME NAME
	  TDNN	S2,LSTJBM		;MASK OUT
	   CAIA				;MATCHES
	    JRST  SMNT.6		;LOSER

	LOAD	S1,.VSFLG(P1),VS.TYP	;GET THE VOLUME SET TYPE
	CAXE	S1,%DISK		;IS THIS A STRUCTURE REQUEST ???
	JRST	SMN.3B			;NO,,PUT OUT ALL TAPE REQUESTS
	LOAD	S1,.VLFLG(P2),VL.STA	;GET THE VOLUME STATUS
	CAXN	S1,%STAMN		;IS THE STRUCTURE MOUNTED ???
	JRST	SMNT.6			;YES,,SKIP THIS REQUEST

SMN.3B:	AOSG	JOBNBR			;BUMP REQUEST COUNT BY 1
	PUSHJ	P,MNTHDR		;FIRST TIME,,PUT OUT A HEADER
	SKIPE	LSTSUM			;SUMMARY?
	JRST	SMNT.6			;YES--BE QUIET
	SKIPE	NOROOM			;ANY ROOM LEFT ???
	PUSHJ	P,PAGOVF		;NO,SEND CURRENT PAGE AND START NEW ONE

	PUSHJ	P,SMTVOL		;DISPLAY VOLUME NAME
	PUSHJ	P,SMTSTS		;DISPLAY STATUS
	PUSHJ	P,SMTTYP		;DISPLAY MOUNT TYPE
	PUSHJ	P,SMTWLE		;DISPLAY WRITE LOCKED/ENABLED STATUS
	PUSHJ	P,SMTDMO		;DISPLAY DEMOGRAPHIC STUFF
	PUSHJ	P,SMNATT		;PRINT MOUNT REQUEST ATTRIBUTES

SMNT.6:	AOBJN	P4,SMNT.3		;CONTINUE THROUGH ALL USERS
	JRST	SMNT.1			;CONTINUE THROUGH ALL VOLUMES

SMNT.7:	AOSG	S1,JOBNBR		;CORRECT THE COUNT
	JRST	SMNT.9			;NO REQUESTS,,RETURN NOW
	SETOM	QEMPTY			;INDICATE THE QUEUES ARE NOT EMPTY
	SKIPN	LISTYP			;IS THIS A FAST LISTING ???
	JRST	SMNT.9			;YES,,SKIP THIS
	SKIPE	LSTSUM			;SUMMARY?
	JRST	SMNT.8			;YES

	CAIN	S1,1			;IS THERE 1 REQUEST ???
	$ASCII	(<There is 1 request in the queue>) ;YES,,SAY SO
	CAILE	S1,1			;IS THERE MORE THEN 1 ???
	$TEXT	(DEPBYT,<There are ^D/S1/ requests in the queue^A>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	JRST	SMNT.9			;ONWARD
SMNT.8:	MOVEI	S1,[ASCIZ /Mount/]	;GET QUEUE NAME
	MOVEI	S2,[ASCIZ /request/]	;GET SUMMARY QUANTITY NAME
	PUSHJ	P,LIST.S		;DO SUMMARY LINE
	PUSHJ	P,CRLF			;END LINE
SMNT.9:	SETOM	JOBNBR			;RESET THE JOB/REQUEST COUNTER
	SETZM	ACTIVE			;AND THE ACTIVE COUNTER
	$RETT				;AND RETURN
; MOUNT display volume output
;
SMTVOL:	LOAD	S1,.VSFLG(P1),VS.TYP	;GET THE REQUEST TYPE
	CAXE	S1,%TAPE		;IS IT A MAGTAPE ?
	CAXN	S1,%DTAP		;OR A DECTAPE ?
	JRST	SMTV.1			;YES - HANDLE DIFFERENTLY
	$TEXT	(DEPBYT,<^W9/.VLNAM(P2)/^A>) ;ALL OTHERS
	POPJ	P,			;RETURN

SMTV.1:	LOAD	T1,.VLFLG(P2),VL.SCR	;GET THE SCRATCH VOLUME BIT
	SKIPE	T1			;IS THIS A SCRATCH TAPE
	$ASCII	(<Scratch  >)		;YES,,MAKE IT SCRATCH
	SKIPN	T1			;CHECK FOR SCRATCH ONCE AGAIN
	$TEXT	(DEPBYT,<^W9/.VLNAM(P2)/^A>)	;NOT SCRATCH,,DUMP VOL NAME
	POPJ	P,			;RETURN


; MOUNT display status output
;
SMTSTS:	LOAD	T1,.VSFLG(P1),VS.TYP	;GET THE REQUEST TYPE
	CAXN	T1,%DSMT		;DISMOUNT STRUCTURE ???
	JRST	[$ASCII (<Dismount  >)	;YES,,SAY SO
		 $RET   ]		;AND RETURN
	LOAD	T1,.VLFLG(P2),VL.STA	;[1164] GET THE VOLUME STATUS
	TXNN	P1,VL.ASN		;DOES THE USER HAVE IT MOUNTED ???
	JRST	SMTS.1			;NO,,MAKE IT WAITING
	CAXN	T1,%STAAB		;IS IT 'ABORTED' ???
	$ASCII	(<Aborted   >)		;YES,,SAY SO
	CAXE	T1,%STADM		;IS IT 'DISMOUNT' ???
	CAXN	T1,%STAMN		;OR IS IT MOUNTED ???
	$TEXT	(DEPBYT,<^W10/.UCBNM(P3)/^A>) ;YES,,INSERT THE DEVICE NAME
	POPJ	P,			;[1164] RETURN

SMTS.1:	CAXN	T1,%STAIN		;IS IT 'INITIALIZING'???
	$ASCII	(<Initial   >)		;YES,,SAY SO
	CAXE	T1,%STAIN		;NO,,ANYTHING ELSE IS 'WAITING'
	$ASCII	(<Waiting   >)		;..
	POPJ	P,			;RETURN

; MOUNT display type output
;
SMTTYP:	LOAD	T1,.VSFLG(P1),VS.TYP	;GET THE VOLUME-SET TYPE
	CAXN	T1,%DTAP		;IS IT 'DECTAPE' ??
	$ASCII	(<DECtape   >)		;YES
	CAXN	T1,%TAPE		;IS IT 'TAPE' ???
	$ASCII	(<Magtape   >)		;YES
	CAXE	T1,%DSMT		;IS IT A STRUCTURE DISMOUNT ???
	CAXN	T1,%DISK		;OR IS IT 'DISK' ???
	$ASCII	(<Disk      >)		;YES
	CAXE	T1,%UNKN		;OR 'UNKNOWN' DEVICE ?
	$RETT				;NO
	MOVX	T1,VS.FDV		;BIT TO TEST
	TDNE	T1,.VSFLG(P1)		;FOREIGN (UNIT RECORD) DEVICE?
	$ASCII	(<          >)		;YES,JUST PUT OUT BLANKS
	TDNN	T1,.VSFLG(P1)		;CHECK AGAIN
	$ASCII	(<Unknown   >)		;YES
	$RETT				;RETURN


; MOUNT display write locked/enabled status output
;
SMTWLE:	LOAD	T1,.VSFLG(P1),VS.TYP	;GET THE VOLUME-SET TYPE
	CAXE	T1,%TAPE		;IS IT 'TAPE' ???
	CAXN	T1,%DTAP		;OR A DECTAPE ?
	JRST	SMTW.1			;YES TO EITHER
	JRST	SMTW.2			;OTHERWISE, SKIP THIS FIELD

SMTW.1:	LOAD	T1,.VSFLG(P1)		;GET THE FLAG BITS FOR THE VOLUME SET
	TXC	T1,VS.WLK		;WANT IR WRITE ENABLED
	TXNE	T1,VS.WLK+VS.NEW+VS.SCR	;IS ENABLED OR NEW OR SCRATCH
	$ASCII	(<Enabled  >)		;THEN SAY SO
	TXNN	T1,VS.WLK+VS.NEW+VS.SCR	;CHECK AGAIN
	$ASCII	(<Locked   >)		;NONE SET,,THEN WRITE LOCKED
	POPJ	P,			;RETURN

SMTW.2:	$ASCII	(<         >)		;DISPLAY NOTHING
	POPJ	P,			;RETURN


; MOUNT display demographic output
;
SMTDMO:	LOAD	S1,.MRJOB(AP),MR.JOB	;GET THE 'JOB NUMBER'
	TXZN	S1,BA%JOB		;IS THIS A PSEUDO PROCESS ???
	JRST	SMTD.1			;NO,,SKIP THIS
	$TEXT	(<-1,,G$MSG>,<^I/MNTUSR/^0>) ;GEN THE DEMOGRAPHIC DATA
	$TEXT	(DEPBYT,<^D6R /.VSRID(P1)/  ^D4R /S1/  ^T20/G$MSG/ ^15/.VSRFL(P1),MR.QUE/>) ;[1173]
	POPJ	P,			;RETURN

SMTD.1:	$TEXT	(DEPBYT,<^D6R /.VSRID(P1)/  ^D4R /.MRJOB(AP),MD.PJB/  ^I/MNTUSR/>)
	POPJ	P,			;RETURN



; MOUNT display request attribute output
;
SMNATT:	SKIPN	LISTYP			;WAS IT /FAST ?
	$RETT				;YES - RETURN NOW
	LOAD	T1,.VSFLG(P1),VS.TYP	;GET VOLUME SET TYPE

TOPS10<	CAXN	T1,%DISK		;STRUCTURE ???
	JRST	SMNA.1			;YES,,SKIP THIS
	CAXE	T1,%DTAP		;DECTAPE?
	CAXN	T1,%TAPE		;MAGTAPE?
	JRST	[$TEXT (DEPBYT,<   Volume-set: ^T/.VSVSN(P1)/>) ;INSERT TEXT
		 JRST  SMNA.1  ]	;AND SKIP THIS
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,I$CGEN##		;GET TRANSLATION INDEX
	JUMPF	SMNA.1			;NO TYPEOUT IF UNABLE TO TRANSLATE
	$TEXT	(DEPBYT,<   Device-type: ^T/@DEVNTB(S1)/>) ;YES
> ;End TOPS10 conditional

SMNA.1:	SKIPE	.VSREM(P1)		;Was there a remark ?
	$TEXT	(DEPBYT,<   Remark: ^T/.VSREM(P1)/>) ;Yes,,tell user

TOPS10<	CAXE	T1,%TAPE		;Check again for a tape request
	$RETT				;Not one - return
	LOAD	T1,.VSFLG(P1),VS.LBT	;Get the label type
	LOAD	T2,.VSATR(P1),VS.TRK	;Get the track status
	LOAD	T3,.VSATR(P1),VS.DEN	;Pick up density index
	$TEXT	(DEPBYT,<   Label-Type: ^T/@LABELS(T1)/, Tracks:^W/TRK(T2)/, Density: ^T/@DENSTY(T3)/ BPI>)
	MOVE	T1,.VSFLG(P1)		;GET VSL FLAGS
	TXNE	T1,VS.NEW!VS.INI	;[1164] REINITIALIZING?
	JRST	SMNA.2			;[1164] YES,,JUMP OVER SCRATCH STUFF
	TXNE	T1,VS.SCR		;[1164] NO,,IS THE SCRATCH BIT ON?
	TXNN	T1,VS.REL		;AND THE USER SPECIFY A REELID?
	$RETT				;NO MORE TO DO
	LOAD	S1,.VSFLG(P1),VS.LBT	;GET LABEL TYPE
	PUSHJ	P,D$GLBT##		;SEE IF IT IS LABELED
	CAIN	S1,%LABEL		;[1164] YES
	$TEXT	(DEPBYT,<   Initialize new/scratch tape: - Volume-id: ^W/.VLNAM(P2)/ - Protection: ^O3/.VSATR(P1),VS.PRT/>) ;[1164]
	$RETT				;[1164] GO AWAY

SMNA.2:	LOAD	S1,.VSCVL(P1),VS.CNT	;[1164] GET NUMBER OF VOLS
	CAIE	S1,1			;[1164] ONLY 1 VOL?
	SKIPA	T1,[BYTE (7) "s",0,0,0,0] ;[1164] NO
	SETZM	T1			;[1164] YES
	$TEXT	(DEPBYT,<   Reinitializing ^D/S1/ volume^T/T1/>) ;[1164]
> ;End TOPS10 Conditional
	$RETT				;Return
MNTHDR:	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,GO DO IT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$ASCII	(<Mount Queue:>) ;OUTPUT A HEADER
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	SKIPN	LISTYP			;IS THIS A FAST LISTING ???
	$RETT				;YES,,RETURN
	$ASCII	(<Volume    Status     Type     Write    Req#   Job#          User>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$ASCII	(<-------  --------  --------  -------  ------  ----  ------------------->)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$RETT				;AND RETURN
	SUBTTL	SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.

SHOWQS:	$SAVE	<H,P1>			;SAVE H AND P1
	STORE	H,HDRSAV		;HERE ALSO.
	SETO	P1,			;FLAG FIRST PASS THROUGH QUEUES
	SETZM	LSTSMT			;ZERO ACCUMULATED TOTALS
	MOVSI	S1,'*  '		;GEN A SIXBIT '*' IN LOW BITS
	MOVEM	S1,JOBACT		;STORE IT IN JOBACT
	MOVEI	H,HDRUSE##		;LOOP THROUGH ACTIVE QUEUE FIRST.
	LOAD	AP,.QHLNK(H),QH.PTF	;GET THE FIRST ENTRY.
SHOW.1:	JUMPE	AP,SHOW.3		;DONE,,DO EXTERNAL QUEUE.
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE OBJECT TYPE.
	PUSHJ	P,A$OB2Q##		;CONVERT IT TO A QUEUE HEADER.
	CAME	S1,HDRSAV		;ARE THEY THE SAME ???
	JRST	SHOW.2			;NO,,TRY THE NEXT ONE.
	LOAD	T2,.QESEQ(AP),QE.RDE	;GET THE RDE BITS.
	JUMPN	T2,SHOW.2		;NOT REALLY THERE,,TRY NEXT ONE.
	PUSHJ	P,PUTOUT		;GO PUT OUT THE LISTING.
	JUMPF	SHOW.2			;NOT THIS ONE,,GET NEXT.
	AOS	ACTIVE			;BUMP THE ACTIVE COUNT BY 1.
	SKIPN	LSTSUM			;SKIP IF SUMMARY
	SKIPN	LISTYP			;IF THIS IS A QUICK LIST,,SKIP THIS.
	JRST	SHOW.2			;DO NOT DUMP STATUS DATA.
	$ASCII	(<   >)			;INSERT SOME BLANKS.
	MOVEI	S1,OBJST1(P3)		;DEFAULT TO THE JOB STATUS DATA.
	MOVE	S2,OBJSTS(P3)		;GET THE DEVICE STATUS
	CAIN	S2,%STOPD		;IS IT 'STOPPED' ???
	MOVEI	S1,[ASCIZ/--Stopped By Operator--/] ;YES,,SAY SO
	CAIN	S2,%NPTYS		;ARE WE WAITING FOR PTYS ???
	MOVEI	S1,[ASCIZ/--Waiting For PTYs--/] ;YES,,SAY SO
	CAIN	S2,%OFLNE		;ARE WE OFFLINE ???
	MOVEI	S1,[ASCIZ/--Waiting For Operator Intervention--/] ;YES,,SAY SO
	CAIN	S2,%OREWT		;ARE WE WAITING FOR OPR RESPONSE
	MOVEI	S1,[ASCIZ/--Waiting For Operator Response--/] ;YES,,SAY SO
	CAIN	S2,%ALIGN		;ARE WE ALIGNING FORMS ???
	MOVEI	S1,[ASCIZ/--Aligning Forms--/]  ;YES,,SAY SO
	PUSHJ	P,ASCOUT		;DUMP THE STATUS OUT.
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
SHOW.2:	LOAD	AP,.QELNK(AP),QE.PTN	;GET THE ADDRESS OF THE NEXT ENTRY.
	JRST	SHOW.1			;AND GO PROCESS IT.

SHOW.3:	LOAD	H,HDRSAV		;GET THE HEADER ADDRESS.
	LOAD	AP,.QHLNK(H),QH.PTF	;GET THE FIRST ENTRY ADDRESS.
	SETZM	JOBACT			;INDICATE EXTERNAL QUEUE PROCESSING.
SHOW.4:	JUMPE	AP,SHW.5A		;NO MORE,,FINISH UP.
	MOVE	S1,G$NOW##		;GET NOW
	CAML	S1,.QECRE(AP)		;IS THIS AN AFTER ENTRY?
	JRST	[JUMPE	P1,SHOW.5	;NO, IS IT THE SECOND PASS?
		 JRST	.+2]		;NO, LIST THIS ONE
	JUMPN	P1,SHOW.5		;IGNORE AFTER ENTRIES IN FIRST PASS
	PUSHJ	P,PUTOUT		;PUT OUT THE LISTING.
SHOW.5:	LOAD	AP,.QELNK(AP),QE.PTN	;GET THE NEXT ENTRY.
	JRST	SHOW.4			;AND GO PROCESS IT.

SHW.5A:	AOJN	P1,SHOW.6		;JUMP IF REALLY DONE
	JRST	SHOW.3			;JUST FINISHED FIRST PASS, GO DO SECOND

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

SHOW.6:	AOSG	T1,JOBNBR		;GET & CORRECT THE JOB COUNT
	JRST	SHOW.7			;NONE THERE,,RETURN
	SETOM	QEMPTY			;INDICATE THAT THE Q'S ARE NOT EMPTY.
	SKIPN	LISTYP			;IS THIS A 'FAST' LISTING ???
	JRST	SHOW.7			;YES,,SKIP THIS
	MOVE	H,HDRSAV		;GET SAVED QUEUE HEADER
	SKIPE	LSTSUM			;SUMMARY?
	JRST	SHOW.S			;YES
	CAIN	T1,1			;JUST 1 JOB PROCESSED ???
	$TEXT	(DEPBYT,<There is 1 ^T/@.QHSQN(H)/ in the queue^A>)
	CAIE	T1,1			;MORE THEN 1 JOB ???
	$TEXT	(DEPBYT,<There are ^D/T1/ ^T/@.QHSQN(H)/s in the queue^A>)
	JRST	SHOW.A			;SKIP SUMMARY STUFF
SHOW.S:	MOVE	S2,.QHSQN(H)		;GET SUMMARY QUANTITY NAME
	MOVE	S1,.QHLQN(H)		;GET LISTING QUEUE NAME
	PUSHJ	P,LIST.S		;LIST SUMMARY LINE
SHOW.A:	SKIPG	ACTIVE			;ANY OF THEM ACTIVE ???
	$ASCII	(< (none in progress)>)	;NO,,SAY SO.
	SKIPE	ACTIVE			;ANY OF THEM ACTIVE ???
	$TEXT	(DEPBYT,< (^D/ACTIVE/ in progress)^A>) ;YES,,SAY SO.
	PUSHJ	P,LIST.X		;FINISH OFF LINE
	PUSHJ	P,CRLF			;INSERT A CRLF.
SHOW.7:	SETOM	JOBNBR			;RESET JOB COUNT
	SETZM	ACTIVE			;RESET ACTIVE COUNT.
	CAIE	H,HDRINP##		;WAS THIS THE BATCH QUEUE ???
	$RETT				;NO,,RETURN.

	;Here to output the batch pre-processor queue

	SKIPN	LSTJOB			;USER SPECIFY A JOB ?
	SKIPE	LSTUSR			;OR A USER ?
	  $RETT				;YES TO EITHER
	SKIPE	LISTYP			;A 'FAST' LISTING ???
	SKIPL	LSTUNT			;OR A UNIT ?
	  $RETT				;YES
	SKIPE	LSTUTY			;A UNIT TYPE?
	$RETT				;YES
	MOVEI	S1,HDRBIN##		;GET THE SPRINT QUEUE ADDRESS
	LOAD	S2,.QHLNK(S1),QH.PTF	;GET THE FIRST ENTRY ADDRESS.
	JUMPE	S2,SHOW.8		;NOTHING THERE,,SKIP THIS
	AOS	JOBNBR			;BUMP THE QUEUE COUNT
	LOAD	S2,.QELNK(S2),QE.PTN	;GET THE ADDRESS OF THE NEXT ENTRY.
	JUMPN	S2,.-2			;ANOTHER,,COUNT'EM UP !!!
SHOW.8:	MOVX	S1,.OTBIN		;GET OBJECT TYPE
	MOVEM	S1,TIME.+OBJ.TY		;SAVE IT
	SETZM	TIME.+OBJ.UN		;UNIT 0
	MOVE	S1,G$LNAM##		;GET LOCAL NODE NAME
	MOVEM	S1,TIME.+OBJ.ND		;SAVE IT
	MOVEI	S1,TIME.		;GET OBJ BLK ADDRESS
	PUSHJ	P,A$FOBJ##		;LOCATE THE REAL THING
	JUMPF	SHOW.9			;NOT THERE,,STRANGE !!!
	MOVE	AP,S1			;SAVE THE OBJECT ADDRESS
	LOAD	S1,OBJSCH(AP),OBSBUS	;GET OBJ ACTIVE STATUS
	SKIPGE	JOBNBR			;ANY JOBS PENDING ???
	JUMPE	S1,.RETT		;NO,,AND OBJECT NOT ACTIVE - RETURN !!!
	PUSH	P,[[ASCIZ/none active/]
		    [ASCIZ/1 active/]](S1) ;SAVE STATUS TEXT ADDRESS
	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET LIST HEADER ADDRESS
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,THEN SET ONE UP !!!
	SETOM	QEMPTY			;SET FLAG 'QUEUE NOT EMPTY'
	MOVEI	S2,[ASCIZ/ jobs pending, /] ;DEFAULT TO MULTIPLE JOBS
	AOS	S1,JOBNBR		;UPDATE JOB COUNT
	CAIN	S1,1			;ONLY 1 JOB ???
	MOVEI	S2,[ASCIZ/ job pending, /] ;YES,,MAKE IT 1 JOB
	POP	P,S1			;GET THE STATUS TEXT ADDRESS BACK
	$TEXT(DEPBYT,<^M^JReader interpreter queue: ^D/JOBNBR/^T/0(S2)/^T/0(S1)/>)
	LOAD	S1,OBJSCH(AP),OBSBUS	;GET OBJ ACTIVE STATUS
	SKIPE	S1			;WAS IT ACTIVE ???
	$TEXT	(DEPBYT,<*  ^T/OBJST1(AP)/>) ;YES,,INSERT STATUS
SHOW.9:	SETOM	JOBNBR			;RESET JOB COUNT
	$RETT				;AND RETURN
	SUBTTL	PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING.

PUTOUT:	LOAD	P3,.QEOBJ(AP)		;GET THE OBJECT ADDR (FOR ACTIVE JOBS)
	MOVE	S2,.QEOID(AP)		;GET THE QUEUE ENTRY USER ID
	XOR	S2,LSTUSR		;COMBINE WITH LIST REQUESTS
	SKIPE	LSTUSR			;SEE IF LIST REQUEST USER ID
	 TDNN	S2,LSTUSM		;MASK OUT
	  CAIA				;MATCHES
	   $RETF			;LOSER
	MOVE	S2,.QEJOB(AP)		;GET THE QUEUE ENTRY JOB NAME
	XOR	S2,LSTJOB		;COMBINE WITH LIST REQUESTS
	SKIPE	LSTJOB			;SEE IF LIST REQUEST JOB NAME
	 TDNN	S2,LSTJBM		;MASK OUT
	  CAIA				;MATCHES
	   $RETF			;LOSER
	SKIPGE	S2,LSTUNT		;GET /UNIT
	 JRST	POUT1			;NOT SPECIFIED
	SKIPE	JOBACT			;SEE IF ACTIVE
	 JRST	[MOVE	S1,OBJUNI(P3)	;YES--GET UNIT FROM OBJ BLOCK
		 JRST	POUT2]		;AND USE THAT
	LOAD	S1,.QEROB+.ROBAT(AP),RO.ATR;GET ATTRIBUTES
	CAIE	S1,%PHYCL		;PHYSICAL?
	 $RETF				;NO--DOESNT MATCH
	LOAD	S1,.QEROB+.ROBAT(AP),RO.UNI;GET REQUESTS UNIT
POUT2:	CAIE	S1,(S2)			;MATCH USERS?
	 $RETF				;NO--DOESNT MATCH
POUT1:	SKIPN	S2,LSTUTY		;UNIT TYPE REQUESTED?
	JRST	POUT3			;NO
	SKIPE	JOBACT			;SEE IF ACTIVE
	MOVE	S1,OBJPRM+.OOUNT(P3)	;GET FROM OBJECT BLOCK
	MOVE	S1,.QEROB+.ROBUT(AP)	;GET FROM QE
	CAME	S1,S2			;REQUESTED UNIT TYPE MATCH LIST SPEC?
	$RETF				;NO
POUT3:	SKIPE	NOROOM			;IS THERE ROOM IN THE OUTPT PAGE ?
	PUSHJ	P,PAGOVF		;NO,,CLEAN UP A BIG MESS.
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE OBJECT (QUEUE) TYPE.
	MOVEM	S1,OBTYPE		;SAVE IT FOR LATER USE.
	MOVE	S1,HDRSAV		;GET SAVED QUEUE HEADER ADDRESS
	PUSHJ	P,@.QHDEP(S1)		;DUMP IT OUT
	POPJ	P,			;RETURN TRUE OR FALSE
	SUBTTL	SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATUS COMMAND.

SHSTAT:	LOAD	S1,OBJSTS(T1)		;GET THIS OBJECTS STATUS CODE
	$TEXT	(DEPBYT,<^T15L /@OBJSTC(S1)/  ^A>) ;OUTPUT THE STATUS
	LOAD	S1,OBJSCH(T1)		;GET THIS OBJECTS SCHEDLNG BITS
	TXNN	S1,OBSBUS		;IS IT BUSY ???
	PJRST	CRLF			;GO FINISH UP
	MOVE	TF,OBJTYP(T1)		;GET OBJECT TYPE
	CAIN	TF,.OTFAL		;IS IT FAL?
	JRST	FALSTS			;YES, FAL'S A HYBRID
	CAIN	TF,.OTNQC		;NETWORK QUEUE CONTROLLER?
	JRST	NQCSTS			;YES
	LOAD	S1,OBJITN(T1)		;GET THE CONTROLLING JOB
	PUSHJ	P,Q$SUSE##		;FIND THE JOB IN THE USE QUEUE
	JUMPF	CRLF			;SHOULD NOT HAPPEN !!
	MOVE	AP,S1			;GET THE QUEUE ENTRY ADDRESS
	$TEXT	(DEPBYT,<^W6L /.QEJOB(AP)/   ^D6/.QERID(AP)/  ^I/USR/>)
	SKIPN	LISTYP			;IF THIS IS A FAST LISTING,,THEN
	$RETT				;SKIP THE JOB STATUS DISPLAY
	$ASCII	(<	>)		;INSERT A <TAB>
	MOVEI	S1,OBJST1(T1)		;GET THE JOBS STATUS DESCRIPTION ADDR
	PUSHJ	P,ASCOUT		;PUT IT OUT
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN

;DISPLAY FAL-STREAM STATUS

FALSTS:	MOVE	S1,OBJPRM+.OBCON(T1)	;GET STREAM CONNECT TIME
	IDIV	S1,G$TIC##		;GET NUMBER OF SECONDS
	IDIVI	S1,^D60			;GET CONNECT SECONDS
	MOVEM	S2,TIME.+2		;SAVE IT
	IDIVI	S1,^D60			;GET CONNECT HOURS IN S1, MINUTES IN S2
	DMOVEM	S1,TIME.+0		;SAVE THEM
	$TEXT	(DEPBYT,<^W6L /OBJPRM+.OBNDN(T1)/    ^I/TIM/    ^D7R /OBJPRM+.OBBYT(T1)/>)
	$ASCII	(<	>)		;INSERT A <TAB>
	MOVEI	S1,OBJST1(T1)		;GET THE JOBS STATUS DESCRIPTION ADDR
	PUSHJ	P,ASCOUT		;PUT IT OUT
	PJRST	CRLF			;END LINE AND RETURN

DEFINE	X (TXT,SYM,OBJ) <
	[ASCIZ\TXT\]
>
ATRBTB:	ATTRIB				;GENERATE ATTRIBUTE TEXT TABLE
NQCSTS:	SKIPN	OBJPRM+.ONNOD(T1)	;NQC TELL US ANYTHING YET?
	PJRST	CRLF			;NO, THEN NOT MUCH ELSE WE CAN ADD
	MOVE	S1,OBJPRM+.ONCON(T1)	;GET STREAM CONNECT TIME (IN SECONDS)
	IDIVI	S1,^D60			;GET CONNECT SECONDS
	MOVEM	S2,TIME.+2		;SAVE IT
	IDIVI	S1,^D60			;GET CONNECT HOURS IN S1, MINUTES IN S2
	DMOVEM	S1,TIME.+0		;SAVE THEM
	MOVE	S1,OBJPRM+.ONLNK(T1)	;GET LINK TYPE (NETWORK TYPE)
	MOVE	S1,[[ASCIZ\ANF-10\]
		    [ASCIZ\DECnet\]]-1(S1) ;GET TEXT ASSOCIATED WITH IT
	$TEXT	(DEPBYT,<^W6L /OBJPRM+.ONNOD(T1)/  ^T/0(S1)/    ^I/TIM/    ^D7R/OBJPRM+.ONBYT(T1)/>)
	$ASCII	(<	>)		;INSERT A <TAB>
	MOVEI	S1,OBJST1(T1)		;GET THE JOBS STATUS DESCRIPTION ADDR
	PUSHJ	P,ASCOUT		;PUT IT OUT
	PJRST	CRLF			;END LINE AND RETURN
	SUBTTL	SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.

SHPARM:	MOVE	S1,OBTYPE		;GET THE OBJECT TYPE
	CAIE	S1,.OTBAT		;IS IT BATCH ???
	JRST	SHPA.1			;NO,,GO TRY SOMETHING ELSE
	LOAD	S1,OBJPRM+.OBTIM(T1),OBPMIN  ;GET MIN TIME LIMIT
	LOAD	S2,OBJPRM+.OBTIM(T1),OBPMAX  ;GET MAX TIME LIMIT
	LOAD	T2,OBJPRM+.OBPRI(T1),OBPMIN  ;GET MIN PRIORITY
	LOAD	T3,OBJPRM+.OBPRI(T1),OBPMAX  ;GET MAX PRIORITY
	$TEXT	(DEPBYT,<^D6R /S1/:^D6L /S2/  ^D2R /T2/:^D2L /T3/  ^A>)
IFN INPCOR,<
	LOAD	S1,OBJPRM+.OBCOR(T1),OBPMIN  ;GET MIN CORE LIMIT
	LOAD	S2,OBJPRM+.OBCOR(T1),OBPMAX  ;GET MAX CORE LIMIT
	$TEXT	(DEPBYT,<^D5R /S1/:^D5L /S2/  ^A>)
>
	LOAD	S1,OBJPRM+.OBFLG(T1),.OPRIN  ;GET OPR INTRVN FLAG
	CAIN	S1,.OPINY		;IS IT ALLOW OPR INTRVN ???
	$ASCII	(<      Yes>)		;YES,,SAY SO
	CAIN	S1,.OPINN		;IS IT NO OPR INTRVN ???
	$ASCII	(<       No>)		;YES,,SAY SO
	CAIN	S1,.OPINS		;DEPEND ON SCHED?
	$ASCII	(<   System>)		;YES,,SAY SO
	SKIPN	ATRIB			;NEED TO LIST ATTRIBUTES ?
	JRST	SHPA.0			;NO - ALL DONE
	LOAD	S1,OBJDAT(T1),RO.ATR	;GET ATTRIBUTES
	CAIN	S1,%SITGO		;SITGO PROCESSOR?
	$ASCII	(<  SITGO>)

SHPA.0:	SKIPE	OBJRID(T1)		;NEXTED REQUEST?
	$TEXT	(DEPBYT,<^M^J	Next request #^D/OBJRID(T1)/^A>) ;INCLUDE BLURB
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN

SHPA.1:	CAIN	S1,.OTFAL		;FAL?
	JRST	SHPA.2			;YES, GO HANDLE FAL
	CAIN	S1,.OTNQC		;NETWORK QUEUE CONTROLLER?
	JRST	SHPA.3			;YES
	LOAD	S1,OBJPRM+.OOLIM(T1),OBPMIN  ;GET MIN OUTPUT LIMIT
	LOAD	S2,OBJPRM+.OOLIM(T1),OBPMAX  ;GET MAX OUTPUT LIMIT
	LOAD	T2,OBJPRM+.OOFRM(T1)	     ;GET THE FORMS TYPE
	LOAD	T3,OBJPRM+.OOPRI(T1),OBPMIN  ;GET MIN PRIORITY
	LOAD	T4,OBJPRM+.OOPRI(T1),OBPMAX  ;GET MAX PRIORITY
	$TEXT	(DEPBYT,<^D5R /S1/:^D6L /S2/  ^W6L /T2/  ^D2R /T3/:^D2L /T4/  ^A>)
	LOAD	S1,OBJPRM+.OOFLG(T1),.OFLEA  ;GET LIMIT EXCEEDED ACTION
	CAIN	S1,.STIGN		     ;IS IT 'IGNORE' ???
	$ASCII	(<Proceed  >)		     ;YES,,SAY SO
	CAIN	S1,.STCAN		     ;IS IT 'CANCEL' ???
	$ASCII	(<Abort    >)		     ;YES,,SAY SO
	CAIN	S1,.STASK		     ;IS IT ASK ???
	$ASCII	(<Ask      >)		     ;YES,,SAY SO
	LOAD	S1,OBJDAT(T1),RO.ATR	     ;GET THE DEVICE ATTRIBUTES
	CAIN	S1,%LOWER		     ;IS IT LOWER CASE??
	$ASCII	(<Lower  >)		     ;YES,,SAY SO
	CAIN	S1,%UPPER		     ;IS IT UPPER CASE ??
	$ASCII	(<Upper  >)		     ;YES,,SAY SO
	SKIPE	S1,OBJPRM+.OOUNT(T1)	     ;HAVE A UNIT TYPE?
	$TEXT	(DEPBYT,<^W/S1/  ^A>)	     ;DISPLAY IT
	LOAD	S1,OBJSCH(T1),OBSSPL	     ;GET THE SPOOLING TO TAPE BITS
	SKIPE	S1			     ;ARE WE SPOOLING TO TAPE ???
	$TEXT	(DEPBYT,<^W/OBJPRM+.OOTAP(T1)/:^A>) ;YES,,SAY SO
	SKIPE	OBJRID(T1)		;NEXTED REQUEST?
	$TEXT	(DEPBYT,<^M^J	Next request #^D/OBJRID(T1)/^A>) ;INCLUDE BLURB
	PJRST	SHPSIM			;GO DISPLAY DETAILED PARAMETERS

;Display FAL-STREAM parameters

SHPA.2:	MOVE	S1,OBJPRM+.OBNTY(T1)	;GET NETWORK-TYPE ATTRIBUTE
	MOVE	S1,[[ASCIZ\ANF-10\]
		    [ASCIZ\DECnet\]]-1(S1) ;GET TEXT ASSOCITATED WITH IT
	PUSHJ	P,ASCOUT		;DUMP IT
	PJRST	CRLF			;FINISH UP


;Display NETWORK-QUEUE-CONTROLLER parameters
SHPA.3:	LOAD	S1,OBJDAT(T1),RO.ATR	;GET ATTRIBUTES
	MOVE	S1,ATRBTB(S1)		;AND ASSOCIATED TEXT
	PUSHJ	P,ASCOUT		;DUMP IT
	PJRST	CRLF			;FINISH UP
;SHOW SIMULATION
SHPSIM:	LOAD	S1,OBJPRM+.OOFLG(T1),OF.LP2 ;LP20 SIMULATION
	JUMPE	S1,SHPMTA		;GO CHECK MAGTAPE PARAMETERS
	SETZM	BYTCNT			;FORCE CRLF ON FIRST OUTPUT
SHPLP2:	LOAD	S1,OBJPRM+.OOFLG(T1),OF.LP2 ;LP20 SIMULATION
	JUMPE	S1,SHPMTA		;NEED TO DISPLAY?
	MOVEI	S1,^D12			;FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOFLG(T1),OF.LP2 ;DATA
	$TEXT	(DEPBYT,<LP20 simulation:^T/@YNTAB(S1)/  ^A>)


;SHOW MAGTAPE PARAMETERS
SHPMTA:	MOVE	S1,OBJPRM+.OOMTA(T1)	;MAGTAPE PARAMETERS?
	IOR	S1,OBJPRM+.OOVSN(T1)	; OR VOLUMET-SET NAME?
	JUMPE	S1,CRLF			;RETURN IF NONE
	SETZM	BYTCNT			;FORCE CRLF ON FIRST OUTPUT

;DENSITY
SHPMDN:	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MDN ;GET DENSITY
	JUMPE	S1,SHPMDI		;NEED TO DISPLAY?
	MOVEI	S1,^D12			;FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MDN ;GET DENSITY
	$TEXT	(DEPBYT,<Density:^T/@DENSTY(S1)/  ^A>)

;DIRECTORY-FILE
SHPMDI:	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MDI ;GET DIRECTORY-FILE
	JUMPE	S1,SHPMLT		;NEED TO DISPLAY?
	MOVEI	S1,^D12			;FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MDI ;GET DIRECTORY-FILE
	$TEXT	(DEPBYT,<Directory:^T/@YNTAB(S1)/  ^A>)

;LABEL-TYPE
SHPMLT:	MOVX	S1,OB.MLV		;BIT TO TEST
	TDNN	S1,OBJPRM+.OOMTA(T1)	;LABEL FIELD VALID?
	JRST	SHPMRL			;NO
	MOVEI	S1,^D16			;FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MLT ;GET LABEL TYPE
	$TEXT	(DEPBYT,<Labels:^T/@LABELS(S1)/  ^A>)

;MULTI-REEL
SHPMRL:	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MRL ;GET MULTI-REEL
	JUMPE	S1,SHPMPR		;NEED TO DISPLAY?
	MOVEI	S1,^D14			;FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MRL ;GET MULTI-REEL
	$TEXT	(DEPBYT,<Multi-reel:^T/@YNTAB(S1)/  ^A>)

;PARITY
SHPMPR:	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MPR ;GET PARITY
	JUMPE	S1,SHPMTK		;NEED TO DISPLAY?
	MOVEI	S1,^D11			;FIELD WIDTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MPR ;GET PARITY
	$TEXT	(DEPBYT,<Parity:^T/@PARTAB(S1)/  ^A>)

;TRACKS
SHPMTK:	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MTK ;GET TRACKS
	JUMPE	S1,SHPMVS		;NEED TO DISPLAY?
	MOVEI	S1,^D8			;FIELD WIDTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,OBJPRM+.OOMTA(T1),OB.MTK ;GET TRACKS
	$TEXT	(DEPBYT,<Tracks:^T/@TRKTAB(S1)/  ^A>)

;VOLUME-SET NAME
SHPMVS:	SKIPN	OBJPRM+.OOVSN(T1)	;HAVE A VSN?
	PJRST	CRLF			;DONE
	MOVEI	S1,^D11			;INITIAL FIELD WIDTH
	MOVEI	S2,OBJPRM+.OOVSN(T1)	;POINT TO VSN
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER
	ILDB	TF,S2			;GET A CHARACTER
	SKIPE	TF			;END?
	AOJA	S1,.-2			;COUNT CHARACTER AND LOOP
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<Volume-set:^T/OBJPRM+.OOVSN(T1)/^A>)
	PJRST	CRLF			;END LINE


YNTAB:	[ASCIZ	/Default/]
	[ASCIZ	/No/]
	[ASCIZ	/Yes/]

TRKTAB:	[ASCIZ	/Default/]
	[ASCIZ	/7/]
	[ASCIZ	/9/]

PARTAB:	[ASCIZ	/Default/]
	[ASCIZ	/Odd/]
	[ASCIZ	/Even/]
	SUBTTL DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.

DEPOUT::
	SKIPN   KLUDGE                  ;[1206]CHECK FOR KLUDGE
	SKIPA	S1,[-1]			;MAKE IT WILD
	MOVE	S1,LSTPND		;GET /PROC
	CAME	S1,[-1]			;WAS IT SPECIFIED?
	$RETF				;NO PROCESSING NODE FOR OUTPUT QUEUES
	SKIPE	JOBACT			;ACTIVE?
	SKIPA	S1,OBJNOD(P3)		;YES - GET NODE FROM OBJECT BLOCK
	MOVE	S1,.QEROB+.ROBND(AP)	;GET /DESTINATION NODE NAME OR NUMBER
	MOVE	S2,LSTDND		;GET REQUESTED DESTINATION NODE
	PUSHJ	P,LSTNOD		;COMPARE THEM
	  JUMPF	.POPJ			;RETURN FALSE IF NO MATCH
	AOSG	JOBNBR			;IS THERE A HEADER ???
	PUSHJ	P,OUTHDR		;NO,,PUT ONE OUT.
	GETLIM	S1,.QELIM(AP),OLIM	;GET THE OUTPUT PAGE LIMIT.
	ADDM	S1,LSTSMT		;ACCUMULATE TOTAL
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	STORE	S1,LIMIT		;SAVE IT FOR OUTPUT.
	PUSH	P,BYTCNT		;SAVE THE CURRENT BYTE COUNT
	$TEXT	(DEPBYT,<^W2L /JOBACT/^I/JS/^D7R /LIMIT/  ^I/USR/^A>)
	POP	P,S1			;RESTORE OLD BYTE COUNT TO S1.
	MOVX	S2,%OTLEN		;GET THE OUTPUT LINE LENGTH
	PUSHJ	P,DMPSTS		;INSERT THE JOB STATUS INFO.
	$RETT				;RETURN.

OUTHDR:	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,GO DO IT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	$TEXT	(DEPBYT,<^1/OBTYPE/ Queue:>)	;PUT OUT THE HEADING
	SKIPN	LISTYP			;IS THIS A 'FAST' LISTING ??
	$RETT				;YES,,RETURN NOW.
	$ASCII	(<Job Name   Req#    Limit             User>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$ASCII	(<--------  ------  -------  ------------------------>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	$RETT				;RETURN.

	SUBTTL DEPBAT - ROUTINE TO PROCESS BATCH QUEUE ENTRYS.

DEPBAT::GETLIM	S1,.QELIM(AP),ONOD	;GET /DESTINATION NODE NAME OR NUMBER
	MOVE	S2,LSTDND		;GET REQUESTED DESTINATION NODE
	PUSHJ	P,LSTNOD		;COMPARE THEM
	SKIPE   KLUDGE                  ;[1206]CHECK FOR KLUDGE
	  JUMPF	.POPJ			;RETURN IF FALSE OR NO MATCH
	SKIPE	JOBACT			;ACTIVE?
	SKIPA	S1,OBJNOD(P3)		;YES - GET NODE FROM OBJECT BLOCK
	MOVE	S1,.QEROB+.ROBND(AP)	;GET /PROCESSING NODE NAME OR NUMBER
	MOVE	S2,LSTPND		;GET REQUESTED PROCESSING NODE
	PUSHJ	P,LSTNOD		;COMPARE THEM
	  JUMPF	.POPJ			;RETURN FALSE IF NO MATCH
	AOSG	JOBNBR			;IS THE HEADER THERE ???
	PUSHJ	P,BATHDR		;NO,,PUT ONE OUT.
	GETLIM	S1,.QELIM(AP),TIME	;GET THE TIME LIMIT IN SECONDS.
	ADDM	S1,LSTSMT		;ACCUMULATE TOTAL
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	IDIVI	S1,^D60			;GET # OF SECONDS.
	MOVEM	S2,TIME.+2		;   AND SAVE IT.
	IDIVI	S1,^D60			;GET HOURS,MINUTES.
	MOVEM	S1,TIME.		;SAVE HOURS.
	MOVEM	S2,TIME.+1		;SAVE MINUTES.
	PUSH	P,BYTCNT		;SAVE THE CURRENT BYTE COUNT

IFE INPCOR,<$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^I/TIM/  ^I/USR/^A>)>

IFN INPCOR,<
	PUSH	P,T1			;SAVE T1
	GETLIM	T1,.QELIM(AP),CORE	;GET CORE LIMIT
	$TEXT (DEPBYT,<^W2L /JOBACT/^I/JS/^I/TIM/  ^D5R /T1/  ^I/USR/^A>)
	POP	P,T1			;RESTORE T1
>
	POP	P,S1			;RESTORE OLD BYTE COUNT TO S1
	MOVX	S2,%INLEN		;GET THE BATCH LINE LENGTH
	PUSHJ	P,DMPSTS		;INSERT THE JOB STATUS INFO.
	$RETT				;RETURN.

BATHDR:	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,GO DO IT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	PUSHJ	P,CRLF			;PUT OUT A CRLF.
	$ASCII	(<Batch Queue:>)	;PUT OUT A HEADER LINE.
	PUSHJ	P,CRLF			;PUT OUT A CRLF.
	SKIPN	LISTYP			;IS THIS A 'FAST' LISTING ??
	$RETT				;YES,,RETURN NOW.

IFE INPCOR,<$ASCII (<Job Name   Req#   Run Time            User>)>
IFN INPCOR,<$ASCII (<Job Name   Req#   Run Time   Core            User>)>
	PUSHJ	P,CRLF			;PUT OUT A CRLF.

IFE INPCOR,<$ASCII (<--------  ------  --------  ------------------------>)>
IFN INPCOR,<$ASCII (<--------  ------  --------  -----  ------------------------>)>
	PUSHJ	P,CRLF			;PUT OUT A CRLF.
	$RETT				;AND RETURN.
	SUBTTL DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS.

TOPS10	<
DEPRET::$RETT				;JUSR RETURN ON THE 10
>
TOPS20	<
DEPRET::AOSG	JOBNBR			;IS THE HEADER OUT YET???
	PUSHJ	P,RETHDR		;NO, PUT ONE OUT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	GETLIM	S1,.QELIM(AP),TID1	;Get tape 1 ID
	GETLIM	S2,.QELIM(AP),TID2	;Get tape 2 ID
	MOVE	T2,S1			;Copy tape ID 1
	IOR	T2,S2			; Assume both or neither is SIXBIT
	TLNE	T2,777777		; Sixbit?
	$TEXT	(DEPBYT,<^I/JS/^W6R /S1/  ^W6R /S2/  ^I/USR/>)
	TLNN	T2,777777
	$TEXT	(DEPBYT,<^I/JS/^D6R /S1/  ^D6R /S2/  ^I/USR/>)
	SKIPG	LISTYP			;IS THIS A /ALL LIST ???
	$RETT				;NO,,JUST RETURN
	$ASCII	(<   File: >)		;INSERT A HEADING
	MOVEI	S1,.QECON(AP)		;GET THE FILE NAME ADDRESS
	PUSHJ	P,ASCOUT		;PUT IT OUT
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN

RETHDR:	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,GO DO IT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	PUSHJ	P,CRLF
	$ASCII	(<Retrieval Queue:>)
	PUSHJ	P,CRLF
	SKIPN	LISTYP			;IS THIS A 'FAST' LISTING ???
	$RETT				;YES,,RETURN NOW
	$ASCII	(< Name    Req#   Tape 1  Tape 2          User>)
	PUSHJ	P,CRLF
	$ASCII	(<------  ------  ------  ------  --------------------->)
	PUSHJ	P,CRLF
	$RETT
>;END TOPS20
	SUBTTL DEPEVT - ROUTINE TO PROCESS EVENT QUEUE ENTRYS.

DEPEVT::MOVE	S1,LSTDND		;GET NODE
	PUSHJ	P,N$LOCL$$		;MUST BE LOCAL
	CAME	S1,[-1]			; OR ALL NODES
	JUMPF	.RETT			;  ELSE DON'T LIST
	GETLIM	S1,.QELIM(AP),INVS	;GET INVISIBLE BIT
	SKIPN	DEBUGW			;ARE WE DEBUGGING?
	JUMPN	S1,.RETT		;NO--AN INVISIBLE ENTRY?
	AOSG	JOBNBR			;IS THE HEADER OUT YET?
	PUSHJ	P,EVTHDR		;NO, PUT ONE OUT
	GETLIM	S1,.QELIM(AP),ACTV	;GET ACTIVE BIT
	CAIN	S1,1			;ACTIVE?
	AOSA	ACTIVE			;COUNT UP ACTIVE EVENTS
	TDZA	S1,S1			;DON'T FLAG
	MOVSI	S1,'*  '		;MAKE DISPLAY PRETTY
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	$TEXT	(DEPBYT,<^W2L /S1/^I/JS/^H/.QECRE(AP)/^A>)
	GETLIM	S2,.QELIM(AP),TYPE	;GET EVENT TYPE
	GETLIM	S1,.QELIM(AP),TEXT	;GET ADDRESS OF TEXT BLOCK
	SKIPN	S1			;ANY ASSOCIATED TEXT?
	SKIPE	S1,EVTDSC##(S2)		;NO, GET DEFAULT DISPLAY TEXT, IF ANY
	$TEXT	(DEPBYT,<  ^T33L/(S1)/^A>) ;DISPLAY IT
	PUSHJ	P,CRLF			;END LINE
	SKIPG	LISTYP			;CHECK FOR /LIST:ALL
	$RETT				;RETURN IF NOT
	GETLIM	S1,.QELIM(AP),REPT	;GET REPEAT BITS
	TXNN	S1,QB.DLY!QB.WKY	;DAILY OR WEEKLY OCCURANCE?
	JRST	EVTD.1			;NO
	PUSH	P,S1			;SAVE BITS
	$ASCII	(<	  Request will be requeued >)
	POP	P,TF			;GET BITS BACK
	TXNE	TF,QB.DLY		;DAILY?
	MOVEI	S1,EVTDLY		;YES
	TXNE	TF,QB.WKY		;WEEKLY?
	MOVEI	S1,EVTWKY		;YES
	LOAD	S2,TF,QB.DAY		;GET DAY OF WEEK
	MOVE	S2,EVTDAY(S2)		;POINT TO TEXT
	$TEXT	(DEPBYT,<^I/(S1)/ at ^C/.QECRE(AP)/^A>)
	PUSHJ	P,CRLF			;END LINE

EVTD.1:	GETLIM	S1,.QELIM(AP),FILE	;GET THE FD ADDRESS
	JUMPE	S1,.RETT		;RETURN IF NO ASSOCIATED FILE
	PUSHJ	P,A$WHEEL##		;GOT PRIVS?
	GETLIM	S1,.QELIM(AP),FILE	;GET FD AGAIN
	SKIPF				;CAN'T SEE FILESPEC IF NO PRIVS
	$TEXT	(DEPBYT,<	  /File:^F/(S1)/>) ;YES--TYPE IT
	$RETT				;AND RETURN
EVTHDR:	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GET THE HEADER LINE
	SKIPN	BYTPTR			;DO WE HAVE A PAGE ALREADY SETUP
	PUSHJ	P,SETPAG		;NO,,GO DO IT
	SKIPE	LSTSUM			;SUMMARY?
	$RETT				;YES--DONE HERE
	PUSHJ	P,CRLF			;START WITH A NEW LINE
	$ASCII	(<Event Queue:>)	;DISPLAY QUEUE NAME
	PUSHJ	P,CRLF			;ANOTHER CRLF
	SKIPN	LISTYP			;IS THIS A 'FAST' LISTING ???
	$RETT				;YES,,RETURN NOW
	$ASCII	(<  Type     Req#       Expiration                 Description           >)
	PUSHJ	P,CRLF
	$ASCII	(<--------  ------  ------------------  --------------------------------->)
	PUSHJ	P,CRLF
	$RETT


EVTDLY:	ITEXT	(<daily>)

EVTWKY:	ITEXT	(<every ^T/(S2)/>)

EVTDAY:	[ASCIZ	|Wednesday|]
	[ASCIZ	|Thursday|]
	[ASCIZ	|Friday|]
	[ASCIZ	|Saturday|]
	[ASCIZ	|Sunday|]
	[ASCIZ	|Monday|]
	[ASCIZ	|Tuesday|]
	SUBTTL	D$SALC - SHOW ALLOCATION

TOPS20<
D$LALC::
	PJRST	E$ILM##			;ILLEGAL TO DO ON THE -20
>;END TOPS20
TOPS10<

D$SALC::SETZM	G$ACK##			;DON'T ACK THE OPR
	SKIPA	S1,[-1]			;INDICATE OPERATOR REQUEST
D$LALC::SETZ	S1,			;INDICATE USER LIST REQUEST
	MOVEM	S1,ENTYPE		;SAVE THE ENTRY FLAG
	MOVE	S1,.MSCOD(M)		;GET THE ACK CODE, IF ANY
	MOVEM	S1,ACKCOD		;SAVE IN GLOBAL
	SETZM	NOROOM			;CLEAR THE PAGE OVERFLOW FLAG
	SETOM	JOBNBR			;INDICATE NONE LISTED SO FAR

	PUSHJ	P,A$GBLK##		;GET THE NEXT BLOCK IN THE MESSAGE
	JUMPF	E$ILM##			;NO MORE, QUIT
	MOVE	S1,[XWD -LDSPLN,LALDSP]	;AIM AT THE TABLE
LALC.1:	HRRZ	S2,0(S1)		;GET THE NEXT KNOWN BLOCK TYPE
	CAME	S2,T1			;MATCH?
	AOBJN	S1,LALC.1		;NO, TRY AGAIN
	JUMPGE	S1,E$ILM##		;NO MATCH,, BAD MESSAGE
	HLRZ	S1,0(S1)		;GET THE SERVICE ADRS
	PUSHJ	P,0(S1)			;DO IT
	AOSE	JOBNBR			;ANY LISTED AT ALL?
	PJRST	SENDIT			;YES, FINISH UP

LALC.2:	SKIPE	ENTYPE			;NO, WAS THIS A USER REQUEST?
	JRST	LALC.3			;NO, MUST BE OPERATOR
	PUSHJ	P,ALCHDR		;SETUP THE PAGE HEADER
	$ASCII	(<[No outstanding allocation]>)
	PUSHJ	P,CRLF			;FINISH THE LINE
	PJRST	SENDIT			;FIRE IT OFF

LALC.3:	$ACK	(<No outstanding allocations>,,,ACKCOD)	;TELL THE SAD NEWS
	$RETT				;AND QUIT

LALDSP:	XWD	LALJNU,.ORJNU		;LIST A CERTAIN JOB
	XWD	LALREQ,.ORREQ		;LIST A BATCH REQUEST
	LDSPLN==.-LALDSP		;TABLE LENGTH

	;CONTINUED ON NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Here to list a certain job's request
LALJNU:	SETZ	S2,			;SAY WE WANT ALL JOBS
	MOVE	S1,0(T3)		;GET THE DATA
	AOJE	S1,LALALL		;IF -1, LIST EVERYTHING
	CAXLE	S1,MAXRES+1		;IS THE JOB NUMBER VALID ???
	$RETF				;NO,,RETURN NOW
	SOJA	S1,L1ALOC		;JUST LIST THAT ONE

;Here to list a batch request's allocation
LALREQ:	MOVX	S2,BA%JOB		;SAY WE CAME FROM BATCH
	MOVE	S1,0(T3)		;GET THE REQUEST NUMBER
	AOJE	S1,LALALL		;IF -1, LIST EVERYTHING
	SOS	S1			;NOT -1, GET NUMBER AGAIN
	TXO	S1,BA%JOB		;LIGHT THE BATCH REQUEST BIT
	PJRST	L1ALOC			;PUT INFO ABOUT THIS ONE OUT

;Here to list all the requests
LALALL:	$SAVE	<P1,P2>			;THE LIST POINTER
	MOVE	P2,S2			;SAVE THE ENTRY FLAG
	MOVE	S1,BMATRX##		;GET THE LIST HANDLE
	$CALL	L%FIRST			;START AT THE TOP
LALA.1:	JUMPF	.RETT			;QUIT IF LIST EMPTY
	SKIPE	P2			;WANT TO LIST ALL BATCH?
	TDNE	P2,.SMJOB(S2)		;YES, IS THIS BATCH?
	SKIPA				;WANT ALL, OR THIS IS BATCH
	JRST	LALA.2			;BATCH, BUT THIS IS NOT BATCH ENTRY
	MOVE	P1,S2			;SAVE THE ADRS OF THIS BLOCK
	MOVE	S1,.SMJOB(S2)		;GET THE JOB NUMBER
	PUSHJ	P,L1ALOC		;DISPLAY THIS ONE
	MOVE	S1,BMATRX##		;GET THE LIST HANDLE
	MOVE	S2,P1			;GET THE OLD ADRS
	$CALL	L%APOS			;GET BACK TO THAT ONE
	JUMPF	.RETT			;CAN'T, QUIT
LALA.2:	$CALL	L%NEXT			;TO THE NEXT ONE, PLEASE
	JRST	LALA.1			;DO 'EM ALL

	;CONTINUED ON NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;A routine to dump one job's allocation into the message
L1ALOC:	$SAVE	<P1,P2,P3,P4>
	MOVE	P1,S1			;SAVE THE JOB NUMBER
	PUSHJ	P,D$FMDR##		;FIND THIS GUY'S MDR
	JUMPF	.RETT			;NO MDR, DON'T LIST ANYTHING
	MOVEI	P2,[ASCIZ/job/]		;ASSUME LISTING OF JOB
	TXNE	P1,BA%JOB		;IS THIS A BATCH REQUEST?
	MOVEI	P2,[ASCIZ/batch request/] ;YES, SAY SO
	PUSHJ	P,D$BMTX##		;FIND THIS JOB'S B MATRIX
	JUMPF	L1AL.5			;CAN'T, SO GIVE UP
	PUSHJ	P,D$CMTX##		;FIND THIS JOB'S C MATRIX
	SKIPT				;IS THERE ONE?
	SETZ	CM,			;NO, CLEAR THE POINTER
	AOSN	JOBNBR			;FIRST TIME THRU?
	PUSHJ	P,ALCHDR		;YES, START THE PAGE
	PUSHJ	P,CRLF			;NEW LINE
	$ASCII	<Allocation for >
	PUSHJ	P,LALCDM		;ADD THE DEMOGRAPHIC INFO
	PUSHJ	P,CRLF			;FINISH THE LINE
	LOAD	P3,.SMFLG(BM),SM.CNT	;FIND OUT HOW MANY ENTRIES ARE HERE
	MOVNS	P3			;NEGATE IT
	MOVSS	P3			;TO LH
	HRRI	P3,.SMRES+1(BM)		;AIM AT THE LIST OF RESOURCE NUMBERS
	MOVEI	P4,1			;START WITH RESOURCE 1
	$ASCII	(<     Volume set           Resource          Type      All  Own>)
	PUSHJ	P,CRLF			;FINISH THIS LINE
	$ASCII	(<--------------------  ----------------  ------------  ---  --->)
	PUSHJ	P,CRLF			;FINISH THIS LINE
L1AL.3:	SKIPN	0(P3)			;ANY OF THIS TYPE ALLOCATED?
	JRST	L1AL.4			;NO, TRY THE NEXT
	SKIPE	NOROOM			;ANY ROOM LEFT ON PAGE?
	PUSHJ	P,PAGOVF		;NO, GET A NEW ONE
	MOVE	S1,P4			;GET THE RESOURCE NUMBER
	PUSHJ	P,GETVSN		;TRY TO FIND IT
	MOVE	T3,S1			;GET STRING ADDRESS (WHAT EVER IT IS)
	MOVE	S1,P4			;GET THE RESOURCE NUMBER
	PUSHJ	P,FNDCME		;GET THE NUMBER OWNED
	MOVE	S2,P4			;GET THE INDEX
	IMULI	S2,AMALEN		;MAKE INDEX INTO A MATRIX
	ADD	S2,AMATRX		;AND AIM AT THIS ENTRY
	MOVEI	T1,[ITEXT (<^D3C/0(P3)/  ^D3C/S1/>)]
	MOVE	T2,(P3)			;GET ALLOCATION COUNT
	CAXN	T2,MAXRES		;EQUAL TO MAXIMUM NUMBER OF JOBS ?
	MOVEI	T1,[ITEXT (< 1    1   Single access>)] ;YES,,ITS SINGLE ACCESS
	LOAD	T2,.AMSTA(S2),AM.DVT	;GET RESOURCE TYPE
	$TEXT	(DEPBYT,<^T20L/(T3)/  ^T16L/@.AMNAM(S2)/  ^T12L/@RESTAB(T2)/  ^I/(T1)/>)

L1AL.4:	AOS	P4			;BUMP THE RESOURCE INDEX
	AOBJN	P3,L1AL.3		;CHECK EACH RESOURCE
	$RETT				;BYE

L1AL.5:	AOSN	JOBNBR			;ANYTHING LISTED YET?
	PUSHJ	P,ALCHDR		;NO, ADD A HEADER
	SKIPE	NOROOM			;ANY SPACE LEFT?
	PUSHJ	P,PAGOVF		;NO, MAKE SOME
	PUSHJ	P,CRLF			;NEW LINE
	$ASCII	<No outstanding allocations for >
	PUSHJ	P,LALCDM		;ADD THE DEMOGRAPHIC INFO
	$RETT


; Table of resource types in the 'A' matrix
;
RESTAB:	[ASCIZ	|Unknown|]
	[ASCIZ	|Magtape unit|]
	[ASCIZ	|Disk unit|]
	[ASCIZ	|DECtape unit|]
	[ASCIZ	|Dismount|]
	[ASCIZ	|Structure|]
	[ASCIZ	|Magtape vol.|]
	[ASCIZ	|DECtape vol.|]
SUBTTL	Find a VSN given a resource number


; Routine to find a VSN string
; Call:	MOVE	AP,MDR address
;	MOVE	S1,resrource number
;	PUSHJ	P,GETVSN
;
; On return, S1:= VSN string address if there is one, otherwise S1:= "---"
;
GETVSN::$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET NUMBER OF VOLUMES
	MOVNS	P1			;GET -COUNT
	HRLI	P1,.MRVSL(AP)		;GET ADDRESS OF FIRST VSL
	MOVSS	P1			;MAKE AN AOBJN POINTER

GETV.1:	MOVE	P2,(P1)			;GET ADDRESS OF VOLUME SET LIST
	LOAD	P3,.VSCVL(P2),VS.CNT	;GET NUMBER OF VOLUMES
	MOVNS	P3			;GET -COUNT
	HRLI	P3,.VSVOL(P2)		;GET ADDRESS OF FIRST VOLUME
	MOVSS	P3			;MAKE AN AOBJN POINTER

GETV.2:	MOVE	P4,(P3)			;GET A VOLUME ADDRESS
	LOAD	S2,.VLFLG(P4),VL.RSN	;GET VOLUME RESOURCE NUMBER
	CAMN	S1,S2			;IS IT THE ONE WE'RE LOOKING FOR?
	JRST	GETV.3			;GOT IT
	AOBJN	P3,GETV.2		;TRY ANOTHER VOLUME
	AOBJN	P1,GETV.1		;TRY ANOTHER VOLUME SET
	MOVEI	S1,[ASCIZ |---|]	;LOAD ADDRESS OF "---" STRING
	POPJ	P,			;RETURN

GETV.3:	MOVE	S1,(P1)			;GET ADDRESS OF CURRENT VSL
	MOVEI	S1,.VSVSN(S1)		;GET VSN ADDRESS
	POPJ	P,			;RETURN
	;CONTINUED FROM THE PREVIOUS PAGE

;A routine do dump the demographic info about a user
;Call -
;	P1/	job number or batch stream number
;	P2/	adrs of batch or job ASCIZ descriptor
;	AP/	adrs of MDR

LALCDM:	MOVE	S1,P1			;GET THE JOB NUMBER
	TXZ	S1,BA%JOB		;CLEAR THE BATCH FLAG BIT
	$TEXT	(DEPBYT,<^T/0(P2)/ ^D/S1/ ^W6/.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^U/.MRUSR(AP)/>^A)
	$RETT

;Routine to dump a header into the message
ALCHDR:	MOVEI	S1,[ASCIZ/ Mountable Device Allocations /]
	PJRST	SETPAG			;SETUP WITH THIS HEADER

;This routine finds the contents of C MATRIX [.S1, .CM]
;If either the column or the row is not there, 0 is returned in S1
;Call -
;	S1/	Resource number
;	CM/	0 if no column known, or adrs of CM header
FNDCME:	JUMPE	CM,FNDC.1		;IF NO CMATRIX, RETURN 0
	LOAD	S2,.SMFLG(CM),SM.CNT	;GET THE MAXIMUM REPRESENTED
	CAMLE	S1,S2			;ARE WE IN RANGE?
	JRST	FNDC.1			;NO, QUIT
	ADDI	S1,(CM)			;AIM AT THE START OF THE ENTRY
	SKIPA	S1,.SMRES(S1)		;GET THE NUMBER THERE
FNDC.1:	SETZ	S1,			;OFF THE END, SET 0
	$RETT
>;END TOPS10
	SUBTTL	SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE.

	;CALL:	S1/ The Address of an Asciz Type Line String
	;
	;RET:	True Always

SETPAG:	MOVE	T3,S1			;SAVE THE HEADER ADDRESS.
	PUSHJ	P,M%GPAG		;GET A PAGE FOR OUTPUT.
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVX	S2,PAGSIZ		;GET A PAGE LENGTH
	MOVEM	S2,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVE	S2,[.OHDRS,,.OMACS]	;GET MSG TYPE PARMS.
	MOVEM	S2,.MSTYP(S1)		;SAVE IT IN THE MSG.
	MOVE	S2,ACKCOD		;GET THE OPR ACK CODE.
	MOVEM	S2,.MSCOD(S1)		;SAVE IT IN THE MSG.
	MOVX	S2,WT.SJI+WT.NFO	;GET JOB INFO SUPPRESS BITS.
	MOVEM	S2,.OFLAG(S1)		;SAVE IT IN THE MSG.
	AOS	.OARGC(S1)		;ADD 1 TO THE ARGUMENT COUNT.
	MOVEI	S1,.OHDRS(S1)		;POINT TO THE FIRST MESSAGE BLK.
	SKIPE	T3			;SKIP IF NO HEADER WANTED.
	PUSHJ	P,SETHDR		;ELSE GO PUT IT IN.
	MOVEI	T4,.CMTXT		;GET THE TEXT BLOCK TYPE.
	MOVEM	T4,ARG.HD(S1)		;SAVE IT IN THE MESSAGE.
	MOVEI	T4,ARG.DA(S1)		;POINT TO DATA AREA.
	MOVEM	T4,DATADR		;SAVE THE START DATA ADDRESS.
	MOVE	S1,G$SAB##+SAB.MS	;GET THE MESSAGE START ADDRESS.
	SUB	S1,T4			;CALC NEG. NUMBER OF WORDS USED.
	ADDI	S1,^D512-^D75		;CALC NUMBER OF WORDS LEFT.
	IMULI	S1,5			;CALC NUMBER OF BYTES LEFT.
	MOVEM	S1,BYTCNT		;AND SAVE IT.
	SETZM	NOROOM			;RESET NO MORE ROOM FLAG.
	HRLI	T4,(POINT 7,)		;GEN THE BYTE POINTER.
	MOVEM	T4,BYTPTR		;AND SAVE IT.
	$RETT				;RETURN


	SUBTTL 	SETHDR - ROUTINE TO INSERT THE MESSAGE HEADER.

;Here with
;	S1/	Adrs of free slot in message
;	T3/	Adrs of ASCIZ string
;Returns
;	display block into message
;	S1	points to new first free location in message

SETHDR:	$SAVE	<P1>			;PRESERVE A REG
	MOVE	S2,G$SAB##+SAB.MS	;GET THE MESSAGE ADDRESS.
	AOS	.OARGC(S2)		;ALSO BUMP THE BLOCK COUNT BY 1.
	MOVX	P1,.ORDSP		;GET BLOCK TYPE
	STORE	P1,ARG.HD(S1),AR.TYP	;SAVE IT IN THE MSG.
	MOVE	P1,G$NOW##		;GET THE TIME
	MOVEM	P1,ARG.DA(S1)		;SAVE TIME STAMP
	MOVEI	P1,ARG.DA+1(S1)		;POINT TO BLOCK DATA AREA.
	HRLI	P1,(POINT 7,)		;MAKE A BYTE POINTER OF IT
	MOVEM	P1,BYTPTR		;SAVE FOR TEXT OUTPUT ROUTINE
	$TEXT	(DEPBYT,<^T/0(T3)/^A>)	;DUMP THE HEAD INTO THE MESSAGE
	HRRZ	P1,BYTPTR		;GET LAST ADRS USED
	SUBI	P1,-1(S1)		;FIGURE LENGTH OF THIS BLOCK
	STORE	P1,ARG.HD(S1),AR.LEN	;MARK LENGTH OF THIS BLOCK
	ADDI	S1,0(P1)		;POINT TO NEXT SLOT AFTER THIS BLOCK
	MOVSS	P1			;LENGTH TO LEFT HALF
	ADDM	P1,.MSTYP(S2)		;UPDATE MESSAGE LENGTH, TOO
	$RETT
	SUBTTL SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.

SNDMSG:	MOVX	S1,WT.MOR		;GET THE MORE PAGES COMMING BIT.
	MOVE	S2,G$SAB##+SAB.MS	;GET THE MESSAGE ADDRESS.
	IORM	S1,.OFLAG(S2)		;LIGHT THE BIT.

SENDIT:	SETZ	S1,			;MAKE A NULL BYTE
	IDPB	S1,BYTPTR		;TERMINATE THE STRING
	HRRZ	S1,BYTPTR		;GET FINAL MESSAGE ADDRESS.
	SUB	S1,DATADR		;CALCULATE ITS LENGTH
	ADDI	S1,2			;ADD THE HEADER LENGTH+1.
	MOVSS	S1			;SHIFT RIGHT TO LEFT.
	MOVE	S2,DATADR		;GET THE BLOCK DATA START ADDRESS.
	ADDM	S1,-1(S2)		;BUMP TEXT BLOCK LENGTH.
	ADDM	S1,@G$SAB##+SAB.MS	;BUMP TOTAL MSG LENGTH.
	MOVE	S1,G$OPR##		;GET ORION'S PID
	SKIPL	ENTYPE			;UNLESS THIS IS A USER REQUEST..
	MOVE	S1,G$SND##		;  THEN GET THE SENDERS PID.
	MOVEM	S1,G$SAB##+SAB.PD	;AND SAVE IT.
	PUSHJ	P,C$SEND##		;SEND IT OFF.
	SETZM	G$SAB##+SAB.MS		;ZERO THE SAB MSG ADDRESS.
	$RETT				;RETURN.
	SUBTTL	DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO

DMPSTS:	SKIPN	LISTYP			;IF THIS IS A QUICK LIST,,SKIP THIS
	JRST	DMPS.8			;EXIT

	PUSHJ	P,PADLIN		;PAD LINE LINE TO MAKE IT PRETTY
	MOVE	T3,BYTCNT		;GET THE CURRENT BYTE COUNT
	SUBI	T3,^D30			;CALC ROOM TILL END OF LINE

	LOAD	S1,.QESEQ(AP),QE.HBO	;IS THE JOB IN OPERATOR HOLD ???
	SKIPE	S1			;0=NO, 1=YES.
	$ASCII	(<  Hold:Yes>)		;YES,,SAY SO

	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE QUEUE TYPE
	CAIE	S1,.OTBAT		;IS IT BATCH ???
	JRST	DMPS.1			;NO,,PROCESS AS OUTPUT QUEUE

	MOVEI	S1,^D13			;GET THE FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	MOVX	S1,QE.STR		;BIT TO TEST
	TDNN	S1,.QENQC(AP)		;SPOOLING TO REMOTE?
	TDZA	S1,S1			;NO
	MOVE	S1,[ASCIZ /NQC /]	;YES
	SKIPE	JOBACT			;IS THE JOB ACTIVE ???
	$TEXT	(DEPBYT,<  In ^5/S1/stream:^D/OBJUNI(P3)/^A>) ;YES,,SAY SO

	MOVEI	S1,^D8			;GET FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,.QEROB+.ROBAT(AP),RO.ATR ;GET STREAM ATTRIBUTES
	CAIN	S1,%SITGO		;SITGO REQUEST?
	$TEXT	(DEPBYT,<  /SITGO^A>)	;YES,,SAY SO


	MOVEI	S1,^D8			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S1,.QELIM(AP),DEPN	;GET THE DEPENDENCY COUNT
	SKIPE	S1			;ANY THERE ???
	$TEXT	(DEPBYT,<  /Dep:^D/S1/^A>) ;YES,,SAY SO

	MOVEI	S1,^D18			;GET NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S1,.QELIM(AP),ONOD	;GET /DEST 
	PUSHJ	P,N$NODE##		;FIX IT UP
	PUSHJ	P,N$LOCL##		;IS IT A LOCAL NODE?
	SKIPT				;YES--SKIP IT
	$TEXT	(DEPBYT,<  /Dest:^T/NETASC(S2)/^A>);NO--OUTPUT IT

	JRST	DMPS.3			;CONTINUE ON
DMPS.1:	MOVEI	S1,^D12			;GET THE FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM.
	LOAD	S1,.QEROB+.ROBAT(AP),RO.ATR ;GET THE DEVICE ATTRIBUTES
	SKIPN	JOBACT			;JOB ACTIVE?
	JRST	DMP.1A			;NO
	MOVX	S2,QE.STR		;BIT TO TEST
	TDNE	S2,.QENQC(AP)		;SPOOLING TO REMOTE?
	JRST	DMP.1D			;YES
	MOVE	S2,OBJUNI(P3)		;GET UNIT NUMBER
	$TEXT	(DEPBYT,<  On Unit:^D/S2/^A>) ;IS ACTIVE,,SAY SO
	JRST	DMPS.2			;ONWARD
DMP.1A:	SKIPN	S2,.QEROB+.ROBUT(AP)	;GET UNIT TYPE IF SPECIFIED
	JRST	DMP.1B			;NOT KNOWN
	$TEXT	(DEPBYT,<  /Unit:^W/S2/^A>) ;DISPLAY UNIT TYPE
	JRST	DMPS.2			;ONWARD
DMP.1B:	CAIE	S1,%PHYCL		;WAS 'PHYSICAL' SPECIFIED?
	JRST	DMP.1C			;NO PARTICULAR UNIT
	LOAD	S2,.QEROB+.ROBAT(AP),RO.UNI ;YES,,GET THE UNIT NBR
	$TEXT	(DEPBYT,<  /Unit:^D/S2/^A>) ;NOT ACTIVE,,SAY SO
	JRST	DMPS.2			;AND CONTINUE ON
DMP.1C:	CAIN	S1,%LOWER		;WAS IT LOWER??
	$ASCII	(<  /Lower>)		;YES,,SAY SO
	CAIN	S1,%UPPER		;WAS IT /UPPER??
	$ASCII	(<  /Upper>)		;YES,,SAY SO
	JRST	DMPS.2			;ONWARD
DMP.1D:	$TEXT	(DEPBYT,<  In NQC stream:^D/OBJUNI(P3)/^A>)

DMPS.2:	SKIPN	.QEQNM(AP)		;QUEUE NAME SPECIFIED?
	JRST	DMPS2A			;NO
	MOVSI	S1,-QNMLEN		;COMPUTE FIELD LENGTH
	SKIPE	.QEQNM(AP)		;LOOK FOR A ZERO WORD
	AOBJN	S1,.-1			;...
	LSH	S1,2			;FOUR CHARACTERS/WORD
	HRRZS	S1			;ISOLATE LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Queue:^Q/QUEQUE/^A>)
DMPS2A:	MOVEI	S1,^D15			;GET NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S2,.QELIM(AP),FORM	;GET THE FORMS TYPE
	MOVE	S1,S2			;PUT IT HERE ALSO
	MOVX	TF,FRMNOR		;GET 'NORMAL' FORMS NAME
	ANDX	S2,FRMSK1		;JUST GET THE IMPORTANT PART
	ANDX	TF,FRMSK1		;HERE ALSO
	CAME	S2,TF			;EVERYTHING OK ???
	$TEXT	(DEPBYT,<  /Forms:^W/S1/^A>) ;NO,,SAY SO
DMPS.3:	MOVEI	S1,^D16			;GET NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	SKIPE	JOBACT			;[1156] JOB ACTIVE?
	JRST	DMPS3A			;[1156] YES,,GO CHECK ROUTING
	MOVE	S1,.QEROB+.ROBND(AP)	;[1156] NO,,GET NODE NAME
	PUSHJ	P,N$NODE		;[1156] CHECK IT OUT
	JRST	DMPS3B			;[1156] CONTINUE
DMPS3A:	MOVEI	S1,.QEROB(AP)		;[1156] GET THE REQ OBK BLK ADDRESS
	SETZM	S2			;NO OBJECT MATCH
	PUSHJ	P,N$CSTN##		;PERFORM ANY ROUTING
DMPS3B:	PUSHJ	P,N$LOCL##		;[1156] IS IT A LOCAL NODE ???
	JUMPT	DMPS.4			;YES,,SKIP THIS.
	MOVE	S1,.QEROB+.ROBTY(AP)	;GET THE OBJECT TYPE
	CAIE	S1,.OTBAT		;IS IT BATCH ???
	MOVEI	S1,[ASCIZ'/Dest:']	;NO,,MAKE IT /DEST:
	CAIN	S1,.OTBAT		;TRY ONCE MORE...
	MOVEI	S1,[ASCIZ'/Proc:']	;IT IS BATCH,,MAKE IT /PROC-NODE:
	$TEXT	(DEPBYT,<  ^T/0(S1)/^T/NETASC(S2)/^A>) ;NO,,SAY SO
DMPS.4:	MOVEI	S1,^D12			;GET THE FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	MOVE	S1,.QEROB+.ROBTY(AP)	;GET THE QUEUE TYPE
	CAIE	S1,.OTBAT		;BATCH?
	JRST	DMP.42			;NO

TOPS10	<
	SKIPE	G$MDA##			;MDA TURNED ON?
	JRST	DMP.40			;YES - DO IT THE RIGHT WAY
> ;END TOPS10 CONDITIONAL

DMP.42:	PUSHJ	P,Q$CDEP##		;FIND THE MISSING STRUCTURE
	SKIPT				;NONE THERE,,SKIP THIS
	$TEXT	(DEPBYT,<  Str:^I/STRUCT/^A>) ;PUT IT OUT
	JRST	DMP.41			;SKIP MDA STUFF

DMP.40:	MOVE	S1,.QESEQ(AP)		;GET STATUS BITS
	TXNE	S1,QE.HBO		;HELD BY OPERATOR?
	JRST	DMP.41			;YES
	TXNE	S1,QE.WAM		;IS IT WAITING FOR A MOUNT ???
	$ASCII	(<  Mount wait>)	;YES,,SAY SO

DMP.41:	MOVE	S1,G$NOW##		;GET CURRENT TIME
	CAML	S1,.QECRE(AP)		;IS THERE A /AFTER PARM ???
	JRST	DMP.4A			;NO,,SKIP THIS
	MOVEI	S1,^D24			;GET LENGTH FOR NEXT FIELD
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	$TEXT (DEPBYT,<  /After:^H15/.QECRE(AP)/^A>) ;YES,,SAY SO

DMP.4A:	SKIPG	LISTYP			;IS THIS AN EVERYTHING LIST ??
	JRST	DMPS.7			;NO,,SKIP THIS
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE QUEUE TYPE
	CAIE	S1,.OTBAT		;IF BATCH,,CONTINUE ON
	JRST	DMPS.5			;ELSE PROCESS OUTPUT QUEUE

	MOVEI	S1,^D11			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S1,.QELIM(AP),UNIQ	;GET THE UNIQUE SWITCH
	CAIN	S1,%EQUYE		;IS IT /UNIQUE:YES ???
	$ASCII	(<  /Uniq:Yes>)		;YES,,SAY SO
	CAIN	S1,%EQUNO		;OR IS IT /UNIQUE:NO ???
	$ASCII	(<  /Uniq:No>)		;YES,,SAY SO

	MOVEI	S1,^D14			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S1,.QELIM(AP),REST	;GET THE /RESTART SWITCH
	CAIN	S1,%EQRNO		;IS IT /RESTART:NO ???
	$ASCII	(<  /Restart:No>)	;YES,,SAY SO
	CAIN	S1,%EQRYE		;IS IR /RESTART:YES ???
	$ASCII	(<  /Restart:Yes>)	;YES,,SAY SO

	MOVEI	S1,^D13			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	GETLIM	S1,.QELIM(AP),OINT	;GET /ASSISTANCE: VALUE
	CAIN	S1,.OPINY		;IS IT /ASSIST:YES ???
	$ASCII	(<  /Assist:Yes>)	;YES,,SAY SO
	CAIN	S1,.OPINN		;IS IT /ASSIST:NO ???
	$ASCII	(<  /Assist:No>)	;YES,,SAY SO
	MOVEI	S1,^D15			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;SEE IF ROOM
	GETLIM	S1,.QELIM(AP),OUTP	;GET /OUTPUT
	CAIN	S1,%EQONL		;NOLOG?
	 $ASCII	(<  /Output:Nolog>)	;YES
	CAIN	S1,%EQOLG		;LOG?
	 $ASCII	(<  /Output:Log>)	;YES
	CAIN	S1,%EQOLE		;ERROR?
	 $ASCII	(<  /Output:Error>)	;YES

	MOVEI	S1,^D16			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;SEE IF ROOM
	GETLIM	S1,.QELIM(AP),BLOG	;GET /BATLOG
	CAIN	S1,%BAPND		;APPEND?
	 $ASCII	(<  /Batlog:Append>)	;YES
	CAIN	S1,%BSCDE		;SUPERSEDE?
	 $ASCII	(<  /Batlog:Super>)	;YES
	CAIN	S1,%BSPOL		;SPOOL?
	 $ASCII	(<  /Batlog:Spool>)	;YES
	JRST	DMPS.6			;CONTINUE ON

DMPS.5:	MOVEI	S1,^D20			;GET THE FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ENOUGH ROOM
	GETLIM	S1,.QELIM(AP),NOT1	;GET THE FIRST NOTE WORD
	GETLIM	S2,.QELIM(AP),NOT2	;GET THE SECOND NOTE WORD
	SKIPE	S1			;ANY NOTE THERE ???
	$TEXT	(DEPBYT,<  /Note:^W6L /S1/^W/S2/^A>) ;YES,,SAY SO

DMPS.6:	MOVEI	S1,^D10			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	LOAD	S1,.QESEQ(AP),QE.PRI	;GET THE JOB PRIORTY
	CAXE	S1,SPLPRI		;IS IT THE DEFAULT ???
	$TEXT	(DEPBYT,<  /Prio:^D/S1/^A>) ;NO,,SAY SO

	MOVEI	S1,^D11			;GET THE NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Seq:^D/.QESEQ(AP),QE.SEQ/^A>) ;OUTPUT SEQ #

DMPS.7:	SKIPN	CRLFLG			;[1200]START OF THE LINE ??
	  JRST	DMPS.8			;[1200]NO, OUTPUT A CRLF
	MOVX	S1,.CHNUL		;[1200]YES, GET A NULL CHARACTER
	DPB	S1,BYTPTR		;[1200]CLEAR TAB IN BUFFER
	DMOVE	S1,LASTPT		;[1200]GET THE LAST BYTPTR AND BYTCNT
	DMOVEM	S1,BYTPTR		;[1200]RESET THE BYTPTR AND BYTCNT
	$RETT				;[1200]AND RETURN
DMPS.8:	PUSHJ	P,CRLF			;PUT OUT A CRLF
	$RETT				;AND RETURN
	SUBTTL	PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE

	;CALL:	S1/ The Byte count before the current line was generated
	;	S2/ The maximum line length
	;	BYTCNT/ The byte count after the current line was generated
	;
	;RET:	True Always

PADLIN:	MOVE	T3,S1			;GET THE OLD BYTE COUNT
	SUB	T3,S2			;CALC BYTE COUNT-LINE LENGTH
	SUB	T3,BYTCNT		;GET DIFFERENCE BETWEEN OLD AND NEW
	SKIPL	T3			;IF LESS,,THEN CONTINUE ON
	$RETT				;NO,,JUST RETURN
	MOVMS	T3,T3			;MAKE IT POSITIVE
PADL.1:	SOJL	T3,.RETT		;INSERT ANY SLACK BYTES
	$ASCII	(< >)			;PUT ONE IN
	JRST	PADL.1			;KEEP ON GOING TILL DONE
	SUBTTL	GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SHOW QUEUES MSG.

GETPAR:	SETZM	QUEBITS			;ZERO THE QUEUES WE WANT.
	SETZM	BLKADR			;ZERO THE MESSAGE BLOCK ADDRESS.
	SETZM	LSTUSR			;INDICATE ALL USER IDS
	SETOM	LSTUSM			;DEFAULT MASK TO NO WILDS
	SETZM	LSTJOB			;INDICATE ALL JOB NAMES
	SETOM	LSTJBM			;DEFAULT MASK TO NO WILDS
	SETOM	LSTUNT			;INDICATE ALL UNITS
	SETZM	LSTUTY			;INDICATE ALL UNIT TYPES
	SETOM	LSTDND			;ALL DESTINATION NODES
	SETOM	LSTPND			;ALL PROCESSING NODES
	MOVX	S1,QNMLEN		;LENGTH
	MOVEI	S2,LSTQNM		;ADDRESS
	PUSHJ	P,.ZCHNK		;ZERO IT
	SETZM	OBJADR			;ZAP THE OBJECT BLOCK ADDRESS
	SETOM	NODE6B			;INDICATE ALL NODES
	SETZM	DEVICE			;NO SPECIFIC DEVICE

	LOAD	S1,.MSCOD(M)		;GET THE ACK CODE.
	STORE	S1,ACKCOD		;AND SAVE IT.
	LOAD	S1,.OFLAG(M)		;GET THE MESSAGE FLAG BITS.
	MOVEM	S1,LISFLG		;SAVE FLAG BITS
	SETZM	LSTSUM			;ASSUME NO SUMMARY WANTED
	TXNE	S1,LS.SUM		;CHECK THE BIT
	SETOM	LSTSUM			;AND SET FLAG IF DESIRED
	SETOM	S2			;SET S2 UP AS 'NORMAL' LISTING
	TXNE	S1,LS.FST		;DOES HE WANT A QUICK LISTING ???
	SETZM	S2			;MAKE IT A 'FAST' LISTING
	TXNE	S1,LS.ALL		;DOES HE WANT EVERYTHING ???
	MOVEI	S2,1			;MAKE IT EVERYTHING BUT KITCHEN SINK !
	MOVEM	S2,LISTYP		;SAVE IT FOR LATER

GETP.1:	PUSHJ	P,A$GBLK##		;GO GET A MESSAGE BLOCK.
	JUMPF	GETP.2			;NO MORE, RESOLVE /DEST /PROC /NODE
	CAIN	T1,.LSQNM		;IS THIS THE QUEUE NAME BLOCK?
	JRST	GETP.3			;YES
	LOAD	S1,0(T3)		;GET THE FIRST ENTRY IN THE BLOCK
	CAIN	T1,.LSQUE		;IS THIS THE QUEUES BLOCK ???
	MOVEM	S1,QUEBITS		;SAVE THE QUEUE TYPE(S) WE WANT.
	CAIN	T1,.LSUSR		;OR IS IT THE USER BLOCK ???
	MOVEM	S1,LSTUSR		;SAVE THE USER DATA.
	CAIN	T1,.LSUSM		;USER MASK BLOCK?
	 MOVEM	S1,LSTUSM		;YES--SAVE IT
	CAIN	T1,.LSJOB		;JOB NAME BLOCK?
	 MOVEM	S1,LSTJOB		;YES--SAVE IT
	CAIN	T1,.LSJBM		;JOB NAME MASK BLOCK?
	 MOVEM	S1,LSTJBM		;YES--SAVE IT
	CAIN	T1,.LSUNT		;UNIT SPECIFICATION BLOCK?
	 MOVEM	S1,LSTUNT		;YES--SAVE IT
	CAIN	T1,.LSUTY		;UNIT TYPE?
	 MOVEM	S1,LSTUTY		;YES--SAVE IT
	CAIN	T1,.LSDND		;DESTINATION NODE?
	MOVEM	S1,LSTDND		;YES--SAVE IT
	CAIN	T1,.LSPND		;PROCESSING NODE?
	MOVEM	S1,LSTPND		;YES--SAVE IT
	CAIN	T1,.OROBJ		;IS IT THE OBJECT BLOCK ???
	MOVEM	T3,OBJADR		;YES,,SAVE ITS ADDRESS
	CAIN	T1,.ORNOD		;IS THIS THE NODE BLOCK ???
	MOVEM	S1,NODE6B		;YES,,SAVE THE NODE WE WANT
	CAIE	T1,.TAPDV		;IS IT A TAPE VOLUME BLOCK ???
	CAIN	T1,.STRDV		;OR IS IT A STRUCTURE BLOCK?
	SKIPA				;TREAT THEM THE SAME
	JRST	GETP.1			;NO,,SKIP IT AND PROCESS NEXT BLOCK
	HRROI	S1,0(T3)		;YES,,POINT TO THE ASCIZ DEVICE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,DEVICE		;SAVE IT
TOPS10<	DEVNAM	S2,			;GET THE REAL DEVICE NAME
	SKIPA				;SKIP IF IT DOES NOT EXIST
	MOVEM	S2,DEVICE		;SAVE IT
> ;END TOPS10 CONDITIONAL
	JRST	GETP.1			;AND GO TRY AGAIN.

; Resolve /DEST, /PROC and /NODE conflicts.
; This assumes some toad doesn't mix /DEST/PROC with /NODE in
; a list request.  This crock is a temporary (but not a complete)
; solution to the SHOW Q /NODE problem until OPR implements /DEST
; and /PROC switches. This won't be done in GALAXY %4.1/4.2
;
GETP.2:	SETOM   KLUDGE                  ;[1206]TURN OFF KLUDGE
	MOVE	T1,NODE6B		;GET /NODE
	CAMN	T1,[-1]			;WAS /NODE SPECIFIED?
	$RETT				;NO - NOTHING TO DO
	MOVE	T2,LSTDND		;GET /DEST
	CAMN	T2,[-1]			;WILD?
	MOVEM	T1,LSTDND		;YES
	MOVE	T2,LSTPND		;GET /PROC
	CAMN	T2,[-1]			;WILD?
	MOVEM	T1,LSTPND		;YES
	SETZM	KLUDGE			;[1206]FLAG KLUDGE
	$RETT				;AND RETURN

GETP.3:	HRLI	T3,LSTQNM		;BUILD REVERSED BLT WORD
	MOVSS	T3			;CORRECT IT
	BLT	T3,LSTQNM-1(T2)		;COPY QUEUE NAME
	MOVEI	S1,LSTQNM		;POINT AT IT
	PUSHJ	P,A$FQNM##		;SEE IF WE CAN DECIPHER IT
	JUMPF	GETP.4			;IF NOT, IGNORE /QUEUE
	MOVE	S2,QNM.RO+.ROBND(S1)	;GET NODE
	MOVEM	S2,LSTDND		;OVERWRITE
	LOAD	S2,QNM.RO+.ROBAT(S1),RO.UNI ;GET UNIT NUMBER
	MOVEM	S2,LSTUNT		;OVERWRITE
	JRST	GETP.1			;GO PROCESS THE NEXT BLOCK

GETP.4:	SETZM	LSTQNM			;ZAP OUT ANY MEMORY OF QUEUE NAME
	JRST	GETP.1			;GO PROCESS THE NEXT BLOCK
	SUBTTL	UTILITY ROUTINES


DEPBYT:	IDPB	S1,BYTPTR		;PUT THE BYTE INTO THE MESSAGE.
	SOSG	BYTCNT			;CHECK THE BYTES REMAINING.
	SETOM	NOROOM			;NO MORE ROOM,,TURN ON FLAG.
	SETZM	CRLFLG			;CLEAR THE CRLF FLAG
	$RETT				;RETURN


PAGOVF:	PUSHJ	P,SNDMSG		;SEND THE MESSAGE OFF.
	SETZ	S1,			;INDICATE WE DONT HAVE ANY HEADER.
	PUSHJ	P,SETPAG		;GO SET UP A NEW OUTPUT PAGE.
	$COUNT	(NLAP)			;COUNT THE PAGES SENT
	$RETT				;AND RETURN.

CRLF:	MOVEI	S1,[BYTE(7) 15,12,0,0,0] ;GET THE CRLF.
	PUSHJ	P,ASCOUT		;DUMP IT OUT
	SETOM	CRLFLG			;SAY LAST THING OUT WAS CRLF
	$RETT				;AND RETURN

ASCOUI:	PUSH	P,S1			;SAVE S1
	HRRZ	S1,@-1(P)		;GET THE ADRS OF THE MESSAGE
	AOS	-1(P)			;SKIP OVER THE ARG POINTER
	PUSHJ	P,ASCOUT		;DUMP IT OUT
	POP	P,S1			;RESTORE S1
	$RETT				;AND WIN

ASCOUT:	PUSHJ	P,.SAVE1		;SAVE P1.
	MOVE	P1,S1			;SAVE THE INPUT ADDRESS.
	HRLI	P1,(POINT 7,0)		;MAKE IT A BYTE POINTER.
ASCO.1:	ILDB	S1,P1			;GET A BYTE.
	JUMPE	S1,.RETT		;DONE,,RETURN.
	PUSHJ	P,DEPBYT		;PUT IT OUT.
	JRST	ASCO.1			;AND DO ANOTHER.


CHKSPC:	ADD	S1,T3			;ADD FIELD LENGTH AND LAST BYTE ADDRESS
	CAMG	S1,BYTCNT		;IS THERE ROOM FOR THE FIELD ???
	$RETT				;YES,,RETURN
	PUSHJ	P,CRLF			;INSERT A CRLF
	DMOVE	S1,BYTPTR		;GET THE BYTPTR AND BYTCNT
	DMOVEM	S1,LASTPT		;SAVE THEM IN CASE WE NEED THEM
	$ASCII	(<	>)		;INSERT A TAB
	SETOM	CRLFLG			;INDICATE BEGINNING OF LINE
	MOVE	T3,BYTCNT		;GET THE BYTE COUNT
	SUBI	T3,^D64			;GET NEW LINE END ADDRESS
	$RETT				;AND RETURN


CHKLIN:	MOVE	S1,BYTCNT		;Get the current byte count for out page
	SUBI	S1,^D64			;Subtract a "standard" line
	SKIPG	S1			;More room left?
	PUSHJ	P,PAGOVF		;No, go set up next page
	$RET				;Continue


; Compare two nodes
; Call:	S1/ node name or number from QE
;	S2/ requested node name or number (for listings only)
;	PUSHJ	P,CMPNOD	to compare against NODE6B
;	PUSHJ	P,LSTNOD	to compare against listing requests
;
; Ret:	TRUE if a match, FALSE if no match
;
CMPNOD:	MOVE	S2,NODE6B		;GET THE NODE NAME/NUMBER WE WANT
LSTNOD:	CAMN	S2,[-1]			;IS IT ALL NODES ???
	$RETT				;YES,,RETURN
	PJRST	N$MTCH##		;NO,,RETURN THROUGH NODE MATCH ROUTINE
	SUBTTL	Remote Queue Utility Routines


;Check if a remote queue listing is needed for this LIST/SHOW QUEUES
;request.  If any remote queues have been defined AND a node was
;specified which has any remote queues, we will assume a remote
;listing is required.

CHKRMQ:	MOVE	S1,QUEBIT		;GET THE BITS
	MOVE	S2,LISFLG		;AND THE FLAGS
	TXNE	S1,LIQOUT		;ASKING FOR OUTPUT QUEUES?
	TXNN	S2,LS.RMT		;AND DO THEY WANT REMOTE QUEUE LISTING?
	$RETF				;NO, NO NEED FOR REMOTE LISTING
	SKIPN	LSTQNM			;A QUEUE NAME SUPPLIED?
	JRST	CHKRQ1			;NO, MAYBE OLD /DEST: SWITCH?
	MOVEI	S1,LSTQNM		;ADDRESS OF THE QUEUE NAME STRING
	PUSHJ	P,A$FQNM##		;IS THERE A MATCH?
	$RETIF				;IF NO MATCH
	MOVX	S2,QN.LCL		;IS IT A LOCAL QUEUE?
	TDNE	S2,QNM.FL(S1)		;IF SO, WE DON'T NEED TO BOTHER NQC
	$RETF				;LOCAL
	$RETT				;REMOTE

CHKRQ1:	MOVE	S1,LSTDND		;GET /DEST (/NODE) VALUE
	CAME	S1,[-1]			;ALL NODES?
	$RETT				;NO, THAT'S OK
	$RETF				;NO NEED FOR REMOTE LISTING


;Ask the Network Queue Controller for a remote queue listing.  Sends
;a copy of the original LIST/SHOW QUEUES request to the NQC, who in
;turn responds with text messages to the recipient (using QUASAR's
;PID so folks who check senders don't get confused).

ASKNQC:	MOVX	S1,.OTNQC		;GET THE OBJECT TYPE
	MOVX	S2,%NQOUT		;ANYTHING WILL DO
	PUSHJ	P,A$LPSB##		;LOCATE THE PSB
	JUMPF	ASKN.2			;NQC MUST NOT BE RUNNING
	MOVE	S2,[G$SAB##,,SAVSAB]	;WE MUST SALT THE SAB AWAY FOR A BIT
	BLT	S2,SAVSAB+SAB.SZ-1	; SINCE WE'RE GOING TO OVERWRITE IT
	MOVE	S1,PSBPID(S1)		;GET THE PID OF THE NET QUEUE CTLR
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE RECEIVER'S PID
	PUSHJ	P,.SAVET		;FREE UP SOME AC'S
	PUSHJ	P,M%GPAG		;GET A PAGE TO SEND A MESSAGE
	MOVEM	S1,G$SAB##+SAB.MS	;STORE THE ADDRESS
	MOVE	S2,G$ENT##		;GET THE MDB ADDRESS
	LOAD	S2,MDB.MS(S2),MD.ADR	;GET THE LIST REQUEST MESSAGE ADDRESS
	HRL	S1,S2			;SET SOURCE FOR BLT
	LOAD	S2,.MSTYP(S2),MS.CNT	;GET THE MESSAGE LENGTH
	ADDI	S2,(S1)			;COMPUTE END+1 OF BLT
	BLT	S1,-1(S2)		;COPY THE ORIGINAL LIST REQUEST MESSAGE
	MOVE	T1,G$SAB##+SAB.MS	;GET MESSAGE ADDRESS BACK
	MOVE	S1,[2,,.LSPID]		;BLOCK WE ALWAYS ADD
	MOVE	S2,G$OPR##		;GET REQUESTOR'S PID
	SKIPL	ENTYPE			;IF USER REQUEST
	MOVE	S2,G$SND##		;GET FROM HERE
	PUSHJ	P,ASKN.A		;ADD THE BLOCK TO THE NEW MESSAGE
	MOVEI	S1,LSTQNM		;ADDRESS OF QUEUE NAME STRING
	PUSHJ	P,A$FQNM##		;GET THE ENTRY
	JUMPF	ASKN.1			;DUH?  JUST WORKED!
	MOVE	S2,QNM.RO+.ROBND(S1)	;GET THE NODE NAME
	MOVE	S1,[2,,.LSDND]		;BLOCK WE ADD
	PUSHJ	P,ASKN.A		;ADD THE BLOCK TO THE NEW MESSAGE
					;(MIGHT ALREADY BE ONE, BUT BIG DEAL)
ASKN.1:	MOVX	S1,PAGSIZ		;WE'RE SENDING A PAGE
	MOVEM	S1,G$SAB##+SAB.LN	;SET LENGTH
	PUSHJ	P,C$SEND##		;SEND IT OFF TO THE NET QUEUE CTLR
	MOVE	S1,[SAVSAB,,G$SAB##]	;NOW RESTORE THE OLD SAB
	BLT	S1,G$SAB##+SAB.SZ-1	;...
	JUMPF	ASKN.2			;IN CASE OF ERROR
	$RETT				;NQC WILL HANDLE THE REST

ASKN.2:	$ASCII	(<%The remote queues are not accessible>)
	PUSHJ	P,CRLF			;END WITH A CRLF
	$RETF				;WE DID OUR BEST

;ADD A BLOCK TO THE LIST REQUEST MESSAGE

ASKN.A:	AOS	.OARGC(T1)		;WE'RE ADDING ANOTHER BLOCK
	LOAD	T2,.MSTYP(T1),MS.CNT	;GET THE COUNT FIELD
	ADDI	T2,2			;BUMP BY TWO WORDS
	CAILE	T2,PAGSIZ		;QUICK SANITY CHECK
	STOPCD	(LPO,HALT,,<List request message page overflowed>)
	STORE	T2,.MSTYP(T1),MS.CNT	;STORE NEW COUNT
	ADDI	T2,-2(T1)		;FIND WHERE THE NEW BLOCK GOES
	DMOVEM	S1,(T2)			;MOVE IT THERE
	POPJ	P,			;RETURN

SAVSAB:	BLOCK	SAB.SZ			;SAVED G$SAB
	END