Google
 

Trailing-Edge - PDP-10 Archives - tops20_v6_1_tcpip_distribution_tp_ft6 - galaxy-sources/qsrdsp.mac
There are 39 other files named qsrdsp.mac in the archive. Click here to see a list.
	TITLE	QSRDSP - OPERATOR DISPLAY ROUTINES.
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	QSRMAC,GLXMAC,ORNMAC
	PROLOG	(QSRDSP)

	DSPMAN==:2			;Maintenance edit number
	DSPDEV==:15			;Development edit number
	VERSIN (DSP)			;Generate edit number
	SUBTTL	Table of Contents


;		Table of Contents for QSRDSP
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision history . . . . . . . . . . . . . . . . . . .    3
;   4. LOCAL STORAGE AND BRANCH TABLES. . . . . . . . . . . .    4
;   5. ROUTINE DATA AREAS AND ITEXT STATEMENTS. . . . . . . .    5
;   6. D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST. .    8
;   7. D$SHST - ROUTINE TO SHOW DEVICE STATUS.. . . . . . . .    9
;   8. EXPTIM - Expand time . . . . . . . . . . . . . . . . .   10
;   9. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS . . . . . .   11
;  10. SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE . . . .   13
;  11. CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS . .   14
;  12. D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE. . . . . .   16
;  13. D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMETERS  17
;  14. NPRHDR - NETWORK PARAMETER HEADER ROUTINE. . . . . . .   18
;  15. D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE) . . .   19
;  16. D$STAP - SHOW STATUS OF TAPE DRIVES. . . . . . . . . .   21
;  17. D$SDSK - SHOW STATUS OF DISK DRIVES. . . . . . . . . .   23
;  18. GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADDRESS   26
;  19. D$SSTR - SHOW STATUS OF FILE STRUCTURE . . . . . . . .   27
;  20. GETSTR - Get a primary file structure block. . . . . .   30
;  21. STRHDR - Type a header line for SHOW STATUS STRUCTURES   31
;  22. TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HEADER   32
;  23. DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER   33
;  24. D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES. . . . . . .   34
;  25. SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.. . . .   38
;  26. PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING. . . . .   40
;  27. SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATUS COMMAND.   41
;  28. SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.   42
;  29. DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE..   43
;  30. DEPBAT - ROUTINE TO PROCESS BATCH QUEUE ENTRYS.. . . .   43
;  31. DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS.. .   44
;  32. D$SALC - SHOW ALLOCATION . . . . . . . . . . . . . . .   45
;  33. Find a VSN given a resource number . . . . . . . . . .   48
;  34. SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE. . . . . .   50
;  35. SETHDR - ROUTINE TO INSERT THE MESSAGE HEADER. . . . .   50
;  36. SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.. . . . . .   51
;  37. DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO . . . . . .   52
;  38. PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE . . . .   56
;  39. GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SHOW QUEUES MSG.   57
;  40. UTILITY ROUTINES . . . . . . . . . . . . . . . . . . .   58
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

0			7-Jan-83
	Currently no edits

2	4.2.1598	20-Nov-84
	If the last character in an INFORMATION OUTPUT or INFORMATION BATCH
message page is a TAB, replace it with a NULL.

*****  Release 5.0 -- begin development edits  *****

10	5.1003		7-Jan-83
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

11	5.1144		25-May-84
	Include if the tape is labeled or not in the SHOW QUEUES 
MOUNT-REQUESTS/ALL and INFORMATION MOUNT-REQUESTS/ALL commands.

12	5.1162		21-Sep-84
	Add code to SHOW PARAMETERS for SNA Workstation. Add code to
SHOW DESTINATION for SNA printers and punches.

13	5.1171		22-Oct-84
	Don't try to display both IBM and SNA parameters when a specific
node is given.

14	5.1175		23-Oct-84
	Don't show the password in SHOW PARAMETERS for an SNA-Workstation 
printer.

15	5.1210		25-Mar-85
	Show all the volume i.d.s of a volume set when the command INFORMATION
MOUNT-REQUESTS/ALL is given.

\   ;End of Revision History
	SUBTTL	LOCAL STORAGE AND BRANCH TABLES

DEPDEV:	EXP	<.POPJ>			;ILLEGAL QUEUE TYPE 0.
	EXP	<.POPJ>			;.OTRDR - CARD READER QUEUE
	EXP	<.POPJ>			;.OTNCU - NETWORK CONTROLLER QUEUE.
	EXP	DEPOUT			;.OTLPT - LINE PRINTER QUEUE
	EXP	DEPBAT			;.OTBAT - BATCH QUEUE
	EXP	DEPOUT			;.OTCDP - CARD PUNCH QUEUE
	EXP	DEPOUT			;.OTPTP - PAPER TAPE QUEUE
	EXP	DEPOUT			;.OTPLT - PLOTTER QUEUE
	EXP	<.POPJ>			;.OTTRM - TERMINAL
	EXP	<.POPJ>			;.OTJOB - JOB (T/S) QUEUE
	EXP	<.POPJ>			;.OTOPR - OPERATOR QUEUE
	EXP	<.POPJ>			;.OTIBM - IBM
	EXP	<.POPJ>			;.OTMNT - MOUNT
	EXP	<.POPJ>			;.OTXFR - FILE TRANSFER
	EXP	<.POPJ>			;.OTBIN - CARD READER INTERPRETER
	EXP	DEPRET			;.OTRET - RETRIEVAL QUEUE
	EXP	<.POPJ>			;.OTNOT - RETREIVAL NOTIFICATION
	EXP	<.POPJ>			;.OTDBM
	EXP	<.POPJ>			;.OTFAL
	EXP	<.POPJ>			;.OTSNA - SNA Workstation


	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/Min:Max Lim./]	;.OTDBM
	[ASCIZ/Min:Max Lim./]	;.OTFAL
	[ASCIZ/Min:Max Lim./]	;.OTSNA

	%UNLBL==1			;VOLUME IS UNLABELED
	%LABEL==2			;VOLUME IS LABELED
	VOLLIN==5			;Volumes displayed/line
	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
LSTDND:	BLOCK	1		;DESTINATION NODE
LSTPND:	BLOCK	1		;PROCESSING NODE
LISTYP:	BLOCK	1		;FLAG: 0=FAST, -1=NORMAL, 1=ALL
BLKADR:	BLOCK	1		;MESSAGE BLOCK ADDRESS.
OBTYPE:	BLOCK	1		;OBJECT TYPE
ACTIVE:	BLOCK	1		;ACTIVE JOB COUNT.
ATTRIB:	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		;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 /]

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/]

	    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'
	;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.
	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.
	JUMPE	P1,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
	SKIPN	QEMPTY			;ARE THE QUEUES EMPTY ???
	JRST	LIST.2			;YES,,PROCESS A LITTLE DIFFERENTLY
	PUSHJ	P,CRLF			;END WITH A CRLF
	PUSHJ	P,SENDIT		;SEND THE LAST PAGE.
	$RETT				;RETURN.

LIST.2:	SKIPE	ENTYPE			;WAS THIS AN USER REQUEST ???
	JRST	LIST.3			;NO,,MUST BE OPERATOR
	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;GENERATE THE ID
	PUSHJ	P,SETPAG			;GO SETUP THE PAGE
	$ASCII	(<[The queues are empty]>) 	;PUT IN THE TEXT
	PUSHJ	P,CRLF				;ADD A CRLF
	PUSHJ	P,SENDIT			;SEND IT OFF
	$RETT					;AND RETURN

LIST.3:	$ACK	(<The queues are empty>,,,ACKCOD) ;YES,,RESPOND !!
	$RETT				;AND RETURN
	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.
	$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
	PUSHJ	P,EXPTIM		;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)/^A>)
	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'
	SKIPA				;IF NOT,, THEN HE WINS
	$RETF				;ELSE TOUGH BREAKEEEEE
	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
	SKIPN	S2,OBJ.ND(S2)		;IF NO NODES,
	JRST	CHKO.1			;WIN,,CHECK FOR DN60 EMULATION
	CAME	S2,[-1]			;IF ALL NODES,
	CAMN	S2,NETNAM(P1)		;   OR IF WE MATCH BY NAME,
	SKIPA				;THEN CHECK FOR DN60 EMULATION
	CAMN	S2,NETNBR(P1)		;IF WE MATCH BY NODE NUMBER,
	SKIPA				;THEN CHECK FOR DN60 EMULATION
	$RETF				;ELSE RETURN FALSE

CHKO.1:	MOVE	S1,OBJSCH(T1)		;GET THE SCHEDULING BITS
	TXNE	S1,OBSSIP+OBSSUP	;IF SIP OR SETUP,,THEN
	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)		;NO - FIX UP STATUS
	JRST	CHKO.3			;CONTINUE

CHKO.2:	MOVE	S1,OBJSTS(T1)		;GET CURRENT STATUS WORD
	CAXE	S1,%NOPRC		;WAS IT "NO PROCESSOR" ?
	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),NETSNA	;IS THIS AN SNA WORKSTATION STATION ???
	JUMPN	S2,CHKO.5		; Yes, Go do it
	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
	SKIPE	SHWTYP			;YES,,IS THIS 'SHOW STATUS' ???
	$RETF				;NO,,JUST SKIP THIS OBJECT
CHKO.4:	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

;
;  Here when we have an SNA workstation; only send one status request
;  to the spooler since response includes all station devices
;

CHKO.5:	SKIPE	SHWTYP			; Is this 'SHOW STATUS' ?
	$RETT				;   Yes, don't send request to spooler
	MOVE	S1,OBJADR		; Get message obj block address
	SKIPL	OBJ.TY(S1)		; If no object specified (-1)
	SKIPGE	OBJ.UN(S1)		;  or no specific unit specified
	SKIPA				;   do more checking
	JRST	CHKO.4			; Otherwise, send message to spooler
	MOVE	S1,OBJTYP(T1)		; If -1 was specified
	MOVE	S2,OBJUNI(T1)		;  then only send message to spooler
	CAIN	S1,.OTBAT		;  if this is the master batch stream
	CAIE	S2,1
	$RETF				; Return false, we don't want this one
	JRST	CHKO.4
	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	ATTRIB			;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	S1,OBJTYP(T1)		;GET OBJECT TYPE
	CAXE	S1,.OTBAT		;IS IT BATCH ?
	JRST	CHK1.A			;NO

	LOAD	S1,OBJDAT(T1),RO.ATR	;GET ATTRIBUTE FIELD
	CAXN	S1,%SITGO		;SITGO ??
	SETOM	ATTRIB			;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
	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:	$ASCII	(<   Minutes      Prio  >) ;START HEADING
IFN INPCOR,< $ASCII (<  Core   >)  > 	;PUT OUT 'CORE'
	$ASCII	(<Opr-Intvn>)		;PUT OUT OPR-INTERVENTION HEADING
	SKIPE	ATTRIB			;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
	$ASCII	(<-------------  -----  >) ;OUTPUT SOME UNDERLINES
IFN INPCOR,< $ASCII (<-------  >) >  	;'CORE' UNDERLINE
	$ASCII	(<--------->)		;OPR-INTERVENTION UNDERLINE
	SKIPE	ATTRIB			;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
	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$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
	MOVE	S1,NETCOL(P1)		;GET THIS NODES NAME/NUMBER
	PUSHJ	P,CMPNOD		;IS IT ONE WE WANT ???
	JUMPF	NPRM.3			;NO,,TRY NEXT
	MOVE	S1,NETCOL(P1)		;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)/^T12/@IBMODE(T2)/^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	T3,NETSTS(P2),NT.TOU	;Get protocol timeout cat.
	LOAD	T4,NETSTS(P2),NT.TRA	;GET 'TRANSPARENCY'
	$TEXT	(DEPBYT,< ^O4/NETPTL(P2),NT.PRT/ ^D4/NETPTL(P2),NT.LIN/  ^T/@IBMDTR(T4)/  ^D5/NETCSD(P2)/ ^D5/NETRPM(P2)/ ^D5/NETBPM(P2)/ ^T/@IBMTIM(T3)/>)
	LOAD	T1,NETSTS(P2),NETSGN	;GET 'SIGNON REQUIRED' BIT
	$ASCII	(<   Signon>)		;Add SIGNON LINE
	SKIPN	T1			;IS IT REQUIRED ???
	$ASCII	(< is not>)		;NO,,SAY SO
	$ASCII	(< Required>)		;ADD LAST BIT OF 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))
	PJRST	NPRSNA			;Go look for SNA-Workstations

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
	$CALL	SENDIT
	MOVE	S2,NODE6B		;Get the node we asked for
	CAMN	S2,[-1]			;Did we ask for all nodes?
	PJRST	NPRSNA			;Go look for SNA-Workstations
	$RETT				;No, we are finished
	SUBTTL	NPRSNA - ROUTINE TO DISPLAY SNA-WORKSTATION NETWORK PARAMETERS

NPRSNA:	SETOM	JOBNBR			;SET NODE COUNT TO -1
	LOAD	P1,HDRNET##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY

NPRS.1:	JUMPE	P1,NPRS.5		;NO MORE,,GO FINISH UP
	MOVE	S1,NETCOL(P1)		;GET THIS NODES NAME/NUMBER
	PUSHJ	P,CMPNOD		;IS IT ONE WE WANT ???
	JUMPF	NPRS.3			;NO,,TRY NEXT
	MOVE	S1,NETCOL(P1)		;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),NETSNA	;GET THIS ONES TYPE DESIGNATION
	JUMPE	S1,NPRS.3		;NOT SNA,,SKIP THIS STUFF
	AOSG	JOBNBR			;BUMP NODE COUNT.
	PUSHJ	P,NPSHDR		;FIRST TIME,,SET UP THE HEADER
	PUSHJ	P,CHKLIN		;Check to see if next line fits
	$TEXT	(DEPBYT,<^T11/NETASC(P2)/  ^W9/NETGWY(P2)/  ^T11/NETACC(P2)/^A>)
	LOAD	T1,NETNAB(P2),NA.ADR	;Get the NAB address
	JUMPE	T1,NPRS.2		;Continue on if none
	$TEXT	(DEPBYT,<  ^T11/NABPLU(T1)/  ^T7/NABCIR(T1)/  ^T10/NABLOM(T1)/^A>)
	MOVE	T2,NABCHS(T1)		; Start of character set
	SKIPE	T2			; Skip if node specified
	$TEXT	(DEPBYT,<^M^J   Character set: ^T/NABCHS(T1)/^A>)

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

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

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

NPRS.6:	CAIN	S1,1			;IS THERE 1 NODE ???
	$ASCII	(<There is 1 SNA-Workstation defined in the network>)
	CAILE	S1,1			;IS THERE MORE THEN 1 ???
	$TEXT(DEPBYT,<There are ^D/JOBNBR/ SNA-Workstations 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        Port Line Trans  CSD   RPM   BPM  Timeout>) 
	PUSHJ	P,CRLF			;END THE LINE
	$ASCII	(<-------------- ----------------- ---- ---- ----- ----- ----- ----- ------->) 
	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN

;
; Header for SNA-Workstations
;

NPSHDR:	MOVEI	S1,[ASCIZ/ SNA Workstation Parameters /] ;GET THE HEADING.
	PUSHJ	P,SETPAG		;SET UP AN OUTPUT PAGE.
	PUSHJ	P,CRLF			;OUTPUT A CRLF.
	$ASCII	(<Workstation   Gateway   Access Name  Application  Circuit  Logon Mode>)
	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
	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),NETSNA	; Is it an SNA Workstation?
	SKIPE	S1			;  No, go try others
	$TEXT	(DEPBYT,< (SNA Workstation)^A>)  ;  Yes, put out SNA indication
	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)		;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	S1,.UCBVS(P1)		;GET VSL ADDRESS JUST IN CASE
	JRST	STAP.5			;NO OWNER,,SKIP THIS
	MOVE	AP,.VSMDR(S1)		;GET THE OWNER MDR ADDRESS
	LOAD	S1,.MRJOB(AP),MD.PJB	;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,<^D6R /.QERID(S2)/ ^I/MNTUSR/ ^15/.MRFLG(AP),MR.QUE/^A>)
	TXNN	S1,BA%JOB		;OWNED BY A NORMAL REQUEST ???
	$TEXT(DEPBYT,<^D6R /.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,<^W7/.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)/ ^W5R/.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
	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>
	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	S1,0(P2)		;AIM AT THE VSL
	SKIPN	S1,.VSMDR(S1)		;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),MD.PJB	;Get the job number
	TXZN	S2,BA%JOB		;PSEUDO PROCESS ???
	JRST	SUSR.2			;NO,,SKIP THIS
	$TEXT	(<-1,,G$MSG>,< (^15/.MRFLG(P4),MR.QUE/^0)>) ;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
>;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)
	$STOP	(NUV,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>) ;START THE HEADING
	SKIPE	REMOTE			;ANY VOLUMES MOUNTED ???
	$ASCII	(<  Write  Volume>)	;YES,,ADD TO THE HEADER
	SKIPE	ACTIVE			;ANY VOLUME OWNED ???
	$ASCII	(<  Job#          User>)	;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
	SKIPE	ACTIVE			;ANY OWNED VOLUMES
	$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:	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	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
TOPS20<	PUSHJ	P,SMTDEN >		;DISPLAY DENSITY
	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.8			;NO REQUESTS,,RETURN NOW
	SETOM	QEMPTY			;INDICATE THE QUEUES ARE NOT EMPTY
	SKIPN	LISTYP			;IS THIS A FAST LISTING ???
	JRST	SMNT.8			;YES,,SKIP THIS

	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>) ;YES,,SAY SO
	PUSHJ	P,CRLF			;OUTPUT A CRLF
SMNT.8:	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
	TXNN	P1,VL.ASN		;DOES THE USER HAVE IT MOUNTED ???
	JRST	SMTS.1			;NO,,MAKE IT WAITING
	LOAD	T1,.VLFLG(P2),VL.STA	;GET THE VOLUME STATUS
	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
	CAXN	T1,%STAWT		;IS IT 'WAITING' ???

SMTS.1:	$ASCII	(<Waiting   >)		;YES,,SAY SO
	POPJ	P,			;RETURN


; MOUNT display type output
;
SMTTYP:	LOAD	T1,.VSFLG(P1),VS.TYP	;GET THE VOLUME-SET TYPE
	CAXN	T1,%TAPE		;IS IT 'TAPE' ???
	$ASCII	(<Tape  >)		;YES
	CAXE	T1,%DSMT		;IS IT A STRUCTURE DISMOUNT ???
	CAXN	T1,%DISK		;OR IS IT 'DISK' ???
	$ASCII	(<Disk  >)		;YES
	CAXE	T1,%DTAP		;IS IT DECTAPE ???
	CAXN	T1,%UNKN		;OR 'UNKNOWN' DEVICE ?
	$ASCII	(<      >)		;YES,,JUST PUT OUT BLANKS
	$RETT				;RETURN


; MOUNT display tape density
;
TOPS20<
SMTDEN:	LOAD	T1,.VSFLG(P1),VS.TYP	;GET VOLUME SET TYPE
	CAXE	T1,%TAPE		;IS IT TAPE?
	JRST	[$ASCII (<      >)	;NO, OUTPUT BLANKS
		$RETT]			;AND RETURN
	LOAD	S1,.VSATR(P1),VS.DEN	;GET POINTER TO DENSITY
	$TEXT	(DEPBYT,<^T4/@DENSTY(S1)/  ^A>) ;OUTPUT DENSITY
	$RETT
> ; End of TOPS20

; 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),MD.PJB	;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),VS.RID/  ^D4R /S1/  ^T20/G$MSG/ ^15/.MRFLG(AP),MR.QUE/>)
	POPJ	P,			;RETURN

SMTD.1:	$TEXT	(DEPBYT,<^D6R /.VSRID(P1),VS.RID/  ^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

	CAXN	T1,%DISK		;STRUCTURE ???
	JRST	SMNA.1			;YES,,SKIP THIS
	CAXN	T1,%TAPE		;MAGTAPE ?
	JRST	[
		 MOVE T1,LISTYP		;Get volume set name
		 JUMPLE T1,SMNA.1 	;Only if all
		 LOAD T1,.VSFLG(P1),VS.LBT ;Get the label type
		 CAIN T1,%UNLBL		;Unlabeled?
		 $TEXT (DEPBYT,<   Volume-set: ^T/.VSVSN(P1)/  Tape is unlabeled>)
		 CAIE T1,%UNLBL		;Labeled?
		 $TEXT (DEPBYT,<   Volume-set: ^T/.VSVSN(P1)/    Tape is labeled>)
		 $TEXT (DEPBYT,<   Volumes in this set:  ^A>)	
		 LOAD  T1,.VSCVL(P1),VS.CNT	;Number of volumes in set
		 MOVEI T3,.VSVOL(P1)		;Get current VOL adr.
		 ADD   T3,T1			;Point to 1st vol. name
		 $TEXT (DEPBYT,<^W9/.VLNAM(T3)/^A>)	;Print it
		 SOJLE T1,LSTVL3		;Finished if no more vols
		 SUB   T3,T1			;Point to 2nd VOL adr.
		 IMULI T1,-1			;Make it into a
		 HRLZ  T1,T1			;AOBJN counter
		 HRR   T1,T3			;Finish the AOBJN counter
		 MOVEI T2,VOLLIN-1		;Max number of vol/line
LSTVL1:		 MOVE  S1,0(T1)			;Get its address
		 $TEXT(DEPBYT,<^W9/.VLNAM(S1)/^A>)	
		 SOJG  T2,LSTVL2		;Any room left?
		 MOVEI T2,VOLLIN		;Reset max. number
		 $TEXT(DEPBYT,<                                   ^A>)
LSTVL2:		 AOBJN T1,LSTVL1		;Get the next name
LSTVL3:		 $TEXT(DEPBYT,< >)		;Leave this line
		 JRST  SMNA.1  ]	;AND SKIP THIS
TOPS10<
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,I$CGEN##		;GET TRANSLATION INDEX
	$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.SCR!VS.NEW	;ARE THE SCRATCH OR NEW BITS 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		;YES
	$TEXT	(DEPBYT,<   Initialize new tape with volume-id: ^W/.VLNAM(P2)/ protection: ^O3/.VSATR(P1),VS.PRT/>)
> ;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
	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
TOPS10<
	$ASCII	(<Volume    Status   Type   Write    Req#   Job#          User>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$ASCII	(<-------  --------  ----  -------  ------  ----  ------------------->)
> ;End of TOPS10
TOPS20<
	$ASCII	(<Volume    Status   Type  Dens   Write    Req#   Job#          User>)
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$ASCII	(<-------  --------  ----  ----  -------  ------  ----  ------------------->)
> ;End of TOPS20
	PUSHJ	P,CRLF			;OUTPUT A CRLF
	$RETT				;AND RETURN
	SUBTTL	SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.

SHOWQS:	$SAVE	H			;SAVE H
	STORE	H,HDRSAV		;HERE ALSO.
	MOVSI	S1,120000		;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	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,SHOW.6		;NO MORE,,FINISH UP.
	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.

	;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
	CAIN	T1,1			;JUST 1 JOB PROCESSED ???
	$ASCII	(<There is 1 job in the queue>) ;YES,,SAY SO.
	CAIE	T1,1			;MORE THEN 1 JOB ???
	$TEXT	(DEPBYT,<There are ^D/T1/ jobs in the queue^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,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
	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:	SKIPE	NOROOM			;IS THERE STILL ROOM IN THE OUTPT PAGE ?
	PUSHJ	P,PAGOVF		;NO,,KLEEN UP A BIG MESS.
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE OBJECT (QUEUE) TYPE.
	MOVEM	S1,OBTYPE		;SAVE IT FOR LATER USE.
	PUSHJ	P,@DEPDEV(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			;NO,,END NOW
	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
	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,<^D3R /S1/:^D3L /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
	SKIPN	ATTRIB			;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:	PUSHJ	P,CRLF			;END THE LINE
	$RETT				;AND RETURN

SHPA.1:	LOAD	S1,OBJSCH(T1),OBSSNA	; Is this for SNA Workstation?
	 JUMPE	S1,SHPA.2		;  No, continue on
	PUSHJ	P,.SAVE1		;  Yes, save P1
	MOVE	P1,T1			; Save object address in P1
	MOVE	S1,OBJNOD(T1)		; Get the node name
	PUSHJ	P,N$NODE##		; Find data base entry
	MOVE	S1,NETNOB(S2)		; Get NOB list index
	PUSHJ	P,FNDNOB##		; Get the NOB
	 SKIPF				; Failed?
	PUSHJ	P,DSPDST		; Go display destination field
	MOVE	T1,P1			; Restore object address
	PJRST	P,CRLF			; Finish off line and return
	
SHPA.2:	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
	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
	PJRST	CRLF			     ;END THE LINE & RETURN
	SUBTTL DSPDST - DISPLAY SNA PRINTER / PUNCH DESTINATION PARAMETER

;	S1/ address of object entry in NOB list

DSPDST:	$TEXT	(DEPBYT,<  Destination: ^A>)
	MOVEI	S2,NOBDST(S1)		; Address of destination string
	HRLI	S2,(POINT 7)		; Make it a pointer
DSP.1:	ILDB	S1,S2			; Get a byte
	JUMPE	S1,.RETT		; If null, all done
	$CALL	DEPBYT			; Move to message
	CAIE	S1,""""			; See if quote
	JRST	DSP.1			; Keep looking for a "
					; Start of acess string found
DSP.2:	ILDB	S1,S2			; Get a byte
	JUMPE	S1,.RETT		; If null, all done
	$CALL	DEPBYT			; Move to message
	CAIE	S1," "			; See if space
	JRST	DSP.2			; Keep looking for a space
	$TEXT	(DEPBYT,<password"^A>)	; Fill in password field
DSP.3:	ILDB	S1,S2			; Get a byte
	JUMPE	S1,.RETT		; If null, all done
	CAIE	S1,""""			; See if quote
	JRST	DSP.3			; Keep looking for a quote
	$TEXT	(DEPBYT,<^Q/S2/^A>)	; Finish off string
	$RET
	SUBTTL DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.

DEPOUT:	SKIPN	KLUDGE			;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.
	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
	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			;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.
	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/  ^D4R /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
	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
	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
	LOAD	S1,.QEOID(AP)		;GET REQUEST ID USER NUMBER
	CAMN	S1,G$SID##		;MATCH THE GLOBAL SENDER
	JRST	DEP.1			;YES, OK TO SHOW FILES
	PUSHJ	P,A$WHEEL##		;DOES USER HAVE PRIVILEGES
	JUMPF	.RETT			;NO, THEN NO FILES
DEP.1:	$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
	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	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
	HRRZ	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:	MOVE	S2,BYTPTR		;Pick up the byte pointer
	ILDB	S1,S2			;Pick up the last character
	CAIN	S1,11			;Is it a TAB?
	SETZM	S1			;Yes, change to a NULL
	DPB	S1,S2			;And replace
	HRRZ	S1,BYTPTR		;Get final message address.
	SUB	S1,DATADR		;SUBTRACT THE START ADDRESS.
	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
	SKIPE	JOBACT			;IS THE JOB ACTIVE ???
	$TEXT	(DEPBYT,<  In 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
	SETOM	S2			;INDICATE NO DEVICE SPECIFIED
	CAIN	S1,%PHYCL		;WAS 'PHYSICAL' SPECIFIED?
	LOAD	S2,.QEROB+.ROBAT(AP),RO.UNI ;YES,,GET THE UNIT NBR
	SKIPE	JOBACT			;IS THE JOB ACTIVE
	LOAD	S2,OBJUNI(P3)		;YES,,GET THE DEVICE NUMBER.
	SKIPGE	S2			;DO WE HAVE ANYTHING ???
	JRST	DMP.1A			;NO,,SKIP THIS
	SKIPN	JOBACT			;IS THE JOB ACTIVE ???
	$TEXT	(DEPBYT,<  /Unit:^D/S2/^A>) ;NOT ACTIVE,,SAY SO
	SKIPE	JOBACT			;CHECK JOB ACTIVE AGAIN.
	$TEXT	(DEPBYT,<  On Unit:^D/S2/^A>) ;IS ACTIVE,,SAY SO
	JRST	DMPS.2			;AND CONTINUE ON
DMP.1A:	CAIN	S1,%LOWER		;WAS IT LOWER??
	$ASCII	(<  /Lower>)		;YES,,SAY SO
	CAIN	S1,%UPPER		;WAS IT /UPPER??
	$ASCII	(<  /Upper>)		;YES,,SAY SO

DMPS.2:	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
	MOVEI	S1,.QEROB(AP)		;GET THE REQ OBK BLK ADDRESS
	SETZM	S2			;NO OBJECT MATCH
	PUSHJ	P,N$CSTN##		;PERFORM ANY ROUTING
	PUSHJ	P,N$LOCL##		;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:	DMOVE	S1,LASTPT		;GET THE LAST BYTPTR AND BYTCNT
	SKIPE	CRLFLG			;ARE WE STILL AT THE START OF THE LINE
	DMOVEM	S1,BYTPTR		;YES,,RESET THE BYTPTR AND BYTCNT
	SKIPN	CRLFLG			;SKIP IF WE DONT NEED A CRLF
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
	SETOM	LSTDND			;ALL DESTINATION NODES
	SETOM	LSTPND			;ALL PROCESSING NODES
	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.
	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
	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,.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 someone 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			;SAY NO 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			;FLAG KLUDGE
	$RETT				;AND RETURN
	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
	END