!=====================================================================+
	! SYSTAT - Show system status                                         |
	!=====================================================================+
	! Author: Harry Flowers
	! Usage:
	!
	! $ SYSTAT [/NODE[=nodename]]
	!          [/IMAGE[=imagname]]
	!          [/[NO]RIGHTS]
	!          [/[NO]IO]
	!          [/[NO]PROCESS_NAME]
	!          [/[NO]INTERACTIVE]
	!          [/[NO]BATCH]               
	!          [/[NO]NETWORK]
	!          [/[NO]OTHER]
	!          [username]
	!
	! See SYSTAT.TEX for full documentation.
	!
	!======================================================================
	!
	! Set up system services
	OPTION TYPE = EXPLICIT
	EXTERNAL LONG FUNCTION	LIB$GET_FOREIGN,	&
				LIB$STOP,		&
				LIB$SIGNAL,		&
				LIB$SUB_TIMES,		&
				LIB$CVT_TO_INTERNAL_TIME, &
				SYS$PROCESS_SCAN,	&
				SYS$GETJPIW,		&
				SYS$GETSYIW,		&
				SYS$IDTOASC,		&
				SYS$FAO,		&
				SYS$FILESCAN,		&
				SYS$GETTIM,		&
				SYS$ASCTIM,		&
				SOR$BEGIN_SORT,		&
				SOR$RELEASE_REC,	&
				SOR$SORT_MERGE,		&
				SOR$RETURN_REC,		&
				SOR$END_SORT,		&
				STR$MATCH_WILD
	!
	%INCLUDE "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$SYIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$KGBDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$FSCNDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$PSCANDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$LIBDTDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$SORDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$DSCDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$STRDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	!
	DECLARE LONG STAT, RET_LENGTH
	DECLARE LONG CONSTANT	BUF_LENGTH = 255%,	&
				JPILIMAGNAME = 128%
	!	
	MAP(FIXED_STRINGS)				&
		STRING RET_STRING = BUF_LENGTH,		&
		       ONE_STRING = BUF_LENGTH,		&
		       JPIIMAGNAME = JPILIMAGNAME
	!
	DECLARE LONG CONSTANT FATAL = 268435460%
	!
	RECORD ITMLST
	    GROUP ITEM(14)
		VARIANT
		    CASE
			WORD	BUFFER_LEN
			WORD	ITEM_CODE
			LONG	BUFFER_ADDR
			LONG	LENGTH_ADDR
		    CASE
			LONG	TERMINATOR
		END VARIANT
	    END GROUP
	END RECORD
	!
	MAP(FSITMLST)			&
		WORD	IMAGNAMELEN,	&
			NAME_CODE,	&
		LONG	IMAGNAMEADDR,	&
			FSTERMINATOR	
	!
	DECLARE ITMLST	ITEM_LIST
	DECLARE WORD	RETLEN(14%)
	DECLARE	LONG	IOSB(1%),	&
			DELTATIM(1%),	&
			CURTIM(1%),	&
			CPUDELTA(1%),	&
			OPERATION,	&
			JPICONTROL,	&
			PROCRIGHTS(128%)
	!
	MAP(SORT_REC_FMT)		&
		STRING	USERNAME = 12%,	&
			IMAGNAME = 16%,	&
			PROCNAME = 15%,	&
		LONG	LOGINTIM(1%),	&
			CPUTIM,		&
			PID,		&
			GPGCNT,		&
			PPGCNT,		&
			PROCMODE,	&
			PROCSTATE,	&
			PROCEFWM,	&
			MASTERPID,	&
			RIGHTS(64%)
	MAP(SORT_REC_FMT)		&
		STRING	SORT_REC = 343%
	!   12   + 16  + 15 +  8  + 4 + 4 + 4 + 4 + 4  +  4  + 4  + 4  + 260  = 343
	!username image proc login cpu pid gpg ppg mode state efwm mpid rights 
	!
	DECLARE STRING	COMMAND_LINE,		&
		WORD	OUT_LEN
	!
	DECLARE STRING	ID_NAME,		&
		LONG	RIGHTS_ID,		&
			ID_ATTRIB
	!
	DECLARE	LONG	CONTEXT
	!
	DECLARE	WORD	KEYBUFFER(12%),		&
			RECLENGTH,		&
		BYTE	WORKFILES		
	!
	! Misc declarations
	DECLARE STRING	QUALIFIER,		&
			QVALUE,			&
			COMMAND,		&
			MYNODE,			&
			NODES,			&
			IMAGE_MATCH,		&
			IMAGE_TO_MATCH,		&
			PMODE,			&
			SUBPROC,		&
			PSTATE,			&
			ETIME,			&
			CPUTIME,		&
			RIGHTSNAME,		&
			STATUS_LINE,		&
			TIME_OR_NAME,		&
			HEADER,			&
		LONG	NUMRECORDS,		&
			MEMORY,			&
			INC_RIGHTS,		&
			INC_PROCNAME,		&
			INC_IO,			&
			INC_OTHER,		&
			INC_NETWORK,		&
			INC_BATCH,		&
			INC_INTERACTIVE,	&
			NUM_INTERACTIVE,	&
			NUM_BATCH,		&
			NUM_NETWORK,		&
			NUM_OTHER,		&
			NODE_GIVEN,		&
			IMAGE_GIVEN,		&
			X, Y, Z
	!
	!======================================================================
	MARGIN 80%
	! Initialize some variables
	NAME_CODE = FSCN$_NAME
	FSTERMINATOR = 0%
	OPERATION = LIB$K_DELTA_SECONDS
	NODE_GIVEN = 0%
	IMAGE_GIVEN = 0%
	INC_PROCNAME = 0%
	INC_RIGHTS = 0%
	INC_IO = 0%
	INC_OTHER = 0%
	INC_NETWORK = 0%
	INC_BATCH = -1%
	INC_INTERACTIVE = -1%
	NUM_INTERACTIVE = 0%
	NUM_BATCH = 0%
	NUM_NETWORK = 0%
	NUM_OTHER = 0%
	!
	! Find out where we're running.
	ITEM_LIST::ITEM(0%)::BUFFER_LEN	= BUF_LENGTH
	ITEM_LIST::ITEM(0%)::ITEM_CODE	= SYI$_NODENAME
	ITEM_LIST::ITEM(0%)::BUFFER_ADDR = LOC(RET_STRING)
	ITEM_LIST::ITEM(0%)::LENGTH_ADDR = LOC(RET_LENGTH)
	ITEM_LIST::ITEM(1%)::TERMINATOR  = 0%
	STAT = SYS$GETSYIW(,,,ITEM_LIST BY REF, IOSB(0%) BY REF,,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	CALL LIB$STOP(IOSB(0%) BY VALUE) IF (IOSB(0%) AND 1%) = 0%
	MYNODE = LEFT$(RET_STRING,RET_LENGTH)
	NODES = LEFT$(MYNODE,5%) + "*"
	!
	! Parse command line.
	STAT = LIB$GET_FOREIGN(COMMAND_LINE,,OUT_LEN,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	COMMAND_LINE = EDIT$(COMMAND_LINE,4%+8%+16%+32%+128%)
	!
	! Start our primitive parse of the command line
	Y = POS(COMMAND_LINE,"/",0%)		! First slash (/)
	WHILE Y <> 0%				! While there are /'s
	Z = POS(COMMAND_LINE,"/",Y+1%)		! Next / after Y
	X = POS(COMMAND_LINE," ",Y+1%)		! Next space after Y
	IF (Z = 0%) THEN Z = X \ END IF		! If no /, end @ space
	IF (X <> 0%) AND (X < Z) THEN Z = X \ END IF ! Space before /, end@space
	Z = LEN(COMMAND_LINE) + 1% IF Z = 0%	! No space or slash, end @ end+1
	QUALIFIER = SEG$(COMMAND_LINE,Y+1%,Z-1%) ! Extract qualifier
	COMMAND_LINE = LEFT$(COMMAND_LINE,Y-1%) + RIGHT$(COMMAND_LINE,Z)
	X = POS(QUALIFIER,"=",0%)
	IF X <> 0%
	    THEN
		QVALUE = RIGHT$(QUALIFIER,X+1%)
		QUALIFIER = LEFT$(QUALIFIER,X-1%)
	END IF
	SELECT QUALIFIER
		CASE "IO"
			INC_IO = -1%
		CASE "NOIO"
			INC_IO = 0%
		CASE "IN" TO "INTERACTIVE"
			INC_INTERACTIVE = -1%
		CASE "NOI" TO "NOINTERACTIVE"
			INC_INTERACTIVE = 0%
		CASE "BA" TO "BATCH"
			INC_BATCH = -1%
		CASE "NOB" TO "NOBATCH"
			INC_BATCH = 0%
		CASE "OT" TO "OTHER"
			INC_OTHER = -1%
		CASE "NOO" TO "NOOTHER"
			INC_OTHER = 0%
		CASE "NE" TO "NETWORK"
			INC_NETWORK = -1%
		CASE "NON" TO "NONETWORK"
			INC_NETWORK = 0%
		CASE "PR" TO "PROCESS_NAME"
			INC_PROCNAME = -1%
		CASE "NOP" TO "NOPROCESS_NAME"
			INC_PROCNAME = 0%
		CASE "RI" TO "RIGHTS"
			INC_RIGHTS = -1%
		CASE "NOR" TO "NORIGHTS"
			INC_RIGHTS = 0%
		CASE "I" TO "IMAGE"
			IMAGE_GIVEN = -1%
			IMAGE_MATCH = QVALUE
		CASE "N" TO "NODE"
			NODES = MYNODE
			NODES = QVALUE IF QVALUE <> ""
			NODE_GIVEN = -1%
		CASE ELSE
		    PRINT "%SYSTAT-I-UNK, unknown qualifier: ";QUALIFIER
	END SELECT		
	Y = POS(COMMAND_LINE,"/",0%)		! Find remaining /'s
	NEXT 					! Y <> 0%; /'s to parse
	!
	COMMAND_LINE = EDIT$(COMMAND_LINE,2%)
	NODES = "*" IF (COMMAND_LINE <> "") AND (NOT NODE_GIVEN)
	!
	PRINT	"-------- System Status on Node(s) " + NODES + " at " + &
		TIME$(0%) + ", " + DATE$(0%) + " --------"
	PRINT
	!
	IF NOT (INC_INTERACTIVE OR INC_BATCH OR INC_NETWORK OR INC_OTHER)
	    THEN
		PRINT "%SYSTAT-F-NOMODES, all modes excluded!"
		CALL LIB$STOP(FATAL BY VALUE)
	END IF
	!======================================================================
	! BEGIN_SORT				Set up sort
	! PROCESS_SCAN				Set up GETJPIW
	! LOOP:
	!	GETJPIW				Get process info
	!	Trim image name, rights info
	!	RELEASE_REC			Give it to sort
	! SORT_MERGE				Sort data
	! GETTIM				Get current time
	! LOOP:
	!	RETURN_REC			Get & format data
	!		SUB_TIMES		
	!		CVT_TO_INTERNAL_TIME
	!		IDTOASC
	!		ASCTIM
	!		FAO
	! END_SORT				End sort
	NUMRECORDS = 0%
	KEYBUFFER(0%) = 3%		! Three keys
	! Username
	KEYBUFFER(1%) = DSC$K_DTYPE_T	! Text key
	KEYBUFFER(2%) = 0%		! Ascending order
	KEYBUFFER(3%) = 0%		! Offset in record
	KEYBUFFER(4%) = 12%		! Key size
	! Mode
	KEYBUFFER(5%) = DSC$K_DTYPE_LU	! Longword
	KEYBUFFER(6%) = 1%		! Descending order
	KEYBUFFER(7%) = 67%		! Offset in record
	KEYBUFFER(8%) = 4%		! Key size
	! Login time
	KEYBUFFER(9%) = DSC$K_DTYPE_QU	! Quadword
	KEYBUFFER(10%) = 0%		! Ascending order
	KEYBUFFER(11%) = 43%		! Offset in record
	KEYBUFFER(12%) = 8%		! Key size
	!
	RECLENGTH = 343%		! Record size
	WORKFILES = 0%			! Sort in memory
	! Set up the sort
	STAT = SOR$BEGIN_SORT(KEYBUFFER(0%) BY REF,	&
	                      RECLENGTH BY REF,,,,,,	&
	                      WORKFILES BY REF,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	! Set up PROCESS_SCAN
	CONTEXT = 0%
	ITEM_LIST::ITEM(0%)::BUFFER_LEN	= 0%
	ITEM_LIST::ITEM(0%)::ITEM_CODE	= PSCAN$_GETJPI_BUFFER_SIZE
	ITEM_LIST::ITEM(0%)::BUFFER_ADDR = 1720%
	ITEM_LIST::ITEM(0%)::LENGTH_ADDR = 0%
	RET_STRING = NODES
	ITEM_LIST::ITEM(1%)::BUFFER_LEN	= LEN(NODES)
	ITEM_LIST::ITEM(1%)::ITEM_CODE	= PSCAN$_NODENAME
	ITEM_LIST::ITEM(1%)::BUFFER_ADDR = LOC(RET_STRING)
	IF POS(NODES,"*",0%)=0% AND POS(NODES,"%",0%)=0%
	    THEN
		ITEM_LIST::ITEM(1%)::LENGTH_ADDR = PSCAN$M_EQL
	    ELSE
		ITEM_LIST::ITEM(1%)::LENGTH_ADDR = PSCAN$M_WILDCARD
	END IF
	Z = 2%
	IF COMMAND_LINE <> ""
	    THEN
		ONE_STRING = COMMAND_LINE
		! This next mess is to take care of a strange problem with
		! matching trailing spaces in the username field.  It does
		! *not* work as you'd expect or as the other wildcards do.
		X = 12%    ! Pass 12 to match trailing spaces in usernames
		IF POS(ONE_STRING,"*",0%) <> 0%
		    THEN
			X = LEN(COMMAND_LINE)
			IF X < 11% AND POS(COMMAND_LINE,"*",X) = 0%
			    THEN
				ONE_STRING = COMMAND_LINE + " *"
				X = LEN(COMMAND_LINE) + 2%
			END IF
		END IF
		ITEM_LIST::ITEM(Z)::BUFFER_LEN	= X ! 12 unless wildcard trick
		ITEM_LIST::ITEM(Z)::ITEM_CODE	= PSCAN$_USERNAME
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = LOC(ONE_STRING)
		IF POS(COMMAND_LINE,"*",0%)=0% AND POS(COMMAND_LINE,"%",0%)=0%
		    THEN
			ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_EQL
		    ELSE
			ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_WILDCARD
		END IF
		Z = Z + 1%
	END IF
	Y = 0%
	IF INC_INTERACTIVE
	    THEN
		ITEM_LIST::ITEM(Z)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(Z)::ITEM_CODE	= PSCAN$_MODE
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = JPI$K_INTERACTIVE
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_EQL
		Y = Z
		Z = Z + 1%
	END IF
	IF INC_BATCH
	    THEN
		ITEM_LIST::ITEM(Z)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(Z)::ITEM_CODE	= PSCAN$_MODE
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = JPI$K_BATCH
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_EQL
		Y = Z IF Y = 0%
		Z = Z + 1%
	END IF
	IF INC_NETWORK
	    THEN
		ITEM_LIST::ITEM(Z)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(Z)::ITEM_CODE	= PSCAN$_MODE
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = JPI$K_NETWORK
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_EQL
		Y = Z IF Y = 0%
		Z = Z + 1%
	END IF
	IF INC_OTHER
	    THEN
		ITEM_LIST::ITEM(Z)::BUFFER_LEN	= 0%
		ITEM_LIST::ITEM(Z)::ITEM_CODE	= PSCAN$_MODE
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = JPI$K_OTHER
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = PSCAN$M_EQL
		Y = Z IF Y = 0%
		Z = Z + 1%
	END IF
	ITEM_LIST::ITEM(Z)::TERMINATOR  = 0%
	IF Y <> 0%
	     THEN
		Z = Z - 2%
		FOR X = Y TO Z
		ITEM_LIST::ITEM(X)::LENGTH_ADDR = PSCAN$M_EQL OR PSCAN$M_OR
		NEXT X
	END IF
	STAT = SYS$PROCESS_SCAN(CONTEXT BY REF,	&
	                        ITEM_LIST BY REF)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	! Set up GETJPI
	! 0) GETJPI control flags
	ITEM_LIST::ITEM(0%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(0%)::ITEM_CODE   = JPI$_GETJPI_CONTROL_FLAGS
	ITEM_LIST::ITEM(0%)::BUFFER_ADDR = LOC(JPICONTROL)
	ITEM_LIST::ITEM(0%)::LENGTH_ADDR = LOC(RETLEN(0%))
	!
	! 1) Username
	ITEM_LIST::ITEM(1%)::BUFFER_LEN  = 12%
	ITEM_LIST::ITEM(1%)::ITEM_CODE   = JPI$_USERNAME
	ITEM_LIST::ITEM(1%)::BUFFER_ADDR = LOC(USERNAME)
	ITEM_LIST::ITEM(1%)::LENGTH_ADDR = LOC(RETLEN(1%))
	!
	! 2) Image name
	ITEM_LIST::ITEM(2%)::BUFFER_LEN  = JPILIMAGNAME
	ITEM_LIST::ITEM(2%)::ITEM_CODE   = JPI$_IMAGNAME
	ITEM_LIST::ITEM(2%)::BUFFER_ADDR = LOC(JPIIMAGNAME)
	ITEM_LIST::ITEM(2%)::LENGTH_ADDR = LOC(RETLEN(2%))
	!
	! 3) Process ID
	ITEM_LIST::ITEM(3%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(3%)::ITEM_CODE   = JPI$_PID
	ITEM_LIST::ITEM(3%)::BUFFER_ADDR = LOC(PID)
	ITEM_LIST::ITEM(3%)::LENGTH_ADDR = LOC(RETLEN(3%))
	!
	! 4) Login time
	ITEM_LIST::ITEM(4%)::BUFFER_LEN  = 8%
	ITEM_LIST::ITEM(4%)::ITEM_CODE   = JPI$_LOGINTIM
	ITEM_LIST::ITEM(4%)::BUFFER_ADDR = LOC(LOGINTIM(0%))
	ITEM_LIST::ITEM(4%)::LENGTH_ADDR = LOC(RETLEN(4%))
	!
	! 5) CPU time
	ITEM_LIST::ITEM(5%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(5%)::ITEM_CODE   = JPI$_CPUTIM
	ITEM_LIST::ITEM(5%)::BUFFER_ADDR = LOC(CPUTIM)
	ITEM_LIST::ITEM(5%)::LENGTH_ADDR = LOC(RETLEN(5%))
	!
	! 6) Global page count OR Buffered IO
	ITEM_LIST::ITEM(6%)::BUFFER_LEN  = 4%
	IF INC_IO
	    THEN
		ITEM_LIST::ITEM(6%)::ITEM_CODE   = JPI$_BUFIO
	    ELSE
		ITEM_LIST::ITEM(6%)::ITEM_CODE   = JPI$_GPGCNT
	END IF
	ITEM_LIST::ITEM(6%)::BUFFER_ADDR = LOC(GPGCNT)
	ITEM_LIST::ITEM(6%)::LENGTH_ADDR = LOC(RETLEN(6%))
	!
	! 7) Private page count OR Direct IO
	ITEM_LIST::ITEM(7%)::BUFFER_LEN  = 4%
	IF INC_IO
	    THEN
		ITEM_LIST::ITEM(7%)::ITEM_CODE   = JPI$_DIRIO
	    ELSE
		ITEM_LIST::ITEM(7%)::ITEM_CODE   = JPI$_PPGCNT
	END IF
	ITEM_LIST::ITEM(7%)::BUFFER_ADDR = LOC(PPGCNT)
	ITEM_LIST::ITEM(7%)::LENGTH_ADDR = LOC(RETLEN(7%))
	!
	! 8) Mode 
	ITEM_LIST::ITEM(8%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(8%)::ITEM_CODE   = JPI$_MODE
	ITEM_LIST::ITEM(8%)::BUFFER_ADDR = LOC(PROCMODE)
	ITEM_LIST::ITEM(8%)::LENGTH_ADDR = LOC(RETLEN(8%))
	!
	! 9) State
	ITEM_LIST::ITEM(9%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(9%)::ITEM_CODE   = JPI$_STATE
	ITEM_LIST::ITEM(9%)::BUFFER_ADDR = LOC(PROCSTATE)
	ITEM_LIST::ITEM(9%)::LENGTH_ADDR = LOC(RETLEN(9%))
	!
	!10) Master PID (to determine subprocess)
	ITEM_LIST::ITEM(10%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(10%)::ITEM_CODE   = JPI$_MASTER_PID
	ITEM_LIST::ITEM(10%)::BUFFER_ADDR = LOC(MASTERPID)
	ITEM_LIST::ITEM(10%)::LENGTH_ADDR = LOC(RETLEN(10%))
	!
	!11) Event flag wait mask (for MWAIT)
	ITEM_LIST::ITEM(11%)::BUFFER_LEN  = 4%
	ITEM_LIST::ITEM(11%)::ITEM_CODE   = JPI$_EFWM
	ITEM_LIST::ITEM(11%)::BUFFER_ADDR = LOC(PROCEFWM)
	ITEM_LIST::ITEM(11%)::LENGTH_ADDR = LOC(RETLEN(11%))
	!
	! Process name
	Z = 12%
	IF INC_PROCNAME
	    THEN
		ITEM_LIST::ITEM(Z)::BUFFER_LEN  = 15%
		ITEM_LIST::ITEM(Z)::ITEM_CODE   = JPI$_PRCNAM
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = LOC(PROCNAME)
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = LOC(RETLEN(Z))
		Z = Z + 1%
	END IF
	IF INC_RIGHTS
	    THEN
		! Rights
		ITEM_LIST::ITEM(Z)::BUFFER_LEN  = 512%
		ITEM_LIST::ITEM(Z)::ITEM_CODE   = JPI$_PROCESS_RIGHTS
		ITEM_LIST::ITEM(Z)::BUFFER_ADDR = LOC(PROCRIGHTS(1%))
		ITEM_LIST::ITEM(Z)::LENGTH_ADDR = LOC(PROCRIGHTS(0%))
		Z = Z + 1%
	END IF
	ITEM_LIST::ITEM(Z)::TERMINATOR  = 0%
	!
	JPICONTROL = JPI$M_NO_TARGET_INSWAP OR JPI$M_IGNORE_TARGET_STATUS
	!
	!======================================================================
	! Start the information gathering loop
	STAT = 0%
	WHILE STAT <> SS$_NOMOREPROC
	!
	STAT = SYS$GETJPIW(,CONTEXT BY REF,,	&
	                   ITEM_LIST BY REF,	&
	                   IOSB(0%) BY REF,,)
	IF STAT = SS$_NOMOREPROC THEN ITERATE \ END IF
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	IF IOSB(0%) = SS$_NOMOREPROC THEN ITERATE \ END IF
	CALL LIB$STOP(IOSB(0%) BY VALUE) IF (IOSB(0%) AND 1%) = 0%
	!
	USERNAME = ""		IF RETLEN(1%) = 0%
	JPIIMAGNAME = ""	IF RETLEN(2%) = 0%
	PID = 0%		IF RETLEN(3%) = 0%
	LOGINTIM(0%) = -1%	IF RETLEN(4%) = 0%
	LOGINTIM(1%) = -1%	IF RETLEN(4%) = 0%
	CPUTIM = -1%		IF RETLEN(5%) = 0%
	GPGCNT = -1%		IF RETLEN(6%) = 0%
	PPGCNT = -1%		IF RETLEN(7%) = 0%
	PROCMODE = -1%		IF RETLEN(8%) = 0%
	PROCSTATE = -1%		IF RETLEN(9%) = 0%
	MASTERPID = PID		IF RETLEN(10%) = 0%
	PROCEFWM = 0%		IF RETLEN(11%) = 0%
	PROCNAME = ""		IF RETLEN(12%) = 0%
	!
	!
	! Copy array of identifiers and attributes to array of just identifiers
	IF INC_RIGHTS
	    THEN
		RIGHTS(0%) = PROCRIGHTS(0%)/8%
		FOR X = 1 TO RIGHTS(0%)
		Y = 2%*X - 1%
		RIGHTS(X) = PROCRIGHTS(Y)
		NEXT X
	END IF
	!
	! Get file name part from image
	STAT = SYS$FILESCAN(JPIIMAGNAME BY DESC,	&
	                    IMAGNAMELEN BY REF,)
	X = IMAGNAMEADDR - LOC(JPIIMAGNAME) + 1%
	Y = MIN(IMAGNAMELEN,16%)
	IMAGNAME = MID$(JPIIMAGNAME,X,Y)
	IF IMAGE_GIVEN
	    THEN
		IF POS(IMAGE_MATCH,"*",0%)=0% AND POS(IMAGE_MATCH,"%",0%)=0%
		    THEN
			ITERATE IF IMAGNAME <> IMAGE_MATCH
		    ELSE
			IMAGE_TO_MATCH = EDIT$(IMAGNAME,2%)
			STAT = STR$MATCH_WILD(IMAGE_TO_MATCH BY DESC,	&
			                      IMAGE_MATCH BY DESC)
			ITERATE IF STAT = STR$_NOMATCH
		END IF
	END IF
	!
	! Pass the record to the sort routine
	STAT = SOR$RELEASE_REC(SORT_REC BY DESC,)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	NUMRECORDS = NUMRECORDS + 1%
	!
	NEXT	! STAT <> SS$_NOMOREPROC
	!======================================================================
	HEADER = "  PID    Username "
	IF INC_PROCNAME
	    THEN
		HEADER = HEADER + "    Process-Name        State M   "
	    ELSE
		HEADER = HEADER + "Elapsed-Time  CPU-Time  State M   "
	END IF
	IF INC_IO
	    THEN
		HEADER = HEADER + "BIO/DIO   Image"
	    ELSE
		HEADER = HEADER + "Gbl/Mem   Image"
	END IF
	PRINT HEADER UNLESS NUMRECORDS = 0%
	!
	! Actually do the sort
	STAT = SOR$SORT_MERGE()
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	! Get the current time
	STAT = SYS$GETTIM(CURTIM(0%) BY REF)
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	!
	!======================================================================
	! Start the loop to format and print the records
	FOR X = 1 TO NUMRECORDS
	!
	! Get a record back from sort
	STAT = SOR$RETURN_REC(SORT_REC BY DESC,	&
	                      RET_LENGTH BY REF,)
	!
	! Memory is the sum of global and process-private pages
	IF INC_IO
	    THEN
		MEMORY = PPGCNT ! Really Direct I/Os
	    ELSE
		MEMORY = PPGCNT + GPGCNT
	END IF
	!
	! |El Time|
	!0000 00:00:00.00 Delta time format
	!  |CPU Time |
	!
	IF (LOGINTIM(0%) = -1% AND LOGINTIM(1%) = -1%)
	    THEN
		ETIME = SPACE$(9%)
	ELSE
		STAT = LIB$SUB_TIMES(CURTIM(0%) BY REF,LOGINTIM(0%) BY REF, &
				DELTATIM(0%) BY REF)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		STAT = SYS$ASCTIM(RET_LENGTH BY REF, &
		                  RET_STRING BY DESC, &
		                  DELTATIM(0%) BY REF,)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		ETIME = MID$(RET_STRING,2%,9%)
	END IF
	IF CPUTIM = -1%
	    THEN
		CPUTIME = SPACE$(11%)
	ELSE
		CPUTIM = (CPUTIM+50%)/100%
		CPUTIM = 1% IF CPUTIM = 0% ! Minimum 1 second or CVT bombs
		STAT = LIB$CVT_TO_INTERNAL_TIME(OPERATION BY REF,	&
		                                CPUTIM BY REF,		&
		                                CPUDELTA(0%) BY REF)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		STAT = SYS$ASCTIM(RET_LENGTH BY REF, &
		                  RET_STRING BY DESC, &
		                  CPUDELTA(0%) BY REF,)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		CPUTIME = MID$(RET_STRING,3%,11%)
	END IF
	!
	! Translate process mode to a letter
	SELECT PROCMODE
	    CASE JPI$K_OTHER
		PMODE = "O"
		USERNAME = "(swapper)" IF EDIT$(USERNAME,2%) = "" AND MEMORY=0%
		NUM_OTHER = NUM_OTHER + 1%
	    CASE JPI$K_NETWORK
		PMODE = "N"
		NUM_NETWORK = NUM_NETWORK + 1%
	    CASE JPI$K_BATCH
		PMODE = "B"
		NUM_BATCH = NUM_BATCH + 1%
	    CASE JPI$K_INTERACTIVE
		PMODE = "I"
		NUM_INTERACTIVE = NUM_INTERACTIVE + 1%
	    CASE ELSE
		PMODE = "U"
	END SELECT
	!
	! Translate process state; values from $STATEDEF in LIB.MLB
	SELECT PROCSTATE
	    CASE  3% !SCH$C_CEF
		PSTATE = "CEF"
	    CASE 12% !SCH$C_COM
		PSTATE = "COM"
	    CASE 13% !SCH$C_COMO
		PSTATE = "COMO"
	    CASE 14% !SCH$C_CUR
		PSTATE = "CUR"
	    CASE  1% !SCH$C_COLPG
		PSTATE = "COLPG"
	    CASE 11% !SCH$C_FPG
		PSTATE = "FPG"
	    CASE  7% !SCH$C_HIB
		PSTATE = "HIB"
	    CASE  8% !SCH$C_HIBO
		PSTATE = "HIBO"
	    CASE  5% !SCH$C_LEF
		PSTATE = "LEF"
	    CASE  6% !SCH$C_LEFO
		PSTATE = "LEFO"
	    CASE  2% !SCH$C_MWAIT
		! Translate MWAIT state; values from $RSNDEF in LIB.MLB
		SELECT PROCEFWM
		    CASE  1% ! RSN$_ASTWAIT	AST wait
			PSTATE = "RWAST"
		    CASE  2% ! RSN$_MAILBOX	Mailbox full
			PSTATE = "RWMBX"
		    CASE  3% ! RSN$_NPDYNMEM	Nonpaged dynamic memory
			PSTATE = "RWNPG"
		    CASE  4% ! RSN$_PGFILE	Page file full
			PSTATE = "RWPFF"
		    CASE  5% ! RSN$_PGDYNMEM	Paged dynamic memory
			PSTATE = "RWPAG"
		    CASE  6% ! RSN$_BRKTHRU	Breakthrough
			PSTATE = "RWBRK"
		    CASE  7% ! RSN$_IACLOCK	Image activation lock
			PSTATE = "RWIMG"
		    CASE  8% ! RSN$_JQUOTA	Job pooled quota
			PSTATE = "RWQUO"
		    CASE  9% ! RSN$_LOCKID	Lock identifier
			PSTATE = "RWLCK"
		    CASE 10% ! RSN$_SWPFILE	Swap file space
			PSTATE = "RWSWP"
		    CASE 11% ! RSN$_MPLEMPTY	Modified page list empty
			PSTATE = "RWMPE"
		    CASE 12% ! RSN$_MPWBUSY	Modified page writer busy
			PSTATE = "RWMPB"
		    CASE 13% ! RSN$_SCS		Distributed lock manager wait
			PSTATE = "RWSCS"
		    CASE 14% ! RSN$_CLUSTRAN	Cluster transition
			PSTATE = "RWCLU"
		    CASE 15% ! RSN$_CPUCAP	CPU capability
			PSTATE = "RWCAP"
		    CASE 16% ! RSN$_CLUSRV	Cluster server process
			PSTATE = "RWCSV"
		    CASE 17% ! RSN$_SNAPSHOT	Snapshot
			PSTATE = "RWSNP"
		    CASE 18% ! RSN$_MAX		Max
			PSTATE = "RWMAX"		
		    CASE < 0% ! System address of MUTEX
			PSTATE = "MUTEX"
		    CASE ELSE ! Other unknown
			PSTATE = "MWAIT"
		END SELECT
	    CASE  4% !SCH$C_PFW
		PSTATE = "PFW"
	    CASE  9% !SCH$C_SUSP
		PSTATE = "SUSP"
	    CASE 10% !SCH$C_SUSPO
		PSTATE = "SUSPO"
	    CASE ELSE
		PSTATE = "UNK"
	END SELECT
	!
	IF PID <> MASTERPID
	    THEN
		SUBPROC = "s"
	    ELSE
		SUBPROC = " "
	END IF
	! Now, format the results
	!12345678 123456789012 00 00:00 0 00:00:00 12345 12 123/12345 123456789012123456
	IF INC_PROCNAME
	    THEN
		TIME_OR_NAME = " " + EDIT$(PROCNAME,4%)
	    ELSE
		TIME_OR_NAME = ETIME + CPUTIME
	END IF
	STAT = SYS$FAO("!8XL !12AS!20AS !5AS!1AS!1AS!6UL/!6<!UL!>!16AS", &
		RET_LENGTH BY REF, RET_STRING BY DESC, PID BY VALUE,	&
		USERNAME BY DESC, TIME_OR_NAME BY DESC,			&
		PSTATE BY DESC, SUBPROC BY DESC, PMODE BY DESC,		&
		GPGCNT BY VALUE, MEMORY BY VALUE, IMAGNAME BY DESC)
	CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
	STATUS_LINE = LEFT$(RET_STRING,RET_LENGTH)
	!
	! Tack on the rights if we're doing this, too.
	IF INC_RIGHTS
	    THEN
		STATUS_LINE = STATUS_LINE + "  "
		FOR Y = 1 TO RIGHTS(0%)
		STAT = SYS$IDTOASC(RIGHTS(Y) BY VALUE,		&
		                   RET_LENGTH BY REF,		&
		                   RET_STRING BY DESC,		&
		                   ,,,)
		CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
		RIGHTSNAME = EDIT$(LEFT$(RET_STRING,RECLENGTH),2%)
		SELECT RIGHTSNAME
		    CASE "INTERACTIVE"
		    CASE "BATCH"
		    CASE "NETWORK"
		    CASE "LOCAL"
		    CASE ELSE
			IF EDIT$(USERNAME,2%) <> RIGHTSNAME
			    THEN
				STATUS_LINE = STATUS_LINE + " " + RIGHTSNAME
			END IF
		END SELECT
		NEXT Y
	END IF
	!
	! Finally, print the status line.
	PRINT EDIT$(STATUS_LINE,128%)
	!
	NEXT X
	!======================================================================
	! We're done, so tell sort and hit the road
	STAT = SOR$END_SORT()
	CALL LIB$STOP(STAT BY VALUE) IF (STAT AND 1%) = 0%
	PRINT
	STAT = SYS$FAO("-----  !UL record!%S:  !UL Interactive  !UL Batch  !UL Network  !UL Other  -----", &
		RET_LENGTH BY REF, RET_STRING BY DESC,		&
		NUMRECORDS BY VALUE, NUM_INTERACTIVE BY VALUE,	&
		NUM_BATCH BY VALUE, NUM_NETWORK BY VALUE,	&
		NUM_OTHER BY VALUE)
	CALL LIB$SIGNAL(STAT BY VALUE) IF (STAT AND 1%) = 0%
	PRINT LEFT$(RET_STRING,RET_LENGTH)
	END