;<135-TENEX>SCHED.MAC;343    17-DEC-75 12:12:00    EDIT BY ALLEN
; PROTECT AGAINST RE-ENTERING SCHEDULER BY ACCIDENT
;<ALLEN>SCHED.MAC;5     4-NOV-75 11:45:51    EDIT BY ALLEN
; FIX ERROR IN ASSFK LEADING TO NCP BUFFER SCREWUPS
;<134-TENEX>SCHED.MAC;339    30-SEP-75 10:29:30    EDIT BY ALLEN
;<134-TENEX>SCHED.MAC;338    26-SEP-75 16:27:31    EDIT BY ALLEN
; DO SIMPLE INSERT ON PLACING FORK ON COMPQ, RATHER THAN RESORTING
;<134-TENEX>SCHED.MAC;337    14-AUG-75 16:34:29    EDIT BY ALLEN
; AVOID LOCKUP IF BSYS OR SOME SUCH USER CODE UNLOCKS A DIRECTORY
; OR SUB-INDEX LOCK ON WHICH A CONFLICT HAS OCCURRED
;<134-TENEX>SCHED.MAC;336     5-AUG-75 11:38:26    EDIT BY CLEMENTS
; CHANGE TAGS P1 AND P2 TO BE PATCH1, PATCH2, TO AVOID CONFLICT WITH
; NEW ACCUMULATOR NAMES
;<134-TENEX>SCHED.MAC;335    12-JUN-75 15:18:53    EDIT BY ALLEN
; MINOR FIXES
;<134-TENEX>NSCHED.MAC;21    11-JUN-75 10:13:27    EDIT BY ALLEN
; FIX TO RESORT
;<134-TENEX>NSCHED.MAC;20    10-JUN-75 13:11:13    EDIT BY ALLEN
; LIST ROUTINES ARE NOW SUBROUTINES AGAIN INSTEAD OF MACROS
; FIX NECESSITY TO RESKED ON RELHIQ
;<134-TENEX>SCHED.MAC;334     4-JUN-75 13:09:12    EDIT BY ALLEN
; MORE FIXES TO NEW REGULATOR
;<134-TENEX>SCHED.MAC;332     3-JUN-75 15:59:55    EDIT BY ALLEN
; VARIOUS FIXES TO NEW REGULATOR
;<134-TENEX>NSCHED.MAC;13     3-JUN-75 11:27:03    EDIT BY ALLEN
; MINOR FIXES TO SPECIAL SCHEDULING FOR LOCKERS TO AVOID RESPONSE
; PROBLEMS AFTER CLEARING LOCK
;<134-TENEX>NSCHED.MAC;10    20-MAY-75 21:36:47    EDIT BY ALLEN
;<134-TENEX>NSCHED.MAC;9    20-MAY-75 16:49:14    EDIT BY ALLEN
; PARAMETERIZE UTILIZATION AVERAGE TIME CONSTANT
;<134-TENEX>NSCHED.MAC;8    20-MAY-75 16:23:57    EDIT BY ALLEN
; SHORTEN UTILIZATION AVERAGE TIME CONSTANT TO ABOUT
; 4 SECONDS
;<134-TENEX>NSCHED.MAC;7    20-MAY-75 08:26:17    EDIT BY ALLEN
;<134-TENEX>NSCHED.MAC;6    19-MAY-75 17:24:28    EDIT BY ALLEN
; REVISED PIE-SLICE REGULATOR
;<134-TENEX>SCHED.MAC;331    15-MAY-75 08:24:44    EDIT BY TOMLINSON
;<134-TENEX>SCHED.MAC;330    15-MAY-75 08:17:05    EDIT BY TOMLINSON
;<134-TENEX>SCHED.MAC;329    15-MAY-75 08:06:02    EDIT BY TOMLINSON
; ADDED CALL TO TNTCHK IN SCHEDULER
;<134-TENEX>SCHED.MAC;328     2-MAY-75 18:14:13    EDIT BY CLEMENTS
; INTERNED TTPSR1. XLISTED JTDVC1.
;<134-TENEX>SCHED.MAC;327    28-APR-75 12:10:32    EDIT BY CLEMENTS
;<134-TENEX>SCHED.MAC;326    14-APR-75 13:40:38    EDIT BY ALLEN
;<134-TENEX>SCHED.MAC;325    14-APR-75 13:28:24    EDIT BY ALLEN
;<134-TENEX>SCHED.MAC;324    11-APR-75 18:28:29    EDIT BY ALLEN
; FIXES TO NEW SPECIAL SCHEDULING FOR LOCKERS
;<134-TENEX>SCHED.MAC;323    10-APR-75 22:03:08    EDIT BY ALLEN
; REVISED HANDLING OF HIGH PRIORITY FOR LOCKERS
;<134-TENEX>SCHED.MAC;320     8-APR-75 23:44:35    EDIT BY ALLEN
; ADD SPECIAL SCHEDULING QUEUE. REDUCE BEHIND SCHED QUANTUM
;<134-TENEX>SCHED.MAC;318    12-MAR-75 13:08:18    EDIT BY PLUMMER
; CALLS TO ROUTINES IN SIGNAL.MAC
;<134-TENEX>SCHED.MAC;317    25-FEB-75 14:26:47    EDIT BY CLEMENTS
; MOVE DEFINITION OF MAXQ UP BEFORE USE OF IT TO AVOID PASS1 "V" ERRS
;<134-TENEX>SCHED.MAC;316    14-FEB-75 17:51:40    EDIT BY OPERATOR
; FIX BUG IN PSSKD2 LEADING TO LONG QUANTA ON Q0
;<134-TENEX>SCHED.MAC;315     5-FEB-75 15:32:43    EDIT BY ALLEN
;<134-TENEX>SCHED.MAC;314     4-FEB-75 20:07:02    EDIT BY ALLEN
; VARIOUS FIXES TO NEW LIST STUFF
;<134-TENEX>SCHED.MAC;313     4-FEB-75 12:56:11    EDIT BY ALLEN
;<134-TENEX>SCHED.MAC;312     4-FEB-75 12:30:10    EDIT BY ALLEN
; REORGANIZE LIST MANIPULATION STUFF
;<134-TENEX>SCHED.MAC;310    30-JAN-75 15:00:04    EDIT BY ALLEN
;DETAIL CHANGES TO NEW WAITLIST STUFF
;<134-TENEX>SCHED.MAC;309    30-JAN-75 00:12:03    EDIT BY ALLEN
; PLACE FORK DIRECTLY ON RUNLIST IN ASSFK
;<134-TENEX>SCHED.MAC;308    29-JAN-75 23:24:05    EDIT BY ALLEN
; WAITLST NOW DOUBLE LINKED LIST. FORK ON WAITLIST NOW INDICATED
;BY PRESENCE OF WTLS BIT IN FKFLGS, NOT LH(FKPT)=WTLST.
;NEW ROUTINE, 'PRWAKE', TRANSPARENT TO ACS, TAKES FORKX IN AC7
;AND AWAKENS SAID FORK.
;<134-TENEX>SCHED.MAC;301    17-JAN-75 15:12:30    EDIT BY ALLEN
; CORRECT NON-TRANSPARENCY OF HIQ
;<134-TENEX>SCHED.MAC;300    16-JAN-75 12:17:57    EDIT BY ALLEN
; NEWST HIQ'S UNCONDITIONALLY IF WAKEUP FROM TCI OR TCOTST
;FIX ERROR IN INCREMENTING NAPROC IN WTSCAN
;<134-TENEX>SCHED.MAC;299    12-JAN-75 21:17:14    EDIT BY ALLEN
; CORRECT RADIX ERROR IN CHGQ
;<134-TENEX>SCHED.MAC;298    10-JAN-75 11:54:28    EDIT BY ALLEN
; ADD HIQ ROUTINE FOR PIE-SLICE SCHEDULER
; PIE-SLICE PSSKD2 NOW HI-QUEUES
;<134-TENEX>SCHED.MAC;297    10-JAN-75 11:08:34    EDIT BY ALLEN
; HI-Q THE NCP ON WAKEUP
;<133-TENEX>SCHED.MAC;295    21-DEC-74 11:47:52    EDIT BY ALLEN
; MOVE CHKWT ROUTINE TO SCHED. UNDO PREVIOUS DUMB CHANGE I.E.
; DISMT IS NOW A LOCAL AGAIN.
;<133-TENEX>SCHED.MAC;294    19-DEC-74 17:53:04    EDIT BY ALLEN
; MAKE DISMT A GLOBAL
;<133-TENEX>SCHED.MAC;293    19-DEC-74 13:29:48    EDIT BY ALLEN
; REMOVED INIT OF PIEGRP TABLE TO -1
;<133-TENEX>SCHED.MAC;292    16-DEC-74 14:06:41    EDIT BY ALLEN
; MAKE NEWFKF A GLOBAL
;<133-TENEX>SCHED.MAC;291    11-DEC-74 16:58:17    EDIT BY ALLEN
; TREAT DDMP SAME AS NCP WITH RESPECT TO SCHEDULING
;<133-TENEX>SCHED.MAC;290    10-DEC-74 10:52:04    EDIT BY ALLEN
; INITIALIZE PIEGRP TO -1
;<133-TENEX>SCHED.MAC;289     9-DEC-74 19:32:16    EDIT BY ALLEN
; FIX BUG IN RMPROC UNCOVERED BY CHANGE TO MAXBSH LOGIC
;<133-TENEX>SCHED.MAC;288     9-DEC-74 13:21:11    EDIT BY ALLEN
; HOLD FORK IN BALSET FOR MAXBSH IF PREVIOUS DISMISS WAS OF DURATION
; NOT GREATER THAN MAXBSH
;<133-TENEX>SCHED.MAC;287    12-NOV-74 16:35:41    EDIT BY CLEMENTS
;<133-TENEX>SCHED.MAC;286     5-NOV-74 17:09:36    EDIT BY CLEMENTS
; PART OF CRJOB JSYS
;<133-TENEX>SCHED.MAC;285     1-NOV-74 13:37:28    EDIT BY ALLEN
; REMOVE UNNECESSARY GCCORS IN BKGND
;<133-TENEX>SCHED.MAC;284    29-OCT-74 16:56:28    EDIT BY PLUMMER
; RTISW CONDITIONS CALL TO GCCOR
;<133-TENEX>SCHED.MAC;283    18-OCT-74 09:11:20    EDIT BY BTHOMAS
; FIX JTENQ AND FRZPSI TO CALL ENSKED IN CORRECT PLACE
;<133-TENEX>SCHED.MAC;282    11-OCT-74 16:13:33    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;281     8-OCT-74 16:16:47    EDIT BY ALLEN
; TEST FOR VALID UNDERFLOW AT AVERG2+1
;<133-TENEX>SCHED.MAC;280     8-OCT-74 10:18:53    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;279     7-OCT-74 17:40:25    EDIT BY ALLEN
; PIE-SLICE SCHEDULER QUANTA SCALED BY TARGET
; UTILIZATION. PERIODIC SCAN OF AHEAD SCHEDULE QUEUE
;DONE TO DISCOVER NOW-BEHIND-SCHEDULE PROCESSES.
;<133-TENEX>SCHED.MAC;274    25-SEP-74 20:17:05    EDIT BY CLEMENTS
; MISSING CONDITIONAL ON PIESLC CODE FIXED
;<133-TENEX>SCHED.MAC;273    25-SEP-74 14:03:24    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;272    25-SEP-74 13:36:22    EDIT BY ALLEN
; UNLOCK GRPLOK AT HLTFK1 FOR PIE-SLICE SYSTEM
;<133-TENEX>SCHED.MAC;271    24-SEP-74 17:06:07    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;270    24-SEP-74 16:45:20    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;268    20-SEP-74 20:40:58    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;267    20-SEP-74 20:24:43    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;266    19-SEP-74 17:21:14    EDIT BY ALLEN
; VARIOUS PIE-SLICE REPAIRS AND ADDITION TO LOCK COLLISION LOGIC
; TO AVOID POSSIBLE DEADLOCK
;<133-TENEX>SCHED.MAC;264    16-SEP-74 20:04:35    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;263    16-SEP-74 19:34:37    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;262     5-SEP-74 15:27:24    EDIT BY ALLEN
; ADD ROUTINE FOR UNLOCKING LOCKS ON WHICH CONFLICT HAS OCCURRED
;<133-TENEX>SCHED.MAC;261     1-AUG-74 11:43:49    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;260     1-AUG-74 10:46:42    EDIT BY ALLEN
; MORE EFFICIENT HANDLING OF COLLISIONS ON NON-RESIDENT LOCKS
;<133-TENEX>SCHED.MAC;258    22-JUL-74 14:42:37    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;257    22-JUL-74 10:29:09    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;256    19-JUL-74 17:04:40    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;255    18-JUL-74 16:23:02    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;254    18-JUL-74 16:17:32    EDIT BY ALLEN
; ADD CODE FOR PIE-SLICE SCHEDULER REGULATOR
;<133-TENEX>SCHED.MAC;242    16-JUL-74 17:00:19    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;241    16-JUL-74 16:39:43    EDIT BY ALLEN
;<133-TENEX>SCHED.MAC;232    12-JUL-74 11:06:58    EDIT BY ALLEN
; CORRECT BLUNDER IN SCDRUN CAUSING OVERLOADING OF BALSET
;<133-TENEX>SCHED.MAC;231    10-JUL-74 11:26:12    EDIT BY ALLEN
; ELIMINATE RACE AT SCHED4, ELIMINATE RESCHEDULE ON CHAR ARRIVAL
; AND TEST FOR PENDING BALSET REMOVAL IN RMPROC
;<TENEX-132>SCHED.MAC;230    17-JUN-74 20:19:37    EDIT BY ALLEN
; CORRECT BUG IN MAINTENANCE OF OLDSUM


	SEARCH PROLOG
	TITLE SCHED

;TENEX SCHEDULER - D. MURPHY

;LINKAGE TO OTHER PARTS OF MON -- PAGEM AND PISRV

EXTERN ASSPT,BUGCHK,BUGNTE,BUGHLT,DCHKSW,DDTPRS,DESPT,DRMFRE,DRMIN0
EXTERN DSKRT,GCALC,GCCOR,XGC,ICAPT,IOIP,MENTR,MONCOR,MRETN
EXTERN NXTDMP,PIAPRX,POSTPG,PRELD,PRELDF,POSPGF,SETPPG
EXTERN SETPT,SPTC,SWPIN0,SWPINT,SWPRT
EXTERN SETMPG,JDSPTP

PGR==24	;I/O DEVICE NUMBER FOR PAGER

	EXTERN AUTONX
	EXTERN TTCH7,TTBIGC,TTPSI,TADSEC,LSTERR,FACTSW,FLOGO
	EXTERN TCITST,TCOTST,TTEMES,FRZWT,CAPMSK,CAPENB
	EXTERN KSELF,LOGTOT,LOGDES
	EXTERN TTFORK,TTFRK1,EXEC0
	EXTERN BHC,BITS,SVN,CH6TAB
	EXTERN GFKH,SETLF1

	INTERN PSISV2,RSKEDN
	INTERN BLOCK0,BLOCK1
	INTERN ITRAP,DISGE,DISGET,DISL,DISLT,RSKP,R,JRET,JSKP,NJOBS
	INTERN PJMPG,PJMA,PPMPG,PPMA,PSB,JSB
	INTERN FREJPA,FREJP,JFNPC0,RJFN,MJFN,SJFN,SWPMA0
	INTERN NNAMES,SCDIN,ILIST,SCHEDP,.DISMS,SCHED0
	INTERN SCDRQ7,JOBSRT,TTPSRQ,PSIT1A,GETCHA,.DEBRK
	INTERN DISE,DISET,DISN,DISNT
	INTERN ASSFK,WTFPGS,WTSPT,SUSFKR,SUSWT,ITRAP1
	INTERN NTASKT,NLOADT,NEVENT
	INTERN STIME,ETIME,SETOVF,MAXQ,DISG,DISGT,BLOCKW
	INTERN SUPERP,PARALP,INFERP,PSILOB,TMZONE,DISLE,DISLET
	INTERN FFF,PATCH1,PATCH2,INDFLG
	INTERN .HALTF,EDISMS,HALTF1,HALTT
	INTERN HLTJB,HLTFK1,CLRM0,FRZB1,FRZB2,FRZBB,PSIJTR
	INTERN PSIRQ0,PSIRQF,PSIRQB,CHNSON,PSIR4,FORCTM,PSIRQ
	INTERN P7POV,P7FOV,P7OV,PI7P,WTSPTT,SCHEDR,APCLK1,MINNR,MPEINT
	INTERN SCDVE,PISC7
	INTERN JTULCK,PSIWTF,JTMCN,JTFRZB,JTDVC1,FRZBAL,TRPSI5
	INTERN NEWFKF
	INTERN TTFRKP
	IFDEF RTISW,<INTERN .SOLO,.TUTTI>



NSKDP==40		;LOCAL PUSH LIST
NSCDRQ==20		;SIZE OF SCHEDULER REQUEST QUEUE

MINNR==3		;MIN SIZE OF RPLQ FOR LOADING FORK



;MACROS FOR TIMING SUBROUTINES

DEFINE STMR
<	SKIPL BKGFLG
	JSP 4,STIME
>

DEFINE ETMR(CLK)
<	SKIPGE BKGFLG		;BACKGROUND MODE?
	JRST .+4		;YES
	JSP 4,ETIME
	ADDM 1,CLK
	AOS CLK+1
>


;STORAGE

LS SKDPDL,NSKDP		;SCHEDULER LOCAL PDL
LS MSCNT,1		;INDEX TO MSEC/TICK TABLE
LS APCLKC,1		;COMMUNICATION TO CH7 FROM CH1 CLOCK INTERRUPT
LS CLKAC2,1		;CLOCK ROUTINE TEMP
LS CLKAC1,1		;  "
LS SYNCC,1		;  "
LS OLDTCK,1		;  "
LS PISC7R,1
LS FKPT6M,1		;-FKPT(6)

GS FORKX,1		;INDEX OF CURRENTLY RUNNING FORK

GS FKPGS,NFKS		;UPT,,PSB   SPT NUMBERS
GS FKSTAT,NFKS		;FORK WAIT TEST
GS FKWSP,NFKS		;NO. PGS NEEDED TO PRELOAD,,NO. PGS IN CORE
GS FKPGST,NFKS		;TEST WORD WHILE IN PAGE WAIT
			;IF ON WTLST, TIME WAIT BEGAN
GS FKQ,NFKS		;QUEUE NUMBER,,TIME REMAINING IN QUANTUM
GS FKPT,NFKS		;IF ON WTLST, =WTLST,,ADDRESS OF NEXT FKPT OR 0
			;IF ON A RUNLST, ADDRESS OF PREV FKPT,, ADDRESS
			;OF NEXT FKPT
			;IF DELETED FORK, B0=1
GS FKINT,NFKS		;FORK INTERRUPT COMMUNICATION REG
;BITS IN FKINT --
; B0 = REQUEST FOR PSI PROCESSING
; B1 = PSI PROCESSING IN PROGRESS - DEFER FURTHER REQUESTS
; REST DEFINED AND COMMENTED AT TAG "PIRQ"
GS FKINTB,NFKS		;INTERRUPT CHANNELS REQUEST
GS FKJOB,NFKS		;JOB NUMBER ,, JSB
GS FKNR,NFKS		;AGE,,BALANCE SET SIZE (RESERVE)
GS FKFLGS,NFKS		;PER PROCESS FLAGS,,CORE NUMBER
 
;FLAG BIT DEFS FOR ABOVE TABLE
WTFK==:1B18	;PROCESS IN BALANCE SET AND WAITING
NOSK==:1B19	;PROCESS IS NOSKED
FORCEM==:1B20	;PROCESS IS TO BE REMOVED FROM BS 
BLST==:1B21	;PROCESS IS IN BALANCE SET
RNLS==:1B22	;PROCESS IS ON A RUNLIST
ZIFA==:1B23	;ZERO IFAV AT NEXT PAGE-FAULT (PLEASE)
NOFLT==:1B24	;INDICATES ADJUSTMENT OF FKNR DUE TO LACK OF PAGE-FAULTING HAS BEEN DONE
WTCLCT==:1B25	;FORK HAS LEFT BAL SET BUT GCCOR NOT YET RUN

IFN PIESLC,<
NOCNT==:1B26	;FORK BEING BORN OR DYING. DON'T INCLUDE IN NAPROC
		;AS FORK IS NOT RECORDED IN SYSFK
> ;END PIE-SLICE SCHEDULER CONDITIONAL

HOLD==:1B27	;HOLD FORK IN BALANCE SET FOR MAXBSH AFTER DISMISS
WTLS==:1B28	;FORK IS ON THE WAIT LIST

IFN PIESLC,<
HIQFK==:1B29	;FORK MUST REMAIN ON A HIGH QUEUE
SPQFK==:1B30	;FORK MUST REMAIN ON THE SPECIAL QUEUE
PHIQFK==:1B31	;USED TO REMEMBER THAT FORK WAS ALREADY ON INTERQ AT
		;TIME OF CALL TO SETHIQ
>

FKCNO=:FKFLGS		;CORE NUMBER IN RIGHT HALF OF FKFLGS

GS FKJTQ,NFKS		;JSYS TRAP QUEUE - BACK PTR,,FWRD PTR

IFN PIESLC,<
GS FKSOLD,NFKS		;SYSTEM SOLD TIME WHEN FKUTIL LAST UPDATED
GS FKUTIL,NFKS		;PROCESSOR UTILIZATION PER FORK (FLOATING POINT)
GS FKPRT,NFKS		;PROCESS TIME SINCE FKUTIL LAST UPDATED
GS FKUDT,NFKS		;REAL TIME SINCE FKUTIL UPDATE

> ;END PIE-SLICE SCHEDULER CONDITIONAL

LS FREFK,1		;LIST OF FREE FORKS
GS SYSIFG,1		;SYSTEM HAS BEEN INITIALIZED IF NOT 0
GS ACCIFG,1		;ACCOUNTING INITIALIZED WHEN NON-0
GS ENTFLG,1		;PERMIT NEW JOB ON ^C IF NON-0
GS PWRDWN,1		;POWER FAILURE DETECTED IF .G. 0, DONE IF .L. 0

GS JOBDIR,NJOBS		;ATTACHED DIRECTORY,,LOGIN DIRECTORY
GS JOBNAM,NJOBS		;JOB SUBSYSTEM NAME INDEX FOR SETNM
GS JOBRT,NJOBS		;JOB RUN TIME
GS JOBPT,NJOBS		;CONTROL TTY,,TOP FORK
LS FREJOB,1		;LIST OF FREE JOBS

IFE PIESLC,<
MAXQ==:4			;HIGHEST NUMBERED QUEUE
>
IFN PIESLC,<
MAXQ==:2			;HIGHEST NUMBERED QUEUE
>

;RH(RUNLST(I)) CONTAINS A POINTER TO THE FKPT ENTRY OF THE HIGHEST
;PRIORITY PROCESS ON Q(I) REQUIRING SERVICE. SUBSEQUENT ENTRIES IN
;THE LIST MAY BE FOUND BY FOLLOWING THE POINTER IN RH(FKPT).

;LH(RUNLSB(I)) CONTAINS A POINTER TO THE FKPT ENTRY OF THE LOWEST
;PRIORITY PROCESS ON Q(I) REQUIRING SEERVICE. THE LIST MAY BE
;FOLLOWED VIA THE POINTERS IN LH(FKPT).

LS RUNLST,MAXQ+1	;RUNNING FORK LISTS (DESCENDING PRIORITY)
LS RUNLSB,MAXQ+1		;RUNNING FORK LISTS (ASCENDING PRIORITY)

LS WTLST,1	;WAITING FORK LIST
LS WTLSTB,1	;WAIT LIST TAIL POINTER
LS WAITFS,1	;WAIT LIST FULL SCAN FLAG
LS WAITLS,1	;TIME OF LAST FULL WAIT LIST SCAN

LS JTLST,1	;JSYS TRAP QUEUE
LS JTLSTL,1	; ... LAST


LS JB0FLG,1		;RUN JOB 0 REQUEST
LS FRECB,1		;FREE CORE NUMBER BITS

;BALANCE SET VARIABLES

LS NBPROC,1		;NUMBER OF PROCESSES IN BAL SET
LS NBRUN,1		;NUMBER RUNNABLE FORKS IN BALSET 

GS TOTRC,1		;TOTAL NUMBER REAL CORE PAGES
GS SUMNRX,1		;SUM(FKNR FOR BALSET PROCS)+SUM(FKWSP FOR ALL OTHERS)
			;+PAGES UNASSIGNED AND AWAITING COLLECTION
GS NRPMIN,1		;MINIMUM VALUE OF NRPLQ
GS MAXNRX,1		;MAX VALUE OF SUMNRX
GS CGFLG,1		;DEASSIGNED PAGES MAY EXIST IF >0
LS PANIC,1		;COUNT OF PANIC MODE GCCORS
LS RLBITS,1		;FOR GCCOR -- PROC USE BITS OF RUNLIST PROCS
LS BSBITS,1		;PROC USE BITS OF BAL SET PROCS
LS RUNT1,1		;RUNTIME SINCE FORK BEGAN EXECUTION

GS NRPLQ,1		;NUMBER OF PAGES ON REPLACABLE QUEUE
GS RPLQ,1		;REPLACABLE QUEUE    END,,BGN
GS PNDING,1		;NO. UNASSIGNED PAGES AWAITING COLLECTION

GS NPMAX,1		;MAX NUMBER OF PAGES IN CORE FOR ONE PROCESS
GS SNPMAX,1		;SMALL NPMAX FOR LOADED CONDITIONS
GS SJSIZ,1		;'SMALL' JOB SIZE
GS IRJAV,1		;NEAREST INTEGER TO RJAV

;SCHEDULER VARIABLES

LS SKEDF1,1		;START PROCESS VIA CH7 BREAK IN 1
LS SKEDF3,1		;PROCESS CLOCK COUNTED TO 0
LS INSKED,1		;IN SCHEDULER IF NON-ZERO
LS SSKED,1		;LAST JOB RUNNING WAS NOSKED

GS PSKED,1		;PAGE TRANSFER COMPLETED OR PSI NEEDS ATTENTION
GS ISKED,1		;SCHEDULE REQUEST FLAG
GS FSHBAL,1		; FLUSH BALSET REQUEST FLAG
GS BKGFLG,1		;WHEN = 0 INDICATES BACKGROUND

LS NGPROC,1		;NUMBER OF FORKS WAITING TO ENTER BAL SET
LS OLDSUM,1		;SUMNRX AT TIME OF LAST ATTEMPT TO ADD TO
			;BALANCE SET. -1 IF THIS VALUE HAS BEEN
			;INVALIDATED BY SOME CHANGE SUCH AS A FORK
			;ENTERING THE RUNLISTS.
LS POTEN,1		;UPPER BOUND ON NUMBER OF PAGES TO BE GAINED
			;BY DOING GCCOR


LS RJAVS1,1		;RJTSUM AT LAST RJAV UPDATE

;TABLES FOR SETNM

NNAMES==^D50		;NUMBER OF NAMES ALLOWED

GS SNAMES,NNAMES	;SIXBIT NAME OF SUBSYSTEM
GS STIMES,NNAMES	;ACCUMULATED RUNTIME OF SUBSYSTEM
GS SPFLTS,NNAMES	;ACCUMULATED PAGE FAULTS OF SUBSYSTEM
GS SWAKES,NNAMES	;WAKEUPS 0-14, SIZE INTEGRAL 15-35
GS SBLKTM,NNAMES	; BLOCKED FOR TTY TIME

;"QTIMES" GETAB TABLE
GS QSUM,5		;ACCUMULATED TIME OF JOBS OF RESPECTIVE Q'S

;PROCESSOR TASK GETAB TABLE ("TASKTB")
;ACCOUNTS FOR WHERE PROCESSOR TIME IS BEING SPENT
;EACH CATEGORY CONSISTS OF TWO WORDS; FIRST WORD IS TOTAL TIME
;SPENT PERFORMING THE TASK OR ROUTINE, SECOND IS A COUNT OF INVOKATIONS
;OF THAT TASK OR ROUTINE.

GS SOLD,2		;PROCESS-LEVEL TIME AND NUMBER OF PROCESS
			;DISPATCHINGS
GS IDLE,2		;IDLE TIME (NO PROCESSES REQUESTING SERVICE)
			;AND NUMBER OF TIMES WE GO IDLE
GS SWAPWT,2		;SWAP-WAIT TIME (NO RUNNABLE PROCESSES) AND
			;NUMBER OF TIMES WE HAD TO WAIT
GS NSKWT,2		;NOSKED WAIT TIME (NOSKED PROCESS PAGE FAULTS
			;WHILE THERE ARE OTHER RUNNABLE PROCESSES) AND
			;NUMBER OF TIMES THIS HAPPENS
GS SKMAIN,2		;TOTAL TIME SPENT IN AND ENTRIES TO SCHEDULER
			;MAIN ROUTINE
GS SKBAL,2		;TIME SPENT IN AND ENTRIES TO BALANCE SET SCHED.
GS SKWAIT,2		;TIME SPENT IN AND ENTRIES TO WAIT-LIST SCAN
GS SKLDPR,2		;TIME SPENT IN AND ENTRIES TO LDPROC ROUTINE
			;(ROUTINE THAT PROMOTES ACTIVE PROCESSES TO
			;THE BALANCE SET)
GS GCCR,2		;TIME SPENT IN AND ENTRIES TO GLOBAL GARBAGE
			;COLLECTOR (GCCOR)
GS PPG,2		;TIME SPENT IN AND ENTRIES TO POST-PURGE ROUTINE
GS PTRAP,2		;TIME SPENT IN AND COUNT OF PAGER TRAPS
			;PLEASE NOTE THAT PAGER TRAP TIME IS ALSO
			;INCLUDED IN SOLD TIME
IFN PIESLC,<GS SORTIM,2	;TIME SPENT IN AND ENTRIES TO RESORT>

IFE PIESLC,<NTASKT==^D22>
IFN PIESLC,<NTASKT==^D24>

;SYSTEM LOAD GETAB TABLE ("LOADTB")
GS RJTSUM,1		;INTEGRAL OF NBPROC+NGPROC DT
GS BSTSUM,1		;INTEGRAL OF NBPROC DT
GS NBRSUM,1		;INTEGRAL OF NBRUN DT
NRJAVS==3		;NUMBER OF LOAD AVERAGES WE MAINTAIN
GS RJAV,NRJAVS		;EXPONENTIAL AVERAGES OF NUMBER OF ACTIVE PROCESSES

NLOADT==NRJAVS+3

;SYSTEM MISCELLANEOUS EVENT COUNTERS ("EVENTS")
GS DRMRD,1		;NUMBER OF DRUM READS
GS DRMWR,1		;NUMBER OF DRUM WRITES
GS DSKRD,1		;NUMBER OF DISK READS
GS DSKWR,1		;NUMBER OF DISK WRITES
GS TOPTRP,1		;COUNT OF TOP-LEVEL PAGER TRAPS
GS WAKEUP,1		;NUMBER OF PROCESS WAKE-UPS
GS TTINTS,1		;NUMBER OF TERMINAL INTERRUPTS
GS NTTYIN,1		;TOTAL NUMBER TERMINAL INPUT CHARS
GS NTTYOT,1		;TOTAL NUMBER TERMINAL OUTPUT CHARS
GS ENTDMS,1		;ENTRIES TO SCHED DUE TO FORKX DISMS
GS ENTPGF,1		;ENTRIES TO SCHED DUE TO FORKX PAGE-FAULT
GS NGCLCT,1		;NUMBER OF PAGES COLLECTED BY GCCOR
GS PPCLCT,1		;NUMBER OF PAGES COLLECTED BY POSTPG
GS NREMJ,1		;COUNT OF FORCED BALSET REMOVALS
GS HSYST1,1		;TIME OF SYSTEM SHUTDOWN PENDING (GTAD FORMAT)
GS HSYST4,1		;AND GTAD TIME SYSTEM SCHEDULED BACK UP (OR 0)

NEVENT==^D15

;CLOCKS COUNTED DOWN AND TESTED, PARALLEL TO PCLKT, DON'T REORDER

LS RJQNT,1		;RUNNING JOB REMAINING QUANTUM
GS TIM2,1		;SECOND CLOCK, 100 MS





LS JOBRTT,1		;JOB RUNTIME SINCE LAST UPDATE

LS SCDRQI,1		;SCHEDULER REQUEST QUEUE
LS SCDRQO,1
LS SCDRQB,NSCDRQ

GS TODCLK,1		;MILLISECOND CLOCK, MONOTONICALLY INCREASING
GS CHKTIM,1		;FOUR MINUTES PAST LAST JOB 0 CHECK
GS CHKTM1,1		;TWO MINUTES PAST LAST JOB 0 CHECK
GS DDMPFK,1		;INDEX OF FORK RUNNING DDMP. -1 IF NON-EXISTANT

LS SCDRN1,1			;RUN ONLY FORK N IF N > -1

LS GLOCK,1			;USED TO AVOID UNNECESSARY WAKEUPS
				;AFTER COLLISION ON NON-RESIDENT LOCK
LS RESDNT,1		;ANYTHING BELOW THIS ADDRESS IS RESIDENT


;RESIDENT STORAGE FOR CRJOB JSYS

GS CRJLCK,1		;PROCESS LOCK FOR USE OF CRJOB JSYS
GS CRJANS,1		;ANSWER FROM JOBSRT. 0=WAITING, -1=SUCCESS,
			; +N IS AN ERROR NUMBER.
GS CRJJNO,1		;JOB NUMBER ASSIGNED BY JOBSRT

IFN PIESLC,<
;RESIDENT STORAGE FOR PIE-SLICE SCHEDULER
GS NAPROC,NGRPS		;NUMBER OF ACTIVE PROCESSES PER GROUP
GS DSHARE,NGRPS		;FRACTION (INCLUDING WINDFALL) PER GROUP
GS PIEGRP,NJOBS			;GROUP INDEX PER JOB
GS DEFGP,1			;DEFAULT PIE-SLICE GROUP
GS PASSES,1			;LOCAL COUNT OF PASSES PER ENTRY TO RESORT
GS EXCHGS,1			;LOCAL COUNT OF EXCHANGES IN RESORT
GS SRTBEG,1			;PLACE TO BEGIN NEW SORT PASS
GS SRTEND,1			;PLACE TO END IT
GS SRTTMP,1			;TEMPORARY FOR SORT

>; END PIE-SLICE SCHEDULER CONDITIONAL


;PATCH SPACE FOR RES MON

SCDV1==1		;IF DEFINED MEANS ASSEMBLING MON
SCDVE==.-1		;UPPER LIMIT FOR CORE CLEAR ON STARTUP

FFF:
PATCH1:
PATCH2:	XLIST	;REPEAT 300,<0>
	REPEAT 300,<	0>
	LIST

INDFLG:	0			; .NE. 0 MEANS LOCK JSB
				; .L. 0 MEANS USE NO INDIRECT PTRS

;SCHEDULER INITIALIZATION

SCDIN:	SETZM SYSIFG
	SETZM AUTONX
	SETZM PWRDWN
	SETZM ENTFLG
	SETZM WAITLS
	MOVE 1,[JRST SCDRQ0]
	MOVEM 1,SCDRQ+1		;DISPATCH FOR JSR-CALLED ROUTINE
	MOVEI 1,JTLST
	MOVEM 1,JTLSTL		;SET UP JSYS TRAP WAIT LIST
	MOVNI 1,FKPT		;BECAUSE MACRO DOESN'T HAVE NEG RELOC'N
	HRLI 1,6
	MOVEM 1,FKPT6M		;-FKPT(6)
	MOVEI 1,SCDRQB
	MOVEM 1,SCDRQI
	MOVEM 1,SCDRQO
	MOVEI 1,FKPT
	MOVEI 2,NFKS
	CALL ILIST		;INIT FREE FORK LIST
	MOVEM 1,FREFK
IFDEF SIGIPC,<	CALL SIGINI##	;INIT SIGNL/WTFOR TABLES>
	MOVEI 1,JOBPT
	MOVEI 2,NJOBS
	CALL ILIST
	MOVEM 1,FREJOB		;INIT FREE JOB LIST
	SETOM JOBRT
	MOVE 1,[XWD JOBRT,JOBRT+1]
	BLT 1,JOBRT+NJOBS-1

	SETZM 20
	SETOM SCDRN1
	SETOM GLOCK
	SETOM FORKX
	SETOM TADSEC
	SETOM OLDSUM
	SETOM SSKED
	SETOM DDMPFK
	SETOM CRJLCK		;FREE LOCK ON CRJOB CELLS

	HRLOI 1,377777
	MOVEM 1,CHKTM1			;AVOID JOB0 BUGHLT ON STARTUP

	MOVSI 1,(777B8!CORMB)	;INIT RLBITS NOT TO CLEAR AGE AND CORMB
	MOVEM 1,RLBITS

	HRLOI 1,377		;BITS IN PROC. USE REG.
	MOVEM 1,FRECB
	MOVEM 1,INSKED
	MOVE 1,[FACTON]
	MOVEM 1,FACTSW		;FACT FILE ON AND INIT THE REST=0

	MOVEI 1,MAXQ+1		;CLEAR RUNLST AND RUNLSB
SCDIN2:	MOVEI 2,RUNLST(1)
	MOVEI 3,RUNLSB(1)
	HRLZM 2,0(3)
	HRRZM 3,0(2)
	SOJGE 1,SCDIN2

	MOVEI 1,WTLST
	HRLZM 1,WTLSTB
	MOVEI 1,WTLSTB
	HRRZM 1,WTLST


	MOVE 1,MONCOR
	LSH 1,^D9
	MOVEM 1,RESDNT

	RET

ILIST:	ADDI 1,-1(2)
	SETZM 0(1)		;INIT FREE LIST, BLOCK ADR IN AC1,
	SOJLE 2,ILIST1		;  SIZE OF BLOCK IN 2
	MOVEM 1,-1(1)
	SUBI 1,1
	SOJG 2,.-2
ILIST1:	RET

;CHANNEL 7 INTERRUPT
;CLOCK, POSSIBLE RESCHEDULING, OR START PROCESS FROM SCHEDULER

PISC7:	XWD PISC7R,.+1
IFN KIFLG,<			;PROTECT SOME AREAS ON KI-10.
	CLSB SCDCHN		;THE ISB MUST BE EXPLICITLY CLEARED
	MOVEM 1,KIP7A		;STASH AN AC TO DO THE RANGE CHECK
	SKIPE KIP7Q		;REQUEST FROM KI RETURN?
	JRST [	MOVE 1,KIP7P	;YES. GET PC AND FLAGS
		MOVEM 1,PISC7R	;SET TO GO THERE
		SETZM KIP7Q	;CLEAR REQUEST
		SETZM KIP7F
		JRST .+1]
	MOVE 1,PISC7R		;SEE IF WE WERE IN USER MODE
	TLNE 1,UMODF		; ..
	JRST KIP71		;YES. OK TO RESCHEDULE
	MOVEI 1,0(1)		;EXEC MODE. JUST THE ADDRESS. CLR FLAGS
	CAIL 1,KIBGN		;CRITICAL SECTION RANGE CHECK
	CAIL 1,KIEND		; ..
KIP71:	SKIPA 1,KIP7A		;NO. OK TO BREAK HERE. GET THE AC BACK.
	 JRST [	AOS KIP7F	;CRITICAL. FLAG INTERRUPT NEEDED, BUT
		MOVE 1,KIP7A	; FOR NOW JUST RESTORE AC AND GO AWAY
		JEN @PISC7R]	;DISMISS FROM CHANNEL 7
>;				;END OF KI-10 SAFETY CHECK.
	SKIPG PSKED		;RESCHEDULE ON PAGE ARRIVAL .. DCA
	SKIPE ISKED
	AOSA SKEDF3		;RESKED REQUEST
	SKIPE APCLKC		;CLOCK TICK?
	JRST APCLK		;SERVICE IT
APCLKX:	SKIPE SKEDF1		;INITIATED BY SCHEDULER?
	JRST SCDR		;YES, GO START PROCESS
	SKIPG INSKED		;IN SCHEDULER NOW, OR
	SKIPG SKEDF3		;NO SCHEDULING REQUESTS?
	JEN @PISC7R		;IGNORE INTERRUPT
	SKIPE ENSKR		; ABOUT TO ENTER SCHEDULER AT PROC LVL?
	 JEN @PISC7R		; YES. NO NEED TO DO IT HERE
	SKIPN TRAPPC		;PAGER TRAP STARTING?
	SKIPE NSKED		;OK TO RESCHEDULE?
	JRST SCDW		;NO, GO SET TRAPS
	ENTSKD			;ENTER SCHEDULER ENVIRONMENT
	MOVE 1,PISC7R
	MOVEM 1,PPC
	JEN @[SCHED0]

SCDW:	MOVEM 1,RSKED		;SAVE AC1
	MOVE 1,RSKEDT		;GET TRAP INSTRUCTION
	EXCH 1,RSKED		;LEAVE IT TO GET EXECUTED
	JEN @PISC7R

RSKEDN:	JFCL 0			;NO-TRAP CONTENTS OF RSKED
RSKEDT:	JSYS RSKD0		;TRAP CONTENTS OF RSKED

;SETUP AND RESUME PROCESS

SCDR:	SETZM SKEDF1		;CLEAR LOCAL FLAG
	SETZM INSKED		;NO LONGER IN SCHEDULER
IFN KIFLG,<
	JSP 7,KISLOD>		;RELOAD STUFF PECULIAR TO KI-10
IFE JTRPSW-1,<			;IF MAPPING RES MON FOR TRAPS
	HRRZ 1,JTMNW		;1=FORKS MONITOR
	CAIN 1,7777		;NULL FORK?
	JRST .+5		;YES, DON'T MAP RES MON
	SKIPN 1,PSB+JDVPG	;NO, IS FORK INIT'D?
	JRST .+3		;NO
	MOVEM 1,MMAP+1		;YES, SET MON MAP AND
	CONO PGR,7		;MAP RES MON
	     >
	MOVE 1,PSB40
	MOVEM 1,40
	MOVSI 17,PAC		;RESTORE PROCESS AC'S
	BLT 17,17
	JEN @PPC		;RUN PROCESS


;VARIOUS WAYS OF ENTERING SCHEDULER

;JSYS HALTF - DISMISS FORK UNTIL INTERRUPT OR EXTERNALLY RESTARTED

.HALTF:	JSYS MENTR
HALTF1:	CALL FKTMI		;FORK TERM INTERRUPT
HALTX:	MOVEI 1,HALTT
	JSYS EDISMS
	JRST MRETN		;IF CONTINUED

HALTT:	JRST 0(4)		;IDENTIFIABLE TEST FOR HALTED FORK

;EXEC DISMISS - AC1 CONTAINS  XWD DATA,TEST ROUTINE ADR

EDISMS:	XWD FPC,.+1
	ENTSKD			;ENTER SCHEDULER
DISMS1:	MOVE 2,FPC		;USE JSYS RETURN AS PPC
	MOVEM 2,PPC
DISMSE:	SKIPE NSKED		;CHECK FOR BUGGY DISMISS
	BUG(HLT,<DISMISS WHILE NOSKED>)
	AOS ENTDMS	;COUNT DISMISSES
	MOVEM 1,FKSTAT(7)		;STORE ACTIVATION TEST WORD
	LSH 1,-^D9
	ANDI 1,777
	CAML 1,MONCOR
	BUG(HLT,<DISMISS WITH NON-RES TEST ADDRESS>)
	CALL SAVRT
	SETZM JOBCK0		;INIT MEASURING INTERVAL
	SETZ 2,
	MOVSI 1,HOLD		;THIS FORK TO BE KEPT IN BALSET?
	TDNE 1,FKFLGS(7)
	MOVE 2,MAXBSH		;YES
	HRRZ 1,FKSTAT(7)
	CAIE 1,BLOCKM
	CAIN 1,BLOCKT		;DISMISSED FOR WAIT .G. 500 MS?
	SETZ 2,			;YES, DON'T RETAIN IN BALSET
	JUMPE 2,[ CALL REMBSJ	;IF NO HOLD TIME REMOVE FROM
		  SETOB 7,FORKX	;BAL SET IMMED.
		  JRST SCHED0 ]
	MOVE 1,TODCLK
	ANDI 1,377777
	ADDI 1,0(2)
	MOVSI 1,0(1)
	HRRI 1,DISMT
	MOVEM 1,FKPGST(7)
	JRST SCHP3

MAXBSH:	^D100		;MAX BALSET 'HYSTERESIS'


;RESCHEDULE ON PAGE WAIT

SCHEDP:	XWD SKDPC,.+1
	ENTSKD
SCHP1:	AOS ENTPGF	;COUNT ENTRIES DUE TO PAGE-FAULT
	MOVEM 1,FKPGST(7)

	CALL SAVRT

	MOVE 1,SKDPC
	MOVEM 1,PPC
SCHP3:	MOVSI 1,WTFK
	SOS NBRUN		;FORK NO LONGER RUNNABLE .. COUNT
	CALL SCHP2
	JRST SCHED0

SCHP2:	SKIPE NSKED
	 JRST [MOVEM 7,SSKED	;SAVE NOSKED FORK INDEX
		TLO 1,NOSK
		JRST .+1]
	IORM 1,FKFLGS(7)
	SETOB 7,FORKX
	RET

;DO OKSKED AND RESCHEDULE

SCHEDR:	XWD SKDPC,.+1
	ENTSKD
	SOSGE NSKED
	BUG(HLT,<OKSKED WHEN NOT NOSKED>)
	JRST SCHP1

;DEFERRED SCHEDULING REQUEST TRAP

RSKD0:	XWD SKDPC,.+1
	ENTSKD			;ENTER SCHEDULER
	MOVE 1,SKDPC
RSKD2:	MOVEM 1,PPC
RSKD3:	MOVE 1,RSKEDN
	MOVEM 1,RSKED
	JRST SCHED0

;COMMON SCHEDULER ENTER ROUTINE, SAVE AC'S AND SET INSKED FLAG
;UPDATES PROCESS CLOCKS. SMASHES ACS 15 AND 16 IN DOING SO!!

ENSKED:	XWD ENSKR,.+1
	SKIPE INSKED
	BUG(HLT,<CALL TO SCHEDULER WHEN ALREADY IN SCHEDULER>)
	AOS INSKED		;PREVENT ACTION BY CH7 BREAK
	MOVEM 17,PAC+17		;SAVE PROCESS AC'S
	MOVEI 17,PAC
	BLT 17,PAC+16
	MOVE 7,40
	MOVEM 7,PSB40
IFN KIFLG,<
	JSP 7,KISSAV>		;SCHEDULER SAVE ROUTINE FOR KI-10 HWARE
	MOVE 7,FORKX		;GET INDEX OF CURRENT FORK
	MOVE P,PI7P		;GET PDL POINTER
	PUSH P,ENSKR		; SAVE ENSKR
	SETZM ENSKR

;UPDATE PROCESS CLOCKS
UCLOCK:	MOVE 16,JOBNO
	SETZ 15,
	EXCH 15,JOBRTT		;RUN TIME SINCE LAST UPDATE
	JUMPE 15,R		;RETURN NOW IF NO CHANGE
	ADDM 15,SOLD		;ACCUMULATE ALL SOLD TIME
	ADDM 15,JOBRT(16)		;ACCOUNT FOR JOB
	ADDM 15,FKRT		;ACCOUNT FOR FORK

IFN PIESLC,<
	ADDM 15,FKPRT(7)	;RUNTIME SINCE LAST FKUTIL UPDATE
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	ADDM 15,RUNT1		;LOCAL RUNTIME
	ADDM 15,IFTIM		;INTERFAULT TIME
	HRRZ 16,JOBNAM(16)	;GET SUBSYSTEM INDEX
	ADDM 15,STIMES(16)	;ACCUMULATE SUBSYSTEM TIME
	ADDB 15,PGTIM		;CORE MGT CLOCK
	CAIGE 15,AGTICK		;TIME TO TICK AGE CLOCK?
	RET			;NO
	IDIVI 15,AGTICK		;YES, COMPUTE NUMBER TICKS IN INTERVAL
	MOVEM 16,PGTIM		;LEAVE REMAINDER
	CAILE 15,AGSEC		;STRANGELY LONG INTERVAL?
	MOVEI 15,AGSEC		;YES, NORMALIZE TO A SECOND
	LDB 16,[POINT 9,FKNR(7),17] ;CURRENT AGE
	ADDI 15,0(16)		;ADD TICKS
	TRNE 15,777000		;OVERFLOW 9 BIT FIELD?
	SUBI 15,1000-100		;YES, WRAPAROUND
	DPB 15,[POINT 9,FKNR(7),17] ;SET NEW AGE
	DPB 15,[POINT 9,PGR72,8]	;FOR PAGER
	PGRLAG			;LOAD NEW AGE INTO PAGER
	RET

;INSTRUCTION TRAP - TRAP PC IN FPC, ASSUMED TO BE I +1

ITRAP1:	MOVEM 1,LSTERR		;SAVE ERROR CODE GIVEN IN 1
ITRAP:	SKIPE INSKED
	BUG(HLT,<INSTRUCTION TRAP WHILE IN SCHEDULER>)
	SKIPL FORKX		;NO FORK RUNNING, OR
	CONSZ PI,177B27		;PI IN PROGRESS?
	BUG(HLT,<INSTRUCTION TRAP WHILE PI IN PROGRESS OR IN SCHEDULER>)
	SKIPGE SLOWF		;NOW IN SLOW CODE?
	JSYS MENTR		;NO, ENTER
ITR3:	MOVE 1,MPP		;STACK PTR ON ENTERING THIS CONTEXT
	MOVE 2,0(1)		;RETURN PC
	TLNN 2,UMODF		;PREVIOUS CONTEXT INTERRUPTABLE?
	SKIPGE -2(1)		;I.E. USER MODE, OR INTDF .L. 0
	JRST ITR2		;YES, OK
	BUG(CHK,<INSTRUCTION TRAP AND PREVIOUS CONTEXT WAS NOINT>)
ITR2:	SETZM NSKED
	SETOM TRAPC		;CLEAR FLAGS AND COUNTERS
	SETZM INTDF		;SET TO 1 LEVEL NOINTERRUPT
	MOVE 1,CHNSON
	ANDCAM 1,PSIBW		;FLUSH PREVIOUS PANIC BREAKS
	MOVEI 1,^D15		;INITIATE CHANNEL 15 INTERRUPT
	CALL PSIRQ0
	RESKD1			;GET THE INTERRUPT "SEEN"
	OKINT			;INTERRUPT SHOULD TAKE HERE
	MOVE P,UPP		;RETURN TO USER IF CONTINUED
	ADD P,BHC+2
	JRST MRETN

;BLOCK UNTIL CONDITION SATISFIED
;BLOCK0 - STAYS IN BALSET,  BLOCK1 - LEAVES BALSET

BLOCK0:	XWD SKDPC,.+1
	ENTSKD
	CALL BLOCKS
	JRST SCHP1

BLOCK1:	XWD SKDPC,.+1
	ENTSKD
	CALL BLOCKS
	MOVE 2,SKDPC
	MOVEM 2,PPC
	JRST DISMSE

BLOCKS:	MOVNI 1,^D100
	ADDM 1,RJQNT		;CHARGE Q TO PREVENT HOGGING
	MOVNI 1,2
	ADDM 1,SKDPC		;MAKE RETURN TO INSTRUCTION BEFORE CALL
	MOVE 1,TODCLK
	ANDI 1,377777
	ADDI 1,^D100		;ADD 100 MILLISECS
	MOVSI 1,0(1)
	HRRI 1,BLOCKW
	RET

BLOCKM:	JFCL			;SCHED TEST FOR .5 TO 64 SEC.
BLOCKW:	MOVE 2,TODCLK		;SCHEDULER TEST, GET TIME
	ANDI 2,377777
	SUB 1,2			;DESIRED - NOW = WAIT LEFT
BLK2:	JUMPLE 1,1(4)		;NO WAIT TIME LEFT
	CAIGE 1,200000		;BIG DIFFERENCE?
	JRST 0(4)		;NO, KEEP WAITING
	SUBI 1,400000		;YES, COMPENSATE FOR WRAPAROUND
	JRST BLK2


;DEFAULT LOCK FAILURE ROUTINE
CNTLCK::
LCKTST::
	PUSH P,1		;SAVE AC1
	PUSH P,1		;DO IT AGAIN
	MOVE 1,-2(P)
	MOVE 1,-2(1)		;GET THE FAILING AOSE
	EXCH 1,0(P)		;PUT IT ON THE STACK AND RESTORE AC1
	HRRZI 1,@0(P)		;AC1=ADDRESS OF LOCK
	CAML 1,RESDNT		;RESIDENT?
	 JRST [SETZM GLOCK	;NO, INDICATE COLLISION
		MOVEI 1,SLOCKT	;ACTIVATION ROUTINE
		JSYS EDISMS	;SLEEP
		MOVNI 1,2	;BACK UP THE PC
		ADDM 1,-2(P)
		SUB P,BHC+1	;ADJUST STACK
		POP P,1		;RESTORE AC1
		RET]		;TRY AGAIN
	HRLZS 1			;ADDRESS TO LEFT HALF
	HRRI 1,RLOCKT		;ACTIVATION TEST
	JSYS EDISMS		;SLEEP
	SUB P,BHC+1
	POP P,1			;RESTORE AC1
	RET

;ACTIVATION TEST FOR PROCESS WAITING FOR RESIDENT LOCK
RLOCKT:	AOSE 0(1)
	JRST 0(4)
	JRST 1(4)



;ACTIVATION TEST FOR PROCESS WAITING FOR A SWAPPABLE LOCK
SLOCKT:	SKIPL GLOCK		;NOW A GOOD TIME TO TRY AGAIN?
	JRST 0(4)		;NO
	JRST 1(4)		;YES

;HERE ON UNLOCKING A LOCK ON WHICH A CONFLICT HAS OCCURRED
;NOTE THAT SPECIAL CARE IS TAKEN TO PRESERVE THE STATE OF
;ALL ACS BUT P WHEN THE EFFECTIVE ADDRESS COMPUTATION IS DONE
;TO ADDRESS THE LOCK. THUS, TABLES OF LOCKS MAY BE INDEXED VIA
;ANY AC EXCEPT P.
CNFLCT:: PUSH P,1
	MOVE 1,-1(P)		;GET PC
	MOVE 1,-2(1)		;GET THE SOSL THAT DIDN'T SKIP
	EXCH 1,0(P)		;PUT IT ON THE STACK AND RESTORE 1
	SETOM @0(P)		;UNLOCK THE LOCK
	PUSH P,1
	HRRZI 1,@-1(P)		;GET ADDRESS OF LOCK
	CAMGE 1,RESDNT		;RESIDNET?
	 JRST CNFL2		;YES
	SETOM GLOCK		;INDICATE A CONFLICT RESOLVED
	SETZM WAITLS		;REQUEST IMMEDIATE FULL WAITLIST SCAN
	AOS ISKED		;TO AVOID POSSIBLE DEADLOCK
CNFL2:	POP P,1
	SUB P,BHC+1
	RET


;DISMISS UNTIL WORD .GE. 0

DISGE:	PUSH P,1
	HRLI 1,DISGET		;GIVEN MON ADDRESS IN 1
DISXE:	MOVS 1,1
	JSYS EDISMS
	POP P,1
	RET

DISGET:	SKIPGE 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS UNTIL WORD .L. 0

DISL:	PUSH P,1
	HRLI 1,DISLT
	JRST DISXE

DISLT:	SKIPL 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS UNTIL WORD .G. 0

DISG:	PUSH P,1
	HRLI 1,DISGT
	JRST DISXE

DISGT:	SKIPG 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS UNTIL WORD .LE. 0

DISLE:	PUSH P,1
	HRLI 1,DISLET
	JRST DISXE

DISLET:	SKIPLE 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS UNTIL WORD .E. 0

DISE:	PUSH P,1
	HRLI 1,DISET
	JRST DISXE

DISET:	SKIPE 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS UNTIL WORD .N. 0

DISN:	PUSH P,1
	HRLI 1,DISNT
	JRST DISXE

DISNT:	SKIPN 0(1)
	JRST 0(4)
	JRST 1(4)

;DISMISS FOR SPECIFIED TIME JSYS

.DISMS:	JSYS MENTR
	JUMPLE 1,MRETN
	CAIL 1,100000		;LONG OR SHORT TIME?
	JRST TDIS1		;LONG
	MOVE 2,TODCLK
	ANDI 2,377777
	ADDI 2,0(1)		;COMPUTE TIME TO RESTART
	CAIGE 1,^D500		;USE BLOCKW FOR WAIT .L. 500 MS
	SKIPA 1,[BLOCKW]
	MOVEI 1,BLOCKM		;BLOCKM OTHERWISE
	HRLI 1,0(2)
TDIS2:	JSYS EDISMS		;DISMISS WITH SPECIFIED TEST
	JRST MRETN

TDIS1:	CAML 1,BITS+^D9
	MOVSI 1,(1B9)		;APPROX 17 HRS IS MAX PERMITTED
	MOVE 2,TODCLK
	TLZ 2,777000
	ADD 2,1			;COMPUTE TIME TO RESTART
	LSH 2,-^D10		;DIVIDE BY 1024
	MOVSI 1,0(2)
	HRRI 1,BLOCKT
	JRST TDIS2		;GO COMPLETE DISMISSAL

;SCHEDULER WAIT TEST FOR LONG WAIT

BLOCKT:	LSH 1,^D10		;RESTORE WAKEUP TIME TO FULL SIZE
	MOVE 2,TODCLK		;GET TIME NOW
	TLZ 2,777000
	SUB 1,2			;DESIRED-NOW = TIME LEFT TO WAIT
BLKT1:	JUMPLE 1,1(4)		;WAKEUP IF NEGATIVE
	CAMG 1,BITS+^D9		;VERY LARGE DIFFERENCE?
	JRST 0(4)		;NO, KEEP WAITING
	SUB 1,BITS+^D8		;COMPENSATE FOR WRAPAROUND OF TODCLK
	JRST BLKT1		;CHECK AGAIN

;SCHEDULER

SCHED0:	SETZ 0,			;FOR PEOPLE WATCHING LIGHTS

SCH0:	CONSZ PI,177B27		;ANY PI IN PROGRESS?
	BUG(HLT,<ENTERED SCHEDULER WITH PI IN PROGRESS>)

IFE JTRPSW-1,<			;IF MAPPING RES MON FOR TRAPPED FORK
	CONO PGR,6		;UNMAP IT
	>

	MOVE 1,NBPROC
	ADD 1,NGPROC
	LSH 1,^D9
	ADD 1,NBPROC
	HRLI 0,0(1)		;DISPLAY NRUN, NBPROC IN LH 0
	MOVEM 0,22		;AND 22

	MOVSI 16,-NPCLKS	;SCAN PROCESS CLOCKS
	SKIPG RJQNT(16)		;EXHAUSTED? (RJQNT IS FIRST IN TABLE)
	XCT PCLKT(16)		;YES, SERVICE WHATEVER
	AOBJN 16,.-2

	SKIPLE TTBIGC		;TTY BIG BUFFER NEED SERVICE?
	CALL TTCH7		;YES
IFDEF TNTCHN,<
	SKIPE TNTFLG##
	 CALL TNTCHK##>

	SETZM SKEDF3

	MOVE 4,SCDRQO
	CAME 4,SCDRQI		;ANY REQUESTS?
	CALL SCDRQ1		;YES

	SKIPN ISKED		;ANY REQUESTS FOR RESCHEDULING?
	SKIPE PSKED
	 CALL DISMSJ		;YES

	SKIPE ISKED		;SCHED REQUEST?
	CALL WTSCAN		;YES, CHECK WAITING FORKS

	SKIPE PWRDWN		;POWER FAIL DETECTED?
	JRST SCHPRF		;YES

	SKIPE 1,20		;REQUEST FROM SWITCHES?
	JSP 4,SWTST		;YES

	SKIPGE 7,FORKX		;JOB TO CONTINUE?
	 CALL SKPROC		;NO, GO FIND ONE. 

SCHED3:	SKIPGE 1,FKINT(7)	;INTERRUPT REQUEST?
	TLNE 1,200000		;AND NOT ONE IN PROGRESS
	JRST SCHED4
	MOVSI 1,200000		;CLEAR WORD EXCEPT FOR PI IN PROG
	EXCH 1,FKINT(7)
	MOVEM 1,PIMSK		;PASS REQUEST WORD TO SERVICE ROUTINE
	MOVEI 1,PIRQ		;PSEUDO-INTERRUPT SERVICE
IFN KIFLG,<
	TLO 1,(1B6)>		;SO UXCT GOES TO USER SPACE
	EXCH 1,PPC
	MOVEM 1,PIPC		;SAVE OLD PC

SCHED4:	SETZ 1,
	EXCH 1,JOBRTT

	AOSG BKGFLG		;COMING OUT OF BACKGROUND?
	 JRST [ASH 1,-1		;YES, CHARGE SCHED AND SWAPWT EQUALLY
		ADDM 1,SWAPWT
		JRST .+1]
	ADDM 1,SKMAIN
	AOS SKMAIN+1

	AOS SKEDF1		;TELL CH7 TO START PROCESS
	ISB SCDCHN		;LET IT START PROCESS
	JRST .-1		;JUST IN CASE ....

	DEFINE ECALL (D)
<IFDEF D'CHN,<EXTERN D'CHK
	CALL D'CHK
	GS D'TIM
>>

;TABLE OF SERVICE CALLS FOR PROCESS CLOCKS

PCLKT:	CALL DISMSJ		;RUNNING JOB QUANTUM OVERFLOW
BKGNDT:	CALL CLK2		;SECOND LEVEL CLOCK
NPCLKS==.-PCLKT
NBKR==.-BKGNDT		;THE (LAST) N OF THESE TO RUN ANYTIME


;SECOND PROCESS CLOCK, LESS PRECISE, UPDATES EVERY 100 MS

CLK2:	SKIPL SCDRN1		;RUNNING SPECIFIC JOB?
	 JRST CLK22		;YES, DON'T DO JOB 0 CHECK

	MOVE 1,TODCLK
	CAMGE 1,CHKTM1		;JOB 0 NOT RUN FOR TWO MINS.?
	 JRST CLK22		;EVERYTHING'S OKAY

	SKIPGE 7,DDMPFK		;GET INDEX OF DDMP FORK
	 JRST CLK22		;DOESN'T EXIST

	HLRZ 2,FKQ(7)
	JUMPE 2,CLK23		;FORK ALREADY ON HI-Q

	HRRZS FKQ(7)		;PLACE ON Q0

	MOVE 2,FKFLGS(7)	;SEE IF CURRENTLY ACTIVE
	TLNN 2,RNLS
	 JRST CLK23		;NOT ACTIVE

	CALL CHGRLS			;MOVE TO NEW RUNLIST
	JRST CLK22

CLK23:	CAML 1,CHKTIM	;DDMP 4 MIN. OVERDUE?
	BUG(HLT,<JOB 0 NOT RUN FOR TOO LONG, PROBABLE SWAPPING HANGUP>)

CLK22:	MOVEI 15,^D100
	SUBM 15,TIM2		;ACTUAL TIME SINCE LAST UPDATE
	EXCH 15,TIM2

;UPDATE ACTIVE-PROCESS TIME INTEGRAL
	MOVE 1,NBPROC
	ADD 1,NGPROC
	IMUL 1,15
	ADDM 1,RJTSUM


	MOVN 15,15		;NEGATE TIME

	MOVSI 14,-N2CLKS	;SET TO SCAN SECOND LEVEL CLOCKS
CLK21:	ADDM 15,DSKTIM(14)	;UPDATE CLOCK
	SKIPG DSKTIM(14)	;COUNTED OUT?
	XCT CLK2CL(14)		;YES, DO WHATEVER
	AOBJN 14,CLK21

	AOS ISKED		;DO COMPLETE RESKED AT LEAST THIS OFTEN
IFDEF DIALLN,<
	PUSHJ P,DILCHK##>	; TEMP FOR BBN AUTODIALLER
	RET

;TABLE OF CALLS FOR SECOND LEVEL CLOCKS

CLK2CL:	ECALL DSK		;DISK RE-QUEUE CHECK
				;NOTE THAT DSKCHK MUST BE FIRST --
				;SEE CLK21 ABOVE.
IFDEF IMPCHN,<
	EXTERN IMPCHK
	CALL IMPCHK
	GS IMPTM2,1
>
	ECALL TNT		;TELENET
	ECALL MTA		;MAG TAPE
	ECALL PTP		;PAPER TAPE PUNCH
	ECALL PLT		;PLOTTER
	ECALL DTA		;DECTAPE
	ECALL LPT		;PHYSICAL LPT
	CALL SKDCHK		;DO PERIODIC SCHEDULER FUNCTIONS
	GS SKDTIM,1

IFN PIESLC,<
	CALL RESORT		;REORDER COMPUTATION QUEUE
	GS RESTIM,1
> ;END PIE-SLICE SCHED CONDITIONAL

	CALL DORJAV		;UPDATE LOAD AVS
	GS RJATIM,1
	ECALL DLS		;DLS (TTY) BACKGROUND STUFF
N2CLKS==.-CLK2CL

RSKP:	AOS 0(P)		;RETURN (VIA PDL) SKIPPING
R:	RET

PI7P:	IOWD NSKDP,SKDPDL

;UPDATE RUNNABLE JOB AVERAGES

DORJAV:	MOVEI 2,^D5000
	MOVEM 2,RJATIM		;SET TIME OF NEXT UPDATE
	MOVE 4,RJTSUM		;CURRENT INTEGRAL OF NBPROC+NGPROC
	SUBM 4,RJAVS1		;DIFFERENCE FROM LAST UPDATE
	EXCH 4,RJAVS1
	FSC 4,233		;FLOAT IT
	FDVR 4,[5000.0]		;AVERAGE OVER LAST 5000 MS
	JOV .+1			;CLEAR OV FLAG
	MOVSI 2,-NRJAVS
SCHC1:	MOVE 3,EXPFF(2)
	FMPRM 3,RJAV(2)		;SUM*EXP(-T/C) -) SUM
	JOV [	SETZM RJAV(2)	;THAT MAY HAVE UNDERFLOWED,
		JRST .+1]	;IF SO, CLEAR IT TO 0
	MOVE 3,4
	FMPR 3,EXPGF(2)
	FADRM 3,RJAV(2)		;TERM*(1-EXP(-T/C)) + SUM -) SUM
	AOBJN 2,SCHC1
	MOVE 2,RJAV		;1 MIN AV.
	FADRI 2,(0.5)		;ROUND
	MULI 2,400		;FLOAT-TO-FIX
	ASH 3,-243(2)
	MOVEM 3,IRJAV		;MAINTAIN INTEGER VALUE
	RET

;TABLE OF EXP(-T/C) FOR T = 5 SEC.

EXPFF:	EXP 0.920043902	;C = 1 MIN
	EXP 0.983471344	;C = 5 MIN
	EXP 0.994459811	;C = 15 MIN

;TABLE OF 1-EXP(-T/C) FOR T = 5 SEC

EXPGF:	EXP 0.0799560979	;C = 1 MIN
	EXP 0.0165286558	;C = 5 MIN
	EXP 0.00554018893	;C = 15 MIN



; PERIODIC SCHEDULER FUNCTIONS

;CHECK SUMNRX
SKDCHK:	MOVSI 2,-NFKS
	SETZ 1,
SUMLUP:	MOVE 3,FKFLGS(2)
	TLNE 3,BLST
	TLNE 3,FORCEM
	 SKIPA 4,FKWSP(2)
	MOVE 4,FKNR(2)
	ADDI 1,0(4)
SUMNXT:	AOBJN 2,SUMLUP

	PIOFF			;PREVENT PNDING FROM CHANGING
	ADD 1,PNDING
	CAMN 1,SUMNRX
	 JRST SUMEXT

	BUG (NTE,<SUMNRX INCORRECT>)
	MOVEM 1,SUMNRX

SUMEXT:	PION

;CHECK PNDING
	SKIPE IOIP		;DON'T CHECK IF ANY WRITES IN PROGRESS
	 JRST UDINT

	MOVE 1,SWPCOR##
	SETZ 2,
	MOVSI 4,(77B5)		;MASK TO CHECK AGE

PNDCHK:	TDNN 4,CST0(1)		;ON RPLQ??
	 JRST PNDCH2		;YES, DON'T INSPECT FURTHER

	MOVE 3,CST3(1)
	TLC 3,7777
	TLNN 3,7777		;PAGE UNOWNED AND NOT ON RPLQ?
	ADDI 2,1		;YES, COUNT IT
PNDCH2:	CAME 1,NHIPG##		;HAVE WE JUST DONE LAST PAGE?
	AOJA 1,PNDCHK		;NO, DO ANOTHER

	CAMN 2,PNDING		;PNDING OK?
	 JRST UDINT		;YES

	BUG (CHK,<PNDING INCORRECT>)	;NO

	SUB 2,PNDING
	ADDM 2,PNDING
	ADDM 2,SUMNRX		;ADD SAME AMT TO SUMNRX WE JUST ADDED TO PNDING


;UPDATE INTERESTING TIME INTEGRALS
UDINT:	MOVEI 1,^D60000		;UPDATE EVERY 60 SECONDS
	SUBM 1,SKDTIM
	EXCH 1,SKDTIM

	MOVE 2,NBPROC
	IMUL 2,1
	ADDM 2,BSTSUM		;INTEGRAL NBPROC DT

	MOVE 2,NBRUN
	IMUL 2,1
	ADDM 2,NBRSUM		;INTEGRAL NBRUN DT


; GUARD AGAINST POSSIBLE LOCKUP IN NON-RESIDENT LOCK CONFLICT
; RESOLUTION STRATEGY
	SETOM GLOCK		; WAKE EVERYBODY JUST IN CASE
	SETZM WAITLS		; A DIRECTORY OR SUBINDEX GOT LOCKED BY 
	AOS ISKED		; USER CODE WHICH UNLOCKS BUT CAN'T 
				; SETOM GLOCK

	RET
IFN PIESLC,<

;ROUTINE WHICH PERIODICALLY REORDERS THE COMPUTATION QUEUE

RESORT:	STMR			;TIME THIS ROUTINE

	MOVEI 1,^D1000		;DO THIS EVERY SECOND
	MOVEM 1,RESTIM
	SETOM OLDSUM
	MOVEI 1,RUNLST+COMPQ	;INIT SRTBEG
	MOVEM 1,SRTBEG
	MOVEI 1,RUNLSB+COMPQ	;INIT SRTTMP
	MOVEM 1,SRTTMP

	SETZM PASSES		;ZERO COUNT OF PASSES PER ENTRY
RESOR3:	SETOM EXCHGS		;ZERO COUNT OF EXCHANGES PER PASS

	MOVE 1,SRTTMP		;INIT SRTEND
	MOVEM 1,SRTEND

	MOVE 6,SRTBEG		;PLACE TO START THIS PASS
	HRLOI 5,377777		;5=LARGEST FLOATING POINT NUMBER
	JRST RESOR8

RESOR6:	MOVEI 7,@FKPT6M		;GET FORKX OF LOWER FORK
	SKIPN PASSES		;FIRST PASS?
	 CALL UPDUT		;YES, UPDATE UTILIZATION
	CALL CDIST		;AND GET DISTANCE FROM TARGET
	CAMGE 5,1		;IN PROPER ORDER?
	 JRST RESOR7		;NO, EXCHANGE THEM
	MOVE 5,1		;YES, MOVE LOWER FORK'S DIST TO AC5
RESOR8:	HRRZ 6,0(6)		;NEXT FKPT
	CAMN 6,SRTEND		;LAST?
	 JRST RESOR5		;YES
	JRST RESOR6		;NO

;EXCHANGE THE FORK POINTED TO BY AC6 WITH THE ONE ABOVE IT.
;DENOTE THE FORK IN 6 BY "C" IN THE SEQUENCE "A,B,C,D".
;WE WISH TO COME OUT WITH "A,C,B,D".

RESOR7:				;6=C
	HLRZ 3,(6)		;3=B
	HLRZ 2,(3)		;2=A
	HRRZ 4,(6)		;4=D

	MOVEM 3,SRTTMP		;NEXT PASS MAY END AFTER COMPARING
				;A&C IF NO EXCHANGES FOLLOW

	AOSN EXCHGS		;FIRST EXCHANGE THIS PASS?
	 JRST [HLRZ 1,(2)	;YES, NEXT PASS BEGINS BY COMPARING A&C
		JUMPE 1,.+1	;CAN'T DO IF AT TOP OF LIST
		MOVEM 1,SRTBEG
		JRST .+1]

	HRRM 6,(2)		;A FORWARD TO C
	HRLZM 2,(6)		;C BACK TO A

	HRRM 3,(6)		;C FORWARD TO B
	HRLZM 6,(3)		;B BACK TO C

	HRRM 4,(3)		;B FORWARD TO D
	HRLM 3,(4)		;D BACK TO B

	HRRZ 6,0(6)		;6 MUST NOW POINT TO B

	JRST RESOR8		;DONE

RESOR5:	SKIPL EXCHGS		;ANY EXCHANGES THIS PASS?

	AOSA PASSES		;COUNT PASSES PER ENTRY TO RESORT
	CAIA
	JRST RESOR3
	ETMR SORTIM		;COMPLETE TIMING OF THIS ROUTINE
	RET

;ROUTINE TO COMPUTE DISTANCE FROM TARGET. LEAVES RESULT IN AC1.
;SMASHES AC2.
CDIST:	HLRZ 2,FKJOB(7)		;GET JOB NO.
	MOVE 2,PIEGRP(2)	;GET GROUP INDEX
	MOVE 1,DSHARE(2)
	FDVR 1,NAPROC(2)	;AC1=TARGET
	FSBR 1,FKUTIL(7)	;AC1=TARGET-UTIL
	RET



> ;END PIE-SLICE SCHED CONDITIONAL




;TEST WORD DEPOSITED BY SWITCHES IN 20

SWTST:	SETZM 20
	JFFO 1,.+1
	CAIGE 2,NSWTT
	XCT SWTT(2)
SWTST1:	JRST 0(4)		;RESUME SCHEDULER

SWTT:	JRST SWHLT		;HALT T.S.
	JRST SWRUN1		;RUN ONLY SPECIFIED JOB
	JRST SWCRSH		;INITIATE JOB0 FUNCTION
NSWTT==.-SWTT

SWHLT:	CALL DISMSJ		;DISMISS CURRENT JOB
	PUSH P,DCHKSW
	SETOM DCHKSW
	MOVNI 0,1
	BUG(CHK,<SCHED HALTED>)	;GO TO DDT
SWHLT1:	POP P,DCHKSW
	SKIPE DDTPRS
	JRST .
	JRST SCHED0

SWRUN1:	HRREI 1,0(1)		;-1 OR JOB NUMBER IN RH
	JUMPL 1,SWRUN2		;-1 MEANS RESTORE TO NORMAL
	CAIGE 1,NJOBS		;LEGAL JOB NUMBER?
	SKIPGE JOBRT(1)		;RIGHT HALF OF SWITCHES SPECIFIES JOB
	JRST SWTST1		;EXCEPT THAT JOB DOESN'T EXIST
SWRUN2:	MOVEM 1,SCDRN1		;ALLOW ONLY THAT JOB TO RUN
	CALL DISMSJ		;DISMISS CURRENT FORK
	JRST SWTST1

SWCRSH:	SETZM NXTDMP		;DO DDMP
	SETZB 1,DDTIME##	;HUSTLE UP THE DISK TRICKLER
	AOS JB0FLG		;DO JOB 0
	JRST SWTST1

;POWER FAIL DETECTED

SCHPRF:	CALL DISMSJ		;FLUSH CURRENT FORK
	MOVE 1,TODCLK		;WAIT A COUPLE MS FOR IO TO STOP
	ADDI 1,2
	CAMLE 1,TODCLK
	JRST .-1
	PIOFF 610000		;CLEAR WORLD
	CONO APR,1B19
	SETOM PWRDWN		;SAYS WE FINISHED PWR DWN SEQUENCE
	JRST 4,.		;SYSTEM SHOULD BE RESTARTABLE AT SYSRST

;SCHEDULER REQUEST PROCESSOR

;SCDRQ7 CALLED BY ROUTINES HAVING PDL POINTER IN P

SCDRQ7:	PIOFF
	JSR SCDRQ
	PION
	RET

;SCDRQ CALLED BY JSR AFTER HAVING TURNED OFF PI SYSTEM

LS SCDRQ,2

SCDRQ0:	MOVEM 1,@SCDRQI
	AOS 1,SCDRQI
	CAIE 1,SCDRQB+NSCDRQ
	JRST @SCDRQ
	MOVEI 1,SCDRQB
	MOVEM 1,SCDRQI
	JRST @SCDRQ

;PROCESS SCHEDULER REQUESTS

SCDRQ1:	CAMN 4,SCDRQI
	RET
	MOVE 2,0(4)		;WORD CONTAINS DATA,,DISPATCH ADR
	HLRZ 1,2
	CALL 0(2)
	AOS 4,SCDRQO
	CAIE 4,SCDRQB+NSCDRQ
	JRST SCDRQ1
	MOVEI 4,SCDRQB
	MOVEM 4,SCDRQO
	JRST SCDRQ1

;SCHEDULER REQUESTS
;PUSHJ TO THESE ROUTINES ON SCHED LEVEL WHEN SCDRQ QUEUE NON-EMPTY.
; CALL WITH DATUM IN AC1

;JOB STARTUP ROUTINE. CALL WITH TTY NUMBER OR 0,,-1 IN AC 1


JOBSRT:	HRRE 1,1		;FULL WORD IN CASE DETACHED STARTUP
	MOVE 2,SPTC		;CURRENT SPT COUNT
	CAIL 2,SSPT-NOFN-20	;NEARLY FULL?
	JRST JOBSR1		;YES, DON'T PERMIT LOGIN
	MOVE 2,DRMFRE
	CAIG 2,100		;ENOUGH FOR THE EXEC, IF NOT A JOB?
	JRST JOBSR2		;NO
	SKIPN FREJOB		;ROOM FOR NEW JOB
	JRST JOBSR3		;NO JOBS
	SKIPN FREFK		;AND NEW FORK?
	JRST JOBSR4		;NO
	MOVE 2,@FREJOB		;GET THE FREE JOB OFF THE FREE LIST
	EXCH 2,FREJOB		; ..
	SUBI 2,JOBPT		;CONVERT TO JOB NUMBER FROM LIST ADR
	PUSH P,2		;SAVE JOB NUMBER
	PUSH P,1		;TTY NUMBER (FROM TTY SRV)
	CALL ASSFK		;GET A FORK
	POP P,1
	POP P,2			;JOB NUMBER AGAIN
	HRLM 2,FKJOB(7)		;PUT IT IN FORK TABLE, TO RE-FIND JOB NUMBER
	HRLI 1,NEWJBF		;ADD TTY #, NEWJOB TO B0&NEWFKF
	IORM 1,FKINT(7)		;LEAVE TTY NUMBER IN RH FOR STARTUP ROUTINE

IFN PIESLC,<
	SKIPE 1,SYSIFG		;SYSTEM INITIALIZED?
	MOVE 1,DEFGP		;GET DEFAULT PIE-SLICE GROUP
	MOVEM 1,PIEGRP(2)
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	RET

JOBSR4:	MOVEI 2,[ASCIZ / FORKS FULL
/]
	JRST JOBSR0
JOBSR3:	MOVEI 2,[ASCIZ / JOBS FULL
/]
	JRST JOBSR0
JOBSR2:	MOVEI 2,[ASCIZ / DRUM FULL
/]
	JRST JOBSR0
JOBSR1:	MOVEI 2,[ASCIZ / SPT FULL
/]
JOBSR0:	JUMPL 1,JOBSRC		;JUMP IF FROM CRJOB
	EXCH 1,2		;MSG TO 1, TTY TO 2
	HRRZS 2			;JUST LINE NUMBER
	HRLI 1,440700		;STRING POINTER
	CALL TTEMES		;GIVE USER BAD NEWS
	SETOM TTFORK(2)		;CLEAR TTY
	RET
JOBSRC:	MOVEI 1,CRJBX6##	;FAIL RETURN FROM CRJOB
	MOVEM 1,CRJANS		;RETURN IT
	RET

;ASSIGN FORK SLOT

ASSFK:	HRRZ 7,@FREFK
	EXCH 7,FREFK		;GET FORK, UPDATE LIST
	SUBI 7,FKPT
	MOVEI 1,JSKP
	MOVEM 1,FKSTAT(7)	;MAKE STATUS RUNNABLE AT NEXT TEST

IFE PIESLC,<
	MOVE 1,QBASE+1
	MOVEM 1,FKQ(7)		;ESTABLISH QUEUE
> ;END NON-PIE-SLICE SCHEDULER CONDITIONAL

IFN PIESLC,<
	MOVE 1,SOLD
	MOVEM 1,FKSOLD(7)
	SETZM FKUTIL(7)
	SETZM FKPRT(7)
	MOVE 1,TODCLK
	MOVEM 1,FKUDT(7)
	MOVSI 1,NOCNT		;INITIALIZE FKFLGS
	HLLM 1,FKFLGS(7)
	MOVEI 2,INTERQ
	CALL CHGQ
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	CALL WTCONC		;PUT ON WAITLIST
	MOVSI 1,400000+NEWFKF
	MOVEM 1,FKINT(7)	;LEAVE INTERRUPT REQUEST
	MOVEI 2,(7)		;PSIR4 TAKES FORKX IN AC2
	CALL PSIR4		;AND GET IT NOTICED
	SETZM FKINTB(7)
	SETZM FKPGS(7)		;CLEAR PT AND PSB WORD
	SETZM FKJOB(7)
	SETZM FKWSP(7)
	MOVE 1,[XWD 100100,3]	;INIT AGE TO 100, W.S. TO 3
	MOVEM 1,FKNR(7)
	RET

;PROCESSOR INTERRUPTS REFERRED FROM CHANNEL 1

P7OV:	MOVEI 2,6		;OVERFLOW, FLOATING OVERFLOW
	JRST P7PI1

P7FOV:	MOVEI 2,7		;FLOATING OVERFLOW CHANNEL
	JRST P7PI1

P7POV:	MOVEI 2,^D9		;PDL OVERFLOW
P7PI1:	EXCH 1,2		;FORK NUMBER LEFT BY APR ROUTINE
	CALL PSIRQ
	RET

MPEINT:	MOVEI 2,^D11		;GIVES IO ERROR INTERRUPT
	JRST P7PI1

;BALANCE SET SCHEDULER
;CALLED TO SELECT PROCESS TO RUN

SKPROC:	STMR		;BEGIN TIMING THIS ROUTINE

	SETZM 21	;CLEAR JOB RUNNING DISPLAY
	SETZM PSKED

	SKIPE FSHBAL	;ANYBODY WANT TO FLUSH THE BALANCE SET?
	 CALL FSHBS	;YES, GO DO IT

SKPR1:	SKIPGE SSKED		;ARE WE NOSKED?
	SKIPN NBRUN		;NO, ANYBODY TO RUN?
SKPR5:	SKIPA 1,NRPLQ		;NOBODY TO RUN OR NOSKED
	 JRST SKPR3		;SOMEBODY TO RUN, GO DO IT.
	ADD 1,IOIP
	CAMLE 1,NRPMIN
	 JRST SKPR3		;NO

	ADD 1,POTEN		;ANY POINT IN DOING A GCCOR?
	CAMG 1,NRPMIN
	 JRST SKPR4		;NO, TRY TO REMOVE A PROCESS

	CALL GCCOR		;YES, TRY GARBAGE COLLECTING

	MOVE 1,NRPLQ		;DID THAT HELP?
	ADD 1,IOIP
	CAMLE 1,NRPMIN
	 JRST SKPR3		;YES

SKPR4:	CALL RMPROC		;NO, REMOVE A PROCESS FROM BALANCE SET
	 JRST [PUSH P,BSBITS	;COULDN'T FIND ONE, DO PANIC GCCOR
		SETZM BSBITS	;MAKE GCCOR COLLECT ALL UNLOCKED PAGES
		CALL GCCOR
		POP P,BSBITS
		AOS PANIC	;COUNT OCCURRENCES
		JRST SKPR3]

	JRST SKPR5		;FOUND ONE, RECHECK CORE SITUATION




SKPR3:	SKIPL 7,SSKED	;ARE WE NOSKED?
	 JRST SKPR11		;YES

	SKIPN 1,NGPROC	;ANY PROCS WAITING TO ENTER BAL SET?
	 JRST SKPR7	;NO

	SKIPL SCDRN1		;RUNNING SPECIAL JOB?
	 JRST SKPR6		;CALL LDPROC

	SKIPL 1,OLDSUM		;VALID OLD SUMNRX?
	CAMLE 1,SUMNRX		;YES, HAS SUMNRX GOTTEN SMALLER?
SKPR6:	CALL LDPROC	;TRY TO LOAD SOME PROCESSES

SKPR7:	SKIPN 10,NBPROC	;NUMBER OF BALSET PROCS
	 JRST BKGND1		;THERE AREN'T ANY

	MOVSI 11,-<MAXQ+1>		;INIT QUEUE LIST LOOP AOBJN POINTER

SKPR8:	HRRZ 6,RUNLST(11)	;GET FKPT ADDRESS FOR FIRST FORK

SKPR9:	CAIN 6,RUNLSB(11)	;END OF LIST?
	 JRST SKPR10		;YES, GO TO NEXT ONE

;WE HAVE A PROCESS TO LOOK AT, GET ITS FORK INDEX
	MOVEI 7,@FKPT6M	;FORK INDEX TO 7
	HRRZ 6,0(6)		;GET POINTER TO NEXT PROCESS

	MOVE 2,FKFLGS(7)	;GET FLAGS

	TLNN 2,BLST	;IS IT IN THE BALANCE SET?
	 JRST SKPR9	;NO, GET NEXT PROCESS

	TLNN 2,WTFK+FORCEM	;RUNNABLE?
	 JRST SKPR2	;YES, GIVE HIM CONTROL

	CALL WAITT	;INSPECT WAITING FORK
	 JRST [	SOJG 10,SKPR9	;GO ON TO NEXT PROC, IF ANYMORE IN BS
		JRST BKGND1]	;NO NEED TO LOOK FURTHER, GO IDLE

	JRST SKPR2

;MOVE ON TO THE NEXT LIST
SKPR10:	AOBJN 11,SKPR8		;ANOTHER LIST?
	 JRST BKGND1	;NO, NOBODY TO RUN

;TEST NOSKED FORK
SKPR11:	CALL WAITT		;NOSKED FORK MUST BE WAITING
	 JRST BKGND1		;STILL WAITING

	SETOM SSKED		;NO LONGER WAITING, RUN HIM
	ETMR SKBAL
	JRST SETRT







;TEST WAITING BALANCE SET PROCESS

WAITT:	HRRZ 2,FKPGST(7)	;GET ADDRESS OF TEST ROUTINE
	HLRZ 1,FKPGST(7)	;GET TEST DATA
	JSP 4,0(2)		;CALL IT
	 RET			;STILL WAITING

;FORK NO LONGER WAITING
WAITT2:	MOVSI 4,WTFK+NOSK
	ANDCAB 4,FKFLGS(7)	;TURN OFF WAIT AND NOSKED BITS

	AOS NBRUN		;COUNT RUNNABLE FORKS

	TLNN 4,FORCEM	;IS THIS A DELAYED FORCED BS REMOVAL?
	 JRST WAITT3		;NO

	HRRZ 1,FKPGST(7)	;YES
	CAIN 1,SWPINT	;WAS THIS PROCESS ENTERING BALANCE SET?
	 CALL UDNRP		;YES, CLEAN UP


	CALL REMBSF		;KICK HIM OUT

	RET

WAITT3:	HRRZ 1,FKPGST(7)
	CAIE 1,SWPINT	;ENTERING BALANCE SET?
	 JRST RSKP		;SKIP RETURN

	SKIPN PRELDF		;PRELOADING DESIRED?
	 JRST WAITT4		;NO

	HLRZ 1,FKWSP(7)	;IS THERE ENOUGH CORE TO PRELOAD?
	CAMLE 1,NRPLQ
	 JRST [SKIPG IOIP	;NO, FREE PAGES ON THE WAY?
		JRST .+1	;NO, LOAD AS MUCH AS POSSIBLE NOW
		MOVSI 1,WTFK	;YES, MAKE HIM WAIT AGAIN
		IORM 1,FKFLGS(7)
		SOS NBRUN
		RET]

	PUSH P,6
	PUSH P,10
	CALL PRELD		;PRELOAD THE WS
	POP P,10
	POP P,6

WAITT4:	CALL UDNRP
	JRST RSKP



;UPDATE FOR PROCESS FINISHED ENTERING BALSET
UDNRP:	SKIPN PRELDF		;PRELOADING?
	RET

	HLRZ 1,FKWSP(7)		;PRELOAD SIZE AS DETERMINED BY LDPROC
	MOVN 1,1
	ADDM 1,NRPMIN		;REMOVE FROM REPLQ RESERVE
	RET



;TEST EDISMS FORK FOR ELAPSED GRACE PERIOD

DISMT:	PUSH P,4	;SAVE AC4

	MOVE 2,FKFLGS(7)	;GET FLAG WORD
	TLNE 2,FORCEM		;DELAYED FORCED REMOVAL?
	 JRST DISMT2		;YES

;SEE IF EDISMS WAIT IS OVER
	MOVE 2,FKSTAT(7)
	HLRZ 1,2
	JSP 4,0(2)	;CALL ACTIVATION ROUTINE
	CAIA			;STILL WAITING
	JRST RSKP		;NO LONGER WAITING


;STILL BLOCKED, SEE IF PSI IS PENDING
DISMT4:	SKIPGE 1,FKINT(7)	;INTERRUPT PENDING?
	TLNE 1,(1B1)		;AND ACCEPTABLE?
	 JRST DISMT3		;NO, SEE IF GRACE PERIOD IS OVER

	MOVSI 1,PSIWTF		;YES, REMEMBER FORK WAS WAITING
	IORM 1,FKINT(7)

	JRST RSKP

;SEE IF GRACE PERIOD IS OVER
DISMT3:	HLRZ 1,FKPGST(7)
	JSP 4,BLOCKW		;GRACE PERIOD OVER?
	RET		;NO

DISMT2:	CALL REMBSJ


	RET

;ROUTINE TO DETERMINE WHETHER FORK IS WAITING
; CHECKS FOR FORK ON WAIT-LIST OR BEING HELD IN BALANCE SET
;TAKES FORK INDEX IN AC7. CLOBBERS NO ACS.
;SKIP RETURNS IF FORK IS WAITING, RETURNS +1 OTHERWISE.
CHKWT::	PUSH P,1

	MOVE 1,FKFLGS(7)	;SEE IF FORK ON WAIT-LIST
	TLNE 1,WTLS
	 JRST CHKWT1		;IT IS, SKIP RETURN

;SEE IF BEING HELD IN BALANCE SET
	TLC 1,WTFK+RNLS+BLST
	TLNE 1,WTFK+RNLS+BLST
	 JRST CHKWT2		;NOT BEING HELD
	HRRZ 1,FKPGST(7)	;ITS IN BALANCE SET AND NOT RUNNABLE
	CAIN 1,DISMT		;BEING HELD?
CHKWT1:	AOS -1(P)		;YES
CHKWT2:	POP P,1			;NO, RESTORE AC1
	RET			;AND RETURN


;GIVE CONTROL TO SELECTED PROCESS

SKPR2:	ETMR SKBAL	;FINISH TIMING BALANCE SET SCHEDULER

	SKIPL SCDRN1		;RUN SPECIAL JOB?
	 JRST SKDSP		;YES

SETRT:	HRRZM 7,FORKX
	CALL SETPPG		;SETUP PAGER FOR THIS PROCESS

IFE PIESLC,<
	HLRZ 2,FKQ(7)		;SETUP REMAINING TIME
	HRRZ 3,FKQ(7)
	SUB 3,QBASE(2)
> ;END NON-PIE-SLICE SCHEDULER CONDITIONAL

IFN PIESLC,<
	HRRZ 3,FKQ(7)		;GET REMAINING TIME ON THIS QUEUE
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	MOVEM 3,RJQNT
	SETZM RUNT1
	AOS SOLD+1		;COUNT TOTAL RESCHEDULES
	HLRZ 1,FKQ(7)		;QUEUE LEVEL OF FORK
	HLRZ 2,FKJOB(7)		;JOB NUMBER OF FORK
	CAIG 2,^D32		;DONT DISPLAY IF GT JOB 32
	IOR 1,BITS(2)		;BIT POSITION DESIGNATES JOB NUMBER
	MOVEM 1,21		;FORK NUMBER AND STATUS FOR LIGHTS

IFN KIFLG,<
	JRST SETOVF>		;SET UP FLAGS IN OTHER MODULE FOR KI10
IFN KAFLG,<
SETOVF:	MOVEI 2,5B29+5B32	;CLEAR OV AND FOV FLAGS
	MOVE 1,PSICHM		;GET THIS FORKS CHANNEL MASK
	TLNE 1,(1B6)		;CHANNEL 6?
	TRC 2,6B32		;YES, ENABLE OVERFLOW
	TLNE 1,(1B7)		;CHANNEL 7?
	TRC 2,6B29		;YES, ENABLE FLOATING OVERFLOW
	CONO APR,APRCHN(2)	;SET APR ACCORDING TO FORGOING
	RET			;RETURN (+2 IF CALLED FROM SCHED)
>
;RUN SPECIAL JOB ONLY
SKDSP:	HLRZ 1,FKJOB(7)		;GET SELECTED FORK'S JOB NO.
	CAMN 1,SCDRN1		;IS IT THE RIGHT JOB?
	 JRST SETRT		;YES

	CALL RMPROC		;NO, THROW OUT A PROCESS
	BUG (HLT,<COULDN'T FLUSH BAL SET FOR SPECIAL JOB>)


;BACKGROUND ACTIVITIES, IF NO PROCESS TO RUN

BKGND1:	SKIPGE BKGFLG
	JRST .+3	;ALREADY BACKGROUND
	JSP 4,ETIME	;FINISH TIMING ROUTINE
	ADDM 1,JOBRTT	;BUT ADD BACK INTO JOBRTT SO SWAPWT GETS CHARGED

	MOVSI 16,-NBKR		;PERFORM ANY PERIODIC ROUTINES
	XCT BKGNDT(16)		;WHICH CAN BE RUN MORE OFTEN THAN
	AOBJN 16,.-1		;WHEN THEIR CLOCK RUN OUT

	SETZ 1,
	EXCH 1,JOBRTT		;GET TIME SINCE LAST UPDATE
	SKIPG 2,NBPROC		;ANYONE IN BALANCE SET?
	IOR 2,NGPROC		;OR WAITING TO ENTER BAL SET?
	 JUMPE 2,[ADDM 1,IDLE	;NO .. TREAT AS IDLE TIME
		SKIPL BKGFLG
		AOS IDLE+1
		JRST BKGND2]


	SKIPL SSKED		;NOSKED?
	 JRST [SKIPG NBRUN	;ANYBODY RUNNABLE?
		JRST .+1	;NO ,CHARGE TO IOWT
		ADDM 1,NSKWT	;CHARGE TO NOSKED WAIT
		SKIPL BKGFLG
		AOS NSKWT+1
		JRST BKGND2]

	ADDM 1,SWAPWT		;CHARGE TO SWAPWT
	SKIPL BKGFLG
	AOS SWAPWT+1


BKGND2:	SETOM BKGFLG		;INDICATE BACKGROUND
	SETZM WAITLS		;INSURE FULL SCAN OF WAIT LIST

	SKIPE CGFLG		;EXPLICIT GCCOR REQUEST?
	 CALL GCCOR		;YES


SCHRST:	MOVE P,PI7P		;REINITIALIZE STACK POINTER
	AOJA 0,SCH0		;TRY AGAIN

;CORE OVER RESERVED, SELECT PROCESS TO REMOVE
;SELECT PROCESS WITH LOWEST PRIORITY THAT CAN BE REMOVED

RMPROC:	SKIPL SCDRN1		;ARE WE RUNNING SCECIAL JOB?
	 JRST RMPR2		;YES, DONT CHECK FOR ONE PROCESS

	MOVE 1,NBPROC
	CAIG 1,1	;ONLY ONE PROCESS IN BALSET?
	 JRST RMPR1	;YES, MUST BE A BIG ONE

RMPR2:	MOVEI 1,MAXQ

RMPR3:	HLRZ 6,RUNLSB(1)

RMPR4:	CAIN 6,RUNLST(1)	;END OF LIST?
	 JRST RMPR5		;YES, GO TO NEXT ONE

	MOVEI 7,@FKPT6M		;GET FORK INDEX
	HLRZ 6,0(6)		;GET POINTER TO NEXT FKPT

	MOVE 2,FKFLGS(7)
	TLNN 2,BLST		;IS THIS A BAL SET PROCESS?
	 JRST RMPR4		;NO

	SKIPL SCDRN1	;ARE WE RUNNING A SPECIAL JOB?
	 JRST [HLRZ 10,FKJOB(7)
		CAMN 10,SCDRN1	;IS THIS THE RIGHT ONE?
		JRST RMPR4		;YES, DONT KICK HIM OUT
		JRST .+1]

	TLNE 2,NOSK		;CAN THIS GUY BE KICKED OUT?
	 JRST RMPR4	;NO

	TLNE 2,FORCEM		;WAITING FOR FORCED BALSET REMOVAL?
	 JRST [PUSH P,1		;YES, TRY TO KICK HIM OUT
		CALL WAITT
		POP P,1
		JRST RMPR4]

	TLNE 2,WTFK	;IS THIS FORK WAITING?
	 JRST [MOVSI 10,FORCEM+WTCLCT	;INDICATE FORCED OUT AND AWAITS COLLECTION
		IORM 10,FKFLGS(7)
		HRRZ 10,FKWSP(7)
		ADDM 10,POTEN	;INCREASE POTENTIALLY COLLECTABLE
		HRRZ 2,FKNR(7)
		SUBI 10,0(2)
		ADDM 10,SUMNRX
		AOS NREMJ
		MOVE 2,FKCNO(7)
		MOVE 2,BITS(2)
		ANDCAM 2,BSBITS		;BAL SET MASK FOR GCCOR
		JRST RSKP]

	CALL REMBSF		;KICK HIM OUT NOW

	AOS NREMJ

	JRST RSKP

;END OF LIST, GO TO NEXT ONE
RMPR5:	SOJGE 1,RMPR3
	RET

RMPR1:	MOVE 1,NRPLQ	;TIGHT ON CORE?
	CAMLE 1,NRPMIN
	 RET		;NO, LEAVE BALANCE SET AS IS

	JRST RMPR2




;REMOVE PROCESS FROM BALANCE SET

REMBSF:	TDZA 3,3
REMBSJ:	SETO 3,
	MOVE 1,FKFLGS(7)	;SEE IF DELAYED FORCED REMOVAL
	TLNE 1,FORCEM
	 JRST REMBS4		;IT IS, FOLLOWING HAS BEEN DONE


	TLO 1,WTCLCT		;INDICATE AWAITS COLLECTION
	MOVEM 1,FKFLGS(7)
	HRRZ 2,FKWSP(7)	;DECREASE SUMNRX BY FKNR-FKWSP
	ADDM 2,POTEN	;INCREASE POTENTIALLY COLLECTABLE
	MOVE 1,FKNR(7)
	SUBI 2,0(1)
	ADDM 2,SUMNRX
	MOVE 2,FKCNO(7)
	MOVE 2,BITS(2)
	ANDCAM 2,BSBITS		;MASK FOR GCCOR

;IF NEITHER PRELOADING NOR POSTPURGING, AVOID POSTPG CALL
REMBS4:	SKIPN 1,PRELDF
	IOR 1,POSPGF
	JUMPE 1,REMBS3
	PUSH P,10
	PUSH P,6
	PUSH P,3
	MOVE 1,3
	CALL POSTPG
	POP P,3
	POP P,6
	POP P,10

REMBS3:	HLRZ 2,FKJOB(7)		;MAINTAIN SUBSYS INFO
	HRRZ 2,JOBNAM(2)
	HRRZ 1,FKNR(7)
	HRLI 1,(1B14)		;COUNT REMOVALS FROM BALSET
	ADDM 1,SWAKES(2)	;INTEGRATE SIZE


	MOVSI 2,-PLKV

	SKIPN INDFLG		;ARE WE LOCKING JSB'S?
	 JRST REMB1		;NO

	HRRZ 1,FKJOB(7)	;GET SPT INDEX OF JSB
	MOVE 1,SPT(1)	;GET CORE INDEX
	ADDM 2,CST1(1)	;REDUCE LOCK COUNT

REMB1:	HRRZ 1,FKPGS(7)	;PSB SPT INDEX
	MOVE 1,SPT(1)
	ADDM 2,CST1(1)	;UNLOCK PSB

	HLRZ 1,FKPGS(7)	;UPT SPT INDEX
	JUMPE 1,.+3		;NO UPT
	MOVE 1,SPT(1)
	ADDM 2,CST1(1)	;UNLOCK UPT

	MOVSI 1,BLST+FORCEM
	ANDCAB 1,FKFLGS(7)	;TURN OFF BAL SET BIT

	TLZE 1,WTFK		;WAITING FORK?
	JRST [ANDM 1,FKFLGS(7)	;TURN OFF WAIT BIT
		JRST REMBS2]
	SOS NBRUN		;WE ARE REMOVING A RUNNABLE FORK

REMBS2:	SOS NBPROC

	JUMPGE 3,[AOS NGPROC
		RET]

;REMOVE PROCESS FROM RUNLST AND PLACE ON WTLST
	CALL REMRUN

	SETOM OLDSUM		;INDICATE OLDSUM INVALID

	MOVE 1,FKCNO(7)
	MOVE 1,BITS(1)
	ANDCAM 1,RLBITS		;MAINTAIN MASK FOR GCCOR

IFN PIESLC,<
	MOVE 1,FKFLGS(7)
	TLNE 1,NOCNT		;ARE WE TO DECREMENT NAPROC?
	 JRST REMBS5		;NO
	HLRZ 1,FKJOB(7)
	MOVE 1,PIEGRP(1)	;GET PIESLICE GROUP INDEX
	MOVSI 2,(-1.0)
	FADRM 2,NAPROC(1)
REMBS5:
> ; END PIE-SLICE SCHEDULER CONDITIONAL


	HRRZ 1,0(P)	;SEE IF WE SHOULD DO WTCONC CALL
	CAIE 1,HLTFK3	;IF FROM HLTFK3 DONT DO IT
	CALL WTCONC
	RET



;ADD PROCESS TO BALANCE SET IF POSSIBLE

LDPROC:	STMR		;BEGIN TIMING THIS ROUTINE


	CALL SCDRUN		;SELECT BEST RUNNABLE FORK

	JRST LDPRT	;RETURN IF NONE FOUND


;PROMOTE TO THE BALANCE SET
LDPR2:	MOVE 3,NRPLQ		;SEE IF ENOUGH PAGES ON RPLQ TO LOAD PSB&UPT
	CAIGE 3,MINNR
	 JRST [ADD 3,IOIP	;ADD WRITES IN PROGRESS
		CAIL 3,MINNR	;NNOW ENOUGH?
		JRST LDPRT		;YES, JUST RETURN WITHOUT GCCOR
		PUSH P,7
		CALL GCCOR	;TRY TO GET SOME PAGES
		POP P,7
		MOVE 3,NRPLQ	;NOW TEST
		CAIGE 3,MINNR	;ENOUGH NOW?
		JRST LDPRT		;NO
		JRST LDPR3]

LDPR3:	HRRZ 1,FKNR(7)
	SKIPE 2,FKWSP(7)
	SUBI 1,0(2)		;FKNR-FKWSP
	ADDM 1,SUMNRX		;UPDATE SUMNRX

	MOVSI 10,BLST+WTFK+ZIFA	;INDICATE WAITING, BAL SET FORK AND REQUEST
			;CLEAR OF IFAV

	IORB 10,FKFLGS(7)

	TLNN 10,WTCLCT		;FORK BEEN GCCOR'D?
	 JRST .+3
	MOVNI 2,0(2)		;NO
	ADDM 2,POTEN

	SETOM OLDSUM		;INDICATE OLDSUM INVALID
	SOS NGPROC
	AOS NBPROC

	SKIPN PRELDF		;PRELOADING WANTED?
	 JRST LDPR4		;NO



;NOTE THAT IT IS ASSUMED HERE THAT FKNR-FKWSP IS STILL IN AC1
;LEFT OVER FROM LDPR3!!
	HRLM 1,FKWSP(7)	;SAVE
	ADDM 1,NRPMIN	;MAKE SURE WE HAVE THEM ON RPLQ

LDPR4:	HRRZ 1,FKPGS(7)		;GET PSB INTO CORE
	JUMPN 1,.+3
	CALL ASSPT		;NO PSB, GO ASSIGN ONE
	HRRZM 1,FKPGS(7)
	CALL SWPIN0
	HLRZ 1,FKPGS(7)
	JUMPN 1,.+3
	CALL ASSPT		;NO UPT, ASSIGN ONE
	HRLM 1,FKPGS(7)
	CALL SWPIN0
	HRRZ 1,FKJOB(7)		;GET JSB SPTN
	JUMPN 1,.+3		;IS ONE?
	CALL ASSPT		;NO, ASSIGN FOR NEW JOB
	HRRM 1,FKJOB(7)
	SKIPE INDFLG		;LOCKING JSB'S?
	CALL SWPIN0		;SWAP IT IN AND LOCK IT
	MOVEI 1,SWPINT
	MOVEM 1,FKPGST(7)	;SET TEST TO WAIT FOR PSB AND PT

	MOVE 1,FKCNO(7)
	MOVE 1,BITS(1)
	IORM 1,BSBITS		;MAINTAIN MASK FOR GCCOR


	ETMR SKLDPR		;FINISH TIMING THIS ROUTINE
	RET			;AND EXIT

LDPRT:	ETMR SKLDPR		;COMPLETE TIMING OF THIS ROUTINE
	RET			;NO SKIP RETURN


;SELECT PROCESS TO PROMOTE TO BALANCE SET

SCDRUN:	MOVSI 1,-<MAXQ+1>
	SETZ 4,		;4 USED TO ACCUMULATE NR OF BALSET PROCS
SCDR1:	MOVEI 6,RUNLST(1)	;ADDRESS OF CURRENT LIST POINTER
SCDR2:	HRRZ 6,0(6)	;GET ADDRESS OF NEXT FKPT ENTRY

	CAIN 6,RUNLSB(1)	;END OF LIST?
	 JRST SCDR3		;YES, GO TO NEXT ONE

	MOVEI 7,@FKPT6M	;GET FORK INDEX

	MOVE 2,FKFLGS(7)	;GET FLAG WRD

	TLNE 2,BLST	;IN BALANCE SET?
	 JRST [MOVE 2,FKNR(7)	;YES, ACCUMULATE NR
		ADDI 4,0(2)
		JRST SCDR2]

	SKIPL SCDRN1	;RUNNING A SPECIAL JOB?
	 JRST [HLRZ 10,FKJOB(7)	;YES, ONLY LOAD ITS FORKS
		CAME 10,SCDRN1
		JRST SCDR2	;THIS FORK NOT PART OF SPEC. JOB
		JRST .+1]

;SEE IF HE CAN ENTER BY DISPLACING LOWER PRIORITY BALSET FORKS
	HRRZ 5,FKNR(7)		;SPACE HE WILL NEED
	SKIPE 3,FKWSP(7)	;SPACE HE CURRENTLY OCCUPIES
	SUBI 5,0(3)		;DEDUCT FROM FKNR IF NON-ZERO
	ADDI 5,0(4)		;PLUS SPACE REQUIRED BY HIGHER PRIORITY FORKS
	CAMGE 5,MAXNRX		;DOES THIS EXCEED MAXNRX?
	 JRST RSKP		;NO, OKAY TO LOAD
SCDR4:	MOVE 5,SUMNRX		;YES, SAVE SUMNRX
	MOVEM 5,OLDSUM
	RET

;NEXT LIST
SCDR3:	AOBJN 1,SCDR1
	JRST SCDR4


;LIST MAINTENANCE SUBROUTINES

; REMOVE FORK FROM CURRENT LIST
REMOVE:	MOVE 3,FKPT(7)
	HLLM 3,(3)		;NEXT POINTS BACK TO PREVIOUS
	MOVS 3,3
	HLRM 3,(3)		;PREVIOUS POINTS FORWARD TO NEXT
	RET

; INSERT FORK ON LIST
;RH(3) POINTS TO EXISTING ENTRY ON LIST. FORK WILL BE INSERTED ABOVE IT.
INSERT:	HRLI 3,FKPT(7)		;LH(3)=ADDRESS(NEW FKPT)
	HLRZ 4,(3)		;RH(4)=ADDRESS(OLD FKPT)
	HLLM 3,(3)		;TAIL POINTS BACK TO NEW
	HLRM 3,(4)		;OLD POINTS FORWARD TO NEW
	HRLZM 4,FKPT(7)		;NEW POINTS BACK TO OLD
	HRRM 3,FKPT(7)		;NEW POINTS FORWARD TO TAIL
	RET

; REMOVE A FORK FROM THE RUNLIST IT IS ON
REMRUN:	CALL REMOVE
	MOVSI 3,RNLS
	ANDCAM 3,FKFLGS(7)
	RET

; REMOVE FORK FROM WAITLIST
REMWT:	CALL REMOVE
	MOVSI 3,WTLS
	ANDCAM 3,FKFLGS(7)
	RET

; APPEND FORK TO RUNLIST
APPRUN:	HLRZ 3,FKQ(7)
	MOVEI 3,RUNLSB(3)
	CALL INSERT
	MOVSI 3,RNLS
	IORM 3,FKFLGS(7)
	RET

; APPEND FORK TO WAITLIST
APPWT:	MOVEI 3,WTLSTB
	CALL INSERT
	MOVSI 3,WTLS
	IORM 3,FKFLGS(7)
	RET

;REMOVE FORK FROM CURRENT RUNLIST AND PLACE ON RUNLIST SPECIFIED BY
;CURRENT CONTENTS FOR FKQ
CHGRLS:	CALL REMOVE		;REMOVE FROM CURRENT LIST
	HLRZ 3,FKQ(7)		;QUEUE

IFN PIESLC,<
	CAIN 3,COMPQ		;GOING TO COMPQ?
	JRST REQUE		;PLACE ON COMPQ
> ;END PIE-SLICE CONDITIONAL

	MOVEI 3,RUNLSB(3)	;TAIL POINTER
	CALL INSERT
	RET

IFN PIESLC,<
;TRANSPARENT ROUTINE TO INSERT A FORK IN ITS PROPER PLACE ON THE COMPQ
REQUE:	ADD P,BHC+7
	JUMPGE P,MSTKOV##
	MOVEM 7,-6(P)
	MOVEM 6,-5(P)
	MOVEM 5,-4(P)
	MOVEM 4,-3(P)
	MOVEM 3,-2(P)
	MOVEM 2,-1(P)
	MOVEM 1,(P)

	CALL UPDUT		;UPDATE FORK'S UTIL AVERAGE
	CALL CDIST		;GET DISTANCE FROM TARGET
	MOVE 5,1		;SAVE IT IN AC5

	MOVEI 6,RUNLST+COMPQ	;PREPARE TO CHASE DOWN COMPQ
REQUE1:	HRRZ 6,0(6)		;NEXT FORKPT
	CAIN 6,RUNLSB+COMPQ	;ARE WE AT THE END?
	 JRST REQUE2		;YES
	MOVEI 7,@FKPT6M		;NO
	CALL CDIST		;GET THIS FORK'S DISTANCE FROM TARGET
	CAMGE 5,1		;SAVED DISTANCE .GE. THIS ONE?
	 JRST REQUE1		;NO, DON'T WANT TO PUT HIM HERE

REQUE2:	MOVE 3,6		;GET FKPT TO INSERT AT
	MOVE 7,-6(P)		;AND FORKX WE SAVED
	CALL INSERT		;AND STUFF HIM ONTO COMPQ


	MOVE 1,(P)
	MOVE 2,-1(P)
	MOVE 3,-2(P)
	MOVE 4,-3(P)
	MOVE 5,-4(P)
	MOVE 6,-5(P)
	SUB P,BHC+7
	RET
> ;END PIE-SLICE SCHED CONDITIONAL

;PUT PROCESS ON THE WAITLIST

WTCONC:	MOVE 1,TODCLK		;SAVE TIME FORK WAS PUT INTO WAITING
	MOVEM 1,FKPGST(7)

	HRRZ 1,FKWSP(7)
	JUMPN 1,WTCON1		;NO PAGES IN CORE?
	HRRZ 1,FKCNO(7)		;YES, HAS CORE NUMBER?
	JUMPE 1,WTCON1
	MOVE 1,BITS(1)		;YES, DEASSIGN IT
	IORM 1,FRECB
	HLLZS FKCNO(7)
WTCON1:	CALL APPWT			;APPEND TO WAITLIST

	RET

;PERFORM WAIT LIST SCAN FOR UNBLOCKED PROCESSES
WTSCAN:	STMR 		;TIME WAIT LIST SCAN

	SETZM ISKED
	SETZM WAITFS		;RESET FULL-SCAN FLAG
	MOVE 6,TODCLK		;GET TIME-NOW
	SUB 6,WAITLS		;LESS TIME OF LAST FULL SCAN
	CAIL 6,^D750		;HAS IT BEEN 3/4 SEC OR MORE?
	 JRST	[AOS WAITFS	;YES, INDICATE FULL SCAN DESIRED
		ADDM 6,WAITLS	;WAITLS=TIME NOW
		JRST .+1]

	HLRZ 6,WTLSTB		;BEGIN BACKWARDS SCAN
WTSCN1:	CAIN 6,WTLST		;DONE YET?
	 JRST WTSCN2		;YES
	MOVEI 7,@FKPT6M		;FORK INDEX

	HLRZ 6,0(6)		;GET FKPT ADDRESS OF NEXT ENTRY


	MOVE 1,TODCLK		;TIME NOW
	SUB 1,FKPGST(7)		;LESS TIME THIS PROCESS ENTERED WAIT LIST
	CAIL 1,^D3000		;HAS HE BEEN THERE 3 SEC OR MORE?
	 JRST [SKIPN WAITFS	;FULL SCAN REQUIRED?
		JRST WTSCN2	;NO, TERMINATE THE SCAN HERE
		JRST .+1]	;YES, CONTINUE

	SKIPGE 1,FKINT(7)	;INTERRUPT REQUESTED?
	JRST [	TLNE 1,(1B1)	;AND ACCEPTABLE?
		JRST .+1	;NOW DEFERRING...
		MOVSI 1,PSIWTF
		IORM 1,FKINT(7)	;REMEMBER WAS IN WAIT STATE
		IFN PIESLC,<CALL INCNAP>
		CALL PSIAWK	;AWAKEN WITHOUT NEWST
		JRST WTSCN1]	;NEXT FORK
	MOVE 2,FKSTAT(7)	;GET ACTIVATION TEST
	HLRZ 1,2
	JSP 4,0(2)		;CALL TEST ROUTINE
	JRST WTSCN1		;NO SKIP => STILL NOT RUNNABLE
	CALL AWAKEN		;FORK IS ARISING

	JRST WTSCN1		;NEXT ONE


WTSCN2:	ETMR SKWAIT		;FINISH TIMING WAITLIST SCAN
	RET


;TRANSPARENT CALL TO AWAKEN.
PRWAKE:: PUSH P,1
	PUSH P,2
	PUSH P,3
	PUSH P,4
	CALL AWAKEN
	POP P,4
	POP P,3
	POP P,2
	POP P,1


	RET


;ROUTINE TO MOVE FORK FROM WAIT LIST TO RUNLIST. FORKX IN 7.
;ALTERNATE ENTRY POINT 'PSIAWK' USED FOR SLEEPING FORK THAT'S BEEN
;PSI'D.
AWAKEN:
IFN PIESLC,<CALL INCNAP>
	AOS WAKEUP		;NOW RUNNABLE, COUNT UNBLOCKS
	CALL NEWST		;ESTABLISH NEW QUEUE STATUS
PSIAWK:	MOVSI 1,HOLD		;PREPARE TO SEE IF THIS FORK
				;SHOULD BE HELD IN BALSET AFTER NEXT
	MOVE 2,TODCLK		;DISMISS
	SUB 2,FKPGST(7)		;AC2=DURATION OF DISMISS
	CAMLE 2,MAXBSH		;LESS THAN OR EQUAL TO MAXBSH?
	ANDCAB 1,FKFLGS(7)	;NO, TURN OFF HOLD BIT
	IORB 1,FKFLGS(7)	;YES, SET HOLD BIT. NOP IF WE FALL
				;THRU FROM ANDCAB.
	TLZN 1,WTLS		;MAKE SURE THIS GUY'S ON WAITLIST
	BUG (HLT,<ATTEMPT TO WAKE-UP FORK NOT ON WAITLIST>)
	TLO 1,RNLS		;TURN ON RUNLIST BIT
	MOVEM 1,FKFLGS(7)	;AND STUFF THE WHOLE THING IN FKFLGS


;PLACE PROCESS ON PROPER QUEUE LIST

	CALL CHGRLS		;PLACE ON RUNLIST
	AOS NGPROC
	SETOM OLDSUM		;INDICATE OLDSUM INVALID


;ASSIGN A CORE NUMBER
	HRRZ 2,FKCNO(7)
	JUMPN 2,[MOVE 2,BITS(2)	;ALREADY ASSIGNED
		IORM 2,RLBITS	;MASK FOR GCCOR
		RET]

	MOVE 2,FRECB
	JFFO 2,.+2		;NONE AVAILABLE
	MOVEI 3,^D35		;YES, USE 35
	MOVE 2,BITS(3)
	ANDCAM 2,FRECB
	IORM 2,RLBITS		;MASK FOR GCCOR
	HRRM 3,FKCNO(7)

	RET


IFN PIESLC,<
; ROUTINE TO INCREMENT NAPROC

INCNAP:	MOVE 1,FKFLGS(7)
	TLNE 1,NOCNT		;ARE WE TO INCREMENT NAPROC
	 RET			;NO
	HLRZ 1,FKJOB(7)		;GET JOB NUMBER
	MOVE 1,PIEGRP(1)	;GET PIE-SLICE GROUP INDEX
	MOVSI 2,(1.0)		;UPDATE ACTIVE PROCESS COUNT
	FADRM 2,NAPROC(1)
	RET
> ;END PIE-SLICE SCHEDULER CONDITIONAL



;DISMISS JOB FOR RESCHEDULING OR ON QUANTUM OVERFLOW

DISMSJ:	SKIPGE 7,FORKX
	 RET			;NOTHING IN FORKX
	CALL SAVRT		;UPDATE QUEUE AND QUANTUM
	SETZ 1,
	JRST SCHP2

;UPDATE QUEUE NUMBER AND TIME USED VALUE

SAVRT:	MOVE 1,IFTIM		;HAS HE GONE .5 SEC. WITHOUT FAULTING?
	CAIGE 1,^D500
	 JRST SAVRT2		;NO

	MOVE 1,FKFLGS(7)
	TLOE 1,NOFLT		;HAVE WE ALREADY DONE FKNR ADJUSTMENT?
	 JRST SAVRT2		;YES, DON'T KEEP DOING IT

	MOVEM 1,FKFLGS(7)	;REPLACE FKFLGS WITH NOFLT BIT ON

	HRRZ 1,FKNR(7)		;MAKE FKNR=FKWSP+1
	HRRZ 2,FKWSP(7)
	SUBI 2,-1(1)
	ADDM 2,SUMNRX
	ADDM 2,FKNR(7)

SAVRT2:	HLRZ 2,FKQ(7)		;CURRENT QUEUE NUMBER
	HRLOI 1,377777		;LARGEST NUMBER
	EXCH 1,RJQNT		;GET REMAINING QUANTUM
	MOVE 3,RUNT1		;RUNTIME THIS RUNNING
	ADDM 3,QSUM(2)		;ACCUMULATE STATISTIC
	JUMPG 1,DISMJ1		;NOT EXHAUSTED
	SETOM OLDSUM		;INDICATE OLDSUM INVALID

IFE PIESLC,<
	MOVE 1,JOBNO
	SKIPE JOBCK0		;GUARANTEE WORDS INIT'ED?
	JRST SAVRT7		;YES, GO CHECK CURRENT PERFORMANCE
	MOVE 3,TODCLK		;INITIALIZE TIME QUARANTEE WORDS
	MOVEM 3,JOBCK0
	MOVE 3,JOBRT(1)
	MOVEM 3,JOBCK1
SAVRT7:	LDB 3,[POINT 7,JOBBIT,17] ;GET GUARANTEE PERCENTAGE
	JUMPE 3,SAVRT8		;NOT SPECIAL
	LDB 4,[POINT 6,JOBBIT,23]	;DOES FORK HAVE TEMP MINQ?
	JUMPN 4,SAVRT8		;YES, IGNORE PCT. PRIORITY
	MOVE 4,JOBRT(1)		;COMPUTE RUNTIME DURING TEST INTERVAL
	SUB 4,JOBCK1
	MOVE 1,TODCLK		;COMPUTE REAL TIME OF TEST INTERVAL
	SUB 1,JOBCK0
	IMULI 4,^D100		;COMPUTE RUNTM*100%/PCT TO GET
	IDIV 4,3		;EXPECTED REAL TIME
	SUB 4,1			;EXCESS OR DEFICIT OF REAL TIME
	MOVEM 4,23		;FOR LIGHT WATCHERS
	HRLM 2,23		; ..
	JUMPGE 4,SAVRT5		;.G. 0 MEANS BETTER THAN GUARANTEE
	MOVEI 2,0		;KEEP ON QUEUE 0 TO GET EXCLUSIVE TIME
	JRST SAVRT9

SAVRT8:	LDB 3,[POINT 6,JOBBIT,35] ;GET MAX Q FOR THIS JOB
	CAIL 2,0(3)		;IF REACHED MAX Q, AND 
	JUMPN 3,[LDB 2,[POINT 6,JOBBIT,29] ;PRIORITY WORD NOT 0,
		MOVEM 7,23	;FOR DISPLAY
		JRST SAVRT9]	;SET NEW Q AS SPECIFIED
	CAIGE 2,MAXQ		;NOW ON MAX Q?
	AOJA 2,SAVRT9		;NO, GO TO NEXT ONE
SAVRT9:	LDB 3,[POINT 6,JOBBIT,23]	;TEMP MINQ??
	JUMPE 3,.+3		;NO
	CAILE 2,0(3)		;IS NEW QUEUE HIGHER OR SAME?
	MOVEI 2,0(3)		;NO, USE MINQ
	MOVSM 2,FKQ(7)
	CALL CHGRLS		;APPEND FORK TO APPROPRIATE RUN LIST
	SKIPA 1,QBASE+1(2)	;NEXT QUEUE TIME
DISMJ1:	ADD 1,QBASE(2)		;INCREASE BY BASE TIME
DISMJ2:	HRRM 1,FKQ(7)
	RET

SAVRT5:	CAIGE 4,LOWQT	;IS HE AHEAD BY MORE THAN LOWQT?
	 JRST SAVRT8	;NO

	LDB 2,[POINT 6,JOBBIT,35]	;GET MAXQ FOR THIS FORK
	SKIPE 2		;NO MAXQ
	CAIL 2,MAXQ
	MOVEI 2,MAXQ
	MOVSM 2,FKQ(7)
	CALL CHGRLS
	MOVE 1,QBASE+1	;GIVE HIM HI-Q QUANTUM
	JRST DISMJ2

;THIS ROUTINE ACCEPTS AN ARGUMENT IN AC1. IF THIS ARGUMENT IS
;NON-ZERO, THE CALLING FORK IS PLACED ON QUEUE 0. IN ANY CASE,
;THE ARGUMENT IS DEPOSITED IN JOBBIT IN THE SIX BIT BYTE ENDING AT
;BIT 23. THE SCHEDULER TREATS THIS BYTE AS A MINIMUM QUEUE IF NON-ZERO.
;THIS ROUTINE IS INTENDED FOR USE BY MONITOR ROUTINES WHICH ARE
;ABOUT TO USE A CRITICAL RESOURCE (SUCH AS LOCKING A DIRECTORY)
;AND WANT TO INSURE PROMPT COMPLETION.
STMINQ:: DPB 1,[POINT 6,JOBBIT,23]	;STASH THE ARG
	JUMPE 1,R		;IF ZERO NOTHING MORE TO DO.

	PUSH P,7		;SAVE AC7
	MOVE 7,FORKX		;GET INDEX OF THIS FORK

	NOSKED
	HRRZS FKQ(7)		;PUT HIM ON Q 0.
	PUSH P,3
	PUSH P,4
	CALL CHGRLS		;PUT HIM ON Q0 RUNLIST
	POP P,4
	POP P,3
	MOVE 1,QBASE+1		;GET Q0 QUANTUM
	HRRM 1,FKQ(7)		;STASH IN FKQ
	MOVEM 1,RJQNT		;AND IN RJQNT
	OKSKED

	POP P,7			;RESTORE 7
	RET

> ;END NON-PIE-SLICE SCHEDULER CONDITIONAL

IFN PIESLC,<
	MOVE 3,FKFLGS(7)
	TLNE 3,HIQFK		;FORK NEED SPECIAL SCHEDULING?
	 JRST [TLNE 3,SPQFK	;SPECIAL QUEUE?
		SKIPA 2,[SPECQ] ;YES
		MOVEI 2,INTERQ	;NO
		TLZE 3,PHIQFK	;FORGET THAT HE WAS ORIGINALLY ON INTERQ
		MOVEM 3,FKFLGS(7)
		CALL CHGQ	;SET UP FKQ
		CALL CHGRLS
		RET]


	MOVEI 2,COMPQ		;HE GOES ON COMPQ
	CALL CHGQ	;SET UP FKQ
	CALL CHGRLS			;APPEND TO NEW RUNLST
	RET

DISMJ1:	HRRM 1,FKQ(7)		;SAVE TIME LEFT ON THIS QUEUE
	RET


> ;END PIE-SLICE SCHEDULER CONDITIONAL


;CLOCK ROUTINES

;CALLED FROM APR INTERRUPT, 60 CY CLOCK INITIATES BREAK ON CH7
;FOR SERVICE

APCLK1:	CONO APR,1000+APRCHN	;TURN OFF FLAG
	AOS APCLKC		;FOR CH7 ROUTINE
	ISB 7
	SOSLE MSCNT		;THIRD TICK?
	JEN @PIAPRX
	MOVEM 1,MSCNT		;THIRD TICK (50 MS.), SYNC 1 MS. CLOCK
	SKIPE 1,SYNCC		;COUNTED 50 MS.?
	JRST [	ADDM 1,TODCLK	;NO, FINISH UP LAST TICKS
		ADDM 1,JOBRTT
		JRST .+2]	;AND LEAVE IT RUNNING
	MSCKON			;TURN CLOCK BACK ON
	MOVEI 1,^D50
	MOVEM 1,SYNCC		;SET TO SYNC AFTER 50 TICKS
	MOVEI 1,3		;AND 3 TICKS OF 60 HZ CLOCK
	EXCH 1,MSCNT
	JEN @PIAPRX

;SCHEDULER CLOCK UPDATE

APCLK:	SETZM APCLKC		;CLEAR REQUEST FLAG
	MOVEM 1,CLKAC1		;SAVE COUPLE AC'S
	MOVEM 2,CLKAC2
	MOVE 1,TODCLK		;CLOCK UPDATED BY 1MS INTERRUPT
	SUBM 1,OLDTCK		;COMPUT NUMBER MS. SINCE LAST UPDATE
	EXCH 1,OLDTCK		;SAVE 'NOW' IN OLDTCK
	MOVN 1,1
	MOVSI 2,-NPCLKS		;UPDATE PROCESS CLOCKS
APCLK3:	ADDM 1,RJQNT(2)		;UPDATE (RJQNT IS FIRST OF TABLE)
	SKIPG RJQNT(2)		;TIMED OUT?
	AOS SKEDF3		;YES, NOTIFY SCHED
	AOBJN 2,APCLK3
	MOVE 2,CLKAC2		;RESTORE AC2
	MOVE 1,CLKAC1
	JRST APCLKX


;TIMER ROUTINES

;	JSP 4,STIME	;STARTS TIMING
;	..		;PROGRAM
;	JSP 4,ETIME	;ENDS TIMING, RETURNS TIME IN 1
;	ADDM 1,CLOCK	;ADD TIME TO APPROPRIATE CLOCK

STIME:	SETZ 1,
	EXCH 1,JOBRTT		;GET AND RESET RUNTIME
	PUSH P,1
	JRST 0(4)

ETIME:	POP P,1			;OLD RUNTIME
	EXCH 1,JOBRTT		;RESTORE OLD RUNTIME, GET RUNTIME OF
	JRST 0(4)		;TIMED CODE AND RETURN IT

JSKP:	JRST 1(4)
JRET:	JRST 0(4)

;FLUSH ALL JOBS FROM THE BALANCE SET, THEN CALL GCALC
FSHBS:	SKIPL SSKED		;ARE WE NOSKED?
	 JRST SKPR1		;YES, DONT TRY TO FLUSH BALSET

	MOVSI 10,-<MAXQ+1>
FSHBS1:	MOVEI 6,RUNLST(10)
FSHBS2:	HRRZ 6,0(6)

	CAIN 6,RUNLSB(10)	;END OF LIST?
	 JRST FSHNL		;YES, GET NEXT ONE

	MOVEI 7,@FKPT6M	;GET FORK INDEX

FSHBSD:	MOVE 2,FKFLGS(7)	;GET FLAG WORD

	TLNN 2,BLST	;IS PROCESS IN BALANCE SET?
	 JRST FSHBS2	;NO

	TLNE 2,WTFK	;IS IT WAITING?
	 JRST FSHBSW	;YES

FSHBSN:	CALL REMBSF

	JRST FSHBS1

FSHBSW:	HRRZ 5,FKPGST(7)	;GET WAIT TEST

	CAIE 5,DISMT		;EDISMS?
	 JRST FSHBSS		;NO


	CALL REMBSJ

	JRST FSHBS1

FSHBSS:	HLRZ 1,FKPGST(7)
	JSP 4,0(5)		;CALL WAIT ROUTINE
	 JRST FSHBSD		;STILL WAITING

	CAIN 5,SWPINT		;WAS HE ENTERING BAL SET?
	 CALL UDNRP		;YES, UPDATE NRPMIN

	JRST FSHBSN

;NEXT LIST
FSHNL:	AOBJN 10,FSHBS1
	 JRST GCALC


;QUEUE PARAMETER TABLES


IFE PIESLC,<
	RADIX 10

QBASE:	0
	100
	500
	2500
	4500
	14500

LOWQT=10000			;TIME QUANTUM OF LOWEST QUEUE
	RADIX 8
> ;END NON-PIE-SLICE SCHEDULER CONDITIONAL


IFN PIESLC,<
SPECQ==0			;QUEUE FOR SPECIAL SCHEDULING
INTERQ==SPECQ+1			;INTERACTIVE QUEUE
COMPQ==INTERQ+1		;COMPUTATION QUEUE

QUANTS:	^D100
	^D100
	777777			;ESSENTIALLY INFINITE QUANTUM FOR COMPQ

; ROUTINE TO SET UP FKQ WITH PROPER QUANTUM AND QUEUE NUMBER
;QUEUE IN AC2
CHGQ:	HRL 2,QUANTS(2)		;GET QUANTUM
	MOVSM 2,FKQ(7)		;STASH IT AWAY
	RET


> ;END PIE-SLICE SCHEDULER CONDITIONAL

IFE PIESLC,<
;HEURISTIC FOR ADJUSTING QUEUE LEVEL AFTER I/O WAIT

;THIS ROUTINE IS THE PRINCIPLE CONTROL OVER THE EXTENT TO WHICH
;'INTERACTIVE' OR 'COMPUTE-BOUND' JOBS ARE FAVORED.  IT GIVES
;PRIORITY 'CREDIT' TO A FORK AS A RESULT OF WAITING.  THE MORE
;CREDIT GIVEN FOR A CERTAIN LENGTH WAIT (OR THE SHORTER THE WAIT
;REQUIRED TO BECOME HIGH-Q), THE MORE THE SYSTEM WILL FAVOR
;INTERACTIVE FORKS, AND THE GREATER THE CHANCE THAT FREQUENT OR
;WELL-TIMED INTERACTIONS WILL GIVE A PROCESS AN EXCESSIVELY LARGE
;SHARE OF COMPUTE TIME.  IT HAS BEEN DEMONSTRATED HOWEVER, THAT
;A COMPLETELY 'FAIR' ALGORITHM HERE, I.E. ONE WHICH PREVENTS AN
;INTERACTIVE FORK FROM GETTING ANY GREATER SHARE OF THE MACHINE
;THAN A COMPUTE-BOUND FORK, IS HIGHLY UNSATISFACTORY TO INTERACTIVE
;USERS UNDER MEDIUM AND HEAVY LOADS (AND ALL USERS ARE INTERACTIVE
;SOMETIMES), AND RESULTS IN EXPONENTIALLY INCREASING LEVELS OF
;FRUSTRATION, CURSING AND BEATING OF TERMINALS, ETC.  THEREFORE
;THIS ROUTINE IS GENUINELY A HEURISTIC, MODIFIED AS A RESULT OF
;PRESSURES BROUGHT TO BEAR ON SYSTEM PROGRAMMERS.

;THE FOLLOWING DESCRIBES THE CURRENT PRACTICE:
; 1. TTY INPUT WAITS OF .GE. 1 SEC GIVE HIGH-Q.  GREATLY REDUCES
;    USER FRUSTRATION LEVEL.
; 2. WAITS BY FORKS ON QUEUE 0 RESULT IN NO CHANGE TO Q VALUE
; 3. FORKS ON QUEUES 1 TO MAXQ-1 WILL BE HIGH-Q IF WAITING TIME IS
;    LONGER THAN LAST RUNTIME AS IMPLIED BY Q LEVEL.  THIS LIMITS
;    'WELL-TIMED' INTERACTIONS TO ABOUT 1/2 THE CPU.
; 4. FORKS ON MAXQ WILL BE HIGH-Q IF WAITING TIME IS LONGER THAN
;    THE MAXQ QUANTUM, AND WILL BE MOVED UP TO MAXQ-1 IF WAITING
;    TIME IS LONGER THAN SOME 'MINIMAL' TIME (500 MS)

;POSSIBLE ADJUSTMENTS INCLUDE:
; 1. INCLUDE NJOB WEIGHTING BY INCLUDING IDIV AT NEWST+3
; 2. REDUCE CPU LIMIT IN 3 ABOVE BY INCLUDING IDIVI 1,M AT NEWST2
;    MAX CPU USE WILL THEN BE 1-M/(M+1), E.G. 1/3 FOR M=2

;COMPUTE NEW Q VALUE

NEWST:	MOVE 1,TODCLK		;CALCULATE ACTUAL WAITING TIME
	SUB 1,FKPGST(7)
;	IDIV 1,IRJAV		;DIVIDE BY AV NUMBER RUNNABLE FORKS
	CAIGE 1,^D1000		;ABOVE MIN WAIT TIME?
	JRST NEWST2		;NO FOLLOW REGULAR ALGORITHM
	HRRZ 2,FKSTAT(7)
	CAIN 2,TCITST		;TTY INPUT?
	JRST NEWST1		;YES, BE MORE GENEROUS
NEWST2:	HLRZ 2,FKQ(7)		;CURRENT Q
	JUMPE 2,R		;NO CHANGE IF HIGHEST
	CAIGE 2,MAXQ		;LOW Q?
	JRST NEWST4		;NO, DO Q'S 1 TO MAXQ-1 ALGORITHM
	CAIL 1,LOWQT		;LOW Q - WAITED FULL QUANTUM?
	JRST PSSKD1		;YES, CAN BE HI-Q
	CAIGE 1,^D500		;.GE. MINIMAL WAIT?
	RET			;NO
	MOVEI 1,MAXQ-1		;YES, REQUE ON MAXQ-1
	JRST NEWST3

NEWST4:	HRRZ 3,FKQ(7)		;COMPUTE TIME USED ON CURRENT QUEUE
	MOVN 3,3
	ADD 3,QBASE+1(2)
	CAMGE 1,3		;WAIT TIME LONGER THAN THAT?
	JRST [	ADDM 1,FKQ(7)	;NO, GIVE CREDIT FOR WAIT, LEAVE
		RET]		;FORK ON SAME QUEUE
	ADD 3,QBASE(2)		;ADD TIME USED ON EARLIER QUEUES
	CAML 1,3		;WAIT TIME LONGER THAN THAT?
	JRST PSSKD1		;YES, HI-QUEUE THE FORK
	MOVEI 1,-1(2)		;NO, BUMP FORK UP ONE LEVEL
	JRST NEWST3

PSSKD1:				;REINIT ON QUEUE 0 AND CLEAR WS
NEWST1:	MOVEI 2,6		;TTYIN COMPLETED -- IF LONG WAIT,
	HRRZ 1,FKWSP(7)
	CAIGE 2,0(1)		;CHOOSE MIN(6,SIZE)
	MOVEI 2,0(1)
	HRRM 2,FKNR(7)
	SETZ 1,			;INIT ON QUEUE 0
NEWST3:	MOVE 2,QBASE+1(1)
	HRLI 2,0(1)		;CONSTRUCT NEW Q WORD
	MOVEM 2,FKQ(7)
	RET

> ;END NON-PIE-SLICE SCHEDULER CONDITIONAL

IFN PIESLC,<
;ROUTINE CALLED BY PIE-SLICE SCHEDULER FOR DETERMINING QUEUE LEVEL
;AFTER A PERIOD DURING WHICH A PROCESS HAS BLOCKED.
NEWST:	MOVEI 2,INTERQ
	MOVE 3,FKFLGS(7)
	TLNE 3,HIQFK			;SPECIAL SCHEDULING?
	 JRST [TLNE 3,SPQFK		;SPECIAL QUEUE
		MOVEI 2,SPECQ
		JRST NEWST2]

	HRRZ 3,FKSTAT(7)
	CAIE 3,TCITST			;WAS WAITING FOR TTY INPUT?
	CAIN 3,TCOTST##			;OR OUTPUT?
	 JRST NEWST2			;YES, HI-Q

	MOVEI 2,COMPQ
NEWST2:	CALL CHGQ		;GET QUANTUM AND UPDATE FKQ
	RET

;ROUTINE TO MAINTAIN EXPONENTIAL AVERAGE OF PROCESS UTILIZATION
UPDUT:	MOVE 1,FKUTIL(7)	;GET CURRENT VALUE
	MOVE 2,TODCLK
	SUB 2,FKUDT(7)		;TIME SINCE LAST UPDATE
	CAIG 2,<1B<35-<TCEXP-4>>-1>	;ENOUGH TIME ELAPSED TO UPDATE?
	 RET				;NO, JUST RETURN
	ADDM 2,FKUDT(7)			;TODCLK TO FKUDT

	CONO APR,APRCHN+550	;CLEAR AND DISABLE OV AND FOV

	SKIPE 4,FKPRT(7)	;GET INCREMENTAL RUNTIME
	 JRST UPDUT3		;NON-ZERO
	MOVE 3,SOLD
	MOVEM 3,FKSOLD(7)
UPDUT2:	CALL AVERAG		;COMPUTE AVERAGE
	MOVEM 1,FKUTIL(7)
	RET

UPDUT3:	SETZM FKPRT(7)
	FSC 4,233	;CONVERT TO FLOATING POINT
	MOVE 3,SOLD
	SUBM 3,FKSOLD(7)
	EXCH 3,FKSOLD(7)
	FSC 3,233
	FDVR 4,3	;COMPUTE RECENT UTILIZATION
	JFCL 11,UPDUTE	;ERROR IF OVERFLOW
	JRST UPDUT2
UPDUTE:	BUG (CHK,<OVERFLOW COMPUTING PROCESSOR UTILIZATION>)
	SETZ 4,
	JRST UPDUT2


;ROUTINE TO COMPUTE EXPONENTIAL AVERAGE
;ACCEPTS IN AC1: A(I) FLOATING POINT FORMAT
;	    AC2: T	TIME SINCE LAST UPDATE IN MILLISECS (FIXED PT)
;           AC4: K  (THE SAMPLE VALUE) IN FLOATING POINT FORMAT

;RETURNS +1 ALWAYS WITH A(I+1)=((A(I)-K)*E^-(T/C))+K  IN AC1
;			WHERE C=TC*LOG E
;                                     2
;	SMASHES AC3
TCEXP==^D12		;GIVES ABOUT 4 SEC TIME CONSTANT

TC==1B<35-TCEXP>		; =2^TCEXP

AVERAG:	FSBR 1,4			;AC1=A(I)-K

	CAILE 2,<TC-1>			;INTEGER PART NON-ZERO?
	 JRST	[ASHC 2,-TCEXP		;NO, GET INT(T/TC)
		MOVNS 2			;NEGATE
		FSC 1,(2)			;AC1=(A(I)-K)*2^-INT(T/TC)
		JFCL 11,AVEROV		;FSC CAN UNDERFLOW
		ASHC 2,4		;GET BACK FRACTIONAL PART
		ANDI 2,17		;TAKE OUT ALL OTHER BITS
		JRST AVERG2]

	ASH 2,-<TCEXP-4>			;GET TOP 4 BITS OF FP

AVERG2:	FMPR 1,EXPTAB(2)		;AC1=(A(I)-K)*2^-(T/TC)
	 JFCL 11,AVEROV			;FMPR COULD HAVE UNDERFLOWED
	FADR 1,4			;PLUS K GIVES A(I+1)
	RET

AVEROV:	MOVE 1,4		;NEW VALUE = K
	RET

EXPTAB:	1.0		;2^0
	 .957603281	;2^-(1/16)
	 .917004043	;2^-(2/16)
	 .87812608	;...
	 .840896415
	 .805245166
	 .771105413
	 .738413073
	 .707106781
	 .677127773
	 .648419777
	 .620928906
	 .594603558
	 .569394317
	 .545253866
	 .522136891	;2^-(15/16)
> ;END PIE-SLICE SCHEDULER CONDITIONAL

;NON-PIESLICE SYSTEM: IF NOT ON ONE OF TOP TWO QUEUES, MOVE PROCESS UP A QUEUE
;PIESLICE SYSTEM: HI-QUEUE THE FORK

PSSKD2:	PUSH P,3
	PUSH P,4


IFE PIESLC,<
	HLRZ 2,FKQ(7)		;GET PRESENT QUEUE
	CAIG 2,1		;.GT. 1?
	 RET			;NO, DO NOTHING
	SUBI 2,1		;BUMP HIM UP A QUEUE

	HRLM 2,FKQ(7)
	MOVE 2,QBASE+1(2)
	HRRM 2,FKQ(7)		;SET UP HIS QUANTUM
> ;END NON-PIE-SLICE CONDITIONAL

IFN PIESLC,<
	MOVSI 2,SPQFK		;SPECIAL QUEUE?
	TDNE 2,FKFLGS(7)
	SKIPA 2,[SPECQ]		;YES
	MOVEI 2,INTERQ		;NO
PSSKD4:	CALL CHGQ
> ;END PIE-SLICE CONDITIONAL

	NOSKD1
	MOVE 2,FKFLGS(7)
	TLNN 2,RNLS		;IS FORK NOW ACTIVE?
	 JRST PSSKD3		;NO
	CALL CHGRLS		;APPEND TO NEW LIST
	SKIPN INSKED		;IN SCHEDULER?
	CAME 7,FORKX		;NO, PROCESS LEVEL
	 JRST PSSKD3		;IN SCHED, OR OBJECT FORK NOT THIS ONE
	HRRZ 4,FKQ(7)		;PUT NEW QUANTUM
	MOVEM 4,RJQNT		;IN RJQNT
PSSKD3:	OKSKD1
	POP P,4
	POP P,3

	RET


IFN PIESLC,<

;ROUTINE TO REPLACE FORK ON COMPQ
SETCQ:	PUSH P,3
	PUSH P,4
	MOVEI 2,COMPQ
	JRST PSSKD4

;TRANSPARENT ROUTINE TO PLACE CURRENT FORK ON ONE OF THE HI QUEUES
SETHIQ:: AOSE HIQCNT		;ALREADY HI-QUEUED?
	 RET			;YES
	PUSH P,1
	PUSH P,2
	PUSH P,7
	MOVE 7,FORKX
	HLRZ 1,FKQ(7)		;IS HE NOW ON INTERQ?
	CAIN 1,INTERQ
	 JRST [MOVSI 1,PHIQFK	;YES, MAKE NOTE OF THAT
		IORM 1,FKFLGS(7)
		JRST SETHI2]
	MOVSI 2,HIQFK
	IORM 2,FKFLGS(7)	;SET IN FKFLGS
	CALL PSSKD2
SETHI2:	POP P,7
	POP P,2
	POP P,1
	RET

;ROUTINE TO RESUME NORMAL SCHEDULING IF THE OUTERMOST
;SUCH REQUEST
RELHIQ:: SKIPGE HIQCNT
	BUG (HLT,<ATTEMPT TO OVERDECREMENT HIQCNT>)
	SOSL HIQCNT		;OUTERMOST REQUEST?
	 RET
	PUSH P,1
	PUSH P,2
	PUSH P,7
	MOVE 7,FORKX
RELHI2:	MOVSI 1,SPQFK+HIQFK	;TURN OFF SPECIAL SCHED BITS
RELHI3:	ANDCAB 1,FKFLGS(7)
	TLZN 1,PHIQFK		;WAS HE PREVIOUSLY ON INTERQ?
	 JRST [CALL SETCQ	;REPLACE ON COMPQ
		JRST .+2]
	MOVEM 1,FKFLGS(7)	;YES, CLEAR THE BIT BUT NO RESCHED
	POP P,7
	POP P,2
	POP P,1
	RET


; ROUTINE TO OBTAIN TOP PRIORITY SCHEDULING FOR RUNNING FORK
SETSPQ:: AOSE SPQCNT		;FIRST SUCH REQUEST?
	 RET		;NO, JUST NOTE THAT IT HAPPENED
	PUSH P,1
	PUSH P,2
	PUSH P,7
	MOVE 7,FORKX
	MOVSI 1,SPQFK+HIQFK
	IORM 1,FKFLGS(7)
	AOSN HIQCNT
	 JRST [HLRZ 1,FKQ(7)	;IF NOT INTERQ AS A RESULT OF PRIOR
				;CALL TO SETHIQ, THEN NOTE IF INTERQ NOW
		CAIN 1,INTERQ
		 JRST [MOVSI 1,PHIQFK
			IORM 1,FKFLGS(7)
			JRST .+1]
		JRST .+1]
	CALL PSSKD2
	POP P,7
	POP P,2
	POP P,1
	RET

;ROUTINE TO TURN OFF TOP PRIORITY SCHEDULING IF OUTERMOST
;SUCH REQUEST
RELSPQ:: SKIPGE SPQCNT
	BUG (HLT,<ATTEMPT TO OVERDECREMENT SPQCNT>)
	SOSL SPQCNT
	 RET		;NESTED REQUEST
	PUSH P,1
	PUSH P,2
	PUSH P,7
	MOVE 7,FORKX
	SKIPGE HIQCNT
	BUG (HLT,<ATTEMPT TO OVERDECREMENT HIQCNT>)
	SOSGE HIQCNT
	 JRST RELHI2
	MOVSI 1,SPQFK
	JRST RELHI3

>; END PIE-SLICE SCHEDULER CONDITIONAL


;HALT JOB

HLTJB:	HRRE 6,CTRLTT
	JUMPL 6,HLTJB1		;IF JOB DETACHED
	SETZM TTPSI(6)		;CLEAR TTY WORDS
	SETOM TTFORK(6)
HLTJB1:	MOVE 5,JOBNO
	SETZM CTRLTT		;CLEAR CONTROL TTY WORDS
	HRRZS JOBPT(5)
	MOVEI 1,400000
	SETO 2,
	DIC			;DEACTIVATE ALL INTERRUPTS
	MOVNI 1,1
	CLOSF
	JFCL
	RELD			;RELEASE ALL DEVICES
	JFCL
	MOVEI 1,-4
	KFORK			;KILL ALL INFERIOR FORKS
IFDEF SIGIPC,<	CALL RMJBRF##	;REMOVE REFERENCES TO THIS JOB IN SIGS>
	MOVE 7,FORKX		;THIS FORK.
	HLLZ 2,FKPGS(7)		;FORKS PT
	MOVSI 6,-1000
	CALL CLRM0		;CLEAR UPT
	MOVE 6,[XWD PJMPG-PPMPG,JOBMAP-JSB]
	HRLZ 2,FKJOB(7)		;GET SPTN OF JSB
	CALL CLRM0		;CLEAR JDV AND PAGES IN JOB AREA
	SKIPGE JOBPMF
	JRST HLTJB4		;NO PMF
	SETO 1,
	HRLZ 2,JOBPMF
	MOVSI 6,-1000
	HRRI 2,0(6)
	PMAP			;DELETE CONTENTS OF PMF
	AOBJN 6,.-2
	HRRZ 1,JOBPMF
	SETOM JOBPMF		;ENABLE CLOSE OF PMF
	CLOSF			;CLOSE PMF - NO JSYS' AFTER HERE
	JFCL
HLTJB4:	MOVE 1,ACBAS
	CAIGE 1,<EUACB>B39	;AC BLOCKS IN PSB?
	SETZM PSB+UACPG		;YES, CLEAR MAP ENTRY FOR UACPG

HLTJB5:	MOVE 6,[XWD CPTPG+1-UPTPG,CPTPG+1]
	HRLZ 2,FKPGS(7)
	CALL CLRM0		;CLEAR PAGES IN PP AREA
	HRRZ 1,FKJOB(7)		;JSB
	CALL WTSPT		;WAIT FOR IT TO BE UNSHARED
	CALL WTFPGS		;WAIT FOR PSB AND UPT TO BE IN NO MAPS
	ENTSKD			;ENTER SCHED
	MOVE 1,JOBNO		;RELEASE JOB NUMBER
	SETZM JOBDIR(1)		;CLEAR DIRECTORY NUMBER
	SETOM JOBRT(1)		;INDICATE JOB NUMBER NOT IN USE
	ADDI 1,JOBPT
	EXCH 1,FREJOB		;PUT SLOT ON FREE LIST
	MOVEM 1,@FREJOB
	JRST HLTFK2		;FLUSH THIS LAST FORK

HLTFK1:	ENTSKD		;ENTER SCHEDULER
HLTFK2:	CALL REMBSJ		;REMOVE FORK FROM BALANCE SET
HLTFK3:		;THIS LABEL MUST IMMEDIATELY FOLLOW CALL TO
		;REMBSJ. DO NOT SEPARATE!!!

	MOVEI 1,(1B0)
	HRLM 1,FKPT(7)		;NOTE FORK NOT IN BALSET
	HRRZ 1,FKJOB(7)		;JSB
	LDB 2,[POINT 14,SPT(1),13] ;SHARE COUNT NOW 1?
	CAIE 2,1		;LAST USE OF JSB?
	JRST [	MOVSI 2,-1B31	;NO, REDUCE SHARE COUNT
		ADDM 2,SPT(1)
		JRST .+2]
	CALL DESPT		;YES, DELETE IT (LOGOUT CASE)
	HLRZ 1,FKPGS(7)		;UPT
	CALL DESPT		;DELETE IT
	HRRZ 1,FKPGS(7)
	CALL DESPT		;DEASSIGN PSB
	SETOM FORKX
	PUSH P,7
	ADDI 7,FKPT
	EXCH 7,FREFK		;PUT FORK NUMBER ON FREE LIST
	TLO 7,400000
	MOVEM 7,@FREFK
	CALL GCCOR		;CLEAN UP PAGES
	POP P,7
	HRRZ 1,FKWSP(7)		;MAKE SURE FORK CLEANED UP
	HRRZ 2,FKCNO(7)
	CAIN 1,0
	CAIE 2,0
	BUG(CHK,<FORK NOT PROPERLY DELETED>)
	JRST SCHED0		;NOW THERE IS NOTHING LEFT OF JOB...

CLRM0:	SETZ 1,
CLRM1:	HRRI 2,0(6)		;PUT PAGE NUMBER WITH PTN
	CALL SETPT
	AOBJN 6,CLRM1
	RET

;WAIT FOR PSB AND UPT TO HAVE SHARE COUNT OF 1

WTFPGS:	HRRZ 1,FKPGS(7)		;PSB
	CALL WTSPT
	HLRZ 1,FKPGS(7)		;UPT
WTSPT:	PUSH P,4
WTSPT2:	JSP 4,WTSPTT		;TEST PAGE NOW
	JRST WTSPT1		;MUST WAIT
	POP P,4			;NOW OK
	RET

WTSPT1:	MOVSI 1,0(1)
	HRRI 1,WTSPTT
	JSYS EDISMS
	HLRZ 1,1
	JRST WTSPT2

WTSPTT:	LDB 2,[POINT 14,SPT(1),13]	;GET SHARE COUNT
	CAIE 2,1
	JRST 0(4)
	JRST 1(4)

;PRELIMINARY FORK INIT
;HERE ON PROCESS LEVEL FROM PIRQ IF NEWFKF IS SET IN FKINT
; IF NEW JOB, TTY # IS IN PIMSK AND RH 7

FKSET:	MOVE 1,PSB+PSBPG	;SETUP USER MAP WORD
	MOVEM 1,PSB+UACPG	;SAME AS PSB UNTIL OVERFLOW
	MOVE 1,[IOWD NUPDL,UPDL]
	MOVEM 1,UPP		;MON ROUTINES PDL
	MOVE 1,[IOWD 1000,PSIPGA]
	MOVEM 1,PSIPT		;PSI STORAGE STACK
	MOVEI 1,<UACB>B39	;SETUP AC BASE
	MOVEM 1,ACBAS
	MOVEM 1,ACBAS1
	SETACB 1
	MOVE 1,ICAPT
	MOVEM 1,CAPT
	MOVE 1,INTDF0		;INTERRUPT SWITCHES
	MOVEM 1,INTDFF
	MOVE 1,MJRST0
	MOVEM 1,MJRSTF
	SETZM NSKED
	MOVE 1,RSKEDN
	MOVEM 1,RSKED
	MOVSI 1,(<MOVEM 1,0>)
	MOVEM 1,PATU40		;SETUP INSTRUCTION PART FOR COMPAT
	MOVEM 1,PATUPC		;ENTRY PROCEDURE

IFN PIESLC,<
	SETOM HIQCNT		;INIT SPEC SCHEDULING REQUEST COUNTS
	SETOM SPQCNT
> ;END PIE-SLICE CONDITIONAL
	SETOM SLOWF
	SETOM INTDF
	SETOM TRAPC
	SETOM FKTAB
	MOVEI 1,FKTAB+1
	HRLI 1,-1(1)
	BLT 1,FKTAB+NLFKS/2-1
	SETOM JTLCK		;INIT JSYS TRAP LOCK
	MOVE 2,[XWD 77,7777]	;INIT JTMNW TO NO CHANNEL, NO MONITOR
	MOVEM 2,JTMNW
	MOVE 1,JDSPTP
	MOVE 2,FORKX
	HRL 2,FKPGS(2)
	HRRI 2,JDVPG
	MOVSI 3,RWX		;SET JSYS DISPATCH TO STANDARD
	CALL SETPT		;NON-MONITORED DISPATCH
	MOVE 2,FORKX
	HLRZ 1,FKPGS(2)		;GET SPTN OF PAGE TABLE
	LSH 1,^D9		;CONSTRUCT SHARE POINTER
	TLO 1,RWXB-XCTB+SHRBIT
	MOVEM 1,PSB+UPTPG
	MOVE 6,FORKX
	TLNE 7,NEWJBF		;NEW JOB TOO?
	JRST FKSET1		;YES
	HRRZ 1,FKJOB(6)		;GET JSB
	MOVSI 2,1B31
	ADDM 2,SPT(1)		;BUMP SHARE COUNT
	LSH 1,^D9
	TLO 1,RWXB+SHRBIT	;CONSTRUCT SHARE POINTER
	MOVEM 1,PSB+JSBPG
	MOVEI 1,FKSET2
FKSET3:	MOVEM 1,PIPC
	SETZM PIOLDS
	MOVE 1,PSB+JSBPG	;GET JSB POINTER
	TLC 1,SHRBIT+INDBIT	;MAKE INTO INDIRECT POINTER
	ADDI 1,JOBMAP-JSB+JSBPG-PJMPG+1	;FIRST WORD OF JOB PT
	MOVEI 2,JSBPG+1		;STARTING AFTER JSB,
	MOVEM 1,PSB(2)		;FILL MON MAP WITH IND POINTERS
	ADDI 2,1
	CAIGE 2,PPMPG
	AOJA 1,.-3
	JRST PIRQR		;DEBREAK - RUN IN NORMAL MODE

;INIT NEW JOB

FKSET1:	HRRE 2,7		;GET CONTROLLING TTY #, IF ANY
	HLRZ 1,FKJOB(6)		;GET JOB NUMBER STORED BY JOBSRT
	MOVEM 1,JOBNO
	MOVSM 2,JOBPT(1)	;TTY ASSIGNED TO JOB, OR -1, TO LH JOBPT
	SKIPL 2			;UNLESS DETACHED, SET TTFORK TOO
	HRLM 1,TTFORK(2)	;JOB CONTROLLED BY TTY
	MOVE 2,FORKX
	HRRM 2,JOBPT(1)		;TOP FORK OF JOB
	SETZM JOBRT(1)		;JOB RUNTIME
	HRRZ 1,FKJOB(6)		;JSB
	LSH 1,^D9
	TLO 1,RWXB+SHRBIT
	MOVEM 1,PSB+JSBPG	;SETUP JSB
	MOVE 1,JOBNO
	HLRE 2,JOBPT(1)		;CONTROLLING TTY OR -1
	MOVEM 2,CTRLTT		;IN JSB
	MOVEI 1,EXEC0
	HRRZS FKTAB		;FORK 400000 IN TOP FK IS JOB FK 0
	JRST FKSET3

FKSET2:	SETZ 0,			;START WITH 0 AC'S
	MOVEI 17,1
	BLT 17,16
	SETZ 17,
	ENTSKD
	MOVSI 1,UMODF
	MOVEM 1,PPC
	MOVEI 1,HALTT
	JRST DISMSE

INTDF0:	SOS INTDF		;NORMAL CONTENTS OF INTDFF
MJRST0:	JRSTF @FPC		;NORMAL CONTENTS OF MJRSTF
CHNSON:	EXP 1B9+1B11+1B15+1B16+1B17+1B18+1B20	;ALWAYS ON PSI CHANS

IFDEF RTISW,<

;SOLO -- CAPTURE THE WHOLE MACHINE

.SOLO:	JSYS MENTR
	MOVE 1,JOBNO
	MOVEM 1,SCDRN1		;TELL SCHED TO RUN THIS JOB ONLY
	MOVEI 1,FSHBAL
	MOVEM 1,FSHBAL		;TELL SCHED TO FLUSH BALANCE SET
	CALL DISE		;WAIT TIL DONE
	JRST MRETN


;TUTTI -- ALLOW ALL JOBS TO RUN

.TUTTI:	JSYS MENTR
	MOVSI 1,(1B1)
	MOVEM 1,CHKTIM
	SETOM SCDRN1
	JRST MRETN

>;END IFDEF RTISW

;PSEUDO-INTERRUPT SYSTEM

;BITS IN LH FKINT, LH PIMSK

;B18=INT REQUEST
;B19=INTERRUPT HANDLER RUNNING AT PROCESS LEVEL
NEWFKF==:1B20			;INITIATE NEW FORK - PI FLAG
NEWJBF==1B21			;INITIATE NEW JOB - PI FLAG
PSIIF==1B22			;CHANNEL INTERRUPT REQUESTED IN FKINTB
PSIT1F==1B23			;TERMINAL CODE INTERRUPT, PHASE 1
PSIT2F==1B24			;TERMINAL CODE INTERRUPT, PHASE 2
SUSFKR==1B25			;SUSPEND FORK REQUEST
PSIWTF==1B26			;JOB WAS IN WAIT STATUS
PSILOB==1B27			;LOGOUT JOB REQUEST
FRZB1==1B28			;DIRECT FREEZE HAS BEEN DONE
FRZB2==1B29			;INDIRECT FREEZE HAS BEEN DONE
PSIJTR==1B30			;JSYS TRAP REQUEST
JTFRZB==1B31			;JSYS TRAP FREEZE
FRZBB==FRZB1+FRZB2		;BOTH BITS FOR EXTERNAL REFS
FRZBAL==JTFRZB+FRZBB		;FOR EXTERNAL REFS

;SCHEDULER CAUSES JOB TO BE STARTED HERE ON PI REQUEST
;SAVED PC IN PIPC
;PIMSK CONTAINS INTERRUPT REQUEST WORD

PIRQ:	MOVEM P,PIAC+17
	MOVEI P,PIAC		;SAVE USER AC'S
	BLT P,PIAC+16
	MOVE P,PIPDL		;SET UP LOCAL STACK
	PUSH P,PGURET		;SAVE UNTRAP RETURN ON LOCAL STACK
	MOVE 7,PIMSK		;INTERRUPT REQUEST WORD
	MOVE 6,FORKX
	SETZ 2,
	TLNE 7,PSIWTF		;WAS JOB IN WAIT STATUS?
	MOVE 2,FKSTAT(6)	;YES, GET OLD STATUS
	MOVEM 2,PIOLDS		;SAVE OLD STATUS, OR 0 IF WAS RUNNING
	TLNE 7,NEWFKF		;START NEW FORK?
	JRST FKSET		;YES
	TLNE 7,PSIT1F
	JRST PSIT1		;TERMINAL, PHASE 1
	TLNE 7,PSIT2F
	JRST PSIT2		;TERMINAL, PHASE 2
PSITR1:	TLNE 7,PSIIF+SUSFKR+PSILOB+PSIJTR
	JRST PSII		;CHANNEL INTERRUPT SPEC. BY FKINTB
PIRQR:	JSYS UNPIR		;LEAVE PI STATE
PSIDF1:	SKIPN 1,PIOLDS		;WAS RUNNING BEFORE PSI?
	 JRST SCHED3
	JRST DISMSE		;NO, REPLACE ON WAIT LIST

;NOTE THAT THIS ROUTINE IS NOW CALLED VIA
;JSYS UNPIR. THIS WILL NOT WORK ON THE KI10.
UNPIR:	XWD ENSKR,.+1
	SKIPE INSKED
	BUG(HLT,<CALL TO SCHEDULER WHEN ALREADY IN SCHEDULER>)
	AOS INSKED		;ENTER SCHEDULER
	MOVE P,PI7P		;SCHEDULER STACK
	PUSH P,ENSKR
	SETZM ENSKR
	MOVE 1,PIPDB		;RESTORE PGURET
	MOVEM 1,PGURET
	MOVE 1,[XWD PIAC,PAC]
	BLT 1,PAC+17		;PUT AC'S BACK
IFN KIFLG,<
	JSP 7,KISSAV>		;SAVE STUFF FOR KI-10 HARDWARE
	MOVE 1,PIPC
	MOVEM 1,PPC
	MOVSI 1,200000
	MOVE 7,FORKX
	ANDCAM 1,FKINT(7)
	JRST UCLOCK		;CHARGE PROCESS TIME AND RETURN

PIPDL:	IOWD NPIPDL,PIPDB	;INTERRUPT ROUTINES LOCAL PDL

;REQUEST INTERRUPT
;AC1 CONTAINS INTERRUPT NUMBER
;AC2 CONTAINS FORK INDEX

PSIRQ0:	MOVE 2,FORKX		;REQUEST INTERRUPT IN CURRENT FORK
PSIRQF:	NOSKED			;REQUEST INTERRUPT, FORK IN AC2
	CALL PSIRQ
	OKSKED
	RET

;ENTERED FROM SCHEDULER REQUEST PROCESSOR

PSIRQ:	MOVE 1,BITS(1)
PSIRQB:	IORM 1,FKINTB(2)	;SET BIT IN INTERRUPT WAITING BUFFER
PSITQ:	MOVSI 1,400000+PSIIF	;REGULAR INTERRUPT FLAG
	IORM 1,FKINT(2)
	CAMN 2,FORKX		;FOR THIS FORK?
	RET			;YES
PSIR4:	PUSH P,7
	MOVEI 7,0(2)
	NOSKD1
	MOVE 1,FKFLGS(7)	;NO, GET STATUS OF FORK
	TLNN 1,WTLS		;ON WAITLIST?
	 JRST PSIR6		;NO
	MOVSI 1,(1B1)		;INTERRUPT IN PROGRESS?
	TDNE 1,FKINT(7)
	 JRST PSIR6		;YES, LET WTSCAN PICK HIM UP
	MOVSI 1,PSIWTF		;REMEMBER IT WAS WAITING
	IORM 1,FKINT(7)
IFN PIESLC,<CALL INCNAP>
	PUSH P,3
	PUSH P,4
	CALL PSIAWK		;AWAKEN HIM
	POP P,4
	POP P,3

;SET NEW SCHED STATUS FOR PSI'D FORK

PSIR6:	OKSKD1
	CALL PSSKD2		;SET SHORT QUANTUM, HIGH PRIORITY
	MOVEI 2,0(7)
	POP P,7
	RET

;TERMINAL INTERRUPT
;PHASE ONE - CALLED FROM TERM SERVICE ROUTINES
; 2/ LINE NO.,   3/ INTERRUPT CODE
;SEND TO TOP FORK TO FIND PROPER DESTINATION

TTPSRQ:	HLRZ 1,TTFORK(2)	;GET JOB USING THIS TTY
	ANDCMI 1,600000		;FLUSH EXTRANEOUS BITS
	HLRZ 4,JOBPT(1)		;4=JOB CTTY LINE #
	CAIE 4,0(2)		;LINE PSI REQUESTED?
	JRST TTPSR2		;NO, MUST FIND TOP FORK IN GROUP TO PSI
	HRRZ 2,JOBPT(1)		;YES, 2=INDEX OF TOP JOB FORK
TTPSR1:: MOVSI 1,1B18+PSIT1F	;PHASE ONE REQUEST
	IORM 1,FKINT(2)
	HRRM 3,FKINT(2)		;INTERRUPT CODE
	JRST PSIR4		;SET NEW STATUS

TTPSR2:	MOVEI 1,0(2)		;1=LINE #
	IDIVI 1,2		;COMPUTE BYTE PTR TO TTFRK1 ENTRY
	ADD 1,TTFRKP(2)
	LDB 2,1			;2=INDEX OF TOP FORK IN GROUP
	CAIL 2,NFKS		;RANGE CHECK
	RET			;FAILED, ABORT PSI
	JRST TTPSR1

TTFRKP:	POINT 18,TTFRK1,17	;POINTERS TO TTFRK1 ENTRIES
	POINT 18,TTFRK1,35

;ROUTINES TO HANDLE INTERRUPT CONDITIONS AS SPECIFIED BY BITS
;IN LEFT HALF OF FKINT

;TERMINAL INTERRUPT, PHASE ONE
;THIS CODE RUN IN TOP FORK OF PROCESS GROUP ONLY

PSIT1:	MOVE 6,BITS(7)
	HRRZ 1,FORKN		;START WITH THIS FORK
	HLRZ 4,SYSFK(1)		;4=DESIGNATOR OF TERM PSI SOURCE
	SETO 5,
	TDNE 6,FKPSIE(1)	;TERM CODE ON IN FORK?
	MOVEI 5,0(1)		;YES, REMEMBER FORK
	CALL PSIT1A		;LOOK AT ALL INFERIORS
	JUMPL 5,PSIT11		;NOT FOUND, SO TURN OFF CODE
	HRRZ 2,SYSFK(5)		;GET SYSTEM INDEX OF FORK TO GET INTERPT
	CAMN 2,FORKX		;THIS FORK?
	JRST PSIT2		;YES, GO DIRECTLY TO PHASE TWO
	NOSKED
	HRRM 7,FKINT(2)		;NO, SETUP TO INTERRUPT PROPER FORK
	MOVSI 1,PSIT2F+400000	;PHASE TWO REQUEST FLAG
	IORM 1,FKINT(2)
	CALL PSIR4
	OKSKED
	JRST PSITR1

PSIT11:	CAIN 4,-1		;SOURCE OF PSI=JOB CTTY?
	JRST PSIT12		;YES.
	TRZN 4,1B18		;MAYBE, CONVERT TO LINE #, ASSUMING TTY
	JRST PSITR1		;DESIGNATOR.  NOT TTY DES. RETURN.
	CAMN 4,CTRLTT		;CTTY OF JOB?
	JRST PSIT12		;YES.
	CAIGE 4,NLINES		;NO, RANGE CHECK LINE #
	CAIGE 4,0
	JRST PSITR1
	JRST PSIT13
PSIT12:	ANDCAM 6,TTSPSI 	;CLEAR PSI CODE FOR JOB
	SKIPL 4,CTRLTT
PSIT13:	ANDCAM 6,TTPSI(4)	;CLEAR CODE FOR TTY
	JRST PSITR1

;SEARCH FORK STRUCTURE FOR FORK TO INTERRUPT
;4/ DESIGNATOR OF SOURCE OF THIS PSI

PSIT1A:	ADD 1,INFERP		;LOOK AT INFERIOR LIST
PSIT1B:	LDB 1,1			;GET NEXT IN LIST
	JUMPE 1,R		;RETURN AT END OF LIST
	HLRZ 2,SYSFK(1)		;2=FORK'S SOURCE OF TTY PSI'S
	CAIE 2,0(4)		;=SOURCE OF THIS ONE?
	JRST PSIT1E		;NO, CONSIDER FORK NO FURTHER.
	HRRZ 2,SYSFK(1)		;CHECK STATE OF FORK
	PUSH P,7		;SEE IF FORK FROZEN OR HALTED
	MOVEI 7,0(2)
	CALL CHKWT		;SEE IF DISMISSED
	 JRST [POP P,7		;ITS NOT
		JRST PSIT1D]
	POP P,7
	HRRZ 3,FKSTAT(2)
	CAIN 3,FRZWT		;FROZEN?
	JRST PSIT1G		;YES
	CAIE 3,HALTT		;HALTED OR FORCED TERM?
	CAIN 3,FORCTM
	JRST PSIT1C		;YES
PSIT1D:	TDNE 6,FKPSIE(1)	;FORK HAS CODE ENABLED?
	MOVEI 5,0(1)		;YES, REMEMBER IT
PSIT1E:	HRLM 1,0(P)		;REMEMBER CURRENT FORK
	CALL PSIT1A		;CHECK INFERIORS
	HLRZ 1,0(P)		;RECOVER CURRENT
PSIT1C:	ADD 1,PARALP		;DO PARALLELS
	JRST PSIT1B

PSIT1G:	MOVSI 3,JTFRZB		;JSYS TRAP FREEZE?
	TDNN 3,FKINT(2)
	JRST PSIT1C		;NO
	MOVSI 3,FRZBB
	TDNE 3,FKINT(2)		;OTHER FREEZE ALSO?
	JRST PSIT1C		;YES.
	JRST PSIT1D

;FORK STRUCTURE POINTERS

SUPERP:	POINT 12,FKPTRS,11	;SUPERIOR
PARALP:	POINT 12,FKPTRS,23	;PARALLEL
INFERP:	POINT 12,FKPTRS,35

;TERMINAL INTERRUPT, PHASE TWO

PSIT2:	MOVEI 1,0(7)
	CALL GETCHA
	LDB 2,2
	MOVE 1,BITS(2)		;AND SET BIT IN INT. WAITING WORD
	AND 1,PSICHM		;BUT ONLY FOR ENABLED CHANNELS
	IORM 1,PSIBW
	JRST PSII		;THEN GO PROCESS IT

;SUSPEND FORK REQUEST

PIRSFK:	TLNE 7,PSIJTR		;JSYS TRAP PSI REQUEST ALSO PRESENT?
	JRST [	MOVE 2,FORKX	;YES, REMEMBER IT
		MOVSI 1,PSIJTR+400000
		IORM 1,FKINT(2)
		JRST .+1 ]
	MOVE 1,PIPC
	CALL PITEST		;NOW INTERRUPTABLE?
	JRST PIRSF1		;NO
PIRSK2:	MOVEI 3,SUSWT		;SUSPENDED FORK TEST
PIRSK1:	MOVE 2,FORKX
	MOVSI 1,SUSFKR
	ANDCAM 1,FKINT(2)
	JSYS UNPIR		;LEAVE INTERRUPT STATE
	IORM 1,FKINT(7)		;KEEP INTERRUPT STARTING BIT
	MOVEI 1,0(3)		;SUSWT OR FRZWT
	HRL 1,PIOLDS		;WITH OLD STATUS
	JRST DISMSE		;DISMISS

PIRSF1:	MOVE 7,FORKX
       NOSKED
	HRRZ 1,FKSTAT(7)
	CAIN 1,JTQWT		;IN JSYS TRAP QUEUE WAIT?
	JRST PIRSF2		;YES, ALLOW SUSPENSION
       OKSKED
	MOVSI 1,SUSFKR		;TURN REQUEST BIT BACK ON
	IORM 1,FKINT(7)
	JRST PSIDFR		;AND SET DEFERRED INTERRUPTS

PIRSF2:	MOVEI 1,FKJTQ(7)	;FORK IN JSYS TRAP QUEUE WAIT
	CALL JTDEQ		;REMOVE IT FROM QUEUE
	MOVEI 1,JTRLCK		;SET RESUME ADDR TO LOCK ROUTINE
	SETZM PIOLDS
	MOVEM 1,PIPC
       OKSKED
	JRST PIRSK2

SUSWT:	JRST 0(4)		;SCHEDULER TEST FOR SUSPENDED FORK

;LOGOUT REQUEST

PIRLGO:	MOVE 1,PIPC
	CALL PITEST		;OK TO INTERRUPT?
	JRST [	MOVE 7,FORKX	;NO, REMEMBER REQUEST
		MOVSI 1,PSILOB
		IORM 1,FKINT(7)
		JRST PSIDFR]
	SETZM PIOLDS		;MAKE FORK RUNNABLE
	MOVEI 1,FLOGO
	EXCH 1,PIPC
	SKIPGE SLOWF
	JRST [	MOVEM 1,FPC	;IN USER MODE, SIMULATE JSYS
		JRST PIRQR]
	MOVE 2,PIAC+17		;IN MON MODE, SIMULATE PUSHJ
	PUSH 2,1
	MOVEM 2,PIAC+17
	JRST PIRQR


;JSYS TRAP REQUEST

PIRJTP:	MOVE 1,PIPC
	CALL PITEST		;FORK INTERRUPTABLE?
	JRST PIRJT1		;NO, DEFER IT
	MOVSI 1,PSIJTR
	MOVE 7,FORKX		;IN CASE THIS PSI WAS DEFERRED
	ANDCAM 1,FKINT(7)	;CLEAR IT FROM FKINT
	LDB 1,JTMCN		;GET PSI CHANNEL FOR TRAP
	MOVE 1,BITS(1)
	IORM 1,PSIBW		;SET BIT IN INT WAITING WORD
	SETZ 7,
	JRST PSII		;GO PROCESS THE TRAP

PIRJT1:	MOVE 7,FORKX		;DEFER THE JSYS TRAP PSI
	MOVSI 1,PSIJTR
	IORM 1,FKINT(7)
	JRST PSIDFR

;PROCESS INTERRUPT(S) FOR THIS FORK AS SPECIFIED BY FKINTB

PSII:
IFN KIFLG,<
	JRSTF @[1B6+.+1]>	;TURN ON UXCT FLAG
	MOVE 1,MJRST0		;NORMALIZE ALL DEFER TRAPS
	MOVEM 1,MJRSTF
	MOVE 1,INTDF0
	MOVEM 1,INTDFF
	TLNE 7,SUSFKR		;FORK SUSPENSION REQUEST?
	JRST PIRSFK		;YES
	TLNE 7,PSILOB		;LOGOUT REQUEST?
	JRST PIRLGO
	TLNE 7,PSIJTR		;JSYS TRAP REQUEST?
	JRST PIRJTP
	MOVE 2,FORKX
	MOVEI 1,0
	EXCH 1,FKINTB(2)	;RESET FKINTB TO 0
	IORM 1,PSIBW		;INCLUDE IN PROCESS WAITING BREAKS
	MOVE 1,PSICHM		;USERS ENABLED CHANNELS
	IOR 1,CHNSON		;WITH ALWAYS ON CHANNELS
	IOR 1,SUPCHN		;WITH SUPERIOR RESERVED CHANNELS
	SKIPE 3,PIOLDS		;WAS FORK WAITING?
	JRST [	SKIPN FORKN		;AND NOT TOP FORK?
		JRST .+1	;NO
		MOVEI 3,0(3)	;YES, HALT OR FORCED TERM?
		CAIE 3,HALTT
		CAIN 3,FORCTM
		SETZ 1,		;YES, FLUSH BREAKS
		JRST .+1]
	ANDB 1,PSIBW		;FLUSH DISABLED CHANS
	JUMPE 1,PIRQR		;RETURN IF NO BREAKS WAITING
	MOVE 1,PIPC		;PROCESS PC
	CALL PITEST		;CAN PROCESS BE INTERRUPTED NOW?
	JRST PSIDFR		;NO, GO SETUP DEFERRED INTERRUPT
PSIS:	MOVE 1,PSIBW
	TDNE 1,MONCHN		;MONITOR RESERVED CHANNEL?
	JRST PSIMB		;YES
	AND 1,SUPCHN		;LOOK AT SUPERIOR RESERVED CHANS
	JUMPN 1,PSIN1		;TERMINATE IF ANY
	MOVE 1,PSIBW
	AND 1,CHNSON		;LOOK AT SPECIAL CHANNELS
	SKIPE PSISYS		;IF THIS PROCESS NOT TAKING PSI'S,
	JUMPN 1,PSIN1		;TERMINATE IT IF ANY SPECIALS
	ANDCM 1,PSICHM		;AND'ING WITH USER'S 'OFF' CHANNELS
	JUMPN 1,PSIN1		;TERMINATE CAUSE CHANNEL NOT ACTIVE
	SKIPE PSISYS		;PSI SYSTEM ON?
	JRST PIRQR		;NO
	SKIPN LEVCHN		;THIS PROCESS TAKING INTERRUPTS?
	JRST PSIN1		;NO, GO TRANSMIT THE PSI
	MOVE 1,PSIBW		;FIND HIGHEST PRIORITY INTERRUPT
	MOVEI 2,0		;NOW WAITING
	MOVSI 3,1
PSIS1:	JUMPL 1,PSIS2		;THIS CHANNEL HAS WAITING BREAK?
PSIS4:	LSH 1,1			;NO, SHIFT TO NEXT CHANNEL
	ADDI 2,1		;COUNT CHANNEL NUMBER
	JUMPN 1,PSIS1		;KEEP LOOKING IF ANY BITS LEFT

;AC3 NOW CONTAINS LEVEL OF HIGHEST PRIORITY INTERRUPT FOUND
;AC5 CONTAINS CORRESPONDING CHANNEL NUMBER

	JUMPE 3,PSID1		;NO LEVEL ASSIGNED? GO XMIT INTERRUPT
	MOVE 1,BITS(3)
	CAMG 1,PSIBIP		;OK TO BREAK ON THIS LEVEL?
	JRST [	MOVE 2,PSIBW	;NO, .GE. PRIORITY LEVEL IN PROGRESS
		TDNN 2,CHNSON	;BREAKS ON PANIC CHNS WAITING?
		JRST PIRQR	;NO, HOLD WAITING BREAKS
		JRST PSIN1]	;YES, MUST TERMINATE
	IORM 1,PSIBIP		;YES, REMEMBER  BREAK THIS LEVEL
	HRRZ 1,LEVCHN		;GET ADR OF USER'S CHANNEL TABLE
	ADDI 1,0(5)		;COMPUTE ADR OF USER'S CHANNEL WORD
	UMOVE 1,0(1)		;GET ADR OF USER'S INT ROUTINE
	HRLI 1,UMODF		;USER MODE ON, OTHER FLAGS OFF
	EXCH 1,PIPC		;GET OLD PC
	TLNN 1,UMODF		;WAS IN USER MODE?
	JRST PSISM		;NO, MUST SAVE MONITOR CONTEXT
PSIS5:	SETZM PIOLDS
	HLRZ 2,LEVCHN		;GET ADR OF USER'S LEVEL TABLE
	ADDI 2,-1(3)		;COMPUTE ADR OF USER'S LEVEL WORD
	UMOVE 2,0(2)		;GET ADR OF PC WORD FOR THIS LEVEL
	TRNN 2,777760		;ADDRESS IS AC?
	MOVEM 1,PIAC(2)		;YES, STRANGE BUT ALLOW IT
	TRNE 2,777760		;NORMALLY,
	UMOVEM 1,0(2)		;STORE BREAK PC IN USER'S MEMORY
PSID3:	MOVE 1,BITS(5)		;CLEAR WAITING BREAK BIT FOR THIS CHANNEL
	ANDCAM 1,PSIBW
	JRST PIRQR		;TO USER

PSIS2:	HRRZ 4,LEVCHN		;GET ADR OF USER'S CHANNEL TABLE
	ADDI 4,0(2)		;COMPUTE ADR OF USER'S CHANNEL WORD
	XCTUU [HLRZ 4,0(4)]	;GET LEVEL NUMBER FOR THIS CHANNEL
	CAILE 4,NPILEV		;LEGAL LEVEL?
	SETZ 4,			;NO, TREAT AS 0
	CAIG 3,0(4)		;OLD LEVEL GREATER THAN CURRENT?
	JRST PSIS4		;NO
	MOVEI 3,0(4)		;YES, REMEMBER NEW LEVEL
	MOVEI 5,0(2)		;AND CHANNEL NUMBER
	JRST PSIS4		;RESUME SCAN

;MONITOR ROUTINE IS SHORTSTOPPING INTERRUPTS - SIMULATE  JSYS MONBK

PSIMB:	HRRZ 1,MONBK		;ROUTINE ADDRESS
	EXCH 1,PIPC		;GET OLD PC
	SETZM PIOLDS
	HLRZ 2,MONBK		;RET LOC
	MOVEM 1,0(2)		;STORE RETURN
	JRST PIRQR

;SPECIAL ROUTINE TO SAVE STATE OF INTERRUPTED MONITOR
;ROUTINE

PSISM:	MOVS 2,BITS(3)		;NO, REMEMBER MONITOR INTERRUPT
	IORM 2,PSIBIP		;IN RH OF BIP WORD
	MOVE 7,PSIPT		;STORAGE STACK POINTER
	HLRE 6,7		;SEE IF ENOUGH ROOM
	MOVN 6,6		;GET POSITIVE COUNT
	MOVE 2,ACBAS
	LSH 2,4			;2=ADDR OF END OF USER AC BLOCKS
	CAIGE 6,NUPDL-UACB+34(2) ;ENOUGH ROOM?
	BUG(HLT,<PSI STORAGE STACK OVERFLOW>)
	MOVE 10,7		;SAVE POINTER
	PUSH 7,1
	MOVSI 6,-NSAVC		;SAVE VULNERABLE CELLS
	PUSH 7,@SAVCT(6)	; ..
	AOBJN 6,.-1
	MOVSI 6,UPDL		;STORE ENTIRE MONITOR STACK
	HRRI 6,1(7)
	ADD 7,[XWD NUPDL,NUPDL]
	BLT 6,0(7)
	MOVSI 1,PIAC		;STORE CURRENT MONITOR AC'S
	HRRI 1,1(7)		;NOW LIVING IN PIAC
	ADD 7,[XWD 20,20]
	BLT 1,0(7)
IFN KIFLG,<
	MOVEI 1,KIASTK		;MOVE AC BLOCK 1 TO TOP OF STACK
	XCTUM [BLT 1,KIASTK+17]>
	HRRZ 1,ACBAS		;STORE ALL AC BLOCKS IN USE
	HRRZ 2,ACBAS1
	SUBI 1,-1(2)		;COMPUTE NUMBER OF BLOCKS IN USE
	SUBI 2,<PSB-UACPGA>B39	;FORCE BLT FROM UACPG
	LSH 2,^D18+4
IFN KIFLG,<
	MOVSI 2,KIASTK>		;ACTUAL TOP OF AC STACK
	MOVE 4,2
	HRRI 2,1(7)
	LSH 1,4
	HRLI 1,0(1)		;NUMBER OF WORDS BOTH HALFS
	ADD 7,1
	BLT 2,0(7)
	PUSH 7,1		;SAVE COUNT FOR DEBRK
	PUSH 7,ACBAS		;AND CURRENT ACBAS
	HRRI 4,PIAC		;RECOVER USER AC'S AT TIME OF MON CALL
	BLT 4,PIAC+17
	HRRZ 1,ACBAS
	CAIL 1,<EUACB>B39	;USING PSB FOR AC BLOCKS?
	JRST [	SETZ 1,		;NO, SWITCH BACK TO PSB
		MOVEI 2,UACPGA
		CALL SETMPG	;UNMAP UACPG
		MOVE 1,PSB+PSBPG
		MOVEM 1,PSB+UACPG	;RESET MAP ENTRY FOR UACPG
		JRST .+1 ]	;TO THAT FOR PSB
	MOVE 1,UPDL		;USER PC AT MONITOR CALL
	PUSH 7,10		;PSI STACK BEFORE ALL THIS PUSHING
	PUSH 7,1
	PUSH 7,PIPDB		;SAVE IN CASE PSI DURING PGUTRP
	MOVEM 7,PSIPT
	TLZ 1,UMODF		;SO HE CAN TELL IT WAS MON INTERRUPT
	SETOM SLOWF
	JRST PSIS5		;FINISH INTERRUPT START

;XMIT INTERRUPT TO SUPERIOR FORK

PSIT:	HRRZ 2,FORKN
	MOVE 2,FKPTRS(2)	;POINTERS RELATIVE TO FORK
	LSH 2,-^D24		;SUPERIOR FORK POINTER
	HRRZ 2,SYSFK(2)		;SYSTEM FORK INDEX
	JRST PSIRQF		;REQUEST INTERRUPT

;THIS FORK WON'T TAKE INTERRUPT, DISMISS IT AND RECORD WHY

PSID1:	MOVEI 2,0(5)		;CHANNEL WITH NO LEVEL ASSIGNED
	JRST PSIN2

PSIN1:	MOVE 1,PSIBW		;INTERRUPTS OFF OR NO LEVCHN
	JFFO 1,.+1		;CALCULATE CHANNEL NUMBER
PSIN2:	MOVEM 2,FORCTC		;SAVE CHANNEL NUMBER FOR STATUS
	MOVE 1,BITS(2)		;JUST ONE CHANNEL AT A TIME
	ANDCAM 1,PSIBW		;RESET WAITING BIT
	CALL FKTMI		;GIVE FORK TERM INTERRUPT
	MOVEI 3,FRZWT		;FORK FROZEN STATE TEST
	MOVE 1,CAPENB
	TLNE 1,(1B17)		;SUPERIOR WANTS FROZEN STEAD HALT?
	JRST PIRSK1		;YES, GO FREEZE
	JSYS UNPIR		;LEAVE PI STATE, MOVE AC'S ETC.
	MOVEI 1,FORCTM
	JRST DISMSE		;THIS ONE IS BEING DISMISSED

FORCTM:	JRST 0(4)		;SCHEDULER TEST FOR FORCED TERM FORK

;INTERRUPT SUPERIOR FORK ON TERMINATION

FKTMI:	PUSH P,1
	HRRZ 1,FORKN
	SKIPN 1
	SKIPA 1,[^D35]		;TERMINATING TOP FORK, GIVE CH 35
	MOVEI 1,^D19		;19 IS FORK TERMINATED
	CALL PSIT		;TRANSMIT IT
	POP P,1
	RET

GETCHA:	MOVEI 2,0(1)
	IDIVI 2,6
	ADDI 2,PSICHA
	HLL 2,CH6TAB(3)
	RET

;DEFERRED INTERRUPT LOGIC
;SET TRAPS TO RECHECK INTERRUPTS WHEN STATE CHANGES

PSIDFR:	MOVE 1,MJRST1
	MOVEM 1,MJRSTF
	MOVE 1,INTDF1
	MOVEM 1,INTDFF
	JSYS UNPIR		;LEAVE BREAK STARTING STATE
	IORM 1,FKINT(7)		;BUT LEAVE PENDING BIT
	JRST PSIDF1		;RESUME

MJRST1:	JRSTF @[PSISV0]
INTDF1:	JSYS PSISV1

PSISV1:	XWD PIPC,.+1
	SOSGE INTDF
	JRSTF @[PSISV2]
	JRSTF @PIPC		;JUST RETURN, HE'S NOT INTERRUPTIBLE

PSISV0:	MOVEM 1,PIPC		;SAVE AC1
	MOVE 1,FPC		;FPC NOW CONTAINS USER'S PC
	EXCH 1,PIPC
PSISV2:	MOVEM P,PIAC+17		;SAVE USER'S AC17
	MOVEI P,PIAC		;AND AC'S 0-NSAC
	BLT P,PIAC+16
	MOVE P,PIPDL		;RESTORE INTERRUPT STARTING STATE
	PUSH P,PGURET		;SAVE PGURET
	SETZM PIOLDS
PSISV3:	MOVE 2,FORKX
	MOVE 7,FKINT(2)
	JRST PSII		;ENTER MAIN SEQUENCE

;TEST FOR IMMEDIATE OR DEFERRED INTERRUPT
;SKIP => IMMEDIATE
;NOSKIP => DEFERRED
;CALLED WITH TEST USER PC IN AC1

PITEST:	TLNE 1,UMODF		;USER MODE?
	JRST RSKP		;YES, IMMEDIATE
	SKIPL SLOWF		;NO, SLOW CODE?
	SKIPL INTDF		;YES, INTERRUPTABLE
	RET			;NO, DEFER
	SKIPN NSKED		;IN CASE NOSKED W/O NOINT
	SKIPL TRAPC		;IN PAGER TRAP, OR
	RET			;YES, DEFER
	JRST RSKP		;IMMEDIATE

;DEBREAK

.DEBRK:	SKIPN PSIBIP		;ANY BREAKS IN PROGRESS?
	XCT MJRSTF		;NO, ACTS AS NOP
	MOVEM 1,TW1		;SAVE USER AC1,2
	MOVEM 2,TW2
	MOVE 2,FORKX
	MOVSI 1,200000
	IORM 1,FKINT(2)		;SET INTERRUPT STARTING BIT
	MOVE 2,TW2
	MOVE 1,TW1
	MOVEM P,PIAC+17		;ENTER INTERRUPT STARTING STATE
	MOVEI P,PIAC
	BLT P,PIAC+16
	MOVE P,PIPDL
	PUSH P,PGURET		;SAVE PGURET ON LOCAL STACK
	SETZM PIOLDS
PSIDBK:	MOVE 2,PSIBIP		;BREAKS NOW IN PROGRESS
	JFFO 2,.+2		;FIND HIGHEST ONE
	JRST 4,.		;IMPOSSIBLE
	HLRZ 1,LEVCHN		;COMPUTE ADDRESS OF RETURN PC
	ADDI 1,-1(3)
	UMOVE 1,0(1)
	TRNN 1,777760		;ADDRESS IS AC?
	SKIPA 1,PIAC(1)		;YES
	UMOVE 1,0(1)		;GET RETURN PC FROM USER MEMORY
	MOVS 2,BITS(3)
	TDNE 2,PSIBIP		;WAS THIS MONITOR INTERRUPT?
	JRST PSIS7		;YES, GO UNWIND
PSIS8:
IFN KAFLG,<
	TLZ 1,7637>		;FLUSH TROUBLESOME BITS
IFN KIFLG,<
	TLZ 1,7037>		; ..
	TLO 1,UMODF		;MAKE SURE USER MODE IS ON
	MOVEM 1,PIPC		;SET TO DEBREAK AT THAT ADDRESS
PSIS6:	MOVE 1,BITS(3)
	ANDCAM 1,PSIBIP		;CLEAR BIP THIS LEVEL
	JRST PSISV3		;GO CHECK FOR OTHER INTERRUPTS AND RETURN

PSIS7:	ANDCAM 2,PSIBIP		;CLEAR MON BREAK FLAG FOR THIS LEVEL
	MOVE 7,PSIPT
	POP 7,PIPDB		;RESTORE PGURET ON LOCAL STACK
	POP 7,4			;PC GIVEN TO USER
	POP 7,PSIPT		;TOP OF THIS BLOCK OF PSI STORAGE
	TLON 1,UMODF		;IF IT WAS DIDDLED AT ALL,
	CAME 1,4
	JRST PSIS8		;DON'T RESUME MON ROUTINE
	POP 7,2
	MOVEM 2,ACBAS
	SETACB 2
	POP 7,4
	SUB 7,4
	HRRZ 5,ACBAS1
	LSH 5,4
	CAIL 2,<EUACB>B39	;PREVIOUSLY USING PSB FOR AC BLOCKS?
	JRST [	SUBI 5,PSB-UACPGA	;NO, FORCE BLT TO UACPG
		SETZM PSB+UACPG		;CLEAR UACPG MAP ENTRY
		PUSH P,1
		LDB 1,[POINT 13,PSB+PSBPG,26]
		MOVE 2,[XWD RCW,UACPGA]
		CALL SETMPG		;SET UP MAP FOR UACPG
		POP P,1
		JRST .+1 ]
IFN KIFLG,<
	MOVEI 5,KIASTK>		;ACTUAL TO OF KI STACK
	MOVE 2,5		;SAVE ACB ADDRESS
	HRLI 5,1(7)
	ADDI 4,0(5)
	BLT 5,-1(4)		;RESTORE AC BLOCKS
	MOVSI 5,PIAC		;PUT USER CURRENT AC'S INTO TOP BLOCK
	HRRI 5,0(2)
	BLT 5,17(2)
IFN KIFLG,<
	MOVSI 5,KIASTK		;PUT TOP OF STACK BACK IN AC BLOCK 1
	XCTMU [BLT 5,17]>
	SUB 7,[XWD 20,20]
	HRRZ 5,ACBAS
	CAIGE 5,<EUACB>B39	;AC BLOCKS IN PSB?
	JRST PSIS7A		;YES
	HRRZ 5,ACBAS1		;NO, MUST COPY THEN FROM UACPG
	SUBI 5,<PSB-UACPGA>B39	;TO PSB
	HRL 5,ACBAS1
	LSH 5,4
	MOVSS 5
	BLT 5,EUACB-1		;COPY AS MANY AS FIT IN PSB

PSIS7A:	MOVEI 2,PIAC
	HRLI 2,1(7)
	BLT 2,PIAC+17		;RESTORE MONITOR AC'S
	SUB 7,[XWD NUPDL,NUPDL]
	MOVEI 2,UPDL
	HRLI 2,1(7)
	BLT 2,UPDL+NUPDL-1	;RESTORE STACK
	MOVEI 2,NSAVC-1		;RESTORE GROUP OF CELLS
	POP 7,@SAVCT(2)
	SOJGE 2,.-1
	POP 7,PIPC		;ACTUAL MON INTERRUPT PC
	SETZM SLOWF
	SETOM INTDF
	JRST PSIS6		;NOW DEBRK

;TABLE OF CELLS STORED ON PI STACK AROUND A PSI

SAVCT:	40
	60
	MPP
	FPC
	PIOLDS
	XMENTR
IFN KIFLG,<
	KIMAC1
	KIMAC2>
NSAVC==.-SAVCT		;LENGTH OF THIS LIST


;TRAP AND PSI ROUTINE EXECUTED WHEN A FORK EXECUTES A TRAPPED JSYS

JTSRVD==400000 		;TRAP SERVICED FLAG

TRAPSI: XWD JTTMP,TRPSI0
TRPSI0: MOVEM 1,TW1		;SAVE AC1 AND AC2
	MOVEM 2,TW2
	MOVSI 1,200000
	MOVE 2,FORKX		;PREVENT PSI'S WHILE IN
	IORM 1,FKINT(2)		;THIS CODE
	HRRZ 1,JTMNW		;GET HANDLE OF IMMED MON.
	CAIN 1,7777		;NULL MON FORK?
	BUG(CHK,<UNMONITORED FORK TRAPPED>)

	HRRZ 1,JTTMP		;DETERMINE JSYS EXECUTING WHEN
	SUBI 1,JTDVC1+1		;TRAPPED
	DPB 1,JTTJSY		;SAVE IT
IFE JTRPSW-1,<
	CONO PGR,6		;UNMAP RES MON
	    >
	HRRZ 1,NJDV(1)	 	;GET NORMAL DISPATCH
IFE JTRPSW-1,<
	CONO PGR,7		;REMAP RES MON
	    >
	HRRM 1,JTTMP		;AND SAVE IT.  AT THIS POINT
	MOVE 1,FPC		;RH(JTTMP)=NORM DISP
	TLNE 1,UMODF		;CALL FROM USER MODE?
	JRST TRPSI1		;YES, DETERMINE FORK TO PSI
	MOVSI 1,200000		;NO, ACCEPT PSI'S,
	MOVE 2,FORKX	
	ANDCAM 1,FKINT(2)
	MOVE 1,TW1		;RESTORE ACS 1 AND 2,
	MOVE 2,TW2
	JRST @JTTMP		;AND DO NORMAL DISPATCH

TRPSI1: MOVEM 1,JTFPC
	MOVE 1,TW1		;RESTORE ACS 1 AND 2
	MOVE 2,TW2

	MOVEM P,XMENT1		;CALL FROM USER MODE, SET UP
	MOVE P,UPP		;STACK, ETC. AS IN BECOMING SLOW
	MOVEM P,MPP		;BUT DON'T BE INTERRUPTABLE
	MOVE P,ACBAS1
	MOVEM P,ACBAS
	SETACB P
	MOVE P,XMENT1
	UMOVEM P,P
	SETZ P,
	XCTMU [ BLT P,P-1 ]
	MOVE P,MPP

	PUSH P,FPC		;SAVE USER RETRUN FOR RFSTS,ETC
	HRRZ 1,JTMNW		;GET IMMED MONITOR
	LDB 2,JTTJSY
	IDIVI 2,^D36
	MOVE 3,BITS(3)		;2=OFFSET INTO BIT TABLE
	TDNE 3,JTBTB(2)		;3=MASK FOR TRAPPED JSYS.
	JRST TRPSI3		;HANDLED BY IMMED MONITOR

TRPSI2: JUMPN 1,TRPSIA		;FORK=TOP JOB FORK?
TRPSIB: TLNN 2,JTSRVD		;YES, TRAP HANDLED YET?
	BUG(CHK,<NO MONITOR FOR TRAPPED FORK>)
	JRST TRPSI6		;YES, DO NORMAL DISPATCH.

TRPSIA:	MOVEI 11,0(1)
	CALL SETLF1		;MAP MONITOR'S PSB
	EXCH 1,11
	HRRZ 1,JTMNW(11)	;1=ITS MONITOR
	CAIN 1,7777		;NULL MONITOR?
	JRST TRPSIB		;YES.
	ADD 11,2
	TDNN 3,JTBTB(11)	;IS THAT FORK HANDLING JSYS?
	JRST TRPSI2		;NO, TRY ITS MONITOR.

TRPSI3: TLO 2,JTSRVD		;INDICATE TRAP HANDLED
	MOVEI 11,0(1)
	CALL SETLF1		;MAP PSB OF THE MONITOR
	EXCH 1,11
TRPSI4:	HLRZ 4,JTMNW(11)
	TRZ 4,777700
	CAIN 4,77		;IS CHANNEL SPECIFIED?
	JRST TRPSI5		;NO, DON'T PSI
	CALL JTLOCK		;SYNCH WITH OTHER TRAPPING FORKS
	JRST TRPSI4		;FORK SUSPENDED AND RESUMED
	 			;WHILE QUEUED, RETRY LOCKING
	JSYS FRZPSI		;FREEZE SELF AND PSI MONITOR


;RESUMED HERE AFTER TRAP HANDLED IF MONITOR DOES NOT CHANGE PC

TRPSI5:	JUMPE 1,TRPSI6		;IF TOP JOB FORK DO DISPATCH
	JRST TRPSIA		;OTHERWISE LOOK FOR MORE MONS.

TRPSI6:	LDB 1,JTTJSY
IFE JTRPSW-1,<
	CONO PGR,6		;UNMAP RES MON
	    >
	HRRZ 1,NJDV(1)		;GET NORMAL DISPATCH
IFE JTRPSW-1,<
	HRRZ 2,JTMNW
	CAIE 2,7777		;UNLESS NO LONGER TRAPPED
	CONO PGR,7		;REMAP RES MON
	    >
	MOVEM 1,JTTMP
	MOVE P,JTFPC
	MOVEM P,FPC		;RESTORE FPC
	TLZ P,UMODF
	HLLM P,JTTMP
	MOVSI 1,200000
	MOVE 2,FORKX
	ANDCAM 1,FKINT(2)	;ACCEPT PSI'S
	SETZ P,
	XCTUM [ BLT P,P-1 ]	;RESTORE ACS
	UMOVE P,P
	JRSTF @JTTMP		;DO NORMAL DISP FOR THIS JSYS


;FREEZE AND PSI ROUTINE - FORK INITIATES JSYS TRAP PSI OF
;FORK TRAPPED TO AND THEN FREEZES ITSELF
;1/ JOB INDEX OF FORK TO PSI
;11/ OFFSET TO FORKS PSB


FRZPSI:	XWD FPC,FRZPS0

FRZPS0:	LDB 4,JTTJSY
	HRL 4,FORKN		;4=FORK INDEX,,JSYS
	MOVEM 1,JTTMP		;SAVE FORK TRAPPED FOR UTFRK
	MOVEM 4,JTTRW(11)	;SET TRAPPED FORK,,JSYS
	HRRZ 4,SYSFK(1)
	ENTSKD			;ENTER THE SCHEDULER, SAVE ACS,
	 			;ETC.
	MOVEI 2,0(4)
	MOVSI 1,400000+PSIJTR
	IORM 1,FKINT(2)		;PSI MONITORING FORK
	CALL PSIR4		;MAKE SCHEDULER SEE IT

	MOVSI 1,200000+JTFRZB	;DO "JSYS TRAP" FREEZE OF SELF
	IORM 1,FKINT(7)		;7=FORKX SET BY ENSKED
	SETZM PIOLDS		;"OLD STATE" = RUNNING
	MOVEI 1,FRZWT
	JRST DISMS1		;DISMS

JTMCN:	POINT 6,JTMNW,17	;SELECTS PSI CHANNEL
JTTJSY:	POINT 9,JTMNW,11	;PTR TO TEMP STORAGE FOR TRAPPED JSYS

JTDVC1:	XLIST	;REPEAT 1000,<	JSYS TRAPSI >
	REPEAT 1000,<	JSYS TRAPSI >
	LIST
;THE INTERMEDIATE DISPATCH VECTOR.
;TRAPPED JSYS'S DISPATCH THROUGH IT
;TO TRAPSI ROUTINE

;JSYS TRAP LOCK AND UNLOCK ROUTINES
;WHEN A FORK TRIES JTLOCK AND SOME OTHER FORK HAS THE
;LOCK, THE FORK ADDS ITSELF TO A QUEUE (FKJTQ) AND BECOMES BLOCKED.
;WHEN THE LOCK IS CLEARED (BY A MONITORING FORK) THE QUEUE IS
;SCANNED FOR THE FIRST FORK (IF ANY) WAITING ON THE LOCK.  THAT
;FORK IS REMOVED FROM THE QUEUE AND ALLOWED TO RUN.

;LOCK ROUTINE
;ON ENTRY TO JTLOCK:
;1/ JOB FORK INDEX (OF FORK TO FIELD TRAP)
;11/ PTR TO ITS PSB
;RET + 1 IF SUSPENDED AND RESUMED WHILE QUEUED
;RET + 2 WITH LOCK SET

JTLOCK:	NOSKED
	AOSE JTLCK(11)		;TRY TO SEIZE THE LOCK
	JRST JTLOC2		;SOMEONE ELSE HAS IT
	OKSKED 			;GOT IT
JTLOC1:	AOS 0(P)		;RET + 2
 	RET

JTLOC2:	JSYS JTENQ		;PUT SELF ON JSYS TRAP QUEUE
	JRST JTLOC1		;RETURNS HERE WITH LOCK SEIZED

;IF FORK IS RESUMED AT JTRLCK, IT RETURNS + 1 TO TRAPSI ROUTINE
;FORCING ANOTHER CALL TO JTLOCK AFTER A CHECK TO SEE IF THE TRAP IS
;STILL TO GO TO THE SAME FORK.


JTRLCK:	MOVEM 1,TW1		;SAVE ACS 1 AND 2
	MOVEM 2,TW2
	MOVSI 1,200000
	MOVE 2,FORKX
	IORM 1,FKINT(2)		;PREVENT PSI'S BEFORE REENTERING
	MOVE 1,TW1		;TRAP CODE
	MOVE 2,TW2
	RET

JTENQ:	XWD FPC,JTENQ0		;ROUTINE TO PALCE FORK ON QUEUE
JTENQ0:	HRL 1,SYSFK(1)		;1=FORK WAITING ON
	ENTSKD			;ENTER SCHEDULER
	SOSE NSKED		;MATCHED NOSKED IN JTLOCK
	BUG(HLT,<JTENQ WITH BAD NSKED>)
	MOVEI 6,FKJTQ(7)	;7=FORKX, SET BY ENSKED
	HRRM 6,@JTLSTL		;ADD THIS FORK TO END OF QUEUE
	EXCH 6,JTLSTL		;SET NEW END OF QUEUE PTR
	MOVSM 6,FKJTQ(7)	;SET BACK PTR TO OLD QUEUE END
	HRRI 1,JTQWT
	JRST DISMS1		;DISMS


;JSYS TRAP QUEUE WAIT TEST

JTQWT:	MOVE 1,FKINT(7)		;DID A SUSPEND REQUEST OCCUR
	TLNN 1,SUSFKR		;BEFORE BLOCKING?
	JRST 0(4)		;NO.
	MOVSI 1,400000+PSIWTF	;YES, REINITIATE SUSPEND
	IORM 1,FKINT(7)		;REQUEST PSI
	MOVSI 1,200000
	ANDCAM 1,FKINT(7)	;ALLOW PSI'S
	HLRZ 1,FKQ(7)
	CAIG 1,1
	JRST 1(4)
	PUSH P,3		;GIVE FORK SOME PRIORITY
	CALL PSSKD2
	POP P,3
	JRST 1(4)


;UNLOCK ROUTINE
;USES BUT DOES NOT SAVE ACS 1,2,3,4

JTULCK:	HRRZ 2,FORKX
       NOSKED
	MOVE 1,JTLST		;SCAN QUEUE LOOKING FOR FORK
	 			;WAITING ON EXECUIING FORK
JTULC1:	JUMPE 1,JTULC3		;NONE FOUND
	MOVEI 4,0(1)
	SUBI 4,FKJTQ		;4=FORK INDEX OF QUEUED FORK
	HLRZ 3,FKSTAT(4)
	CAMN 3,2		;THIS FORK WAITING ON EX FORK?
	JRST JTULC2		;YES, REMOVE IT FROM QUEUE
	HRRZ 1,0(1)		;NO, TRY NEXT FORK
	JRST JTULC1

JTULC2:	CALL JTDEQ		;REMOVE FORK FROM QUEUE
	MOVEI 3,JSKP		;SET WAIT TEST TO SKIP
	MOVEM 3,FKSTAT(4)	;CAUSING FORK TO RUN
	CAIA
JTULC3:	SETOM JTLCK		;NO FORKS ON QUEUE, CLEAR LOCK
       OKSKED
	RET

;REMOVE FORK WHOSE FKJTQ ENTRY IS PT'D TO BY 1 FROM JSYS TRAP QUEUE
;USES BUT DOES NOT SAVE ACS 2,3

JTDEQ:	NOSKED
	HRRZ 3,(1)		;3=PTR TO NEXT ITEM ON QUEUE
	HLRZ 2,(1)		;2=PTR TO PREV ITEM
	HRRM 3,(2)
	JUMPE 3,JTDEQ1		;REMOVING LAST ITEM?
	HRLM 2,(3)		;NO
	CAIA
JTDEQ1:	MOVEM 2,JTLSTL
       OKSKED
	RET

END			;END OF SCHED.MAC FILE