Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 7/monitor/ipcf.mac
There are 57 other files named ipcf.mac in the archive. Click here to see a list.
; Edit= 8841 to IPCF.MAC on 6-May-88 by RASPUZZI (TCO 7.1283)
;Add hooks for GTDOM% JSYS for non-source sites. Also, make paged mode IPCF
;transfers work from monitor mode.
; UPD ID= 8528, RIP:<7.MONITOR>IPCF.MAC.10,   9-Feb-88 16:15:20 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8416, RIP:<7.MONITOR>IPCF.MAC.9,   4-Feb-88 12:12:57 by GSCOTT
;TCO 7.1210 - Set NOALCM normally not dumpable.
; UPD ID= 8401, RIP:<7.MONITOR>IPCF.MAC.8,   2-Feb-88 15:03:13 by RASPUZZI
;TCO 7.1206 - Make a note in DISMES that it depends on a TRVAR in MSTR.
; UPD ID= 179, RIP:<7.MONITOR>IPCF.MAC.7,  21-Oct-87 17:03:27 by RASPUZZI
;TCO 7.1076 - Note that PID tables are also in CLUPAR
; UPD ID= 93, RIP:<7.MONITOR>IPCF.MAC.6,  28-Aug-87 10:42:20 by RASPUZZI
;TCO 7.1045 - Prevent ILMNRFs by making the monitor execute a LDB
;instruction in section 1.
; UPD ID= 79, RIP:<7.MONITOR>IPCF.MAC.5,  12-Aug-87 21:27:43 by RASPUZZI
;Yet some more of TCO 7.1034 - Change the LOKK/UNLOKK macros such that
;they will run in section 1 (use S1XCT).
; UPD ID= 69, RIP:<7.MONITOR>IPCF.MAC.4,  12-Aug-87 12:32:41 by RASPUZZI
;More of TCO 7.1034 - Change XCALLs to CALLXs when already in section 6!
; UPD ID= 64, RIP:<7.MONITOR>IPCF.MAC.3,  10-Aug-87 14:12:49 by RASPUZZI
;TCO 7.1034 - Move IPCF out of section 0/1. Make it run in XCDSEC. This
;             is done to gain back some 0/1 space.
; *** Edit 7332 to IPCF.MAC by JROSSELL on 14-Jul-86, for SPR #21052
; Change routine DISMES to not overwrite the function code of IPCF messages to
; MOUNTR.
; *** Edit 7313 to IPCF.MAC by LOMARTIRE on 6-Jun-86
; Return global not local job number in IPCF logout packet in LOGOMO 
; *** Edit 7207 to IPCF.MAC by WAGNER on 9-Dec-85
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs. 
; UPD ID= 2230, SNARK:<6.1.MONITOR>IPCF.MAC.33,  17-Jun-85 15:45:23 by MOSER
;TCO 6.1.1454 - REMOVE MTAMES
; UPD ID= 2085, SNARK:<6.1.MONITOR>IPCF.MAC.32,   3-Jun-85 14:44:32 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1899, SNARK:<6.1.MONITOR>IPCF.MAC.31,   4-May-85 16:07:23 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1882, SNARK:<6.1.MONITOR>IPCF.MAC.30,   4-May-85 14:00:41 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1719, SNARK:<6.1.MONITOR>IPCF.MAC.29,   6-Apr-85 11:03:06 by LEACHE
;Fix mispelling of BUG.
; UPD ID= 1713, SNARK:<6.1.MONITOR>IPCF.MAC.28,   5-Apr-85 14:02:32 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1604, SNARK:<6.1.MONITOR>IPCF.MAC.27,   7-Mar-85 19:14:55 by PRATT
;TCO 6.1.1242 - Fix check for .IPCCG and typo for IP%MON in VALARG routine
; UPD ID= 4933, SNARK:<6.MONITOR>IPCF.MAC.26,  15-Oct-84 13:02:59 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4742, SNARK:<6.MONITOR>IPCF.MAC.25,  24-Aug-84 09:43:42 by PAETZOLD
;TCO 6.2191 - Change unsafe SETJSB calls to MAPJSB.
; UPD ID= 4526, SNARK:<6.MONITOR>IPCF.MAC.24,  13-Jul-84 20:21:46 by PURRETTA
;Update copyright notice
; UPD ID= 4387, SNARK:<6.MONITOR>IPCF.MAC.23,  26-Jun-84 12:38:24 by SHTIL
;Use  a global byte pointer for ARCPY
; UPD ID= 4237, SNARK:<6.MONITOR>IPCF.MAC.22,  21-May-84 16:34:00 by MCLEAN
;FIX VALARG TO PERMIT LARGER PAGE NUMBERS (SECTIONS)
; UPD ID= 3800, SNARK:<6.MONITOR>IPCF.MAC.21,  29-Feb-84 01:43:18 by TGRADY
;Implement Global Job Numbers.
; - In MUTCRE, Assume all job numbers are global, and convert them to locals
;   before attempting to use them.  -1 means use GBLJNO and convert it.
; - In MUTFOJ, convert local job index to Global Job number before returning
;   it to the user.
; - In SPLMES, use GBLJNO to build message, but use JOBNO for index into job
;   tables.
; - In LOGIMS/LOGOMS, use Global job number in RH of message header
; - Samething in LOGOMO.
; UPD ID= 3766, SNARK:<6.MONITOR>IPCF.MAC.20,  27-Feb-84 10:02:17 by PRATT
;TCO 6.1966 - Check IP%MON and PCU in VALARG
; UPD ID= 3344, SNARK:<6.MONITOR>IPCF.MAC.19,  19-Dec-83 14:57:08 by LEACHE
;TCO 6.1641 Change ARCMSG to use extended freespace
; UPD ID= 3031, SNARK:<6.MONITOR>IPCF.MAC.18,  12-Oct-83 08:19:12 by MILLER
;TCO 6.1826. Return IPCF36 when appropriate
; UPD ID= 3030, SNARK:<6.MONITOR>IPCF.MAC.17,  11-Oct-83 13:28:45 by MILLER
;Once more on TCO 6.1824
; UPD ID= 3029, SNARK:<6.MONITOR>IPCF.MAC.16,  11-Oct-83 10:30:13 by MILLER
;TCO 6.1824. Rework use of PID ID field
; UPD ID= 2861, SNARK:<6.MONITOR>IPCF.MAC.15,  23-Aug-83 15:08:23 by LOMARTIRE
;TCO 6.1692 - Change macro name from LCKINI to INILCK so routine is usable
; UPD ID= 2835, SNARK:<6.MONITOR>IPCF.MAC.14,  16-Aug-83 17:26:16 by LEACHE
;More of previous
; UPD ID= 2834, SNARK:<6.MONITOR>IPCF.MAC.13,  16-Aug-83 17:09:04 by LEACHE
;Change invocations of .P0xxx definitions
; UPD ID= 2833, SNARK:<6.MONITOR>IPCF.MAC.12,  16-Aug-83 16:48:52 by LEACHE
;TCO 6.1641 - Change local BP's to 1-word globals
; UPD ID= 2831, SNARK:<6.MONITOR>IPCF.MAC.11,  15-Aug-83 19:52:31 by LEACHE
;More of previous
; UPD ID= 2795, SNARK:<6.MONITOR>IPCF.MAC.10,   4-Aug-83 00:29:46 by LEACHE
;TCO 6.1641 Move swappable freespace out of section zero
; UPD ID= 2600, SNARK:<6.MONITOR>IPCF.MAC.9,  20-Jun-83 15:07:57 by HALL
;TCO 6.1689 - Move fork tables to extended section
;	Reference FKJOB via DEFSTR
; UPD ID= 1547, SNARK:<6.MONITOR>IPCF.MAC.8,  21-Dec-82 08:07:53 by MOSER
;TCO 6.1409 - PREVENT FLKTIM-FLKNS AND SOME LOST PIDS TOO
; UPD ID= 1498, SNARK:<6.MONITOR>IPCF.MAC.7,   1-Dec-82 12:05:10 by MOSER
;TCO 6.1207 - CORRECT CHECK FOR IPCF11 ERROR
; UPD ID= 1441, SNARK:<6.MONITOR>IPCF.MAC.6,  14-Nov-82 14:04:27 by COBB
;TCO 5.1.1106 - Save T1 and T2 before calls to WAKFRK, prevents ILMNRFs
; UPD ID= 845, SNARK:<6.MONITOR>IPCF.MAC.5,   6-Jun-82 13:27:00 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 748, SNARK:<6.MONITOR>IPCF.MAC.4,  14-May-82 16:52:44 by MILLER
;TCO 6.1136. Make page mode send work in the monitor (for QUEUE%)
; UPD ID= 303, SNARK:<6.MONITOR>IPCF.MAC.3,  15-Jan-82 15:18:36 by GRANT
;TCO 5.1679 - Create GTPIDL routine to use for obtaining the PID lock
;<6.MONITOR>IPCF.MAC.2, 16-Oct-81 18:02:41, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 25, SNARK:<5.MONITOR>IPCF.MAC.11,  13-Jul-81 13:02:42 by GRANT
;TCO 5.1409 - Fix the locking of the fork lock and the PID lock in MRECV JSYS
; UPD ID= 2198, SNARK:<5.MONITOR>IPCF.MAC.10,  14-Jun-81 10:54:11 by HALL
;FIX PREVIOUS EDIT IN MWAIT
; UPD ID= 2192, SNARK:<5.MONITOR>IPCF.MAC.9,  11-Jun-81 16:50:13 by HALL
;REORDER LOCKS IN MWAIT
; UPD ID= 2062, SNARK:<5.MONITOR>IPCF.MAC.8,  22-May-81 11:16:31 by GRANT
;Again
; UPD ID= 2061, SNARK:<5.MONITOR>IPCF.MAC.7,  22-May-81 10:19:40 by GRANT
;Fix to previous edit - PIDLOK is now PIDLKK
; UPD ID= 2059, SNARK:<5.MONITOR>IPCF.MAC.6,  21-May-81 17:24:47 by SCHMITT
;Tco 5.1341 - Lock up IPCF data base early in PIDJBI
; UPD ID= 1978, SNARK:<5.MONITOR>IPCF.MAC.5,  11-May-81 19:38:32 by ZIMA
;TCO 5.1322 - correct PIDLST initialization for MAXPID odd case.
; UPD ID= 1858, SNARK:<5.MONITOR>IPCF.MAC.4,  21-Apr-81 13:10:50 by SCHMITT
;TCO 5.1291 - Break apart routines MUTFPQ and MUTSPQ
; UPD ID= 1444, SNARK:<5.MONITOR>IPCF.MAC.3,  15-Jan-81 15:56:58 by FLEMMING
;add code for SMAP/RSMAP
; UPD ID= 939, SNARK:<5.MONITOR>IPCF.MAC.2,  20-Aug-80 15:18:10 by ENGEL
;TCO #5.1136 - CHANGE ALL LOCKS TO CONFORM TO THE NEW LOCK SCHEME
; UPD ID= 88, SNARK:<4.1.MONITOR>IPCF.MAC.172,   5-Dec-79 07:40:48 by R.ACE
;ADD COMMENTS TO PIDTBL
; UPD ID= 31, SNARK:<4.1.MONITOR>IPCF.MAC.171,  28-Nov-79 09:46:41 by ENGEL
;AT MWAIT DO PIDLKK FIRST.  AVOIDS FLKTIM BUGCHKS
; UPD ID= 29, SNARK:<4.1.MONITOR>IPCF.MAC.170,  28-Nov-79 09:39:05 by ENGEL
;TCO 4.2581 AT MRECV2 DO PIDLKK FIRST.  AVOIDS FLKTIM BUGCHKS
;<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 ASGFOO/RELSWP/RELIPC 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

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

;IPCF - INTERPROCESS COMMUNICATIONS FACILITY

REPEAT 0,<
;DATA STRUCTURES FOR IPCF

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


	INDEX (1-BASED)

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


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

NOTE:  IF THE VALUE OF A PIDTBL ENTRY IS LESS THAN IPCFSP, IT SIGNIFIES
A FREE ENTRY, AND THE VALUE IS THE NUMBER OF THE NEXT FREE PID.  IF THE
VALUE OF THE ENTRY IS GREATER THAN OR EQUAL TO IPCFSP, THE PID IS IN
USE, AND THE PIDTBL ENTRY IS THE ADDRESS OF THE HEADER FOR THAT PID.

;PID HEADER FORMAT

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

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

		Definitions for offsets 22 and 23 are for page mode only



;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 <IPCFSP,ASGIPC,RELIPC>
EXTN <HSHTBL,ENQBKS,HSHLEN,ENFREL,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 <NXTPID,INFOPD,INFOPV,PIDLST,PIDMXP,PIDPBT>
EXTN <PIDFTB,PIDCNT,PDFKTB,PDFKTL,PIDPRT>

	XSWAPCD			;[7.1034]

;PID HEADER

DEFSTR(PIDUN,0,17,18)		;UNIQUE NUMBER IN LH OF PID
 DEFSTR(PIDCI,,21,4)		;CFS local port part of ID
;DEFSTR(XXXXX,0,35,18)		;RESERVED
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,35,36)		;LINK TO NEWEST MESSAGE
DEFSTR(PIDOL,5,35,36)		;LINK TO OLDEST MESSAGE

;MESSAGE

DEFSTR(MESLNK,0,35,36)		;LINK TO NEXT MESSAGE - 0 IF LAST MESS
;DEFSTR(XXXXX,1,17,18)		;RESERVED
DEFSTR(MESLEN,1,35,18)		;LENGTH OF THIS MESSAGE BLOCK
DEFSTR(MESSJN,2,17,18)		;SENDER'S JOB NUMBER
DEFSTR(MESFLG,2,35,18)		;FLAGS FOR THIS MESSAGE
DEFSTR(MESSPD,3,35,36)		;SENDER'S PID
DEFSTR(MESLDN,4,35,36)		;LOGGED IN DIR # OF SENDER
DEFSTR(MESENB,5,35,36)		;ENABLED CAPABILITIES OF SENDER
DEFSTR(MESCDN,6,35,36)		;CONNECTED DIR # OF SENDER
	MESACT==7		;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

;[7.1076] If these are changed, please change them in CLUPAR also.
;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

XNENT	(.MRECV,G)		;[7.1034] .MRECV:: or X.MREC::
	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
	MOVEI T1,(P4)		;[8841] Get user page number
	LSH T1,PGSFT		;[8841] Make it an address
	TXNN P1,IP%INT		;[8841] Internal call?
	TXO T1,TWUSR		;[8841] No, say user context
	CALLX (MSEC1,FPTA)	;[8841] (T1,FX/T1) Get ID for this page
	JUMPE T1,[RETERR (ARGX23)] ;[8841] Section table does not exist
	MOVE P5,T1		;SAVE IDENTIFIER
	CALLX (MSEC1,MRPACS)	;[7.1034] 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
MRECV2:	CALL GTLCKS		;GET FORK LOCK AND PIDLKK
MRECV0:	TRNN P1,IP%CFV		;PAGE MODE?
	JRST MRECV3		;NO
	MOVE T1,P5		;YES, CHECK IF STILL NO PAGE
	CALLX (MSEC1,MRPACS)	;[7.1034]
	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
	S1XCT <UNLOKK PIDLKK>	;[7.1034] FREE THE LOCKS
	OKINT
	CALLX (MSEC1,FUNLK)	;[7.1034] 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:	S1XCT <UNLOKK PIDLKK>	;[7.1034] UNLOCK THE LOCKS
	OKINT
	CALLX (MSEC1,FUNLK)	;[7.1034] 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.(CHK,IPCMCN,IPCF,HARD,<MESREC - Message count went negative>,,<

Cause:	MESREC was called to copy an IPCF message into user space, but
	GETMES found that there were no messages posted for this user.
>)
		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
	CALLX (MSEC1,RELIPC)	;[7.1034] 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]
	CALLX (MSEC1,SETPT)	;[7.1034] 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 T1,.IPCAS(Q2)	;GET USER'S BYTE POINTER
	MOVE T2,T3		;GET ADDRESS OF HEADER BLOCK
	ADDI T2,MESACT-1	;STEP TO OFFSET OF ACCOUNT STRING MINUS 1
	MOVEI T3,.IPCAS(Q2)	;USER ADDRESS INTO WHICH TO RETURN UPDATED BYTE POINTER
	XCALLRET (MSEC1,CPYTU1)	;[7.1034] 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 B,MHA		;GET ADDRESS OF HEADER BLOCK (CPYACT WIPES T3)
	ADDI B,MESLLO-1		;STEP TO OFFSET OF NODE NAME (MINUS 1)
	MOVEI C,.IPCLL(Q2)	;USER ADDRESS FOR UPDATED BYTE POINTER
	XCALLRET (MSEC1,CPYTU1)	;[7.1034] 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

XNENT	(.MSEND,G)		;[7.1034] .MSEND:: or X.MSEN::
	MCENT			;ENTER SLOW CODE
	CALL VALARG		;READ IN ARGUMENTS AND CHECK VALIDITY
	 RETERR			;SOMETHING NOT RIGHT - ERROR CODE IN T1
	CALL GTLCKS		;GET BOTH LOCKS
	CALL MESSND		;SEND THE MESSAGE
	 JRST MULKER		;NO GOOD RETURN ERROR AFTER UNLOCKING
	S1XCT <UNLOKK PIDLKK>	;[7.1034] OK, UNLOCK EVERYTHING
	OKINT
	CALLX (MSEC1,FUNLK)	;[7.1034] THIS TOO
	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 LOCAL JOB NUMBER OF SENDER (FOR INDEX)
	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
MSENDL:	UMOVE T4,0(P4)		;GET WORD FROM USER MESSAGE
	STOR T4,MESWD0,(T1)	;STORE IN MESSAGE BLOCK
	AOS P4			;STEP POINTER TO USER MESSAGE
	AOS T1			;STEP POINTER TO MESSAGE BLOCK
	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 INDEX
		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:	SAVET			;SAVE AC'S
	STOR T2,MESFLG,(T1)	;STORE FLAGS
	STOR T3,MESSJN,(T1)	;STORE JOB # OF SENDER
	MOVE T3,JOBNO		;GET LOCAL JOB NUMBER(INDEX)
	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
	MOVEI T3,ACCTSR		;GET POINTER TO SENDER'S ACCOUNT STRING
	MOVE T4,T1		;POINTER TO BLOCK INTO WHICH TO COPY IT
	ADDI T4,MESACT		;... AT THIS OFFSET
	MOVEI T2,MESALN		;GET LENGTH
	XBLT. T2		;COPY IT IN CASE RECEIVER WANTS IT
	MOVEI T3,LLSR		;POINTER TO SENDER'S LOGICAL LOGICATION
	MOVE T4,T1		;POINTER TO MESSAGE BLOCK
	ADDI T4,MESLLO		;... AT THIS OFFSET
	MOVEI T2,MESLLN		;GET LENGTH
	XBLT. T2		;COPY IT IN CASE RECEIVER 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,MEBSZ>
	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]
	MOVEM T1,MEBSZ		;SAVE REQUESTED BLOCK SIZE
	CALLX (MSEC1,ASGIPC)	;[7.1034] GET SPACE FOR MESSAGE
	 RET			;NOT ENOUGH ROOM
	MOVEM T1,MESHED		;SAVE POINTER TO MESSAGE BLOCK
	MOVE T2,MEBSZ		;GET REQUESTED BLOCK SIZE
	STOR T2,MESLEN,(T1)	;STORE IN MESSAGE HEADER
	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
		CALLX (MSEC1,RELIPC) ;[7.1034] 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 (1B0 means "monitor")
;	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
	SKIPL T1,P4		;USER OR MONITOR
	IFSKP.
	  LSH T1,PGSFT		;MAKE IT A WORD ADDRESS
	  CALLX (MSEC1,FPTA)	;[7.1034] GET IT
	ELSE.			;IF USER
	  HRLI T1,.FHSLF	;T1/ (THIS FORK,,PAGE NUMBER)
	  MOVEI T2,0		;USE PC SECTION NUMBER
	  CALLX (MSEC1,FKHPTN)	;[7.1034] GET PAGE ID
	   RETBAD ()
	ENDIF.
	MOVEM T1,SNDPGP		;SAVE PTN.PN
	CALLX (MSEC1,MRPACS)	;[7.1034] 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
	CALLX (MSEC1,SETPT)	;[7.1034] 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

XNENT	(.MUTIL,G)		;[7.1034] .MUTIL:: or X.MUTI::
	MCENT			;[7.1034] Enter monitor context
	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
	CALL GTPIDL		;GET THE PID LOCK
	CALL (T1)		;DISPATCH TO ROUTINE
	IFNSK.			;[7.1034] Error return
	  S1XCT <UNLOKK PIDLKK>	;[7.1034] Unlock lock
	  OKINT			;[7.1034] Now that we have freed the lcok
	  RETERR()		;[7.1034] And return bad
	ENDIF.			;[7.1034]
	S1XCT <UNLOKK PIDLKK>	;[7.1034] 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
	 RETBAD()		;ILLEGAL ARGUMENT.  PASS DOWN ERROR.
	CALLX (MSEC1,MAPJSB)	;[7.1034] MAP IN THE APPROPRIATE JSB
	 RETBAD(IPCF30)		;NO SUCH JOB
	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
	CALLX (MSEC1,CLRJSB)	;[7.1034] 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
	 RETBAD			;ILLEGAL VALUE
	CALLX (MSEC1,MAPJSB)	;[7.1034] MAP IN JSB OF THIS JOB
	 RETBAD(IPCF30)		;NO SUCH JOB
	MOVE T2,MUTCPT		;GET BACK PID
	MOVEM T2,JBINFO(T1)	;STORE PID INTO JSB
	CALLX (MSEC1,CLRJSB)	;[7.1034] 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,GBLJNO		;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
		CALLX (MSEC1,STJFKR) ;[7.1034] 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
	CALLX (MSEC1,GL2LCL)	;[7.1034] CONVERT GLOBAL JOB NUMBER TO LOCAL
	 RETBAD (IPCF21)	;ILLEGAL JOB NUMBER
	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,MXGLBS		;...HIGHEST GLOBAL JOB NUMBER...
	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
	CALLX (MSEC1,GL2LCL)	;[7.1034] CONVERT GLOBAL JOB NUMBER TO LOCAL...
	 RET			;BAD NUMBER
	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.(CHK,PIDOD1,IPCF,HARD,<MUTCHO - PID count overly decremented>,,<

Cause:	When attempting to tranfer ownership of a PID from one job to
	another, MUTIL% discovered that the count of PIDs of the original
	owner has gone negative.
>)
		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 T1,FKJOB(T3)	;CONVERT IT INTO A JOB INDEX
	CALLX (MSEC1,LCL2GL)	;[7.1034] Go get Global Job number
	 RET			;Job not found or illegal
	UMOVEM T1,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

MUTSPQ:	UMOVE T1,1(Q2)		;GET ARGUMENT
	CALL GETJNO		;GET THE JOB NUMBER DESIRED
	 RET			;ILLEGAL ARGUMENT
	UMOVE T2,2(Q2)		;GET SECOND ARGUMENT
	SKIPL T2		;IS THIS A LEGAL VALUE?
	CAILE T2,MAXQTA		;...
	RETBAD (IPCF35)		;NO
	STOR T2,PIDPQ,(T1)	;STORE NEW QUOTA
	RETSKP			;AND RETURN SUCCESS

MUTFPQ:	UMOVE T1,1(Q2)		;GET ARGUMENT
	CALL GETJNO		;GET THE JOB NUMBER DESIRED
	 RET			;ILLEGAL ARGUMENT
	LOAD T2,PIDPQ,(T1)	;GET QUOTA
	UMOVEM T2,2(Q2)		;WRITE ANSWER BACK
	RETSKP
;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/	LOCAL JOB NUMBER(INDEX)

GETJNO:	CAMN T1,[-1]		;IS THIS A REQUEST FOR OUR JOB?
	JRST [	MOVE T1,JOBNO	;YES, GET OUR JOB INDEX
		RETSKP]		;AND RETURN
	TLNN T1,-1		;IS THIS A JOB NUMBER?
	 JRST [	CALLX (MSEC1,GL2LCL) ;[7.1034] CONVERT GLOBAL JOB NUMBER TO LOCAL
		 RETBAD(IPCF21)	;GIVE ILLEGAL JOB NUMBER RETURN
		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:	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
	CALLX (MSEC1,STJFKR)	;[7.1034] 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
	TXZ P1,IP%CFZ		;[8841] Clear impossible bit
	MOVE P2,KIMUFL		;Get the PC flags of JSYS
	TXNE P2,PCU		;Was previous context user?
	TXZ P1,IP%MON!IP%INT	;[8841] If so, clear the "by monitor" bits
				;Note: This works for QUEUE% because
				;the user can't set this bit via QUEUE%
	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,740000		;IS THE PAGE NUMBER LEGAL?(HI REX)
	RETBAD (IPCF31)		;NO
	CALLX (MSEC1,CKMMOD)	;[7.1034] FROM THE MONTIOR?
	 SKIPA			;NO
	TXO P4,1B0		;YES. SO NOTE
	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
	 SKIPA	
	RETSKP			;YES
	JXN P1,IP%CFP,R		;[8841] Privileged function was requested
	TXZ P1,IP%CFE!IP%CFM	;[8841] Else turn extra fields off
	JXE P1,IP%CFC,RSKP	;[8841] Anything in IP%CFC?
	LOAD T1,IP%CFC,P1	;[8841] Get the sender code
	CAIE T1,.IPCCG		;QUEUE% JSYS is sender?
	TXZ P1,IP%CFC		;No, give error return
	RETSKP			;Yes. then it's OK
;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:
;   IFN CFSCOD,<			;If CFS stuff enabled
	HLRZ T3,T1		;Get code
	LOAD T3,PIDCI,T3	;Get CFS port ID
	CAME T3,PIDPRT		;Is it us?
	RETBAD(IPCF36)		;No. Error then
;   >	;IFN CFSCOD
	CALL GETPID		;GET HALF WORD ENTRY FROM PID TABLE
	 RET			;ILLEGAL PID TABLE INDEX
	CAMGE T2,[IPCFSP]	;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 <XENT GETMSK>	;[7.1034] GET MASK INTO PDFKTB IN T2
	ANDCAM T2,PDFKTB(T1)	;CLEAR THE WAITING BIT
	S1XCT <UNLOKK PIDLKK>	;[7.1034] UNLOCK THE LOCKS WHILE WAITING
	OKINT
	CALLX (MSEC1,FUNLK)	;[7.1034] 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
	CALL GTLCKS		;GET FORK LOCK AND PID LOCK
	CALLRET ENDWAT		;CLEAR PIDFW


;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
	CAMGE T2,[IPCFSP]	;IS THIS 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
	SUBTTL Routine PDWTCK
;[8841]
;PDWTCK - Accessory routine to allow external routines to dismiss with PDFKTB
;bit as (one of) their wakeup conditions.  We can dismiss only if
;this PID is valid for this fork and this PID does not have any
;messages already pending.  To avoid races, we have to hold the PID
;lock when we clear the PDFKTB bit.
;
; Call with:
;	T1/ PID
;	CALL PDWTCK
;
; Returns:
;	 +1: T1/ error code or zero to indicate that
;	     PID already has message pending, don't dismiss.
;	 +2: No message pending, PDFKTB bit cleared, ok to dismiss,
;	     T1 not preserved!
;
;Note: If you change this routine, be sure locks are released on all exits.

PDWTCK::SAVEAC <T2,T3,T4>	;Preserve all ACs except T1
	CALL GTLCKS		;(/) Get all locks we need
	CALL VALPDJ		;(T1/) Check PID, can this job use it?
	IFSKP.			;Yes
	  CALL CHKNOA		;Make sure this particular fork can use it
	  ANSKP.		;It can
	    CALL CHKPDW		;See if we are allowed to hang on this PID
	    ANSKP.		;Yup
	      SETZ T1,		;Set up flag for non-empty queue
	      LOAD T3,PIDRC,(T2) ;Get receive count
	      ANDE. T3		;Any messages pending?
	        MOVE T1,FORKX	;No, we can dismiss
	        STOR T1,PIDFW,(T2) ;Say that we're going to be waiting
	        CALL <XENT GETMSK> ;Clear our bit in PDFKTB
	        ANDCAM T2,PDFKTB(T1)
	        AOS (P)		;Arrange for skip return
	ENDIF.			;All exits must unlock!
	S1XCT <UNLOKK PIDLKK>	;Free locks in correct order
	OKINT
	CALLX (MSEC1,FUNLK)
	RET			;Return, skipping if appropriate
	SUBTTL Routine PWDTCL
;[8841]
;PWDTCL - Companion routine to clean up.  Does the cleanup operations MWAIT
;would do for us if we were using the normal IPCF scheduler test.
;
;There may be a timing problem here, in that if we never execute
;this code we leave PIDFW set, which prevents an inferior fork from
;being able to hang on this PID. MWAIT experiences the same problem.
;If anybody ever fixes this problem in MWAIT, the fix should be copied
;to this routine too.
;
; Call with:
;	No arguments
; 	CALL PDWTCL
; Returns:
;	+1 - Always, preserving all ACs.

PDWTCL::SAVEAC <T1,T2,T3,T4>
	CALL GTLCKS		;(/) Get locks
	CALL ENDWAT		;(T1/) Clear PIDFW
	S1XCT <UNLOKK PIDLKK>	;Free locks in correct order
	OKINT
	CALLX (MSEC1,FUNLK)
	RET			;Done
;ROUTINE TO GET BOTH THE FORK LOCK AND THE PID LOCK
;RETURNS:	+1 NOINT WITH BOTH LOCKS

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

GTLCKS:	SAVEAC <T1>		;PRESERVE ALL ACS
GTLCK0:	CALLX (MSEC1,FLOCK)	;[7.1034] GET THE FORK LOCK
	NOINT			;NOINT FOR PID LOCK
	S1XCT <LOKK PIDLKK,<XJRST [XCDSEC,,GTLCK1]>> ;[7.1034]
	RET			;GOT IT, DONE

;COULDN'T GET PIDLKK. GIVE UP FORK LOCK AND WAIT A WHILE

GTLCK1:	OKINT
	CALLX (MSEC1,FUNLK)	;[7.1034] UNLOCK FORK LOCK
	MOVEI T1,^D200		;WAIT 200 MS BEFORE RECHECKING
	DISMS
	JRST GTLCK0		;GO GET BOTH LOCKS



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

GTPIDL:	S1XCT <LOKK PIDLKK,<XJRST [XCDSEC,,GTPIDF]>> ;[7.1034] GET THE PID LOCK
	RET			;GOT IT

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

;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

	RESCD			;[7.1034] Scheduler test to section 0/1

PIDWAT::PUSH P,T4		;SAVE RETURN
	XCALL (XCDSEC,GETMSK)	;[7.1034] 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

;	XRESCD			;[7.1034] Called from scheduler!

XRENT	(GETMSK,G)		;[7.1034] GETMSK:: or XGETMS::
	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
;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

	XSWAPCD

CHKFKW:	SAVEAC <T1,T2>		;PRESERVE THESE
	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 <XENT GETMSK>	;[7.1034] GET BIT MASK INTO PDFKTB
	IORM T2,PDFKTB(T1)	;SET THE BIT
	POP P,T1		;GET BACK FORK INDEX
	XCALLRET (MSEC1,UNBLKF)	;[7.1034] 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
	CALLX (MSEC1,PSIRQ)	;[7.1034] 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

CHKPDW:	SAVEAC <T1,T2>
	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
	CALLX (MSEC1,SKIIF)	;[7.1034] 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
	RETSKP			;OK TO WAIT ON THIS PID NOW

CHKPDD:	AOBJN T3,CHKPDL		;LOOP BACK FOR ALL FORKS
	BUG.(CHK,IPCFKH,IPCF,HARD,<CHKPDD - Could not find local fork handle>,,<

Cause:	The fork number waiting for a PID does not exist in the SYSFK
	table for this job.

>)
	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
	CAMGE T2,[IPCFSP]	;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
	CAMGE T2,[IPCFSP]	;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 PIDTBL SLOT

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
	MOVE T2,PIDTBL(T1)	;GET PID HEADER BLOCK
	POP P,T1		;RESTORE PID
	RETSKP			;AND RETURN

;ROUTINE TO STORE NEW DATA IN PIDTBL

;ACCEPTS IN T1:	PID
;	    T2:	NEW DATA
;		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)]
	MOVEM T2,PIDTBL(T1)	;STORE ADDRESS
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.(CHK,PIDFLF,IPCF,HARD,<CREPID - Free PID list fouled up>,,<

Cause:	An invalid PID number was passed to GETPID by CREPID. This value
	passed was retrieved from PIDLST.

Action:	If these BUGCHKs persist, look at the PIDLST and try to determine
	how it was corrupted.

>)
		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
	CALLX (MSEC1,ASGIPC)	;[7.1034] ...
	 JRST [	MOVE T2,CREPDT	;NO ROOM FOR HEADER, RESTORE PIDLST
		MOVEM T2,PIDLST	;...
		RET]		;NO FREE SPACE LEFT ERROR
;   IFN CFSCOD,<			;CFS monitors do it this way
	AOSGE T2,NXTPID		;GET A UNIQUE NUMBER FOR LH OF PID
	IFNSK.			;If not initialized yet
	 BLOCK.
	  SAVEAC<T1>
	  CALLX (MSEC1,CFSPRT)	;[7.1034] Get CFS local port ID
	  MOVEM T1,PIDPRT	;Save it for later
	  CALLX (MSEC1,LGTAD)	;[7.1034] Get system date and time
	  HRRZM T1,NXTPID	;Init PID code to local time
	  HRRZ T2,T1		;Get value to use
	 ENDBK.
	ENDIF.
	MOVE T3,PIDPRT		;Get Local CFS indentifier
	STOR T3,PIDCI,T2	;And make it part of it
;   >		;IFN CFSCOD
   REPEAT 0,<			;CFSCOD NO LONGER USED
   IFE CFSCOD,<AOS T2,NXTPID>	;The old way
   >				;END REPEAT 0
	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.(CHK,ILPID1,IPCF,HARD,<CREPID - Attempt to create illegal PID>,,<

Cause:	CREPID called PUTPID with an illegal PID number.

Action:	If these persist, change the CHK to a HLT and examine the dump to
	determine why GETPID returned an illegal PID value.

>)
		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.(CHK,PIDOD2,IPCF,HARD,<DELPID - Overly decremented pid count>,,<

Cause:	When releasing a PID, DELPID discovered that the PID count for the
	current job has gone negative.
>)
		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 T1,Q2		;GET PID HEADER ADDRESS
	CALLX (MSEC1,RELIPC)	;[7.1034] 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.(CHK,ILPID2,IPCF,HARD,<DELPID - Validated PID turned illegal>,,<

Cause:	A PID which had previously been blessed by VALPID was found to be
	illegal by PUTPID.

Action:	If the problem continues, change this CHK to a HLT and try to
	determine from a dump why the PID was OKed by VALPID and rejected
	by PUTPID.

>)
		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
	CALLX (MSEC1,SETPT)	;[7.1034] GO REMOVE AND DISCARD THIS PAGE
MESRT2:	MOVE T1,MSRTMH		;GET ADDRESS OF MESSAGE BLOCK
	CALLX (MSEC1,RELIPC)	;[7.1034] 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.(CHK,IPCSOD,IPCF,HARD,<GETMES - Sender's count overly decremented>,,<

Cause:	GETMES has discovered that the count of messages from a sender has
	gone negative.

>)
		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 PIDLKK IS TURNED OFF

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

MFLOCK:	S1XCT <UNLOKK PIDLKK>	;[7.1034] UNLOCK THE LOCKS
	OKINT
	CALL GTLCKS		;GET FORK LOCK AND PID LOCK
	RET			;ALL LOCKS SET AGAIN

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

MFUNLK:	S1XCT <UNLOKK PIDLKK>	;[7.1034] UNLOCK IN THE REVERSE ORDER
	CALLX (MSEC1,FUNLK)	;[7.1034] CLEAR FORK LOCK
	NOINT			;GO NOINT AGAIN
	CALL GTPIDL		;GET THE PID LOCK
	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

XNENT	(PIDJBI,G)		;[7.1034] PIDJBI:: or XPIDJB::
	STKVAR <PIDJBJ,PIDJBC>
	NOINT			;LOCK UP DATA BASE
	CALL GTPIDL		;GET THE PID LOCK
	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
	JUMPE T3,PIDJBR		;IF PREVIOUS SEND COUNT WAS 0, EXIT
	MOVEM T1,PIDJBJ		;SAVE JOB NUMBER
	MOVEM T3,PIDJBC		;SAVE NUMBER OF OUTSTANDING MESSAGES
	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
	CAMGE T2,[IPCFSP]	;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:	S1XCT <UNLOKK PIDLKK>	;[7.1034] 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

XNENT	(PIDKFK,G)		;[7.1034] PIDKFK:: or XPIDKF::
	TDZA T2,T2		;KILL ALL PIDS OF FORK
XNENT	(PIDRFK,G)		;[7.1034] PIDRFK:: or XPIDRF::
	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			;LOCK UP
	CALL GTPIDL		;GET THE PID LOCK
	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.(CHK,NOPID,IPCF,HARD,<PIDKFL - PID disappeared>,,<

Cause:	DELPID rejected a PID that had been returned from GETNPF.

>)
	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:	S1XCT <UNLOKK PIDLKK>	;[7.1034] 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

XNENT	(SPLMES,G)		;[7.1034] SPLMES:: or XSPLME::
	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			;DONT ALLOW INTERRUPTIONS
	CALL GTPIDL		;GET THE PID LOCK
	SKIPL T1,CTRLTT		;SET BATCH BIT IN JBFLAG
	CALLX (MSEC1,PTYGBB)	;[7.1034] 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
	ADDI T1,MESWDI		;STEP TO ACTUAL MESSAGE
	MOVE T2,GBLJNO		;GET GLOBAL JOB NUMBER
	HRLI T2,SPMHDS		;GET HEADER SIZE
	PUSH T1,T2		;STORE HEADER SIZE ,, GLOBAL JOB NUMBER
	HLLZ T3,JBFLAG		;GET FLAGS TO BE SENT
	PUSH T1,T3		;STORE FLAGS ,, STATION # (0 FOR NOW)
	MOVE T2,JOBNO		;GET OUR JOB INDEX IN T2
	PUSH T1,JOBPNM(T2)	;SAVE PROGRAM NAME
	PUSH T1,SPLMSV		;STORE FBBYV
	PUSH T1,SPLMSZ		;AND FBSIZ
	AOS T1			;STEP TO CORRECT ADDRESS
	TXO T1,.P0736		;BUILD 1-WORD GLOBAL BYTE-POINTER
	LOAD T2,FLUC,(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.(CHK,NODIR1,IPCF,HARD,<SPLMES - DIRST failed on existing directory name>,<<T2,DIRNUM>>,<

Cause:	DIRST failed to translate a directory number into a string for the
	currently mapped directory.

Action:	Verify the integrity of the directory.

Data:	DIRNUM - Directory number

>)
		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.(CHK,NOUTF2,IPCF,HARD,<SPLMES - NOUT of generation number failed>,,<

Cause:	SPLMES attempted to NOUT the generation number of a spooled file
	and it failed.
>)
IPCMSR:	AOS 0(P)		;SET UP FOR SUCCESSFUL RETURN
IPCMSE:	S1XCT <UNLOKK PIDLKK>	;[7.1034] 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

XNENT	(LOGIMS,G)		;[7.1034] LOGIMS:: or XLOGIM::
	SKIPA T2,[.IPCLI]	;LOGIN MESSAGE CODE
XNENT	(LOGOMS,G)		;[7.1034] LOGOMS:: or XLOGOM::
	MOVEI T2,.IPCSL		;LOGOUT MESSAGE CODE
	NOINT			;LOCK UP IPCF DATA BASE
	CALL GTPIDL		;GET THE PID LOCK
	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
	CALLX (MSEC1,PTYGBB)	;[7.1034] 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
	ADDI T1,MESWDI		;STEP TO ACTUAL MESSAGE
	MOVSI T2,LGMHDS		;GET HEADER SIZE
	HRR T2,GBLJNO		;GET GLOBAL 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 KJOMO
;RETURNS +1:	COULD NOT SEND MESSAGE
;	 +2:	SUCCESSFUL

XNENT	(KJOMO,G)		;[7.1034] KJOMO:: or XKJOMO::
	NOINT			;LOCK IPCF DATA BASE
	CALL GTPIDL		;GET THE PID LOCK
	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
	ADDI T1,MESWDI		;STEP TO ACTUAL MESSAGE
	MOVSI T2,LG2MHS		;ALL BUT HEADER MAKES SIZE FOR USER
	HRR T2,GBLJNO		;IDENTITY OF LOGGING-OUT JOB
	PUSH T1,T2		;PUT THOSE IN MESSAGE
	HRRZ T2,JOBNO		;REAL (LOCAL) JOB NUMBER FOR LATER (INDEX)
	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
	MOVEM T1,Q1		;[7313] Save pointer
	SKIPN T1,JSLOJB		;[7313] Did someone else log me out?
	IFSKP.			;[7313] Yes
	  CALLX (MSEC1,LCL2GL)	;[7.1034][7313] (T1/T1) Convert to global job number
	   SETO T1,		;[7313] Job no longer exits - indicate this
	ENDIF.			;[7313]
	EXCH T1,Q1		;[7313] Swap pointer and job number
	PUSH T1,Q1    		;[7313] 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

XNENT	(ARCMSG,G)		;[7.1034] ARCMSG:: or XARCMS::
	NOINT
	CALL GTPIDL		;GET THE PID LOCK
	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
	 JRST IPCMSE		; [7207]Couldn't, fail with IPCMES's error code
	ADDI T1,MESWDI		;STEP TO ACTUAL MESSAGE
	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
	CALLX (MSEC1,XBLTA)	;[7.1034] Copy the account
	POP P,T1		; Recover blk addr
	MOVE Q1,ARFDB		; Get FDB offset
	MOVE Q2,DIRORA		; Get directory addr
	MOVE T2,T1		; Set up to PUSH thru T2
	SOS 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+1		; Skip over account string
	TXO T2,.P0736		;BUILD 1-WORD GLOBAL BYTE-POINTER
	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.(CHK,ARCVER,IPCF,HARD,<ARCMSG - NOUT failed>,,<

Cause:	ARCMSG attempted to NOUT the generation number of a file and it
	failed.
>)
	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

; Replace 1 line at ARCPY+3 (SPR #20218)
ARCPY:	STKVAR <ARCPOP,ARCPEC>
	MOVEM T2,ARCPOP		;SAVE OUTPUT POINTER
	MOVEM T3,ARCPEC		;SAVE CHARACTER EXEMPTED FROM QUOTING
	ADD T1,[OWGP. 7,0,42]   ; Use dirora offset & make valid ptr
	ADD T1,Q2
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
	S1XCT <LDB T3,CPTAB(T3)>;[7.1045]  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

ARCMS1:	BUG.(INF,NOARCS,IPCF,HARD,<ARCMSG - PID for QUASAR is not valid>,,<

Cause:	ARCMSG could not validate the PID for QUASAR.

Action:	Check QUASAR and be sure it is processing requests.

>)
	SETZM SPIDTB+.SPQSR
	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

XNENT	(IPCMTM,G)		;[7.1034] IPCMTM:: or XIPCMT::
	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

XNENT	(ALCMES,G)		;[7.1034] ALCMES:: or XALCME::
	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

;[7332]Replace header comments  JCR 9-July-86
; ROUTINE TO SEND A MESSAGE TO THE ALLOCATOR WHEN MOUNT COUNT
; OF A STRUCTURE IS INCREMENTED OR DECREMENTED
;
;[7.1206] Nota Bene: This routine accesses TRVAR data as passed in
;from MSTR!!!
;
; ACCEPTS IN P6/ POINTER TO TRVAR OF CALLER IN FORM:
;0		    TRVAR DATA
;1	FUNCTION CODE	,,	BLOCK SIZE
;2	JOB NO		,,	MOUNT COUNT (LINE NUMBER IF INCREMENTING COUNT)
;3		STRUCTURE UNIQUE CODE
;4		      TIME
;
; NOTE: IF MOUNT COUNT IS BEING INCREMENTED, MORE DATA FOLLOWS
;
;		CALL DISMES
; RETURNS: +1	 FAILED, MESSAGE NOT SENT
;	   +2	SUCCESS, MESSAGE WAS SENT

XNENT	(DISMES,G)		;[7.1034] DISMES:: or XDISME::
	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
	ADDI T1,MESWDI+1	;[7332]Step to actual message
	MOVEM Q3,(T1)		;STORE LENGTH
	AOS T3,T1		;STEP TO NEXT ADDRESS AND LOAD IT IN T3
	MOVEI T2,2(P6)		;GET SOURCE POINTER
	HRRZ T1,1(P6)		;[7332]Pick up the block size
	SOS T1			;[7332]Don't count the header word
	XBLT. T1		;MOVE THE DATA
	JRST IPCMSR		;RETURN SUCCESS...
ALOMDM:	NOINT			;LOCK UP IPCF DATA BASE
	CALL GTPIDL		;GET THE PID LOCK
	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.(CHK,NOALCM,IPCF,HARD,<ALCMES - Cannot send message to allocator>,<<T1,PID>>,<

Cause:	Messages cannot be sent to the device allocator PID.

Action:	Check the state of the allocator and see if it is running properly.
	Chances are it is not processing the messages queued for it or that
	the system is out of IPCF free space for some other reason.

Data:	PID - PID
>,,<DB%NND>)			;[7.1210] 
		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

XNENT	(PIDINI,G)		;[7.1034] PIDINI:: or XPIDIN::
	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.(CHK,IPCJB0,IPCF,HARD,<PIDINI - Not in context of job 0>,,<

Cause:	PIDINI was called by a job other than job 0.

>)
	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
	MOVEI T2,0		;...
	CALLX (MSEC1,FKHPTN)	;[7.1034] ...
	 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
	HRROS NXTPID		;Make a negative number in NXTPID
	;..
	;..
	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
	MOVEI T2,2		;Start off with PID 2 as next of PID 1
PIDINL:	MOVEM T2,PIDTBL(T1)	;SET UP PID FREE LIST
	AOS T2			;Increment for next free PID
	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
	MOVEI T1,MAXPID		;FREE LIST IS TERMINATED
	SETZ T2,		; WITH A ZERO
	CALL PUTPID		;SO DO IT
	 NOP
	INILCK PIDLKK		;INITIALIZE LOCK
	RET			;AND EXIT

PIDINB:	BUG.(CHK,IPCFRK,IPCF,HARD,<PIDINB - Cannot create forks for IPCF>,,<

Cause:	PIDINI could not create a fork for pages in transit.

>)
	JRST PIDIN2		;CONTINUE ON

	TNXEND
	END