Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99l-bb - qsrinf.x18
There is 1 other file named qsrinf.x18 in the archive. Click here to see a list.
TITLE	QSRINF  --  [SYSTEM]INFO For GALAXY-10 Systems
SUBTTL	Chuck O'Toole/CDO/RCB	15 Aug 84

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

	SEARCH	GLXMAC			;GLXLIB SYMOLS
	SEARCH	QSRMAC			;SEARCH QUASAR SYMBOLS

	PROLOGUE(QSRINF)		;GENERATE THE NECESSARY SYMBOLS

	.DIRECTIVE FLBLST		;FOR CLEANER LISTINGS

IFE FTINFO,<		;IF ANSWERED 'NO' TO GALGEN
	PASS2		;GIVE UP NOW
	END		;SAVE COMPUTES AND A TREE
>  ;END OF IFE FTINFO

;ALL ENTRIES THAT PROCESS MESSAGES ARE CALLED WITH
;	P1 = THE MESSAGE TYPE
;	M  = THE MESSAGE PROPER
;	T1 = PACKET FLAGS

;ALL HAVE FULL USE OF THE ACCUMULATORS
SUBTTL	Table of contents

;               TABLE OF CONTENTS FOR QSRINF
;
;
;                        SECTION                                   PAGE
;    1. Table of contents.........................................   2
;    2. Preamble..................................................   3
;    3. Explanations..............................................   4
;    4. Module storage............................................   6
;    5. P$INIT  --  [SYSTEM]INFO Initialization...................   7
;    6. Error Handling............................................   8
;    7. The system PID list.......................................   9
;    8. Process a message to [SYSTEM]INFO.........................  10
;    9. Process IPCFM. UUO request from [SYSTEM]GOPHER............  11
;   10. Common message dispatching................................  12
;   11. Dispatch table for messages to [SYSTEM]INFO from users....  14
;   12. Find PID for name  --  Function 1.........................  15
;   13. Find name for PID  --  Function 2.........................  16
;   14. Assign PIDs  --  Functions 3 and 4........................  17
;   15. Drop specific PID  --  Function 5.........................  19
;   16. Drop PIDs  --  Functions 6 and 7..........................  20
;   17. Tell others when a PID is dropped  --  Function 10........  21
;   18. Routine to allocate a system pid for P$PCPD...............  22
;   19. IPCC Request to drop PIDs  --  Function 15................  23
;   20. P$KLPD  --  Kill a PID if couldn't send to it.............  24
;   21. Privilege checking routines...............................  25
;   22. DROPIT  --  Drop a PID....................................  26
;   23. VALPID -- Validate a PID..................................  27
;   24. VALNAM  --  Validate the contents of the name.............  28
;   25. String conversion routines for VALNAM.....................  30
;   26. FNDNAM  --  Find the name sent in the PID queue...........  35
;   27. Some utility routines.....................................  36
;   28. IPCREQ -- IPCFM. dialog with [SYSTEM]IPCC.................  37
;   29. Common message blocks (pre-formatted).....................  38
;   30. INFDMP - Dump [SYSTEM]INFO database (for debugging).......  39
SUBTTL	Preamble

;	Entry points found in QSRINF

	ENTRY	P$INIT	;Initialization Entry Point
	ENTRY	P$INFO	;User request received for [SYSTEM]INFO
	ENTRY	P$IGFR	;IPCFM. UUO request (Send by GOPHER)
	ENTRY	P$PCSS	;[SYSTEM]INFO notification of RESET or LOGOUT
	ENTRY	P$KLPD	;PID in S1 is no longer valid ( Parallel to A$KLPD )
	ENTRY	INFDMP	;Debugging database dump


;	There are no stopcodes in QSRINF
SUBTTL	Explanations

COMMENT \

     When using either function 3  or  4  to  assign  a  PID  to  the  name
provided, there is only one error code defined, IPCBN% (77).  This may be a
good idea since the malicious user does not know exactly what he did wrong,
only  that it is wrong.  This same reasoning is used by LOGIN and SPRINT-10
when either the P,Pn  is  invalid  or  the  Password  specified  is  wrong.
However,  it  is  useful  to  know exactly what could generate IPCBN%.  The
following is a list of reasons why QSRINF generates IPCBN%.

1.0  INVALID CHARACTERS

     1.  Control Characters (<40 octal) may not appear anywhere in the name
         (except Horizontal Tab (11 octal).
     2.  Exceeding the maximum number of characters in the name  (including
         the null at the end of the ASCIZ string).  The number is:
         5 * MIN(number of data words sent - 2 , %IPCML - 2)

2.0  IF THE OPTIONAL SQUARE BRACKETS ARE USED

     1.  More than one open square bracket.
     2.  More than one close square bracket.
     3.  Not one of each or they're in the wrong order.
     4.  Bracketed text is not first or last in the string.
     5.  The only forms legal within the square brackets are:

         1.  [Project,Programmer]
         2.  [Project,*]
         3.  [*,Programmer]
         4.  [*,*]
         5.  [SYSTEM]

         The strings 'ANY' or ANY may be used in  place  of  the  *.   Only
         alphanumerics  are valid here (blanks and tabs are illegal) and if
         both (or either) Project and Programmer are specified, only  octal
         numbers  are  valid and the requestor must match the result (after
         wild carding).  A request to use the name [SYSTEM]  requires  that
         the requestor be a privileged job (JACCT), be an operator ([1,2]),
         or have the IPCF privilege.

     IPCBN% may also be returned when using function 1 to find the PID  for
a  name.  however, it can only occur if the maximum number of characters is
exceeded (i.e.  the null character was not found).  If the name is  invalid
for one of the other reasons, a name search is done anyway and error IPCNN%
(Unknown  Name)  will  probably  be  returned.   This  is  to  reduce   the
restriction on the contents of square brackets.
     Additional error codes returned by QSRINF and their meanings are:

IPCNL%  3  Callers data block is < 3 words
IPCTL%  5  Asked for the name of a PID but answer doesn't fit in  the  data
           block sent
IPCPI% 15  Request to Drop PIDs not belonging to the job and IP.CFP is  not
           set or caller doesn't have the privilege to set IP.CFP
IPCUF% 16  Requested function code not in the range of 1 - 10
IPCBJ% 17  Argument to functions 6 or 7 is not a valid job number or JCH
IPCPF% 20  [SYSTEM]IPCC's PID table has no more free slots
IPCCF% 71  [SYSTEM]IPCC did not honor a request to Create or Drop a PID
IPCQP% 73  Job's PID quota exceeded
IPCBP% 74  PID is truely unknown or Function 5 argument was not a PID
IPCDN% 75  Name requested is already in use by another job or context (if
	   it  belongs to  the requesting context, the old PID will be returned
	   as a normal answer).
IPCNN% 76  Name has no corresponding PID if function 1, PID requested has a
           null name if function 2
IPCBN% 77  Described above

\
SUBTTL	Module storage

THSMAX:	BLOCK	1		;MAXIMUM NAME LENGTH FOR THIS MESSAGE
PRIVRQ:	BLOCK	1		;STATE OF IP.CFP IN RECEIVED PACKET
SNDJCH:	BLOCK	1		;SENDER'S JCH
GFRMSG:	BLOCK	1		;FLAG MESSAGE FROM GOPHER, NOT USER
CCPID:	BLOCK	1		;PID FOR DUPLICATE ANSWER
PAKLEN:	BLOCK	1		;SPACE AVAILABLE IN USER'S PACKET
RSPLEN:	BLOCK	1		;SPACE FOR LENGTH OF RESPONSE MESSAGE
DEFER:	BLOCK	1		;FLAG TO DEFER RESPONSE FOR .IPCIN

;DEBUGGING STORAGE
NAMBUF:	BLOCK	12		;SPACE FOR COMPONENT NAMES

;Space for copying user strings
USRSIZ:	BLOCK	1			;CURRENT SIZE OF USER BLOCK	
USRBUF:	BLOCK	1			;ADDRESS OF BUFFER FOR COPYING
USRCNT:	BLOCK	1			;COUNTDOWN OF BUFFER SIZE
SUBTTL	P$INIT  --  [SYSTEM]INFO Initialization

;P$INIT IS CALLED FOR ONCE ONLY START-UP OF [SYSTEM]INFO

P$INIT:	MOVE	S1,G$MPS##		;MAXIMUM PACKET SIZE
	$CALL	M%GMEM			;GET SOME SPACE
	DMOVEM	S1,USRSIZ		;SAVE THE SIZE AND ADDRESS FOR LATER
	MOVEI	S1,PB.MXS		;SIZE OF PIB
	MOVEI	S2,G$IPIB##		;POINT TO OUR PIB
	$CALL	C%CPID			;TRY TO GET OUR PID
	$RETIF				;GIVE UP IF CAN'T
	MOVE	S1,G$IPIB##+PB.PID	;YES, GET RETURNED PID
	MOVEM	S1,G$IPID##		;STORE SO WE GET OUR MESSAGES
	$RETT				;RETURN GOODNESS
SUBTTL	Error Handling

;DEFINE [SYSTEM]INFO ERROR MESSAGES

DEFINE	INFERS(A),<
	XLIST
	IRP	A,<
		E$'A'%: PUSHJ P,INFERR
			EXP IPC'A'%
		>
	LIST
	SALL
>  ;END OF DEFINE INFERS

	INFERS<UF,NL,PI,BP,TL,QP,NN,BN,DN,PF,CF,BJ,IS>

;HERE WHEN SOMEONE CALLS (OR EXITS THROUGH) ANY OF THE E$xx% ERROR CODES
;	STORES THE CORRESPONDING IPCxx% ERROR NUMBER INTO G$ERR

INFERR:	EXCH	T1,(P)			;SAVE T1, GET ADDRESS OF ERROR CODE
	MOVE	T1,(T1)			;GET ERROR PROPER
	HRRZM	T1,G$ERR##		;SAVE GLOBAL ERROR INDICATOR
	POP	P,T1			;RESTORE T1
	POPJ	P,			;AND RETURN
SUBTTL	The system PID list

;SYSTAB IS USED BY FNDNAM AND P$PCIG FOR PREDEFINED NAMES

DEFINE	.SPID(IDX,T10,T20,NAME),<
	NAM.LN==8	;;"[SYSTEM]" TAKES UP 8 CHARS
	IRPC (NAME),<NAM.LN==NAM.LN+1>	;;COUNT UP LENGTH OF NAME
	IFL	MX.NLN-NAM.LN,<MX.NLN==NAM.LN>	;;KEEP TRACK OF LARGEST
	BYTE (9) IDX, NAM.LN (18) [ASCIZ |[SYSTEM]'NAME'|]
> ;END OF DEFINE .SPID

	MX.NLN==0			;START WITH SMALL NAME
SYSTAB:	SPIDS				;EXPAND THE NORMAL NAMES
	.SPID	SP.IPC,,,IPCF		;ADD IN THIS TRADITIONAL ONE
SYSTBL==.-SYSTAB	;LENGTH OF THE TABLE

	MX.NLN==MX.NLN			;SHOW THE MAX NAME LENGTH

;DEFINE MASKS TO EXTRACT THE ABOVE

SPD.ID==777B8				;THE SYSTEM PID INDEX
SPD.LN==777B17				;THE LENGTH OF THE PID'S NAME
SPD.NM==0,,-1				;ADDRESS OF THE NAME STRING
SUBTTL	Process a message to [SYSTEM]INFO

;CALL IS FROM TOP LEVEL
;	P1 = MESSAGE TYPE (FUNCTION CODE)
;	M = THE MESSAGE PROPER
;	T1 = THE PACKET FLAGS

P$INFO:	LOAD	S1,G$PRVS##,MD.PJH	;GET SENDER'S JCH
	MOVEM	S1,SNDJCH		;SAVE TO LOOK AT LATER
	MOVE	S1,G$ENT##		;GET MDB
	LOAD	S2,MDB.MS(S1),MD.CNT	;GET RECEIVED LENGTH
	SETZM	GFRMSG			;NOT FROM [SYSTEM]GOPHER
	PUSHJ	P,P$MSG			;DO THE FUNCTION DISPATCH (AND CC SEND)
	MOVE	S1,G$SND##		;GET SENDER
	MOVEM	S1,G$SAB##+SAB.PD	;SAVE AS OUR TARGET
	SKIPE	DEFER			;WANT TO DEFER RESPONSE?
	JRST	INFO.1			;YES, DO SO
	MOVE	S1,RSPLEN		;NO, GET RESPONSE SIZE
	CAIE	S1,PAGSIZ		;SENDING A PAGE BACK?
	PJRST	SENDIT			;NO, JUST RESPOND AND RETURN
	MOVE	S1,G$ENT##		;YES, GET MDB ADDRESS AGAIN
	MOVEI	S2,1			;SINCE C%REL WILL TRY TO GIVE AWAY
	STORE	S2,MDB.MS(S1),MD.CNT	;OUR PAGE, FAKE IT OUT
	PJRST	SENDIT			;NOW SEND RESPONSE AND RETURN

;Here to give a deferred response.  This is an answer to .IPCIN, and
;the PID queue entry to be watched is in AP.

INFO.1:	MOVEI	H,PIDLNK-.QHLNK(AP)	;FAKE QUEUE HEADER FOR M$ELNK
	MOVEI	P1,G$SAB##		;THE SAB WE WANT TO COPY
	PUSHJ	P,C$GET##		;GET A COPY IN AP (PRESERVES H)
	PUSHJ	P,LINKNT		;APPEND IT TO THE NOTIFY LIST AND RETURN
	SETZM	G$SAB##+SAB.FL		;CLEAR THE ERROR INDICATOR AGAIN
	POPJ	P,			;RETURN
SUBTTL	Process IPCFM. UUO request from [SYSTEM]GOPHER

P$IGFR:	SETOM	GFRMSG			;THIS MESSAGE IS FROM THE GOPHER
	MOVE	S1,.OHDRS+ARG.DA(M)	;GET IYB WORD
	MOVEM	S1,G$SND##		;SAVE IN OURS
	$CALL	C%PIDH			;GET ITS OWNING JCH
	SKIPT				;IS IT STILL THERE?
	HRRZ	S1,G$MCOD##		;NO, USE INVOKING JCH
	MOVEM	S1,SNDJCH		;SAVE FOR PRIV CHECKERS
	LOAD	S2,.OHDRS(M),AR.LEN	;GET SIZE OF INFO BLOCK SENT
	SOJ	S2,			;ACCOUNT FOR IYB WORD
	STORE	S2,.OHDRS(M),AR.LEN	;PUT BACK TO USER'S VALUE
	MOVEI	M,.OHDRS+ARG.DA(M)	;POINT M TO REAL INFO MESSAGE
	MOVE	S1,-1(M)		;GET LEN,,FUNCTION
	MOVEM	S1,(M)			;PUT WHERE AN ANSWER SHOULD HAVE IT
	HRRZ	P1,S1			;COPY FUNCTION CODE TO CORRECT AC
	PUSHJ	P,P$MSG			;DISPATCH THE FUNCTION REQUESTED
	MOVE	S1,RSPLEN		;GET RESPONSE SIZE
	STORE	S1,(M),AR.LEN		;SET AS SUB-BLOCK LENGTH FOR GOPHER
	SUBI	M,.OHDRS		;MAKE ROOM FOR GALAXY HEADER
	MOVEM	M,G$SAB##+SAB.MS	;SAVE AS PACKET ADDRESS
	ADDI	S1,.OHDRS		;ACCOUNT FOR OVERHEAD
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE PACKET SIZE
	STORE	S1,.MSTYP(M),MS.CNT	;SET MESSAGE SIZE IN HEADER
	MOVEI	S1,MT.TXT		;GOPHER ACK TYPE
	STORE	S1,.MSTYP(M),MS.TYP	;SET AS TYPE OF RESPONSE
	MOVE	S1,G$MCOD##		;GOPHER'S ACK CODE
	MOVEM	S1,.MSCOD(M)		;GIVE IT BACK TO HIM
	SETZM	.MSFLG(M)		;NO FLAGS DESIRED
	SETZM	.OFLAG(M)		;ALSO NOT HERE
	MOVEI	S1,1			;ONE SUB-BLOCK
	MOVEM	S1,.OARGC(M)		;SET FOR CONSISTENCY
	MOVE	S1,G$GPID##		;PICK UP GOPHER'S PID
	MOVEM	S1,G$SAB##+SAB.PD	;THAT'S OUR TARGET
	MOVEI	S1,IPCNL%		;NOT LONG ENOUGH ERROR
	MOVE	S2,G$ERR##		;GET THE ERROR TO RETURN
	CAIN	S2,IPCTL%		;DATA TOO LONG FOR USER'S BUFFER?
	STORE	S1,G$SAB##+SAB.FL,SF.ECD ;YES, CHANGE TO USER'S BUFFER TOO SHORT
	SKIPN	DEFER			;WANT TO DEFER THIS SEND?
	PJRST	SENDIT			;NO, JUST SEND IT OFF
	PJRST	INFO.1			;YES, DO SO
SUBTTL	Common message dispatching

P$MSG:	MOVEM	S2,PAKLEN		;SAVE MESSAGE SIZE
	MOVEM	S2,RSPLEN		;ALSO DEFAULT RESPONSE LENGTH
	MOVEM	M,G$SAB##+SAB.MS	;SAVE ADDRESS FOR RESPONSE MESSAGE
	MOVEI	S2,G$IPIB##		;POINT TO MY PIB
	MOVEM	S2,G$SAB##+SAB.PB	;AS THE SENDER
	SETZM	G$SAB##+SAB.SI		;CLEAR SPECIAL INDEX STUFF
	SETZM	G$SAB##+SAB.FL		;CLEAR FLAGS
	MOVE	S1,1(M)			;GET PID FOR COPY
	MOVEM	S1,CCPID		;SAVE FOR RESPONSE TIME
	SETZM	1(M)			;WE NEVER RETURN THE CC PID
	TXNN	T1,IP.CFP		;PRIVILEGED SEND?
	TDZA	S1,S1			;NO, LOAD ZERO
	MOVEI	S1,1			;YES, LOAD ONE
	MOVEM	S1,PRIVRQ		;REMEMBER STATE OF IP.CFP
	SETZM	DEFER			;NOT YET TRYING TO DEFER RESPONSE

;Done with the setup, now check and dispatch the function itself.
;P1, T1, and M still set up.

	CAXL	P1,FNCMIN		;IN CUSTOMER RANGE?
	CAILE	P1,FNCMAX		;TYPE IN RANGE
	  ZERO	P1			;NO, MAKE IT LOOK INVALID
	MOVE	S1,PAKLEN		;GET THE COUNT SENT
	CAIGE	S1,3			;MINIMUM SIZE FOR ALL MESSAGES
	  MOVEI	P1,FNCMAX+1		;SET TO SAY TOO SHORT
	MOVE	S1,FNCTAB(P1)		;GET DISPATCH ADDRESS FOR THIS FUNCTION
	PUSHJ	P,(S1)			;DISPATCH

	;P$MSG CONTINUED ON NEXT PAGE
	;P$MSG CONTINUED FROM PREVIOUS PAGE

;Here after calling the function processor

	SKIPE	S1,G$ERR##		;GET ERROR CODE
	SETZM	CCPID			;NO DUPLICATES IF ERRORS
	STORE	S1,G$SAB+SAB.FL,SF.ECD	;STORE IN SEND ARGUMENT BLOCK
	MOVE	S1,RSPLEN		;GET RESPONSE MESSAGE SIZE
	MOVEM	S1,G$SAB##+SAB.LN	;SET FOR ANSWER
	SKIPN	P1,CCPID		;WANT TO SEND A DUPLICATE?
	 JRST	MSG.3			;NO, SO DON'T
	PUSHJ	P,ISPID			;IS NUMBER IN P1 A PID?
	 JUMPF	MSG.3			;NO, SO DON'T SEND TO IT
	MOVE	S1,P1			;YES, COPY IT
	$CALL	C%SIDX			;IS IT ONE OF THE SYSTEM PIDS?
	 JUMPT	MSG.3			;YES, DON'T SEND TO IT
	MOVEM	P1,G$SAB##+SAB.PD	;NO, SET AS TARGET
	PUSH	P,AP			;SAVE AP IN CASE WANT TO DEFER
	MOVEI	P1,G$SAB##		;SAB TO REPLICATE
	PUSHJ	P,C$GET##		;MAKE A COPY
	SKIPE	DEFER			;WANT TO DEFER?
	JRST	MSG.1			;YES, DO SO
	PUSHJ	P,C$LINK##		;NO, JUST PUT IN RESEND QUEUE
	JRST	MSG.2			;MERGE WITH CLEANUP
MSG.1:	MOVE	H,(P)			;GET OLD AP AGAIN
	MOVEI	H,PIDLNK-.QHLNK(H)	;BUILD FAKE QUEUE HEADER
	PUSHJ	P,LINKNT		;PUT ON END OF QUEUE FOR THIS PID
MSG.2:	POP	P,AP			;RESTORE AP
MSG.3:	MOVE	S1,PRIVRQ		;PROPAGATE SENDER'S PRIVILEGE BIT
	STORE	S1,G$SAB##+SAB.FL,IP.CFP ;INTO RESPONSE TO HIM (BUT NOT CC PID)
	POPJ	P,			;RETURN TO P$INFO OR P$IGFR
SUBTTL	Dispatch table for messages to [SYSTEM]INFO from users

CSTTAB:
				; ADD INSTALLATION-SPECIFIC FUNCTIONS HERE

FNCTAB:	EXP	E$UF%		;  0 = UNKNOWN FUNCTION
	EXP	P$PCIW		;  1 = .IPCIW = FIND PID FOR SPECIFIED NAME
	EXP	P$PCIG		;  2 = .IPCIG = FIND NAME FOR SPECIFIED PID
	EXP	P$PCII		;  3 = .IPCII =  PID TO NAME UNTIL RESET
	EXP	P$PCIJ		;  4 = .IPCIJ =  PID TO NAME UNTIL LOGOUT
	EXP	P$PCID		;  5 = .IPCID = DROP A PID
	EXP	P$PCIR		;  6 = .IPCIR = PRETEND JOB DID A RESET
	EXP	P$PCLQ		;  7 = .IPCIL = PRETEND JOB DID A LOGOUT
	EXP	P$PCPD		; 10 = .IPCIN = NOTIFY WHEN A PID IS DROPPED

FNCMIN==<CSTTAB-FNCTAB>		;MINIMUM LEGAL MESSAGE TO [SYSTEM]INFO
FNCMAX==<.-FNCTAB>-1		;HIGHEST LEGAL MESSAGE FROM USERS TO INFO

	EXP	E$NL%		;HIGHEST + 1 = NOT LONG ENOUGH
SUBTTL	Find PID for name  --  Function 1

P$PCIW:	PUSHJ	P,VALNAM		;VALIDATE NAME, GET LENGTH
	SKIPN	S1			;WAS NAME BAD
	  JUMPE S2,E$BN%		;YES, NO LENGTH = NO TERMINATOR FOUND
	PUSHJ	P,FNDNAM		;FIND NAME IN TABLES (COULD BE NO PRIVS)
	JUMPE	AP,E$NN%		;UNKNOWN NAME
	JUMPL	AP,PCIW.1		;SYSTEM PIDS ARE DIFFERENT
	MOVE	S1,PIDPID(AP)		;GET THE PID WHO HAS THAT NAME
	PUSHJ	P,VALPID		;SANITY CHECK
	  JRST	E$NN%			;UNKNOWN NAME IF INVALID PID
	STORE	S2,PIDJOB(AP),PID.JC	;SAVE JCH FOR LATER SANITY CHECKS
	MOVEM	S1,1(M)			;PUT PID INTO ANSWER FIELD
	POPJ	P,			;RETURN TO GIVE ANSWER

PCIW.1:	LOAD	S1,SYSTAB(AP),SPD.ID	;GET SYSTEM INDEX
	$CALL	C%RPRM			;GET THE CORRESPONDING PID
	JUMPF	E$NN%			;NOT ASSIGNED
	PUSHJ	P,VALPID		;SEE IF STILL VALID
	  JRST	E$NN%			;UNASSIGNED
	MOVEM	S1,1(M)			;VALID, STORE INTO ANSWER FIELD
	POPJ	P,			;RETURN TO GIVE ANSWER
SUBTTL	Find name for PID  --  Function 2

P$PCIG:	MOVE	S1,2(M)			;GET PID REQUESTED
	PUSHJ	P,VALPID		;SANITY CHECK
	  JRST	E$BP%			;UNKNOWN PID
	LOAD	AP,HDRPID##+.QHLNK,QH.PTF  ;SEARCH THE PID QUEUE
PCIG.1:	JUMPE	AP,PCIG.4		;UNKNOWN VALID PID, CHECK IF SYSTEM
	CAME	S1,PIDPID(AP)		;THIS IT
	  JRST	PCIG.3			;NO, TRY THE NEXT
	LOAD	T2,PIDJOB(AP),PID.LN	;NUMBER OF CHARS IN PID'S NAME
	JUMPE	T2,E$NN%		; NULL NAME GETS 'UNKNOWN NAME'
	MOVSI	T1,PIDNAM(AP)		;GET ADDRESS OF NAME
PCIG.2:	HRR	T1,PAKLEN		;INCLUDE CALLER'S PACKET LENGTH
	INCR	T2			;ACCOUNT FOR THE NULL
	ADDI	T2,^D4			;NOW ROUND UP TO A FULL WORD
	IDIVI	T2,^D5			;CONVERT TO FULL WORDS
	CAILE	T2,-2(T1)		;CALLER HAVE ENOUGH ROOM
	  PJRST	E$TL%			;NO, TOO LONG FOR USERS BUFFER
	HRRI	T1,2(M)			;INTO ANSWER
	ADDI	T2,-1(T1)		;END OF THE BLT
	BLT	T1,(T2)			;MOVE THE DATA INTO ANSWER BLOCK
	MOVEM	S1,1(M)			;RETURN PID ASKED ABOUT AS WELL
	POPJ	P,			;AND RETURN
PCIG.3:	LOAD	AP,.QELNK(AP),QE.PTN	;FIND NEXT IN QUEUE
	JRST	PCIG.1			;AND SEE IF THATS IT

PCIG.4:	$CALL	C%SIDX			;IS THIS A SYSTEM PID?
	JUMPF	E$NN%			;NO, UNKNOWN NAME
	MOVSI	AP,-SYSTBL		;AOBJN INDEX FOR SYSTAB
PCIG.5:	LOAD	S2,SYSTAB(AP),SPD.ID	;GET THE INDEX FOR THIS ENTRY
	CAME	S1,S2			;DO THEY MATCH?
	AOBJN	AP,PCIG.5		;NO, KEEP LOOKING
	JUMPGE	AP,E$NN%		;NO NAME IF CAN'T FIND IT
	MOVE	S1,2(M)			;RESTORE PID
	LOAD	T1,SYSTAB(AP),SPD.NM	;GET ADDRESS OF NAME
	MOVSS	T1			;WHERE WE WANT IT
	LOAD	T2,SYSTAB(AP),SPD.LN	;LOAD NAME LENGTH
	JRST	PCIG.2			;SET UP ANSWER AND RETURN IT
SUBTTL	Assign PIDs  --  Functions 3 and 4

P$PCIJ:	TDZA	S1,S1			;INDICATE JOB WIDE PID
P$PCII:	MOVX	S1,1B0			;INDICATE KEEP IT UNTIL RESET
	IOR	S1,SNDJCH		;MAKE ARGUMENT TO .IPCSC
	MOVEM	S1,PCII.A		;SAVE THE EVENTUAL ARGUMENT
	PUSHJ	P,VALNAM		;VALIDATE THE NAME
	JUMPF	E$BN%			;NAME HAS ILLEGAL CHARACTERS
	MOVEM	S2,PCII.B		;SAVE LENGTH OF NAME
	PUSHJ	P,FNDNAM		;SEE IF NAME ALREADY EXISTS
	JUMPE	AP,PCII.2		;NOT FOUND, OK SO FAR
	MOVE	S1,PIDPID(AP)		;GET PID OR INDEX
	JUMPL	AP,PCII.4		;TEST SYSTEM NAME DIFFERENTLY
	PUSHJ	P,VALPID		;SEE IF STILL VALID
	  JRST	PCII.2			;NO, TRY TO ASSIGN IT ANEW

;Here if name already exists with a valid PID

PCII.1:	CAME	S2,SNDJCH		;ASKING FOR SAME NAME AGAIN
	  PJRST	E$DN%			;NO, DUPLICATE NAME
	MOVEM	S1,1(M)			;YES, PUT SAME PID INTO ANSWER
	POPJ	P,			;AND GIVE IT BACK TO CALLER

;Here if name does not exist yet (or now)

PCII.2:	MOVE	S1,PCII.A		;GET BACK THE JCH + FLAG
	MOVEI	AP,CREBLK		;BLOCK FOR IPCC
	ZERO	CREANS			;CLEAR ANY JUNK
	PUSHJ	P,IPCREQ		;ASK TO CREATE A PID FOR THE JOB
	JUMPT	PCII.3			;ANALYZE FAILURES
	CAIN	S2,IPCPF%		;PID TABLE FULL
	  PJRST	E$PF%			;YES, GIVE USER SAME ERROR
	CAIN	S2,IPCQP%		;PID QUOTA EXCEEDED?
	  PJRST	E$QP%			;YES, GIVE USER SAME ERROR
	JRST	E$CF%			;ANY OTHERS, GIVE IPCC REQUEST FAILED

	;P$PCII CONTINUED ON NEXT PAGE
	;P$PCII CONTINUED FROM PREVIOUS PAGE

PCII.3:	MOVE	P1,CREANS		;GET PID CREATED
	MOVEM	P1,1(M)			;STORE CREATED PID IN ANSWER
	MOVEM	P1,G$SND##		;NEW PID GETS THE ANSWER
	MOVEI	H,HDRPID##		;POINT TO PID QUEUE
	SKIPN	S1,PCII.B		;GET NAME LENGTH AGAIN
	POPJ	P,			;SAVE SPACE, DON'T STORE NULL NAMES
	IDIVI	S1,5			;MAKE WORD COUNT
	AOS	AP,S1			;ROUND UP, LEAVING ROOM FOR NULL
	PUSHJ	P,M$GFRE##		;GET A CELL
	MOVEM	P1,PIDPID(AP)		;STORE PID
	MOVE	S1,PCII.A		;GET JCH AGAIN
	STORE	S1,PIDJOB(AP),PID.JC	;STORE OWNER
	MOVE	S1,PCII.B		;GET THE LENGTH OF THE NAME
	STORE	S1,PIDJOB(AP),PID.LN	;AS NAME LENGTH
	HRL	S2,USRBUF		;WHERE THE NAME IS
	HRRI	S2,PIDNAM(AP)		;THE NAME IN THE QUEUE ENTRY
	LOAD	S1,.QEVSZ(AP),QE.VSZ	;NUMBER OF WORDS TO MOVE
	ADDI	S1,PIDNAM(AP)		;FIND END OF TRANSFER
	BLT	S2,-1(S1)		;MOVE NAME INTO QUEUE ENTRY
	PJRST	M$ELNK##		;ADD TO END OF PID QUEUE

PCII.4:	LOAD	S1,SYSTAB(AP),SPD.ID	;GET THE SYSTEM INDEX
	$CALL	C%RPRM			;FIND ITS VALUE
	JUMPF	PCII.5			;OK IF NOT FOUND
	PUSHJ	P,VALPID		;SEE IF STILL A VALID PID
	 JRST	PCII.5			;PRETEND WE DIDN'T FIND IT
	JRST	PCII.1			;CHECK OWNERSHIP, ETC.

PCII.5:	PUSH	P,AP			;SAVE INDEX INTO SYSTAB
	PUSHJ	P,PCII.2		;ASSIGN A NEW PID
	POP	P,AP			;RESTORE SYSTAB INDEX
	SKIPE	G$ERR##			;IF FAILED,
	  POPJ	P,			;PROPAGATE
	MOVE	S1,1(M)			;OK SO FAR, GET THE PID
	MOVEM	S1,SETPID		;STORE IN .IPCWP BLOCK
	LOAD	S1,SYSTAB(AP),SPD.ID	;GET INDEX AGAIN
	MOVEI	AP,SETBLK		;POINT TO REQUEST BLOCK
	PUSHJ	P,IPCREQ		;TRY TO SET THE PID FOR THE USER
	$RETIT				;IF SUCCEEDS, WE'RE GOLDEN
	PUSH	P,S2			;SAVE ERROR CODE
	MOVE	S1,1(M)			;GET PID BACK AGAIN
	SETZM	1(M)			;NOT GOING TO GIVE IT TO THE USER
	SETOM	PRIVRQ			;WE WANT OUR PRIVS NOW
	PUSHJ	P,DROPIT		;DELETE THE PID
	  PUSHJ	P,G$SFAL##		;DELETE CORE EVEN IF CAN'T ZAP PID
	POP	P,G$ERR##		;RESTORE OUR ERROR CODE
	POPJ	P,			;AND RETURN TO P$MSG

PCII.A:	BLOCK	1			;JCH DURING CREATE OPERATION
PCII.B:	BLOCK	1			;NUMBER OF CHARACTERS IN NAME REQUESTED
SUBTTL	Drop specific PID  --  Function 5

P$PCID:	MOVE	P1,2(M)			;THE PID TO DROP
	PUSHJ	P,ISPID			;IS P1 A PID ( BY FORMAT )
	JUMPF	E$BP%			;NO, JOB NUMBERS ARE ILLEGAL HERE
	MOVE	S1,2(M)			;THE PID TO DROP
	PUSHJ	P,DROPIT		;DO SO
	  POPJ	P,			;RETURN ERROR
	POPJ	P,			;AND SUCCESS
SUBTTL	Drop PIDs  --  Functions 6 and 7

P$PCLQ:	TDOA	P2,[-1]			;MASK FOR ALL PIDS
P$PCIR:	MOVX	P2,1B0			;MASK FOR RESET'ABLE PIDS
	SETZM	SHWANS			;CLEAR STARTING PID ARGUMENT
	MOVE	P1,SNDJCH		;GET SENDER'S JCH
	CAMN	P1,2(M)			;GETTING OWN JOB
	  JRST	PCIR.2			;YES, OK SO FAR
	PUSHJ	P,CHKENB		;NO, CHECK CALLERS ENABLED PRIVS
	JUMPT	PCIR.1			;SUFFICIENT, JUST DO IT
	TRZ	P1,IP.SCN		;CLEAR CONTEXT NUMBER FROM SENDER
	CAME	P1,2(M)			;DOES IT MATCH NOW?
	JRST	E$PI%			;NO, PRIVILEGES INSUFFICIENT
	MOVE	P1,SNDJCH		;YES, PRETEND GAVE FULL CURRENT JCH
	JRST	PCIR.2			;JOIN MAIN LINE
PCIR.1:	MOVE	P1,2(M)			;YES, GET JCH AGAIN
	PUSHJ	P,ISPID			;IS P1 A PID
	JUMPT	E$BJ%			;YES, AND WE WANT JCHS HERE
PCIR.2:	MOVE	S1,P1			;COPY JCH TO LIST
	MOVEI	AP,SHWBLK		;IPCFM BLOCK
	PUSHJ	P,IPCREQ		;LIST THE PIDS
	JUMPF	E$CF%			;[SYSTEM]IPCC REQUEST FAILED
	MOVSI	P3,-SHWLN2		;MAKE AOBJN FOR PID LIST
PCIR.3:	SKIPN	S1,SHWANS(P3)		;THROUGH THE PIDS YET?
	POPJ	P,			;YES, RETURN TO P$MSG
	TDNN	S1,P2			;NO, SHOULD WE DROP THIS ONE?
	JRST	[MOVEM	S1,SHWANS	;NO, SAVE AS START OF NEXT LIST
		 JRST	PCIR.4]		;LOOK FOR MORE TO DROP
	SETZM	SHWANS(P3)		;REMEMBER THAT WE'RE DROPPING THIS ONE
	PUSHJ	P,DROPIT		;YES, DROP IT
	  JRST	PCIR.5			;SEE IF A SYSTEM PID
PCIR.4:	AOBJN	P3,PCIR.3		;LOOP OVER ALL PIDS IN LIST
	JRST	PCIR.2			;GET NEXT LIST FOR JCH

PCIR.5:	CAIE	S2,IPCPI%		;PRIV ERROR?
	 POPJ	P,			;NO, JUST GIVE UP
	$CALL	C%SIDX			;YES, SEE IF A SYSTEM PID
	$RETIF				;NO, GIVE UP
	MOVE	S2,SNDJCH		;YES, GET SENDER'S JCH
	TRNN	P1,IP.SCN		;DOING A JCH?
	TRZ	S2,IP.SCN		;NO, KEEP ONLY JOB NUMBER
	CAME	S2,P1			;USER DOING HIS OWN JOB?
	POPJ	P,			;NO, GIVE UP
	SETZM	SETPID			;YES, SET TO CLEAR THE VALUE
	MOVEI	AP,SETBLK		;BLOCK TO MAKE THE ATTEMPT
	PUSHJ	P,IPCREQ		;TRY TO CLEAR THE SYSTEM INDEX
	$RETIF				;GIVE UP IF CAN'T
	MOVE	S1,PIDPID(P3)		;YES, GET PID BACK AGAIN
	PUSHJ	P,DROPIT		;NOW TRY TO DELETE IT
	  POPJ	P,			;GIVE UP IF STILL CAN'T
	JRST	PCIR.4			;WORKED, TRY NEXT
SUBTTL	Tell others when a PID is dropped  --  Function 10

P$PCPD:	MOVE	P1,G$SND##		;SENDER GET ANSWER LATER
	PUSHJ	P,ISPID			;IS P1 A PID
	JUMPF	E$BP%			;NO, CALLER MUST HAVE A PID
	MOVE	S1,2(M)			;GET PID REQUESTED
	PUSHJ	P,VALPID		;SEE IF LEGAL
	  JRST	E$BJ%			;NO, PROPAGATE ERROR BACK
	LOAD	AP,HDRPID##+.QHLNK,QH.PTF  ;YES, LOOK FOR THAT PID
PCPD.1:	JUMPE	AP,PCPD.2		;TEST FURTHER IF WE DON'T KNOW IT
	CAMN	S1,PIDPID(AP)		;THIS IT
	  JRST	PCPD.5			;YES, GO APPEND TO ITS NOTIFY LIST
	LOAD	AP,.QELNK(AP),QE.PTN	;NO, FIND THE NEXT IN THE QUEUE
	JRST	PCPD.1			;AND CONTINUE LOOKING

;Here to make a new PID queue entry for a null name (and valid PID)

PCPD.2:	DMOVE	P1,S1			;SAVE PID AND OWNING JCH
	MOVEI	H,HDRPID##		;QUEUE TO ADJUST
	$CALL	C%SIDX			;SEE IF IT'S A SYSTEM PID
	JUMPF	PCPD.3			;NO, ALLOCATE A ZERO-LENGTH NAME
	PUSHJ	P,SYSPID		;YES, ALLOCATE A SYSTEM NAME ENTRY
	JRST	PCPD.4			;NOW APPEND TO THE NOTIFY LIST
	$FALL	PCPD.3			;USE ZERO-LENGTH NAME IF NO SYSTEM NAME

PCPD.3:	PUSHJ	P,M$GFRE##		;GET A BLOCK FOR THIS PID
PCPD.4:	MOVEM	P1,PIDPID(AP)		;SAVE THE PID
	STORE	P2,PIDJOB(AP),PID.JC	;AND ITS OWNER
	PUSHJ	P,M$ELNK##		;LINK INTO THE PID QUEUE

PCPD.5:	SETOM	DEFER			;REMEMBER TO DEFER THIS RESPONSE
	MOVEI	S1,3			;WE ONLY NEED THREE WORDS FOR THE ANSWER
	MOVEM	S1,RSPLEN		;SO DON'T KEEP ANY MORE AROUND IN CORE
	POPJ	P,			;RETURN THE DEFERRED RESPONSE
SUBTTL	Routine to allocate a system pid for P$PCPD

SYSPID:	MOVSI	AP,-SYSTBL		;AOBJN INDEX TO SYSTAB
SYSP.1:	LOAD	S2,SYSTAB(AP),SPD.ID	;GET INDEX FROM TABLE
	CAME	S1,S2			;MATCH INDEX REQUESTED?
	 AOBJN	AP,SYSP.1		;NO, KEEP LOOKING
	JUMPGE	AP,.POPJ1		;GIVE CONTINUE RETURN IF NO MATCH
	MOVE	E,AP			;SAVE SYSTAB INDEX
	LOAD	S1,SYSTAB(AP),SPD.LN	;GET LENGTH OF THE NAME
	MOVE	P3,S1			;SAVE A COPY
	IDIVI	S1,5			;MAKE WORD COUNT
	AOS	AP,S1			;ROUNDED UP
	PUSHJ	P,M$GFRE##		;GRAB SOME CORE
	LOAD	S1,.QEVSZ(AP),QE.VSZ	;GET SIZE IN WORDS
	HRLZ	S2,SYSTAB(E)		;GET BLT SOURCE
	HRRI	S2,PIDNAM(AP)		;AND DESTINATION
	ADDI	S1,PIDNAM(AP)		;AND END OF BLOCK
	BLT	S2,-1(S1)		;TRANSFER THE NAME
	STORE	P3,PIDJOB(AP),PID.LN	;SAVE LENGTH AWAY
	POPJ	P,			;RETURN TO UPDATE PID & JCH
SUBTTL	IPCC Request to drop PIDs  --  Function 15

;FUNCTION 15 IS SENT BY [SYSTEM]IPCC WHEN A JOB WHICH OWNS A
;	PID DOES A RESET OR LOGOUT, WITH THE PIDS ALREADY DROPPED.

	IP.DPL==1B3		;FLAG FROM THE JOB'S PROCESS DATA BLOCK (PDB)
				; WHICH INDICATES AT LEAST 1 PID TO DROP ON LOGOUT

P$PCSS:	MOVE	P1,1(M)			;GET FLAG AND JCH
	MOVX	P2,1B0			;ALWAYS WANT THIS BIT
	MOVEI	P3,IP.SJC		;KEEP FULL JCH FOR COMPARES
	TXNE	P1,IP.DPL		;JOB LOGGING OUT
	  JRST	[SETO	P2,		;YES, MASK FOR ALL PIDS
		 MOVEI	P3,IP.SJN	;KEEP ONLY JOB NUMBER FOR COMPARES
		 JRST	.+1]		;MERGE BACK INLINE
	ANDI	P1,(P3)			;ISOLATE THE JCH OR JOBNO
	MOVEI	H,HDRPID##		;GET RIGHT QUEUE HEADER
	LOAD	P4,.QHLNK(H),QH.PTF	;BEGIN SEARCH FOR THE JCH
PCSS.1:	JUMPE	P4,.POPJ		;DONE IF AT END OF QUEUE
	LOAD	T1,PIDJOB(P4),PID.JC	;GET THE OWNER OF THIS PID
	ANDI	T1,(P3)			;KEEP ONLY WHAT WE WANT
	MOVE	S1,PIDPID(P4)		;GET THE PID
	CAMN	T1,P1			;SAME JOB
	 TDNN	P2,S1			;YES, SHOULD WE DROP IT
	  JRST	PCSS.2			;DON'T DROP THIS PID
	MOVE	AP,P4			;SAVE POINTER TO CURRENT JUST IN CASE
	LOAD	P4,.QELNK(P4),QE.PTN	;FIND NEXT PID FIRST
	$CALL	C%PIDH			;SEE IF IT HAS AN OWNING JCH
	JUMPT	[STORE	S1,PIDJOB(AP),PID.JC	;YES, UPDATE IT
		 JRST	PCSS.1]		;LOOK FOR NEXT TO TRY
	PUSHJ	P,TELALL		;NO, NOTIFY THE WAITERS
	PUSHJ	P,M$RFRE##		;RELEASE THE STORAGE
	JRST	PCSS.1			;AND DROP ANY OTHERS
PCSS.2:	LOAD	P4,.QELNK(P4),QE.PTN	;FIND THE NEXT
	JRST	PCSS.1			;AND DROP ANY OTHERS
SUBTTL	P$KLPD  --  Kill a PID if couldn't send to it

;CALLED BY QUASAR TO NOTIFY THAT A SEND HAS FAILED (OR A RETURNED MESSAGE)
;	S1 = THE PID
;PRESERVES S1

P$KLPD:	$SAVE	<H,AP>			;SAVE CALLER'S H AND AP
	PUSHJ	P,.SAVE1##		;AND CALLERS P1
	MOVE	P1,S1			;COPY THE PID
	MOVEI	H,HDRPID##		;POINT TO THE PID QUEUE
	LOAD	AP,.QHLNK(H),QH.PTF	;FIND THE FIRST
KLPD.1:	JUMPE	AP,.POPJ		;DONE IF OUT OF PIDS
	CAME	P1,PIDPID(AP)		;THIS THE ONE
	  JRST	KLPD.2			;NO, TRY ANOTHER
	PUSHJ	P,TELALL		;TELL ALL WHO HAVE ASKED
	PUSHJ	P,M$RFRE##		;REMOVE THE CELL
	MOVE	S1,P1			;RESTORE S1
	$RETT				;DONE
KLPD.2:	LOAD	AP,.QELNK(AP),QE.PTN	;FIND THE NEXT
	JRST	KLPD.1			;AND KEEP LOOKING
SUBTTL	Privilege checking routines

;CHKENB CHECKS IF THE CALLER HAS ASKED TO ENABLE PRIVILEGES AND
;	INDEED HAS THEM TO ENABLE.  THIS IS NORMALLY CALLED WHEN
;	ASKED TO DROP PID FOR A JOB AND THE CALLER .NE. THE JOB REQUESTED

;RETURNS .TRUE. IF ENABLED
;	 .FALSE. IF NOT

CHKENB:	SKIPE	PRIVRQ			;PRIVILEGE FLAG ON IN REQUEST?
	  $RETT				;YES, IPCC CHECKED JP.IPC FOR US
	$FALL	CHKPRV			;MAYBE, CHECK PRIV BITS


;CHKPRV CHECKS IF THE CALLER HAS SUFFICIENT PRIVS TO USE THE NAME [SYSTEM]

;RETURNS .TRUE. IF CALLER DOES
;	 .FALSE. IF NOT

CHKPRV:	MOVX	S1,MD.PWH!MD.POP!MD.PIP	;JACCT, OPERATOR, OR IPCF PRIVS.
	SKIPN	GFRMSG			;CAN'T TRUST PRIV BITS IN GOPHER MESSAGE
	TDNN	S1,G$PRVS##		;CHECK CALLERS PRIVS
	  $RETF				;NO CAN DO
	$RETT				;CALLER IS ENABLED
SUBTTL	DROPIT  --  Drop a PID

;SUBROUTINE TO DROP A SPECIFIC PID
;CALL	S1 = THE PID TO DROP
;
;RETURN SKIP IF SUCCESS,
; NON-SKIP WITH ERROR IN G$ERR IF FAILED
;TAKES CARE OF UPDATING G$SND AND CCPID FOR RESPONSES

DROPIT:	PUSHJ	P,VALPID		;IS IT STILL AROUND?
	 JRST	.POPJ1			;NO, SAY WE DELETED IT
	DMOVEM	S1,DROP.A		;SAVE PID AND OWNING JCH
	MOVEI	AP,DRPBLK		;IPCFM BLOCK TO DROP A PID
	PUSHJ	P,IPCREQ		;DO IT
	JUMPF	DROP.2			;ANALYZE FAILURE
	DMOVE	S1,DROP.A		;GET PID AND JCH AGAIN
	CAMN	S1,G$SND##		;ZAPPING SENDER'S PID?
	 MOVEM	S2,G$SND##		;YES, SEND TO THE JCH INSTEAD
	CAMN	S1,CCPID		;ZAPPED CC PID?
	 SETZM	CCPID			;YES, DON'T SEND DUPLICATE
DROP.1:	AOS	(P)			;SET TO GIVE SKIP RETURN
	PJRST	G$SFAL##		;EXIT, DELETING CORE VIA P$KLPD

DROP.2:	CAIN	S2,IPCBJ%		;UNKNOWN TO IPCC?
	 JRST	DROP.1			;YES, ANNOUNCE ITS DEATH AND RETURN GOOD
	CAIN	S2,IPCPI%		;NO PRIVS?
	 JRST	E$PI%			;YES, GIVE USER SAME ERROR
	JRST	E$CF%			;NO, USE GENERIC IPCC FAILURE


;STORAGE USED

DROP.A:	BLOCK	2			;SAVE PID & JCH HERE
SUBTTL	VALPID -- Validate a PID

;SUBROUTINE TO VALIDATE A PID SUPPLIED TO [SYSTEM]INFO
;CALL	S1 = THE PID IN QUESTION
;	PUSHJ	P,VALPID
;RETURNS NON-SKIP IF THE PID IS BAD, AFTER CALLING G$SFAL
;	SKIP WITH PID STILL IN S1 AND OWNING JCH IN S2 IF VALID

VALPID:	PUSH	P,S1			;NEED TO KEEP THIS AROUND
	$CALL	C%PIDH			;CHECK VALIDITY/GET OWNER
	JUMPF	VALP.1			;INVALID, GO NOTIFY
	POP	P,S2			;RETRIEVE PID
	EXCH	S1,S2			;RETURN VALUES IN CORRECT ORDER
	JRST	.POPJ1			;GIVE SKIP RETURN

VALP.1:	POP	P,S1			;RESTORE PID
	PJRST	G$SFAL##		;NOTIFY ALL WHO CARE OF PID LOSS
SUBTTL	VALNAM  --  Validate the contents of the name

;SUBROUTINE TO VALIDATE THE CONTENTS OF THE NAME SENT TO [SYSTEM]INFO
;CALL	M = THE MESSAGE SENT
;	PUSHJ	P,VALNAM
;RETURNS .TRUE. IF NAME IS OK
;	 .FALSE. IF CONTAINS ILLEGAL SYNTAX, CHARS, OR [xxx]
;	 S2 = THE NUMBER OF CHARACTERS IN THE NAME (NOT COUNTING THE NULL)
;	 IF .FALSE. & S2 = 0, NO TERMINATOR WAS FOUND

VALNAM:	$SAVE	<P1,P2>			;SAVE P1 & P2
	PUSHJ	P,FNDMAX		;CALCULATE THSMAX
	PUSHJ	P,CHKUSR		;COPY STRING WITH PRELIM. CHECKS
	$RETIF				;RETURN (WITH 0 IN S2) IF BAD
	PUSHJ	P,VALN.1		;CHECK DIRECTORY STRING
	MOVE	S2,P1			;RETURN COUNT IN S2
	POPJ	P,			;AND RETURN TO CALLER


;STORAGE FOR VALNAM

VPOS.A:	BLOCK	1			;BYTE POINTER FOR OPENING
VPOS.B:	BLOCK	1			;BYTE POINTER FOR CLOSURE
VCNT.A:	BLOCK	1			;CHARACTER NUMBER OF OPENING
VCNT.B:	BLOCK	1			;CHARACTER NUMBER OF CLOSURE
;HERE AFTER THE STRING HAS BEEN SWEPT FOR ILLEGAL CHARACTERS

VALN.1:	SKIPN	VPOS.A			;FIND AN OPENING
	  $RETT				;NO, NAME IS OK
	SKIPN	VPOS.B			;YES, FIND A MATCHING CLOSURE
	  JRST	VALN.3			;NO, ILLEGAL SYNTAX
	CAMN	P1,VCNT.B		;WAS CLOSURE THE LAST CHARACTER
	  JRST	VALN.2			;YES, CHECK ITS CONTENTS
	MOVE	S1,VCNT.A		;NO, WHERE WAS THE OPENING
	CAIE	S1,1			;MUST BE THE FIRST CHARACTER
	  JRST	VALN.3			;CAN'T HAVE CHARACTER AROUND BRACKETS
VALN.2:	MOVE	S2,VPOS.A		;GET BYTE POINTER FOR OPENING
	PUSHJ	P,GETSIX		;GET SIXBIT STRING
	JUMPF	.RETF			;INVALID CHARACTERS IN BRACKETS
	CAIN	T4,","			;ENCOUNTER A COMMA
	  JRST	VALN.4			;YES, SPLIT HALVES NOW
	CAMN	S1,[SIXBIT/SYSTEM/]	;ONLY OTHER POSSIBILITY
	  PJRST	CHKENB			;SEE IF PRIVILEGED ENOUGH TO USE IT
VALN.3:	SETZ	P1,			;BAD SYNTAX IN NAME AFTER ALL
	$RETF				;RETURN FAILURE

VALN.4:	ZERO	P2			;FOR P,PN ASSEMBLY
	CAME	S1,[SIXBIT/'ANY'/]	;WILD CARD NAME
	 CAMN	S1,[SIXBIT/ANY/]	;ALLOW IT WITHOUT THE QUOTES
	  HLL	P2,G$SID##		;YES, GET PROJECT OF SENDER
	CAMN	S1,[SIXBIT/*/]		;ALLOW TRADITIONAL WILD CARD
	  HLL	P2,G$SID##		;THAT IS OK TOO
	TLNE	P2,-1			;GET ONE OF THE WILD CARDS
	  JRST	VALN.5			;YES, GO GET PROGRAMMER NUMBER
	PUSH	P,S2			;SAVE BYTE POINTER
	PUSHJ	P,CNVOCT		;CONVERT S1 TO OCTAL
	POP	P,S2			;RESTORE POINTER
	JUMPF	VALN.3			;ILLEGAL OCTAL DIGITS
	HRL	P2,S1			;GET REQUESTED PROJECT NUMBER
VALN.5:	PUSHJ	P,GETSIX		;GET RIGHT HALF NOW
	JUMPF	VALN.3			;ILLEGAL CHARACTERS
	CAIE	T4,"]"			;BETTER BE TRUE
	  JRST	VALN.3			;ILLEGALLY FORMATTED
	CAME	S1,[SIXBIT/'ANY'/]	;WILD CARD NAME
	 CAMN	S1,[SIXBIT/ANY/]	;ALLOW IT WITHOUT THE QUOTES
	  HRR	P2,G$SID##		;YES, GET PROGRAMMER OF SENDER
	CAMN	S1,[SIXBIT/*/]		;ALLOW TRADITIONAL WILD CARD
	  HRR	P2,G$SID##		;THAT IS OK TOO
	TRNE	P2,-1			;GET ONE OF THE WILD CARDS
	  JRST	VALN.6			;YES, NOW CHECK VALIDITY
	PUSHJ	P,CNVOCT		;CONVERT S1 TO OCTAL
	JUMPE	S1,VALN.3		;PROGRAMMER NUMBER IS BAD
	HRR	P2,S1			;NOW HAVE FULL P,PN
VALN.6:	CAME	P2,G$SID##		;NOW THE ACID TEST
	  $RETF				;OH WELL, IT WAS A NICE TRY
	$RETT				;GIVE CALLER THE NAME
SUBTTL	String conversion routines for VALNAM

;GETSIX IS CALLED WITH S2 = THE BYTE POINTER READY FOR ILDB

;RETURNS S1 = A SIXBIT STRING OR .FALSE. IF ILLEGAL CHARS OR TERMINATOR
;	 S2 = UPDATED BYTE POINTER
;	 T4 = THE TERMINATOR

GETSIX:	ZERO	GETS.A			;WHERE STRING WILL BE BUILT
	MOVE	S1,[POINT 6,GETS.A]	;BYTE POINTER FOR THE STRING
GETS.1:	ILDB	T4,S2			;GET A CHARACTER
	CAIE	T4,","			;HIT A COMMA
	 CAIN	T4,"]"			;OR THE END OF THE FIELD
	  JRST	GETS.3			;YES, GET ANSWER
	TLNN	S1,770000		;ROOM IN THE WORD
	  $RETF				;NO, TOO MANY CHARACTERS
	CAIE	T4,"'"			;ALLOWABLE CHARACTERS
	 CAIN	T4,"*"			;FOR 'ANY' OR * WILD CARDS
	  JRST	GETS.2			;YES, INCLUDE IT
	CAIG	T4,"9"			;ALLOW ALL NUMBERS HERE
	 CAIGE	T4,"0"			;A DIGIT
	  SKIPA				;NO, TRY ANOTHER
	JRST	GETS.2			;YES, TAKE IT
	CAIG	T4,172			;LOWER CASE Z
	 CAIGE	T4,141			;A LOWER CASE LETTER
	  SKIPA				;NO, TRY ANOTHER
	SUBI	T4," "			;YES, MAKE IT UPPER CASE
	CAIG	T4,"Z"			;REGULAR LETTER CHECK
	 CAIGE	T4,"A"			;IS IT AN UPPER CASE LETTER
	  $RETF				;BAD NAME
GETS.2:	SUBI	T4," "			;CONVERT TO SIXBIT
	IDPB	T4,S1			;STORE THE CHARACTER
	JRST	GETS.1			;GET ANOTHER
GETS.3:	MOVE	S1,GETS.A		;GET THE SIXBIT VALUE
	POPJ	P,			;AND RETURN

GETS.A:	BLOCK	1			;ANSWER FROM GETSIX
;CNVOCT IS CALLED WITH S1 = POSSIBLE OCTAL NUMBER IN SIXBIT (OUTPUT FROM GETSIX)

;RETURNS S1 = THE BINARY VALUE OF THE STRING OR .FALSE. IF ILLEGAL CHARS

CNVOCT:	MOVEM	S1,CNVO.A		;SAVE THE STRING
	ZERO	S1			;THE ANSWER TO BE RETURNED
	MOVE	S2,[POINT 6,CNVO.A]	;POINTER TO THE STRING
CNVO.1:	ILDB	T4,S2			;GET A CHARACTER
	JUMPE	T4,.POPJ		;DONE IF OUT OF CHARACTERS
	CAIG	T4,'7'			;VALID OCTAL DIGIT
	 CAIGE	T4,'0'			;P,PN'S ARE OCTAL
	  $RETF				;ILLEGAL CHARACTERS
	ANDI	T4,7			;WANT ONLY THE DIGIT PART
	LSH	S1,3			;MAKE ROOM FOR IT
	ADD	S1,T4			;INCLUDE THE DIGIT
	TLNE	S2,770000		;END OF THE STRING
	  JRST	CNVO.1			;NO, GET ANOTHER
	POPJ	P,			;YES, RETURN

CNVO.A:	BLOCK	1			;INPUT TO CNVOCT
;FNDMAX IS CALLED TO CALCULATE THSMAX

FNDMAX:	$CALL	C%MAXP			;GET MAXIMUM SHORT PACKET SIZE AGAIN
	MOVEM	S1,G$MPS##		;UPDATE ALL OF QUASAR (IN CASE OF POKE)
	CAMLE	S1,PAKLEN		;IS USER'S PACKET SHORTER?
	MOVE	S1,PAKLEN		;NO, GET THAT LIMIT INSTEAD
	SUBI	S1,2			;ACCOUNT FOR OVERHEAD WORDS
	IMULI	S1,5			;5 CHARS PER WORD (INCLUDING NUL)
	CAILE	S1,SZ.INF+1		;FIT IN GALGEN LIMIT?
	MOVEI	S1,SZ.INF+1		;NO, USE THAT SIZE
	MOVEM	S1,THSMAX		;SET THSMAX
	POPJ	P,			;RETURN TO VALNAM
;CHKUSR IS CALLED TO MAKE A CLEAN COPY OF THE USER'S NAME STRING
;ON TRUE RETURN, P1 HAS THE LENGTH OF THE STRING
;	VPOS.A HAS B.P. TO "[" IF PRESENT
;	VCNT.A HAS STRING POSITION (1-N) OF "["
;	VPOS.B & VCNT.B ARE SIMILAR FOR "]"
;ON FALSE RETURN, S2 IS ZERO (NAME HAS ILLEGAL SYNTAX)

CHKUSR:	MOVE	S1,G$MPS##		;GET MAXIMUM PACKET LENGTH
	CAMG	S1,USRSIZ		;ARE WE SURE WE'LL FIT?
	JRST	CHKU.1			;YES, DON'T CHANGE THE BUFFER
	$CALL	M%GMEM			;NO, GET NEW BUFFER
	EXCH	S1,USRSIZ		;UPDATE SIZE
	EXCH	S2,USRBUF		;AND ADDRESS
	$CALL	M%RMEM			;RETURN THE OLD ONE
	JRST	CHKU.2			;SKIP REDUNDANT ZEROING
CHKU.1:	DMOVE	S1,USRSIZ		;GET SIZE AND ADDRESS
	$CALL	.ZCHNK			;ZERO OUT THE BUFFER
CHKU.2:	ZERO	P1			;WILL COUNT THE CHARACTERS
	ZERO	VPOS.A			;CLEAR POINTER TO OPENING
	ZERO	VPOS.B			;AND POINTER TO CLOSURE
	MOVE	S1,THSMAX		;GET NAME SIZE
	MOVEM	S1,USRCNT		;SAVE AS COPY LIMIT
	MOVE	S1,USRBUF		;GET BUFFER ADDRESS
	MOVEI	S2,2(M)			;AND USER'S BUFFER
	HRLI	S1,(POINT 7)		;MAKE BYTE POINTER
	HRLI	S2,(POINT 7)		;LIKEWISE
CHKU.3:	ILDB	TF,S2			;GET NEXT CHAR FROM USER
	JUMPE	TF,.RETT		;DONE IF A NUL
	INCR	P1			;INCREMENT LENGTH COUNT
	IDPB	TF,S1			;STORE IN CANONICAL BUFFER
	SOSLE	USRCNT			;SEE IF THERE'S STILL ROOM
	PUSHJ	P,CHKCHR		;AND IF THE CHARACTER'S GOOD
	JRST	CHKU.4			;NO, FAIL
	JRST	CHKU.3			;YES, LOOP OVER ALL CHARACTERS
CHKU.4:	SETZ	S2,			;THE NAME IS BAD
	$RETF				;SO SAY SO
;CHKCHR is called by CHKUSR to see if the current character is valid
;Return non-skip if something's wrong,
;Return skip if valid

CHKCHR:	CAIL	TF,40			;IS IT IN THE RANGE FROM 40
	CAILE	TF,176			;THROUGH 176?
	CAIN	TF,.CHTAB		;OR IS IT A TAB?
	TRNA				;YES, IT'S LEGAL SO FAR
	POPJ	P,			;NO, GIVE UP
	CAIE	TF,"["			;IS IT AN OPEN BRACKET?
	JRST	CHKC.1			;NO, TRY CLOSE
	SKIPE	VPOS.A			;YES, IS IT THE FIRST?
	POPJ	P,			;NO, FAIL
	MOVEM	P1,VCNT.A		;YES, STORE POSITION
	MOVEM	S1,VPOS.A		;AND POINTER
	JRST	.POPJ1			;GIVE SKIP RETURN
CHKC.1:	CAIE	TF,"]"			;IS IT A CLOSE BRACKET?
	JRST	.POPJ1			;NO, ASSUME IT'S OK
	SKIPN	VPOS.B			;IS IT THE FIRST?
	SKIPN	VPOS.A			;AND IS THERE A MATCHING OPEN?
	POPJ	P,			;NO TO EITHER, GIVE UP
	MOVEM	P1,VCNT.B		;OK, STORE POSITION OF CLOSE
	MOVEM	S1,VPOS.B		;AND POINTER
	JRST	.POPJ1			;RETURN GOODNESS
SUBTTL	FNDNAM  --  Find the name sent in the PID queue

;SUBROUTINE TO FIND THE NAME SENT TO [SYSTEM]INFO IN THE PID QUEUE
;CALL	S2 = LENGTH OF NAME (OUTPUT FROM VALNAM)
;	PUSHJ	P,FNDNAM
;RETURNS AP = THE PID QUEUE ENTRY OR ZERO IF NOT FOUND, OR -VE IF SYSTEM

FNDNAM:	JUMPE	S2,[SETZ AP,		;CAN NEVER FIND THE NULL NAME
		    POPJ P,]		;SO JUST RETURN
	$SAVE	<P1,P2,P3>		;SAVE A FEW REGS
	MOVE	P1,S2			;SAVE THE LENGTH OF THE NAME
	MOVNI	P2,4(P1)		;GET -VE NAME LENGTH (ROUNDED UP)
	IDIVI	P2,5			;MAKE -VE WORD COUNT
	LOAD	AP,HDRPID##+.QHLNK,QH.PTF  ;FIND THE FIRST IN THE QUEUE
FNDN.1:	JUMPE	AP,FNDN.3		;RAN OUT, TRY SYSTEM LIST
	LOAD	S2,PIDJOB(AP),PID.LN	;LENGTH OF THIS ONES NAME
	MOVEI	S1,PIDNAM(AP)		;THE NAME OF THIS PID
	PUSHJ	P,CHKNAM		;SEE IF NAMES MATCH
	 POPJ	P,			;YES, SO RETURN
FNDN.2:	LOAD	AP,.QELNK(AP),QE.PTN	;NO, GET NEXT ENTRY IN PID QUEUE
	JRST	FNDN.1			;SEE IF THEY MATCH

;Here to test for system PID

FNDN.3:	MOVSI	AP,-SYSTBL		;AOBJN INDEX FOR SYSTAB
FNDN.4:	LOAD	S2,SYSTAB(AP),SPD.LN	;GET LENGTH OF NAME
	LOAD	S1,SYSTAB(AP),SPD.NM	;AND ADDRESS OF NAME
	PUSHJ	P,CHKNAM		;SEE IF NAMES MATCH
	 POPJ	P,			;YES, RETURN THIS ONE
	AOBJN	AP,FNDN.4		;NO, KEEP LOOKING
	SETZ	AP,			;NOT THERE EITHER, ZERO AP
	POPJ	P,			;GIVE NOT FOUND RETURN

;Helper routine to test for name equality

CHKNAM:	CAIE	S2,(P1)			;DO NAME LENGTHS MATCH?
	 JRST	.POPJ1			;NO, GIVE CONTINUE RETURN
	HRLI	S1,(P2)			;AOBJN POINTER
	MOVE	S2,USRBUF		;NAME SENT TO [SYSTEM]INFO
CHKN.1:	MOVE	P3,(S2)			;GET NEXT WORD FROM NAME RECEIVED
	CAME	P3,(S1)			;MATCH THIS NAME?
	  JRST	.POPJ1			;NO, TRY ANOTHER ENTRY
	AOBJP	S1,.POPJ		;IF BOTH NAMES ENDED, THIS IS IT
	AOJA	S2,CHKN.1		;NO, KEEP LOOKING AT THIS NAME FOR MATCH
SUBTTL	Some utility routines

;SUBROUTINE TO DETERMINE IF THE NUMBER IN P1 IS IN CORRECT FORMAT FOR A PID
;CALL	P1 = POSSIBLE PID
;	PUSHJ	P,ISPID
;RETURNS S1 = .TRUE. IS IN FORMAT FOR A PID
;	    = .FALSE. IF A JCH

ISPID:	TLNE	P1,377777		;PIDS (IN 7.03) HAVE NON-ZERO LH
	  $RETT				;YES, GOOD PID FORMAT
	$RETF				;THIS IS A JCH

;SUBROUTINE TO TELL ALL WHO HAVE ISSUED .IPCIN FOR A PID THAT IS BEING DROPPED
;CALL	AP = THE CELL BEING REMOVED

TELALL:	$SAVE	<H,AP>			;SAVE CALLER'S H AND AP
	$SAVE	<P1>			;SAVE P1
	MOVEI	H,PIDLNK-.QHLNK(AP)	;POINT TO FAKE QUEUE HEADER
TELA.1:	LOAD	AP,.QHLNK(H),QH.PTF	;LOAD UP THE FIRST
	JUMPE	AP,.POPJ		;DONE
	PUSHJ	P,M$DLNK##		;REMOVE FROM NOTIFY LIST
	PUSHJ	P,C$LINK##		;PUT INTO RESEND QUEUE
	JRST	TELA.1			;CONTINUE PURGE

;SUBROUTINE TO INSERT IN A NOTIFY QUEUE
;CALL	AP = THE CELL TO ADD
;	H = HEADER FOR A PID'S NOTIFY QUEUE

LINKNT:	$SAVE	<P1,P2>			;SAVE OUR REGISTERS
	MOVE	P1,RS.SAB+SAB.PD(AP)	;GET PID WE'RE ENTERING
	LOAD	P2,.QHLNK(H),QH.PTF	;GET FIRST QUEUE ENTRY
LINK.1:	JUMPE	P2,M$ELNK##		;LINK AT END IF NOT ALREADY IN QUEUE
	CAMN	P1,RS.SAB+SAB.PD(P2)	;IS IT ALREADY IN THE QUEUE?
	 PJRST	C$PUT##			;YES, DELETE THE BLOCK, DON'T DUPLICATE
	LOAD	P2,.QELNK(P2),QE.PTN	;NO, GET POINTER TO NEXT
	JRST	LINK.1			;LOOP OVER THE NOTIFY LIST

;SUBROUTINE TO SEND A RESPONSE

SENDIT:	PUSHJ	P,C$SNDA##		;SEND FROM AUX PIB
	SETZM	G$SAB##+SAB.FL		;DON'T LEAVE THE ERRORS AROUND
	$RETT				;AND RETURN SUCCESS
SUBTTL	IPCREQ -- IPCFM. dialog with [SYSTEM]IPCC

;CALL WITH:
;	AP = START OF PRE-BUILT IPCFM. BLOCK
;	S1 = ARGUMENT FOR .IPCS1 WORD OF BUFFER
;RETURN TRUE IF NO ERRORS
;	FALSE WITH IPCFM. ERROR IN S2 IF FAILS

IPCREQ:	MOVE	S2,.IPCMP(AP)		;GET BUFFER POINTER
	MOVEM	S1,.IPCS1(S2)		;SAVE ARGUMENT TO FUNCTION
	MOVE	S2,PRIVRQ		;GET PRIVILEGES REQUESTED FLAG
	STORE	S2,.IPCMF(AP),IP.CMP	;PROPAGATE TO IPCFM. PRIVILEGE FLAG
	XMOVEI	S2,(AP)			;POINT TO UUO BLOCK
	IPCFM.	S2,			;ATTEMPT THE FUNCTION
	  $RETF				;PROPAGATE FAILURE
	$RETT				;AND SUCCESS
SUBTTL	Common message blocks (pre-formatted)

;BLOCK USED FOR CREATION OF PID'S FOR JCH (MUST BE FILLED IN)

CREBLK:	EXP	IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
	IFIW	CREFNC			;BUFFER POINTER
	IFIW	G$SND##			;WHERE TO PICK UP PID
CREFNC:	XWD	CRELEN,.IPCSC		;LENGTH,,CREATE A PID FOR A JOB
CREJCH:	EXP	0			;JCH FILLED IN
CREANS:	EXP	0			;PID RETURNED
CRELEN==.-CREFNC			;LENGTH OF MESSAGE

;BLOCK USED TO ASK [SYSTEM]IPCC TO DROP A PID (MUST BE FILLED IN)

DRPBLK:	EXP	IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
	IFIW	DRPFNC			;BUFFER POINTER
	IFIW	G$SND##			;WHERE TO PICK UP PID
DRPFNC:	XWD	DRPLEN,.IPCSZ		;LENGTH,,DROP A PID
DRPPID:	EXP	0			;PID TO DROP
DRPLEN==.-DRPFNC			;LENGTH OF MESSAGE

;BLOCK USED TO ASK [SYSTEM]IPCC TO LIST PIDS FOR A JOB OR JCH (MUST FILL IN)

SHWBLK:	EXP	IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
	IFIW	SHWFNC			;BUFFER POINTER
	IFIW	G$SND##			;WHERE TO PICK UP PID
SHWFNC:	XWD	SHWLEN,.IPCSP		;LENGTH,,PID LIST
SHWWHO:	BLOCK	1			;JOB OR JCH TO LIST
SHWANS:	BLOCK	10			;SPACE FOR SOME PIDS IN ANSWER
SHWLN2==.-SHWANS			;MAX. NUMBER OF PIDS RETURNED AT ONCE
SHWLEN==.-SHWFNC			;LENGTH OF MESSAGE

;BLOCK USED TO ASK [SYSTEM]IPCC TO SET A SYSTEM PID (MUST BE FILLED IN)

SETBLK:	EXP	IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
	IFIW	SETFNC			;BUFFER POINTER
	IFIW	G$SND##			;WHERE TO PICK UP PID
SETFNC:	XWD	SETLEN,.IPCWP		;LENGTH,,WRITE PID TABLE
	BLOCK	1			;INDEX GOES HERE
SETPID:	BLOCK	1			;PID TO WRITE GOES HERE
SETLEN==.-SETFNC			;LENGTH OF MESSAGE
SUBTTL	INFDMP - Dump [SYSTEM]INFO database (for debugging)

;Can only be called by PUSHJ P,INFDMP<ESC>X while debugging.
;Preserves all ACs it touches.
;Used to dump out the [SYSTEM]INFO database.

INFDMP:	$SAVE	<S1,S2,E,AP,P1,P2>		;PRESERVE WHAT WE USE
	$TEXT (,<
     PID	OWNER	NAME
------------	-----	--------------------------------------->)
						;TYPE HEADING
	LOAD	E,HDRPID##+.QHLNK,QH.PTF	;GET FIRST PID IN QUEUE
DUMP.1:	JUMPE	E,DUMP.2			;QUIT WHEN WE FIND THE END
	LOAD	S1,PIDJOB(E),PID.CX		;GET CONTEXT NUMBER
	LOAD	S2,PIDJOB(E),PID.JB		;AND JOB NUMBER
	MOVEI	P1,PIDNAM(E)			;POINT TO NAME
	LOAD	P2,PIDJOB(E),PID.LN		;GET NAME LENGTH
	SKIPN	P2				;HAVE A NAME?
	MOVEI	P1,[ASCIZ |[NONAME]|]		;NO, USE THIS
	$TEXT (,<^M^J^O12R /PIDPID(E)/	^D3R /S2/.^D/S1/	^T/(P1)/>)
					;TYPE OUT PID, OWNING JCH, AND NAME
	PUSHJ	P,DUMP.4			;LIST THE NOTIFY CHAIN
	LOAD	E,.QELNK(E),QE.PTN		;GET POINTER TO NEXT
	JRST	DUMP.1				;LOOP OVER ENTIRE QUEUE

DUMP.2:	$TEXT (,<^M^J^M^JSystem PID List
--------------------------------------->)	;MORE HEADER
	MOVSI	AP,-SYSTBL			;AOBJN INDEX FOR SYSTAB
DUMP.3:	HRRZ	S1,SYSTAB(AP)			;GET THE NAME ADDRESS
	$TEXT (,<^T/(S1)/>)			;TYPE THE NAME
	AOBJN	AP,DUMP.3			;LOOP OVER ALL SYSTEM PIDS
	$TEXT (,<^M^J>)				;DOUBLE CRLF
	POPJ	P,				;RETURN TO DDT

DUMP.4:	SKIPN	PIDLNK(E)			;IS THERE A NOTIFY LIST?
	POPJ	P,				;NO, RETURN NOW
	$TEXT (,<	Notify:	^A>)		;NOTE WHAT WE'RE TYPING
	LOAD	AP,PIDLNK(E),QH.PTF		;POINT TO FIRST TO NOTIFY
	SETZ	P1,				;CLEAR COUNT (THIS LINE)
DUMP.5:	TRZE	P1,4				;FOUR ALREADY THIS LINE?
	$TEXT (,<^M^J		^A>)		;YES, CRLF TAB TAB
	AOJ	P1,				;BUMP COUNT
	$TEXT (,<^O16R /RS.SAB+SAB.PD(AP)/^A>)	;TYPE THIS PID
	LOAD	AP,.QELNK(AP),QE.PTN		;POINT TO NEXT
	JUMPN	AP,DUMP.5			;LOOP UNTIL END OF LIST
	$TEXT (,<>)				;TYPE A CRLF
	POPJ	P,				;RETURN TO OUTER LOOP
	END