Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393M-SM - monitor-sources/ipcf.mac
There are 57 other files named ipcf.mac in the archive. Click here to see a list.
; *** Edit 7207 to IPCF.MAC by WAGNER on 9-Dec-85, for SPR #18886
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs. 
;Edit 6700 to IPCF.MAC by EVANS on Fri 22-Feb-85 - Remove Edit 3197.
;Edit 3206 to IPCF.MAC by GUNN on Mon 14-Jan-85
;		Fix typo in edit 3197. (Replace SAVPQ by SAVEPQ)
;Edit 3197 to IPCF.MAC by GUNN on Thu 10-Jan-85
;		Make ARCF% .ARRFR function DISMS and wait if IPCF to 
;;		QUASAR fails
;Edit 3191 to IPCF.MAC by GUNN on Fri 21-Dec-84 - Remove edit 3187
;Edit 3187 to IPCF.MAC by GUNN on Fri 7-Dec-84, for SPR #20473
;		Make ARCMSG DISMS and wait if free space unavailable
;**;[3187] Add 2 lines at ARCMS2+1L	DCG	6-Dec-84
;Edit 2949 by LOMARTIRE on Mon 25-Apr-83, for SPR #18937
;		Install version 5.1 edit 2870 into version 4.1; prevents ILMNRF
;Edit 2928 by MOSER on Wed 30-Mar-83, for SPR #16525 - FIK FLKTIM, FLKNS, GLFNF
;EDIT 2928 - FIX FLKTIM, FLKNS, GLFNF
; UPD ID= 124, FARK:<4-1-WORKING-SOURCES.MONITOR>IPCF.MAC.3,   5-Aug-82 14:54:09 by MOSER
;EDIT 2643 - MORE OF 2641. CHECK IP%CFP AND OTHER SPECIALS.
; UPD ID= 120, FARK:<4-1-WORKING-SOURCES.MONITOR>IPCF.MAC.2,   3-Aug-82 15:35:28 by MOSER
;EDIT 2641 - CORRECTLY CHECK ONLY IP%CFP IN VALARG.
;<4-1-FIELD-IMAGE.MONITOR>IPCF.MAC.2, 25-Feb-82 20:24:48, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 545, FARK:<4-WORKING-SOURCES.MONITOR>IPCF.MAC.4,  21-May-81 17:02:48 by SCHMITT
;Edit 1879 - Lock up the data base early in PIDJBI
; UPD ID= 479, FARK:<4-WORKING-SOURCES.MONITOR>IPCF.MAC.3,  23-Apr-81 16:07:49 by SCHMITT
;Edit 1854 - Fix argument checking for .MUFPQ of MUTIL JSYS
; UPD ID= 425, FARK:<4-WORKING-SOURCES.MONITOR>IPCF.MAC.2,   1-Apr-81 15:10:46 by ZIMA
;Edit 1839 - correct PID freelist initialization for MAXPID odd case.
;<4.MONITOR>IPCF.MAC.172,  3-Jan-80 08:09:00, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 30, SNARK:<4.MONITOR>IPCF.MAC.171,  28-Nov-79 09:44:58 by ENGEL
;AT MWAIT LOCK PIDLOK FIRST. IT STOPS FLKTIM BUGCHK'S
; UPD ID= 28, SNARK:<4.MONITOR>IPCF.MAC.170,  28-Nov-79 09:36:29 by ENGEL
;TCO # 4.2581 AT MRECV2 LOCK PIDLOK FIRST. IT STOPS FLKTIM BUGCHK'S
;<4.MONITOR>IPCF.MAC.169, 19-Oct-79 15:11:30, EDIT BY HALL
;VALARG - REMOVE CODE TO APPLY PCS TO PAGE NUMBERS BECAUSE FHKPTN
;NOW DOES IT
;<OSMAN.MON>IPCF.MAC.1, 10-Sep-79 15:35:24, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>IPCF.MAC.167, 21-Jul-79 17:22:41, EDIT BY R.ACE
;XCT 10 WON'T DO IT, BACK TO XCT 14 (XCTUU)
;ALSO CHANGE EXECUTED INSTRUCTION FROM XHLLI TO XMOVEI
;<4.MONITOR>IPCF.MAC.166, 21-Jul-79 14:48:09, EDIT BY HALL
;VALARG - GET USER'S SECTION WITH XCT 10 (MAYBE THIS ONE'S RIGHT)
;<4.MONITOR>IPCF.MAC.165, 13-Jul-79 11:33:41, EDIT BY HALL
;CHANGES FOR USER-MODE EXTENDED ADDRESSING:
; SNDPAG - CONVERT PAGE NUMBER TO PTN,,PN
; MSRECP - USE P5 FOR PAGE ID
; VALARG - CLEAR LH OF P4 FOR ADDRESS, ADD PCS TO PAGE NUMBER
;<4.MONITOR>IPCF.MAC.164,  7-Jun-79 09:28:25, Edit by KONEN
;GIVE REASON CODE FOR NOALCM BUGCHK
;<4.MONITOR>IPCF.MAC.163, 18-May-79 13:04:25, EDIT BY KIRSCHEN
;IF NO WAITING FORK DO NOT GIVE INTERRUPT IN CHKFKW
;<4.MONITOR>IPCF.MAC.162, 31-Mar-79 09:58:15, EDIT BY R.ACE
;FIX ARCMSG NOT QUOTE PERIODS IN DIRECTORY NAMES WITH ^V
;<4.MONITOR>IPCF.MAC.161, 12-Mar-79 10:31:32, Edit by KONEN
;MODIFY DISMES TO SEND ALL USAGE INFO TO DEVICE ALLOCATOR
;<4.MONITOR>IPCF.MAC.160,  4-Mar-79 17:30:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>IPCF.MAC.159,  2-Mar-79 14:51:37, EDIT BY R.ACE
;MOVE PIDRQ AND PIDRC TO WORD 2 TO LEAVE THE COUNT IN WORD 0
; FOR PID HEADERS
;<4.MONITOR>IPCF.MAC.158, 21-Feb-79 13:48:01, EDIT BY HURLEY.CALVIN
; Cause ARCMSG to wait only if over allocation, not if free space exhausted
;<4.MONITOR>IPCF.MAC.157, 13-Jan-79 13:49:43, EDIT BY OSMAN
;create MSHEAD for filling in message header
;<4.MONITOR>IPCF.MAC.156, 17-Dec-78 18:13:58, Edit by HEMPHILL
;TCO 4.2118 - FIX MESTOR RANGE CHECKING ON MESSAGE LENGTHS
;<4.MONITOR>IPCF.MAC.155, 16-Nov-78 14:11:46, Edit by KONEN
;ADD MOUNT/DISMOUNT CODE AS ARGUMENT TO DISMES
;<4.MONITOR>IPCF.MAC.154, 28-Oct-78 08:57:54, EDIT BY R.ACE
;TCO 4.2071 - MAKE MRECV WITH -1 IN .IPCFR FIELD OF PDB BYPASS JOB-WIDE
;PIDS WHEN LOOKING FOR A MESSAGE TO RECEIVE
;TCO 4.2072 - FIX BUG IN MSEND: IF IP%CPD AND IP%JWP ARE SET, THE
;CREATED PID IS DELETED WHEN THE FORK THAT CREATED IT IS KILLED
;<4.MONITOR>IPCF.MAC.152, 27-Oct-78 11:38:59, EDIT BY OSMAN
;TRY TO MAKE IT WORK...
;<4.MONITOR>IPCF.MAC.148, 24-Oct-78 14:13:03, EDIT BY OSMAN
;TCO 4.2060 - add .IPCLL goodies
;<KONEN>IPCF.NEW.4,  3-Aug-78 09:53:30, Edit by KONEN
;<ARC-DEC>IPCF.MAC.17, 11-Oct-78 09:04:26, EDIT BY CALVIN
; Convert to latest QUASAR expectations
;<ARC-DEC>IPCF.MAC.9,  3-Oct-78 14:25:16, EDIT BY CALVIN
; Re-write ARCMSG to not use a page mode message
;[BBN-TENEXD]<3A-EONEIL>IPCF.MAC.4, 30-Aug-78 14:47:29, Ed: CRDAVIS
; Changed ARCMSG to send to Quasar.
;SNARK:<4.MONITOR>IPCF.MAC.145, 17-Oct-78 14:25:39, Edit by MCLEAN
;FIX LOGIMS/LOGOMS TO TAKE A PID
;<4.MONITOR>IPCF.MAC.144,  3-Oct-78 12:54:10, EDIT BY MILLER
;<4.MONITOR>IPCF.MAC.143,  3-Oct-78 12:41:36, EDIT BY MILLER
;ADD IPCMTM FOR SENDING TAPE MESSAGES TO MDA
;<4.MONITOR>IPCF.MAC.142,  9-Aug-78 14:32:40, Edit by;FIX JRST IPCMSR IN DISMES
;<4.MONITOR>IPCF.MAC.141,  2-Aug-78 23:09:03, Edit by MCLEAN
;<4.MONITOR>IPCF.MAC.140,  2-Aug-78 23:04:54, Edit by MCLEAN
;<4.MONITOR>IPCF.MAC.139,  2-Aug-78 23:01:33, Edit by MCLEAN
;MESSAGES FOR DEVICE ALLOCATOR ADDED
;<4.MONITOR>IPCF.MAC.138,  2-Aug-78 22:49:57, Edit by MCLEAN
;<4.MONITOR>IPCF.MAC.137, 31-Jul-78 17:00:49, EDIT BY HURLEY
;FIX KILLED PID FEATURE TO SEND DELETED PID
;<4.MONITOR>IPCF.MAC.136, 19-Jul-78 00:04:04, Edit by MCLEAN
;MOVE ASGSWP/RELSWP/RELMES TO FREE WHERE IT BELONGS
;<4.MONITOR>IPCF.MAC.135, 16-Feb-78 17:42:13, EDIT BY HURLEY
;<4.MONITOR>IPCF.MAC.134, 14-Feb-78 15:37:17, EDIT BY HURLEY
;TCO 1884 - ADD SENDING OF MESSAGES ON DELETED PIDS


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE IPCF

;IPCF - INTERPROCESS COMMUNICATIONS FACILITY

REPEAT 0,<
;DATA STRUCTURES FOR IPCF

		!---------------------------------------------!
PIDLST:		!  INDEX OF FIRST FREE PID ON FREE LIST   (4) !
		!---------------------------------------------!



		!---------------------------------------------!
PIDTBL:		!  ADR OF PID HEADER 1 ! ADR OF PID HEADER 2  !
 		!----------------------!----------------------!
		!  ADR OF PID HEADER 3 ! NEXT FREE PID   (5)  !
		!----------------------!----------------------!
		!	    6          !          7	      !
		!----------------------!----------------------!
		!	   10          !          0	      !
		!----------------------!----------------------!

PIDTBS = SIZE OF PIBTBL
MAXPID = HIGHEST LEGAL HALF WORD INDEX INTO PIDTBL


;PID HEADER FORMAT

		!----------------------!----------------------!
		!PIDUN:                !		      !
		!        UNIQUE #      ! LENGTH OF THIS BLOCK !
		!      (LH OF PID)     !		      !
		!-------------!--------!----------!-----------!
		!PIDFLG:      !PIDCHN: !PIDFW:                !
		!     FLAGS   !   CHN  !     FORK NUMBER OF   !
		!             !    #   !      WAITING FORK    !
		!-------------!--------!----------------------!
		!   PIDRQ:  !   PIDRC: !PIDFO:                !
		!   RECEIVE !  RECEIVE !     FORK NUMBER      !
		!    QUOTA  !   COUNT  !       OF OWNER       !
		!-----------!----------!----------------------!
		! PIDKMP:				      !
		!	PID TO RECEIVE A MESSAGE IF	      !
		!	   THIS PID GETS DELETED	      !
		!----------------------!----------------------!
		!PIDNL:                !PIDOL:                !
		!        LINK TO       !       LINK TO        !
		!     NEWEST MESSAGE   !    OLDEST MESSAGE    !
		!----------------------!----------------------!
;MESSAGE FORMAT

		!----------------------!----------------------!
		!MESLNK:               !MESLEN:               !
		! LINK TO NEXT MESSAGE ! LENGTH OF THIS BLOCK !
		!----------------------!----------------------!
		!MESSJN:               !MESFLG:               !
		! SENDER'S JOB NUMBER  !         FLAGS        !
		!----------------------!----------------------!
		!MESSPD:                                      !
		!           SENDER'S       PID                !
		!---------------------------------------------!
		!MESLDN:		                      !
		!            LOGGED IN DIRECTORY              !
		!---------------------------------------------!
		!MESENB:                                      !
		!           ENABLED          CAPABILITIES     !
		!---------------------------------------------!
		!MESCDN:		                      !
		!            CONNECTED IN DIRECTORY           !
		!---------------------------------------------!
		!MESACT:	ACCOUNT STRING		      !
		!		BLOCK MESALN		      !
		!					      !
		!---------------------------------------------!
		!MESLLO:	LOGICAL LOCATION STRING	      !
		!		BLOCK MESLLN		      !
		!					      !
		!---------------------------------------------!
		!MESWD0: (MESPTN)                             !
		!                   MESSAGE                   !
		!	       (PTN.PN IN PAGE MODE)          !
		!---------------------------------------------!
		!MSFTM:                                      !
		!               FORK TABLE MASK               !
		!              (PAGE MODE ONLY)               !
		!----------------------!----------------------!
		!MESPAC:               !MSFTI:               !
		!     ACCESS BITS      !       INDEX INTO     !
		!       OF PAGE        !       FORK TABLE     !
		!----------------------!----------------------!

;MESSAGE SPACE POOL FORMAT  (DICTATED BY ASGFRE)

		!----------------------!----------------------!
SWPFRE:		! ADR OF 1ST FREE BLOCK!        UNUSED        !
		!----------------------!----------------------!
		!             LOCK ON FREE SPACE              !
		!---------------------------------------------!
		!               SPACE COUNTER                 !
		!---------------------------------------------!
		!           MOST COMMON BLOCK SIZE            !
		!----------------------!----------------------!
		! MAX TOP OF FREE AREA ! BOTTOM OF FREE AREA  !
		!----------------------!----------------------!
		!            TEMPORARY WORK SPACE             !
		!---------------------------------------------!
		!            TEMPORARY WORK SPACE             !
		!---------------------------------------------!
SWFREE:		!               FREE SPACE POOL               !
		!                                             !
		!          SPACE FOR THE ASSIGNMENT OF:       !
		!                 PID HEADERS                 !
		!                     AND                     !
		!                  MESSAGES                   !
		!---------------------------------------------!



;QUOTA TABLE  (INDEXED BY JOB NUMBER)

		!-----------!----------!----------!-----------!
PIDCNT:		!PIDSQ:     !PIDSC:    !PIDPQ:    !PIDPC:     !
		!    SEND   !   SEND   !    PID   !    PID    !
		!   QUOTA   !  COUNT   !   QUOTA  !   COUNT   !
		!-----------!----------!----------!-----------!
		!           !          !          !           !
		!    ETC.   !   ETC.   !    ETC.  !    ETC.   !
		!           !          !          !           !
		!-----------!----------!----------!-----------!
		!           !          !          !           !

>
;DATA STRUCTURE FOR IPCF PID HEADERS AND MESSAGES

;LOCAL STORAGE DECLARED IN STG.MAC

EXTN <HSHTBL,ENQBKS,HSHLEN,ENFREL,ENQLOK,ENFKTB>
EXTN <PIDHDS,MESHDS,PAGMSZ,MAXMSL,MAXSMS,MINPHL,SWOPTL,PIDSSQ>
EXTN <PIDSRQ,PIDSPQ,IPCCFL,PIDTBS,MAXPID,PDFREL>
EXTN <SWFREL,MAXPIT,PIDPBL,PIDFTL,PIDTBL,SPDTBL>
EXTN <PIDLOK,NXTPID,INFOPD,INFOPV,PIDLST,PIDMXP,PIDPBT>
EXTN <PIDFTB,SWPFRE,SWFREE,PIDCNT,PDFKTB,PDFKTL>

	SWAPCD

;PID HEADER

DEFSTR(PIDUN,0,17,18)		;UNIQUE NUMBER IN LH OF PID
DEFSTR(PIDFLG,1,11,12)		;PID FLAGS
	PD%NOA==1		;NO ACCESS BY OTHER FORKS
	PD%CHN==2		;A CHANNEL IS SET UP TO GET INTERRUPTS
	PD%DIS==4		;PID IS DISABLED
	PD%JWP==10		;PID IS A JOB WIDE PID
DEFSTR(PIDCHN,1,17,6)		;CHANNEL # TO INTERRUPT WAITING FORK ON
DEFSTR(PIDFW,1,35,18)		;FORK WAITING FOR MESSAGE TO THIS PID
DEFSTR(PIDRQ,2,8,9)		;RECEIVE QUOTA FOR THIS PID
DEFSTR(PIDRC,2,17,9)		;RECEIVE COUNT FOR THIS PID
DEFSTR(PIDFO,2,35,18)		;FORK # OF OWNER OF THIS PID
DEFSTR(PIDKMP,3,35,36)		;PID TO RECEIVE DELETED PID MESSAGE
DEFSTR(PIDNL,4,17,18)		;LINK TO NEWEST MESSAGE
DEFSTR(PIDOL,4,35,18)		;LINK TO OLDEST MESSAGE

;MESSAGE

DEFSTR(MESLNK,0,17,18)		;LINK TO NEXT MESSAGE - 0 IF LAST MESS
DEFSTR(MESLEN,0,35,18)		;LENGTH OF THIS MESSAGE BLOCK
DEFSTR(MESSJN,1,17,18)		;SENDER'S JOB NUMBER
DEFSTR(MESFLG,1,35,18)		;FLAGS FOR THIS MESSAGE
DEFSTR(MESSPD,2,35,36)		;SENDER'S PID
DEFSTR(MESLDN,3,35,36)		;LOGGED IN DIR # OF SENDER
DEFSTR(MESENB,4,35,36)		;ENABLED CAPABILITIES OF SENDER
DEFSTR(MESCDN,5,35,36)		;CONNECTED DIR # OF SENDER
	MESACT==6		;BEGINNING OF BLOCK WHICH HOLDS ACCOUNT STRING OF SENDER
	MESALN==MAXLW		;SIZE OF BLOCK FOR ACCOUNT STRING
	MESLLO==MESACT+MESALN	;BLOCK FOR LOGICAL LOCATION
	MESLLN==WPN		;SIZE OF BLOCK FOR LOGICAL LOCATION STRING
	MESWDI==MESLLO+MESLLN	;OFFSET OF FIRST DATA WORD IN MESSAGE

;HEY, Y'ALL... DUE TO SPLATTERED DATABASE DEFINITION, YOU MUST CHANGE
;DEFINITION OF MESHDS IN STG EVERY TIME YOU ADD TO THIS DATABASE!!

DEFSTR(MESWD0,MESWDI,35,36)	;FIRST WORD OF MESSAGE
DEFSTR(MESPTN,MESWDI,35,36)	;PTN.PN OF PAGE (PAGE MODE ONLY)
DEFSTR(MSFTM,MESWDI+1,35,36)	;MASK INTO FORK PAGE BIT TABLE
DEFSTR(MESPAC,MESWDI+2,17,18)	;ACCESS BITS FOR PAGE
DEFSTR(MSFTI,MESWDI+2,35,18)	;INDEX INTO FORK BIT TABLE

;PID QUOTA TABLE

DEFSTR(PIDSQ,PIDCNT,8,9)	;SEND QUOTA FOR JOB
DEFSTR(PIDSC,PIDCNT,17,9)	;SEND COUNT FOR JOB
DEFSTR(PIDPQ,PIDCNT,26,9)	;PID QUOTA FOR JOB
DEFSTR(PIDPC,PIDCNT,35,9)	;PID COUNT FOR JOB
	MAXQTA==777		;MAXIMUM PID QUOTA

	SPMHDS==5		;SPOOL MESSAGE HEADER SIZE
	LOGMSZ==3		;LOGOUT MESSAGE SIZE
	LGMHDS==2		;LOGOUT MESSAGE HEADER SIZE
	LG2MSZ==^D9		;LOGOUT MESSAGE TO CREATOR SIZE
	LG2MHS==^D8		;LOGOUT MESSAGE TO CREATOR HEADER SIZE
	DISMSZ==3		;MOUNT COUNT DECREMENT MESSAGE SIZE
	DSMHDS==2		;MOUNT COUNT DECREMENT HEADER SIZE
	PKMHDS==2		;LENGTH OF DELETED PID MESSAGE

	ARMSSZ==^D60		; Archive message size

; Various Quasar parameters for sending a CREATE message

	%%.QSR==33		; Quasar version
	.QOCRE==7		; CREATE message type
	EQHSIZ==^D18		; Size of CREATE header
	FPMSIZ==5		; Size of File Param area

; Table of SIXBIT queue names.  Indexed by ARCMSG function code.

ARDVTB:	SIXBIT/RET/		; Name of retrieval queue
	SIXBIT/NOT/		; Name of notification queue
;THE IPCF RECEIVE JSYS - USED TO RECEIVE MESSAGES FROM A PID

;CALL:
;	MOVEI 1,N		;NUMBER OF WORDS IN PACKET DESCRIPTOR
;	MOVEI 2,ADR		;ADDRESS OF PACKET DESCRIPTOR BLOCK
;	MRECV
;	  ERROR RETURN		;ERROR CODE IN AC1
;	SUCCESSFUL		;MESSAGE RETURNED AS DIRECTED


.MRECV::MCENT			;ENTER SLOW CODE
	CALL VALARG		;VALIDATE THE CALLER'S ARGUMENT LIST
	  RETERR		;SOMETHING WRONG, ERROR CODE IN T1
	TRNN P1,IP%CFV		;PAGE MODE?
	JRST MRECV2		;NO
	HRLI T1,.FHSLF		;YES, SEE IF PAGE EXISTS IN DEST PAGE
	HRR T1,P4		;GET AN IDENTIFIER FOR THE PAGE
	CALL FKHPTN		;...
	  RETERR		;SHOULD NEVER HAPPEN...
	MOVE P5,T1		;SAVE IDENTIFIER
	CALL MRPACS		;GET INFO ABOUT PAGE
	TXNN T1,PA%PEX		;PAGE EXIST?
	JRST MRECV2		;NO, THAT IS GOOD
	SETO T1,		;YES, GET RID OF IT
	HRLI T2,.FHSLF
	HRR T2,P4		;BUILD PMAP ARGS
	SETZ T3,
	PMAP			;GET RID OF THE PAGE
;**;[2928] REPLACE 3 LINES WITH 1 AT MRECV2:+0L	TAM	29-MAR-83
MRECV2:	CALL GTLCKS		;[2928]
MRECV0:	TRNN P1,IP%CFV		;PAGE MODE?
	JRST MRECV3		;NO
	MOVE T1,P5		;YES, CHECK IF STILL NO PAGE
	CALL MRPACS
	TXNE T1,PA%PEX		;PAGE EXIST?
	JRST [	MOVEI T1,IPCF34	;YES, PAGE MUST BE EMPTY TO RECIEVE
		JRST MULKER]	;GO GIVE ERROR RETURN
MRECV3:	MOVE T1,P3		;GET RECEIVERS PID
	CAMN T1,[-1]		;USER WANT ANY MESSAGE FOR THIS FORK?
	JRST [	CALL MRECFK	;YES, GO GET A PID FOR THIS FORK TO READ
		 JRST MULKER	;SOMETHING WENT WRONG, GO UNLOCK
		JRST MRECV1]	;GO READ IN THE MESSAGE
	CAMN T1,[-2]		;USER WANT ANY MESSAGE FOR THIS JOB?
	JRST [	CALL MRECJB	;YES, GO FIND A MESSAGE FOR THIS JOB
		 JRST MULKER	;ERROR OF SOME FLAVOR, GO UNLOCK
		JRST MRECV1]	;GO READ IN MESSAGE
	CALL VALPDJ		;NO, SEE IF PID IS VALID TO RECEIVE ON
	 JRST [	MOVEI T1,IPCFX4	;NO, GET ILLEGAL RECEIVER'S PID CODE
		JRST MULKER]	;GO UNLOCK AND GIVE ERROR RETURN
	CALL CHKNOA		;CHECK THE ACCESS BY THIS FORK
	 JRST MULKER		;NOT ACCESSABLE
MRECV1:	CALL MESREC		;GO COPY A MESSAGE TO USER SPACE
	 JRST MRECER		;NONE THERE, GO SEE IF WE NEED TO WAIT
	UNLOCK PIDLOK		;FREE THE LOCKS
	OKINT
	CALL FUNLK		;UNLOCK FORK LOCK
	UMOVEM T1,1		;RETURN INFO ABOUT NEXT MESSAGE
	SMRETN			;GIVE SUCCESSFUL RETURN
MRECER:	JUMPN T1,MULKER		;IF T1 IS NON-ZERO, THIS IS AN ERROR
	TLNE P1,(IP%CFB)	;NO MESSAGE, SEE IF WANT TO BLOCK
	JRST MNOMES		;NO, GIVE ERROR RETURN
	LOAD T4,PIDFO,(T2)	;GET FORK NUMBER OF OWNER
	CAMN T4,FORKX		;THIS US?
	JRST MRECE1		;YES, WE CAN WAIT
	CALL CHKNOA		;SEE IF NO ACCESS ON
	 RET			;YES, GIVE ERROR RETURN
	CALL CHKPDW		;SEE IF WAITING ALLOWED FOR THIS PID
	 JRST MULKER		;NO, GIVE ERROR RETURN
MRECE1:	MOVE T3,FORKX		;SET UP TO WAIT
	STOR T3,PIDFW,(T2)
	CALL MWAIT		;YES, GO WAIT FOR A MESSAGE
	JRST MRECV0		;TRY AGAIN

MNOMES:	MOVEI T1,IPCFX2		;NO MESSAGES READY
MULKER:	UNLOCK PIDLOK		;UNLOCK THE LOCKS
	OKINT
	CALL FUNLK		;UNLOCK FORK LOCK
	RETERR			;GIVE ERROR RETURN TO USER
;ROUTINE TO FIND A PID WITH A MESSAGE READY BELONGING TO THIS FORK

;	CALL MRECFK
;RETURNS +1:	UNSUCCESSFUL, ERROR CODE IN T1
;	 +2:	SUCCESSFUL - A MESSAGE WAS FOUND
;		T1/	PID
;		T2/	POINTER TO PID HEADER

MRECFK:	STKVAR <PDFKC,MRCFKE>
MRCFK0:	CALL FNDNMF		;FIND THE NEXT MESSAGE FOR THIS FORK
	 JRST [	JUMPG T1,MRCFK2	;IF ANY PIDS SEEN, GO WAIT MAYBE
		RETBAD (IPCF15)] ;NO PIDS SEEN, GIVE ERROR
	RETSKP			;FOUND A NON-EMPTY PID

MRCFK2:	TLNE P1,(IP%CFB)	;USER WANT TO BLOCK?
	RETBAD (IPCFX2)		;NO, RETURN TO HIM NOW
	SETZB T1,PDFKC		;INITIALIZE PID COUNTER
MRCFK1:	MOVE T2,FORKX		;GET OUR FORK #
	CALL GETNPF		;GET NEXT PID FOR THIS FORK
	 JRST MRCFKW		;NO MORE PIDS
	CALL CHKPDW		;SEE IF LEGAL TO WAIT ON THIS PID
	 JRST [	MOVEM T1,MRCFKE	;SAVE ERROR
		CALL ENDWAT	;STOP WAITING ON OTHER PIDS
		MOVE T1,MRCFKE	;GET BACK ERROR CODE
		RET]		;AND RETURN
	MOVE T3,FORKX		;GET OUR FORK NUMBER
	STOR T3,PIDFW,(T2)	;MARK THAT THIS FORK IS WAITING
	AOS PDFKC		;MARK THAT WE ARE WAITING ON A PID
	JRST MRCFK1		;LOOP BACK FOR ALL PIDS

MRCFKW:	SKIPG PDFKC		;ANY PIDS SEEN?
	RETBAD (IPCF15)		;NO, TELL USER
	CALL MWAIT		;GO WAIT
	JRST MRCFK0		;LOOP BACK TO SEE IF A MESSAGE IS THERE
;ROUTINE TO FIND A NON-EMPTY PID FOR THIS JOB

;	CALL MRECJB
;RETURNS +1:	ERROR - ERROR CODE IN T1
;	 +2:	T1/	PID
;		T2/	POINTER TO PID HEADER

MRECJB:	STKVAR <PDJBC,MRCJBT>
MRCJB0:	CALL FNDNMJ		;FIND A MESSAGE FOR THIS JOB
	 JRST [	JUMPG T1,MRCJB3	;NO MESSAGES, WERE ANY PIDS SEEN?
		RETBAD (IPCF14)] ;NO, GIVE ERROR RETURN
	RETSKP			;MESSAGE FOUND

MRCJB3:	TLNE P1,(IP%CFB)	;USER WANT TO BLOCK?
	RETBAD (IPCFX2)		;NO, TELL HIM NO MESSAGES READY
	SETZM PDJBC		;INITIALIZE COUNT OF PIDS FOR JOB
	SETZM MRCJBT		;START AT PID 0
MRCJB1:	MOVE T2,FORKX		;GET NUMBER OF OUR FORK
	HLRZ T2,FKJOB(T2)	;GET OUR JOB NUMBER
	MOVE T1,MRCJBT		;GET PID INDEX
	CALL GETNPJ		;GET NEXT PID FOR THIS JOB
	 JRST MRCJBW		;NO MORE PIDS
	MOVEM T1,MRCJBT		;SAVE NEW PID
	CALL CHKNOA		;SEE IF NO ACCESS BY OTHER FORKS
	 JRST MRCJB1		;YES, IGNORE IT
	CALL CHKPDW		;CHECK IF WE CAN WAIT ON THIS PID
	 JRST [	MOVEM T1,MRCJBT	;SAVE ERROR CODE
		CALL ENDWAT	;CLEAN UP WAITING PIDS
		MOVE T1,MRCJBT	;GET BACK ERROR CODE
		RET]		;AND GIVE ERROR RETURN
MRCJB2:	AOS PDJBC		;COUNT UP PIDS SEEN
	MOVE T3,FORKX		;GET OUR FORK NUMBER
	STOR T3,PIDFW,(T2)	;MARK THAT WE ARE WAITING FOR A MES
	JRST MRCJB1		;LOOP BACK FOR ALL PIDS

MRCJBW:	SKIPG PDJBC		;ANY PIDS SEEN?
	RETBAD (IPCF14)		;NO, TELL USER NONE AVAILABLE
	CALL MWAIT		;GO WAIT FOR A MESSAGE
	JRST MRCJB0		;GO TRY AGAIN
;ROUTINE TO FIND A MESSAGE FOR THIS FORK

;	CALL FNDNMF
;RETURNS +1:	NO MESSAGES, T1 CONTAINS # OF PIDS SEEN FOR THIS FORK
;	 +2:	MESSAGE FOUND
;		T1/	PID
;		T2/	PID HEADER ADDRESS

FNDNMF:	STKVAR <FNDMFC>
	SETZB T1,FNDMFC		;START AT FIRST PID
FNDMFL:	MOVE T2,FORKX		;GET CURRENT FORK INDEX
	CALL GETNPF		;GET THE NEXT PID BELONGING TO THIS FORK
	 JRST FNDMFD		;NO MORE PIDS FOR THIS FORK
	LOAD T4,PIDRC,(T2)	;DOES THIS PID HAVE ANY MESSAGES?
	JUMPG T4,[LOAD T4,PIDFLG,(T2) ;YES, GET PID FLAGS
		TRNE T4,PD%JWP	;IS THIS A JOB-WIDE PID?
		JRST FNDMFL	;YES, BYPASS IT
		RETSKP]		;ELIGIBLE PID WITH A MESSAGE WAS FOUND
	AOS FNDMFC		;REMEMBER THAT A PID WAS SEEN
	JRST FNDMFL		;LOOP BACK UNTIL ALL PIDS CHECKED

FNDMFD:	MOVE T1,FNDMFC		;GET COUNT OF PIDS SEEN
	RET			;AND GIVE ERROR RETURN

;ROUTINE TO FIND A MESSAGE FOR THE JOB

;	CALL FNDNMJ
;RETURNS +1:	NO MESSAGES, T1 CONTAINS # OF PIDS SEEN FOR JOB
;	 +2:	MESSAGE FOUND
;		T1/	PID
;		T2/	PID HEADER ADDRESS

FNDNMJ:	STKVAR <FNDMJC>
	SETZB T1,FNDMJC		;INITIALIZE PID INDEX
FNDMJL:	MOVE T2,FORKX		;GET OUR FORK NUMBER
	HLRZ T2,FKJOB(T2)	;GET JOB NUMBER OF FORK
	CALL GETNPJ		;GET THE NEXT PID FOR THIS JOB
	 JRST FNDMJD		;NO MORE PIDS
	CALL CHKNOA		;SEE IF ACCESSIBLE BY THIS FORK
	 JRST FNDMJL		;NO, LOOP BACK FOR ALL PIDS
	LOAD T4,PIDRC,(T2)	;GET COUNT OF MESSAGES FOR THIS PID
	JUMPG T4,RSKP		;IF ONE THERE, GO READ MESSAGE
	AOS FNDMJC		;REMEMBER THAT A PID WAS SEEN
	JRST FNDMJL		;LOOP BACK FOR ALL PIDS

FNDMJD:	MOVE T1,FNDMJC		;GET COUNT OF PIDS SEEN
	RET			;AND RETURN TO USER
;ROUTINE TO COPY A MESSAGE INTO USER SPACE

;ACCEPTS IN T1:	PID
;	    T2:	ADDRESS OF PID HEADER
;	    Q1:	COUNT OF ITEMS IN PACKET DESCRIPTOR BLOCK
;	    Q2:	ADDRESS OF PACKET DESCRIPTOR BLOCK IN USER SPACE
;	    Q3:	# OF WORDS TO RECEIVE
;	    P5: PAGE ID FOR PAGE TO RECEIVE MESSAGE (IF PAGE MODE)
;	CALL MESREC
;RETURNS IN +1:	T1=0 MEANS NO MESSAGES
;		T1 NOT 0 MEANS ERROR CODE
;	    +2:	MESSAGE COPIED SUCCESSFULLY
;		T1/	XWD LENGTH,FLAGS - FOR NEXT MESSAGE IN QUEUE

MESREC:	STKVAR <MESPID,MESRPH,MESADR>
	MOVEM T1,MESPID		;SAVE PID
	MOVEM T2,MESRPH		;SAVE PID HEADER ALSO
	LOAD T3,PIDRC,(T2)	;GET COUNT OF MESSAGES FOR PID
	JUMPE T3,[SETZ T1,	;IF NONE, RETURN
		RET]
	LOAD T3,PIDOL,(T2)	;GET POINTER TO MESSAGE
	MOVEM T3,MESADR		;SAVE ADDRESS OF START OF MESSAGE
	LOAD T1,MESFLG,(T3)	;GET FLAGS OF THAT MESSAGE
	XOR T1,P1		;SEE IF MODES MATCH
	TRNE T1,IP%CFV		;...
	RETBAD (IPCF16)		;NO, FLAG THIS AS AN ERROR
	LOAD T1,MESLEN,(T3)	;GET MESSAGE SIZE
	SUBI T1,MESHDS		;GET ACTUAL SIZE OF SENT MESSAGE
	TRNE P1,IP%CFV		;PAGED MODE?
	MOVEI T1,PGSIZ		;YES, USE LENGTH OF A PAGE
	LOAD T4,MESFLG,(T3)	;GET FLAGS OF MESSAGE TO RETURN TO USER
	SUBI T1,0(Q3)		;DID USER GIVE A BIG ENOUGH BUFFER
	SKIPG T1
	TLZA T4,(IP%TTL)	;YES, CLEAR TTL BIT
	TLOA T4,(IP%TTL)	;NO, SET TRUNCATED BIT
	JRST MESRC0		;MESSAGE SIZE ALRIGHT
	TLNN P1,(IP%TTL)	;DOES USER WANT TO TRUNCATE?
	RETBAD (IPCFX3)		;NO, GIVE ERROR RETURN
MESRC0:	TRNN P1,IP%CFP		;CALLER WANT PRIV'D MESSAGE?
	TRZ T4,IP%CFP		;NO, HE DOESNT CARE IF MESSAGE WAS PRIV'D
	UMOVEM T4,.IPCFL(Q2)	;STORE FINAL FLAGS
	CALL GETMES		;GET THE OLDEST MESSAGE FROM LIST IN T3
	 JRST [	BUG(IPCMCN)
		SETZ T1,	;PRETEND NO MESSAGES IF CONTINUED
		RET]		;AND RETURN
	MOVE T1,MESPID		;GET BACK PID
	CALL CPYMHD		;COPY MESSAGE HEADER TO USER SPACE
	;..			;MESSAGE SIZE IS RETURNED IN T1
	;..
	MOVE T3,MESADR		;GET BACK POINTER TO MESSAGE
	TRNE P1,IP%CFV		;PAGE MODE RECEIVE?
	JRST MSRECP		;YES, GO TRANSFER THE PAGE
	JUMPE Q3,MSRECD		;USER DOES NOT WANT MESSAGE IF 0
	CAML Q3,T1		;GET SMALLER OF TWO LENGTHS
	MOVE Q3,T1		;SENDER'S MESSAGE IS SMALLER
	XCTU [HRLM Q3,.IPCFP(Q2)] ;STORE LENGTH OF MESSAGE SENT
	MOVNS Q3		;SET UP AN AOBJN POINTER
	HRLZS Q3
	HRR Q3,P4		;GET POINTER INTO USER SPACE FOR MESS
MSRECL:	LOAD T1,MESWD0,(T3)	;GET NEXT WORD IN MESSAGE
	UMOVEM T1,0(Q3)		;STORE IN USER SPACE
	AOS T3			;ADVANCE POINTER TO MESSAGE
	AOBJN Q3,MSRECL		;LOOP BACK FOR ALL WORDS IN MESSAGE
MSRECD:	MOVE T1,MESADR		;GET POINTER TO START OF MESSAGE
	CALL RELMES		;GO RELEASE THE MESSAGE SPACE TO POOL
	MOVE T2,MESRPH		;GET POINTER TO PID HEADER
	LOAD T2,PIDOL,(T2)	;GET POINTER TO OLDEST MESSAGE
	JUMPE T2,[SETZ T1,	;IF NO MESSAGE, RETURN 0
		RETSKP]
	LOAD T1,MESLEN,(T2)	;GET LENGTH OF MESSAGE BLOCK
	HRLI T1,-MESHDS(T1)	;GET LENGTH OF MESSAGE IN LH OF T1
	LOAD T3,MESFLG,(T2)	;GET FLAGS OF NEXT MESSAGE IN QUEUE
	TRNE T3,IP%CFV		;PAGE MODE MESSAGE?
	MOVSI T1,PGSIZ		;YES, SET LENGTH TO BE ONE PAGE
	HRR T1,T3		;SET UP LENGTH,,FLAGS
	RETSKP			;EXIT SUCCESSFULLY

MSRECP:	LOAD T1,MSFTI,(T3)	;GET INDEX INTO FORK BIT TABLE
	LOAD T2,MSFTM,(T3)	;GET MASK FOR THIS PAGE
	IORM T2,PIDPBT(T1)	;MAKE THIS PAGE AVAILABLE TO BE USED
	LOAD T1,MESPTN,(T3)	;GET PTN.PN OF PAGE
	MOVE T2,P5		;GET ID FOR PAGE TO RECEIVE INTO
	LOAD T3,MESPAC,(T3)	;GET ACCESS BITS FOR PAGE
	HRLZS T3
	JUMPE Q3,[SETZB T2,T3	;USER WANT THIS PAGE?
		EXCH T2,T1	;NO, THEN THROW IT AWAY
		JRST .+1]
	CALL SETPT		;GO MAP IT INTO USER'S FORK
	JRST MSRECD		;GO FINISH UP AND RETURN
;ROUTINE TO COPY A MESSAGE HEADER TO USER SPACE

;ACCEPTS IN T1/	PID
;	    T2/	PID HEADER ADDRESS
;	    T3/	MESSAGE HEADER ADDRESS
;	    Q1/	LENGTH OF HEADER IN USER SPACE
;	    Q2/	ADDRESS OF HEADER SPACE IN USER'S AREA
;	CALL CPYMHD
;RETURNS +1:	ALWAYS - T1/	LENGTH OF MESSAGE DATA AREA

CPYMHD:	TRVAR <MHA>
	MOVEM T3,MHA		;REMEMBER MESSAGE HEADER ADDRESS
	UMOVEM T1,.IPCFR(Q2)	;STORE RECEIVER'S PID
	LOAD T1,MESSPD,(T3)	;GET SENDER'S PID
	UMOVEM T1,.IPCFS(Q2)	;STORE SENDER'S PID IN USER SPACE
	LOAD T4,MESLDN,(T3)	;GET LOGGED IN DIR NUMBER
	CAILE Q1,.IPCFD		;USER WANT LOGGED IN DIR?
	UMOVEM T4,.IPCFD(Q2)	;YES, GIVE IT TO USER
	LOAD T1,MESENB,(T3)	;GET SENDER'S ENABLED CAPABILITIES
	CAILE Q1,.IPCFC		;USER WANT THEM?
	UMOVEM T1,.IPCFC(Q2)	;YES, GIVE HIM CAPABILITIES OF SENDER
	LOAD T1,MESCDN,(T3)	;GET CONNECTED DIR NUMBER
	CAILE Q1,.IPCSD		;USER WANT SENDER'S CONNECTED DIR?
	UMOVEM T1,.IPCSD(Q2)	;YES
	CAILE Q1,.IPCAS		;USER WANT ACCOUNT STRING?
	CALL CPYACT		;YES, GIVE IT TO HIM
	CAILE Q1,.IPCLL		;USER WANT LOGICAL LOCATION?
	CALL CPYLLO		;YES, GIVE IT TO HER
	MOVE T3,MHA		;ASSUME ROUTINES CLOBBERED T3
	LOAD T1,MESLEN,(T3)	;GET LENGTH OF MESSAGE BLOCK
	SUBI T1,MESHDS		;GET LENGTH OF MESSAGE DATA AREA
	RET			;RETURN TO CALLER

;ROUTINE TO COPY SENDER'S JOB ACCOUNT STRING TO CALLER'S ADDRESS SPACE,
;USING BYTE POINTER SUPPLIED BY RECEIVER IN WORD .IPCAS OF HEADER BLOCK

CPYACT:	UMOVE A,.IPCAS(Q2)	;GET USER'S BYTE POINTER
	MOVEI B,MESACT-1(T3)	;GET ADDRESS OF ACCOUNT STRING(MINUS 1!)
	MOVEI C,.IPCAS(Q2)	;USER ADDRESS INTO WHICH TO RETURN UPDATED BYTE POINTER
	CALLRET CPYTU1		;COPY THE STRING AND RETURN

;SIMILAR ROUTINE TO ABOVE, WHICH COPIES CALLER'S LOGICAL LOCATION

CPYLLO:	UMOVE A,.IPCLL(Q2)	;GET POINTER TO WHERE CALLER WANTS STRING PUT
	MOVE C,MHA		;CPYACT CLOBBERED IT
	MOVEI B,MESLLO-1(C)	;GET ADDRESS OF STRING IN MONITOR SPACE (MINUS 1!)
	MOVEI C,.IPCLL(Q2)	;USER ADDRESS FOR UPDATED BYTE POINTER
	CALLRET CPYTU1		;DO IT AND EXIT
;THE MESSAGE SEND JSYS - MSEND

;THIS JSYS ALLOWS ONE PROCESS SEND MESSAGES TO ANY PROCESS IN THE SYSTEM
;ACCEPTS IN 1:	COUNT OF ITEMS IN THE HEADER
;	    2:	LOCATION OF MESSAGE HEADER
;	MSEND
;RETURNS +1:	ERROR - CODE IN 1
;	 +2:	SUCCESSFUL - PID OF SENDER IN USER'S DESCRIPTOR BLOCK

.MSEND::MCENT			;ENTER SLOW CODE
	CALL VALARG		;READ IN ARGUMENTS AND CHECK VALIDITY
	 RETERR			;SOMETHING NOT RIGHT - ERROR CODE IN T1
;**;[2928] MAKE CHANGES AT .MSEND:+3L	TAM	29-MAR-83
	CALL GTLCKS		;[2928] GET LOCKS
	CALL MESSND		;SEND THE MESSAGE
	 JRST MULKER		;[2928] ERROR
	UNLOCK PIDLOK		;OK, UNLOCK EVERYTHING
	OKINT
	CALL FUNLK		;[2928]
	CALL STOSPD		;STORE SENDER'S PID IN DESCRIPTOR BLOCK
	SMRETN
;ROUTINE TO DO THE SENDING

;ACCEPTS IN ACS:	ACS SET UP FROM VALARG
;	CALL MESSND
;RETURNS +1:	ERROR CODE IN T1
;	 +2:	SUCCESSFUL

MESSND:	HRRZ T4,FORKX		;GET JOB # OF FORK DOING JSYS
	HLRZ T1,FKJOB(T4)
	LOAD T3,PIDSQ,(T1)	;GET CURRENT SEND QUOTA FOR THIS JOB
	LOAD T4,PIDSC,(T1)	;GET SEND COUNT
	TLNE P1,(IP%CFO)	;ALLOW ONE MORE MESSAGE BIT ON?
	ADDI T3,1		;YES, MAKE QUOTA ONE BIGGER
	CAMG T3,T4		;ROOM FOR ANOTHER MESSAGE?
	RETBAD (IPCFX6)		;NO, GIVE ERROR RETURN
	CAME P3,INFOPV		;IS THIS THE PUBLIC VALUE OF INFO?
	JRST MSEND0		;NO, DONT GET INFO'S PID
	SETZ T1,		;YES, SET UP INDEX TO POINT TO OUR JSB
	CALL GTINFO		;GET PID OF INFO FOR THIS JOB
	 RET			;THERE ISNT AN INFO
	MOVE P3,T2		;STORE PID OF INFO AS RECEVIER'S PID
MSEND0:	TLNE P1,(IP%CPD)	;USER WANT A PID CREATED ON CALL?
	JRST MSEND2		;YES, GO CREATE ONE
	JUMPE P2,MSEND1		;0 PID FOR SENDER MEANS NO PID
	TRNE P1,IP%CFP		;PRIVELEGED CALL?
	CALL CHKPRV		;YES, CHECK CALLERS PRIV'S
	SKIPA T1,P2		;NO PRIVELEGES, CHECK SENDER'S PID
	JRST MSEND1		;PRIVELEGED, DONT CHECK PID OF SENDER
	CALL VALPDJ		;CHECK IF PID OF THIS JOB
	 RETBAD (IPCFX9)	;NOT LEGAL FOR THIS JOB
MSEND1:	MOVE T1,P3		;GET PID OF RECEIVER
	MOVEI T2,0		;GET A BLOCK FOR THIS MESSAGE
	CALL MESTOR		;GO ADD THIS MESSAGE TO THE PID
	 RET			;SOMETHING WAS NOT LEGAL, GIVE ERROR RET
	STOR P2,MESSPD,(T1)	;STORE SENDER'S PID IN MESSAGE
	SKIPG Q3		;ZERO LENGTH MESSAGE?
	TXO P1,IP%CFZ		;YES, SET ZERO FLAG
	MOVE T2,P1		;FLAGS FOR MESSAGE HEADER
	MOVE T3,JOBNO		;GET JOB NUMBER OF SENDER
	LOAD T4,PIDSC,(T3)	;GET SENDER'S SEND COUNT
	ADDI T4,1		;INCREMENT IT
	STOR T4,PIDSC,(T3)	;STORE UPDATED COUNT
	CALL MSHEAD		;FILL IN MESSAGE HEADER
	TRNE P1,IP%CFV		;IS THIS A PAGE SEND?
	JRST MSEND3		;PAGE HAS ALREADY BEEN TRANSFERED
	JUMPE Q3,MSEND3		;MESSAGE SIZE = 0?
	MOVN T3,Q3		;NO, SET UP AOBJN WORD
	HRLZS T3
	HRR T3,T1		;GET POINTER TO MESSAGE BLOCK
MSENDL:	UMOVE T4,0(P4)		;GET WORD FROM USER MESSAGE
	STOR T4,MESWD0,(T3)	;STORE IN MESSAGE BLOCK
	AOS P4			;STEP POINTER TO USER MESSAGE
	AOBJN T3,MSENDL		;LOOP BACK FOR REST OF MESSAGE
MSEND3:	RETSKP			;RETURN SUCCESSFULLY

MSEND2:	HRRZ T1,FORKX		;GET THIS FORK #
	SETZ T2,		;SET UP FLAGS FOR NEW PID
	TLNE P1,(IP%JWP)	;JOB WIDE PID?
	JRST [	TRO T2,PD%JWP	;YES, MARK IT AS JOB WIDE
		MOVE T1,JOBNO	;GET USER'S JOB#
		HRRZ T1,JOBPT(T1) ;JWP'S BELONG TO TOP FORK OF JOB
		JRST .+1]
	TLNE P1,(IP%NOA)	;NO ACCESS BY OTHER FORKS?
	TRO T2,PD%NOA		;YES, MARK THAT ALSO
	CALL CREPID		;CREATE THE PID
	 RET			;ERROR OF SOME KIND
	MOVEM T1,P2		;REMEMBER NEW PID VALUE
	CALL STOSPD		;STORE SENDER'S PID IN DESCRIPTOR BLOCK
	JRST MSEND1		;GO BACK TO MAIN FLOW

;ROUTINE TO FILL IN MESSAGE HEADER
;ACCEPTS:	T1/	HEADER ADDRESS
;		T2/	FLAGS
;		T3/	VALUE FOR JOB-#-OF-SENDER FIELD
;RETURNS:	+1

MSHEAD:	STOR T2,MESFLG,(T1)	;STORE FLAGS
	STOR T3,MESSJN,(T1)	;STORE JOB # OF SENDER
	MOVE T3,JOBNO		;GET REAL JOB NUMBER
	HRRZ T3,JOBDIR(T3)	;GET LOGGED IN DIR
	HRLI T3,USRLH		;BUILD THE USER NUMBER
	STOR T3,MESLDN,(T1)	;STORE LOGGED IN DIR
	LOAD T2,JSUC		;BUILD THE CONNECTED DIR #
	LOAD T3,JSDIR		;GET DIR NUMBER
	HRL T3,T2		;GET STR NUMBER,, DIR #
	STOR T3,MESCDN,(T1)	;STORE IT TOO
	MOVE T3,CAPENB		;GET JOB CAPABILITIES
	STOR T3,MESENB,(T1)	;STORE THEM IN MESSAGE HEADER
	HRLI T3,ACCTSR		;GET POINTER TO SENDER'S ACCOUNT STRING
	HRRI T3,MESACT(T1)	;POINTER TO BLOCK INTO WHICH TO COPY IT
	BLT T3,MESACT+MESALN-1(T1)	;COPY IT IN CASE RECEIVER WANTS IT
	HRLI T3,LLSR		;POINTER TO SENDER'S LOGICAL LOCATION
	HRRI T3,MESLLO(T1)	;POINT TO MESSAGE BLOCK
	BLT T3,MESLLO+MESLLN-1(T1)	;COPY LOGICAL LOCATION IN CASE CALLER WANTS IT
	RET

;ROUTINE TO STORE THE SENDER'S PID IN THE DESCRIPTOR BLOCK

STOSPD:	MOVEI T2,.IPCFS(Q2)	;GET ADR OF WHERE TO STORE THE PID
	TLNE P1,(IP%CFS)	;INDIRECT POINTER?
	UMOVE T2,0(T2)		;YES, GET ACTUAL ADDRESS
	UMOVEM P2,0(T2)		;STORE THE PID
	RET			;DONE
;ROUITNE TO PUT A MESSAGE ONTO A PID'S LIST

;ACCEPTS IN T1/	PID
;	    T2/	POINTER TO MESSAGE, 0 TO GET A BLOCK FOR THE MESSAGE
;	    Q3/	LENGTH OF MESSAGE DATA AREA IF T2 IS 0
;	    P1/	FLAGS FOR SEND FUNCTION (IE. PAGE MODE)
;	CALL MESTOR
;RETURNS +1:	ERROR - ERROR CODE IN T1
;	 +2:	SUCCESSFUL - POINTER TO MESSAGE BLOCK IN T1

MESTOR:	STKVAR <MESHED,MESPHD,MESERC>
	MOVEM T2,MESHED		;SAVE POINTER TO MESSAGE BLOCK
	CALL VALPID		;SEE IF DESTINATION IS LEGAL
	 RETBAD (IPCFX4)	;NOT A KNOWN PID
	MOVEM T2,MESPHD		;SAVE POINTER TO PID HEADER
	LOAD T3,PIDFLG,(T2)	;GET FLAGS OF THAT PID
	TRNE T3,PD%DIS		;PID DISABLED?
	RETBAD (IPCFX5)		;YES, THEN PID CANT BE SENT TO
	LOAD T3,PIDRC,(T2)	;GET COUNT OF MESSAGES FOR THIS PID
	LOAD T4,PIDRQ,(T2)	;GET QUOTA OF MESSAGES
	CAML T3,T4		;ROOM FOR ONE MORE?
	RETBAD (IPCFX7)		;NO, DONT SEND TO IT
	SKIPE T1,MESHED		;IS THERE ALREADY A MESSAGE BLOCK?
	JRST MESTO1		;YES, DONT GET ANOTHER
	MOVEI T1,MESHDS(Q3)	;GET LENGTH OF MESSAGE BLOCK NEEDED
	CAIGE T1,MESHDS		;WAS USER ARGUMENT NEGATIVE?
	RETBAD (IPCF24)		;YES
	TRNE P1,IP%CFV		;PAGE MODE TRANSFER?
	MOVEI T1,PAGMSZ		;YES, GET SIZE OF PAGE MODE MESSAGE
	CAILE T1,MAXMSL+MESHDS	;MESSAGE LENGTH OK?
	JRST [	TXNE P1,IP%INT		; Internal call?
		CAILE T1,MAXSMS+MESHDS ; Ok for system?
		RETBAD (IPCF24)	;NO, MESSAGE TOO LARGE
		JRST .+1]
	CALL ASGSWP		;GET SPACE FOR MESSSAGE
	 RET			;NOT ENOUGH ROOM
	MOVEM T1,MESHED		;SAVE POINTER TO MESSAGE BLOCK
	TRNN P1,IP%CFV		;PAGE MODE TRANSFER?
	JRST MESTO1		;NO
	CALL SNDPAG		;YES, GO STORE PAGE IN FORK OF JOB 0
	 JRST [	MOVEM T1,MESERC	;SAVE ERROR CODE
		MOVE T1,MESHED	;GET ADDRESS OF MESSAGE BLOCK
		CALL RELMES	;RELEASE THE SPACE
		MOVE T1,MESERC	;GET BACK ERROR CODE
		RET]		;AND GIVE NON-SKIP RETURN
	;..
	;..
MESTO1:	MOVE T1,MESHED		;GET ADDRESS OF MESSAGE
	SETZRO MESLNK,(T1)	;CLEAR OUT GARBAGE IN MESLNK
	MOVE T2,MESPHD		;GET POINTER TO PID HEADER AGAIN
	LOAD T3,PIDNL,(T2)	;GET POINTER TO END OF MESS LIST
	SKIPE T3		;ANY MESSAGES?
	STOR T1,MESLNK,(T3)	;YES, ADD THIS MESSAGE TO END OF LIST
	SKIPN T3		;WAS THIS THE FIRST MESSAGE FOR THE PID?
	STOR T1,PIDOL,(T2)	;YES, INITIALIZE OLDEST MESSAGE POINTER
	STOR T1,PIDNL,(T2)	;UPDATE POINTER TO NEWEST MESSAGE
	LOAD T3,PIDRC,(T2)	;GET RECEIVE COUNT
	ADDI T3,1		;INCREMENT IT
	STOR T3,PIDRC,(T2)	;STORE IT IN HEADER
	CAIN T3,1		;DID COUNT JUST GO NON-ZERO?
	CALL CHKFKW		;SEE IF A FORK IS WAITING AND WAKE IT
	MOVE T1,MESHED		;GET BACK POINTER TO MESSAGE BLOCK
	RETSKP			;GIVE OK RETURN
;ROUTINE TO PUT A PAGE INTO A FORK OF JOB 0 AWAITING RECEIVING

;ACCEPTS:
;	T1/ ADDRESS OF MESSAGE BLOCK
;	P4/ PAGE NUMBER TO SEND FROM
;	CALL SNDPAG
;RETURNS +1:	ERROR, ERROR CODE IN T1
;	 +2:	SUCCESSFUL, MESSAGE BLOCK PROPERLY UPDATED

SNDPAG:	STKVAR <SNDPGM,SNDPGP>
	MOVEM T1,SNDPGM		;REMEMBER THE MESSAGE ADDRESS
	HRLI T1,.FHSLF		;T1/ (THIS FORK,,PAGE NUMBER)
	HRR T1,P4		;PAGE NUMBER TO SEND FROM
	CALL FKHPTN		;GET PAGE ID
	 RETBAD ()
	MOVEM T1,SNDPGP		;SAVE PTN.PN
	CALL MRPACS		;GET ACCESSIBILITY OF PAGE
	TLNN T1,(1B10)		;IS THIS A PRIVATE PAGE?
	RETBAD (IPCF32)		;NO, GIVE ERROR RETURN
	CALL PIDFFP		;GET A FREE FORK PAGE TO USE
	 RET			;NONE LEFT
	ANDCAM T3,PIDPBT(T4)	;MARK THAT THIS PAGE IS IN USE
	HLL T2,PIDFTB(T1)	;GET PTN.PN IN T2
	MOVE T1,SNDPGM		;GET BACK MESSAGE ADDRESS
	STOR T2,MESPTN,(T1)	;SAVE PTN.PT FOR RECEIVER
	STOR T3,MSFTM,(T1)	;SAVE MASK
	STOR T4,MSFTI,(T1)	;AND INDEX FOR RELEASING PAGE SLOT
	MOVEI T3,(PM%MVP!PM%RD!PM%WT!PM%EX)
	STOR T3,MESPAC,(T1)	;SAVE ACCESS OF PAGE
	HRLZS T3		;GET BITS INTO LEFT HALF WORD
	MOVE T1,SNDPGP		;GET PTN.PN OF PAGE TO BE SENT
	CALL SETPT		;TRANSFER THE PAGE
	RETSKP			;GIVE OK RETURN
;ROUTINE TO FIND A FREE FORK PAGE TO HOLD A PAGE IN TRANSIT

;	CALL PIDFFP
;RETURNS +1:	NO MORE PAGES LEFT - ERROR CODE IN T1
;	 +2:	SUCCESSFUL
;		T1/	INDEX INTO PIDFTB
;		T2/	PAGE # OF DESTINATION FORK
;		T3/	MASK IN PAGE BIT TABLE (PIDPBT)
;		T4/	INDEX INTO BIT TABLE (PIDPBT)

PIDFFP:	MOVSI T4,-PIDPBL	;GET LENGTH OF BIT TABLE
PIDFF0:	SKIPE T1,PIDPBT(T4)	;GET NEXT WORD FROM BIT TABLE
	JFFO T1,PIDFF1		;ANY 1 BITS?
	AOBJN T4,PIDFF0		;NO, TRY NEXT WORD
	RETBAD (IPCFX8)		;NO MORE PAGES LEFT

PIDFF1:	MOVEI T1,^D36		;FOUND A FREE PAGE
	IMULI T1,0(T4)		;TURN IT INTO A PAGE NUMBER
	ADDI T1,0(T2)		;...
	CAML T1,PIDMXP		;TOO LARGE?
	RETBAD (IPCFX8)		;NO MORE ROOM
	MOVSI T3,400000		;NOW CREATE A MASK
	MOVNS T2		;GET NUMBER OF BITS TO SHIFT RIGHT
	LSH T3,0(T2)		;MAKE MASK
	IDIVI T1,^D512		;GET PIDFTB INDEX IN T1 AND PN IN T2
	RETSKP			;AND RETURN SUCCESSFULY
;THE MUTIL JSYS - MESSAGE UTILITY FUNCTION

;ACCEPTS IN 1:	COUNT OF ARGUMENTS IN BLOCK
;	    2:	LOCATION OF ARGUMENT BLOCK
;	MUTIL
;RETURNS +1:	ERROR, ERROR CODE IN T1
;	 +2:	SUCCESSFUL

.MUTIL::XCTU [SKIPG Q1,1]	;ANY ARGUMENTS?
	RETERR (IPCF17)		;NO, GIVE ERROR RETURN
	UMOVE Q2,2		;GET POINTER TO ARGUMENT BLOCK
	UMOVE Q3,0(Q2)		;GET FUNCTION CODE
	SKIPLE Q3		;GREATER THAN ZERO?
	CAILE Q3,MAXFUN		;WITHIN BOUNDS?
	RETERR (IPCF18)		;NO, GIVE ERROR RETURN
	HLRZ P1,MUTLTB-1(Q3)	;GET LENGTH OF MINIMUM ARG BLOCK SIZE
	TRZN P1,400000		;PRIVILEGES REQUIRED?
	JRST MUTIL1		;NO
	CALL CHKPRV		;YES, CHECK THEM
	 RETERR			;USER DOES NOT HAVE PRIV'S
MUTIL1:	CAMGE Q1,P1		;ENOUGH WORDS IN ARG LIST?
	RETERR (IPCF17)		;NO, GIVE USER AN ERROR RETURN
	HRRZ T1,MUTLTB-1(Q3)	;GET ADDRESS OF ROUTINE
	NOINT			;LOCK UP
;**;[2928] CHANGE 1 LINE AT MUTIL1:+4L	TAM	29-MAR-83
	CALL GTPIDL
	CALL (T1)		;DISPATCH TO ROUTINE
	 JRST [UNLOCK PIDLOK	;ERROR RETURN
		OKINT
		RETERR()]
	UNLOCK PIDLOK		;SUCCESSFUL
	OKINT
	SMRETN
MUTLTB:	2,,MUTENB		;(1) ENABLE A PID
	2,,MUTDIS		;(2) DISABLE A PID
	3,,MUTGTI		;(3) GET PID OF INFO
	400003,,MUTCPI		;(4) CREATE A PRIVATE INFO FOR A JOB
	2,,MUTDES		;(5) DESTROY A PID
	3,,MUTCRE		;(6) CREATE A PID
	400003,,MUTSSQ		;(7) SET SEND AND RECEIVE QUOTAS
	3,,MUTCHO		;(10) CHANGE OWNER OF A PID
	3,,MUTFOJ		;(11) FIND OWNER'S JOB NUMBER
	3,,MUTFJP		;(12) FIND JOB'S PIDS
	3,,MUTFSQ		;(13) FIND SEND AND RECEIVE QUOTAS
	1,,MUTILL		;(14) ILLEGAL FUNCTION
	3,,MUTFFP		;(15) FIND THE FORK'S PIDS
	400003,,MUTSPQ		;(16) SET PID QUOTA
	3,,MUTFPQ		;(17) FIND PID QUOTA
	5,,MUTQRY		;(20) QUERY
	3,,MUTAPF		;(21) ASSOCIATE A PID WITH A FORK
	3,,MUTPIC		;(22) PUT A PID ON AN INTERRUPT CHANNEL
	400002,,MUTDFI		;(23) DEFINE PID OF [SYSTEM]INFO
	400003,,MUTSPT		;(24) SET SYSTEM PID TABLE
	3,,MUTSPT		;(25) READ SYSTEM PID TABLE
	2,,MUTMPS		;(26) GET MAX PACKET SIZE
	3,,MUTSKP		;(27) SET PID TO RECEIVE DELETED PID MESSAGES
	3,,MUTRKP		;(30) GET PID TO RECEIVE DELETED PID MESSAGES
	2,,MUTSPS		;(31) Get max system packet size

MAXFUN==.-MUTLTB		;MAXIMUM DEFINED FUNCTION
;MUTIL FUNCTIONS 1 AND 2 - ENABLE AND DISABLE A PID

MUTDIS:	SKIPA T4,[TRO T3,PD%DIS] ;SET UP TO DISABLE PID FROM RECEIVING
MUTENB:	MOVE T4,[TRZ T3,PD%DIS]	;SET UP TO ENABLE PID FOR RECEIVING
	UMOVE T1,1(Q2)		;GET PID
	PUSH P,T4		;SAVE FUNCTION
	CALL VALPDJ		;VALIDATE THIS PID
	 JRST [	POP P,(P)	;NOT LEGAL PID OF THIS JOB
		RET]
	CALL CHKNOA		;SEE IF NO ACCESS BY THIS FORK
	 JRST [	POP P,(P)	;NO ACCESS
		RET]		;GIVE ERROR RETURN
	POP P,T4		;GET BACK FUNCTION
	LOAD T3,PIDFLG,(T2)	;GET PID FLAGS
	XCT T4			;PERFORM OPERATION
	STOR T3,PIDFLG,(T2)	;PUT FLAGS BACK
	RETSKP			;GIVE OK RETURN

;MUTIL FUNCTION 3 - GET [SYSTEM]INFO FOR THIS JOB

MUTGTI:	UMOVE T1,1(Q2)		;GET PID OR JOB NUMBER
	CALL GETJNO		;GET A JOB NUMBER
	 RET			;ILLEGAL ARGUMENT
	CALL SETJSB		;MAP IN THE APPROPRIATE JSB
	CALL GTINFO		;GET THE PID OF INFO FOR THE JOB
	 SETZ T2,		;NONE, RETURN 0
	UMOVEM T2,2(Q2)		;STORE THIS VALUE
	PUSH P,T2		;SAVE PID
	CALL CLRJSB		;UNMAP JSB
	POP P,T2		;GET BACK PID
	SKIPN T2		;WAS THERE A PID
	RETBAD (IPCF19)		;NO, TELL USER OF THIS
	RETSKP			;EXIT SUCCESSFULLY

;MUTIL FUNCTION 4 - CREATE A PRIVATE INFO FOR A JOB

MUTCPI:	STKVAR <MUTCPT>
	UMOVE T1,1(Q2)		;GET THE NEW INFO PID
	CALL VALPID		;IS IT OK?
	 RET			;NO
	MOVEM T1,MUTCPT		;REMEMBER PID
	UMOVE T1,2(Q2)		;GET JOB NUMBER OR PID
	CALL GETJNO		;GET JOB NUMBER
	 RET			;ILLEGAL VALUE
	CALL SETJSB		;MAP IN JSB OF THIS JOB
	MOVE T2,MUTCPT		;GET BACK PID
	MOVEM T2,JBINFO(T1)	;STORE PID INTO JSB
	CALL CLRJSB		;UNMAP THE JSB
	RETSKP			;RETURN SUCCESSFULLY
;MUTIL FUNCTION 5 - DESTROY A PID

MUTDES:	STKVAR <MUTDEP,MUTDEQ>
	UMOVE T1,1(Q2)		;GET PID TO BE DESTROYED
	CALL VALPDJ		;VALIDATE IT
	 RET			;NOT A LEGAL PID FOR THIS JOB
	CALL CHKNOA		;CHECK NO ACCESS BY THIS FORK
	 RET			;NOT ACCESSABLE, GIVE ERROR RETURN
	MOVEM T1,MUTDEP		;SAVE PID BEING DELETED
	CALL DELPID		;DELETE THE PID
	 RET			;COULD NOT DELETE IT
	MOVEM Q3,MUTDEQ		;SAVE Q3
	MOVEI Q3,3		;GET LENGTH OF MESSAGE FOR INFO
	CALL IPCDEL		;SET UP A MESSAGE FOR INFO
	 JRST MUTDE1		;CANNOT GET SPACE FOR MESSAGE
	MOVE T2,MUTDEP		;RETREIVE PID THAT WAS DROPPED
	STOR T2,MESWD0,(T1)	;PUT IT INTO THE MESSAGE
MUTDE1:	MOVE Q3,MUTDEQ		;RESTORE Q3
	RETSKP			;RETURN SUCCESSFULLY
;MUTIL FUNCTION 6 - CREATE A PID

MUTCRE:	XCTU [HRRZ T1,1(Q2)]	;GET FORK HANDLE OR JOB NUMBER
	CAIN T1,-1		;THIS JOB?
	MOVE T1,JOBNO		;YES, GET OUR JOB NUMBER
	TRNE T1,400000		;FORK OR JOB NUMBER?
	JRST [	TRNE T1,200000	;SPECIAL DESIGNATOR?
		RETBAD (IPCF20)	;YES, NOT ALLOWED
		CALL MFLOCK	;LOCK UP FORK LOCK
		CALL STJFKR	;GET JOB FORK INDEX FROM HANDLE
		 JRST [	CALL MFUNLK	;BAD FORK HANDLE
			RETBAD (IPCF20)]
		HRRZ T1,SYSFK(T1) ;GET SYSTEM FORK HANDLE
		CALL MFUNLK	;UNLOCK FORK LOCK
		JRST MUTCR1]	;GO CREATE THE PID
	CAIL T1,NJOBS		;WITHIN BOUNDS AS A JOB NUMBER?
	RETBAD (IPCF21)		;NO
	HRRZ T1,JOBPT(T1)	;YES, GET TOP FORK OF THAT JOB
MUTCR1:	XCTU [HLLZ T3,1(Q2)]	;GET FLAGS
	HLRZ T2,FKJOB(T1)	;GET JOB NUMBER OF OWNER
	HRRZ T2,JOBPT(T2)	;GET TOP FORK OF OWNER
	TLNE T3,(IP%JWP)	;USER WANT A JOB WIDE PID?
	MOVE T1,T2		;YES, USE THE TOP FORK OF JOB AS OWNER
	SETZ T2,		;INITIALIZE FLAGS ARGUMENT
	TLNE T3,(IP%JWP)	;JOB WIDE PID?
	TRO T2,PD%JWP		;YES, CREATE THIS PID FOR TOP FORK
	TLNE T3,(IP%NOA)	;NO ACCESS BY OTHER FORKS?
	TRO T2,PD%NOA		;YES, MARK IT AS SUCH
	CALL CREPID		;CREATE THE PID
	 RET			;ERROR
	UMOVEM T1,2(Q2)		;STORE PID IN USERS SPACE
	RETSKP			;AND RETURN

;MUTIL FUNCTION 7 - SET SEND AND RECEIVE QUOTAS

MUTSSQ:	UMOVE T1,1(Q2)		;GET PID TO BE SET FOR
	CALL VALPID		;VALIDATE IT
	 RET			;ILLEGAL PID
	UMOVE T3,2(Q2)		;GET QUOTAS
	LDB T4,[POINT 9,T3,35]	;GET RECEIVE QUOTA
	STOR T4,PIDRQ,(T2)	;STORE NEW QUOTA
	LDB T4,[POINT 9,T3,26]	;GET SEND QUOTA
	LOAD T3,PIDFO,(T2)	;GET JOB NUMBER OF OWNER
	HLRZ T3,FKJOB(T3)	;...
	STOR T4,PIDSQ,(T3)	;STORE SEND QUOTA FOR JOB
	RETSKP
;MUTIL FUNCTION 10 - CHANGE OWNER OF A PID

MUTCHO:	STKVAR <SAVCHO>
	CALL CHKWHL		;MUST BE A WHEEL FOR THIS FUNCTION
	 RET			;NOT A WHEEL
	UMOVE T1,2(Q2)		;GET PID OR JOB NUMBER OF NEW OWNER
	SKIPL T1		;SEE IF IT IS A JOB #
	CAIL T1,NJOBS		;...
	JRST [	CALL VALPID	;NOT A JOB #, TRY FOR A PID
		 RET		;NOT A LEGAL PID
		LOAD T3,PIDFO,(T2) ;GET FORK # OF OWNER
		JRST MUTCH1]	;GO CHANGE OWNER
	HRRZ T3,JOBPT(T1)	;JOB # SPECIFIED, USE TOP FORK OF JOB
MUTCH1:	MOVEM T3,SAVCHO		;SAVE FORK # OF OWNER
	UMOVE T1,1(Q2)		;GET PID TO BE CHANGED
	CALL VALPID		;VALIDATE IT
	 RET			;ILLEGAL
	MOVE T3,SAVCHO		;GET FORK # AGAIN
	HLRZ T4,FKJOB(T3)	;GET JOB NUMBER
	LOAD T3,PIDPQ,(T4)	;GET PID QUOTA FOR THIS JOB
	LOAD T1,PIDPC,(T4)	;AND GET THE ACTUAL COUNT OF PIDS
	CAMG T3,T1		;IS THERE ROOM FOR ONE MORE?
	RETBAD (IPCF13)		;NO, GIVE ERROR RETURN
	AOS T1			;COUNT UP COUNT OF PIDS
	STOR T1,PIDPC,(T4)	;SAVE NEW COUNT OF PIDS
	CALL CHKFKW		;SEE IF A FORK IS WAITING, AND WAKE IT
	MOVEI T3,-1		;NOW CLEAR OUT WAITING FORK
	STOR T3,PIDFW,(T2)	;...
	LOAD T3,PIDFLG,(T2)	;GET FLAGS
	TRZ T3,PD%CHN		;CLEAR OUT CHANNEL ASSIGNED BIT
	STOR T3,PIDFLG,(T2)	;USER WILL HAVE TO SET CHANNEL BACK UP
	LOAD T3,PIDFO,(T2)	;GET PREVIOUS OWNER
	HLRZ T3,FKJOB(T3)	;GET ITS JOB NUMBER
	LOAD T4,PIDPC,(T3)	;GET PRESENT COUNT OF PIDS IN THAT JOB
	SOJL T4,[BUG(PIDOD1)
		JRST MUTCH2]	;DONT STORE BAD COUNT
	STOR T4,PIDPC,(T3)	;STORE BACK UPDATED PID COUNT
MUTCH2:	MOVE T3,SAVCHO		;GET NEW FORK # OF OWNER
	STOR T3,PIDFO,(T2)	;PUT IT BACK IN THE PID HEADER
	RETSKP			;AND RETURN
;MUTIL FUNCTION 11 - FIND OWNER OF A PID

MUTFOJ:	UMOVE T1,1(Q2)		;GET PID
	CALL VALPID		;VALIDATE IT
	 RET			;NOT A LEGAL PID
	LOAD T3,PIDFO,(T2)	;GET FORK NUMBER OF OWNER
	HLRZ T3,FKJOB(T3)	;CONVERT IT INTO A JOB NUMBER
	UMOVEM T3,2(Q2)		;STORE IT IN ARG LIST
	RETSKP			;RETURN SUCCESSFULLY

;MUTIL FUNCTIONS 12 AND 15 - FIND PIDS OF A JOB AND OF A FORK

MUTFJP:	UMOVE T1,1(Q2)		;GET ARGUMENT
	CALL GETJNO		;TURN IT INTO A JOB NUMBER
	 RET			;ILLEGAL ARGUMENT
	MOVE T2,[CALL GETNPJ]	;GET ROUTINE TO BE CALLED
	JRST MUTFPC		;GO TO COMMON CODE

MUTFFP:	UMOVE T1,1(Q2)		;GET PID
	CALL VALPID		;SEE IF IT IS A LEGAL PID
	 RET			;NO LEGAL
	LOAD T1,PIDFO,(T2)	;GET FORK NUMBER OF PID OWNER
	MOVE T2,[CALL GETNPF]	;GET ROUTINE TO BE CALLED
MUTFPC:	STKVAR <MUTFJI,MUTFJN>
	MOVEM T1,MUTFJN		;STORE JOB NUMBER OR FORK NUMBER
	MOVEM T2,MUTFJI		;SAVE INSTRUCTION
	MOVEI T1,0		;START AT PID INDEX 0
	AOS Q2			;START ANSWER AT LOC+2
	SOJLE Q1,RSKP		;COUNT DOWN SPACE COUNTER
MUTFPL:	AOS Q2			;ADVANCE POINTER TO USER AREA
	SOJLE Q1,RSKP		;ANY MORE ROOM?
	MOVE T2,MUTFJN		;GET JOB NUMBER OR FORK NUMBER
	XCT MUTFJI		;YES, GET NEXT PID FOR JOB OR FORK
	 JRST MUTFPD		;NO MORE, GO TACK 0 ON END OF LIST
	UMOVEM T1,0(Q2)		;STORE PID
	AOS Q2
	SOJLE Q1,RSKP		;ANY MORE ROOM FOR FLAGS?
	LOAD T3,PIDFLG,(T2)	;GET FLAGS
	SETZ T4,		;INITIALIZE ANSWER
	TRNE T3,PD%JWP		;IS THIS A JOB WIDE PID?
	TLO T4,(IP%JWP)		;YES, SET FLAG
	TRNE T3,PD%NOA		;NO ACCESS BY OTHER FORKS
	TLO T4,(IP%NOA)		;YES, SET BIT
	UMOVEM T4,0(Q2)		;STORE FLAGS
	JRST MUTFPL		;LOOP BACK FOR ALL PIDS

MUTFPD:	XCTU [SETZM 0(Q2)]	;END LIST WITH A ZERO
	RETSKP			;AND EXIT
;MUTIL FUNCTION 13 - FIND SEND AND RECEIVE QUOTAS

MUTFSQ:	UMOVE T1,1(Q2)		;GET PID
	CALL VALPID		;VALIDATE IT
	 RET			;ILLEGAL PID
	LOAD T3,PIDFO,(T2)	;GET FORK NUMBER OF OWNER
	HLRZ T3,FKJOB(T3)	;TRANSLATE INTO JOB NUMBER
	LOAD T3,PIDSQ,(T3)	;GET SEND QUOTA OF JOB
	LOAD T4,PIDRQ,(T2)	;GET RECEIVE QUOTA OF PID
	DPB T3,[POINT 9,T4,26]	;SET UP ANSWER
	UMOVEM T4,2(Q2)		;GIVE ANSWER TO USER
	RETSKP

;MUTIL FUNCTION 14 - ILLEGAL

MUTILL:	RETBAD (IPCF18)		;ILLEGAL FUNCTION

;MUTIL FUNCTIONS 16 AND 17 - SET AND FIND PID QUOTA

;**;[1854] Replace five lines with one line at MUTSPQ:	RAS	23-APR-81
MUTSPQ:	UMOVE T1,1(Q2)		;[1854] GET ARGUMENT
	CALL GETJNO		;GET THE JOB NUMBER DESIRED
	 RET			;ILLEGAL ARGUMENT
	UMOVE T2,2(Q2)		;GET SECOND ARGUMENT
	CAILE T2,MAXQTA		;IS THIS A LEGAL VALUE?
	RETBAD (IPCF35)		;NO
;**;[1854] Replace two lines with one line at MUTSPQ: +10L RAS	23-APR-81
	STOR T2,PIDPQ,(T1)	;[1854] STORE NEW QUOTA
	RETSKP

;**;[1854] Insert six lines at MUTSPI: -1L		RAS	23-APR-81
MUTFPQ:	UMOVE T1,1(Q2)		;[1854] GET ARGUMENT
	CALL GETJNO		;[1854] GET THE JOB NUMBER DESIRED
	 RET			;[1854] ILLEGAL ARGUMENT
	LOAD T2,PIDPQ,(T1)	;[1854] GET QUOTA
	UMOVEM T2,2(Q2)		;[1854] WRITE ANSWER BACK
	RETSKP			;[1854] INDICATE SUCCESS

;**;[1854] Delete two lines at MUTSPI:		RAS	23-APR-81
;ROUTINE TO GET A JOB NUMBER OF A PID GIVEN A PID OR A JOB NUMBER

;ACCEPTS IN T1/	JOB NUMBER OR PID
;	CALL GETJNO
;RETURNS +1:	ERROR, ILLEGAL ARG
;	 +2:	T1/	JOB NUMBER

GETJNO:	CAMN T1,[-1]		;IS THIS A REQUEST FOR OUR JOB?
	JRST [	MOVE T1,JOBNO	;YES, GET OUR JOB NUMBER
		RETSKP]		;AND RETURN
	TLNN T1,-1		;IS THIS A JOB NUMBER?
	JRST GETJN1		;YES, GO CHECK ITS LEGALITY
	CALL VALPID		;NOT A JOB #, TRY A PID
	 RET			;NOT A PID EITHER
	LOAD T3,PIDFO,(T2)	;GET FORK # OF OWNER
	HLRZ T1,FKJOB(T3)	;GET JOB NUMBER
GETJN1:	CAIL T1,NJOBS		;IS THIS A LEGAL JOB NUMBER
	RETBAD (IPCF21)		;NO, GIVE ILLEGAL JOB NUMBER RETURN
	SKIPGE JOBRT(T1)	;IS THE JOB LOGGED IN
	RETBAD (IPCF30)		;NOT IN EXISTENCE
	RETSKP

;MUTIL FUNCTION 20 - QUERY

MUTQRY:	UMOVE T1,1(Q2)		;GET PID
	CAMN T1,[-1]		;IS THIS A REQUEST FOR THE WHOLE FORK?
	JRST [	CALL FNDNMF	;YES, GO FIND THE NEXT MESSAGE FOR FORK
		 RETBAD (IPCFX2) ;THERE ARE NO MESSAGES READY
		JRST MUTQR1]	;GO RETURN INFO ABOUT THIS MESSAGE
	CAMN T1,[-2]		;IS THIS A REQUEST FOR THE WHOLE JOB?
	JRST [	CALL FNDNMJ	;YES, FIND THE NEXT MESSAGE FOR THE JOB
		 RETBAD (IPCFX2) ;THERE ARE NO MESSAGES WAITING
		JRST MUTQR1]	;GO GIVE USER INFO ABOUT THIS MESSAGE
	CALL VALPDJ		;VALIDATE THAT THIS IS LEGAL PID FOR JOB
	 RET			;ILLEGAL PID FOR THIS JOB TO QUERY
	CALL CHKNOA		;SEE IF ACCESSABLE BY THIS FORK
	 RET			;NOT ACCESSABLE, GIVE ERROR RETURN
MUTQR1:	LOAD T3,PIDOL,(T2)	;GET POINTER TO OLDEST MESSAGE IN QUEUE
	JUMPE T3,[RETBAD (IPCFX2)] ;NO MESSAGES IN THE QUEUE
	SOS Q1			;SET UP TO COPY HEADER
	AOS Q2			;POINT TO AREA TO RECEIVE DATA
	LOAD T4,MESFLG,(T3)	;GET FLAGS OF MESSAGE
	UMOVEM T4,.IPCFL(Q2)	;GIVE THEM TO THE USER
	LOAD T4,PIDRC,(T2)	;GET NUMBER OF MESSAGES IN QUEUE
	XCTU [HRRM T4,.IPCFP(Q2)] ;RETURN COUNT TO USER
	CALL CPYMHD		;GIVE USER THE MESSAGE HEADER
	XCTU [HRLM T1,.IPCFP(Q2)] ;STORE MESSAGE LENGTH ALSO
	RETSKP			;ALL THROUGH
;MUTIL FUNCTION 21 - ASSIGN A PID TO A FORK

MUTAPF:	STKVAR <MUTAPT>
	UMOVE T1,2(Q2)		;GET FORK HANDLE
	TRNE T1,200000		;SPECIAL FUNCTION?
	RETBAD (IPCF20)		;YES, GIVE ERROR RETURN
	CALL MFLOCK		;LOCK UP FORK LOCK
	CALL STJFKR		;GET JOB FORK HANDLE
	 JRST [	CALL MFUNLK	;ILLEGAL FORK HANDLE
		RETBAD (IPCF20)]
	HRRZ T1,SYSFK(T1)	;GET SYSTEM WIDE FORK HANDLE
	MOVEM T1,MUTAPT		;SAVE IT
	CALL MFUNLK		;UNLOCK FORK LOCK
	UMOVE T1,1(Q2)		;GET PID
	CALL VALPDJ		;VALIDATE IT
	 RET			;ILLEGAL
	MOVE T3,MUTAPT		;GET FORK #
	STOR T3,PIDFO,(T2)	;SET UP NEW OWNER
	RETSKP			;AND RETURN
;MUTIL FUNCTION 22 - PUT A PID ON AN INTERRUPT CHANNEL

MUTPIC:	STKVAR <MUTPIT>
	UMOVE T1,1(Q2)		;GET PID
	CALL VALPDJ		;LEGAL PID FOR THIS JOB?
	 RET			;NO, GIVE ERROR RETURN
	UMOVE T3,2(Q2)		;GET CHANNEL
	CAMN T3,[-1]		;REMOVING IT
	JRST MUTPI1		;YES, GO DO SO
	SKIPL T3		;CHECK LEGALITY OF CHANNEL
	CAIL T3,^D36		;...
	RETBAD (IPCF22)		;NOT BETWEEN 0 AND 35
	MOVEM T3,MUTPIT		;SAVE CHANNEL NUMBER
	CALL MFLOCK		;LOCK UP FORK LOCK
	CALL VALPDJ		;MUST RE-VALIDATE THE PID
	 JRST [	CALL MFUNLK	;PID WENT AWAY
		RET]		;GIVE ERROR RETURN
	CALL CHKNOA		;NO ACCESS BY THIS FORK
	 JRST [	CALL MFUNLK	;YES, GIVE ERROR RETURN
		RET]
	CALL CHKPDW		;SEE IF LEGAL TO PUT PID ON A CHANNEL
	 JRST [	CALL MFUNLK	;NO, A SUPERIOR FORK HAS IT
		RET]
	MOVE T3,MUTPIT		;GET BACK CHANNEL NUMBER
	STOR T3,PIDCHN,(T2)	;STORE CHANNEL NUMBER
	LOAD T3,PIDFLG,(T2)	;GET FLAGS
	TRO T3,PD%CHN		;MARK THAT A CHANNEL IS SET UP
	STOR T3,PIDFLG,(T2)	;SAVE NEW FLAGS
	MOVE T3,FORKX		;GET OUR FORK NUMBER
	STOR T3,PIDFW,(T2)	;MARK THAT WE ARE WAITING FOR INTERRUPTS
	LOAD T3,PIDRC,(T2)	;ANY MESSAGES FOR THIS PID?
	SKIPE T3		;...
	CALL CHKFKW		;YES, GO CAUSE AN INTERRUPT
	CALL MFUNLK		;UNLOCK THE FORK LOCK
	RETSKP			;ALL THRU

MUTPI1:	MOVEI T4,-1		;SET UP TO CLEAR WAITER
	LOAD T3,PIDFLG,(T2)	;GET PID FLAGS
	TRZE T3,PD%CHN		;CLEAR THE FLAG THAT SAYS A CHN EXISTS
	STOR T4,PIDFW,(T2)	;CLEAR WAITING PID ONLY IF ONE WAS THERE
	STOR T3,PIDFLG,(T2)	;SAVE NEW FLAGS
	RETSKP			;ALL DONE
;MUTIL FUNCTION 23 - DEFINE PID OF [SYSTEM]INFO

MUTDFI:	SKIPE INFOPD		;ALREADY HAVE A PID FOR INFO?
	RETBAD (IPCF23)		;YES, THIS IS AN ERROR
	UMOVE T1,1(Q2)		;GET NEW PID
	CALL VALPID		;VALIDATE IT
	 RET			;NOT A VALID PID
	MOVEM T1,INFOPD		;SAVE NEW VALUE OF [SYSTEM]INFO PID
	MOVEM T1,.SPINF+SPIDTB	;PUT IT IN SYSTEM PID TABLE ALSO
	RETSKP			;AND RETURN


;MUTIL FUNCTION 24 AD 25 - SET AND READ SYSTEM PID TABLE

MUTSPT:	UMOVE T1,2(Q2)		;GET PID IF SPECIFIED
	XCTU [HRRZ T2,1(Q2)]	;GET INDEX INTO TABLE
	CAIL T2,SPDTBL		;IS THIS A LEGAL INDEX VALUE?
	RETBAD (IPCF33)		;NO, GIVE ERROR RETURN
	CAIE Q3,.MUSSP		;IS THIS A SET REQUEST?
	JRST MUTSP1		;NO
	MOVEM T1,SPIDTB(T2)	;YES, STORE NEW PID
	JUMPE T1,RSKP		;IF ARG IS 0, THEN CLEARING LOCATION
MUTSP1:	SKIPN T1,SPIDTB(T2)	;IS THERE A PID THERE?
	RETBAD (IPCF27)		;NO, NOT A DEFINED PID THERE
	PUSH P,T2		;SAVE INDEX
	CALL VALPID		;IS THIS A LEGAL PID?
	 JRST [	POP P,T2	;NO, GET BACK INDEX INTO TABLE
		SETZM SPIDTB(T2) ;CLEAR OUT BAD PID
		RET]		;AND GIVE ERROR RETURN
	POP P,T2		;GET BACK INDEX
	MOVE T1,SPIDTB(T2)	;AND GET BACK PID
	CAIN Q3,.MURSP		;IS THIS A READ REQUEST?
	UMOVEM T1,2(Q2)		;YES, RETURN PID TO USER
	RETSKP			;GIVE OK RETURN


;MUTIL FUNCTION 26 - GET MAXIMUM PACKET SIZE

MUTMPS:	MOVEI T1,MAXMSL		;GET MAX MESSAGE SIZE ALLOWED
	UMOVEM T1,1(Q2)		;GIVE IT TO USER
	RETSKP			;AND EXIT

;MUTIL FUNCTION 27 - GET MAXIMUM SYSTEM PACKET SIZE

MUTSPS:	MOVEI T1,MAXSMS		; Get max size allowed
	UMOVEM T1,1(Q2)		; Hand to the user
	RETSKP			; And exit
;MUTIL FUNCTION 27 - SET PID TO RECEIVE DELETED PID MESSAGES

MUTSKP:	STKVAR <MUTSKT>
	UMOVE T1,1(Q2)		;GET THE PID
	CALL VALPDJ		;SEE IF WE ARE ALLOWED TO DO THIS
	 RETBAD			;NO
	CALL CHKNOA		;MAKE SURE THAT ACCESS IS LEGAL
	 RETBAD
	MOVEM T2,MUTSKT		;SAVE THE PID INDEX
	UMOVE T1,2(Q2)		;GET THE RECEIVER PID
	CALL VALPID		;VALIDATE THE RECEIVER PID
	 RET			;ILLEGAL PID
	MOVE T2,MUTSKT		;GET BACK ORIGINAL PID HEADER ADR
	STOR T1,PIDKMP,(T2)	;STORE THE PID IN THE HEADER
	RETSKP			;DONE


;MUTIL FUNCTION 30 - READ PID TO RECEIVE DELETED PID MESSAGES

MUTRKP:	UMOVE T1,1(Q2)		;GET THE PID
	CALL VALPDJ		;VALIDATE IT
	 RETBAD
	LOAD T3,PIDKMP,(T2)	;GET THE PID TO RECEIVE DELETED MESSAGE
	UMOVEM T3,2(Q2)		;RETURN IT TO THE USER
	RETSKP
;ROUTINE TO VALIDATE THE USERS ARGUMENTS AND SET UP Q1-Q2, P1-P4

;	CALL VALARG
;RETURNS +1:	SOMETHING ILLEGAL - ERROR CODE IN T1
;	 +2:	Q1/	COUNT OF WORDS IN PID DISCRIPTOR BLOCK FROM USER
;		Q2/	USER ADDRESS OF PID DESCRIPTOR BLOCK
;		Q3/	SIZE OF MESSAGE AREA FROM USER
;		P1/	FLAGS FROM USER
;		P2/	SENDER'S PID
;		P3/	RECEIVER'S PID
;		P4/	ADDRESS OF MESSAGE IN USER SPACE

VALARG:	XCTU [HRRZ Q1,1]	;GET LENGTH OF DESCRIPTOR BLOCK
	UMOVE Q2,2		;GET POINTER TO DESCRIPTOR BLOCK
	CAIGE Q1,MINPHL		;LONG ENOUGH?
	RETBAD (IPCFX1)		;NO
	UMOVE P1,.IPCFL(Q2)	;GET FLAGS
;**;[2643]CHANGE 1 LINE AT VALARG:+5L	TAM	4-AUG-82
	TXZ P1,IP%INT+IP%CFZ	;[2643]Clear impossible bits
	UMOVE P2,.IPCFS(Q2)	;GET SENDER'S PID
	TLNE P1,(IP%CFS)	;INDIRECT SENDER'S PID?
	UMOVE P2,0(P2)		;YES, GET ACTUAL PID
	UMOVE P3,.IPCFR(Q2)	;GET RECEIVER'S PID
	TLNE P1,(IP%CFR)	;INDIRECT POINTER?
	UMOVE P3,0(P3)		;YES, GET ACTUAL VALUE
	UMOVE P4,.IPCFP(Q2)	;GET POINTER TO MESSAGE
	HLRZ Q3,P4		;SET UP Q3 WITH LENGTH OF MESSAGE
	HRRZS P4		;CLEAR LEFT HALF OF ADDRESS
	TRNN P1,IP%CFV		;PAGE MODE?
	JRST VALAR1		;NO
	TRNE P4,777000		;IS THE PAGE NUMBER LEGAL?
	RETBAD (IPCF31)		;NO
	TLNE P1,(IP%TTL)	;TRUNCATE IF TOO LONG?
	JUMPE Q3,VALAR1		;YES, 0 IS OK FOR PAGE MODE
	CAIE Q3,PGSIZ		;OTHERWISE, LENGTH MUST BE 1 PAGE
	RETBAD (IPCF24)		;NOT LEGAL SIZE
VALAR1:	CALL CHKPRV		;SEE IF CALLER IS PRIV'D
;**;[2643]CHANGE 1 2641 LINE AT VALAR1:+1L	TAM	4-AUG-82
;**;[2641]CHANGE 1 LINE AT VALAR1:+1L	TAM	3-AUG-82
	 TXNN P1,IP%CFP+IP%CFC+IP%CFM ;[2641][2643] NO, PRIVELEGED FUNCTION?
	RETSKP			;NOT PRIV'D FUNCTION OR USER HAS PRIV'S
	RET			;YES, GIVE ERROR RETURN
;ROUTINE TO VALIDATE A PID AS BELONGING TO THE CURRENT JOB

;ACCEPTS IN 1:	PID
;	CALL VALPDJ
;RETURNS +1:	PID NOT VALID FOR THIS JOB
;	 +2:	PID LEGAL FOR THIS JOB
;		T1/	PID
;		T2/	POINTER TO PID HEADER

VALPDJ:	CALL VALPID		;SEE IF PID IS LEGAL AT ALL
	 RET			;IT ISNT
	LOAD T3,PIDFO,(T2)	;GET FORK # OF OWNER
	HRRZ T4,FORKX		;GET CURRENT FORK #
	HLRZ T3,FKJOB(T3)	;GET JOB # OF PID OWNER
	HLRZ T4,FKJOB(T4)	;GET JOB # OF THIS JOB
	CAME T3,T4		;SAME JOB?
	RETBAD (IPCF25)		;NO
	RETSKP			;YES
;ROUTINE TO SEE IF A PID IS A VALID ONE

;ACCEPTS IN 1:	PID
;	CALL VALPID
;RETURNS +1:	ERROR RETURN, PID IS NOT VALID
;	 +2:	SUCCESSFULL
;		T1/	PID
;		T2/	ADDRESS OF PID HEADER BLOCK

VALPID:	CALL GETPID		;GET HALF WORD ENTRY FROM PID TABLE
	 RET			;ILLEGAL PID TABLE INDEX
	CAIGE T2,SWFREE		;IS THIS PID ON THE FREE LIST?
	RETBAD (IPCF27)		;YES, GIVE ERROR RETURN
	LOAD T3,PIDUN,(T2)	;GET UNIQUE NUMBER FROM PID HEADER
	HRL T3,T1		;BUILD THE FULL PID
	MOVSS T3		;GET PID IN RIGHT ORDER
	CAME T3,T1		;DO THE TWO PIDS MATCH?
	RETBAD (IPCF27)		;NO, INVALID PID
	RETSKP			;YES, PID IS VALID
;ROUTINE TO WAIT FOR A MESSAGE TO ARRIVE FOR A PID OR MULTIPLE PIDS

;THIS ROUTINE ASSUMES THAT "PIDFW" HAS BEEN SET UP FOR EACH PID

;	CALL MWAIT
;RETURNS +1:	ALLWAYS, AFTER A WAKE UP OCCURED. ALL LOCKS SET.

MWAIT:	MOVE T1,FORKX		;WAIT THIS FORK
	CALL GETMSK		;GET MASK INTO PDFKTB IN T2
	ANDCAM T2,PDFKTB(T1)	;CLEAR THE WAITING BIT
	UNLOCK PIDLOK		;UNLOCK THE LOCKS WHILE WAITING
	OKINT
	CALL FUNLK		;UNLOCK THE FORK LOCK
	HRRI T1,PIDWAT		;SET UP FOR MDISMS
	HRL T1,FORKX		;XWD DATA,ADDRESS OF TEST ROUTINE
	MOVEI T2,^D50		;HOLD IN THE BALANCE SET FOR 50 MS
	HDISMS			;DISMIS UNTIL TEST SUCCEEDS
;**;[2928] REPLACE 3 LINES WITH 1 AT MWAIT:+10L	TAM	29-MAR-83
	CALL GTLCKS		;[2928] GET LOCKS AGAIN
	CALLRET ENDWAT		;CLEAR PIDFW'S WITH THIS FORK IN IT

;ROUTINE TO CLEAR PIDFW WHERE EVER FORKX IS THE FORK NUMBER IN PIDFW

;	CALL ENDWAT
;RETURNS +1:	ALWAYS, FORKX NO LONGER WAITING ON ANY PID

ENDWAT:	MOVEI T1,1		;NOW CLEAR PIDFW FOR THIS FORK
ENDWT1:	CALL GETPID		;LOOP THRU ALL PIDS
	 RET			;NO MORE TO LOOK AT
	CAIGE T2,SWFREE		;IS THIS A PID ON THE FREE LIST?
	AOJA T1,ENDWT1		;YES, IGNORE IT
	LOAD T3,PIDFLG,(T2)	;GET FLAGS FOR THIS PID
	TRNE T3,PD%CHN		;IS THIS PID ON AN INTERRUPT CHANNEL?
	AOJA T1,ENDWT1		;YES, IGNORE IT ALSO
	LOAD T3,PIDFW,(T2)	;GET WAITING FORK NUMBER
	CAMN T3,FORKX		;THIS OUR FORK NUMBER?
	MOVEI T3,-1		;YES, SET TO -1 TO MEAN NOBODY WAITING
	STOR T3,PIDFW,(T2)	;PUT BACK VALUE
	AOJA T1,ENDWT1		;LOOP FOR ALL PIDS
;**;ADD 1 PAGE OF SUBROUTINES TO IPCF	TAM	29-MAR-83
;[2928]ROUTINE TO GET BOTH THE FORK LOCK AND THE PID LOCK
;[2928]RETURNS:	+1 NOINT WITH BOTH LOCKS

;[2928]To avoid deadly embrace, give up the first one if we can't get the
;[2928]second one, wait a while, and try again.

GTLCKS:	CALL FLOCK		;[2928] GET THE FORK LOCK
	NOINT			;[2928]NOINT FOR PID LOCK
	LOCK PIDLOK,<JRST GTLCK1> ;[2928]
	RET			;[2928]GOT IT, DONE

;[2928]COULDN'T GET PIDLOK. GIVE UP FORK LOCK AND WAIT A WHILE

GTLCK1:	OKINT
	CALL FUNLK		;[2928]UNLOCK FORK LOCK
	PUSH P,T1		;[2928]SAVE THIS
	MOVEI T1,^D200		;[2928]WAIT 200 MS BEFORE RECHECKING
	DISMS			;[2928]
	POP P,T1		;[2928]GET IT BACK
	JRST GTLCKS		;[2928] GO GET BOTH LOCKS

;[2928]GET THE PID LOCK.  THIS ROUTINE IS CALLED WHILE NOINT.

GTPIDL:	LOCK PIDLOK,<JRST GTPIDF>  ;[2928]GET THE PID LOCK
	RET			;[2928]GOT IT

GTPIDF:	OKINT			;[2928]INTERRUPTABLE NOW
	PUSH P,T1		;[2928]PRESERVE IT
	MOVEI T1,^D200		;[2928]WAIT A BIT BEFORE
	DISMS			;[2928] CHECKING AGAIN
	POP P,T1		;[2928]GET IT BACK
	NOINT			;[2928]NOT INTERRUPTABLE WHILE GETTING LOCK
	JRST GTPIDL		;[2928]GO TRY IT AGAIN
	RESCD

;ROUTINE CALLED BY SCHED TO SEE IF THIS FORK HAS BEEN WOKEN

;ACCEPTS IN T1:	DATA FROM MDISMS (FORK NUMBER)
;	JSP T4,PIDWAT
;RETURNS +1:	THIS FORK HAS NOT BEEN AWAKENED
;	 +2:	THE BIT IN PDFKTB WAS SET AND THIS FORK SHOULD BE RUN

PIDWAT::PUSH P,T4		;SAVE RETURN
	CALL GETMSK		;GET BIT MASK INTO T2
	TDNN T2,PDFKTB(T1)	;IS THIS FORK TO BE AWAKENED?
	RET			;NO
	RETSKP			;YES

;ROUTINE TO GET A BIT MASK FOR THE PDFKTB FOR A PARTICULAR FORK

;ACCEPTS IN T1:	FORK NUMBER
;	CALL GETMSK
;RETURNS +1:	ALWAYS
;		T1/	INDEX INTO PDFKTB
;		T2/	BIT MASK FOR THIS FORK

GETMSK::IDIVI T1,^D36		;GET BIT POSITION
	MOVN T3,T2		;SET UP FOR SHIFT
	MOVSI T2,400000		;INITIALIZE BIT MASK
	LSH T2,(T3)		;GET THE MASK
	RET			;AND RETURN

	SWAPCD
;ROUTINE TO SEE IF A FORK IS WAITING FOR A MESSAGE AND TO WAKE IT

;ACCEPTS IN T1/	PID
;	    T2/	PID HEADER ADDRESS
;	CALL CHKFKW
;RETURNS +1:	ALWAYS - FORK WAKENED IF ONE WAS WAITING

;**;[2949]  Add 1 line at CHKFKW:		DML	25-APR-83
CHKFKW:	SAVEAC <T1,T2>		;[2949] SAVE THESE TO PREVENT ILMNRFS
	LOAD T4,PIDFW,(T2)	;GET WAITING FORK
	CAIN T4,-1		;ANY FORK WAITING?
	RET			;NO, DONE
	LOAD T3,PIDFLG,(T2)	;GET FLAGS OF PID
	TRNE T3,PD%CHN		;IS THERE A CHANNEL SET UP FOR THIS PID?
	CALL INTFRK		;YES, GO INTERRUPT THE FORK
	LOAD T1,PIDFW,(T2)	;GET WAITING FORK
	CALL WAKFRK		;GO WAKE FORK
	RET			;AND RETURN

;ROUTINE TO WAKE UP A FORK THAT IS WAITING FOR A MESSAGE

;ACCEPTS IN T1:	FORK NUMBER TO BE AWAKENED
;	CALL WAKFRK
;RETURNS +1:	ALWAYS

WAKFRK:	PUSH P,T1		;SAVE FORK INDEX
	CALL GETMSK		;GET BIT MASK INTO PDFKTB
	IORM T2,PDFKTB(T1)	;SET THE BIT
	POP P,T1		;GET BACK FORK INDEX
	CALLRET UNBLKF		;GO UNBLOCK THE FORK

;ROUTINE TO CAUSE A SOFTWARE INTERRUPT TO A FORK WAITING FOR A PID

;ACCEPTS IN T1:	PID
;	    T2:	POINTER TO PID HEADER
;	CALL INTFRK
;RETURNS +1:	ALWAYS

INTFRK:	PUSH P,T1		;SAVE PID
	PUSH P,T2		;AND POINTER
	LOAD T1,PIDCHN,(T2)	;GET CHANNEL NUMBER TO INTERRUPT ON
	LOAD T2,PIDFW,(T2)	;GET FORK NUMBER TO BE AWAKENED
	CALL PSIRQ		;GO INTERRUPT
	POP P,T2
	POP P,T1
	RET			;AND RETURN
;ROUTINE TO SEE IF THIS FORK HAS SC%IPC OR SC%WHL PRIVILEGES

;	CALL CHKPRV
;RETURNS +1:	DOES NOT HAVE SC%WHL OR SC%IPC PRIVS
;	 +2:	THIS FORK HAS ONE OF THOSE PRIVILEGES

CHKPRV:	MOVE T1,CAPENB		;GET ENABLED CAPABILITIES
	TRNN T1,SC%WHL!SC%OPR!SC%IPC	;SEE IF EITHER PRIVILEGE IS SET
	RETBAD (IPCF11)		;NOT SET
	RETSKP			;PRIVILEGES SET

;ROUTINE TO SEE IF THE CALLER HAS SC%WHL OR OPERATOR PRIV'S

;	CALL CHKWHL
;RETURNS +1:	SC%WHL NOT SET
;	 +2:	SC%WHL SET

CHKWHL:	MOVE T1,CAPENB		;GET CAPABILITIES
	TRNN T1,SC%WHL!SC%OPR	;SC%WHL SET?
	RETBAD (IPCF10)		;NO
	RETSKP			;YES

;ROUTINE TO SEE IF PID HAS NO ACCESS BY OTHER FORKS BIT SET

;ACCEPTS IN T1/	PID
;	    T2/	PID HEADER
;	CALL CHKNOA
;RETURNS +1:	NO ACCESS BIT IS SET
;	 +2:	ACCESS BY OTHER FORKS IS ALLOWED

CHKNOA:	LOAD T4,PIDFO,(T2)	;GET OWNER OF PID
	CAMN T4,FORKX		;IS THIS OUR FORK
	RETSKP			;YES, THEN WE CAN ACCESS IT
	LOAD T4,PIDFLG,(T2)	;GET FLAGS
	TRNE T4,PD%NOA		;IS THIS PID NO ACCESS BY OTHER FORKS?
	RETBAD (IPCF28)		;YES
	RETSKP			;NO
;ROUTINE TO CHECK IF A PID CAN BE WAITED ON BY THIS FORK

;ACCPETS IN T1/	PID
;	    T2/	PID HEADER
;		FORK LOCK MUST BE SET DURING CALLS TO CHKPDW
;	CALL CHKPDW
;RETURNS +1:	NOT ALLOWED TO WAIT ON THIS PID
;	 +2:	WAITING IS ALLOWED

;**;[2949]  Replace 3 lines with 1 line at CHKPDW:	DML	25-APR-83
CHKPDW:	SAVEAC <T1,T2>		;[2949] SAVE THESE TO PREVENT ILMNRFS
	LOAD T4,PIDFW,(T2)	;GET FORK # OF WAITING FORK
	CAIE T4,-1		;NOBODY WAITING?
	CAMN T4,FORKX		;OR OUR FORK?
	RETSKP			;YES, OK TO WAIT
	LOAD T3,PIDFLG,(T2)	;GET FLAGS
	TRNE T3,PD%CHN		;A CHANNEL SET UP BY SOME FORK?
	RETBAD (IPCF29)		;YES, THEN NOT ALLOWED TO WAIT
	MOVSI T3,-NFKS		;SET UP AOBJN POINTER
CHKPDL:	SKIPGE T1,SYSFK(T3)	;IS THERE A FORK IN THIS SLOT
	JRST CHKPDD		;NO, GO TRY OTHER SLOTS
	CAIE T4,(T1)		;IS THIS THE ONE WE WANT?
	JRST CHKPDD		;NO, GO TRY REST
	MOVEI T1,(T3)		;GET LOCAL FORK HANDLE
	CALL SKIIF		;SEE IF INFERIOR TO OURSELVES
	 RETBAD (IPCF29)	;NO, GIVE ERROR RETURN
	MOVE T1,T4		;GET FORK OF WAITER ON THIS PID
	CALL WAKFRK		;WAKE THIS FORK UP
;**;[2949]  Delete 2 lines at CHKPDL:+9		DML	25-APR-83
	RETSKP			;OK TO WAIT ON THIS PID NOW

CHKPDD:	AOBJN T3,CHKPDL		;LOOP BACK FOR ALL FORKS
	BUG(IPCFKH)
;**;[2949]  Delete 2 lines at CHKPDD:+1		DML	25-APR-83
	RETBAD (IPCF29)		;GIVE ERROR RETURN
;ROUTINES TO GET THE NEXT PID FOR A JOB OR FOR A FORK

;ACCEPTS IN 1/	PID INDEX (STARTING AT 0)
;	    2/	FORK # OR JOB #
;	CALL GETNPF	OR	CALL GETNPJ
;RETURNS +1:	NO MORE PIDS FOR THIS FORK OR JOB
;	 +2:	SUCCESSFUL, T1=PID,  T2=POINTER TO PID HEADER

GETNPF:	STKVAR <SAVFRK>
	MOVEM T2,SAVFRK		;SAVE FORK NUMBER
GTNPFL:	AOS T1			;COUNT UP PID INDEX
	CALL GETPID		;GET POINTER TO PID HEADER IF THERE
	 RET			;NO MORE PIDS
	CAIGE T2,SWFREE		;IS THIS A PID ON THE FREE LIST?
	JRST GTNPFL		;YES, LOOP BACK
	LOAD T3,PIDFO,(T2)	;NO, GET OWNER OF PID
	CAME T3,SAVFRK		;FOUND A MATCH?
	JRST GTNPFL		;NO, LOOP BACK
	LOAD T3,PIDUN,(T2)	;GET UNIQUE NUMBER
	HRL T1,T3		;SET UP ACTUAL PID IN T1
	RETSKP			;GIVE OK RETURN

GETNPJ:	STKVAR <SAVJOB>
	MOVEM T2,SAVJOB		;SAVE JOB NUMBER
GTNPJL:	AOS T1			;COUNT UP PID INDEX
	CALL GETPID		;GET POINTER TO PID HEADER
	 RET			;NO MORE PIDS
	CAIGE T2,SWFREE		;IS THIS A PID ON THE FREE LIST?
	JRST GTNPJL		;YES, GO GET ANOTHER ONE
	LOAD T3,PIDFO,(T2)	;GET OWNER FORK NUMBER
	HLRZ T4,FKJOB(T3)	;GET JOB NUMBER
	CAME T4,SAVJOB		;IS THIS A MATCH?
	JRST GTNPJL		;NO, LOOP BACK FOR OTHER PIDS
	LOAD T3,PIDUN,(T2)	;GET UNIQUE NUMBER FOR THIS PID
	HRL T1,T3		;SET UP PID
	RETSKP			;GIVE OK RETURN
;ROUTINE TO RETREIVE THE PER PID INFORMATION FROM PIDTBL

;ACCEPTS IN 1:	PID
;		CALL GETPID
;RETURNS +1:	ILLEGAL PID INDEX
;	 +2:	SUCCESSFUL
;		T1/	PID
;		T2/	CONTENTS OF APPROPRIATE HALF WORD FROM PIDTBL

GETPID:	PUSH P,T1		;SAVE PID
	HRRZS T1		;CLEAR OUT UNIQUE NUMBER
	SOSL T1			;ZERO IS NOT A LEGAL PID #
	CAIL T1,MAXPID		;PID LEGAL?
	JRST [	POP P,(P)	;NO
		RETBAD (IPCF27)] ;GIVE ERROR RETURN
	ROT T1,-1		;GET LOW ORDER BIT AS SIGN BIT
	HLRZ T2,PIDTBL(T1)	;ASSUME PID IS EVEN FIRST
	SKIPGE T1		;IS IT EVEN?
	HRRZ T2,PIDTBL(T1)	;NO, GET CORRECT INFO
	POP P,T1		;RESTORE PID
	RETSKP			;AND RETURN

;ROUTINE TO STORE NEW DATA IN THE PID HALF WORD TABLE (PIDTBL)

;ACCEPTS IN T1:	PID
;	    T2:	NEW DATA RIGHT JUSTIFIED
;		CALL PUTPID
;RETURNS +1:	ILLEGAL PID
;	 +2:	SUCCESSFUL, ACS UNCHANGED

PUTPID:	PUSH P,T1		;SAVE ALL REGISTERS
	HRRZS T1		;CLEAR OUT UNIQUE NUMBER FROM LH OF PID
	SOSL T1			;0 IS NOT A LEGAL PID #
	CAIL T1,MAXPID		;PID WITHIN BOUNDS?
	JRST [	POP P,T1	;NO, GIVE ERROR RETURN
		RETBAD (IPCF27)]
	ROT T1,-1		;GET LOW ORDER BIT AS SIGN BIT
	JUMPL T1,[HRRM T2,PIDTBL(T1)
		  JRST PUTPD1]	;STORE IN RIGHT HALF WORD IF PID IS ODD
	HRLM T2,PIDTBL(T1)	;STORE IN LEFT HALF WORD IF PID IS EVEN
PUTPD1:	POP P,T1		;RESTORE PID
	RETSKP			;AND RETURN
;ROUTINE TO CREATE A PID
;  THIS ROUTINE GETS A FREE PID FROM THE FREE LIST AND ASSIGNS
;  SPACE FROM THE FREE POOL FOR THE PID HEADER

;ACCEPTS IN T1:	FORK OF NEW OWNER
;	  T2:	FLAGS OF NEW PID
;	CALL CREPID
;RETURNS +1	NO MORE PIDS AVAILABLE, ERROR CODE IN T1
;	 +2	PID CREATED
;		T1/	PID (36 BITS)
;		T2/	POINTER TO PID HEADER

CREPID:	STKVAR <CREFKO,CREPDF,CREPDT>
	MOVEM T1,CREFKO		;STORE FORK NUMBER AWAY
	MOVEM T2,CREPDF		;AND FLAGS
	HLRZ T2,FKJOB(T1)	;GET JOB NUMBER OF OWNER
	MOVE T3,FORKX		;SEE IF CALLER ALLOWED TO CREATE PID
	HLRZ T3,FKJOB(T3)	;GET JOB NUMBER OF CALLER
	CAMN T2,T3		;SAME AS ONE OF CREATED PID?
	JRST CREPD1		;YES, THEN THIS IS OK
	MOVEM T2,CREPDT		;SAVE JOB NUMBER
	CALL CHKPRV		;SEE IF PRIVILEGES SET
	 RET			;NO, CREATING NOT ALLOWED
	MOVE T2,CREPDT		;GET BACK JOB NUMBER
CREPD1:	HRRZ T3,JOBPT(T2)	;GET TOP FORK OF JOB IN CASE JOB WIDE PID
	MOVE T4,CREPDF		;GET FLAGS OF PID
	TLNE T4,(IP%JWP)	;JOB WIDE PID WANTED?
	MOVEM T3,CREFKO		;YES, STORE FORK NUMBER OF TOP FORK
	LOAD T3,PIDPQ,(T2)	;IS THIS JOB OVER ITS PID QUOTA
	LOAD T4,PIDPC,(T2)	;GET CURRENT PID COUNT
	CAML T4,T3		;SEE IF OVER QUOTA
	RETBAD (IPCF13)		;YES, GIVE ERROR RETURN
	SKIPN T1,PIDLST		;ANY FREE PIDS AVAILABLE?
	RETBAD (IPCF12)		;NO PID'S FREE
	CALL GETPID		;GO GET LINK TO NEXT PID IN FREE LIST
	 JRST [	BUG(PIDFLF)
		RET]		;GIVE ERROR RETURN FROM CREATE PID
	EXCH T2,PIDLST		;STORE NEW LINK WORD
	MOVEM T2,CREPDT		;SAVE PID NUMBER
	MOVEI T1,PIDHDS		;GO GET FREE SPACE FOR HEADER
	CALL ASGSWP		;...
	 JRST [	MOVE T2,CREPDT	;NO ROOM FOR HEADER, RESTORE PIDLST
		MOVEM T2,PIDLST	;...
		RET]		;NO FREE SPACE LEFT ERROR
	AOS T2,NXTPID		;GET A UNIQUE NUMBER FOR LH OF PID
	STOR T2,PIDUN,(T1)	;STORE UNIQUE NUMBER IN PID HEADER
	HRLM T2,CREPDT		;PUT UNIQUE NUMBER IN PID ITSELF
	MOVE T2,T1		;GET POINTER TO HEADER INTO T2
	;..
	;..
	MOVEI T1,0		;CLEAR RECEIVE COUNT
	STOR T1,PIDRC,(T2)	;...
	MOVEI T1,PIDSRQ		;GET STANDARD RECEIVE QUOTA
	STOR T1,PIDRQ,(T2)	;STORE IT IN PID HEADER
	MOVE T1,CREPDF		;GET FLAGS
	STOR T1,PIDFLG,(T2)	;STORE THEM IN HEADER
	MOVE T1,CREFKO		;GET OWNER FORK
	STOR T1,PIDFO,(T2)	;STORE IT TOO
	HLRZ T3,FKJOB(T1)	;GET JOB NUMBER OF OWNER FORK
	LOAD T4,PIDPC,(T3)	;GET PID COUNT
	ADDI T4,1		;UPDATE THE COUNT
	STOR T4,PIDPC,(T3)
	MOVEI T1,-1		;MARK THAT NO FORK IS WAITING
	STOR T1,PIDFW,(T2)	;...
	MOVE T1,CREPDT		;GET BACK PID
	CALL PUTPID		;PUT POINTER TO HEADER INTO PIDTBL
	 JRST [	BUG(ILPID1)
		RET]		;GIVE ERROR RETURN
	RETSKP			;RETURN TO CALLER
;ROUTINE TO DELETE A PID AND RETURN IT TO THE FREE LIST

;ACCEPTS IN T1:	PID
;	CALL DELPID
;RETURNS +1:	NOT A LEGAL PID
;	 +2:	PID DELETED

DELPID:	SAVEQ
	CALL VALPID		;VALIDATE THIS PID FIRST
	 RET			;ILLEGAL PID, OR NOT IN USE
	DMOVE Q1,T1		;SAVE THE PID AND PID INDEX
	MOVEI Q3,PKMHDS		;SET UP TO SEND A DELETED PID MESSAGE
	LOAD T1,PIDKMP,(Q2)	;GET PID TO SEND TO
	MOVE T2,Q1		;GET DELETED PID
	SKIPE T1		;IS THERE ONE SET UP?
	CALL IPCPKM		;YES, GO SEND A MESSAGE TO THAT PID
	 JFCL			;NOTHING TO DO IF MESSAGE NOT SENT
	LOAD T3,PIDFO,(Q2)	;GET OWNER OF PID
	HLRZ T3,FKJOB(T3)	;GET JOB NUMBER OF OWNER
	LOAD T4,PIDPC,(T3)	;DECREMENT THE PID COUNT FOR THIS JOB
	SOJL T4,[BUG(PIDOD2)
		JRST DELPD1]	;DONT STORE BAD COUNT
	STOR T4,PIDPC,(T3)	;PUT BACK UPDATED PID COUNT
DELPD1:	DMOVE T1,Q1		;SET UP PID AND INDEX
	CALL MESRET		;RETURN ALL MESSAGES IN QUEUE
	MOVE T2,Q2		;GET PID HEADER ADDRESS
	MOVEI T1,PIDHDS		;GET LENGTH OF HEADER
	MOVEM T1,0(T2)		;PUT IN FIRST WORD OF HEADER BLOCK
	HRRZ T1,T2		;GET POINTER TO PID HEADER
	CALL RELMES		;RELEASE THE HEADER TO THE FREE POOL
	MOVE T1,Q1		;GET BACK THE PID
	CAMN T1,INFOPD		;IS THIS THE [SYSTEM]INFO PID GOING AWAY
	SETZM INFOPD		;YES, MARK THAT NO PID EXISTS FOR INFO
	MOVE T2,PIDLST		;GET POINTER TO NEXT PID ON LIST
	CALL PUTPID		;STORE POINTER TO THIS PID IN TABLE
	 JRST [	BUG(ILPID2)
		RET]		;GIVE ERROR RET
	HRRZM T1,PIDLST		;MAKE THIS PID BE FIRST ON LIST
	RETSKP			;AND EXIT SUCCESSFULLY
;ROUTINE TO RETURN ALL MESSAGES BELONGING TO A PID TO THE SENDER
;	OF EACH MESSAGE.

;ACCEPTS IN T1/	PID
;	    T2/	PID HEADER POINTER
;	CALL MESRET
;RETURNS +1:	ALWAYS - NO MORE MESSAGES IN THIS PID QUEUE

MESRET:	STKVAR <MSRTPD,MSRTPH,MSRTMH>
	MOVEM T1,MSRTPD		;SAVE PID
	MOVEM T2,MSRTPH		;SAVE PID HEADER
MESRT0:	MOVE T2,MSRTPH		;GET PID HEADER POINTER
	CALL GETMES		;GET NEXT MESSAGE FROM PID QUEUE
	 RET			;NO MORE MESSAGES IN THE QUEUE
	MOVEM T3,MSRTMH		;SAVE ADDRESS OF MESSAGE HEADER
	LOAD T4,MESFLG,(T3)	;GET FLAGS OF MESSAGE
	TROE T4,.IPCFN		;ALREADY BEEN TURNED AROUND ONCE?
	JRST MESRT1		;YES, THROW THE MESSAGE AWAY
	STOR T4,MESFLG,(T3)	;STORE NEW FLAGS
	LOAD T1,MESSPD,(T3)	;GET SENDER'S PID
	JUMPE T1,MESRT1		;IF 0 JUST THROW IT AWAY
	CAMN T1,MSRTPD		;SENDING TO SAME PID?
	JRST MESRT1		;YES, JUST THROW IT AWAY
	MOVE T2,T3		;GET POINTER TO MESSAGE
	MOVE T3,MSRTPD		;GET OLD PID OF THIS MESSAGE
	STOR T3,MESSPD,(T2)	;MAKE THIS BE THE NEW SENDER'S PID
	CALL MESTOR		;GO PUT MESSAGE ON QUEUE
	 JRST MESRT1		;FAILURE, THROW MESSAGE AWAY
	LOAD T3,MESSJN,(T1)	;GET JOB NUMBER OF SENDER
	CAIN T3,-1		;IF ONE STILL EXISTS
	JRST MESRT0		;NO JOB #, JUST LOOP BACK
	LOAD T4,PIDSC,(T3)	;GET THE SENDER'S COUNT
	ADDI T4,1		;INCREMENT IT
	STOR T4,PIDSC,(T3)	;PUT BACK NEW COUNT
	JRST MESRT0		;LOOP BACK FOR ALL MESSAGES

MESRT1:	MOVE T1,MSRTMH		;GET POINTER TO MESSAGE BLOCK
	LOAD T2,MESFLG,(T1)	;GET FLAGS OF MESSAGE
	TRNN T2,IP%CFV		;IS THIS A PAGE MODE MESSAGE?
	JRST MESRT2		;NO, NO NEED TO DELETE THE PAGE
	LOAD T2,MSFTI,(T1)	;GET INDEX INTO PAGES BIT TABLE
	LOAD T3,MSFTM,(T1)	;GET BIT MASK
	IORM T3,PIDPBT(T2)	;RETURN THIS PAGE TO THE FREE POOL
	LOAD T2,MESPTN,(T1)	;GET PTN,,PN OF PAGE IN TRANSIT
	SETZB T1,T3		;MARK THAT IT IS TO BE DELETED
	CALL SETPT		;GO REMOVE AND DISCARD THIS PAGE
MESRT2:	MOVE T1,MSRTMH		;GET ADDRESS OF MESSAGE BLOCK
	CALL RELMES		;RELEASE THE SPACE TO THE FREE POOL
	JRST MESRT0		;LOOP BACK FOR ALL MESSAGES
;ROUTINE TO GET THE OLDEST MESSAGE FROM A PID AND DECREMENT THE COUNTS

;ACCEPTS IN T1/	PID
;	    T2/	PID HEADER POINTER
;	CALL GETMES
;RETURNS +1:	NO MORE MESSAGES
;	 +2:	SUCCESSFUL - MESSAGE REMOVED FROM LIST
;		T3/	POINTER TO MESSAGE BLOCK

GETMES:	LOAD T1,PIDRC,(T2)	;GET COUNT OF MESSAGES ON LIST
	SOSGE T1		;ANY THERE?
	RET			;NO, JUST RETURN
	STOR T1,PIDRC,(T2)	;STORE DECREMENTED COUNT
	LOAD T3,PIDOL,(T2)	;GET ADDRESS OF OLDEST MESSAGE
	LOAD T4,MESLNK,(T3)	;GET POINTER TO NEXT MESSAGE ON LIST
	STOR T4,PIDOL,(T2)	;MAKE PID POINT TO SECOND MESSAGE
	SKIPN T4		;IS THE LIST EMPTY NOW?
	STOR T4,PIDNL,(T2)	;YES, ZERO THE POINTER TO THE NEWEST
	LOAD T4,MESSJN,(T3)	;GET JOB NUMBER OF SENDER OF MESSAGE
	CAIN T4,-1		;HAS JOB LOGGED OUT ALREADY?
	RETSKP			;YES, THEN DONT DECREMENT COUNT
	LOAD T1,PIDSC,(T4)	;GET COUNT OF MESSAGES SENT
	SOJL T1,[BUG(IPCSOD)
		JRST GETMS1]
	STOR T1,PIDSC,(T4)	;PUT BACK THE UPDATED COUNT
GETMS1:	RETSKP			;GIVE OK RETURN
;ROUTINE TO GET THE PID OF INFO FOR SOME JOB

;ACCEPTS IN T1/	INDEX THAT MAPS JSB ADDRS INTO WHERE THE JSB IS MAPPED
;	CALL GTINFO
;RETURNS +1:	NO INFO FOR THIS JOB, ERROR CODE IN T1
;	 +2:	T2/	PID OF INFO

GTINFO:	STKVAR <GTINFT>
	MOVEM T1,GTINFT		;SAVE INDEX
	SKIPN T1,JBINFO(T1)	;GET PID IF ANY
	JRST GTINFP		;NONE, GET [SYSTEM]INFO
	CALL VALPID		;VALIDATE THIS PID
	 JRST [	MOVE T1,GTINFT	;GET BACK INDEX
		SETZM JBINFO(T1) ;ZERO OUT BAD PID
		JRST GTINFP]	;GO GET PUBLIC VALUE OF INFO
GTINFD:	MOVE T2,T1		;GET PID INTO T2
	MOVE T1,GTINFT		;GET BACK INDEX
	RETSKP			;AND RETURN TO CALLER

GTINFP:	MOVE T1,INFOPD		;GET PUBLIC PID OF INFO
	CALL VALPID		;VALIDATE IT
	 RETBAD (IPCF19)	;GIVE ERROR RETURN
	JRST GTINFD		;GO CLEAN UP AND RETURN OK
;ROUTINES TO LOCK AND UNLOCK THE FORK LOCKS AND OTHER LOCKS
;	ALL PIDS MUST BE RECHECKED SINCE PIDLOK IS TURNED OFF

;CALL MUST BE MADE WITH PIDLOK ON AND NOINT
;	CALL MFLOCK
;RETURNS +1:	ALWAYS - PIDLOK, FLOCK, AND NOINT ARE ALL SET

MFLOCK:	UNLOCK PIDLOK		;UNLOCK THE LOCKS
	OKINT
;**;[2928] REPLACE 2 LINES WITH 1 AT MFLOCK:+2L	TAM	29-MAR-83
	CALL GTLCKS		;[2928]
	RET			;ALL LOCKS SET AGAIN

;	CALL MFUNLK
;RETURNS +1:	ALWAYS - JOB IS NOINT AND PIDLOK IS SET, FLOCK OFF

MFUNLK:	UNLOCK PIDLOK		;UNLOCK IN THE REVERSE ORDER
	CALL FUNLK		;CLEAR FORK LOCK
	NOINT
;**;[2928] REPLACE 1 LINE AT MFUNLK:+1L	TAM	29-MAR-83
	CALL GTPIDL
	RET
;ROUTINE TO INITIALIZE THE JOB QUOTAS WHEN A JOB IS CREATED
;  THIS ROUTINE ALSO CLEARS THE SENDER'S JOB NUMBER FIELD IN ALL
;  MESSAGES THAT WERE SENT BY THE PREVIOUS OWNER OF THIS JOB NUMBER.
;  THIS PREVENTS THE NEW OWNER OF THE JOB NUMBER FROM HAVING HIS
;  SEND COUNT INCORRECTLY DECREMENTED.

;ACCEPTS IN T1/	JOB NUMBER
;	CALL PIDJBI
;RETURNS +1:	ALWAYS

PIDJBI::STKVAR <PIDJBJ,PIDJBC>
;**;[1879] Insert two lines at PIDJBI: +1L	RAS	21-MAY-81
	NOINT			;[2879]
;**;[2928] REPLACE 1 [1879] LINE AT PIDJBI:+1L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	MOVEI T2,PIDSSQ		;GET STANDARD SEND QUOTA
	STOR T2,PIDSQ,(T1)	;SET UP STANDARD QUOTAS
	MOVEI T2,PIDSPQ		;GET STANDARD PID QUOTA
	STOR T2,PIDPQ,(T1)
	LOAD T3,PIDSC,(T1)	;GET THE SEND COUNT OF LAST USER
	MOVEI T2,0		;CLEAR OTHER FIELDS
	STOR T2,PIDSC,(T1)	;SEND COUNT = 0
	STOR T2,PIDPC,(T1)	;PID COUNT = 0
;**;[1879] Change one line at PIDJBI: +9L	RAS	21-MAY-81
	JUMPE T3,PIDJBR		;[1879] IF PREVIOUS SEND COUNT WAS 0, EXIT
	MOVEM T1,PIDJBJ		;SAVE JOB NUMBER
	MOVEM T3,PIDJBC		;SAVE NUMBER OF OUTSTANDING MESSAGES
;**;[1879] Delete two lines at PIDJBI: +12L	RAS	21-MAY-81
	MOVEI T1,1		;SET UP TO FIND MESSAGES FROM THIS JOB
PIDJBL:	CALL GETPID		;GET POINTER TO PID HEADER IF ANY
	 JRST PIDJBR		;LOOKED AT ALL PIDS, GO UNLOCK AND EXIT
	CAIGE T2,SWFREE		;IS THIS A PID ON THE FREE LIST
PIDJBD:	AOJA T1,PIDJBL		;YES, INCREMENT PID INDEX AND LOOP BACK
	LOAD T3,PIDOL,(T2)	;GET POINTER TO START OF MESSAGE LIST
PIDJBM:	JUMPE T3,PIDJBD		;ANY MESSAGES ON THIS LIST?
	LOAD T4,MESSJN,(T3)	;YES, GET JOB NUMBER OF SENDER
	CAMN T4,PIDJBJ		;SAME AS OUR'S?
	JRST [	MOVEI T4,-1	;YES, CLEAR OUT THE JOB NUMBER
		STOR T4,MESSJN,(T3)
		SOSG PIDJBC	;ANY MORE MESSAGES TO BE FOUND?
		JRST PIDJBR	;NO, GO UNLOCK AND RETURN
		JRST .+1]	;YES, CONTINUE SEARCHING
	LOAD T3,MESLNK,(T3)	;GET POINTER TO THE NEXT MESSAGE ON LIST
	JRST PIDJBM		;LOOP BACK FOR ALL MESSAGES

PIDJBR:	UNLOCK PIDLOK		;UNLOCK THE LOCKS
	OKINT
	RET			;AND EXIT
;ROUTINES TO DELETE ALL PIDS BELONGING TO A FORK DURING A FORK KILL
;  OR A RESET.  JOB WIDE PIDS ARE NOT DELETED ON RESET.

;ACCEPTS IN T1/	FORK #
;	CALL PIDKFK	OR	CALL PIDRFK
;RETURNS +1:	ALWAYS

PIDKFK::TDZA T2,T2		;KILL ALL PIDS OF FORK
PIDRFK::MOVEI T2,PD%JWP		;DONT KILL JOB WIDE PIDS DURING RESET'S
	STKVAR <SAVKFK,SAVKFP,SAVKF3,SAVINF,SAVKFT>
	MOVEM T2,SAVKFT		;SAVE THE TEST BITS
	MOVEM Q3,SAVKF3		;SAVE Q3
	MOVEM T1,SAVKFK		;SAVE THE FORK BEING KILLED
	HLRZ T2,FKJOB(T1)	;GET JOB NUMBER OF FORK
	LOAD Q3,PIDPC,(T2)	;GET COUNT OF PIDS OWNED BY THIS JOB
	JUMPE Q3,PIDKFR		;IF NONE, DONT BOTHER TO DELETE ANY
	NOINT
;**;[2928] REPLACE 1 LINE AT PIDRFK:+9L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	SETZ T1,		;CLEAN UP ALL PIDS WAITED ON BY FORK
PIDKF3:	MOVE T2,SAVKFK		;GET JOB NUMBER OF THIS FORK
	HLRZ T2,FKJOB(T2)	;...
	CALL GETNPJ		;GET NEXT PID OF THIS JOB
	 JRST PIDKF4		;NO MORE PIDS FOR JOB
	LOAD T3,PIDFW,(T2)	;GET FORK WAITING ON THIS PID
	MOVEI T4,-1		;PREPARE TO INITIALIZE PIDFW
	CAMN T3,SAVKFK		;IS THIS THE FORK BEING KILLED?
	STOR T4,PIDFW,(T2)	;YES, CLEAR OUT FORK NUMBER
	JRST PIDKF3		;LOOP BACK FOR ALL PIDS OF THE JOB
PIDKF4:	SETZB Q3,T1		;INITIALIZE INDEX INTO JSB
	CALL GTINFO		;GET PID OF INFO FOR THIS JOB
	 JRST PIDKF2		;NO INFO FOR THIS JOB
	MOVEM T2,SAVINF		;SAVE PID OF INFO
PIDKF0:	MOVE T2,SAVKFK		;GET FORK NUMBER
	CALL GETNPF		;GET NEXT PID OF THIS FORK
	 JRST PIDKF1		;NO MORE PID'S
	LOAD T3,PIDFLG,(T2)	;GET FLAGS OF PID
	TDNE T3,SAVKFT		;IS THIS PID NOT TO BE KILLED?
	JRST PIDKF0		;YES, DONT COUNT IT
	CAME T1,SAVINF		;IS THIS THE PID OF INFO FOR THIS JOB
	AOJA Q3,PIDKF0		;NO, LOOK AT EACH PID OF THIS FORK
	SETZ Q3,		;YES, DONT SEND A MESSAGE TO THIS INFO
PIDKF1:	JUMPE Q3,PIDKF2		;ANY PIDS SEEN?
	ADDI Q3,2		;YES, GET LENGTH OF MESSAGE FOR INFO
	CALL IPCDEL		;SET UP A MESSAGE FOR INFO
	 TDZA Q3,Q3		;NO ROOM FOR MESSAGE
	MOVE Q3,T1		;GET ADDRESS OF MESSAGE AREA INTO Q3
PIDKF2:	MOVEI T1,0		;START AT PID INDEX 0
	;..
	;..
PIDKFL:	MOVE T2,SAVKFK		;GET FORK # AGAIN
	CALL GETNPF		;GET THE NEXT PID OF THE FORK
	 JRST PIDKFD		;ALL DONE, GO UNLOCK
	MOVEM T1,SAVKFP		;SAVE PID INDEX
	LOAD T3,PIDFLG,(T2)	;GET FLAGS OF PID
	TDNE T3,SAVKFT		;IS THIS PID TO BE DELETED?
	JRST PIDKFL		;NO, JUST LOOP BACK
	CALL DELPID		;GO DELETE THIS PID
	 BUG(NOPID)
	MOVE T1,SAVKFP		;GET BACK PID INDEX
	JUMPE Q3,PIDKFL		;ARE WE BUILDING A MESSAGE FOR INFO?
	STOR T1,MESWD0,(Q3)	;YES, STORE PID IN MESSAGE
	AOJA Q3,PIDKFL		;LOOP BACK FOR OTHER PIDS

PIDKFD:	UNLOCK PIDLOK		;CLEAN UP
	OKINT
PIDKFR:	MOVE Q3,SAVKF3		;RESTORE Q3
	RET			;AND RETURN
;ROUTINE TO SEND A MESSAGE TO QUASAR ON CLOSEING OF A SPOOLED FILE

;ACCEPTS IN T1/	JFN  (ALREADY SHIFTED BY SJFN)
;	    T2/	FBBYV
;	    T3/	FBSIZ
;	CALL SPLMES
;RETURNS +1:	ERROR - COULD NOT SEND MESSAGE
;	 +2:	SUCCESSFUL

SPLMES::SAVEQ			;SAVE ALL THE PERMANENT ACS USED
	STKVAR <SPLMSV,SPLMSZ>
	MOVEM T1,Q1		;SAVE JFN IN PERMANENT AC
	MOVEM T2,SPLMSV		;SAVE FBBYV FOR LATER
	MOVEM T3,SPLMSZ		;SAVE FBSIZ
	NOINT
;**;[2928]REPLACE 1 LINE AT SPLMES:+6L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	SKIPL T1,CTRLTT		;SET BATCH BIT IN JBFLAG
	CALL PTYGBB		;SEE IF JOB IS CONTROLLED BY BATCH
	 SETZ T1,		;NO, IT ISNT
	STOR T1,JSBAT		;STORE BIT IN FLAG WORD
	MOVEI Q3,MAXLW+SPMHDS	;CALCULATE # OF WORDS NEEDED FOR MESSAGE
	HLRZ T2,FILNEN(Q1)	;GET POINTER TO NAME STRING
	HRRZ T1,0(T2)		;GET LENGTH OF STRING
	ADD Q3,T1		;UPDATE COUNT OF WORDS NEEDED
	HRRZ T2,FILNEN(Q1)	;GET POINTER TO EXTENSION STRING
	HRRZ T1,0(T2)		;GET LENGTH OF EXT STRING
	ADD Q3,T1		;UPDATE COUNTER
	MOVE T1,SPIDTB+.SPQSR	;GET PID OF QUASAR
	CALL VALPID		;MAKE SURE IT IS STILL VALID
	 JRST [	SETZM SPIDTB+.SPQSR ;NOT VALID, ZERO ENTRY IN TABLE
		JRST IPCMSR]	;GIVE OK RETURN TO AVOID BUG CHECK
	CALL IPCMES		;GO PUT MESSAGE ONTO QUASAR'S QUEUE
	 JRST IPCMSE		;COULD NOT SEND MESSAGE
	MOVEI T2,.IPCSU		;GET FUNCTION CODE OF SPOOLED FILE CLOSE
	STOR T2,MESWD0,(T1)	;PUT IT IN MESSAGE FOR QUASAR TO SEE
	HRRZI T1,MESWDI(T1)	;GET POINTER TO ACTUAL MESSAGE
	MOVE T2,JOBNO		;GET JOB NUMBER
	HRLI T2,SPMHDS		;GET HEADER SIZE
	PUSH T1,T2		;STORE HEADER SIZE ,, JOB NUMBER
	HLLZ T3,JBFLAG		;GET FLAGS TO BE SENT
	PUSH T1,T3		;STORE FLAGS ,, STATION # (0 FOR NOW)
	HRRZS T2
	PUSH T1,JOBPNM(T2)	;SAVE PROGRAM NAME
	PUSH T1,SPLMSV		;STORE FBBYV
	PUSH T1,SPLMSZ		;AND FBSIZ
	HRLI T1,(POINT 7,0,35)	;MAKE A BYTE POINTER
	LOAD T2,FILUC,(Q1)	;GET UNIQUE CODE OF STR 
	HRLS T2			;BUILD A DIR NUMBER
	HRR T2,FILDDN(Q1)	;ADD IN THE DIRECTORY NUMBER
	DIRST			;PUT DIRECTORY NAME INTO STRING
	 ERJMP [BUG(NODIR1)
		JRST .+1]
	;..
	;..
	HLRZ T2,FILNEN(Q1)	;NOW ADD ON THE NAME
	HRLI T2,(POINT 7,0,35)	;MAKE A STRING POINTER
	SETZ T3,
	SOUT			;NAME FIELD
	MOVEI T2,"."		;PUT IN PUNCTUATION
	IDPB T2,T1		;...
	HRRZ T2,FILNEN(Q1)	;NOW GET POINTER TO EXTENSION
	HRLI T2,(POINT 7,0,35)
	SOUT			;PUT EXTENSION INTO STRING
	MOVEI T2,PNCVER		;NOW PUT IN VERSION NUMBER
	IDPB T2,T1		;PUT IN PUNCTUATION
	HRRZ T2,FILVER(Q1)	;GET VERSION NUMBER
	MOVEI T3,12		;MAKE IT DECIMAL
	NOUT
	 BUG(NOUTF2)
IPCMSR:	AOS 0(P)		;SET UP FOR SUCCESSFUL RETURN
IPCMSE:	UNLOCK PIDLOK		;FREE UP DATA BASE
	OKINT
	RET			;AND EXIT


;ROUTINE TO SEND A MESSAGE TO PID ON LOGOUT/LOGIN

;	ACCEPTS:
;	T1/ ADDRESS OF PID
;	CALL LOGOMS
;	CALL LOGIMS
;RETURNS +1:	COULD NOT SEND MESSAGE
;	 +2:	SUCCESSFUL

LOGIMS::SKIPA T2,[.IPCLI]	;LOGIN MESSAGE CODE
LOGOMS::MOVEI T2,.IPCSL		;LOGOUT MESSAGE CODE
	NOINT
;**;[2928]REPLACE 1 LINE AT LOGOMS:+2L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	SAVEQ			;PRESERVE Q1-Q3
	STKVAR <LOGMSC,LOGPID>
	MOVEM T1,LOGPID		;SAVE PID
	MOVEM T2,LOGMSC		;SAVE THE MESSAGE CODE
	SKIPL T1,CTRLTT		;SET BATCH BIT IN JBFLAG
	CALL PTYGBB		;SEE IF JOB IS CONTROLLED BY BATCH
	 SETZ T1,		;NO, IT ISNT
	STOR T1,JSBAT		;STORE BIT IN FLAG WORD
	MOVEI Q3,LOGMSZ		;GET A MESSAGE FOR LOGOUT
	MOVE T1,@LOGPID		;GET PID OF PID
	CALL VALPID		;MAKE SURE IT IS STILL VALID
	 JRST [	SETZM @LOGPID	;IT ISNT VALID, CLEAR TABLE
		JRST IPCMSE]	;CANNOT SEND MESSAGE
	CALL IPCMES		;GET MESSAGE PUT ONTO QUASAR'S QUEUE
	 JRST IPCMSE		;FAILED
	MOVE T2,LOGMSC		;GET THE MESSAGE CODE
	STOR T2,MESWD0,(T1)	;PUT IT IN THE MESSAGE
	MOVEI T1,MESWDI(T1)	;GET ACTUAL ADR OF MESSAGE AREA
	MOVSI T2,LGMHDS		;GET HEADER SIZE
	HRR T2,JOBNO		;GET JOB NUMBER OF JOB LOGGING OUT
	PUSH T1,T2		;STORE IT IN MESSAGE
	HLLZ T3,JBFLAG		;GET SPOOL FLAGS ,, STATION #
	PUSH T1,T3		;STORE IT IN MESSAGE
	JRST IPCMSR		;AND EXIT


;ROUTINE TO SEND A MSG TO A JOB'S CREATOR ON LOGOUT.

;	MOVE T1,PID-OF-CREATOR
;	CALL LOGOMO
;RETURNS +1:	COULD NOT SEND MESSAGE
;	 +2:	SUCCESSFUL

LOGOMO::NOINT
;**;[2928] REPLACE 1 LINE AT LOGOMO:+1L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	SAVEQ			;SOME AC'S TO WORK WITH
	MOVEI Q3,LG2MSZ		;SIZE OF MESSAGE NEEDED
	CALL VALPID		;SEE IF PID IN T1 IS STILL GOOD
	 JRST IPCMSR		;NO. GIVE SUCCESS RETURN
	CALL IPCMES		;OK, PUT THE MSG ON CREATORS QUEUE
	 JRST IPCMSE		;COULDN'T. FAIL RETURN.
	MOVEI T2,.IPCLO		;MSG NOT YET SENT. PUT DATA IN IT.
	STOR T2,MESWD0,(T1)	;DESCRIPTOR OF MSG
	MOVEI T1,MESWDI(T1)	;SET TO PUSH DATA THRU T1
	MOVSI T2,LG2MHS		;ALL BUT HEADER MAKES SIZE FOR USER
	HRR T2,JOBNO		;IDENTITY OF LOGGING-OUT JOB
	PUSH T1,T2		;PUT THOSE IN MESSAGE
	HRRZS T2		; Just job # for later (index JOBRT)
	HLLZ T3,JBFLAG		;SPOOLED FLAGS, REASON FOR LOGOUT.
	PUSH T1,T3		;INTO MESSAGE
	MOVE T3,TODCLK		;MY CONSOLE TIME
	SUB T3,CONSTO		; IS NOW MINUS WHEN I LOGGED IN
	PUSH T1,T3		; (PLUS OR MINUS CACCT)
	PUSH T1,JOBRT(T2)	;MY JOB RUN TIME
	PUSH T1,CTRLTT		;MY TERMINAL
	PUSH T1,JSLOJB		;JOB WHO LOGGED ME OUT, IF ANY.
	PUSH T1,[0]		;SPECED AS REASONS FOR ERROR LOGOUT
	PUSH T1,LSTERR		;LAST JSYS ERROR CODE
	JRST IPCMSR		;SEND THIS MESSAGE AND RETURN.

; Routine to send ARCSYS a message for various reasons
; Function code in AC1 RH, reason modifier in AC1 LH
; AC2 is offset to FDB of file in question
; Returns: +1 failed	T1/ Error code
;	   +2 msg sent

;**;[7207] CLEANUP CODE IN ARCMSG:	DSW	12/06/85
ARCMSG::NOINT
;**;[2928] REPLACE 1 LINE AT ARCMSG:+1L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
;**;[7207] REPLACE 1 LINE AT ARCMSG:+2.L	DSW	12/06/85
	SAVEPQ			;[7207] SAVE ALL BUT T'S
	STKVAR <FNCD,ARFDB>
	MOVEM T1,FNCD		; Save fnc,,reason
	MOVEM T2,ARFDB		; Offset to FDB of file in question
ARCMSA:	MOVEI Q3,ARMSSZ		; Size our message will be
	MOVE T1,SPIDTB+.SPQSR	; Get PID to use
	CALL VALPID		; Still ok?
	 JRST ARCMS1		; Fails, take a way out
	MOVX P1,IP%INT		; Flag internal call
	CALL IPCMES		; Put message on Quasar's Q
;**;[7207] REPLACE 1 LINE AT ARCMSA:+6.L	DSW	12/06/85
	 JRST IPCMSE		;[7207]Couldn't, fail with IPCMES's error code
	ADDI T1,MESWDI		; Point to data area of msg
	PUSH P,T1		; Save ptr
	XMOVEI T3,10(T1)	; Where account goes in the msg
	XMOVEI T2,ACCTSR	; Current job account
	MOVE T1,ACCTSL		; Size of move
	CALL XBLTA		; Copy the account
	POP P,T1		; Recover blk addr
	MOVE Q1,ARFDB		; Get FDB offset
	MOVE Q2,DIRORA		; Get directory addr
	MOVEI T2,-1(T1)		; Set up to PUSH thru T2
	PUSH T2,[ARMSSZ,,.IPCSR] ; Length,,msg type
	PUSH T2,FNCD		; Put in function code & modifier
	HRRZ T1,.FBPRT(Q1)	; Get file's protection
	PUSH T2,T1		; Store that
	PUSH T2,.FBTP1(Q1)	; Tape #1 ID
	PUSH T2,.FBSS1(Q1)	; Tape #1 TSN,,TFN
	PUSH T2,.FBTP2(Q1)	; Tape #2 ID
	PUSH T2,.FBSS2(Q1)	; Tape #2 TSN,,TFN
	PUSH T2,.FBTDT(Q1)	; Tape write time & date

; Now we need to do a JFNS into the blk, however, the directory may be
; locked (if EXPUNGE case, is for sure). So..., we'll do our own,
; considerably simpler JFNS here; However, we are forced to use
; directory information

	ADDI T2,10		; Skip over account string
	HRLI T2,(<POINT 7,0,35>) ; Need to cause IDPB to go to next wrd
	LOAD T4,CURSTR		; Structure no. for this directory
	ADDI T4,DVXST0
	MOVE T4,DEVNAM(T4)	; Get mounted structure name
ARCSTR:	SETZ T3,		; Loop to convert str. name to ASCII
	LSHC T3,6		; Sixbit char. in T3
	JUMPE T3,ARDIRS		; Done on null
	ADDI T3,40		; Convert char. to ASCII
	IDPB T3,T2		; Put the character into the str name
	JRST ARCSTR		; Back for next char.
ARDIRS:	MOVEI T1,":"
	IDPB T1,T2		; Punctuation
	MOVEI T1,"<"		; Start directory
	IDPB T1,T2
	LOAD T1,DRNAM,(Q2)	; Get directory name ptr
	MOVEI T3,"."		;DON'T QUOTE PERIODS WITHIN DIR NAME
	CALL ARCPY
	MOVEI T1,">"		; End directory name
	IDPB T1,T2
	LOAD T1,FBNAM,(Q1)	; Get name ptr
	SETZ T3,
	CALL ARCPY		; Put it in blk too
	MOVEI T1,"."		; Punct
	IDPB T1,T2
	LOAD T1,FBEXT,(Q1)	; Extention blk
	SETZ T3,
	CALL ARCPY
	MOVEI T1,PNCVER		; Punc before version
	IDPB T1,T2
	LOAD T1,FBGEN,(Q1)	; Get file generation
	EXCH T1,T2
	MOVEI T3,^D10
	NOUT
	 BUG(ARCVER)
	SETZ T2,
	IDPB T2,T1		; End it
	MOVEI T2,1(T1)		; Point to next word
	CALLRET IPCMSR		; Send this message and return
;ARCPY - COPY STRING FROM DIRECTORY TO OUTPUT STRING WITH QUOTING
; T1/ OFFSET INTO DIRECTORY OF WORD BEFORE SOURCE STRING
; T2/ OUTPUT BYTE POINTER
; T3/ CHARACTER TO BE EXEMPTED FROM QUOTING, OR 0 IF NONE
;RETURNS +1: ALWYAS, T2/ UPDATED OUTPUT POINER

ARCPY:	STKVAR <ARCPOP,ARCPEC>
	MOVEM T2,ARCPOP		;SAVE OUTPUT POINTER
	MOVEM T3,ARCPEC		;SAVE CHARACTER EXEMPTED FROM QUOTING
	ADD T1,[POINT 7,0(Q2),35] ; Use dirora offset & make valid ptr
ARCPY1:	ILDB T4,T1		; Get a char
	JUMPE T4,[MOVE T2,ARCPOP ;NULL HIT, RETRIEVE OUTPUT POINTER
		RET]
	MOVE T2,T4		;COPY CHARACTER FOR DIVISION
	IDIVI T2,^D36/CCSIZE	; CCSIZE and CPTAB and char type
	LDB T3,CPTAB(T3)	;  are found in GTJFN.MAC
	JUMPE T3,ARCPY2		; 0 class is normal alphas
	CAME T4,ARCPEC		;CHARACTER EXEMPTED FROM QUOTING?
	CAIN T3,30		; Minus is not special
	JRST ARCPY2
	CAIL T3,21
	CAILE T3,24
	JRST [	MOVEI T3,.CHCNV	; Special quote char
		IDPB T3,ARCPOP	; Insert a quote
		JRST .+1]
ARCPY2:	IDPB T4,ARCPOP		;DEPOSIT CHARACTER FROM INPUT STRING
	JRST ARCPY1		; Loop over entire string

;**;[7207] CLEANUP CODE AT ARCMS1:	DSW	12/06/85
ARCMS1:	BUG(NOARCS)
	SETZM SPIDTB+.SPQSR
;**;[7207] REPLACE 11 LINES WITH 2 AT ARCMS1:+2.L	DSW	12/06/85
	MOVX T1,ARCX13		;[7207] INDICATE FAILURE
	JRST IPCMSE		;[7207] COULDN'T SEND MESSAGE
;ROUTINE CALLED FROM TAPE TO SEND A MESSAGE.
;	T1/ FUNCTION SUBCODE
;	T2/ LENGTH OF ADDITIONAL DATA
;	T3/ ADDRESS OF ADDITIONAL DATA

;RETURNS:	+1 FAILED
;		+2 SENT

IPCMTM::ASUBR <SUBCOD,ARGLEN,ARGADR,UNITNO>
	SAVEQ
	MOVEI Q3,3(T2)		;GET MESSAGE SPACE
	SKIPN T1,SPIDTB+.SPMDA	;HAVE A PID?
	RET			;NO. BOO AND HIS
	CALL ALOMDM		;YES. GET SPACE
	 JRST IPCMSE		;FAILED
	MOVEI T2,.IPCTR		;TAPE REQUEST
	STOR T2,MESWD0,(T1)	;SAVE FUNCTION
	MOVE T2,SUBCOD		;GET SUBFUNCTION
	MOVEM T2,MESWDI+1(T1)	;STASH IT AS WELL
	MOVE T2,UNITNO		;GET UNIT NUMBER
	MOVEM T2,MESWDI+2(T1)	;SAVE IT
	MOVE T3,ARGADR		;GET ADDRESS OF ADDITIONAL ITEMS
	MOVE T2,T1		;COPY ADDRESS
	ADDI T2,2		;SKIP THREE ARGS SO FAR STORED
IPCMT0:	SOSGE ARGLEN		;MORE ARGS?
	JRST IPCMSR		;NO. ALL DONE
	MOVE Q2,0(T3)		;GET NEXT ITEM
	MOVEM Q2,MESWDI+1(T2)	;SAVE IT
	ADDI T2,1		;NEXT ITEM
	AOJA T3,IPCMT0		;AND DO THEM ALL
;ALCMES - ROUTINE TO SET UP A MESSAGE AREA FOR AN ALLOCATE MESSAGE
;  THIS MESSAGE GETS SENT WHENEVER AN ALLOCATED DEVICE IS RELEASED

;ACCEPTS IN T1/ DEVICE DESIGNATOR
;	CALL ALCMES
;RETURNS +1:	NO MESSAGE CAN BE SENT
;	 +2: MESSAGE SENT

ALCMES::SAVEQ			;SAVE THE PERMANENT ACS
	MOVE Q2,T1		;SAVE DEVICE DESIGNATOR
	MOVEI Q3,2		;GET SIZE OF MESSAGE
	SKIPN T1,SPIDTB+.SPMDA	;GET PID OF ALLOCATOR
	RET			;NO PID CAN'T SEND
	CALL ALOMDM		;ALLOCATE A BLOCK
	JRST IPCMSE		;CAN'T DO IT
	MOVEI T2,.IPCSA		;GET FUNCTION CODE
	STOR T2,MESWD0,(T1)	;STORE IT IN MESSAGE
	MOVEM Q2,MESWDI+1(T1)	;SET UP POINTER TO MESSAGE AREA
	JRST IPCMSR		;GO TAKE SUCCESS RETURN


; ROUTINE TO SEND A MESSAGE TO THE ALLOCATOR WHEN MOUNT COUNT
; OF A STRUCTURE IS DECREMENTED
;
; ACCEPTS IN P6/ POINTER FOR TRVAR
;		CALL DISMES
; RETURNS: +1	 FAILED, MESSAGE NOT SENT
;	   +2	SUCCESS, MESSAGE WAS SENT

DISMES::SAVEQ			;PRESERVE THE Q-AC'S
	MOVE Q2,1(P6)		;GET HEADER WORD
	HRRZ Q3,Q2		;GET SIZE OF MESSAGE
	AOS Q3
	SKIPN T1,SPIDTB+.SPMDA	;IS THERE A PID FOR THE DEVICE ALLOCATOR ?
	JRST RSKP		;NO, RETURN SUCCESS ANYWAY...
	CALL ALOMDM		;ALLOCATE BLOCK
	 JRST IPCMSE		;FAILED
	HLRZ T2,Q2		;GET FUNCTION CODE
	STOR T2,MESWD0,(T1)	;ADD FUNCTION CODE TO MESSAGE
	MOVEI T1,MESWDI+1(T1)	;GET ADDRESS OF DATA PORTION OF MESSAGE
	MOVEM Q3,(T1)		;STORE LENGTH
	AOS T1			;GET NEXT DATA WORD
	MOVEI T2,-3(Q3)		;SET UP LAST WORD FOR TRANSFER
	ADD T2,T1
	HRLI T1,2(P6)		;SET UP BLT POINTER
	BLT T1,@T2		;MOVE DATA
	JRST IPCMSR		;RETURN SUCCESS...

;
;MTAMES - ROUTINE TO SEND A MESSAGE TO THE DEVICE ALLOCATIOR
;
;ACCEPTS IN T1/MESSAGE TO BE SENT
;	CALL ALCMES
;RETURNS +1: NO MESSAGE CAN BE SENT
;	 +2: MESSAGE SENT
;

MTAMES::SAVEQ			;SAVE REGISTERS
	MOVE Q2,T1		;SAVE CALLING ARGUMENTS
	MOVE Q1,T2
	MOVE Q3,2		;SIZE OF BLOCK
	SKIPN T1,SPIDTB+.SPMDA	;IS THERE A PID FOR THE DEVICE ALLOCATOR?
	RET			;NO JUST RETURN
	CALL ALOMDM		;ALLOCATE A BLOCK
	JRST IPCMSE		;NO CAN'T ALLOCATE A MESSAGE
	STOR Q1,MESWD0,(T1)	;STORE FUNCTION CODE
	MOVEM Q2,MESWDI+1(T1)	;STORE DATA
	JRST IPCMSR		;GO TAKE SUCCESS RETURN

ALOMDM:	NOINT			;LOCK UP IPCF DATA BASE
;**;[2928]CHANGE 1 LINE AT ALOMDM:+1L	TAM	29-MAR-83
	CALL GTPIDL		;[2928]
	CALL VALPID		;VALIDATE IT
	 JRST [	SETZM SPIDTB+.SPMDA ;NOT A VALID PID, ZERO ENRTY IN TABL
		RET]		;AND GIVE NON-SKIP RETURN
	CALL IPCMES		;GO GET MESSAGE
	 JRST [	BUG(NOALCM,<<T1,D>>)
		RET]		;GO GIVE NON-SKIP RETURN
	RETSKP			;SUCCESS RETURN
;ROUTINE TO SET UP A MESSAGE FOR INFO WHEN DELETING A PID

;ACCEPTS IN Q3/	LENGTH OF MESSAGE DATA AREA
;	CALL IPCDEL
;RETURNS +1:	NO ROOM FOR MESSAGE
;	 +2:	T1/	POINTER TO FIRST DATA WORD INDEXED BY MESWD0

IPCDEL:	SETZ T1,		;GET PID OF INFO FOR THIS JOB
	CALL GTINFO		;...
	 RET			;NO INFO FOR THIS JOB
	MOVE T1,T2		;GET PID OF INFO
	CALL IPCMES		;SEND THE MESSAGE TO INFO
	 RET			;COULD NOT SEND FOR SOME REASON
	MOVEI T2,.IPCSS		;GET FUNCTION CODE
	STOR T2,MESWD0,(T1)	;PUT IT AS FIRST WORD OF MESSAGE
	ADDI T1,2		;MAKE POINTER POINT TO FIRST PID
	RETSKP


;ROUTINE TO SEND A MESSAGE WHEN A PID IS DELETED

;ACCEPTS IN T1/	PID TO SEND TO
;	    T2/	DELETED PID
;	    Q3/	LENGTH OF MESSAGE DATA AREA
;	CALL IPCPKM
;RETURNS +1:	FAILED
;	 +2:	MESSAGE IS SENT

IPCPKM:	ASUBR <IPCPKP,IPCPKD>
	CALL VALPID		;VALIDATE THE PID
	 RET
	CALL IPCMES		;GET THE MESSAGE AREA
	 RETBAD
	MOVEI T2,.IPCKP		;GET FUNCTION CODE
	STOR T2,MESWD0,(T1)	;STORE THE FUNCTION CODE
	MOVE T2,IPCPKD		;GET THE DELETED PID
	MOVEM T2,MESWDI+1(T1)	;SAVE THE PID THAT IS BEING DELETED
	RETSKP
;ROUTINE TO SEND MESSAGES FROM IPCC TO A PID

;ACCEPTS IN T1/	PID TO SEND TO
;	    Q3/	LENGTH OF MESSAGE (NOT INCLUDING HEADER)
;	CALL IPCMES
;RETURNS +1:	COULD NOT SEND TO THAT PID FOR SOME REASON
;	 +2:	SUCCESSFUL - T1/  ADDRESS OF MESSAGE

IPCMES:	STKVAR <IPCMSP>
	MOVEM P1,IPCMSP		;SAVE THE PERMANENT ACS
	SETZ T2,		; Get the message space
	TXZ P1,IP%CFV		; Not page mode
	CALL MESTOR		;GO PUT MESSAGE ON PID QUEUE
	 SKIPA P1,IPCMSP	;RESTORE PERMANENT AC
	SKIPA P1,IPCMSP		;DITTO
	 RETBAD ()		;AN ERROR OCCURED ON SEND
	MOVEI T2,IPCCFL		;GET FLAGS FOR INFO TO SEE
	MOVEI T3,-1		;JOB NUMBER -1 SO SEND COUNT DOESN'T GET DECREMENTED
	CALL MSHEAD		;FILL IN MESSAGE HEADER
	RETSKP			;GIVE SUCCESSFUL RETURN
;ROUTINE TO INITIALIZE THE FREE SPACE AND THE PID FREE LIST

;	CALL PIDINI
;RETURNS +1:	ALWAYS

PIDINI::STKVAR <PIDINX>
	SETZM PIDMXP		;INIT # OF PAGES IN TRANSIT ALLOWED
	SETOM PIDPBT		;INITIALIZE BIT TABLE
	MOVE T1,[PIDPBT,,PIDPBT+1]
	BLT T1,PIDPBT+PIDPBL-1	;MAKE ALL PAGES AVAILABLE (SET TO 1)
	MOVSI T1,-PIDFTL	;INITIALIZE FORK TABLE TO 0
	SETZM PIDFTB(T1)
	AOBJN T1,.-1		;LOOP BACK TIL ALL ZERO
	SKIPE JOBNO		;IS THIS JOB ZERO?
	BUG(IPCJB0)
	MOVSI T4,-PIDFTL	;SET UP TO CREATE FORKS
PIDIN1:	MOVEM T4,PIDINX		;SAVE COUNTER AND INDEX VALUE
	SETZB T1,T2		;CREATE A FORK
	CFORK			;UNDER JOB 0
	 JRST PIDINB		;CANNOT CREATE A FORK, GO BUGCHK
	HRLZS T1		;NOW GET PTN.PN OF THIS FORK
	CALL FKHPTN		;...
	  JRST PIDINB		;FAILED
	MOVE T4,PIDINX		;GET BACK INDEX
	MOVEM T1,PIDFTB(T4)	;STORE PTN IN FORK TABLE
	MOVEI T2,^D512		;UPDATE MAX PAGES ALLOWED
	ADDM T2,PIDMXP		; FOR IN-TRANSIT PAGES
	AOBJN T4,PIDIN1		;LOOP BACK TIL ALL FORKS CREATED
PIDIN2:	SETZM INFOPV		;INITIALIZE PUBLIC VALUE OF SYSTEM INFO
	SETZM NXTPID		;INITIALIZE UNIQUE NUMBER LOCATION
	MOVEI T1,SWFREE		;CHECK IF PIDS AND FREE POOL OVERLAP
	CAIGE T1,MAXPID		;OTHERWISE IPCF WONT WORK
	BUG(IPCOVL)
	MOVE T1,[SWFREE,,SWFREE+1]
	SETZM SWFREE		;ZERO THE FREE POOL
	BLT T1,SWFREE+SWFREL-1	;...
	MOVEI T1,SWFREE		;GET ADR OF FREE POOL
	HRLOM T1,SWPFRE		;INITIALIZE POINTER TO FREE BLOCK
	MOVEI T1,SWFREL		;GET LENGTH OF FREE AREA
	HRRZM T1,SWFREE		;MAKE IT ONE LARGE BLOCK
	MOVEM T1,SWPFRE+2	;STORE IN SPACE COUNTER
	SETOM SWPFRE+1		;INITIALIZE LOCK ON FREE STORE
	MOVE T1,[XWD SWFREE+SWFREL,SWFREE]
	MOVEM T1,SWPFRE+4	;SET UP TOP AND BOTTOM POINTERS
	MOVEI T1,SWOPTL		;GET OPTIMUM LENGTH OF MESSAGES
	MOVEM T1,SWPFRE+3	;SAVE IN HEADER BLOCK
	;..
	;..
	SETZM PDFKTB		;INITIALIZE WAKE UP TABLE
	MOVE T1,[PDFKTB,,PDFKTB+1]
	MOVEI T2,PDFKTL
	CAILE T2,1		;DONT BLT IF ONLY ONE WORD TO BE ZEROED
	BLT T1,PDFKTB-1+PDFKTL
	MOVSI T1,-PIDTBS	;GET LENGTH OF PIDTBL
	MOVE T2,[XWD 2,3]
PIDINL:	MOVEM T2,PIDTBL(T1)	;SET UP PID FREE LIST
	ADD T2,BHC+2		;ADD 2,,2
	AOBJN T1,PIDINL		;LOOP FOR AWHOLE PID TABLE
	MOVEI T1,1		;START PID TABLE FREE LIST AT 1
	MOVEM T1,PIDLST		;MAKE FREE LIST START AT PID 1
;**;[1839] Replace one line at PIDINL: +5L	JGZ	1-APR-81
	MOVEI T1,MAXPID		;[1839] FREE LIST IS TERMINATED
	SETZ T2,		;[1839]  WITH A ZERO
	CALL PUTPID		;[1839] SO DO IT
	 NOP			;[1839]
	SETOM PIDLOK		;INITIALIZE LOCK
	RET			;AND EXIT

PIDINB:	BUG(IPCFRK)
	JRST PIDIN2		;CONTINUE ON

	TNXEND
	END