Google
 

Trailing-Edge - PDP-10 Archives - custsupcuspmar86_bb-x130b-sb - sysinf.mac
There are 5 other files named sysinf.mac in the archive. Click here to see a list.
	TITLE	SYSINFO
	SUBTTL	T KORTEWEG/SMM/DD/MHK JUNE-8-79

	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


	SALL

	VMAJOR==3		;MAJOR VERSION NUMBER
	VEDIT==322		;EDIT NUMBER
	VMINOR==2		;MINOR VERSION NUMBER
	VWHO==0			;DIGITAL EQUIPMENT CORP

;COPYRIGHT (C) 1978  DIGITAL EQUIPMENT CORPORATION MAYNARD MASS.

	ENTRY	VERSION

VERSION:	PVER			;PROGRAM VERSION

;EDITING CONVENTION


;THE FORMAT OF A LINE IS:
; [LABEL:]<TAB>OPERATOR<TAB><OPERANDS><TAB(S)><COMMENT><CRLF>


;SYSINF HAS TO BE ASSEMBLED WITH A VERSION OF MACRO  SUPPORTING
;UNVERSAL FILES.THE FOLLOWING FILES ARE NEEDED:

;1.	  UNIVERSAL VERSION OF C FILE
;2.	UNIVERSAL VERSION OF [SYSTEM]INFO SYMBOLS
;EDIT HISTORY

;ALL VERSIONS UP TILL 43 WERE DEVELOPMENT VERSIONS USED STAND ALONE
;ON IN HOUSE SYSTEMS. VERSION 44 WAS THE FIRST VERSION ,WHICH
;HAD DAEMON AND [SYSTEM]INFO INTEGRATED.

;1 SETJOB FAILED CAUSING CRASHES HEN JOBS WITH A PID NOT ASSIGNED
;  BY [SYSTEM]INFO ASKED FOR SERVICE
;
;2 TASK CCONTEXT WAS SET UP INCORRECTLY IN STARTQ LOGIC CAUSING
;  ERROS IN SETJOB TO CAUSE ILLEGAL UUOS
;
;3 RESET UUO AND LOGOUT UUO PASSED DIFFERENT FLAGS IN THE PAST
;  THAN NOW (SIGN BIT FORMERLY) CAUSING JOBS TO BE REMEMBERED
;  ACROSS LOGOUTS
;
;4 MESSAGES TURNED AROUND BY [SYSTEM]INFO CAUSED DISASTER WHEN
;  THE MESSAGE CREATOR HAD DISAPPEARED.AS A CONSEQUENCE THROW NESSA
;  GES FROM [SYSTEM] INFPO AWAY.(USE JOBNO TOO)
;
;5 LEAVE MORE TRACES OF CRASHES BAD RECEIVE CODE CRASH REASON E.G.
;
;6 IF AN OWNER OF A PID REASKS A PID FOR HIS NAME THE RETURN HIM
;  HIS CURRENT PID



;162	THERE ARE RACE CONDITIONS BETWEEN USERS AND RESET OR LOGOUT
;	UUO.MAKE THE PROCESSING OF RESET AND LOGOU UUO'S THE LOWEST
;	PRIORITY JOB.WHEN DELAYING ALWAYS FLAG NEWNUM.
;NOTE:	THIS REQUIRES THAT IPCSER ALWAYS RESPONDS IMMEDIATELY TO IPCC
;	REQUESTS(WHY USE SENDS AT ALL?)

;163	MESSSAGES WAITING IN THE SEND Q TO JOBS WHOSE RECEIVE QUOTA
;	IS EXHAUSTED CAN SIT THERE FOREVER IF SYSINF IS NOT WAKED 
;	BY SOME IPCF ACTIVITY

;164	THE SNDTSK CLEARS THE JS.SND FLAG BUT DOES NOT RESET IT IF
;	A JOB DOES NOT ACCEPT INPUT YET

;165	THE PROCESSING OF DELAYED JOBS IS WRONG THIS EDIT IS NOT
;	MAKED IN THE LISTING.THE CONSEQUENCE WERE CIRCULAR LISTS.

;166	MEESAGES IN THE SEND Q FOR DROPPED PIDS AND LOGGED JOBS
;	SHOULD BE DISCARDED IMMEDIATELY THIS WILL PREVENT JOBS 
;	LOGGING IN UNDER THE SAME NUMBER NOT TO GET JUNK MAIL
;	AND WIIL PREVENT SENDTSK CALLS.NOTE JS.SND WILL NOT HURT

;167	THE JS.SND IS NOT SET WHEN A JOB ENTERS DATA IN SEND Q

;170	DO NOT SET JS.WAI BIT FOR  SENDS TO UNKNOWN PIDS

;271	TEST FOR PRIVILIGES IN THE USE OF PIDS OF THE FORM:
;	XXXX[SYSTEM] WAS WRONG
;272	(16286) PRIVILIGED FUNCTIONS DON'T PROPERLY CHECK PRIV'S
;	AREAS AFFECTED: IPCID AND IPCLQ
;273	(16281) REMOVE UNNEEDED BLOCK STAEMENT IN INIMOD
;274	REMOVE DUPLICATION OF C FILE SYMBOLS AND INTERNAL SYMBOLS
;275	ALLOW ZERO NAMES ON GET A PID CALLS 
;276	TREAT A REQUEST SENT AS APAGE IN THE FOLLOWING WAY:
;	RECEIVE THE PAGE AND USE THE FIRST PAKLEN WORDS AS A STAN-
;	DARD MESSAGE
;277	USE JOB NUMBER TO IDENTIFY DESTINATION AFTER DROPPING PID
;	AT USER'S REQUEST. SEE IPCID + 14 AND IPCRS + 7.

;300	DELAYED REQUESTS ARE TREATED AS SUCCESSFUL TRANSFERS.
;	SEE IPCSPS+14.
;301	WRONG ERROR CODES ARE EXTRACTED FROM ERRLST. CHANGE SNDPRB+2 & 3
;	CHANGE THE .TBYTE AT ERRLST

;302	EDIT 301 REQUIRES EPTR TO BE INTERNED

;303	SOME EDIT BETWEEN 271 AND 275 WAS WRONG.. CORRECT IT

;304	MAKE SYSINF LIKE ASCII STRING TERMINATED BY NULL BYTE, EVEN IF
;	JUNK FOLLOWS THE NULL.  ROUTINES AFFECTED:  PARSE, PARSE1.

;305	CORRECT SPELLING OF FAILURE IN MESSAGE
;306	REARRANGE REPEAT COUNT CALCULATIONS AT NM.IPF AND NM.INF
;	TO ALLOW MACRO TO ASSEMBLE THEM.
;307	MAKE THE SCHEDULAR DO RESET'S FIRST TO KEEP THE LIST
;	OF ASSIGNED PID'S STRAIGHT.
;310	ALWAYS SET THE TRUNCATE BIT FOR SHORT MESSAGES.
;311	MOVE ASCII STRINGS AROUND TO PRODUCE MORE EFFICIENT CODE.
;312	FIX UNECCESSARY QUEUE ERRORS BECAUSE EXTRANEOUS
;	FLAGS WERE LEFT SET IN THE LEFT HALF OF V AT IPCFL0.
;	CHANGE THE MOVE TO HRRZ V,BL.XTR(W)
;313	DELETE CODE FOR DAEMON-SYSINF INTEGRATION SINCE ITS
;	NOT SUPPORTED AND TAKES UP ROOM.
;314	WHEN INITIALIZING, VERIFY RESPONSES FROM IPCP ARE
;	WHAT WE EXPECT.
;315	TURN OFF FTFLOW AND MOVE MESSAGES MOVED IN EDIT 311 BACK.
;316	DO NOT ALLOW USERS TO REQUEST COPIES OF PACKETS TO BE SENT
;	TO OTHER EXEC PROCESSES SINCE THIS WILL CAUSE THE PROCESS
;	AND SYSINF TO LOOP FOREVER SENDING THE MESSAGES BACK AND FORTH.
;317	FIX EDIT 310 AREA AFFECTED GETIPC
;320	DON'T CONSTANTLY RUN IF MESSAGES STUCK IN THE SEND QUEUE.
;	AFTER TRYING TO SEND CALL THE NULL TASK.
;	AREAS AFFECTED: SCHTSK+3, SEND1+1
;321	SPR 10-29964		BCM	14-SEP-80
;	FIX SEARCHES TO GO TO UUOSYM & MACTEN, INSTEAD OF C.UNV
;	ALSO CHANGE IP.TTL TO REFERENCE IP.CFT INSTEAD
;322	NO SPR		RCB	27-AUG-84
;	DON'T EVEN ATTEMPT TO RUN UNDER 7.03, IT DOESN'T WORK.
;	DEFER TO THE NEW QSRINF UNDER NEW MONITORS.

;BECOME VERSION 3B FOR THE 7.03 GENERAL RELEASE

;END OF REVISION HISTORY

	PRGEND
	TITLE	INFEXC
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


;GLOBAL SYMBOLS
	ENTRY	INFEXC		;START UP POINT
	ENTRY	SCHED

	SUBTTL	TASK ORGANIZATION
	COMMENT &

TASKS ARE PROCESSES ,WHICH PERFORM THE FUNCTION REQUIRED
BY THE WORKQ ENTRIES
QUEUE PROCESSORS ARE PROCESSES CALLED BY THE SCHEDULER TO
EXTRACT ENTRIES FROM THE WORK QUEUES FOR PROCESSING
THE WHOLE QUEUE SYSTEM USES 2 LIST STRUCTURES:
1 A DOUBLE LINKED LIST
2 A SINGLE LINKED LIST
ALL LIST TERMINATE ON A ZERO.
THE LIST ENTRIES ALL HAVE AN IDENTICAL SIZE AND ARE OBTAINED
FROM GETBLK.ENTRIES MAY BE RETURNED BY INVOKING RETBLK.
THE ENVIRONMENT OF A TASK IS A SET OF DATA BLOCKS (NODES)
AND A STATUS REGISTER(PS),MOREOVER REGISTERS U,W AND M
ARE USED FOR SPECIAL DATA BLOCKS DURING THE ACTIVE PERIODS.
WHEN A TASK DIES (EXITS) ITS COMPLETE HISTORY DISAPPEARS.
TASKS MAY BE SUSPENDED AT TASK LEVEL( WITH RESPECT TO
THE STACK SITUATION) BY CALLING THE WAIT SCHEDULER DELAY.
WAITS ARE DUE TO THE NEED TO RECEIVE AN ANSWER FROM IPCF.
THE QUEUE PROCESSOR REQUE WILL RESTORE THE TASK ENVIRONMENT.
	&
	SUBTTL	START OF [SYSTEM]INFO

INFEXC:	JFCL			;NORMAL START
	JFCL			;CCL ENTRY
;RESTARTS START AT THE NEXT LOCATION
	JSR	SETSTA##	;ALLOW A RESTART
	MOVE	P,STACK##	;SET UP STACK
	MOVEI	V,INFBLK	;GET PARAMETER BLOCK
	CALL	INIMOD##	;INITILIZE THIS SA OF [SYSTEM]INFO
	CALL	NOOPT##		;APPARENTLY PSISER HAS PROBLEMS
	CALL	INIINF##	;CALL THE INITIALIZER
	MOVEI	T1,INFREN##	;RESTORE ADDRESS
	MOVEM	T1,.JBREN##	;SET REENTER ADDRESS
	PUSH	P,V		;SAVE IT TEMPORARILY
	MOVEI	V,DETING	;JUST IN CASE WE CAN.
	PJOB	T1,		;GET OUR JOB NUMBER
	TRMNO.	T1,		;GET OUR UDX
	JRST	NODET		;SOMETHING WRONG, FORGET IT.
	HRLZ	T1,T1		;GET UDX IN LEFT HALF.
	TLZ	T1,600000	;MAKE SURE ITS A LINE NUMBER ONLY.
	ATTACH	T1,		;   NOW!!!
	SKIPA			;OUGHT NOT TO HAPPEN.
	CALL	TYPOPR##	;TELL OPR WE DETACHED.
NODET:	POP	P,V		; RESTORE IT NOW.
	PJRST	SCHED		;AND GO TO SCHEDULER
DETING:	ASCIZ/	DETACHED.
/

	SUBTTL	TASK SCHEDULER

;SCHED SCHEDULE THE QUEUE TASKS
;NOTE:  1  THAT SCHTSK IS ALLWAYS SCHEDULED WHEN THE OTHER QUEUES ARE EMPTY
;	2  MESSAGES FOR A DELETED USER GO FROM THE OLD QUEUE TO THE
;	   END OF THE SEND QUEUE
;	3  THE SEND QUEUE HAS THE LOWEST PRIORITY
;
SCHED:	MOVEI	T1,SCHEDQ##	;GET QUEUE FOR SCHEDULING
SCHED0:	SKIPE	@(T1)		;ANY ENTRIES IN Q
	JRST	SCHED1		;YES PROCES THEM
	ADDI	T1,SCHSIZ##	;POINT TO THE NEXT TASKS
	JRST	SCHED0		;THE END OF THE QUEUE IS A TASK:
SCHED1:	CALL	@1(T1)		;INVOKE THE Q PROCESSOR
	JRST	SCHED		;AND SCAN THE QUEUES AGAIN

;SCHTSK IS THE NULL TASK
;THE CALL TO THIS TASK IS AFFECTED BY VARIABLE SCHNUM,WHICH IS ALLWAYS TRUE

SCHTSK::MOVX	T1,HB.IPC	;WAKE FOR IPC
	SKIPE	OLDNUM##	;[163]ANY SENDS WAITING?
	HRRI	T1,^D3000	;[163](YES) SLEEP 3 SECONDS THEN
	SKIPE	SNDNUM##	;[320] ANYTHING IN SENDQ?
	HRRI	T1,^D3000	;[320] YES, SLEEP A LITTLE
	HIBER	T1,		;HIBERNATE TILL WAKE UUO
	CALL	HIBERR##	;UUO ERROR
	SETOM	NEWNUM##	;ACTIVATE INPUT Q SCAN
	RETURN

;DAECHK CHECK IF DAEMON SHOULD PROCES INTERRUPT
;V CONTAINS ADDRESS XWD INTERRUPTTEXT,XXX'NPC
;WHERE XXX'NPC IS VALUE OF NPC ENTRY

DAECHK::RETURN		;IT IS SYSTEM INFO

INFBLK:			;[SYSTEM]INFO PARAMETER BLOCK
	SIXBIT	/SYSINF/	;PROGRAM NAME IS PASSWORD
	Z			;SEQUENCE NUMBER
	INFDIF			;TIME GUARD AGAINST LOOPS

	EXP	17		;DUMP MODE
	SIXBIT	/XPN/
	EXP	0		;NO HEADER

	SIXBIT	/INF/		;SEQ # WILL BE APPENDED
	SIXBIT	/XPN/
	BLOCK	2

	ASCIZ	/(SYSINF) /
	PRGEND	INFEXC
	TITLE	INIMOD
	ENTRY	INIMOD
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


;THIS MODULE INITS INTERRUPT TRAPPING FOR DAMAGING ERRORS
;AND SETS UP THE TAKINK OF AN EXPANDED CRASH FILE ON ERRORS AND
;SETS UP MESSAGE PRINT OUT
;THE FUNCTIONS TO BE PERFORMED BY THIS MODULE ARE:
;
;1	PREPARE MESSAGE PREFIX ??(DEAMON) TO BE WRITTEN TO OPR'S CTY
;2	PREPARE THE DUMPING OF FILES ANMED DAEXXX XXX=0-777 OCTAL
;	(EXTENSION XPN),WHICH CAN BE INVESTIGATED WITH FILDDT
;3	ENABLE ALL HORRIBLE INTERRUPT CONDITIONS
;4	INITIALIZE THE RESTART LOGIC PROTECTOR,AND SET OUR PASSWORD

INIMOD:	RESET			;RESET BEFORE ENABLING PSISER
	PUSH	P,P1		;SAVE A SACRED COW
	MOVE	P1,V			;COP PARAMETER
	MOVEI	V,.PREOF(V)		;POINT TO LINE PREFIX
	MOVSI	T1,(SIXBIT /OPR/)	;FOR CTY TEXT LINES
	CALL	SETOPR##		;PREPARE IT FOR LATER
	JFCL				;IGNORE FAILURE
	MOVEI	V,.BLKOF(P1)		;PASSWORD TIME INCR
	PJOB	T1,			;AND JOB NUMBER
	CALL	RUNNUM##		;OBTAIN RUN SEQ NUMBER
	CALL	NORUNU		;NO SEQ # NUMBER OBTAINED ABORT
	MOVE	V,.BLKOF+1(P1)		;GET SEQ NUMBER
	CALL	SIXNUM##		;CONVERT IT TO 6 BIT
	JFCL
	HRRM	T1,.FILOF(P1)		;CONSTRUCT CRASH NAME
	MOVEI	V,.DEVOF(P1)		;GET CRASH ADDRESS
	CALL	STCRSH##		;AND PREPARE THE CRASH
	JFCL				;OUR ADDRESS IS NOT ZERO
	CALL	ALERT			;THE INTERRUPT FACILITY
	SOS	-1(P)		;A NORMAL RETURN -+=0
	POP	P,P1		;GET THE PERMANENT ONE BACK
	JRST	CPOPJ1##
;ALERT SET UP INTERRUPT WORLD AND POINT TO THE INTERRUPT CODE
;XXX'INT  E.G. ILUINT FOR ILLEGAL UUO'S

	SUBTTL	INTERRUPT SET UP

ALERT:	MOVEI	T1,.INTVC	;BASE OF INTERRUPT VECTOR
	PIINI.	T1,		;INITIALIZE PSI SERVICE
	CALL	NOPSI		;NO PSI SYSTEM FOR ME
	SETINT	<ILU,ILM,ADC,PDL,NXM,EJE>
	XLIST
	LIST
	JRST	CPOPJ1##	;A SKIP RETURN
;ERRORS DURING INITIALIZATION

NORUNU:	MOVEI	V,TOSOON	;LET OPERATOR TRY
	CALL	TYPOPR		;TELL HIM
	JFCL			;IGNORE
	CALL	ZAPRUN##	;FORGET HISTORY
	JFCL
	MOVEI	T1,.GTPRG	;PROGRAM NAME TABLE
	PJOB	T2,		;GET OUR NUMBER
	HRL	T1,T2		;GET GETTAB VALUE
	GETTAB	T1,		;GET THE NAME
	JFCL
	CAME	T1,[SIXBIT /DAEMON/]	;THE MASTERMIND?
	EXIT			;NOTHING FATAL HAS HAPPENED YET
	MOVSI	T1,(SIXBIT /DAE/)	;CHANGE TO DAE
	SETNAM	T1,		;CHANGE MY NAME
	EXIT			;NOW TAKE AN EXIT

TOSOON:	ASCIZ	/CRASH RATE TOO HIGH CHANGE VERSION
/

NOPSI:	MOVEI	V,NOITXT	;NO INTERRUPT SYSTEM
	CALL	TYPOPR		;TEL OPERATOR
	JFCL			;IGNORE FAILURE
	PJRST	TPOPJ##		;POP OFF RETURN

NOITXT:	ASCIZ	/PSI INTERRUPTS COULD NOT BE ENABLED
/
	SUBTTL	INTERRUPT DATA

	INTV		;BASE OF INTERRUPT VECTOR

	.ENABLE	<ILU,ILM,ADC,PDL,NXM,EJE>
	XLIST
	LIST

INTLEN=:.-.INTVC	;FOR BLT IN WAKINT
	PRGEND
	TITLE	INFO
	ENTRY	INFO
INFO:

	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


;GLOBAL SYMBOL DEFINITIONS
;FORCE LOADING OF MODULES FOR ONCE ONLY CODE
	EXTERN	ADCENB,ILUENB,ILMENB,NXMENB,PDLENB,EJEENB
	SUBTTL	QUEUE PROCESSORS
	SUBTTL	ARRIVAL Q PROCESSOR

	SUBTTL	EMPTY THE RECEIVE QUEUE AND CLASSIFY THE ENTRIES
;NEWTSK IS THE HIGHEST PRIORITY JOB IN THE SYSTEM AS IT EMPTIES
;THE EXECC SPACE OF MESSAGES.  ITS MAIN TASK IS TO DISTRBUTE
;INCOMING MESSAGES OVER THE VARIOUS WORK QUEUES:
;(1) THE LOG OUT QUEUE L.LOG RECEIVES ALL .IPCIL REQUEST, THIS
;    IS REGARDED TO BE THE MOST URGENT REQUEST
;(2) THE RESET QUEUE L.RST RECEIVES ALL .IPCIR REQUESTS THIS
;    THE NEXT HIGHEST PRIORITY & .IPCID REQUESTS:
;(3) THE REQUE QUEUE L.RQE RECEIVES ALL IPCF ANSWERS TO
;    REQUESTS FOR MESSAGES MADE FOR OBJECT JOBS
;(4) THE UNDELIVERABLE QUEUE L.OLD THIS QUEUE RECEIVES ALL MESSAGES
;    DIRECTED TO A DELETED PID, THEY WILL PLACED IN THE SEND QUEUE
;    TO THE "SENDER" AND MARKED AS UNDELIVERABLE
;(5) THE MESSAGE QUEUE L.MESS THIS RECEIVES ALL NEW MESSAGE:
;    NOT GOING TO QUEUES 1-4

NEWTSK::SKIPE	V,RCVBLK##
	JRST	GETME0
	CALL	GETTWO##	;GET A NEW WORKBLOCK
	CALL	SPCERR##	;NO ONE IS AVAILABLE!
	MOVEM	V,RCVBLK##
GETME0:	MOVE	U,V		;GET ADDRESS IN GOOD REGISTER
	IFN	FTDEBUG,<
..GET0:	MOVS	T1,BL.SLN(V)	;GET THE CONJUGATED SLOT
	CAME	T1,V		;IS THE LIST CIRCULAR??
	JRST	NTX1		;IT IS OKAY
	MOVEI	V,.TX1		;GET TEXT ADDESS
	CALL	ECRSH##		;THIS IS A CRASH
TX1:	ASCIZ	/CIRCULAR LIST OF 1 ELEMENT
/
NTX1:
>
	SETZM	NEWNUM##	;CLEAR THE FLAG
	CALL	GETIPC		;GET A MESSAGE
	PJRST	GETME3		;RECEIVE UUO FAILED CHECK THE ERROR TYPE
	SETZM	RCVBLK##	;ZAP THE WORK BLOCK WE USED IT
	HLRZ	W,BL.SLN(U)	;GET ADDRESS OF MESSAGE BLOCK
	MOVE	T1,BL.UU1(U)	;GET THE SENDERS PID
	CAME	T1,MYJOB##	;DID A MESSAGE FROM ME COME BACK?
	CAMN	T1,MYPID##	;DID A TURNED AROUND MESSAGE COME BACK
	JRST	NEWTSK		;YES FORGET IT
	CAME	T1,IPCFPD##	;A MESSAGE FROM IPCF
	JRST	GETME1		;NO SEE IF IT IS FOR ME
;QUEUE MESSAGES FROM IPCF
; VERIFY THAT THE MESSAGE IS A RESPONSE TO A REQUEST
; AND PUT THE DELAYED JOB IN THE REQUE Q
;ELSE IT IS A REST OR LOGOUT REQUEST
	HLRZ	V,BL.COD(W)	;GET THE STAMPS
	CAIN	V,..LRG		;IS IIT LOGOUT
	JRST	GETME1		;YES I DO NOT USE 7777777
	JUMPE	V,GETME1	;IT IS NOT FOR A DELAYED JOB!
;V SHOULD BE AN OLD M BLOCK SEARCH IT
	MOVEI	L,L.DELAY##	;AND SEE IF IT IS IN THE
	CALL	SREMOV##	;DELAY QUEUE
	JRST	GETME1		;IT IS NOT FO A DELAYED JOB
	HLRZ	T1,BL.SLN(V)	;GET THE M DATA BLOCK
	LDB	T2,IP.CRE(U)	;GET THE ERROR CODE
	MOVEM	T2,BL.XTR(W)	;LEAVE THE MESSAGE
	EXCH	W,BL.SLN(T1)	;AND LINK IN THE REPLY
	PUSH	P,W		;SAVE THE OLD ANSWER BLOCK IF ANY
	EXCH	V,U		;RELEASE THE UUO BLOCK
	CALL	RETBLK##	;WHICH IS USELESS NOW
	POP	P,V		;GET OLD ANSWWER BLOCK BACK
	SKIPE	V		;AND IF IT EXISTED THEN
	CALL	RETBLK##	;RETURN IT
	MOVE	V,U		;GET THE OLD M REGISTER
	MOVEI	L,L.RQUE##	;GET THE REQUE Q
	JRST	GETME4
GETME1:	MOVE	T1,BL.UU2(U)	;GET THE RECEIVERS PID
	HRRZ	T2,BL.COD(W)	;GET REQUEST CODE
	CAILE	T2,MAXCOD	;IS THE CODE VALID
	SETZ	T2,		;NO POINT TO ERROR HANDLING TASK
	CAME	T1,MYPID##	;IS IT FOR ME?
	SKIPA	L,[L.OLD##]	;(NO) PUT IT ON THE OLD QUEUE
	HLRZ	L,TASK(T2)	;GET THE PROPER Q
GETME4:
	IFN	FTFLOW,<
	CAIE	L,L.OLD##	;GOING TO OLD Q??
	JRST	NTX2		;SKIP THE TRACE
	PUSH	P,V		;DO NOT CLOBBER IT
	MOVEI	V,TX2		;TEXT 2
	CALL	TYPOPB##	;WARN OPERATOR
	JFCL
	POP	P,V
	JRST	NTX2
TX2:	ASCIZ	/ENTERING ENTRY IN OLD Q]
/
NTX2:
>
	MOVE	V,U		;SET THE VALUE REGISTER
	CALL	APPEND##	;INSET MESSAGE IN THE PROPER Q
	JRST	NEWTSK		;GETALL MESSAGESS

;ERROR CHECKS ERRJB IS DUE TO ERROR RETURN WHEN LOGOUT DOES NOT 
;HIBER BEFORE ZEROING PIDTAB ENTRIES
GETME3:	MOVEM	T1,BADRCV##	;REMEMBER WHY!!
	CAIN	T1,IPCNP%	;A RECEIVE PROBLEM
	RETURN			;NO MORE MESSAGES
	CALL	RCVERR##	;YES
	SUBTTL	SEND Q PROCESSOR

;THE SEND Q RECEIVES THE FOLLOWING MESSAGES:
;1 MESSAGES ADDRESSED TO DISABLED USERS
;2 MESSAGES FOR USERS WHOSE QUOTA HAS BEEN EXCEEDED
;3 MESSAGES SENT WHEN [SYSTEM]INFO'S QUOTA WAS FILLED
;SNDTSK WILL TRY TO EMPTY THE Q MOREOVER IT WILL
;CLEAR OR SET THE SEND WAIT STATUS FOR JOBS
;NOTE: THIS COMPLEMENTS THE STANDARD SEND INTERFACE 

SNDTSK::IFN	FTFLOW,<
	PUSH	P,V		;SAVE THE REGISTER
	MOVEI	V,TX3		;TRACE TEXT
	CALL	TYPOPB##
	JFCL			;IGNORE FAILURE
	POP	P,V
	JRST	NTX3
TX3:	ASCIZ	/ENTERING SEND Q PROCESSOR]
/
NTX3:
>
	MOVE	J,JOBSCN##	;START SCANNING THE JOBTABLE
	MOVX	P1,JS.SND	;CLEAR THE SEND WAIT BIT
SEND0:	ANDCAM	P1,@JOBSTS##	;FOR ALL JOBS
	AOBJN	J,SEND0
	MOVEI	L,L.SEND##	;GET Q ADDRESS
	MOVEI	U,L.SEND##	;WE WILL LOOK AT THIS Q
SEND1:	HLRZ	U,BL.LNK(U)	;GET THE NEXT ENTRY
	JUMPE	U,SCHTSK##	;[320] ALL DONE, RETURN FROM NULL TASK
	MOVE	J,BL.UU2(U)	;GET THE RECEIVERS PID
	TDNN	J,PIDMSK##	;IS IT A PID OR JOB #
	JRST	SEND2		;A JOB NUMBER
	MOVE	V,J		;GET THE PID
	SETZ	J,		;[170]IN CASE WE DO NOT KNOW PID
	CALL	FNDPID		;FIND THE PID
	JRST	SEND3		;I DO NOT KNOW HIM SO SKIP JOB LOGIC
	LDB	J,[POINT 8,PIDFLG##(V),18]	;GET THE JOB NUMBER
SEND2:	TDNE	P1,@JOBSTS##	;IS THE JOB ALLREADY DELAYED(SENDS!!)
	JRST	SEND1		;YES DO NOT SEND
SEND3:	MOVEI	T1,BL.UU0(U)	;GET THE ADDRESS OF THE MESSAGE DATA
	HRLI	T1,PAKLEN	;SET THE STANDARD PACK LENGTH
	IPCFS.	T1,		;GO NOW
	SKIPA			;GO TO ERROR LOGIC
	PJRST	SEND4		;ALL WAS SENT
	CALL	SNDPRB		;ANALYZE THE SEND PROBLEM
	JFCL			;IGNORE FATAL ERRORS
	JRST	SEND4		;REMOVE THE ENTRIES
	JUMPE	J,SEND1		;[170]THIS IS NONE OF OUR BUSINESS
	IORM	P1,@JOBSTS##	;[164] REMEMBER THE WAIT STATE
	JRST	SEND1		;KEEP IT DELAYED
SEND4:	MOVE	V,U		;GET ADDRESS OF MESSAGE THAT WENT OUT
	CALL	REMOVE##	;AND GET IT OUT OF THE Q
	CALL	RETTWO##	;AND RETURN THE 2 BLOCKS
	JRST	SEND1		;PROCES THE WHOLE Q
	SUBTTL	RUN SUSPENDED TASKS
;RQETSK REVIVES TASKS DELAYED BY AN IPCF REQUEST
;IT REMOVES THE OLDEST ENTRY FROM THE QUEUE AND RESTORES
;THE SUSPENDED MESSAGE ENVIRONMENT (REGISTERS U,W,PS&M)
;

RQETSK::MOVEI	L,L.RQUE##	;GET THE REQUE Q'S ADDRESS
	CALL	REMOVT##	;TOP ONE HAS TO RUN!!!
	MOVE	M,V		;SET UP THE M REGISTER
	HRRZ	W,BL.SLN(M)	;AND THE WORK REGISTER
	HRRZ	U,BL.SLN(W)	;AND THE USER REGISTER
	MOVE	PS,BL.FLG(M)	;AND THE STATUS OF THE TASK
	TXZE	PS,FL.DLY	;REQUE FROM TASK CALL LEVEL
	PUSH	P,BL.PCR(U)	;YES THEN ONE STACK ENTRY MORE
	MOVE	J,BL.XTR(M)	;GET THE JOB NUMBER
	MOVX	T1,JS.DLY	;JOB DELAY BIT
	ANDCAM	T1,@JOBSTS##	;ZAP IT NOW
	HLRZ	T1,BL.SLN(M)	;GET THE  M DATA BLOCK ADDRESS
	HRRZ	T1,BL.SLN(T1)	;GET THE REPLY
	MOVE	T1,BL.XTR(T1)	;GET IPCF'S ERROR CODE
	SKIPN	T1		;ANY ERRORS DETECTED
	AOS	BL.PCO(M)	;NO SET A SKIP CONTINUE
REQUE0:	PUSH	P,BL.PCR(M)	;RESTORE THE CALLERS ENVIRONMENT
	PJRST	@BL.PCO(M)	;CONTINUE

;OLDTSK QUEUE L.OLD
;THIS TASK MASKS MESSAGES AS UNDELIVERABLE AN REROUTES THEM
;TO THE SENDER
OLDTSK::
	IFN	FTFLOW,<
	PUSH	P,V		;SAVE THE REGISTER
	MOVEI	V,TX4
	CALL	TYPOPB##
	JFCL
	POP	P,V		;GET REG BACK
	JRST	NTX4
TX4:	ASCIZ	/ENTERING OLD Q PROCESSOR]
/
NTX4:
>
	MOVEI	L,L.OLD##	;GET THE OLD MESSAGE
	CALL	REMOVT##	;REMOVE THE TAPE MESSAGE:
	MOVEI	T1,.IPCFN	;MESSAGE UNDELIVERABLE
	DPB	T1,IP.CMF(V)	;SET THE ERROR FIELD
	MOVE	T1,BL.UU1(V)	;GET SENDER
	MOVEM	T1,BL.UU2(V)	;MAKE HIM THE RECEIVER
	MOVE	T1,MYPID##	;IT COMES FROM ME
	MOVEM	T1,BL.UU1(V)	;THIS IS SENDER:
	MOVE	U,V		;U WILL BE SEND
	MOVEI	L,L.SEND##	;THE SEND Q
	PJRST	APPEND##	;TAKES CARE OF SENDING
	SUBTTL	SET UP LOGOUT RESET AND MESSAGE TASKS

	COMMENT	&
ALL PREVIOUS QUEUE PROCESSORS SIMPLY PERFORMED AN ACTION
ON THE Q ENTRY AND THAT WAS ALL TO BE DONE.THE Q PROCESSORS
MSSTSK AND RSTTSK HOWEVER START UP TASKS, WHICH CAN RUN INPARALLEL
WITH OTHER TASKS AND Q PROCESSORS.THIS OBVIOUSLY INTRODUCES THE POSSI
BILITY OF CONFLICTS. CONFLICTS COULD BE E.G. :
1. ASSIGN A NAME CAN BE EXECUTE 2 TASKS MAKING AN IDENTICAL
   REQUEST.
2. A JOB ASKS TO DROP HIS PIDS DOES NOT WAIT FOR THE ANSWER AND
  LOGS OUT. CAUSING THE POSSIBILITY OF CALLING DELPID FROM 2 SIDES.

PROBLEMS OF THESE TYPES FALL INTO 2 CATEGORIES:

1. REQ I AND REQUEST I+1 FROM JOB N CAN CONFLICT
2. REQ I FROM JOB N AND REQ J FROM JOB M WITH N .NEQ. M
   INTERFERE

THE PROBLEMS OF CATAGORY 1 ARE SOLVED BY SERIALIZING ALL REQUESTS
FOR JOB N IN SUCH A WAY,THAT REQUEST I WILL ONLY BE PROCESSED
IF THE PROCESSING OF REQUEST I-1 HAS BEEN COMPLETED.
IN THIS CODE THIS IS ACHIEVED BY THE USE OF THE BITS:
1. JS.WAI  JOB WAITS FOR TASK TO COMPLETE
2. JS.DLY  JOB HAS A SUSPENDED TASK

THE PROBLEMS OF CATEGORY 2 CAN ONLY BE DUE TO SHARED VARIABLES
BETWEEN THE TASKS.THE ONLY INTERFERING PART OF THE DATA BASE IS:
1. THE COMMON NAME TABLE
2. THE COMMON PID TABLE

NAME TABLE PROBLEMSARE PREVENTED BY MEANS OF THE CONCEPT OF INVISIBLE
NAMES.THIS MEANS NO USER CAN GET INFORMATION  ABOUT INVISIBLE NAMES.
ONLY THE NAME ALLOCATOR CAN SEE THESE NAMES.

PID TABLE ENTRIES ARE INTERFERENCE FREE DUE TO THE GUARANTEE OF
IPCF THAT IT WILL CREATE A UNIQUE PID FOR [SYSTEM]INFO
	&
	COMMENT	&

THE CODE ON THE NEXT 2 PAGES CAN BE DIVIDED IN 2 SECTIONS:
1. GUARANTEE THAT A TASK  IS SCHEDULED FOR AN UNDELAYED JOB
   IF THE JOB IS DELAYED THEN TRANSFER THE REQUEST TO THE
   WAIT QUEUE AND LINK IT IN THE JBWAIT Q TABLE.MOREOVER
   SET THE JS.WAI BIT

2. SET UP THE TASK CONTEXT.BLOCKS U,M,W AND STATUS PS.
	&

MSSTSK::SKIPA	L,[L.MESS##]	;TAKE INPUT FROM MESSAGE Q
RSTTSK::MOVEI	L,L.RST##		;TAKE THE RESET OR LOGOUT Q
	CALL	REMOVT##	;REMOVE THE OLDEST ENTRY
	MOVE	M,V		;COPY THE MESSAGE BLOCK ADDRESS
	CALL	GETBLK##	;GET  A WORK BLOCK
	CALL	SPCERR##	;THERE WERE NO MORE BLOCKS AVAILABLE
	MOVE	W,V		;IT IS THE WORK BLOCK ,WHICH WE GOT
	CALL	GETBLK##	;GET ANOTHER BLOCK
	CALL	SPCERR##	;SPACE TROUBLES CANNOT PROCEED
	MOVE	U,V		;THIS IS THE USER BLOCK
	SETZ	PS,		;START WITH A ZER STATUS
	HRRM	W,BL.SLN(M)	;POINT TO WORK BLOCK
	HRRM	U,BL.SLN(W)	;LINK TO USER BLOCK
	MOVE	J,BL.UU1(M)	;GET PID OF SENDER
	HLRZ	T1,BL.SLN(M)	;GET ADDRESS OF M DATA BLOCK
	PUSH	P,T1		;GET CALL VALUE OF PDL POINTR
	MOVEM	P,BL.XTR(T1)	;AND SET THE VALUE FOR ERRVAL
	POP	P,T1		;RETURN TO THE BASE LEVEL
	CAME	J,IPCFPD##	;IF IT IS IPCF THEN
	JRST	START3		;(NO) FIND JOB NUMBER
;THE ONLY IPCF REQUEST SCHEDULING A TASK IS THE RESET OR LOGOUT UUO!
	HLRZ	T1,BL.SLN(M)	;GET THE MESSAGE DATA
	HRRZ	J,BL.PID(T1)	;THIS SHOULD BE THE JOB NUMBER
	HRRZ	T1,BL.COD(T1)	;IF THIS IS THE RESET REQUEST
	CAIN	T1,.IPCSS	;CHECK IT
	JRST	STARTQ		;TRY TO START THE Q
	CALL	WRNUIF##	;UNKNOWN IPCF FUNCTION
	PJRST	FINIS0		;FINISH THE REQUEST
START3:	TDNN	J,PIDMSK##	;A REAL JOB NUMBER
	JRST	STARTQ		;YES ONLY MAKE DELAY TET
	CALL	FNDPID		;DO WE KNOW THE PID?
	JRST	START2		;IT IS NOT OUR PID
 	LDB	J,[POINT 8,PIDFLG##(T2),18]	;GET THE JOB NUMBER
	JRST	STARTQ		;MAKE THE DELAY TEST
START2:	CALL	SETJOB		;GET THE JOB NUMBER
	PJRST	FINISH		;AN ILLEGAL PID WAS GIVEN
;AT THIS POINT THE JOB NUMBER IS KNOWN AND MAY THR TASK BE STARTED

STARTQ:	MOVEM	J,BL.XTR(M)	;SAVE THE JOB NUMBER
	MOVE	T2,@JOBSTS##	;GET THE JOB STATUS
	TXNE	T2,JS.DLY	;IS JOB DELAYED
	PJRST	DLYRUN		;DELAY THE RUNNING OF THE TASK
;CONTINUE JOBS COMING OUT OF A WAIT HERE
CONTIN:	HLRZ	T1,BL.SLN(M)	;GET M'S DATA BLOCK
	HRRZ	T1,BL.COD(T1)	;AND NEXT THE USERS REQUEST CODE
	CAILE	T1,MAXCOD	;DID HE GIVE A VAILD ONE
	SETZ	T1,		;NO GIVE HIM THE ERROR TASK
	HRRZ	T1,TASK(T1)	;GET THE TASK ADDRESS
	CALL	<(T1)>		;AND CALL THE TASK
FINISH:	CALL	FINIS0		;GIVE STORAGE BACK
	MOVX	P1,JS.WAI	;IS THE JOB WAITING??
	TDNN	P1,@JOBSTS##	;(J HAS JOB NUMBER!)
	RETURN			;(NO) ALL SET
	MOVE	L,JBWAIT##	;(YES) GET LIST OF WAIT QUESUES
	ADD	L,J		;ADD .J
	ADD	L,J		;.JBWAIT+2*.J IS Q HEADER
	CALL	REMOVT##	;REMOVE THE OLDEST ONE
	SKIPN	LI.NUM(L)	;ARE THERE MORE IN Q??
	ANDCAM	P1,@JOBSTS##	;(NO) ZAP THE FLAG
	MOVE	M,V		;GET MESSAGE BLOCK BACK
	HRRZ	W,BL.SLN(M)	;GET WORK BLOCK ADDRESS
	HRRZ	U,BL.SLN(W)	;AND USER BLOCK
	SETZ	PS,		;START WITH A CLEAN SLATE
	JRST	CONTIN		;AND CONTINUE THE JOB

FINIS0:	HLRZ	U,BL.SLN(M)	;GET THE RIGHT BRANCH OF THE TREE
	CALL	DROPBR		;DROP THE BRANCH
	MOVE	U,M		;NEXT THE RIGHT BRANCH
;	PJRST	DROPBR		;DROP THE BRANCH
DROPBR:	JUMPE	U,CPOPJ##	;IS IT AN EMPTY LIST
	HRRZ	V,U		;(NO) PREPARE THE DELETE
	MOVE	U,BL.SLN(V)	;GET THE NEXT BLOCK
	CALL	RETBLK##	;RETURN THE BLOCK
	JRST	DROPBR		;DROP THE REST


	SUBTTL	TASK DATA BLOCK

;THE TABLE TASK IS USED FOR 2 PURPOSES:
;(1) THE LEFT HALF CONTAINS THE Q FROM WHICH WORK ENTRIES COME
;(2) THE RIGHT HALF GIVES THE ADDRESS OF THE PROCESS

TASK:	L.MESS##,,TSKERR		;BAD CODE ERROR NO TASK
	L.MESS##,,IPCIW		;(1) WHAT IS PID
	L.MESS##,,IPCIG		;(2) WHAT IS NAME OF PID
	L.MESS##,,IPCII		;(3) GET PID UNTIL RESET
	L.MESS##,,IPCIJ		;(4) GET PID UNTIL LOGOUT
	L.MESS##,,IPCID		;(5) DROP A NAME USER FUNCTION
	L.MESS##,,IPCRS		;(6) DROP ALL PIDS VALID UNTIL RESET 
	L.MESS##,,IPCLQ		;(7) DROP ALL PIDS ASSOCIATED WITH THIS JOB
	L.MESS##,,TSKERR	;(10) UNDEFINED
	L.MESS##,,TSKERR	;(11) UNDEFINED
	L.MESS##,,TSKERR	;(12) UNDEFINED
	L.MESS##,,TSKERR	;(13) UNDEFINED
	L.MESS##,,TSKERR	;(14) UNDEFINED
	L.RST##,,.RESET		;(15) SIGNAL FROM RESET OR LOGOUT UUO
MAXCOD=.-TASK-1

;ALL ILLEGAL FUNCTION CODES COME HERE

TSKERR:	PJRST	BADFUN		;A BAD FUNCTION
	SUBTTL	GET A JOB NUMBER FOR AN UNKNOWN PID

;THIS TASK FINDS THE JOB NUMBER FOR AN UNKNOWN PID
;THERE ARE TWO RETURNS:
;(1) NORMAL SETJOB LOST NO JOB# FOUND
;(2) SKIP RETURN JOB NUMBER IS IN J
;THE PID WHOS PID HAS TO BE FOUND IS IN J
;THIS TASK WILL SEND THE USER AN ERROR MESSAGE IF NEEDED

SETJOB:	MOVEI	T1,.IPCSJ	;GET JOB# OF PID
	HRL	T1,M		;AND ADDRESS OF MESSAGE BLOCK
	MOVEM	T1,BL.COD(U)	;SET THE FUNCTION
	MOVE	T1,BL.UU1(M)	;GET THE SENDER
	MOVEM	T1,BL.PID(U)	;AND PUT IT IN PID FIELD
	SETZM	BL.STR(U)	;ZAP THE JOB FIELD
	CALL	IPCSPS		;A PRIVILIGED SEND
	PJRST	IPCFLS		;A FATAL SEND ERROR
	PJRST	IPCFLS		;EVEN A RECOVERABLE ONE LOOSES
	SETZM	J		;ZAP THE JOB NUMBER
	CALL	DELAY		;AND WAIT SOME TIME
	PJRST	NOHELP		;NO HELP FOR THIS MAN
	HLRZ	T1,BL.SLN(M)	;GET ADDRESS OF M DATA BLOCK
	HRRZ	T1,BL.SLN(T1)	;AND GET ADDRESS OF IPCF'S REPLY
	MOVE	J,BL.STR(T1)	;AND GET THE JOB NUMBER
	JUMPE	J,NOHELP	;NULJOB DOES NOT USE [SYSTEM]INFO
	PJRST	CPOPJ1##

	SUBTTL	DELAY OF TASKS FOR DELAYED JOBS

DLYRUN:	MOVX	T1,JS.WAI	;JOB IS WAITING
	IORM	T1,@JOBSTS##	;SET IT IN THE JOB
;FIRST BUILD THE JOBS WAIT Q , THIS STORES EQUESTS IN THE ORDER
;OF ARRIVAL AND EXTRACTS THEM LATER IN THAT ORDER(FIFO)

	MOVE	L,JBWAIT##	;COMPUTE Q HEADER
	ADD	L,J		;START + JOB NUMBER
	ADD	L,J		;*2
	MOVE	V,M		;GET AMIN BLOCK
	PJRST	APPEND##	;AND APPEND IT
	SUBTTL	GET PID OF NAME PROCESSOR

;GET THE NAME OF A PID OR WHO IS?
;ERROR EXITS:
;1 A BAD NAME
;2 NONAME

IPCIW:	CALL	PARSE		;REDUCE THE NAME TO A CANONICAL FORM
	PJRST	BADNAM		;IT IS A BAD ONE
	CALL	SEARCH		;SEE IF WE! NOW THE PID
	PJRST	NONAME		;(NO) NOT YET THERE
	PUSH	P,BL.PID(V)	;SAVE THE PID FROM THE NAME BLOCK
;
;IPCIW0 IS CALLED FROM IPCIJ WHEN A JOB OWNING A NAME 
;REASKS FOR A PID

IPCIW0:	CALL	SETANS		;SETUP THE ANSWER
	POP	P,BL.PID(W)	;AND STORE IT IN THE ANSWER
	HRLI	T1,PAKLEN	;LENGTH  IS A PACKET
	HLLM	T1,BL.UU3(V)	;SET THE LENGTH OF THE ANSWER
	PJRST	SENDU		;AND EXIT AFTER SENDING IT TO THE USER
	SUBTTL	GET THE NAME OF A PID IN CANONICAL FORM

;GET THE NAME OF A PID AND ROUT THE ANSWER TO THE SENDER
;OR THE DESIGNATED RECEIVER (WORD 1)

IPCIG:	HLRZ	T2,BL.SLN(M)	;GET DATA BLOCK ADDRESS
	MOVE	V,BL.STR(T2)	;GET THE PID  WHOSE NAME IS REQUESTED
	CALL	FNDPID		;SEE IF WE KNOW THE PID
	PJRST	BADPID		;TOO BAD YOU LOOSE

;FROM THIS POINT ON DROP THE CONTENT OF THE U REGISTER
;AND USE IT FOR BETTER PURPOSES

	HRRZ	U,@PIDFLG##	;GET THE ADDRESS OF THE NAME BLOCK
	CALL	SETANS		;GET THE ANSWER BLOCKS
	MOVSI	T1,BL.STR(U)	;GET THE START ADDRESS OF THE NAME FIELD
	HRRI	T1,BL.STR(W)	;ADDRESS OF REPLY BLOCK
	MOVE	T2,T1		;NO BLT PROBLEMS
	BLT	T1,NM.NAM-1(T2)	;TRANSFER THE NAME
	MOVE	T1,BL.PID(U)	;GET THE PID WHOSE NAME WE FOUND
	MOVEM	T1,BL.PID(W)	;AND INSERT IT IN THE USERREPLY BLOCK
	MOVEI	T1,PAKLEN	;LENGTH OF A LONG PACKET
	HRLM	T1,BL.UU3(V)	;SET THE PROPER LENGTH
	PJRST	SENDU		;EXIT VIA THE SEND TO HE USER
	SUBTTL	CREATE PIDS FOR NAMES

IPCII:	TXO	PS,FL.RST	;FLAG THAT PID IS VALID UNTIL RESET
IPCIJ:	CALL	CHECKQ		;DO A QUOTA CHECK
	PJRST	QUOLOW		;YOU HAVE NO MORE TO ASK
	CALL	PARSE		;PARSE THE NAME
	PJRST	BADNAM		;THE NAME IS BAD
	CALL	CHKACC		;SEE IF WE MAY USE THE NAME
	PJRST	NOPRIV		;TOO BAD IT IS NOT FOR YOU
	TXO	PS,FL.INV	;WE MUST SEE ALL ENTRIES!!
	CALL	SEARCH		;NEXT SEARCH THE NAME
	JRST	IPCIJ1		;IT DID NOT EXIST YET
	MOVE	V,BL.PID(V)	;GET THE PID
	PUSH	P,V		;SAVE THE PID VALUE
	CALL	FNDPID		;GET PID INDEX IN V
	JRST	IPCIJ0		;SHOULD NOT HAPPEN SO LOOSE
	LDB	T1,[POINT 8,@PIDFLG##,17]	;GET JOB OWNING PID
	CAMN	T1,J		;IS THE OWNER REASKING?
	PJRST	IPCIW0		;YES RETURN THE PID
IPCIJ0:	POP	P,V		;CLEAN UP STACK
	PJRST	DUPNAM		;AND REPORT ERROR
IPCIJ1:	MOVEI	T1,.IPCSC	;CREATE A PID
	HRL	T1,M		;REMEMBER THE TASK DATA
	MOVEM	T1,BL.COD(U)	;THIS IS THE REQUEST
	TXNE	PS,FL.RST	;VALID UNTIL RESET
	TXO	J,SIGN		;YES SET THE SIGN BIT FLAG
	MOVEM	J,BL.PID(U)	;SET THE REQUEST DATA
	MOVE	J,BL.XTR(M)	;GET THE JOB NUMBER BACK
	SETZM	BL.STR(U)	;AND ZAP THE PID FIELD
	CALL	IPCSPS		;A PRIVILIGED SEND TO IPCF
	PJRST	IPCFLS		;A LOSER A LOSER,THAT'S WHAT YOU ARE
	PJRST	IPCFLS		;THE SAME REFRAIN
	CALL	ADDNAM		;ADD THE  NAME INVISIBLE!!!
	CALL	DELAY		;DELAY THE TASK UNTIL THERE IS GOOD OR BAD NEWS
	PJRST	IPCFL0		;IPCF LOST
	CALL	ADDUSR		;ADD NAME AND PID TO THE LIST
	PJRST	CNTNTR		;INTERNAL PROBLEMS
	CALL	SETANS		;PREPARE THE ANSWER V & W BLOCK
	HLRZ	T1,BL.SLN(M)	;GET THE M DATA BLOCK
	MOVE	T1,1(T1)	;GET THE LINK TO THE REPLY
	MOVE	T1,BL.STR(T1)	;GET THE PID OF THE USER
	MOVEM	T1,BL.PID(W)	;SET THE PID FIELD IN THE ANSWER
	PJRST	SENDU		;SEND THIS TO THE USER

IPCFL0:	HRRZ	V,BL.XTR(W)	;GET THE NAME BLOCK
	MOVEI	L,L.NAME##	;IT IS IN THE NAME Q
	CALL	SREMOV##	;SEARCH IT AND REMOVE
	CALL	QUEERR##		;IT IS A QERROR
	CALL	RETBLK##	;GIVE THE BLOCK BACK
	PJRST	IPCFLS		;LOOSER
	SUBTTL	DROP A NAME FOR A USER

;DROP  A NAME IS USER FUNCTION THIS FUNCTION IS ONLY ALLOWED TO
;THE OWNER OF THE NAME!!

IPCID:	HLRZ	T1,BL.SLN(M)	;GET M'S DATA BLOCK
	MOVE	V,BL.STR(T1)	;GET THE PID  TO BE DROPPED
	CALL	FNDPID		;SEARCH IT IN THE LIST
	PJRST	BADPID		;YOU LOOSE IT DOES NOT EXIST
	HRRZ	T2,V		;GET THE TABLE INDEX
	HLRZ	T1,@PIDFLG##	;GET THE JOB INDEX
	AND	T1,JOBMSK##	;BY MASKING OTHER DATA
	CAMN	T1,J		;IS THIS THE OWNER
	JRST	IPCID1		;(YES) OKAY
	CALL	IPCPC		;SEE IF PRIVILIED
	PJRST	NOPRIV		;NO NO PRIVILIGES
IPCID1:	CALL	IPCD1		;DELETE THE ENTRY
	PJRST	IPCFLS		;IPCF LOST
	CALL	SETANS		;RETURN THE QUESTION
	MOVEM	J,BL.UU2(V)	;[276] USE JOB # FOR DESTINATION
	PJRST	SENDU		;AND BACK IT GOES
	SUBTTL	DROP PIDS ASSIGNED UNTIL A RESET OR LOGOUT
;THESE FUNCTIONS ARE ONLY ALLOWED TO THE OWNER OF THE PIDS

IPCRS:	TXO	PS,FL.RST	;UNTIL REST 
IPCLQ:	HLRZ	T1,BL.SLN(M)	;GET M DATA BLOCK ADDRESS
	CAMN	J,BL.STR(T1)	;IS THIS THE OWNING JOB
	JRST	IPCLQ1		;(YES) GO ON
	CALL	IPCPC		;OR PRIVILIGED
	PJRST	NOPRIV		;NO NOT ALLOWED
IPCLQ1:	CALL	DELPID		;DELETE AL THE PIDS
	PJRST	IPCFLS		;WE LOST
	CALL	SETANS		;PREPARE THE ANSWER
	MOVEM	J,BL.UU2(V)	;[276] USE JOB # FOR DESTINATION
	PJRST	SENDU		;AND SEND IT TO THE USER


;ROUTINE TO CHECK IF USER IS PRIVILED 
;A USER IS PRIVILIGED IF:
;1 HE HAS POKE OR IPCF PRIVILIGES
;2 RUNS WITH JACCT ON
;3 HAS THE OPRPPN
;RETURNS: NORMAL IF UNPRIVILIGD
;	  SKIP   IF PRIVILIGED

	JACCT==1
IPCPC:	PUSH	P,T1		;GET A SCRATCH
	HRRI	T1,.GTPRV	;PRIVILIGE CHECK
	HRL	T1,J		;GET JOB NUMBER
	GETTAB	T1,		;GET PRIVILIGE BITS
	MOVEI	T1,0		;ERROR RETURN ASSUME NONE
	TXNE	T1,JP.IPC!JP.POK	;POWERFULL?
	PJRST	TPOPJ1##	;ALL SET
	HRL	T1,J		;GET JOB NUMBER
	HRRI	T1,.GTSTS	;GET STATUS
	GETTAB	T1,
	MOVEI	T1,0		;ERROR ASSUME ZERO
	TLNE	T1,JACCT	;JACCT IS GOOD TOO
	PJRST	TPOPJ1##	;YOU WIN
	HRRI	T1,.GTPPN	;GET THE PPN
	HRL	T1,J		;GET JOB NUMBER
	GETTAB	T1,
	MOVEI	T1,0		;ERROR SOS TAKE ZERO
	CAMN	T1,OPRPPN##	;OPR? 
	JRST	TPOPJ1##	;SKIP RETURN ALLOAKY
	PJRST	TPOPJ##
	SUBTTL	LOGOUT OR RESET DROP PID REQUESTS

;LOGOUT AND RESET BOTH SIGNAL THE SAME OPERATION TO [SYSTEM]INFO
;HOWEVER THE LOGOUT AND RESET SIGNAL DISTINGUISH
;THEMSELVES BY THE LEFTHALF OF THE CODE ORD OF THE REQUEST:
;LEFT  HALF  0 REQUEST FROM RESET
;RIGHT HALF -1 REQUEST FROM LOGOUT


.RESET:	HLRZ	T1,BL.SLN(M)	;GET ADDRESS OF THE M DATA BLOCK
	MOVSI	T2,IP.PDL	;LOGOUT FLAG NOT -1
	TDNN	T2,BL.PID(T1)	;IS IT A RESET UUO REQUEST?
	TXOA	PS,FL.RST	;YES FLAG IT
	CALL	SNDDJB		;DELETE MESSAGES FOR JOB
	CALL	DELPID		;DELETE THE PIDS
	JFCL			;IGNORE THE ERROR AND WAKE ANYHOW
	MOVEM	J,BL.PID(U)	;JOB TO WAKE
	MOVEI	T1,.IPCSW	;WAKE CODE
	HRL	T1,M		;MESSAGE
	MOVEM	T1,BL.COD(U)	;SET THE FUNCTION
	CALL	IPCSPS		;WAKE THE JOB
	RETURN			;A FATAL ERROR OR NO RESET
	RETURN			;A RECOVERABLE SEND ERROR
	CALL	DELAY		;WAIT FOR THE ANSER
	RETURN			;IGNORE
	RETURN				;JOB HAS BEEN WAKED
	SUBTTL	SCHEDULE A WAIT FOR A JOB
;DELAY IS CALLED WHEN A JOB HAS TO WAIT FOR AN ANSWER FROM
;IPCF AND THE CALLER IS AT TASK LEVEL
;DELAYC IS CALLED FROM CODE CALLED BY A TASK

;CALLING SEQUENCE
;	CALL	DELAY
;	RETURN WITH ANSWER
;THE CALL MUST BE DONE AT TASK LEVEL!!
;

DELAYC:	TXO	PS,FL.DLY	;CALL FROM CALLED LEVEL
	POP	P,BL.PCO(M)	;THE CONTINUE PC
	POP	P,BL.PCR(M)	;THE RETURN TO THE TASK INITIATOR
	POP	P,BL.PCR(U)	;THE RETURL TO TASK LEVEL
	JRST	DELAY1		;RESCHEDULE
DELAY:	POP	P,BL.PCO(M)	;PC TO CONTINUE
	POP	P,BL.PCR(M)	;RETURN PC TO TASK CALLER
DELAY1:	MOVEM	PS,BL.FLG(M)	;SAVE THE TASK FLAGS
	JUMPE	J,DELAY2	;DO NOT FLAG AS DELAYED SETJOB
	MOVX	T2,JS.DLY	;AND GET THE DELAY FLAG
	IORM	T2,@JOBSTS##	;INDECED BY T1
DELAY2:	SETOM	NEWNUM##	;[162]GURANTEE THE RECEIVING OF THE ANSER
	MOVEI	L,L.DELAY##	;GET ADDRESS OF DELAY LIST
	MOVE	V,M		;GET THE TASK ENVIRONMENT
	PJRST	APPEND##	;AND RETURN VIA THE APPEND
	SUBTTL	QUOTA CHECKING AND ALLOCATION

;CHECKQ	 CHECK QUOTA OF USER
;THE RIGHT HALF OF THE JOBSTS CONTAINS THE QUOTA INFO
;BITS 18-26 CONTAIN THE MAXIMUM NUMBER OF PIDS ALLOWED
;BITS 27-35 CONTAIN THE NUMBER OF PIDS IN USE

CHECKQ:	LDB	T1,[POINT 9,@JOBSTS##,26]	;MAX QUOTA
	LDB	T2,[POINT 9,@JOBSTS##,35]	;IN USE
	CAME	T1,T2		;EQUAL IS ALLREADY WRONG
	PJRST	CPOPJ1##	;GIVE THE OKAY EXIT
	RETURN			;WRONG


;ADD A PID TO A USERS ACCOUNT

ADDQ1:	AOS	@JOBSTS##	;INCREMENT THE BYTE
	RETURN


;DELQ1 DELETE ONE FROM THE QUOTA

DELQ1:	SOS	@JOBSTS##	;DECREMENT THE USED COUNT
	RETURN

;INIQUO  INIT THE QUOTA SYSTEM 2 PER JOB IN FIRST VERSION
;LATER DIFFERENTLY

INIQUO::MOVEI	T1,2000		;2 IS INITIAL QUOTA
	MOVE	J,JOBSCN##	;SCANNER OF JOB TABLES
INIQU0:	HRRM	T1,@JOBSTS##	;STORE THE ORIGINAL VALUE
	AOBJN	J,INIQU0	;STORE THE INITIALVALUE
	RETURN
	SUBTTL	ENTER A PID AND NAME

;ADDUSR AD A CHECKED USER TO THE SYSTEM
;W CONTAINS A NAME BLOCK
;THE REPLY BLOCK CONTAINS THE PID

ADDUSR:	HLRZ	T1,BL.SLN(M)	;GETS M DATA BLOCK
	MOVE	T1,BL.SLN(T1)	;GET THE REPLY BLOCK
	MOVE	T1,BL.STR(T1)	;GET THE PID
	MOVE	T2,BL.XTR(W)	;ADDRESS OF TEMPORARY NAME
	MOVEM	T1,BL.PID(T2)	;SAVE THE PID VALUE
	TXZ	PS,FL.INV	;MAKE NAME AVAILABLE
	HLLM	PS,BL.XTR(T2)	;AND SET THE NAME FLAGS
	CALL	INSPID		;STORE THE PID
	CALL	ADDQ1		;AD 1 TO QUOTA
	PJRST	CPOPJ1##


;SENDS TO IPCF ARE ALWAYS MADE BY MEANS OF MYBLOK
;AFTER INITIALIZATION OF THIS BLOCK, THE ONLY ONLY THINGS WHICH NEED TO
;BE SET ARE:
;1 THE EVENTUALLY NEEDED PRIVILEGE BIT:  (USE ENTRY IPCSPP)
;2 THE CONTENT OF WORD 0 OF THE PACKET
;3 THE CONTENT OF WORD 1 OF THE PACKET
;4 THE CONTENT OF WORD 2 OF THE PACKET
;THERE ARE 3 RETURNS:
;(0) FATAL SEND ERROR
;(1) RECOVERABLE SEND ERROR
;(2) CALL WAS SUCCESSFUL.

IPCSPS::SKIPA	T1,[400000]	;FLAG THE PRIVILEGE
IPCSND:	SETZ	T1,		;FLAG THE UNPRIVILEGED SEND
	MOVEM	T1,MYBLOK##	;SET THE FLAG WORD IN UUO BLOCK
	MOVE	T1,BL.COD(U)	;COPY THREE
	MOVEM	T1,MYCODE##	;WORDS FROM THE
	MOVE	T1,BL.COD+1(U)	;ARGUMENT BLOCK
	MOVEM	T1,MYCODE##+1	;TO THE SEND BLOCK
	MOVE	T1,BL.COD+2(U)	;FOR IPCF
	MOVEM	T1,MYCODE##+2
	MOVEI	T1,MYBLOK##	;GET THE ADDRESS
	HRLI	T1,4		;AND THE LENGTH OF THE UUO BLOCK
	IPCFS.	T1,		;AND SET IT
	;	PJRST	SNDPRB	;[300] ***DELETED
	;	PJRST	CPOPJ2##;[300]***DELETED
	SKIPA			;[300]
	PJRST	CPOPJ2		;[300] ALL IS OK
	CALL	SNDPRB		;[300] ANALIZ THE ERROR
	RETURN			;[300] FATAL SEND ERROR
	PJRST	CPOPJ1		;[300] IGNORE
	PJRST	CPOPJ1		;[300] DELAYED PACKET
	SUBTTL	SEND INTERFACE FOR USERS WITH IPCF

;SENDU IS USED TO SEND GOOD ANSWERS TO USERS,IT WILL
;GET IN THE REGISTERS V AND W RESPECTIVELY
;A UUOBLOCK TO SEND TO ORIGINAL SENDER
;A DATA BLOCK COMPLETELY READY
;AFTER SENDING TO THE ORGINAL SENDER OPTIONALLY AN
;ANSWER IS SHIPPED TO AN ALTERNATIVE TARGET


SENDU:	HLRZ	T1,BL.SLN(M)	;M DATA BLOCK
	SKIPE	T1,BL.PID(T1)	;AN OPTIONAL TARGET??
	CALL	SENCOP		;YES MAIL A COPY
	CALL	SENDIT		;SEND THE BLOCKS OR PUT THEM INTHE Q
	RETURN


SENCOP:	MOVEI	T2,.GTSID	;SPECIAL PID TABLE VALUE
NXTSPD:	PUSH	P,T2		;WE WILL ITERATE ON THIS VALUE
	GETTAB	T2,		;GET A SPECIAL PID
	  JRST	SNDCP1		;NO MORE SEARCHING NEEDED- REQUEST OK.
	CAMN	T1,T2		;COPY TO A SPECIAL PID?
	JRST	T2POPJ		;YES, CAN'T COPY AN EXEC PROCESS
	POP	P,T2		;NO, GET ANOTHER SPECIAL PID
	MOVSS	T2		;ADD 1 TO THE LEFT HALF
	ADDI	T2,1		;  TO GET THE NEXT ENTRY
	MOVSS	T2		;  IN THE SPECIAL PID TABLE.
	JRST	NXTSPD		;COMPARE REQUEST TO NEXT SPECIAL PID
T2POPJ:	POP	P,T2		;RESTORE STACK
	RETURN
SNDCP1:POP	P,T2		;RESTORE STACK
	PUSH	P,V		;SAVE THE
	PUSH	P,W		;ORIGINAL DATA
	PUSH	P,T1		;,,
	CALL	GETTWO		;GET 2 BLOCKS
	CALL	SPCERR##	;THERE IS NO MORE CORE
	POP	P,T4		;GET
	POP	P,T2		;ADDRESSES
	POP	P,T1		;BACK
	HRLI	T3,2(T1)	;SOURCE BLOCK
;NOTE: THAT THE LINK AREA IS EXCEPTED FROM THE BLT!!
	HRRI	T3,2(V)		;TARGET BLOCK
	BLT	T3,LI.SIZ-1(V)	;COPY THE BLOCK
	MOVEM	T4,BL.UU2(V)	;SET THE OPTIONAL RECEIVER
	HRLI	T3,2(T2)	;SOURCE BLOCK
;NOTE: EXCEPT THE LINK AREA FROM THE BLT
	HRRI	T3,2(W)		;TARGET BLOCK
	BLT	T3,LI.SIZ-1(W)	;COPY THE BLOCK
	MOVEI	T3,BL.COD(W)	;MESSAGE
	HRRM	T3,BL.UU3(W)	;STORE THE ADDRESS
	PUSH	P,T1		;SAVE THE ORIGINAL
	PUSH	P,T2		;ADDRESSES
	CALL	SENDIT		;SEND THE MESSAGE TO THE DESTINATION
	POP	P,W
	POP	P,V
	RETURN

;SENDIT USES J TO CHECK WHETHER THE JOB IS IN A SEND WAIT

SENDIT:	MOVE	T1,@JOBSTS##	;GET THE JOB STATUS
	TXNE	T1,JS.SND	;IS THE JOB NOT LISTENING
	JRST	NOSEND		;YES DO NOT SEND YET
	MOVEI	T2,BL.COD(W)	;ADDRESS OF MESSAGE
	HRRM	T2,BL.UU3(V)	;LINK THE MESSAGE PACKET
	MOVSI	T2,400000	;DO NOT BLOCK
	MOVEI	T1,BL.UU0(V)	;GET UUO BLOCK
	HRLI	T1,4		;LENGTH OF A UUO BLOCK
	IORM	T2,(T1)		;[303] SET NO BLOCK FLAG
	IPCFS.	T1,		;THERE IT GOES
	CALL	SNDPRB		;ANALYZE IT
	PJRST	RETTWO##	;FATAL ERROR OR NO ONE
	PJRST	RETTWO##	;NOT OUR PROBLIF HE IS DISABLED
NOSEND:	MOVX	T1,JS.SND	;[167]GET SEND WAIT STATUS
	IORM	T1,@JOBSTS##	;[167]AND REMEMBER IT
	MOVEI	L,L.SEND##	;QUOTA EXHAUSTED PUT MESSAGE IN Q
	CALL	APPEND##	;APPEND THE MESSAGE
	RETURN


;SENDE IS CALLED WHEN ERRORS OCCUR IT HAS THE ERROR CODE
;IN REGISTER T1
;THIS CODE WI SEND THE M AND M DATA REGISTER BACK

SENDE:	PUSH	P,T1		;SAVE THE ERROR
	CALL	SETANS		;TOO BAD YOU LOOSE
	POP	P,T1		;GET THE ERROR BACK
	DPB	T1,IP.CRE(V)	;SET THE ERROR
	PJRST	SENDIT
;SUBROUTINES TO DELETE DATA FROM SEND Q FOR:
;1 A JOB LOGGING OUT SNDDJB
;2 A DROPPED PID     SNDDPD

SNDDJB:	MOVX	V,JS.SND	;GET WAIT BIT
	ANDCAM	V,@JOBSTS##	;AND ZAP IT
	MOVE	V,J		;TARGET WE AIM AT

SNDDPD:	SKIPN	SNDNUM##	;ARE THERE ANY ENTRIES?
	RETURN			;(NO) ALL SET
	MOVEI	T1,L.SEND##	;GET SEND Q ADDRESS
SNDD0:	HLRZ	T1,LI.LNK(T1)	;GET NEXT ELEMENT
SNDD1:	JUMPE	T1,CPOPJ##	;ALL SET
	CAME	V,BL.UU2(T1)	;IS THIS THE RECEIVER
	JRST	SNDD0		;(NO) SCAN RESTING ENTRIES
	PUSH	P,T2
	PUSH	P,V		;SAVE REGISTERS
	MOVE	V,T1		;COPY DELETED BLOCK ADDRESS
	HLRZ	T1,LI.LNK(T1)	;GET NEXT BLOCK ADDRESS
	PUSH	P,T1		;SAVE REGISTERS
	PUSH	P,L		;,,,
	MOVEI	L,L.SEND##	;Q ADDRESS
	CALL	REMOVE##	;REMOVE THE ENTRY
	CALL	RETTWO##	;RETURN THE STORAGE
	POP	P,L		;GET
	POP	P,T1		;ALL
	POP	P,V		;VALUABLES
	POP	P,T2		;BACK
	JRST	SNDD1		;SCAN REST OF THE Q
	SUBTTL	ANALYZE SEND ERRORS
;ANALYZE A SEND ERROR ,3 RETURNS:
;(1) FATAL ERROR
;(2) IGNORE THE PROBLEM A BAD USER
;(3) DELAY THE REQUEST

SNDPRB:	CAILE	T1,ERRMAX##	;A VALID ERROR CODE??
	SETZ	T1,		;(YES) GET DEFAULT ERROR
	;	IDIVI	T1,ESIZE##	;[301]***DELETED
	;	LDB	T1,EPTR##(T1)	;[301]***DELETED
	IDIVI	T1,<^D36/^D9>	;[301] ERROR POINTERS
	LDB	T1,EPTR##(T2)	;[301] GET ERROR CODES
	CAIN	T1,$FATAL	;IS THE ERROR FATAL
	RETURN			;CALLER MAKES THE POLICY
	CAIN	T1,$IGNO	;IS ERROR IGNORABLE?
	JRST	CPOPJ1##	;YES FORGET HIM
	CAIE	T1,$DELAY	;IS PROBLEM DELAYABLE
	RETURN			;NO DISASTER STRIKES
	PJRST	CPOPJ2##	;YES PUT IT IN A Q
	SUBTTL	PREPARE AN ANSWER TO A JOB

;TO GIVE THE ANSWER TO A JOB THE FOLLOWING HAS TO BE DONE
;1 MAKE UUO BLOCK PROPERLY SET UP FOR THE SENDER
;2 COPY THE ORIGINAL MESSAGE CONTENT
;RETURN THE ADDRESS OF THE UUO BLOCK IN V
;THE ADDRESS OF THE ANSWER BLOCK IN W

SETANS:	CALL	GETTWO		;GET TWO BLOCKS
	CALL	SPCERR##	;SHOULD NEVER HAPPEN
	HRLI	T1,BL.XTR(M)	;ORINAL UUO BLOCKMINUS LINKS
	HRRI	T1,BL.XTR(V)	;COPY IT
	BLT	T1,LI.SIZ-1(V)	;COPY IT
	HLL	T1,BL.SLN(M)	;ADDRESSOF M DATA BLOCK
	HRR	T1,W		;COPY IT HERE
	BLT	T1,LI.SIZ-1(W)	;DO THE COPY
	SETZM	BL.SLN(W)	;DESTROY ALL LINKS
	MOVE	T1,BL.UU1(V)	;GET THE SENDER
	EXCH	T1,BL.UU2(V)	;HE WILL BE THE RECEIVER
	MOVEM	T1,BL.UU1(V)	;I WILL BE THE SENDER
	MOVEI	T1,BL.COD(W)	;START OF DATA PACKET
	HRRM	T1,BL.UU3(V)	;SET IT IN THE UUO BLOCK
	RETURN
;GETIPC IS THE GENERAL PURPOSE GET A MESSAGE ROUTINE
;THERE ARE 2 EXITS:
;1 THE HAPPY ONE A SKIP RETURN
;2 THE SAD ONE A NORMAL RETURN
;ON A SUCCESSFULL RETURN:
;THE ASSOCIATED BLOCK OF U WILL CONTAIN THE DATA PACKET
;ON AN ERROR RETURN:
;T1 WILL CONTAIN THE ERROR CODE

GETIPC::MOVE	T2,[IP.CFB!IP.CFT]	;TRUNCATE BUT DO NOT BLOCK[317]
					;[321] IP.TTL CHANGED TO IP.CFT
	MOVEM	T2,BL.UU0(U)	;SET THE FLAGS
	SKIPN	T2,MYPID##	;GET MY PID
	MOVE	T2,MYJOB##	;AND ELSE MY JOB NUMBER
	MOVEM	T2,BL.UU2(U)	;I WANT THE ANSWER
	HRLI	T1,4		;LENGTH FOR IPCF REQUESTS
	HRRI	T1,BL.UU0(U)	;GET ADDRESS
	HRLI	T2,PAKLEN	;# IN PACKET
	HLR	T2,BL.SLN(U)	;GET DATA ADDRESS
	ADDI	T2,BL.COD	;POINT TO THE DATA AREA
	MOVEM	T2,BL.UU3(U)	;OF UUO PACKET
	IPCFR.	T1,		;RECEIVE
	SKIPA			;CHECK ERROR TYPE
	JRST	CPOPJ1##	;NO PROBLEM LET USER SORT OUT FLAG
	CAIE	T1,IPCPR%	;A PAGE ERROR
	POPJ	P,		;LET USER SORT IT OUT
	MOVE	T2,[ .PAGCD,,PAGEA## ] ;DESTROY THE PAGE
	PAGE.	T2,
	JFCL			;IGNORE IF PAGE NOT THERE
	MOVE	T2,[IP.CFB!IP.CFV] ;GET A PAGE NON BLOCKED
	MOVEM	T2,BL.UU0(U)	;SET THE FLAGS
	HRR	T2,PGNUMB##	;GET THE PAGE NUMBER
	HRLI	T2,1000		;LENGTH OF A PAGE
	MOVEM	T2,BL.UU3(U)	;SET THE LAST WORD
	HRLI	T1,4		;LENGTHOF DESCRIPTOR BLOCK
	HRRI	T1,BL.UU0(U)	;AND THE ADDRESS
	IPCFR.	T1,		;GET THE PAGE
	RETURN			;AN WRROR GIVE IT TO THE USER
	HLRZ	T2,BL.SLN(U)	;GET THE DATA BLOCK
	ADDI	T2,BL.COD	;AND ADD THE CODE OFFSET
	HRL	T2,PGADR##	;GET PAGE ADDR AS SOURCE
	HRRZ	T1,T2		;START ADDRESS OF DATA AREA
	BLT	T2,PAKLEN-1(T1)	;COP THE DATA
	HRLI	T1,PAKLEN	;LENGTH
	MOVEM	T1,BL.UU3(U)	;SIMULATE BLOCK RECEIVE
	JRST	CPOPJ1		;OKAY
	SUBTTL	DELETE PIDS FOR RESET LOGOUT AND A USER

;CALLED WTH JOB NUMBER IN J
;PS HAS FL.RST BIT SET WHEN ONLY PIDS VALID UNTIL RESET ARE 
;TOO DISAPPEAR
;THERE ARE 2 RETURNS:
;(1) IPCF REQUEST LOST OR SEND FAILURE
;(2) ALL PIDS ARE AWAY ALL ACCOUNTING DONE

DELPID:	HRLZ	T1,J		;GET JOB NUMBER
	TXO	T1,SIGN		;ASSUME MATCH ON ONLY VALID UNTIL RESET
	MOVE	T2,PIDSCN##	;GET THE TABLE SCANNER
	JUMPE	T2,CPOPJ1##	;THERE ARE NO ENTRIES
IPC0:	HLLZ	T3,@PIDFLC##	;INDEXED BY T2
	TXNN	PS,FL.RST	;ONLY PID'S VALID UNTIL RESET?
	TXO	T3,SIGN		;THE MATCH ALLWAYS
	CAME	T1,T3		;FOUND A PID??
	JRST	IPC1		;NO RCAN NEXT ONE
	MOVEM	T1,BL.T1(W)	;SAVE THE MATCH VALUE

;IPCD1 IS AN ENTRY POINT TO DELETE A SINGLE ENTRY
;CALL WITH INDEX OF ENTRY IN T2

IPCD1:	MOVEM	T2,BL.T2(W)	;AND THE LOOP COUNT
	MOVE	V,@PIDTBC##	;GET THE PID
	CALL	SNDDPD		;DELETE MESSAGES FOR PID
	MOVEM	V,BL.PID(U)	;AND STORE IT IN THE ARGUMENT FIELD
	MOVEI	T1,.IPCSZ	;GET THE KILL CODE
	HRL	T1,M		;REMEMBER THE MESSAGE BLOCK
	MOVEM	T1,BL.COD(U)	;AN STORE THE OPERATION
	CALL	IPCSPS		;MAKE THE PRIVILIGE SEND
	RETURN			;A FATAL SEND ERROR
	JRST	IPCD2		;A RECOVERABLE ERROR
	CALL	DELAYC		;DELAY UNTILL THERE IS A RESPONSE
	JFCL			;IGNORE IPCC COMPLAINTS
IPCD2:	MOVE	T2,BL.T2(W)	;GET T2 BACK
	SETZM	@PIDTBC##	;ZAP THE PID
	HRRZ	V,@PIDFLC##	;GET THE NAME BLOCK ADDRESS
	MOVEI	L,L.NAME##	;IT IS ON THE NAME LIST
	CALL	REMOVE##	;REMOVE IT
	CALL	RETBLK##	;RETUPN THE BLOCK
	CALL	DELQ1		;ONE PID LESS
	MOVE	T1,BL.T1(W)	;GET THE SEARCH VALUE BACK
	MOVE	T2,BL.T2(W)	;AND THE LOOP COUNT
IPC1:	AOBJN	T2,IPC0		;FIND ALL PIDS
	CALL	SQZPID		;SQUEEZE THE TABLE
	JRST	CPOPJ1##	;GIVE THE TRUE RETURN
;SQZPID IS CALLED AFTER PIDS HAVE BEEN DELETED
;THE ESSENTIAL ELEMENT IS THAT A ZERO TABLE ELEMENT
;WAS DELETED:

SQZPID:	MOVSI	T3,1		;UPDATE OF PIDSCN
	SETO	T2,		;SECOND PID TABLE POINTER IDX
	MOVE	V,PIDSCN##	;SCANNER VALUE
SQZPI0:	SKIPE	@PIDTBL##	;ENTRY DELETED?
	AOJA	T2,SQZPI1	;NO SEE IF NEED TO MOVE
	ADDM	T3,PIDSCN##	;ONE LESS IN TABLE
	JRST	SQZPI2
SQZPI1:	CAIN	T2,(V)		;ANYONE FOUND DELETED YET
	JRST	SQZPI2		;NO
	MOVE	T4,@PIDTBL##	;(YES) BUBBLE THE
	MOVEM	T4,@PIDTBC##	;PID TABLE ENTRY UP
	MOVE	T4,@PIDFLG##	;THE SAME FOR THE FLAG
	MOVEM	T4,@PIDFLC##	;TABLE
SQZPI2:	AOBJN	V,SQZPI0	;SCAN THE WHOLE TABLE
	RETURN

;FNDPID THIS IS A SLOW BINARY SEARCH
;THE FAST BINARY SEARCH WILL BE ACTIVATED WHEN THE
;INSERT IN THE ORDERED TABLE HAS BEEN CODED:
FNDPID:	MOVE	T2,PIDSCN##	;GET THE SCANNER VALUE
	JUMPE	T2,CPOPJ##	;EMPTY TABLE
FNDPI0:	CAME	V,@PIDTBC##	;ADDRESS WITH T2
	AOBJN	T2,FNDPI0	;SCAN THE WHOLE TABLE
	JUMPG	T2,CPOPJ##	;DID NOT FIND ONE
	HRRZ	V,T2		;GET THE INDEX:
	JRST	CPOPJ1##	;SKIP RETURN


;INSPID INSERT A PID IN THE TABLE AND PUT ITS NAME
;IN THE NAME LIST WITH A NAMEBLOCK (PID IS IN V)
INSPID:	MOVSI	T1,..LRG	;GET SCAN INCREMENT
	ADDB	T1,PIDSCN##	;UPDATE THE SCANNER
	HLRE	T2,T1		;GET THE NEGATIVE INDEX
	SETCMM	T2		;MAKE IT POSITIVE MINUS ONE
	HRL	T3,J		;GET JOB NUMBER
	TXNE	PS,FL.RST	;VALID UNTILL RESET
	TXO	T3,SIGN		;(YES) SET THE SIGN BIT
	HRR	T3,BL.XTR(W)	;GET NAME ADDRESS
	MOVEM	T3,@PIDFLC##	;STORE THE FLAG WORD
	MOVE	T1,BL.PID(T3)	;GET THE PID
	MOVEM	T1,@PIDTBC##	;AND STORE IT IN PID TABLE
	RETURN
	SUBTTL	SEARCH A NAME IN THE NAME LIST

;THIS ROUTINE FINDS IN THE NAME LIST THE NAME IN THE CURRENT 
;WORK BLOCK OR SIGNALS THAT IT IS ABSENT
;2 RETURNS:
;(1) THERE IS NO NAME IN THE TABLE
;(2) NAME HAS BEEN FOUND (SKIP RETURN)
;IF THE NAME IS FOUND .V IS THE ADDRESS OF THE NAME BLOCK

SEARCH:	HRRZ	T1,BL.XTR(W)	;GET LENGTH OF NAME
	JUMPE	T1,CPOPJ##	;ZERO  LENGTH IS INVISIBLE
	SKIPN	NAMNUM##	;ARE THERE ANY NAMES
	RETURN			;NO GIVE A NON SKIP RETURN
	MOVEI	V,L.NAME##	;ELSE FIND THE FIRST ADDRESS
SEARC0:	HLRZ	V,BL.LNK(V)	;GET THE NEXT ENTRY
	JUMPE	V,CPOPJ##	;THERE ARE NO MORE ENTRIES
	MOVEI	T1,BL.STR(W)	;GET ADDRESS OF SEARCH ARGUMENT
	MOVEI	T2,NM.NAM	;AND THE LENGTH OF NAMES
	MOVEI	T3,BL.STR(V)	;NEXT GET THE ADDRESS OF CURRENT NAME SLOT
SEARC1:	MOVE	T4,(T3)		;ARE THESE FIELDS EQUAL
	CAME	T4,(T1)		;COMPARE ARGUMENT AND LIST ENTRY
	JRST	SEARC0		;NO TRY NEXT NAME LIST ENTRY
	TRNN	T4,BITS8	;IS THIS THE LAST WORD ASCIZ
	JRST	SEARC2		;(YES) CHECK WHETHER IT MAY BE SEEN
	ADDI	T1,1		;NO COMPARE THE NEXT WORD TOO
	ADDI	T3,1		;OF BOTH FIELDS
	SOJG	T2,SEARC1	;UNTIL ALL NAME WORDS HAVE BEEN DONE
SEARC2:	MOVX	T4,FL.INV	;INVISIBLITY ATTRIBUTE
	TDNE	T4,BL.XTR(V)	;CAN NAME BE SEEN
	TXNE	PS,FL.INV	;(NO) BUT IS USER PRIVILIGED
	PJRST	CPOPJ1##	;(YES) LET HIM SEE THE NAME
	RETURN			;THERE CAN ONLY BE ONE COPY
SUBTTL	ADD A NAME TO THE NAME TABLE

ADDNAM:	CALL	GETBLK##	;GET A NAME BLOCK
	CALL	SPCERR##	;NO ROOM FOR NAME
	MOVEI	L,L.NAME##	;ADD TO THE NAME TABLE
	CALL	APPEND##	;APPEND IT
	HLLM	PS,BL.XTR(W)	;SET THE FLAGS
	MOVSI	T1,2(W)		;SOURCE IS W
	HRRI	T1,2(V)		;TARGET IS V
	BLT	T1,LI.SIZ-1(V)	;TRANSFER ALL NAME DATA
	HRRM	V,BL.XTR(W)	;REMEMBER THE NAME SLOT
	RETURN			;THAT'S IT
	SUBTTL	REDUCE USER NAME TO A CANONICAL FORM

;PARSE THE NAME

PARSE:	CALL	PARSE0		;SETUP PARAMETERS
	RETURN			;WRONG
	JUMPE	T3,PARS0	;AN EMPTY NAME
	CALL	PARSE1		;SQUEEZE OUT
	RETURN			;NAME NOT OKAY
PARS0:	HRRM	T4,BL.XTR(W)	;REMEMBER LENGTH IN BYTES OF NAME
	PJRST	CPOPJ1##	;NAME IS OKAY


;PARSE0 SETS UP THE PARAMETERS FOR THE SCAN OF THE NAME SUPPLIED
;BY THE USER THE SET UP RESULTS IN:
;.T1  IS A POINTER TO THE USER SUPPLIED NAME
;.T2  IS A POINTER TO THE SPACE WHERE PARSED NAME WILL LIVE
;.T3  IS NUMBER OF 7 BIT BYTES IN USER NAME SPACE
;.T4  IS ZERO, THE NUMBER OF USEFUL CHARACTERS FOUND:

PARSE0:	HLRZ	T1,BL.SLN(M)	;GET M'S DATA BLOCK ADDRESS
	MOVEI	T1,BL.STR(T1)	;POINT TO THE MESSAGE STRING
	HRLI	T1,440700	;T1 POINTS TO MESSAGE STRING
	MOVEI	T2,BL.STR(W)	;T2 POINTS TO WORK STRING
	HRLI	T2,440700	;SET
	HLRZ	T3,BL.UU3(M)	;VERIFY IF LENGTH
	SUBI	T3,BL.STR-BL.COD ;OF NAME STRING IS NOT
	JUMPL	T3,CPOPJ##	;< 0 AND IF IT IS LONGER
	CAILE	T3,NM.NAM	;THAN THE DEFAULT THEN
	MOVEI	T3,NM.NAM	;REDUCE IT TO THE DEFAULT
	IMULI	T3,5		;MAKE WORDS BYTES
	SETZ	T4,		;THIS MANY BYTES WERE USEFUL
	JRST	CPOPJ1##
;PARSE1 PARSE THE STRING TO A REDUCED FORM ON THE WORK BLOCK W
;THIS PARSE WILL GIVE AN ERROR RETURN WHEN:
;(1) A NON ZERO BYTE FOLLOWS THE DELIMITING ASCIZ CHARACTER
;(2) A DELIMITING ZERO WAS FOUND BEFORE ANY CHARACTER HAD BEEN ASSEMBLED
;(3) AN INVALID CHARACTER WAS SEEN (ANY ASCII CHARACTER WITH VALUE
;    <40 (OCTAL) AND NOT EQUAL TO A TAB
;THE INPUT PARAMETERS ARE THE OUTPUT FROM PARSE
;THE OUTPUT PARAMETERS:
;(1) A PARSED NAME IN BLOCK W
;(2) LEFTBR POSITION OF THE LEFT MOST IN THE STRING IF FLAG FL.LBR IS ON
;(3) RGHTBR POSITION OF THE MATCHING] IF FLAG FL.RBR IS ON:

PARSE1:	ILDB	T5,T1		;GET A CHARACTER
	JUMPE	T5,PARS06	;[304] NULL TERMINATES NAME
PARS01:	CAIE	T5,.CHRBR	;IF NO RIGHT HAND BRACKET THEN
	CAIN	T5,.CHRSQ	;OR A RIGHT SQUARE BRACKET
	SKIPA			;ENDS A POSSIBLE PPN
	JRST	PARS02		;GO TO CHARACTER CHECK
	TXNE	PS,FL.LBR	;ELSE IF A LEFT HAND BRACKET SEEN
	TXOE	PS,FL.RBR	;AND NO RIGHT HAND BRACKET YET
	SKIPA			;ELSE CLAUSE
	MOVEM	T2,RGHTBR##	;THEN SAVE POINTER
PARS02:	ADDI	T4,1		;COUNT THE CHARACTER
PARS03:	IDPB	T5,T2		;EXTEND THE TARGET EVEN ZEROES!
	CAIE	T5,.CHLSQ	;A LEFT SQUARE BRACKET
	CAIN	T5,.CHLBR	;IF A LEFT BRACKET
	TXNE	PS,FL.RBR	;AND NO RIGHT HAND BRACKET SEEN YET

	JRST	PARS04		;(ELSE) GO TO
	TXO	PS,FL.LBR	;(THEN) FLAG LEFT HAND BRACKET
	MOVEM	T2,LEFTBR##	;AND REMEMBER WHERE IT WAS
PARS04:	SOJG	T3,PARSE1	;SCREEN THE WHOLE ARGUMENT
	POPJ	P,		;[304] IF GET HERE, DOESN'T END WITH NULL
PARS05:	TLNN	T2,760000	;PADDED
	JRST	CPOPJ1##	;YES
PARS06:	IDPB	T5,T2		;NO INSERT MORE NULLS
	SOJG	T3,PARS06	;[304] PAD FOR ANY UNSCANNED BYTES FIRST
	JRST	PARS05
	SUBTTL	VERIFY LEGALITY OF PPN FIELDS

;CHKACC CHECK THE NAME RIGHT

CHKACC:	TXZE	PS,FL.LBR	;A LEFT HAND BRACKET SEEN
	TXZN	PS,FL.RBR	;AND A RIGHT HAND BRACKET
	JRST	CPOPJ1##	;(NO) THEN ALL HAS BEEN DONE
	MOVEI	T5,.GTPPN	;GET THE PPN OF THE REQUESTOR
	HRL	T5,J		;JOB (.J)
	GETTAB	T5,		;GET IT
	RETURN			;IMPOSSIBLE!! OR SYSTEM IS SICK
	CALL	PARSE2		;PARSE THE PPN AND SET FLAGS
	JRST	CPOPJ##		;A BAD PPN WAS GIVEN
	PJRST	PARSE3		;VERIFY THE LEGALITY OF THE USER
				;AND MAKE INDIRECT 2 EXITS
;	RETURN			;ILLEGAL CLAIM
;	JRST	CPOPJ1##	;USER CAN USE IT
;PARSE2 PARSES A PPN FIELD
;IT RETURN THE PPN DATA IN THE U BLOCK
;THE FOLLOWING FLAGS MAY BE SET
;FL.NAM	NAME SEEN
;FL.PPN	OCTAL,,OCTAL SEEN
;FL.LFW	*,,OCTAL1*SEEN
;FL.RFW	OCTAL1*,,*SEEN:
	SUBTTL	CHECK PRIVILIGES OF NAMES

PARSE2:	MOVE	T1,LEFTBR##	;START AT THE LEFT HAND SQUARE BRACKET
	CALL	PARS23		;AND COLLECT A 6 BIT FIELD
	RETURN			;A BAD CHARACTER WAS SEEN
	JRST	PARS22		;NO COMMA WAS SEEN IT IS A NAME
	CAME	V,[SIXBIT /'ANY'/]	;IT WAS A FIELD IS IT WILD?
	JRST	PA20		;IT IS NOT WILD
	TXO	PS,FL.LFW	;(YES) FLAG A WILD LEFTHAND FIELD
	JRST	PARS20		;DO NOT CONVERT TO BINARY A WILD FIELD
PA20:	CALL	PARS24		;CONVERT THE 6 BIT FIELD TO BINARY
	RETURN		;THERE ARE BAD CHARACTERS
	HRLM	V,BL.PPN(W)	;STORE THE LEFT HAND PART OF THE PPN
PARS20:	CALL	PARS23		;NEXT COLLECT THE RIGHT HAND FIELD OF THE PPN
	RETURN			;A BAD CHARACTER WAS SEEN
	SKIPA		;THERE WAS NO COMMA AND THAT IS GOOD
	RETURN		;THERE WAS A COMMA AND THAT IS BAD
	CAME	V,[SIXBIT /'ANY'/]	;IS THE RIGHT HAND WILD
	JRST	PA21		;(NO) SKIP WILD LOGIC
	TXO	PS,FL.RFW	;(YES) FLAG THAT FIELD IS WILD
	JRST	PARS21		;DO NOT PARSE A WILD FIELD
PA21:	CALL	PARS25		;CONVERT 6 BIT FIELD TO BINARY
	RETURN			;THERE WAS A BAD CHARACTER
	HRRM	V,BL.PPN(W)	;STORE THE RIGHT HAND FIELD
PARS21:	TXO	PS,FL.PPN	;FLAG THAT A PPN FIELD WAS SEEN
	JRST	CPOPJ1##	;THE SYNTAX OF THE PPN FIELD WAS OKAY
PARS22:	MOVEM	V,BL.PPN(W)	;A NAME WAS SSEN STORE THE NAME
	TXO	PS,FL.NAM	;AND FLAG THAT PPN WAS A NAME
	JRST	PARS21		;ALSO FLAG THAT A PPN WAS SEEN
;PARSE23 PARSES THE STRING BETWEEN THE LEFT AND RIGHT BRACKET
;THE RESULT (SIXBIT VALUE)IS IN V IT GIVES 3 RETURNS:
;(0) NORMAL A BAD CHARACTER  WAS SEEN (ASCII VALUE<41 OCTAL)
;(1) SKIP NO COMMA HAS BEEN SEEN = NAME FIELD
;(2) DOUBLE SKIP A COMMA HAS BEEN SEEN
;THE FIELD TO THE RIGHT HAND SIDE OF THE COMMA HAS NOT SEEN COLLECTED

PARS23:	SETZ	V,		;THE RESULT IS ZERO BY DEFAULT
	MOVE	T3,[POINT 6,V]	;SET A POINTER TO THE VALUE REGISTER
PAR230:	CAMN	T1,RGHTBR##	;IS THE END OF THE SCAN THERE
	JRST	CPOPJ1##	;(YES) GIVE THE END RETURN
	ILDB	T2,T1		;GET A CHARACTER OF THE PPN
	CAIN	T2,.CHCOM	;IS IT A COMMA?
	JRST	CPOPJ2##	;(YES) IN THAT CASE GIVE A DOUBLE SKIP RETURN
	SUBI	T2,.CHSPC	;(NO) REDUCE CHARACTER TO SIXBIT
	JUMPLE	T2,CPOPJ##	;A BAD CHARACTER
	TLNE	T3,770000	;SEE IF THERE IS STILL ROOM IN THE VALUE REGISTER
	IDPB	T2,T3		;(YES) STORE IT
	JRST	PAR230		;GET MORE CHARACTERS

;PARS24 REDUCE THE SIXBIT FIELD IN V TO BINARY
;THE RESULT IS PASSED BACK IN V
;THERE ARE 2 RETURNS:
;(1) THERE IS A BAD CHARACTER IN THE FIELD
;(2) THE FIELD IS OAKY

PARS24:	JUMPN	V,PARS26	;A FIELD AWS GIVEN
	HLRZ	V,T5		;GET THE USERS PROJECT
	JRST	CPOPJ1##	;OKAY ALL SET
PARS25:	JUMPN	T5,PARS26	;A FIELD WAS GIVEN
	HRRZ	V,T5		;TAKE THE USERS PROGR #
	JRST	CPOPJ1##	;ALL SET
PARS26:	MOVE	T2,V		;COPY THE SIXBIT FIELD
	SETZ	V,		;AND ZERO THE RESULT
	MOVE	T3,[POINT 6,T2];AND BUILD A POINTER TO THE ARGUMENT CHARACTERS
PAR240:	ILDB	T4,T3		;GET A 6 BIT CHAR
	JUMPE	T4,CPOPJ1##	;A ZERO MEANS ALL WORK IS OVER
	CAIGE	T4,30		;>=8 IS BAD
	CAIGE	T4,20		;<=0 IS BAD TOO
	JRST	CPOPJ##		;WHICH CASES RESULT IN AN ERROR RETURN
	SUBI	T4,20		;REDUCE VALUE TO BINARY
	LSH	V,3		;MULTIPLY THE RESULT BY 8
	ADD	V,T4		;ADD THE CUURRENT DIGIT
	TLNE	T3,770000	;SEE IF ALL CHARACTERS HAVE BEEN PROCESSED
	JRST	PAR240		;(NO) DO THE REMAINDER
	JRST	CPOPJ1##	;(YES) GIVE THE TRUE EXIT
;PARSE3 CHECKS THE PPN FIELD
;

PARSE3:	CAMN	T5,BL.PPN(W)	;HIS OWN PPN??
	PJRST	CPOPJ1##	;(YES) THEN QUIT
	MOVE	T1,BL.PPN(W)	;GET THE PPN FIELD
	TXNN	PS,FL.NAM	;WAS A NAME DETECTED?
	JRST	PARS32		;(NO) CHECK THE PPN FIELD
;A NAME MAY ONLY BE USED IF ITS:
;1 IN THE HOLY NAME LIST (NAMLST)
;2 AND A USER WITH PROJECT# <10 (OCTAL)
	CALL	IPCPC		;SEE IF PRIVILIGED
	RETURN			;NO JUST GO BACK
	MOVE	T2,NAMLST##	;GET LIST OF ESERVED NAMES
PARS31:	CAMN	T1,(T2)		;SEE IF A RESERVED NAME WAS GIVEN
	JRST	CPOPJ1##	;(YES) HE IS ALLOWED TO DO THAT
	AOBJN	T2,PARS31	;SCAN THE WHOLE LIST
	RETURN			;NO UNKNOWN NAMES
PARS32:	TXNE	PS,FL.LFW	;IS LEFT PART WILD?
	JRST	PARS33		;(YES) THAT IS OAKAY
	HLRZ	T1,BL.PPN(W)	;GET THE PROJECT FIELD
	HLRZ	T2,T5		;GET THE USERS PROJECT
	CAME	T1,T2		; A MATCH ??
	RETURN			;(NO) TOO BAD YOU LOOSE
PARS33:	TXNE	PS,FL.RFW	;IS RIGHT HAND WILD
	PJRST	CPOPJ1##	;(YES) THAT IS OKAY
	HRRZ	T1,BL.PPN(W)	;GET CLAIMED PROGR #
	CAIN	T1,(T5)		;DOES IT MATCH THE REQUESTORS??
	PJRST	CPOPJ1##	 ;(YES) GIVE THE TRUE EXIT
	RETURN			;(NO) THE EXIT IS FALSE
	SUBTTL	ERRORS REPORTED TO USERS
;ERROR REPORTING TO USERS IS DONE
;(1) AT TASK LEVEL
;(2) BY MEANS OF PJRST ERROR LABEL
;THE ERROR LABEL POSITION DEFINES THE ERROR VALUE
;ANY NEW ERRORS SHOULD BE APPENDED TO THE END OF THE LIST
;ERROR CODES ARE RETURNED IN FIELD IP.CFE

BADNAM:	JSP	T2,ERRVAL	;(1) RETURN ERROR CODE
				;NAME ARGUMENT INVALID
NONAME:	JSP	T2,ERRVAL	;(2) NAME UNKNOW
SMLNAM:	JSP	T2,ERRVAL	;(3) LENGTH OF NAME IS INCORRECT
BADPID:	JSP	T2,ERRVAL	;(4) PID IS UNKNOWN
DUPNAM:	JSP	T2,ERRVAL	;(5) NAME DUPLICATES
QUOLOW:	JSP	T2,ERRVAL	;(6) USER PID QUOTA EXHAUSTED
CNTNTR:	JSP	T2,ERRVAL	;(7) COULD NOT ENTER PID
IPCFLS:	JSP	T2,ERRVAL	;(10) IPCF REFUSES ITS SERVICE
NOPRIV:	JSP	T2,ERRVAL	;(11) CANNOT EXECUTE REQUEST
NOHELP:	JSP	T2,ERRVAL	;(12) NO SERVICE FOR THIS PID
NFOERR:	JSP	T2,ERRVAL	;(13) [SYSTEM]INFO HAS PROBLEMS
NOCONT:	JSP	T2,ERRVAL	;(14) FATAL SEND ERROR TO DESTINATION
BADFUN:	JSP	T2,ERRVAL	;(15) A BAD FUNCTION WAS PASSED

;ERROR REPORTING TO A JOB IS DONE BY ENTERING A CODE
;IN THE IP.CRE FIELD,THIS IS DONE BY THE SENDE CODE
;THE INPUT PARAMETER OF SENDE IS THE ERROR CODE.
;THE STACK WILL BE RESET TO THE TASK CALL LEVEL

ERRVAL:	HRRZS	T2		;KILL ANY FLAGS
	SUBI	T2,BADNAM+1	;GET THE ERROR OFFSET
	ROT	T2,-1		;GET THE PROPER INDEX
	HRRZ	T1,ERRTAB(T2)	;GET THE EVEN ERROR CODE
	SKIPGE	T2		;VALID FOR AN POSITIVE T2
	HLRZ	T1,ERRTAB(T2)	;GET THE ODD ERROR CODE
	HLRZ	T2,BL.SLN(M)	;GET THE M DATA BLOCK ADDRESS
	MOVE	P,BL.XTR(T2)	;AND GET THE CORRECT STACK VALUE
	PJRST	SENDE		;EXIT VIA SENDE

;ERRTAB IS THE ERROR VALUE TABLE 

ERRTAB:	IPCNN%,,IPCBN%			;NONAME,,BADNAM
	IPCBP%,,65			;BADPID,,SMLNAM
	IPCQP%,,IPCDN%			;QUOLOW,,DUPNAM
	IPCCF%,,IPCFF%			;IPCFLS,,CNTNTR
	70,,IPCPI%			;NOHELP,,NOPRIV
	67,,66			;NOCONT,,NFOERR
	IPCUF%				;A BAD FUNCTION
	PRGEND
	TITLE	INFERR
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES

	ENTRY	INFERR

INFERR:			;FORCE LOADING



;WARNINGS USED EITHER PERMANENTLY OR ONLY DURING THE DEVELOPMENT

WRNELS::PUSH	P,V
	MOVEI	V,TX5
	CALL	TYPOPR##
	JFCL
	POP	P,V
	RETURN
TX5:	ASCIZ	/REMOVE MADE FROM AN EMPTY LIST
/

WRNBLN::PUSH	P,V
	MOVEI	V,TX6
	CALL	TYPOPR##
	JFCL
	POP	P,V
	JRST	CPOPJ1##	;SKIP THE RETBLK CALL
TX6:	ASCIZ	/ZERO LINK IN LINKED BLOCK PAIR
/


WRNUIF::PUSH	P,V
	MOVEI	V,TX7
	CALL	TYPOPR##
	JFCL
	POP	P,V
	RETURN
TX7:	ASCIZ	/UNKNOWN IPCF REQUEST RECEIVED
/
	SUBTTL	RUN TIME DETECTED ERRORS

;FATAL ERRORS DURING [SYSTEM]INFO EXECUTION
;DETECTED BY [SYSTEM]INFO

HIBERR::MOVEI	V,HIBTXT
	JRST	NOINTE		;NON INTERRUPT ERROR
HIBTXT:	ASCIZ	/HIBERNATE UUO FAILED
/
SPCERR::MOVEI	V,SPCTXT
	JRST	NOINTE		;NON INTERRUPT ERROR
SPCTXT:	ASCIZ	/NOT ENOUGH CORE FOR WORK SPACE
/
RCVERR::MOVEI	V,RCVTXT
	JRST	NOINTE		;NON INTERRUPT ERROR
RCVTXT:	ASCIZ	/UNEXPECTED RECEIVE ERROR
/
QUEERR::MOVEI	V,QUETXT
	JRST	NOINTE		;NON INTERRUPT ERROR
QUETXT:	ASCIZ	/QUEUE PROBLEM
/
SNDERR::MOVEI	V,SNDTXT
	JRST	NOINTE		;NON INTERRUPT ERROR
SNDTXT:	ASCIZ	/UNEXPECTED SEND ERROR
/
NOMESS::MOVEI	V,NOMTXT
	JRST	NOINTE		;NON INTERRUPT ERROR
NOMTXT:	ASCIZ	/ERROR ANSWER FROM IPCF
/
WTERR::	MOVEI	V,WTTXT		;WAIT LOGIC ERROR
	JRST	NOINTE
WTTXT:	ASCIZ	/WAITING JOB LOST ITS ENTRY IN DELAY Q
/
INFREN::	SETOM	STOPFL##	;FLAG THAT NO RESTART MUST BE DONE
	MOVEI	V,RENTXT	;STOPPED BY REENTER
	JRST	NOINTE
RENTXT:	ASCIZ	/STOPPED BY MEANS OF A REENTER
/
;ERROR TYPER AND DISPATCHER TO SYSTEM ERROR HANDLER

NOINTE:	PUSH	P,V		;SAVE MESSAGE
	MOVEI	V,INFNAM##	;NAME [SYSTEM]INFO
	CALL	TYPOPR##	;TYPE IT
	JFCL			;IGNORE THE FAILURE
	POP	P,V		;GET MESSAGE BACK
;	MOVEM	V,CRSMSS##	;REMEMBER WHY WE CRASHED
	CALL	TYPOP0##	;TELL IT THE WORLD
	JFCL
	PJRST	SYSERR##	;SYSTEM ERROR ROUTINE
	SUBTTL	ERROR HANDLER FOR [SYSTEM]INFO ERRORS

;ERRORS CAN BE OF 2 TYPES:
;(1) ANNOYING BUT ONE CAN LIVE WITH THEM
;(2) FATAL THE [SYSTEM]INFO FACILITY HAS TO BE CLOSED DOWN
;CURRENTLY ALL ERRORS ARE TERMED FATAL
;A FATAL ERROR WILL RESULT IN THE FOLLOWING ACTIONS:
;1 CLOSE DOWN OF THE INTERRUPT SYSTEM IF ON
;2 RELEASE OF THE [SYSTEM]INFO FACILITY
;3 RELEASE OF THE [SYSTEM]INFO PID
;4 MARK THE SYSTEM UNAVAILABLE BY SETTING NF.DWN
;  IN THE INFO STATUS WORD

DOWN::	MOVE	P1,NFOSTS##	;GET THE STATUS
	MOVEI	U,DISAST##-BL.COD	;THE DISASTER AREA
	TXZN	P1,NF.NFO	;ARE WE SYS INFO
	JRST	NOTMAS		;NO WE ARE NOT
	MOVEI	T1,4		;MAKE [SYSTEM]INFO
	MOVEM	T1,BL.COD(U)	;AGAIN
	SETZM	BL.PID(U)	;BUT ZERO THIS TIME
	SETZM	BL.STR(U)	;SO ZAP BLOK
	CALL	IPCSPS##	;SEND
	JRST	NOTPID		;FATAL SEND ERROR
	JRST	NOTPID		;DO EVEN NOT RECOVER
	MOVEI	V,INFNAM	;NAME OF [SYSTEM] INFO
	CALL	TYPOPR##	;TYPE NAME
	JFCL
	MOVEI	V,DWNTXT	;WE ARE DOWN
	CALL	TYPOP0##	;TELL IT
	JFCL
NOTMAS:	TXZN	P1,NF.PID	;HAVE WE GOT A PID
	JRST	NOTPID		;NO PID
	MOVEI	T1,5		;GET DESTROY CODE
	MOVEM	T1,BL.COD(U)	;SET THE VALUE
	MOVE	T1,MYPID##	;TO BE MY PID
	MOVEM	T1,BL.PID(U)	;
	CALL	IPCSPS##	;TELL IPC
	JFCL			;FATAL ERROR
	JFCL			;RECOVERABLE
ZAPRCV:	MOVX	T1,IP.CFB	;DONOT BLOCK RECEIVES
	MOVEM	T1,MYBLOK##	;WHICH WILL BE DONE USING
	SETZM	MYPID##		;MY BLOCK
	MOVE	T1,MYJOB##	;WITH ONLY JOB NUMBER AS THE RECEIVER
	MOVEM	T1,IPCFPD##
	MOVEI	T1,MYBLOK##	;BUILD UUO ACCU
	HRLI	T1,4		;FOR THE RECEIVE CALL
	IPCFR.	T1,		;MAKE THE CALL
	SKIPA			;UNTILL THERE IS NO MORE
	JRST	ZAPRCV		;ZAP ALL REQUESTS OR ANSWERS
NOTPID:	MOVX	P1,NF.DWN	;THE SHOP IS CLOSED
	MOVEM	P1,NFOSTS##	;SHUT THE DOOR
	RETURN			;NEXT STEP

DWNTXT:	ASCIZ	/HAS BEEN STOPPED
/
	PRGEND
	TITLE	ERRMOD
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


	ENTRY	SYSERR,.SFIN

	SUBTTL	ENTRY OF FATAL INTERRUPT CONDITIONS

;INTERRUPT ARE SERVICED BY CODE LABELED XXX'INT WHERE 
;XXX IS THE CONDITION E.G. NXM INTERRUPTS AT NXM

	INTLOC	<ILU,ILM,ADC,PDL,NXM,EJE>,INTERR
	SUBTTL	FATAL ERROR PROCESSING

;INTERR RECEIVES CONTROL FOR INTERRUPT ERRORS
;NOINTE FOR NON INTERRUPT FATAL ERRORS

INTERR:	MOVEM	V,VCRSH		;ALL ACCUS SAVED ON INTERRUPTS
	HRRZ	V,(P)		;GETADDRESS OF INT ID BLOCK
	CALL	DAECHK##	;TO WHOM BELONGS THE INTERRUPT
	JRST	INTER0		;TO ME SO CRASH
	MOVE	V,VCRSH		;RESTORE REGISTERS
	MOVE	P,PCRSH		;P AND V
	DEBRK.			;ANG GO AWAY
	HALT	.-1		;IMPOSSIBLE
INTER0:	HRRZ	V,(P)		;GET V BACK
	HLRZ	V,(V)		;GET MESSAGE
;	MOVEM	V,CRSMSS##	;REMEMBER WHY WE CRASHED
	CALL	TYPOPR##	;AND TELL THE OPERATOR
	JFCL			;IGNORE THE FAILURE
	MOVEI	V,[ASCIZ / INTERRUPT OCCURRED
/]
	CALL	TYPOP0##	;NO PREFIX
	JFCL			;IGNORE FAILURE

; NOTE WHEN STOPFL=0 THEN RESTART IF STOPFL .NE 0 THEN STOP

SYSERR:	CALL	CRASH##		;AND WRITE THE CRASH FILE
	SETZM	CRSTXT		;NO CRASH WAS WRITTEN
	SKIPE	LAST		;SPECIAL EXIT CODE??
	CALL	@LAST		;EXECUTE HIS LAST WILL
	MOVEI	V,CRSTXT	;TELL ABOUT CRASH FILE
	CALL	TYPOPR##
	JFCL
NOCRSH:	SKIPE	STOPFL		;SHOULD A RESTART BE MADE
	JRST	ZAPIT		;(NO) LEAVE IT AS IT IS
	MOVEI	V,TRYTXT	;TEL ABOUT RETRY
	CALL	TYPOPR##	;SO OPERATOR KNOWS
	JFCL			;IGNORE FAILURES
	CALL	RESTAR##	;TRY TO GET BACK ON THE AIR
	MOVEI	V,SOSTXT	;SAVE OUR SOULS
	CALL	TYPOPR##	;WE SURRENDER
	JFCL		;THIS IS REALLY LOUSY,BUT WHAT TO DO?
ZAPIT:	CALL	ZAPRUN##	;PREVENT PROBLEMS FOR NEXT RUN
	JFCL			;IGNORE THE FAILURE
	MOVEI	T1,.GTPRG	;GET OUR NAME
	PJOB	T2,		;AND JOB NUMBER
	HRL	T1,T2		;MAKE GETTAB CODE
	GETTAB	T1,		;GET THE NAME
	JFCL			;IGNORE ERRORS
	CAME	T1,[SIXBIT /DAEMON/]	;RTHE MASTER?
	EXIT			;NO JUST PLAIN
	MOVSI	T1,(SIXBIT /DAE/)	;CHANGE NAME
	SETNAM	T1,		;NOW
	EXIT		;LEAVE IT TO HUMAN BEINGS

;(MEMENTO MORI) FINAL WORDS WOTHY TO MEMORIZE

.SFIN:	MOVEM	V,LAST		;REMEMBER LAST CODE TO EXECUTE
	RETURN
;CRASH DATA


STOPFL::Z		;NON ZERO WHEN A STOP IS WISHED
PCRSH::	Z		;STORE P HERE ON CRASHES
VCRSH::	Z		;STORE V HERE ON CRASHES
PANIC::	-10,,.		;EMERGENCY STACK
	BLOCK	10
LAST:	Z			;EXIT FUNCTION
CRSTXT:	ASCIZ	/A CRASH FILE HAS BEEN WRITTEN
/
TRYTXT:	ASCIZ	/CRASHED WILL TRY TO RESTART
/
SOSTXT:	ASCIZ	/RESTART LOST TRY IT AGAIN
/
	PRGEND
	TITLE	STACK
	SEARCH	INFSYM

	ENTRY	STACK

STACK:	-STKLEN,,.+1		;ZERO STACK POINTER
	BLOCK	STKLEN
	PRGEND
	TITLE	INFDAT
	ENTRY	INFDAT
INFDAT:
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES


;GLOBAL SYMBOLS


;INTERNAL SYMBOLS


;NAME OF [SYSTEM]INFO

INFNAM::	ASCIZ	/[SYSTEM]INFO /		;THAT'S OUR NAME
;ALL ERROR VALUES RETURNED FOR SEND AND RECEIVE REQUESTS
;ARE JUDGED BY MEANS OF THE BYTES IN TABLE ERRLST
;(ALL UNKNOWN CODES ARE REDUCED TO ERROR CODE 0)
;TO EXTARCT THE ERROR CODE FOR VALUE N THE FOLLOWING LOGIC IS USED:
;	MOVEI	T1,N		;GET THE ERROR CODE
;	IDIVI	T1,ESIZE
;	LDB	T1,EPTR(T1)	;GET THE ERROR CODE NOTE: THE
;				;HIDEN ROLE OF T2

;OPTIMUM VALUE OF ESISIZE IS: MAX(^D36/(SQRT(MAX ERROR CODE),MAX # OF BITS NEEDE)

ESIZE=^D9

	.IBYTE(ESIZE)		;OPTIMUM BYTE SIZE

ERRLST::	.ABYTE($FATAL)		;UNKNOWN ERROR
	.ABYTE($FATAL)		;(1) ADDRESS CHECK
	.ABYTE($FATAL)		;(2) LENGTH OF PACKET NOT LONG ENOUGH
	.ABYTE($FATAL)		;(3) NO PACKET IN QUEUE
	.ABYTE($FATAL)		;(4) PAGE ALREADY IN USE
	.ABYTE($FATAL)		;(5) PACKET TOO LONG
	.ABYTE($IGNO)		;(6) DESTINATION UNKNOWN
	.ABYTE($IGNO)		;(7) DISABLED
	.ABYTE($DELAY)		;(10) NO ROOM IN SENDERS QUOTA
	.ABYTE($DELAY)		;(11) NO ROOM IN RECEIVERS QUOTA
	.ABYTE($DELAY)		;(12) NO ROOM IN SYSTEM FOR PACKET
	.ABYTE($FATAL)		;(13) UNKNOWN PAGE
	.ABYTE($FATAL)		;(14) INVALID SENDERS ADDRESS
	.ABYTE($FATAL)		;(15) PRIVLEGES INSUFFICIENT
	.ABYTE($FATAL)		;(16) UNKNOWN FUNCTION
	.ABYTE($FATAL)		;(17) BAD JOB NUMBER
	.ABYTE($IGNO)		;(20) PID TABLE FULL
	.ABYTE($FATAL)		;(21) PAGE REQ NOT A PAGE IN Q
	.ABYTE($FATAL)		;(22) PAGING I/O ERROR
ERRMAX=:22
	INTERN	EPTR		;[302]

	;	.TBYTE(T2,ERRLST,EPTR)	;[301]***DELETED
	.TBYTE(T1,ERRLST,EPTR)	;[301] FINALIZE TABLE


;TWO BLOCKS ARE USED FOR SENDS::
;1 MYBLOK FOR SENDS TO IPCF
;2 US.SND FOR SENDS FROM SYS::INFO TO USERS

MYBLOK::	Z
MYPID::	Z
IPCFPD::	Z
MYLENG::	3,,.+1
MYCODE::	0,,4
MYANSW::	BLOCK	3

;SEND BLOCK TO USERS

US.SND::	Z			;ALLWAYS ZERO
MYPID0::	Z		;CHANGED TO MY PID
US.RCV::	Z		;RECEIVERS PID
US.LNK::	Z		;LINK TO USERS PACKET

JOBSTS::	J,,Z			;WILL ADDRESS JOB TABLE
JBWAIT::	Z			;ADDRESS OF TABLE OF JOB WAIT Q HEADERS
PIDFLG::	V,,Z			;ADDRESS PID FLAG WORDS
PIDFLC::	T2,,0			;(2) START UP CODE WILL SET
PIDTBL::	V,,0			;(3) THE RIGHT HAND PART
PIDTBC::	T2,,0			;(4) OF THIS 4 VARIABLES
NFOSTS::	NF.DWN			;WE ARE DOWN IF JUST LOADED

;NAMLST IS THE NAME OF PRIVILIGED PPN FIELDS

NAMLST::	-NAMLEN,,.+1
	SIXWRD	(SYSTEM)
NAMLEN=.-NAMLST
STACK0::	Z		;SAVE P HERE FOR DAEMON
;SCHEDQ IS A LIST USED TO SCHEDULE TASKS PROCESSING WORK QUEUE
;ENTRIES EACH TASK EXITS TO THE START OF THE SCHEDULER QUEUE:
;THE QUEUE CONSISTS OF SCHSIZ WORD ENTRIES (NOW 2)
;THE LAST ENTRY SCHEDULS THE NULJOB (SCHTSK)
;WORD (1) CONTAINS THE SCHEDULING PARAMETER ADDRESS
;WORD (2) CONTAINS THE TASK ADDRESS
	DEFINE	.SCH(LIST)
<	IRP	LIST,<
...ZZZ=.
	LIST'NUM		;;LINK TO Q ENTRY OR ZERO
	LIST'TSK##		;;TASK ADDRESS
SCHSIZ=:.-...ZZZ
>
	PURGE	...ZZZ
>
SCHEDQ::.SCH(<RST,NEW,RQE,MSS,OLD,SND,SCH>);[307]

SCHNUM:	1		;;ALLWAYS TRUE
FIRZER::
LEFTBR::	Z			;PLACE OF LEFT BRACKET IN NAME STRING.
RGHTBR:: Z			;PLACE OF RIGHT BRACKET IN NAME STRING.
PIDMSK::	Z			;COMPLEMENT OF JOBMSK
MYJOB::	Z			;MY ([SYSTEM]INFO) JOB NUMBER
SCNMSS::	Z			;CURRENT POINTER IN MESSAGE QUEUE.

; THE NEXT 3 WORDS ARE USED DURING A SYSTEM TAKE DOWN IT WILL DO NO HARM::
DISAST::BLOCK	3		;DO NOT OVERWRITE USEFULL INFO
BADRCV::Z				;VALUE OF LAST RECEIVE ERROR
;CRSMSS::Z				;ADDRESS OF CRASH TEXT IDENTIFIES WHY
NEWNUM::	Z			;NUMBER OF MESSAGES, WHICH ARRIVED
RCVBLK::	Z			;ADDRESS OF A BUCKET FOR GETWRK (0 WHEN NONE)
JOBSCN::	Z			;-JOBN,,0 USED TO SWEEP JOB TABLES WITH J
ERRLOC::	Z
GTTVAR::
IPCFD::	Z
PIDNUM::	Z
JOBMSK::	Z
JOBN::	Z
OPTION::	Z		;UUO OPTIONS
OPRPPN::	Z		;FULL FILE ACCESS PPN
MONVER::	Z		;MONITOR MAJOR VERSION
FRCLIN::	Z		;FRCLIN'S TTY NUMBER
MYQUOT::	Z		;THE QUOTA USED BY [SYSTEM]INFO
PAGEA::	EXP	1		;1 PAGE ONLY
PGNUMB::	Z		;PAGE NUMBER TO BE USED FOR REC A PAGE
PGADR::	Z			;ADDRESS OF RECEIVE PAGE
;LIST PARAMETERS
;CONTROL FOR QUEUE OF MESSAGES
L.MESS::
MSSLNK::	Z			;(FIRST ,, LAST) ELEMENT LIST POINTER
MSSNUM::	Z			;# OF ELEMENTS IN LIST
;QUEUE OF DELAYED COMMANDS
L.DELAY::
DLYLNK::	Z			;(FIRST ,, LAST) ELEMENT LIST POINTER
DLYNUM::	Z			;NUMBER OF DELAYED COMMANDS
;QUEUE OF TEMPORARY REJECTED SEND REQUESTS.
L.SEND::
SNDLNK::	Z			;(FIRST ,, LAST) ELEMENT LIST POINTER
SNDNUM::	Z			;NUMBER OF WAITING SEND REQUESTS:
;NAME LIST STRUCTURE
;REQUEUE, HAS HIGHER PRIORITY THAN MESSAGE QUEUE.
L.RQUE::
RQELNK::	Z			;(FIRST ,, LAST) ELEMENT LIST POINTER
RQENUM::	Z			;# OF REQUEUED JOBS
;QUEUE FOR LOGOUT AND RESET REQUESTS HAS HIGHER PRIORITY THAN REQUE Q
L.RST::
RSTLNK::	Z			;(FIRST ,, LAST) LIST POINTER
RSTNUM::	Z			;NUMBER OF RESET UUO ENTRIES
;L.OLD MESSAGES FOR DELETED JOBS
L.OLD::
OLDLNK::	Z
OLDNUM::	Z
LASZER::
PIDSCN::	-2,,0			;SCANNER OF PID TABLES

L.NAME::
NAMLNK::	NM.IPF,,NM.INF		;(FIRST ,, LAST) ELEMENT LIST POINTER
NAMNUM::	2			;# NAMES KNOWN TO SYSTEM

;INITIAL NAME LIST

NM.IPF::	NM.INF,,NAMLNK			;IPCF ENTRY
	EXP	0,0,0,0
	ASCIZ	/[SYSTEM]IPCF/
	REPEAT	<LI.SIZ+1+NM.IPF-.>,<
	Z
>

NM.INF::	0,,NM.IPF		;[SYSTEM]INFO ENTRY
	EXP	0,0,0,0		
	ASCIZ	/[SYSTEM]INFO/
	REPEAT	<LI.SIZ+1+NM.INF-.>,<
	Z
>
	PRGEND
	TITLE	INIINF
	SEARCH	UUOSYM,MACTEN,INFSYM		; [321] FIX SEARCHES

	ENTRY	INIINF

	SUBTTL	SYSINFO SET UP

;THE SETUP OF [SYSTEM]INFO TAKES THE FOLLOWING STEPS:
;(1) SET UP A STACK AND ALL OPTIONS AND MY JOB NUMBER
;(2) GET ALL MONITOR DATA WITH GETTABS
;(3) ESTABLISH THIS JOB AS SYSINFO
;(4) SET THE INTERRUPT SYSTEM ON
;NEXT FALL INTO THE SCHEDULER

INIINF:	MOVEM	P,PSAV			;SAVE P FOR ERROR EXITS
	ZERO	FIRZER##,<LASZER##-1>	;ZERO CORE
	MOVEI	V,LI.SIZ	;SIZE OF LIST ELEMENTS
	CALL	BLKINI##	;INITIALIZE THE FREE LIST DATA
	PJOB	T1,		;GET JOB NUMBER
	MOVEM	T1,MYJOB##	;REMEMBER MY JOB #
;***********************************************************************
;******THE USE OF FTON IS ONLY FOR IN HOUSE DEVELOPMENT*****************
;******NEVER USE THE FUNCTION UNTIL  EXPLICITLY INDICATED*****************
;***********************************************************************
;	FTON	<OPR,FMT,TRC>	 ;ENABLE FEATURES:
;*************************************************************************
;SETUP ALL GETTAB VALUES AND ITS DERIVED VARIABLES

	CALL	SETUP		;ANY ERROR CAN OCCUR HERE

;NEXT ESTABLISH:
;(1) APID
;(2) OURSELVES A [SYSTEM]INFO IF [SYSTEM]INFO DOES NOT EXIST
;(3) OUR QUOTA:

	CALL	SETIPC		;SET UP THE IPC PART
	CALL	INIQUO0##	;INIT THE QUOTA SYSTEM
	CALL	SETNAM		;INITIALIZE NAME SYSTEM
	MOVX	T1,NF.DWN	;THE SYSTEM IS NO LONGER
	ANDCAM	T1,NFOSTS##	;DOWNNNNNN....BUT UP.....
	MOVEI	V,DOWN##	;DOWN IS THE LAST WISH
	CALL	.SFIN##		;SET IT FOR CRASHES
	MOVEI	V,UPTXT		;TELL THAT WE ARE LIVING
	CALL	TYPOPB##	;HELLO HERE WE ARE
	RETURN			;IGNORE THE FAILURE
	RETURN			;GO BACK TO CALLER
PSAV:	Z			;P TO GET BACK FROM ERRORS
UPTXT:	ASCIZ	/[SYSTEM]INFO STARTED AND RUNNING]
/
	SUBTTL	GET ALL MONITOR DEPENDENT DATA WITH GETTABS

SETUP:	MOVSI	T1,-GTTBLN	;GET AOBJN VALUE
SETUP0:	MOVE	T2,GTTBVL(T1)	;GET GETTAB CODE
	GETTAB	T2,		;GET THE VALUE
	CALL	GETERR		;THE GETTAB FAILED
	MOVEM	T2,GTTVAR##(T1)	;STORE IT
	AOBJN	T1,SETUP0	;AND GET MORE
;VERFY IF WE CAN RUN!!!
	HRRZ	T1,MONVER##	;GET BINARY MONITOR VERSION
	CAILE	T1,702		;IS IT OK FOR US?
	CALL	NOT703		;NO, DEFER TO QUASAR
	MOVE	T1,OPTION##	;GET OUR UUO OPTIONS
	TXNE	T1,F%PI		;IS PSISER AVAILABLE?
	TXNN	T1,F%IPCF	;(YES) BUT IPCSER IS NEEDED TO
	CALL	NOOPT		;(NO) PROTEST AND EXIT
;SETUP PID TABLE INDICES
	MOVE	T1,[ %FTRTS ]	;GET PARAMETERS
	GETTAB	T1,		;GET VALUE
	SETZ	T1,		;ASSUME NONE
	TXNN	T1,F%VM		;IS VM THERE?
	JRST	SETUP1		;NO JUST LEAVE VARIABLES 0
	HRRZ	T1,.JBFF	;GET FIRST FREE LOC
	MOVEI	T2,1777(T1)	;GET FIRST FREE LOC BACK
	TRZ	T2,777		;ZAP OVERFLOW
	HRRM	T2,.JBFF	;SET THE BORDER AGAIN
	SUBI	T2,1000		;GET START OF REC PAGE
	HRRZM	T2,PGADR##	;STORE IT
	LSH	T2,-^D9		;REDUCE TO PAGE NUMBER
	TLO	T2,400000	;SET THE DESTROY BIT
	MOVEM	T2,PGNUMB##	;AND SET THE NUMBER
	MOVEI	T2,1		;1 ARGUMENT
	MOVEM	T2,PGNUMB-1
SETUP1:	MOVE	T1,PIDNUM##	;GET # OF PIDS
	CALL	GETCOR##	;GET THE TABLE
	CALL	NOCORE		;TOO BAD NO CORE AVAILABLE
	HRRM	V,PIDTBL##	;FOR PID'S: ADDRESSED BY V
	HRRM	V,PIDTBC##	;FOR PID'S ADDRESSED BY T2
	CALL	GETCOR##	;GET ANOTHER TABLE
	CALL	NOCORE		;THERE IS NO CORE
	HRRM	V,PIDFLG##	;FOR PID FLAGS: ADDRESSED BY V
	HRRM	V,PIDFLC##	;FOR PID FLAGS: ADDRESSED BY T2
;SET UP JOB DATA:
	HRRZ	T1,JOBN##	;GET THE NUMBER OF JOBS
	CALL	GETCOR##	;GET A JOB STATUS TABLE
	CALL	NOCORE		;THERE IS NO MORE
	HRRM	V,JOBSTS##	;SET JOB STATUS TABLE
	MOVE	T2,T1		;COPY THE NUMBER OF JOBS
	LSH	T1,1		;TIMES 2 IS LENGTH OF WAIT TABLE
	CALL	GETCOR##	;GET THE TABLE SPACE
	CALL	NOCORE		;LOOSE NO CORE
	MOVEM	V,JBWAIT##	;REMEBER THE WAIT TABLE
	HRLS	V		;MAKE A BLT POINTER
	SETZM	(V)		;TO ZAP THE TABLE
	ADDI	T1,-1(V)	;GET THE LAST ADDRESS
	ADDI	V,1		;TARGET IS ONE HIGHER
	BLT	V,(T1)		;ZAP THE TABLE
	LSH	T2,^D9		;AS MANY SENDS AS JOBS
	IORI	T2,777		;AND THE MAXIMUM NUMBER OF RECEIVES
	MOVEM	T2,MYQUOT##	;AND SET MY QUOTA 
	HRRZ	T1,JOBN##	;GET NUMBER OF JOBS
	MOVNS	T1		;-# OF JOBS
	HRLM	T1,JOBSCN##	;SET THE SCAN VALUE
	MOVE	T1,JOBMSK##	;BUILD THE COMPLEMENT
	SETCMM	T1		;MASK OF THE JOB OR INDEX FILLED
	MOVEM	T1,PIDMSK##	;FOR LATER USE
	MOVE	T1,IPCFD##	;GET IPCF PID
	MOVEM	T1,IPCFPD##	;AND SET IT IN THE IPCF REQUEST BLOCK
	RETURN

GTTBVL:	%IPCCP			;PID OF IPCF
	%IPCMP			;LENGTH OF PID TABLE
	%IPCPM			;MASK TO GET PID INDEX OR JOB#
	%CNSJN			;-# OF SEGMENTS,,#OF JOBS
	%FTUUO			;UUO OPTIONS PSISER&IPCSER
	%LDFFA			;2,,16 FULL FILE ACCESS PPN
	%CNDAE			;MONITOR VERSION WORD
	%CNFLN			;FRCLIN'S TTY NUMBER

GTTBLN=.-GTTBVL
	SUBTTL	GIVE UP ON BEING [SYSTEM]INFO IF THIS IS 7.03

NOT703:	MOVEI	V,MSG703	;POINT TO ERROR MESSAGE
	SETO	T1,		;OUR JOB
	TRMNO.	T1,		;GET OUR TERMINAL ID
	 TDZA	T1,T1		;FORGET IT IF DETACHED
	TRZ	T1,.UXTRM	;KEEP ONLY LINE NUMBER
	CAME	T1,FRCLIN##	;RUNNING ON FRCLIN?
	 JRST	ERRTYP		;NO, ABORT THE STANDARD WAY
	CALL	TYPOPR##	;YES, TELL THE OPERATOR WHY WE GAVE UP
	 JFCL			;IGNORE ERROR
	CALL	DOWN##		;WE'RE DEAD
	CALL	ZAPRUN##	;AND NOT RESTARTABLE
	 JFCL			;IGNORE ERRORS
	MOVSI	T1,-1		;DETACH ARGUMENT
	ATTACH	T1,		;TRY TO GIVE AWAY THE FORCE LINE
	 JFCL			;TOO LATE TO WORRY IF CAN'T
	MOVEI	T1,[SIXBIT /SYS/
		    SIXBIT /LOGOUT/
		    EXP 0,0,0,0]
	RUN	T1,		;TRY TO LOGOUT INSTEAD
	 HALT			;I DON'T WANT TO HEAR ABOUT IT
MSG703:	ASCIZ	|Deferring the [SYSTEM]INFO facility to QUASAR for 7.03
|
	SUBTTL	SET UP THIS JOB AS [SYSTEM]INFO
;THE SET UP OF [SYSTEM]INFO REQUIRES THE FOLLOWING STEPS
;(1) (STATE ZERO)INTO (STATE ONE) GET A PID
;(2) (STATE ONE) INTO (STATE TWO) MAKE OURSELVES SYS: INFO
;(3) (STATE TWO) INTO (STATE THREE) SET US OUR ROYAL QUOTA:
;ERRORS CAN BE CLASSIFIED AS
;(1) ZERO INTO ONE TOO BAD SIMPLY NO PRIVILIGES
;(2) ONE INTO TWO OPERATOR DOES NOT KNOW WHAT THE DOES RELEASE PID
;(3) TWO TO THREE SHOULD NOT HAPPEN, BUT ONE CAN LIVE WITH LESS


SETIPC:	CALL	GETTWO##	;GET TWO MESSAGE BLOCKS V,W
	CALL	SPCERR##	;NO MORE CORE
	MOVE	U,V		;COPY TO A GOOD REGISTER
SETIP0:	CALL	GETIPC##	;GET ALL OLD MESSAGES
	SKIPA			;NO ONE MORE AROUND
	JRST	SETIP0		;AND FORGET THEM
	MOVSI	P1,-3		;3 STATES CHANGE
SETPI0:	CALL	<@STCHNG(P1)>	;TRY TO CHANGE THE STATE
SETPI2:	CALL	GETIPC##	;GET THE ANSWER
	JRST	@STTERR(P1)	;PROCESS THE ERROR
	LDB	T1,IP.CRE(U)	;GET IPCC FLAGS
	JUMPN	T1,@STTERR(P1)	;AND LOOSE 
	HLRZ	T1,BL.COD(W)	;GET THE ID
	CAME	T1,U		;IS IT OURS?
	JRST	SETPI2		;(NO) JUNK IT
	CALL	@SETSTT(P1)	;SET THE VALUE
	AOBJN	P1,SETPI0	;FOR ALL 3 STATES
SETPI1:	MOVE	V,U		;NO PRIVILIGES FOR V
	CALL	RETTWO##	;RETURN CORE
	RETURN

STCHNG:	GETPID			;GET MY PID
	MASTER			;NO PROFINCTIES (SEE SYSTAT)
	LOTS			;TREAT YOURSELF GENEROUSLY

SETSTT:	SETPID			;REMEMBER YOUR PLACE IN THE SYSTEM
	CPOPJ##			;SEE IF WE ARE MU BIG
	CPOPJ##			;DO NOT BOTHER EVER OR NEVER?)

STTERR:	NOPID			;WE GOT NO PID
	NOMAST			;WE ARE NO [SYSTEM]INFO
	SETPI1			;FORGET THIS
	SUBTTL	SUBFUNCTIONS FOR IPCF SETUP

GETPID:	MOVEI	T1,.IPCSC	;CREATE A PID
	HRL	T1,U		;SET MY STAMP
	MOVEM	T1,BL.COD(U)	;THAT'S WHAT IS GOING TO HAPPEN
	MOVE	T1,MYJOB##	;IT IS FOR ME
	MOVEM	T1,BL.PID(U)	;THE REST CAN BE FORGOTTEN
	CALL	IPCSPS##	;DO A PRIVILEGED SEND
	CALL	NOPID		;WE BLEW IT A FATAL SEND ERROR
	CALL	NOPID		;RENTERY IT
	RETURN			;WAIT FOR THE ANSWER
SETPID:	MOVE	T1,BL.STR(W)	;GET THE PID
	CAIN	T1,0		;[314]DID WE GET A VALID PID?
	JRST	NOPID		;[314] NO, WE DIDN'T.
	MOVEM	T1,MYPID##	;REMEMBER MY PID FINISH MY BLOK
	MOVEM	T1,MYPID0##	;MY PID FOR  SENDS TO USERS
	MOVEM	T1,BL.UU2(U)	;I AN THE RECEIVER
	MOVX	T1,NF.PID	;[314]WE ACQUIRED A PID.
	IORM	T1,NFOSTS##	;[314]FLAG IT IN THE STATUS WORD.
	RETURN
MASTER:	MOVEI	T1,.IPCSF	;MAKE ME [SYSTEM]INFO
	HRL	T1,U		;SET MY STAMP
	MOVEM	T1,BL.COD(U)	;SET THE REQUEST
	SETZM	BL.STR(U)	;0 MEANS SYS:[SYSTEM]INFO
	MOVE	T1,MYPID##	;GET MY PID VALUE
	MOVEM	T1,BL.PID(U)	;WHICH SHOULD BE IT
	CALL	IPCSPS##	;SEND PRIVILEGED
	CALL	NOMAST		;WE DID NOT MAKE IT
	CALL	NOMAST		;EVEN IF RECOVERABLE
	RETURN
LOTS:	MOVX	T1,NF.NFO	;WE ARE NOW SYS:[SYSTEM]INFO
	IORM	T1,NFOSTS##	;FLAG IT FOR THE ERROR PROCESSOR
	MOVE	T1,MYPID##	;GET MY PID
	MOVEM	T1,BL.PID(U)	;REQUIRED FOR QUOTA REQUEST
	MOVE	T1,MYQUOT##	;SET MY QUOTA
	HRL	T1,U		;SET MY STAMP
	MOVEM	T1,BL.STR(U)
	MOVEI	T1,.IPCSQ	;AND THE SET QUOTA FUNCTION
	MOVEM	T1,BL.COD(U)
	CALL	IPCSPS##	;GET A LIBERAL AMOUNT
	RETURN			;IGNORE
	RETURN			;IGNORE IGNORE
	RETURN			;WE GOT IT
;SET UP STANDARD NAME ENTRIES FOR:
;[SYSTEM]INFO AND [SYSTEM]IPCF
;AND PUT PIDS IN PID TABLE

SETNAM:	SETZM	T2		;PID TABLE INDEX
	MOVEI	T1,NM.INF##	;GET [SYSTEM]INFO'S NAME SLOT
	HRRZM	T1,@PIDFLC##	;STORE ADDRESS IN TABLE
	MOVE	T3,MYPID##	;GET INFO'S PID
	MOVEM	T3,@PIDTBC##	;STORE IT IN PID TABLE
	MOVEM	T3,NM.INF##+BL.PID	;AND IN NAME SLOT
	ADDI	T2,1		;GO TO IPCF ENTRY
	MOVEI	T1,NM.IPF##	;IPCF NAME SLOT
	HRRZM	T1,@PIDFLC##	;STORE IN PID TABLE
	MOVE	T3,IPCFPD##	;GET IPCF'PID
	MOVEM	T3,@PIDTBC##	;STORE IT IN TABLE
	MOVEM	T3,NM.IPF##+BL.PID	;STORE PID IN NAME SLOT
	RETURN
;INITIALIZATION ERRORS
;NEVER RETURN FROM DOWN!!!!!

GETERR:	MOVEI	V,TX8
	JRST	ERRTYP		;TYPE IT
TX8:	ASCIZ	/GETTAB UUO FAILED
/

NOCORE:	MOVEI	V,TX9
	JRST	ERRTYP		;TYPE IT
TX9:	ASCIZ	/NO CORE DURING START UP
/
NOOPT::	MOVEI	V,TX10
	JRST	ERRTYP		;TYPE IT
TX10:	ASCIZ	/EITHER PSISER OR IPCSER IS NOT SUPPORTED
/
NOPID:	MOVEI	V,TX11
	JRST	ERRTYP		;TYPE IT
TX11:	ASCIZ	/NO PID WAS OBTAINED BY [SYSTEM]INFO
/
NOMAST:	MOVEI	V,TX12
	JRST	ERRTYP		;TYPE IT
TX12:	ASCIZ	/FAILURE TO BECOME [SYSTEM]INFO
/
NOPSI:	MOVEI	V,TX13
ERRTYP:	CALL	TYPOPR##
	JFCL
	CALL	DOWN##
	MOVEI	T1,.GTPRG	;GET OUR NAME
	PJOB	T2,		;AND JOB NUMBER
	HRL	T1,T2		;CONSTRUCT OUR NAME
	GETTAB	T1,		;THIS IS OUR NAME
	SETZ	T1,		;A GETTAB PROBLEM
	MOVE	P,PSAV		;IN CASE WE RETURN EXIT TO INIINF CALLER
	CAMN	T1,[SIXBIT /DAEMON/]	;THE MIGHTY ONE
	RETURN			;LET DAEMON RUN
	CALL	ZAPRUN##	;REMOVE TMPCOR FILE
	JFCL			;IGNORE THE FAILURE
	EXIT			;NO, JUST EXIT
TX13:	ASCIZ	/INTERRUPT SYSTEM DID NOT START
/
	END