TITLE TYPIDS - Type all PIDs and their associated information
SUBTTL  Irwin L. Goverman/ILG/PJT/DC 18-Oct-78 


	SEARCH	GLXMAC			;LOAD GALAXY SYSTEM SYMBOLS
	PROLOG(TYPIDS)			;DECLARE NAME, ETC...

	TYPVER==1			;VERSION
	TYPEDT==107			;EDIT LEVEL
	TYPWHO==0
	TYPMIN==0

	%%.TYP==<VRSN.(TYP)>		;MAKE INTO VERSION NUMBER




SUBTTL Definitions and Storage

	ND	MAXJOB,^D250		;MAXIMUM NUMBER OF JOBS
	ND	STACKL,^D100		;SIZE OF STACK

	SYSPRM	.JIJNO,0		;DEFINE -10 JOB DATA OFFSETS
	SYSPRM	.JIUNO,1		;FOR VARIOUS STUFF
	SYSPRM	.JIPNM,2
	SYSPRM	.JIDFS,.JIPNM		;TOTAL LENGTH NEEDED
	SYSPRM	NAMLOC,.IPCI2,.IPCI1	;WHERE NAME STARTS IN INFO RESPONSE
	SYSPRM	OFFSET,1,2		;WORDS PER PID IN MB
	SYSPRM	MBSIZ,12,^D200		;WORDS OF JOB PID TABLE


MB:	BLOCK	MBSIZ			;BLOCK FOR PIDS

JB:	BLOCK	.JIDFS+1		;JOB INFORMATION BLOCK

IB:	$BUILD(IB.SZ)
	  $SET(IB.PRG,,%%.MOD)		;SET PROGRAM NAME
	  $SET(IB.OUT,,T%TTY)		;AND DEFAULT OUTPUT ROUTINE
	  $SET(IB.PIB,,PIB)		;AIM AT PID BLOCK
	$EOB

PIB:	$BUILD	(PB.MNS)		;MINIMAL PID
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;NOTHING SPECIAL, JUST GET A PID
	$EOB

ENTVEC:	JRST	TYPIDS			;ENTRY VECTOR
	JRST	TYPIDS
	EXP	%%.TYP			;VERSION

	LOC	137
	EXP	%%.TYP
	RELOC

STACK:	BLOCK	STACKL			;PUSHDOWN LIST


INFSAB:	$BUILD	SAB.SZ
	$SET	(SAB.LN,,INFMSL)	;LENGTH OF MSG
	$SET	(SAB.MS,,INFMS)		;MESSAGE ADRS
	$SET	(SAB.SI,SI.FLG,1)	;SEND BY SPECIAL INDEX
	$SET	(SAB.SI,SI.IDX,SP.INF)	;SEND TO SYSTEM INFO
	$EOB

INFMS:	EXP	.IPCIG			;GET NAME FROM PID
	BLOCK	^D7			;PLACE FOR NAME
	INFMSL==.-INFMS			;SIZE OF THE MESSAGE

	SUBTTL	Special PID tables

	DEFINE .SPID(CANNAM,T10VAL,T20VAL,SIXNAM),<
IFNB <SIXNAM>,<	SIXBIT\SIXNAM\>
IFB  <SIXNAM>,<	SIXBIT\******\>
	>

	SIXBIT	/      /		;No match on pid, type blanks
NAMTAB:	SPIDS
	  NAMTBL==.-NAMTAB

	DEFINE .SPID(CANNAM,T10VAL,T20VAL,SIXNAM),<
	CANNAM
	>

;Build a table of the indicies themselves
PIDIDX:	SPIDS

PIDTAB:	BLOCK	NAMTBL			;PIDS OF SYSTEM COMPONENTS
SUBTTL Main Program Loop

TYPIDS:	RESET
	MOVE	P,[IOWD STACKL,STACK]	;SET UP STACK POINTER
	DMOVE	S1,[EXP IB.SZ,IB]	;POINT TO THE INIT BLOCK
	$CALL	I%INIT##		;INITIALIZE EVERTHING
	$CALL	RDPIDS		;READ SYSTEM PIDS
TOPS10 <
	PJOB	S1,			;GET OUR JOB NUMBER
	$CALL	GETJOB		;SEE IF WE CAN READ OUR OWN STUFF
					;IF NOT, GETJOB WILL $FATAL IMMEDIATELY
>;END TOPS10

MAIN:	MOVSI	P1,-MAXJOB		;GET MAXIMUM JOB NUMBER AS COUNTER
	$TEXT(,<Job    User        Program       PID   JWP NOA SYSPID  Name>)
	$TEXT(,<---    ----        -------       ---   --- --- ------  ---->)

MAIN.1:	HRRZ	S1,P1			;GET JOB NUMBER
	$CALL	GETJOB		;GET JOB DATA SET UP
	JUMPF	MAIN.2			;IF NOT A JOB, SKIP DISPLAY
	$CALL	DISPID		;DISPLAY ALL THE PID INFORMATION
MAIN.2:	AOBJN	P1,MAIN.1		;REPEAT FOR ALL THE JOBS
	JRST	I%EXIT			;THEN EXIT
SUBTTL DISPID - Display PID information for one job

DISPID:	MOVEI	T1,MB+2			;GET ADDR OF FIRST PID

DISP.1:	SKIPN	0(T1)			;A PID HERE?
	$RETT				;NO, SO WE ARE DONE
	MOVE	S1,0(T1)		;GET THE PID
	MOVEM	S1,INFMS+.IPCI2		;STORE INTO [SYSTEM]INFO BLOCK
	DMOVE	S1,[EXP SAB.SZ,INFSAB]	;SIZE AND LOC OF MESSAGE
	$CALL	C%SEND		;SEND IT TO INFO
	SKIPT				;DID IT WORK?
	$STOP(SIF,Send to [SYSTEM]INFO failed)

DISP.2:	$CALL	C%BRCV		;WAIT FOR THE ANSWER
	SKIPT				;CHECK FOR ERRORS
	$STOP(ERI,Error receiving from [SYSTEM]INFO)
	MOVE	S2,MDB.SI(S1)		;GET SPECIAL INDEX
	TXZE	S2,SI.FLG		;IS THIS SPECIAL
	CAXE	S2,SP.INF		;AND FROM INFO?
	JRST	[ PUSHJ P,C%REL		;NO, LET GO OF MESSAGE
		  JRST DISP.2 ]		;AND TRY AGAIN
	LOAD	T2,MDB.MS(S1),MD.ADR	;GET ADDRESS OF RESPONSE
	LOAD	S2,MDB.MS(S1),MD.CNT	;GET LENGTH OF MESSAGE
	ADD	S2,T2			;POINT TO LAST WORD
	SETZM	(S2)			;AND CLEAR IT
	LOAD	S2,MDB.FG(S1),IP.CFE	;GET ERROR FLAGS FROM MESSAGE
	SKIPE	S2			;ARE THERE ERRORS?
	SETZM	NAMLOC(T2)		;YES, CLEAR ANYTHING IN NAME WORD
	MOVEI	T3,NAMTBL-1		;GET MAX OFFSET INTO SYS PID TBL
	MOVE	S1,0(T1)		;GET THE PID UNDER CONSIDERATION
	CAME	S1,PIDTAB(T3)		;A MATCH?
	SOJGE	T3,.-1			;NO, LOOP IF MORE
	MOVE	S1,T1			;GET POINTER
	$CALL	SETFLG		;SET UP THE FLAGS
	$TEXT(,<^D3R/JB+.JIJNO/  ^U12/JB+.JIUNO/  ^W6/JB+.JIPNM/^A>)
	$TEXT(,<^O13/0(T1)/  ^6/S1/   ^6/S2/  ^W6/NAMTAB(T3)/  ^T/NAMLOC(T2)/>)
	ADDI	T1,OFFSET		;STEP TO NEXT PID
	JRST	DISP.1			;
SUBTTL System PID table routines

;RDPIDS reads the system's pid table

RDPIDS:	$CALL	.SAVE1		;GET ONE AC
	MOVSI	P1,-NAMTBL		;GET SIZE OF TABLE SET UP

RDPI.1:	LOAD	S1,PIDIDX(P1)		;GET THE SP.XXX SYMBOL FOR SYS JOB
	$CALL	C%RPRM		;AND READ IT'S PID
	SKIPT				;MONITOR MAY NOT HAVE ONE
	SETZ	S1,			;IF SO, CLEAR THE PID
	STORE	S1,PIDTAB(P1)		;REMEMBER PID GOTTEN
	AOBJN	P1,RDPI.1		;LOOP FOR ALL WE KNOW ABOUT
	$RETT				;AND THEN RETURN
SUBTTL GETJOB  --  Set up job data and PIDs

;CALL IS:	S1/ Job number
;
;TRUE RETURN:	Job is existent
;FALSE RETURN:	No job with this job number exists

GETJOB:
TOPS20 <
	$CALL	.SAVET		;NEED T1
	MOVE	S2,[-<.JIDFS+1>,,JB]	;PLACE TO PUT JOB INFORMATION
	MOVX	T1,.JIJNO		;FIRST WORD TO FETCH
	GETJI				;GET THE JOB INFORMATION
	  $RETF
	MOVX	S1,.MUFJP		;FIND JOB'S PID
	MOVEM	S1,MB+0			;IS THE FUNCTION
	MOVE	S1,JB+.JIJNO		;GET JOB NUMBER
	MOVEM	S1,MB+1			;STORE IT AWAY
	DMOVE	S1,[EXP MBSIZ,MB]	;SIZE,LOCATION OF MUTIL BLOCK
	MUTIL				;SEE IF ANY PIDS
	  $STOP(PQF,PID query failed)
	$RETT				;AND RETURN

> ;END OF TOPS20

TOPS10 <
	$CALL	.SAVE2		;SAVE TWO ACS
	MOVE	P1,S1			;COPY JOB NUMBER
	MOVEM	S1,JB+.JIJNO		;AND STORE INTO JOB DATA BLOCK
	HRLZ	S1,P1			;GET JOB NUMBER
	HRRI	S1,.GTPPN		;AND THEN PPN
	GETTAB	S1,
	  SETZ	S1,			;IF ILLEGAL, CLEAR PPN
	JUMPE	S1,.RETF		;IF NO PPN, NOT LOGGED IN
	MOVEM	S1,JB+.JIUNO		;STORE USER NUMBER
	HRLZ	S1,P1			;COPY JOB NUMBER BACK
	HRRI	S1,.GTPRG		;AND FIND PROGRAM NAME
	GETTAB	S1,			;FROM MONITOR
	  SETZ	S1,			;CLEAR IT IF IT FAILS
	MOVEM	S1,JB+.JIPNM		;STORE NAME
	MOVX	S1,.IPCSP		;FUNCTION IS GET PIDS FOR JOB
	MOVEM	S1,MB+0			;STORE IT
	MOVEM	P1,MB+1			;STORE THE JOB NUMBER
	SETZM	MB+2			;START WITH FIRST PID
	DMOVE	S1,[EXP SAB.SZ,IPCSAB]	;SEND THIS OFF TO INFO
	$CALL	C%SEND		;
	SKIPT
	$FATAL(IPCF privileges required)
	
GETJ.2:	$CALL	C%BRCV		;RECEIVE THE MESSAGE
	SKIPT				;IS IT OK?
	$STOP(RMF,Receive from monitor failed)
	MOVE	S2,MDB.SI(S1)		;GET INDEX
	TXZE	S2,SI.FLG		;IS IT SPECIAL?
	CAXE	S2,SP.IPC		;AND FROM IPCC?
	JRST	[ PUSHJ P,C%REL		;NO, FLUSH MSG
		  JRST GETJ.2 ]		;AND TRY AGAIN
	LOAD	S2,MDB.MS(S1),MD.ADR	;GET WHERE PACKET LIVES
	HRLZS	S2			;REVERSE
	HRRI	S2,MB			;AND GET THE DESTINATION
	BLT	S2,MB+MBSIZ-1		;TRANSFER IT
	$RETT				;AND RETURN


IPCSAB:	$BUILD	SAB.SZ
	$SET	(SAB.LN,,MBSIZ)		;SIZE OF MESSAGE
	$SET	(SAB.MS,,MB)		;ADDR OF MESSAGE
	$SET	(SAB.SI,SI.FLG,1)	;SEND BY SPECIAL INDEX
	$SET	(SAB.SI,SI.IDX,SP.IPC)	;SEND TO IPCC
	$EOB
> ;END OF TOPS10
SUBTTL SETFLG  --  Set flags for display line

;CALL IS:	S1/ Pointer to PID
;
;TRUE RETURN:	S1/ Indicator of "permanence"
;		S2/ Indicator of "no access"

SETFLG:
TOPS20 <
	MOVE	S2,S1			;GET COPY OF INDEX
	LOAD	S1,1(S2),IP%JWP		;GET "JOB WIDE" FLAG
	SKIPE	S1			;IF ITS ON,
	MOVEI	S1,'*'			;FLAG IT
	LOAD	S2,1(S2),IP%NOA		;IS THIS "NO ACCESS"
	SKIPE	S2			; TO OTHER PROCESSES?
	MOVEI	S2,'*'			;YES, REMEMBER IT
	$RETT				;AND RETURN
> ;END OF TOPS20


TOPS10 <
	SKIPL	0(S1)			;IF SIGN BIT LIT, PID IS TEMP
	SKIPA	S1,['*']		;ELSE IT IS PERMANENT
	MOVEI	S1,' '
	MOVEI	S2,' '			;NO ACCESS IS NEVER ON
	$RETT				;RETURN
> ;END OF TOPS10
TOPS10 <	END	TYPIDS>

TOPS20 <	END 	<3,,ENTVEC>>