;<FOONEX>SCHED.MAC;81 18-Mar-81 20:50:28, Edit by MMCM
; ERJMP/ERCAL
;DSK:<FOONEX>SCHED.MAC;80 19-Sep-80 14:19:12, Edit by DANG
; Added versatec device VTC
;<FOONEX>SCHED.MAC;79    11-Jun-80 15:31:31    EDIT BY LYNCH
; CHANGED INTERACTIVE QUANTUM TO BE BIGGER.
;<134-TENEX>SCHED.MAC;78     8-Jun-80 16:30:00    EDIT BY LYNCH
; made jobact update always.
;DSK:<PEFMON>SCHED.MAC;11  4-Jun-80 12:02:41, Edit by FRENCH
;MAKE FLASHS FLASH RATE ADJUSTER AS WELL AS SWITCH
;DSK:<PEFMON>SCHED.MAC;9  3-Jun-80 14:07:11, Edit by FRENCH
;MAKE FLASHS LOCAL SO NOT CLEARED IN SYSGO
;DSK:<PEFMON>SCHED.MAC;8 30-May-80 12:39:47, Edit by FRENCH
;ADDED IDLE LOOP FLASHER, ON/OFF SWITCHABLE (LEAVE IT IN DAN)
;<134-TENEX>SCHED.MAC;74    20-May-80 09:06:35    EDIT BY LYNCH
; put in hack in CDIST to really shut down batch jobs!!!
;<134-TENEX>SCHED.MAC;73    30-Apr-80 15:30:46    EDIT BY PETERS
; Fix SETZM CTRLTT to SETOM CTRLTT at HLTJB1
;<134-TENEX>SCHED.MAC;72    14-Apr-80 08:40:48    EDIT BY LYNCH
; MADE DEMO HACK ONLY USE UP TO "CUTOFF" AMOUNT OF THE MACHINE BY
; FAKING ITS DSHARE OVER IN ASGDSH AND ELIMINATING THE INTERQ HACKS 
; HERE ALTOGETHER.  SHOULD RESULT IN SLIGHTLY LESS RESPONSIVE DEMO
; MODE, BUT IT SHOULD NEVER KILL THE MACHINE.
;<134-TENEX>SCHED.MAC;71    10-Apr-80 13:33:06    EDIT BY LYNCH
; MADE DEMO HACK GIVE ONLY "CUTOFF" PORTION OF THE MACHINE.
; ALSO DID MORE CODE CLEANUP
;<134-TENEX>SCHED.MAC;70     8-Apr-80 17:05:56    EDIT BY LYNCH
; REORGANIZED SCHEDULER CODE TO MAKE MORE READABLE (HOPEFULLY).
;<134-TENEX>SCHED.MAC;69     7-Apr-80 17:12:19    EDIT BY PETERS
; Cleanup done by Dan Lynch
;<134-TENEX>SCHED.MAC;68     1-Apr-80 07:46:36    EDIT BY LYNCH
; Changed load ave fence from 5 to 8.
;DSK:<134-TENEX>SCHED.MAC;67 31-Mar-80 12:27:19, Edit by RKNIGHT
; Added table LLORCA for last login/change account date/time.
;DSK:<134-TENEX>SCHED.MAC;65  5-Mar-80 14:48:03, Edit by RKNIGHT
; Added table TTYCHS for character counts.
;<134-TENEX>SCHED.MAC;64    27-Jan-80 18:26:56    EDIT BY PETERS
; Fix KAFLG to KAFLG!F3FLG
;DSK:<134-TENEX>SCHED.MAC;63 25-Jan-80 18:30:21, Edit by FRENCH
;ALLOW TERMINAL CODE PSIS FOR DETACHED JOBS
;DSK:<134-TENEX>SCHED.MAC;62 14-Jan-80 20:07:09, Edit by FRENCH
;RELEASE ANY AUX CIRCUITS JOB MAY HAVE IN HLTJB
;RELD NO LONGER DOES THAT FOR US
;<134-TENEX>SCHED.MAC;61    12-Dec-79 22:12:36    EDIT BY FRENCH
;ADDED CALL TO LGOAUX AT HLTJB1
;<134-TENEX>SCHED.MAC;60    28-Nov-79 10:53:52    EDIT BY LYNCH
; FIXED UP SCHED HACK ON LIMIT STUFF.
;<134-TENEX>SCHED.MAC;59    19-Nov-79 16:30:49    EDIT BY PETERS
; Added storage for sysmem getab
;<134-TENEX>SCHED.MAC;58    19-Nov-79 15:27:59    EDIT BY PETERS
; Patched limiter to not limit system jobs
;<134-TENEX>SCHED.MAC;57     5-Nov-79 22:48:24    EDIT BY PETERS
; Fixed DEMO bug at SETCQ
;<134-TENEX>SCHED.MAC;56    31-Oct-79 12:23:02    EDIT BY LYNCH
; PUT IN LIMIT CODE TO PREVENT HOGS FROM GETTING MORE THAN TWICE THEIR
; SHARE AT LOADS ABOVE 5.
;<134-TENEX>SCHED.MAC;55    16-Sep-79 18:44:47    EDIT BY PETERS
;added isi, ki, and tymshare changes

	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,IOIP,MENTR,MONCOR,MRETN
EXTERN NXTDMP,PIAPRX,SETPPG
EXTERN SETPT,SPTC,SWPIN0,SWPINT,SWPRT
EXTERN SETMPG,JDSPTP

ifn kiflg,<
extern kiastk,kibgn,kiend,kifupt,kimac1,kimac2
extern kip7a,kip7f,kip7p,kip7q,kislod,kissav,kitbl,kxupt
>

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,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,MAXQ,DISG,DISGT,BLOCKW
	INTERN SUPERP,PARALP,INFERP,PSILOB,TMZONE,DISLE,DISLET
	INTERN PATCH1,PATCH2,FFF
	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,MPEINT
	INTERN SCDVE,PISC7
	INTERN JTULCK,PSIWTF,JTMCN,JTFRZB,JTDVC1,FRZBAL,TRPSI5
	INTERN NEWFKF
	INTERN TTFRKP
	intern setspq,sethiq,relhiq,cntlck,cnflct,lcktst,chkwt,ttpsr1
	intern relspq,prwake,ensked,trapsi,trpsi0

ifn kaflg!f3flg,<
	intern setovf
>

ifn kiflg,<
	intern rskd1
>

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




;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*KAFLG>+<2*KIFLG>+<2*KLFLG>+<1*F3FLG>
IFN KIFLG,<		;[ISI]
LS PGUNTF,1 >		;[ISI] PGRTRP untrap thru scheduler flag
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 FKFLGS,NFKS		;PER PROCESS FLAGS
			;FLAG BIT DEFS FOR ABOVE FKFLGS TABLE
WTFK==:1B18		;PROCESS IN BALANCE SET AND WAITING
NOSK==:1B19		;PROCESS IS NOSKED
BLST==:1B21		;PROCESS IS IN BALANCE SET
RNLS==:1B22		;PROCESS IS ON A RUNLIST
NOCNT==:1B26		;FORK BEING BORN OR DYING. DON'T INCLUDE IN NAPROC
			;AS FORK IS NOT RECORDED IN SYSFK
HOLD==:1B27		;HOLD FORK IN BALANCE SET FOR MAXBSH AFTER DISMISS
WTLS==:1B28		;FORK IS ON THE WAIT LIST
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 TTO SETHIQ
GS FKJTQ,NFKS		;JSYS TRAP QUEUE - BACK PTR,,FWRD PTR
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
GS FKINTT,NFKS		; IIT - TIME TO INTERRUPT
GS FKINTW,NFKS		; IIT - CHANNELS TO INT ON
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
GS JOBACT,NJOBS		; LAST TIME CPU ACTIVE FOR THIS JOB
GS JOBPGF,NJOBS		; NUMBER OF PAGE FAULTS PER JOB
GS TTYCHS,NJOBS		;TTY character count per job.
GS LLORCA,NJOBS		; Last login date or date/time of last change account.
LS FREJOB,1		;LIST OF FREE JOBS

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

;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
			;+PAGES UNASSIGNED AND AWAITING COLLECTION
GS SYSMEM,1		;RH = TOTAL PAGES OF MEMORY ONLINE, LH = MAXCOR
GS NRPMIN,1		;MINIMUM VALUE OF NRPLQ
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 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 RJAVS1,1		;RJTSUM AT LAST RJAV UPDATE

;TABLES FOR SETNM

NNAMES==^D80		;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
LS QSUM,MAXQ+1		;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
GS SORTIM,2		;TIME SPENT IN AND ENTRIES TO RESORT

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==^D16

;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 JOB 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

;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



;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


;SCHEDULER INITIALIZATION

SCDIN:	SETZM SYSIFG
	SETZM AUTONX
	SETZM PWRDWN
	SETZM ENTFLG
ifn kiflg,<
	setzm pguntf		;[isi]
>
	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 SSKED
	SETOM DDMPFK
	SETOM CRJLCK		;FREE LOCK ON CRJOB CELLS
	HRLOI 1,377777
	MOVEM 1,CHKTM1		;AVOID JOB0 BUGHLT ON STARTUP
	HRLOI 1,377		;BITS TO MAKE INSKED PLUS ON STARTUP
	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

;CLOCK ROUTINES

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

APCLK1:	CONO APR,1000+APCHNS	;[ISI] 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
	SKIPLE 1,SYNCC		;COUNTED 50 MS.?
	JRST [	ADDM 1,TODCLK	;NO, FINISH UP LAST TICKS
		ADDM 1,JOBRTT
		CAIN 1,^D50	;[ISI] IS MS CLOCK RUNNING?
		 JRST .+1	;[ISI] NO, RESTART IT.
		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


;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
	SKIPE PGUNTF		;[ISI] PGRTRP untrap request?
	 JRST SCDR		;[ISI]  Yes, resume process
	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,<
	SKIPE PGUNTF		;[ISI] PGRTRP untrap request?
	 JRST SCDRB		;[ISI]  Yes, skip following!
	JSP 7,KISLOD>		;RELOAD STUFF PECULIAR TO KI-10
IFE JTRPSW-1,<			;IF MAPPING RES MON FOR TRAPS
	HRRZ 1,JTMNW		;1=FORKS MONITOR
	CAIE 1,7777		;[ISI] Null fork?
	SKIPN 1,PSB+JDVPG	;NO, IS FORK INIT'D?
	 JRST SCDRA		;[ISI]  Null fork or not init'd
	MOVEM 1,MMAP+1		;YES, SET MON MAP AND
 IFN KAFLG!F3FLG,<		;[ISI]
	CONO PGR,7 >		;[ISI] MAP RES MON
 IFN KIFLG,<			;[ISI]
	SETOM USEJDV## >	;[ISI] JSYS dispatch thru JDVPG
SCDRA:
>
	MOVE 1,PSB40
	MOVEM 1,40
	MOVSI 17,PAC		;RESTORE PROCESS AC'S
	BLT 17,17
IFN KIFLG,<			;[ISI]
SCDRB:	SETZM PGUNTF >		;[ISI] Correct setting for PGUNTF
	JEN @PPC		;RUN PROCESS
;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
	jsp 2,tymclk##		;go do tymnet clock stuff
	MOVE 2,CLKAC2		;RESTORE AC2
	MOVE 1,CLKAC1
	JRST APCLKX


;IDLE LOOP FLASHER
;ONLY FLASHES IF FLASHS IS NON-NEGATIVE
;ADJUST FLASHS FOR RATE OF FLASH

FLASHS: -1			;-1 TO NOT FLASH OR
				;NON-NEGATIVE FOR # TIMES IDLE LOOP SHOULD
				;EXECUTE BETWEEN EACH FLASH
				;EX. 0 FOR FLASH EVERYTIME
				;    1 FOR EVERY OTHER TIME
				;    2 FOR EVERY 3RD TIME

LS (FLASHC)			;FLASH RATE ADJUSTER COUNTER
LS (FLASH1)			;1ST DATA REG
LS (FLASH2)			;2ND DATA REG

SFLASH:	SKIPGE FLASHS		;DO IT?
	 RET			;NO
	SOSL FLASHC		;TIME TO FLASH?
	 RET			;NO
	PUSH P,1		;CLOBBER NO REGS
	MOVE 1,FLASHS		;YES-REINIT FLASH COUNTER
	MOVEM 1,FLASHC
	SKIPE FLASH1		;INITED YET?
	 JRST SFLAS1		;YES
	MOVEI 1,1B18!1B35	;LEFT AND RIGHT MOST BITS OF HALF
	MOVEM 1,FLASH1		;INTO RIGHT HALF
	MOVSM 1,FLASH2		;INTO LEFT HALF
SFLAS1:	MOVE 1,FLASH1
	ROT 1,1			;SHIFT IT LEFT
	MOVEM 1,FLASH1		;UPDATE
	MOVE 1,FLASH2
	ROT 1,-1		;SHIFT IT RIGHT
	MOVEM 1,FLASH2		;UPDATE
	IOR 1,FLASH1		;OR TOGETHER
	DATAO PI,1		;FLASH
	POP P,1			;RESTORE ACS
	RET


;SCHEDULER  --   MAIN SCHEDULER LOOP IS HERE -- DISPATCHES TO EVERYTHING

SCHED0:	CAIA
SCH0:	CALL SFLASH		;MAYBE FLASH LITES IN IDLE LOOP
	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
 IFN KAFLG!F3FLG,<		;[ISI]
	CONO PGR,6 >		;[ISI] UNMAP IT
 IFN KIFLG,<			;[ISI]
	SETZM USEJDV## >	;[ISI] Normal JSYS dispatch
>
	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, GO OFF TO TTYSRV

	SETZM SKEDF3		; RESET REQUEST FLAG
	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 .			;WAIT FOR INTERRUPT DISPATCH ....

; PROCESS CLOCKS SCANNED HERE -- LOT'S OF MISC THINGS UPDATED
	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
	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 MTA		;MAG TAPE
	ECALL PTP		;PAPER TAPE PUNCH
	ECALL LPT		;PHYSICAL LPT
	ECALL VTC		;VERSATEC PRINTER-PLOTTER
	CALL SKDCHK		;DO PERIODIC SCHEDULER FUNCTIONS
	GS SKDTIM,1
	CALL RESORT		;REORDER COMPUTATION QUEUE
	GS RESTIM,1
	CALL DORJAV		;UPDATE LOAD AVS
	GS RJATIM,1
	ECALL DLS		;DLS (TTY) BACKGROUND STUFF
	call tymchk##		;primary tymnet i/o handler
	gs tymtim,1
IFDEF CHAOS,<
	CALL CHTTC7##		;DO CHECKING ON CHAOSNET NVT'S
	GS CHATM0,1
>

N2CLKS==.-CLK2CL

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

PI7P:	IOWD NSKDP,SKDPDL

; PERIODIC SCHEDULER FUNCTIONS

SKDCHK:	MOVEI 1,^D8000		;UPDATE EVERY 8 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
	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

;ROUTINE WHICH PERIODICALLY REORDERS THE COMPUTATION QUEUE
;		AND IT INCREMENTS THE GLOBAL PAGE AGE VALUE

RESORT:
	AOS 1,AGEGLB##		; TICK THE GLOBAL PAGE AGE VALUE
	TRNE 1,777000		; OVERFLOW 9 BIT FIELD?
	 MOVEI 1,100		; YES, SO RESET TO LEGAL STARTING AGE
	MOVEM 1,AGEGLB		; STORE IT AWAY!
	STMR			;TIME THIS ROUTINE
	MOVEI 1,^D1000		;DO THIS EVERY SECOND
	MOVEM 1,RESTIM
	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
	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 4,FKJOB(7)		;GET JOB NO.
	MOVE 2,PIEGRP(4)	;GET GROUP INDEX
	MOVE 3,DSHARE(2)
	FDVR 3,NAPROC(2)	;AC3=TARGET
	MOVN 1,FKUTIL(7)	; GET NEGATIVE UTILIZATION
	SKIPN 3			; 
	 MOVSI 3,167400		; PROTECT AGAINST 0
	FDVR 1,3		; MERIT FUNCTION IS -(FKUTIL)/(DSHARE/NAPROC)
	HLRZ 2,JOBPT(4)		; NOW SEE IF THIS IS A BATCH JOB
	CAIG 2,PTYHI
	 CAIGE 2,PTYLO
	  RET			; NOPE, SO JUST RETURN
	FMPRI 1,(100.0)		; YES, SO EXAGGERATE HIS UTILIZATION GREATLY
	RET







;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
	CALL GCBLBS##		; GO COMPUTE BALSET BIAS FOR NGCC
	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



;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

;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:
	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,[HRRM 1,FKQ(7)	; SAVE REMAINING TIME ON THIS QUEUE
		RET]
	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

;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
	CALL TIMIIT		; TEST FOR IIT INTERRRUPT
	MOVE 1,FKFLGS(7)	; GET FLAGS
	TLNN 1,WTLS		; ON WAIT LIST
	JRST WTSCN1		; NO, GO CHECK NEXT
	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
		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:	nosked
	PUSH P,1
	move	1, fkflgs(7)		; Check to see if he's on waitlist.
	tlnn	1, wtls
	 jrst	prwak2
	PUSH P,2
	PUSH P,3
	PUSH P,4
	move	2, fkstat(7)		; Does activation test agree that he
	hlrz	1, 2			; should run?
	jsp	4, 0(2)
	 caia				; It doesn't, just return (bugchk?).
	CALL AWAKEN
	POP P,4
	POP P,3
	POP P,2
prwak2:	POP P,1
	oksked

	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:
	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
	RET

; 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



;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 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

;QUEUE PARAMETER TABLES

SPECQ==0			; QUEUE FOR SPECIAL SCHEDULING
INTERQ==SPECQ+1			;INTERACTIVE QUEUE
COMPQ==INTERQ+1			;COMPUTATION QUEUE

QUANTS:	^D100
	<^D1000*KAFLG>+<^D800*KIFLG>+<^D750*F3FLG>
	^D10000				;ESSENTIALLY INFINITE QUANTUM FOR COMPQ


;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

;BALANCE SET SCHEDULER
;CALLED TO SELECT PROCESS TO RUN

SKPROC:	STMR			;BEGIN TIMING THIS ROUTINE

	SETZM PSKED
	SKIPE FSHBAL		;ANYBODY WANT TO FLUSH THE BALANCE SET?
	 CALL FSHBS		;YES, GO DO IT
SKPR1:	MOVE 1,NRPLQ		; GET NUMBER OF FREE PAGES
	ADD 1,IOIP		; ADD IN SWPOUTS IN PROGRESS
	CAMG 1,GCSTRT##		; BELOW THRESHOLD?
	 CALL NGCC##		; YES, SO CALL GLOBAL CORE GARBAGE COLLECTOR
	SKIPL 7,SSKED		; ARE WE NOSKED NOW?
	 JRST SKPR11		; YES, SO JUST CHECK TO SEE IF IT IS RUNNABLE
	MOVE 1,NRPLQ		; NOW SEE IF ENOUGH PAGES TO EVEN LOAD A FORK
	CAMGE 1,NRPMIN##	; BARE MINIMUM?
	 JRST SKPR7		; NOT ENOUGH SO JUST RUN THOSE IN CORE NOW
	SKIPN NGPROC		;ANY PROCS WAITING TO ENTER BAL SET?
	 JRST SKPR7		;NO
	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		;RUNNABLE?
	 JRST [	HRRZ 2,11	; GET QUEUE LEVEL
		CAIGE 2,COMPQ	; IS IT ON COMPQ?
		 JRST SKPR2	; NOPE SO DON'T PUNISH
		MOVE 2,IRJAV	; GET LOAD AVE
		CAIGE 2,8	; IS LOAD AVE ABOVE 8?
		 JRST SKPR2	; NOPE, SO LET HIM SLOP IT UP.
		HLRZ 4,FKJOB(7)	; YES, SO FIND OUT HIS SHAR AND UTIL.
		HRRZ 3,JOBDIR(4)
		CAIN 3,1
		 JRST SKPR2	; LET SYSTEM HAVE ANYTHING IT WANTS.
		MOVE 4,PIEGRP(4)
		MOVE 3,DSHARE(4)
		FDVR 3,NAPROC(4)
		FMPRI 3,(2.0)	; LIMIT TO TWICE ALLOCATION
		FADRI 3,171500	; ADD IN .005 FOR LOGOUT PROBLEM
		CAML 3,FKUTIL(7)
		 JRST SKPR2	; STILL WITHIN LIMITS
		SETZM FKPAGE(7)	; THIS IS A HOG SO KICK HIS PAGES OUT
		SOJG 10,SKPR9	; AND FORGET HIM THIS PASS UNTIL HE
		 JRST BKGND1]	; DECAYS IN UTILIZATION.
	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
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

;FLUSH ALL JOBS FROM THE BALANCE SET, THEN CALL GCALC
FSHBS:	SKIPL SSKED		;ARE WE NOSKED?
	 RET			;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
	JRST FSHBSN
FSHNL:	AOBJN 10,FSHBS1		; NEXT LIST
	 JRST GCALC

;REMOVE PROCESS FROM BALANCE SET

REMBSF:	TDZA 3,3
REMBSJ:	SETO 3,
	HLRZ 2,FKJOB(7)		;MAINTAIN SUBSYS INFO
	HRRZ 2,JOBNAM(2)
	HRRZ 1,FKWSP(7)
	HRLI 1,(1B14)		;COUNT REMOVALS FROM BALSET
	ADDM 1,SWAKES(2)	;INTEGRATE SIZE
	MOVSI 2,-PLKV
	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
	ANDCAB 1,FKFLGS(7)	;TURN OFF BAL SET BIT
	TLZN 1,WTFK		;[ISI] Waiting fork?
	 SOSA NBRUN		;[ISI]  No, removing runable fork
	  ANDM 1,FKFLGS(7)	;[ISI]  Yes, turn off wait bit
	SOS NBPROC		;[ISI]
IFN KIFLG,<			;[ISI]
	hrrz 1,fkflgs(7)	;release ki upt
	SKIPL 1,BITS(1)		;[ISI]  set available bit in KIFUPT
	 IORM 1,KIFUPT		;[ISI]  (but never set B0!)
	hllzs fkflgs(7)		;remove upt # from fkglgs
>
	JUMPGE 3,[AOS NGPROC
		RET]

;REMOVE PROCESS FROM RUNLST AND PLACE ON WTLST
	CALL REMRUN
	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:
	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
LDPR3:
IFN KIFLG,<
	SKIPG 1,KIFUPT		;[ISI] Assign UPT..
	 JRST LDPRT		;[ISI]  none available, go away
	JFFO 1,.+1		;[ISI] Isolate UPT #,
	MOVE 1,BITS(2)		;[ISI]
	ANDCAM 1,KIFUPT		;[ISI] clear available bit
	hrrm 2,fkflgs(7)	;remember assignment in fkflgs
	MOVSI 1,(1B0)		;[ISI] flag UPT resetting
	IORM 1,KITBL(2)		;[ISI]
>
	MOVSI 10,BLST+WTFK	;INDICATE WAITING, BAL SET FORK
	IORM 10,FKFLGS(7)
	SOS NGPROC
	AOS NBPROC
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)
	MOVEI 1,SWPINT
	MOVEM 1,FKPGST(7)	;SET TEST TO WAIT FOR PSB AND PT
LDPRT:	ETMR SKLDPR		;COMPLETE TIMING OF THIS ROUTINE
	RET			;NO SKIP RETURN


;SELECT PROCESS TO PROMOTE TO BALANCE SET

SCDRUN:	MOVSI 1,-<MAXQ+1>
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 [	AOBJN 1,SCDR1	; YES, GO TO NEXT LIST
		RET]		; SCANNED ALL LISTS WITH NO CANDIDATES FOUND
	MOVEI 7,@FKPT6M		;GET FORK INDEX
	MOVE 2,FKFLGS(7)	;GET FLAG WORD
	TLNE 2,BLST		;IN BALANCE SET?
	 JRST SCDR2		; YES, SO KEEP LOOKING FOR PROCESS NOT IN BALSET
	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]
	JRST RSKP		; SUCCESS RETURN WITH FORK INDEX IN 7

;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		; SET GLOBAL FORK INDEX FOR ALL TO SEE
	CALL TIMIIT		; TEST FOR IIT INTERRRUPT
	CALL SETPPG		;SETUP PAGER FOR THIS PROCESS
	HRRZ 3,FKQ(7)		;GET REMAINING TIME ON THIS QUEUE
	MOVEM 3,RJQNT
	SETZM RUNT1
	AOS SOLD+1		;COUNT TOTAL RESCHEDULES
ifn kiflg,<
	jrst setovf##		;go to kisrv if ki
>
IFN KAFLG!F3FLG,<
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


;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
SCHRST:	MOVE P,PI7P		;REINITIALIZE STACK POINTER
	JRST SCH0		; GO TRY FROM TOP AGAIN TO FIND A RUNNABLE JOB

;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

IFN KIFLG,<			;[ISI] Code from KI TENEX 1.31
RSKD1:	SETZM INSKED		;[ISI] From PGU3
	ENTSKD			;[ISI] (Enter SCHED for real)
	HRRZ 1,PPC		;[ISI] Within KI protected area?
	CAIL 1,KIBGN		;[ISI]
	CAIL 1,KIEND		;[ISI]
	SKIPE NSKED		;[ISI] Or no-sked?
	 JRST SCHED4		;[ISI]  Yes, resume process
	HRRZ 1,MJRSTF		;[ISI] Deferred interrupt waiting?
	CAIN 1,FPC		;[ISI]
	 JRST RSKD3		;[ISI]  No
	MOVEI 1,PSISV2		;[ISI] Yes, set to check it next running..
	EXCH 1,PPC		;[ISI]
	MOVEM 1,PIPC		;[ISI]
	JRST RSKD3		;[ISI]
>

;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
	MOVE 15,TODCLK
	MOVEM 15,JOBACT(16)	; LAST TIME ANY CPU ACTIVITY FOR THIS JOB
	SKIPN	JOBRTT		; ANY CHANGE?
	RET
	SETZ 15,
	EXCH 15,JOBRTT		;RUN TIME SINCE LAST UPDATE
	ADDM 15,SOLD		;ACCUMULATE ALL SOLD TIME
	ADDM 15,JOBRT(16)		;ACCOUNT FOR JOB
	ADDM 15,FKRT		;ACCOUNT FOR FORK
	ADDM 15,FKPRT(7)	;RUNTIME SINCE LAST FKUTIL UPDATE
	ADDM 15,RUNT1		;LOCAL RUNTIME
	HRRZ 16,JOBNAM(16)	;GET SUBSYSTEM INDEX
	ADDM 15,STIMES(16)	;ACCUMULATE SUBSYSTEM TIME
	MOVE 15,AGEGLB		; GET GLOBAL AGE
	DPB 15,[POINT 9,PGR72,8]	;FOR PAGER
	PGRLAG			;LOAD NEW AGE INTO PAGER
	RET

;VARIOUS WAYS OF ENTERING SCHEDULER

;JSYS HALTF - DISMISS FORK UNTIL INTERRUPT OR EXTERNALLY RESTARTED

.HALTF:	JSYS MENTR
HALTF1:
HALTX:	CALL GETSFX		;Get FORKX of superior in LH of 1
	HRRI 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
	CALL UPDUT		;[SRI] Maintain utilization stats
	SETZB	2,JOBCK0	;[ISI] Init measuring interval and hold time
	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
		  CALL CHKUNB	;Wake and/or PSI superior if needed
		  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)
	CALL CHKUNB		;Wake and/or PSI superior if needed
	JRST SCHP3

; ROUTINE TO DETERMINE WHETHER SUPERIOR NEEDS UNBLOCKING
CHKUNB:	HRRZ 1,FKSTAT(7)
	CAIE 1,HALTT		;FORK TERMINATING?
	CAIN 1,FORCTM
	CALL SUPUNB		;YES, UNBLOCK SUPERIOR IF NECESSARY
	RET

MAXBSH:	^D100		;MAX BALSET 'HYSTERESIS'


;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

IFN KAFLG!F3FLG,<		;[ISI]
	CONO APR,APRCHN+550 >	;[ISI] Clear & disable OV and FOV
IFN KIFLG,<			;[ISI]
	JFCL 11,.+1 >		;[ISI] Clear 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==^D14		;GIVES ABOUT 16 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)

;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 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

;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)

;CHECK SUPERIOR ON FORK TERMINATION
;SUPERIOR FORK INDEX LEFT IN LH OF DISMISS TEST WORD

SUPUNB:	PUSH P,7
	HLRZ 7,FKSTAT(7)	;GET SUPERIOR FORK INDEX
	MOVSI 2,WTLS		;FORK ON A WAITLIST?
	TDNN 2,FKFLGS(7)	;??
	 JRST SUPUX		;NO
	HRRZ 2,FKSTAT(7)	;GET ACTIVATION TEST
	CAIE 2,TRMTST##		;SPECIFIC FORK?
	JRST SUPUX		;NO
	HLRZ 2,FKSTAT(7)	;NO, SPECIFIC FORK.
	CAMN 2,0(P)		;WAITING FOR THIS ONE?
SUPU1:	CALL AWAKEN		;YES, WAKE IT
SUPUX:	SKIPE PRIMRY##		;IS THIS IN FORK INIT?
	CALL FKTMI		;NO. GENERATE INTERRUPT THEN
	POP P,7
	RET

;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
	JRST RSKP		; SO LET HIM IN

;TEST EDISMS FORK FOR ELAPSED GRACE PERIOD

DISMT:	PUSH P,4		;SAVE AC4
	MOVE 2,FKSTAT(7)	;SEE IF EDISMS WAIT IS OVER
	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
	CALL REMBSJ		; YES, SO DUMP FROM BALSET NOW
	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
	TLC 1,WTFK+RNLS+BLST	;SEE IF BEING HELD IN BALANCE SET
	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


;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)

; PIESLICE SYSTEM: HI-QUEUE THE FORK
PSSKD2:	PUSH P,3
	PUSH P,4
	MOVSI 2,SPQFK		;SPECIAL QUEUE?
	TDNE 2,FKFLGS(7)
	SKIPA 2,[SPECQ]		;YES
	MOVEI 2,INTERQ		;NO
PSSKD4:	CALL CHGQ
	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


; ROUTINE TO REPLACE FORK ON COMPQ
SETCQ:	PUSH P,3
	PUSH P,4
	MOVEI 2,COMPQ		;NO, OUT WITH THE REST OF THE LUSERS
	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+HIQFK	;YES, MAKE NOTE OF THAT
		IORM 1,FKFLGS(7)
		JRST SETHI2]
	MOVSI 2,HIQFK
	IORM 2,FKFLGS(7)	;SET IN FKFLGS
SETHI1:	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
	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
	ANDCAM 1,FKFLGS(7)	;SPQFK OFF BUT HIQFK STILL ON
	JRST SETHI1


;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
	CAIN 3,COMPQ		;GOING TO COMPQ?
	JRST REQUE		;PLACE ON COMPQ
	MOVEI 3,RUNLSB(3)	;TAIL POINTER
	CALL INSERT
	RET

;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

;PUT PROCESS ON THE WAITLIST

WTCONC:	MOVE 1,TODCLK		;SAVE TIME FORK WAS PUT INTO WAITING
	MOVEM 1,FKPGST(7)
WTCON1:	CALL APPWT		;APPEND TO WAITLIST
	RET


;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
	SKIPE 1,SYSIFG		;SYSTEM INITIALIZED?
	MOVE 1,DEFGP		;GET DEFAULT PIE-SLICE GROUP
	MOVEM 1,PIEGRP(2)
	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
	cail 2,tymttl		;is this a tymnet line?
	caile 2,tymtth		;true if in this range
	ret			;not tymnet, return
	jrst tymnfk##		;tymnet, go set connection status

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
	MOVE 1,SOLD
	MOVEM 1,FKSOLD(7)
	MOVSI 1,603146		; -.05 INITIAL UTILIZATION FOR USER
	MOVEM 1,FKUTIL(7)
	SETZM FKPRT(7)
	MOVE 1,TODCLK
	MOVEM 1,FKUDT(7)
	MOVEI 1,^D360		; INIT FKPAGE CUTOFF VALUE
	MOVEM 1,FKPAGE##(7)
	MOVSI 1,NOCNT		;INITIALIZE FKFLGS
	HLLM 1,FKFLGS(7)
	MOVEI 2,INTERQ
	CALL CHGQ
	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 FKINTT(7)	
	SETZM FKJOB(7)
	SETZM FKWSP(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

;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:
IFN KAFLG!F3FLG,<		;[ISI] IF KI DO NOT SET UP THE UACPG
	MOVE 1,PSB+PSBPG	;SETUP USER MAP WORD
	MOVEM 1,PSB+UACPG	;SAME AS PSB UNTIL OVERFLOW
>				;[ISI]
	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,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

	SETOM HIQCNT		;INIT SPEC SCHEDULING REQUEST COUNTS
	SETOM SPQCNT
	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

;HALT JOB

HLTJB:	HRRE 6,CTRLTT
	JUMPL 6,HLTJB1		;IF JOB DETACHED
	SETZM TTPSI(6)		;CLEAR TTY WORDS
	SETOM TTFORK(6)
	movei 2,(6)		;get line number to ac2
	cail 2,tymttl		;is this a tymnet line?
	caile 2,tymtth		;true if in this range
	jrst hltjb1		;not tymnet
	call tyhngu##		;tymnet, go start disconnect sequence

HLTJB1:	CALL LGOAUX##		;CLEAN UP AUXQUE TABLES
	MOVE 5,JOBNO
	SETOM CTRLTT		;CLEAR CONTROL TTY WORDS
	HRROS JOBPT(5)
	MOVEI 1,400000
	SETO 2,
	DIC			;DEACTIVATE ALL INTERRUPTS
	MOVNI 1,1
	CLOSF
	JFCL
	RELD			;RELEASE ALL DEVICES
	JFCL
	CALL TYMRLA##		;RELEASE ANY AUX CIRCUITS JOB MAY HAVE
	MOVEI 1,-4
	KFORK			;KILL ALL INFERIOR FORKS
IFDEF SIGIPC,<	CALL RMJBRF##	;REMOVE REFERENCES TO THIS JOB IN SIGS>
	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
				;[ISI] MOVED THE FOLLOWING 7 LINES FROM ABOVE
HLTJB4:	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

	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 FKDGCC##		;CLEAN UP PAGES
	POP P,7
	HRRZ 1,FKFLGS(7)	;[ISI]
	CAIN 1,0
	SKIPE FKWSP(7)
	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



;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)
;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
	CALL JSERT##
	 JRST MRETN
	MOVEI 1,^D15		;INITIATE CHANNEL 15 INTERRUPT

ITR4::	PUSH P,1
	MOVE 1,CHNSON
	ANDCAM 1,PSIBW		;FLUSH PREVIOUS PANIC BREAKS
	POP P,1
	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

;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:	JUNPIR			;[ISI] Leave PI state
PSIDF1:	SKIPN 1,PIOLDS		;WAS RUNNING BEFORE PSI?
	 JRST SCHED3
	JRST DISMSE		;NO, REPLACE ON WAIT LIST

IFN KAFLG!F3FLG,<	;;KA can use JSYS call
DEFINE	JUNPIR	<JSYS UNPIR>
>
IFN KIFLG,<	;;KI can't/shouldn't
DEFINE	JUNPIR	<JSP 7,UNPIR>
>

UNPIR:
IFN KAFLG!F3FLG,<
	XWD ENSKR,.+1 >
IFN KIFLG,<
	MOVEM 7,ENSKR >
	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:				;REQUEST INTERRUPT, FORK IN AC2
	NOSKD1			;[ISI] We may be in sched already
	CALL PSIRQ
	OKSKD1			;[ISI] Resume if we were not in sched
	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)
	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 #
	CAIN 4,777777		;DETACHED?
	 JRST TTPSR0		;YES-POKE JOBS TOP FORK THEN
	CAIE 4,0(2)		;LINE PSI REQUESTED?
	JRST TTPSR2		;NO, MUST FIND TOP FORK IN GROUP TO PSI
TTPSR0:	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)
	JUNPIR			;[ISI] 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]

       NOSKED			;[ISI]
	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,<
	HRRZ 2,KXUPT		;[ISI] Current UPT
	MOVEI 1,KIASTK(2)	;[ISI] Move AC block 1 to top of stack
	XCTUM [BLT 1,KIASTK+17(2)]  ;[ISI]
>
	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,<
	HRRZ 2,KXUPT		;[ISI]
	MOVSI 2,KIASTK(2)	;[ISI] 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
     OKSKED			;[ISI]

	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
	MOVE 1,CAPENB
	TLNE 1,(1B17)		;SUPERIOR WANTS FROZEN STEAD HALT?
	JRST [	CALL FKTMI		;GIVE FORK TERM INTERRUPT
		MOVEI 3,FRZWT		;FORK FROZEN STATE TEST
		JRST PIRSK1]
	CALL GETSFX		;GET SUPERIOR'S FX IN LH 1
	MOVE 10,1		;SAVE IT A WHILE
	JUNPIR			;[ISI] Leave PI state, move AC's etc.
	MOVEI 1,FORCTM
	HLL 1,10		;PUT IN THE FORKX OF SUPERIOR
	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

;GET SUPERIOR'S FORK INDEX FOR HALT OR FORCED TERMINATION

GETSFX:	HRRZ 1,FORKN		;FIND ME
	ADD 1,SUPERP		;MAKE POINTER TO MY SUPERIOR
	LDB 1,1			;FIND SUPERIOR'S FORKN
	HRLZ 1,SYSFK(1)		;CONVERT TO FORKX, PUT IN LH OF 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
	JUNPIR			;[ISI] 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!F3FLG,<
	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,<
	HRRZ 5,KXUPT		;[ISI]
	ADDI 5,KIASTK		;[ISI] Actual top of KI stack
>
	MOVE 2,5		;SAVE ACB ADDRESS
	HRLI 5,1(7)
	ADDI 4,0(5)

       NOSKED			;[ISI]
	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,<
	HRRZ 5,KXUPT		;[ISI]
	MOVSI 5,KIASTK(5)	;[ISI] Put top of stack back in AC block 1
	XCTMU [BLT 5,17]	;[ISI]
>
	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
       OKSKED			;[ISI]

	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,<
 IFN KAFLG!F3FLG,<
	CONO PGR,6 >		;UNMAP RES MON
>
	HRRZ 1,NJDV(1)	 	;GET NORMAL DISPATCH
IFE JTRPSW-1,<
 IFN KAFLG!F3FLG,<
	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,<
 IFN KAFLG!F3FLG,<
	CONO PGR,6 >		;UNMAP RES MON
 IFN KIFLG,<			;[ISI]
	SETZM USEJDV## >	;[ISI] Normal JSYS dispatch
>
	HRRZ 1,NJDV(1)		;GET NORMAL DISPATCH
IFE JTRPSW-1,<
	HRRZ 2,JTMNW
	CAIE 2,7777		;UNLESS NO LONGER TRAPPED
 IFN KAFLG!F3FLG,<
	CONO PGR,7 >		;REMAP RES MON
 IFN KIFLG,<			;[ISI]
	SETOM USEJDV## >	;[ISI] JSYS dispatch thru JDVPG
>
	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
TIMIIT:		; ROUTINE TO TEST TIMER INTERRUPT
	SKIPE 1,FKINTT(7)		; TIMER SET?
	CAMLE 1,TODCLK			; YES, IS IT TIME YET?
	 RET				; NOPE
	MOVE 1,FKINTW(7)		; GET INT CHANNEL
	MOVEI 2,(7)
	SETZM FKINTT(7)
	CALL PSIRQB			; CALL REQUEST INTERUPT
	RET

END			;END OF SCHED.MAC FILE
