SUBTTL	CONDITIONAL ASSEMBLY THINGS

	SEARCH	MACTEN,UUOSYM
	SALL
	ND	FTKI10,1	;KI-10
	ND	FTVM,FTKI10	;USE VM FEATURES
	ND	PAGMES,FTVM	;INCLUDE ABILITY TO SEND PAGES
	IFE	FTKI10,<
	FTVM==0			;NO VM FEATURES UNLESS AT LEAST KI
	PURGE	DMOVE,DMOVEM	;WE SHALL REDEFINE AS MACROS
	DEFINE	DMOVE(AC,M)<
		MOVE	AC,M
		MOVE	AC+1,1+M
>
	DEFINE	DMOVEM(AC,M)<
		MOVEM	AC,M
		MOVEM	AC+1,1+M
>
> ;END OF IFE	FTKI10
	IFE	FTVM,PAGMES==0	;NO PAGES WITHOUT VM FEATURES.
	IFE	PAGMES,<
	SMLMES==1		;INCLUDE ABILITY TO SEND SMALL MESSAGES
	SNDMUL==0>		;IF CAN'T SEND PAGES, CAN'T SEND SEVERAL.
	ND	KLUDGE,1	;KLUDGES TO GET AROUND MONITOR BUGS.
	ND	LANGUAGE,0	;0 FOR F-10 CALLING CONVENTIONS
				;1 FOR SAIL
				;2 FOR BLISS
	ND	TYPERR,1	;+ FOR SEPERATE MESSAGES FOR EACH ERROR CODE
				;- FOR 1 MESSAGE +OCTAL CODE
				;0 FOR NO ERROR TYPER
	ND	HIPAGE,700	;1ST PAGE ATTEMPTED TO GET+1
	ND	SNDMUL,1	;BY DEFAULT, INCLUDE CODE TO SEND MULTIPLE PAGES
	ND	NUMMES,14	;SAVE UP TO 12 MESSAGES, BY DEFAULT.
	ND	MAXEXP,12	;LARGEST EXPECTED NON-PAGE MESSAGE.
				;IF A LARGER ONE COMES, A PAGE WILL
				;BE CREATED FOR THE PURPOSE.
	IFL	<MAXEXP-10>,<MAXEXP==10>	;INFO WANTS 8 WORDS.
	ND	IPCGTB,1	;GETTAB ROUTINES BY DEFAULT.
	ND	IPCCRT,1	;[SYSTEM]IPCC ROUTINES BY DEFAULT.
	ND	SMLMES,1	;INCLUDE ABILITY TO SEND NON-PAGES.
	ND	CORMAN,1	;0 TO USE LANGUAGE OTS CORE MANAGEMENT
				;1 TO DO OWN .JBFF CORE MANAGEMENT
	SUBTTL	AC'S AND DEFINITIONS.

	IFE	LANGUAGE,<

	IFE CORMAN,<
	TITLE	IPCFOR--FORTRAN-10 CALLABLE SUBROUTINES FOR IPCF.
	ND	PURESW,0>	;BY DEFAULT, PUT CODE IN LOW SEG

	IFN CORMAN,<
	TITLE	IPCPAS--FORTRAN-10 CALLABLE SUBROUTINES FOR IPCF.  PASCAL VERSION
	ND	PURESW,1>	;BY DEFAULT, PUT CODE IN HIGH SEGMENT

	T0=0		;TEMPORARY THAT NEED NOT BE PRESERVED
	T1=1		;ANOTHER AC  "    "   "   "     "
	T2=2
	T3=3
	T4=4
	P1=5		;START OF A BLOCK OF 5 AC'S THAT MUST BE PRESERVED
	P2=6
	P3=7
	P4=10
	ARGS=16		;POINTER TO ARGUMENT BLOCK
	P=17		;STACK POINTER

;CALLING CONVENTION MACROS

	DEFINE	FENTER(N),<>

	DEFINE	FEXIT(N),<POPJ	P,>

	DEFINE	VMOVE(REG,NUM),<MOVE	REG,@NUM(ARGS)>
	DEFINE	RMOVE(REG,NUM),<MOVE	REG,@NUM(ARGS)>
	DEFINE	RMOVEI(REG,NUM),<MOVEI	REG,@NUM(ARGS)>
	DEFINE	RMOVEM(REG,NUM),<MOVEM	REG,@NUM(ARGS)>
	DEFINE	RHRRZM(REG,NUM),<HRRZM	REG,@NUM(ARGS)>
	DEFINE	RHLRZM(REG,NUM),<HLRZM	REG,@NUM(ARGS)>
	DEFINE	VHRL(REG,NUM),<HRL	REG,@NUM(ARGS)>
	DEFINE	RPOP(REG,NUM),<POP	REG,@NUM(ARGS)>
	DEFINE	RHRRI(REG,NUM),<HRRI	REG,@NUM(ARGS)>
	DEFINE	VSKIPE(REG,NUM),<SKIPE	REG,@NUM(ARGS)>
	DEFINE	RSKIPE(REG,NUM),<SKIPE	REG,@NUM(ARGS)>
	DEFINE	VSKIPG(REG,NUM),<SKIPG	REG,@NUM(ARGS)>
	DEFINE	VSKIPN(REG,NUM),<SKIPN	REG,@NUM(ARGS)>
	DEFINE	VSKPLE(REG,NUM),<SKIPLE	REG,@NUM(ARGS)>
	DEFINE	RSKPLE(REG,NUM),<SKIPLE	REG,@NUM(ARGS)>
	DEFINE	RSETZM(NUM),<SETZM	@NUM(ARGS)>
	DEFINE	RAOS(NUM),<AOS	@NUM(ARGS)>
	DEFINE	VMOVM(REG,NUM),<MOVM	REG,@NUM(ARGS)>

	DEFINE	GETCOUNT(REG),<
	HLRE	REG,-1(ARGS)
	MOVMS	REG>
> ;END OF IFE	LANGUAGE
	IFE	LANGUAGE-1,<
	TITLE	IPCSAI--SAIL CALLABLE SUBROUTINES FOR IPCF

	T0=0
	T1=1
	T2=2
	T3=3
	T4=4
	P1=5
	P2=6
	P3=7
	P4=10
	F=12
	USER=15		;POINTER TO USER TABLE
	P=17		;NORMAL STACK

	ND	PURESW,0	;BY DEFAULT, PUT CODE IN LOW SEG

;*****THE FOLLOWING PARAMETERS MAY BE SAIL VERSION NUMBER DEPENDENT!
;THEY ARE INDICES INTO THE USER TABLE
	TOPBYTE==11	;INDEX INTO GOGTAB OF NEXT FREE BYTE OF STRING SPACE
	REMCHAR==12	;REMAINING FREE CHARS IN STRING SPACE

	DEFINE	FENTER(N),<
	PUSH	P,F		;SAVE FREG
	MOVEI	F,-N-1(P)>	;AND SET UP NEW ONE

	DEFINE	FEXIT(N),<
	POP	P,F		;RESTORE OLD F REGISTER
	SUB	P,[N+1,,N+1]	;REMOVE PARAMETERS FROM STACK
	JRST	@N+1(P)>	;AND RETURN TO USER

	DEFINE	VMOVE(REG,NUM),<MOVE	REG,NUM(F)>
	DEFINE	RMOVE(REG,NUM),<MOVE	REG,@NUM(F)>
	DEFINE	RMOVEI(REG,NUM),<MOVEI	REG,@NUM(F)>
	DEFINE	RMOVEM(REG,NUM),<MOVEM	REG,@NUM(F)>
	DEFINE	RHRRZM(REG,NUM),<HRRZM	REG,@NUM(F)>
	DEFINE	RHLRZM(REG,NUM),<HLRZM	REG,@NUM(F)>
	DEFINE	VHRL(REG,NUM),<HRL	REG,NUM(F)>
	DEFINE	RPOP(REG,NUM),<POP	REG,@NUM(F)>
	DEFINE	RHRRI(REG,NUM),<HRRI	REG,@NUM(F)>
	DEFINE	VSKIPE(REG,NUM),<SKIPE	REG,NUM(F)>
	DEFINE	RSKIPE(REG,NUM),<SKIPE	REG,@NUM(F)>
	DEFINE	VSKIPG(REG,NUM),<SKIPG	REG,NUM(F)>
	DEFINE	VSKIPN(REG,NUM),<SKIPN	REG,NUM(F)>
	DEFINE	VSKPLE(REG,NUM),<SKIPLE	REG,NUM(F)>
	DEFINE	RSKPLE(REG,NUM),<SKIPLE	REG,@NUM(F)>
	DEFINE	RSETZM(NUM),<SETZM	@NUM(F)>
	DEFINE	RAOS(NUM),<AOS	@NUM(F)>
	DEFINE	VMOVM(REG,NUM),<MOVM	REG,NUM(F)>
> ;END OF IFE	LANGUAGE-1
	IFE	LANGUAGE-2,<
	TITLE	IPCBLI--BLISS CALLABLE SUBROUTINES FOR IPCF

	SREG=0
	FREG=2
	T0=3
	T1=4
	T2=5
	T3=6
	T4=7
	P1=10
	P2=11
	P3=12
	P4=13
	P=17

	ND	PURESW,1	;TWO-SEG CODE, BY DEFAULT
	CORMAN==1		;BLISS HAS NO OTS, HENCE NO DEFAULT CORE MANAGEMENT

	DEFINE	FENTER(N),<
	EXCH	SREG,P		;PUT STACK IN AN INDEX REGISTER
	PUSH	P,FREG		;SAVE OLD FREG
	PUSH	P,12		;ALSO SAVE P3
	PUSH	P,13		;AND P4
	MOVEI	FREG,-N-3(P)>	;SET UP NEW FREG

	DEFINE	FEXIT(N),<
	POP	P,13		;RESTORE OLD REGISTER 13
	POP	P,12		;AND REGISTER 12
	POP	P,FREG		;AND OLD FREG
	EXCH	SREG,P		;PUT STACK POINTER BACK WHERE BLISS EXPECTS
	POPJ	SREG,>		;AND RETURN

	DEFINE	VMOVE(REG,NUM),<MOVE	REG,NUM(FREG)>
	DEFINE	RMOVE(REG,NUM),<MOVE	REG,@NUM(FREG)>
	DEFINE	RMOVEI(REG,NUM),<MOVEI	REG,@NUM(FREG)>
	DEFINE	RMOVEM(REG,NUM),<MOVEM	REG,@NUM(FREG)>
	DEFINE	RHRRZM(REG,NUM),<HRRZM	REG,@NUM(FREG)>
	DEFINE	RHLRZM(REG,NUM),<HLRZM	REG,@NUM(FREG)>
	DEFINE	VHRL(REG,NUM),<HRL	REG,NUM(FREG)>
	DEFINE	RPOP(REG,NUM),<POP	REG,@NUM(FREG)>
	DEFINE	RHRRI(REG,NUM),<HRRI	REG,@NUM(FREG)>
	DEFINE	VSKIPE(REG,NUM),<SKIPE	REG,NUM(FREG)>
	DEFINE	RSKIPE(REG,NUM),<SKIPE	REG,@NUM(FREG)>
	DEFINE	VSKIPG(REG,NUM),<SKIPG	REG,NUM(FREG)>
	DEFINE	VSKIPN(REG,NUM),<SKIPN	REG,NUM(FREG)>
	DEFINE	VSKPLE(REG,NUM),<SKIPLE	REG,NUM(FREG)>
	DEFINE	RSKPLE(REG,NUM),<SKIPLE	REG,@NUM(FREG)>
	DEFINE	RSETZM(NUM),<SETZM	@NUM(FREG)>
	DEFINE	RAOS(NUM),<AOS	@NUM(FREG)>
	DEFINE	VMOVM(REG,NUM),<MOVM	REG,NUM(FREG)>
> ;END OF IFE	LANGUAGE-2
	IFG	LANGUAGE-2,<
	PRINTX	?SORRY, ONLY F10 & SAIL & BLISS CALLING SEQUENCES WRITTEN
	PASS2
	END>

	IFL	LANGUAGE,<
	PRINTX	?SORRY, ONLY F10 & SAIL & BLISS CALLING SEQUENCES WRITTEN
	PASS2
	END>
	SUBTTL	REVISION HISTORY

	VWHO==0
	VMAJOR==2
	VMINOR==0
	VEDIT==25
	%%IPCF==:BYTE	(3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT
	PURGE	VWHO,VMAJOR,VMINOR,VEDIT

;%1(0) -- FIRST FULLY WORKING SET OF ROUTINE.
;1	CREATE FTKI10 CONDITIONAL AND DEFINE DMOVE AND DMOVEM AS MACROS FOR A KA.
;2	CREATE FTVM CONDITIONAL AND ALLOW USE OF A NON-VM MONITOR.  (ORIGINAL
;	PACKAGE WAS HIGHLY VM DEPENDENT)
;3	IN IPCRCV, SAVE MESSAGE AT END, RATHER THAN AT BEGINNING
;4	IN IPCINF, ALWAYS CLEAR 30TH CHARACTER OF NAME TO FORCE ASCIZ (ANSWER TO A QAR).
;5	CREATE UFUNCT CONDITIONAL TO ALLOW USE OF FUNCT. ROUTINE IN FOROTS FOR
;	SAFER CORE ALLOCATION.
;6	CREATE LANGUAGE CONDITIONAL.  SOONER OR LATER I SHALL GET AROUND
;	TO WRITING THE ROUTINES FOR A BLISS-10 CALLING SEQUENCE, RATHER THAN
;	FORCING BLISS ROUTINES TO GO THROUGH A FCALL ROUTINE.
;7	IMPROVE SELF CONTAINED CORE MANAGEMENT OF SMALL MESSAGES.
;10	FIX BUG WHICH PREVENTED SMALL MESSAGES FROM BEING SAVED CORRECTLY.
;	(BLT WAS NOT BEING SET UP RIGHT FOR A MESSAGE AT DBLK).
;11	FIX BUG IN SNDINF ABOUT SAVING MESSAGES WHILE WAITING FOR INFO'S RESPONSE.
;12	FIX BUG IN SAVMES THAT SAVED MESSAGE INFO ON TOP OF PREVIOUSLY SAVED INFO.
;13	MORE EFFICIENT PAGE SAVING WITH FUNCT.
;%1A(13)	Dec 21,1974
;14	DEFINE FENTER,FEXIT, AND GETCOUNT MACROS IN PREPARATION FOR
;	PROVIDING SAIL CALLING CONVENTION. THESE ATTEMPT TO MAKE THE ROUTINES
;	LANGUAGE INDEPENDENT FOR CALLING CONVENTION, ROUTINE EXIT AND ENTRY,
;	AND ARGUMENT COUNTING.
;15	DEFINE V????? MACROS TO MANIPULATE A VALUE PARAMETER, AND R????? MACROS
;	TO MANIPULATE REFERENCE PARAMETERS.  MAKE SURE THAT ALL ROUTINES EXIT
;	THROUGH A SINGLE EXIT POINT PER ROUTINE.  REMOVE CALLS TO SAVE4 AND
;	SAVE2 IN TOPLEVEL IPC??? ROUTINES. THESE ARE NOT NECESSARY FOR EITHER
;	FORTRAN OR SAIL, AND THEY SCREW UP SAIL'S EXIT SEQUENCE.
;16	REALLY CLEAN UP CORE MANAGEMENT.  GET RID OF UFUNCT CONDITIONAL & CREATE
;	CORMAN CONDITIONAL (=1, DO OWN .JBFF CORE MANAGEMENT.  =0, USE ROUTINES
;	IN OTS).
;17	LANGUAGE=2 PROVIDES BLISS CALLING CONVENTION
;20	CLEAN UP IPCSND.
;21	IF ALLCPG CAN'T GET A PAGE IN CORE, GET IT ON DSK.  THIS PATCH WAS
;	INSERTED INTO THE LISP CALLABLE VERSION A LONG TIME AGO, BUT NEVER
;	INSERTED HERE.
;22	IF A JOB'S WORKING SET IS CORMAX, IPCFR. WILL FAIL WITH CODE 13
;	IF THIS HAPPENS, PAGE SOMETHING OUT (ANYTHING--ACTUALLY, PAGE 1 IS USED)
;	AND TRY AGAIN.  TOO BAD YOU CAN'T ASK PFH TO SELECT WHAT TO PAGE OUT...
;23	FIX UP EDIT 22 SO IT PAGES OUT THE FIRST PAGE IN THE WORKING SET.
;24	PUT IN SEVERAL PATCHES FROM THE LISP VERSION FOR IPCCON
;25	UPDATE TO 603; RETURN UP TO 6 WORDS OF QUEUE INFO, RATHER THAN 4
	SUBTTL	STORAGE

	IFN	PURESW,<
	TWOSEG	400000
	RELOC	0>

DBLK:	BLOCK	2		;2 WORDS IN FRONT OF NAME
MYNAME:	BLOCK	MAXEXP-2	;THE NAME ITSELF
PIDUS:	BLOCK	1		;OUR PID
SAVCOD:	BLOCK	1		;FUNCTION CODE SAVED HERE
SAVBLK:	BLOCK	6		;IPCFQ. PACKET OF SAVED MESSAGE
SAVNUM:	BLOCK	1		;HOW MANY MESSAGES ARE BEING SAVED.
MESTAB:	BLOCK	7*NUMMES	;POINTERS TO START OF EACH SAVED MESSAGE FOLLOWED BY
				;THE QUEUE ENTRY FOR THE MESSAGE.
SVMES1:	BLOCK	1		;ADDRESS IN MESTAB OF 1ST SAVED MESSAGE
SVMESN:	BLOCK	1		;ADDRESS IN MESTAB OF THE LAST MESSAGE
INFIND:	BLOCK	1		;0 IF EXPECTING REPLY FROM INFO, NON-0 IF
				;EXPECTING REPLY FROM IPCC.
	IFN	IPCCRT,<
CONPID:	BLOCK	1>		;PID OF [SYSTEM]IPCC

	IFE	LANGUAGE!CORMAN,<	;FORTRAN WITH OTS CORE MANAGEMENT?
FUNCT:	BLOCK	1		;FUNCT. FUNCTION
ERROR:	BLOCK	1		;ERROR CODE
STATUS:	BLOCK	1		;ACTUAL ERROR CODE
ARG1:	BLOCK	1		;FIRST ARGUMENT
ARG2:	BLOCK	1		;SECOND ARGUMENT
> ;END OF IFE	LANGUAGE!CORMAN		;FORTRAN WITH OTS CORE MANAGEMENT

	IFN	CORMAN,<	;IF WE DO OUR OWN CORE MANAGEMENT...
FRECOR:	BLOCK	1		;POINTER TO FREE-CORE LIST
> ;END OF IFN	CORMAN

	IFN	FTVM,<		;IF HAVE VM MONITOR
	BLOCK	1
PAGTAB:	BLOCK	17		;ARRAY OF BITS FOR WORKING SET
> ;END OF IFN	FTVM

	IFN	PURESW,<
	RELOC	400000>
	SUBTTL	IPCINF--IPC [SYSTEM]INFO CALLS

	ENTRY	IPCINF
;THE FOLLOWING ROUTINE PREPARES TO MAKE A REQUEST TO [SYSTEM]INFO.  IT SETS
;UP SOME PRELIMINARY INFORMATION, CHECKS THE VALIDITY OF THE FUNCTION, AND
;DISPATCHES TO THE PROPER CODE TO HANDLE THAT PARTICULAR FUNCTION.
;CALL:	INTEGER ERROR,FUNCT,CODE,DUPPID,PID,FLAG,NAME(6)
;  OR	DOUBLE PRECISION NAME
;	CALL IPCINF(ERROR,FUNCT,CODE,DUPPID,PID,FLAG,NAME)
;ERROR IS RETURNED 0 IF NO ERROR, POSITIVE IF IPCF ERROR, NEGATIVE IF OTHER ERROR.
;FUNCT IS THE FUNCTION TO HAVE INFO DO. THE MAGNITUDE MUST BE IN THE RANGE 1 TO 7.
;	POSITIVE IF CONTROL IS TO RETURNED IMMEDIATELY AFTER THE FUNCTION IS SUBMITTED.
;	NEGATIVE IF ROUTINE WILL WAIT FOR THE ANSWER, SAVING PACKETS UNTIL IT ARRIVES.
;CODE IS AN 18 BIT QUANTITY TO ALLOW THE USER TO ASSOCIATE AN ANSWER WITH A REQUEST.
;DUPPID IS THE PID OF THE USER TO RECEIVE A DUPLICATE COPY OF THE REPLY, OR IS 0.
;PID IS EITHER THE ARGUMENT OR IS RETURNED. IT MAY BE EITHER A PID OR A JOB NUMBER.
;FLAG DETERMINES THE HANDLING OF THE NAME:
;	IF NAME IS AN ARGUMENT, AND:
;		FLAG .LT. 0, NAME IS A DOUBLE PRECISION ASCII STRING.
;		FLAG .EQ. 0, NAME IS NOT SUPPLIED.  IPCINF MUST MAKE A DOUBLE
;			PRECISION, BLANK FILLED, ASCII STRING FROM THE PROGRAM NAME.
;		FLAG .GT. 0, NAME IS A 6 WORD ASCII STRING.  BEFORE SENDING,
;			THE LAST CHARACTER WILL BE CLEARED TO MAKE SURE THE
;			NAME IS ASCIZ.
;	IF NAME IS RETURNED, AND:
;		FLAG .LE. 0, NAME IS DOUBLE PRECISION. (2 WORDS SUPPLIED OUT OF 6).
;		FLAG .GT. 0, NAME IS 6 WORDS.
;NAME IS EITHER USED AS AN ARGUMENT OR IS RETURNED.
;THE FUNCTIONS ARE:
;1	CALL IPCINF(ERROR,1,CODE,DUPPID,PID,FLAG,NAME)
;		RETURN THE PID CORRESPONDING TO THE NAME.
;2	CALL IPCINF(ERROR,2,CODE,DUPPID,PID,FLAG,NAME)
;		RETURN THE NAME CORRESPONDING TO THE PID.
;3	CALL IPCINF(ERROR,3,CODE,DUPPID,PID,FLAG,NAME)
;		ASSIGN THE NAME AND RETURN A PID TO BE DROPPED ON RESET.
;4	CALL IPCINF(ERROR,4,CODE,DUPPID,PID,FLAG,NAME)
;		ASSIGN THE NAME AND RETURN A PID TO BE DROPPED ON LOGOUT.
;FOR THE FOLLOWING 3 FUNCTIONS, IF FLAG IS NON-0, PRIVILEGES WILL BE INVOKED.
;IF FLAG IS NOT PRESENT OR IS PRESENT AND IS 0, PRIVILEGES WILL NOT BE INVOKED.
;5	CALL IPCINF(ERROR,5,CODE,DUPPID,PID,FLAG)
;		DROP THE PID.
;FOR THE FOLLOWING TWO FUNCTIONS, JOB MUST NOT BE A PID.
;6	CALL IPCINF(ERROR,6,CODE,DUPPID,JOB,FLAG)
;		DROP ALL PIDS FOR JOB THAT WERE SIGNED OUT UNTIL RESET.
;7	CALL IPCINF(ERROR,7,CODE,DUPPID,JOB,FLAG)
;		DROP ALL PIDS FOR JOB.
IPCINF:	FENTER(7)
	PUSHJ	P,SETINF	;SET UP SAVBLK TO CALL [SYSTEM]INFO
	VMOVM	T0,1		;GET THE POSITIVE FUNCTION CODE
	SKIPLE	T0		;-3 MEANS INVALID FUNCTION
	CAILE	T0,7		;FUNCTION .LE. 7?
	  JRST [PUSHJ	P,RETM3	;NOPE. UNKNOWN FUNCTION.
		JRST	XITINF]
	VHRL	T0,2		;GET THE CODE HE SPECIFIED
	MOVEM	T0,SAVCOD	;SAVE FOR GETANS
	VMOVE	T1,3		;AND THE PID TO RECEIVE A DUPLICATE RESPONSE
	DMOVEM	T0,DBLK		;STORE IN BEGINNING OF [SYSTEM]INFO ARG BLOCK.
	HRRZ	T1,T0		;GET FUNCTION AGAIN
	HRRZ	T1,INFDIS-1(T1)	;GET ADDRESS FROM DISPATCH TABLE
	PUSHJ	P,(T1)		;GO THERE.
XITINF:	FEXIT(7)		;RETURN TO USER
	SUBTTL	IPCANS--GET ANSWER FROM [SYSTEM]INFO

	ENTRY	IPCANS
;THE FOLLOWING ROUTINE COMPLETES A REQUEST TO [SYSTEM]INFO OR [SYSTEM]IPCC.
;IT REQUIRES THAT THE TOP PACKET IN THE QUEUE WAS SENT BY [SYSTEM]INFO OR
;[SYSTEM]IPCC AND WILL COMPLETE THE REQUEST ACCORDING TO WHAT THE FUNCTION IN
;THE RETURN MESSAGE IS.
;THE ARGUMENTS FOR IPCANS ARE THE SAME AS FOR THE CORRESPONDING INFO OR IPCC
;REQUEST BEYOND THE FIRST 4.
;CALL:	INTEGER ERROR,FUNCT,CODE,PID,FLAG,NAME
;	CALL IPCANS(ERROR,FUNCT,CODE,WHO,SUBSEQUENT ARGUMENTS)
;FUNCT IS RETURNED AS THE FUNCTION CODE IN THE MESSAGE FROM INFO.
;CODE IS RETURNED FROM THE USER SPECIFIED CODE IN THE MESSAGE FROM INFO.
;WHO IS A CODE INDICATING WHO THE MESSAGE IS FROM.
;PID IS RETURNED IF THE FUNCTION RETURNS A PID.
;NAME IS RETURNED IF THE FUNCTION RETURNS A NAME.
;FLAG INDICATES HOW NAME IS TO BE STORED.  SEE IPCINF.
;ERROR IS NON-0 IF TOP PACKET IS NOT FROM INFO, SOME UUO ERROR OCCURRED,
;	OR THE ERROR CODE FIELD OF THE PACKET IS NON-0.
IPCANS:	FENTER(7)
	PUSHJ	P,INFCHK	;SEE IF FROM INFO
	  JRST	XITANS		;NOT INFO OR IPCC. ERROR ALREADY SET UP.
	IFN	IPCCRT,<
	  JFCL>			;[SYSTEM]IPCC
	IFE	IPCCRT,<
	  JRST [PUSHJ	P,RETM4		;IPCC. STILL NOT INFO.
		JRST	XITANS]>
	RMOVEM	T0,3		;SAVE FROM WHO
	SKIPE	SAVNUM		;DO WE ALREADY HAVE THE MESSAGE?
	JRST	IPCAN2		;YES--DON'T GET THE NEXT ONE
	PUSHJ	P,SETINF	;SET UP INFO CALL
	IPCFR.	T1,		;DO IT
	  JRST [PUSHJ	P,ERRRET	;NO GOOD.
		JRST	XITANS]
IPCAN2:	MOVE	T1,(P1)		;GET FIRST WORD OF MESSAGE
	RHRRZM	T1,1		;STORE THE FUNCTION
	RHLRZM	T1,2		;AND THE CODE
	LDB	T1,[POINT 6,(P2),29]	;READ ERROR FIELD INTO T1
	JUMPN	T1,DMSG		;RETURN ERROR IF NON-ZERO
	HRRZ	T1,(P1)		;RETRIEVE FUNCTION AGAIN
	IFN	IPCCRT,<
	CAIN	T0,.IPCCC	;WAS MESSAGE FROM IPCC?
	JRST	ISIPCC>		;YES--HANDLE ELSEWHERE
	CAILE	T1,7		;DO WE KNOW ABOUT THIS FUNCTION?
	  JRST [PUSHJ	P,RETM3	;NOPE
		JRST	XITANS]
	HLRZ	T1,INFDIS-1(T1)	;GET DISPATCH ADDRESS
	PUSHJ	P,(T1)		;DISPATCH
	SKIPE	SAVNUM		;WERE WE LOOKING AT A SAVED MESSAGE?
	PUSHJ	P,IPCDS1	;YES--KILL IT
XITANS:	FEXIT(7)

DMSG:	PUSH	P,T1		;SAVE ANY ERROR WE MAY HAVE HAD
	SKIPE	SAVNUM		;LOOKING AT A SAVED MESSAGE?
	PUSHJ	P,IPCDS1	;YES--DELETE IT
	RPOP	P,0		;RESTORE THE ERROR CODE
	JRST	XITANS		;AND RETURN

	IFN	IPCCRT,<
ISIPCC:	CAILE	T1,25		;WITHIN RANGE?
	  JRST [PUSHJ	P,RETM5	;NO--FUNCTION OUT OF RANGE
		JRST	XITANS]
	HLRZ	T1,CONDIS-1(T1)	;GET PROPER DISPATCH ADDRESS
	PUSHJ	P,(T1)		;CALL THE ROUTINE
	SKIPE	SAVNUM		;MESSAGE SAVED?
	PUSHJ	P,IPCDS1	;YES--DISCARD IT
	JRST	XITANS		;RETURN
> ;END OF IFN	IPCCRT
	SUBTTL	IPCFUN--GET INFO FUNCTION OF TOP PACKET.

	ENTRY	IPCFUN
;THE FOLLOWING SUBROUTINE CHECKS IF THE TOP PACKET IN THE QUEUE IS FROM
;[SYSTEM]INFO OR [SYSTEM]IPCC.  IF SO, IT WILL READ IN AND RETAIN THE MESSAGE,
;RETURNING THE CODE AND FUNCTION FROM THE FIRST WORD.
;CALL:	INTEGER ERROR,FUNCT,CODE,WHO
;	CALL IPCFUN(ERROR,FUNCT,CODE,WHO)
;WHO IS RETURNED TO INDICATE WHO THE MESSAGE IS FROM:
;	WHO=1	;[SYSTEM]IPCC
;	WHO=2	;PUBLIC [SYSTEM]INFO
;	WHO=3	;PRIVATE [SYSTEM]INFO
;IF TOP MESSAGE IS NOT FROM INFO, IT WILL NOT BE RECEIVED AND ERROR WILL BE -4.
IPCFUN:	FENTER(4)
	PUSHJ	P,INFCHK	;SEE IF INFO OR IPCC
	  JRST	XITFUN		;NEITHER. ERROR ALREADY SET
	IFN	IPCCRT,<
	  JFCL>			;IPCC
	IFE	IPCCRT,<
	  JRST [PUSHJ	P,RETM4	;IPCC
		JRST	XITFUN]>
	RMOVEM	T0,3		;STORE T0 IN WHO
	SKIPE	SAVNUM		;STORING THIS MESSAGE?
	JRST	GOTMES		;YES--LOOK AT IT
	PUSHJ	P,GETMES	;NO--GET IT
	  JRST	XITFUN		;ERROR SOMEWHERE
	PUSHJ	P,SAVMES	;AND SAVE IT
	  JRST	XITFUN		;ERROR
GOTMES:	MOVE	T1,(P1)		;GET FIRST WORD OF MESSAGE IN T1
	RHLRZM	T1,2		;STORE CODE
	RHRRZM	T1,1		;AND FUNCTION
	PUSHJ	P,GODRET	;AND RETURN
XITFUN:	FEXIT(4)
	SUBTTL	DISPATCH TABLES

;THE FOLLOWING TABLE HAS ENTRIES FOR EACH [SYSTEM]INFO FUNCTION. FORMAT:
;	ADR TO RECEIVE MESSAGE FROM INFO,,ADR TO SEND MESSAGE TO INFO
INFDIS:	GOTPDM,,GETPDM
	GOTNPD,,GETNPD
	GOTPDM,,GETPDM
	GOTPDM,,GETPDM
	GODRET,,PIDGO
	GODRET,,PIDGO
	GODRET,,PIDGO

	IFN	IPCCRT,<
;THE FOLLOWING TABLE HAS SIMILAR ENTRIES FOR EACH [SYSTEM]IPCC FUNCTION.
CONDIS:	GODRET,,GIVJOB
	GODRET,,GIVJOB
	GETIN,,GJBGIN
	GETPID,,GJBGPD
	GODRET,,GIVJOB
	GETPID,,MAKPID
	GODRET,,SETQOT
	GODRET,,CHGJOB
	GETPID,,GJBGPD
	GETMPD,,GJGMPD
	GETQOT,,GJGQOT
	GODRET,,GIVJOB
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,RETM3
	GODRET,,CHGJOB
	GETPID,,GJBGPD
> ;END OF IFN	IPCCRT
	SUBTTL	INFDIS--ROUTINES TO HANDLE SYSTEM INFO FUNCTIONS.

;ROUTINE TO SEND A NAME AND RECEIVE A PID.
GETPDM:	VSKIPE	0,5		;FLAG.NE.0?
	JRST	NAMSUP		;YES--A NAME IS SUPPLIED.  USE IT.
	HRROI	T0,.GTPRG	;NO--CREATE A NAME OUT OF OUR PROGRAM NAME
	GETTAB	T0,		;-1,,3 IS PROGRAM NAME INDEX FOR OUR JOB.
	  JRST	RETM2		;VERY UNUSUAL
	MOVE	P1,[POINT 6,T0]	;SIXBIT POINTER
	MOVE	P2,[POINT 7,MYNAME]	;ASCII POINTER
	MOVE	P3,[ASCII /     /]	;5 SPACES
	MOVEM	P3,MYNAME	;INITIALIZE FIRST 2 WORDS OF NAME WITH BLANKS
	MOVEM	P3,MYNAME+1	;...
	MOVNI	P4,6		;ALLOW UP TO SIX CHARACTERS
CLOOP:	ILDB	T1,P1		;GET FIRST SIXBIT CHARACTER IN T1
	ADDI	T1,40		;CONVERT TO ASCII
	IDPB	T1,P2		;DEPOSIT IN NAME
	AOJL	P4,CLOOP	;REPEAT 6 TIMES
CLRNAM:	SETZB	T0,T1		;CLEAR 2 AC'S
	DMOVEM	T0,MYNAME+2	;CLEAR 2ND 2 WORDS
	DMOVEM	T0,MYNAME+4	;AND 3RD SET OF 2 WORDS
GETNAM:	PUSHJ	P,SNDINF	;SEND THE MESSAGE TO INFO
	  POPJ	P,		;TIME TO RETURN.
GOTPDM:	MOVE	T1,1(P1)	;GET THE PID
	JUMPE	T1,RETM1	;MUST BE A PID
	RMOVEM	T1,4		;STORE IN THE PROPER PLACE
	HRRZ	T0,(P1)		;GET THE FUNCTION CODE
	CAIE	T0,.IPCII	;SIGNING OUT UNTIL RESET?
	CAIN	T0,.IPCIJ	;OR LOGOUT?
	MOVEM	T1,PIDUS	;YES--REMEMBER AS DEFAULT PID
GODRET:	RSETZM	0		;CLEAR ERROR
	POPJ	P,		;AND RETURN

	IFN	LANGUAGE-1,<	;FORTRAN OR BLISS
NAMSUP:	RMOVEI	P1,6		;GET ADDRESS OF NAME IN P1
	DMOVE	T0,0(P1)	;GET 1ST 2 WORDS OF NAME
	DMOVEM	T0,MYNAME	;STORE THEM
	VSKIPG	0,5		;IS MORE SUPPLIED?
	JRST	CLRNAM		;NO--CLEAR REST OF NAME
	DMOVE	T0,2(P1)	;GET 2ND SET OF 2 WORDS
	DMOVEM	T0,MYNAME+2	;STORE THEM
	DMOVE	T0,4(P1)	;AND LAST 2 WORDS
	TRZ	T1,377		;CLEAR THE LAST CHARACTER
	DMOVEM	T0,MYNAME+4	;STORE THEM
	JRST	GETNAM		;SEND AWAY
> ;END OF IFN	LANGUAGE-1	;FORTRAN OR BLISS
	IFE	LANGUAGE-1,<	;SAIL
NAMSUP:	SETZM	MYNAME		;CLEAR FIRST WORD OF NAME
	MOVE	T0,[MYNAME,,MYNAME+1]	;PREPARE FOR BLT
	BLT	T0,MYNAME+5	;CLEAR REST OF NAME
	RMOVEI	T1,6		;GET ADR OF STRING DESCRIPTOR
	HRRZ	T0,-1(T1)	;BYTE COUNT IN T0
	CAILE	T0,^D29		;TOO MANY?
	MOVEI	T0,^D29		;YES--TRUNCATE
	MOVE	P1,0(T1)	;GET SUPPLIED BYTE POINTER
	MOVE	P2,[POINT 7,MYNAME]	;AND POINTER TO DESTINATION
STRLOP:	SOJL	T0,GETNAM	;IF DONE, SEND NAME TO [INFO]
	ILDB	T1,P1		;GET CHAR FROM SUPPLIED NAME
	IDPB	T1,P2		;STORE IN MESSAGE
	JRST	STRLOP		;CHECK IF DONE
> ;END OF IFE	LANGUAGE-1	;SAIL
;HERE TO SEND A PID AND RECEIVE A NAME.
GETNPD:	RMOVE	T1,4		;GET PID SUPPLIED
	MOVEM	T1,DBLK+2	;STORE IT
	PUSHJ	P,SNDINF	;SEND IT AWAY
	  POPJ	P,		;TIME TO RETURN
GOTNPD:	RMOVEI	P2,6		;GET ADDRESS OF WHERE TO STORE NAME
	IFN	LANGUAGE-1,<	;FORTRAN OR BLISS
	DMOVE	T0,2(P1)	;GET 1ST 2 WORDS OF NAME
	DMOVEM	T0,0(P2)	;STORE THEM
	VSKIPG	0,5		;GET MORE?
	JRST	GODRET		;NO--GOOD RETURN
	DMOVE	T0,4(P1)	;2 MORE
	DMOVEM	T0,2(P2)	;STORE
	DMOVE	T0,6(P1)	;2 MORE
	DMOVEM	T0,4(P2)	;STORE
	JRST	GODRET		;RETURN
> ;END OF IFN	LANGUAGE-1	;FORTRAN OR BLISS
	IFE	LANGUAGE-1,<	;SAIL
	SETZ	T0,		;CLEAR CHAR COUNTER
	MOVE	T1,[POINT 7,2(P1)]	;POINT INTO NAME
CCLOOP:	ILDB	T2,T1		;GET A CHAR
	SKIPE	T2		;NULL?
	AOJA	T0,CCLOOP	;NO--COUNT IT AND LOOP
	PUSH	P,T0		;PUSH CHAR COUNT
	EXCH	F,-2(P)		;RESTORE "SAIL" TYPE F-REG
	PUSHJ	P,STRGC##	;MAKE SURE THERE ARE THAT MANY CHARS AVAILABLE
	EXCH	F,-1(P)		;NOW GET BACK "IPCSAI" TYPE F-REG
	MOVE	USER,GOGTAB##	;POINT TO USER TABLE
	ADDM	T0,REMCHAR(USER)	;UPDATE FREE CHAR COUNT
	MOVE	T2,TOPBYTE(USER)	;GET BYTE POINTER TO FIRST FREE BYTE
	HRRM	T0,-1(P2)	;STORE CHAR COUNT
	MOVEM	T2,0(P2)	;AND BYTE POINTER
	MOVE	T1,[POINT 7,2(P1)]	;POINT TO NAME AGAIN
STMKLP:	SOJL	T0,STOBYT	;RETURN IF STORED WHOLE STRING
	ILDB	T3,T1		;GET A CHAR
	IDPB	T3,T2		;STORE IT
	JRST	STMKLP		;LOOP BACK TO CONTINUE MAKING STRING
STOBYT:	MOVEM	T2,TOPBYTE(USER)	;STORE NEW FIRST FREE CHAR
	JRST	GODRET		;AND GIVE A GOOD RETURN
> ;END OF IFE	LANGUAGE-1	;SAIL

;THE FOLLOWING ROUTINE SENDS A PID, OPTIONALLY INVOKING PRIVILEGES.
PIDGO:
	IFE	LANGUAGE,<	;FORTRAN? (ONLY LANGUAGE WITH VAR # OF ARGS..)
	GETCOUNT(T1)		;GET ARG COUNT IN T1
	CAIG	T1,5		;FLAG SUPPLIED?
	JRST	SPID>		;NO--NON-PRIVILEGED REQUEST
	MOVX	T1,IP.CFP	;PRIVILEGE BIT.
	VSKIPE	0,5		;FLAG NON-ZERO?
	IORM	T1,SAVBLK	;YES--SET FLAG
SPID:	RMOVE	T1,4		;GET PID TO SEND
	MOVEM	T1,DBLK+2	;STORE IT
	PUSHJ	P,SNDINF	;SEND THE MESSAGE
	  POPJ	P,		;TOUGH ROCKS, BABY.
	JRST	GODRET		;GOOD RETURN
	SUBTTL	IPCCON--REQUESTS TO IPCC

	IFN	IPCCRT,<
	ENTRY	IPCCON
;THE FOLLOWING ROUTINE MAKES A REQUEST TO [SYSTEM]IPCC.
;CALL:	INTEGER ERROR,FUNCT,CODE,FLAG
;	CALL IPCCON(ERROR,FUNCT,CODE,FLAG,FUNCTION DEPENDENT ARGUMENTS)
;ERROR IS RETURNED NON-0 ON ANY ERROR
;FUNCT IS THE DESIRED FUNCTION
;CODE IS AN 18 BIT QUANTITY SUPPLIED BY THE USER TO IDENTIFY THE REQUEST.
;FLAG IS NON-0 TO INVOKE PRIVILEGES
;THE POSSIBLE CALLS ARE:
;1	CALL	IPCCON(ERROR,1,CODE,FLAG,JOBPID)
;		ENABLE JOB'S ABILITY TO RECEIVE PACKETS.
;		PRIVILEGED FUNCTION IF NOT YOUR OWN JOB.
;2	CALL	IPCCON(ERROR,2,CODE,FLAG,JOBPID)
;		DISABLE JOB'S ABILITY TO RECEIVE PACKETS.
;		PRIVILEGED FUNCTION IF NOT YOUR OWN JOB.
;3	CALL	IPCCON(ERROR,3,CODE,FLAG,JOBPID,INFPID)
;		RETURN PID OF [SYSTEM]INFO IN INFPID.
;4	CALL	IPCCON(ERROR,4,CODE,FLAG,JOBPID,INFPID)
;		CREATE A [SYSTEM]INFO FOR A SPECIFIED JOB (PRIVILEGED FUNCTION).
;		INFPID IS RETURNED AS THE PID OF THE NEW INFO.
;5	CALL	IPCCON(ERROR,5,CODE,FLAG,PID)
;		DESTROY A PID (PRIVILEGED FUNCTION).
;6	CALL	IPCCON(ERROR,6,CODE,FLAG,JOB,PID,TYPE)
;		CREATE A PID FOR A SPECIFIED JOB (PRIVILEGED FUNCTION).
;		TYPE IS NON-0 IF THE PID IS TO BE DROPPED ON RESET,
;		0 IF PID IS TO BE DROPPED ON LOGOUT.
;7	CALL	IPCCON(ERROR,7,CODE,FLAG,PIDJOB,SND,RCV)
;		SET SEND AND RECEIVE QUOTAS FOR A JOB (PRIVILEGED FUNCTION).
;10	CALL	IPCCON(ERROR,8,CODE,FLAG,PIDJOB,NEWJOB)
;		CHANGE THE JOB NUMBER ASSOCIATED WITH A PID (PRIVILEGED FUNCTION).
;11	CALL	IPCCON(ERROR,9,CODE,FLAG,PIDJOB,JOB)
;		FIND THE JOB NUMBER OF A PID.
;12	CALL	IPCCON(ERROR,10,CODE,FLAG,JOB,PIDCNT,PIDARR)
;		FIND 1 OR MORE PIDS OF A JOB.
;		PIDARR IS AN ARRAY THAT THE PIDS ARE LEFT IN.
;		PIDCNT IS INITIALLY THE NUMBER OF ELEMENTS IN THE ARRAY, AND IS
;		RETURNED AS THE NUMBER OF PIDS FOUND.
;13	CALL	IPCCON(ERROR,11,CODE,FLAG,JOB,SND,RCV)
;		FIND SEND AND RECEIVE QUOTAS OF A JOB.
;14	CALL	IPCCON(ERROR,12,CODE,FLAG,JOB)
;		UNBLOCK A JOB FROM RESET.
;24	CALL	IPCCON(ERROR,20,CODE,FLAG,INDEX,PID)
;		SET THE SPECIFIED INDEX IN THE SYSTEM PID TABLE
;25	CALL	IPCCON(ERROR,20,CODE,FLAG,INDEX,PID)
;		READ THE SPECIFIED ELEMENT FROM THE SYSTEM PID TABLE
IPCCON:	FENTER	(7)
	PUSHJ	P,SETINF	;SET UP SAVBLK
	SKIPE	T1,CONPID	;DO WE KNOW THE PID OF IPCC?
	JRST	STPID		;YES--PUT IN SAVBLK
	MOVX	T1,%IPCCP	;GETTAB TO FIND IT
	GETTAB	T1,		;DO SO
	  JRST [PUSHJ	P,RETM2	;IMPOSSIBLE UUO FAILURE
		JRST	XITCON]
	MOVEM	T1,CONPID	;WE'LL KNOW NEXT TIME
STPID:	MOVEM	T1,SAVBLK+2	;STORE IN RECEIVER'S PID
	MOVX	T1,IP.CFP	;PRIVILEGE BIT
	VSKIPE	0,3		;SHOULD WE INVOKE PRIVILEGES?
	IORM	T1,SAVBLK	;YES--SET BIT
	VMOVM	T0,1		;GET POSITIVE FUNCTION
	SKIPE	T0		;FUNCTION = 0?
	CAILE	T0,25		;LE 15?
	  JRST [PUSHJ	P,RETM3	;STORE ERROR
		JRST	XITCON]	;AND LEAVE ROUTINE
	VHRL	T0,2		;GET USER SPECIFIED CODE
	VMOVE	T1,4		;ALSO JOB NUMBER TO DO IT TO/FOR
	DMOVEM	T0,DBLK		;STORE
	MOVEM	T0,SAVCOD	;ALSO STORE FOR GETANS
	HRRZ	T1,T0		;GET FUNCTION AGAIN
	HRRZ	T1,CONDIS-1(T1)	;GET WHERE TO GO
	PUSHJ	P,(T1)		;AND GO THERE.
XITCON:	FEXIT	(7)
	SUBTTL	CONDIS--ROUTINES TO HANDLE [SYSTEM]IPCC FUNCTIONS

;CREATE A PID.  PID EXPECTED IN RETURN
MAKPID:	HRRZS	DBLK+1		;JOB NUMBER IN RIGHT HALF
	MOVSI	T1,(1B0)	;PREPARE TO SET BIT
	RSKIPE	0,6		;SIGN OUT UNTIL LOGOUT?
	IORM	T1,DBLK+1	;NO--UNTIL RESET
;SEND MESSAGE TO IPCC.  PID OR JOB EXPECTED IN RETURN IN WORD 2
GJBGPD:	PUSHJ	P,SNDCON	;SEND THE MESSAGE TO IPCC
	  POPJ	P,		;ERROR MAYBE
GETPID:	MOVE	T1,2(P1)	;GET PID RETURNED
	RMOVEM	T1,5		;STORE IT
	JRST	GODRET		;AND GIVE A GOOD RETURN

;SEND MESSAGE TO IPCC.  PID OR JOB EXPECTED IN RETURN IN WORD 1
GJBGIN:	PUSHJ	P,SNDCON	;SEND THE MESSAGE
	  POPJ	P,		;DONE
GETIN:	MOVE	T1,1(P1)	;GET RESPONSE
	RMOVEM	T1,5		;AND STORE
	JRST	GODRET

;SET QUOTAS FOR A JOB. NO ANSWER EXPECTED.
SETQOT:	RMOVE	T0,5		;GET SEND QUOTA
	RMOVE	T1,6		;GET RECEIVE QUOTA
	ANDI	T1,777		;...
	DPB	T0,[POINT 9,T1,26]	;COMBINE THE 2
SGJOB:	MOVEM	T1,DBLK+2	;AND STORE
GIVJOB:	PUSHJ	P,SNDCON	;SEND TO IPCC
	  POPJ	P,		;RETURN
	JRST	GODRET		;SUCCESS

;CHANGE THE JOB NUMBER ASSOCIATED WITH A PID
CHGJOB:	RMOVE	T1,5		;GET NEW JOB NUMBER
	JRST	SGJOB		;STORE T1 AND SEND MESSAGE

;FIND SEVERAL PIDS FOR A JOB NUMBER
GJGMPD:	PUSHJ	P,SNDCON	;SEND TO IPCC
	  POPJ	P,		;RETURN
GETMPD:	RMOVE	P2,5		;GET SIZE OF ARRAY
	CAILE	P2,-2(P3)	;LARGER THAN MESSAGE?
	MOVEI	P2,-2(P3)	;YES--LOOK ONLY AT MESSAGE
	SETZ	T0,		;CLEAR COUNTER
	JUMPLE	P2,RETPCN	;RETURN 0 IF NON-POSITIVE COUNT
	RMOVEI	P4,6		;P4 IS ADDRESS OF ARRAY
MPDLOP:	AOS	T0		;INCREMENT PID-COUNT
	SKIPN	T1,2(P1)	;IS THERE A NEXT PID?
	SOJA	T0,RETPCN	;YES--RETURN T0-1
	MOVEM	T1,(P4)		;STORE IN ARRAY
	AOS	P4		;POINT TO NEXT ARRAY ELEMENT
	CAME	T0,P2		;DONE ENOUGH?
	AOJA	P1,MPDLOP	;NO--TRY FOR SOME MORE
RETPCN:	RMOVEM	T0,5		;STORE PID-COUNT
	JRST	GODRET		;GOOD RETURN

;FIND QUOTAS FOR A JOB
GJGQOT:	PUSHJ	P,SNDCON	;SEND MESSAGE
	  POPJ	P,		;RETURN
GETQOT:	LDB	T1,[POINT 9,2(P1),35]	;GET RECEIVE QUOTA
	RMOVEM	T1,6		;AND STORE IT
	LDB	T1,[POINT 9,2(P1),26]	;GET SEND QUOTA
	RMOVEM	T1,5		;STORE THAT TOO
	JRST	GODRET		;RETURN
> ;END OF IFN	IPCCRT
	SUBTTL	IPCGET--IPCF MISCELLANEOUS DATA

	IFN	IPCGTB,<
	ENTRY	IPCGET
;THIS ROUTINE RETURNS THE CONTENTS OF GETTAB TABLE 77.
;CALL:	INTEGER COUNT,INFARR(0/9)
;	CALL	IPCGET(COUNT,INFARR)
;IF COUNT IS .LT. 0 OR .GT. 9, ALL ENTRIES IN THE TABLE WILL BE RETURNED.
;IF 0.LE.COUNT.LE.9, THEN ENTRIES 0-COUNT ARE RETURNED.
;COUNT IS RETURNED WITH THE NUMBER OF ENTRIES SUCCESSFULLY GOTTEN.
;N	INFARR(N)
;0	MAXIMUM PACKET LENGTH
;1	PID OF SYSTEM-WIDE [SYSTEM]INFO
;2	DEFAULT QUOTA
;3	TOTAL PACKETS SENT SINCE RELOAD
;4	TOTAL PACKETS OUTSTANDING
;5	PID OF [SYSTEM]IPCC
;6	PID MASK
;7	LENGTH OF PID TABLE
;8	NUMBER OF PIDS NOW DEFINED
;9	TOTAL PIDS DEFINED SINCE RELOAD
IPCGET:	FENTER	(2)
	RSKPLE	P1,0		;NEGATIVE COUNT?
	CAILE	P1,11		;OR TOO BIG?
	MOVEI	P1,11		;ONE OF THOSE.
	RMOVEI	T1,1		;T1 = ADDRESS OF ARRAY
	SETZ	P2,		;P2=CURRENT ENTRY NUMBER
GETLOP:	MOVEI	T0,.GTIPC	;IPCF MISCELLANEOUS DATA TABLE
	HRL	T0,P2		;ENTRY COUNT
	GETTAB	T0,		;FIND DATA
	  SOJA	P2,XITGET	;RETURN COUNT
	MOVEM	T0,(T1)		;STORE
	AOS	T1		;POINT TO NEXT ARRAY CELL
	IFN	IPCCRT,<
	CAIN	P2,5		;IS THIS THE PID OF [SYSTEM]IPCC?
	MOVEM	T0,CONPID>	;YES--STORE IT
	CAME	P1,P2		;ARE WE DONE?
	AOJA	P2,GETLOP	;NO--CARRY ON
XITGET:	RMOVEM	P2,0		;STORE COUNT
	FEXIT	(2)
	SUBTTL	IPCGTJ--GET IPCF INFO FOR ANY JOB

	ENTRY	IPCGTJ
;THIS ROUTINE RETURNS THE IPCF INFORMATION FOR A JOB THAT CAN BE FOUND FROM
;GETTAB TABLES.
;CALL:	INTEGER COUNT,INFARR(0/4),JOB
;	CALL IPCGTJ(COUNT,INFARR,JOB)
;RETURNS:
;N	TABLE#	INFARR(N)
;0	76	PROCESS COMMUNICATION ID
;1	104	IPCF STATISTICS
;2	105	IPCF POINTERS AND COUNTS
;3	106	PID OF JOB'S [SYSTEM]INFO
;4	107	IPCF FLAGS AND QUOTAS
IPCGTJ:	FENTER	(3)
	RSKPLE	P1,0		;NEGATIVE COUNT?
	CAILE	P1,4		;OR TOO MANY TABLES?
	MOVEI	P1,4		;ONE OF THOSE.
	RMOVEI	T1,1		;ARRAY ADDRESS IN RH(T1)
	VHRL	T1,2		;JOB # IN LH(T1)
	SETZ	P2,		;TABLE COUNTER
GTLOP1:	HRRZ	T0,[	.GTPID
			.GTIPA
			.GTIPP
			.GTIPI
			.GTIPQ](P2)	;TABLE NUMBER
	HLL	T0,T1		;AND JOB NUMBER
	GETTAB	T0,		;FIND THE INFO
	  SOJA	P2,XITGTJ	;ERROR
	MOVEM	T0,(T1)		;STORE
	AOS	T1		;INCREMENT ARRAY POINTER
	CAME	P1,P2		;DONE?
	AOJA	P2,GTLOP1	;NO--CARRY ON
XITGTJ:	RMOVEM	P2,0		;STORE FINAL COUNT
	FEXIT	(3)
> ;END OF IFN	IPCGTB
	SUBTTL	IPCQER--QUERY STATUS OF INPUT QUEUE

	ENTRY	IPCQER
;THE FOLLOWING SUBROUTINE QUERIES THE STATUS OF THE IPCF INPUT QUEUE AND
;RETURNS THE INFORMATION IT FINDS.
;CALL:	INTEGER ERROR,FLAGS,HISPID,MYPID,MESLEN,PPN,PRIVS,QUELEN
;	CALL IPCQER(ERROR,FLAGS,HISPID,MYPID,MESLEN,QUELEN,PPN,PRIVS)
IPCQER:	FENTER	(^D8)
	PUSHJ	P,QUERY		;GET INFORMATION ABOUT TOP PACKET
	  JRST [PUSHJ	P,ERRRET	;OOPS! GIVE AN ERROR
		JRST	XITQER]
IPCQR1:	DMOVE	T0,0(P2)	;GET FIRST 2 WORDS OF PACKET INFO
	RMOVEM	T0,1		;FLAGS
	RMOVEM	T1,2		;AND HIS PID
	DMOVE	T0,2(P2)	;AND THE LAST 2 WORDS
	RMOVEM	T0,3		;AND MY PID
	RHLRZM	T1,4		;STORE THE LENGTH OF THE PACKET
	RHRRZM	T1,5		;STORE THE NUMBER OF PACKETS IN THE QUEUE
	IFE	LANGUAGE,<	;FORTRAN
	GETCOUNT(T2)		;GET ARG COUNT
	CAIG	T2,6		;GTR 6 ARGS?
	JRST	XITQR1>		;NO--DON'T STORE EXTRAS. (WE MAKE THIS CHECK
				; FOR COMPATIBILITY WITH OLD PROGRAMS)
	DMOVE	T0,4(P2)	;GET LAST TWO WORDS
	RMOVEM	T0,6		;STORE PPN
	RMOVEM	T1,7		;AND PRIVS
XITQR1:	PUSHJ	P,GODRET	;AND GIVE A GOOD RETURN
XITQER:	FEXIT	(^D8)


	ENTRY	IPCWQR
;THIS SUBROUTINE IS THE SAME AS IPCQER IF ANY PACKET EXISTS IN THE QUEUE.
;IF THE QUEUE IS EMPTY, THIS ROUTINE WILL WAIT UNTIL A PACKET ARRIVES
;AND THEN WILL FINISH AS IPCQER.
;CALL:	INTEGER ERROR,FLAGS,HISPID,MYPID,MESLEN,QUELEN,PPN,PRIVS
;	CALL IPCWQR(ERROR,FLAGS,HISPID,MYPID,MESLEN,QUELEN,PPN,PRIVS)
IPCWQR:	FENTER	(^D8)
IPCWQ1:	PUSHJ	P,QUERY		;FIND OUT ABOUT TOP PACKET
	  TRNA			;ERROR--SKIP
	JRST	IPCQR1		;FINISH AS IF IPCQER
	CAXE	T1,IPCNP%	;PACKET NOT THERE ERROR?
	  JRST [PUSHJ	P,ERRRET	;NO--WORSE ERROR
		JRST	XITQER]
	MOVX	T1,HB.IPC+HB.RWJ	;HIBERNATE WAKE ON IPCF.  ONLY THIS
				;JOB CAN WAKE ITSELF.
	HIBER	T1,		;GO TO SLEEP. IF A PACKET IS THERE ALREADY,
				;WAKE UP IMMEDIATELY.
	  JRST [PUSHJ	P,RETM2	;IMPOSSIBLE UUO FAILURE.
		JRST	XITQER]
	JRST	IPCWQ1		;QUERY THE QUEUE.
	SUBTTL	IPCSML--SEND A SMALL MESSAGE

	IFN	SMLMES,<
	ENTRY	IPCSML

;THIS ROUTINE ATTEMPTS TO SEND A BLOCK OF DATA AS A SMALL MESSAGE
;CALL:	INTEGER ERROR,MYPID,HISPID,LENGTH,ADR
;	CALL IPCSML(ERROR,MYPID,HISPID,LENGTH,ADR)
IPCSML:	FENTER	(5)
	SETZ	P1,		;NO FLAGS
	VSKIPN	P2,1		;DID HE SPECIFY MY PID?
	MOVE	P2,PIDUS	;NO--USE THE ONE WE REMEMBERED
	VMOVE	P3,2		;SET UP HIS PID.
	VSKIPG	P4,3		;ACCEPT ONLY POSITIVE LENGTHS
	  JRST [PUSHJ	P,RETM3	;TELL HIM WE DON'T KNOW WHAT TO DO.
		JRST	XITSML]
	HRLZS	P4		;PUT LENGTH IN LEFT HALF
	RHRRI	P4,4		;GET ADDRESS OF MESSAGE
	MOVE	T1,[4,,P1]	;PREPARE TO SEND
	IPCFS.	T1,		;DO SO
	  JRST [PUSHJ	P,ERRRET	;STORE ERROR
		JRST	XITSML]
	PUSHJ	P,GODRET	;GOOD RETURN
XITSML:	FEXIT	(5)
> ;END OF IFN	SMLMES
	SUBTTL	IPCSND--SEND A PAGE OF INFORMATION

	IFN	PAGMES,<
	ENTRY	IPCSND
;THE FOLLOWING ROUTINE WILL PACK A PAGE WITH BLOCKS OF DATA AND SEND IT TO
;WHOEVER IS SPECIFIED AS THE RECEIVER.
;CALL:	INTEGER ERROR,MYPID,HISPID,FLAG,PAGCNT,LEN1,LEN2,...LENN
;	CALL IPCSND(ERROR,MYPID,HISPID,FLAG,PAGCNT,LEN1,ADR1,LEN2,ADR2,...LENN,ADRN)
;ANY NUMBER OF BLOCKS OF DATA MAY BE PACKED ON THE PAGE.
;IF FLAG IS 0, ONLY ONE PAGE WILL BE SENT.  IE, IF THE TOTAL LENGTH
;IS GREATER THAN 512(DECIMAL) ONLY THE FIRST 512 WORDS WILL BE SENT.
;IF FLAG IS NON-0, AS MANY PAGES WILL BE SENT AS ARE NEEDED.
;PAGCNT IS RETURNED WITH THE NUMBER OF PAGES SENT SUCCESSFULLY.
;MYPID IS OPTIONAL.  IF 0, THE PID MOST RECENTLY INITIALIZED WILL BE USED.
IPCSND:	FENTER	(7)
	RSETZM	4		;CLEAR PAGE COUNTER
	IFN	LANGUAGE,<	;IF NOT FORTRAN, CHECK IF WE HAVE ANYTHING TO DO
	VSKIPG	0,5		;LENGTH GTR 0?
	JRST	GODSND>		;NO--GIVE A GOOD RETURN
	PUSHJ	P,ALLCPG	;GET A PAGE--RETURN NUMBER IN P4
	  JRST	XITSND		;NONE AVAILABLE.
	MOVX	P1,IP.CFV	;FLAG TO INDICATE PAGE MODE IPCF SEND.
	VSKIPN	P2,1		;IS MY PID SPECIFIED?
	MOVE	P2,PIDUS	;NO--USE THE ONE WE REMEMBERED
	VMOVE	P3,2		;GET PID OF DESIRED RECEIVER
	HRLI	P4,1000		;LENGTH OF MESSAGE IS 512 WORDS
	DMOVEM	P1,SAVBLK	;STORE 1ST 2 WORDS OF PACKET
	DMOVEM	P3,SAVBLK+2	;AND THE LAST 2 WORDS
	LSH	P4,11		;CONVERT PAGES TO WORDS
	MOVEI	P2,1000		;HOW MANY WORDS ARE ALLOWED
	IFE	LANGUAGE,<	;FORTRAN?
	MOVE	P3,-1(ARGS)	;GET -ARG COUNT,,0
	HRR	P3,ARGS		;P3 IS NOW AN AOBJN POINTER
	ADD	P3,[5,,5]	;POINT TO FIRST LENGTH
GETARG:	MOVE	P1,@0(P3)	;GET LENGTH IN P1
	MOVEI	T0,@1(P3)	;AND ADDRESS OF ARRAY IN T0
	JUMPLE	P1,NXTARG	;IF LENGTH LEQ 0, LOOK AT NEXT ARG
> ;END OF IFE	LANGUAGE	;FORTRAN
	IFN	LANGUAGE,<	;NOT FORTRAN?
	VMOVE	P1,5		;GET NUMBER OF WORDS TO SEND
	RMOVEI	T0,6		;AND THE ADDRESS WHERE THEY RESIDE
> ;END OF IFN	LANGUAGE	;NOT FORTRAN
	PUSHJ	P,PCKMSG	;PACK THE ARGUMENT ONTO THE PAGE
	  JRST	XITSND		;FAILURE, FOR SOME REASON
	IFE	LANGUAGE,<	;FORTRAN
NXTARG:	AOBJN	P3,.+1		;POINT TO NEXT ARGS
	AOBJN	P3,GETARG	;AND PROCESS THEM, TOO
> ;END OF IFE	LANGUAGE
	PUSHJ	P,SNDPAG	;SEND THE PAGE!
	  JRST	XITSND		;NO?
GODSND:	PUSHJ	P,GODRET	;GOOD RETURN
XITSND:	FEXIT	(7)

PCKMSG:	JUMPLE	P2,SNDCHK	;IF NO ROOM ON PAGE, SEE IF SHOULD SEND MESSAGE
	HRRZ	T1,P1		;GET # OF WORDS IN ARGUMENT
	CAMLE	T1,P2		;ROOM ON PAGE?
	MOVE	T1,P2		;NO--ONLY FILL UP PAGE
	HRRZ	T2,P4		;RH(T2) = DESTINATION ADDRESS
	HRL	T2,T0		;LH(T2) = SOURCE ADDRESS
	MOVE	T3,T1		;T3 IS # OF WORDS WE WILL TRANSFER
	ADDI	T3,-1(P4)	;NOW T3 IS ADR OF LAST WORD TO TRANSFER INTO
	BLT	T2,(T3)		;TRANSFER THE WORDS!
	SUB	P2,T1		;DECREASE # OF WORDS REMAINING ON PAGE
	SUB	P1,T1		;AND # OF WORDS REMAINING IN ARGUMENT
	ADD	P4,T1		;INCREASE ADDRESS OF FREE SPACE ON PAGE
	ADD	T0,T1		;AND ADDRESS OF ARG
SNDCHK:
	IFN	SNDMUL,<	;IF WE WILL SEND MULTIPLE PAGES...
	SKIPLE	P1		;COPIED WHOLE ARG?
	VSKIPN	0,3		;NO--DOES USER WANT US TO SEND SEVERAL PAGES?
> ;END OF IFN	SNDMUL
	JRST	.POPJ1		;WHOLE ARG OR DON'T CONTINUE--GIVE GOOD RETURN
	IFN	SNDMUL,<	;IF WE SEND MULTIPLE PAGES....
	MOVE	P2,T0		;SAVE ADDRESS OF PARTIAL ARG
	PUSHJ	P,SNDPAG	;SEND THE PAGE!
	  POPJ	P,		;FAILURE?
	PUSHJ	P,ALLCPG	;GET A NEW PAGE
	  POPJ	P,		;WHAT??? WE JUST RELEASED A PAGE!
	HRRM	P4,SAVBLK+3	;STORE NEW PAGE NUMBER
	LSH	P4,11		;MAKE INTO A PAGE ADDRESS
	MOVE	T0,P2		;RESTORE ADDRESS OF ARGUMENT
	MOVEI	P2,1000		;1000 FREE WORDS ON THIS PAGE
	JRST	PCKMSG		;CONTINUE SENDING THIS ARGUMENT
> ;END OF IFN	SNDMUL

SNDPAG:	MOVE	T1,[4,,SAVBLK]
	IPCFS.	T1,		;SEND THE PAGE!
	  JRST [PUSHJ	P,ERRRET	;FAILED. STORE THE ERROR CODE
		PUSHJ	P,KILPAG	;DELETE THE PAGE WE CREATED
		POPJ	P,]	;GIVE NON-SKIP RETURN
	RAOS	4		;INCREMENT COUNT OF SUCCESSFUL SENDS
	JRST	.POPJ1		;AND GIVE A SKIP RETURN

ALLCPG:	PUSHJ	P,GETPAG	;GET A PAGE TO USE
	  JRST	RETM2		;NONE AVAILABLE?
	MOVEI	T2,1		;ONE ARGUMENT
	MOVE	T3,P4		;COPY PAGE NUMBER
	MOVE	T1,[.PAGCD,,T2]	;AC FOR PAGE. UUO
	PAGE.	T1,		;GET THE PAGE!
	  TRNA			;COULD NOT--TRY TO GET THE PAGE ON DISK
	JRST	.POPJ1		;SUCCESS.  SKIP RETURN WITH PAGE# IN P4
	TLO	T3,(1B1)	;SET BIT TO GET PAGE ON DISK
	MOVE	T1,[.PAGCD,,T2]	;RESET PAGE. UUO AC
	PAGE.	T1,		;AND ALLOCATE THAT PAGE!
	  JRST	RETM2		;COULD NOT.
	JRST	.POPJ1		;SUCCESS. SKIP RETURN WITH PAGE # IN P4
> ;END OF IFN	PAGMES
	SUBTTL	IPCRCV--RECEIVE A MESSAGE

	ENTRY	IPCRCV
;THE FOLLOWING ROUTINE WILL RECEIVE A MESSAGE AND UNPACK IT INTO BLOCKS
;WHERE EVER THE USER SPECIFIES.
;CALL:	INTEGER ERROR,MYPID,HISPID,FLAG,OFFSET,LEN1,LEN2,LEN3,...LENN
;	CALL IPCRCV(ERROR,MYPID,HISPID,FLAG,OFFSET,LEN1,ADR1,LEN2,ADR2...LENN,ADRN)
;MYPID AND HISPID ARE RETURNED.
;OFFSET IS THE WORD IN THE MESSAGE TO START AT (0-777).
;IF FLAG IS NON-0, THE MESSAGE WILL BE SAVED AFTER THIS ROUTINE
IPCRCV:	FENTER	(7)
	SKIPE	SAVNUM		;ARE WE SAVING A MESSAGE?
	JRST  [ MOVE	T1,SVMES1	;GET ADDRESS OF INFO OF FIRST MESSAGE.
		HRRZ	P1,(T1)		;GET ADDRESS
		HLRZ	P3,4(T1)	;LENGTH OF MESSAGE.
		DMOVE	T0,2(T1)	;GET PIDS IN T0 AND T1
		JRST	ARDSV1]		;AND FINISH
	PUSHJ	P,GETMES	;GET THE MESSAGE
	  JRST	XITRCV		;COULDN'T
	DMOVE	T0,SAVBLK+1	;GET THE PIDS IN T0, T1
ARDSV1:	PUSHJ	P,DORCV		;RECEIVE THE MESSAGE
	VSKIPN	0,3		;WE'VE DONE IT.  SHALL WE SAVE IT?
	JRST	NOSAVE		;NO--DELETE IT.
	SKIPE	SAVNUM		;ALREADY SAVING A MESSAGE?
	JRST	XITRCV		;YES--THIS MESSAGE MUST BE ALREADY SAVED
	PUSHJ	P,SAVMES	;NO--SAVE THIS MESSAGE.
	  JRST	XITRCV		;SOME ERROR.  ALREADY RETURNED CODE.
XITRCV:	FEXIT	(7)

NOSAVE:	SKIPE	SAVNUM		;WERE WE SAVING A MESSAGE?
	JRST  [ PUSHJ	P,IPCDS1	;YES--DELETE IT
		JRST	XITRCV]
	IFN	FTVM,<
	JUMPN P4,[PUSHJ	P,KILPAG	;DELETE ANY PAGE WE CREATED
		JRST	XITRCV]
> ;END OF IFN	FTVM
	CAIN	P1,DBLK		;NO--IS THE MESSAGE AT DBLK?
	JRST	XITRCV		;YES--WE ARE DONE
	HRRZ	T1,P1		;NO--MUST RETURN CORE.  T1<--ADDRESS
	HRRZ	T2,P3		;T2<--WORD COUNT
	PUSHJ	P,RETCOR
	JRST	XITRCV
DORCV:	PUSHJ	P,.SAVE4	;SAVE FOR SAVMES
	RMOVEM	T1,1		;STORE MY PID
	RMOVEM	T0,2		;STORE HIS PID
	VSKIPG	T1,4		;GOOD OFFSET?
	JRST	NOOFF		;NOPE.
	SUB	P3,T1		;LESS NUMBER OF WORDS IN OFFSET
	ADD	P1,T1		;START AT BEGINNING+OFFSET
	JUMPLE	P3,GODRET	;MAYBE WE ARE DONE.
NOOFF:
	IFE	LANGUAGE,<	;FORTRAN?  (ONLY LANG WITH VARIABLE # OF ARGS)
	MOVE	P4,-1(ARGS)	;LH(P4) = - ARG COUNT
	HRR	P4,ARGS		;P4 IS NOW AOBJN POINTER TO ARG LIST
	ADD	P4,[5,,5]	;SKIP 5 ARGS
	JUMPGE	P4,GODRET	;RETURN NOW IF NONE SPECIFIED
RCVLOP:	MOVE	T4,@(P4)	;T4=HOW MANY WORDS ARE DESIRED THIS TIME
	MOVEI	T0,@1(P4)	;RH(T0)=ADDRESS OF WHERE MESSAGE GOES
	JUMPLE	T4,NXRSPC	;DO SOMETHING
> ;END OF IFE	LANGUAGE	;FORTRAN?
	IFN	LANGUAGE,<	;NOT FORTRAN?
	VMOVE	T4,5		;GET # OF WORDS TO TRANSFER
	RMOVEI	T0,6		;AND WHERE TO PUT THEM
	JUMPLE	T4,GODRET	;LEAVE, IF NOTHING TO DO
> ;END OF IFN	LANGUAGE	;NOT FORTRAN?
	CAMLE	T4,P3		;ARE THERE THAT MANY WORDS?
	MOVE	T4,P3		;NO--STORE ONLY AS MANY AS THERE ARE.
	HRRZ	T1,T0		;SAME FOR T1
	SOS	T1		;-1
	HRL	T0,P1		;T0=WHERE WORDS ARE,,WHERE THEY GO
	HRLI	T1,(BLT T0,(T4))	;T1 IS A BLT INSTRUCTION
	XCT	T1		;DO IT
	IFE	LANGUAGE,<	;FORTRAN?
	ADD	P1,T4		;UPDATE POINTER TO WHERE WORDS ARE
	SUB	P3,T4		;COUNT DOWN WORDS REMAINING
	JUMPLE	P3,GODRET	;DONE RECEIVING IF NONE LEFT
NXRSPC:	AOBJN	P4,.+1		;POINT TO NEXT ARGS
	AOBJN	P4,RCVLOP	;IF ANY
> ;END OF IFE	LANGUAGE	;FORTRAN?
	PJRST	GODRET		;RETURN
	SUBTTL	IPCDIS--DISCARD A PACKET

	ENTRY	IPCDIS
;THE FOLLOWING ROUTINE DISCARDS THE TOP PACKET IN THE QUEUE.
;CALL:	INTEGER ERROR
;	CALL	IPCDIS(ERROR)
;OTHER ENTRIES (FOR INTERNAL USE ONLY):
;	PUSHJ	P,IPCDS1	;DELETE NEXT SAVED OR UNSAVED MESSAGE
;	PUSHJ	P,IPCDSC	;DELETE NEXT UNSAVED MESSAGE
IPCDIS:	FENTER	(1)
	PUSHJ	P,IPCDS1	;DISCARD THE MESSAGE
	FEXIT	(1)

IPCDS1:	SKIPN	SAVNUM		;SAVING A PACKET?
	JRST	IPCDSC		;NO--BETTER FIND ABOUT TOP ONE
	MOVE	P1,SVMES1	;GET ADDRESS OF 1ST SAVED PACKET INFO IN P1.
	HRRZ	T1,(P1)		;GET ADDRESS OF SAVED MESSAGE
	HLRZ	T2,4(P1)	;AND IT'S LENGTH
	PUSHJ	P,RETCOR	;RETURN THE CORE
	CAIL	P1,MESTAB+<NUMMES*7>-7	;ARE WE ON THE LAST SLOT?
	MOVEI	P1,MESTAB-7	;YES--NEXT IS 1ST SLOT
	ADDI	P1,7		;POINT TO NEXT
	MOVEM	P1,SVMES1	;SAVE NEW POINTER
	SOS	SAVNUM		;DECREMENT COUNT OF SAVED MESSAGES
	JRST	GODRET		;AND GIVE A GOOD RETURN

IPCDSC:	MOVE	T1,[4,,P1]	;READ PACKET INTO P1-4
	IPCFQ.	T1,		;QUERY THE QUEUE
	  JRST	ERRRET		;WHAT?
	IFN	KLUDGE,<
	JUMPE	P4,RET3>	;PAGE NOT THERE ERROR?
	TXO	P1,IP.CFT	;NO--FLAG TO READ AS MUCH AS WILL FIT
	MOVEI	P4,DBLK		;0 WORDS AT DBLK
	IPCFR.	T1,		;GET THE MESSAGE
	  JRST	ERRRET		;SHOULDN'T HAPPEN, BUT...
	JRST	GODRET		;GOOD RETURN
	SUBTTL	IPCERR--TYPE AN ERROR MESSAGE

	IFG	TYPERR,<
	ENTRY	IPCERR
;THE FOLLOWING ROUTINE TYPES A MESSAGE IDENTIFYING AN ERROR RETURNED BY
;ANY OF THE ABOVE ROUTINES
;CALL:	INTEGER ERROR
;	CALL IPCERR(ERROR)
IPCERR:	FENTER	(1)
	VMOVE	T1,0		;GET ERROR CODE
	MOVM	T0,T1		;GET POSITIVE ERROR
	TLNE	T0,-1		;ANYTHING IN LEFT HALF?
	MOVEI	T1,0		;YES--IPCF MUST NOT BE IMPLEMENTED
	OUTCHR	["?"]		;ERROR PREFIX CHAR
	CAIL	T1,INFERR	;SEE IF INFO ERROR
	CAILE	T1,77		; (RANGE INFERR TO 77)
	JRST	IPCER1		;NO--TRY NORMAL IPCF ERROR
	SUBI	T1,INFERR-MAXERR-1	;YES--REMOVE TABLE OFFSET
	JRST	IPCER2		;AND ISSUE MESSAGE
IPCER1:	CAIG	T1,MAXERR	;DO WE UNDERSTAND THIS ERROR?
	CAMGE	T1,[MINERR]	;CHECK LOWER BOUND
	JRST	UNKERR		;NO--HANDLE SEPERATELY
IPCER2:	OUTSTR	@ERRTBL(T1)	;TYPE MESSAGE FOLLOWED BY A CRLF
IPCERT:	OUTSTR	[ASCIZ \.
\]
	FEXIT	(1)		;RETURN

UNKERR:	OUTSTR	[ASCIZ \Unknown IPCF error code \]
	MOVE	T0,T1		;ERROR CODE TYPED FROM T0
	PUSHJ	P,TYPOCT	;TYPE ERROR CODE IN OCTAL
	JRST	IPCERT

;TABLE OF ERROR MESSAGES

ETBSTR:	[ASCIZ	\No room to store message\]
	[ASCIZ	\Message not from INFO or IPCC\]
	[ASCIZ	\Message not from INFO\]
	[ASCIZ	\Unknown function\]
	[ASCIZ	\Impossible UUO failure\]
	[ASCIZ	\Unkown receiver\]
	MINERR==ETBSTR-.
ERRTBL:	[ASCIZ	\IPCF not implemented\]
	[ASCIZ	\Address check\]
	[ASCIZ	\UUO block not long enough\]
	[ASCIZ	\No packet in queue\]
	[ASCIZ	\Page in use\]
	[ASCIZ	\Data too long for buffer\]
	[ASCIZ	\Destination unknown\]
	[ASCIZ	\Destination disabled\]
	[ASCIZ	\Sending quota exceeded\]
	[ASCIZ	\Receiving quota exceeded\]
	[ASCIZ	\System storage exceeded\]
	[ASCIZ	\Unknown page (send), existing page (receive)\]
	[ASCIZ	\Invalid sender\]
	[ASCIZ	\Insufficient privileges\]
	[ASCIZ	\Unknown function\]
	[ASCIZ	\Bad job number\]
	[ASCIZ	\PID table full\]
	[ASCIZ	\Page requested with non-page packet next\]
	[ASCIZ	\Paging i/o error\]
	[ASCIZ	\Bad index into system PID table\]
	[ASCIZ	\Undefined ID in system PID table\]
	MAXERR==.-ERRTBL-1	;HIGHEST KNOWN ERROR CODE
	[ASCIZ	\INFO had an internal error\]
	[ASCIZ	\INFO ran into an IPCF rejection\]
	[ASCIZ	\INFO failed to complete an assign\]
	[ASCIZ	\INFO ran out of PIDs\]
	[ASCIZ	\INFO could not identify the PID\]
	[ASCIZ	\INFO found a duplicate name\]
	[ASCIZ	\INFO knew of no such name\]
	[ASCIZ	\INFO determined that name has illegal characters\]
	INFERR==100-<.-<ERRTBL+MAXERR+1>>	;FIRST INFO ERROR
> ;END OF IFG TYPERR

	IFL	TYPERR,<
	ENTRY	IPCERR
;THE FOLLOWING ROUTINE TYPES A MESSAGE INDENTIFYING NUMERICALLY AN IPCF ERROR.
;CALL:	INTEGER ERROR
;	CALL IPCERR(ERROR)
IPCERR:	FENTER	(1)
	VMOVE	T0,0		;GET ERROR CODE IN T1
	OUTSTR	[ASCIZ \?IPCF error code \]
	PUSHJ	P,TYPOCT	;TYPE T1 IN OCTAL
	OUTSTR	[ASCIZ \.
\]
	FEXIT	(1)		;RETURN
> ;END OF IFL	TYPERR

	IFN	TYPERR,<
;THE FOLLOWING ROUTINE TYPES THE NUMBER IN T0 IN OCTAL.
TYPOCT:	JUMPGE	T0,TYPOC1	;JUMP IF NON-NEGATIVE
	MOVMS	T0		;ELSE, GET MAGNITUDE
	OUTCHR	["-"]		;AND ISSUE A MINUS SIGN.
TYPOC1:	IDIVI	T0,10		;DIVIDE BY 8
	HRLM	T1,(P)		;SAVE REMAINDER
	SKIPE	T0		;DONE?
	PUSHJ	P,TYPOC1	;NO--REPEAT
	HLRZ	T1,(P)		;RESTORE A DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	OUTCHR	T1		;TYPE IT
	POPJ	P,		;AND RETURN TO WHERE YOU CAME FROM
> ;END OF IFN	TYPERR
	SUBTTL	LOW LEVEL CORE ALLOCATION ROUTINES

;GETCOR--ALLOCATE A BLOCK OF CORE.  ACCEPTS # OF WORDS TO ALLOCATE IN T2,
;AND RETURNS ADDRESS OF A BLOCK THAT SIZE IN T1 (T2 UNHARMED)
;SKIP RETURN IF SUCCESS, NON-SKIP IF NO CORE AVAILABLE

;RETCOR--DEALLOCATE A BLOCK OF CORE.  ACCEPTS T1=ADDRESS OF BLOCK, T2 = SIZE
;OF BLOCK.  ALWAYS NON-SKIP RETURN.

	IFE	CORMAN,<	;USE LANGUAGE SPECIFIC CORE ALLOCATION

	IFE	LANGUAGE,<	;FORTRAN
GETCOR:	MOVEI	T1,6		;FUNCTION 6 IS GET CORE
	MOVEM	T1,FUNCT	;STORE IN FUNCTION VARIABLE
	MOVEM	T2,ARG2		;STORE REQUESTED # OF WORDS
	PUSHJ	P,CALFNC	;CALL FUNCT.
	  POPJ	P,		;ERROR
	MOVE	T1,ARG1		;GET ADDRESS OF CORE
	JRST	.POPJ1		;AND GIVE A SKIP RETURN

RETCOR:	MOVEM	T1,ARG1		;STORE ADDRESS OF CORE
	MOVEM	T2,ARG2		;AND HOW MANY WORDS
	MOVEI	T1,7		;FUNCTION 7 IS RETURN CORE
	MOVEM	T1,FUNCT
	PUSHJ	P,CALFNC	;CALL FUNCT.
	  POPJ	P,		;ERROR
	POPJ	P,		;OK

CALFNC:	PUSH	P,ARGS		;SAVE REG 16
	MOVEI	ARGS,FRGLST	;POINT TO FUNCT. ARG LIST
	PUSHJ	P,FUNCT.##	;CALL OTS!
	POP	P,ARGS		;RESTORE ARG POINTER
	SKIPN	STATUS		;SUCCESS?
	AOS	(P)		;YES--SET UP SKIP
	POPJ	P,		;RETURN

	-5,,0
FRGLST:	ARG	2,FUNCT		;FUNCTION
	ARG	2,ERROR		;ERROR MESSAGE
	ARG	2,STATUS	;RETURNED STATUS
	ARG	2,ARG1		;FIRST ARGUMENT
	ARG	2,ARG2		;SECOND ARGUMENT

> ;END OF IFE	LANGUAGE	;FORTRAN
	IFE	LANGUAGE-1,<	;SAIL

GETCOR:	PUSH	P,3		;SAVE REGISTER 3
	MOVE	3,T2		;PLACE REQUESTED WORDS INTO IT
	PUSHJ	P,CORGET##	;GET THAT MUCH CORE!
	  JRST [POP	P,3	;RESTORE REG 3
		POPJ	P,]	;AND GIVE NON-SKIP RETURN
	MOVE	T1,2		;COPY ADDRESS INTO T1
	MOVE	T2,3		;RESTORE WORD COUNT INTO T2
	POP	P,3		;RESTORE REG 3
	JRST	.POPJ1		;AND GIVE A SKIP RETURN

RETCOR:	PUSH	P,2		;SAVE REGISTER 2
	MOVE	2,T1		;STORE ADDRESS OF CORE BLOCK TO RETURN
	PUSHJ	P,CORREL##	;RELEASE THE CORE!
	POP	P,2		;RESTORE REGISTER 2
	POPJ	P,		;AND RETURN

> ;END OF IFE	LANGUAGE-1	;SAIL

> ;END OF IFE	CORMAN
	IFN	CORMAN,<	;DOING OWN CORE ALLOCATION...

;IF WE DO OUR OWN CORE MANAGEMENT, A VERY SIMPLE SCHEME IS USED:
;  IF A SIMPLE FIRST FIT SEARCH ON THE FREE CHAIN FINDS A SUITABLE BLOCK, IT
;IS REMOVED FROM THE FREE CHAIN AND ITS ADDRESS IS RETURNED TO THE USER.  ELSE,
;IF THE USER REQUESTS N WORDS, N+1 ARE ALLOCATED AT .JBFF.  THE 0 WORD CONTAINS
;<SIZE OF BLOCK,,NEXT BLOCK IN FREE CHAIN>. THE ADDRESS OF THE 1ST WORD IS RETURNED
;TO THE USER
GETCOR:	PUSHJ	P,CHKLST	;IS THERE A SUITABLE BLOCK IN THE FREE-CORE LIST?
	  JRST	.POPJ1		;YES--T1 ALREADY SET UP.  GIVE A SKIP RETURN
	MOVE	T1,.JBFF##	;NO--GET FIRST FREE LOC AT END OF CORE
	ADD	T1,T2		;POINT TO LAST DESIRED WORD
	CAMG	T1,.JBREL##	;HAVE ENOUGH CORE?
	JRST	HAVCOR		;YES--SKIP UUO
	PUSH	P,T1		;SAVE LAST WORD'S ADR
	CORE	T1,		;ALLOCATE MORE CORE
	  JRST [POP	P,T1	;RESTORE T1
		POPJ	P,]	;AND GIVE NON-SKIP RETURN
	POP	P,T1		;RESTORE T1
HAVCOR:	EXCH	T1,.JBFF##	;STORE ADR(LAST WORD) & GET ADR(FIRST WORD)
	AOS	.JBFF##		;.JBFF NOW POINTS TO FIRST FREE WORD
	HRLZM	T2,(T1)		;STORE SIZE OF BLOCK IN FIRST WORD
	AOJA	T1,.POPJ1	;POINT TO FIRST WORD USER SEES, AND GIVE SKIP RETURN

CHKLST:	SKIPN	T1,FRECOR	;IS THERE A FREE CORE LIST?
	JRST	.POPJ1		;NO--GIVE SKIP RETURN
	PUSH	P,T3		;BE NICE AND SAVE TEMP AC'S NEEDED
	PUSH	P,T4
	MOVEI	T3,FRECOR+1	;PRETEND ADR IN T1 IS CORE BLOCK LIKE WE CREATE
CORLOP:	HLRZ	T4,-1(T1)	;GET SIZE OF THIS CORE BLOCK
	CAML	T4,T2		;BIG ENOUGH?
	JRST  [	HRRZ	T4,-1(T1)	;YES--GET ADR(NEXT CORE BLOCK)
		HRRM	T4,-1(T3)	;AND STORE IN PREVIOUS BLOCK'S LINK
		POP	P,T4	;RESTORE TEMPORARIES
		POP	P,T3
		POPJ	P,]	;AND GIVE A NON-SKIP RETURN
	MOVE	T3,T1		;NO--SAVE POINTER TO PREVIOUS BLOCK
	HRRZ	T1,-1(T1)	;AND GET NEW CURRENT BLOCK
	JUMPN	T1,CORLOP	;IF IT EXISTS...
	POP	P,T4		;NOTHING IN CORE LIST IS SUITABLE. RESTORE TEMPS
	POP	P,T3
	JRST	.POPJ1		;AND GIVE A SKIP RETURN

RETCOR:	HRRZ	T2,FRECOR	;GET POINTER TO PREVIOUS 1ST AVAILABLE CORE BLOCK
	HRRM	T2,-1(T1)	;STORE IN NEXT FIELD OF THIS BLOCK
	HRRZM	T1,FRECOR	;AND STORE POINTER TO THIS BLOCK IN FRONT OF LIST
	POPJ	P,		;RETURN

	ENTRY	IPCINI		;MUST ALSO PROVIDE A ROUTINE TO INITIALIZE FRECOR
IPCINI::SETZM	FRECOR		;FORGET WHAT WE THINK WE KNOW
	IFN	LANGUAGE-2,<	;NOT BLISS?
	POPJ	P,>		;RETURN THROUGH P
	IFE	LANGUAGE-2,<	;BLISS?
	POPJ	SREG,>		;RETURN THROUGH SREG
> ;END OF IFN	CORMAN
	SUBTTL	COMMON ROUTINES FOR INTERNAL USE ONLY

;THE FOLLOWING ROUTINE STORES ITS RETURN ADDRESS ON THE STACK AND
;SAVES P1-P4.  A POPJ WILL RETURN TO RET4 WHICH WILL RESTORE THE AC'S
;AND RETURN TO THE CALLING PROGRAM.
;BORROWED FROM SCAN %7(535)
.SAVE4:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	HRLI	P1,(P)		;GET ADDRESS WHERE P1 IS SAVED
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,P4		;SAVE P4
	PUSHJ	P,SAVJMP	;STACK NEW RETURN PC AND JUMP
	POP	P,P4		;RESTORE P4
	POP	P,P3		;RESTORE P3
	POP	P,P2		;RESTORE P2
	POP	P,P1		;RESTORE P1
	POPJ	P,		;AND RETURN

;THE FOLLOWING INSTRUCTION RESTORES P1 AND DISPATCHES TO THE CALLER
SAVJMP:	JRA	P1,(P1)		;RETURN TO CALLER

;ERROR RETURNING
RETM6:	SKIPA	T1,[-6]		;-6 ERROR RETURN MEANS COULD NOT SAVE MESSAGE.
RETM5:	MOVNI	T1,5		;-5 ERROR RETURN MEANS MESSAGE NOT FROM INFO OR IPCC.
	JRST	ERRRET
RETM4:	SKIPA	T1,[-4]		;-4 ERROR RETURN MEANS MESSAGE NOT FROM INFO
RETM3:	MOVNI	T1,3		;-3 ERROR RETURN MEANS UNKNOWN FUNCTION
	JRST	ERRRET		;ISSUE IT
RETM2:	SKIPA	T1,[-2]		;-2 ERROR RETURN MEANS IMPOSSIBLE UUO FAILURE
RETM1:	MOVNI	T1,1		;-1 ERROR RETURN MEANS UNKNOWN NAME
ERRRET:	RMOVEM	T1,0		;STORE ERROR CODE
	POPJ	P,		;RETURN

	IFN	KLUDGE,<
RET3:	MOVEI	T1,3
	JRST	ERRRET
> ;END OF IFN	KLUDGE
;THE FOLLOWING ROUTINE SENDS A MESSAGE TO [SYSTEM]INFO
;AND OPTIONALLY RECEIVES AN ANSWER.
;RETURNS WITH P1=ADDRESS OF MESSAGE AND P3=# OF WORDS IN MESSAGE.
SNDCON:	SETOM	INFIND		;-1 MEANS ANSWER FROM IPCC
	TRNA			;AND SKIP
SNDINF:	SETZM	INFIND		;0 MEANS ANSWER FROM INFO
	MOVE	T1,[6,,SAVBLK]	;POINTER TO SEND BLOCK
	IPCFS.	T1,		;SEND THE MESSAGE TO INFO
	  JRST	ERRRET		;COULDN'T
	VSKPLE	0,1		;SHOULD WE WAIT FOR AN ANSWER?
	JRST	GODRET		;NO--RETURN NOW
GETANS:	MOVE	T1,[6,,SAVBLK]	;PREPARE TO QUERY QUEUE
	IPCFQ.	T1,		;DO SO
	  JRST	INFWAT		;WELL, WE ARE PROBABLY FASTER THAN INFO.
	IFN	KLUDGE,<
	SKIPN	SAVBLK+3	;IS THERE REALLY A MESSAGE?
	JRST	WTINF>		;NO--GO WAIT FOR INFO
	LDB	T0,[POINT 3,SAVBLK,32]	;GET SENDER'S CODE
	CAIE	T0,.IPCCF	;SEE IF FROM SYSTEM [SYSTEM]INFO
	CAIN	T0,.IPCCP	; OR IF FROM LOCAL  [SYSTEM]INFO
	SKIPE	INFIND		;WAITING FOR INFO?
	JRST	CHKCON		;YES--RECEIVE MESSAGE AND CHECK IT OUT
CHKMES:	PUSHJ	P,GETMES	;GET THE MESSAGE
	  POPJ	P,		;COULDN'T
	MOVE	T1,(P1)		;GET FIRST WORD
	CAMN	T1,SAVCOD	;IS IT WHAT WE EXPECT?
	JRST  [	LDB	T1,[POINT 6,SAVBLK,29]	;YES--SEE IF AN ERROR WAS RETURNED
		JUMPN	T1,ERRRET	;IF SO, INFORM USER
		JRST	.POPJ1]	;NONE--GIVE GOOD RETURN
	PUSHJ	P,SAVMES	;WRONG MESSAGE--SAVE IT
	  POPJ	P,		;COULDN'T
	JRST	GETANS		;NO--TRY AGAIN

CHKCON:	CAIN	T0,.IPCCC	;NOT INFO. IPCC?
	SKIPN	INFIND		;YES. DO WE WANT TO HEAR FROM HIM?
	TRNA			;NO...
	JRST	CHKMES		;YES--CHECK IT OUT.
	PUSHJ	P,GETMES	;GET THE MESSAGE
	  POPJ	P,		;COULDN'T
	PUSHJ	P,SAVMES	;AND SAVE IT
	  POPJ	P,		;COULDN'T
	JRST	GETANS		;AND REPEAT.

INFWAT:	CAXE	T1,IPCNP%	;PACKET NOT THERE ERROR?
	  JRST	ERRRET		;NOPE--RETURN
WTINF:	MOVX	T1,HB.IPC+HB.RWJ	;SLEEP UNTIL INFO CALLS
	HIBER	T1,		;DO IT
	  JRST	RETM2		;SET ERROR=-2 AND DO A NON-SKIP RETURN.
	JRST	GETANS		;TRY AGAIN
;THE FOLLOWING ROUTINE SETS UP P1 AS THE ADDRESS OF THE NEXT MESSAGE IN THE QUEUE
;AND P2 AS THE ADDRESS OF THE QUEUE INFO BLOCK. (UNLESS MESSAGES ARE BEING
;SAVED, THESE WILL ALWAYS BE DBLK AND SAVBLK, RESPECTIVELY.)
;IT WILL QUERY THE QUEUE IF NECESSARY AND DO A SKIP RETURN IF ALL OK.
QUERY:	SKIPN	SAVNUM		;SAVING A MESSAGE?
	JRST	FINDOU		;NO--FIND OUT ABOUT A NEW ONE
	HRRZ	P2,SVMES1	;PACKET INFO ADDRESS IN P2
	HRRZ	P1,(P2)		;PAGE ADDRESS IN P1
	AOJA	P2,.POPJ1	;POINT TO QUEUE INFO AND RETURN

FINDOU:	MOVE	T1,[6,,SAVBLK]	;PREPARE TO GET QUEUE INFO AT SAVBLK
	IPCFQ.	T1,		;DO IT.
	  POPJ	P,		;ERROR
	IFN	KLUDGE,<
	SKIPN	SAVBLK+3	;IS THERE REALLY A PACKET?
	JRST	RET3>		;NO.
	MOVEI	P1,DBLK		;DBLK MAY BE WHERE THE PACKET WILL GO
	MOVEI	P2,SAVBLK	;SAVBLK IS WHERE THE QUEUE INFO IS
.POPJ1:	AOS	(P)		;DO A SKIP RETURN
.POPJ:	POPJ	P,		;RETURN

;THE FOLLOWING ROUTINE WILL FIND OUT IF THE TOP PACKET IS FROM [SYSTEM]INFO
;OR [SYSTEM]IPCC.  NON-SKIP WITH 0(ARGS)SET IF NEITHER, SKIP IF IPCC, DOUBLE
;SKIP IF INFO.  T0 IS WHO FIELD.
INFCHK:	PUSHJ	P,QUERY		;FIND OUT ABOUT TOP PACKET
	  JRST	ERRRET		;COULDN'T
	LDB	T0,[POINT 3,(P2),32]	;GET SENDER'S CODE
	CAIE	T0,.IPCCF	;FROM SYSTEM-WIDE [SYSTEM]INFO?
	CAIN	T0,.IPCCP	;OR FROM LOCAL [SYSTEM]INFO?
.POPJ2:	AOSA	(P)		;DOUBLE SKIP--IS FROM INFO
	CAIN	T0,.IPCCC	;FROM [SYSTEM]IPCC?
	JRST	.POPJ1		;YES--SKIP RETURN
	JRST	RETM5		;NOT FROM INFO OR IPCC

;THE FOLLOWING PREPARES TO SEND OR RECEIVE A MESSAGE FROM INFO.
SETINF:	SETZM	SAVBLK		;NO FLAGS
	SETZM	SAVBLK+1	;FROM US
	SETZM	SAVBLK+2	;TO INFO
	MOVE	T1,[^D8,,DBLK]	;POINTER TO DATA
	MOVEM	T1,SAVBLK+3	;STORE IN LAST WORD
	MOVE	T1,[6,,SAVBLK]	;READY TO USE
	POPJ	P,		;SO RETURN
	SUBTTL	INTERNAL ROUTINES FOR PAGE MANAGEMENT.

	IFN	FTVM,<
;THE FOLLOWING ROUTINE FINDS A FREE PAGE NUMBER AND LEAVES IT IN P4.
GETPAG:	MOVEI	P4,HIPAGE	;START CHECKING WITH PAGE 677
GPLOOP:	SOJLE	P4,.POPJ	;ERROR RETURN IF WE GET DOWN TO PAGE 0
	HRRZ	T1,P4		;PAGE TO CHECK IN RIGHT HALF
	HRLI	T1,.PAGCA	;CHECK PAGE ACCESS FUNCTION
	PAGE.	T1,		;CHECK IT OUT
	  POPJ	P,		;ERROR RETURN
	JUMPGE	T1,GPLOOP	;IF NEGATIVE, PAGE DOES NOT EXIST
	JRST	.POPJ1		;DO A SKIP RETURN

;THE FOLLOWING ROUTINE DESTROYS THE PAGE WHOSE NUMBER IS IN RH(SAVBLK+3)
KILPAG:	HRRZ	P4,SAVBLK+3	;GET PAGE NUMBER
	HRLI	P4,(1B0)	;SET SIGN BIT SO DESTROY PAGE
	MOVEI	P3,1		;ONLY ONE
	MOVE	P2,[.PAGCD,,P3]	;P2 IS AC FOR PAGE. UUO
	PAGE.	P2,		;GET RID OF THE PAGE
	  POPJ	P,		;WELL, WE DID WHAT WE COULD.
	POPJ	P,		;RETURN
> ;END OF IFN	FTVM
	SUBTTL	INTERNAL ROUTINE TO RECEIVE A MESSAGE

;ROUTINE TRIES TO READ IN THE NEXT MESSAGE.  IF A PAGE, CHOOSES A SUITABLE PAGE.
;GETS MESSAGE, AND RETURNS.  IF A SMALL MESSAGE, READ INTO DBLK IF IT FITS, ELSE
;IF SMLPAG EXISTS AND THERE IS ROOM AT END, PUT IT THERE. ELSE, CREATE A NEW
;PAGE AND PUT AT BEGINNING.  IPCFQ. BLOCK WILL BE IN SAVBLK.
;ACS:	P1=START OF MESSAGE
;	P3=# OF WORDS IN MESSAGE
;	P4=0 OR PAGE NUMBER OF PAGE JUST CREATED.
;SKIP RETURN IF ALL WENT WELL, NON-SKIP WITH ERROR IN 0(ARGS) ELSE.
GETMES:	MOVE	T1,[6,,SAVBLK]	;PREPARE TO FIND OUT ABOUT QUEUE
	IPCFQ.	T1,		;DO SO.
	  JRST	ERRRET		;NOPE
	IFN	KLUDGE,<
	SKIPN	SAVBLK+3	;REALLY A MESSAGE?
	JRST	RET3>		;NO.
	HLRZ	P3,SAVBLK+3	;NO--GET LENGTH.
	IFN	FTVM,<
	MOVE	P2,SAVBLK	;GET FLAGS
	TXNE	P2,IP.CFV	;PAGE MODE?
	JRST	PGMS>		;YES
	CAILE	P3,MAXEXP	;TOO BIG FOR DBLK?
	JRST	TOOBIG		;YES.
	MOVEI	P1,DBLK		;DBLK IS WHERE WE WANT TO PUT IT.
NOPG:	SETZ	P4,		;NO PAGE WAS CREATED
IPG:	HRR	T0,P1		;WHERE IT GOES IN RIGHT HALF
	HRL	T0,P3		;LENGTH IN LEFT HALF OF T0
	MOVX	T1,IP.CFV	;GET PAGE MODE BIT
	ANDM	T1,SAVBLK	;CLEAR REST OF FLAG WORD
	EXCH	T0,SAVBLK+3	;USE IPCFQ. BLOCK
	MOVE	T1,[6,,SAVBLK]	;SET UP TO RECEIVE
	IPCFR.	T1,		;DO SO
IFN FTVM,JRST	CHKPAG		;COULD NOT  ;MAY BE RECOVERABLE
IFE FTVM,JRST	ERRRET		;COULD NOT  ;IS NOT RECOVERABLE
	EXCH	T0,SAVBLK+3	;RESTORE SAVBLK
	SKIPE	P4		;WAS THIS A PAGE?
	LSH	P1,^D9		;YES--CONVERT P1 TO AN ADDRESS
	JRST	.POPJ1		;AND DO A SKIP RETURN

	IFN	FTVM,<
;HERE IF IPCF RECEIVE FAILS.  MAY BE ABLE TO RECOVER BY PAGING SOMEONE OUT
CHKPAG:	SKIPE	P4		;PAGE MODE MESSAGE?
	CAXE	T1,IPCUP%	;YES--NO ROOM IN CORE MESSAGE?
	JRST	ERRRET		;NOT PAGE, OR NOT THAT ERROR
;NOW WE KNOW WE CAN RECOVER IF WE JUST PAGE SOMEBODY OUT.  BUT WHO?
	MOVEI	T1,17		;17 WORDS IN PAGE TABLE
	MOVEM	T1,PAGTAB-1	;STORE IN PAGE. UUO ARG LIST
	MOVX	T1,<.PAGWS,,PAGTAB-1>	;GET WORKING SET
	PAGE.	T1,
	 JRST	RETM2		;"IMPOSSIBLE"
	MOVEI	T1,0		;A FEW PAGES WE DON'T WANT TO PAGE OUT
	PUSHJ	P,CLRPBT	;E.G. PAGE 0
	MOVEI	T1,CHKPG1	;AND CRITICAL SECTION BELOW
	PUSHJ	P,CLRPBT
	MOVEI	T2,CHKPG2	;END OF CRITICAL SECTION
	PUSHJ	P,CLRPBT	;IN CASE CROSSES PAGE BOUNDARY
	HRLZI	T1,-17		;NOW SEARCH FOR FIRST PAGE IN WORKING SET
	SKIPN	T2,PAGTAB(T1)	;FIND NON-ZERO WORD
	AOBJN	T1,.-1
	JUMPGE	T1,RETM2	;NONE - IRRECOVERABLE
	JFFO	T2,.+1		;FIND NON-ZERO BIT IN THAT WORD
	TLZ	T1,-1		;T1 IS NOW HIGHORDER PART OF PAGE NO.
	IMULI	T1,^D36		;GET IT IN RIGHT PLACE
	ADD	T3,T1		;T3 IS LOWORDER, SO COMBINE
	TLO	T3,(1B0)	;ADD CODE TO PAGE IT OUT
	MOVEI	T2,1		;THAT ONE PAGE ONLY
	MOVX	T1,<.PAGIO,,T2>	;PAGE IT OUT
;BEGIN CRITICAL SECTION - BETTER NOT PAGE OUT ANY OF THIS STUFF, SINCE
;IF WE DID IT WOULD GET PAGED IN AGAIN!
CHKPG1:	PAGE.	T1,		;DO IT!
	  JRST	RETM2		;COULD NOT
	MOVE	T1,[4,,SAVBLK]	;TRY UUO AGAIN
	IPCFR.	T1,
CHKPG2:	  JRST	ERRRET		;FAILED AGAIN??
;END OF CRITICAL SECTION, SINCE IPCF HAS BEEN DONE
	EXCH	T0,SAVBLK+3	;RESTORE QUEUE INFO
	LSH	P1,^D9		;CONVERT PAGE # TO PAGE ADDRESS
	JRST	.POPJ1		;AND GIVE A GOOD RETURN

;CLRPBT - REMOVE BIT FROM PAGE MAP - T1=ADDRESS ON PAGE TO REMOVE
CLRPBT:	LSH	T1,-^D9		;MAKE ADDR INTO PAGE NO.
	IDIVI	T1,^D36		;T1=WORD IN MAP, T2=BIT
	MOVSI	T3,400000	;BIT MASK
	MOVNS	T2		;BIT NO. - NEG. FOR RIGHT SHIFT
	LSH	T3,(T2)		;NOW MASK RIGHT BIT
	ANDCAM	T3,PAGTAB(T1)	;CLEAR BIT IN MEMORY
	POPJ	P,

PGMS:	PUSHJ	P,GETPAG	;FIND A FREE PAGE
	  JRST	RETM2		;NONE?
	HRRZ	P1,P4		;STORE PAGE # IN P1
	JRST	IPG		;AND CARRY ON
> ;END OF IFN	FTVM

TOOBIG:	HRRZ	T2,P3		;GET # OF WORDS REQUIRED IN T2
	PUSHJ	P,GETCOR	;GET THAT MUCH CORE!
	  JRST	RETM2		;NONE?
	HRRZ	P1,T1		;SAVE ADDRESS IN P1
	JRST	NOPG		;AND CARRY ON
	SUBTTL	INTERNAL ROUTINE TO SAVE A MESSAGE.

;ROUTINE TRIES TO SAVE THE MESSAGE JUST READ.
;NEEDS ACS AS THEY ARE RETURNED FROM GETMES.
SAVMES:	SKIPE	T1,SAVNUM	;ARE WE SAVING ANYTHING?
	JRST	NOTFIR		;YES--NOT FIRST MESSAGE
	MOVEI	P2,MESTAB	;NO--INITIALIZE.
	MOVEM	P2,SVMES1	;STORE WHERE THE FIRST MESSAGE IS.
	JRST	BYPS1		;BYPASS UNNECESSARY CODE.
NOTFIR:	CAIL	T1,NUMMES	;IS THERE A FREE MESSAGE SLOT?
	  JRST	RETM6		;NOPE. RETURN -6 AS ERROR
	MOVE	P2,SVMESN	;GET LAST JOB USED
	CAIN	P2,MESTAB+<7*NUMMES>-7	;LAST SLOT?
	MOVEI	P2,MESTAB-7	;YES--NEXT IS FIRST
	ADDI	P2,7		;POINT TO NEXT SLOT.
BYPS1:	MOVEM	P2,SVMESN	;UPDATE LAST MESSAGE SAVED POINTER
	DMOVE	T0,SAVBLK	;GET FIRST 2 WORDS OF QUEUE INFO
	DMOVEM	T0,1(P2)	;STORE IN MESSAGE TABLE
	DMOVE	T0,SAVBLK+2	;GET NEXT 2 WORDS OF QUEUE ENTRY
	DMOVEM	T0,3(P2)	;STORE
	DMOVE	T0,SAVBLK+4	;GET LAST TWO WORDS
	DMOVEM	T0,5(P2)	;AND STORE THEM
	AOS	SAVNUM		;INCREMENT COUNT OF SAVED MESSAGES
	MOVEM	P1,(P2)		;ASSUME P1 IS ADR OF FINAL RESTING PLACE OF MESSAGE.
	CAIE	P1,DBLK		;IS MESSAGE AT DBLK?
	JUMPE	P4,.POPJ1	;NO.  IF NOT A PAGE, EITHER, WE NEED DO NO MORE
	HLRZ	T2,SAVBLK+3	;GET SIZE OF MESSAGE IN T2
	PUSHJ	P,GETCOR	;GET THAT MUCH CORE
	  JRST [SOS	SAVNUM	;NO CORE? THEN UNSAVE MESSAGE.
		JRST	RETM2]
	MOVEM	T1,(P2)		;STORE ADDRESS IN QUEUE
	ADDI	T2,-1(T1)	;T2 IS NOW ADDRESS OF LAST WORD OF NEW MESSAGE
	HRL	T1,P1		;T1 == OLD MESSAGE,,NEW MESSAGE
	BLT	T1,(T2)		;MOVE THE MESSAGE!
	JRST	.POPJ1		;AND GIVE A SKIP RETURN
	SUBTTL	END AND SUCH THINGS

;LITERALS

	XLIST
	LIT
	LIST

	END