Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - galaxy-sources/glxipc.mac
There are 26 other files named glxipc.mac in the archive. Click here to see a list.
	TITLE GLXIPC  --  IPCF INTERFACE FOR GALAXY PROGRAMS
	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	GLXMAC			;SEARCH SUBSYSTEMS SYMBOLS
	PROLOG(GLXIPC,IPC)		;PRODUCE PROLOG CODE

;THE PURPOSE OF THIS MODULE IS TO PROVIDE AN OPERATING SYSTEM INDEPENDENT
;	IPCF INTERFACE TO GALAXY PROGRAMS (OR ANY OTHER PROGRAM WHICH
;	WANTS TO USE IT).

;ALL SUBROUTINES IN THIS MODULE USE ACS S1 AND S2 (1 AND 2) AND GUARANTEE
;	THAT ALL OTHER ACS WILL BE PRESERVED.

	IPCMAN==:0			;Maintenance edit number
	IPCDEV==:111			;Development edit number
	VERSIN (IPC)			;Generate edit number
	Subttl	Table of Contents

;		     Table of Contents for GLXIPC
;
;				  Section		      Page
;
;
;    1. Revision History . . . . . . . . . . . . . . . . . . .   3
;    2. Entry Points found in GLXIPC . . . . . . . . . . . . .   4
;    3. Global Storage . . . . . . . . . . . . . . . . . . . .   5
;    4. C%INIT - Initialize the IPCF interface . . . . . . . .   6
;    5. C%CPID - Create a PID  . . . . . . . . . . . . . . . .   7
;    6. CHKNAM - See if PIB has a name attached  . . . . . . .  10
;    7. C%KPID, C%SPID . . . . . . . . . . . . . . . . . . . .  11
;    8. C%SEND Routine to send an IPCF Message . . . . . . . .  12
;    9. SNDMSG - Work routine to do actual IPCF send . . . . .  14
;   10. C%INTR - Interrupt level routine to flag message avail  16
;   11. RCVMSG - Work routine to do an actual IPCF receive . .  17
;   12. C%REL - Release the last message received  . . . . . .  20
;   13. GETPID - Acquire a PID for this job  . . . . . . . . .  21
;   14. KILPID Routine to delete a pid . . . . . . . . . . . .  22
;   15. SPID - Set a system PID  . . . . . . . . . . . . . . .  23
;   16. RSPIDS Routine to read System Pid tables . . . . . . .  24
;   17. RSPID Routine to return a system pid . . . . . . . . .  25
;   18. RSYPD - Perform actual system pid read . . . . . . . .  27
;   19. C%MAXP - Read maximum short packet size  . . . . . . .  28
;   20. CPIDI - Connect PID to specified interrupt channel . .  29
;   21. IPRM Read/Write IPCF parameters  . . . . . . . . . . .  30
;   22. MNPRED/MNPWRT - Read/Write maximum number of PIDS  . .  31
;   23. QTARED/QTAWRT - Read/Write the Send and Receive Quotas  32
;   24. SETNAM - Routine to declare our name to INFO . . . . .  33
;   25. SNDSYS - Routine to converse with [SYSTEM]INFO & IPCC   34
;   26. STAC - Routine to build INFO messages  . . . . . . . .  36
;   27. C%PIDJ Return PID owners job number  . . . . . . . . .  37
SUBTTL Revision History

COMMENT \
*****  Release 4.2 -- begin maintenance edits  *****

64	4.2.1394
	Insure all messages get received by setting MSGFLG early.

65	4.2.1574
	Store word .IPCFC (enabled capabilities word) of IPCF message
sender in word MDB.PR of the MDB.

66	4.2.1584
	Cause GLXIPC not to give up sending IPCF packets if the problem is
due to IPCF swapping space low.

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

70	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.

71	5.1023		8-Apr-83
	If DB.IPC is set in the debug word, and if the process is ORION
or QUASAR, set the system debugging pids.

72	5.1025		4-May-83
	In SPID, always set the system pid, i.e. don't quit because we THINK
it is already set.  In RSPID, if DB.IPC is set in DEBUGW, try picking up
the debugging system wide pid before using the alternate table.

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

100	Increment maintenance edit level for version 5 of GALAXY.

101	5.1224	SPR#20908
	In routine SNDM.5:, add check for error code MONX06 on a MSEND failure
and retry if so.

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

105	6.1037 and 6.1034	23-Oct-87
	Move from G5 to G6.  In routine RCVM.2 check for SC%SEM and lite
MD.SEM if on.  This will include the SEMI-OPERATOR priv bit in the MDB.

106	6.1066		9-Nov-87
	Change C%SEND to not inform GLXMEM that an IPCFed page is now
available to be re-used if C%SEND detects that bit PT.KEE is turned on
in the SAB length AC.

107	6.1076		15-Nov-87
	Check for NEBULA's PID when debugging.

110	6.1089		19-Nov-87
	Don't turn on bit IP.JWP when obtaining a PID when debugging.

111	6.1225		8-Mar-88
	Update copyright notice.

\   ;End of Revision History
	SUBTTL Entry Points found in GLXIPC

	ENTRY	C%INIT			;INITIALIZE THE MODULE
	ENTRY	C%CPID			;CREATE A PID
	ENTRY	C%SPID			;SET DEFAULT SENDER PID
	ENTRY	C%KPID			;KILL A PID
	ENTRY	C%RPRM			;READ IPCF PARAMETERS
	ENTRY	C%INTR			;POST AND IPCF INTERRUPT
	ENTRY	C%SEND			;SEND AN IPCF MESSAGE
	ENTRY	C%RECV			;NON-BLOCKING IPCF RECEIVE
	ENTRY	C%BRCV			;BLOCKING IPCF RECEIVE
	ENTRY	C%REL			;RELEASE LAST IPCF MESSAGE
	ENTRY	C%MAXP			;MAX PACKET SIZE ENTRY POINT
	ENTRY	C%PIDJ			;RETURN PID OWNERS JOB NUMBER
SUBTTL Global Storage

	EXT	IIB			;USE GLOBAL IB
	EXT	MYJOB			;JOB NUMBER FROM GLXINT
	$DATA	IPCBEG,0		;START OF ZEROABLE $DATA SPACE
	$GDATA	MYPID			;PROCESS IDENTIFIER
	$DATA	DEFPID			;Default (ie first) PID
	$DATA	FSTPFG			;Set after we define first PID
	$GDATA	IMOPR			;Set if we are ORION
	
	$DATA	PSIFLG			;FLAG SET IF IPCF IS CONNECT TO PSI SYSTEM
	$DATA	SNDFLG			;FLAGS TO USE FOR SEND
	$DATA	RCVFLG			;FLAGS TO USE FOR RECIEVE
	$DATA	RCVPAG			;PAGSIZ,,PAGADR RESERVED FOR RECV
	$DATA	MSGFLG			;SET AT INTERRUPT LEVEL (IF PSI USED)
	$GDATA	RSEFLG			;RETURN SEND ERROR FLAG
	$GDATA	MAXPAK			;LARGEST SIZE OF A SHORT MESSAGE


	$DATA	IPCINT			;INTERRUPT ADDRESS FOR IPCF STATUS
	$DATA	IPCSTS			;IPCF STATUS..ASSOCIATED VARIABLE
	$DATA	PIDTAB,SZ.PID		;TABLE OF SYSTEM PIDS
	$DATA	ALTNAM,SZ.PID		;Table of alternate names for system
					;components.  Debuggers can poke
					;a slot to -1 to force a debugging library
					;to talk to that system component.
					;Or, the address of an ASCIZ string can
					;be poked in to force a debugging
					;library to talk to that named component
					;instead of the standard library
					;debugging conventions.

	$DATA	STACP			;BYTE POINTER FOR NAME CREATION

	$DATA	MTLBLK,3		;MUTIL BLOCK

	SYSPRM	(IPCSLN,4,.IPCFP+1)	;Length of a send block
	SYSPRM	(IPCRLN,.IPCFC+1,.IPCLL+1) ;Length of a receive block
	$DATA	SNDBLK,IPCSLN		;IPCF SEND PACKET DESCRIPTOR BLOCK
	$DATA	RCVBLK,IPCRLN		;IPCF RECEIVE PDB

	$DATA	SNDSAB,SAB.SZ		;PLACE TO BUILD A SAB INTO
	$DATA	RCVMDB,MDB.SZ		;PLACE TO BUILD MDB INTO
	$DATA	ACTPTR			;POINTER TO USER AREA FOR ACCT STRING
	$DATA	NODPTR			;POINTER TO USER AREA FOR NODE STRING
	$DATA	PACKET,SZ.PAK		;PLACE TO RECEIVE SHORT MESSAGE INTO
	$DATA	QUELOK			;LOCK FOR THE INTERNAL IPCF QUEUE
	$DATA	IPCQUE			;LINK LIST ID OF THE INTERNAL IPCF QUEUE
	$DATA	KEPPAG			;[106]DON'T RELEASE THE PAGE AFTER A SEND
TOPS10<	$DATA	OPRPPN			;PPN OF THE OPERATOR
	$DATA	MNTPPN			;PPN FOR MAINT PRIVS
	$DATA	GOPHER			; [SYSTEM]GOPHER PID, THE EXEC PSUEDO PROCESS
>  ;END TOPS10 CONDITIONAL
	$DATA	IPCEND,0		;END OF ZEROABLE $DATA SPACE

;SPDNAM TABLE TO SETUP SEARCH FOR SPECIAL SYSTEM PIDS BY NAME

DEFINE .SPID(CANNAM,T10IDX,T20IDX,SYMNAM),<
IFNB <SYMNAM>,<
	$SET	(CANNAM,,<SIXBIT/SYMNAM/>)
>;;END IFNB SYMNAM
>;End DEFINE .SPID

SPDNAM:	$BUILD	(SZ.PID)
	SPIDS				;Generate the Special names
	$EOB


; INDIRECT TEXT STRING TO USE FOR BUILDING INFO NAME

TOPS10 <
NAMTXT:	ITEXT(<^U/[-1]/^W/S1/>) 	;OUR NAME+CUSP+NULL 
>
TOPS20 <
NAMTXT:	ITEXT(<[^U/[-1]/]^W/S1/>)
> ;END TOPS20 CONDITIONAL



	DEFINE	$SLEEP(TIME),<
	XLIST
	TOPS10 <MOVEI S1,TIME		;;GET THE TIME TO SLEEP IN SECONDS
		SLEEP S1,		;;GO TO SLEEP
	>
	TOPS20 <MOVEI S1,TIME*^D1000	;;GET THE TIME TO SLEEP IN MILLISECONDS
		DISMS			;;GO TO SLEEP
	>
	LIST>
SUBTTL	C%INIT - Initialize the IPCF interface

; Initializes IPCF interface, acquires PID and does alternate search.

;CALL IS:	IIB setup by I%INI1 in GLXINT
	
;TRUE RETURN:	Always, PID stored in the IIB

C%INIT:	MOVE	S1,[IPCBEG,,IPCBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	IPCBEG			;ZERO THE FIRST LOC
	BLT	S1,IPCEND-1		;AND DO THE REST WITH A BLT
;	SETZM	FSTPFG			;Clear first PID flag
;	SETZM	IMOPR			;Say that I'm not ORION
;	SETZM	MYPID			;We don't have a PID
;	SETZM	ACTPTR			;Clear out the acct string ptr
;	SETZM	NODPTR			;And clear out nod pointer, too
	SETOM	ALTNAM+SP.INF		;Always use real system info
	PUSHJ	P,C%MAXP			;READ MAXIMUM PACKET SIZE
	CAXLE	S1,SZ.PAK		;IS IT TOO LARGE?
	$WARN <Packet size (^D/[SZ.PAK]/) too small.  MAXPAK (^D/S1/).>
	CAXLE	S1,SZ.PAK		;PACKET SIZE OK?
	MOVX	S1,SZ.PAK		;NO -- GET OUR MAXIMUM
	MOVEM	S1,MAXPAK		;STORE FOR C%SEND
TOPS10<
	MOVX	S1,%IPCSP		;GETTAB INDEX FOR [SYSTEM]GOPHER'S PID
	GETTAB	S1,			;GET EXEC PSUEDO-PROCESS'S PID
	$STOP	(GOF,SYSTEM GOPHER IS NOT AROUND)
	MOVEM	S1,GOPHER		;SAVE FOR LATER
	SETOM	ALTNAM+SP.IPC		;Always use real IPCC, too
>;End TOPS10 conditional
	SKIPN	S2,IIB+IB.PIB		;Does the caller want to use IPCF?
	$RETT				;No, nothing to do here!
	LOAD	S1,PB.HDR(S2),PB.LEN	;Yes, get length of block in S1
	PUSHJ	P,C%CPID		;Get the PID
	JUMPT	.RETT			;OK
	$STOP	(CGP,Can't Get a PID)
SUBTTL	C%CPID - Create a PID
;This routine will create a PID, give it a name, connect it to
; the interrupt system, set its quotas, etc, etc, based on the PIB passed.
;Arguments:
;	S1-Length of block
;	S2-Addr of PIB
;Returns:
;	True, all set
;	False,	ERARG$
C%CPID:	CAIL	S1,PB.MNS		;Small PIB?
	CAILE	S1,PB.MXS		;.. or big PIB
	$RETE	(ARG)			;No good
	$SAVE	<P1,P2>			;Save some work regs
	DMOVE	P1,S1			;Copy the input args
	SKIPE	FSTPFG			;Has our data base been intialized?
	JRST	CPID.1			;Yes, charge on!
	SETOM	MSGFLG			;SET MESSAGE AVAILABLE FLAG
	SETZM	SNDFLG			;INIT SEND FLAGS
	MOVX	S1,IP.TTL		;GET TRUNCATE LONG MESSAGE FLAG
	MOVEM	S1,RCVFLG		;INIT RECEIVE FLAGS
	PUSHJ	P,RSPIDS		;READ THE SYSTEM PIDS
TOPS10 <
	MOVX	S1,%LDFFA		;WE NEED OPR PPN FOR PRIV CHECK
	GETTAB	S1,			;SO GET IT
	  MOVX	S1,<1,,2>		;USE A SUITABLE DEFAULT
	MOVEM	S1,OPRPPN		;SAVE IT
	MOVX	S1,%LDUMD		;GET MAINTANANCE PPN
	GETTAB	S1,
	  MOVX	S1,<6,,6>
	MOVEM	S1,MNTPPN
>  ;END TOPS10 CONDITIONAL

	;C%CPID	CONTINUED ON NEXT PAGE
	;C%CPID CONTINUED FROM PREVIOUS PAGE

CPID.1:	LOAD	S2,PB.INT(P2),IP.SPI	;GET REQUESTED INDEX
	JUMPE	S2,CPID.3		;JUMP IF WE ARE NOT SYSTEM TO JUST GET A PID
	CAXN	S2,SP.OPR		;Becoming ORION?
	SETOM	IMOPR			;Set flag for .STOP
	SKIPN	S1,PIDTAB(S2)		;IS THERE A PID THERE?
	JRST	CPID.2			;NAME NOT THERE -- MUST GET A PID
	MOVEM	S1,PB.PID(P2)		;Save as ours
	PUSHJ	P,C%PIDJ		;GET PID'S JOB NUMBER
	JUMPF	CPID.2			;NO OWNER -- MUST GET A PID
	CAME	S1,MYJOB		;IS IT MINE?
	 $FATAL (Requested Pid belongs to JOB ^D/S1/) ;NOPE
	JRST	CPID.7			;NO NEED TO GET A PID
					;We already own that PID

CPID.2:	SKIPN	DEBUGW			;Are we debugging?
	JRST	CPID.4			;No, never bother INFO in production
	PUSHJ	P,CHKNAM		;Set up the name pointer
	JUMPT	CPID.5			;All set, caller has special debug name
					;Otherwise, set up library convention
	LOAD	S2,PB.INT(P2),IP.SPI	;Get back special index
	SKIPN	S1,SPDNAM(S2)		;Get debugging name from table
	$FATAL	(No debugging name for special index ^O/S2/)	;None there
	MOVEI	S2,NAMTXT		;Aim at ITEXT to convert debug name
	JRST	CPID.5			;Go setup the name, get the PID

;Here if we're not becoming a system PID
CPID.3:	PUSHJ	P,CHKNAM		;Set up name pointers
	JUMPT	CPID.5			;All set, use callers name
					;otherwise, use noname
CPID.4:	SETZ	S2,			;Indicate no name desired
CPID.5:	PUSHJ	P,SETNAM		;Set name in message to IPCC or IPCF
	LOAD	S1,PB.FLG(P2),IP.JWP	;Get desired job-wide flag
	SKIPE	DEBUGW			;[110]Debugging?
	SETZ	S1,			;[110]Yes, so don't make it job-wide
	PUSHJ	P,GETPID		;GET A PID FOR MY JOB
	MOVEM	S1,PB.PID(P2)		;SAVE ACQUIRED PID

;C%CPID	CONTINUED ON NEXT PAGE
;C%CPID CONTINUED FROM PREVIOUS PAGE

;Here when the PID and requisite name have been set up.
CPID.7:	LOAD	S2,PB.PID(P2)		;Get back pid
	SKIPE	FSTPFG			;First time 'round?
	JRST	CPID.8			;No, the defaults were set last time
	MOVEM	S2,DEFPID		;Save as default for -1 to C%SPID
	MOVEM	S2,MYPID		;That's mine!
	SETOM	FSTPFG			;Note that we've been here
CPID.8:	LOAD	S1,PB.INT(P2),IP.SPI	;GET SPECIAL INDEX FIELD
	SKIPE	S1			;WANT TO BE SYSTEM PID?
	PUSHJ	P,SPID			;YES -- GO SET IT
	SETO	S1,			;SET TO WRITE IPCF PARAMETERS
	SKIPE	S2,PB.SYS(P2)		;GET IPCF PARAMETER WORD
	PUSHJ	P,IPRM			;MAKE CHANGES
	LOAD	S1,PB.FLG(P2),IP.RSE	;WANT SEND FAILURES RETURNED?
	MOVNM	S1,RSEFLG		;SET OR CLEAR THE FLAG
	LOAD	S1,PB.FLG(P2),IP.SPB	;GET SENDER'S PRIV FLAG
	SKIPN	DEBUGW			;DEBUGGING?
	STORE	S1,RCVFLG,IP.CFP	;NO -- STORE IN RECIEVE FLAGS
	LOAD	S1,PB.INT(P2),IP.CHN	;GET CHANNEL OR OFFSET FOR PSI
	LOAD	S2,PB.FLG(P2),IP.PSI	;SEE WHETHER PSI IS TO BE USED
	MOVNM	S2,PSIFLG		;SET OR CLEAR THE FLAG
	LOAD	S2,PB.PID(P2)		;Get desired PID
	SKIPE	PSIFLG			;IS IPCF CONNECTION WANTED?
	PUSHJ	P,CPIDI			;YES, CONNECT PID TO INTERRUPT SYSTEM
	PUSHJ	P,CHKAND		;Check out account and node pointers
	$RETT				;All done
SUBTTL	CHKNAM - See if PIB has a name attached
;Call - P1/ length of PIB
;	P2/ addr of PIB
;Returns - FALSE if PIB is too short or no name pointer in PIB
;	TRUE - S1 has pointer, S2 has ITEXT to it (suitable for SETNAM)

CHKNAM:	CAILE	P1,PB.NAM		;Was a name supplied?
	SKIPN	S1,PB.NAM(P2)		;Was one?
	$RETF				;No, Tell caller there's none

	TLCE	S1,-1			;0 left half
	TLCN	S1,-1			; or -1 left half?
	HRLI	S1,(POINT 7,)		;Yes, make a pointer
	MOVEI	S2,[ITEXT (<^Q/S1/>)]	;Aim at the pointer just built
	$RETT				;Return S1,S2 setup

SUBTTL	CHKAND - Check PIB to see if account and node pointers specified
;Call -	P1/ length of PIB
;	P2/ addr of PIB
;Returns - TRUE (always)

CHKAND:	CAIG	P1,PB.ACT		;Is there an act ptr on the block?
	$RETT				;No, quit
	SKIPE	S1,PB.ACT(P2)		;Get ptr, if any
	MOVEM	S1,ACTPTR		;Save it if there is one
	CAIG	P1,PB.LOC		;Is there a logical location pointer
	$RETT				;No
	SKIPE	S1,PB.LOC(P2)		;Maybe, get it
	MOVEM	S1,NODPTR		;Yes there is, save it
	$RETT				;All done
SUBTTL	C%KPID, C%SPID
;C%KPID - Kill a PID
;	Call - S1/addr of  PIB describing PID to be killed
;	Return, TRUE - PID has been killed, and removed from system tables
;			(if appilicable)
;		FALSE - PID wasn't killed,perhaps because
;			insufficient privs, or no such PID
C%KPID:	$SAVE	<P1>			;Save work reg
	MOVE	P1,S1			;Copy input arg
	SKIPN	S1,PB.PID(P1)		;Get PID, if any
	$RETT				;None there, all done!
TOPS10<
	LOAD	S2,PB.INT(P1),IP.SPI	;Get special PID index
	SKIPE	S2			;If special index
	SKIPN	DEBUGW			; ... and we're debugging,
	SKIPA				;(Not special, or not debug) skipa
	JRST	KPID.N			; ... must be named, kill via INFO
	$SAVE	<P2>			;Preserve another AC
	PUSH	P,S1			;Save PID to be killed
	MOVE	P2,P1			;Setup addr of PIB
	LOAD	P1,PB.HDR(P2),PB.LEN	;Get length of the PIB
	PUSHJ	P,CHKNAM		;See if this PIB is named
	JUMPF	[POP	P,S1		;No name, Get back PID
		JRST	KPID.U]		;And kill it either way
	POP	P,S1			;There is a name, must kill via INFO
KPID.N:	PUSHJ	P,KILPDN		;Kill via INFO
	SKIPA				;Reenter common flow
KPID.U:>;End TOPS10
	PUSHJ	P,KILPID		;Give it the gong
	JUMPF	.RETF			;Couldn't do it
	MOVE	S2,PB.PID(P1)		;Get back PID just killed
	MOVSI	S1,-SZ.PID		;Get AOBJN ptr for PIDTAB
KPID.1:	CAMN	S2,PIDTAB(S1)		;Does this one match?
	SETZM	PIDTAB(S1)		;Yes, kill it
	AOBJN	S1,KPID.1		;Check all the pids in our table
	$RETT				;Back to caller

;C%SPID - A routine to set the default send PID
;Call  S1/addr of PIB describing new default or -1 to set original default
;Return - TRUE always
C%SPID:	SKIPGE	S1			;Skip if a PIB is there, otherwise...
	SKIPA	S2,DEFPID		;Get original default PID
	SKIPE	S2,PB.PID(S1)		;Get PID to be set
	MOVEM	S2,MYPID		;Set as our sender default
	$RETT
SUBTTL	C%SEND Routine to send an IPCF Message

;CALL	S1/ Length of SAB
;	S2/ Address of SAB

;TRUE Return if message is sent Successfully

;FALSE Return if message cannot be sent for any reason

;POSSIBLE ERRORS

;	ERARG$		Invalid Calling Argument
;	ERNSP$		No Such Pid
;	ERRQF$		Recievers Quota Full
;	ERSQF$		Senders Quota Full
;	ERSLE$		System Limits Exceeded
;	ERUSE$		Unexpected System Error

C%SEND:	SETZM	KEPPAG			;[106]ASSUME WANT TO RELEASE THE PAGE
	TXZE	S1,PT.KEE		;[106]KEEP THIS PAGE AFTER A SEND?	
	SETOM	KEPPAG			;[106]YES, INDICATE SO
	CAIGE	S1,SAB.SZ		;[106]PROPER SAB?
	 $RETE(ARG)			;NO -- RETURN ERROR
	PUSHJ	P,.SAVE2		;PRESERVE P1-P2
	LOAD	P1,SAB.LN(S2)		;P1 IS MESSAGE LENGTH
	MOVE	P2,S2			;P2 IS SAB ADDRESS
	CAIL	P1,1			;MESSAGE LENGTH OK?
	CAILE	P1,PAGSIZ
	 $RETE(ARG)			;NO -- RETURN ERROR
	LOAD	S2,SAB.MS(P2)		;GET MESSAGE ADDRESS
	CAMG	P1,MAXPAK		;LARGR THAN A PACKET?
	JRST	SEND.4			;NO -- SEND A PACKET
	CAIN	P1,PAGSIZ		;EXACTLY ONE PAGE?
	JRST	SEND.2			;YES -- GO SEND IT
	$CALL	M%GPAG			;NO -- CREATE A PAGE AND COPY MESSAGE
	HRL	S1,SAB.MS(P2)		;FORM BLT POINTER
	HRRZ	S2,S1			;GET NEW PAGE ADDRESS
	ADDI	S2,0(P1)		;ADDRESS + MESSAGE SIZE
	BLT	S1,-1(S2)		;MOVE ENTIRE MESSAGE TO NEW PAGE
	SUBI	S2,0(P1)		;RECLAIM NEW MESSAGE ADDRESS
	SETZM	KEPPAG			;[106]RETURN SUPPLIED PAGE
;HERE TO SEND A PAGE

SEND.2:	TRNE	S2,PAGSIZ-1		;IS PAGE ON PAGE BOUNDRY?
	 $RETE(ARG)			;NO -- RETURN ERROR
	ADR2PG	S2			;YES -- CONVERT TO PAGE NUMBER
	HRLI	S2,PAGSIZ		;SEND A FULL PAGE
	MOVX	S1,IP.CFV		;GET THE PAGE MODE FLAG
	IORM	S1,SNDFLG		;AND SET IT
	MOVE	S1,P2			;POINT TO SAB
	MOVEI	P2,(S2)			;REMEMBER THE PAGE NUMBER
	PUSHJ	P,SNDMSG		;GO SEND THE MESSAGE
	JUMPT	.POPJ			;ANY ERRORS? NO, RETURN
	CAIN	P1,PAGSIZ		;YES, DID WE SUPPLY THIS PAGE?
	$RET				;NO, USER GAVE US THE PAGE, RETURN F
	$SAVE	<TF,S1>			;SAVE FOR FINAL RETURN
	MOVE	S1,P2			;RECLAIM PAGE NUMBER
	$CALL	M%RELP			;RELEASE THE PAGE WE GOT FOR THE BIG PACKET
	$RET				;RETURN TF AND S1 FROM SNDMSG

;HERE TO SEND A PACKET

SEND.4:	HRL	S2,P1			;FORM LENGTH,,ADDRESS
	MOVX	S1,IP.CFV		;GET PAGE MODE FLAG
	ANDCAM	S1,SNDFLG		;AND CLEAR IT
	MOVE	S1,P2			;POINT TO SAB
	PJRST	SNDMSG			;FALL INTO COMMON CODE AND RETURN
SUBTTL SNDMSG - Work routine to do actual IPCF send

;CALL		S1/ SAB Address
;		S2/ Message Length,,Message Address
;If the message is paged, then a true return will
; leave the page unaddressable, and a false return will leave it addressable

SNDMSG:	$SAVE	<P1,P2,P3,P4>
	DMOVE	P1,S1			;PRESERVE CALLING ARGS
	SKIPN	P3,RSEFLG		;RETURN SEND ERRORS?
	MOVX	P3,RT.SFL		;NO -- LOAD RETRY LIMIT
	MOVE	S1,MYPID		;GET MY PID
	SKIPE	S2,SAB.PB(P1)		;WANT TO SEND FOR A DIFFERENT PID?
	MOVE	S1,PB.PID(S2)		;YES, GET PID FROM PIB ATTACKED TO SAB
	SKIPN	S1			;IS THERE REALLY A PID?
	$RETE	(ARG)			;NO, COMPLAIN
	MOVEM	S1,SNDBLK+.IPCFS	;I AM SENDER
	LOAD	S1,SAB.PD(P1)		;GET RECIEVERS PID OR ADDR OF PID'S NAME
	SETO	P4,			;SYSTEM INDEX OR -1 IF SEND BY PID
	LOAD	S2,SAB.SI(P1),SI.FLG	;GET SPECIAL INDEX FLAG
	JUMPE	S2,SNDM.2		;SEND BY PID? NO, TRY OTHER FEATURES
	LOAD	S1,SAB.SI(P1),SI.IDX	;NO -- SEND BY INDEX
	MOVE	P4,S1			;REMEMBER WHO IT IS
	SKIPN	P3,RSEFLG		;RETURN SEND ERRORS?
	MOVX	P3,RT.SCL		;NO -- GET SYSTEM RETRY LIMIT
SNDM.1:	PUSHJ	P,RSPID			;GET THE RECIEVERS PID
	JUMPT	SNDM.3			;GOT IT, SO SEND TO IT
	CAIE S1,ERNSP$			;UNKNOWN PID FOR SYSTEM COMPONENT?
	$RET				;NO -- RETURN THE ERROR
	CAXN P3,RT.SCL			;YES -- FIRST RETRY?
	SKIPN SPDNAM(P4)		;YES -- DOES PID HAVE A NAME?
	 CAIA				;NO -- DON'T PRINT THE MSG
	SKIPN DEBUGW			;YES -- DEBUGGING?
	 CAIA				;NO -- DON'T PRINT THE MESSAGE
	$WARN (Waiting for ^W/SPDNAM(P4)/ to start)
	SOJL P3,.POPJ			;RETURN ERROR IF RETRY LIMIT EXAUSTED
	$SLEEP RT.SLP			;SLEEP FOR A WHILE
	MOVE S1,P4			;RETORE DESIRED INDEX
	JRST SNDM.1			;AND TRY AGAIN

SNDM.2:	LOAD	S2,SAB.SI(P1),SI.NAM	;WANT TO SEND TO A NAMED PID?
	JUMPE	S2,SNDM.3		;NO, JUST USE THE PID
	MOVEI	S2,[ITEXT(^Q/S1/)]	;YES, AIM AT THE TEXT (SAB.PD HAS ADDR)
	PUSHJ	P,FNDNAM		;GET THE NAME'S PID FROM INFO
	JUMPF	.POPJ			;QUIT IF INFO CAN'T MAP THE NAME
SNDM.3:	MOVEM	S1,SNDBLK+.IPCFR	;SAVE RECIEVERS PID
	MOVEM	P2,SNDBLK+.IPCFP	;SAVE PAGE/PACKET POINTER
	MOVE	S2,SNDFLG		;GET SEND FLAGS
TOPS10 <
	CAME	S1,GOPHER		;SENDING TO SYSTEM GOPHER?
	CAMN	S1,PIDTAB+SP.IPC	;SENDING TO IPCC?
	IORX	S2,IP.CFP		;YES -- ENABLE PRIVS
	SETZ	P1,			;CLEAR PAGE MODE TO GOPHER FLAG
	CAMN	S1,GOPHER		;SENDING TO GOPHER?
	TXZN	S2,IP.CFV		;SENDING A PAGE TO THE GOPHER?
	JRST	SNDM.4			;NO, NOTHING SPECIAL
	SETO	P1,			;NOTE THAT WE FAKED A PAGE TO GOPHER
	IORX	S2,IP.CFL		;YES, SET LARGE PACKET BIT
	HRRZ	TF,P2			;GOPHER DOESN'T LIKE PAGES
	PG2ADR	TF			;SO MAKE IT A LARGE PACKET
	HRLI	TF,PAGSIZ-2		;AND LOSE 2 WORDS OF CALLER'S MESSAGE
	MOVEM	TF,SNDBLK+.IPCFP	;SEND LARGE PACKET INSTEAD
SNDM.4:
> ;END TOPS10 CONDITIONAL
	MOVEM	S2,SNDBLK+.IPCFL	;STORE SEND FLAGS

TOPS10 <
SNDM.5:	MOVE	S1,[IPCSLN,,SNDBLK]	;ARG FOR UUO
	IPCFS.	S1,			;SEND THE MESSAGE
	  JRST	SNDERR			;SEE WHY WE LOST
> ;END TOPS10 CONDITIONAL

TOPS20 <
SNDM.5:	MOVEI	S1,IPCSLN		;NUMBER OF WORDS IN BLOCK
	MOVEI	S2,SNDBLK		;AND ITS ADDRESS
	MSEND				;SEND IT
	  JRST	SNDERR			;SEE WHY WE LOST
>	;END TOPS20 CONDITIONAL

;Here if the send wins
	HLRZ	S1,P2			;GET DESIRED MESSAGE SIZE
	CAIE	S1,PAGSIZ		;WAS THE MESSAGE A PAGE?
	$RETT				;NO, ALL DONE!
	SKIPE	KEPPAG			;[106]WANT TO KEEP THE PAGE?
	$RETT				;[106]RETURN NOW
	HRRZ	S1,P2			;GET THE ADRS OF THE PAGE
	PUSHJ	P,M%IPSN##		;NO, NOTIFY MEMORY MANAGER OF PAGE SENT
	HRRZ	S1,P2			;GET PAGE NUMBER AGAIN
	PJRST	M%RELP##		;AND NOW SAY ITS OUT OF OUR ADRS SPACE

;SNDMSG CONTINUED ON NEXT PAGE
;SNDMSG CONTINUED FROM PREVIOUS PAGE

;HERE TO HANDLE SEND FAILURES WITH ERROR CODE IN S1

SNDERR:	CAXE	S1,IPE.SQ		;SENDER'S QUOTA FULL?
	CAXN	S1,IPE.RQ		;OR RECIEVER'S QUOTA FULL?
	 JRST	SNDE.1			;YES -- THEN TRY AGAIN
	CAXE	S1,IPE.SF		;FREE SPACE EXAUSTED?
;**;[101]At SNDERR:+4L add 2 lines	JYCW	10/7/85
	CAXN	S1,IPE.SS		;[101]Swappable free space? 
	SKIPA				;[101]Yes, try again
	 JRST	SNDE.3			;NO -- THEN FAIL

;HERE TO HANDLE TRANSIENT SEND FAILURES

SNDE.1:	SOJL	P3,SNDE.2		;TIME TO GIVE UP?
	$SLEEP	RT.SLP			;WAIT FOR CONDITION TO CLEAR
	JRST	SNDM.5			;THEN TRY THE SEND AGAIN

;**;[101]At SNDE.2: add 1 line	JYCW	10/7/85
SNDE.2:	CAXE	S1,IPE.SS		;[101]No swappable free space
	CAXN	S1,IPE.SF		;NO SYSTEM FREE SPACE?
	JRST	[ $WARN(IPCF Swapping Space Low - Will Retry Message Send)
		  MOVX P3,RT.SCL		;Reset Retry Count
		  JRST SNDM.5 ]			;Reattempt to send message
	CAXN	S1,IPE.RQ		;IS RECEIVER'S QUOTA FULL?
	 $RETE(RQF)			;YES -- RETURN ERROR
	CAXN	S1,IPE.SQ		;IS SENDER'S QUOTA FULL?
	 $RETE(SQF)			;YES -- RETURN ERROR
SNDE.3:	CAXE	S1,IPE.DU		;UNKNOWN DESTINATION?
	 $RETE(USE)			;NO -- UNEXPECTED SYSTEM ERROR
	SKIPL	P4			;YES --WAS THERE A SYSTEM INDEX?
	SETZM	PIDTAB(P4)		;YES -- REMEMBER IT'S GONE AWAY
	$RETE(NSP)			;RETURN NO SUCH PID
SUBTTL	C%INTR - Interrupt level routine to flag message available

;Called to note the fact that an IPCF interrupt has occured

;CALL IS:	No arguments
;
;TRUE RETURN:	Always


C%INTR:	SKIPN	PSIFLG			;ARE IPCF INTERRUPTS EXPECTED?
	  $STOP(UIR,Unexpected IPCF interrupt received)
	SETOM	MSGFLG			;FLAG THAT INTERRUPT HAS OCCURED
TOPS10 <
	MOVE	S1,@IPCINT		;GET ASSOCIATED VARIABLE
	SKIPN	IPCSTS			;ALREADY SETUP
	MOVEM	S1,IPCSTS		;NO..SET IT UP
>;END TOPS10 CONDITIONAL
	$RETT				;TAKE A GOOD RETURN

SUBTTL	C%RECV - Non-blocking IPCF receive

;C%RECV returns the next message from the IPCF queue or error ERNMA$
;	indicating that no messages are outstanding.
;
;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ CONTAINS POINTER TO MDB (SEE GLXMAC)
;  OR
;FALSE RETURN:	S1/ CONTAINS ERROR CODE FOR FAILURE


C%RECV:	AOSE	MSGFLG			;IF FLAG SAYS THERE IS MESSAGE
	SKIPN	PSIFLG			; OR NO PSI CONNECTION
	SKIPA	S1,[IP.CFB]		;OK -- GET NON-BLOCKING FLAG
	$RETE(NMA)			;OTHERWISE, NO MESSAGE AVAILABLE
	IORM	S1,RCVFLG		;SET THE FLAG
	PJRST	RCVMSG			;AND GO DO THE WORK




SUBTTL	C%BRCV - Blocking IPCF Receive

;C%BRCV differs from C%RECV in that it never returns with the error
;	condition ERNMA$.  If no message is available, C%BRCV will block,
;	waiting for the next IPCF message.
;
;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ CONTAINS POINTER TO MDB (SEE GLXMAC)
;  OR
;FALSE RETURN:	S1/ CONTAINS ERROR CODE (SEE GLXMAC)

C%BRCV:	MOVX	S1,IP.CFB		;GET NON BLOCKING FLAG
	ANDCAM	S1,RCVFLG		;CLEAR IT AND GO DO RECIEVE
SUBTTL	RCVMSG - Work routine to do an actual IPCF receive


RCVMSG:	SKIPN	QUELOK			;IS THE IPCF QUEUE LOCKED ???
	SKIPN	S1,IPCQUE		;NO,,ANY INTERNAL QUEUE ???
	JRST	RCVM.A			;LOCKED OR NO QUEUE,,GET REAL MSG

	;Here to pick up an IPCF message off the internal queue

	PUSHJ	P,L%FIRST		;GET THE FIRST MSG ON THE QUEUE
	JUMPF	[MOVE  S1,IPCQUE	;NO MSGS,,GET THE ID BACK
		 SETZM IPCQUE		;CLEAR THE QUEUE ID
		 PUSHJ P,L%DLST		;DELETE THE QUEUE
		 JRST  RCVM.A	]	;AND GET A REAL MESSAGE
	SETOM	MSGFLG			;REMEMBER WE HAVE A PACKET
	MOVSS	S2			;GET MDB ADDRESS,,0
	HRRI	S2,RCVMDB		;GET MDB ADDRESS,,DESTINATION
	BLT	S2,RCVMDB+MDB.SZ-1	;COPY OVER TO PERMANENT MDB
	PUSHJ	P,L%DENT		;DELETE THE QUEUED MDB
	LOAD	S1,RCVMDB+MDB.MS,MD.CNT	;GET THE MESSAGE LENGTH
	CAXN	S1,PAGSIZ		;IS IT A PAGE ???
	JRST	RCVM.7			;YES,,RETURN TO THE USER
	LOAD	S2,RCVMDB+MDB.MS,MD.ADR	;GET THE PACKET ADDRESS
	PUSH	P,S2			;SAVE ITS ADDRESS
	MOVSS	S2			;GET PACKET ADDRESS,,0
	HRRI	S2,PACKET		;GET PACKET ADDRESS,,NEW ADDRESS
	BLT	S2,PACKET-1(S1)		;COPY IT OVER
	POP	P,S2			;GET THE ADDRESS BACK
	PUSHJ	P,M%RMEM		;DELETE THE QUEUED PACKET
	MOVEI	S1,PACKET		;GET THE NEW PACKET ADDRESS
	STORE	S1,RCVMDB+MDB.MS,MD.ADR	;AND SAVE IT
	JRST	RCVM.7			;RETURN TO THE USER

	;Here to recieve a real IPCF message

RCVM.A:	PUSHJ	P,.SAVE3		;GET SOME AC'S
	SETZ	S1,			;SETUP TO TEST/CLEAR IPCSTS
	EXCH	S1,IPCSTS		;GET STATUS WORD AND RESET
	SKIPN	S1			;ANYTHING SET?
	TXOA	S1,1			;NO -- SET A BIT FOR PAGE MODE
	LOAD	S1,S1,IP.CFV		;YES -- GET ACTUAL MODE
	STORE	S1,RCVFLG,IP.CFV	;STORE MODE FLAG
	JUMPE	S1,RCVM.1		;PACKET?
RCVM.0:	SKIPE	S1,RCVPAG		;NO -- DO WE HAVE A RECIVE PAGE?
	 JRST	RCVM.1			;YES -- NO NEED TO GET ONE
	PUSHJ	P,M%NXPG		;NO --GET A NON-EXISTENT PAGE
	JUMPF	[SETOM	MSGFLG		;OOPS -- CAN'T GET ONE
		 $RETE	(SLE)]		;RETURN ERROR
	HRLI	S1,PAGSIZ		;PLACE PAGE SIZE IN LEFT HALF
	MOVEM	S1,RCVPAG		;AND SAVE IT
RCVM.1:	MOVE	S1,RCVFLG		;GET FLAGS TO USE
	MOVEM	S1,RCVBLK+.IPCFL	;INIT RECIEVE BLOCK
	TXNN	S1,IP.CFV		;PAGE MODE?
	SKIPA	S2,[SZ.PAK,,PACKET]	;NO -- POINT TO PACKET
	MOVE	S2,RCVPAG		;YES -- GET PAGE TO USE
	MOVEM	S2,RCVBLK+.IPCFP	;SAVE PROPER POINTER
	MOVE	S1,MYPID		;RECIEVE ON MY BEHALF
	MOVEM	S1,RCVBLK+.IPCFR
	SETZM	RCVBLK+.IPCFS		;UNKNOWN SENDER -- UNTIL RECIEVE

TOPS10 <
RCVM.2:	MOVE	S1,[IPCRLN,,RCVBLK]	;UUO ARGUMENT
	IPCFR.	S1,			;DO THE RECEIVE
	  JRST	RCVM.3			;WE HAVE AN ERROR, GO ANALYZE IT
	SKIPE	S1			;ANY ASSOCIATED VARIABLE
	MOVEM	S1,IPCSTS		;YES..UPDATE THE STATUS
	LOAD	S2,RCVBLK+.IPCFU	;GET LOGGED IN PPN OF USER
	STORE	S2,RCVMDB+MDB.SD	;STORE IT
	STORE	S2,RCVMDB+MDB.CD	;ALSO USE IT AS CONNECTED DIRECTORY
	MOVE	S2,RCVBLK+.IPCFC	;GET CAPABILTIES WORD
	LOAD	P1,S2,IP.SJN		;GET SENDERS JOB NUMBER
	STORE	P1,P1,MD.PJB		;STORE IT
	TXNE	S2,IP.JAC		;JACCT ON?
	TXO	P1,MD.PWH		;YES, TURN ON WHEEL
	MOVE	S2,RCVBLK+.IPCFU	;GET PPN WORD
	CAMN	S2,OPRPPN		;IS HE THE OPERATOR?
	TXO	P1,MD.POP		;YES, SET OPERATOR
	CAMN	S2,MNTPPN		;HAVE MAINTANANCE PRIVS?
	TXO	P1,MD.PMT		;YES, SET THE PRIV
	LOAD	S1,P1,MD.PJB		;GET THE JOB NUMBER
	STORE	P1,RCVMDB+MDB.PV	;SAVE SENDERS PRIVILEGES
	SKIPN	NODPTR			;WANT THE LOCATED NODE RETURNED?
	PJRST	RCVM.5			;NO..PROCEED
	MOVX	S2,JI.LOC		;YES..GET THE INFO
	$CALL	I%JINF
	JUMPF	RCVM.5			;SORRY ABOUT THAT
	MOVE	S1,NODPTR		;GET THE POINTER
	$CALL	SIXASC			;STORE SIXBIT AS ASCIZ
	JRST	RCVM.5			;GO FINISH UP
>  ;END TOPS10 CONDITIONAL
TOPS20 <
RCVM.2:	MOVE	S1,ACTPTR		;Get ptr to users acct area
	MOVEM	S1,RCVBLK+.IPCAS	;SAVE IT IN THE BLOCK.
	MOVE	S1,NODPTR		;Get ptr to users node area
	MOVEM	S1,RCVBLK+.IPCLL	;SAVE IT IN THE BLOCK
	DMOVE	S1,[EXP IPCRLN,RCVBLK]	;SET SIZE AND LOCATION OF BLOCK
	MRECV				;DO THE RECEIVE
	  JRST	RCVM.3			;WE HAVE AN ERROR, ANALYZE IT
	SKIPE	S1			;ANY ASSOCIATED VARIABLE
	MOVEM	S1,IPCSTS		;YES..UPDATE THE STATUS
	MOVE	S2,RCVBLK+.IPCFD	;GET LOGGED IN NUMBER
	STORE	S2,RCVMDB+MDB.SD	;STORE AS USER NUMBER
	MOVE	S2,RCVBLK+.IPCSD	;GET THE CONNECTED DIRECTORY
	STORE	S2,RCVMDB+MDB.CD	;AND STORE IT TOO
	LOAD	S1,RCVBLK+.IPCFS	;GET SENDERS PID
	$CALL	C%PIDJ			;GET SENDERS JOB NUMBER
	SKIPT				;FAIL?
	SETZ	S1,			;YES..STORE A ZERO
	SETZ	P3,			;CLEAR ANY JUNK
	STORE	S1,P3,MD.PJB		;AND PUT IT IN THE CORRECT PLACE
	MOVE	S2,RCVBLK+.IPCFC	;GET OS CAPABILITIES
	MOVEM	S2,RCVMDB+MDB.PR	;Save enabled capabilites of sender
	TXNE	S2,SC%WHL		;SENDER A WHEEL?
	TXO	P3,MD.PWH		;YES
	TXNE	S2,SC%OPR		;SENDER AN OPERATOR?
	TXO	P3,MD.POP		;YES
	TXNE	S2,SC%MNT		;GOT MAINTAINACE PRIVS
	TXO	P3,MD.PMT		;YES!
	TXNE	S2,SC%SEM		;[6000]GOT SEMI-OPR PRIVS
	TXO	P3,MD.SEM		;YES!
	MOVEM	P3,RCVMDB+MDB.PV	;STORE THE PRIVS
	JRST	RCVM.5			;GO FINISH UP THE RECEIVE
>  ;END TOPS20 CONDITIONAL


; HERE TO WHEN IPCF RECIEVE FAILS
RCVM.3:	CAXN	S1,IPE.NM		;IS THIS "NO MESSAGE"?
	  $RETE	(NMA)			;YES -- RETURN
	CAXE	S1,IPE.WM		;CHECK FOR "WRONG MODE" ERROR
	  JRST	RCVM.4			;NOPE -- MUST BE REAL ERROR
	MOVX	S1,IP.CFV		;YES --GET PAGE MODE BIT
	XORB	S1,RCVFLG		;SWITCH MODES
	TXNE	S1,IP.CFV		;PAGE MODE
	JRST	RCVM.0			;YES -- GO GET IT RIGHT
	JRST	RCVM.1			;NO -- GO GET A PACKET

RCVM.4:	CAXE	S1,IPE.NR		;CHECK FOR "NO ROOM" (TOPS-10)
	$STOP(IRF,IPCF Reception failure)
	PUSHJ	P,M%IPRM		;TRY TO MAKE SOME ROOM
	JUMPT	RCVM.1			;TRY AGAIN
	$RETE	(NPI)			;?NO FREE PAGES FOR IPCF RECEPTION
;HERE ON A SUCCESSFUL RECEIVE

RCVM.5:	SKIPE	IPCSTS			;MORE MESSAGES IN QUEUE?
	SETOM	MSGFLG			;YES -- SET MSG AVAILABLE FLAG
	LOAD	S1,RCVBLK+.IPCFL	;GET FLAGS
	STORE	S1,RCVMDB+MDB.FG	;STORE INTO MDB
	TXNE	S1,IP.CFV		;DID WE RECIVE A PAGE?
	SETZM	RCVPAG			;YES -- CLEAR OUR PAGE
	LOAD	S1,RCVBLK+.IPCFP	;GET LENGTH AND ADDRESS OF DATA
	STORE	S1,RCVMDB+MDB.MS	;STORE INTO MDB
	LOAD	S1,RCVBLK+.IPCFS	;GET PID OF SENDER
	STORE	S1,RCVMDB+MDB.SP	;STORE AS SENDER'S PID
	LOAD	S1,RCVBLK+.IPCFR	;GET RECEIVER'S PID
	STORE	S1,RCVMDB+MDB.RP	;STORE IT TOO
	SETZM	RCVMDB+MDB.SI		;ASSUME NOT A SPECIAL SENDER
	MOVSI	S1,-SZ.PID		;GET LENGTH OF TABLE
	MOVE	S2,RCVMDB+MDB.SP	;GET SENDER'S PID
	CAME	S2,PIDTAB(S1)		;MATCH SENDER'S PID?
	AOBJN	S1,.-1			;KEEP LOOKING
	TXZN	S1,LHMASK		;WAS IT A MATCH?
	 JRST	RCVM.6			;NO -- GIVE UP
	TXO	S1,SI.FLG		;YES -- SET SPECIAL INDEX FLAG
	MOVEM	S1,RCVMDB+MDB.SI	;STORE INTO INDEX WORD
	MOVX	S1,MD.POP		;SET OPERATOR CAPABILITY
	SKIPE	DEBUGW			;DEBUGGING?
	IORM	S1,RCVMDB+MDB.PV	;YES..SET THE CAPABILITY
RCVM.6:	LOAD	S1,RCVMDB+MDB.MS,MD.CNT	;GET SIZE OF MESSAGE
	CAXE	S1,PAGSIZ		;IF NOT A PAGE
	JRST	RCVM.7			;RETURN NOW
	LOAD	S1,RCVMDB+MDB.MS,MD.ADR	;GET PAGE NUMBER
	PUSHJ	P,M%IPRC		;NOTIFY THAT IT IS IN NOW
	LOAD	S1,RCVMDB+MDB.MS,MD.ADR	;GET PAGE NUMBER FROM MDB
	PG2ADR	S1			;CONVERT IT TO AN ADDRESS
	STORE	S1,RCVMDB+MDB.MS,MD.ADR	;STORE IT BACK INTO MDB
RCVM.7:	MOVEI	S1,RCVMDB		;GET POINTER TO MDB AND TAKE
	$RETT				;GENERATE A GOOD RETURN
SUBTTL C%REL  - Release the last message received

; C%REL is used to release the last message received via C%RECV or C%BRCV.
;If this message is a packet, then this is a null operation, and if its
;a page, the page is released.

;CALL IS:	No arguments
;
;TRUE RETURN:	Always

C%REL:	SKIPN	S2,RCVMDB+MDB.MS	;GET SIZE AND ADDRESS OF MESSAGE
	$STOP(RAR,Releasing already released IPCF message) ;ALREADY RELEASED
	ZERO	RCVMDB+MDB.MS		;MARK MESSAGE AS RELEASED
	LOAD	S1,S2,MD.CNT		;GET SIZE OF MESSAGE
	CAXE	S1,PAGSIZ		;IS THIS MESSAGE A PAGE?
	$RETT				;NO, SO RETURN NOW
	LOAD	S1,S2,MD.ADR		;GET ADDRESS OF MESSAGE
	ADR2PG	S1			;GET THE PAGE NUMBER
	PJRST	M%RELP			;RETURN AFTER RELEASING THE PAGE


SUBTTL	C%RPRM	Routine to read IPCF Parameters

;C%RPRM IS USED TO  EXAMINE THE MOST COMMONLY NEEDED
;IPCF PARAMETERS.  THESE INCLUDE THE TOTAL NUMBER OF PIDS AND THE 
;IPCF RECEPTION / SEND QUOTAS.

;CALL IS:	S1/ -1 TO READ PARAMETERS OF PID QUOTA, SND,RCV QUOTAS
;			OR ELSE AN SP.??? SYMBOL TO RETURN THAT ENTRY FROM
;			THE PID TABLE
;
;TRUE RETURN:	IF THE INFORMATION IS AVAILABLE
;		S1/<MAX PIDS>B17+<SND QUOTA>B26+<RCV QUOTA>B35 ;IF S1=-1
;		S1/ PID TABLE ENTRY ; IF S1=0 OR +

C%RPRM:	JUMPGE	S1,RSPID		;IF NON-ZERO, WANT SYSTEM PID
	SETZ	S1,			;SET TO READ IPCF PARAMETERS
	PJRST	IPRM			;GO READ PARAMS AND RETURN
SUBTTL GETPID - Acquire a PID for this job


;CALL IS:	First, Call SETNAM to setup name (if any)
;		S1 - 1 means set JWP
;
;TRUE RETURN:	S1/ PID acquired for this job

GETPID:
TOPS10 <
	$SAVE	<P1,P2,MYPID>		;Save some regs
	PJOB	S2,			;Get our job number
	MOVX	TF,IB.DPM		;GET A BIT
	TDNE	TF,IIB##+IB.FLG		;USE JOB NUMBER AS PID ?
	JRST	GETP.1			;YES - THIS MAKES LIFE EASY FOR US
	MOVEM	S2,MYPID		;Save as our (temporary) PID
	SKIPN	P2,S1			;Want JWP?
	TXO	S2,1B0			;NO -- MAKE PID TEMPORARY
	MOVEM	S2,PACKET+.IPCI1	;ARGUMENT
	SETO	P1,			;Set 'named PID flag'
	SKIPE	PACKET+.IPCI2		;Is a name desired?
	JRST	GETP.3			;Yes, must go thru INFO
	SETZ	P1,			;Clear 'named PID flag'
	MOVE	S1,[XWD C%INIT,.IPCSC]	;FUNCTION IS MAKE PID
	MOVX	S2,SP.IPC		;ASK IPCC TO DO IT
	PUSHJ	P,SNDSYS		;SEND IT OFF, GET REPLY
	JUMPF	GETP.2			;Failed, maybe no privs, try INFO
	MOVE	S1,PACKET+.IPCS2	;GET PID RETURNED BY IPCC
	$RETT				;RETURN

; Here to use our job number fo r a PID
GETP.1:	MOVE	S1,S2			;GET JOB NUMBER
	$RETT				;RETURN

;Here to ask INFO for a PID (perhaps named)
GETP.2:	SETZ	S2,			;Indicate no name desired
	PUSHJ	P,SETNAM		;Set up the PACKET
GETP.3:	MOVE	S1,[XWD C%INIT,.IPCII]	;Function to make a named PID, till RESET
	SKIPE	P2			;Want to be job-wide?
	MOVE	S1,[XWD C%INIT,.IPCIJ]	;Function to make a named PID, job wide
	MOVX	S2,SP.INF		;Ask INFO to do it
	PUSHJ	P,SNDSYS		;SEND IT OFF, GET REPLY
	SKIPT				;Ok?, Yes, return it
	$FATAL	<Can't get a PID>
	MOVE	S1,PACKET+.IPCI1	;Get the PID returned by INFO
	SKIPN	P1			;Did we get a name?
	$RETT				;Give that back
	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	$WARN	<^I/NAMMSG/>		;Type the name we're getting
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL


TOPS20 <
	$SAVE	<T1,T2,T3,T4>		;SAVE TEMPS
	MOVX	T1,.MUCRE		;CREATE A PID FUNCTION
	MOVX	T2,IP%CPD+.FHSLF	;CREATE A PID FOR ME
	STORE	S1,T2,IP%JWP		;SET OR CLEAR REQUEST FLAG
	DMOVE	S1,[EXP 3,T1]		;3 WORDS, START AT T1
	MUTIL				;EXECUTE IT
	  $FATAL <Can't get a PID>
	MOVEM	T3,PACKET+.IPCI1	;Save PID obtained
	MOVE	S1,T3			;Set up for quick return
	SKIPN	PACKET+.IPCI2		;Do we need a name?
	$RETT				;No, all done!
	PUSH	P,MYPID			;Save whatever is there now
	MOVEM	S1,MYPID		;Save temp PID while we name ourselves
	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	$WARN	<^I/NAMMSG/>		;TYPE OUT MESSAGE
	MOVE	S1,[XWD C%INIT,.IPCII]	;Setup code to assign name
	MOVX	S2,SP.INF		;Send to INFO
	PUSHJ	P,SNDSYS		;Get name assigned to our PID
	SKIPT				;Did that work?
	$FATAL	<Can't name the PID. Error bits = ^O/RCVMDB+MDB.FG,IP.CFE/>
	MOVE	S1,MYPID		;Get back PID
	POP	P,MYPID			;Put back previous PID
	$RETT				;OK
> ;END TOPS20 CONDITIONAL

;An ITEXT to print out the debugging name
NAMMSG:	ITEXT	<Becoming  ^T20/PACKET+.IPCI2/ (PID = ^O/S1/)>
SUBTTL	KILPID	Routine to delete a pid

;KILL PID IS CALLED DURING INITIALIZATION TO RETURN ANY PID ACQUIRED
;THAT WE NO LONGER NEED.
;Tops10 Alternate entry at KILPDN, to kill a PID via INFO, since
;	the PID to be killed is known to be named

;CALL		S1/ Pid to be killed

;TRUE RETURN:	Pid has been killed

;FALSE RETURN:	Pid wasn't killed

TOPS10 <
KILPID:	MOVEM	S1,PACKET+.IPCI1	;SAVE PID TO BE KILLED
	MOVE	S1,[KILPID,,.IPCSZ]	;CODE,,DELETE PID FUNCTION
	MOVX	S2,SP.IPC		;Try sending to IPCC
	PUSHJ	P,SNDSYS		;SEND IT OFF
	JUMPT	.RETT			;RETURN IF ALL SET
	MOVE	S1,PACKET+.IPCI1	;Get back PID which should have gone
KILPDN:	MOVEM	S1,PACKET+.IPCI2	;Save PID in message to INFO
	MOVE	S1,[KILPID,,.IPCID]	;IPCC won't listen, probably no privs
	MOVX	S2,SP.INF		;Try INFO
	PJRST	SNDSYS			;If that bombs, return F
> ;END TOPS10 CONDTIONAL

TOPS20 <
KILPID:	MOVEM	S1,MTLBLK+1		;SAVE PID TO BE KILLED
	DMOVE	S1,[EXP 1,MTLBLK]	;POINT TO IT
	MOVX	S1,.MUDES		;DESTROY THE PID
	MOVEM	S1,MTLBLK		;SET THE FUNCTION
	MUTIL
	 $RETF
	$RETT
> ;END TOPS20 CONDITIONAL
SUBTTL SPID   - Set a system PID

;SPID sets a system wide pid in the internal pid table and in the
;monitor pid table if not debugging.

;CALL IS:	S1/ Index into the system pid table
;		S2/ Pid to store in system Pid Table
;
;RETURN:	Pid stored in internal and system pid table
;		(if Debugging -- pid is stored in internal table only)

SPID:	CAIL	S1,1			;MUST BE 1 THRU SZ.PID
	CAXL	S1,SZ.PID		;INDEX IN RANGE?
	 $STOP	(PIR,PID Index out of range)
	MOVEM	S2,PIDTAB(S1)		;STORE MYPID IN INTERNAL TABLE
TOPS20 <
	MOVEM	S1,MTLBLK+1		;STORE THE TABLE OFFSET
	MOVEM	S2,MTLBLK+2		;STORE PID TOO
	SKIPN	S1,DEBUGW		;Debugging?
	JRST	SPID.1			;No, go to set pid in system table
	TXNN	S1,DB.IPC		;Debugging IPC?
	$RETT				;No, go no further
	SETZ	S2,			;Clear S2
	MOVE	S1,MTLBLK+1		;Get index back
	CAIN	S1,.SPQSR		;Is it QUASAR?
	MOVEI	S2,.SDQSR		;Yes, set debugging system PID
	CAIN	S1,.SPOPR		;Is it ORION?
	MOVEI	S2,.SDOPR		;Yes, set debugging system PID
	CAIN	S1,.SPNEB		;[107]Is it NEBULA?
	MOVEI	S2,.SDNEB		;[107]Yes, set debugging system PID
	SKIPN	S2			;Anything special set?
	$RET				;No, just return
	MOVEM	S2,MTLBLK+1		;Set for debugging system pid
SPID.1:	MOVX	S1,.MUSSP		;FUNCTION IS SET SYSTEM PID TABLE
	MOVEM	S1,MTLBLK+0		;STORE IT
	DMOVE	S1,[EXP 3,MTLBLK]	;3 WORD MUTIL BLOCK
	MUTIL				;ASK SYSTEM TO SET THE PID UP
	 $FATAL	<Can't write System PID table>
	$RETT				;AND RETURN
> ;END TOPS20 CONDITIONAL

TOPS10 <
	SKIPE	DEBUGW			;DEBUGGING?
	$RETT				;YES -- DON'T TELL THE MONITOR
					;NO -- SET PID IN SYSTEM TABLE
	MOVEM	S1,PACKET+.IPCS1	;STORE FIRST WORD , THE INDEX
	MOVEM	S2,PACKET+.IPCS2	;STORE PID TO SET
	MOVE	S1,[XWD SPID,.IPCWP]	;FUNCTION IS SET SYSTEM PID
	MOVX	S2,SP.IPC		;WANT TO SEND TO IPCC
	PUSHJ	P,SNDSYS		;SEND TO [SYSTEM]IPCC
	JUMPT	.POPJ			;RETURN ALL OK IF WE ARE IN GOOD SHAPE
	 $FATAL	<Can't write System PID table>
> ;END TOPS10 CONDITIONAL
SUBTTL	RSPIDS	Routine to read System Pid tables

;RSPIDS is called from initialization to set up our internal System
;pid table.  It requests all system pids from the monitor or from
;INFO if the pid has a name.  If a Pid exists, it's entry in PIDTAB
;will be non-zero.
;RSPIDS is usually called only during intialization.  It gets a PID for us,
;reads all the PIDS, then destroys the PID
;For hacking around, the ALTNAM table can be twiddled, and
;a debugger can do PUSHJ P,RSPIDS to set up some different PIDs

;CALL		No Arguments

;TRUE RETURN	PIDTAB Contains all valid system pids

RSPIDS:	$SAVE	<P1>			;PRESERVE P1
	MOVE	S1,[XWD PIDTAB,PIDTAB+1] ;Make BLT pointer
	SETZM	PIDTAB			;To clear all the PIDs
	BLT	S1,PIDTAB+MX.PID	;Clear it

TOPS20<	SETZ	S2,			;Indicate no name desired
	PUSHJ	P,SETNAM		;Set up our name
	SETZ	S1,			;Indicate No JWP desired
	PUSHJ	P,GETPID		;Get us a temporary PID
>;End TOPS20

TOPS10<	MOVX	S2,SP.INF		;GET SYSINF INDEX
	PUSHJ	P,RSPI.1		;Find and save that one
	PJOB	S1,			;-10, just use job # as PID
>;End TOPS10

	PUSH	P,MYPID			;Save whatever is there now
	MOVEM	S1,MYPID		;Save as ours, for now
	MOVSI	P1,-SZ.PID		;DO ALL ENTRIES

RSPD.1:	HRRZ	S1,P1			;LOAD THE INDEX
	PUSHJ	P,RSPID			;GET THE PID
	JUMPF	[CAIE S1,ERARG$		;INVALID INDEX?
		 TDZA S1,S1		;NO -- MUST BE NO SUCH PID
		 SETO S1,		;YES -- MARK INVALID ENTRY
		 JRST .+1]		;RETURN IN LINE
	MOVEM	S1,PIDTAB(P1)		;STORE THE ENTRY
RSPD.2:	AOBJN	P1,RSPD.1		;LOOP THRU ALL ENTRIES

TOPS20<	MOVE	S1,MYPID		;Get our temporary PID
	PUSHJ	P,KILPID		;Flush it out
>;End TOPS20

	POP	P,MYPID			;Put back the old one
	$RETT				;AND RETURN
	SUBTTL	RSPID Routine to return a system pid

;RSPID is called to return system PID when sending by special index.
;If the Pid is not found in our internal table, we request the Pid
;from the monitor (or from INFO if we are debugging and the System
;index has a name.)
;The PID is obtained from the system table unless
; 1) - the DEBUGW is set and DB.IPC is not
;   and ALTNAM(index) contains an address of a string
;or
; 2) - the DEBUGW is set and DB.IPC is not
;   and ALTNAM(index) = 0 (no fooling around), and SPDNAM has a SIXBIT
;		library convention debug name.
;Under normal debug, ALTNAM is 0.
;To fool around, put a -1 in an entry to talk to system component, or
;   put the address of a string which is the name of the PID you want to talk to.

;CALL IS:	S1/ Index into System PID table
;
;TRUE RETURN:	S1/ PID for that index

;FALSE RETURN:	ERARG$		Invalid index
;		ERNSP$		No Such Pid

RSPID:	CAIL	S1,0			;INDEX VALID?
	CAIL	S1,SZ.PID
	 $RETE(ARG)			;NO -- FAIL
	MOVE	S2,S1			;GET THE INDEX
	SKIPE	S1,PIDTAB(S2)		;IS ENTRY IN OUR INTERNAL TABLE?
	 $RETT				;YES -- RETURN

	$SAVE	<P1>			;Save an AC
	MOVE	P1,S2			;Keep the index around

	SKIPN	S1,DEBUGW		;Are we debugging?
	JRST	RSPI.1			;No, never use names
	TXNN	S1,DB.IPC		;Debugging IPCF?
	JRST	RSPI.0			;No, go to use names

	SETZ	S1,			;Clear S1
	CAIN	S2,.SPQSR		;Is it QUASAR?
	MOVEI	S1,.SDQSR		;Yes, set debugging system PID
	CAIN	S2,.SPOPR		;Is it ORION?
	MOVEI	S1,.SDOPR		;Yes, set debugging system PID
	CAIN	S2,.SPNEB		;[107]Is it NEBULA?
	MOVEI	S1,.SDNEB		;[107]Yes, set debugging system PID
	SKIPN	S1			;Anything special set?
	JRST	RSPI.0			;No, go use names

	MOVE	S2,S1			;Move the new index to the right place
	$CALL	RSYPD			;Go try to read the pid
	JUMPT	RSPI.4			;Win, go finish
	MOVE	S2,P1			;Lose, restore the original index

	;RSPIDS is continued on the next page
	;RSPIDS continued from previous page

RSPI.0:	SKIPGE	S1,ALTNAM(S2)		;Force use of system for component?
	JRST	RSPI.1			;Yes, go thru system table
	JUMPN	S1,RSPI.3		;If an addr was in there, use that name
	SKIPE	S1,SPDNAM(S2)		;0 in ALTNAM, is there a library entry?
	JRST	RSPI.3			;Yes, use library convention

	;Here to get PID from system table
RSPI.1:
TOPS10<	MOVEI	S1,.GTSID		;NO -- ASK THE MONITOR
	HRL	S1,S2			;LOAD THE INDEX
	GETTAB	S1,			;GET THE ENTRY
	 $RETE(ARG)			;INVALID INDEX
	SKIPN	S1			;ANY VALUE?
	 $RETE(NSP)			;NO -- RETURN NO SUCH PID
	JRST	RSPI.4			;STORE THE PID
> ;END TOPS10 CONDITIONAL

TOPS20<	$CALL	RSYPD			;Go try to read pid
	JUMPT	RSPI.4			;Win, go finish up
	CAXE S1,IPCF27			;NO SUCH PID?
	$RETE(ARG)			;NO -- ASSUME INVALID INDEX
	$RETE(NSP)			;YES -- RETURN THE ERROR
> ;END TOPS20 CONDITIONAL

	;Here to find a system component thru INFO
	;Enter with S1/addr of ASCIZ name (LH of S1 = 0)
	;	or S1/SIXBIT debug name (LH of S1 .NE. 0)
	;	S2/ special system index

RSPI.3:	MOVEI	S2,NAMTXT		;Assume library convention
	TLNN	S1,-1			;Is S1 SIXBIT?
	MOVEI	S2,[ITEXT (<^T/(S1)/>)]	;No, use different arg
	PUSHJ	P,FNDNAM		;ASK INFO FOR THE PID
	MOVE	S2,P1			;RESTORE THE INDEX
	JUMPF	.POPJ			;RETURN ERROR FROM FNDNAM
RSPI.4:	MOVEM	S1,PIDTAB(S2)		;STORE THE PID
	$RETT
	SUBTTL	RSYPD - Perform actual system pid read

;  Call is:	S2 / PID index

;  Returns:	True if found,	S1 / PID
;				S2 / Index
;		False if error, S1 / error code
;				S2 / Index

RSYPD:	MOVX	S1,.MURSP		;READ SYSTEM PID FUNCTION
	MOVEM	S1,MTLBLK+0		;SET FUNCTION
	MOVEM	S2,MTLBLK+1		;SET INDEX
	DMOVE	S1,[EXP 3,MTLBLK]	;POINT TO ARGUMENTS
	MUTIL				;AND ASK THE MONITOR
	JRST	[MOVE	S2,MTLBLK+1	;Not found, restore the index
		$RETF]			;Quit
	MOVE	S1,MTLBLK+2		;Get the pid
	MOVE	S2,MTLBLK+1		;Restore the index
	$RETT
	SUBTTL C%MAXP  - Read maximum short packet size

;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ Largest size of short IPCF message

TOPS10 <
C%MAXP:	MOVX	S1,%IPCML		;ASK MONITOR FOR IT
	GETTAB	S1,			;
	  MOVEI	S1,-1			;WILL TAKE "TOO LARGE" FAILURE
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL

TOPS20 <
C%MAXP:	MOVX	S1,.MUMPS		;ASK MONITOR FOR
	MOVEM	S1,MTLBLK		;LARGEST PACKET SIZE
	DMOVE	S1,[EXP 2,MTLBLK]	;ARG COUNT AND ADDRESS
	MUTIL				;
	  TROA	S1,-1			;LOAD LARGE NUMBER
	MOVE	S1,MTLBLK+1		;GET SIZE OF PACKET
	$RETT				;AND RETURN IT
> ;END TOPS20 CONDITIONAL
SUBTTL CPIDI  - Connect PID to specified interrupt channel

;This routine connects the PID acquired
;to the specified interrupt channel.

;CALL IS:	S1/ Channel to connect PID to
;		S2 / PID to connect
;		TOPS10, IIB is used to setup internal intrpt connection
;TRUE RETURN:	Always

CPIDI:
TOPS20 <
	MOVEM	S1,MTLBLK+2		;STORE CHANNEL
	MOVX	S1,.MUPIC		;FUNCTION IS CONNECT TO PSI
	MOVEM	S1,MTLBLK+0		;SO STORE FUNCTION
	MOVEM	S2,MTLBLK+1		;Save PID to connect
	DMOVE	S1,[EXP 3,MTLBLK]	;SIZE AND LOC OF MUTIL BLOCK
	MUTIL				;DO THE ACTUAL EXEC FUNCTION
	  $STOP(IIF,IPCF to interrupt system connect failed)
	MOVX	S2,1B0			;GET A BIT IN PLACE 0
	MOVN	S1,MTLBLK+2		;GET CHANNEL NUMBER BACK
	LSH	S2,0(S1)		;PUT INTO PROPER PLACE
	MOVX	S1,.FHSLF		;FOR MYSELF
	AIC				;ACTIVATE THE CHANNEL
	  ERJMP	[$STOP(AII,Cannot activate IPCF interrupts)]
	$RETT
> ;END TOPS20 CONDITIONAL

TOPS10 <
	HRLZM	S1,MTLBLK+1		;STORE OFFSET,,0
	PUSH	P,S1			;Save offset
	MOVX	S1,.PCIPC		;REASON IS IPCF RECEPTION
	MOVEM	S1,MTLBLK+0		;STORE IT
	SETZM	MTLBLK+2		;CLEAR PRIORITY LEVEL
	MOVE	S1,[PS.FAC+MTLBLK]	;ADD THE CONDITION
	PISYS.	S1,			;ADD IT
	  $STOP(IIF,IPCF to interrupt system connect failed)
	LOAD	S1,IIB+IB.INT		;ADDRESS OF INTERRUPT VECTOR
	POP	P,S2			;GET VECTOR OFFSET FOR IPCF
	ADDI	S1,.PSVIS(S2)		;GET ADDRESS OF ASSOCIATED VARIABLE
	MOVEM	S1,IPCINT		;SAVE ADDRESS FOR C%INTR
	$RETT				;RETURN
 > ;END TOPS10 CONDITIONAL
SUBTTL	IPRM Read/Write IPCF parameters



;CALL IS:	S1 / -1 TO WRITE,   0 TO READ PARAMETERS
;		S2 / PARAMETERS TO WRITE (IF S1=-1)
;
;TRUE RETURN:	S1 / <MAX PIDS>B17+<SND QUOTA>B26+<RCV QUOTA>B35 ;IF S1=0

IPRM:	PUSHJ	P,.SAVE1		;GET ONE AC
	MOVE	P1,S2			;REMEMBER 2ND ARG
	JUMPE	S1,IPRM.2		;IF READING, SKIP THIS
	HLRZ	S1,S2			;GET THE PID MAX WANTED
	JUMPE	S1,IPRM.1		;IF DEFAULTED, SKIP THIS
	PUSHJ	P,MNPRED		;GET THE CURRENT MAXIMUM
	HLRZ	S2,P1			;GET THE REQUESTED NUMBER
	ADD	S1,S2			;ADD TO CURRENT AMOUNT
	CAIL	S1,1000			;MAXIMUM IN RANGE
	MOVEI	S1,777			;NO..SET TO MAXIMUM
	PUSHJ	P,MNPWRT		;WRITE MAXIMUM NUMBER OF PIDS
	SKIPT				;OK?
	 $FATAL <IPCF privileges required to set maximum number of pids>

IPRM.1:	HRRZ	S1,P1			;GET THE QUOTAS
	JUMPE	S1,.RETT		;IF DEFAULTING, LEAVE IT ALONE

TOPS20<	PUSHJ	P,QTARED		;READ THE CURRENT SETTINGS
	LOAD	S2,S1,IP.SQT		;GET THE SEND QUOTAS
	LOAD	S1,P1,IP.SQT		;GET CURRENT SETTING REQUEST
	ADD	S1,S2			;GET NEW SEND QUOTAS
> ;END OF TOPS20 CONDITIONAL

TOPS10<	LOAD	S1,P1,IP.SQT >		;GET THE QUOTAS

	CAIL	S1,1000			;MAXIMUM IN RANGE
	MOVEI	S1,777			;NO..SET TO MAXIMUM
	STORE	S1,P1,IP.SQT		;SAVE THE VALUES
	HRRZ	S1,P1			;GET THE QUOTAS AGAIN
	PUSHJ	P,QTAWRT		;WRITE QUOTAS OUT
	JUMPT	.RETT			;IF ALL OK, RETURN NOW
	 $FATAL <IPCF privileges required to set IPCF quotas>

IPRM.2:	PUSHJ	P,MNPRED		;READ MAXIMUM NUMBER OF PIDS
	MOVE	P1,S1			;REMEMBER THE ANSWER
	PUSHJ	P,QTARED		;AND THE QUOTA'S
	SKIPT				;DID WE GET IT?
	$FATAL	<Can't read IPCF quotas>
	HRLM	P1,S1			;MAKE UP THE TWO HALVES
	$RETT				;AND RETURN
SUBTTL MNPRED/MNPWRT - Read/Write maximum number of PIDS

;THESE ROUTINES DO THE SYSTEM DEPENDENT WORK FOR SETTING THE MAXIMUM
;NUMBER OF PIDS FOR A JOB. 
;
; CALL IS:	READ/NO ARGUMENTS  WRITE/S1 MAXIMUM NUMBER OF PIDS
;TRUE RETURN:	READ/S1 MAX NR. OF PIDS	WRITE/NO RETURNED VALUE
;FALSE RETURN:	FAILURE OF SOME SORT

TOPS20 <
MNPWRT:	SKIPA	S2,[.MUSPQ]		;SET MAX. NUMBER OF PIDS
MNPRED:	MOVX	S2,.MUFPQ		;READ MAX. NUMBER OF PIDS
	MOVEM	S2,MTLBLK		;SET IT UP
	MOVEM	S1,MTLBLK+2		;STORE THE DESIRED NUMBER (FOR WRITE)
	MOVE	S1,MYPID		;GET OUR PID
	MOVEM	S1,MTLBLK+1		;SET IT UP
	DMOVE	S1,[EXP 3,MTLBLK]	;3 WORD BLOCK @ MTLBLK
	MUTIL				;ASK THE MONITOR
	  $RETF				;FAILURE
	MOVE	S1,MTLBLK+2		;PICK UP MAX NUMBER OF PIDS
	$RETT				;SUCCESS

> ;END TOPS20 CONDITIONAL

TOPS10 <
MNPRED:	MOVX	S1,777			;LARGE NUMBER OF PIDS AVAILABLE
MNPWRT:	$RETT				;RETURN WITH IT
> ;END TOPS10 CONDITIONAL
SUBTTL QTARED/QTAWRT - Read/Write the Send and Receive Quotas

;CALL IS:	S1/ 0,,<SND QUOTA>B26+<RCV QUOTA>B35 IF WRITING
;TRUE RETURN:	S1/ 0,,<SND QUOTA>B26+<RCV QUOTA>B35 IF READING
;FALSE RETURN:	ON ANY FAILURE OF TASK

TOPS20 <
QTARED:	SKIPA	S2,[EXP .MUFSQ]		;READ THE QUOTA FOR SEND/RECEIVE
QTAWRT:	MOVX	S2,.MUSSQ		;SET QUOTA
	MOVEM	S2,MTLBLK		;SET IT UP
	MOVEM	S1,MTLBLK+2		;STORE THE DESIRED QUOTA (FOR WRITE)
	MOVE	S1,MYPID		;GET OUR PID
	MOVEM	S1,MTLBLK+1		;SET IT UP
	DMOVE	S1,[EXP 3,MTLBLK]	;SET UP 3 WORD MUTIL BLOCK
	MUTIL				;ASK THE MONITOR
	  $RETF				;FAILURE
	MOVE	S1,MTLBLK+2		;PICK UP SEND/RECEIVE QUOTA
	$RETT				;SUCCESS
> ;END TOPS20 CONDITIONAL

TOPS10 <
QTARED:	SKIPA	S2,[EXP .IPCSR]		;READ QUOTAS
QTAWRT:	MOVX	S2,.IPCSQ		;WRITE QUOTAS
	HRLI	S2,QTAWRT		;A GOOD CODE TO USE
	MOVEM	S1,PACKET+.IPCS2	;STORE QUOTA FOR WRITE
	MOVE	S1,MYPID		;GET OUR PID
	MOVEM	S1,PACKET+.IPCS1	;STORE IT AWAY 
	MOVX	S1,SP.IPC		;SEND TO IPCC
	EXCH	S1,S2			;WHOOPS, BUILT IT BACKWARDS
	PUSHJ	P,SNDSYS		;SEND IT OFF
	MOVE	S1,PACKET+.IPCS2	;GET RESPONSE
	POPJ	P,			;PASS ON SNDSYS'S TF VALUE
> ;END TOPS10 CONDITIONAL
SUBTTL SETNAM - Routine to declare our name to INFO

;SETNAM is used to setup the name in the packet about to go to INFO or IPCC
;This allows programs to communicate
; by other means than the system PID table.  This is useful for debugging
; purposes when multiple components are going to be used.
;SETNAM should always be called just before calling GETPID

;CALL:		S2/ Addr of ITEXT of name to write
;		 or 0, to set up no name
;
;TRUE RETURN:	Always, name has been established
;		2 nd  word of PACKET has 0 or name,
;		  STACP has incremented pointer


SETNAM:	SETZM	PACKET+.IPCI2		;Clear name from message
	PUSH	P,[POINT 7,PACKET+.IPCI2] ;GET POINTER TO MESSAGE AREA
	POP	P,STACP			;STORE THAT POINTER
	JUMPE	S2,.RETT		;If no name desired, we're done
	$TEXT(STAC,<^I/(S2)/^0>)	;CREATE THE NAME
	$RETT				;RETURN SUCCESS


;FNDNAM is used to ask INFO for the pid of a specified name
;  It is called by GETPID to look for our name and by RSPIDX
;  to check for Private Quasar and Private Orion

;CALL:		S2/ addr of ITEXT to build name

;TRUE RETURN:	S1/ Pid of Specified Name

FNDNAM:	PUSHJ	P,SETNAM		;Set up name in message
	MOVE	S1,[XWD FNDNAM,.IPCIW]	;FUNCTION IS FIND PID FOR NAME
	MOVX	S2,SP.INF		;COMMUNICATE WITH [SYSTEM]INFO
	PUSHJ	P,SNDSYS		;SEND TO SYSTEM, WAIT FOR REPLY
	 JUMPF	[$RETE(NSP)]		;RETURN NO SUCH PID
	MOVE	S1,PACKET+.IPCI1	;GET THE PID
	SKIPE	DEBUGW			;DEBUGGING ?
	$WARN	<Alternate ^T20/PACKET+.IPCI2/ (PID = ^O/S1/)> ;SHOW THE NAME
	$RETT				;RETURN SUCCESS
SUBTTL SNDSYS - Routine to converse with [SYSTEM]INFO & IPCC


;SNDSYS is used to carry on a SEND-RECEIVE dialog with the system
; IPCF facilities

;CALL IS:	S1/ CODE WORD TO USE, I.E. ID,,FUNCTION CODE
;		S2/ CANONICAL SYSTEM INDEX TO SEND TO, EITHER SP.IPC OR SP.INF
;
;TRUE RETURN:	If acknowledgement comes back successfully
;
;FALSE RETURN:	If for any reason we cannot sent, or the
;		response contains an error.

SNDSYS:	$SAVE	<P1,P2,SNDFLG,RCVMDB+MDB.MS>	;PRESERVE WHAT WE TOUCH
	DMOVE	P1,S1			;SAVE INPUT ARGUMENTS
	SETOM	QUELOK			;LOCK THE INTERNAL IPCF QUEUE
	MOVEM	S1,PACKET+.IPCI0	;STORE THE CODE WORD AWAY
	CAXN	P2,SP.INF		;IF SENDING TO INFO,
	ZERO	PACKET+.IPCI1		;NO ONE IS TO BE COPIED
	MOVEI	S1,PACKET		;GET LOCATION OF PACKET
	MOVEM	S1,SNDSAB+SAB.MS	;STORE MESSAGE LOCATION

TOPS10<	CAXN	P2,SP.IPC		;SENDING TO IPCC?
	SKIPA	S1,[EXP PACKET+2]	;YES -- FORCE PACKET LENGTH TO 3
					;NO -- COMPUTE PACKET LENGTH
> ;END TOPS10 CONDITIONAL

TOPS20<	SKIPN	MYPID			;DO WE HAVE A PID?
	$STOP	(SWP,Called SNDSYS without a PID) ;Something has gone wrong
> ;END TOPS20 CONDITIONAL

SNDS.1:	HRRZ	S1,STACP		;HERE TO SEND TO INFO
	CAXN	P2,SP.INF		;SENDING TO SYSTEM INFO ???
	SKIPE	PIDTAB+SP.INF		;IS SYSTEM INFO RUNNING ???
	SKIPA				;SEND TO [IPCC] OR SYSINF RUNNING,,SKIP
	 $FATAL	(<No IPCF privs or SYSINF is not running>)
	SUBI	S1,PACKET-1		;COMPUTE SIZE
	MOVEM	S1,SNDSAB+SAB.LN	;STORE AS MESSAGE LENGTH
	SKIPN	S1,PIDTAB(P2)		;GET PROPER SYSTEM PID
	 $FATAL	<Attempt to send to non-existant system component>
	MOVEM	S1,SNDSAB+SAB.PD	;SEND IS BY PID
	ZERO	SNDSAB+SAB.SI		;NOT BY INDEX

	;SNDSYS CONTINUED ON NEXT PAGE
	;SNDSYS CONTINUED FROM PREVIOUS PAGE

	MOVEI	S1,SAB.SZ		;SIZE OF SAB
	MOVEI	S2,SNDSAB		;AND ITS LOCATION
	PUSHJ	P,C%SEND		;SEND IT OFF
	SKIPF				;SKIP IF FAILED !!!
SNDS.2:	PUSHJ	P,C%BRCV		;DO A WAITING RECEIVE NOW
	JUMPF	[SETZM QUELOK		;FAILED,,CLEAR IPCF QUEUE LOCK
		 $RETF ]		;AND RETURN
	MOVE	S1,RCVMDB+MDB.SI	;GET SPECIAL INDEX WORD
	TXNN	S1,SI.FLG		;FROM A 'SPECIAL' PID ???
	JRST	SNDS.3			;NO,,TRY ANOTHER MESSAGE
	LOAD	S1,S1,SI.IDX		;GET THE SPECIAL PID INDEX
	CAME	S1,P2			;REPLY FROM DESTINATION?
	JRST	SNDS.3			;NO, TRY AGAIN
	MOVE	S1,PACKET+.IPCI0	;GET CODE WORD
	CAME	S1,P1			;DOES IT MATCH WHAT WE SENT?
	JRST	SNDS.3			;NO
	SETZM	QUELOK			;CLEAR THE IPCF QUEUE LOCK
	LOAD	S1,RCVMDB+MDB.FG,IP.CFE	;DID WE GET ANY ERRORS?
	JUMPN	S1,.RETF		;IF WE DID, GIVE UP NOW
	$RETT				;OTHERWISE, RETURN A GOOD RETURN

SNDS.3:	SKIPN	S1,IPCQUE		;GET THE IPCF QUEUE ID
	PUSHJ	P,[PUSHJ P,L%CLST	;NONE,,CREATE A LIST FOR IT
		   MOVEM S1,IPCQUE	;SAVE THE ID
		   POPJ  P,  ]		;AND CONTINUE
	PUSHJ	P,L%LAST		;POSITION TO THE LAST ENTRY
	MOVE	S1,IPCQUE		;GET THE ID AGAIN,,LIST MAY BE NULL
	MOVX	S2,MDB.SZ		;GET THE MDB LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY AT THE END
	MOVE	S1,S2			;GET THE ENTRY ADDRESS
	HRLI	S1,RCVMDB		;GET THE SOURCE ADDRESS
	BLT	S1,MDB.SZ-1(S2)		;COPY THE MDB TO THE IPCF QUEUE
	LOAD	S1,RCVMDB+MDB.MS,MD.CNT	;GET THE MESSAGE LENGTH
	CAXN	S1,PAGSIZ		;IS IT A PAGE ???
	JRST	SNDS.2			;YES,,LETS TRY AGAIN (PAGE IS SAVED)
	PUSH	P,S2			;SAVE THE MDB ADDRESS
	PUSHJ	P,M%GMEM		;NO,,GET A CHUNK TO SAVE IT IN
	EXCH	S1,0(P)			;GET MDB ADDRESS,,SAVE PACKET LENGTH
	STORE	S2,MDB.MS(S1),MD.ADR	;SAVE THE NEW PACKET ADDRESS
	POP	P,S1			;RESTORE THE PACKET LENGTH
	ADD	S1,S2			;CALC CHUNK END ADDRESS
	HRLI	S2,PACKET		;GET THE PACKET ADDRESS
	BLT	S2,-1(S1)		;SAVE THE PACKET AS WELL
	SETOM	MSGFLG			;INDICATE ANOTHER MSG POSSIBLE !!
	JRST SNDS.2			;AND GET THE NEXT MESSAGE
	SUBTTL STAC   - Routine to build INFO messages

; STAC IS USED IN THE $TEXT INSTRUCTION TO DEPOSIT CHARACTERS INTO
; THE MESSAGE THAT IS SENT TO SYSTEM-INFO

STAC:	HRRZ	TF,STACP		;GET THE BYTE POINTER ADDRESS PART
	SUBI	TF,PACKET		;SUBTRACT OFF START OF PACKET
	CAIL	TF,SZ.PAK		;STILL INSIDE PACKET?
	$RETF				;NO, FORCE A STOP
	IDPB	S1,STACP		;STORE A BYTE
	$RETT				;OTHERWISE, RETURN GOODLY

SUBTTL	SIXASC	Store sixbit word in S2 as an asciz string

;Accepts	S1/ Pointer to destination
;		S2/ Sixbit value

SIXASC:	$SAVE	<P1,P2>
	TLC	S1,777777		;FIX DESTINATION POINTER
	TLCN	S1,777777
	 HRLI	S1,(POINT 7)
	MOVE	P1,[POINT 6,S2]		;GET POINTER TO THE WORD
	MOVEI	P2,6			;STORE SIX CHARACTERS
SIXAS1:	ILDB	TF,P1			;STORE THE TEXT
	ADDI	TF," "
	IDPB	TF,S1
	SOJG	P2,SIXAS1
	MOVE	TF,S1
	IDPB	P2,TF			;TERMINATE WITH A NULL
	$RETT
SUBTTL	C%PIDJ	Return PID owners job number


;CALL IS:	S1/ PID
;
;TRUE RETURN	S1/ Job number of PID's owner

TOPS20 <
C%PIDJ:	MOVEM	S1,MTLBLK+1		;USE MUTIL TO FIND JOB ASSOCIATED
	MOVX	S1,.MUFOJ		;WITH THIS PID
	MOVEM	S1,MTLBLK		;
	DMOVE	S1,[EXP 3,MTLBLK]	;ARG COUNT AND ADDRESS
	MUTIL
	 $RETF				;CAN'T GET JOB NUMBER OF PID
	MOVE	S1,MTLBLK+2		;GET THE JOB NUMBER
	$RETT				;AND RETURN
> ;END TOPS20 CONDITIONAL

TOPS10 <
C%PIDJ:	MOVX	S2,%IPCPM		;GET SYSTEM PID MASK
	GETTAB	S2,			;FROM MONITOR
	  $RETF				;CAN'T GET PID MASK
	AND	S1,S2			;AND TO GET PID TABLE OFFSET
	MOVSS	S1			;REVERSE TO GET GETTAB INDEX
	HRRI	S1,.GTPID		;AND NOW LOOK INTO PID TABLE
	GETTAB	S1,			;TO GET THE JOB NUMBER
	  $RETF				;CAN'T GET JOB NUMBER OF PID
	AND	S1,S2			;STRIP ALL BUT JOB NUMBER
	JUMPE	S1,.RETF		;NO OWNER
	$RETT				;RETURN THE JOB
> ;END TOPS10 CONDITIONAL
IPC%L:				;LABEL THE LITERAL POOL
	END