00100	COMMENT ⊗   VALID 00033 PAGES VERSION 17-1(13)
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00004 00002	HISTORY
00500	 00009 00003	 MANY DECLARATIONS
00600	 00015 00004	PROCESS VARIABLE NUMBERS
00700	 00018 00005	event variables
00800	 00019 00006	procedure descriptors & null process skeleton
00900	 00021 00007	DSCR SPROUT -- THE PROCESS SPROUTER
01000	 00028 00008	
01100	 00035 00009	
01200	 00036 00010	routines for inserting & deleting set elements
01300	 00040 00011	USER REQUESTED SCHEDULING
01400	 00045 00012	HERE(RESUME)
01500	 00049 00013	SUSPEND and TERMINATE runtime routines
01600	 00052 00014	The JOIN runtime routine
01700	 00054 00015	THE MAIN PROCESS INITIALIZER
01800	 00056 00016	CALLER , MYPROC, AND PSTATUS 
01900	 00058 00017	 PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY 
02000	 00059 00018	SPECIAL GC ROUTINE FOR PROCESSES
02100	 00060 00019	INTERRUPT ROUTINES
02200	 00064 00020	THE INTERRUPT PROCESS
02300	 00068 00021	
02400	 00069 00022	 CAUSE 
02500	 00071 00023	CAUSE1 -- ROUTINE TO DO ACTUAL WORK 
02600	 00074 00024	ANSWER -- subroutine used by CAUSE
02700	 00076 00025	DELWRQ -- delete all wait requests
02800	 00078 00026	INTERROGATE
02900	 00080 00027	ASK -- used by INTERROGATE
03000	 00083 00028	MKEVTT,SETCP,& SETIP
03100	 00084 00029	SPARE HERE TABLE ENTRIES
03200	 00085 00030	COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
03300	 00087 00031	HERE(INTTBL)
03400	 00090 00032	PROCEDURES TO ENABLE FOR INTERRUPTS
03500	 00101 00033	
03600	 00102 ENDMK
03700	⊗;
     

00100	COMMENT ⊗HISTORY
00200	AUTHOR,REASON
00300	021  102100000015  ⊗;
00400	
00500	
00600	COMMENT ⊗
00700	VERSION 17-1(13) 3-26-74 BY RLS INSTALL TENEX
00800	VERSION 17-1(12) 12-8-73 BY JRL  REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
00900	VERSION 17-1(11) 12-8-73 BY RHT FIX IEXT5 SCREW FOR EXPO WORLD
01000	VERSION 17-1(10) 12-8-73 BY RHT CHANGE PLACE WHERE REMEMBER THE APRENB BITS
01100	VERSION 17-1(9) 12-4-73 BY rht fix process string garb coll routine
01200	VERSION 17-1(8) 12-3-73 BY RHT MAKE SUSPEND(OTHERGUY) RETURN ANY
01300	VERSION 17-1(7) 12-2-73 BY RHT ADD A FEW IRP SPARES
01400	VERSION 17-1(6) 10-30-73 BY RHT BUG #OU# A TYPO IN %AA%
01500	VERSION 17-1(5) 10-30-73 BY RHT BUG #OT# SPROUT APPLY BUG
01600	VERSION 17-1(4) 10-28-73 BY RHT FEAT %AG% INITIALIZE RSMR←DADDY WHEN SPROUT
01700	VERSION 17-1(27) 10-14-73 BY RHT BUG #OO# SPROUT APPLY TROUBLES
01800	VERSION 17-1(26) 9-1-73 BY RHT FEATURE %AA% -- ADD CODE FOR SPROUT DEFAULTS
01900	VERSION 17-1(25) 8-19-73 BY RHT FIX COMPIL FOR SAIIRP TO KNOW ABOUT APRACS
02000	VERSION 17-1(24) 7-26-73 BY RHT **** VERSION 17 ****
02100	VERSION 16-2(23) 7-15-73 BY RHT BUG #NC# ASKNTC WAS WRONG
02200	VERSION 16-2(22) 7-15-73 BY RHT MORE OF BUG NB
02300	VERSION 16-2(21) 7-15-73 BY RHT BUG #NB# NOT GETTING CONTXT RIGHT FOR USER IP
02400	VERSION 16-2(20) 7-14-73 BY RHT MAKE SAIIRP A SEP COMPIL & PROVIDE FOR APPL$Y
02500	VERSION 16-2(19) 7-14-73 BY RHT BUG #NA# RACE CONDITION IN URSCHD IWAIT
02600	VERSION 16-2(18) 3-18-73 BY RHT MINOR MOD TO DFR1IN
02700	VERSION 16-2(17) 2-4-73 BY RHT PROVIDE MORE HOOKS INTO EVENT ROUTINES
02800	VERSION 16-2(16) 1-15-73 BY DCS BUG #LB# MINOR RESUME BUG
02900	VERSION 16-2(15) 12-9-72 BY RHT MAKE MINOR ADJUSTMENTS TO RESUME
03000	VERSION 16-2(14) 12-4-72 BY RHT INTERNAL PSTATUS
03100	VERSION 16-2(13) 12-4-72 BY RHT  CURE POTENTIAL LOSSAGE OF STATIC LINKAGE
03200	VERSION 16-2(12) 12-2-72 BY RHT REWRITE RESUME
03300	VERSION 16-2(11) 12-1-72 BY RHT PROVIDE FOR DEFAULTS AS CORE VARS
03400	VERSION 16-2(10) 11-30-72 BY RHT ADD THE DDFINT ROUTINE & ZAP POLL
03500	VERSION 16-2(9) 11-29-72 BY DCS ADD INTERRUPT THINGS TO ENTRIES IN COMPIL
03600	VERSION 16-2(8) 11-29-72 BY RHT RESUME DISPATCH NEEDS @
03700	VERSION 16-2(7) 11-26-72 BY DCS ALLOW <ESC>I AS IO INTERRUPT (AVOID "NO ONE TO RUN")
03800	VERSION 16-2(6) 11-26-72 BY DCS CHANGE OPDEF FOR INTENS TO 400030 FROM ..31
03900	VERSION 16-2(5) 11-25-72 BY RHT FIX DATAB & INFTAB REFERENCES
04000	VERSION 16-2(4) 11-15-72 BY RHT ADD OPTIONS FOR RESUME
04100	VERSION 16-2(3) 11-15-72 BY RHT ADD INTERRUPTS,SPARE HERE ENTRIES
04200	VERSION 16-2(2) 11-15-72 
04300	VERSION 16-2(1) 11-15-72 
04400	
04500	⊗;
     

00100	; MANY DECLARATIONS
00200	TENX<
00300	↓APRISW←←1	;Not always what's wanted but better than 0.
00400	>;TENX
00500	COMPIL(PRC,,,,,,DUMMYFORGDSCISS)
00600	DEFINE ENS1 < SPROUT,URSCHD,RESUME,SUSPEND,TERMINATE,JOIN,MAINPR,CALLER>
00700	DEFINE ENS2 <%PSSGC,DDFINT,INTSET,CAUSE,ANSWER,INTERROGATE,SETCP>
00800	DEFINE ENS3 <MKEVTT,SETIP,MYPROC,CLKMOD,DFR1IN,DFRINT,INTPRO>
00900	DEFINE ENS4 <DFCPKT,PSTATUS,ASKNTC,CAUSE1,PRISET>
01000	DEFINE EXT1 <LEAP,STKUWD,X44,GOGTAB,%ARSR1,SGINS,ALLPDP>
01100	DEFINE EXT2 <CORGET,CORREL,INTRPT,INFTB,%SPGC,X22,%SPGC1,FP1DON,STACSV>
01200	DEFINE EXT3 <X33,%ARRSR,DATM,SGLKBK,FP2DON,SGREM,STACRS,RUNNER,NOPOLL>
01300	DEFINE EXT4 <X11,DEFSSS,DEFPSS,DEFPRI,DEFQNT,INTTBL,APPL$Y>
01400	
01500	IFN APRISW <
01600	DEFINE XJBCNI <JOBCNI>
01700	DEFINE XJBTPC <JOBTPC>
01800	DEFINE XJBAPR <JOBAPR>
01900	DEFINE EXT5 <JOBCNI,JOBTPC,JOBAPR>
02000	IFN ALWAYS <
02100	EXTERN EXT5	;THESE ARE ALWAYS EXTERNAL
02200	>;IFN ALWAYS
02300	>;IFN APRISW
02400	IFE APRISW <
02500	DEFINE EXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
02600	IFN ALWAYS <
02700	EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
02800	>;IFN ALWAYS
02900	>;IFE APRISW
03000	COMMENT ⊗THIS IS FOR THE STUPIDITY OF SCISS ⊗
03100	
03200	COMPXX(PRC,<ENS1,ENS2,ENS3,ENS4>,<EXT1,EXT2,EXT3,EXT4,EXT5>
03300		,<MULTIPLE PROCESS STUFF>,<SPRPDA>,HIIFPOSSIB)
03400	
03500	
03600	
03700	BEGIN PROCSS
03800	
03900	; (AC DEFNS)
04000	
04100	; A,B,C,P,SP,RF AS BEFORE
04200	KL	←D	;KILL LIST & SCRATCH
04300	PB	←5	;PROCESS BASE
04400	OPTS	←6	;HOLDS OPTIONS
04500	PDA	←7	;HOLDS PDA
04600	EVT	←10	;EVENT DATUM
04700	NSP	←←10	;NEW SP
04800	NP	←11	;NEW P
04900	TMP	←LPSA	;TEMP AC
05000	
05100	GLOB < 
05200	TABL ←← 7	;NEEDED BY LIST CELL GETTER
05300	>;GLOB
05400	NOGLOB <
05500	TABL ←← USER	;NEEDED BY LIST CELL GETTER
05600	>;NOGLOB
05700	FP ←← 6		;NEEDED BY LIST CELL GETTER
05800	
05900	; (LOCAL VARIABLES FOR SCHEDULER)
06000	MAXPRI ←← 0	;MAXIMUM PRIORITY
06100	MINPRI ←← NPRIS-1
06200	
06300	;REASONS FOR SUSPENSION
06400	PSPF←←0		;ONLY P, SP, F NEED BE RESTORED
06500	SPNDR←←1	;SUSPENDED (FROM READY) BY SUSPEND
06600	JOINR←←2	;SUSPENDED BECAUSE OF A JOIN
06700	WAITNG←←3	;WAITING ON AN EVENT OR SO
06800	
06900	; ( CONSTANT DATA USED BY SPROUTER)
07000	
07100	; FIELD DEFNS FOR OPTIONS WORD (SEE ALSO POINT S BELOW)
07200	
07300	STSMSK←	77 ⊗ =8	;MASK FOR P STACK SIZE FIELD
07400	SSSMSK←	17 ⊗ =14;MASK FOR SP STACK SIZE FIELD OF OPTIONS WORD
07500	PRIMSK←	17 ⊗ 4	;MASK FOR PRIORITY FIELD
07600	QNTMSK←← 17	;MASK FOR QUANTUM
07700	RUNME←←	1	;RUN THE SPROUTING PROCESS
07800	SPNDME←←2	;SUSPEND THE SPROUTING PROCESS
07900	SPNDNP←←10	;SUSPEND THE NEW PROCESS
08000	
08100	;MORE FIELD DEFS & BIT VALUES
08200	TERM  ←← 1	;BIT (LH) IN DATUM OF TERMINATED PROCESS ITEM
08300	
08400	;DEFAULT VALUES --INITIALLY SET BY MAINPR
08500	
08600	STPSZ←	40	;DEFAULT P- STACK SIZE (MINUS THE PROCESS TABLE AREA)
08700	STSPST ←20	;DEFAULT SP STACK SIZE
08800	STDQNT ←← 4	;DEFAULT STD QUANTUM IS 4
08900	STDPRI	←←7	;DEFAULT PRIORITY
09000	
09100	;OPTIONS FOR RESUME
09200	MSTMSK←←14	;MASK FOR MY NEW STATUS FIELD
09300	NOTNOW←←1	;SET IF RESUMED PROCESS IS MERELY TO GO READY
09400	
09500	;CONSTANTS USED BY RESUME
09600	MSTBYT:	POINT	2,OPTS,33 ;MY NEW STATUS
09700	
09800	; (CONSTANTS USED BY SPROUTER)
09900	SSSBYT:	POINT	4,OPTS,21	;STRING STACK FIELD (MOD 32)
10000	STSBYT:	POINT	6,OPTS,27	;P - STACK FIELD (MOD 32)
10100	PRIBYT:	POINT	4,OPTS,31	;PRIORITY FIELD
10200	QNTBYT:	POINT	4,OPTS,17	;LOG2 (QUANTUM)
10300	
10400	
10500	; MACROS USED TO GET LIST CELLS
10600	DEFINE NCELL(AC) <
10700		MOVE	FP,FP1(TABL)	;USE WHERE SURE THE LIST SPACE IS INITIALIZED
10800		HRRI	AC,(FP)
10900		SKIPN	FP,(FP)
11000		PUSHJ	P,FP1DON
11100		HRRM	FP,FP1(TABL)
11200	>
11300	
11400	DEFINE NNCELL(AC) <
11500		SKIPN	FP,FP1(TABL)	;USE WHERE LIST SPACE MAY NEED INITIALIZATION
11600		PUSHJ	P,FP1DON
11700		HRRI	AC,(FP)
11800		SKIPN	FP,(FP)
11900		PUSHJ	P,FP1DON
12000		HRRM	FP,FP1(TABL)
12100	>
12200	
12300	DEFINE NNCLL2(AC) <
12400		SKIPN	FP,FP2(TABL)	;USE WHERE LIST SPACE MAY NEED INITIALIZATION
12500		PUSHJ	P,FP2DON
12600		HRRI	AC,(FP)
12700		SKIPN	FP,(FP)
12800		PUSHJ	P,FP2DON
12900		HRRM	FP,FP2(TABL)
13000	>
13100	
13200	NOTENX <
13300	OPDEF INTENS [CALLI 400030]
13400	OPDEF IWAIT [CALLI 400040]
13500	>;NOTENX
13600	
     

00100	;PROCESS VARIABLE NUMBERS
00200	
00300	DEFINE PVAR (V,ATTRIB),
00400		<↑V ←← NPVARS
00500		NPVARS←← NPVARS+1
00600	IFE ALWAYS,<
00700		IFDIF <ATTRIB>,<> < ATTRIB V >
00800	>;IFE ALWAYS
00900		>
01000	
01100	
01200	NPVARS←← 0
01300	
01400		PVAR	DYNL	;DYNAMIC LINK
01500		PVAR	STATL	;STATIC LINK
01600		PVAR	ISP	;REST OF MSCP
01700		PVAR	AC0	;AC SAVE AREA
01800		PVAR	AC1
01900		PVAR	AC2
02000		PVAR	AC3
02100		PVAR	AC4
02200		PVAR	AC5
02300		PVAR	AC6
02400		PVAR	AC7
02500		PVAR	AC10
02600		PVAR	AC11
02700		PVAR	AC12
02800		PVAR	AC13
02900		PVAR	AC14
03000		PVAR	AC15
03100		PVAR	AC16
03200		PVAR	AC17
03300	↑ACF ←← AC12
03400	↑ACP ←← AC17
03500	↑ACSP ←← AC16
03600		PVAR	PCW	;PC WORD
03700		PVAR	QUANTM	;TIME QUANTUM
03800		PVAR	PRIOR	;PRIORITY
03900		PVAR	PRCITM	;PROCESS ITEM OF THIS PROCESS
04000		PVAR	KLOWNR	;THE OWNER OF MY KILL LIST
04100		PVAR 	STATUS	;-1 = RUNNING, 0 = SUSPEND, 1 = READY, 2 = TERMINATED
04200		PVAR	DADDY,INTERNAL	;PROCESS ITEM OF SPROUTING PROCESS
04300		PVAR	CAUSRA	;RETN ADDRESS FROM CAUSE
04400	;THE FOLLOWING ARE ZEROED OUT ON CREATION
04500	ZFIRST←←NPVARS
04600		PVAR	CURSCB,INTERNAL	;CURRENT SEARCH CONTROL BLOCK
04700		PVAR	REASON	;HOW GOT UNSCHEDULED (0 MEANS ONLY NEED ACS F,SP,P)
04800		PVAR	PLISTE	;PRIORITY LIST ENTRY
04900		PVAR	RSMR	;THE GUY WHO RESUMED ME (%AG% ** INIT TO DADDY ** )
05000		PVAR	JOINCT	;HOW MANY PROCESSES NEED TO JOIN THIS ONE
05100		PVAR	JOINS	;WHO IS WAITING TO FOR ME TO JOIN (A SET OF ITEMS)
05200		PVAR	WAITES	;LIST OF ALL EVENT TYPES ON WHICH I AM WAITING
05300		PVAR	INTRGC	;THE CONTROL WORD FOR MY CURENT INTERROGATION
05400		PVAR	CAUSES	;COUNT OF CAUSES PENDING
05500		PVAR	CAUSEQ	;QUEUE OF CAUSES TO BE MADE
05600	ZLAST←←NPVARS-1
05700	
05800	↑NPVARS ← NPVARS
05900	↑STKBAS ← NPVARS	;STACK BASE SIZE (= #PROCESS VARS FOR NOW)
     

00100	COMMENT ⊗event variables⊗
00200	
00300	NEVARS←←0
00400	
00500	DEFINE EVAR(V) ,
00600		<↑↑V←←NEVARS
00700		NEVARS←←NEVARS+1
00800		>
00900	
01000		EVAR	NOTCLS		;LIST OF CURRENT NOTICES
01100		EVAR	WAITLS		;LIST OF CURRENTLY WAITING PROCESSES
01200		EVAR	CAUSEP		;USER SPEC CAUSE PROC
01300		EVAR	INTRGP		;USER SPEC INTERROGATE PROC
01400		EVAR	USER1		;AVAIL TO USER
01500		EVAR	USER2		;AVAIL TO USERR
01600	
01700	;OPTIONS BITS FOR CAUSE
01800	DNTSAV ←← 1
01900	TELLAL ←← 2
02000	SCHDIT ←← 4
02100	
02200	;OPTIONS BITS FOR INTERROGATE
02300	RETAIN ←← 1
02400	WAIT   ←← 2
02500	SAYWCH ←← 10
02600	MULTIN ←← 200000
02700	NOJOY  ←← 400000
02800	
     

00100	COMMENT ⊗procedure descriptors & null process skeleton⊗
00200	
00300	FLXXX←←0
00400	UP <
00500	FLXXX←←%FIRLOC-400000
00600	>;UP
00700	
00800	
00900	DEFINE PUTINLOC(LCN,V),< 
01000	UP <
01100		SVPCXX ←← .
01200		DEPHASE
01300	>;UP
01400		RELOC LCN+FLXXX
01500		V
01600		RELOC
01700	UP <
01800		PHASE SVPCXX
01900	>;UP
02000	>
02100	
02200	;MAKE A PD FOR THE SPROUTER
02300	↑SPRPDA:BLOCK PD.XXX+1
02400	
02500	DEFINE FPDE(IX,V),<PUTINLOC (SPRPDA+IX,V)>
02600	
02700		FPDE	(PD.,SPROUT)
02800		FPDE	(PD.DSW,STKBAS)
02900		FPDE	(PD.PDA,<<XWD SPRPDA,0>>)
03000		FPDE	(PD.LLW,<SPRPDA+PD.XXX>)
03100		FPDE	(PD.DLW,<SPRPDA+PD.XXX>)
03200	
03300	
03400	IFN 0,<
03500	
03600	;NULL PROCESS
03700	NULPDA:	NULPRO			;PD OF NUL PROC
03800	↑NULPRC: %NULPR			;NULL PROCESS
03900	
04000	%NULPR:	BLOCK STKBAS+=32	;NULL PROCESS AREA
04100	
04200	DEFINE NPE (IX,V), <PUTINLOC (%NULPR+IX,V)>
04300	
04400		NPE	(STATL,<<XWD SPRPDA,0>>)
04500		NPE	(ACF,STKBAS+%NULPR+1)
04600		NPE	(ACP,<<TPDL: XWD - =29,%NULPR+STKBAS+3>>)
04700		NPE	(STKBAS+1,%NULPR+DYNL)
04800		NPE	(STKBAS+2,<<XWD NULPDA,0>>)
04900	
05000	
05100	
05200	↑NULPRO:
05300		ERR	<I SHOULD NEVER RUN>
05400	>;IFN 0
05500	
05600	
05700	
05800	
05900	
06000	
06100	
     

00100	DSCR SPROUT -- THE PROCESS SPROUTER
00200	CAL 	PUSHJ
00300	PARM	-1(P)	;KILL LIST
00400		-2(P)	;OPTIONS WORD
00500		-3(P)	;PDA OF SPROUTED PROCESS
00600		-4(P)	; PROCEDURE PARAMS
00700		:
00800		-?(P)	;LAST OF PROCEDURRE PARAMS
00900		-?-1(P)	;PROCESS ITEM
01000	DES 
01100		This procedure acts as the "process" procedure.
01200	Roughly, it does the following:
01300	
01400	1. Saves the return address in PCW(RUNNER)
01500	2. gets stack space
01600	3. puts self on appropriate kill list & priority list
01700	4. copies over the procedure parameters.
01800	5. sets status of new & SPROUTing process
01900		&(eventually) calls the appropriate procedure.
02000	6. when the procedure returns, SPROUT then kills the process.
02100	
02200	⊗
02300	HERE (SPROUT)
02400		MOVE	USER,RUNNER	;
02500		POP	P,PCW(USER)	;RETN ADDRESS
02600		POP	P,KL		;PICK UP KILLL LIST
02700		POP	P,OPTS		;OPTIONS
02800		POP	P,PDA		;FIND OUT WHO
02900	;;%AA% -- 1 OF 1  DEFAULTS, ALSO THE POP P,PDA USED TO BE LATER
03000		CAIN 	PDA,APPL$Y	;SPROUT APPLY IS A ROYAL PAIN
03100	;;#OU# A TYPO RHT
03200		SKIPA	TMP,-1(P)	;REAL PDA FOR SPROUT APPLY
03300		MOVE	TMP,PDA		;
03400		HRRZ	A,PD.PDB(TMP)	;THE DEFAULTS
03500		JUMPE	A,SALCS		;NO DEFAULTS -- SPROUT ALLOCATIONS NOW
03600		LSH	A,4		;INTO POSITION
03700		TRNE	OPTS,STSMSK	;P STACK
03800		TRZ	A,STSMSK
03900		TRNE	OPTS,SSSMSK	;SP STACK
04000		TRZ	A,SSSMSK
04100		TRNE	OPTS,PRIMSK	;PRIORITY
04200		TRZ	A,PRIMSK
04300		TLNE	OPTS,QNTMSK	;QUANTUM
04400		TLZ	A,QNTMSK	;
04500		IOR	OPTS,A		;OR IN THE BITS FOR DEFAULTS
04600	SALCS:
04700	;;%AA%
04800	
04900		TRNE	OPTS,SSSMSK	;SPECIFIED SP STACK SIZE ?
05000		JRST	[ LDB C,SSSBYT	;YES, GET IT
05100			LSH   C,5	;TIMES 32
05200			JRST  .+2 ]
05300		MOVE	C,DEFSSS	;STANDARD SIZE
05400		PUSHJ	P,CORGET	;GET SPACE
05500		ERR	<NOT ENOUGH CORE -- SPROUT >
05600		MOVN	C,C		;MAKE PDP
05700		HRLZI	NSP,-1(C)	
05800		HRRI	NSP,-1(B)
05900		TRNE	OPTS,STSMSK	;P - STACK
06000		JRST	[ LDB C,STSBYT	;YES, GET IT
06100			LSH	C,5	;TIMES 32
06200			JRST	.+2]
06300		MOVE	C,DEFPSS	;STANDARD AMOUNT TO GET
06400		ADDI	C,STKBAS	;SPACE FOR BASE
06500		PUSHJ	P,CORGET	;GET ROOM
06600		ERR	<NOT ENOUGH CORE -- SPROUT >
06700		MOVE	PB,B		;PROCESS BASE
06800		MOVN	C,C
06900		HRLZI	NP,STKBAS(C)	;MAKE PDP
07000		HRRI	NP,STKBAS(PB)
07100	
07200	;ZERO OUT SOME OF THE PROCESS VARS
07300		HRLZI	A,ZFIRST(PB)	;
07400		HRRI	A,ZFIRST+1(PB)
07500		SETZM	ZFIRST(PB)
07600		BLT	A,ZLAST(PB)
07700	
07800	;REMEMBER DADDY
07900		MOVE	USER,RUNNER
08000		MOVE	A,PRCITM(USER)
08100		MOVEM	A,DADDY(PB)
08200	;;%AG% ! REMEMBER SPROUTER AS THE FIRST CALLER. RHT
08300		MOVEM	A,RSMR(PB)	;SO CALLER(MYPROC) STARTS OUT AS DADDY
08400	
08500	;BUILD MSCP, ETC.
08600	
08700		SETZM	DYNL(PB)	;NULL DYN LINK
08800		CAIN	PDA,APPL$Y	;IS IT A SPROUT APPLY?
08900		JRST	[		;YES
09000	UP <
09100			MOVE	PDA,(PDA) ;SINCE APPL$Y IS HERED
09200	>;UP
09300			POP	P,TMP	;ARG LIST
09400			POP	P,A	;PDA OF TARGET
09500			PUSH	NP,A	;PUT ON CALL STACK
09600			PUSH	NP,TMP	;PUT ON CALL STACK
09700	;;#OO# !(1 OF 2) A TYPO
09800			HRLZI	TMP,SPRPDA
09900			HLRZ	C,PD.DLW(A) ;LOOK FOR RIGHT LINK
10000	;;#OT# ! RHT DONT LOOK IF THE FELLOW SUPPLIES AN ENVIRONMENT
10100			TLNN	A,-1	;ENVIRON SUPPLIED??
10200			CAIG	C,1	;GLOBAL??
10300			JRST	SSLON	;YES
10400			HRRZ	A,PD.PPD(A);
10500			SKIPA	TMP,RF
10600		SSLFLP:	HLRZ	TMP,C
10700			MOVS	C,1(TMP)
10800			CAIE	A,(C)
10900			JRST	SSLFLP
11000	;;#OO# ! (2 OF 2) NEED TO SAY A SPROUT
11100			HRLI	TMP,SPRPDA
11200		SSLON:	MOVEM	TMP,STATL(PB)
11300			MOVEM	NSP,ISP(PB)
11400			JRST	APSON	]
11500		HLRZ	A,PD.DLW(PDA)	;DISPLAY LEVEL
11600		HRLZI	TMP,SPRPDA	;IN CASE OUTER LEVEL
11700		CAIG	A,1		;OUTER BLOCK PROC?
11800		JRST	SLON		;YES -- NO LOOP
11900		HRRZ	A,PD.PPD(PDA)	;THE LEXICAL PARENT
12000		SKIPA	TMP,RF		;DYNL
12100	SLFLP:	HLRZ	TMP,C		;BACK A STATL
12200		MOVS	C,1(TMP)	;SL,,PDA
12300		CAIE	A,(C)		;SAME AS DADDY?
12400		JRST	SLFLP		;NO
12500		HRLI	TMP,SPRPDA	;SPRPDA,,STATL
12600	SLON:	MOVEM	TMP,STATL(PB)	;STATIC LINK WORD
12700		MOVEM	NSP,ISP(PB)	;SP WORD
12800	
12900	;COPY PROC PARAMS
13000	
13100		HLRZ	TMP,PD.NPW(PDA)	;#STRING PARAMS*2
13200		JUMPE	TMP,STPSON	;HAVE ANY ?
13300		HRL	TMP,TMP		;YES, DO A BLT
13400		HRRZI	A,1(NSP)	;DEST
13500		ADD	NSP,TMP		;BUMP OLD STACK
13600		SUB	SP,TMP		;DECREMENT OLD STACK
13700		HRLI	A,1(SP)		;SOURCE
13800		BLT	A,(NSP)		;COPY THEM
13900	STPSON:	HRRZ	TMP,PD.NPW(PDA)	;# ARITH PARMS +1
14000		SOJLE	TMP,APSON	;ANY TO BLT ?
14100		HRL	TMP,TMP		;MAKE XWD
14200		HRRZI	A,1(NP)		;DEST
14300		ADD	NP,TMP
14400		SUB	P,TMP
14500		HRLI	A,1(P)
14600		BLT	A,(NP)		;DO IT
14700	APSON:
14800	
     

00100	
00200	;NOW  SET UP NEW PROCESS'S STATUS, QUANTUM, & PRIORITY
00300	
00400		SETOM	STATUS(PB)		;ASSUME RUNNING
00500		TRNE	OPTS,SPNDNP		;UNLESS SUSPEND
00600		SETZM	STATUS(PB)		;0 MEANS SUSPENDED
00700		MOVE	TMP,DEFQNT		;STANDARD QUANTUM
00800		TLNN	OPTS,QNTMSK		;GET LOG2 QUANTUM
00900		JRST	SVQNT			;NO NEED
01000		LDB	A,QNTBYT
01100		MOVEI	TMP,1
01200		LSH	TMP,(A)
01300	SVQNT:	MOVEM	TMP,QUANTM(PB)
01400		MOVE 	A,DEFPRI		;ASSUME STD PRIORITY
01500		TRNE	OPTS,PRIMSK		;SAID OTHERWISE?
01600		LDB	A,PRIBYT
01700		PUSHJ	P,SETPRI		;GO SET PRIORITY
01800	
01900	;SET UP PROCESS ITEM
02000	
02100		POP	P,C			;PICK UP ITEM #
02200		MOVEM	C,PRCITM(PB)		;REMEMBER IT
02300		MOVEI	A,PRCTYP		;SAY IS OF TYPE PROCESS
02400	
02500	COMMENT **** MAY WANT TO WORRY HERE ABOUT GLOBAL ITEMS **** ;
02600	
02700		MOVE	TABL,GOGTAB
02800		DPB	A,INFOTAB(TABL)		;SAY IS A PROCESS
02900		HRRZM	PB,@DATAB(TABL)		;SET DATUM VALUE
03000	
03100	;KILL SET STUFF
03200		MOVE	B,C			;ITEM NUMBER
03300		MOVEM	KL,KLOWNR(PB)		;REMEMBER KILL LIST OWNER
03400		JUMPE	KL,NEWSTT		;ONLY PUT ON KILL SET IF HAVE ONE
03500		PUSH	P,TABL			;NEED TO SAVE THESE
03600		PUSH	P,FP			;
03700		PUSHJ	P,INSRTS		;GO PUT ITEM IN KILL SET
03800		POP	P,FP
03900		POP	P,TABL
04000	
04100	;NOW DECIDE WHAT TO DO WITH SPROUTING PROCESS & DO THE RIGHT THING
04200	
04300	NEWSTT:	MOVE 	USER,RUNNER		;HOPE IT IS STILL HIM
04400		TRNE	OPTS,RUNME		; DOES SPROUTING PROCESS WANT TO RUN?
04500		JRST	RNSPRR			;YES
04600		MOVEM	P,ACP(USER)		;IF HERE, THEN WANT TO RUN NEW GUY
04700		MOVEM	SP,ACSP(USER)		;SAVE THE NECESSARY ACS
04800		MOVEM	RF,ACF(USER)		;
04900		MOVNS	STATUS(USER)		;RUNNING BECOMES READY
05000		TRNE	OPTS,SPNDME		;IF I WANTED SUSPENSION
05100		SETZM	STATUS(USER)		;DO IT
05200		SKIPL	STATUS(PB)		;DOES SPROUTED PROCESS WANT TO RUN
05300		JRST	NORFR			;NO
05400		MOVE	USER,GOGTAB
05500		MOVE	A,QUANTM(PB)
05600		MOVEM	A,TIMER(USER)
05700		MOVE	P,NP			;
05800		MOVE	SP,NSP			;GET READY
05900		MOVEI	RF,DYNL(PB)		;
06000		MOVEM	PB,RUNNER
06100	CALLIT:	PUSHJ	P,@PD.(PDA)		;CALL THE SO AND SO
06200	
06300	;HERE IS WHERE WE COME ON PROCEDURE EXIT
06400	CALRET:	MOVE	PB,RUNNER		;I HOPE ITS ME
06500		PUSHJ	P,KACTS			;DO EVERYTHING BUT SPACE FREEING
06600		MOVE	P,ALLPDP		;USE THIS PDL FOR KILLING CORE
06700	
06800	;NOW KILL CORE FOR SP STACK
06900	
07000		HRRZ	B,ISP(PB)
07100		ADDI	B,1
07200		PUSHJ	P,CORREL
07300	
07400	;NOW KILL CORE FOR P-STACK
07500	
07600		HRRZI	B,(PB)
07700		PUSHJ	P,CORREL
07800	
07900	;NOW ALL TRACES ARE GONE (I HOPE)
08000	
08100		JRST	FOTR			;GO FIND SOMETHING TO DO
08200	
08300	;PROCEDURE THAT PERFORMS ALL KILL ACTIONS EXCEPT STACK RELEASING
08400	;EXPECTS PB TO POINT AT THE CONDEMNED PROCESS
08500	;USES A,B,C,KL
08600	
08700	KACTS:	HRRZ	C,PRCITM(PB)
08800		MOVE	B,C			;
08900		MOVE	TABL,GOGTAB		;
09000		TLO	PB,TERM			;SET TERM BIT
09100		MOVEM	PB,@DATAB(TABL)		;TERMINATED
09200		SKIPE	KL,KLOWNR(PB)		;IF HAVE A KILL SET
09300		PUSHJ	P,DELTSE		;DELETE FROM SET
09400	
09500	;NOW  CHECK TO SEE IF WE WERE ON ANY JOIN LISTS
09600	
09700		SKIPN	A,JOINS(PB)
09800		JRST	REMPRI
09900		MOVE	KL,GOGTAB	;
10000	KACT.1:	HLRZ	C,(A)		;THE ITEM
10100		MOVE	B,@DATAB(TABL)	;GET ADDRESS OF THE DATUM
10200		TLNE	B,TERM		;DEAD ALREADY??
10300		JRST	KACT.2		;YES
10400		SOSLE	JOINCT(B)	;READY TO ROLL ??
10500		JRST	KACT.2		;NO
10600		SKIPN	STATUS(B)	;CURRENT STATUS
10700		AOS	STATUS(B)	;READY
10800	KACT.2:	HRRZ	B,(A)
10900		HRR	C,FP1(KL)	;RELEASE LIST CELL
11000		HRRM	C,(A)	
11100		HRRM	A,FP1(KL)	;NEW FREE LIST
11200		JUMPE	B,REMPRI	;END OF LIST
11300		MOVE	A,B		;
11400		JRST 	KACT.1
11500	
11600	
11700	
11800	;NOW TAKE OFF PRIORITY LIST AND RETURN
11900	;NOTE -- THE CODE FROM HERE TO THE POPJ IS ITSELF A PROCEDURE USED
12000	;ELSEWHERE TO REMOVE PROCESS (PB) FROM ITS PRIORITY LIST
12100	;SIDE EFFECTS -- USES A,B,C 
12200	
12300	REMPRI:	MOVE	A,PRIOR(PB)
12400		ADD	A,GOGTAB
12500		HRRZ	B,PLISTE(PB)
12600		HLRZ	C,PLISTE(PB)
12700		JUMPN	C,.+3
12800		HRRM	B,PRILIS(A)		;HEAD OF LIST
12900		JRST	.+2
13000		HRRM	B,PLISTE(C)		;NEXT(C)←B
13100		JUMPN	B,.+3
13200		HRLM	C,PRILIS(A)		;NEW TAIL
13300		POPJ	P,
13400		HRLM	C,PLISTE(B)		;PREV(B)←C
13500		POPJ	P,
13600	
13700	;PROCEDURE TO PUT PROCESS (PB) ON PRIORITY LIST A
13800	;SIDE EFFECT -- MODIFIES B
13900	SETPRI:	MOVEM	A,PRIOR(PB)		;REMEMBER MY PRIORITY
14000		ADD	A,GOGTAB
14100		SKIPE	B,PRILIS(A)		;PRIORITY LIST OWNER
14200		HRLM	PB,PLISTE(B)		;LINK BACK
14300		HRRZM	B,PLISTE(PB)		;LIINK DOWM
14400		HRRM	PB,PRILIS(A)		;NEW RHS FOR OWNER IS PTR TO  ME
14500		TLNN	B,-1			;WAS THE LIST EMPTY ??
14600		HRLM	PB,PRILIS(A)		;YES -- THIS IS THE TAIL TOO
14700	CPOPJ:	POPJ	P,
14800	
     

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

00100	COMMENT ⊗routines for inserting & deleting set elements⊗
00200	
00300	;expects item no in B , (KL) = the owner
00400	;mangles A,B,C,FP,TABL
00500	
00600	INSRTS:	MOVE	TABL,GOGTAB
00700		SKIPN	A,(KL)		;GET OWNER
00800		JRST	NEWINS		;IT WAS NULL BEFORE
00900		MOVE	C,(A)		;POINT AT FIRST
01000	ISCH:	MOVS	C,(C)		;CONTENTS (SWAPPED) OF THIS
01100		CAILE	B,(C)		;ELIGIBLE
01200		JRST	NX1		;MUST GO FURTHER
01300		CAIL	B,(C)		;THERE ALREADY?
01400		POPJ	P,		;YES
01500	NI:	HRL	B,(A)		;POINTER AT THIS
01600		NCELL	(C)		;GET A CELL FOR IT
01700		MOVSM	B,(C)		;SAVE CONTENTS OF CELL
01800		HRRM	C,(A)		;LINK TO NEW
01900		HRLZI	A,1
02000		ADDB	A,(KL)		;UPDATE COUNT -- POINT AT LAST,,FIRST
02100		TLNN	B,-1		;AT THE END???
02200		HRLM	C,(A)		;YES
02300		POPJ	P,
02400	NX1:	HRRZ	A,(A)
02500		TLNN	C,-1		;END OF LIST
02600		JRST	NI		;YES -- PUT AT END
02700		MOVSS	C
02800		JRST	ISCH		;GO LOOK SOME MORE
02900	NEWINS:	NNCELL	(A)
03000		SETZM	(A)
03100		HRRZM	A,(KL)		;IT USED TO BE NULL
03200		JRST	NI
03300	
03400	;ROUTINES FOR ADDING TO LISTS
03500	;EXPECT ITEM NO IN B, KL= ADRS OF OWNER
03600	;MANGLE A,B,C,FP,TABL
03700	;;#QK# RHT ! SET UP OF TABL NEEDED
03800	IHEDLS:	MOVE	TABL,GOGTAB
03900		SKIPN	A,(KL)		;INSERT AT HEAD
04000		JRST	NEWINS
04100		JRST	NI		
04200	ITAILS:	
04300	;;#QK# ! SET UP TABL (2 OF 2)
04400		MOVE	TABL,GOGTAB	;
04500		SKIPN	A,(KL)		;INSERT AT TAIL
04600		JRST	NEWINS
04700		MOVS	A,(A)
04800		JRST	NI
04900	
05000	
05100	;ROUTINE TO DELETE SET OR LIST ELEMENTS
05200	;B = ITEM NO, (KL) IS THE OWNER
05300	;MANGLES A,B,C,TABL
05400	
05500	DELTLE:
05600	DELTSE:	SKIPN	A,(KL)		;GET SET DESCRIPTOR
05700		POPJ	P,		;NULL ALREADY
05800		MOVE	C,(A)
05900	DSCH:	MOVE	C,(C)
06000		TLC	C,(B)
06100		TLNN	C,-1		;WAS IT THIS ONE???
06200		JRST	DIT		;YES
06300		TRNN	C,-1		;END OF SEARCH
06400		POPJ	P,		;YES
06500		MOVE	A,(A)		;LINK
06600		JRST	DSCH		;GO LOOK
06700	DIT:	MOVE	TABL,GOGTAB
06800		MOVE	B,(A)		;B PTR TO THIS CELL
06900		HRRM	C,(A)		;LINK PREV TO NEXT
07000		HRL	C,FP1(TABL)	;OLD FREE LIST
07100		HLRM	C,(B)		;LINK CELL
07200		HRRM	B,FP1(TABL)	;
07300		HRLZI	B,-1		;ADJUST DESCRIPTOR
07400		ADDB	B,(KL)
07500		TLNE	B,-1		;LIST NULL NOW???
07600		JRST	CKEND		;NO
07700		SETZM	(KL)		;YES
07800		MOVSS	(B)		;LAST,,FIRST CELL 
07900					;NOW IS 0,,PTR TO CELL JUST FREED UP
08000		HRRM	B,FP1(TABL)	;NEW FREE LIST
08100		POPJ	P,
08200	CKEND:	TRNN	C,-1		;WAS THIS THE END
08300		HRLM	A,(B)		;YES
08400		POPJ	P,
08500	
08600	
08700	;ROUTINE TO DELETE FIRST ELT OF A LIST
08800	;PUTS ITEM # INTO A
08900	;EXPECTS (KL) = THE OWNER
09000	;MODIFIES A,B,C,TABL
09100	
09200	REMCAR:	SKIPN	A,(KL)
09300		POPJ	P,		;IF WAS NULL RETURN A 0
09400		MOVE	C,(A)
09500		MOVE	C,(C)		;FIRST REAL LIST CELL
09600		HLRZ	B,C		;FIRST ONE
09700		PUSH	P,B		;SAVE IT
09800		PUSHJ	P,DIT
09900		POP	P,A		;VALUE
10000		POPJ	P,
10100	
10200	
10300	
10400	
10500	
     

00100	;USER REQUESTED SCHEDULING
00200	
00300	
00400	HERE(URSCHD)
00500		MOVE	PB,RUNNER
00600		SKIPL	STATUS(PB)		;
00700		JRST 	FOTR			;GO FIND ONE TO RUN
00800		MOVNS	STATUS(PB)		;SET TO READY
00900	SPSRN1:	SETZM	REASON(PB)		;OTHER ACS NOT SAVED
01000	SPSRN2:	POP	P,PCW(PB)		;DITTO -- BUT LEAVE REASON INTACT
01100						;THESE TWO LABELS ARE USED
01200						;BY SUSPEND, JOIN & THE LIKE
01300		MOVEM	P,ACP(PB)
01400		MOVEM	SP,ACSP(PB)
01500		MOVEM	RF,ACF(PB)		
01600	FOTR:	HRRZ	B,GOGTAB
01700		TLO	B,-NPRIS
01800		MOVEI	A,1			;READY
01900	SCHLIS:	SKIPN	PB,PRILIS(B)		;SEARCH DOWN THIS LIST
02000		JRST	NXLIS			;LIST IS EMPTY
02100	TRYTHS:	CAMN	A,STATUS(PB)		;IS THIS READY
02200		JRST	SCDTHS			;YES -- DO HIM
02300		HRRZ	PB,PLISTE(PB)		;LINK DOWN LIST
02400		JUMPN	PB,TRYTHS		;IF ANY LEFT AT THIS LEVEL,TRY
02500	NXLIS:	AOBJN	B,SCHLIS		;SEARCH LIST
02600		
02700	IFE APRISW <
02800	;;#NA#  RACE CONDITION ON WHEN INTERRUPT HAPPENS
02900		IMSKCL	1,[-1]			;MASK OFF ALL INTERRUPTS
03000		SKIPE	INTRPT			; A RECENT INTERRUPT
03100		JRST	[INGOSC: SETZM INTRPT	;GO TRY AGAIN TO SCCHEDULE
03200				IMSKST 1,[-1]
03300				JRST	FOTR ]
03400		INTENS	B,			;GET INTERRUPT ENABLING
03500		TLNN	B,775204		;IS HE ENABLED FOR SOMETHING
03600						;THAT CAN STILL HAPPEN
03700		ERR <NO ONE TO RUN>,1,INGOSC	;NO
03800		IMSTW	[-1			;WAIT FOR AN INTERRUPT
03900			1]
04000		SETZM	INTRPT			;ZERO THE FLAG
04100	;;#NA# -- EVENTUALLY FIX THIS CROCK
04200	>;IFE APRISW
04300	IFN APRISW <
04400		SKIPN	INTRPT
04500		ERR <NO ONE TO RUN>,1
04600		SETZM	INTRPT
04700	>;IFN APRISW
04800		JRST	FOTR			;FIND SOMEONE TO RUN
04900	
05000	SCDTHS:	
05100	;CIRCLE THE QUEUE
05200		SKIPN	A,PLISTE(PB)		;ONLY ONE ON THE LIST?
05300		JRST	RDYTHS			;YES
05400		TRNN	A,-1			;ALREADY AT END?
05500		JRST	RDYTHS			;YES
05600		HLLM	A,PLISTE(A)		;PREV(NEXT(ME))←PREV(ME)
05700		MOVS	C,A			;NEXT(ME),,PREV(ME)
05800		TRNE	C,-1			;ANY PREV?
05900		HLRM	C,PLISTE(C)		;YES -- NEXT(PREV(ME))←NEXT(ME)
06000		TLNE	A,-1			;WAS I FIRST?
06100		HRR	A,PRILIS(B)		;NO -- FIRST WILL STAY FIRST
06200		HRL	A,PB			;NEW OWNER -- ME,,NEW FIRST
06300		EXCH	A,PRILIS(B)		;GET OLD LAST,,FIRST
06400		HLLZM	A,PLISTE(PB)		;MY NEW ENTRY IS OLD LAST,,0
06500		MOVS	A,A			;    XXX,,OLD LAST
06600		HRRM	PB,PLISTE(A)		;POINT AT ME
06700	
06800	
06900	RDYTHS:	SETOM 	STATUS(PB)		;RUNNING
07000		HRRM 	PB,RUNNER		;SAY SO
07100		MOVE	USER,GOGTAB
07200		MOVE	A,QUANTM(PB)
07300		MOVEM	A,TIMER(USER)
07400		SKIPE	A,REASON(PB)
07500		JRST	@SPCASE(A)		;SOME SPECIAL CASE
07600	RPSPF:	MOVE	P,ACP(PB)		;GET THE NEEDED REGISTERS
07700		MOVE	SP,ACSP(PB)
07800		MOVE	RF,ACF(PB)
07900		JRST	@PCW(PB)		;GO START RUNNING THE SO AND SO
08000	
08100	
08200	SPCASE:	RPSPF				;0 THEN RESTORE P, SP, F
08300		RSTACS				;1 THEN RESTORE ALL ACS
08400		RPSPF				;2 THEN FROM JOINER
08500		RST1				;3 THEN FROM INTERROGATE
08600	
08700	RSTACS:	MOVE	P,ACP(PB)		;PUT THE RETURN ADDRESS ON THE STACK
08800		PUSH	P,PCW(PB)
08900		MOVEM	P,ACP(PB)
09000		HRLZI	P,AC0(PB)
09100		BLT	P,P			;RESTORE THE OLD ACS
09200		POPJ	P,			;GO RUN
09300	
09400	
09500	RST1:	MOVE	A,AC1(PB)		;RESTORE REG 1 , SP,P,F
09600		JRST	RPSPF
09700	
     

00100	HERE(RESUME)
00200		MOVE	USER,RUNNER	;TAKE CARE OF RET ADDRS
00300		POP	P,PCW(USER)
00400		POP	P,OPTS		;OPTIONS
00500		POP	P,A		;RETURN VALUE
00600		POP	P,C		;WHO
00700		MOVE	TEMP,GOGTAB	;
00800		LDB	B,INFOTAB(TEMP)	;TEST THE TYPE
00900		CAIE	B,PRCTYP	;IS THE TYPE A PROCESS
01000		ERR	<ATTEMPT TO RESUME SOMETHING NOT A PROCESS>
01100		MOVE	PB,@DATAB(TEMP)	;GET THE DATUM
01200		TLNE	PB,TERM		;WAS IT TERMINATED?
01300		ERR	<ATTEMPT TO RESUME A TERMINATED PROCESS>
01400		MOVE	B,PRCITM(USER)	;MY NAME
01500		MOVEM	B,RSMR(PB)	;REMEMBER CALLER
01600		SKIPE	STATUS(PB)	;HIS STATUS BETTER BE 0
01700		ERR	<ATTEMPT TO RESUME NON-SUSPENDED PROCESS>,1,<@PCW(USER)>
01800		JUMPN	OPTS,NS.RSM	;NONSTANDARD IF JUMP
01900		SETZM	STATUS(USER)
02000	RSM.H:	SETOM	STATUS(PB)
02100		MOVEM	P,ACP(USER)	;SAVE NEEDFUL REGISTERS
02200		MOVEM	RF,ACF(USER)
02300		MOVEM	SP,ACSP(USER)
02400		SETZM	REASON(USER)	;ONTL P, SP, F IMPORTANT
02500		MOVEM	PB,RUNNER	;
02600		MOVE	C,REASON(PB)	;
02700		JRST	@SPCASE(C)	;GO FIRE HIM UP
02800	
02900	
03000	NS.RSM:	TRNN	OPTS,MSTMSK	;FUNNYNESS IN MY NEW STATUS?
03100		JRST	RSM.4		;NO -- IT MUST BE NOTNOW
03200		LDB	D,MSTBYT	;GET INDEX
03300		JRST	@[ RSM.1	;I GO READY
03400			  RSM.3		;I DIE
03500			  RSM.4		;I WANT TO KEEP RUNNING
03600			]-1(D)		;SELECT
03700	
03800	RSM.1:	TRNN	OPTS,NOTNOW	;HE RUNS?
03900		JRST	RSM.2		;YES
04000		AOS	STATUS(PB)	;MAKE HIM READY
04100		MOVE	B,REASON(PB)	;WERE ALL REGISTERS SAVED
04200		CAIN	B,1		;
04300		JRST	RSM.01		;YES
04400		MOVEM	A,AC1(PB)	;
04500		MOVEI	A,3
04600		MOVEM	A,REASON(PB)	;A IS IMPORTANT
04700	RSM.01:	PUSH	P,PCW(USER)	;RET AD
04800		JRST	URSCHD		;RESCHEDULE
04900	
05000	
05100	
05200	RSM.2:	MOVNS	STATUS(USER)	;
05300		JRST	RSM.H		;GO GET HIM GOING
05400	
05500	
05600	
05700	RSM.3:	MOVE	B,REASON(PB)	;
05800		CAIN	B,1		;ALL ACS SAVED?
05900		JRST	RSM.3X		;YES
06000		MOVEM	A,AC1(PB)	;SAVE A
06100		MOVEI	A,3		;
06200		MOVEM	A,REASON(PB)	;
06300	RSM.3X:	TRNE	OPTS,NOTNOW	;HE RUNS?
06400		JRST	RSM.03		;YES
06500		AOS	STATUS(PB)	;NO - I CAN COMMIT SUICIDE
06600		MOVE	PB,USER		;
06700		JRST	TERMPB		; I DIE
06800	RSM.03:	MOVE	B,ACP(PB)	;
06900		MOVEI	C,RSM.T		;
07000		EXCH	C,PCW(PB)	;FIRST HE WILL KILL ME
07100		PUSH 	B,C		;
07200		PUSH	B,PB		;
07300		MOVEM	B,ACP(PB)	;THE TERMPB POPJ WILL CONTINUE HIM
07400		JRST	RSM.H		;GO FIRE THE DEAR BOY UP
07500	
07600	RSM.4:	AOS	STATUS(PB)	;GET HIM READY
07700		MOVE	B,REASON(PB)	;SHOULD WE SAVE 1
07800		CAIE	B,1		;
07900		JRST	@PCW(USER)	;I GO ON MY WAY
08000		MOVEM	A,AC1(PB)	;SAVE IT
08100		MOVEI	A,3		;
08200		MOVEM	A,REASON(PB)	;
08300	;;#LB#! 1-15-73 DCS WAS @PCW(PB), THAT'S WRONG ("TYPO")
08400		JRST	@PCW(USER)	;
08500	
08600	RSM.T:	MOVE	PB,(P)		;
08700		PUSHJ	P,TERMPB	;
08800		MOVE	PB,1(P)		;TERMPB BACKED UP THE STACK
08900		POP	P,PCW(PB)	;RET AD
09000		MOVE	C,REASON(PB)	;
09100		JRST	@SPCASE(C)	;GO DO RIGHT THING ABOUT ACS
09200	
     

00100	COMMENT ⊗SUSPEND and TERMINATE runtime routines⊗
00200	HERE(SUSPEND)
00300		MOVE	C,-1(P)		;THE ITEM
00400		POP	P,-1(P)		;BACK UP RETN ADDR
00500		MOVE	TABL,GOGTAB	;
00600		LDB	B,INFOTAB(TABL)
00700		CAIE	B,PRCTYP	;BE SURE A PROCESS ITEM
00800		ERR	<ATTEMPT TO SUSPEND A NON PROCESS ITEM>
00900		MOVE	PB,@DATAB(TABL)
01000	        TLNE	PB,TERM		;IF TERMINATED , 
01100		ERR	<SUSPENDING A TERMINATED ITEM>
01200		CAME	PB,RUNNER	;IS IT THE RUNNER
01300		JRST	OTHGUY		;NO
01400		SETZM	STATUS(PB)
01500		JRST	SPSRN1		;GO RESCHEDULE
01600	OTHGUY:	MOVEI	A,SPNDR		;HE MUST HAVE BEEN READY
01700		SKIPE	STATUS(PB)	;IF HE WASNT SUSPENDED
01800		MOVEM	A,REASON(PB)	;THE REGISTERS MUST BE RESTORED
01900		SETZM	STATUS(PB)	;BE SURE
02000	TENX <
02400	IFNAVL ITMANY, <
02500	ITMANY←←-1
02600	>
02700	>;TENX
02800		MOVEI	A,ITMANY	;GET THE ITEM ANY
02900		POPJ	P,
03000	
03100	HERE(TERMINATE)
03200		MOVE	C,-1(P)
03300		MOVE	TABL,GOGTAB	;
03400		LDB	B,INFOTAB(TABL)	;IS HE A PROCESS
03500		CAIE	B,PRCTYP
03600		ERR	<TERMINATING A NON-PROCESS>
03700		MOVE	PB,@DATAB(TABL)	;POINT AT PROCESS
03800		TLNE	PB,TERM		;ALREADY DEAD
03900		JRST	RET1		;YES
04000	↑TERMPB:
04100		MOVE	USER,RUNNER	;COME HERE IF PB LOADED
04200		CAMN	PB,USER		;IS IT ME THAT IS TO DIE?
04300		JRST	KILLIT		;YES
04400		PUSH	P,PRIOR(USER)	;I AM ABOUT TO GET HIGH PRIORITY
04500		PUSHJ	P,REMPRI
04600		MOVEI	A,MAXPRI	;
04700		PUSHJ	P,SETPRI
04800		MOVEI	A,FIXPRI
04900		MOVEM	A,PCW(USER)
05000		MOVEM	P,ACP(USER)
05100		MOVEM	RF,ACF(USER)
05200		MOVEM	SP,ACSP(USER)
05300		MOVE	RF,ACF(PB)
05400		MOVE	P,ACP(PB)
05500		MOVE	SP,ACSP(PB)
05600		MOVEI	A,1		;NOW FIX STATUS
05700		MOVEM	A,STATUS(USER)	;
05800		MOVNM	A,STATUS(PB)
05900		MOVEM	PB,RUNNER	;THE NEW RUNNER
06000	KILLIT:	MOVEI	LPSA,SPRPDA	;THE SPROUTER IS WHERE WE GO BACK TO
06100		PUSHJ	P,STKUWD	;UNWIND THE STACK
06200		JRST	CALRET		;GO DIE 
06300	
06400	;IF LIVED THROUGH THE DESTRUCTION, WILL COME HERE
06500	FIXPRI:	PUSHJ	P,REMPRI
06600		POP	P,A		;REAL PRIORITY
06700		PUSHJ	P,SETPRI
06800	RET1:	SUB	P,[XWD 2,2]	;GET OFF THE PARAMETER
06900		JRST	@2(P)		;RETURN
07000	
     

00100	COMMENT ⊗The JOIN runtime routine⊗
00200	
00300	DSCR JOIN
00400	CAL  PUSH P,SET
00500	     PUSHJ P,JOIN
00600	DES  CAUSES YOUR PROCESS TO WAIT FOR THE TERMINATION OF ANY
00700	PROCESSES NAMED IN ITS ARGUMENT SET
00800	⊗
00900	
01000	HERE(JOIN)
01100		MOVE	PB,RUNNER
01200		MOVE	B,-1(P)		;THE SET 
01300		POP	P,-1(P)		;FOR LATER
01400		JUMPE	B,CPOPJ		;
01500		MOVE	TABL,GOGTAB	;GET READY FOR CELL GETTING
01600		HRRZ	A,(B)		;A NOW POINTS AT FIRST
01700		HRLZ	D,PRCITM(PB)	;THE PROCESS ITEM OF THE JOIN
01800	
01900	;NOW LOOP ALONG SET, GIVING WARNINGS
02000	
02100	JNST:	HLRZ	C,(A)		;THE ITEM NUMBER
02200		LDB	B,INFOTAB(TABL)	;GET TYPE
02300		CAIE	B,PRCTYP	;PROCESS?
02400		ERR	<ATTEMPT TO DO JOIN ON NON-PROCESS>
02500		MOVE	B,@DATAB(TABL)	;GET DATUM
02600		TLNE	B,TERM		;DEAD ???
02700		JRST	NXTJNR		;YES
02800		AOS	JOINCT(PB)	;ONE MORE TO DIE
02900		NNCELL	(C)		;GET (POSSIBLY FIRST) NEW CELL
03000		HRR	D,JOINS(B)	;LINK TO OLD JOIN LIST
03100		MOVEM	D,(C)		;NEW CONTENTS OF THIS CELL
03200		HRRZM	C,JOINS(B)	;NEW JOIN LIST
03300	NXTJNR:	HRRZ	A,(A)		;GET NEXT ENTRY
03400		JUMPN	A,JNST
03500		SKIPG	JOINCT(PB)	;DO WE NEED TO WAIT?
03600		POPJ	P,		;NO
03700		MOVEI	A,JOINR		;REASON IS A JOIN
03800		MOVEM	A,REASON(PB)	;
03900		SETZM	STATUS(PB)	;I AM SUSPENDED
04000		JRST	SPSRN2		;GO SAVE P,RF,SP & RUN SOMEONE
04100					;(BUT DONT CHANGE REASON)
04200	
04300	
04400	
04500	
04600	
04700	
04800	
     

00100	COMMENT ⊗THE MAIN PROCESS INITIALIZER⊗
00200	
00300	HERE(MAINPR)
00400		MOVE	USER,GOGTAB
00500		SKIPE	GGDAD(USER)	;INITIALIZED ALREADY
00600		POPJ	P,		;YES
00700		MOVEI	C,NPVARS+40	;HOW MUCH SPACE WE NEED
00800		PUSHJ	P,CORGET
00900		ERR	<NO ROOM FOR THE MAIN PROCESS>
01000		HRRZ	PB,B		;PROCESS BASE
01100		MOVE	A,SPDL(USER)	;STRING PDL
01200		MOVEM	A,ISP(PB)
01300		SETOM	DYNL(PB)
01400		HLROI	A,SPRPDA
01500		MOVEM	A,STATL(PB)
01600		MOVEM	PB,GGDAD(USER)
01700		MOVEM	PB,RUNNER	;SAY THIS IS THE RUNNER
01800		HRLZI	A,ZFIRST(PB)
01900		HRRI	A,ZFIRST+1(PB)
02000		SETZM	ZFIRST(PB)
02100		BLT	A,ZLAST(PB)
02200	
02300		MOVEI	C,MAINPI	;THE MAIN PROCESS ITEM NUMBER
02400		MOVEI	A,PRCTYP	;MAKE A PROCESS
02500		DPB	A,INFOTAB(USER)
02600		HRRZM	PB,@DATAB(USER)
02700		MOVEM	C,PRCITM(PB)
02800	
02900		SETZM	KLOWNR(PB)	;NASTY
03000		SETOM	STATUS(PB)	;I AM THE RUNNER
03100		MOVEI	A,STPSZ		;SET DEFAULTS
03200		MOVEM	A,DEFPSS	;P STACK
03300		MOVEI	A,STSPST	;
03400		MOVEM	A,DEFSSS	;SP STACK
03500		MOVEI	A,STDQNT	;
03600		MOVEM	A,DEFQNT	;QUANTUM
03700		MOVEM	A,QUANTM(PB)	;
03800		MOVEI	A,STDPRI	;STANDARD PRIORITY
03900		MOVEM	A,DEFPRI	;PRIORITY
04000		PUSHJ	P,SETPRI	;SET THE PRIORITY
04100		PUSH	P,[%SPGC]
04200		PUSHJ	P,SGREM
04300		PUSH	P,[%ARRSRT]
04400		PUSHJ	P,SGREM
04500		PUSH	P,[%PSSGC]
04600		PUSH	P,[SGLKBK+1]
04700		PUSHJ	P,SGINS
04800	
04900		POPJ	P,
05000	
05100	
     

00100	COMMENT ⊗CALLER , MYPROC, AND PSTATUS ⊗
00200	
00300	HERE(CALLER)
00400		JSP	TEMP,PDG
00500		ERR	<NOT A PROCESS ITEM>
00600		TLNE	A,TERM
00700		ERR	<PROCESS IS TERMINATED>
00800		MOVE	A,RSMR(A)
00900	C.XIT1:	EXCH	C,-1(P)
01000	C.XIT:	SUB	P,X22
01100		JRST	@2(P)
01200	
01300	HERE(MYPROC)
01400		MOVE	USER,RUNNER
01500		MOVE	A,PRCITM(USER)
01600		POPJ	P,
01700	
01800	HERE(PSTATUS)
01900		JSP	TEMP,PDG
02000		ERR	<NOT A PROCESS ITEM>
02100		TLNN	A,TERM
02200		SKIPA	A,STATUS(A)
02300		MOVEI	A,2
02400		JRST	C.XIT1
02500	
02600	
02700	;PDG -- GETS PROC ITEM IN -1(P) INTO C , CHECKS TYPE, & PUTS DATUM INTO A
02800	;CALLED BY JSP TEMP,PDG
02900	;SIDE EFFECTS: USES USER, PUTS OLD VALUE OF C INTO -1(P), SKIP RETURNS IF
03000	;THE ITEM WAS OK. OTHERWISE RETURNS WITH A= WHATEVER TYPE ITEM IN C IS
03100	
03200	PDG:	EXCH	C,-1(P)		;ITEM NUMBER
03300		MOVE	USER,GOGTAB
03400		LDB	A,INFOTAB(USER)
03500		CAIE	A,PRCTYP
03600		JRST	(TEMP)		;WAS NOT A PROC ITEM
03700		MOVE	A,@DATAB(USER)
03800		JRST	1(TEMP)		;RETURN
03900	
     

00100	COMMENT ⊗ PRISET -- ROUTINE USER CALLS TO CHANGE PRIORITY ⊗
00200	
00300	HERE(PRISET)
00400		MOVE	C,-2(P)		;ITEM
00500		MOVE	TABL,GOGTAB	;
00600		LDB	A,INFOTAB(TABL)
00700		CAIE	A,PRCTYP
00800		ERR	<ATTEMPT TO SET PRIORITY OF NON PROCESS ITEM>
00900		MOVE	PB,@DATAB(TABL)	;GET DATUM
01000		TLNE	PB,TERM
01100		ERR	<ATTEMPT TO SET PRIORITY OF TERMINATED PROCESS>
01200		PUSHJ	P,REMPRI	;TAKE OFF MY LIST
01300		MOVE	A,-1(P)
01400		CAIG	A,17		;CHECK BOUNDS
01500		CAIGE	A,0
01600		ERR	<ERR ATTEMPT TO GIVE A PROCESS AN ILLEGAL PRIORITY>
01700		PUSHJ	P,SETPRI
01800		SUB	P,X33
01900		JRST	@3(P)
02000	
     

00100	COMMENT ⊗SPECIAL GC ROUTINE FOR PROCESSES⊗
00200	
00300	
00400	HERE(%PSSGC)
00500		MOVE	TEMP,RUNNER
00600		MOVEM	SP,ACSP(TEMP)
00700	;; dont get it from here (assume was ok)
00800	;	MOVE	RF,RACS+RF(USER)
00900		MOVEM	RF,ACF(TEMP)
01000		HRLZI	B,-NPRIS
01100		HRR	B,GOGTAB
01200	SCHL1:	SKIPN	TEMP,PRILIS(B)
01300		JRST	NXLS
01400		PUSH	P,B
01500	SCHL2:	MOVE	RF,ACF(TEMP)
01600		PUSH	P,TEMP
01700		PUSHJ	P,%ARSR1
01800		MOVE	TEMP,(P)
01900		HRRZ	A,ISP(TEMP)
02000		MOVE	SP,ACSP(TEMP)
02100		PUSHJ	P,%SPGC1
02200		POP	P,TEMP
02300		HRRZ	TEMP,PLISTE(TEMP)
02400		JUMPN	TEMP,SCHL2
02500		POP	P,B
02600	NXLS:	AOBJN	B,SCHL1
02700		MOVE	TEMP,RUNNER
02800	;; now get rf for this process back (also sp)
02900		MOVE	RF,ACF(TEMP)
03000		MOVE	SP,ACSP(TEMP)
03100		POPJ	P,
03200	
03300	
03400	
03500	
03600	
03700	
     

00100	COMMENT ⊗INTERRUPT ROUTINES⊗
00200	
00300	
00400	HERE(DDFINT)			;DO DEFERRED INTERRUPT
00500		SKIPE	NOPOLL		;IGNORING IT?
00600		POPJ	P,		;YES
00700		SETZM	INTRPT		;
00800		MOVE	USER,RUNNER	;NEED TO SAVE ACS
00900		POP	P,PCW(USER)	;SAVE PC WORD
01000		MOVNS	STATUS(USER)	;READY
01100		MOVEI	TEMP,AC0(USER)	;
01200		BLT	TEMP,ACP(USER)	;
01300		MOVEI	A,1		;NEED ALL ACS
01400		MOVEM	A,REASON(USER)	;
01500		JRST	FOTR		;SEE WHOM TO RUN
01600	
01700	HERE(INTSET)
01800	
01900	;CALL IS  INTSET(ITEM,SPROUT OPTS)
02000	;ORS IN THE STATUS OPTIONS FOR SPNDNP+RUNME
02100	;TURNS OFF THE OPTION FOR SPNDME
02200		MOVE	USER,GOGTAB	;
02300		SKIPE	DISPAT(USER)	;HAVE TABLES???
02400		JRST	.+3		;YES
02500		PUSH	P,[=128]	;DEFAULT BUFFER SIZE
02600		PUSHJ	P,INTTBL	;GO GET EM
02700		PUSH	P,-2(P)		;ITEM
02800		PUSH	P,[INTPDA]	;INTERRUPT PROCEDURE
02900		MOVE	A,-2(P)		;GET OPTIONS
03000		TRZ	A,SPNDME	;SET UP STATUS FIELD
03100		TRO	A,SPNDNP+RUNME	;
03200		PUSH	P,A		;
03300		PUSH	P,[0]		;NO KILL SET
03400		PUSHJ	P,SPROUT	;SPROUT IT
03500	
03600		MOVE	C,-2(P)		;THE ITEM
03700		MOVE	A,@DATM
03800		MOVE	USER,GOGTAB
03900		MOVEM	A,INTPRC(USER)	;REMEMBER INTERRUPT PROCESS BASE
04000		MOVE	A,-1(P)		;
04100		TRNE	A,PRIMSK	;DID HE SPEC A PRIORITY
04200		JRST	POK
04300	
04400		PUSH	P,C		;ITEM
04500		PUSH	P,[0]
04600		PUSHJ	P,PRISET	;SET THE PRIORITY
04700	POK:
04800		SUB	P,X33
04900		JRST	@3(P)
05000	
05100	
05200	
05300	
05400	HERE(CLKMOD)
05500	NOTENX<
05600		MOVE	USER,GOGTAB	;
05700		SOSG	TIMER(USER)	;IF COUNTDOWN COMPLETE THEN
05800		SETOM	INTRPT		;SIGNAL THE INTERRUPT
05900		POPJ	P,		;LET CALLER DISMIS
06000	>;NOTENX
06100	TENX<
06200		ERR <CLKMOD not implemented.>
06300	>;TENX
06400	
06500	DEFINE QW(VALAC,WPAC,RPTR,WTOP,WBOT,OVINST) <
06600		MOVEM	VALAC,(WPAC)
06700		ADDI	WPAC,1
06800		CAMLE	WPAC,WTOP
06900		MOVE	WPAC,WBOT
07000		CAMN	WPAC,RPTR
07100		OVINST
07200		>
07300	
07400	DEFINE QR(VALAC,WPTR,RPAC,WTOP,WBOT,OVINST) <
07500		CAMN	RPAC,WPTR
07600		OVINST
07700		MOVE	VALAC,(RPAC)
07800		ADDI	RPAC,1
07900		CAMLE	RPAC,WTOP
08000		MOVE	RPAC,WBOT
08100		>
08200	
08300	DEFINE IQW(VAC) <
08400		QW(VAC,11,<INTQRP(USER)>,<INTQWT(USER)>,<INTQWB(USER)>,< JRST IQWOV >)
08500		>
08600	
08700	HERE(DFR1IN)
08800		MOVE	USER,GOGTAB	;SO CAN CALL ANY TIME
08900		MOVE	11,INTQWP(USER)
09000	NOTENX <
09100		IQW	1
09200		IQW	6
09300		MOVE	TEMP,XJBCNI
09400		IQW	TEMP
09500		MOVE	TEMP,XJBTPC
09600		IQW	TEMP
09700	>;NOTENX
09800	TENX <
09900		IQW	14		;LPC WORD FOR THIS INTERRUPT.
10000	>;TENX
10100		MOVE	TEMP,RUNNER
10200		IQW	TEMP
10300		MOVE	1,-1(P)
10400	VILOOP:	MOVE	TEMP,(1)
10500		IQW	TEMP
10600		AOBJN	1,VILOOP
10700		MOVEM	11,INTQWP(USER)
10800		SETOM	INTRPT
10900		SKIPN	7,INTPRC(USER)	;INTERRUPT PROCESS
11000		JRST	DF.X
11100		MOVEI	TEMP,1		;READY
11200		SKIPL	STATUS(7)
11300		MOVEM	TEMP,STATUS(7)
11400	DF.X:	SUB	P,X22
11500		JRST	@2(P)
11600	
11700	IQWOV:	ERR	<DRYROT IN INTMOD -- WRITER>
11800		JRST	DF.X
11900	
12000	HERE(DFRINT)
12100	NOTENX <
12200		PUSH	P,@DFRINF(USER)
12300	>;NOTENX
12400	TENX <
12500		PUSH	P,13		;PUSH AOBJN PTR, 3RD ARG TO INTMAP
12600	>;TENX
12700		PUSHJ	P,DFR1IN
12800		POPJ	P,
12900	
13000	
13100	
     

00100	COMMENT ⊗THE INTERRUPT PROCESS⊗
00200	
00300	
00400	DEFINE IQR(AC) <
00500		QR	(AC,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,<JRST QRERR>)
00600		>
00700	
00800	HERE(INTPRO)
00900		PUSH	P,RF
01000		PUSH	P,INPDA0
01100		PUSH	P,SP
01200		MOVE	USER,GOGTAB
01300	DO1INT:	MOVE	D,INTQRP(USER)	;READER OF THE QUEUE
01400		QR	(1,<INTQWP(USER)>,D,<INTQWT(USER)>,<INTQWB(USER)>,< JRST ALDCIS >);
01500	;ABOVE GETS LPC WORD ON TENEX, FOR IJBTPC
01600	NOTENX <
01700		IQR	6
01800		IQR	TEMP
01900		MOVEM	TEMP,IJBCNI(USER)
02000		IQR	TEMP
02100		MOVEM	TEMP,IJBTPC(USER)
02200	>;NOTENX
02300	TENX <
02400		MOVEM	1,IJBTPC(USER)
02500	>;TENX
02600		IQR	TEMP
02700		MOVEM	TEMP,IRUNNR(USER)
02800		IQR	B
02900	TENX <
03000		SUBI	B,1		;GROSS CROCK - FIND OUT WHY WORKS SOMEDAY
03100					;ACTUALLY FIND OUT WHY STANFORD WORKS WITHOUT
03200					;THE CROCK. SEEMS TO BE DISAGREEMENT BETWEEN
03300					;QUEUE WRITER AND READER AS TO WHETHER THE COUNT
03400					;WORD INCLUDES SELF OR NOT.
03500	>;TENX
03600		JUMPE	B,DISDFI
03700	DO1I.1:	
03800		IQR	C
03900		MOVEM	D,INTQRP(USER)
04000		SOJLE	B,DO1I.2
04100		PUSH	P,C
04200		JRST	DO1I.1
04300	DO1I.2:	HLRZ	D,C		
04400		CAIN	D,-1		;IS THIS A PDA
04500		JRST	DO1I.4		;NO -- JUST ISSUE THE CALL
04600		TLNN	C,-1		;WAS THERE A CONTEXT??
04700		JRST	DO1I.3		;NO
04800		MOVS	D,C		;PDA,,STATIC LINK
04900		HRRZ	TEMP,PD.PPD(C)	;PARENTS PDA
05000		PUSH	P,[ DO1INT]
05100		PUSH	P,RF
05200		HLRZ	LPSA,1(D)	;THE PDA IIN THE STACK
05300		CAIE	LPSA,TEMP	;BETTER BE THE SAME
05400		ERR	<ATTEMPT TO REFERENCE A NON-EX ENVIRONMENT IN INTPRO >
05500		PUSH	P,D		;STATIC LINK
05600		PUSH	P,SP		;SAVE SP
05700		HLRZ	C,PD.PPD	;END OF MKSEMT
05800		JRST	(C)
05900	DO1I.3:	HRRZ	C,PD.(C)	;ENTRY ADDRESS
06000	DO1I.4:	PUSHJ	P,(C)		;CALL THE PROCEDURE
06100		JRST	DO1INT
06200	
06300	ALDCIS:	MOVE	PB,RUNNER	;ALL DONE CURRENT INTERRUPTS
06400		SETZM	STATUS(PB)	;SUSPEND SELF
06500		PUSHJ	P,SPSRN1
06600		JRST	DO1INT
06700	
06800	QRERR: ERR	<DRYROT IN INTPRO -- READER>
06900		JRST 	ALDCIS
07000	
07100	
07200	DISDFI:	ERR	<STRANGENESS IN DEFERRED INTERRUPT>,1
07300		JRST	DO1INT
07400	
07500	DEFINE IPDE(X,V), < PUTINLOC(INTPDA+X,V) >
07600	
07700	INTPDA: BLOCK PD.XXX+1
07800	
07900		IPDE	(PD.,INTPRO)
08000		IPDE	(PD.DSW,3)
08100		IPDE	(PD.PDA,<<INPDA0: XWD INTPDA,0>>)
08200		IPDE	(PD.LLW,<INTPDA+PD.XXX>)
08300		IPDE	(PD.DLW,<INTPDA+PD.XXX>)
08400	
08500	
     

00100	
00200	
00300	;DFCPKT(5 WD BLOCK ADDR,EVTYP,EVNOT,OPTS)
00400	; CREATES A FIVE WORD BLOCK FOR A DEFERED CAUSE & RETURNS AN AOBJN 
00500	; POINTER TO THE BLOCK
00600	; IF THE SUPPLIED BASE ADDRESS IS ≠0 THEN USES THAT ADDRESS
00700	; OTHERWISE DOES A CORGET TO GET THE FIVE WORDS
00800	
00900	HERE(DFCPKT)
01000		SKIPE	B,-4(P)		;DID USER GIVE ME A BLOCK
01100		JRST	DFC.1		;YES
01200		MOVEI	C,5
01300		PUSHJ	P,CORGET
01400		ERR	<NO CORE LEFT>
01500	DFC.1:	HRLI	B,-5
01600		MOVE	A,B		;AOBJN PTR
01700		SUB	B,X11		;READY FOR PUSHES
01800		PUSH	B,[4]
01900		PUSH	B,-3(P)
02000		PUSH	B,-2(P)
02100		PUSH	B,-1(P)
02200		PUSH	B,[XWD -1,CAUSE]
02300		SUB	P,[XWD 5,5]
02400		JRST	@5(P)		;RETURN
02500	
     

00100	COMMENT ⊗ CAUSE ⊗
00200	
00300	HERE(CAUSE)
00400		MOVE	PB,RUNNER
00500		AOS	A,CAUSES(PB)
00600		CAIE	A,1		;FIRST CAUSE?
00700		JRST	DFRCS		;NO -DEFER IT
00800		POP	P,CAUSRA(PB)	;SAVE RETN ADDRESS
00900	CSIT:	PUSHJ	P,CAUSE1	;DO THE WORK
01000		MOVE	PB,RUNNER
01100		SOSG	A,CAUSES(PB)	;DONE ONE
01200		JRST	CSE.X		;ALL ARE DONE -- CHECK FOR SCHED REQ
01300		MOVEI	KL,CAUSEQ(PB)	;GET NEXT FROM QUEUE
01400		PUSHJ	P,REMCAR
01500		HLRZ	B,(A)		;PICK UP TYPE
01600		PUSH	P,B
01700		HRRZ	B,(A)		;NOTICE
01800		PUSH	P,B
01900		PUSH	P,1(A)		;OPTIONS
02000		MOVE	TABL,GOGTAB
02100		HRR	B,FP2(TABL)	;RELEASE 2 WD BLOCK
02200		HRRM	B,(A)
02300		HRRM	A,FP2(TABL)
02400		JRST	CSIT		;GO WORK ON THIS
02500	DFRCS:	MOVE	TABL,GOGTAB	;
02600		NNCLL2	(B)		;GET 2 WD CELL
02700		POP	P,TMP		;RETURN ADDRESS
02800		POP	P,1(B)		;OPTS
02900		POP	P,(B)		;NOTICE
03000		POP	P,A		;TYPE
03100		HRLM	A,(B)
03200		MOVEI	KL,CAUSEQ(KL)	;PUT ON CAUSE QUEUE
03300		PUSHJ	P,ITAILS	;PUT ON TAIL OF QUEUE
03400		JRST	(TMP)		;RETURN
03500	CSE.X:	MOVE	USER,GOGTAB
03600		SKIPN	SCHDRQ(USER)	;SCHEDULING REQUEST
03700		JRST	@CAUSRA(PB) 	;NO
03800		SETZM	SCHDRQ(USER)	;YES
03900		PUSH	P,CAUSRA(PB)	;YES
04000		JRST	URSCHD		;RESCHEDULE
04100	
     

00100	COMMENT ⊗CAUSE1 -- ROUTINE TO DO ACTUAL WORK ⊗
00200	
00300	HERE(CAUSE1)
00400	CSE1:	JSP	TMP,EVTCK3	;VERIFY THAT THIS IS AN EVENT ITEM
00500					;ALSO EVT ← DATUM ,B&C←ITEM #
00600		SKIPE	PDA,CAUSEP(EVT)	;DID THE USER SAY SOMETHING???
00700		JRST	USPPRC		;USER SPEC PROCEDURE
00800		MOVE	FF,-1(P)	;OPTIONS
00900		SKIPN	TMP,WAITLS(EVT)	;WAS ANYONE WAITING?
01000		JRST	SCA.2		;NO
01100		MOVE	TEMP,B		;EV TYP NO
01200		MOVE	TMP,(TMP)	;LAST,,FIRST
01300		MOVE	D,-2(P)		;NOTICE NO
01400	SCA.1:	MOVE	TMP,(TMP)	;WAIT ENTRY
01500		HLRZ	C,TMP		;PROCESS NO
01600		MOVE	TABL,GOGTAB	;SET TABL TO RIGHT THING
01700		PUSHJ	P,ANSWR1	;SPECIAL ENTRY POINT IN ANSWER
01800		TRNE	A,NOJOY		;DID WE SUCCEED??
01900		JRST	SCA.1A		;NO
02000		TRNN	A,RETAIN	;KEEP THE NOTICE??
02100		TRO	FF,DNTSAV	;YES
02200		TRNN	FF,TELLAL	;TELL THE WHOLE WORLD?
02300		JRST	SCA.2		;NO
02400	SCA.1A:	TRNE	TMP,-1		;ANY LEFT
02500		JRST	SCA.1		;YES
02600	
02700	SCA.2:	TRNE	FF,DNTSAV	;SAVE IT?
02800		JRST	SCA.3		;NO
02900		MOVE	B,-2(P)		;ITEM NO OF NOTICE
03000		MOVEI	KL,NOTCLS(EVT)	;
03100		PUSHJ	P,ITAILS	;PUT ON END OF NOTIICE LIST
03200	SCA.3:
03300		MOVE	USER,GOGTAB
03400		TRNE	FF,SCHDIT	;WANT TO RESCHEDULE
03500		SETOM	SCHDRQ(USER)	;RESCHEDULE REQUEST
03600	SCA.X:	SUB	P,X44		;RETURN
03700		JRST	@4(P)
03800	
03900	USPPRC:	MOVE	B,PD.(PDA)	;HERE IF USER SPECIFIED A PROCEDURE
04000	;;#NB# !TYPO -- WAS A TLNE
04100		TLNN	PDA,-1		;CONTEXT GIVEN
04200		JRST	(B)		;NO
04300		PUSH	P,RF		;SET UP CONTEXT
04400		HRRZ	C,PD.PPD	;PARENTS PDA
04500		MOVS	A,PDA		;
04600		HLRZ	D,1(A)
04700		CAME	D,C		;SAME?
04800		ERR 	<CONTEXT WRONG OR CLOBBERED IN INTERP CALL
04900	USER SPEC EVENT PROC >
05000		PUSH	P,A		;STATL
05100		PUSH	P,SP
05200		HLRZ	B,PD.PPD(PDA)
05300		JRST	(B)		;GO TO INSTR AFTER THE MKSEMT
05400	
     

00100	COMMENT ⊗ANSWER -- subroutine used by CAUSE⊗
00200	
00300	HERE(ANSWER)
00400	
00500	;A←ANSWER(EV!TYP,NOT,PROCESS!ITEM);
00600	;IF ATTEMPT TO ANSWER INTERROGATE IS SUCCESSFUL, A ← REQUEST CODE
00700	;OTHERWISE, NOJOY BIT IS ON IN A & REST OF WORD IS INVALID
00800	
00900		MOVE	TEMP,-3(P)	;EV TYPE
01000		POP	P,-3(P)		;RET ADRS
01100		POP	P,C		;PROCESS ITEM
01200		POP	P,D		;NOTICE
01300		MOVE	TABL,GOGTAB
01400		LDB	B,INFOTAB(TABL)
01500		CAIE	B,PRCTYP
01600		ERR	<NOT A PROCESS ITEM>
01700	
01800	;THE REST OF THIS IS CALLED INTERNALLY 
01900	;EXPECTS D= NOIICE, C=PROCESS ITEM, TEMP=EV TYPE
02000	;        ALSO TABL SET UP FOR PROCESS ITEM
02100	;MODIFIES A,B,C,TABL,PB,TEMP,USER
02200	
02300	ANSWR1:	MOVE	PB,@DATAB(TABL)	;THE PROCESS BASE
02400		TLNN	PB,TERM		;TERMINATED?
02500		SKIPE	STATUS(PB)	;OR NOT SUSPENDED??
02600		JRST	NOANS		;YES
02700		AOS	STATUS(PB)	;MAKE READY
02800		MOVEM	D,AC1(PB)
02900	ANSWR2:	PUSHJ	P,DELWRQ	;DELETE ALL WAIT REQUESTS
03000		MOVE	A,INTRGC(PB)	;THE INTERROG CONTROL WORD
03100		TRNN	A,SAYWCH	;ASKED FOR THE ASSOCIATION
03200		POPJ	P,		;NO
03300		PUSH	P,[EVTYPI]	;
03400		PUSH	P,D
03500		PUSH	P,TEMP
03600		PUSHJ	P,STACSV	;SAVE ALL ACS
03700		MOVEI	5,16		;MAKE
03800		PUSHJ	P,LEAP
03900		PUSHJ	P,STACRS	;GET ACS BACK
04000		POPJ	P,
04100	NOANS:	TRO	A,NOJOY
04200		POPJ	P,		;RETURN
     

00100	COMMENT ⊗DELWRQ -- delete all wait requests⊗
00200	
00300	;EXPECTS PB = THIS PROCESS
00400	;MANGLES A,B,C,TABL
00500	
00600	DELWRQ:	SKIPN	A,WAITES(PB)
00700		POPJ	P,
00800		PUSH	P,KL
00900		MOVE	A,(A)		;A IS LAST,,FIRST
01000	DTHSRQ:	MOVE	A,(A)		;NEXT ENTRY
01100		HLRZ	C,A		;ITEM NUMBER OF TYPE
01200		PUSH	P,A		;FOR SAFE KEEPING
01300		MOVE	TABL,GOGTAB	;
01400	GLOB <
01500	;;%BE%
01600		CAIL	C,GBRK		;GLOBAL ??
01700		MOVEI	TABL,GLUSER	;
01800	>;GLOB
01900		MOVE	A,@DATAB(TABL)
02000		MOVEI	KL,WAITLS(A)
02100		MOVE	B,PRCITM(PB)
02200		PUSHJ	P,DELTLE	;DELETE ELEMENT
02300					;SETS TABL BACK TO GOGTAB
02400					;(MAYBE)
02500		POP	P,A		
02600		TRNE	A,-1		;ANY LEFT
02700		JRST	DTHSRQ		;YES
02800		MOVE	A,WAITES(PB)
02900		MOVE	TABL,GOGTAB
03000		HLRZ	B,(A)		;ADDRESS OF LAST
03100		HRRZ	C,FP1(TABL)
03200		HRRM	C,(B)		;RELEASE THE LOT
03300		HRRM	A,FP1(TABL)
03400		SETZM	WAITES(PB)	;NONE LEFT
03500		POP	P,KL
03600		POPJ	P,
     

00100	COMMENT ⊗INTERROGATE⊗
00200	HERE(INTERROGATE)
00300		SKIPN	B,-2(P)		;SET OR ITEM
00400		ERR	<NULL INTERROGATION???>
00500		TLNN	B,-1		;SET?
00600		JRST	ASK1.0		;NO
00700		MOVEI	FF,MULTIN
00800		IORM	FF,-1(P)	;SAY MULT REQUEST
00900		MOVE	TMP,(B)		;LAST,,FIRST
01000	MPCI:	MOVE	TMP,(TMP)	;NEXT ENTRY
01100		HLRZ	B,TMP
01200		PUSH	P,TMP
01300		PUSH	P,B		;TYPE ITEM
01400		PUSH	P,-3(P)		;OPTIONS WORD
01500		PUSHJ	P,ASK1.0
01600		POP	P,TMP		;GET LIST BACK
01700		CAIE	A,NIC		;FIND ONE??
01800		JRST	ASK1.X		;YES
01900		TRNE	TMP,-1		;DONE LIST???
02000		JRST	MPCI		;NO
02100		MOVE	FF,-1(P)
02200		TRNN	FF,WAIT		;WAITING REQUESTED
02300		JRST	ASK1.X		;NO
02400		MOVE	PB,RUNNER	;SUSPEND SELF
02500		MOVE	B,-2(P)		;THE LIST
02600		MOVE	TMP,(B)		;LAST,,FIRST
02700	BWL:	MOVEI	KL,WAITES(PB)
02800		MOVE	TMP,(TMP)	;NEXT
02900		HLRZ	B,TMP		;ITEM NO
03000		MOVE	C,B
03100		MOVE	EVT,@DATM
03200		PUSHJ	P,ITAILS	;ON TAIL
03300		MOVE	B,PRCITM(PB)	;
03400		MOVEI	KL,WAITLS(EVT)
03500		PUSHJ	P,ITAILS	;ON EVENT WAIL LIST
03600		TRNE	TMP,-1
03700		JRST	BWL		;CDR DOWN LIST
03800		JRST	DOWAIT		;GO WAIT
     

00100	COMMENT ⊗ASK -- used by INTERROGATE⊗
00200	
00300	ASK1I:	MOVE	B,-2(P)
00400	ASK1.0:	JSP	TMP,EVTCKB	;GET DATUM OF EVENT TYPE
00500	;;#NB# ! WAS SKIPE A,...
00600		SKIPE	PDA,INTRGP(EVT)	;USER WAIT PROCESS??
00700		JRST	USPPRC		;YES
00800	;;# #! ASKNTC POINTS HERE
00900	ASKN:	MOVE	FF,-1(P)	;CONTROL WORD
01000		SKIPN	A,NOTCLS(EVT)	;ANY READY TO GO
01100		JRST	ASK1.4		;NO
01200		TRNE	FF,RETAIN	;RETAIN THIS ONE??
01300		JRST 	ASK1.1		;YES
01400		MOVEI	KL,NOTCLS(EVT)
01500		PUSHJ	P,REMCAR	;GET THE FIRST
01600		JRST	ASK1.2		;TEST SAYWCH
01700	ASK1.1:	MOVE	A,(A)
01800		HLRZ	A,(A)		;THI FIRST ITEM
01900	ASK1.2:	TRNN	FF,SAYWCH	;WANT ASSOCIATION
02000		JRST	ASK1.3		;NO
02100		PUSH	P,[EVTYPI]	;EVENT TYPE
02200		PUSH	P,A		;NOTICE
02300		PUSH	P,-4(P)		;WHATEVER TYPE IT IS
02400		PUSHJ	P,STACSV	;SAVE REGS
02500		MOVEI	5,16		;MAKE
02600		PUSHJ	P,LEAP
02700		PUSHJ	P,STACRS	;GET ACS BACK
02800	ASK1.3:
02900	ASK1.X:	SUB	P,X33
03000		JRST	@3(P)		;RETURN
03100	
03200	ASK1.4:	MOVEI	A,NIC
03300		TRNE	FF,WAIT		;IF NOT WAITING OR 
03400		TRNE	FF,MULTIN	;MUL REQ
03500		JRST	ASK1.X		;ALL DONE
03600		MOVE	PB,RUNNER
03700		MOVEI	KL,WAITES(PB)	;WAIT ON THIS ONE
03800		PUSHJ	P,ITAILS	;PUT ON TAIL
03900		MOVE	B,PRCITM(PB)
04000		MOVEI	KL,WAITLS(EVT)
04100		PUSHJ	P,ITAILS
04200	DOWAIT:	SETZM	STATUS(PB)
04300		MOVEM	FF,INTRGC(PB)
04400		MOVEI	A,WAITNG
04500		MOVEM	A,REASON(PB)
04600		PUSHJ	P,SPSRN2	;WAIT
04700		JRST	ASK1.X		;RETURN
04800	
04900	HERE(ASKNTC)
05000	;;#NC# ! WAS A PUSHJ
05100		JSP  	TMP,EVTCK3	;CHECK EVENT TYPE
05200		JRST	ASKN		;GO DO IT
05300	
05400	;ROUTINE TO SET UP EVENT TYPE ITEM
05500	;SETS B & C TO ITEM #
05600	;SETS EVT TO DATUM
05700	;SETS TABL TO RIGHT THING FOR ITEM
05800	;CALLED VIA JSP TMP,EVTCKX
05900	
06000	
06100	EVTCK3:	SKIPA	B,-3(P)
06200	EVTCK2:	MOVE	B,-2(P)
06300	EVTCKB:	MOVE	TABL,GOGTAB
06400		MOVE	C,B
06500	GLOB <
06600	;;%BE% allow for global items RHT 1-8-74
06700		CAIL	C,GBRK		;IS THE ITEM GLOBAL
06800		MOVEI	TABL,GLUSER	;YES, USE GLOBAL INFO STUFF
06900	>;GLOB
07000		LDB	A,INFOTAB(TABL)
07100		CAIE	A,EVTTYP
07200		ERR	<THIS ITEM IS NOT AN EVENT TYPE>,6
07300		MOVE	EVT,@DATAB(TABL)
07400	GLOB <
07500	;;%BE% real hack for now, only the item gets to be global.
07600		MOVE	TABL,GOGTAB
07700	>;GLOB
07800		JRST	(TMP)
     

00100	COMMENT ⊗MKEVTT,SETCP,& SETIP⊗
00200	HERE(SETCP)
00300		JSP	TMP,EVTCK2
00400		MOVE	A,-1(P)
00500		MOVEM	A,CAUSEP(EVT)
00600	XIT3:	SUB	P,X33
00700		JRST	@3(P)
00800	
00900	
01000	HERE(SETIP)
01100		JSP	TMP,EVTCK2
01200		MOVE	A,-1(P)
01300		MOVEM	A,INTRGP(EVT)
01400		JRST	XIT3
01500	
01600	HERE(MKEVTT)	;MAKE EVENT TYPE
01700		MOVE	C,-1(P)
01800		MOVEI	A,EVTTYP
01900		MOVE	TABL,GOGTAB
02000		DPB	A,INFOTAB(TABL)
02100		MOVEI	C,NEVARS
02200		PUSHJ	P,CORGET
02300		ERR	<NO CORE LEFT -- MKEVT>
02400		MOVE	C,-1(P)
02500		MOVE	TABL,GOGTAB
02600		MOVEM	B,@DATAB(TABL)
02700		HRLI	D,(B)
02800		HRRI	D,1(B)
02900		SETZM	(B)
03000		BLT	D,NEVARS-1(B)
03100		SUB	P,X22
03200		JRST	@2(P)
03300	
     

00100	COMMENT ⊗SPARE HERE TABLE ENTRIES⊗
00200	
00300	;THE IDEA IS THAT THIS WAY WE HAVE FLEXIBILITY 
00400	;WITHOUT GOING TO A NEW SEGMENT ALL THE TIME
00500	
00600	HERE(NWLD1)
00700	HERE(NWLD2)
00800	HERE(NWLD3)
00900	HERE(NWLD4)
01000	HERE(NWLD5)
01100		ERR <DRYROT IN NWORLD>
01200	
01300	BEND PROCSS
01400	
01500	ENDCOM(PRC)
01600	
     

00100	COMPIL(IRP,,,,,,DUMMYFORGDSCISS)
00200	NOTENX <
00300	DEFINE IENS1 < INTTBL,INTMOD,ENABLE,DISABLE,INTMAP>
00400	>;NOTENX
00500	TENX <
00600	DEFINE IENS1 < INTTBL,ENABLE,DISABLE,ATI,DTI,INTMAP,EINTA>
00700	>;TENX
00800	DEFINE IEXT1 < GOGTAB,INTRPT,X22,CORGET >
00900	
01000	IFN APRISW <
01100	DEFINE XJBCNI <JOBCNI>
01200	DEFINE XJBTPC <JOBTPC>
01300	DEFINE XJBAPR <JOBAPR>
01400	DEFINE IEXT5 <JOBCNI,JOBTPC,JOBAPR,XJBENB,APRACS>
01500	IFN ALWAYS <
01600	EXTERN JOBCNI,JOBTPC,JOBAPR	;THESE ARE ALWAYS EXTERNAL
01700	>;IFN ALWAYS
01800	>;IFN APRISW
01900	IFE APRISW <
02000	DEFINE IEXT5 <XJBCNI,XJBTPC,XJBAPR,JOBINT>
02100	IFN ALWAYS <
02200	EXTERNAL JOBINT ;THIS FELLOW IS ALWAYS EXTERNAL
02300	>;IFN ALWAYS
02400	>;IFE APRISW
02500	
02600	COMPXX(IRP,< IENS1 >,< IEXT1,IEXT5 >
02700			,<INTERRUPT STUFF>,,HIIFPOSSIB)
02800	
02900	BEGIN IRPPKG
03000	
03100	INTDBG←←0
03200	
03300	NOTENX<
03400	IFE APRISW <
03500	
03600	IFE INTDBG <
03700	OPDEF DISMIS [ CALLI 400024]
03800	>;IFE INTDBG
03900	IFN INTDBG <
04000	DEFINE DISMIS < JRST DSMMSR >
04100	DSMMSR:
04200		HRLZI	P,INACS
04300		BLT	P,P
04400		JRST	@JOBTPC
04500	INACS:	BLOCK 	20
04600	>;IFN ITDBG
04700	OPDEF INTORM [ CALLI 400026]
04800	OPDEF INTACM [ CALLI 400027]
04900	OPDEF INTENB [ CALLI 400025]
05000	>;IFE APRISW
05100	
05200	IFN APRISW <
05300	OPDEF APRENB [ CALLI 16]
05400	DEFINE DISMIS < JRST DSMSSR >
05500	DSMSSR:	HRLZI	17,APRACS
05600		BLT	17,17	;BLT BACK ALL ACS
05700		JRST	@XJBTPC
05800	>;IFN APRISW
05900	>;NOTENX
06000	
     

00100	HERE(INTTBL)
00200	;CALL IS INTTBL(BUFFER!SIZE)
00300	;SETS UP TABLES NEEDED BY THE INTERRUPT SYSTEM
00400	;ON TENEX, SEE DFEINT FOR OTHER TABLES OMITTED HERE
00500	
00600		MOVE	USER,GOGTAB	;
00700	INTTB1:
00800	NOTENX <
00900		MOVEI	C,=110
01000		ADD	C,-1(P)
01100	>;NOTENX
01200	TENX <
01300		MOVE	C,-1(P)
01400	>;TENX
01500		PUSHJ	P,CORGET
01600		ERR <NOT ENOUGH SPACE FOR INTSET>
01700	NOTENX <
01800		SKIPN	D,DISPAT(USER)	;ALREADY HABE ONE?
01900		JRST	INTTB2		;NO
02000		MOVSS	D		
02100		HRR	D,B		;D ← OLD,,NEW
02200		BLT	D,=71(B)	;COPY OLD DISPAT TABLE
02300		JRST	INTTB3
02400	INTTB2:	SETZM	(B)
02500		HRL	A,B
02600		HRRI	A,1(B)
02700		ADDI	C,-1(B)
02800		BLT	A,(C)
02900	INTTB3:	HRLI	B,10
03000		MOVEM	B,DISPAT(USER)
03100		ADDI	B,=36
03200		MOVEM	B,DFRINF(USER)
03300		ADDI	B,=36
03400	>;NOTENX
03500		HRRZM	B,INTQWB(USER)
03600		HRRZM	B,INTQWP(USER)
03700		HRRZM	B,INTQRP(USER)
03800		ADD	B,-1(P)
03900		HRRZM	B,INTQWT(USER)
04000	NOTENX <
04100		HRLI	B,-20
04200		MOVEM	B,IPDP(USER)
04300		ADD	B,[XWD -10,20]
04400		MOVEM	B,ISPDP(USER)
04500	>;NOTENX
04600		SUB	P,X22
04700		JRST 	@2(P)
04800	
04900	
05000	
05100	
05200	NOTENX <
05300	;AGAIN SEE DFEINT FOR TENEX EQUIVALENT OF FOLLOWING STUFF.
05400	IFN INTDBG,<
05500	INTAPR:	MOVEM	P,INACS+17
05600		MOVEI	P,INACS
05700		BLT	P,INACS+16
05800	>;IFN INTDBG
05900	
06000	HERE(INTMOD)
06100	IFN APRISW <
06200		MOVEM	17,APRACS+17
06300		MOVEI	17,APRACS
06400		BLT	17,APRACS+16	;SAVE THE ACS
06500	>;IFN APRISW
06600		MOVE	USER,GOGTAB
06700		MOVE	7,XJBCNI	;PICK UP THE BITS
06800	IFN APRISW <			
06900		ANDI	7,235110	;BE SURE LEGIT BITS ONLY
07000	>;IFN APRISW
07100		MOVE	P,IPDP(USER)	;A PDL FOR THIS
07200		MOVE	SP,ISPDP(USER)	;A STRING PDL
07300	DSPIT:	JFFO	7,DODISP	;DISPATCH INDEX
07400		ERR	<DRYROT: INTMOD>
07500	DODISP:
07600		SKIPN	7,@DISPAT(USER)	;GO DISPATCH
07700		DISMIS			;DISMISS
07800		PUSHJ	P,(7)		;
07900		DISMIS
08000	>;NOTENX
08100	
     

00100	COMMENT ⊗PROCEDURES TO ENABLE FOR INTERRUPTS⊗
00200	
00300	;ENABLE(INDEX) -- DOES AN INTORM, OR AIC ON TENEX
00400	;DISABLE(INDEX) -- DOES AN INTACM, OR DIC ON TENEX
00500	
00600	NOTENX <
00700	IFE APRISW <
00800	HERE(ENABLE)
00900		SKIPA	B,[ INTORM A, ]
01000	HERE(DISABLE)
01100		MOVE	B,[ INTACM A, ]
01200		MOVN	C,-1(P)
01300		HRLZI	A,400000
01400		LSH	A,(C)
01500		XCT	B
01600		SUB	P,X22
01700		JRST	@2(P)
01800	>;IFE APRISW
01900	IFN APRISW <
02000	HERE(ENABLE)
02100		SKIPA	B,[OR A,XJBENB]
02200	HERE(DISABLE)
02300		MOVE	B,[ANDCA A,XJBENB]
02400		MOVN	C,-1(P)		;
02500		HRLZI	A,400000
02600		LSH	A,(C)		;THE BIT
02700	EXPO <
02800		TRO	A,400000	;REPETITIVE ENABLE (THIS MIGHT GET YOU
02900					;IN TROUBLE WITH THE CLOCK INTERRUPT)
03000	>;EXPO
03100		XCT	B
03200		MOVEM	A,XJBENB	;REMEMBER
03300		APRENB	A,
03400		SUB	P,X22
03500		JRST	@2(P)
03600	>;IFN APRISW
03700	>;NOTENX
03800	TENX <
03900	HERE(ENABLE)
04000		SKIPA C,AIC1
04100	HERE(DISABLE)
04200		MOVE C,DIC1
04300		MOVN A,-1(P)
04400		HRLZI B,400000
04500		LSH B,(A)
04600		HRRZI A,400000	;Fork handle for 'this fork'
04700		XCT C
04800		SUB P,X22
04900		JRST @2(P)
05000	
05100	AIC1:	JSYS	AIC
05200	DIC1:	JSYS	DIC
05300	
05400	HERE(DTI)
05500		HRRZ	A,-1(P)		;CHARACTER TO DE-ACTIVATE
05600		JUMPL	A,DTIERR
05700		CAILE	A,=35
05800	DTIERR:	  ERR 	<DTI:  Terminal interrupt code not in range>
05900		JSYS	DTI
06000		SUB	P,X22
06100		JRST	@2(P)
06200	
06300	
06400	HERE(ATI)
06500		HRRZ	B,-2(P)		;1ST ARG IS "TERMINAL INTERRUPT CODE"
06600		JUMPL	B,.+2		;31-35 UNUSED, 0 IS BREAK OR ↑@
06700		 CAILE	B,=35		;OTHERS OUT OF RANGE
06800		 ERR	<ATI: Terminal Interrupt Code not in range>,1
06900		MOVE	A,-1(P)		;2nd arg is interrupt channel, 0-35
07000		JUMPL	A,BADCHN
07100		CAILE	A,=35
07200		 JRST	BADCHN
07300		CAIGE	A,=24
07400		 CAIG	A,=5
07500		SKIPA
07600	BADCHN:	 ERR	<ATI: Term. Intrpt. Chnl. not 0-5 or 24-35 dec.>,1
07700		HRL	A,B		;MAKE XWD TERMINAL CODE, CHANNEL NUMBER
07800		JSYS	ATI
07900		SUB	P,X33
08000		JRST	@3(P)
08100	
08200	ATI1:	JSYS	ATI
08300	DTI1:	JSYS	DTI
08400	
08500	;To arm a keybd interrupt on TENEX you must do the ATI in addition
08600	;to the regular stuff (INTMAP's & ENABLE's) because any channel which
08700	;can take a keybd interrupt (namely 0-5 and 24-35) can take any
08800	;interrupt character so you must declare.
08900	>;TENX
09000	
09100	;INTMAP(INDEX,ENTRY!ADDR,PARAM);
09200	NOTENX <
09300	;DISPAT[INDEX]←ENTRY!ADDR
09400	;DFRINF[INDEX]←PARAM
09500	
09600	HERE(INTMAP)
09700	
09800	IFE APRISW <
09900		MOVEI	A,XJBCNI
10000		MOVEM	A,JOBINT
10100	>;IFE APRISW
10200	
10300	IFE INTDBG,<
10400		MOVEI	A,INTMOD
10500	>;IFE INTDBG
10600	IFN INTDBG,<
10700		MOVEI	A,INTAPR
10800	>;IFN INTDBG
10900		MOVEM	A,XJBAPR
11000		MOVE	USER,GOGTAB
11100		SKIPE	DISPAT(USER)
11200		JRST	.+3
11300		PUSH	P,[=128]
11400		PUSHJ	P,INTTB1	;GET MINIMAL TABLES
11500		MOVE	10,-3(P)	;GET INDEX
11600		POP	P,-3(P)		;RET ADR
11700		POP	P,@DFRINF(USER)
11800		POP	P,@DISPAT(USER)
11900		POPJ	P,
12000	>;NOTENX
12100	TENX <
12200	HERE(INTMAP)
12300		HRRZI	A,400000
12400		JSYS	RIR
12500		JUMPE	2,[MOVE	2,[XWD	LEVTAB,CHNTAB]
12600			   JSYS SIR
12700			   JRST .+1]
12800		JSYS	EIR		;ENABLE INTERRUPT SYSTEM IN GENERAL
12900		SKIPL	A,-3(P)		;CHNL
13000		CAILE	A,=35
13100		 ERR	<INTMAP: Channel # not between 0 and 35 dec.>
13200	
13300	
13400	
13500	;The CHNL'th word of the actual TENEX channel table gets the value
13600	;	LVL,,jmpchn-slot		The LVL is the interrupt level. The
13700	;dispatch is to the parallel entry of JMPCHN, a table of 3-word slots,
13800	;one per channel, addressed by the XX var JMPCHN, each of which
13900	;looks like this if the channel is in use:
14000	;	JSA USER,EINT<N>
14100	;	Ptr to simple-procedure		;POPJ'D TO IN EINTA
14200	;	AOBJN ptr for calling block
14300	;
14400	;The EINTn is EINT1, EINT2,  or EINT3, depending on the level of
14500	;the interrupt. INTMAP always initializes an interrupt to level 3,
14600	;i.e. EINT3, but in the future a subr may be provided to change the level
14700	;after the INTMAP is done (or perhaps an argument to INTMAP).
14800	;The three EINT's all immediately jrst to EINTA, but each must have
14900	;its own return vector for reentrancy's sake.
15000	
15100		ADDI	2,(A)		;2 pts to CHNTAB slot.
15200		IMULI	A,3
15300		ADDI	A,JMPCHN	;A pts to JMPCHN slot.
15400		HRLI	A,3		;Level 3 assumed.
15500		MOVEM	A,(2)		;CHNTAB[chnl]←level3,,JMPCHN[3*chnl]
15600		POP	P,-3(P)		;Return goes over 1st arg (chnl)
15700		POP	P,2(A)		;3rd INTMAP arg, AOBJN ptr, to 3rd
15800					;word of JMPCHN slot. DFRINT uses it.
15900		POP	P,1(A)		;2nd JMPCHN wrd gets XWD unused,user's simple
16000					;procedure. Goes onto stack and is POPJ'd to.
16100		MOVE	B,[JSA	USER,EINT3]	;Level 3 assumed.
16200		MOVEM	B,(A)	;1st JMPCHN slot word.
16300		POPJ	P,
16400	
16500	
16600	
16700	
16800	
16900	
17000	;EINT1, EINT2, and EINT3 are in the XX table since they get JSA'd to.
17100	;Each immediately JRST's to EINTA so that all share the code thru the
17200	;DEBRK in EINTR. Note that the TENEX DEBRK call is the normal way to
17300	;leave interrupt level whether continuing normally or forcing continuation
17400	;at a specified place (this is different than Stanford's DEBRK call).
17500	;The following code saves all accumulators because that's what the DEC 
17600	;monitor does and any other solution would have destroyed all semblance of
17700	;compatibility between DECUS or Stanford SAIL and TENEX SAIL.
17800	;Note however that the work of saving AC's has to be done somewhere
17900	;if you are going to run SAIL code at interrupt level; and if you want to
18000	;hack a very fast interrupt in machine language you can easily do it yourself
18100	;by using RIR to find the channel table and so on.
18200	;
18300	;A few more stack words than are really necessary are covered by the
18400	;ADD P,[XWD 21,21] deliberately, in order to leave some room in case the
18500	;interrupted code was not observing stack discipline religiously, because
18600	;it is fairly common in the SAIL system to see routines end with sequences like:
18700	;	SUB	P,X44
18800	;	JRST	4(P)
18900	;
19000	;One non-obvious trick here is that the BLT's which save and restore ac's 
19100	;save and restore a clobbered value of USER, because the value of USER which
19200	;prevailed in the nterrupted code is saved by the JSA/JRA pair around the
19300	;whole mess. Finally it may be helpful to note that at the point just before
19400	;EINTR, i.e. the POPJ, the top of the stack contains:
19500	;0(P)		USERCODE	;addr. of his simple procedure, so that we
19600					;"call" it with POPJ
19700	;-1(P)		AOBJN ptr	;to the "calling block" parameters to his code
19800	;-2(P)		EINTR		;Fake return so his stuff returns to us.
19900	
20000	;We also save 40 for reentrancy since his simple procedure may
20100	;use compiler-emitted UUO's like any other code and thus clobber UUO's in
20200	;progres in the interrupted code (obviously).
20300	
20400	HERE(EINTA)
20500		ADD	P,[XWD 23,23]
20600		TLNN	P,400000	;TEST FOR PDL OVERFLOW
20700		  ERR	<EINTA:  PDL overflow>
20800		MOVEM	16,0(P)
20900		HRRZI	16,-15(P)
21000		BLT	16,-1(P)
21100		MOVE	16,0(P)
21200		PUSH	P,40
21300		PUSH	P,1(USER)	;AOBJN PTR
21400		PUSH	P,[EINTR]	;FAKE RETURN TO REGAIN CONTROL FROM USERCODE
21500		PUSH	P,(USER)	;USERCODE
21600		MOVE	USER,GOGTAB
21700		POPJ	P,		;GO OFF TO RUN HIS STUFF AT INTERRUPT LEVEL
21800	
21900	;IT RETURNS HERE BY VIRTUE OF FAKE RETURN WORD
22000	EINTR:	POP	P,40
22100		HRLZI	16,-15(P)
22200		BLT	16,15
22300		MOVE	16,0(P)
22400		SUB	P,[XWD 23,23]
22500		JRA	USER,.+1
22600		JSYS	DEBRK		;BACK TO INTERRUPTED CODE
22700	>;TENX
22800	
22900	HERE(IRPSP1)
23000	HERE(IRPSP2)
23100	HERE(IRPSP3)
23200	
23300	BEND IRPPKG
23400	
23500	ENDCOM(IRP)
23600	
     

00100	
00200	
00300	
00400