perm filename NWORLD[S,AIL]2 blob sn#010864 filedate 1972-11-10 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00025 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00007 00002	 MANY DECLARATIONS
 00012 00003	PROCESS VARIABLE NUMBERS
 00015 00004	event variables
 00016 00005	procedure descriptors & null process skeleton
 00018 00006	DSCR SPROUT -- THE PROCESS SPROUTER
 00022 00007	
 00028 00008	
 00029 00009	routines for inserting & deleting set elements
 00033 00010	USER REQUESTED SCHEDULING
 00037 00011	RESUME
 00039 00012	SUSPEND and TERMINATE runtime routines
 00042 00013	The JOIN runtime routine
 00044 00014	THE MAIN PROCESS INITIALIZER
 00046 00015	CALLER AND MYPROC 
 00047 00016	SPECIAL GC ROUTINE FOR PROCESSES
 00048 00017	 TIMER & OTHER INTERRUPTS
 00049 00018	 CAUSE 
 00051 00019	CAUSE1 -- ROUTINE TO DO ACTUAL WORK 
 00054 00020	ANSWER -- subroutine used by CAUSE
 00056 00021	DELWRQ -- delete all wait requests
 00057 00022	INTERROGATE
 00059 00023	ASK -- used by INTERROGATE
 00062 00024	MKEVTT,SETCP,& SETIP
 00063 00025	
 00064 ENDMK
⊗;
; MANY DECLARATIONS
COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
DEFINE ENS2 <%PSSGC,POLL,INTSET,INTMOD,CAUSE,ANSWER,INTERROGATE,SETCP>
DEFINE ENS3 <MKEVTT,SETIP,MYPROC>
DEFINE EXT1 <JOBAPR,LEAP,STKUWD,X44,GOGTAB,%ARSR1,SGINS,ALLPDP>
DEFINE EXT2 <CORGET,CORREL,INTRPT,INFTB,%SPGC,X22,%SPGC1,FP1DON,STACSV>
DEFINE EXT3 <X33,%ARRSR,DATM,SGLKBK,FP2DON,SGREM,STACRS,RUNNER>

COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗

COMPXX(PRC,<ENS1,ENS2,ENS3>,<EXT1,EXT2,EXT3>
	,<MULTIPLE PROCESS STUFF>,<SPRPDA>,HIIFPOSSIB)




BEGIN PROCSS

; (AC DEFNS)

; A,B,C,P,SP,RF AS BEFORE
KL	←D	;KILL LIST & SCRATCH
PB	←5	;PROCESS BASE
OPTS	←6	;HOLDS OPTIONS
PDA	←7	;HOLDS PDA
EVT	←10	;EVENT DATUM
NSP	←←10	;NEW SP
NP	←11	;NEW P
TMP	←LPSA	;TEMP AC

GLOB < 
TABL ←← 7	;NEEDED BY LIST CELL GETTER
>;GLOB
NOGLOB <
TABL ←← USER	;NEEDED BY LIST CELL GETTER
>;NOGLOB
FP ←← 6		;NEEDED BY LIST CELL GETTER

; (LOCAL VARIABLES FOR SCHEDULER)
MAXPRI ←← 0	;MAXIMUM PRIORITY
MINPRI ←← NPRIS-1

;REASONS FOR SUSPENSION
PSPF←←0		;ONLY P, SP, F NEED BE RESTORED
SPNDR←←1	;SUSPENDED (FROM READY) BY SUSPEND
JOINR←←2	;SUSPENDED BECAUSE OF A JOIN
WAITNG←←3	;WAITING ON AN EVENT OR SO

; ( CONSTANT DATA USED BY SPROUTER)

; FIELD DEFNS FOR OPTIONS WORD (SEE ALSO POINT S BELOW)

STSMSK←	77 ⊗ =8	;MASK FOR P STACK SIZE FIELD
SSSMSK←	17 ⊗ =14;MASK FOR SP STACK SIZE FIELD OF OPTIONS WORD
PRIMSK←	17 ⊗ 4	;MASK FOR PRIORITY FIELD
QNTMSK←← 17	;MASK FOR QUANTUM
RUNME←←	1	;RUN THE SPROUTING PROCESS
SPNDME←←2	;SUSPEND THE SPROUTING PROCESS
SPNDNP←←10	;SUSPEND THE NEW PROCESS

;MORE FIELD DEFS & BIT VALUES
TERM  ←← 1	;BIT (LH) IN DATUM OF TERMINATED PROCESS ITEM

;DEFAULT VALUES

STPSZ←	200	;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
STSPST ←100	;DEFAULT SP STACK SIZE
STDQNT ←← 2	;DEFAULT (LOG2(QUANTUM)) -- STD QUANTUM IS 4
STDPRI	←←7	;DEFAULT PRIORITY

; (CONSTANTS USED BY SPROUTER)
SSSBYT:	POINT	4,OPTS,21	;STRING STACK FIELD (MOD 32)
STSBYT:	POINT	6,OPTS,27	;P - STACK FIELD (MOD 32)
PRIBYT:	POINT	4,OPTS,31	;PRIORITY FIELD
QNTBYT:	POINT	4,OPTS,17	;LOG2 (QUANTUM)


; MACROS USED TO GET LIST CELLS
DEFINE NCELL(AC) <
	MOVE	FP,FP1(TABL)	;USE WHERE SURE THE LIST SPACE IS INITIALIZED
	HRRI	AC,(FP)
	SKIPN	FP,(FP)
	PUSHJ	P,FP1DON
	HRRM	FP,FP1(TABL)
>

DEFINE NNCELL(AC) <
	SKIPN	FP,FP1(TABL)	;USE WHERE LIST SPACE MAY NEED INITIALIZATION
	PUSHJ	P,FP1DON
	HRRI	AC,(FP)
	SKIPN	FP,(FP)
	PUSHJ	P,FP1DON
	HRRM	FP,FP1(TABL)
>

DEFINE NNCLL2(AC) <
	SKIPN	FP,FP2(TABL)	;USE WHERE LIST SPACE MAY NEED INITIALIZATION
	PUSHJ	P,FP2DON
	HRRI	AC,(FP)
	SKIPN	FP,(FP)
	PUSHJ	P,FP2DON
	HRRM	FP,FP2(TABL)
>

OPDEF INTENS [ CALLI 400031]
OPDEF IWAIT  [ CALLI 400040]

;PROCESS VARIABLE NUMBERS

DEFINE PVAR (V,ATTRIB),
	<↑V ←← NPVARS
	NPVARS←← NPVARS+1
IFE ALWAYS,<
	IFDIF <ATTRIB>,<> < ATTRIB V >
>;IFE ALWAYS
	>


NPVARS←← 0

	PVAR	DYNL	;DYNAMIC LINK
	PVAR	STATL	;STATIC LINK
	PVAR	ISP	;REST OF MSCP
	PVAR	AC0	;AC SAVE AREA
	PVAR	AC1
	PVAR	AC2
	PVAR	AC3
	PVAR	AC4
	PVAR	AC5
	PVAR	AC6
	PVAR	AC7
	PVAR	AC10
	PVAR	AC11
	PVAR	AC12
	PVAR	AC13
	PVAR	AC14
	PVAR	AC15
	PVAR	AC16
	PVAR	AC17
↑ACF ←← AC12
↑ACP ←← AC17
↑ACSP ←← AC16
	PVAR	PCW	;PC WORD
	PVAR	QUANTM	;TIME QUANTUM
	PVAR	PRIOR	;PRIORITY
	PVAR	PRCITM	;PROCESS ITEM OF THIS PROCESS
	PVAR	KLOWNR	;THE OWNER OF MY KILL LIST
	PVAR 	STATUS	;-1 = RUNNING, 0 = SUSPEND, 1 = READY, 2 = TERMINATED
	PVAR	DADDY,INTERNAL	;PROCESS ITEM OF SPROUTING PROCESS
	PVAR	CAUSRA	;RETN ADDRESS FROM CAUSE
;THE FOLLOWING ARE ZEROED OUT ON CREATION
ZFIRST←←NPVARS
	PVAR	CURSCB,INTERNAL ;CURRENT SEARCH CONTROL BLOCK
	PVAR	REASON	;HOW GOT UNSCHEDULED (0 => ONLY NEED ACS F,SP,P)
	PVAR	PLISTE	;PRIORITY LIST ENTRY
	PVAR	RSMR	;THE GUY WHO RESUMED ME
	PVAR	JOINCT	;HOW MANY PROCESSES NEED TO JOIN THIS ONE
	PVAR	JOINS	;WHO IS WAITING TO FOR ME TO JOIN (A SET OF ITEMS)
	PVAR	WAITES	;LIST OF ALL EVENT TYPES ON WHICH I AM WAITING
	PVAR	INTRGC	;THE CONTROL WORD FOR MY CURENT INTERROGATION
	PVAR	CAUSES	;COUNT OF CAUSES PENDING
	PVAR	CAUSEQ	;QUEUE OF CAUSES TO BE MADE
ZLAST←←NPVARS-1

↑NPVARS ← NPVARS
↑STKBAS ← NPVARS	;STACK BASE SIZE (= #PROCESS VARS FOR NOW)
COMMENT ⊗event variables⊗

NEVARS←←0

DEFINE EVAR(V) ,
	<↑↑V←←NEVARS
	NEVARS←←NEVARS+1
	>

	EVAR	NOTCLS		;LIST OF CURRENT NOTICES
	EVAR	WAITLS		;LIST OF CURRENTLY WAITING PROCESSES
	EVAR	CAUSEP		;USER SPEC CAUSE PROC
	EVAR	INTRGP		;USER SPEC INTERROGATE PROC
	EVAR	USER1		;AVAIL TO USER
	EVAR	USER2		;AVAIL TO USERR

;OPTIONS BITS FOR CAUSE
DNTSAV ←← 1
TELLAL ←← 2
SCHDIT ←← 4

;OPTIONS BITS FOR INTERROGATE
RETAIN ←← 1
WAIT   ←← 2
SAYWCH ←← 10
MULTIN ←← 200000
NOJOY  ←← 400000

COMMENT ⊗procedure descriptors & null process skeleton⊗

FLXXX←←0
UP <
FLXXX←←%FIRLOC-400000
>;UP


DEFINE PUTINLOC(LCN,V),< 
	RELOC LCN+FLXXX
	V
	RELOC
>

;MAKE A PD FOR THE SPROUTER
↑SPRPDA:BLOCK PD.XXX+1

DEFINE FPDE(IX,V),<PUTINLOC (SPRPDA+IX,V)>

	FPDE	(PD.,SPROUT)
	FPDE	(PD.DSW,STKBAS)
	FPDE	(PD.PDA,<<XWD SPRPDA,0>>)
	FPDE	(PD.LLW,<SPRPDA+PD.XXX>)
	FPDE	(PD.DLW,<SPRPDA+PD.XXX>)


IFN 0,<

;NULL PROCESS
NULPDA:	NULPRO			;PD OF NUL PROC
↑NULPRC: %NULPR			;NULL PROCESS

%NULPR:	BLOCK STKBAS+=32	;NULL PROCESS AREA

DEFINE NPE (IX,V), <PUTINLOC (%NULPR+IX,V)>

	NPE	(STATL,<<XWD SPRPDA,0>>)
	NPE	(ACF,STKBAS+%NULPR+1)
	NPE	(ACP,<<TPDL: XWD - =29,%NULPR+STKBAS+3>>)
	NPE	(STKBAS+1,%NULPR+DYNL)
	NPE	(STKBAS+2,<<XWD NULPDA,0>>)



↑NULPRO:
	ERR	<I SHOULD NEVER RUN>
>;IFN 0







DSCR SPROUT -- THE PROCESS SPROUTER
CAL 	PUSHJ
PARM	-1(P)	;KILL LIST
	-2(P)	;OPTIONS WORD
	-3(P)	;PDA OF SPROUTED PROCESS
	-4(P)	; PROCEDURE PARAMS
	:
	-?(P)	;LAST OF PROCEDURRE PARAMS
	-?-1(P)	;PROCESS ITEM
DES 
	This procedure acts as the "process" procedure.
Roughly, it does the following:

1. Saves the return address in PCW(RUNNER)
2. gets stack space
3. puts self on appropriate kill list & priority list
4. copies over the procedure parameters.
5. sets status of new & SPROUTing process
	&(eventually) calls the appropriate procedure.
6. when the procedure returns, SPROUT then kills the process.

⊗
HERE (SPROUT)
	MOVE	USER,RUNNER	;
	POP	P,PCW(USER)	;RETN ADDRESS
	POP	P,KL		;PICK UP KILLL LIST
	POP	P,OPTS		;OPTIONS
	TRNE	OPTS,SSSMSK	;SPECIFIED SP STACK SIZE ?
	JRST	[ LDB C,SSSBYT	;YES, GET IT
		LSH   C,5	;TIMES 32
		JRST  .+2 ]
	MOVEI	C,STSPST	;STANDARD SIZE
	PUSHJ	P,CORGET	;GET SPACE
	ERR	<NOT ENOUGH CORE -- SPROUT >
	MOVN	C,C		;MAKE PDP
	HRLZI	NSP,-1(C)	
	HRRI	NSP,-1(B)
	TRNE	OPTS,STSMSK	;P - STACK
	JRST	[ LDB C,STSBYT	;YES, GET IT
		LSH	C,5	;TIMES 32
		ADDI	C,STKBAS;SPACE FOR BASE
		JRST	.+2]
	MOVEI	C,STPSZ+STKBAS	;STANDARD AMOUNT TO GET
	PUSHJ	P,CORGET	;GET ROOM
	ERR	<NOT ENOUGH CORE -- SPROUT >
	MOVE	PB,B		;PROCESS BASE
	MOVN	C,C
	HRLZI	NP,STKBAS(C)	;MAKE PDP
	HRRI	NP,STKBAS(PB)

;ZERO OUT SOME OF THE PROCESS VARS
	HRLZI	A,ZFIRST(PB)	;
	HRRI	A,ZFIRST+1(PB)
	SETZM	ZFIRST(PB)
	BLT	A,ZLAST(PB)

;REMEMBER DADDY
	MOVE	USER,RUNNER
	MOVE	A,PRCITM(USER)
	MOVEM	A,DADDY(PB)

;BUILD MSCP, ETC.

	MOVEM	RF,DYNL(PB)	;
	HRLI	RF,SPRPDA
	MOVEM	RF,STATL(PB)	;MAKE LINKS THE SAME
	MOVEM	NSP,ISP(PB)	;

;COPY PROC PARAMS

	POP	P,PDA		;FIND OUT WHO
	HLRZ	TMP,PD.NPW(PDA)	;#STRING PARAMS*2
	JUMPE	TMP,STPSON	;HAVE ANY ?
	HRL	TMP,TMP		;YES, DO A BLT
	HRRZI	A,1(NSP)	;DEST
	ADD	NSP,TMP		;BUMP OLD STACK
	SUB	SP,TMP		;DECREMENT OLD STACK
	HRLI	A,1(SP)		;SOURCE
	BLT	A,(NSP)		;COPY THEM
STPSON:	HRRZ	TMP,PD.NPW(PDA)	;# ARITH PARMS +1
	SOJLE	TMP,APSON	;ANY TO BLT ?
	HRL	TMP,TMP		;MAKE XWD
	HRRZI	A,1(NP)		;DEST
	ADD	NP,TMP
	SUB	P,TMP
	HRLI	A,1(P)
	BLT	A,(NP)		;DO IT
APSON:


;NOW  SET UP NEW PROCESS'S STATUS, QUANTUM, & PRIORITY

	SETOM	STATUS(PB)		;ASSUME RUNNING
	TRNE	OPTS,SPNDNP		;UNLESS SUSPEND
	SETZM	STATUS(PB)		;0 MEANS SUSPENDED
	MOVEI	A,STDQNT		;STANDARD QUANTUM
	TLNE	OPTS,QNTMSK		;GET LOG2 QUANTUM
	LDB	A,QNTBYT
	MOVEI	TMP,1
	LSH	TMP,(A)
	MOVEM	TMP,QUANTM(PB)
	MOVEI	A,STDPRI		;ASSUME STD PRIORITY
	TRNE	OPTS,PRIMSK		;SAID OTHERWISE?
	LDB	A,PRIBYT
	PUSHJ	P,SETPRI		;GO SET PRIORITY

;SET UP PROCESS ITEM

	POP	P,B			;PICK UP ITEM #
	MOVEM	B,PRCITM(PB)		;REMEMBER IT
	MOVEI	A,PRCTYP		;SAY IS OF TYPE PROCESS

COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;

	HRRZM	A,@INFTB		;SAY IS A PROCESS
	MOVE	C,B			;
	HRRZM	PB,@DATM		;SET DATUM VALUE

;KILL SET STUFF
	MOVEM	KL,KLOWNR(PB)		;REMEMBER KILL LIST OWNER
	PUSH	P,TABL			;NEED TO SAVE THESE
	PUSH	P,FP			;
	PUSHJ	P,INSRTS		;GO PUT ITEM IN KILL SET
	POP	P,FP
	POP	P,TABL

;NOW DECIDE WHAT TO DO WITH SPROUTING PROCESS & DO THE RIGHT THING

	MOVE 	USER,RUNNER		;HOPE IT IS STILL HIM
	TRNE	OPTS,RUNME		; DOES SPROUTING PROCESS WANT TO RUN?
	JRST	RNSPRR			;YES
	MOVEM	P,ACP(USER)		;IF HERE, THEN WANT TO RUN NEW GUY
	MOVEM	SP,ACSP(USER)		;SAVE THE NECESSARY ACS
	MOVEM	RF,ACF(USER)		;
	MOVNS	STATUS(USER)		;RUNNING →→ READY
	TRNE	OPTS,SPNDME		;IF I WANTED SUSPENSION
	SETZM	STATUS(USER)		;DO IT
	SKIPL	STATUS(PB)		;DOES SPROUTED PROCESS WANT TO RUN
	JRST	NORFR			;NO
	MOVE	USER,GOGTAB
	MOVE	A,QUANTM(PB)
	MOVEM	A,TIMER(USER)
	MOVE	P,NP			;
	MOVE	SP,NSP			;GET READY
	MOVEI	RF,DYNL(PB)		;
	MOVEM	PB,RUNNER
CALLIT:	PUSHJ	P,@PD.(PDA)		;CALL THE SO AND SO

;HERE IS WHERE WE COME ON PROCEDURE EXIT
CALRET:	MOVE	PB,RUNNER		;I HOPE ITS ME
	PUSHJ	P,KACTS			;DO EVERYTHING BUT SPACE FREEING
	MOVE	P,ALLPDP		;USE THIS PDL FOR KILLING CORE

;NOW KILL CORE FOR SP STACK

	HRRZ	B,ISP(PB)
	ADDI	B,1
	PUSHJ	P,CORREL

;NOW KILL CORE FOR P-STACK

	HRRZI	B,(PB)
	PUSHJ	P,CORREL

;NOW ALL TRACES ARE GONE (I HOPE)

	JRST	FOTR			;GO FIND SOMETHING TO DO

;PROCEDURE THAT PERFORMS ALL KILL ACTIONS EXCEPT STACK RELEASING
;EXPECTS PB TO POINT AT THE CONDEMNED PROCESS
;USES A,B,C,KL

KACTS:	HRRZ	KL,KLOWNR(PB)		;GET OWNER OF KILL SET
	HRRZ	B,PRCITM(PB)
	MOVE	C,B			;
	TLO	PB,TERM			;SET TERM BIT
	MOVEM	PB,@DATM		;TERMINATED
	PUSHJ	P,DELTSE		;DELETE FROM SET

;NOW  CHECK TO SEE IF WE WERE ON ANY JOIN LISTS

	SKIPN	A,JOINS(PB)
	JRST	REMPRI
	MOVE	KL,GOGTAB	;
KACT.1:	HLRZ	C,(A)		;THE ITEM
	MOVE	B,@DATM		;GET ADDRESS OF THE DATUM
	TLNE	B,TERM		;DEAD ALREADY??
	JRST	KACT.2		;YES
	SOSLE	JOINCT(B)	;READY TO ROLL ??
	JRST	KACT.2		;NO
	SKIPN	STATUS(B)	;CURRENT STATUS
	AOS	STATUS(B)	;READY
KACT.2:	HRRZ	B,(A)
	HRR	C,FP1(KL)	;RELEASE LIST CELL
	HRRM	C,(A)	
	HRRM	A,FP1(KL)	;NEW FREE LIST
	JUMPE	B,REMPRI	;END OF LIST
	MOVE	A,B		;
	JRST 	KACT.1



;NOW TAKE OFF PRIORITY LIST AND RETURN
;NOTE -- THE CODE FROM HERE TO THE POPJ IS ITSELF A PROCEDURE USED
;ELSEWHERE TO REMOVE PROCESS (PB) FROM ITS PRIORITY LIST
;SIDE EFFECTS -- USES A,B,C 

REMPRI:	MOVE	A,PRIOR(PB)
	ADD	A,GOGTAB
	HRRZ	B,PLISTE(PB)
	HLRZ	C,PLISTE(PB)
	JUMPN	C,.+3
	HRRM	B,PRILIS(A)		;HEAD OF LIST
	JRST	.+2
	HRRM	B,PLISTE(C)		;NEXT(C)←B
	JUMPN	B,.+3
	HRLM	C,PRILIS(A)		;NEW TAIL
	POPJ	P,
	HRLM	C,PLISTE(B)		;PREV(B)←C
CPOPJ:	POPJ	P,

;PROCEDURE TO PUT PROCESS (PB) ON PRIORITY LIST A
;SIDE EFFECT -- MODIFIES B
SETPRI:	MOVEM	A,PRIOR(PB)		;REMEMBER MY PRIORITY
	ADD	A,GOGTAB
	SKIPE	B,PRILIS(A)		;PRIORITY LIST OWNER
	HRLM	PB,PLISTE(B)		;LINK BACK
	HRRZM	B,PLISTE(PB)		;LIINK DOWM
	HRRM	PB,PRILIS(A)		;NEW RHS FOR OWNER IS → ME
	TLNN	B,-1			;WAS THE LIST EMPTY ??
	HRLM	PB,PRILIS(A)		;YES -- THIS IS THE TAIL TOO
	POPJ	P,


;HERE IF DONT WANT TO RUN NEW GUY RIGHT AWAY
NORFR:	TROA	B,1			;FLAG
RNSPRR:	MOVEI	B,0
	MOVNS	STATUS(PB)		;IF NEW IS "RUNNING", THEN "READY"
	PUSH	NP,[CALRET]		;
	MOVEM	NP,ACP(PB)		;SET UP NEC. SAVES
	MOVEM	NSP,ACSP(PB)
	MOVEI	A,DYNL(PB)		
	MOVEM	A,ACF(PB)
	MOVE	A,PD.(PDA)		;WHERE HE STARTS
	MOVEM	A,PCW(PB)
	CAIN	B,			;SPROUTER RUNS??
	JRST	@PCW(USER)		;YES -- 
	JRST	FOTR			;NO -- FIND SOMEONE TO RUN

COMMENT ⊗routines for inserting & deleting set elements⊗

;expects item no in B , (KL) = the owner
;mangles A,B,C,FP,TABL

INSRTS:	MOVE	TABL,GOGTAB
	SKIPN	A,(KL)		;GET OWNER
	JRST	NEWINS		;IT WAS NULL BEFORE
	MOVE	C,(A)		;POINT AT FIRST
ISCH:	MOVS	C,(C)		;CONTENTS (SWAPPED) OF THIS
	CAILE	B,(C)		;ELIGIBLE
	JRST	NX1		;MUST GO FURTHER
	CAIL	B,(C)		;THERE ALREADY?
	POPJ	P,		;YES
NI:	HRL	B,(A)		;POINTER AT THIS
	NCELL	(C)		;GET A CELL FOR IT
	MOVSM	B,(C)		;SAVE CONTENTS OF CELL
	HRRM	C,(A)		;LINK TO NEW
	HRLZI	A,1
	ADDB	A,(KL)		;UPDATE COUNT -- POINT AT LAST,,FIRST
	TLNN	B,-1		;AT THE END???
	HRLM	C,(A)		;YES
	POPJ	P,
NX1:	HRRZ	A,(A)
	TLNN	C,-1		;END OF LIST
	JRST	NI		;YES -- PUT AT END
	MOVSS	C
	JRST	ISCH		;GO LOOK SOME MORE
NEWINS:	NNCELL	(A)
	SETZM	(A)
	HRRZM	A,(KL)		;IT USED TO BE NULL
	JRST	NI

;ROUTINES FOR ADDING TO LISTS
;EXPECT ITEM NO IN B, KL= ADRS OF OWNER
;MANGLE A,B,C,FP,TABL
IHEDLS:	SKIPN	A,(KL)		;INSERT AT HEAD
	JRST	NEWINS
	JRST	NI		
ITAILS:	SKIPN	A,(KL)		;INSERT AT TAIL
	JRST	NEWINS
	MOVS	A,(A)
	JRST	NI


;ROUTINE TO DELETE SET OR LIST ELEMENTS
;B = ITEM NO, (KL) IS THE OWNER
;MANGLES A,B,C,TABL

DELTLE:
DELTSE:	SKIPN	A,(KL)		;GET SET DESCRIPTOR
	POPJ	P,		;NULL ALREADY
	MOVE	C,(A)
DSCH:	MOVE	C,(C)
	TLC	C,(B)
	TLNN	C,-1		;WAS IT THIS ONE???
	JRST	DIT		;YES
	TRNN	C,-1		;END OF SEARCH
	POPJ	P,		;YES
	MOVE	A,(A)		;LINK
	JRST	DSCH		;GO LOOK
DIT:	MOVE	TABL,GOGTAB
	MOVE	B,(A)		;B →→ TO THIS CELL
	HRRM	C,(A)		;LINK PREV TO NEXT
	HRL	C,FP1(TABL)	;OLD FREE LIST
	HLRM	C,(B)		;LINK CELL
	HRRM	B,FP1(TABL)	;
	HRLZI	B,-1		;ADJUST DESCRIPTOR
	ADDB	B,(KL)
	TLNE	B,-1		;LIST NULL NOW???
	JRST	CKEND		;NO
	SETZM	(KL)		;YES
	MOVSS	(B)		;LAST,,FIRST CELL 
				;NOW IS 0,,→CELL JUST FREED UP
	HRRM	B,FP1(TABL)	;NEW FREE LIST
	POPJ	P,
CKEND:	TRNN	C,-1		;WAS THIS THE END
	HRLM	A,(B)		;YES
	POPJ	P,


;ROUTINE TO DELETE FIRST ELT OF A LIST
;PUTS ITEM # INTO A
;EXPECTS (KL) = THE OWNER
;MODIFIES A,B,C,TABL

REMCAR:	SKIPN	A,(KL)
	POPJ	P,		;IF WAS NULL RETURN A 0
	MOVE	C,(A)
	MOVE	C,(C)		;FIRST REAL LIST CELL
	HLRZ	B,C		;FIRST ONE
	PUSH	P,B		;SAVE IT
	PUSHJ	P,DIT
	POP	P,A		;VALUE
	POPJ	P,





;USER REQUESTED SCHEDULING


HERE(URSCHD)
	MOVE	PB,RUNNER
	SKIPL	STATUS(PB)		;
	JRST 	FOTR			;GO FIND ONE TO RUN
	MOVNS	STATUS(PB)		;SET TO READY
SPSRN1:	SETZM	REASON(PB)		;OTHER ACS NOT SAVED
SPSRN2:	POP	P,PCW(PB)		;DITTO -- BUT LEAVE REASON INTACT
					;THESE TWO LABELS ARE USED
					;BY SUSPEND, JOIN & THE LIKE
	MOVEM	P,ACP(PB)
	MOVEM	SP,ACSP(PB)
	MOVEM	RF,ACF(PB)		
FOTR:	HRRZ	B,GOGTAB
	TLO	B,-NPRIS
	MOVEI	A,1			;READY
SCHLIS:	SKIPN	PB,PRILIS(B)		;SEARCH DOWN THIS LIST
	JRST	NXLIS			;LIST IS EMPTY
TRYTHS:	CAMN	A,STATUS(PB)		;IS THIS READY
	JRST	SCDTHS			;YES -- DO HIM
	HRRZ	PB,PLISTE(PB)		;LINK DOWN LIST
	JUMPN	PB,TRYTHS		;IF ANY LEFT AT THIS LEVEL,TRY
NXLIS:	AOBJN	B,SCHLIS		;SEARCH LIST
	INTENS	B,			;GET INTERRUPT ENABLING
	TLNN	B,775200		;IS HE ENABLED FOR SOMETHING
					;THAT CAN STILL HAPPEN
	ERR <NO ONE TO RUN>		;NO
	IWAIT				;WAIT FOR AN INTERRUPT
	SETZM	INTRPT			;ZERO THE FLAG
	JRST	FOTR			;FIND SOMEONE TO RUN

SCDTHS:	
;CIRCLE THE QUEUE
	SKIPN	A,PLISTE(PB)		;ONLY ONE ON THE LIST?
	JRST	RDYTHS			;YES
	TRNN	A,-1			;ALREADY AT END?
	JRST	RDYTHS			;YES
	HLLM	A,PLISTE(A)		;PREV(NEXT(ME))←PREV(ME)
	MOVS	C,A			;NEXT(ME),,PREV(ME)
	TRNE	C,-1			;ANY PREV?
	HLRM	C,PLISTE(C)		;YES -- NEXT(PREV(ME))←NEXT(ME)
	TLNE	A,-1			;WAS I FIRST?
	HRR	A,PRILIS(B)		;NO -- FIRST WILL STAY FIRST
	HRL	A,PB			;NEW OWNER -- ME,,NEW FIRST
	EXCH	A,PRILIS(B)		;GET OLD LAST,,FIRST
	HLLZM	A,PLISTE(PB)		;MY NEW ENTRY IS OLD LAST,,0
	MOVS	A,A			;    XXX,,OLD LAST
	HRRM	PB,PLISTE(A)		;POINT AT ME


RDYTHS:	SETOM 	STATUS(PB)		;RUNNING
	HRRM 	PB,RUNNER		;SAY SO
	MOVE	USER,GOGTAB
	MOVE	A,QUANTM(PB)
	MOVEM	A,TIMER(USER)
	SKIPE	A,REASON(PB)
	JRST	@SPCASE(A)		;SOME SPECIAL CASE
RPSPF:	MOVE	P,ACP(PB)		;GET THE NEEDED REGISTERS
	MOVE	SP,ACSP(PB)
	MOVE	RF,ACF(PB)
	JRST	@PCW(PB)		;GO START RUNNING THE SO AND SO


SPCASE:	RPSPF				;0 →→ RESTORE P, SP, F
	RSTACS				;1 →→ RESTORE ALL ACS
	RPSPF				;2 →→ FROM JOINER
	RST1				;3 →→ FROM INTERROGATE

RSTACS:	MOVE	P,ACP(PB)		;PUT THE RETURN ADDRESS ON THE STACK
	PUSH	P,PCW(PB)
	MOVEM	P,ACP(PB)
	HRLZI	P,AC0(PB)
	BLT	P,P			;RESTORE THE OLD ACS
	POPJ	P,			;GO RUN


RST1:	MOVE	A,AC1(PB)		;RESTORE REG 1 , SP,P,F
	JRST	RPSPF

;RESUME
HERE(RESUME)
	MOVE	USER,RUNNER	;TAKE CARE OF RET ADDRS
	POP	P,PCW(USER)
	POP	P,OPTS		;OPTIONS
	POP	P,A		;RETURN VALUE
	POP	P,B		;WHO
	MOVE	C,@INFTB	;TEST THE TYPE
	CAIE	C,PRCTYP	;IS THE TYPE A PROCESS
	ERR	<ATTEMPT TO RESUME SOMETHING NOT A PROCESS>
	MOVE	C,B
	MOVE	PB,@DATM	;GET THE DATUM
	TLNE	PB,TERM		;WAS IT TERMINATED?
	ERR	<ATTEMPT TO RESUME A TERMINATED PROCESS>
	MOVE	B,PRCITM(USER)	;MY NAME
	MOVEM	B,RSMR(PB)	;REMEMBER CALLER
	MOVEM	P,ACP(USER)	;SAVE NEEDFUL REGISTERS
	MOVEM	RF,ACF(USER)
	MOVEM	SP,ACSP(USER)
	SETZM	REASON(USER)	;ONTL P, SP, F IMPORTANT
	MOVE	P,ACP(PB)	;SET UP REGISTERS FOR THIS
	MOVE	RF,ACF(PB)
	MOVE	SP,ACSP(PB)

;***** IGNORE OPTIONS FOR NOW *****
	SETZM	STATUS(USER)
	SETOM	STATUS(PB)
	MOVEM	PB,RUNNER
;*******************

	JRST	@PCW(PB)	;GO TO IT

COMMENT ⊗SUSPEND and TERMINATE runtime routines⊗
HERE(SUSPEND)
	MOVE	B,-1(P)		;THE ITEM
	POP	P,-1(P)		;BACK UP RETN ADDR
	MOVE	C,@INFTB
	CAIE	C,PRCTYP	;BE SURE A PROCESS ITEM
	ERR	<ATTEMPT TO SUSPEND A NON PROCESS ITEM>
	MOVE	C,B
	MOVE	PB,@DATM
        TLNE	PB,TERM		;IF TERMINATED , 
	ERR	<SUSPENDING A TERMINATED ITEM>
	CAME	PB,RUNNER	;IS IT THE RUNNER
	JRST	OTHGUY		;NO
	SETZM	STATUS(PB)
	JRST	SPSRN1		;GO RESCHEDULE
OTHGUY:	MOVEI	A,SPNDR		;HE MUST HAVE BEEN READY
	SKIPE	STATUS(PB)	;IF HE WASNT SUSPENDED
	MOVEM	A,REASON(PB)	;THE REGISTERS MUST BE RESTORED
	SETZM	STATUS(PB)	;BE SURE
	POPJ	P,

HERE(TERMINATE)
	MOVE	B,-1(P)
	MOVE	C,@INFTB	;IS HE A PROCESS
	CAIE	C,PRCTYP
	ERR	<TERMINATING A NON-PROCESS>
	MOVE	C,B		;FOR DATUM
	MOVE	PB,@DATM	;POINT AT PROCESS
	TLNE	PB,TERM		;ALREADY DEAD
	JRST	RET1		;YES
↑TERMPB:
	MOVE	USER,RUNNER	;COME HERE IF PB LOADED
	CAMN	PB,USER		;IS IT ME THAT IS TO DIE?
	JRST	KILLIT		;YES
	PUSH	P,PRIOR(USER)	;I AM ABOUT TO GET HIGH PRIORITY
	PUSHJ	P,REMPRI
	MOVEI	A,MAXPRI	;
	PUSHJ	P,SETPRI
	MOVEI	A,FIXPRI
	MOVEM	A,PCW(USER)
	MOVEM	P,ACP(USER)
	MOVEM	RF,ACF(USER)
	MOVEM	SP,ACSP(USER)
	MOVE	RF,ACF(PB)
	MOVE	P,ACP(PB)
	MOVE	SP,ACSP(PB)
	MOVEI	A,1		;NOW FIX STATUS
	MOVEM	A,STATUS(USER)	;
	MOVNM	A,STATUS(PB)
	MOVEM	PB,RUNNER	;THE NEW RUNNER
KILLIT:	MOVEI	LPSA,SPRPDA	;THE SPROUTER IS WHERE WE GO BACK TO
	PUSHJ	P,STKUWD	;UNWIND THE STACK
	JRST	CALRET		;GO DIE 

;IF LIVED THROUGH THE DESTRUCTION, WILL COME HERE
FIXPRI:	PUSHJ	P,REMPRI
	POP	P,A		;REAL PRIORITY
	PUSHJ	P,SETPRI
RET1:	SUB	P,[XWD 2,2]	;GET OFF THE PARAMETER
	JRST	@2(P)		;RETURN

COMMENT ⊗The JOIN runtime routine⊗

DSCR JOIN
CAL  PUSH P,SET
     PUSHJ P,JOIN
DES  CAUSES YOUR PROCESS TO WAIT FOR THE TERMINATION OF ANY
PROCESSES NAMED IN ITS ARGUMENT SET
⊗

HERE(JOIN)
	MOVE	PB,RUNNER
	MOVE	B,-1(P)		;THE SET 
	POP	P,-1(P)		;FOR LATER
	JUMPE	B,CPOPJ		;
	MOVE	TABL,GOGTAB	;GET READY FOR CELL GETTING
	HRRZ	A,(B)		;A NOW POINTS AT FIRST
	HRLZ	D,PRCITM(PB)	;THE PROCESS ITEM OF THE JOIN

;NOW LOOP ALONG SET, GIVING WARNINGS

JNST:	HLRZ	B,(A)		;THE ITEM NUMBER
	MOVE	C,@INFTB	;GET TYPE
	CAIE	C,PRCTYP	;PROCESS?
	ERR	<ATTEMPT TO DO JOIN ON NON-PROCESS>
	MOVE	C,B
	MOVE	B,@DATM		;GET DATUM
	TLNE	B,TERM		;DEAD ???
	JRST	NXTJNR		;YES
	AOS	JOINCT(PB)	;ONE MORE TO DIE
	NNCELL	(C)		;GET (POSSIBLY FIRST) NEW CELL
	HRR	D,JOINS(B)	;LINK TO OLD JOIN LIST
	MOVEM	D,(C)		;NEW CONTENTS OF THIS CELL
	HRRZM	C,JOINS(B)	;NEW JOIN LIST
NXTJNR:	HRRZ	A,(A)		;GET NEXT ENTRY
	JUMPN	A,JNST
	SKIPG	JOINCT(PB)	;DO WE NEED TO WAIT?
	POPJ	P,		;NO
	MOVEI	A,JOINR		;REASON IS A JOIN
	MOVEM	A,REASON(PB)	;
	SETZM	STATUS(PB)	;I AM SUSPENDED
	JRST	SPSRN2		;GO SAVE P,RF,SP & RUN SOMEONE
				;(BUT DONT CHANGE REASON)







COMMENT ⊗THE MAIN PROCESS INITIALIZER⊗

↑MAINPR:
	MOVE	USER,GOGTAB
	SKIPE	GGDAD(USER)	;INITIALIZED ALREADY
	POPJ	P,		;YES
	MOVEI	C,NPVARS+40	;HOW MUCH SPACE WE NEED
	PUSHJ	P,CORGET
	ERR	<NO ROOM FOR THE MAIN PROCESS>
	HRRZ	PB,B		;PROCESS BASE
	MOVE	A,SPDL(USER)	;STRING PDL
	MOVEM	A,ISP(PB)
	SETOM	DYNL(PB)
	HLROI	A,SPRPDA
	MOVEM	A,STATL(PB)
	MOVEM	PB,GGDAD(USER)
	MOVEM	PB,RUNNER	;SAY THIS IS THE RUNNER
	HRLZI	A,ZFIRST(PB)
	HRRI	A,ZFIRST+1(PB)
	SETZM	ZFIRST(PB)
	BLT	A,ZLAST(PB)

	MOVEI	B,MAINPI	;THE MAIN PROCESS ITEM NUMBER
	MOVEI	A,PRCTYP	;MAKE A PROCESS
	MOVEM	A,@INFTB
	MOVE	C,B
	HRRZM	PB,@DATM
	MOVEM	C,PRCITM(PB)

	MOVEI	A,[0]
	MOVEM	A,KLOWNR(PB)	;NASTY
	SETOM	STATUS(PB)	;I AM THE RUNNER
	MOVEI	A,STDPRI	;STANDARD PRIORITY
	PUSHJ	P,SETPRI	;SET THE PRIORITY
	PUSH	P,[%SPGC]
	PUSHJ	P,SGREM
	PUSH	P,[%ARRSRT]
	PUSHJ	P,SGREM
	PUSH	P,[%PSSGC]
	PUSH	P,[SGLKBK+1]
	PUSHJ	P,SGINS

	POPJ	P,


COMMENT ⊗CALLER AND MYPROC ⊗

HERE(CALLER)
	EXCH	B,-1(P)		;ITEM NUMBER -- SAVE OLD B
	HRRZ	A,@INFTB
	CAIE	A,PRCTYP
	ERR	<NOT A PROCESS ITEM>
	EXCH	C,B
	EXCH	B,-1(P)
	MOVE	A,@DATM
	TLNE	A,TERM
	ERR	<PROCESS IS TERMINATED>
	MOVE	A,RSMR(A)
	EXCH	C,-1(P)
	SUB	P,X22
	JRST	@2(P)

HERE(MYPROC)
	MOVE	USER,RUNNER
	MOVE	A,PRCITM(USER)
	POPJ	P,
COMMENT ⊗SPECIAL GC ROUTINE FOR PROCESSES⊗


HERE(%PSSGC)
	MOVE	TEMP,RUNNER
	MOVEM	SP,ACSP(TEMP)
	MOVE	RF,RACS+RF(USER)
	MOVEM	RF,ACF(TEMP)
	HRLZI	B,-NPRIS
	HRR	B,GOGTAB
SCHL1:	SKIPN	TEMP,PRILIS(B)
	JRST	NXLS
	PUSH	P,B
SCHL2:	MOVE	RF,ACF(TEMP)
	PUSH	P,TEMP
	PUSHJ	P,%ARSR1
	MOVE	TEMP,(P)
	HRRZ	A,ISP(TEMP)
	MOVE	SP,ACSP(TEMP)
	PUSHJ	P,%SPGC1
	POP	P,TEMP
	HRRZ	TEMP,PLISTE(TEMP)
	JUMPN	TEMP,SCHL2
	POP	P,B
NXLS:	AOBJN	B,SCHL1
	MOVE	TEMP,RUNNER
	MOVE	SP,ACSP(TEMP)
	POPJ	P,






COMMENT ⊗ TIMER & OTHER INTERRUPTS⊗

HERE(POLL);
	SKIPN	TEMP,INTRPT	;WERE WE INTERRUPTED
	POPJ	P,		;NO
	MOVEI	A,1
	ANDCAM	A,INTRPT
	JRST	URSCHD		;FOR NOW

HERE(INTSET)

	MOVEI	A,INTMOD
	MOVEM	A,JOBAPR

TIEMB:  HRLZI	A,000200	;INTCLK BIT(I THINK)
	CALLI	A,400026	;INTORM
	POPJ	P,

HERE(INTMOD)
	MOVE	USER,GOGTAB
	SOSLE	TIMER(USER)
	JRST	DSMSIT
	MOVEI	A,1
	IORM	A,INTRPT
DSMSIT:	CALLI	400024		;DISMIS


COMMENT ⊗ CAUSE ⊗

HERE(CAUSE)
	MOVE	PB,RUNNER
	AOS	A,CAUSES(PB)
	CAIE	A,1		;FIRST CAUSE?
	JRST	DFRCS		;NO -DEFER IT
	POP	P,CAUSRA(PB)	;SAVE RETN ADDRESS
CSIT:	PUSHJ	P,CAUSE1	;DO THE WORK
	MOVE	PB,RUNNER
	SOSG	A,CAUSES(PB)	;DONE ONE
	JRST	CSE.X		;ALL ARE DONE -- CHECK FOR SCHED REQ
	MOVEI	KL,CAUSEQ(PB)	;GET NEXT FROM QUEUE
	PUSHJ	P,REMCAR
	HLRZ	B,(A)		;PICK UP TYPE
	PUSH	P,B
	HRRZ	B,(A)		;NOTICE
	PUSH	P,B
	PUSH	P,1(A)		;OPTIONS
	MOVE	TABL,GOGTAB
	HRR	B,FP2(TABL)	;RELEASE 2 WD BLOCK
	HRRM	B,(A)
	HRRM	A,FP2(TABL)
	JRST	CSIT		;GO WORK ON THIS
DFRCS:	MOVE	TABL,GOGTAB	;
	NNCLL2	(B)		;GET 2 WD CELL
	POP	P,TMP		;RETURN ADDRESS
	POP	P,1(B)		;OPTS
	POP	P,(B)		;NOTICE
	POP	P,A		;TYPE
	HRLM	A,(B)
	MOVEI	KL,CAUSEQ(KL)	;PUT ON CAUSE QUEUE
	PUSHJ	P,ITAILS	;PUT ON TAIL OF QUEUE
	JRST	(TMP)		;RETURN
CSE.X:	MOVE	USER,GOGTAB
	SKIPN	SCHDRQ(USER)	;SCHEDULING REQUEST
	JRST	@CAUSRA(PB) 	;NO
	SETZM	SCHDRQ(USER)	;YES
	PUSH	P,CAUSRA(PB)	;YES
	JRST	URSCHD		;RESCHEDULE

COMMENT ⊗CAUSE1 -- ROUTINE TO DO ACTUAL WORK ⊗

CAUSE1:	JSP	TMP,EVTCK3	;VERIFY THAT THIS IS AN EVENT ITEM
				;ALSO EVT ← DATUM ,B&C←ITEM #
	SKIPE	PDA,CAUSEP(EVT)	;DID THE USER SAY SOMETHING???
	JRST	USPPRC		;USER SPEC PROCEDURE
	MOVE	FF,-1(P)	;OPTIONS
	SKIPN	TMP,WAITLS(EVT)	;WAS ANYONE WAITING?
	JRST	SCA.2		;NO
	MOVE	TEMP,B		;EV TYP NO
	MOVE	TMP,(TMP)	;LAST,,FIRST
	MOVE	D,-2(P)		;NOTICE NO
SCA.1:	MOVE	TMP,(TMP)	;WAIT ENTRY
	HLRZ	C,TMP		;PROCESS NO
	PUSHJ	P,ANSWR1	;SPECIAL ENTRY POINT IN ANSWER
	TRNE	A,NOJOY		;DID WE SUCCEED??
	JRST	SCA.1A		;NO
	TRNN	A,RETAIN	;KEEP THE NOTICE??
	TRO	FF,DNTSAV	;YES
	TRNN	FF,TELLAL	;TELL THE WHOLE WORLD?
	JRST	SCA.2		;NO
SCA.1A:	TRNE	TMP,-1		;ANY LEFT
	JRST	SCA.1		;YES

SCA.2:	TRNE	FF,DNTSAV	;SAVE IT?
	JRST	SCA.3		;NO
	MOVE	B,-2(P)		;ITEM NO OF NOTICE
	MOVEI	KL,NOTCLS(EVT)	;
	PUSHJ	P,ITAILS	;PUT ON END OF NOTIICE LIST
SCA.3:
	MOVE	USER,GOGTAB
	TRNE	FF,SCHDIT	;WANT TO RESCHEDULE
	SETOM	SCHDRQ(USER)	;RESCHEDULE REQUEST
SCA.X:	SUB	P,X44		;RETURN
	JRST	@4(P)

USPPRC:	MOVE	B,PD.(PDA)	;HERE IF USER SPECIFIED A PROCEDURE
	TLNE	PDA,-1		;CONTEXT GIVEN
	JRST	(B)		;NO
	PUSH	P,RF		;SET UP CONTEXT
	HRRZ	C,PD.PPD	;PARENTS PDA
	MOVS	A,PDA		;
	HLRZ	D,1(A)
	CAME	D,C		;SAME?
	ERR 	<CONTEXT WRONG OR CLOBBERED IN INTERP CALL
USER SPEC EVENT PROC >
	PUSH	P,A		;STATL
	PUSH	P,SP
	HLRZ	B,PD.PPD(PDA)
	JRST	(B)		;GO TO INSTR AFTER THE MKSEMT

COMMENT ⊗ANSWER -- subroutine used by CAUSE⊗

HERE(ANSWER)

;A←ANSWER(EV_TYP,NOT,PROCESS_ITEM);
;IF ATTEMPT TO ANSWER INTERROGATE IS SUCCESSFUL, A ← REQUEST CODE
;OTHERWISE, NOJOY BIT IS ON IN A & REST OF WORD IS INVALID

	MOVE	TEMP,-3(P)	;EV TYPE
	POP	P,-3(P)		;RET ADRS
	POP	P,B		;PROCESS ITEM
	POP	P,D		;NOTICE
	MOVE	C,@INFTB	;VERIFY PROCESS ITEM
	CAIE	C,PRCTYP
	ERR	<NOT A PROCESS ITEM>
	MOVE	C,B

;THE REST OF THIS IS CALLED INTERNALLY 
;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
;MODIFIES A,B,C,TABL,PB

ANSWR1:	MOVE	PB,@DATM	;THE PROCESS BASE
	TLNN	PB,TERM		;TERMINATED?
	SKIPE	STATUS(PB)	;OR NOT SUSPENDED??
	JRST	NOANS		;YES
	AOS	STATUS(PB)	;MAKE READY
	MOVEM	D,AC1(PB)
ANSWR2:	PUSHJ	P,DELWRQ	;DELETE ALL WAIT REQUESTS
	MOVE	A,INTRGC(PB)	;THE INTERROG CONTROL WORD
	TRNN	A,SAYWCH	;ASKED FOR THE ASSOCIATION
	POPJ	P,		;NO
	PUSH	P,[EVTYPI]	;
	PUSH	P,D
	PUSH	P,TEMP
	PUSHJ	P,STACSV	;SAVE ALL ACS
	MOVEI	5,16		;MAKE
	PUSHJ	P,LEAP
	PUSHJ	P,STACRS	;GET ACS BACK
	POPJ	P,
NOANS:	TRO	A,NOJOY
	POPJ	P,		;RETURN
COMMENT ⊗DELWRQ -- delete all wait requests⊗

;EXPECTS PB = THIS PROCESS
;MANGLES A,B,C,TABL

DELWRQ:	SKIPN	A,WAITES(PB)
	POPJ	P,
	PUSH	P,KL
	MOVE	A,(A)		;A IS LAST,,FIRST
DTHSRQ:	MOVE	A,(A)		;NEXT ENTRY
	HLRZ	C,A		;ITEM NUMBER OF TYPE
	PUSH	P,A		;FOR SAFE KEEPING
	MOVE	A,@DATM
	MOVEI	KL,WAITLS(A)
	MOVE	B,PRCITM(PB)
	PUSHJ	P,DELTLE	;DELETE ELEMENT
	POP	P,A		
	TRNE	A,-1		;ANY LEFT
	JRST	DTHSRQ		;YES
	MOVE	A,WAITES(PB)
	MOVE	TABL,GOGTAB
	HLRZ	B,(A)		;ADDRESS OF LAST
	HRRZ	C,FP1(TABL)
	HRRM	C,(B)		;RELEASE THE LOT
	HRRM	A,FP1(TABL)
	SETZM	WAITES(PB)	;NONE LEFT
	POP	P,KL
	POPJ	P,
COMMENT ⊗INTERROGATE⊗
HERE(INTERROGATE)
	SKIPN	B,-2(P)		;SET OR ITEM
	ERR	<NULL INTERROGATION???>
	TLNN	B,-1		;SET?
	JRST	ASK1.0		;NO
	MOVEI	FF,MULTIN
	IORM	FF,-1(P)	;SAY MULT REQUEST
	MOVE	TMP,(B)		;LAST,,FIRST
MPCI:	MOVE	TMP,(TMP)	;NEXT ENTRY
	HLRZ	B,TMP
	PUSH	P,TMP
	PUSH	P,B		;TYPE ITEM
	PUSH	P,-3(P)		;OPTIONS WORD
	PUSHJ	P,ASK1.0
	POP	P,TMP		;GET LIST BACK
	CAIE	A,NIC		;FIND ONE??
	JRST	ASK1.X		;YES
	TRNE	TMP,-1		;DONE LIST???
	JRST	MPCI		;NO
	MOVE	FF,-1(P)
	TRNN	FF,WAIT		;WAITING REQUESTED
	JRST	ASK1.X		;NO
	MOVE	PB,RUNNER	;SUSPEND SELF
	MOVE	B,-2(P)		;THE LIST
	MOVE	TMP,(B)		;LAST,,FIRST
BWL:	MOVEI	KL,WAITES(PB)
	MOVE	TMP,(TMP)	;NEXT
	HLRZ	B,TMP		;ITEM NO
	MOVE	C,B
	MOVE	EVT,@DATM
	PUSHJ	P,ITAILS	;ON TAIL
	MOVE	B,PRCITM(PB)	;
	MOVEI	KL,WAITLS(EVT)
	PUSHJ	P,ITAILS	;ON EVENT WAIL LIST
	TRNE	TMP,-1
	JRST	BWL		;CDR DOWN LIST
	JRST	DOWAIT		;GO WAIT
COMMENT ⊗ASK -- used by INTERROGATE⊗

ASK1I:	MOVE	B,-2(P)
ASK1.0:	JSP	TMP,EVTCKB	;GET DATUM OF EVENT TYPE
	SKIPE	A,INTRGP(EVT)	;USER WAIT PROCESS??
	JRST	USPPRC		;YES
	MOVE	FF,-1(P)	;CONTROL WORD
	SKIPN	A,NOTCLS(EVT)	;ANY READY TO GO
	JRST	ASK1.4		;NO
	TRNE	FF,RETAIN	;RETAIN THIS ONE??
	JRST 	ASK1.1		;YES
	MOVEI	KL,NOTCLS(EVT)
	PUSHJ	P,REMCAR	;GET THE FIRST
	JRST	ASK1.2		;TEST SAYWCH
ASK1.1:	MOVE	A,(A)
	HLRZ	A,(A)		;THI FIRST ITEM
ASK1.2:	TRNN	FF,SAYWCH	;WANT ASSOCIATION
	JRST	ASK1.3		;NO
	PUSH	P,[EVTYPI]	;EVENT TYPE
	PUSH	P,A		;NOTICE
	PUSH	P,-4(P)		;WHATEVER TYPE IT IS
	PUSHJ	P,STACSV	;SAVE REGS
	MOVEI	5,16		;MAKE
	PUSHJ	P,LEAP
	PUSHJ	P,STACRS	;GET ACS BACK
ASK1.3:
ASK1.X:	SUB	P,X33
	JRST	@3(P)		;RETURN

ASK1.4:	MOVEI	A,NIC
	TRNE	FF,WAIT		;IF NOT WAITING OR 
	TRNE	FF,MULTIN	;MUL REQ
	JRST	ASK1.X		;ALL DONE
	MOVE	PB,RUNNER
	MOVEI	KL,WAITES(PB)	;WAIT ON THIS ONE
	PUSHJ	P,ITAILS	;PUT ON TAIL
	MOVE	B,PRCITM(PB)
	MOVEI	KL,WAITLS(EVT)
	PUSHJ	P,ITAILS
DOWAIT:	SETZM	STATUS(PB)
	MOVEM	FF,INTRGC(PB)
	MOVEI	A,WAITNG
	MOVEM	A,REASON(PB)
	PUSHJ	P,SPSRN2	;WAIT
	JRST	ASK1.X		;RETURN

;ROUTINE TO SET UP EVENT TYPE ITEM
;SETS B & C TO ITEM #
;SETS EVT TO DATUM
;CALLED VIA JSP TMP,EVTCKX

EVTCK3:	SKIPA	B,-3(P)
EVTCK2:	MOVE	B,-2(P)
EVTCKB:	MOVE	A,@INFTB
	CAIE	A,EVTTYP
	ERR	<THIS ITEM IS NOT AN EVENT TYPE>,6
	MOVE	C,B
	MOVE	EVT,@DATM
	JRST	(TMP)
COMMENT ⊗MKEVTT,SETCP,& SETIP⊗
HERE(SETCP)
	JSP	TMP,EVTCK2
	MOVE	A,-1(P)
	MOVEM	A,CAUSEP(EVT)
XIT3:	SUB	P,X33
	JRST	@3(P)


HERE(SETIP)
	JSP	TMP,EVTCK2
	MOVE	A,-1(P)
	MOVEM	A,INTRGP(EVT)
	JRST	XIT3

HERE(MKEVTT)	;MAKE EVENT TYPE
	MOVE	B,-1(P)
	MOVEI	A,EVTTYP
	MOVEM	A,@INFTB
	MOVEI	C,NEVARS
	PUSHJ	P,CORGET
	ERR	<NO CORE LEFT -- MKEVT>
	MOVE	C,-1(P)
	MOVEM	B,@DATM
	HRLI	D,(B)
	HRRI	D,1(B)
	SETZM	(B)
	BLT	D,NEVARS-1(B)
	SUB	P,X22
	JRST	@2(P)


BEND PROCESS

ENDCOM(PRC)