Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11m-bm - galsrc/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, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	QSRMAC,GLXMAC,ORNMAC
	SEARCH	NEBMAC			;[31]SEARCH NEBULA'S SYMBOLS
	PROLOG	(QSRDSP)

	DSPMAN==:60			;Maintenance edit number
	DSPDEV==:52			;Development edit number
	VERSIN (DSP)			;Generate edit number
	Subttl	Table of Contents

;		     Table of Contents for QSRDSP
;
;				  Section		      Page
;
;
;    1. Revision history . . . . . . . . . . . . . . . . . . .   3
;    2. LOCAL STORAGE AND BRANCH TABLES  . . . . . . . . . . .   4
;    3. ROUTINE DATA AREAS AND ITEXT STATEMENTS. . . . . . . .   5
;    4. D$LIST - ROUTINE TO PROCESS THE SHOW QUEUES REQUEST. .   8
;    5. D$SHST - ROUTINE TO SHOW DEVICE STATUS.  . . . . . . .   9
;    6. EXPTIM - Expand time . . . . . . . . . . . . . . . . .  10
;    7. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCKS . . . . . .  11
;    8. SHOW STATUS/PARAMETERS MESSAGE HEADING ROUTINE . . . .  13
;    9. CHKQUE - ROUTINE TO SCAN AND SET UP OBJECT HEADERS . .  14
;   10. D$SHRT - ROUTINE TO DISPLAY THE ROUTE TABLE. . . . . .  16
;   11. D$NPRM - ROUTINE TO DISPLAY THE NETWORK (DN60) PARAMET  17
;   12. NPRSNA - ROUTINE TO DISPLAY SNA-WORKSTATION NETWORK PA  18
;   13. NPRHDR - NETWORK PARAMETER HEADER ROUTINE  . . . . . .  19
;   14. D$NSTS - DISPLAY NETWORK STATUS (ONLINE/OFFLINE) . . .  20
;   15. D$STAP - SHOW STATUS OF TAPE DRIVES  . . . . . . . . .  22
;   16. D$SDSK - SHOW STATUS OF DISK DRIVES  . . . . . . . . .  24
;   17. GETDSK - ROUTINE TO RETURN THE FIRST/NEXT DISK UCB ADD  27
;   18. D$SSTR - SHOW STATUS OF FILE STRUCTURE . . . . . . . .  28
;   19. GETSTR - Get a primary file structure block  . . . . .  31
;   20. STRHDR - Type a header line for SHOW STATUS STRUCTURES  32
;   21. TAPHDR - ROUTINE TO PUT OUT THE TAPE STATUS DISPLAY HE  33
;   22. DSKHDR - ROUTINE TO PUT OUT DISK STATUS DISPLAY HEADER  34
;   23. D$SMNT - ROUTINE TO DUMP THE MOUNT QUEUES  . . . . . .  35
;   24. SHOWQS - ROUTINE TO DUMP THE INDIVIDUAL QUEUES.  . . .  39
;   25. PUTOUT - ROUTINE TO OUTPUT THE QUEUES LISTING. . . . .  41
;   26. SHSTAT - ROUTINE TO PROCESS STATUS INFO FOR SHOW STATU  42
;   27. SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM CO  43
;   28. DSPDST - DISPLAY SNA PRINTER / PUNCH DESTINATION PARAM  44
;   29. DEPLPT - LINE PRINTER QUEUE ENTRY PROCESSING ROUTINE.   45
;   30. DEPRET - ROUTINE TO PROCESS RETRIEVAL QUEUE ENTRYS.  .  46
;   31. D$SALC - SHOW ALLOCATION . . . . . . . . . . . . . . .  47
;   32. Find a VSN given a resource number . . . . . . . . . .  50
;   33. SETPAG - ROUTINE TO SET UP AN ACK IPCF PAGE. . . . . .  52
;   34. SENDIT - END-OF-MESSAGE PROCESSING ROUTINE.  . . . . .  53
;   35. SNDNEB - Send a message to NEBULA  . . . . . . . . . .  54
;   36. DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO . . . . . .  55
;   37. PADLIN - ROUTINE TO PAD THE QUEUE LISTING LINE . . . .  57
;   38. GETPARMS = ROUTINE TO PROCESS THE INPUT BLOCKS IN A SH  58
;   39. REMLIS - Reformat a LIST message to be forward remotel  59
;   40. UTILITY ROUTINES . . . . . . . . . . . . . . . . . . .  60
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.

*****  Release 5.0 -- begin maintenance edits  *****

20	Increment maintenance edit level for GALAXY 5.

*****  Release 6.0 -- begin development edits  *****

25	6.1043		29-Oct-87
	Add support to the SHOW STATUS PRINTER and SHOW PARAMETERS PRINTER
commands for remote printers.

26	6.1051		3-Nov-87
	Change OUTHDR to pick up the object type for the SHOW QUEUES display
from word OBTYPE instead of word OBJTYP.

27	6.1060		6-Nov-87
	Place the user name on a separate line for the SHOW STATUS PRINTER DQS
command.

30	6.1097		22-Nov-87
	Use the $QACK and $QWTO macros instead of the $ACK and $WTO macros
for sending .OMACK and .OMWTO messages.

31	6.1101		23-Nov-87
	Add a remote node name display block to responses to SHOW messages
that originated on a remote node in the cluster. Make the message type
of such responses .NMACS rather than .OMACS.

32	6.1106		1-Dec-87
	In routine SNDMSG: change the MOVEI to MOVX.  It was accidently
changed.

33	6.1110		1-Dec-87
	Change CHKQUE to always display the header line for non-LPT objects.
Also, correct the header underline to match the header words when a LAT
object is active.

34	6.1123		6-Dec-87
	Indicate to routine N$CSTN by word G$DEFL to make node name 
comparisions.

35	6.1138		13-Dec-87
	Fix bugs found while debugging NEBULA.

36	6.1156		4-Jan-88
	Correct the Req# and User header fields for LAT printers

37	6.1172		27-Jan-88
	Change routine DMPSTS to correctly display active print jobs whose
LPT objects have been routed.

40	6.1173		28-Jan-88
	Add the Forms field for LAT printer displays.

41	6.1175		7-Feb-88
	Add support for the INFORMATION OUTPUT/DESTINATION command.

42	6.1177		11-Feb-88
	Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.

43	6.1178		11-Feb-88
	Call routine N$NODE to set up the display of the node name for
active jobs.

44	6.1181		15-Feb-88
	Fix some bugs found while debugging remote INFO OUTPUT requests
against a private EXEC.

45	6.1183		16-Feb-88
	Reject a CANCEL PRINT/DESTINATION request if Cluster GALAXY is not
enabled.

46	6.1185		17-Feb-88
	If an unprivileged user has specified the INFO OUTPUT/DESTINATION
command, then cause routine REMLIS to set up the call to the DIRST% correctly.

47	6.1190		19-Feb-88
	Add the characteristics of TTY: and LAT printers to the SHOW PARAMETERS
PRINTER display.

50	6.1225		8-Mar-88
	Update copyright notice.

51	6.1258		20-May-88
	Orthogonalize the building of the SHOW STATUS and SHOW PARAMETERS
displays among the various types of objects for ease of maintainability.

52	6.1259		31-May-88
	Edit 51 was missing 3 lines of code in routine SHWPAR which includes
the stream numbers for SHOW PARAMETERS BATCH.

*****  Release 6.0 -- begin maintenance edits  *****

53	6.1262		20-Jun-88
	BPN crashes resulting from SHOW STATUS and PARAMETER commands will
have displays over a page long.  Also, add 5 lines in SHST.1 to include the
node name for remote batch streams.

54	6.1289		29-Nov-89
	Declare location G$NULA as external. This location is used by the
$Qxxx macros.

55	6.1294		23-Dec-89
	In CHKOBJ check for all object types ("-1") before checking for remote
printer types.

56	6.1296		25-Dec-89
	Add support for local printer commands that include the /NODE switch.

57	6.1306		31-Jan-90
	Change the SHOW QUEUE/USER commands to expect as an argument the
user name rather than the user public structure directory number. This is
in support of the /CLUSTER-NODE switch in which the remote node has a 
different public structure than the local node.

60	6.1318		3-Jun-90
	Add support for alias printers.

\   ;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
SERNAM: BLOCK	1		;[25]LAT SERVICE NAME HAS BEEN SEEN FLAG
ALLLPT: BLOCK	1		;[25]INCLUDE ALL LPT TYPES IN DISPLAY
LPTHDR: BLOCK	1		;[25]PRINTER HEADER PRINTED
REMMSG:	BLOCK	1		;[31]SECOND PAGE DISPLAY BLOCK INCLUDE FLAG
PIDBLK:	BLOCK	1		;[41]PID OF THE REMOTE SENDER
USRNAM:	BLOCK	1		;[41]POINTER TO THE REMOTE USER NAME
REMUSR:	BLOCK	1		;[41]MESSAGE IS IN BEHALF OF A REMOTE USER
;**;[60]At REMUSR:+1L add 1 line  PMM  6/3/90
AKHEAD: BLOCK   1		;[60]Printer alias header flag (-1=Yes, 0=No)
JOBAKA: BLOCK	1		;[60]SIXBIT alias name


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
	EXTERN	G$REMN		;[30]REMOTE NODE NAME WHERE MSG CAME FROM
	EXTERN	G$NEBF		;[30]REMOTE MESSAGE FLAG
;**;[54]At EXTERN G$NEBF add 1 line  JCR  11/29/89
	EXTERN	G$NULA		;[54]Required by the $Qxxx macros

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 ..
;**;[60]At D$LIST:+6L add 1 line    PMM   6/3/90
	SETZM	AKHEAD			;[60]Indicate no alias header
	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.

	SKIPE	G$NEBF			;[41]MESSAGE ORIGINATE REMOTELY?
	JRST	LIST3A			;[44]YES, SO IGNORE THE FOLLOWING 
	SKIPN	PIDBLK			;[41]IS THERE A PID BLOCK IN THE MSG?
	JRST	LIST.3			;[41]NO, SO LOCAL AND DON'T FORWARD

	MOVEI	S1,.ORNOD		;[41]PICK UP THE NODE NAME BLOCK CODE
	$CALL	A$FNDB##		;[41]FIND THE NODE NAME BLOCK
	JUMPF	E$ILM##			;[41]ILLEGAL LIST MESSAGE
	MOVE	S2,0(S1)		;[41]PICK UP THE NODE NAME
	CAME	S2,G$LNAM##		;[41]LOCAL NODE NAME SPECIFIED?
	JRST	LIST.0			;[41]NO, SO  FORWARD THE REQUEST
	SETZM	PIDBLK			;[41]INDICATE A LOCAL REQUEST
	JRST	LIST.3			;[41]TREAT AS A LOCAL REQUEST

LIST.0:	
SINGLE<	PJRST	E$CNE##>		;[45]QUIT IF CLUSTER GALAXY NOT ENABLED
	SOS	S1			;[41]ADDRESS OF THE NODE BLOCK
	MOVEI	S2,.NDENM		;[41]PICK UP REMOTE NODE NAME BLK CODE
	STORE	S2,ARG.HD(S1),AR.TYP	;[41]UPDATE THE BLOCK TYPE

	SKIPE	G$NEBP			;[41]IS NEBULA'S PID KNOWN?
	JRST	LIST.1			;[41]YES, SO DON'T PICK IT UP
	$CALL	A$NPID##		;[41]]PICK UP NEBULA'S PID
	JUMPF	LIST.2			;[41]IF FALSE, NEBULA'S NOT RUNNING

LIST.1:	$CALL	REMLIS			;[41]REFORMAT THE MESSAGE FOR NEBULA
	$RETIF				;[41]RETURN ON AN ERROR
	$CALL	SNDNEB			;[41]FORWARD THE MESSAGE TO NEBULA
	$RETT				;[44]AND RETURN

LIST.2:	MOVX	S1,MF.NOM		;[44]INDICATE A NULL ACK
	SKIPE	G$ACK##			;[41]AN ACK REQUESTED?
	PUSHJ	P,G$MSND##		;[41]YES, SEND A NULL ACK

	MOVEI	S1,[ASCIZ/ System Queues Listing /] ;[41]PICK UP HEADER ADR
	$CALL	SETPAG			;[41]SET UP THE MESSAGE PAGE
	$ASCII	(<[Unable to obtain output queue listing - node not reachable]>)
	$CALL	CRLF			;[41]END THE LINE
	$CALL	SENDIT			;[41]SEND THE MESSAGE TO THE USER
	$RETT				;[41]RETURN 

LIST.3:	MOVX	S1,MF.NOM		;[44]INDICATE A NULL ACK
	SKIPE	G$ACK##			;[41]AN ACK REQUESTED?
	PUSHJ	P,G$MSND##		;[41]YES, SEND A NULL ACK
	SKIPA				;[44]G$ACK ALREADY ZEROED
LIST3A:	SETZM	G$ACK##			;[44]DON'T SEND AN ACK ON RETURN
	TXNE	P1,LIQMNT		;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.4:	TDNE	P1,.QHLIS(H)		;[41]DOES HE WANT THIS QUEUE?
	PUSHJ	P,SHOWQS		;YES,,DUMP IT.
	ADDI	H,QHSIZE		;POINT TO THE NEXT QUEUE.
	SOJG	P2,LIST.4		;[41]AND TRY THE NEXT ONE.
	$COUNT	(NLAP)			;COUNT PAGES SENT
	SKIPN	QEMPTY			;ARE THE QUEUES EMPTY ???
	JRST	LIST.5			;[41]YES, PROCESS A LITTLE DIFFERENTLY
	PUSHJ	P,CRLF			;END WITH A CRLF
	PUSHJ	P,SENDIT		;SEND THE LAST PAGE.
	$RETT				;RETURN.

LIST.5:	SKIPE	ENTYPE			;[41]WAS THIS AN USER REQUEST?
	JRST	LIST.6			;[41]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.6:	$QACK	(<The queues are empty>,,,ACKCOD) ;[41]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,.SAVET		;SAVE THE T ACS.
	SETOM	ENTYPE			;INDICATE 'OPERATOR' MESSAGE
	SETZM	QEMPTY			;INDICATE NO OBJECTS FOUND
	SETZM	OBTYPE			;ZERO THE OBJECT TYPE.
	SETOM	SERNAM			;[25]INDICATE NO LAT SERVICE OBJECTS
;**;[53]At D$SHST:+7L add 2 lines JYCW 6/20/88
	SETZM	NOROOM			;[53]Clear no more room indicator
	SETZM	BYTPTR			;[53]Indicate no output page yet ..
	PUSHJ	P,GETPARMS		;GO BREAK DOWN THE MESSAGE
	SKIPN	S1,OBJADR		;[25]MAKE SURE WE GOT AN OBJECT BLOCK
	$RETT				;NONE THERE,,THATS AN ERROR

	SETZM	ALLLPT			;[51]ASSUME INCLUDE ONLY SPECIFIC LPTS
	SETOM	LPTHDR			;[25]NO HEADER PRINTED YET
	MOVE	S2,OBJ.TY(S1)		;[25]PICK UP THE OBJECT TYPE FROM MSG
	CAIE	S2,.OTLPT		;[25]IS THIS MESSAGE FOR ALL LPTS?
	JRST	STPR.0			;[25]NO, PICK UP FIRST OBJECT ENTRY
	SKIPGE	OBJ.UN(S1)		;[25]IS IT REALLY FOR ALL LPT TYPES?
	SETOM	ALLLPT			;[25]YES, INDICATE SO

STPR.0:	LOAD	T1,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJ QUEUE ENTRY.

STPR.1:	JUMPE	T1,STPR.8		;[25]NO MORE,,RETURN.
	LOAD	T2,OBJTYP(T1)		;GET THE OBJ TYPE.
	JUMPLE	T2,STPR.7		;[25]NOT VALID,,TRY NEXT.
	PUSHJ	P,CHKOBJ		;DO WE WANT THIS OBJECT ???
	JUMPF	STPR.7			;[25]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 ???
	JRST	STPR.2			;[25]YES, SCAN FOR ACTIVE/REMOTE 
	LOAD	S1,OBJNAM(T1),AR.TYP	;[25]PICK UP THE REMOTE NAME TYPE
	CAIE	S1,.KYSER		;[25]A LAT SERVICE NAME?
	JRST	STPR.3			;[51]NO, CHECK IF SHOW STATUS OR NOT
	AOSN	SERNAM			;[25]IS THIS THE FIRST LAT SERVICE?
STPR.2:	PUSHJ	P,CHKQUE		;[25]YES,  SCAN FOR ACTIVE/REMOTE STAT
STPR.3:	SKIPN	SHWTYP			;[51]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.7:	LOAD	T1,.QELNK(T1),QE.PTN	;[25]GET NEXT OBJ QUEUE ENTRY.
	JRST	STPR.1			;GO PROCESS IT.

STPR.8:	SKIPN	S1,QEMPTY		;[25]WAS ANYTHING PUT OUT?
	JRST	STPR.9			;[25]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.9:	MOVE	S1,OBJADR		;[25]GET THE OBJECT BLOCK ADDRESS
	SKIPGE	S2,OBJ.UN(S1)		;[25]IS IT FOR ALL UNITS?
	JRST	STPR10			;[25]YES, INDICATE SO
	CAIE	S2,.KYPOR		;[25]IS LAT PORT KEYWORD SPECIFIED?
	CAIN	S2,.KYSER		;[25]NO, IS IT LAT SERVICE KEYWORD?
	SKIPA				;[25]LAT PORT OR SERVICE SPECIFIED
	JRST	STPR11			;[25]NO, SEND A SPECIFIC MESSAGE
STPR10:	$QACK	(<There are no devices started>,,,ACKCOD) ;YES,,TELL THE OPR
	$RETT				;AND RETURN

STPR11:	HRRZS	OBJ.UN(S1)		;[25]CHECK THAT THERE IS NO HIGH RANGE
	MOVE	S2,OBJ.TY(S1)		;[25]PICK UP THE OBJECT TYPE
;**;[56]At STPR11:+2L replace 3 lines  with 8 lines  JCR  12/25/89
	TXNN	S2,.LOLPT		;[56]Is it a local LPT?
	JRST	STPR12			;[56]No, go send the ACK
	HRRZS	OBJ.TY(S1)		;[56]Yes, keep only the object code
	SETO	S2,			;[56]Set for all nodes
	CAMN	S2,OBJ.ND(S1)		;[56]For all nodes?
	SETZM	OBJ.ND(S1)		;[56]Yes, default to the local node

STPR12:	$QACK	(<Device unknown>,,0(S1),ACKCOD) ;[56]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
;**;[55]At CHKOBJ:+8L replace 1 line with 2 lines  JCR  12/23/89
	MOVE	S1,OBJ.TY(S2)		;[55]Pick up object type
	CAMN	S1,[-1]			;[55]"-1" matches all object types
	JRST	CHKOBB			;[25]CHECK THE UNITS
	CAMN	S1,OBJTYP(T1)		;COMPARE AGAINST OBJ Q ENTRY
	JRST	CHKOBB			;[25]CHECK THE UNITS
	CAIE	S1,.OTLPT		;[25]A LPT SPECIFIED IN THE MESSAGE?
	JRST	CHKOBA			;[25]NO, CHECK FOR A LOCAL LPT
	MOVE	S1,OBJTYP(T1)		;[25]PICK UP THE OBJECT TYPE
	TXNN	S1,.DQLPT!.LALPT!.CLLPT	;[25]IS THIS A REMOTE LPT OBJECT?
	$RETF				;[25]NO, DON'T INCLUDE THIS OBJECT
	SKIPL	ALLLPT			;[25]INCLUDE ALL LPT OBJECTS?
	$RETF				;[25]NO, DON'T INCLUDE THIS OBJECT
	JRST	CHKOBB			;[25]CHECK THE UNITS
CHKOBA:	CAME	S1,[.LOLPT!.OTLPT]	;[25]IS THIS A LOCAL LPT (SHOW COMMAND?)
	$RETF				;[25]NO, DON'T INCLUDE THIS OBJECT
	HRRZS	S1			;[25]ISOLATE THE OBJECT TYPE
	CAME	S1,OBJTYP(T1)		;[25]IS THE OBJECT A LOCAL LPT?
	$RETF				;[25]NO, RETURN NOW
CHKOBB:	SKIPL	S1,OBJ.UN(S2)		;[25]CHECK THE MSG UNIT #,,-1 WINS
	CAMN	S1,OBJUNI(T1)		;COMPARE AGAINST OBJ Q ENTRY
	JRST	CHKO.1			;[25]MATCH, CONTINUE ON
	CAIE	S1,.KYPOR		;[25]IS THIS A LAT PORT?
	CAIN	S1,.KYSER		;[25]NO, A LAT SERVICE?
	SKIPA				;[25]YES TO EITHER
	JRST	CHKO.0			;[25]NO CHECK THE UNITS RANGE
	LOAD	T3,OBJNAM(T1),AR.TYP	;[25]PICK UP THE OBJECT'S NAME TYPE
	CAME	S1,T3			;[25]ARE THEY THE SAME?
	$RETF				;[25]NO, INDICATE NO MATCH
	JRST	CHKO.1			;[25]CHECK THE NODE NAMES

;Check for within the range.

CHKO.0:	LOAD	S1,OBJ.UN(S2),OU.HRG	;[25]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.1:	PUSHJ	P,.SAVE1		;[25]SAVE P1 FOR A SECOND
	MOVE	S1,OBJNOD(T1)		;GET THE OBJECTS NODE NAME
	PUSHJ	P,N$NODE##		;FIND ITS ENTRY IN OUR DATA BASE
	MOVE	P1,S2			;SAVE/RETURN THE ADDRESS IN P1
	MOVE	S2,OBJADR		;[25]PICK UP THE OBJECT ADDRESS
	SKIPN	S2,OBJ.ND(S2)		;IF NO NODES,
	JRST	CHKO.2			;[25]WIN,,CHECK FOR DN60 EMULATION
	CAMN	S2,[-1]			;[25]IF ALL NODES,
	JRST	CHKO.2			;[25]THEN GO CHECK THE SCHEDULING BITS
	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

	MOVE	S2,OBJADR		;[25]PICK UP THE OBJECT ADDRESS
	MOVE	S1,OBJ.TY(S2)		;[25]PICK UP THE OBJECT'S TYPE
;**;[55]At CHKO.1:+16L add 2 lines  JCR  12/23/89
	CAMN	S1,[-1]			;[55]Is this for all units?
	JRST	CHKO.2			;[55]Yes, pick up the scheduling bits
	TXNN	S1,.DQLPT!.LALPT	;[25]IS THIS A REMOTE PRINTER?
	JRST	CHKO.2			;[25]NO, PICK UP THE SCHEDULING BITS
	MOVEI	S1,OBJ.SZ(S2)		;[25]PICK UP THE NAME BLOCK ADDRESS
	MOVEI	S2,OBJNAM(T1)		;[25]PICK UP OBJECT'S NAME BLOCK ADR
	$CALL	CHRNME##		;[25]CHECK IF THE NAMES ARE THE SAME
	JUMPF	.POPJ			;[25]NO, INDICATE TO THE CALLER

CHKO.2:	MOVE	S1,OBJSCH(T1)		;GET THE SCHEDULING BITS
	TXNE	S1,OBSSIP+OBSSUP	;IF SIP OR SETUP,,THEN
	JRST	CHKO.3			;   SKIP THIS CODE
	TXNE	S1,OBSSTA		;IF NOT STARTED,,THEN SKIP THIS CODE
	SKIPE	SHWTYP			;OR IF SHOWING PARAMETERS,,THEN
	JRST	CHKO.4			;   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.3			;ALL SET IF THERE WAS ONE
	MOVX	S1,%NOPRC		;GET "NO PROCESSOR" STATUS
	MOVEM	S1,OBJSTS(T1)		;NO - FIX UP STATUS
	JRST	CHKO.4			;CONTINUE

CHKO.3:	MOVE	S1,OBJSTS(T1)		;GET CURRENT STATUS WORD
	CAXE	S1,%NOPRC		;WAS IT "NO PROCESSOR" ?
	JRST	CHKO.4			;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.4:	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.6		; 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.5:	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.6:	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.5			; 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.5
	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
;**;[60]At CHKQUE:+5L add 1 line  PMM   6/3/90
	SETZM	AKHEAD			;[60]Indicate no alias header
	PUSH	P,T1			;SAVE THE CURRENT OBJECT ADDRESS

CHKQ.1:	MOVE	S1,OBJNOD(T1)		;GET THE OBJECT'S 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
;**;[60]At CHKQ.1:+8L add 1 line   PMM   6/3/90
	LOAD	S1,OBJTYP(T1),RHMASK	;[60]Get object type
	CAIE	S1,.OTBAT		;IS IT BATCH ?
	JRST	CHKQ.2			;NO

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

;**;[60]At CHKQ.2:+0L add 8 lines   PMM   6/3/90
CHKQ.2:	CAIE	S1,.OTLPT		;[60]Is this a printer?
	JRST	CHKQ2A			;[60]No, ignore alias processing
	SKIPL	AKHEAD			;[60]Skip, if alias header already set
	SKIPN	S1,OBJALI(T1)		;[60]Is the alias name empty?
	JRST	CHKQ2A			;[60]No, need to check object
	$CALL	CHKOBJ			;[60]Is this object in display?
	SKIPF				;[60]No
	SETOM 	AKHEAD			;[60]Yes, set alias header for later
CHKQ2A:	LOAD	T1,.QELNK(T1),QE.PTN	;GET THE NEXT OBJECT IN THE CHAIN
	JUMPE	T1,CHKQ.3		;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.3:	POP	P,T1			;RESTORE T1 TO ORIGIONAL OBJ ADDRESS
	LOAD	S1,OBJNAM(T1),AR.TYP	;[25]PICK UP REMOTE NAME BLOCK TYPE
	HRRZ	S2,T2			;[25]PICK UP THE OBJECT TYPE
	CAIE	S2,.OTLPT		;[33]IS THIS A LPT OBJECT?
	JRST	CHKQ3A			;[33]NO, SO OUTPUT THE HEADER
	CAIN	S1,.KYSER		;[25]IS IT A SERVICE NAME?
	AOS	SERNAM			;[25]YES, REMEMBER ONE HAS BEEN SEEN
	AOSE	LPTHDR			;[25]HEADER PRINTED ALREADY?
	JRST	CHKQ3B			;[25]YES, DON'T PRINT IT AGAIN
CHKQ3A:	PUSHJ	P,CRLF			;[33]OUTPUT A CRLF
	MOVE	S1,SHWTYP		;GET THE 'SHOW' TYPE
	$TEXT	(DEPBYT,<^1/S2/^T/@STAPAR(S1)/>) ;[25]GEN THE HEADING
CHKQ3B:	CAIE	T2,.OTBAT		;[25]IS THIS BATCH?
	JRST	CHKQ.5			;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	CHKQ.4			;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

CHKQ.4:	$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.5:	$CALL	CRLF			;[51]START A NEW LINE
	CAIE	S2,.OTLPT		;[51]IS THIS A LPT?
	JRST	CHKQ18			;[51]NO, OTHER TYPE OF OUTPUT
	TXNE	T2,.CLLPT		;[51]IS THIS A CLUSTER LPT?
	JRST	CHKQ10			;[51]YES, GO BUILD ITS HEADER
	TXNE	T2,.DQLPT		;[51]IS THIS A DQS LPT?
	JRST	CHKQ12			;[51]YES, GO BUILD ITS HEADER
	TXNE	T2,.LALPT		;[51]IS THIS A LAT LPT?
	JRST	CHKQ14			;[51]YES, GO BUILD ITS HEADER

;Local (or IBM) printer status

	SKIPN	REMOTE			;[51]ANY IBM PRINTERS?
	$ASCII	(<Local printers>)	;[51]NO, SO INDICATE ONLY LOCAL
	SKIPE	REMOTE			;[51]ANY IBM PRINTERS?
;**;[56]At CHKQ.5:+15L change 1 line  JCR  12/25/89
	$ASCII	(<Local/IBM/SNA printers>);[56]Yes, so indicate
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]AT CHKQ.5:+13L add 2 lines  PMM    6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (<  Alias >)		;[60]Output Alias field
	$ASCII	(<  Unit  >)		;[51]OUTPUT THE UNIT FIELD
	SKIPE	REMOTE			;[51]ANY IBM PRINTERS?
	$ASCII	(< Node   >)		;[51]YES, NEED A NODE FIELD
	SKIPE	SHWTYP			;[51]SHOW STATUS?
	JRST	CHKQ.6			;[51]NO, SHOW PARAMETER
	$ASCII	(<    Status       >)	;[51]OUTPUT THE STATUS FIELD
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<Jobname   Req#            User>) ;[51]YES
	$CALL	CRLF			;[51]END THIS LINE
;**;[60]At CHKQ.5:+24L add 2 lines    PMM    6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----  >)		;[51]UNDERLINE THE UNIT FIELD
	SKIPE	REMOTE			;[51]ANY IBM PRINTERS?
	$ASCII	(<------  >)		;[51]YES, UNDERLINE THE NODE FIELD
	$ASCII	(<--------------   >)	;[51]UNDERLINE THE STATUS FIELD
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<-------   ----    --------------------->) ;[51]
	PJRST	CRLF			;[51]END THIS LINE AND RETURN

;Local (or IBM) printer parameters

CHKQ.6:	MOVE	S2,OBTYPE		;[51]PICK UP THE OBJECT TYPE
	MOVE	S1,LIMTYP(S2)		;[51]GET THE LIMIT DESCRIPTION ADDRESS
	$CALL	ASCOUT			;[51]PUT IT OUT
	SKIPE	G$LOGF##		;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
	$ASCII	(< Form    Prio  Lim-Ex   Chars Logfile-Ena  Dev-Chars>) ;[51]YES
	SKIPN	G$LOGF##		;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
	$ASCII	(< Form    Prio  Lim-Ex   Chars  Dev-Chars>) ;[51]NO
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ.6:+7L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----  >)		;[51]UNDERLINE THE UNIT FIELD
	SKIPE	REMOTE			;[51]ANY IBM PRINTERS?
	$ASCII	(<------  >)		;[51]YES, UNDERLINE THE NODE FIELD
	SKIPE	G$LOGF##		;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
	$ASCII	(<----------- ------  -----  ------  ------ -----------  --------->) ;[51]YES
	SKIPN	G$LOGF##		;[51]SPECIFIC LOG/SPOOL LPT ENABLED?
	$ASCII	(<----------- ------  -----  ------  ------  --------->) ;[51]NO
	PJRST	CRLF			;[51]AND RETURN

;Cluster printer status

CHKQ10:	$ASCII	(<Cluster printers>)	;[51]OUTPUT THE PRINTER TYPE
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ10:+1L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (<  Alias >)		;[60]Output Alias field
	$ASCII	(<  Unit   Node      >) ;[51]OUTPUT UNIT/NODE FIELDS

	SKIPE	SHWTYP			;[51]SHOW STATUS?
	JRST	CHKQ11			;[51]NO, SHOW PARAMETER
	$ASCII	(<Status       >)	;[51]OUTPUT THE STATUS FIELD
	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS
	$ASCII	(<Jobname   Req#             User>) ;[51]YES
	$CALL	CRLF			;[51]START A NEW LINE

;**;[60]At CHKQ10:+10L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----  ------  --------------   >) ;[60]UNDERLINE
	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS
	$ASCII	(<-------   -----  ------------------------>) ;[51]YES
	PJRST	CRLF			;[51]AND RETURN

;Cluster printer parameters

CHKQ11:	MOVE	S2,OBTYPE		;[51]PICK UP THE OBJECT TYPE
	MOVE	S1,LIMTYP(S2)		;[51]GET THE LIMIT DESCRIPTION ADDRESS
	$CALL	ASCOUT			;[51]PUT IT OUT
;**;[60]At CHKQ11:+2L replace 2 lines with 6 lines  PMM  6/3/90
	$ASCII	(<  Prio  Lim-Ex>)	;[60]Output the rest of the line
	$CALL	CRLF			;[60]Start a new line
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------   ----  ------     -----------  -----  ------>) ;[60]
	SKIPN	AKHEAD			;[60]Is an alias header needed?
	$ASCII	(<  ----  ------     -----------  -----  ------>) ;[60]
	PJRST	CRLF			;[51]AND RETURN

;DQS printer status

CHKQ12:	$ASCII	(<DQS printers>)	;[51]OUTPUT THE PRINTER TYPE
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ12:+1L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (<  Alias           DQS queue name          Node  >) ;[60]
	SKIPN	AKHEAD			;[60]Is an alias header needed?
	$ASCII	(<           DQS queue name           Node  >) ;[60]	

	SKIPE	SHWTYP			;[51]SHOW STATUS?
	JRST	CHKQ13			;[51]NO, SHOW PARAMETER
	$ASCII	(<      Status      >)	;[51]OUTPUT THE STATUS FIELD
	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS?
	$ASCII	(<Jobname  Req# >)	;[51]YES
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ12:+10L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------  ------------------------------  ------  ---------------  >) ;[60]
	SKIPN	AKHEAD			;[60]Is an alias header needed?
	$ASCII	(<  ------------------------------   ------  ---------------  >) ;[60]

	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS?
	$ASCII	(<-------  ---- >)	;[51]YES
	PJRST	CRLF			;[51]AND RETURN

;DQS printer parameters

CHKQ13:	$ASCII	(< Page Limits     Prio  Lim-Ex>) ;[51]OUTPUT REST OF HEADER
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ13:+1L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------   -----------------------------  ------  >) ;[60]Yes
	SKIPN	AKHEAD			;[60]Is an alias header needed?
	$ASCII	(<  -----------------------------    ------  >) ;[60]No
	$ASCII	(<-----------     ----  ------>) 	      ;[51]
	PJRST	CRLF			;[51]AND RETURN

;LAT PORT printer status

CHKQ14:	LOAD	S1,OBJNAM(T1),AR.TYP	;[51]PICK UP NAME TYPE
	CAIE	S1,.KYPOR		;[51]IS IT A LAT PORT?
	JRST	CHKQ16			;[51]NO, IT IS A LAT SERVICE
	$ASCII	(<LAT PORT printers>)	;[51]INDICATE THE LAT TYPE
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ14:+4L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (<  Alias >)		;[60]Output Alias field
	$ASCII	(<      Port name     Server  >) ;[51]
	SKIPE	SHWTYP			;[51]IS THIS 'SHOW STATUS'?
	JRST	CHKQ15			;[51]NO, MUST BE 'SHOW PARAMETERS'
	$ASCII	(<     Status      >)	;[51]STATUS HEADER
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<Jobname    Req#  User>) ;[51]YES
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ12:+13L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----------------  ------  --------------->)
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<  -------    ----  ---->) ;[51]YES
	PJRST	CRLF			;[51]AND RETURN

;LAT PORT printer parameters

CHKQ15:	$ASCII	(<Page Limits    Form    Prio  Lim-Ex >) ;[51]LAT PORT LPT HEADER
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ15:+1L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----------------  ------  >)         ;[51]NAME AND NODE
	$ASCII	(<-----------   ------   ----  ------>)  ;[51]REST OF THE HEADER
	PJRST	CRLF			;[51]AND RETURN

;LAT SERVICE printer status

CHKQ16:	$ASCII	(<LAT SERVICE printers>) ;[51]INDICATE THE LAT TYPE
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ16:+1L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (<  Alias >)		;[60]Output Alias field
	$ASCII	(<    Service name    Server  >) ;[51]
	SKIPE	SHWTYP			;[51]IS THIS 'SHOW STATUS'?
	JRST	CHKQ17			;[51]NO, MUST BE 'SHOW PARAMETERS'
	$ASCII	(<     Status      >)
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<Jobname    Req#  User>) ;[51]YES
	$CALL	CRLF			;[51]START A NEW LINE
;**;[60]At CHKQ16:+10L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----------------  ------  ---------------      >) ;[51]
	SKIPE	ACTIVE			;[51]ANY ACTIVE JOBS?
	$ASCII	(<  -------    ----  ---->) ;[51]YES
	PJRST	CRLF			;[51]AN RETURN

;LAT SERVICE printer parameters

CHKQ17:	$ASCII	(<Page Limits    Form    Prio  Lim-Ex >) ;[51]LAT SERVICE LPT HEADER
	$CALL	CRLF				  ;[51]START A NEW LINE
;**;[60]At CHKQ17:+1L add 2 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Is an alias header needed?
	$ASCII  (< ------ >)		;[60]Output Alias field
	$ASCII	(<  ----------------  ------  >)  ;[51]NAME 
	$ASCII	(<-----------   ------   ----  ------>)  ;[51]REST OF THE HEADER
	PJRST	CRLF			;[51]AND RETURN

;All other types of output status

CHKQ18:	$ASCII	(<  Unit  >)		;[51]OUTPUT THE UNIT FIELD
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$ASCII	(<   Node      >)	;[51]YES, OUTPUT THE NODE NAME FIELD
	SKIPE	SHWTYP			;[51]SHOW STATUS?
	JRST	CHKQ19			;[51]NO, SHOW PARAMETERS
	$ASCII	(<     Status       >)	;[51]OUTPUT THE STATUS FIELD
	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS?
	$ASCII	(<Jobname   Req#             User>) ;[51]OUTPUT REST OF HEADER
	$CALL	CRLF			;[51]START A NEW LINE
	$ASCII	(<  ----  >)		;[51]UNDERLINE THE UNIT FIELD
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$ASCII	(<  ------     >)	;[51]YES, UNDERLINE THE NODE NAME
	$ASCII	(<----------------  >)	;[51]UNDERLINE STATUS
	SKIPE	ACTIVE			;[51]ANY ACTIVE REQUESTS?
	$ASCII	(<-------   -----  ------------------------>) ;[51]
	PJRST	CRLF			;[51]AND RETURN

;All other types of output parameters

CHKQ19:	MOVE	S2,OBTYPE		;[51]GET THE OBJECT TYPE
	MOVE	S1,LIMTYP(S2)		;[51]GET THE LIMIT DESCRIPTION ADDRESS
	PUSHJ	P,ASCOUT		;[51]PUT IT OUT
	$ASCII	(<   Form    Prio  Lim-Ex   Dev-Chars>) ;[51]
	$CALL	CRLF			;[51]START A NEW LINE
	$ASCII	(<  ----  >)		;[51]'UNIT' UNDERLINE
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$ASCII	(<  ------     >)	;[51]YES, UNDERLINE ITS HEADING
	$ASCII	(<------------  ------  -----  ------   --------->) ;[51]
	PJRST	CRLF			;[51]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.
	SETZM	REMUSR			;[41]REQUEST ORIGINATED LOCALLY
	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:	$QACK	(<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 ???
	$QACK	(<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 ???
	$QACK	(<No SNA-Workstations in system network>,,,.MSCOD(M))
	CAME	S2,[-1]			;DID WE ASK FOR ALL NODES ???
	$QACK	(<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
	$QACK	(<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
	$QACK	(<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
	$QACK	(<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
	$QACK	(<Node ^T/NETASC(P1)/ is ^T/@ONOFL(S2)/ (IBM ^T/@IBMODE(S1)/)>,<  as Station ^N/NETLOC(P1)/>,,.MSCOD(M))
	$RETT				;Return
NSTS.8:	$QACK	(<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
	$QACK	(<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
	$QACK	(<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
	$QACK	(<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
	$QACK	(<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),AR.TYP ;[25]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)
	SKIPN	S1,USRNAM		;[41]USER NAME BLOCK PRESENT?
	JRST	PUTO.1			;[41]NO, MUST BE A LOCAL REQUEST
	MOVEI	S2,.QEOWN(AP)		;[41]PICK UP USER NAME ADDRESS
	HRLI	S2,(POINT 7,)		;[41]MAKE INTO A POINTER
	$CALL	S%SCMP			;[41]CHECK FOR A MATCH
	TXNE	S1,SC%LSS!SC%SUB!SC%GTR	;[41]INCLUDE THIS ONE?
	$RETF				;[41]NO, RETURN NOW
	JRST	PUTO.2			;[41]CHECK THE JOB NAME

PUTO.1:	MOVE	S2,.QEOID(AP)		;[41]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
PUTO.2:	MOVE	S2,.QEJOB(AP)		;[41]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.

;**;[53]At SHSTAT:+0L add 1 line JYCW 6/20/88
SHSTAT:	PUSHJ	P,CHKLIN		;[53]Check to see if next line fits
	MOVE	S2,OBJTYP(T1)		;[51]PICK UP THE OBJECT TYPE
	HRRZ	S1,S2			;[51]ISOLATE THE MAJOR PART
	CAIN	S1,.OTBAT		;[51]IS IT BATCH?
	JRST	SHST.1			;[51]YES, OUTPUT ITS STATUS
	CAIN	S1,.OTLPT		;[51]IS IT A LPT?
	JRST	SHST.2			;[51]YES, OUTPUT ITS STATUS

;Non-batch and non-LPT objects

	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/  ^A>) ;[51]OUTPUT THE UNIT
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<  ^N6R/OBJNOD(T1)/     ^A>) ;[51]PUT OUT THE NODE NAME
	LOAD	S1,OBJSTS(T1)		;[51]GET THIS OBJECT'S STATUS CODE
	$TEXT	(DEPBYT,<^T15L /@OBJSTC(S1)/  ^A>) ;[51]OUTPUT THE STATUS
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,< ^W6L /.QEJOB(AP)/   ^D6/.QERID(AP)/  ^I/USR/>) ;[51]
	JRST	SHST.6			;[51]CHECK FOR A FAST LISTING

;Batch objects
	
SHST.1:	LOAD	S1,OBJSTS(T1)		;[51]GET THIS OBJECT'S STATUS CODE
;**;[53]At SHST.1:+1L add 5 lines JYCW 6/20/88
	$TEXT	(DEPBYT,<  ^D4R /OBJUNI(T1)/  ^A>) ;[53]Put out UNIT/STREAM #
	SKIPE	REMOTE			;[53]Any remote stations ???
	$TEXT	(DEPBYT,<^N10R /OBJNOD(T1)/  ^A>) ;[53]Put out the node name
	LOAD	S1,OBJSTS(T1)		;[53]GET THIS OBJECT'S STATUS CODE
	$TEXT	(DEPBYT,<^T15L /@OBJSTC(S1)/  ^A>) ;[53]OUTPUT THE STATUS
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,<^W6L/.QEJOB(AP)/  ^D6/.QERID(AP)/  ^I/USR/>) ;[51]
	JRST	SHST.6			;[51]CHECK FOR A FAST LISTING

;LPT objects

SHST.2:	LOAD	S1,OBJSTS(T1)		;[51]GET THIS OBJECT'S STATUS CODE
	TXNN	S2,.DQLPT		;[51]IS THIS A DQS LPT?
	JRST	SHST.3			;[51]NO, CHECK FOR A CLUSTER LPT
;**;[60]At SHST.2:+2L add 3 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias field?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/ ^T31R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[60]
	SKIPL	AKHEAD		;[60]Do we need an alias field?
	$TEXT	(DEPBYT,< ^T31R/OBJNAM+ARG.DA(T1)/   ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[51]
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,<^W6L/.QEJOB(AP)/ ^D6/.QERID(AP)/^M^J  User:^I/USR/^A>)
	JRST	SHST.6			;[51]CHECK FOR A FAST LISTING

SHST.3:	TXNN	S2,.CLLPT		;[51]IS THIS A CLUSTER LPT?
	JRST	SHST.4			;[51]NO, CHECK FOR A LAT LPT
;**;[60]At SHST.3:+2L add 3 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias field?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^D4R/OBJUNI(T1)/  ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[60]
	SKIPN	AKHEAD			;[60]Do we need an alias field?
	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/  ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[51]
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,<^W6L/.QEJOB(AP)/   ^D6/.QERID(AP)/  ^I/USR/>) ;[51]
	JRST	SHST.6			;[51]CHECK FOR A FAST LISTING

SHST.4:	TXNN	S2,.LALPT		;[51]IS THIS A LAT LPT?
	JRST	SHST.5			;[51]NO, IT MUST BE LOCAL
;**;[60]At SHST.4:+1L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias field?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^T16R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[60]
	SKIPN	AKHEAD			;[60]Do we need an alias field?
	$TEXT	(DEPBYT,<  ^T16R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^T15L/@OBJSTC(S1)/  ^A>) ;[60]
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,<^W6L/.QEJOB(AP)/   ^D6/.QERID(AP)/  ^I/USR/>)
	JRST	SHST.6			;[51]CHECK FOR A FAST LISTING

;**;[60]At SHST.5:+0L replace 1 line with 4 lines  PMM  6/3/90
SHST.5:	SKIPE	AKHEAD			;[60]Do we need an alias name?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^D4R/OBJUNI(T1)/  ^A>) ;[60]Yes
	SKIPN	AKHEAD			;[60]Do we want no alias?
	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/  ^A>) ;[60]No, output the unit
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<^N6R/OBJNOD(T1)/  ^A>) ;[51]PUT OUT THE NODE NAME
	LOAD	S1,OBJSTS(T1)		;[51]GET THIS OBJECT'S STATUS CODE
	$TEXT	(DEPBYT,<^T15L /@OBJSTC(S1)/  ^A>) ;[51]OUTPUT THE STATUS
	$CALL	GTQUEE			;[51]PICK UP AN ACTIVE QE
	JUMPF	CRLF			;[51]IF NONE, END THIS LINE
	$TEXT	(DEPBYT,<^W6L/.QEJOB(AP)/  ^D6/.QERID(AP)/    ^I/USR/>) ;[51]

SHST.6:	SKIPN	LISTYP			;[51]IF THIS IS A FAST LISTING, THEN
	$RETT				;[51]SKIP THE JOB STATUS DISPLAY
	$ASCII	(<      >)		;[51]INSERT A <TAB>
	MOVEI	S1,OBJST1(T1)		;[51]GET THE JOBS STATUS DESCRIPTION ADDR
	$CALL	ASCOUT			;[51]PUT IT OUT
	PJRST	CRLF			;[51]AND RETURN
	SUBTTL	GTQUEE - PICK UP AN ACTIVE QE ENTRY FOR SHOW STATUS COMMAND

;[51]GTQUEE determines if the current object whose status is being displayed
;[51]has an active QE associated with it.
;[51]
;[51]Call is:       T1/Object address
;[51]Returns true:  The object is processing a request
;[51]               AP/Address of the active QE
;[51]Returns false: The object is not processing a request

GTQUEE:	LOAD	S1,OBJSCH(T1)		;[51]PICK UP THE SCHEDULING WORD
	TXNN	S1,OBSBUS		;[51]IS THIS OBJECT BUSY?
	$RETF				;[51]NO, INDICATE SO
	LOAD	S1,OBJITN(T1)		;[51]GET THE CONTROLLING JOB
	PUSHJ	P,Q$SUSE##		;[51]FIND THE JOB IN THE USE QUEUE
	JUMPF	.POPJ			;[51]SHOULD NOT HAPPEN
	MOVE	AP,S1			;[51]GET THE QUEUE ENTRY ADDRESS
	$RETT				;[51]INDICATE SUCCESS
	SUBTTL	SHPARM - ROUTINE TO PROCESS PARM INFO FOR SHOW PARM COMMAND.

;**;[53]At SHPARM:+0L add 1 line JYCW 6/20/88
SHPARM:	PUSHJ	P,CHKLIN		;[53]Check to see if next line fits
	MOVE	S1,OBTYPE		;GET THE OBJECT TYPE
	CAIE	S1,.OTBAT		;IS IT BATCH ???
	JRST	SHPA.1			;NO,,GO TRY SOMETHING ELSE
	$TEXT	(DEPBYT,<  ^D4R /OBJUNI(T1)/  ^A>) ;[52]Put out UNIT/STREAM #
	SKIPE	REMOTE			;[52]Any remote stations ???
	$TEXT	(DEPBYT,<^N10R /OBJNOD(T1)/  ^A>) ;[52]Put out the node name
	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	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	T3,OBJPRM+.OOPRI(T1),OBPMIN  ;GET MIN PRIORITY
	LOAD	T4,OBJPRM+.OOPRI(T1),OBPMAX  ;GET MAX PRIORITY
	LOAD	T2,OBJPRM+.OOFRM(T1)	     ;[51]GET THE FORMS TYPE

	$SAVE	<P1>			;[51]SAVE THIS AC
	MOVE	P1,OBJTYP(T1)		;[51]PICK UP THE OBJECT TYPE
	TXNN	P1,.DQLPT		;[51]A DQS LPT?
	JRST	SHPA.3			;[51]NO, CHECK FOR A CLUSTER LPT
;**;[60]At SHPA.2:+9L replace 1 line with 3 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we want to include an alias?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/ ^T31R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^D5R/S1/:^D6L/S2/   ^D2R/T3/:^D2L/T4/  ^A>) ;[60]Yes
	SKIPN	AKHEAD			;[60]Do we want no alias?
	$TEXT	(DEPBYT,<^T31R/OBJNAM+ARG.DA(T1)/    ^N6R/OBJNOD(T1)/  ^D5R/S1/:^D6L/S2/   ^D2R/T3/:^D2L/T4/  ^A>) ;[60]No
	$CALL	LIMEXC			;[51]PICK UP LIMIT EXCEEDED ACTION
	PJRST	CRLF			;[51]AND RETURN

SHPA.3:	TXNN	P1,.CLLPT		;[51]A CLUSTER LPT?
	JRST	SHPA.4			;[51]NO, CHECK FOR A LAT LPT
;**;[60]At SHPA.3:+2L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^D4R/OBJUNI(T1)/  ^N6R/OBJNOD(T1)/     ^D5R/S1/:^D6L/S2/ ^D2R/T3/:^D2L/T4/  ^A>) ;[60]Yes
	SKIPN	AKHEAD			;[60]Do we need an alias?
	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/  ^N6R/OBJNOD(T1)/     ^D5R/S1/:^D6L/S2/  ^D2R/T3/:^D2L/T4/ ^A>) ;[60]No
	$CALL	LIMEXC			;[51]PICK UP LIMIT EXCEEDED ACTION
	PJRST	CRLF			;[51]AND RETURN

SHPA.4:	TXNN	P1,.LALPT		;[51]A LAT LPT?
	JRST	SHPA.5			;[51]NO, CHECK FOR A LOCAL LPT
;**;[60]At SHPA.4:+2L replace 1 line with 4 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^T16R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^D5R/S1/:^D6L/S2/  ^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[60]Yes
	SKIPN	AKHEAD			;[60]Do we want no alias?
	$TEXT	(DEPBYT,<  ^T16R/OBJNAM+ARG.DA(T1)/  ^N6R/OBJNOD(T1)/  ^D5R/S1/:^D6L/S2/  ^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[60]No

	$CALL	LIMEXC			;[51]PICK UP LIMIT EXCEEDED ACTION
	PJRST	CRLF			;[51]AND RETURN

SHPA.5:	HRRZS	P1			;[51]ISOLATE MAJOR LPT TYPE
	CAIE	P1,.OTLPT		;[51]IS THIS A LOCAL LPT?
	JRST	SHPA.7			;[51]NO, OTHER TYPE OF OUTPUT
;**;[60]At SHPA.5:+3L replace 1 line with 3 lines  PMM  6/3/90
	SKIPE	AKHEAD			;[60]Do we need an alias?
	$TEXT	(DEPBYT,< ^W6R/OBJALI(T1)/   ^D4R/OBJUNI(T1)/^A>) ;[60]Yes
	SKIPN	AKHEAD			;[60]Do we need an alias?
	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/^A>) ;[60]No, output the unit only
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<  ^N6R/OBJNOD(T1)/  ^D5R/S1/:^D6L/S2/^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[51]
	SKIPN	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<  ^D5R/S1/:^D6L/S2/^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[51]
	$CALL	LIMEXC			;[51]PICK UP LIMIT EXCEEDED ACTION

	SKIPN	S1,OBJTCR(T1)		;[51]TERMINAL CHARACTERISTICS?
	$ASCII	(<      >)		;[51]NO, LEAVE BLANK
	SKIPE	S1			;[51]TERMINAL CHARACTERISTICS?
	$TEXT	(DEPBYT,<^W6L/S1/^A>)	;[51]DISPLAY THE CHARACTERISTICS

	SKIPN	G$LOGF##		;[51]SPECIFIC LOG/SPOOL LPT ENA?
	JRST	SHPA.6			;[51]NO, CHECK FOR ATTRIBUTES
	LOAD	S1,OBJSC2(T1),OB2LOG	;[51]PICK UP THE PRINT-LOG BIT
	SKIPE	S1			;[51]ENABLED?
	$ASCII	(<     Yes    >)	;[51]YES, INDICATE SO
	SKIPN	S1			;[51]ENABLED?
	$ASCII	(<      No    >)	;[51]NO, INDICATE SO

SHPA.6:	$CALL	DEVATR			;[51]PICK UP THE DEVICE ATTRIBUTES
	LOAD	S1,OBJSCH(T1),OBSSPL	;[51]GET THE SPOOLING TO TAPE BIT
	SKIPE	S1			;[51]ARE WE SPOOLING TO TAPE?
	$TEXT	(DEPBYT,<  ^W/OBJPRM+.OOTAP(T1)/:^A>) ;[51]YES, SAY SO
	PJRST	CRLF			;[51]END THE LINE AND RETURN

SHPA.7:	$TEXT	(DEPBYT,<  ^D4R/OBJUNI(T1)/  ^A>) ;[51]OUTPUT THE UNIT
	SKIPE	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<    ^N6R/OBJNOD(T1)/     ^D5R/S1/:^D6L/S2/  ^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[51]
	SKIPN	REMOTE			;[51]ANY REMOTE STATIONS?
	$TEXT	(DEPBYT,<^D5R/S1/:^D6L/S2/  ^W6L/T2/  ^D2R/T3/:^D2L/T4/  ^A>) ;[51]
	$CALL	LIMEXC			;[51]GET THE LIMIT-EXCEEDED ACTION
	$CALL	DEVATR			;[51]GET THE DEVICE-ATTRIBUTES
	PJRST	CRLF			;[51]AND RETURN
	SUBTTL	LIMEXC - LIMIT EXCEEDED ACTION FOR SHOW PARAMETERS

;[51]LIMEXC is called to place the limit exceeded action in the SHOW
;[51]PARAMETERS display of an object
;[51]
;[51]Call is: T1/Object address
;[51]Returns: Always

LIMEXC:	LOAD	S1,OBJPRM+.OOFLG(T1),.OFLEA  ;[51]GET LIMIT EXCEEDED ACTION
	CAIN	S1,.STIGN		     ;[51]IS IT 'IGNORE'?
	$ASCII	(<Proceed >)		     ;[51]YES, SAY SO
	CAIN	S1,.STCAN		     ;[51]IS IT 'CANCEL'?
	$ASCII	(<Abort   >)		     ;[51]YES, SAY SO
	CAIN	S1,.STASK		     ;[51]IS IT ASK?
	$ASCII	(<Ask     >)		     ;[51]YES, SAY SO
	$RET				     ;[51]RETURN TO THE CALLER

	SUBTTL	DEVATR - DEVICE ATTRIBUTES FOR SHOW PARAMETERS

;[51]DEVATR is called to place the device attributes for the SHOW
;[51]PARAMETERS display of an object
;[51]
;[51]Call is: T1/Object address
;[51]Returns: Always

DEVATR:	LOAD	S1,OBJDAT(T1),RO.ATR	;[51]GET THE DEVICE ATTRIBUTES
	CAIN	S1,%LOWER		;[51]IS IT LOWER CASE?
	$ASCII	(<  Lower>)		;[51]YES, SAY SO
	CAIN	S1,%UPPER		;[51]IS IT UPPER CASE?
	$ASCII	(<  Upper>)		;[51]YES, SAY SO
	$RET				;[51]AND 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.
	HRRZ	S1,OBTYPE			;[26]PICK UP THE OBJECT TYPE
	$TEXT	(DEPBYT,<^1/S1/ 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:	$QACK 	(<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:	MOVEM	S1,REMMSG		;[31]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.
	SKIPE	G$NEBF			;[31]MESSAGE FROM A REMOTE NODE?
	MOVE	S2,[.OHDRS,,.NMACS]	;[31]YES, CHANGE THE MESSAGE CODE
	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,REMMSG		;[31]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.
	MOVEI	P1,.ORDSP		;GET BLOCK TYPE
	STORE	P1,ARG.HD(S1),AR.TYP	;SAVE IT IN THE MESSAGE
	SKIPN	G$NEBF			;[31]MESSAGE ORIGINATE REMOTELY?
	JRST	SETH.1			;[31]NO, BUILD THE DISPLAY BLOCK

	SKIPE	PIDBLK			;[41]USER PID BLOCK PRESENT?
	JRST	SETH.1			;[41]YES, DON'T ADD THIS DISPLAY BLOCK
	MOVE	P1,G$REMN		;[31]PICK UP NODE NAME MSG CAME FROM
	MOVEM	P1,ARG.DA(S1)		;[31]SAVE IN THE DISPLAY BLOCK
	MOVEI	P1,ARG.DA+1(S1)		;[35]PICK UP WHERE TO PLACE THE TEXT
	HRLI	P1,(POINT 7,)		;[35]MAKE IT INTO A POINTER
	MOVEM	P1,BYTPTR		;[31]SAVE WHERE DEPBYT EXPECTS IT
;**;[54]At SETHDR:+15L change 1 line  JCR  11/29/89
	MOVEI	P1,[ITEXT(< Received message from ^N/G$LNAM##/::>)] ;[54]
	$TEXT	(DEPBYT,<^I/0(P1)/^A>)	;[31]PLACE IN THE MESSAGE
	HRRZ	P1,BYTPTR		;[31]PICK UP THE END ADDRESS
	SUBI	P1,-1(S1)		;[31]CALCULATE LENGTH OF BLOCK
	STORE	P1,ARG.HD(S1),AR.LEN	;[35]STORE IN THE BLOCK
	ADD	S1,P1			;[31]POINT TO THE NEXT BLOCK
	MOVSS	P1			;[31]PLACE LENGTH IN EXPECTED PLACE
	ADDM	P1,.MSTYP(S2)		;[31]ADD TO TOTAL MESSAGE LENGTH
	AOS	.OARGC(S2)		;[31]INCREMENT THE ARGUMENT COUNT
	MOVEI	P1,.ORDSP		;[31]PICK UP THE NEXT BLOCK TYPE
	STORE	P1,ARG.HD(S1),AR.TYP	;[31]STORE IN THE BLOCK HEADER WORD

SETH.1:	MOVE	P1,G$NOW##		;[31]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		;[32]Get the more pages comming bit.
	MOVE	S2,G$SAB##+SAB.MS	;GET THE MESSAGE ADDRESS.
	IORM	S1,.OFLAG(S2)		;LIGHT THE BIT.
	SKIPN	G$NEBF			;[31]MESSAGE ORIGINATE REMOTELY?
	JRST	SEND.1			;[31]NO, FINISH BUILDING THE MESSAGE

	MOVX	S1,MF.NEB!MF.MOR	;[31]INDICATE REMOTE MESSAGE RESPONSE
	IORM	S1,.MSFLG(S2)		;[31]INDICATE IN THE MESSAGE
	JRST	SEND.1			;[31]GO FINISH THE MESSAGE

SENDIT:	SKIPN	G$NEBF			;[31]MESSAGE ORIGINATE REMOTELY?
	JRST	SEND.1			;[31]NO, PICK UP BYTE POINTER
	MOVX	S1,MF.NEB		;[31]PICK UP THE NEBULA BIT
	MOVE	S2,G$SAB##+SAB.MS	;[31]PICK UP THE MESSAGE ADDRESS
	IORM	S1,.MSFLG(S2)		;[31]INDICATE A REMOTE MESSAGE RESPONSE

SEND.1:	MOVE	S2,BYTPTR		;[31]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	SNDNEB - Send a message to NEBULA

SNDNEB::MOVE	S1,G$NEBP##		;[41]PICK UP NEBULA'S PID
	MOVEM	S1,G$SAB##+SAB.PD	;[41]PLACE IN THE SAB
	$CALL	C$SEND##		;[41]SEND THE MESSAGE TO NEBULA
	SETZM	G$SAB##+SAB.MS		;[41]RESET SAB MESSAGE ADDRESS
	$RET				;[41]RETURN TO THE CALLER
	SUBTTL	DMPSTS - ROUTINE TO DUMP QUEUE STATUS INFO

DMPSTS:	SKIPN	LISTYP			;IF THIS IS A QUICK LIST,,SKIP THIS
	JRST	DMPS16			;EXIT
	$SAVE	<P1>			;[25]SAVE THIS AC
	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			;[25]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.7			;CONTINUE ON

DMPS.1:	SKIPN	JOBACT			;[37]IS THIS JOB ACTIVE?
;**;[60]At DMPS.1:+1L change 1 line  PPM  6/3/90
	JRST	DMPS1F			;[60]No, check for a LPT
	MOVE	P1,OBJTYP(P3)		;[37]PICK UP THE OBJECT TYPE
	HRRZ	S1,P1			;[37]ISOLATE THE OJBECT TYPE
	CAIE	S1,.OTLPT		;[37]IS THIS A LPT OBJECT?
	JRST	DMPS.4			;[37]NO, CHECK FOR A UNIT
	MOVE	S1,.QEOBJ(AP)		;[42]PICK UP THE OBJECT ADDRESS
;**;[60]At DMPS.1:+6L add 2 lines  PMM  6/3/90
	MOVE	S1,OBJAKA(S1)		;[60]Get alias name
	MOVEM	S1,JOBAKA		;[60]Save  for later
	TXNN	P1,.DQLPT!.LALPT	;[37]A LAT OR DQS LPT OBJECT?
	JRST	DMPS4A			;[37]NO, IT'S A LOCAL LPT

	TXNN	P1,.DQLPT		;[37]IS THIS A DQS LPT?
	JRST	DMPS1B			;[37]NO, IT IS A LAT OR UNKNOWN
;**;[60]At DMPS.1:+14L replace 2 lines with 7 lines  PMM  6/3/90
	SKIPN	JOBAKA			;[60]Need an alias field?
	JRST	DMPSA1			;[60]No, add the queue name
	MOVEI	S1,^D16			;[60]Get the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Alias:^W/JOBAKA/^A>)   ;[60]Add alias name
DMPSA1:	MOVEI	S1,^D45			;[60]Get the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Queue-name:^T/OBJNAM+1(P3)/^A>)
	JRST	DMPS.6			;[37]CHECK THE FORMS TYPE

DMPS1B:	LOAD	S1,OBJNAM(P3),AR.TYP	;[37]PICK UP THE NAME BLOCK TYPE
	CAIE	S1,.KYPOR		;[37]IS IT A PORT?
;**;[60]At DMPS1B:+2L replace 3 lines with 7 lines PMM  6/3/90
	JRST	DMPS1D			;[60]No, must be a SERVICE
	SKIPN	JOBAKA			;[60]Need an alias field?
	JRST	DMPS1C			;[60]No, add the PORT name
	MOVEI	S1,^D16			;[60]Get the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Alias:^W/JOBAKA/^A>)   ;[60]Add alias name
DMPS1C:	MOVEI	S1,^D29			;[37]GET THE FIELD LENGTH
	$CALL	CHKSPC			;[37]MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Port-name:^T/OBJNAM+1(P3)/^A>)
	JRST	DMPS.6			;[37]CHECK THE FORMS TYPE

;**;[60]At DMPS1C:+L relace 2 lines with 7 lines  PMM  6/3/90
DMPS1D:	SKIPN	JOBAKA			;[60]Need an alias field?
	JRST	DMPS1E			;[60]No, add the SERVICE name
	MOVEI	S1,^D16			;[60]Get the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Alias:^W/JOBAKA/^A>)   ;[60]Add alias name
DMPS1E:	MOVEI	S1,^D32			;[60]Get the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Service-name:^T/OBJNAM+1(P3)/^A>)
	JRST	DMPS.6			;[37]CHECK THE FORMS TYPE

DMPS1F:	MOVE	P1,.QEROB+.ROBTY(AP)	;[37]Pick up the object type
	TXNN	P1,.DQLPT!.LALPT!.UNLPT	;[27]IS THIS A REMOTE LPT?
	JRST	DMPS.4			;[25]NO, CHECK FOR A UNIT
	TXNN	P1,.DQLPT		;[25]IS THIS A DQS LPT?
	JRST	DMPS.2			;[27]NO, IT IS A LAT OR UNKNOWN

	MOVEI	S1,^D45			;[25]GET THE FIELD LENGTH
	$CALL	CHKSPC			;[25]MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Queue-name:^T/.QEONM+ARG.DA(AP)/^A>)
	JRST	DMPS.6			;[25]CHECK THE FORMS TYPE

DMPS.2:	TXNE	P1,.UNLPT		;[27]UNKNOWN REMOTE PRINTER TYPE?
	JRST	DMPS3A			;[27]YES, INDICATE REMOTE NAME
	LOAD	S1,.QEONM(AP),AR.TYP	;[25]PICK UP THE NAME BLOCK TYPE
	CAIE	S1,.KYPOR		;[25]IS IT A PORT?
	JRST	DMPS.3			;[25]NO, MUST BE A SERVICE
	MOVEI	S1,^D29			;[25]GET THE FIELD LENGTH
	$CALL	CHKSPC			;[25]MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Port-name:^T/.QEONM+ARG.DA(AP)/^A>)
	JRST	DMPS.6			;[25]CHECK THE FORMS TYPE

DMPS3A:	$TEXT	(DEPBYT,<  /Remote-name:^T/.QEONM+ARG.DA(AP)/^A>)
	JRST	DMPS.6			;[27]CHECK THE FORMS TYPE

DMPS.3:	MOVEI	S1,^D32			;[25]GET THE FIELD LENGTH
	$CALL	CHKSPC			;[25]MAKE SURE THERE IS ROOM
	$TEXT	(DEPBYT,<  /Service-name:^T/.QEONM+ARG.DA(AP)/^A>)
	JRST	DMPS.6			;[25]CHECK THE FORMS TYPE

DMPS.4:	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
DMPS4A:	LOAD	S2,OBJUNI(P3)		;[37]YES, GET THE DEVICE NUMBER.
	SKIPGE	S2			;DO WE HAVE ANYTHING ???
	JRST	DMPS.5			;NO,,SKIP THIS
	SKIPN	JOBACT			;IS THE JOB ACTIVE ???
;**;[60]At DMPS4A:+3L replace 5 lines with 14 lines  PMM  6/3/90
	JRST	DMPS4C			;[60]No, go indicate so
	SKIPN	JOBAKA			;[60]Does it have an alias?
	JRST	DMPS4B			;[60]No, add the unit field
	MOVEI	S1,^D16			;[60]Pick up the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /On Alias Printer:^W/JOBAKA/^A>)  ;[60]Yes, add it
DMPS4B:	MOVEI	S1,^D13			;[60]Pick up the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  On Unit:^D/S2/^A>) ;[60]Is active,,say so
	JRST	DMPS.6			;[60]And continue on
DMPS4C:	MOVEI	S1,^D10			;[60]Pick up the field length
	$CALL	CHKSPC			;[60]Make sure there is room
	$TEXT	(DEPBYT,<  /Unit:^D/S2/^A>) ;[60]Not active,,say so
	JRST	DMPS.6			;[60]Get the next field

DMPS.5:	CAIN	S1,%LOWER		;WAS IT LOWER??
	$ASCII	(<  /Lower>)		;YES,,SAY SO
	CAIN	S1,%UPPER		;WAS IT /UPPER??
	$ASCII	(<  /Upper>)		;YES,,SAY SO

DMPS.6:	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.7:	MOVEI	S1,^D16			;GET NEXT FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM
	SKIPN	JOBACT			;[42]IS THIS REQUEST ACTIVE?
	JRST	DMPS7A			;[42]NO, CHECK ROUTE TBL FOR NODE NAME
	MOVE	S1,OBJNOD(P3)		;[42]PICK UP THE NODE NAME
	$CALL	N$NODE			;[43]SET UP FOR THE DISPLAY
	JRST	DMPS7B			;[42]CHECK IF ITS LOCAL
DMPS7A:	MOVEI	S1,.QEROB(AP)		;[42]GET THE REQ OBK BLK ADDRESS
	SETZ	S2,			;NO OBJECT MATCH
	PUSHJ	P,N$CSTN##		;PERFORM ANY ROUTING
DMPS7B:	PUSHJ	P,N$LOCL##		;[42]IS IT THE LOCAL NODE
	JUMPT	DMPS.8			;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

	SKIPN	.QENOD(AP)		;[41]REQUEST FROM A REMOTE NODE?
	JRST	DMPS.8			;[41]NO, CHECK FOR STRUCTURE
	MOVEI	S1,^D17			;[41]GET LENGTH FOR NEXT FIELD
	PUSHJ	P,CHKSPC		;[41]MAKE SURE THERE IS ROOM
	$TEXT (DEPBYT,<  /Req-from:^N/.QENOD(AP)/^A>) ;[41]

DMPS.8:	MOVEI	S1,^D12			;GET THE FIELD LENGTH
	PUSHJ	P,CHKSPC		;MAKE SURE THERE IS ROOM

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

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

DMP.11:	MOVE	S1,G$NOW##		;GET CURRENT TIME
	CAML	S1,.QECRE(AP)		;IS THERE A /AFTER PARM ???
	JRST	DMP.12			;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.12:	SKIPG	LISTYP			;IS THIS AN EVERYTHING LIST ??
	JRST	DMPS15			;NO,,SKIP THIS
	LOAD	S1,.QEROB+.ROBTY(AP)	;GET THE QUEUE TYPE
	CAIE	S1,.OTBAT		;IF BATCH,,CONTINUE ON
	JRST	DMPS13			;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	DMPS14			;CONTINUE ON

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

DMPS14:	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 #

DMPS15:	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
DMPS16:	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
	SETZM	USRNAM			;[41]NO USER NAME BLOCK
	SETZM	PIDBLK			;[41]NO PID BLOCK
	SETZM	REMUSR			;[41]NOT IN BEHALF OF A REMOTE USER

	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.3			;[41]NO MORE, CHECK FOR REMOTE USER
	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 ???
;**;[57]At GETP.1:+6L change 1 line  JCR  1/31/90
	MOVEM	T3,LSTUSR		;[57]Save the user name address
	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
	CAIN	T1,.LSPID		;[41]IS THIS A PID BLOCK?
	MOVEM	S1,PIDBLK		;[41]YES, SAVE THE PID
	CAIE	T1,.LSUNM		;[41]IS THIS A USER NAME BLOCK?
	JRST	GETP.2			;[41]NO, CHECK FOR A TAPE BLOCK
	HRLI	T3,(POINT 7,)		;[41]YES, MAKE A POINTER
	MOVEM	T3,USRNAM		;[41]SAVE THE USER NAME POINTER
GETP.2:	CAIE	T1,.TAPDV		;[41]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.

GETP.3:	SKIPN	PIDBLK			;[41]A PID BLOCK PRESENT?
;**;[57]At GETP.3:+1L replace 3 lines with 16 lines  JCR  1/31/90
	JRST	GETP.4			;[57]No, check for user ID block
	SKIPE	G$NEBF			;[57]Message originate remotely?
	SETOM	REMUSR			;[57]Yes, indicate from a remote user

GETP.4:	SKIPN	LSTUSR			;[57]User ID block present?
	JRST	GETP.6			;[57]No, Resolve /DEST /PROC /NODE
	SKIPE	ENTYPE			;[57]From an operator?
	JRST	GETP.5			;[57]Yes, user name instead of number
	MOVE	S1,@LSTUSR		;[57]Pick up the user number
	MOVEM	S1,LSTUSR		;[57]Place where expected
	JRST	GETP.6			;[57]Resolve /DEST /PROC /NODE
GETP.5:	MOVX	S1,RC%EMO		;[57]Exact match only
	HRROI	S2,@LSTUSR		;[57]Point to the user name
	RCUSR%				;[57]Get the user number
	 ERJMP	.RETF			;[57]Quit on an error
	MOVEM	T1,LSTUSR		;[57]Place user number where expected

; 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
;

;**;[57]At GETP.4:+0L change 1 line  JCR  1/31/90
GETP.6:	SETOM	KLUDGE			;[57]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	REMLIS - Reformat a LIST message to be forward remotely

REMLIS:	$SAVE	<P1,P2>			;[41]SAVE THESE AC
	MOVE	S1,.MSFLG(M)		;[41]PICK UP THE FLAG WORD
	TXZ	S1,MF.ACK		;[41]DON'T WANT AN ACK
	TXO	S1,MF.NEB		;[41]INDICATE A REMOTE REQUEST
	MOVEM	S1,.MSFLG(M)		;[41]SAVE THE UPDATED FLAG WORD

	$CALL	M%GPAG			;[41]PICK UP A PAGE FOR THE MSG
	MOVE	P1,S1			;[41]SAVE THE MESSAGE ADDRESS

	LOAD	S2,.MSTYP(M),MS.CNT	;[41]PICK UP THE MESSAGE LENGTH
	ADD	S2,S1			;[41]ADDRESS OF END OF MESSAGE+1
	HRL	S1,M			;[41]SOURCE,,DESTINATION
	BLT	S1,-1(S2)		;[41]COPY MSG TO REFORMATTED MSG


	SKIPE	G$RPRV##		;[41]UNPRIVILEGED USERS ENABLED?
	JRST	REML.1			;[41]YES, CHECK FOR A USER BLOCK
	$CALL	A$WHEEL			;[41]IS THE USER PRIVILEGED?
	JUMPT	REML.1			;[41]YES, CHECK FOR A USER BLOCK

	MOVE	S2,G$SID##		;[46]PICK UP THE USER I.D.
	SKIPN	LSTUSR			;[41]IS THERE A USER BLOCK PRESENT?
	JRST	REML.2			;[41]NO, USE THE USER I.D.
	CAME	S2,LSTUSR		;[41]YES, SAME AS THE USER'S?
	JRST	[ MOVE S1,P1		  ;[41]NO, PICK UP THE MSG PAGE ADR
		  $CALL M%RPAG		  ;[41]RELEASE THE PAGE
		  PJRST E$IUN## ]	  ;[41]INDICATE THE ERROR
	JRST	REML.2			;[41]BUILD THE USER NAME BLOCK

REML.1:	SKIPN	S2,LSTUSR		;[41]IS THERE A USER BLOCK PRESENT?
	JRST	REML.3			;[44]SEND ANY ACK

REML.2:	LOAD	P2,.MSTYP(P1),MS.CNT	;[41]PICK UP THE ORIGINAL MSG LENGTH
	ADD	P2,P1			;[41]POINT TO THE NEXT FREE BLOCK
	MOVE	S1,[11,,.LSUNM]		;[41]PICK UP USER NAME BLOCK HEADER
	MOVEM	S1,ARG.HD(P2)		;[41]PLACE IN THE NAME BLOCK
	HRROI	S1,ARG.DA(P2)		;[41]POINT TO THE FIRST DATA WORD
	DIRST%				;[41]PLACE THE USER NAME IN THE MSG
	 ERJMP	[ MOVE S1,P1		  ;[41]PICK UP THE MESSAGE ADDRESS
		  $CALL M%RPAG		  ;[41]RELEASE THE MESSAGE PAGE
		  PJRST E$CDU## ]	  ;[41]INDICATE AN ERROR
	MOVEI	S1,11			;[41]PICK UP USER NAME BLOCK LENGTH
	MOVSS	S1			;[41]PLACE LENGTH IN EXPECTED PLACE
	ADDM	S1,.MSTYP(P1)		;[41]UPDATE THE MESSAGE LENGTH
	AOS	.OARGC(P1)		;[41]INCREMENT THE ARGUMENT COUNT

REML.3:	MOVX	S1,MF.NOM		;[44]INDICATE A NULL ACK
	SKIPE	G$ACK##			;[44]ACK REQUESTED?
	$CALL	G$MSND##		;[44]YES, ACK THE SENDER

	MOVEM	P1,G$SAB##+SAB.MS	;[44]SAVE MESSAGE ADDRESS HERE
	MOVEI	S1,PAGSIZ		;[44]PICK UP THE MESSAGE SIZE
	MOVEM	S1,G$SAB##+SAB.LN	;[44]SAVE THE MESSAGE SIZE

	$RETT				;[41]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.
	SKIPE	S1,G$NEBF		;[41]MESSAGE ORIGINATE REMOTELY?
	MOVE	S1,REMMSG		;[41]YES, PICK UP DISPLAY BLK ADDRESS
	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