Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93k-bb - 10,7/mon/sched1.mac
There are 13 other files named sched1.mac in the archive. Click here to see a list.
TITLE	SCHED1 - SCHEDULING ALGORITHM FOR SWAPPING SYSTEM (10/51)  V1157
SUBTTL R.KRASIN/TH/CMF/AF/RCC/DAL/EVS/WRS/KBY 05-SEPTEMBER-89

	SEARCH	F,S,DEVPRM
	$RELOC
	$HIGH


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1988>

		
XP VSCHED,1157
		;PUT VERSION NUMBER IN GLOB LISTING AND LOADER STORAGE MAP
ENTRY SCHED,SCHED1	;THIS UNDEFINED GLOBAL IN COMMON CAUSES THIS
			; ROUTINE TO BE LOADED.
SCHED1::		;MODULE ORIGIN

;THIS SCHEDULER BASED ON WORK DONE AT WMU BY E.SMOLSKY AND N.GRANT

;NXTJOB DECREMENTS ALL JOBS' IN CORE PROTECT TIMES AND REQUEUES ANY
; JOB WHOSE ICPT GOES TO ZERO. IT REQUEUES CURRENT JOB IF ITS QUANTUM
; RUN TIME HAS GONE TO ZERO. IT THEN
;SERVICES ANY JOB REQUEUING REQUESTED AT OTHER PRIORITY
;LEVELS THEN CALLS SHUFFLER,SWAPPER AND SCHEDULAR.
;RETURNS NEXT JOB TO RUN IN J.



NXTJOB::
IFN FTMP,<
	SKPCPU	(1)		;USE NXTJB1 IF NOT THE BOOT CPU
>
	SKIPN	.CPTMF##	;CLOCK TIC?
	JRST	NXTJB1		;NO
	MOVE	T4,TIME##	;GET TIME IN JIFFIES
	TRNE	T4,1B35		;ONLY DECREMENT IN CORE TIME ON ODD TICKS
	SOSGE	CORSCD		;COUNT DOWN. CORE STILL SCARCE?
	JRST	NXTJBX
	MOVEI	T4,JS.SCN	;JOB SCANNED DURING TICK BIT
	MOVEI	U,DCSCAN##	;TABLE OF QUEUES TO SCAN
NXTJBL:	SKIPN	T2,(U)		;AT END OF LIST?
	JRST	NXTJBX		;YES. EXIT LOOP
	HLRE	J,JBTCQ##(T2)	;GET LAST JOB IN QUEUE
	JUMPLE	J,NXTJBG	;IF NO ONE IN QUE, GET NEXT QUE
NXTJBA:	HLRE	T2,JBTCQ##(J)	;GET JOB BEFORE THIS JOB
	MOVEM	T2,NEXTJB	;STORE IT FOR LATER. NEXT TO LOOK AT
	SKIPGE	JBTST2##(J)	;DECREMENT ALL JOBS THAT ARE NOT IN A PROCESSOR
				;QUEUE (NORMALLY ONLY CATCHES SLP,EW)
	TDNE	T4,JBTST2##(J)	;OR IF JOB WAS ACTUALLY SCANNED
	JRST	.+2		;WE WILL DECREMENT
	  JRST	NXTJBF		;DO NOT DECREMENT THIS JOB
	ANDCAM	T4,JBTST2##(J)	;CLEAR SCANNED BIT FOR NEXT TIME
	HRRZ	W,JBTPDB##(J)	;GET PDB ADDRESS
	JUMPE	W,NXTJBF	;NO ICPT IF NO PDB
	LDB	T3,PDYIPT##	;GET ICPT
	SOJG	T3,NXTJBE	;IF STILL POSITIVE, JUST DEPOSIT
	MOVSI	T3,PDMSWP	;MARK SWAPPABLE IN PDB
	IORM	T3,.PDIPT##(W)	;..
	MOVE	T2,JBTSTS##(J)	;JOB STATUS WORD
	TLNE	T2,CMWB!JRQ	;COMMAND WAIT OR REQUE?
	JRST	NXTJBD		;YES. GET OUT
	PUSHJ	P,SETIPT	;RESET ICPT SO THE JOB WILL CYCLE
				; EVEN IF IT DOESN'T NEED TO SWAP
	SKIPL	JBTST2##(J)	;IS JOB IN A RUN QUEUE?
	JRST	NXTJBF		;NO. CAN'T REQUE HIM NOW.
IFN FTPSCD,<
	PUSHJ	P,CNTICP	;COUNT NUMBER WHO EXPIRED IN-CORE BY QUE
>
	PUSH	P,U		;SAVE ADDRESS OF QUEUE TABLE
IFN FTNSCHED,<			;
	MOVSI	T2,(JS.BBJ)	; BACKGROUND BATCH BIT FOR SWAPPER
	LDB	T1,JBYCLS##	; GET CLASS NUMBER
	SKIPLE	RRFLAG##	; ROUND ROBIN?
	CAME	T1,BBSUBQ##	; OR NOT BACKROUND BATCH CLASS?
	 CAIA			; OK. NOT B.B.
	  IORM	T2,JBTST2##(J)	; MARK FOR SWAPPER
>
	MOVEI	U,QTIME		;REQUE AROUND RUN QUEUES
	PUSHJ	P,QXFER		;DO TRANSFER
	POP	P,U		;GET ADDRESS OF QUEUE TABLE BACK
	JRST	NXTJBF		;GO TO NEXT JOB
NXTJBD:	SETZ	T3,		;PUT IN A ZERO FOR COMMAND WAIT, JRQ
NXTJBE:	DPB	T3,PDYIPT##	;OR JUST STORE NEW VALUE
NXTJBF:	SKIPLE	J,NEXTJB	;GET BACK THE NEXT JOB TO LOOK AT
	JRST	NXTJBA		;IF ANY AND LOOP FOR THE REST OF QUEUE
NXTJBG:	AOJA	U,NXTJBL	;NOW LOOP OVER ALL QUEUES
NXTJBX:
IFN FTNSCHED,<
	PUSHJ	P,SCDQTA	;RESET SCHEDULING SCAN TABLE AT
				;END OF A MICRO SCHEDULING INTERVAL
>;END IFN FTNSCHED
IFN FTRSP,<			;KEEP TRACK OF WANT-TO-RUN TIME
	SKIPE	RQTCNT		;SKIP IF NO DESIRE TO KEEP TRACK OF WTR TIME
	SOSLE	RQTCNT		;DO THIS EVERY "M.NRQT" TICKS
	JRST	RQT3		;NOT YET TIME
	MOVE	T2,RQTINT	;GET WANT-TO-RUN TIME CALCULATION INTERVAL
	MOVEM	T2,RQTCNT	;RESET COUNTER (KEEP VALUE IN T2 FOR RQT2)
	MOVSI	T1,WTMASK	;TO CHECK FOR RUN STATE COD
	HRRE	J,JBTCQ##-PQ1	;CHECK PQ1 IN CORE
	PUSHJ	P,RQT2
	HRRE	J,JBTCQ##-PQ2	;  PQ2     IN CORE
	PUSHJ	P,RQT2
	HRRE	J,JBCQOH##-PQ1	;CHECK PQ1 NO CORE
	PUSHJ	P,RQT2
	HRRE	J,JBCQOH##-PQ2	;  PQ2     NO CORE
	PUSHJ	P,RQT2
	JRST	RQT3		;SKIP AROUND SUBROUTINE

RQT2:	JUMPLE	J,CPOPJ##	;RETURN IF END OF JOBS IN QUEUE
	TDNE	T1,JBTSTS##(J)	;SKIP IF IN RUN STATE
	JRST	RQT1		;NOT IN RUN STATE
	ADDM	T2,JBTRQT##(J)	;BUMP JBTRQT BY NUMBER OF TICS
RQT1:	HRRE	J,JBTCQ##(J)	; FOR JOBS IN THIS QUEUE
	JRST	RQT2		;LOOK FOR ANOTHER JOB

	$LOW
RQTCNT:	BLOCK	1		;COUNTER FOR CHECKING TIME IN RUN QUEUES
RQTINT:	BLOCK	1		;INTERVAL VALUE
	$HIGH

RQT3:
>	; END OF CONDITIONAL ASSEMBLY ON FTRSP
NXTJB1::
IFN FTMP,<
	MOVE	T1,.CPSCC##	;RUN THE SCHEDULER DOORBELL BIT
	ANDCAM	T1,DOORBL##	;CLEAR IT SINCE WE ARE RUNNING THE SCHEDULER
>
	SKIPN	J,.CPJOB##	;CURRENT JOB NO., IS IT NULL JOB?
	JRST	CKJB1		;YES,GO SEE IF OTHER JOBS NEED RESCHEDULING
	LDB	T2,PJBSTS##	;GET STATE CURRENT JOB GOING TO
	CAIN	T2,PQIOQ	;IS IT GOING INTO PQ?
	SKIPE	T2,PAGIPC##	;YES, DID THE I/O ALREADY COMPLETE
	CAIA			;NOT DONE, DONE AND MORE TO DO, OR NOT PQ
	DPB	T2,PJBSTS##	;DONE AND NO MORE TO DO, PUT BACK IN RN NOW
				;(RNQ=0)
	MOVS	T2,JBTSTS##(J)	;GET JOB STATUS BITS AND CODES, HALVES SWAPPED
	SKIPGE	JBTST2##(J)	;REQUEUED OUT OF RUN QUEUE?
	TLNE	T2,JS.DEP	;IF JOB IS WAITING FOR DAEMON, SEE IF WE
				;CAN REQUE TO DAEMON QUEUE
	JRST	CKJB0A		;JOB SHOULD BE REQUEUED
IFN FTHPQ!FTNSCHED,<
	SKIPE	.CPHQU##	;IF CURRENT JOB JUST DID AN HPQUUO, OR
	JRST	CKJB0A		; CHANGED CLASS, IT IS RUNNABLE BUT
				; MUST BE REQUEUED
>
	ANDI	T2,-1-RUNMSK-CMWB ;MASK OUT DO NOT CARE BITS
	CAIE	T2,RUNABLE	;IS CURRENT JOB RUNABLE?
	JRST	CKJB0		;NO, REQUE CURRENT JOB
	HRRZ	W,JBTPDB##(J)	;YES. GET PDB ADR FOR CURRENT JOB
	JUMPE	W,CKJB1		;GO AWAY IF NONE
	LDB	T2,PDYIPT##	;GET ICPT
	JUMPE	T2,NXTJB4	;ALWAYS REQUE IF ZERO
	LDB	T2,PDYQNT##	;GET IN QUE TIME
	JUMPN	T2,CKJB1	;EXIT IF STILL POSITIVE
IFN FTRSP,<			;RESPONSE DATA?
	MOVEI	T1,.CPARR##	;BASE ADR OF 3 WORDS FOR QUANTUM REQUEING
	MOVSI	T2,(JR.RRR)	;RECORD THIS TYPE OF RSP FOR THIS JOB
	PUSHJ	P,RSPRC2##	;RECORD ELAPSED TIME FOR RESPONSE
				; AND FOR ANY OF TTY IN, TTY OUT, THIS
>	; END OF CONDITIONAL ASSEMBLY ON FTRSP
IFN FTPSCD,<
	PUSHJ	P,CNTINQ	;COUNT NUMBER WHO EXPIRED IN QUE BY QUE
	JRST	NXTJ4A
>
NXTJB4:
IFN FTPSCD,<
	PUSHJ	P,CNTICP	;COUNT NUMBER WHO EXPIRED IN-CORE BY QUE
>
NXTJ4A:	PUSHJ	P,QARNDT	;YES - REQUEUE AND RESET QUANT TIMES.
	JRST	CKJB1		;DO ONCE A CLOCK TICK STUFF

CKJB0:	TRZ	T2,JXPN!SHF!SWP	;JOB NOT RUNNABLE, BUT MAY NOT NEED REQUEUE
	CAIN	T2,RUNABLE	;DOES IT REALLY NEED TO BE REQUEUED?
	JRST	CKJB1		;NO, DON'T GIVE HIM EXTRA PRIORITY
				;BUT REQUE EVERYONE ELSE (IF CPU0)
CKJB0A:	MOVSI	T1,JRQ
	TDNN	T1,JBTSTS##(J)	;IS REQUE SET FOR CURRENT JOB?
	PUSHJ	P,QREQ		;GO REQUEUE THIS JOB
CKJB1:  SKIPN	JBTJRQ##	;AVOID SYSPIF TO SAVE OVERHEAD IF JBTJRQ NOW ZERO
	JRST	CKJB5C		;COULD MISS A REQUE, BUT WILL CATCH IT NEXT TIME.
	SYSPIF			;PREVENT RACES
	SKIPG	J,JBTJRQ##	;ANY JOBS IN LINKED LIST OF REQUEUES?
	JRST	CKJB5		;NO. GO ON
	MOVE	T1,JBTJRQ##(J)	;GET NEXT JOB
	MOVEM	T1,JBTJRQ##	;HE IS NOW FIRST
	MOVSI	T2,JRQ		;CLEAR JOB NEEDS REQUEING BIT
	ANDCAM	T2,JBTSTS##(J)	;JRQ ACTS AS AN INTERLOCK IN REQUE
	SYSPIN			;EXIT RACE WINDOW
	PUSHJ	P,QREQ		;GO REQUE THE JOB
	JRST	CKJB1		;YES. KEEP REQUEING
CKJB5:	SYSPIN			;EXIT RACE WINDOW
CKJB5C:	SKPCPU	(0)		;MASTER?
	JRST	SCHED		;NO, DON'T SWAP ON CPU1 YET?
	SKIPN	EVAVAL##	;EV AVAILABLE AND SOMEONE WAITING?
	SKIPE	FAAVAL##	;FA AVAILABLE (SOMEONE WAITING)?
	CAIA			;YES, SKIP INTO CKJB5B
	JRST	CKJB7		;NO.
	SETZM	EVAVAL##	;YES. CLEAR FLAG
	SETZM	FAAVAL##	;CLEAR FLAG
	SKIPG	J,HIGHJB##	;ANY JOBS?
	JRST	CKJB7		;NO. SHOULDN'T HAPPEN
	MOVSI	T2,WTMASK	;YES. TAKE EVERYBODY OUT OF EV WAIT
CKJB5A:	LDB	T1,PJBSTS##	;GET JOBS STATE CODE
	CAIE	T1,FAQ		;FA?
	CAIN	T1,EVQ		;EV?
	ANDCAM	T2,JBTSTS##(J)	;YES. TAKE HIM OUT
	SOJG	J,CKJB5A	;AND LOOP FOR ALL JOBS
CKJB7:	SKIPG	SWPCNT		; ANY SWAPS COMPLETE?
	SKIPN	.CPJOB##	;OR IF RUNNING NULL JOB
	JRST	CKJB6		;CALL SWAP/SHUFFLE
IFN FTHPQ,<			;
	SKIPLE	SCDRTF##	; IF AN HPQ JOB ON DISK WOKE UP
	 JRST	CKJB6		; CALL SWAP/SHUFFLE
>				;
	SKIPN	.CPTMF##	;ALWAYS CALL SWAP/SHUFFLE ON TICK
	JRST	SCHED		;NOT TICK OR OTHERWISE
CKJB6:
IFN FTMP,<
	PUSHJ	P,SCDMM##	;SEE IF MEMORY MANAGEMENT RESOURCE IS AVAILABLE
	  JRST	SCHED		;ITS NOT, CAN'T SWAP OR LOCK NOW
>	;END OF CONDITIONAL ASSEMBLE ON FTMP
	CPUNLK	(SCD)
	SKIPN	.CPSTS##	;DON'T SWAP IF TIMESHARING TURNED OFF.
	PUSHJ	P,SWAP
IFN FTLOCK,<
	  SKIPA			;NOT TRYING TO LOCK A JOB, PROCEED.
	PUSHJ	P,LOCK0##	;SHUFFLER AND SWAPPER ARE IDLE - SEE IF JOB CAN BE LOCKED
>	; END OF CONDITIONAL ASSEMBLY ON FTLOCK
	  JFCL			;IGNORE POSSIBLE SKIP RETURN
IFN FTMP,<
	PUSHJ	P,GIVMM##	;RETURN MM RESOURCE
>	;END OF CONDITIONAL ASSEMBLE ON FTMP
	CPLOCK	(SCD)
;SCHEDULER--SEARCH THRU QUEUES ACCORDING TO SSCAN TABLE
;FOR 1ST JOB IN CORE--RETURN ITS NO. IN J

SCHED:: SETZM	SCDRTF##	;ABOUT TO DO A SCHEDULER
	SETZM	.CPPLT##	;CLEAR POTENTIALLY LOST TIME FLAG
	SKIPE	.CPTMF##	; CLOCK TICK ON BOOT CPU?
	SETZM	UNWIND		; YES. ALLOW AN UNWIND CYCLE
IFN FTMP,<
	PJRST	MSCHED##	;DO SCHEDULING FOR MULTI-PROCESSORS
				;MSCHED IN TURN CALLS SCHEDJ TO FIND RUNABLE JOBS
>
				;ELSE FALL INTO SCHEDJ FOR SINGLE PROCESSOR SYSTEMS

;SCHEDJ IS CALLED TO FIND A RUNNABLE JOB
;IT RETURNS WITH THE HIGHEST PRIORITY RUNNABLE JOB IN J
;CALL:	PUSHJ	P,SCHEDJ
;	RETURN HERE WITH J SET UP

SCHEDJ::SETZM	.CPSUD##		; MAY NOT USE A SCAN. SO CLEAR INDICATOR

	SKIPL	J, LASLOK##	;SETTING MONITOR MEMORY OFF-LINE?
	SKIPE	J,.CPSTS##	;TIMESHARING TURNE OFF? (TRPSET)
	JRST	[HRRZS	J		;CLEAR LEFT HALF
		 SKIPGE	JBTSTS##(J)	;RUNNABLE?
		 SKIPL	JBTST2##(J)	;YES, IN A RUN QUEUE?
		 JRST	SCHD1		;NO TO EITHER QUESTION
		 MOVEI	T2,SCHD1	;IN CASE HE'S NOT REALLY RUNNABLE
		 JRST	SCHEDB]		;GO SEE
;	SETZM	UNWIND		;FLAG THAT WE ONLY UNWIND ONCE/SCAN
	MOVE	U,.CPSCN##	;ADDRESS OF STANDARD SCAN TABLE
	MOVEM	U,.CPSUD##	;RECORD WHICH SCAN WE USED
	SKIPE	J,FORCEF	;FORCING ANYONE WITH SHAR. RESOURCE?
	SKIPL	JBTST2##(J)	;IS JOB IN A RUN QUEUE?
	JRST	SCHED2		;NO! DON'T BOTHER CHECKING
	MOVEI	T2,SCHED2	;PREPARE TO SCAN NORMALLY
				;BUT START WITH JOB IN FORCEF 
	SETZM	UNWIND		; WANT TO UNWIND IN THIS CASE
	SKIPGE	JBTSTS##(J)	;IF NOT RUNNABLE, SCHED NORMALLY. (POSSIBLE
				; IF JOB HAS STOPPED AND GIVEN UP RESOURCE
	JRST	SCHEDB		; BUT FLAG HAS NOT YET BEEN CLEARED)
SCHED2:	MOVE	T1,.CPSFC##	;GET COUNT OF UNFAIR SCHEDULES
	CAMGE	T1,MFC##(U)	;HAS IT REACHED MAXIMUM FAIRNESS COUNT?
	JRST	SCHDJ1		;NO, DONT USE SECONDARY SCAN TABLE
	SETZM	.CPSFC##	;YES, CLEAR SCHEDULER FAIRNESS COUNT
	MOVE	U,SSCN##(U)	;AND GET ADDRESS OF SECONDARY SCAN TABLE
				; (PQ1 AND PQ2 REVERSED)
	MOVEM	U,.CPSUD##	;RECORD WHICH SCAN WE USED
SCHDJ1:	JSP	T1,QSCAN	;BEGIN SCAN
	  JRST	SCHD1		;NO MORE JOBS--RETURN NULLJOB
SCHEDB:
IFN FTMP,<
	PUSHJ	P,DXRUN##	;GO CHECK IF JOB IS RUNNABLE ON THIS PROCESSOR
	  JRST	(T2)		;NO, GO CONTINUE SCANNING
				; (ALSO SETS .CPPLT IF CAN'T RUN ON CPU1 BECAUSE HI-SEG
				; BEING SHUFFLED, SWAPPED, OR EXPANDED ON CPU 0)
>	; END OF CONDITIONAL ASSEMBLY ON FTMP
	MOVEI	F,JS.SCN	;YES
	IORM	F,JBTST2##(J)	;SET SCANNED BIT
	MOVSI	F,SCHKM		;IS A HIGH SEG THIS JOB OWNS BEING TRANSITIONED?
	TDNE	F,JBTSGN##(J)	;?
	JRST	(T2)		;YES, CAN'T RUN HIM NOW
	LDB	F,PJBSTS##	;GET STATE CODE
	JUMPE	F,SCHEDC	;IF ZERO, LET HIM THROUGH
	MOVE	T3,JBTSTS##(J)	;JOB STATUS
	PUSHJ	P,CJFRCX	;IF JOB IS EXPANDING WITH RESOURCE, IGNORE JXPN
				; SO JOB CAN BE RUN AND GIVE UP RESOURCE
	CAIE	F,EVQ		;EV IS HANDLED SEPARATELY ABOVE.
	TLNE	T3,SWP+JRQ+SHF+JXPN	;IF SWAPPED, SHUFFLING,
	JRST	(T2)		;REQUEING, OR EXPANDING - GIVE UP
	MOVE	T4,[UNWND0,,SCHEDA]	;FAIL,,SUCCESS
	CAIL	F,MINQ		;NON-ZERO. IS HE WAITING FOR A
	CAILE	F,MAXQ		;SHAREABLE RESOURCE?
	JRST	(T2)		;NO. CAN'T HELP HIM
SCHDB0:	HLRZ	T3,UNWTAB-MINQ(F)
	PUSHJ	P,(T3)
	JUMPE	T3,(T4)
SCHDB6:	MOVSS	T4		;TAKE FAIL ADDRESS
	JRST	(T4)

;HERE TO GET OWNER OF A NORMAL RESOURCE

UNWRES:	SETZ	T3,		;ASSUME ITS FREE
	SKIPE	AVTBMQ##(F)	;YES - IS IT FREE?
	POPJ	P,		;YES
	HRRZ	T3,USTBMQ##(F)	;RESOURCE OWNER
	SKIPN	T3
	SETO	T3,		;OTHER CPU IN SRFREE OR MM-STYLE
				;RESOURCE OWNED AT INTERRUPT LEVEL
	POPJ	P,
;HERE FIRST TIME WE CAN'T RUN JOB IN SHARABLE WAIT STATE, SEE
;IF WE CAN UNWIND HIM
UNWND0:	SKIPE	UNWIND		;SHOULD WE UNWIND?
	JRST	(T2)		;NO. ALREADY TRIED ONCE THIS SCAN
	MOVEI	T4,^D10		;TRY TEN LEVELS OF UNWINDING
	PUSH	P,T4
	PUSH	P,J		;SAVE J SO WE CAN CONTINUE SCAN LATER
	SETOM	UNWIND		;SAY WE HAVE UNWOUND ONCE
UNWND1:	SKIPLE	J,T3		;OWNING JOB
	CAMN	J,(P)		;SAME AS US?
	JRST	UNWNDF		;SHOULD NEVER HAPPEN %&'#@!
	LDB	F,PJBSTS##	;GET HIS STATE CODE
	JUMPE	F,UNWNDS	;WIN
	MOVSI	T3,SWP+JRQ+SHF	;BITS TO CHECK (IGNORE JXPN SINCE OWNS RESOURCE)
	CAIE	F,EVQ		;EV IS HANDLED SEPARATELY ABOVE.
	TDNE	T3,JBTSTS##(J)	;IF SWAPPED, SHUFFLING,
	JRST	UNWNDF		;NOPE
	CAIL	F,MINQ		;NON-ZERO. IS HE WAITING FOR A
	CAILE	F,MAXQ		;SHAREABLE RESOURCE?
	JRST	UNWNDF		;NO. CAN'T HELP HIM
	MOVE	T4,[UNWND7,,UNWNDS] ;FAIL,,SUCCESS
	JRST	SCHDB0		;TO SEE IF THIS GUY IS RUNNABLE

;HERE IF UNWINDING AND OWNER JOB ISN'T RUNNABLE
UNWND7:	SOSGE	-1(P)		;LOOPING?
	JRST	UNWND1		;NOT YET
UNWNDF:	POP	P,J		;RESTORE JOB NUMBER FROM SCAN
	POP	P,(P)		;AND COUNTER
	JRST	(T2)		;AND CONTINUE SCAN
UNWNDS:	PUSHJ	P,CHKRUN	;MAKE SURE WE CAN RUN HIM
	  JRST	UNWNDF		;CAN'T. #%$&@!
	LDB	F,PJBSTS##	;GET STATE CODE.
	JUMPE	F,UNWNN5	;RUN HIM IF ZERO
	HRRZ	T3,UNWTAB-MINQ(F)
	PUSHJ	P,(T3)		;GET RESOURCE
	  JRST	UNWNDF		;OH WELL, TRY TRY AGAIN
	MOVSI	T3,WTMASK
	ANDCAM	T3,JBTSTS##(J)
UNWNN5:	MOVEI	T3,JS.OOO	;FLAG FOR CLOCK1 TO STOP WHEN GIVES UP
	IORM	T3,JBTST2##(J)	;ALL HIS SHAREABLE RESOURCES
	AOS	UNWNDC##	;COUNT AN UNWIND
	ADJSP	P,-2		;FIX STACK
	JRST	SCHDC2		;RUN HIM

;HERE FOR NON-SPECIAL RESOURCES:

SCDRES:	SETZM	AVTBMQ##(F)	;GIVE IT TO HIM
	MOVEM	J,USTBMQ##(F)
	AOS	(P)
	POPJ	P,
; SUBROUTINE TO CHECK THAT JOB FOUND BY UNWIND CAN BE RUN
;CALL IS
;	MOVE	J,JOB-NUMBER
;	PUSHJ	P,CHKRUN
;	  NOT RUNNABLE RETURN
;	RUNNABLE RETURN
; SETS T3 TO JBTSTS(J). MAY DESTROY F

CHKRUN:	SKIPGE	T3,JBTSTS##(J)	;RUN BIT ON?
	SKIPL	JBTST2##(J)	;YES. IS JOB IN A RUN QUEUE?
	POPJ	P,		;NO. CAN'T RUN IT
	PUSHJ	P,CJFRCX	;CHECK FOR JOB EXPANDING WITH RESOURCE
				;IF SO, IGNORE JXPN TEMPORARILY SO HE
				; CAN GIVE UP THE RESOURCE TO GET SWAPPED
IFN FTLOCK,<
	TRNN	T3,LOK
>
	TLNE	T3,SWP+JRQ+SHF+JXPN+CMWB ;FLAGS THAT CAN'T USE
	  POPJ	P,		;NOT RUNNABLE
IFE FTMP,<
	JRST	CPOPJ1##	;RUNNABLE!
>
IFN FTMP,<
	PUSHJ	P,DXRUN##	; CHECK THAT WILL RUN ON THIS CPU
	 POPJ	P,		; CAN'T
IFN FTKL10,<			;
	PJRST	SCDCSH##	; O.K. W.R.T. CACHE?
				;AND EXIT SKIP/NON-SKIP
>				;
IFE FTKL10,<			;
	 PJRST	CPOPJ1##	;
>				;
>

;ROUTINE TO IGNORE JXPN FOR JOB EXPANDING WITH SHAREABLE RESOURCE
;ENTER WITH JBTSTS IN T3
;ALWAYS EXITS NONSKIP

CJFRCX:	TLNN	T3,JXPN		;JOB EXPANDING?
	POPJ	P,		;NO, NO PROBLEMS
	TLC	T3,NSHF		;NSHF BUT NOT NSWP SET?
	PUSHJ	P,FLSDR##	;DOES HE HAVE DISK RESOURCE?
	  TLNN	T3,NSHF!NSWP	;NO, IF BOTH NSHF AND NSWP ZERO, ONLY NSHF WAS ON
	TLZ	T3,JXPN		;SO IGNORE JXPN TEMPORARILY
	TLC	T3,NSHF		;SET NSHF BACK THE WAY IT WAS
	POPJ	P,		;RETURN

SCHEDA:	CAME	J,FORCEF	;FORCING JOB WITH SHAREABLE RESOURCE?
	JRST	SCHEDE		;NO. GIVE HIM RESOURCE AND RUN HIM
	PUSHJ	P,FLSDR##	;DOES HE STILL HAVE THE RESOURCE?
	  JRST	(T2)		;NO - DON'T GIVE HIM ONE
	CAIA			;LET HIM THROUGH
SCHEDC:	SETZ	F,		;NO RESOURCE TO GIVE HIM
SCHEDE:	MOVEM	J,.CPPLT##	;SET POTENTIALLY LOST TIME FLAG FOR CLOCK1
	MOVE	T3,JBTSTS##(J)	;IS THIS JOB SWAPPED OUT
	TLNN	T3,JXPN		;JOB EXPANDING?
	CAMN	J,FORCEF	;OR JOB IN FORCEF?
	JRST	[TLC	T3,NSHF		;SPECIAL CASE TO FORCE JOB TO RUN ONLY
		 PUSHJ	P,FLSDR##	;YES. WITH SHAREABLE DISK RESOURCE?
		   TLNN	T3,NSHF!NSWP	;IF ONLY NSHF WAS SET BEFORE
		 TLCA	T3,NSHF		;RESET STATE OF NSHF
		  JRST	(T2)		;NOT A SPECIAL CASE
		 TLZ	T3,JXPN		;YES. IGNORE JXPN (SOMEONE ELSE
					; MUST HAVE EXPANDED OUR HIGH SEG)
		 JRST	SCHDC1]		;CONTINUE
SCHDC1:				;EITHER NOT IN FORCEF, OR IS AND HAS
				; RESOURCE, IN WHICH CASE JXPN CLEARED IN F

IFN FTLOCK,<
	TRNN	T3,LOK		;DON'T RUN JOB CURRENTLY BEING LOCKED IN CORE
>	; END OF CONDITIONAL ASSEMBLY ON FTLOCK
	TLNE	T3,SWP+SHF+JXPN+JRQ ;MONITOR WAITING FOR I/O TO STOP,
				; OR JOB EXPANDING CORE?
				; OR JOB NEEDS REQUEING (SWAP READ ERROR)?
	JRST	(T2)		;YES--CONTINUE SCAN,JOB CANNOT BE RUN

IFN FTKL10&FTMP,<
	PUSHJ	P,SCDCSH##	;IS THIS JOB RUNNABLE WITH RESPECT TO THE
				; CACHE?
	  JRST	(T2)		;NO, GO FIND ANOTHER JOB TO RUN
				; NOTE THAT THIS IS DONE AFTER LOST
				; TIME FLAG IS SET SO THAT CACHE LOST
				; TIME IS INCLUDED IN SYSTEM LOST TIME
>;END IFN FTKL10&FTMP
	JUMPE	F,SCHDC2	;JOB NEED RESOURCE?
	HRRZ	T3,UNWTAB-MINQ(F) ;GET ADDR OF ROUTINE
	PUSHJ	P,(T3)		;YES, TRY TO GIVE IT TO HIM
	  JRST	(T2)		;FAILED
	MOVSI	T3,WTMASK	;CLEAR WAIT STATE
	ANDCAM	T3,JBTSTS##(J)
;HERE WHEN IRREVERSIBLY COMMITTED TO RUNNING THE JOB
SCHDC2:	CAMN	J,FORCEF	;FORCING A GUY WITH SHARABLE RESOURCE?
	AOS	FORCFC##	;YES, COUNT A FORCED SCHEDULE
IFN FTNSCHED,<
	SETZM	.CPSQF##	;ASSUME NOT FROM SUBQUE
	SKIPGE	JBTSCD##(J)	;IN PQ2 (AND THEREFORE SUBQUEUE)?
	SETOM	.CPSQF##	;YES, TELL CLOCK1
>	;END IFN FTNSCHED
IFN FTRSP,<			;RESPONSE DATA?
	MOVEI	T1,.CPACR##	;BASE ADR FOR CPU RESPONSE DATA THIS CPU
	MOVSI	T2,(JR.RCR)	;RECORDED CPU RESPONSE FOR THIS JOB
	PUSHJ	P,RSPREC##	;RECORD RESPONSE TIME (UNLESS ALREADY REC)
	DMOVE	T1,.CPACR##	;STORE DATA IN THE WRONG
	DMOVEM	T1,.CPODA##	; PLACE FOR OLD CUSPS
				; (DO NOT RECORD AS ONE OF TI, TO, RN, ALSO)
>	; END OF CONDITIONAL ASSEMBLY ON FTRSP
	SETZM	.CPPLT##	;CLEAR POTENTIALLY LOST TIME AS A USER IS TO BE RUN
IFN FTKL10&FTMP,<
	SETZM	.CPCLF##	;CLEAR CACHE LOST FLAG ALSO
>;END IFN FTKL10&FTMP
	MOVEI	T1,JS.SCN	;AND MAKE SURE HE GETS SCANNED BIT SET
	IORM	T1,JBTST2##(J)	;SINCE MAY NOT HAVE COME FROM QSCAN
	MOVE	T2,.CPSUD##	;GET START OF SCAN TABLE USED
	CAME	T2,.CPSCN##	;WAS IT PRIMARY SCAN?
	POPJ	P,		;NO. IT WAS FAIRNESS SCAN
	CAMGE	U,FSCN##(T2)	;DID THIS SCAN REACH FAIR TERRITORY
	AOSA	.CPSFC##	;NO, COUNT UP UNFAIR SCANS
	SETZM	.CPSFC##	;YES, CLEAR SCHED FAIRNESS
	POPJ	P,		;RETURN

SCHD1:	SKIPE	.CPPLT##	;ALREADY LOST TIME?
	JRST	SCHDN		;YES.
	MOVEI	U,LSCAN##	;NO. SEE IF SHOULD BE
	JSP	T1,QSCAN
	JRST	SCHDN		;NO MORE JOBS
	MOVSI	T3,WTMASK	;ZERO STATE CODE?
	TDNE	T3,JBTSTS##(J)	;...
	JRST	(T2)		;NO. TRY NEXT
IFN FTMP,<
	PUSHJ	P,DXRUN##	;SEE IF CAN RUN ON THIS CPU
	  JRST	[SKIPN .CPPLT##	;CAN'T, DID .CPPLT GET SET
		 JRST (T2)	;NO, LOOK FOR MORE JOBS
		 JRST SCHDN]	;YES, RETURN NULL JOB NOW
>
	MOVEM	J,.CPPLT##	;YES. LOST TIME
SCHDN:	SETZB	J,.CPSFC##	;RETURN NULL JOB
	POPJ	P,
; THIS SUBROUTINE DETERMINES HOW TO REQUE THE JOB

QREQ:	MOVE	T2,JBTSTS##(J)	;JOB STATUS WORD
	TDNE	T2,[JS.DEP+(CMWB)]	;ANY STRANGE BITS ON?
	JRST	QREQ1		;YES, GO DO SOME SPECIAL THINGS
QREQ0:	LDB	U,PJBSTS##	;GET QUEUE CODE
	JUMPGE	T2,QSTOPT	;IS RUN BIT ON? IF NOT, JOB GOES TO STOP Q.
	HLRZ	T1,QBITS(U)	;GET DISPATCH ADDRESS FOR REQUE METHOD
	JRST	(T1)

QREQ1:	MOVEI	U,QCMW		;ASSUME COMMAND WAIT
	TLNN	T2,CMWB		;IS JOB IN COMMAND WAIT?
	JRST	QREQ2		;NO--WAIT STATE CODE DETERMINES NEW QUEUE
	TLNE	T2,SWP+JXPN	;YES--IS JOB ON DISK, OR TRYING TO EXPAND?
	JRST	QXFER		;YES--PUT JOB IN COMMAND WAIT QUEUE
QREQ2:
	MOVEI	U,JDCQ		;ASSUME DAEMON WAIT
	TRNN	T2,JS.DEP	;IS IT?
	JRST	QREQ0		;NO, JUST REQUEUE BY STATE CODE
	PUSHJ	P,FLSDR##	;YES. PUT IN DAEMON QUEUE IF JOB HAS NO RESOURCES.
	  JRST	QJDCT		;OWNS NO RESOURCE, SO TRANSFER AND ZERO ICPT
				;HAS A RESOURCE, DON'T PUT HIM IN JDCQ

	JRST	QREQ0		;REQUEUE BY STATE CODE

DEFINE X(A,B,C)
<	XLIST
	Q'A'T==QREQ6
	Q'A'W==-1
	LIST
>

	RWAITS
QIOWT==QREQ6
QDIOWT==QREQ6
QPIOWT==QREQ6
QNAPT==QREQ6			;IN CASE OF CONTROL C WHILE IN NAP, ETC.

REPEAT 0,<
QPST:	SKIPL	JBTST2##(J)	;IS JOB IN A RUN QUEUE?
	  PUSHJ	P,QCHNG		;NO. PUT HIM INTO A RUN QUEUE
	CAMN	J,VMQJOB##	;HAS JUST THIS JOB EXCEEDED PAGE RATE?
	JRST	QPST1		;YES. REQUE TO REAR
	SKIPGE	VMQJOB		;SYSTEM PAGE RATE EXCEEDED?
	SKIPN	SLECNT##	;SOMEONE WANT TO USE THE SWAPPING/PAGING CHANNEL?
	JRST	QPSTN		;NO
QPST1:	SKIPN	W,JBTPDB##(J)	;NEED PDB
	JRST	QPSTN		;...
	SKIPGE	.PDIPT##(W)	;DON'T REQUE UNTIL SWAPPABLE, ELSE CORE WILL BE
				;JAMMED WITH VIRTUAL JOBS WHICH WON'T RUN
	PUSHJ	P,TOBACK	;PUT TO REAR OF QUEUES, DON'T RESET Q.R.T.
	JRST	QPSTN		;AND FALL INTO NORMAL QUEUE TRANSFER
>;END REPEAT 0
IFN FTNSCHED,<
QRNT:	MOVSI	T2,(JS.CSQ)	;CHANGING SUB QUEUE?
	TDNE	T2,JBTST2##(J)	;...
	SKIPL	JBTSCD##(J)	;AND STILL IN PQ2?
	JRST	QREQ3		;NO. NORMAL REQUE
	JRST	QREQX		;YES. JUST FIX SUBQUE
>

QPST:
QWST:
QDST:	SKIPL	JBTST2##(J)	;IS JOB IN A RUN QUEUE?
	PUSHJ	P,QCHNG		;NO. PUT HIM IN A RUN QUEUE

QPSTN:	MOVSI	T1,WTMASK	;CLEAR WAIT STATE CODE
	ANDCAM	T1,JBTSTS##(J)
	JRST	QREQX		;AND EXIT QREQ. (NO QUE TRANSFER)

QTST:	MOVSI	T1,WTMASK	;CLEAR WAIT STATE
	ANDCAM	T1,JBTSTS##(J)
;	JRST	QREQ3		;AND PERFORM QUEUE TRANSFER
IFE FTNSCHED,<
QRNT:
>
QSLPT:
QEWT:
QPQIOT:
QREQ3:	HRRZ	U,QBITS(U)	;PICK UP TRANSFER TABLE ADDRESS
	PUSHJ	P,QXFER		;REQUE THE JOB
	JRST	QREQX		;AND EXIT QREQ.

QSTOPT:	SKIPN	JBTADR##(J)	;STOPQ IF REALLY HAS CORE SO WILL SWAP OUT
	CAIE	U,NULQ		;IS HE REALLY GOING TO THE NULL Q?
	MOVEI	U,STOPQ		;NO. STOP QUE
;	JRST	QREQZ		;ZERO ICPT AND REQUE

QNULT:
QJDCT:
QTIOWT:
QREQZ:	PUSHJ	P,ZERIPT	;ZERO ICPT
	JRST	QREQ3		;DO THE REQUE

QREQ6:	SKIPL	JBTST2##(J)	;IS JOB IN RUN QUEUE?
	PUSHJ	P,QCHNG		;NO. PUT IT IN RUN QUEUE
QREQX:
IFN FTNSCHED,<
	MOVSI	T2,(JS.CSQ)	;GET "CHANGED SUB QUE" BIT
	TDNN	T2,JBTST2##(J)	;DID HE?
	POPJ	P,		;NO. EXIT QREQ.
	ANDCAM	T2,JBTST2##(J)	;YES. CLEAR BIT
	SKIPGE	JBTSCD##(J)	;STILL IN PQ2 AFTER OTHER REQUE CODE?
	PUSHJ	P,TOBACK	;PUT HIM TO BACK OF SUBQUE(AND PQ2)
>
	POPJ	P,		;EXIT QREQ.
; SUBROUTINE TO PUT JOB INTO A RUN QUEUE.
; DESTROYS U,T1,T2,R,W.  SAVES J
QCHNG:	MOVEI	U,QRNW1		;PUT IN BACK OF PQ1
	PJRST	QXFER		;WITHOUT ASSIGNING QUANTUM TIME

; ROUTINE TO SET ICPT. J AND W MUST BE SET UP AND PDB MUST EXIST
; PRESERVES ALL ACS
SETIPT::PUSH	P,T1
	MOVE	T1,PROT1##	;MINIMUM ICPT FOR CYCLE TIME
	LSH	T1,-1		;IPT IS DECREMENTED EVERY OTHER TICK
	DPB	T1,PDYIPT##
	JRST	TPOPJ##

; ROUTINE TO CLEAR ICPT. SET UP W. NEEDS J
; PRESERVES ALL ACS EXCEPT W
ZERIPT::HRRZ	W,JBTPDB##(J)	;FIND PDB
	JUMPE	W,CPOPJ##	;NO PDB. NOTHING TO DO.
;	PJRST	CLRIPT		;FALL INTO CLRIPT

; ROUTINE TO SET BIT TO EXPIRE ICPT
; PRESERVES ALL ACS
CLRIPT::PUSH	P,T1
	MOVSI	T1,PDMSWP	;SWAPPABLE BIT
	IORM	T1,.PDIPT##(W)	;SET IT
	PJRST	TPOPJ##

; SAME AS CLRIPT BUT EXPECTS PDB ADDRESS IN T1
CLRIP1::PUSH	P,T2
	MOVSI	T2,PDMSWP	;SWAPPABLE BIT
	IORM	T2,.PDIPT##(T1)	;SET IT
	PJRST	T2POPJ##

; ROUTINE TO ASSIGN ICPT.
; DESTROYS T1,T2.
ASICPT::SKIPGE	CORSCD		;CORE SCARCE?
	PJRST	CLRIPT		;NO
	SKIPN	T1,PROT##
	JRST	ASICP1		;SAVE TIME
	PUSHJ	P,JOBSIZ##	;COMPUTE SIZE OF JOB
	MOVE	T1,T2		;PUT IN T1
	IMUL	T1,PROT##	;ADD VARIABLE AMOUNT DEPENDING ON CORE SIZE
ASICP1:	ADD	T1,PROT0##	;ADD FIXED AMOUNT INDEPENDENT OF CORE SIZE
	CAMLE	T1,PROTM##	;IN LEGAL RANGE?
	MOVE	T1,PROTM##	;NO, USE MAXIMUM
	ADD	T1,ICPCV1	;CONVERT TO TICKS FROM US
	IDIV	T1,ICPCV2	;CONVERT TO TICKS
	LSH	T1,-1		;DECREMENTED EVERY OTHER TICK
	DPB	T1,PDYIPT##	;SET IN-CORE PROTECT TIME.
	POPJ	P,		;RETURN
;SUBROUTINE TO PUT JOB TO BACK OF PQ2
; USES SAME REGISTERS AS QCHNG

TOBACK:	MOVEI	U,QRNW2		;TRANSFER TABLE TO BACK OF PQ2, DONT
	PJRST	QXFER		;CHANGE QUANTUM RUN TIME.


; SUBROUTINE TO REQUEUE JOB AROUND THE RUN QUEUES

QARNDT:	SETZM	UNWIND		; WANT TO UNWIND NOW
	LDB	T1,PJBST2##	;GET REAL QUEUE
	CAIN	T1,PQ2		;IS IT PQ2?
	JRST	QARND1		;YES. REQUE CLEARING ICPT
	LDB	T1,PDYIPT	;NOT PQ2. ANY ICPT LEFT?
	JUMPG	T1,QARND2	;IF ANY LEFT, DON'T CHANGE IT
QARND1:	PUSHJ	P,CLRIPT	;SET BIT FOR NO ICPT
	PUSHJ	P,SETIPT	;RESET ICPT SO JOB WILL CYCLE
IFN FTNSCHED,<			;
	MOVSI	T2,(JS.BBJ)	; BACKGROUND BATCH BIT FOR SWAPPER
	LDB	T1,JBYCLS##	; GET CLASS NUMBER
	SKIPLE	RRFLAG##	; ROUND ROBIN?
	CAME	T1,BBSUBQ##	; OR NOT BACKROUND BATCH CLASS?
	 CAIA			; OK. NOT B.B.
	  IORM	T2,JBTST2##(J)	; MARK FOR SWAPPER
>				;
QARND2:	MOVEI	U,QTIME		;GET TRANSFER TABLE
	PJRST	QXFER		;DO TRANSFER

IFN FTPSCD,<
; ROUTINE TO COUNT NUMBER OF TIMES JOB EXPIRED IN CORE PROTECT BY QUE
CNTICP:	PUSH	P,T1		;SAVE T1
	LDB	T1,PJBST2##	;GET PHYICAL STATE CODE
	CAIN	T1,PQ1		;PQ1?
	AOS	XPICP1		;YES
	CAIN	T1,PQ2		;PQ2?
	AOS	XPICP2		;YES
	CAILE	T1,PQ2		;AN HPQ?
	AOS	XPICHP		;YES
	JRST	TPOPJ##		;RESTORE T1 AND EXIT

; ROUTINE TO COUNT NUMBER OF TIMES JOB EXPIRED IN QUE TIME BY QUE
CNTINQ:	PUSH	P,T1		;SAVE T1
	LDB	T1,PJBST2##	;GET PHYSICAL STATE CODE
	CAIN	T1,PQ1		;PQ1?
	AOS	XPQRP1		;YES
	CAIN	T1,PQ2		;PQ2?
	AOS	XPQRP2		;YES
	CAILE	T1,PQ2		;AN HPQ?
	AOS	XPQRHP		;YES
	JRST	TPOPJ##		;RESTORE T1 AND EXIT
$LOW
SCDPER::		;PERFORMANCE STATS TABLE
%DTASL::BLOCK	1	;DTA GENERATED SLEEPS
%MTASL::BLOCK	1	;DTA GENERATED SLEEPS
%EWCNT::BLOCK	1	;MTA GENERATED SLEEPS
%TISJB::BLOCK	1	;TTY INPUT SATISFIED
%TOSJB::BLOCK	1	;TTY OUTPUT SATISFIED
%PISJB::BLOCK	1	;PTY INPUT SATISFIED
%POSJB::BLOCK	1	;PTY OUTPUT SATISFIED
REQSS::	BLOCK	1	;NUMBER OF REQUEUES FROM SS INTO PQ1
REQWK::	BLOCK	1	;NUMBER OF REQUEUES FROM WAKE INTO PQ1
REQJSD::BLOCK	1	;NUMBER OF REQUEUES FROM DAEMON SATISFIED INTO PQ1
REQPQ1:	BLOCK	1	;NUMBER OF OTHER REQUEUES INTO PQ1
XPQRP1:	BLOCK	1	;NUMBER OF JOBS IN PQ1 WHICH EXPIRED QUANTUM RUN TIME
XPQRP2:	BLOCK	1	;NUMBER OF JOBS IN PQ2 WHICH EXPIRED QUANTUM RUN TIME
XPQRHP:	BLOCK	1	;NUMBER OF JOBS IN HPQ WHICH EXPIRED QUANTUM RUN TIME
XPICP1:	BLOCK	1	;NUMBER OF JOBS IN PQ1 WHICH EXPIRED INCORE PROTECT
XPICP2:	BLOCK	1	;NUMBER OF JOBS IN PQ2 WHICH EXPIRED INCORE PROTECT
XPICHP:	BLOCK	1	;NUMBER OF JOBS IN HPQ WHICH EXPIRED INCORE PROTECT
SWPKP1:	BLOCK	1	;NUMBER OF K SWAPPED IN FOR PQ1 JOBS
SWPKP2:	BLOCK	1	;NUMBER OF K SWAPPED IN FOR PQ2 JOBS
SWPKHP:	BLOCK	1	;NUMBER OF K SWAPPED IN FOR HPQ JOBS
SWPJP1:	BLOCK	1	;NUMBER OF PQ1 JOBS SWAPPED IN
SWPJP2:	BLOCK	1	;NUMBER OF PQ2 JOBS SWAPPED IN
SWPJHP:	BLOCK	1	;NUMBER OF HPQ JOBS SWAPPED IN
RNTPQ1::BLOCK	1	;TICKS CHARGED TO PQ1
RNTPQ2::BLOCK	1	;TICKS CHARGED TO PQ2
RNTHPQ::BLOCK	1	;TICKS CHARGED TO HPQS
%PQ1CM:	BLOCK	1	;NUMBER OF RESPONSES PQ1/CMQ SWAPPED IN
%P1CMT:	BLOCK	1	;TOTAL TICKS OF RESPONSE TIME PQ1/CMQ SWAP IN
%P1CM2:	BLOCK	2	;SUM SQUARES (TWO WORD INTEGER) PQ1/PQ2 SWAPPED IN
%WSTCN:	BLOCK	1	;NUMBER OF MEASUREMENTS OF WASTED CORE
%WSTPS:	BLOCK	1	;TOTAL WASTED CORE SUM (PAGES)
%WSTP2:	BLOCK	2	;SUM OF SQUARES (TWO WORD INTEGER) WASTED CORE
%PERLN==:<.-1-SCDPER>B26
	BLOCK	10

;CONSTANTS TO CONVERT TO TICKS FROM MICROSECONDS
ICPCV1:	EXP	0
ICPCV2:	EXP	0

	$HIGH
CNTSWP:	PUSH	P,T1		;SAVE ACS
	PUSH	P,T2
	PUSH	P,J
	LDB	T1,IMGIN##	;GET INPUT SIZE
	LDB	T2,IMGOUT##	;AND OUTPUT SIZE IN T2
	CAMLE	T1,T2		;GET MINIMUM IN T1
	MOVE	T1,T2		;T2 WAS SMALLER
	LSH	T1,P2KLSH	;IN K
	PUSHJ	P,FITHPQ##	;GET LOW SEG NUMBER
	LDB	T2,PJBST2##	;GET PHYSICAL QUE
	POP	P,J		;RESTORE JOB
	CAIN	T2,PQ1		;PQ1?
	JRST	CNTSP1		;YES
	CAIN	T2,PQ2		;PQ2?
	JRST	CNTSP2		;YES
	CAIG	T2,PQ2		;HPQ?
	JRST	CNTSXT		;NO. EXIT
	ADDM	T1,SWPKHP	;STORE K
	CAIG	J,JOBMAX##	;LOWSEG?
	AOS	SWPJHP		;YES. COUNT A JOB
CNTSXT:	POP	P,T2
	JRST	TPOPJ##		;RESTORE ACS
CNTSP1:	ADDM	T1,SWPKP1	;COUNT K IN PQ1
	CAIG	J,JOBMAX##	;LOWSEG?
	AOS	SWPJP1		;YES. COUNT JOB
	JRST	CNTSXT		;EXIT
CNTSP2:	ADDM	T1,SWPKP2	;COUNT K IN PQ2
	CAIG	J,JOBMAX##	;LOWSEG?
	AOS	SWPJP2		;YES. COUNT JOB
	JRST	CNTSXT		;EXIT


CNTWST:	PUSH	P,T1		;SAVE SOME REGISTERS
	PUSH	P,T2
	MOVE	T1,WASTSZ	;GET AMOUNT OF WASTED CORE
	ADDM	T1,%WSTPS	;ADD TO SUM
	MUL	T1,T1		;SQUARE IT
	TLO	T2,400000	;PREVENT OVERFLOW
	ADD	T2,%WSTP2+1	;ADD IN LOW ORDER WORD OF SUM SQUARE
	TLZN	T2,400000	;OVERFLOW?
	ADDI	T1,1		;YES. INCREMENT HIGH ORDER WORD
	MOVEM	T2,%WSTP2+1	;STORE LOW ORDER WORD
	ADDM	T1,%WSTP2	;ADD HIGH ORDER TO STORE
	AOS	%WSTCN		;INCREMENT COUNT
	POP	P,T2		;RESTORE REGISTERS,
	PJRST	TPOPJ##		;AND RETURN
> ;IFN FTPSCD
SUBTTL	QCSS R. KRASIN

;THIS ROUTINE MUST BE ASSEMBLED WITH THE CONFIGURATION
;TAPE TO DEFINE NUMBER OF JOBS
;THIS SECTION CONTAINS 2 ROUTINES FOR Q MANIPULATION
;AND NECESSARY TABLES FOR SPECIFING OPERATIONS PERFORMED
;BY THEM.


;STORAGE:
;EACH Q IS A RING STRUCTURED, FOWARD AND BACKWARD
;LINKED SRING LIST. THE "FIRST" LINK IN A Q IS
;A Q-HEADER POINTING TO THE FIRST AND LAST MEMBERS OF THE Q.
;A NULL Q HAS ONE LINK--THE Q-HEADER ITSELF.  THE LINKS MAKING
;UP THE QS ARE CONTAINED IN A TABLE WITH NEGATIVE
;INDICIES USED FOR Q-HEADERS AND
;POSITIVE INDICIES USED FOR MEMBERS (JOBS). THUS ONLY ONE WORD
;PER LINK IS NECESSARY--ITS RELATIVE ADDRESS GIVES THE
;JOB NO. (OR Q NO. IF NEGATIVE) WHICH IT REPRESENTS WHILE
;ITS CONTENTS CONTAINS THE LINKING POINTERS. THESE
;POINTERS ARE ALSO RELATIVE INDICIES RATHER THAN
;ABSOLUTE ADDRESSES--RH(LINK)=FORWARD POINTER;
;LH(LINK)=BACKWARD POINTER.
;A JOB IS ASSUMED TO BE IN NO MORE THAN ONE Q AT A TIME, AND
;THE NULL JOB (JOB 0) DOES NOT APPEAR IN THE QS

;ROUTINES:
;BOTH ROUTINES ARE "TABLE DRIVEN" IN THE SENSE THAT THE
;CALLING ROUTINE PROVIDES THE ADDRESS OF A TABLE WHICH
;DEFINES THE SPECIFIC OPERATIONS TO BE PERFORMED.

EQFIX==QFIX+1B0
EQLNKZ==QLNKZ+1B0
QXFER:
	SKIPLE	J		;TRYING TO REQUE JOB 0?
	CAILE	J,JOBMAX##	; OR IS THE JOB NUMBER OUT OF RANGE?
	STOPCD	.,STOP,RJZ,	;++REQUEUE JOB ZERO
				; MESSED UP AND SYSTEM WILL HANG IF ALLOWED
	MOVE	P4,1(U)		;GET TRANSFER TABLE ADDRESS
	JRST	@(U)		;DISPATCH

;DEST-Q AS FUNCTION OF JOB QUE, QUANTUM AS FUNCTION OF JOB SIZE
QLNKZ:	PUSHJ	P,JOBSIZ##	;GET SIZE OF JOB
	SKIPL	JBTST2##(J)	;IS JOB IN A RUN QUEUE?
	STOPCD	.,STOP,NTE,	;NOT PROCESSOR QUE. ERROR.
	LDB	T1,PJBST2##	;GET PHYSICAL QUEUE JOB IS IN NOW
	ADD	T1,1(U)		;ADD TABLE ADDRESS TO QUE NUMBER
	HRRO	P4,0(T1)		;GET QUE HE GOES TO
	HLRZ	T1,0(T1)	;GET PARAMETERS FOR QUE HE IS GOING TO
	SKIPGE	1(U)		;WANT QUANTUM TIME?
	JRST	QFIXED		;NO - ALL FIXED
	PUSHJ	P,CMPQRT	;COMPUTE THE QUANTUM RUN TIME
	MOVEM	T2,QNTRUN	;STORE IT FOR QFIX
	HRLI	P4,QNTRUN	;AND TELL QFIX WHERE WE PUT IT
	JRST	QFIXED		;DO TRANSFER

	$LOW
QNTRUN:	0
	$HIGH

; CALL WITH JOBSIZ IN T2, QUE IN T1, JOB NUMBER IN J
; RETURNS QUANTUM RUN TIME IN T2. USES NO OTHER ACS
CMPQRT:	PUSH	P,T3
	HRRZ	T3,JBTPDB##(J)
	JUMPE	T3,CMPQR1	;IF NO PDB
	SKIPL	.PDIPT##(T3)	;SWAPPABLE?
	SKIPGE	CORSCD		;OR LOTS OF CORE
	JRST	CMPQR1		;USE CONSTANT QUANTA
	IMUL	T2,QMLTBL##(T1)	;SIZE * MULTIPLIER
	IDIV	T2,QRANGE##	;GET IN PROPER UNITS
	ADD	T2,QADTBL##(T1)	;ADD IN BASE AMOUNT FOR QUE
	CAMLE	T2,QMXTBL##(T1)	;LESS THAN MAXIMUM ALLOWED?
	MOVE	T2,QMXTBL##(T1)	;NO. USE MAXIMUM
	JRST	T3POPJ##	;RETURN

CMPQR1:	MOVE	T2,QADTBL##(T1)
	JRST	T3POPJ##	;RETURN BASE QUANTUM

; CALL CMPQSI WHEN SWAP IN JOB IN PROCESSOR QUE TO ASSIGN QUANTUM RUN TIME
CMPQSI:	PUSH	P,T1		;SAVE TWO ACS
	PUSH	P,T2
	PUSHJ	P,JOBSIZ##	;GET SIZE OF JOB
	LDB	T1,PJBST2##	;GET QUE HE IS IN
	PUSHJ	P,CMPQRT	;COMPUTE THE QUANTUM TIME
	DPB	T2,PDYQNT##	;AND STORE IT
	MOVEM	T2,.CPQNT##	;TO MINIMIZE CALLS TO CPUTIM
	JRST	TTPOPJ##	;RESTORE TWO ACS AND RETURN
;FIXED DEST-Q
QFIX:
IFN FTHPQ,<
	HRRZ	T2,P4		;PICK UP QUEUE
	CAILE	T2,-PQ1		;IS IT A RUN QUEUE?
	JRST	QFIXED		;NO.
	LDB	T2,HPQPNT##	;YES. SHOULD IT GO TO A HPQ
	JUMPE	T2,QFIXED	;NO. DON'T DO ANYTHING
	HRR	P4,QTTAB##-1(T2)	;YES. GET HPQ POSITION
	SKIPL	P4		;WAS QUANTUM TIME REQUESTED?
	HRLI	P4,QQSTAB##-1(T2) ;YES. GIVE QUANTUM TIME
>	; END OF CONDITIONAL ASSEMBLY ON FTHPQ
QFIXED:	AOS	RQCNT##		;COUNT A REQUEUE

IFN FTNSCHED,<
	SKIPL	JBTSCD##(J)	;JOB CURRENTLY IN PQ2?
	JRST	QFIXB		;NO
	MOVE	T2,JBTCSQ##(J)	;DELETE FROM CORE/NO-CORE SUBQUEUES
	MOVS	T1,T2
	HRRM	T2,JBTCSQ##(T1)	;NEW FORWARD LINK
	HRLM	T1,JBTCSQ##(T2)	;AND BACK LINK
	MOVSI	T1,(JS.PQ2)	;CLEAR PQ2 BIT
	ANDCAM	T1,JBTSCD##(J)	;KEPT IN SCD DATA TABLE
	PUSHJ	P,DLJILS	;DELETE FROM JBTJIL
>;END IFN FTNSCHED

QFIXB:	HRRE	T1,P4		;PICK UP QUEUE NUMBER
	MOVM	T1,T1		;ABS VALUE
	LDB	T2,PJBST2##	;GET PHY QUE
IFE FTNSCHED,<
	CAIN	T2,PQ2		;IN PQ2?
	PUSHJ	P,[PUSH P,T1
		   PUSHJ P,DLJILS ;YES, DELETE FROM JBTJIL
		   JRST TPOPJ##]
>
	CAIN	T2,PQ2		;IN PQ2?
	CAIE	T1,PQ2		;AND GOING TO PQ2?
	PUSHJ	P,DLOLST	;NO. DELETE FROM JBTOLS (IF IN IT)
	DPB	T1,PJBST2##	;STORE HIS NEW REAL QUEUE
IFN FTPSCD,<
	CAIN	T1,PQ1		;TO PQ1?
	AOSA	REQPQ1		;YES. COUNT IT
	CAIN	T1,CMQ		;OR CMQ?
	PUSHJ	P,[MOVSI T2,SWP		;SWAPPED OUT?
		   HRRZ W,JBTPDB##(J)	;SET PDB ADR
		   TDNE	 T2,JBTSTS##(J)	;...
		   SKIPN W		;YES. GET PDB ADDRESS
		   POPJ P,		;NO OR NO PDB
		   MOVN  T2,SYSUPT##	;STORE -TIME WE STARTED
		   MOVEM T2,.PDPST##(W)	;IN PDB FOR PERFORMANCE MEASURE
		   POPJ  P,]
>
	MOVSI	T2,(JS.IPQ)	;PROCESS QUEUE BIT
	ANDCAM	T2,JBTST2##(J)	;ASSUME NOT GOING INTO ONE
	CAIGE	T1,PQ1		;IS IT GOING INTO PROCESSOR QUEUE?
	JRST	QFIXC		;NO, GO ON
	IORM	T2,JBTST2##(J)	;YES. SET PROCESSOR QUEUE BIT
	CAIE	T1,PQ1		;ARE WE PUTTING HIM INTO PQ1?
	JRST	QFIXC2		;NO, SEE IF GOING INTO PQ2
	HRRZ	W,JBTPDB##(J)	; FIND PDB FOR THE JOB
	JUMPE	W,QFIXC		; IF NONE, DON'T CHANGE ICPT
	SKIPGE	.PDIPT##(W)	;IS THIS JOB ELIGIBLE FOR SWAPPING
	PUSHJ	P,SETIPT	;YES, RESET ICPT SO IT CYCLES CORRECTLY
	JRST	QFIXC		;JOIN PROCESSING

QFIXC2:	CAIE	T1,PQ2		;ARE WE PUTTING HIM IN PQ2?
	JRST	QFIXC		;NO, GO ON
	PUSHJ	P,INOLST	;PUT JOB IN LIST TO SWAP OUT (IF NO ICPT)
IFN FTNSCHED,<
	MOVSI	T1,(JS.PQ2)	;SAY JOB IS NOW IN PQ2
	IORM	T1,JBTSCD##(J)	;FOR SKIPS
;HERE IF WE ARE PUTTING A JOB INTO PQ2. MUST ALSO PUT IT INTO
; A PARALLEL SUBQUEUE.

	LDB	T1,JBYCLS##	;YES, GET HIS CLASS NUMBER
	MOVNI	T1,1(T1)	;GET NEGATIVE INDEX TO JBTSQ
	SKIPN	JBTADR##(J)	;DOES JOB HAVE CORE?
	SUBI	T1,M.CLSN##	;NO. OFFSET POINTER
	HLRZ	T2,JBTCSQ##(T1)	;GET LAST JOB IN SUB QUEUE (CORE/NOCORE)
	HRRM	J,JBTCSQ##(T2)	;MAKE US LAST
	HRLM	J,JBTCSQ##(T1)	;AND MAKE OLD LAST POINT TO US
	HRL	T1,T2		;T1 = OLD LAST MEMBER,,HEADER
	MOVEM	T1,JBTCSQ##(J)	;SAVE AS OUR JBTCSQ ENTRY
>;END IFN FTNSCHED

	SKIPE	JBTJIL##(J)	;ALREADY IN LIST?
	JRST	QFIXC		;YES
	HRRZ	W,JBTPDB##(J)
	SKIPE	JBTADR##(J)	;DOES HE HAVE CORE?
	SKIPN	W		;YES, GET PDB
	JRST	QFIXC		;SWAPPED OR NO PDB
	SKIPGE	.PDIPT##(W)	;ANY ICPT LEFT?
	JRST	QFIXC		;NO, HE STAYS OFF LIST
	HLRZ	T1,JBTJIQ##	;LAST JOB IN QUEUE
	HRLM	J,JBTJIQ##	;MAKE US LAST
	HRRM	J,JBTJIL##(T1)	;MAKE PREVIOUS LAST POINT TO US
	HRLOM	T1,JBTJIL##(J)	;OLD LAST,,HEADER
QFIXC:	MOVE	T1,JBTCQ##(J)	;DELETE JOB FROM CORE/NO-CORE QUE
	MOVS	T2,T1
	HRLM	T2,JBTCQ##(T1)	;BACK. LINK SUCCESSOR
	HRRM	T1,JBTCQ##(T2)	;FOR. LINK PREDECESSOR
	SKIPL	(U)		;TRYING TO REQUEUE TO BEGINNING OF QUEUE?
	STOPCD	.,STOP,RBQ	;++REQUEUEING TO BEGINNING OF QUEUE
	HRRE	T2,P4		;END. INSERT IN CORE/NO-CORE QUE
	SKIPN	JBTADR##(J)	;ANY CORE ASSIGNED?
	SUBI	T2,MXQUE##	;NO. NO-CORE QUEUE
	HLRE	T1,JBTCQ##(T2)	;GET LAST JOB IN QUEUE
	HRLM	J,JBTCQ##(T2)	;NOW WE ARE LAST
	HRRM	J,JBTCQ##(T1)	;AND OLD LAST POINTS FORWARD TO US
	HRL	T2,T1		;OLD LAST,,HEADER
	MOVEM	T2,JBTCQ##(J)	;IS OUR POINTER
	JUMPL	P4,QX3
	HLRZ	U,P4		;GET QUANTUM TIME ADDRESS FOR DPB
	MOVE	U,(U)		;GET QUANTUM TIME
	PUSHJ	P,FNDPDS##	;GET PDB ADR
	DPB	U,PDYQNT##	;STORE QUANTUM RUN TIME
	MOVEM	U,.CPQNT##	;TO MINIMIZE CALLS TO CPUTIM
QX3:	POPJ	P,		;RETURN
;ROUTINE TO MOVE JOB FROM "JOB HAS CORE" QUE TO "JOB DOES NOT" QUE
; IF JOB ALREADY HAS NO CORE, ROUTINE DOES NOTHING
; ALL ACS PRESERVED

DICLNK::CAIG	J,JOBMAX##	;LOW SEGMENT?
	SKIPN	JBTADR##(J)	;YES. HAVE CORE?
	POPJ	P,		;NO
DICLNC:	PUSHJ	P,DCCLNK	;YES. DELETE FROM CORE QUE (AND SUB-QUE)
	LDB	T1,PJBST2##	;GET CURRENT PHYSICAL QUE NUMBER
	MOVNI	T1,MXQUE##(T1)	;NEG OF (QUE NUM + OFFSET)
	PUSHJ	P,ICCLNK	;PUT IN NO-CORE QUE
IFN FTNSCHED,<
	SKIPL	JBTSCD##(J)	;IN PQ2?
	POPJ	P,		;NO. DONE
	LDB	T1,JBYCLS##	;YES. GET CLASS NUMBER
	MOVNI	T1,M.CLSN##+1(T1) ;NEG OF (CLASS NUMBER + OFFSET)
	PUSHJ	P,ICSLNK	;PUT IN NO-CORE SUB QUEUE
>
	POPJ	P,		;DONE. RETURN

;SUBROUTINE TO MOVE JOB FROM "NO CORE" QUE TO "JOB HAS CORE" QUE
; IF JOB ALREADY HAS CORE, ROUTINE DOES NOTHING
; ALL ACS PRESERVED

IICLNK::CAIG	J,JOBMAX##	;LOW SEGMENT?
	SKIPE	JBTADR##(J)	;YES. NO CORE?
	POPJ	P,		;NO. RETURN
	PUSHJ	P,DCCLNK	;DELETE FROM NO-CORE QUE (AND SUB-QUE)
	LDB	T1,PJBST2##	;GET PHYSICAL QUEUE NUMBER
	MOVNI	T1,(T1)		;NEGATE
	PUSHJ	P,ICCLNK	;INSERT IN CORE QUE
IFN FTNSCHED,<
	SKIPL	JBTSCD##(J)	;IN PQ2?
	POPJ	P,		;NO. DONE
	LDB	T1,JBYCLS##	;GET CLASS NUMBER
	MOVNI	T1,1(T1)	;NEGATE AND OFFSET
	PUSHJ	P,ICSLNK	;PUT IN CORE SUB QUE
>
	POPJ	P,		;RETURN
DCCLNK:	CPLOCK	(SCD)		;LOCK THE SCHEDULER
	EXCH	T1,(P)		;SAVE T1 ON LIST
	PUSH	P,T2		;AND T2
	MOVEM	T1,1(P)		;AND PUT CALLER BACK ON LIST
	MOVE	T1,JBTCQ##(J)	;GET JOBS POINTERS
	MOVS	T2,T1		;SWAP HALVES
	HRRM	T1,JBTCQ##(T2)	;MAKE LAST POINT TO NEXT
	HRLM	T2,JBTCQ##(T1)	;AND NEXT POINT TO LAST
IFN FTNSCHED,<
	SKIPL	JBTSCD##(J)	; IN PQ2?
	JRST	DCCLN1		;NO
	MOVE	T1,JBTCSQ##(J)	;LINK AROUND JOB
	MOVS	T2,T1
	HRRM	T1,JBTCSQ##(T2)	;MAKE LAST POINT TO NEXT
	HRLM	T2,JBTCSQ##(T1)	;AND NEXT POINT TO LAST
DCCLN1:>
	PUSHJ	P,@1(P)		;GO BACK TO CALLER WITH T1,T2 SAVED,
				;AND SCHED LOCKED
	CAIA			;NON-SKIP RETURN
	AOS	-2(P)		;SKIP RETURN
	CPUNLK	(SCD)		;UNLOCK SCHEDULER
	POP	P,T2		;RESTORE T2
	PJRST	TPOPJ##		;AND T1 AND RETURN

ICCLNK:	HLRZ	T2,JBTCQ##(T1)	;GET LAST JOB IN QUEUE
	HRLM	J,JBTCQ##(T1)	;MAKE SELF LAST
	HRRM	J,JBTCQ##(T2)	;MAKE OLD LAST POINT TO US
	HRL	T1,T2		;MAKE US POINT TO OLD LAST,,END
	MOVEM	T1,JBTCQ##(J)	;AND STORE IT
	POPJ	P,

IFN FTNSCHED,<
ICSLNK:	HLRZ	T2,JBTCSQ##(T1)	;GET LAST IN SUB QUE
	HRLM	J,JBTCSQ##(T1)	;MAKE US LAST
	HRRM	J,JBTCSQ##(T2)	;MAKE OLD LAST POINT TO US
	HRL	T1,T2		;MAKE US POINT TO OLD LAST,,END
	MOVEM	T1,JBTCSQ##(J)	;AND STORE IT
	POPJ	P,
>
; SUBROUTINE TO INSERT A JOB IN OUTPUT SCAN LIST, IF NOT THERE AND SHOULD BE

INOLST:	CAIG	J,JOBMAX##	;HIGHSEG?
	SKIPE	JBTOLS##(J)	;OR ALREADY IN LIST?
	POPJ	P,		;YES. RETURN
	PUSH	P,T1		;SAVE T1
	HRRZ	W,JBTPDB##(J)
	SKIPE	JBTADR##(J)	;DOES HE HAVE CORE?
	SKIPN	W		;YES. GET PDB
	PJRST	TPOPJ##		;NO OR NO PDB
	SKIPL	.PDIPT##(W)	;ELIGIBLE TO SWAP OUT?
	PJRST	TPOPJ##		;NO. DOESN'T GO ON LIST
	MOVSI	T1,(JS.BBJ)	;BACKGROUND BATCH BIT
	TDNE	T1,JBTST2##(J)	;IS JOB IN BACKGROUND BATCH?
	SKIPA	T1,[EXP MOBQ##]	;YES, PUT HIM IN BB OUTPUT LIST
	MOVNI	T1,OLQ##	;NO, PUT HIM IN REGULAR OUTPUT LIST
	HLL	T1,JBTOLS##(T1)	;GET LAST JOB IN QUEUE
	HRLM	J,JBTOLS##(T1)	;MAKE US LAST
	MOVEM	T1,JBTOLS##(J)	;POINT TO OLD LAST,,HEADER
	MOVS	T1,T1		;GET POINTER TO OLD LAST
	HRRM	J,JBTOLS##(T1)	;MAKE US SUCCESSOR TO PREVIOUS LAST
	PJRST	TPOPJ##		;AND RETURN

; SUBROUTINE TO DELETE JOB FROM OUTPUT SCAN LIST

DLOLST:	PUSH	P,T1		;SAVE T1
	CAIG	J,JOBMAX##	;HIGH SEG?
	SKIPN	T1,JBTOLS##(J)	;YES. IN LIST?
	PJRST	TPOPJ##		;HIGH SEG OR NOT IN LIST. RETURN
	SETZM	JBTOLS##(J)	;NOT IN LIST ANY MORE
	HLLM	T1,JBTOLS##(T1)	;LINK AROUND
	MOVS	T1,T1
	HLRM	T1,JBTOLS##(T1)
	PJRST	TPOPJ##

; SUBROUTINE TO DELETE JOB FROM JUST INPUT LIST

DLJILS:	SKIPN	T1,JBTJIL##(J)	;IN LIST?
	POPJ	P,		;NO, RETURN
	SETZM	JBTJIL##(J)	;NOW HE'S NOT
	HLLM	T1,JBTJIL##(T1)	;LINK AROUND HIM
	MOVS	T1,T1
	HLRM	T1,JBTJIL##(T1)
	POPJ	P,
;SCANS THE QS RETURNING THE NUMBERS OF THE JOBS IN THE QS.
;THE ORDER AND MANNER IN WHICH THE QS ARE SEARCHED IS
;DETERMINED BY A "SCAN TABLE" ADDRESSED IN THE CALLING SEQ.
;THE SCAN TABLE HAS THE FORM:
;
;SCANTAB:	XWD <Q1>,<CODE1>	;SCN Q1 ACCRDING TO CODE1
;		...
;		XWD <QN>,<CODEN>	;QN ACCORDING TO CODEN
;		Z			;ZERO TERMINATES TABLE
;
;EACH Q MAY BE SCANNED IN ONE OF SEVERAL WAYS SPECIFIED BY <CODE>
;THE CODES ARE:
;
;?QFOR	SCAN Q FORWARD
;?QFOR1	SCAN FOR ONLY THE 1ST MEMBER (IF ANY)
;?QBAK	SCAN Q BACKWARD
;?QBAK1	SCAN BACKWARD FOR ALL MEMBERS EXCEPT THE 1ST
;?RRFOR	SCAN THE JUST SWAPPED IN QUEUE
;	THEN SCAN THE ROUND ROBIN QUEUE
;?SSFOR	SCAN SUBQUEUES FORWARD ACCORDING TO SSSCAN TABLE IF RRFLAG .NE. 0,
;	ELSE SCAN PQ2 VIA ?QFOR ROUTINE
;?BBFOR	SCAN THE BACKGROUND BATCH JUST SWAPPED IN QUEUE
;	THEN SCAN THE BACKGROUND BATCH QUEUE
;SQFOR	SCAN SUBQUEUES FORWARD ACCORDING TO SQSCAN TABLE IF RRFLAG .NE. 0,
;	ELSE SCAN PQ2 VIA OQFOR ROUTINE
;BQFOR	SCAN THE BACKGROUND BATCH QUEUE
;
; WHERE ? MAY BE "O" FOR JOBS WITH NO CORE, "I" FOR JOBS WITH CORE,
; OR NULL FOR ALL JOBS(IN WHICH CASE "HAS CORE" IS CONSIDERED
;    TO BE AHEAD OF "NO CORE").
;
;CALLING SEQ.
;
;	MOVEI U,SCAN TABLE ADDRESS
;	JSP T1,QSCAN	;SET UP PC FOR REPEATED RETURNS
;	...		;RETURN HERE WHEN NO MORE JOBS
;	...		;RETURN HERE WITH NEXT JOB IN AC J
;
;	PERFORM ANY NECESSARY TESTING OF THIS JOB
;	J,U,T1,T2 MUST BE PRESERVED
;
;	JRST (T2)	;RETURN TO QSCAN TO GET NEXT JOB
;			; IF THIS ONE NOT ACCEPTABLE
;
;MAJOR QUEUE SCAN ROUTINE

QSCAN::	SKIPN	T2,(U)		;END OF SCAN TABLE?
	JRST	(T1)		;YES--RETURN TO CALL+1
	HLRE	J,T2		;NO--GET NO. OF Q
	JRST	(T2)		;DISPATCH

;ROUTINES TO SCAN BOTH INCORE AND OUTCORE CHAINS

QFOR::	HRRE	J,JBTCQ##(J)	;SCAN FORWARD ALL JOBS
	JUMPG	J,1(T1)		;RETURN THIS JOB NUMBER UNLESS END OF LIST
	HLRE	J,(U)		;GET IN-CORE HEADER
	SUBI	J,MXQUE##	;CHANGE TO NO-CORE HEADER
	MOVEI	T2,QFOR2
QFOR2:	HRRE	J,JBTCQ##(J)	;SCAN FORWARD ALL JOBS
	JUMPG	J,1(T1)		;JUMP IF GOOD JOB #
	AOJA	U,QSCAN		;END OF THIS Q--GET NEXT Q

QBAK::	SUBI	J,MXQUE##	;ADJUST TO NO-CORE HEADER
	MOVEI	T2,QBAK2	;RETURN ADDRESS
QBAK2:	HLRE	J,JBTCQ##(J)	;SCAN BACKWARD ALL JOBS
	JUMPG	J,1(T1)		;RETURN CALL+2 WITH JOB NO.
	HLRE	J,(U)		;GET IN-CORE HEADER
	MOVEI	T2,QBAK3	;RETURN ADDRESS
QBAK3:	HLRE	J,JBTCQ##(J)	;GET NEXT JOB NO.
	JUMPG	J,1(T1)		;RETURN IF GOOD JOB
QSCANX:	AOJA	U,QSCAN		;BEG OF THIS Q--GET NEXT Q
;ROUTINES TO SCAN ONLY INCORE OR OUTCORE CHAIN

OQFOR1::SUBI	J,MXQUE##	;TAMPER WITH INDEX SO USES NO-CORE HEADERS
				;FIRST OF NO-CORE QUEUE
IQFOR1::MOVEI	T2,IQFOR2	;ONLY THE FIRST JOB

IQFOR::	HRRE	J,JBTCQ##(J)	;SCAN FORWARD ALL JOBS
	JUMPG	J,1(T1)		;RETURN THIS JOB NUMBER CALL+2 UNLESS--
IQFOR2:	AOJA	U,QSCAN		;END OF QUEUE--GET NEXT QUEUE

FOQFOR::SETOM	SWPFAR		;SWAPPER REACHED FAIR TERRITORY
OQFOR::	MOVEI	T2,IQFOR	;ALL OF NO-CORE QUE FORWARD
	SUBI	J,MXQUE##	;TAMPER WITH INDEX SO USES NO-CORE HEADERS
	JRST	IQFOR		;AND USE OTHER CODE

OQBAK1::MOVEI	T2,IQBAK1	;ALL BUT FIRST OF NO-CORE
	SUBI	J,MXQUE##	;TAMPER WITH INDEX TO GET NO-CORE HEADERS
IQBAK1::HLRE	J,JBTCQ##(J)	;ALL BUT FIRST OF HAS-CORE
	SKIPLE	JBTCQ##(J)	;FIRST JOB IN QUEUE?
	JRST	1(T1)		;NO. RETURN THIS JOB
	AOJA	U,QSCAN		;YES. GET NEXT QUEUE

OQBAK::	MOVEI	T2,IQBAK	;ALL JOBS BACKWARDS
	SUBI	J,MXQUE##	;FORM NO-CORE QUEUE HEADERS
IQBAK::	HLRE	J,JBTCQ##(J)	;GET JOB
	JUMPG	J,1(T1)		;RETURN IT +2
	AOJA	U,QSCAN		;GET NEXT QUEUE. NO JOB
IFN FTNSCHED,<
;PQ2 CLASS SWAPIN SCAN

FSQFOR::SETOM	SWPFAR		;SWAPPER REACHED FAIR TERRITORY
SQFOR::	SKIPG	RRFLAG##	;ANY NON-ZERO CLASSES?
	JRST	OQFOR		;NO CLASSES DEFINED (OQFOR SETS UP T2)
	MOVEI	T2,SQFORA	;RETURN ADDRESS FOR MORE JOBS, IF ANY
	SOSG	SQCNT##		;ANY ENTRIES LEFT IN PRIMARY SCAN TABLE?
	PUSHJ	P,SQINI		;NO, RECYCLE TO FRONT OF PRIMARY TABLE
	ILDB	J,SQPNT##	;GET NEXT PRIMARY SUBQUEUE
	SETCAM	J,SQSAVJ##	;SAVE THE QUEUE WE ALREADY CHECKED
	MOVNI	J,M.CLSN##+1(J)	;NO-CORE HEADER FOR THIS SUB-QUEUE

SQFORA:	HRRE	J,JBTCSQ##(J)	;GET NEXT JOB IN QUEUE
	JUMPG	J,1(T1)		;RETURN TO CALL+2 IF HAVE A JOB

	SETZB	M,SQSUM##	;ZERO COUNT AND SUM
	SETCM	T2,MAXQTA##	;HEADER OFFSET FOR HIGHEST CLASS WITH QTA
SQFOR1:	SKIPLE	JBCSOH##(T2)	;ANYONE IN THIS CLASS WITHOUT CORE?
	CAMN	T2,SQSAVJ##	;YES, CHECKED THIS CLASS ALREADY?
	JRST	SQFOR2		;NO ONE IN CLASS OR THIS IS PRIMARY CLASS
	SETCM	J,T2		;POSITIVE CLASS NUMBER
	SKIPL	CLSSTS##(J)	;FIXED CLASS?
	SKIPG	T3,CLSQTA##(J)	;ANY SECONDARY QUOTA?
	JRST	SQFOR2		;EITHER FIXED OR NO SECONDARY
	ADDM	T3,SQSUM##	;SUM OF ALL PERCENTS
	HRL	T3,T2		;-CLASS,,QUOTA
	MOVEM	T3,SQSCAN##(M)	;STORE IN TABLE
	AOJ	M,		;BUMP COUNT OF SUBCLASSES
SQFOR2:	AOJL	T2,SQFOR1	;REPEAT FOR ALL SUBCLASSES
	SOJLE	M,SQFOR6	;JUMP IF ZERO OR ONE CLASSES
SQFOR3:	PUSHJ	P,RAND		;GET A RANDOM NUMBER IN T2
	IDIV	T2,SQSUM##	;MODULO SQSUM
	MOVE	J,M		;INITIALIZE LOOP COUNTER
SQFOR4:	HRRZ	T2,SQSCAN##(J)	;GET THIS CLASSES QUOTA
	SUB	T3,T2		;SUBTRACT FROM RANDOM NUMBER
	JUMPL	T3,.+2		;IF NEGATIVE, THIS IS THE ONE WE WANT
	SOJG	J,SQFOR4	;TRY NEXT CLASS
	MOVE	T2,SQSCAN##(M)	;MOVE THE TOP ENTRY
	EXCH	T2,SQSCAN##(J)	;DOWN ONTO THE ONE WE SELECTED
	HLRE	J,T2		;GET HEADER OFFSET FOR THIS CLASS
	MOVNI	T2,(T2)		;SUBTRACT THIS CLASS'S QUOTA...
	ADDM	T2,SQSUM##	;... FROM TOTAL
SQFOR5:	SUBI	J,M.CLSN##	;ADJUST TO NO-CORE HEADER
	MOVEI	T2,SQFORB	;ADDRESS OF SCAN ROUTINE

SQFORB:	HRRE	J,JBTCSQ##(J)	;GET NEXT JOB IN SUB-Q
	JUMPG	J,1(T1)		;SKIP RETURN IF GOOD JOB NUMBER
	SOJG	M,SQFOR3	;ELSE SELECT NEXT SUB-Q

SQFOR6:	JUMPL	M,QSCANX	;IF ALL CLASSES WERE TRIED, TRY BACKGROUND BATCH
	HLRE	J,SQSCAN##	;SETUP FOR THE LAST CLASS
	JRST	SQFOR5		;GO TRY IT
;BACKGROUND BATCH SWAPIN SCAN

BQFOR::	SKIPN	BBFIT##		;ALREADY FITTING IN A BB JOB?
	SKIPG	RRFLAG##	;CLASS SCHEDULING?
	AOJA	U,QSCAN		;NO
	MOVE	T2,SYSUPT##	;CURRENT TIME IN TICKS
	SKIPL	J,BBSUBQ##	;IS THERE A BB CLASS DEFINED?
	CAMGE	T2,SCNBBS##	;IS IT TIME TO SWAP A BB JOB YET?
	AOJA	U,QSCAN		;NOT YET
	MOVNI	J,M.CLSN##+1(J)	;HEADER FOR B B QUEUE
	JRST	BBFOR2		;SCAN B B QUEUE

;ROUTINES USED BY PQ2 CLASS SWAPIN SCAN

SQINI:	MOVEI	T3,^D100	;100 ENTRIES
	MOVEM	T3,SQCNT##	;REINITIALIZE COUNT
	MOVE	T3,[POINT 5,PSQTAB##]
	MOVEM	T3,SQPNT##	;RESET BYTE POINTER
	POPJ	P,

SQTEST:	SKIPG	RRFLAG##	;ACTUALLY CLASS SCHEDULING?
	POPJ	P,		;NO
	PUSH	P,T1		;SAVE T1
	AOS	T1,SCNSWP##	;INCREMENT # TIMES THIS PRIMARY SUBCLASS SCANNED
	CAMGE	T1,SCDSWP##	;SCANNED IT OFTEN ENOUGH?
	JRST	SQTES1		;NO, RESET PRIMARY SCAN POINTERS
	SETZM	SCNSWP##	;YES, ALLOW SQFOR TO GO ON TO THE NEXT CLASS
	JRST	TPOPJ##		;AND RETURN
SQTES1:	AOS	T1,SQCNT##	;MOVE PRIMARY TABLE POINTER BACK ONE
	CAIG	T1,^D100	;UNLESS ALREADY AT TOP
	SETO	T1,
	JUMPL	T1,SQTES2
	MOVEI	T1,^D100	;RESET COUNT TO KNOWN VALUE
	MOVEM	T1,SQCNT##
	SKIPA	T1,[POINT 5,PSQTAB##]
SQTES2:	ADJBP	T1,SQPNT##
	MOVEM	T1,SQPNT##
	JRST	TPOPJ##

>;END IFN FTNSCHED

;RANDOM NUMBER GENERATOR

RAND::	MOVE	T2,SEED##	;GET THE LAST PSEUDO-RANDOM NUMBER
	MULI	T2,377775	;MULTIPLICATIVE MOD 2**35
	MOVEM	T3,SEED##	;SAVE THE CURRENT NUMBER FOR NEXT TIME
	HLRZ	T2,T3		;THROW AWAY RIGHT 18 BITS
	POPJ	P,		;BACK TO CALLER
IFN FTNSCHED,<
;PQ2 CLASS SCHEDULING SCAN

ISSFOR::SKIPG	RRFLAG##	;ARE THERE ANY CLASSES?
	JRST	IRRFOR		;NO
	MOVE	T2,SYSUPT##	;CURRENT TIME
	CAML	T2,SCNJIL##	;STILL SCANNING JBTJIL?
	JRST	SJFORX		;NOT ANY MORE
	MOVEI	T2,SJFORA	;ADDRESS OF SCAN ROUTINE
	MOVNI	J,JIQ##		;OFFSET OF HEADER
SJFORA:	HRRE	J,JBTJIL##(J)	;GET NEXT JOB IN LIST
	JUMPG	J,1(T1)		;SKIP RETURN IF GOOD JOB NUMBER
SJFORX:	MOVEI	T2,SSFORA	;RETURN ADDRESS FOR MORE JOBS
	MOVE	M,.CPSST##	;ADDRESS OF SUB-Q SCHEDULING SCAN TABLE
SSFOR1:	SKIPN	J,(M)		;ANY ENTRIES LEFT IN SUBQUEUE LIST?
	JRST	SSFOR2		;NO

SSFORA:	HRRE	J,JBTCSQ##(J)	;GET NEXT JOB IN IN-CORE SUBQUEUE
	JUMPG	J,1(T1)		;RETURN JOB NUMBER TO CALL+2
	AOJA	M,SSFOR1	;ELSE TRY NEXT SUBQUEUE

SSFOR2:	MOVE	T2,SYSUPT##	;GET UPTIME AGAIN
	CAMGE	T2,SCNJIL##	;HAVE WE SCANNED JBTJIL ALREADY?
	AOJA	U,QSCAN		;YES, GO TRY BACKGROUND BATCH
	MOVNI	J,JIQ##		;OFFSET TO JUST INPUT HEADER
	MOVEI	T2,SSFORJ	;RETURN ADDRESS
SSFORJ:	HRRE	J,JBTJIL##(J)	;NEXT JOB IN LIST
	JUMPLE	J,QSCANX	;GET NEXT QUEUE
	JRST	1(T1)		;RETURN THE JOB

;BACKGROUND BATCH SCHEDULING SCAN

IBBFOR::SKIPG	RRFLAG##	;IS CLASS SCHEDULER IN EFFECT?
	AOJA	U,QSCAN		;NO
	MOVNI	J,BBQ##		;HEADER OFFSET FOR B B QUEUE
	MOVEI	T2,BBFORA	;WHERE TO RETURN TO
	SETOM	BBFLAG##	;INDICATE WE ARE SCANNING B B QUEUE
BBFORA:	HRRE	J,JBTJIL##(J)	;GET NEXT JOB
	JUMPG	J,1(T1)		;RETURN WITH GOOD JOB NUMBER
BBFOR1:	SETCM	J,BBSUBQ##	;HEADER FOR BACKGROUND BATCH SUBQUEUE
	JUMPGE	J,BBFORX	;EXIT IF NO BACKGROUND BATCH QUEUE
BBFOR2:	MOVEI	T2,BBFORB
	SETOM	BBFLAG##	;SCANNING BACKGROUND BATCH
BBFORB:	HRRE	J,JBTCSQ##(J)	;NEXT JOB ON LIST
	JUMPG	J,1(T1)		;JUMP IF GOOD JOB NUMBER
BBFORX:	SETZM	BBFLAG##	;CLEAR SCANNING B B QUEUE FLAG
	AOJA	U,QSCAN		;SCAN THE NEXT MAJOR QUEUE
;PQ2 CLASS LOST TIME SCAN

OSSFOR::SKIPG	RRFLAG##	;ANY CLASSES?
	JRST	OQFOR		;NO, SCAN NO-CORE PQ2 (OQFOR SETS UP T2)
	MOVEI	T2,SSFORB	;RETURN ADDRESS FOR NEXT JOB
	MOVE	M,.CPSST##	;ADDRESS OF SCAN TABLE
SSFOR3:	SKIPN	J,(M)		;ANY ENTRIES LEFT?
	JRST	OBBFOR		;NO, SCAN BACKGROUND BATCH NO-CORE QUE
	SUBI	J,M.CLSN##	;ADJUST TO NO-CORE HEADER
SSFORB:	HRRE	J,JBTCSQ##(J)	;NEXT JOB IN LIST
	JUMPG	J,1(T1)		;JUMP IF REAL JOB NUMBER
	AOJA	M,SSFOR3	;GO TRY NEXT SUB-CLASS

;BACKGROUND BATCH LOST TIME SCAN

OBBFOR:	SKIPGE	J,BBSUBQ##	;IS ANY B B QUE DEFINED?
	AOJA	U,QSCAN		;NO
	MOVNI	J,M.CLSN##+1(J)	;ADJUST TO NO-CORE HEADER
	JRST	BBFOR2		;SCAN THE SUB-QUEUE

>;END IFN FTNSCHED


;PQ2 ROUND ROBIN SCHEDULING SCAN

IRRFOR::MOVEI	T2,RJFORA	;ADDRESS OF SCAN ROUTINE
	MOVNI	J,JIQ##		;OFFSET OF JBTJIQ HEADER
RJFORA:	HRRE	J,JBTJIL##(J)	;NEXT JOB IS JUST SWAPPED IN LIST
	JUMPG	J,1(T1)		;IF GOOD JOB, RETURN TO CALLER
	MOVEI	T2,IQFOR	;ELSE GET READY TO CALL IQFOR
	MOVNI	J,PQ2		;SEARCH PQ2 IN-CORE ONLY
	JRST	IQFOR
;PQ2 JUST INPUT SCAN FOR SWAPPING GETSEGS

IGFOR::	PUSHJ	P,RAND		;GET A RANDOM NUMBER
	IDIVI	T2,^D100	;IN THE RANGE 0-99
	CAML	T3,SCDIOF##	;IS IT TIME FOR A SCAN OF GETSEGGED JOBS?
	AOJA	U,QSCAN		;NOT YET
IGFOR1:	MOVNI	J,JIQ##		;OFFSET TO JUST INPUT HEADER
	MOVEI	T2,IGFORA	;RETURN ADDRESS
IGFORA:	HRRE	J,JBTJIL##(J)	;NEXT JOB IN LIST
	JUMPLE	J,IGFOR2	;GET NEXT QUEUE IF NOT A JOB
	MOVSI	T3,(JS.HNG)	;DID THIS JOB CLEAR OUT OF FORCE?
	TDNN	T3,JBTST2##(J)	;IF SO, DON'T WANT IT COMING IN
	JRST	1(T1)		;OK. RETURN THE JOB
	JRST	IGFORA		;NOT THIS JOB. FIND ANOTHER
IGFOR2:	MOVNI	J,PQ2		;NOW SCAN PQ2
	MOVEI	T2,IGFORB	;WHERE TO COME BACK TO
IGFORB:	HRRE	J,JBTCQ##(J)	;GET NEXT JOB
	JUMPLE	J,QSCANX	;GET NEXT QUEUE IF NOT A JOB
	MOVSI	T3,SWP		;MARKED SWP BUT IN CORE?
	TDNN	T3,JBTSTS##(J)	;...
	JRST	IGFORB		;NO, IGNORE
IFN FTNSCHED,<
	MOVSI	T3,(JS.BBJ)	;BACKGROUND BATCH?
	TDNE	T3,JBTST2##(J)	;YES, SKIP HIM
	JRST	IGFORB		;
>
	JRST	1(T1)		;YES, BROKEN, NOT IN TRANSIT

;PQ2 OUTPUT SCAN
; SCAN OUTPUT LISTS FORWARD, THEN PQ2 BACKWARD, SAVING SUMCOR AROUND
; FIRST SO THAT IF DON'T FIND ROOM WE WILL COUNT EVERYBODY EXACTLY ONCE.

OLFOR::
IFN FTNSCHED,<
	MOVNI	J,OBQ##		;SEARCH BACKGROUND BATCH OUTPUT LIST
	MOVEI	T2,OLFORA	;SET T2
OLFORA:	HRRE	J,JBTOLS##(J)	;GET JOB
	JUMPG	J,1(T1)		;GIVE IT TO USER
	MOVNI	J,BBQ##		;SEARCH BACKGROUND BATCH JUST INPUT LIST
	MOVEI	T2,OLFORB	;SET T2
OLFORB:	HRRE	J,JBTJIL##(J)	;GET NEXT ENTRY
	JUMPG	J,1(T1)		;RETURN IF LEGAL JOB NUMBER
>;END IFN FTNSCHED
	MOVNI	J,OLQ##		;SEARCH PQ2 OUTPUT LIST
	MOVEI	T2,OLFORC	;SETUP T2
OLFORC:	HRRE	J,JBTOLS##(J)	;NEXT ENTRY
	JUMPG	J,1(T1)		;JUMP IF GOOD JOB
	MOVNI	J,PQ2		; NOW PQ2
	JUMPN	T4,OLFORE	; FITTING HPQ JOB?
	SKIPGE	CORSCD		; OR OTHERWISE IGNORE PDMSWP?
	 JRST	OLFORE		; YES. EVERYONE
	MOVEI	T2,OLFORD	; NO. JUST STRANGE JOBS NOT ALREADY RETURNED
OLFORD:	HLRE	J,JBTCQ##(J)	; GET NEXT JOB
	JUMPLE	J,QSCANX	; END OF QUEUE. GO TO NEXT
	SKIPE	JBTOLS##(J)	; IN ONE OF OUTPUT LISTS?
	JRST	OLFORD		; YES. SKIP THIS ONE
IFN FTNSCHED,<			;
	MOVSI	T3,(JS.BBJ)	; IN BACKGROUND BATCH?
	TDNE	T3,JBTST2##(J)	; ...
	 JRST	OLFORD		; YES. SKIP THIS ONE
>				;
	MOVSI	T3,SWP		; SWP SET?
	TDNE	T3,JBTSTS##(J)	; FOR THIS JOB?
	JRST	1(T1)		; YES. RETURN THIS JOB TO SCAN
	HRRZ	T3,JBTPDB##(J)	; ANY PDB?
	JUMPE	T3,1(T1)	; NO. RETURN THIS JOB TO SCAN
	JRST	OLFORD		; NOT SWP AND HAS PDB. SKIP JOB

OLFORE:	MOVEI	T2,OLFORF	; RETURN ALL JOBS NOT ALREADY RETURNED
OLFORF:	HLRE	J,JBTCQ##(J)	; GET NEXT JOB
	JUMPLE	J,QSCANX	; END OF QUEUE. GO TO NEXT
	SKIPE	JBTOLS##(J)	; IN ONE OF OUTPUT LISTS?
	 JRST	OLFORF		; YES. SKIP THIS ONE
IFN FTNSCHED,<			;
	MOVSI	T3,(JS.BBJ)	;  BACKGROUND BATCH JOB?
	TDNE	T3,JBTST2##(J)	; ...
	 JRST	OLFORF		; YES. SKIP THIS ONE
>				;
	JRST	1(T1)		; NO. RETURN JOB TO SCAN
DEFINE X(A,B,C)
<
	A'Q==:ZZ
	ZZ==ZZ+1>

	ZZ==0
	QUEUES
	XP	MINQ,ZZ
DEFINE X(A,B,C)
<	A'Q==:ZZ
	EXTERNAL	A'AVAL
	ZZ==ZZ+1>
	RWAITS

	NQUEUE==ZZ
	XP	MAXQ,NQUEUE-1
	XP	AVLNUM,MAXQ-MINQ


DEFINE X(A,B,C)
<	A'Q==:ZZ
	ZZ==ZZ+1>

	CODES

	XP	MXCODE,ZZ-1


	CMQ==:ZZ
	ZZ==ZZ+1
	PQ1==:ZZ
	ZZ==ZZ+1
	PQ2==:ZZ
;CORRESPONDENCE TABLE BETWEEN JOB STATUS CODES AND QUEUE TRANSFER TABLES
;USED BY SCHEDULER
;RUNCSS SETS JOB STATUS WORD TO NEW STATE CODE.
;SCHEDULER SETS UP QUEUE TRANSFER TABLE ADDRESS FROM
;FOLLOWING TABLE USING NEW STATE CODE AS INDEX

DEFINE X(A,B,C)
<	XWD Q'A'T, Q'A'W
>
QWSW==-1
QIOWW=-1
QDIOWW==-1
QDSW==-1
QPIOWW==-1
QPSW==-1
QNAPW==-1


QBITS::	QUEUES
	RWAITS
	CODES
;SHARABLE DEVICE REQUEST TABLE(GENERALIZED FOR OTHER QUEUES TOO)
;CONTAINS THE NUMBER OF JOB WAITING TO USE SHARBLE DEVICE
;WSREQ AND RNREQ ARE UNUSED

	$LOW
DEFINE X(A,B,C)
<A'REQ::	0
>


REQTAB::RWAITS	;GENERATE REQ TABLE
XP RQTBMQ,REQTAB-MINQ
	$HIGH




	$LOW
QJOB::	0	;NUMBER OF JOBS NEEDING QUEUE TRANSFERS AT
		;OTHER THAN CLOCK LEVEL
XJOB:	0	;NUMBER OF JOBS NEEDING EXPANSION BY SWAPOUT-IN
UNWIND::0	;FLAG THAT SAYS WE'VE UNWOUND ONCE THIS SCHEDULER CYCLE/TICK
	$HIGH

;UNWIND/SCHEDULAR RESOURCE GIVE ROUTINES

	DEFINE X(A,B,C,D,E)<
		IFB /'D'/,<UNWDSP=UNWRES>
		IFB /'E'/,<SCDDSP=SCDRES>
		IFNB /'D'/,<UNWDSP='D'##>
		IFNB /'E'/,<SCDDSP='E'##>
			UNWDSP,,SCDDSP
			>

UNWTAB:	RWAITS
DEFINE TTAB(FCTN,QUEUE,QUANT)
<		EXP FCTN
		XWD QUANT,-QUEUE
>
DEFINE PTTAB(FCTN,QUEUE,QUANT)
<		EXP FCTN
		XWD QUANT,QUEUE
>

QNULW:	TTAB	EQFIX,NULQ,-1	;NULL QUEUE JOB NO. NOT ASSIGNED
QSTOP::QSTOPW:	TTAB EQFIX,STOPQ,-1	;UNRUNABLE JOBS TO END OF STOPQ
QJDCW:	TTAB	EQFIX,JDCQ,-1
QCMW::	TTAB	EQFIX,CMQ,-1	;COMMAND WAIT TILL JOB IN CORE
QTSW:					;TTY IO WAIT SATISFIED(ENTER BACK OF PQ1)
QRNW:	TTAB	EQFIX,PQ1,QADTAB##	;JUST RUNABLE JOBS
	;WHICH ARE NOT IN SOME WAIT STATE BELOW

QRNW1:	TTAB	EQFIX,PQ1,-1	;PUT IN BACK OF PQ1. NO QUANTUM FOR SPECIAL TRANSFER
QRNW2:	TTAB	EQFIX,PQ2,-1	;PUT IN BACK OF PQ2, NO QUANTUM CHANGE

QTIOWW:	TTAB	EQFIX,TIOWQ,-1	;TTY IOW HELD IN TIOWQ
QPQIOW:	TTAB	EQFIX,PQIOQ,-1
QSLPW:	TTAB	EQFIX,SLPQ,-1	;SLEEP UUO
QEWW:	TTAB	EQFIX,EWQ,-1	;EVENT WAIT
QTIME::	PTTAB	EQLNKZ,QRQTBL##,0	;WHEN QUANT. TIME EXCEEDED.
	;WHEN QUANT. TIME EXCEEDED AND RESET QUANT. TIME
SUBTTL	SWAP R. KRASIN

;SWAPPER CALLED EVERY CLOCK TIC.
;SINCE MOST OPERATIONS STARTED BY THE SWAPPER REQUIRE SEVERAL
;TICS TO RUN TO COMPLETION, SEVERAL FLAGS(FINISH,FIT,FORCE
;ARE USED TO "REMEMBER" PREVIOUS STATES.
;THE BASIC ALGORITHM:
;IS CORE SHUFFLER WAITING FOR IO TO FINISH FOR SOME JOB?
;  YES--TRY AGAIN TO SHUFFLE(WHEN IO STOPS)
;IS CORE SHUFFLER STILL WAITING FOR IO TO FINISH?
;  YES--RETURN AND DO NOTHING
;IS SWAPPER STILL BUSY?
;  YES--RETURN AND DO NOTHING
;SCAN QS FOR 1ST JOB OUT OF CORE.
; IF NONE--RETURN
;A:
; IF ONE--WILL LOW(HIGH) SEG FIT IN LARGEST HOLE IN CORE?
;  YES--START INPUT AND RETURN
;  NO--IS TOTAL FREE CORE(CORTAL) ENOUGH TO ACCOMMODATE LOW(HIGH) SEG?
;    YES--CALL CORE SHUFFLER
;      IS SHUFFLER WAITING FOR IO TO STOP?
;        YES--RETURN AND DO NOTHING
;        NO--GO TO A:
;   NO--"REMEMBER" THIS JOB FOR INPUT AND LOOK FOR OUTPUT:
;ANY JOBS WAITING TO XPAND CORE BY SWAP OUT/IN?
; YES--OUTPUT ONE AND RETURN
; NO--SCAN QS BACKWARD FOR JOB IN CORE WHOSE PROTECT TIME
;		(SET ON INPUT) HAS GONE TO 0.
;  IF NONE--RETURN
;  IF ONE--IS IT SWAPPABLE(NO ACTIVE IO AND NOT CURRENT JOB)?
;   YES--OUTPUT HIGH SEG(IF ANY AND NOT ON DISK) THEN LOW SEGMENT
;   NO--SET SWP BIT(SO SCHEDULER WILL NOT RUN), IO WILL CONTINUE
;	IN LOW SEGMENT AS LONG AS IT CAN
;	IO ROUTINES NO LONGER STOP IF SWP SET, JUST SHF)
;ALL DEVICE DEPENDENT CODE MARKED WITH A "*"

SWAP::	PUSHJ	P,SAVE3##
	SETZM	CORFLG		; ASSUME NORMAL SWAPPING
IFN FTHPQ,<
	SKIPE	FIT##		;IS FIT SET?
	SKIPG	J,SCDRTF##	;AND HPQ JOB ON DISK?
	JRST	SWAP0A		;NO. CONTINUE
	MOVSI	T1,(JS.SIP)
	TDNE	T1,JBTST2##(J)	;STAY AWAY IF I/O IS IN PROGRESS
	JRST	SWAP0A
	LDB	T4,HPQPNT##	;GET ITS HPQ NUMBER
	MOVE	J,FIT##		;GET NUMBER FROM FIT
	PUSHJ	P,FITHPQ##	;GET LOW SEG NUMBER OF JOB IN FIT
	LDB	T2,HPQPNT##	;GET HPQ NUMBER OF JOB IN FIT
	CAIL	T2,(T4)		;IS IT LESS THAN JOB IN .CPRTF?
	JRST	SWAP0A		;NO. PROCEED NORMALLY
	MOVEI	T1,JBTSGN##-.HBLNK(J) ;SEGMENT BLOCK CHAIN
SWAP0C:	SKIPN	T1,.HBLNK(T1)
	JRST	SWAP0A		;NO HIGH SEGS AT ALL
	SKIPLE	T2,.HBSGN(T1)	;SEGMENT WORD
	SKIPE	JBTADR##(T1)	;YES. IN CORE, IF NOT, COULD BE IN FIT
	JRST	SWAP0C		;ELSE CHECK NEXT SEGMENT
	PUSHJ	P,ZERFIT	;NO. CAN CLEAR FIT AND RESELECT
SWAP0A:>	; END OF CONDITIONAL ASSEMBLY ON FTHPQ
SWAP1:
	PUSHJ	P,GVIPCP##	;RETURN ANY IPCF PAGES WHICH
				; WERE SWAPPED OUT TO THE FREE CORE LIST

	MOVE	J,FORCE##	;IF FORCING A HI SEG, DON'T PROCESS
	CAIG	J,JOBMAX##	; SWAP COMPLETION UNTIL THE
				; HI SEG SWAP STARTS BECAUSE SWPOUT
				; COULD BE REUSED
	SKIPN	SWPCNT##	;ANY SWAP REQUESTS COMPLETED?
	JRST	SWP2		;NO, PROCEED
	PUSHJ	P,FNDSLE##	;FIND A COMPLETED SWPLST ENTRY
	  STOPCD	FININ4,DEBUG,SMU,	;++SWPCNT MESSED UP
	PUSHJ	P,GETIOS##	;GET ERROR PLUS DIRECTION OF I/O BITS
	TLC	P2,(SL.SIO+SL.IPC) ;A "IP" QUEUE ENTRY?
	TLCN	P2,(SL.SIO+SL.IPC) ;TEST
	JRST	[PUSHJ P,IP2OUT## ;YES, MOVE PAGES FROM THE "IP" QUEUE TO THE "OUT" QUEUE
		 JRST SWAP1]	;AND SEE IF SOMETHING ELSE COMPLETED
	MOVSI	T1,(JS.SIP)
	CAIG	J,JOBMAX##
	ANDCAM	T1,JBTST2##(J)	;SWAPPING I/O IS DONE FOR THIS JOB
	TLNE	S,IO		;SWAP OUT?
	JRST	FINOUT		;YES, FINISH UP OUTPUT
	JUMPN	S,INERR		;JUMP IF SWAP READ ERROR
FININ0:	SETZM	FINISH##	; HERE IF NOTHING TO SWAP IN(HIGH OR LOW SEG EXPANDING FROM 0)
	CAIG	J,JOBMAX##	;WAS SEG JUST SWAPPED IN, A LOW SEG?
	PUSHJ	P,GIVBAK	;RETURN DISK SPACE, 4-WORD BLOCKS.
FININ1:	PUSHJ	P,FININ##	;IS THERE A HIGH SEG WHICH MUST BE SWAPPED IN?
	JRST	FININ5		;PUT IN THE HIGH SEG WAIT QUEUE AND IGNORE
	  JRST	FIT1		;YES, GO SWAP IT IN(J SET TO HIGH SEG NO,JOB # IN JBTSGN)
	 			; NO, EITHER HIGH SEG ALREADY IN FOR ANOTHER USER
				; OR THERE IS NONE, J STILL JOB NO. (IE LOW SEG)
FININ3:	CAIG	J,JOBMAX##	;STILL A HIGH SEG? (MIGRAT)
	JRST	FNIN3A		;NO, PROCEED
	PUSHJ	P,CHKTAL##
	HRRZ	J,JBTSWI##(J)	;GET THE JOB NUMBER
	MOVE	F,[JS.SIP!JS.HNG!JS.SCN!JS.TFO]	;CLEAR ALL GOOD BITS
	ANDCAM	F,JBTST2##(J)	;FOR JOB
	PUSHJ	P,FNDPDS##	;SET UP W
	JRST	FININ7		;AND NO MORE TO DO
FNIN3A:	PUSHJ	P,MAPUSR##	;SETUP THE MAP INCLUDING THE TRAP LOCATIONS
				; FOR THE JOB JUST SWAPPED IN
	PUSHJ	P,SXOPFH##	;MAKE PFH CONCEALED IF IT SHOULD BE
	LDB	F,IMGIN##	;NEW CORE SIZE
	LDB	T2,IMGOUT##	;OLD SIZE WHEN ON DISK
	SUB	T2,F		;OLD-NEW=DECREASE
				; HAS USER DECREASED VIRTUAL MEMORY FROM M TO N(N GR 0)
				; WHILE OUT ON DISK(R,RUN,GET,KJOB) TO 140 WORDS?
				; CORE COMMAND ALWAYS FORCES SWAP IN BEFORE
				; CORE REASSIGNMENT SO NOT IN THIS CATEGORY
				; FRAGMENTED USER TOO HARD TO PARTIALLY
				; RECLAIM DISK SPACE
				; ON REDUCTION WHICH DOES NOT GO TO 0
	SKIPLE	T2		;DECREASED?
	ADDM	T2,VIRTAL##	;YES, NOW INCREASE VIRTUAL MEMORY AVAILABLE BY
				; AMOUNT OF DECREASE IN HIGH OR LOW SEG
	PUSHJ	P,FNDPDS##	;FIND THE PDB OR STOP
	MOVE	F,[JS.SIP!JS.HNG!JS.SCN!JS.TFO] ;CLEAR SCANNED, FORCED BY TIMER, HUNG
	ANDCAM	F,JBTST2##(J)	;IN SECOND STATUS TABLE
	PUSHJ	P,UNSWAP	;MARK JOB IN CORE AGAIN (JS.SIP CLEARED BEFORE CLEARING SWP)
	PUSHJ	P,RTNNWL##	;RETURN SWAPPING SPACE FOR WRITE ENABLED PAGES
	LDB	T1,PJBST2##	;GET PHY QUE
	HRRZ	F,MIGRAT##	;LEFT HALF BITS GET CLEARED
	CAME	J,F		;IF JUST SWAPPING IN TO GET OFF A UNIT GOING
				; DOWN DONT CLEAR SWAPPABLE BIT
	CAIGE	T1,CMQ		;OR IF NOT IN RUN OR CMQ
	JRST	[MOVSI	F,PDMSWP	;MAKE SURE CAN SWAP
		 IORM	F,.PDIPT##(W)	;SET SWAPPABLE BIT
		 JRST	FININ7	]	;NOTHING MORE TO DO
	MOVSI	F,(JS.NNQ)	;JOB THAT DID GETSEG TO SWAPPED OUT HISEG?
	TDNE	F,JBTST2##(J)	;...
	JRST	FININ7		;YES. LEAVE PARAMETERS AND OUTPUT LIST AS IS
	PUSHJ	P,ASICPT	;ASSIGN IN-CORE PROTECT TIME
	MOVSI	F,PDMSWP
	ANDCAM	F,.PDIPT##(W)	;CLEAR SWAPPABLE BIT
	SKIPGE	JBTST2##(J)	;JOB IN PROCESSOR QUEUE?
	PUSHJ	P,CMPQSI	;YES. ASSIGN NEW RUN QUANTA
	PUSHJ	P,DLOLST	;MAKE SURE JOB IS NOT ON OLS
IFN FTNSCHED,<
	MOVSI	F,(JS.BBJ)	;SET/CLEAR B B JOB BIT
	CAME	J,BBFIT##	;IS JOB IN BACKGROUND BATCH?
	JRST	FININ6		;NO
	IORM	F,JBTST2##(J)	;SET THE BACKGROUND BATCH BIT
	MOVEI	T1,MBBQ##	;OFFSET TO BBQ
	JRST	FNIN6A
FININ6:	ANDCAM	F,JBTST2##(J)	;CLEAR THE BACKGROUND BATCH BIT
	MOVEI	T1,-JIQ##	 ;OFFSET TO JBTJIQ
	SKIPGE	JBTSCD##(J)	;IS JOB IN PQ2?
FNIN6A:>
IFE FTNSCHED,<
	LDB	T1,PJBST2##	;GET PHY QUE CODE
	CAIN	T1,PQ2		;IS JOB IN PQ2?
>
	SKIPE	JBTJIL##(J)	;SHOULD BE ZERO SINCE HE JUST CAME IN
	JRST	FININ7		;NOT IN PQ2 OR JBTJIL ALREADY SET
IFN FTMP,<
	CPLOCK	(SCD)
>
	HLL	T1,JBTJIL##(T1)	;PREVIOUS LAST JOB
	HRLM	J,JBTJIL##(T1)	;LAST JOB IS NOW US
	MOVEM	T1,JBTJIL##(J)	;HE IS OUR PREDECESSOR & QUEUE HEADER SUCCESSOR
	HLRZS	T1		;POINT TO HIM
	HRRM	J,JBTJIL##(T1)	;POINT HIM TO US
IFN FTMP,<
	CPUNLK	(SCD)
>
FININ7:	MOVSI	F,(JS.NNQ)	;CLEAR NO NEW QUANTA BIT
	ANDCAM	F,JBTST2##(J)
IFN FTNSCHED,<
	CAMN	J,BBFIT##	;BBFIT JOB?
	SETZM	BBFIT##		;YES, CLEAR IT
>
	SETZM	INFLG		;CLEAR FRUSTRATION FLAGS
	SETZM	INFLGJ
	SETZM	INFLGC
	SETZM	ZAPIDF		; NO LONGER OK TO ZAP 'YOUNG' IDLE/DORMANT SEGMENTS
IFN FTHPQ,<
	SETZM	.PDHZF##(W)	;CLEAR HPQ ZEROED FIT FLAG FOR THIS JOB
>
IFN FTKL10&FTMP,<
	PUSHJ	P,SETCSJ##	;RUN ONLY ON THIS CPU UNTIL CACHE SWEEP
> ;END IFN FTKL10 &FTMP
IFN FTPSCD,<
	SKIPN	T1,.PDPST##(W)	;BEING TIMED?
	JRST	SWP0		; NO
	SETZM	.PDPST##(W)	;YES. CLEAR TIMER
	ADD	T1,SYSUPT##	;GET ELAPSED TIME
	ADDM	T1,%P1CMT	;ADD TO TOTAL TIME SPEND WAITING
	MUL	T1,T1		;COMPUTE DOUBLE WORD SQUARE SUB
	TLO	T2,400000	;PREVENT OVERFLOW
	ADD	T2,%P1CM2+1
	TLZN	T2,400000	;CARRY?
	ADDI	T1,1		;YES. DO IT
	MOVEM	T2,%P1CM2+1	;STORE IT
	ADDM	T1,%P1CM2	;ALSO HIGH ORDER WORD
	AOS	%PQ1CM		;NUMBER OF RESPONSES
>	;END IFN FTPSCD
SWP0:	SETZM	FINISH##	;  CLEAR FINISH EITHER WAY
	SKIPE	FORCE##		; ALREADY FORCING?
	JRST	SWP1		; YES. DO OLD STUFF
	JRST	SCANIN		; NO. SO TRY TO START A NEW SWAPIN
FININ4:	SOS	SWPCNT##	;DECREMENT SWPCNT
	JRST	SWP2		;AND TRY SOMETHING ELSE

;HERE IF THERE'S A COLLISION ON A HIGH SEG FOR A JOB WHICH JUST
;FINISHED SWAPPING (JOB # IN J)

FININ5:	SKIPE	JBTJIL##(J)	;THIS BETTER BE ZERO
	JRST	SWAP1		;ELSE WE'VE BEEN HERE BEFORE
;NOTE THAT THE FOLLOWING 5 LINES ARE NOT UNDER THE SCHEDULAR INTERLOCK.
;THIS IS BECAUSE IT CAN ONLY BE EXECUTED ON POLICY RIGHT NOW (SWAPPER
;DOESN'T RUN ON NON-POLICY), AND THE JOBS IN THE QUEUE ARE NOT RUNNABLE
;SO CANNOT BE RUN BY THE SCHEDULAR.  SHOULD ANY OF THE ABOVE CHANGE,
;THE CODE WILL HAVE TO BE PUT UNDER SCDLOK.
	HLRZ	T1,JBTHSQ##	;LAST JOB WAITING FOR A HIGH SEG
	HRLM	J,JBTHSQ##	;NEW LAST JOB IS US
	HRRM	J,JBTJIL##(T1)	;POINT PREVIOUS LAST TO US
	HRLI	T1,-HSQ##	;WE ARE LAST SO POINT AT HEADER
	MOVSM	T1,JBTJIL##(J)
	MOVSI	T1,(JS.SIP)	;IN CASE THE HIGH SEG IS ON THE WAY OUT
	IORM	T1,JBTST2##(J)	;DON'T PICK US FOR INPUT
	JRST	SWAP1		;AND IGNORE US FOR NOW
;HERE ON SWAP INPUT ERROR IN LOW OR HIGH SEG
INERR:	MOVE	R,JBTADR##(J)	;SETUP RELOC,PROTECTION FOR HIGH OR LOW SEG
	SETZM	FINISH##	; CLEAR FINISH REGARDLESS - ONLY
				; USED TO PREVENT DELETING HISEG
				; FOR JOB SWAPPING IN ANYWAY
	CAILE	J,JOBMAX##	;IS THIS A HIGH SEGMENT JUST SWAPPED IN?
	JRST	INERR2		;YES
	PUSHJ	P,SWPREC	;RECORD ERRORS AND DECREASE AMOUNT OF
				;VIRTUAL CORE LEFT BY SIZE OF DISK SPACE LOST (JBTIMO)
	MOVSI	T1,JACCT	;CLEAR JACCT SO THAT A START COMMAND
	ANDCAM	T1,JBTSTS##(J)	; WILL NOT START A DAMAGED PROGRAM
				; WITH PRIVILEDGES AND SO DAEMON WON'T
				; GET RESTARTED
	PUSHJ	P,FNDPDS##	;GET PDB ADDRESS
	SETZM	.PDCMN##(W)	;ZAP USER DEFINED COMMAND POINTER
	SETZM	.PDUNQ##(W)	; SINCE FUNNY SPACE GOES AWAY
	PUSHJ	P,ZAPUSR##	;CLEAR ALL DDB'S, IO CHANS
	PUSHJ	P,CLRJOB##	;CLEAR PROTECTED PART OF JOB DATA AREA
	PUSHJ	P,ERRSWP##	;PRINT "SWAP READ ERROR"
INERR2:	PUSH	P,J		;SAVE SEGMENT NUMBER
	MOVEI	T1,ZAPHGH##	;SETUP ROUTINE
	CAILE	J,JOBMAX##	;HIGH SEGMENT
	PUSHJ	P,HGHAPP##	;YES, RESET ALL JOBS USING THIS HIGH SEGMENT
	MOVE	J,(P)		;GET SEGMENT NUMBER
	PUSHJ	P,SEGERR##	;GO CHECK IF HIGH SEG WHICH HAD ERROR
				; IF YES, CLEAR HIGH SEG NAME SO NO NEW
				; USERS WILL USE. ALWAYS RETURN JOB NO.
				;RECORD ERROR AND DECREASE VIRTUAL CORE LEFT
				; (SWPREC) IF THIS FIRST READ ERROR ONLY.
	POP	P,J		;RESTORE SEGMENT NUMBER
	CAIG	J,JOBMAX##	;A HIGH SEGMENT?
	JRST	INERR3		;NO
	HRRZ	T1,MIGRAT##	;MIGRATING JOB
	CAME	T1,JBTSWI##(J)
	CAMN	J,T1		;THE ONE WE'RE TRYING TO GET OFF A BAD UNIT?
	PUSHJ	P,DLTSLX##	;YES, FINHGH-ZERSWP WON'T DO THIS
	JRST	FININ0
INERR3:	HRRZ	T1,JBTUPM##(J)
	PUSHJ	P,GVPAGS##	;YES, WE'RE IN BAD TROUBLE-CAN'T BELIEVE FUNNY SPACE
	MOVE	T1,JBTSWP##(J)	;GET BACK ALL CORE FOR JOB
	PUSHJ	P,GVPAGS
	PUSHJ	P,DLTSLE##	;CLEAR THE SWPLST ENTRY
	SETZM	JBTADR##(J)	;THE JOB HAS NO CORE IN CORE
	HRRZS	JBTPDB##(J)
	SETZM	JBTUPM##(J)
	SETZB	T1,JBTSWP##(J)	;NO CORE ON DSK EITHER
	DPB	T1,IMGOUT##
	DPB	T1,IMGIN##
CHKHI0:	MOVEI	T1,JBTSGN##-.HBLNK(J) ;PRESET T1
CHKHI:	MOVE	T3,T1		;IN CASE NEED PREDECESSOR
	SKIPN	T1,.HBLNK(T1)	;ANY (MORE) HIGH SEGS THIS JOB?
	JRST	NOHI		;NO
	SKIPLE	T2,.HBSGN(T1)	;SKIP IF SPY OR NO HI SEG
	TLNN	T2,SHRSEG	;SHARABLE?
	JRST	[MOVE	T2,.HBLNK(T1) ;UNLINK THIS BLOCK
		 HRRM	T2,.HBLNK(T3) ;PREDECESSOR
		 PUSH	P,T3	;SAVE PREDECESSOR
		 MOVEI	T2,(T1)	;THE BLOCK TO RETURN
		 MOVEI	T1,.HBLEN ;HOW MUCH
		 PUSHJ	P,GIVWDS##
		 POP	P,T1	;WHERE TO CONTINUE
		 JRST	CHKHI]
	PUSHJ	P,KILHGH##	;ALSO REMOVE HI SEG FROM ADR SPACE
	JRST	CHKHI0		;AND START AT TOP OF CHAIN AGAIN
NOHI:
IFN FTNSCHED,<
	CAMN	J,BBFIT##	;WAS THIS A BB JOB?
	SETZM	BBFIT##		;YES, CLEAR FLAG SO OTHERS CAN COME IN
>
	PJRST	UNSWAP		;CLEAR SWP AND RETURN

				; CLEARED S SO LOOK LIKE NO ERROR
FINOUT:	TRNE	S,-1		;ANY ERRORS?
	JRST	OUTERR		;YES, PROCESS SWAP OUT ERRORS
	CAILE	J,JOBMAX##	;HI SEGMENT?
	JRST	FINOU1		;YES
	PUSHJ	P,FNDPDB##	;OTHERWISE POINT TO THE PDB
	  CAIA			;NO PDB, NO CONTEXT TO WORRY ABOUT
	SKIPL	.PDCTX##(W)	;CONTEXT SAVE IN PROGRESS?
FINOU1:	PUSHJ	P,DLTSLO##	;DELETE SWAP LIST ENTRY
	MOVE	R,JBTADR##(J)	;XWD PROTECT,,RELOC. FOR LOW SEG
	PUSHJ	P,CTXSCD##	;CALL CONTEXT SERVICE.  IT COULD EITHER:
				; 1. RETURN CORE IF DOING A NORMAL SWAP OUT
				; 2. RETURN CORE IF THIS IS A HIGH SEGMENT
				; 3. FIXUP JOB'S PAGE MAP SO JOB REMAINS IN
				;    CORE AND ON THE SWAPPER (CONTEXT SAVED)
FINOU0:	PUSHJ	P,FINOT##	;IS THIS A HIGH SEG WHICH WAS JUST SWAPPED OUT?
	  JRST	[MOVEI	T2,SWP2	;YES, J SET TO LOW SEG NO, GO TRY SWAP IT OUT
		 MOVSI	T3,(JS.SIP)
		 ANDCAM T3,JBTST2##(J)
		 JRST  FORCEQ ]	; NO, THIS WAS A LOW SEG, ALL SWAPPING FOR THIS USER
				; IS FINISHED.
SWP1:	SETZM	FINISH##	;CLEAR FINISH FLAG
SWP2:
;NOTE THAT THIS CODE DOESN'T HAVE TO BE UNDER SCDLOK.  SEE NOTE AT
;FININ5 FOR REASONS AND CAVEATS.
	SKIPG	J,JBTHSQ##	;IS THERE A HIGH SEG JOB WAITING TO FINISH?
	JRST	SWP9		;NO
SWP3:	HRRZS	J		;YES, SEE IF WE CAN DO ANYTHING WITH IT
	CAME	J,FORCE##	;IS IT SCHEDULED TO SWAP OUT NOW?
	CAMN	J,FORCEF	;?
	JRST	SWP5		;YES, JUST IGNORE HIM FOR NOW
	PUSH	P,J		;SAVE JOB #
	PUSHJ	P,FINCHK##	;WELL?
	  JRST	SWP4		;NO
	  SKIPA	T1,[FIT1]	;WHERE TO GO TO IN THIS CASE
	MOVEI	T1,FININ3	;AND IN THIS
	EXCH	T1,(P)		;STORE ADDRESS, GET OLD JOB
	EXCH	T1,J		;NEW JOB TO T1, OLD JOB TO J
	PUSH	P,T1		;SAVE NEW JOB
	MOVE	T1,JBTJIL##(J)	;GET PREDECESSOR,,SUCCESSOR
	HLLM	T1,JBTJIL##(T1)	;STORE PREDECESSOR TO SUCCESSOR
	MOVSS	T1
	HLRM	T1,JBTJIL##(T1)	;FIX UP THE QUEUE
	SETZM	JBTJIL##(J)	;CLEAR
	POP	P,J		;RESTORE J
	POPJ	P,		;RETURN TO THE APPROPRIATE PLACE
SWP4:	POP	P,J		;RESTORE J
SWP5:	HRRE	J,JBTJIL##(J)	;NEXT
	JUMPG	J,SWP3
SWP9:
IFN FTMP,<
	PUSHJ	P,SCDOWN##	;OWN INTERLOCK?
	  CPUNLK (SCD)		;YES, GIVE UP IN CASE WE EXIT HERE
>
	SKIPE	J,FORCE##	;WAITING FOR JOB TO BECOME SWAPPABLE?
	JRST	FORCEL		;YES, TRY TO SWAP OUT
SCANIN:	SKIPE	SWPCNT##	; ANY SWAPPING I/O DONE (PROBABLY ONLY IF
				; ONE PASS HAS ALREADY BEEN MADE THROUGH THE
				; MAJOR LOOP OF THE SWAPPER)
	JRST	SWAP1		;YES, GO PROCESS THAT FIRST
	SKIPE	J,FIT##		;NO-- WAITING TO FIT JOB IN CORE?
	JRST	FIT1		;YES, TRY TO SWAP IN
IFN FTLOCK,<
	SKIPE	J,LOCK##	;WAITING TO LOCK A JOB IN CORE?
	JRST	CPOPJ1##	;YES, TRY TO POSITION JOB FOR LOCKING
>	; END OF CONDITIONAL ASSEMBLY ON FTLOCK
	SKIPE	MIGRAT##	;IF ANY MIGRATING TO DO
	JRST	CHKMIG		;DO THAT FIRST

;SCAN FOR INPUT
	SETZM	SWPFAR		;ASSUME THIS SCAN WILL NOT BE FAIR
	MOVEI	U,ISCAN##
	MOVE	T1,SWPIFC	;NUMBER OF UNFAIR INPUT SCANS
	CAML	T1,MAXIFC	;REACH MAXIMUM?
	MOVEI	U,ISCAN1##	;YES, USE SECONDARY
IFN FTMP,<
	PUSHJ	P,SCDOWN##	;ALREADY OWN THE SCHEDULER INTERLOCK?
	  CAIA			;YES, DON'T GET IT AGAIN
>
	CPLOCK	(SCD)
IFN FTNSCHED,<
	SETZM	BBFLAG##	;WE ARE NOT SCANNING THE BACKGROUND BATCH QUEUE YET
>
	JSP	T1,QSCAN
	JRST	[CPUNLK	(SCD)	
		 JRST	ZCKXPN]	;NO INPUT TO DO--CK FOR EXPANDING JOBS
	MOVE	F,JBTSTS##(J)	;JOB STATUS WORD
	MOVE	T3,JBTST2##(J)
	TLNN	T3,(JS.SIP)	;FORGET THIS JOB IF SWAPPING I/O IS IN PROGRESS
	TLNE	F,JXPN		;EXPANDING JOB?
	JRST	(T2)		;DON'T SELECT FOR INPUT(CAN HAPPEN IF ZERO FORCE)
	TLNE	F,SWP		;ARE ALL OF THIS JOB'S SEGS IN CORE?
	PUSHJ	P,CKXPN##	;NO, IS HIGH SEG EXPANDING?
	  JRST (T2)		;YES, CONTINUE SCAN FOR SOME OTHER JOB
	TLC	F,NSHF		;NSHF SET AND NOT NSWP?
	TLNN	F,NSHF!NSWP	;?
	JRST	(T2)		;YES, DON'T TOUCH JOB (EG MAPBAK)
	HRRZ	T3,JBTSGN##(J)	;ANY HIGH SEGS?
	JUMPE	T3,SCANI2	;JUMP IF NONE
SCANI0:	PUSH	P,T3		;SAVE HIGH SEG DATA BLOCK ADDR
	SKIPLE	T3,.HBSGN(T3)	;GET SEGMENT WORD
	TLNN	T3,SHRSEG	;ONLY SHARABLE ONES COUNT
	JRST	SCANI1		;THIS ONE DOESN'T
	SKIPN	T3,JBTSWI##(T3)	;GET JOB LAST (CURRENTLY) SWAPPED IN FOR
	JRST	SCANI1
	HLL	T3,JBTST2##(T3)
	HLR	T3,JBTSTS##(T3)
	TDNE	T3,[JS.SIP!JXPN];SOME KIND OF I/O IN PROGRESS FOR LOW SEG
				;SHARING THIS HIGH SEG?
	TLOA	T2,-1		;FLAG
SCANI1:	TLZ	T2,-1		;CONTINUE LOOKING AT HIGH SEGS
	POP	P,T3		;RESTORE T3
	TLZE	T2,-1		;CLEAR AND TEST FLAG
	JRST	(T2)		;ALREADY REJECTED ONE
	HRRZ	T3,.HBLNK(T3)	;NEXT HIGH SEG FOR THIS JOB
	JUMPN	T3,SCANI0	;CHECK IT
SCANI2:	MOVEM	J,FIT##		;NO, REMEMBER JOB (OR HI SEG) TRYING TO FIT IN
IFN FTNSCHED,<
	SKIPE	BBFLAG##	;IS THIS JOB FROM BACKGROUND BATCH SCAN?
	JRST	FITPR1		;YES
	SETZM	SCNSWP##	;NO, ALLOW SCAN POINTER TO ADVANCE
	JRST	FITPR2
FITPR1:	MOVEM	J,BBFIT##	;REMEMBER IT
FITPR2:>
	CAIN	U,FISCAN##	;JOB FROM PQ1 (NOT IN CORE)?
	AOS	SWPIFC		;YES. COUNT UP
	SKIPE	SWPFAR		;DID THIS SCAN REACH FAIR TERRITORY
	SETZM	SWPIFC		;YES. CLEAR COUNT
	CPUNLK	(SCD)
	JRST	FIT1A		; TRY TO FIT JOB INTO CORE
				; (BYPASS SECOND CALL TO CKXPN FOR SPEED)

;HERE TO TRY TO FIT A SWAPPED JOB (OR HI SEG) INTO CORE (AGAIN)
FIT1::
IFN FTRSP,<
	SETOM	SWPPLT##	;SET POTENTIALLY LOST TIME FLAG FOR SWAPPER
>
	MOVEM	J,FIT##		;REMEMBER JOB (OR HI SEG) TRYING TO FIT IN
	PUSHJ	P,CKXPN##	;IS THIS A LOW SEG WHICH IS CONNECTED TO
				; AN EXPANDING HIGH SEG? (SHOULD BE RARE)
	  JRST NOFITZ		;YES. DESELECT IT AND GET OUT.
FIT1A:	LDB	P1,IMGIN##	;CORE SIZE NEEDED FOR THIS SEG (0 IF LOW SEG
				; OR HIGH SEG WITH UWP OFF ALREADY IN CORE
	LDB	T3,IFYPGS##
	SKIPN	T3
	LDB	T3,NFYPGS##
	CAILE	J,JOBMAX##	;ON LOW SEGMENT SWAP-IN, MUST ALSO ALLOCATE
	JRST	FIT1A1
	ADD	P1,T3		; A USER PAGE MAP PAGE SO ADD THAT TO
				; TOTAL CORE REQUIRED TO SWAP IN JOB OR LOW SEGMENT
	LDB	T3,NZSICN##	;# OF NZS MAPS NEEDED
	SKIPN	T3
	LDB	T3,NZSSCN##	;# ALREADY HAVE
	ADDI	P1,(T3)
FIT1A1:	SKIPE	JBTADR##(J)	;IS LOW OR HIGH SEG ALREADY IN CORE?
	MOVEI	P1,0		;YES (RARE) CAN HAPPEN IF JOB IN CORE EXPANDS
				; DURING LOW SEG SWAP IN SO HIGH SEG COULD NOT
				; FIT AND COUND NOT FIND ENOUGH JOBS TO SWAP OUT
				;;(SO CLEARED FIT AT NOFIT).
	PUSHJ	P,FITSIZ##	;COMPUTE AMOUNT OF CORE NEEDED TO BRING IN
				; 1. THIS JOBS LOW SEG AND HIGH SEG
				; 2. THIS JOBS LOW SEG(HIGH ALREADY IN OR NONE)
				; 3. THIS HIGH SEG BECAUSE LOW SEG ALREADY IN
				;WILL LOW SEG FIT IN FREE+DORMANT+IDLE CORE?
	  JRST	[PUSHJ P,BPSLST## ;DUMP "IN" QUEUE
		 JRST SCNOUT]	;NO,WILL NOT FIT EVEN IF ALL DORMANT SEGS DELETED
				; P1=TOTAL CORE NEEDED(IN K)
FIT1B:	CAMG	P1,BIGHOL##	;YES, WILL THIS SEG FIT IN BIGGEST HOLE OF FREE CORE
				; WITHOUT DELETEING ANY DORMANT OR IDLE SEGS?
				; (P1 RESTORED TO SIZE FOR JUST THIS LOW OR HIGH SEG)
				; BIGHOL CONTAINS THE NUMBER OF FREE PAGE ON
				; THE KI10 RATHER THAN THE LARGEST SET OF
				; CONTIGUOUS FREE PAGES
	JRST	SWAPI		;YES, GO SWAP IN THIS LOW OR HIGH SEG
	MOVE	T3,P1		;AMOUNT NEEDED TO T3
	PUSHJ	P,FRPCR##	;CAN IT BE MADE AVAILABLE FROM "OUT" QUEUE?
	  CAIA			;NO, TRY DELETING A DORMANT SEGMENT
	JRST	SWAPI		;YES, GO DO THE SWAP IN
	PUSHJ	P,FRECR1##	;NO, GO DELETE ONE DORMANT OR IDLE SEG IN CORE
				; (THERE MUST BE AT LEAST ONE, OTHERWISE
				; CORTAL WOULD EQUAL BIGHOL).
				; SKIP RETURN (USUAL) EXCEPT IF AN IDLE SEGMENT
				; WAS FOUND WITH NO COPY ON DISK (UWP OFF).
	  JRST FORIDL		; GO SWAP OUT IDLE HIGH SEG WITH NO DSK COPY.
	  JRST FIT1B		; ONE DORMANT OR IDLE SEGMENT HAS BEEN DELETED, GO 
				; TRY TO SWAP IN NOW.
	JRST SCNOUT		;MEMORY IS FRAGMENTED AND THERE ARE NO 
				;DORMANT HIGH SEGMENTS OR HOLES.  SCAN FOR OUTPUT
;HERE ON SWAP OUT ERROR
;CANNOT BE MEMORY PARITY ON CHANNEL READ BECAUSE ARR INTERRUPTS
; OR PROCESSOR STOPS WHEN CONTROLLER ROUTINE TOUCHES BAD PARITY.

OUTERR:	TRNN	S,IOCHMP	;CHANNEL (READ) MEMORY PAR ERROR?
	JRST	OUTER1		;NO, ERROR ON DISK (WRITE)
	PUSHJ	P,SWPRC1	;RECORD ERROR FLAGS AND NO. OF SWAP ERRORS
	PUSHJ	P,HGHSWE##	;IF HIGH SEG, PRINT ERROR FOR ALL JOBS USING
	  JRST	OUTER0		;YES, ALL JOBS USING HIGH SEG GOT ERROR MESSAGE
	MOVEI	T2,JOBPFI##+1	;NO, TEMP UNTIL GET REL ADR OF PAR AREA?
	CAIG	T2,JOBPFI##	;IS ERROR IN PROTECTED PART OF JOB DATA
	PUSHJ	P,[PUSHJ P,CHGSWP  ;YES, RETURN DISK SPACE
				; CANNOT TRUST JOB DATA AREA
				; INCREASE FREE VIRTUAL CORE
		   PJRST ZAPUSR##];CLEAR ALL HIS DDB'S, IO CHANS
	PUSHJ	P,SWOMES##	;PRINT ERROR MESSAGE AND STOP JOB
				; "SWAP OUT CHN MEM PAR ERR"
OUTER0:	MOVSI	T1,(SL.CHN+SL.ERR)
	ANDCAM	T1,SWPLST##(P1)
	JRST	SWAP1		;REENTER SWAPPER AS IF NO ERROR
				; AND FINISH SWAP OUT PROCESSING

;HERE IF SWAP OUT ERROR IS ON THE DEVICE (NOT CORE MEMORY)
OUTER1:	PUSHJ	P,SWPREC	;RECORD ERRORS
	PUSH	P,SW3LST##(P1)	;SAVE SWPOUT JOB
	PUSHJ	P,MAPBAX##	;RESET THE MAP (SETOMT WIPED IT OUT)
	POP	P,T1		;RESTORE SW3LST STUFF
	CAIG	J,JOBMAX##	;LOW SEG?
	JRST	SWP1		;YES, CONTINUE
	SETZ	T2,		;REALLY DIDN'T SWAP IT OUT
	DPB	T2,IMGOUT##	;...
	EXCH	T1,J		;PUT JOB IN J, HIGH SEG IN T1
	HLRZS	J		;THE JOB, THAT IS
	HRRZ	T2,MIGRAT##	;MIGRATING HIGH SEG?
	CAIE	T1,(T2)		;?
	PUSHJ	P,FNDHSB##	;AND DOES THIS JOB OWN HIGH SEG?
	JRST	SWP1		;NEVER MIND...
	MOVSI	T1,SWP		;IS JOB IN WAIT FOR SOME HIGH SEG (LIKE THIS ONE)?
	MOVSI	T2,SHF		;AND NOT ALREADY OUT OR ON THE WAY...
	TDNE	T1,JBTSTS##(J)	;.
	TDNE	T2,JBTSTS##(J)	;..
	JRST	SWP1		;NOT WAITING FOR THIS HIGH SEG
	ANDCAM	T1,JBTSTS##(J)	;ELSE NEED TO START ALL OVER AGAIN...
	MOVSI	T1,(JS.SIP)	;AND THIS
	ANDCAM	T1,JBTST2##(J)	;..
	JRST	SWP1

;SUBROUTINE TO RECORD SWAP IN/OUT ERRORS - REDUCE AMOUNT OF VIRTUAL CORE
; CALLED FROM SEGERR ON FIRST HIGH SEG ERROR


SWPREC::LDB	T1,IMGOUT##	;KEEP COUNT OF NO. OF OCCURANCES
	ADDM	T1,SWPERC##	;AND TOTAL VIRTUAL CORE LOST IN TH
	CAIG	J,JOBMAX##	;HIGH SEGMENT?
	ADDI	T1,UPMPSZ##	;NO, THE SPACE OCCUPIED BY THE UPMP IS LOST TOO
	MOVNI	T1,(T1)		;DECREASE TOTAL AMOUNT OF VIRTUAL CORE
				;IF THIS IS HIGH SEG
	ADDM	T1,VIRTAL##	;BY THE AMOUNT BEING GIVEN UP
				;FALL INTO SWPRC1
;SUBROUTINE TO RECORD SWAP OUT ERROR FROM MEMORY
SWPRC1:	HRRZ	T1,S
	IORM	T1,SWPERC##	;OR IN FLAGS FOR ERROR REPORTING (18-23)
	MOVSI	T1,1		;INCREASE COUNT OF NO OF SWAP ERRORS
	ADDM	T1,SWPERC##
	HRLM	J,SWPEUJ##	;SEGMENT WHICH GOT THE ERROR
	POPJ	P,

;NO INPUT TO DO, CHECK FOR EXPANDING JOBS
ZCKXPN:	SETZM	SWPIFC		;CLEAR SWAPPER FAIRNESS SCAN
IFN FTNSCHED,<
	PUSHJ	P,SQTEST	;POSSIBLY RESET THE PRIMARY SCAN POINTERS
>
CHKXPN:	SKIPG	XJOB		;ANY JOBS TO EXPAND?
	JRST	CHKFRE		;NO, SEE IF FREE CORE GOALS/LIMITS HAVE BEEN MET
	SETZM	SCNJBS		;ONLY SCAN EXPANDING JOBS
	JRST	SCNOU0		;ENTER SCNOUT
;INPUT TO DO, CHECK TO SEE IF ANY JOBS JUST HAPPEN TO WANT TO EXPAND
SCNOUT:	SETOM	SCNJBS		;PERMIT SWAPPING OUT JOBS
SCNOU0:	SETZM	CORFLG		; ASSUME NORMAL SWAPPING
	SKIPE	J,FORCE##	;ALREADY SCANNED FOR OUTPUT, AND FOUND A JOB
				; (BUT HAS ACTIVE IO, SO FINISH NOT SET YET)
	JRST	SCNOU1		;YES, TRY TO FORCE IT OUT AGAIN INSTEAD OF
				; SCANNING AGAIN AND POSSIBLY FINDING A DIFFERENT JOB
				; AND LEAVE THIS JOB IN CORE WITH SWP BIT ON SO CAN NOT
				; RUN (CAN HAPPEN ONLY IF JOBS IN CORE EXPAND
				; WHILE SWAPPING LOW SEG, SO HIGH SEG NO LONGER FITS)
				; BUT DO SOME CHECKING FIRST.
	SKIPG	T3,XJOB		;NO, ANY JOBS WAITING TO EXPAND?
	JRST	SCNJOB		;NO, SCAN ALL JOBS IN PRIORITY ORDER LOOKING
				; FOR ONE TO SWAP OUT
	MOVSI	T4,XPNMPT##	;SET UP AOBJN WORD FOR SEARCH
FNDXPN:	SKIPE	T1,XPNMAP##(T4)	;ANY BITS IN THIS WORD?
FNDXP1:	JFFO	T1,FNDXP2	;YES. FIND FIRST ONE
	AOBJN	T4,FNDXPN	;NO. CHECK NEXT WORD
	STOPCD	.+1,DEBUG,XTH,	;++XJOB TOO HIGH
	SETZM	XJOB		;CLEAR XJOB SO MESSAGE WILL PRINT
	JRST	SCNJOB		;SCAN FOR OUTPUT
FNDXP2:	MOVEI	J,(T4)		;GET WORD NUMBER
	LSH	J,5		;TIMES 32
	ADDI	J,(T2)		;PLUS BIT POSITION IN WORD
	MOVE	F,JBTSTS##(J)	;GET JOBSTS WORD
	TLC	F,NSHF		;WAITING FOR SOMETHING TO HAPPEN (MAPBAK)?
IFN FTMP,<
	TLNE	F,NSHF!NSWP	;(NSHF SET BUT NOT NSWP)
				;GIVES JOB NUMBER OF EXPANDING JOB
	PUSHJ	P,ANYRUN##	;STILL ON ANOTHER CPU
	  JRST	FNDXP3		;YES, SKIP THIS JOB FOR NOW
>
IFE FTMP,<
	TLNN	F,NSHF!NSWP
	JRST	FNDXP3		;SKIP JOB IF NOT SPECIAL
>
	MOVSI	F,(JS.HNG)	;HAS THIS JOB HUNG IN IOACT?
	TDNN	F,JBTST2##(J)	;...?
	JRST	SCNOK		;NO. PROCEED
	MOVE	R,JBTADR##(J)	;MUST SET UP R BEFORE CALLING ANYDEV
	CAME	J,.CPJOB##	;STILL CURRENT JOB(UNLIKELY)
	PUSHJ	P,ANYDEV##	;OR STILL ACTIVE DEVICES?
				; NOTE DESTROYS ONLY F,S(AT LAST CHECK)
FNDXP3:	SOJA	T3,[TDZ	T1,BITTBL##(T2)	;YES, CLEAR BIT FOR THIS JOB
		    JUMPG T3,FNDXP1 ;MORE EXPANDING JOBS?
		    SKIPN SCNJBS;SWAP REGULAR JOBS?
		    JRST FLGNUL	;NO.  DONE.
		    JRST SCNJOB];YES. GO DO REGULAR SCAN
SCNOK:	SKIPE	JBTADR##(J)	;DOES THIS JOB HAVE CORE IN CORE?
	JRST	FORCE0		;YES, DON'T CLEAR JXPN UNTIL THE JOB IS ON WAY OUT
	SOS	XJOB		;DECREMENT COUNT OF EXPANDING JOBS
	PUSHJ	P,XPNCLR	;CLEAR BIT IN TABLE
	MOVSI	F,JXPN
	ANDCAM	F,JBTSTS##(J)	;CLEAR EXPAND BIT IN JOB STATUS WORD
				;MUST BE CLEARED AFTER BIT TABLE AND
				;AFTER XJOB DECREMENTED, SINCE ACTS AS
				;INTERLOCK
	JRST	FORCE0		;GO TRY TO SWAP JOB OUT
;CONTENTS OF MIGRAT IS AS FOLLOWS:
;
;	-N			;FILFND MIGRATING IPCF PAGES FOR JOB N
;	FLAGS,,N		;PROCESSING JOB N
;
;FLAGS:
;	1B1			;IDLE CONTEXTS TO MIGRATE FOR THIS JOB
;	1B2			;ALREADY CALL CTXMIG FOR THIS JOB

CHKMIG:	SKIPN	SPRCNT##	;IF THE SWAPPER IS BUSY,
	SKIPE	SWPCNT##	;DONT TRY TO START ANYTHING
	JRST	FLGNUL
	SKIPG	J,MIGRAT##	;TRYING TO FORCE JOBS OFF A SWAPPING UNIT?
	JRST	CHKFRE		;NO (IPCF), SEE IF SHOULD TRY TO MAKE FOR FREE CORE
CHKMI1:	MOVEI	T1,(J)		;CLEAR FLAG BITS IN LEFT HALF
	CAMLE	T1,HIGHJB##	;YES, DONE ALL JOBS?
	JRST	MIGDON		;YES, THROUGH
	TLNE	J,100000	;ALREADY CALLED CTXMIG?
	JRST	CHKM1A		;YES
	PUSHJ	P,CTXMIG##	;IDLE CONTEXTS IN THIS JOB?
	  TLZA	J,200000	;NO, REMEMBER THAT
	TLO	J,200000
	TLO	J,100000	;(CAN'T TURN ON BEFORE BECAUSE OF CTXMIG)
CHKM1A:	MOVEM	J,MIGRAT##	;WE'VE GOTTEN AT LEAST THIS FAR
	HRRZS	J		;CLEARING LEFT HALF FLAGS
	MOVE	T1,JBTSTS##(J)	;NO, GET SOME INFO ON JOB
	HRR	T1,JBTST2##(J)
	TLNE	T1,SWP
	JRST	CHKMI2		;IF JOB IS NOT SWAPPED,
	PUSHJ	P,PFHMIG##	;SEE IF MORE PAGES TO MIGRATE
	  JRST	FORCE0		;YES
	JUMPGE	J,CHKMI4	;THIS CONTEXT CLEAR, SEE IF ANOTHER
	HRRZM	J,SW0JOB	;FLAG WE WANT JOB TO STOP RUNNING
	MOVSI	T1,JXPN		;IF THIS JOB IS EXPPANDING,
	TDNE	T1,JBTSTS##(J)	;IT WON'T EVER RUN, THOUGH, SO
	JRST	CHKXPN		;CATCH IT AS AN EXPANDING JOB
	JRST	FLGNUL		;AND CAN'T DO ANYTHING THIS TICK

CHKMI2:	TRNE	T1,JS.MIG	;AND WE'RE NOT SURE IT MIGRATED FROM BAD UNIT,
	JRST	CHKMI5		;SEE IF NEED TO DO OTHER CONTEXTS
	HLR	T1,JBTST2##(J)	;OTHER PART OF JBTST2
	CAME	J,FIT##		;SWAPPED NOW?
	TRNE	T1,(JS.SIP)	;SWAPPING I/O IN PROGRESS?
	JRST	FLGNUL
	JRST	FIT1		;ANOTHER SWAPPING UNIT

CHKMI4:	MOVEI	T1,JS.MIG
	IORM	T1,JBTST2##(J)
CHKMI5:	MOVSI	T1,200000	;NEED TO CALL OTHER CONTEXTS?
	TDNN	T1,MIGRAT##	;?
	AOJA	J,CHKMI1	;NO CONTEXTS TO MIGRATE
	SKIPE	JBTADR##(J)	;THIS CONTEXT OUT?
	JRST	FORCE0		;NO, FORCE IT OUT
	PUSHJ	P,CTXMGN##	;NEXT CONTEXT
	  AOJA	J,CHKMI1	;NO MORE
	MOVEI	T1,JS.MIG	;IN CASE LEFT ON FROM A PREVIOUS MIGRATE
	ANDCAM	T1,JBTST2##(J)	;CLEAR IT SO WE ACTUALLY DO CHECK
	TLO	J,300000	;CALLED CTXMIG ALREADY, MORE CONTEXTS TO DO
	JRST	CHKM1A


MIGDON: HRRZ	J,SEGPTR##	;POINT TO HIGH SEGS
MIGDN0:	CAILE	J,JBTMAX##	;DONE?
	JRST	MIGDN4		;YES
	MOVE	T1,JBTIMO##(J)	;GET DISK SIZE
	JUMPE	T1,MIGDN3	;NO CORE ON DISK
	PUSHJ	P,CHSWPU	;SEE IF ANY BAD PIECES
	  JRST	MIGDN5		;YES, SET TO GET RID OF THEM
MIGDN3: AOJA	J,MIGDN0	;CHECK NEXT
MIGDN4: SETZM	MIGRAT##	;DONE-CLEAR FLAG
	JRST	FLGNUL		;EXIT SWAPPER
;HERE TO SEE IF ANY PIECES OF A HIGH SEGMENT ARE ON THE BAD UNIT
;CALL WITH J=SEGMENT NUMBER (MUST BE HIGH SEGMENT)
CHSWPU: PUSHJ	P,SAVT##
	MOVE	T1,JBTSWP##(J)	;GET DSK ADDR OR FRAGMENT TABLE
	SKIPL	T2,T1		;COPY TO T2; IS IT FRAGMENTED?
	JRST	CHSWU2		;NOT FRAGMENTED
CHSWU1: SKIPN	T2,(T1)		;GET FRAGMENT ENTRY
	PJRST	CPOPJ1##	;DONE
	JUMPLE	T2,[HRRZI T1,(T2)
	            JRST CHSWU1]
	TLO	T1,400000	;REMEBER IT'S FRAGMENTED
CHSWU2: PUSH	P,T1		;SAVE FRAGMENT PTR (OR DISK ADDR)
	LDB	T1,[POINT 3,T2,17]	;GET UNIT
	SKIPLE	T1,SWPTAB##(T1)	;IS IT STILL THERE?
	SKIPGE	UNIFKS(T1)	;??
	JRST	TPOPJ##		;NO GIVE FAIL RETURN
	POP	P,T1		;RESTORE FRAGMENT PTR (OR DISK ADDR)
	TLZN	T1,400000	;FRAGMENTED?
	PJRST	CPOPJ1##	;NO, DONE
	AOJA	T1,CHSWU1
;HERE IF WE FIND THERE ARE PIECES ON A BAD UNIT
MIGDN5:	MOVSI	T1,SWP		;IS SEGMENT SWAPPED OUT?
	TDNN	T1,JBTSTS##(J)	;??
	JRST	MIGDN7		;NO JUST CLEAR SWAP SPACE
	MOVSI	T1,MJBTMX##	;LOOK TO SEE IF BEING SWAPPED IN
MIGDN6:	SKIPN	SWPLST##(T1)
	AOBJN	T1,MIGDN6	;THIS ENTRY FREE
	JUMPGE	T1,MIGDN8	;NOT BEING BROUGHT IN OR OUT
	HRRZ	T2,SW3LST##(T1)	;GET SEG # THIS ENTRY BELONGS TO
	CAIN	T2,(J)		;US
	JRST	FLGNUL		;YES, WAIT FOR IT TO SETTLE
	AOBJN	T1,MIGDN6	;OR CHECK NEXT ENTRY
	JRST	MIGDN8		;OK TO DELETE OR BRING IT IN
;HERE IF CAN DELETE COPY (NOT SWAPPED OUT)
MIGDN7:	PUSHJ	P,ZERSWP	;CLEAR IT
	JRST	MIGDN3		;AND CHECK NEXT ENTRY
;HERE IF NOT ACTIVELY SWAPPING, BUT SEGNENT IS SWAPPED OUT
;DELETE IF DORMANT, ELSE SWAP IN
MIGDN8:	SKIPGE	JBTSTS##(J)	;IF THE SEGMENT ISN'T DORMANT
	JRST	MIGDN9		;THEN SWAP IT IN
	PUSHJ	P,CLRNAM##	;ELSE DELETE IT
	JRST	MIGDN3
MIGDN9:	PUSH	P,J		;SAVE SEG #
	HRRZ	T1,JBTSWI##(J)
	EXCH	T1,J		;JOB # IN J, SEG # IN T1
	PUSHJ	P,FNDHSB##	;JOB REALLY OWN THIS SEGMENT (MAY BE STALE)
	  CAIA			;THIS GUY DOESN'T OWN IT
	JRST	MGDN12		;FOUND AN OWNER
MGDN10:	MOVE	J,HIGHJB##	;FIND SOMEBODY WHO HAS IT
MGDN11:	PUSHJ	P,FNDHSB##	;THIS JOB OWN SPEC'D SEG?
	  SOJG	J,MGDN11	;NO
	MOVE	T1,(P)		;SEG # IN QUESTION
	HRRZM	J,JBTSWI##(T1)	;MAKE SURE THERE'S SOME CONSITANCY HERE (BSN)
MGDN12:	POP	P,J		;REMEMBER THIS SEGMENT
	HRRZM	J,MIGRAT##	;AS THE MIGRATING SEGMENT
	JRST	FIT1
CHKFRE:				;HERE TO SEE IF SHOULD MAKE SOME FREE CORE
	SKIPN	SPRCNT##	;SWAPPER BUSY?
	SKIPE	SWPCNT##	;...
	JRST	FLGNUL		;YES
	SKIPN	FIT##		;OR TRYING TO GET BUSY?
	SKIPE	FORCE##		;...
	JRST	FLGNUL		;YES. EXIT SWAPPER
	MOVE	T1,BIGHOL##	;NO. SHOULD WE MAKE SOME FREE SPACE?
	CAML	T1,FREMIN	;LESS THAN DESIRED?
	JRST	FLGNUL		;NO. EXIT SWAPPER
	ADD	T1,PAGINC##	;NUMBER OF PAGES IN THE "IN" QUEUE
	CAML	T1,FREMIN	;WOULD SWAPPING THEM OUT MAKE BIGHOL BIG ENOUGH?
	JRST	BPSLST##	;YES, GO SWAP OUT THE "IN" QUEUE
	MOVE	T1,CORTAL##	;DON'T MAKE TOO MUCH EITHER
	CAML	T1,MAXTAL	;IS THERE TOO MUCH FREE PLUS DORMANT?
	JRST	FLGNUL		;YES. EXIT SWAPPER
	SETOM	CORFLG		;NO. WANT TO MAKE MORE
	SETZM	MAXJBN##	;PRESET STUFF FOR SCNCOR
	SETZM	SUMCOR##	;
IFN FTPSCD,<SETZM WASTSZ>	;
	JRST	FRCOUT		;SO GO BACK AND SCAN FOR OUTPUT WITH FIT=0

FLGNUL:
IFN FTRSP,<
	SETOM	SWPNUF##	;TELL CLOCK1 THAT SWAPPER WILL BE
				;IDLE THIS TICK
IFN FTMP,<
	PUSHJ	P,SCDOWN##
	  CPUNLK	(SCD)
>
>;END IFN FTRSP
	POPJ	P,		;RETURN
				;EXIT SWAPPER IF NO RESPONSE DATA
;HERE IF WE ARE TRYING TO FORCE OUT A JOB LEFT OVER FROM LAST TICK.
SCNOU1:	CAME	J,FORCEF	;IS THIS A JOB WE MUST RUN TO FREE A SHAR. RESOURCE?
	JRST	FORIDL		;NO, INSURE SWAP GETS SET
	JRST	FORCEL		;YES, SEE IF WE CAN GET IT BEFORE TURNING ON SWAP, WHICH
				; WOULD PREVENT US FROM GETTING IT BACK
				; IF THE JOB DID HAVE IT
;SCAN FOR JOB TO OUTPUT IN ORDER TO MAKE ROOM FOR JOB TO COME IN
;SIZE(IN K) NEEDED TO GET THIS USER IN CORE IS IN P1(FITSIZ)
;JUST LOW SEG SIZE IF NO HIGH OR HIGH ALREADY IN, JUST HIGH IF LOW ALREADY IN,
;OR SUM IF BOTH MUST BE SWAPPED IN

SCNJOB:	SKIPE	SPRCNT##	;SWAPPING I/O ALREADY IN PROGRESS?
	JRST	CHKXPN		;YES, DON'T LOOK FOR OUTPUT NOW
	PUSHJ	P,BPSLST##	;IF WE NEED ROOM, DUMP THE "IN" QUEUE NOW
SCNJBA:	MOVNI	J,DISQ##	; SEE IF HOLDING SOME DORMANT/IDLE AROUND
SCNJBB:	HRRE	J,JBTDIQ##(J)	; GET OLDEST IN QUEUE
	JUMPLE	J,SCNJBC	; USE CORTAL IF NONE
	SKIPN	JBTADR##(J)	; BUT MAKE SURE IN CORE
	 JRST	SCNJBB		; NOT. LOOK AT NEXT
	MOVE	T1,SYSUPT##	; SYSTEM UPTIME MINUS
	SUB	T1,JBTIDT##(J)	; TIME OLDEST IN CORE WENT
	CAMG	T1,SGTLIM	; IDLE/DORMANT. 'YOUNG'?
	 SKIPA	F,BIGHOL##	; YES. USE BIGHOL FOR SIZE COMPUTATIONS
SCNJBC:	MOVE	F,CORTAL##	; INITIALIZE FREE CORE COUNTER
	ADD	F,PAGOUC##	;INCLUDE NUMBER OF PAGES ON OUT QUEUE
	MOVEM	F,SUMCOR##
IFN FTPSCD,<
	SETZM	WASTSZ		;CLEAR PAGES WASTED ON THIS SCAN
>
	SETZM	MAXJBN##	;CLEAR SWAP OUT JOB NUMBER
	MOVE	J,FIT##		;JOB (OR HI SEG) BEING FIT IN
	PUSHJ	P,FITHPQ##	;GET JOB NO. IF TRYING TO FIT A HIGH SEG
				; (IN CASE HIGH PRIORITY JOB HAMPERED BY
				; USER IN CORE EXPANDING DURING HIS SWAP IN

	MOVEM	J,FITLOW	;REMEMBER JOB NUMBER WE ARE FITTING
IFN FTHPQ,<			;HIGH PRIORITY QUEUES?
	LDB	T4,HPQPNT##	;GET CURRENT HIGH PRIORITY Q NO, 0 IF NONE
	MOVEI	T1,JS.TFO	;FORCED OUT BY TIMER?
	TDNE	T1,JBTST2##(J)	;...
	SETZ	T4,		;YES. DON'T IGNORE ICPT
>	; END OF CONDITIONAL ASSEMBLY ON FTHPQ
	LDB	T1,PJBST2##	;GET JOB PHYSICAL QUEUE
	CAIL	T1,CMQ		;IS IT CMQ OR PROCESSOR QUEUE?
	SKIPA	T1,OSCNTQ##(T1)	;YES. GET TERMINATOR FROM TABLE
FRCOUT:	MOVE	T1,OSCANT##	;NO. ALL OTHERS TERMINATE AT SAME PLACE
	MOVEM	T1,SCNSTP	;STORE WHERE TO STOP SCAN
	MOVEI	U,OSCAN##	;SCAN ALL JOBS RANKED IN PRIORITY TO BE SWAPPED OUT
IFN FTMP,<
	PUSHJ	P,SCDOWN##	;ALREADY OWN THE SCHEDULER INTERLOCK?
	  CAIA			;YES, DON'T GET IT AGAIN
>
	CPLOCK	(SCD)
	JSP	T1,QSCAN
	  JRST	[CPUNLK	(SCD)			
		 JRST	NOFIT]	;NO MORE JOBS LEFT, CANNOT FIT JOB IN CORE

	CAMLE	U,SCNSTP	;YES. HAVE WE REACHED END OF SCAN?
	SKIPE	INFLG		;YES. IGNORE IF IMPATIENT
	SKIPA	F,JBTSTS##(J)	;NOT END OF SCAN OR TIMER WENT OFF
	JRST	[CPUNLK	(SCD)			
		 JRST	NOFIT]	;CAN'T FIT JOB IN, GO TELL TIMER

	CAME	J,FITLOW	;DON'T SWAP OUT SWAP-IN JOB
	SKIPN	JBTADR##(J)	;DOES JOB HAVE LOW SEG PHYSICAL CORE?
	JRST	(T2)		;NO, CONTINUE SCAN TO FIND ANOTHER JOB
				; (HIGH SEG ALREADY SWAPPED OUT IF NO LOW
				; SEG IN CORE)
	MOVSI	T3,(JS.SIP)	;
	TDNE	T3,JBTST2##(J)	; DON'T TRY TO SWAP OUT A JOB
	JRST	(T2)		;  WHICH IS ON ITS WAY IN/OUT
	HRRZ	W,JBTPDB##(J)	;GET PDB ADR
IFN FTLOCK,<
	TLNN	F,NSWP		;NON-SWAPPABLE?
	JRST	SCNJ0A		;NO, SKIP LOCK CHECK
	TLNN	F,SWP		;ALREADY SWAPPED?
	SKIPN	T3,JBTSGN##(J)	;ANY HIGH SEGMENT?
	JRST	(T2)		;JOB CANNOT BE SWAPPED
	HRRZS	T3		;CLEAR POSSIBLE JUNK
	JUMPE	T3,(T2)		;NO SEGMENT?
SCNJ0N:	HLL	T3,JBTSTS##(T3)	;STATUS WORD FOR SEGMENT
	TLNE	T3,NSHF!NSWP	;SEGMENT LOCKED?
	JRST	(T2)		;YES, CONTINUE SCAN
	HRRZ	T3,.HBLNK(T3)
	JUMPN	T3,SCNJ0N
SCNJ0A:
>	;END IFN FTLOCK
	TLC	F,NSHF		;COMPLEMENT NSHF
	TLZN	F,NSWP!NSHF	;WAS NSHF ON AND NSWP OFF?
	JRST	(T2)		;YES, SOMEONE DOESN'T WANT HIM OUT (EG MAPBAK)
IFN FTNSCHED,<
	SKIPE	BBFIT##		;IS BACKGROUND BATCH TRYING TO FIT?
	JRST	SCNJB0		;YES, LOOK AT ICPT
	MOVSI	T3,(JS.BBJ)	;BACKGROUND BATCH BIT
	TDNE	T3,JBTST2##(J)	;IS SCANNED JOB IN BACKGROUND BATCH?
	JRST	SCNJB1		;YES, IGNORE ICPT
>
	JUMPE	W,SCNJB1	;NO PDB, FORGET PROTECT TIME
SCNJB0:	SKIPGE	CORSCD		;CORE SCARCE
	PUSHJ	P,CLRIPT	;NO, IGNORE ICPT
	HRRZ	T3,MIGRAT##
	SKIPE	T3
	CAME	T3,FITLOW
	TLNE	F,SWP		;NO ICPT IF SWP BIT SET
	JRST	SCNJB1		;DON'T CHECK ICPT
	SKIPL	.PDIPT##(W)	;PROTECTED TIME PAST?
IFN FTHPQ,<
	 JUMPE	T4,(T2)		;NOT HPQ BEING FIT
>
IFE FTHPQ,<
	 JRST	(T2)
>
SCNJB1:	TLNE	F,NSWP		;YES, IS THIS JOB NOT TO BE SWAPPED?
	JRST	(T2)		;YES,CONTINUE SCAN TO FIND ANOTHER
IFN FTNSCHED,<
	SKIPGE	JBTST2##(J)	;IS SCANNED JOB IN A PROCESSOR QUEUE?
	SKIPN	BBFIT##		;ARE WE FITTING BACKGROUND BATCH?
	JRST	SCNJB2		;NOT PROCESSOR QUE OR NOT BACKGROUND BATCH
	MOVSI	T3,(JS.BBJ)	;BACKGROUND BATCH IS TRYING TO FIT
	TDNN	T3,JBTST2##(J)	;SCANNING A TIMESHARE JOB?
	JRST	(T2)		;YES, REJECT JOB
SCNJB2:>
	MOVE	T3,.PDIPL##(W)	;GET IPCF WORD
	TLNE	T3,-1		;OWN SOMEBODY'S INTERLOCK?
	JRST	(T2)		;YES, CAN'T SWAP
	MOVSI	T3,(JS.HNG)	;HAS THIS JOB HUNG WITH IOACT?
	TDNN	T3,JBTST2##(J)	;..?
	JRST	SCNJB3		;NO. OK
	MOVSI	T3,JXPN		;YES. IS IT STILL?(IF JXPN IS ON
				;IT MUST HAVE BEEN STILL STUCK AT
	TDNN	T3,JBTSTS##(J)	;FNDXPN. DON'T TOUCH IT)
	CAMN	J,.CPJOB##	;CURRENT JOB?
	JRST	(T2)		;PICK SOMEONE ELSE
	MOVE	R,JBTADR##(J)	;MUST SET UP R BEFORE CALLING ANYDEV
	PUSHJ	P,ANYDEV##	;SHOULDN'T BOTHER OUR ACS(JUST F,S)
	  JRST	(T2)		;STILL STUCK
SCNJB3:				;
IFN FTHPQ,<			;
	LDB	F,HPQPNT##	; GET JOBS HPQ
	SKIPE	CORFLG		; JUST MAKING ROOM?
	SKIPL	JBTSTS##(J)	; AND NOT STOPPED?
	CAIA			; NO.
	JUMPG	F,(T2)		; YES. DON'T MAKE IT FROM HPQ. LIKELY TO WAKE
>				;
	MOVE	F,JBTIMO##(J)	;JBTIMO NON-ZERO ONLY IF EXPANDING OR
	JUMPN	F,[MOVSI F,JXPN ; WAITING FOR A HI SEG SWAP IN
		   TDNE  F,JBTSTS##(J) ;EXPANDING?
		   JRST  .+1	;YES, HE'S A SUPER CHOICE
		   SKIPN INFLG	;REALLY NEED THE CORE BAD?
		   JRST  (T2)	;NOT YET, THERE MIGHT BE A BETTER CHOICE
		   PUSH  P,T1	
		   PUSHJ P,UNSWP1 ;LO SEG IN CORE BUT SWAP IN DIDN'T
				; FINISH BECAUSE HI SEG DIDN'T MAKE
				; IT. MAKE JBTIMO RIGHT AND
		   POP   P,T1
		   JRST  .+1]	; SWAP OUT THIS LOW SEG
	LDB	F,IMGIN##
	LDB	T3,NFYPGS##	; FUNNY PAGES PLUS UPMP
	ADD	F,T3		; MAKE ESTIMATE MORE ACCURATE
	PUSHJ	P,FORSIZ##	;INCREASE SIZE(F) BY HIGH SEG SIZE/# IN CORE LO SEGS +1
	SKIPE	MAXJBN##	;PICKED ONE YET?
	JRST	FORCE2
IFN FTMP,<
	PUSHJ	P,ANYRUN##	;JOB CURRENTLY RUNNING ON CPU1?
	  JRST	[SKIPL CORSCD	;IF CORE IS SCARCE,		
		 MOVEM J,SW0JOB	;DON'T LET THIS JOB HOG IT BY
		 JRST (T2)]	;RUNNING CONTINUOUSLY ON ANOTHER CPU
				;YES, DON'T SELECT THIS JOB
				; SINCE IT MAY HAVE A HI SEG WITH
				; AN IN-CORE COUNT OF 1 WHICH COULD
				; GET DELETED BY FORHGH
>
	PUSH	P,F		;SAVE J
	HRRZ	F,JBTSGN##(J)	;GET SEGMENT BLOCK POINTER, IF ANY
	JUMPE	F,FORCE3	;NONE
	PUSH	P,J		;SAVE F
FORCE8:	SKIPG	J,.HBSGN(F)	;SPY SEG?
	JRST	FORCE9		;YES, NO SWEAT
	PUSHJ	P,ANYSAV##	;MAKE SURE THIS CAN SWAP
	  JRST	[POP P,J	;RESTORE SIZE
		 POP P,F	;AND JOB
		 MOVEM J,SW0JOB	;KEEP HIM FROM HOGGING CORE ON CPU1
		 JRST (T2)]	;AND REJECT JOB
FORCE9:	HRRZ	F,.HBLNK(F)	;POINT TO NEXT
	JUMPN	F,FORCE8
	POP	P,J		;RESTORE J
FORCE3:	POP	P,F		;AND SIZE
	MOVEM	J,MAXJBN##	;NO. SAVE JOB NUMBER
	ADDM	F,SUMCOR##	; ADD TO TOTAL
IFN FTPSCD,<			;
	SKIPL	JBTST2##(J)	; IS JOB IN A PROCESSOR QUEUE?
	ADDM	F,WASTSZ	; NO. TOTAL IT
>				;
	CAMG	P1,SUMCOR##	; FOUND ENOUGH CORE FOR JOB?
	JRST	FORC2A		; YES, GO TO IT
	MOVE	T3,JBTSTS##(J)	; GET JOB STATUS
	SKIPN	CORFLG		; JUST MAKING SPACE?
	TLNN	T3,RUN+CMWB	; OR STOPPED AND NOT CMW?
	JRST	FORCE5		; YES. THROW IT OUT NOW
	JRST	(T2)		; KEEP MAKING ROOM
FORCE2:	ADDM	F,SUMCOR##	;ADD TO TOTAL
IFN FTPSCD,<
	SKIPL	JBTST2##(J)	;IS JOB IN A PROCESSOR QUEUE?
	ADDM	F,WASTSZ	;NO. TOTAL IT
>
	CAMLE	P1,SUMCOR##	;FOUND ENOUGH CORE FOR JOB TO BE FIT IN?
	JRST	(T2)		;NO. LOOK FOR MORE
FORC2A:				;
IFN FTNSCHED,<
	SKIPN	BBFIT##		;DID WE JUST FIT A BACKGROUND BATCH JOB?
	JRST	FORCE4		;NO, TIMESHARING JOBS ALREADY ZEROED SCNSWP
	SETZM	SCNSWP##	;YES, NOW WE CAN ALLOW SCAN POINTER TO ADVANCE
	MOVEM	T2,SCNBBS##	;SAVE T2
	MOVE	T2,SYSUPT##	;CURRENT TIME
	ADD	T2,SCDBBS##	;PLUS TIME INTERVAL BETWEEN BB SWAPS
	EXCH	T2,SCNBBS##	;TIME WE CAN SWAP IN NEXT BB JOB
FORCE4:
>
IFN FTPSCD,<
	PUSHJ	P,CNTWST	;COUNT THE WASTE
>
FORCE5:	MOVE	J,MAXJBN##	; YES, SWAP OUT FIRST
	SKIPE	INFLG		;TIMER GONE OFF?
	SKIPL	JBTST2##(J)	;YES. IS JOB IN PROCESSOR QUEUE?
	JRST	FORC00		;NO. GO AHEAD
	MOVEI	F,JS.TFO	;YES. SET FORCED BY TIMER BIT
	IORM	F,JBTST2##(J)
	JRST	FORC00		;AND DO PROPER SKIP ENTER OF FORCE0
;HERE FROM SCNOUT OR LOCK


FORCE0::MOVEI	T2,FLGNUL	;GET READY TO FLAG SWAPPER NULL TIME IF ACTIVE DEVICES
FORC00:	PUSHJ	P,ANYSAV##	;NO CAN THIS JOB BE STOPPED IN ORDER TO DO SWAP?
	  JRST	(T2)		;NO, NSWP OR NSHF SET(DISPLAY,REAL TIME) OR
				; SAVE OR GET IN PROGRESS WITH DEVICE STILL ACTIVE
				; LOOK FOR AN OTHER JOB TO SWAP
	CAILE	J,JOBMAX##	;HIGH OR LOW?
	JRST	FORCEA		;LOW. SKIP SOME WORK
	MOVSI	T1,(JS.HNG)	;WAS THIS JOB HUNG IN IOACT?
	TDNE	T1,JBTST2##(J)	;...?
	JRST	[SKIPN R,JBTADR##(J) ;IN CORE?
		 JRST FORC0A	;NO, CONTINUE CHECKING
		 PUSHJ P,ANYDEV## ;IS JOB STILL HUNG?
		   SKIPA J,MAXJBN## ;YES, LOOK FOR ANOTHER
		 JRST [IFN FTMP,<
		       PUSHJ P,SCDOWN##
		  	 CPUNLK	(SCD)>
		       JRST SWAPO]	;NO,SWAP IT OUT
		 JRST 0(T2)]	
	SKIPN	MOFLPG##	;DON'T WORRY ABOUT RESOURES IF SETTING MONITOR
				; MEMORY OFF LINE
	PUSHJ	P,FLSDR##	;ANY SHAREABLE DISK RESOURCES?
	  JRST	FORCEA		;HIGH SEG OR NO RESOURCES - SO OK
	MOVEM	J,FORCE##	;SET FOR LATER RETRIES
	MOVEM	J,FORCEF	;AND FLAG THE PROBLEM
FORC0A:	JRST	FLGNUL		;QUIT FOR NOW SINCE CAN'T SWAP HIM
FORCEA:	PUSH	P,T2		;FORHGH COULD DESTROY T2
	PUSHJ	P,FORHGH##	;IS THERE A HIGH SEG TO BE WRITTEN BEFORE
				; TRYING TO SWAP OUT LOW SEGMENT?
				; WRITE HIGH SEG IF ALL OF THE FOLLOWING ARE TRUE:
				; 1. JOB HAS A HIGH SEG AND
				; 2. IT HAS NOT BEEN SWAPPED FOR THIS USER
				;    (SWP=0 FOR JOB)
				; 3. IT IS IN CORE(NOT XPANDH)
				; 4. IF IN-CORE COUNT IS EXACTLY 1 MEANING
				;    THIS ONLY USER USING IN CORE
				; 5. HIGH SEG NOT ON DISK YET
				; 6. THIS HIGH SEG IS NOT THE SAME ONE AS JOB
				;    BEING FITTED IN IS GOING TO WANT
				; RETURN HIGH SEG NO. IN J IF YES, OTHERWISE
				; RETURN LOW SEG NO.
				; IF JOB JUST HAS LOW SEG, SHF BIT IS SET IN JBTSTS
				;    FOR JOB SO IO WILL STOP NEXT BUFFER
	POP	P,T2
;HERE FROM LOKCON TOO TO FORCE OUT IDLE HIGH SEG
FORIDL::MOVSI	F,SWP		;SET SWAPPED OUT BIT FOR LOW OR HIGH SEG
	IORM	F,JBTSTS##(J)	;SCHEDULER WILL NO LONGER RUN THIS JOB
				; SET SHF BIT IF ONE SEG SOFTWARE, SO IO WILL
				; STOP AFTER NEXT BUFFERFUL.
				; HERE TO FORCE OUT IDLE HIGH SEG WHEN IT
				; HAS NO COPY ON DISK (UWP OFF)
FORCEL:	MOVEI	T2,SWP2		;LOAD BRANCH ADDRESS
	HRRZS	J		;CLEAR LEFT HALF CRUFT
	MOVSI	T3,(JS.SIP)	;BE SURE I/O NOT IN PROGRESS
	CAIG	J,JOBMAX##	;IS IT A JOB?
	TDNN	T3,JBTST2##(J)	;YES, SIP ON?
	JRST	FORCEQ		;NO
	MOVSI	T3,JXPN		;YES, ALSO CHECK FOR JXPN
	TDNE	T3,JBTSTS##(J)	;SIP AND XPN BOTH ON?
	MOVEI	T2,FLGNUL	;YES, GET OUT OF EXPANDING JOB LOOP, WAIT FOR
				; SWAPPER I/O TO COMPLETE FOR THIS JOB
FORCEQ:	CAMN	J,FIT##		;SAME AS FIT JOB (HPQ)
	JRST	[SETZM	FORCE##	;YES, DESELECT AND TRY AGAIN
		 SETZM	FORCEF
		 JRST	(T2)	]
FORCEM:	MOVEM	J,FORCE##	;ASSUME NOT SWAPPABLE--IS IT?
FORCE1:
IFN FTMP,<
	PUSHJ	P,SCDOWN##
	  CPUNLK	(SCD)>
IFN FTKL10&FTMP,<
	PUSHJ	P,SWPCSH##	;JOB MUST BE RUNNABLE W.R.T. CACHE IN ORDER
				; TO SWAP IT OUT, SINCE SOME OF IT MAY
				; ONLY EXIST ON ANOTHER CPU'S CACHE
	  JRST	FLGNUL		;NO GOOD, DO NOTHING THIS TICK, WAIT
				; FOR OTHER CPU TO SWEEP ITS CACHE
				; (HOPE THIS DOESNT HAPPEN TOO OFTEN)
>;END IFN FTKL10&FTMP
	SKIPN	FORCEF		;TRYING TO SWAP GUY WITH DISK RESOURCE?
	JRST	FORCEB		;NO. PROCEED NORMALLY
	PUSHJ	P,FLSDR##	;YES. DOES HE STILL HAVE IT
	  CAIA			;NO. SWAP HIM
	JRST	FLGNUL		;YES. TRY LATER
	SETZM	FORCEF		;CLEAR FLAG
	JRST	FORCEA		;COMPLETE THE WORK SKIPPED EARLIER
FORCEB:	SKIPN	R,JBTADR##(J)	;LOC. IN PHYSICAL CORE, IS CORE
				; ASSIGNED IN MEMORY?
	JRST	SWAPO		;NO, CANNOT HAVE ACTIVE DEVICES
	CAME	J,.CPJOB##	;IF THIS IS CURRENT JOB, WAIT UNTIL
				; PROTECTED AREA IS MOVED BACK TO JOB DATA AREA
	PUSHJ	P,ANYDEV##	;ANY ACTIVE DEVICES?(2ND HALF OF ANYACT ROUT.)
	  JRST	NOFORC		;YES--START HUNG TIMER AND WAIT FOR I/O TO STOP
	PUSHJ	P,BPSLST##	;TRY TO DUMP THE "IN" QUEUE
				;(EVEN IF JOB HAS NO PAGES THERE)
	CAILE	J,JOBMAX##	;HIGH SEG?
	JRST	SWAPO		;YES, NO PAGES ON QUEUES THEN
	PUSHJ	P,JOBNQ##	;ANY PAGES ON THE QUEUES?
	  JRST	FLGNUL		;YES, MUST DELAY
;SWAP OUT LOW OR HIGH SEGMENT



SWAPO:	SETZM	OUFLGJ		;CLEAR TIMER
	CAILE	J,JOBMAX##	;IS THIS A LOW SEG?
	JRST	SWAPO0		;NO
	PUSHJ	P,DLOLST	;DELETE JOB FROM OUTPUT SCAN LIST
	PUSHJ	P,DLJILS	;DELETE FROM JUST SWAPPED IN LIST
	MOVSI	F,(JS.HNG!JS.NNQ) ;CLEAR NO NEW QUANTA BIT, ETC.
	ANDCAM	F,JBTST2##(J)
	MOVE	T1,SCDCOR##	; PREPARE TO RESET TO CORE SCHEDULING
	SKIPGE	JBTST2##(J)	; IF THIS JOB IS IN A PROCESSOR QUEUE
	MOVEM	T1,CORSCD	; IT IS. SET CORSCD
SWAPO0:	SETZM	FORCE##		;CLEAR FORCE FLAG
	SETZM	SW0JOB		;CLEAR CPU1 SWAP FLAG
	SETZM	CORFLG		; ASSUME NORMAL SWAPPING
IFN FTLOCK,<
	MOVE	F,JBTSTS##(J)	;GET SEGMENT STATUS
	TLNE	F,NSWP		;IS THIS SEGMENT LOCKED IN CORE?
	JRST	[PUSHJ	P,FIXXPN  ;YES, RETURN AND PRETEND IT WAS SWAPPED OUT
		 JRST	FINOU0]
>;END IFN FTLOCK
	HLRZ	F,JBTADR##(J)	;COMPUTE CORE IMAGE
	JUMPE	F,SWP1		;DONT OUTPUT IF 0 CORE(JBTIMO ALREADY SET TO 0
				; WHEN CORE WAS RETURNED

	LDB	U,IMGIN##	;HAS SIZE OF CORE NEEDED WHEN NEXT SWAPPED IN
	MOVSI	F,SHF		;ASSUME A LOW SEGMENT
	CAIG	J,JOBMAX##	;IS IT?
	IORM	F,JBTSTS##(J)	;YES, INDICATE SWAPPING OUTPUT IN PROGRESS
	MOVE	F,JBTIMO##(J)	;OUTPUT IMAGE SIZE
	SKIPE	F		;HAS IT BEEN SET BY XPAND?
	SKIPA	U,F		;YES, DON'T CHANGE IT
	MOVEM	U,JBTIMO##(J)	;NO, SET OUTPUT IMAGE
	LDB	T2,NFYPGS##
	CAILE	J,JOBMAX##	;A HIGH SEGMENT?
	JRST	SWAPOX
	PUSHJ	P,SVEUB##	;SO WE CAN ADDRESS .USWLP AND FOR BOSLST
	ADD	U,T2		;NO, ACCOUNT FOR THE UPMP
	LDB	T2,NZSSCN##	;# OF NZS MAPS
	ADDI	U,(T2)
	SKIPLE	JBTST2##(J)	;IF NOT IN A RUN QUEUE,
	SUB	U,.USWLP	; DEMAND PAGE HIM IN IF VIRTUAL
SWAPOX:	MOVE	F,JBTIMO##(J)	;GET OUTPUT IMAGE SIZE
	SETZB	T2,JBTIMO##(J)	; ZERO JBTIMO SO IF A HIGH SEGMENT IT WON'T
				; LOOK LIKE IT ALREAD HAS DISK SPACE TO DODELE
	PUSHJ	P,SWPSPC##	;*GET DEVICE STORAGE, SAVE DEVICE ADDR IN JBTSWP
	  JRST	SWAPO3		;DIDN'T MAKE IT
	PUSHJ	P,BLDVPN##	;CORE FOR VPN TABLE (LS) OR EXTRA FRG LST (HS)
	  JRST	[MOVE	U,F		;RELOAD U
		 MOVE	T1,JBTSWP##(J)
		 PUSHJ	P,FXSAT##
		 SETZM	JBTSWP##(J) ;NO LONGER OWN FRAGMENT TABLE
		 JRST	SWAPO3 ] ;TRY AGAIN LATER
	PUSH	P,J		;SAVE J
	CAIG	J,JOBMAX##
	JRST	SWAPO1
	MOVE	T1,J		;PUT HIGH SEG # IN T1
	SKIPE	J,SWPOUT##	;HIGH SEG, JOB REMEMBERED IN SWPOUT?
	PUSHJ	P,FNDHSB##	;JOB HAVE THIS HIGH SEG?
	  JRST	SWAPO2
SWAPO1:	MOVSI	T1,(JS.SIP)	;IS US OR THIS IS JOB, ETC.  SET JS.SIP
	IORM	T1,JBTST2##(J)
SWAPO2:	MOVE	J,(P)		;RESTORE J
	MOVEM	F,JBTIMO##(J)	;NOW, SAFELY STORE OUTPUT SIZE
	PUSHJ	P,BOSLST##	;BUILD AN OUTPUT SWPLST ENTRY
	AOS	SPRCNT##	;COUNT UP THE NUMBER OF SWAPS IN PROGRESS
IFN FTRSP,<
	SETZM	SWPPLT##	;CLEAR LOST TIME FLAG
>;END IFN FTRSP
	PUSHJ	P,SQOUT##	;START I/O IF NOT ALREADY GOING
	POP	P,J		;RESTORE SEGMENT NUMBER
	CAIG	J,JOBMAX##	;SWAPPING A JOB OR A HIGH SEGMENT?
	PUSHJ	P,DICLNC	;A JOB, REQUE IT NOW TO AVOID SCANNING IT DURING SWAP OUT
	PUSHJ	P,FIXXPN	;FIX JXPN BIT
	JRST	CHKXPN

FIXXPN::MOVSI	T1,JXPN		;JOB IS EXPANDING BIT
	CAIG	J,JOBMAX##	;HIGH SEGMENT?
	TDNN	T1,JBTSTS##(J)	;NO, IS THIS JOB EXPANDING?
	POPJ	P,		;NO, RETURN
	SOS	XJOB		;YES, DECREMENT THE COUNT OF EXPANDING JOBS
	PUSHJ	P,XPNCLR	;CLEAR BIT IN TABLE
	MOVSI	T1,JXPN
	ANDCAM	T1,JBTSTS##(J)	;CLEAR JXPN SO JOB WON'T BE SEEN AGAIN
				;MUST BE CLEARED AFTER BIT TABLE AND
				;AFTER XJOB DECREMENTED, SINCE ACTS AS
				;INTERLOCK
	POPJ	P,		;AND RETURN

SWAPO3:	LDB	T1,IMGIN##	;INPUT SIZE SET BY XPAND
	CAIN	T1,(F)		;INPUT AND OUTPUT SIZES DIFFERENT?
	MOVEI	F,0		;NO, NOT SET OUTPUT SIZE TO ZERO
	MOVEM	F,JBTIMO##(J)	;STORE AS OUTPUT SIZE
	MOVEM	J,FORCE##	;REMEMBER WHO WE WERE TRYING TO SWAP OUT
	JRST	FLGNUL		;RETURN, TRY SWAP NEXT TICK
NOFIT:	SKIPE	CORFLG		; JUST FREEING SOME SPACE?
	JRST	FLGNUL		; YES. SO GET OUT

IFN FTNSCHED,<
	SKIPE	J,BBFIT##	;WAS BACKGROUND BATCH SELECTED FOR SWAPIN?
	CAME	J,FIT##		;REALLY JUST SELECTED?
	JRST	NOFIT1		;NO
	SETZM	FIT##		;YES, DESELECT JOB
	SETZM	BBFIT##		;CLEAR BACKGROUND BATCH INDICATOR
	PUSHJ	P,SQTEST	;RESET SCAN POINTER TO SCAN SAME CLASS
	JRST	FLGNUL		;AND EXIT THE SWAPPER
NOFIT1:>
	MOVE	J,FITLOW	;PICK UP JOB NUMBER WE COULDNT FIT IN NOW
IFN FTHPQ,<
	HRRZ	W,JBTPDB##(J)	;GET PDB ADDRESS
	JUMPE	W,NOFIT3	;NONE. GO ON
	SKIPG	F,.PDHZF##(W)	;WAS THIS PERSON IN FIT AND TIMING?
	JRST	NOFIT3		;NO. JUST NORMAL
	MOVEM	J,INFLGJ	;YES. PUT HIM BACK WHERE HE WAS BEFORE
	MOVEM	F,INFLGC	; LAST TIME IS NEW TIMER
	SETZM	.PDHZF##(W)	;CLEAR FLAG
	JRST	NOFIT7		;AND PROCEED
NOFIT3:>	;END IFN FTHPQ
	CAMN	J,INFLGJ	;SAME JOB WE COULDNT FIT IN LAST TICK?
	JRST	NOFIT7		;YES. COUNT HIS FRUSTRATION INDEX
	MOVEM	J,INFLGJ	;NO. REMEMBER HIM FOR FUTURE REFERENCE
	MOVE	F,SYSUPT##	;AND START TIMER
	MOVEM	F,INFLGC
	JRST	FLGNUL		;FINISH UP
NOFIT7:	MOVE	F,SYSUPT##	;CURRENT TIME
	SUB	F,INFLGC	;COMPUTE TIME WE'VE BEEN WAITING
	CAILE	F,^D200		; STARTING TO GET FRUSTRATED? (3+ SECS)
	SETOM	ZAPIDF		; YES. LET FRECR1 ZAP IDLE/DORMANT SEGS
	CAIGE	F,^D360		;FRUSTRATION TIMED OUT? (ABOUT 6 SEC)
	JRST	NOFIT9		;NO. PATIENCE PLEASE.
	SKIPN	INFLG		;TIMER STILL ON FROM LAST TICK?
	AOS	CINFLG		; NO. COUNT # OF TIMES INFLG WAS SET.
	SETOM	INFLG		;GIVE HIM A QUICKER IN
NOFIT9:	JRST	FLGNUL		;RETURN AND TRY TO SWAP NEXT TICK

NOFITZ:	SKIPE	J,FIT##		;GET JOB IN FIT BEFORE ZAPPING IT
	SETZM	FIT##		;CLEAR JOB BEING FIT IN
IFN FTNSCHED,<
	CAMN	J,BBFIT##	;DON'T CLEAR UNLESS WE'RE SUPPOSED TO
	SETZM	BBFIT##		;CLEAR BACKGROUND BATCH FIT FLAG
>
	JRST	FLGNUL		;EXIT SWAPPER. NEW JOB WILL BE SELECTED NEXT TIME

IFN FTHPQ,<
ZERFIT:	SKIPE	W,FIT##		;GET JOB # IN FIT
	SETZM	FIT##		;CLEAR FIT SO WE CAN RESELECT
IFN FTNSCHED,<
	CAMN	W,BBFIT##	;DON'T CLEAR UNLESS WE'RE SUPPOSED TO
	SETZM	BBFIT##		;CLEAR BACKGROUND BATCH FIT FLAG
>
	HRRZ	W,JBTPDB##(J)	;GET PDB ADDRESS
	JUMPE	W,CPOPJ##	;OOPS
	MOVE	T2,INFLGC	;GET TIME THIS JOB STARTED WAITING
	MOVEM	T2,.PDHZF##(W)	;AND REMEMBER THAT
	SKIPG	J,SCDRTF##
	POPJ	P,
	CAMN	J,FORCE##	;SWAPPER REMEMBERING US?
	SETZM	FORCE##		;NOT ANY MORE
	CAMN	J,FORCEF	;OR HERE?
	SETZM	FORCEF
	MOVEM	J,FIT##		;SELECT HPQ JOB TO SWAPIN
	POPJ	P,
>
NOFORC:	CAILE	J,JOBMAX##	;LOW SEGMENT?(HIGH SHOULD NOT GET HERE)
	JRST	FLGNUL		;BUTS LETS BE SURE
	CAMN	J,OUFLGJ	;SAME AS LAST JOB?
	JRST	NOFOR1		;YES. CONTINUE TIMER
	MOVEM	J,OUFLGJ	;NO. START NEW TIMER
	MOVE	F,SYSUPT##	;BASED ON ELAPSED UPTIME
	MOVEM	F,OUFLGC
	JRST	NOFOR3		;AND SCRAM OUT OF HERE
NOFOR1:	MOVE	F,SYSUPT##	;SAME JOB. TIMER EXPIRED?
	SUB	F,OUFLGC
	CAIGE	F,^D30		; TRY NOT TO DELAY SWAP INS TOO LONG
	JRST	NOFOR3		;NOT YET. BE PATIENT
	AOS	CJHUNG		;COUNT # OF TIMES A JOB HUNG WITH ACTIVE I/O
	SKIPE	FORCEF		;TIMER EXPIRED. BE SURE WASN'T IN FORCEF,
				; SINCE WOULD BLOW SWAPPER
	STOPCD	NOFOR2,DEBUG,SHU,	;TRY TO RECOVER FROM GOOF
	MOVSI	F,(JS.HNG)	;TIMER EXPIRED. PICK SOMEONE ELSE
	IORM	F,JBTST2##(J)	;MARK HUNG
	PUSHJ	P,XPANDH	; GUARANTEE JOB GOES OUT AS SOON AS POSSIBLE
NOFOR2:	SETZM	FORCE##		;CLEAR FORCE
	SETZM	FORCEF		;BE CONSISTENT
	SETZM	OUFLGJ		;CLEAR TIMER
NOFOR3:	JRST	FLGNUL		;AND EXIT SWAPPER
	$LOW
SW0JOB::0		;JOB REJECTED BY SWAPPER BECAUSE IT IS RUNNING
			;ON CPU1.  FLAGS CPU1 TO STOP RUNNING HIM SO HE
			;CAN SWAP.
CORSCD:	BLOCK	1	;SCARCE CORE TIMER IF LESS THAN 0, CORE IS ABUNDANT
INFLGJ::0		;FRUSTRATED JOB NUMBER WAITING TO BE SWAPPED IN
INFLGC::0		;TIME HE STARTED WAITING
INFLG::	0		;HE IS FRUSTRATED
CINFLG::0		;NUMBER OF TIMES WE GOT FRUSTRATED

SCNJBS:	BLOCK	1	;FLAG WHETHER TO SCAN NON-EXPANDING JOBS FOR SWAP OUT

OUFLGJ::0		;FRUSTRATED JOB NUMBER WAITING TO BE SWAPPED OUT
OUFLGC::0		;TIME HE STARTED WAITING
CJHUNG::0		;NUMBER OF TIMES FORCE WAS CLEARED TO AVOID
			;HANGING THE SWAPPER
FORCEF::0

FITLOW:	0		;NUMBER OF JOB BEING FIT(NEVER HIGH SEG NUMBER)
NEXTJB:	0		;NUMBER OF NEXT JOB TO SCAN IN ICPT LOOP (NXTJOB)

SWPIFC::0		;SWAPPER FAIRNESS COUNT
MAXIFC::IFC0##		;MAXIMUM FAIRNESS COUNT FOR SWAPPER
SWPFAR:	0		;FLAG THAT SWAPPER REACHED FAIR TERRITORY

SCNSTP:	0		;CONTAINS ADDRESS OF OSCAN ENTRY FOR LAST QUE TO SCAN
			;IF U BECOMES GREATER, SCNOUT WILL STOP SCANNING UNLESS
			;INFLG IS SET
IFN FTPSCD,<
WASTSZ:	0
>

SGTLIM::^D60		; NUMBER OF TICKS IDLE/DORMANT SEGMENT
			;  MUST AGE BEFORE BEING DELETED
ZAPIDF::0		; FLAG IF SHOULD DELETE ALL DORMANT/IDLE SEGMENTS
CORFLG::0		; SET IF SWAPPING OUT STUFF JUST TO MAKE ROOM
FREMIN::0		; MINIMUM VALUE OF BIGHOL TO STRIVE FOR
MAXTAL::0		; BUT ONLY IF CORTAL LESS THAN THIS
;NEEDED IF SET MEMORY OFF AND LOCK WERE GOING TO KEEP FREMIN/MAXTAL RIGHT
FREMI%::0		;% OF USRCOR SCHED. USER SET FREMIN TO
MAXTA%::0		;% OF USRCOR SCHED. USER SET MAXTAL TO

	$HIGH
;SWAP IN A JOB OR HIGH SEGMENT

SWAPI:	SETZM	FIT##		;CLEAR FIT FLAG
	LDB	T1,IMGIN##	;SIZE OF CORE TO BE ASSIGNED WHEN SWAPPED IN
	LSH	T1,P2WLSH	;CONVERT TO HIGHEST ADR
	SOS	T1		;-1 FOR CALL TO CORGET (ALWAYS POSITIVE)
	SKIPE	R,JBTADR##(J)	;IS (LOW) SEG ALREADY IN CORE ?
	JRST	FININ1		;YES, TREAT AS SWAP IN - GO CLEAN UP
	MOVEM	J,FINISH##	;SET FINISH FLAG TO INPUT
	PUSHJ	P,CORGET##	;NO, GET CORE FOR LOW OR HIGH SEG
	  STOPCD .,STOP,CNA,	;++CORE NOT AVAILABLE
	SKIPN	JBTADR##(J)	;IS SPACE IN CORE?
	STOPCD	.,STOP,SOD,	;++SPACE ON DISK
				;SPACE IS ON THE DISK. THIS HAPPENS
				; IF PDB FRAGMENTS CORE.
	MOVE	F,JBTIMO##(J)	;GET OUTPUT IMAGE
	JUMPE	F,[PUSHJ P,FITHGH## ;INCREASE INCORE COUNT
		   JRST  FININ0]
	MOVSI	T1,(JS.SIP)
	PUSH	P,J		;SAVE J FOR FITHGH
	HRRZS	J		;CLEAR LEFT HALF CRUFT
	CAIG	J,JOBMAX##	;IF NOT A HIGH SEGMENT, INDICATE
	IORM	T1,JBTST2##(J)	; SWAPPING I/O IN PROGRESS FOR THIS JOB
	PUSHJ	P,BUSLST##	;SETUP TO SWAP IN THE UPMP
	  JRST	SWAPIF		;SWAP IN FAILED, TRY AGAIN LATER
	POP	P,J		;RESTORE J WITH BITS
	PUSHJ	P,FITHGH##	;INCREASE INCORE COUNT
IFN FTPSCD,<
	PUSHJ	P,CNTSWP	;RECORD DATA ON SWAPPING
>
	AOS	SPRCNT##	;COUNT UP NUMBER OF SWAPPING OPERATIONS IN PROGRESS
IFN FTRSP,<
	SETZM	SWPPLT##	;CLEAR POT LOST FLAG, WE'RE DOING 
>;END IFN FTRSP
				;SOMETHING
	AOS	SINCNT##	;BUMP COUNT OF NUMBER OF SWAPPING INPUTS IN PROGRESS
	JRST	SQIN##		;*START INPUT

;HERE IF COULDN'T GET CORE BLOCKS, ETC. FOR SWAP IN
SWAPIF:	POP	P,(P)		;FIX STACK
	MOVEM	J,FIT##		;PUT BACK FOR NEXT TIME
	SETZM	FINISH##	;CLEAR FINISH FLAG
	PUSHJ	P,KCORE1##	;DELETE ANY CORE WE ALLOCATED
	MOVSI	T1,(JS.SIP)	;NO LONGER IN PROGRESS
	CAIG	J,JOBMAX##	;(ONLY IF JOB)
	ANDCAM	T1,JBTST2##(J)	;CLEAR SIP
	JRST	FLGNUL		;AND EXIT SWAPPER
;ROUTINE TO CHANGE DISK SWAPPING SPACE ALLOCATION (OR SET TO 0)
;DIFFERS FROM ZERSWP IN THAT VIRTUAL TALLY FOR SYSTEM IS ALSO CHANGED
;CALLED FROM CORE0
;CALL:	MOVE J,JOB OR HIGH SEG NUMBER
;	MOVE T1,#1K BLOCKS TO BE NEW ASSIGNMENT
;	PUSHJ P,CHGSWP
;	ALWAYS RETURN
;CALLED ONLY FROM VIRTUAL+PHYSICAL CORE ROUTINE CORE0


CHGSWP::LDB	T2,IMGIN##	;SIZE WHEN NEXT SWAPPED IN
	JUMPE	T1,CHG1		;IS ZERO BEING ASKED FOR ?
	LSH	T1,W2PLSH	;NO, CONVERT TO 1K BLOCKS
	ADDI	T1,1		;BUT DO NOT ATTEMPT TO RETURN DISK SPACE
				; SINCE IT MIGHT BE FRAGMENTED (SWAPPER WILL
				; RETURN ALL OF DISK SPACE ON NEXT SWAPIN)
				; HAPPENS ONLY ON X,RUN,GET,KJOB
	DPB	T1,IMGIN##	;STORE NEW SIZE WHEN NEXT SWAPPED IN
	PUSH	P,J		;SAVE AN AC
	MOVNI	J,UPMPSZ##	;UPMP SIZE
	SKIPN	T2		;IF GOING FROM 0 TO POSITIVE CORE,
	ADDM	J,VIRTAL##	; DECREMENT VIRTAL FOR UPMP
	MOVE	J,(P)		;RESTORE J FOR JBTIMO USE.
	MOVE	J,JBTIMO##(J)	;GET OLD DISK SIZE OF THIS USER (USES ITEM)
	CAMGE	T2,J		;IS OLD IN-CORE SIZE BIGGER ?
	MOVE	T2,J		;NO, USE DISK SIZE AS USER'S OLD VIRTUAL CORE
	CAMGE	T1,J		;IS NEW IN-CORE SIZE BIGGER ?
	MOVE	T1,J		;NO, USE DISK SIZE AS USER NEW
				; VIRTUAL CORE
	SUB	T2,T1		;DECREASE OF USER VIRTUAL CORE=OLD-NEW
	ADDM	T2,VIRTAL##	;USER'S DECREASE=SYSTEM'S INCREASE OF VIRTUAL
				; CORE
	JRST	JPOPJ##		;RESTORE J AND RETURN
;ROUTINE TO RETURN ALL OF DISK SPACE FOR A LOW OR HIGH SEG
;THIS IS A PHYSICAL DEALLOCATION ONLY AND HAS NO EFFECT ON A SEGMENTS
;VIRTUAL CORE ASSIGNMENT
;CALL:	MOVE J,JOB NUMBER OR HIGH SEG NUMBER
;	PUSHJ P,ZERSWP
;CALLED FROM SEGCON IN MANY PLACES (5)
;AND FININ0 HERE IN SWAP


CHG1:	JUMPE	T2,ZERSWP	;HAVE CORE ON DISK?
	CAIG	J,JOBMAX##	;LOW SEGMENT?
	ADDI	T2,UPMPSZ##	;YES, ACCOUNT FOR THE UPMP
	ADDM	T2,VIRTAL##	;INCREASE SIZE OF VIRTUAL CORE AVAILABLE IN SYSTEM
				; AND THEN RETURN ALL OF DISK SPACE (CHGSWP)
ZERSWP::PUSH	P,U		;SAVE TTY OUTPUT BYTE POINTER (COMMAND DECODER)
	MOVE	U,JBTIMO##(J)	;*SIZE ON DISK (1K BLOCKS)
	JUMPE	U,CHG10		;DID SEG HAVE ANY DISK SPACE ?
	PUSHJ	P,ZERSWH##	;IS THIS A HIGH SEG WITH AN ERROR?
				;T2 SETUP AS ARG
	  PUSHJ	P,GIVBKH	;GIVE BACK HIGH SEGMENT SWAPPING SPACE
CHG10:	POP	P,U		;RESTORE U

UNSWAP:	MOVSI	T2,SWP!SHF	;CLEAR SWAPPED OUT BIT IN JOB OR SEG
	ANDCAB	T2,JBTSTS##(J)	;STATUS WORD (SHF SET IF I/O WAS TO BE STOPPED
				; FOR SWAP OR CORE SHUFFLE
	HRRZ	T1,J		;GET JOB NUMBER IN T1
	CAME	T1,FORCE##	;SWAPPER REMEMBERING US?
	JRST	UNSWP1		;NO, CONTINUE
	SETZM	FORCE##		;YES, CLEAR FLAGS THAT HAVE OUR NUMBER
	SETZM	FORCEF		;FORCEF MAY HAVE OUR JOB NUMBER TOO
				;(FORCEF SHOULD EITHER BE ZERO OR SAME AS FORCE)
UNSWP1:	SETZB	T1,JBTIMO##(J)	;0 IS NEW DISK ASSIGNMENT, SET IT
	CAIG	J,JOBMAX##	;A LOW SEGMENT?
	SETZM	JBTSWP##(J)	;SO IT WON'T LOOK LIKE IT HAS CORE
				;WHEN IT DOESNT
				; HERE FROM CHGSWP IF NOT ASKING FOR 0
	POPJ	P,		;RETURN

;SUBROUTINE TO RETURN A SWPLST POINTER FORMAT WORD OF DISK SPACE
;;IF HIGH SEG, THEN P2=INDEX INTO HIGH SEG MAP IF HIGH SEG ONLY ON DISK,
;ALL OTHER HIGH SEG CASES P2=-1.
;P2 UPDATED AS EACH ENTRY PROCESSED.
RTNDSP:	TLNE	T1,(SL.ERR+SL.CHN) ;DONT GIVE BACK SWAPPING SPACE IF BAD
	POPJ	P,		;RETURN
	CAIG	J,JOBMAX##	;DON'T CHECK .USWLP FOR HIGH SEG
	TLNE	T1,(SL.IPC)	;ALWAYS GIVE BACK SPACE FOR IPC PAGES
	JRST	RTNDS0		;RETURN THE SPACE
	SKIPE	.USWLP		;DON'T GIVE BACK SPACE IF PAGES ARE WRITE LOCKED
	POPJ	P,		;RETURN THE SPACE ON A WRITE LOCK PAGE FAULT
RTNDS0:	SE1ENT			;ENTER SECTION 1 TO REFERENCE MEMTAB
	LDB	U,[POINT SL.SCT,T1,<^L<SL.CNT>+SL.SCT-1>] ;NUMBER OF PAGES OF SWAPPING SPACE
	CAILE	J,JOBMAX##	;ONLY FOR HIGH SEGS
	JUMPGE	P2,RTNDS1	;IF NORMAL SWPLST ENTRY
	LDB	T1,[POINT SL.SPN,T1,<^L<SL.PPN>+SL.SPN-1>] ;FIRST PHYSICAL PAGE I/O WAS DONE INTO OR OUT OF
	SSX	T1,MS.MEM	;MEMTAB SECTION
	LDB	T1,[POINT MT.SAD,MEMTAB(T1),<^L<MT.DAD>+MT.SAD-1>]
	PJRST	FXSAT1##	;RETURN THE DISK SPACE

RTNDS1:	LDB	T1,JBYVAD##	;POINT TO HIGH SEG MAP
	ADDI	T1,(P2)		;POINT TO CORRECT SLOT
	ADDI	P2,(U)		;UPDATE P2 FOR THIS POINTER
	MOVE	T1,(T1)		;GET MAP POINTER
	TLZ	T1,(PM.NAD)	;CLEAR ALL BUT DISK ADDRESS
	PJRST	FXSAT1##	;RETURN THE DISK SPACE

;SUBROUTINE TO GIVE BACK DISK SPACE AND CORE BLOCKS
;CALL WITH P1=LOC OF SWPLST ENTRY
GIVBAK:	LDB	T1,IMGOUT##	;OUTPUT IMAGE SIZE
	JUMPE	T1,CPOPJ##	;RETURN IF NO OUTPUT IMAGE
	PUSH	P,P2		;SAVE P2
	SETO	P2,		;FLAG THIS IS ONLY SWPLST FORMAT (NOT SWAPPED
				;OUT HIGH SEG)
	PUSHJ	P,ZERSLE	;RETURN THE DISK SPACE
	POP	P,P2		;RESTORE P2
	PJRST	DLTSLE##	;AND DELETE THE SWPLST ENTRY

ZERSLE::CAIG	J,JOBMAX##	;A HIGH SEGMENT?
	PUSHJ	P,SVEUB##	;NO, MAKE UPMP ADDRESSABLE (SEE RTNDSP)
	SKIPL	T1,SWPLST##(P1)	;FRAGMENTED?
	PJRST	RTNDSP		;NO, JUST RETURN THE DISK SPACE
	PUSHJ	P,SAVE1##	;SAVE AN AC
GIVBK0:	HRRZ	P1,T1		;ADDRESS OF THE FRAGMENT TABLE
GIVBK1:	MOVE	T1,(P1)		;NEXT ENTRY IN THE FRAGMENT TABLE
	JUMPLE	T1,GIVBK2	;JUMP IF A LINK WORD
	PUSHJ	P,RTNDSP	;RETURN THE DISK SPACE REPRESENTED IN THIS ENTRY
	AOSA	P1		;STEP ON TO THE NEXT ENTRY IN THE TABLE
GIVBK2:	HRRZ	P1,T1		;LINK TO NEXT ENTRY
	JUMPN	P1,GIVBK1	;JUMP IF NOT THE LAST ENTRY
	POPJ	P,		;ALL DONE, RETURN

GIVBKH:	PUSHJ	P,SAVE2##	;SAVE P1-P2
	MOVSI	P1,MJBTMX##	;- TOTAL NUMBER OF SEGMENTS ALLOWED
CHG4:	SKIPN	SWPLST##(P1)	;NON-ZERO ENTRY IN SWPLST?
	JRST	CHG6		;NO, LOOK AT THE NEXT ENTRY
	HRRZ	T1,SW3LST##(P1)	;SEGMENT NUMBER ASSOCIATED WITH THIS ENTRY
	CAIN	T1,(J)		;SAME AS THE ONE WE ARE LOOKING FOR?
	PJRST	GIVBAK		;YES, GIVE BACK THE DISK SPACE
CHG6:	AOBJN	P1,CHG4		;LOOP FOR THE NEXT ENTRY
	SKIPL	T1,JBTSWP##(J)	;GET SWAPPING POINTER
	PJRST	FXSAT##		;GIVE BACK THE DISK SPACE (NOT FRAG'D)
	MOVSI	P1,SWP		;IS HIGH SEG ONLY ON DISK?
	TDNE	P1,JBTSTS##(J)	;?
	TDZA	P2,P2		;YES, START AT PAGE 0 OF MAP
	SETO	P2,		;FLAG SWPLST ENTRY IS OK
	PUSHJ	P,GIVBK0	;RETURN DISK SPACE FROM SWPLST FORMAT
	HRRZ	T1,JBTSWP##(J)	;BLOCK
	SETZM	JBTSWP##(J)	;NO LONGER EXISTENT
	PJRST	RTNBLK##	;RETURN THE BLOCK
;XPAND SETS CONDITIONS TO GET MORE CORE FOR A JOB BY SWAPPING IN OUT
;THEN BACK IN TO DESIRED AMOUNT.
;JOBS POSITION IN QS NOT AFFECTED.
;CALLED ONLY FROM CORE COMMAND
;ASSUMES CALL FOR CURRENT JOB IF EXPANDING HIGH SEG,IE ASSUME AT UUO LEVEL
;THIS IS TRUE SINCE THERE IS NO CORE COMMAND WHICH CAN EXPAND HIGH SEG
;CALL:	MOVE J,[JOB NUMBER]
;	MOVE T1,[HIGHEST LEGAL ADDRESS DESIRED]
;	PUSHJ P,XPAND
;	RETURN, T1 DESTROYED

XPAND::	CAILE	J,JOBMAX##	;IS THIS A LOW SEG?
	TLNN	J,SHRSEG	;SHAREABLE HIGH SEG?
	CAIA			;OK TO CHANGE JBTADR
	JRST	XPAND2		;DON'T CHANGE JBTADR FOR SHR SEG
	SKIPE	R		;DON'T MAKE JBTADR NON-ZERO IF NO CORE IN CORE
	HRLM	T1,JBTADR##(J)	;MAKE JBTADR RIGHT
XPAND2:	ADDI	T1,1		;CONVERT HIGHEST DESIRED ADDRESS
	LSH	T1,W2PLSH	;TO 1K BLOCKS
	CAILE	J,JOBMAX##	;A LOW SEGMENT?
	JRST	XPANDP		;NO, A SHARABLE HIGH SEGMENT, DON'T CHANGE
				; THE WORKING SET
	JUMPE	R,XPAND1	;IF NO CORE, NO WORKING SET TO MAKE RIGHT
	PUSHJ	P,ADJWS##	;TURN ON BITS IN WSBTAB WHICH REPRESENT PAGES
				; BEING ADDED TO THE WORKING SET
XPANDP::LDB	T2,IMGIN##	;CURRENT PHYSICAL SIZE
	MOVEM	T2,JBTIMO##(J)	;STORE AS OUTPUT IMAGE SIZE
XPAND1:	DPB	T1,IMGIN##	;STORE, SO SWAPPER WILL KNOW HOW MUCH CURE
				; TO REQUEST WHEN NEXT SWAPPED IN
;ROUTINE TO FLAG JOB TO BE STOPPED AND SWAPPED OUT
;BECAUSE IT HAS JUST BEEN CONNECTED TO A HIGH SHARABLE SEG WHICH IS ON DISK
;OR ON ITS WAY IN OR OUT.  THE SIZE OF THE HIGH SEG IS UNCHANGED
;THE JOB MUST BE STOPPED UNTIL HIGH SEG SWAPPED IN JUST AS IF JOB HAS
;EXPANDED HIGH SEG (MUST BE CALLED FROM UUO LEVEL FOR CURRENT JOB IF HIGH SEG)
; ALSO CALLED BY MEMORY PARITY ERROR RECOVERY
; IF JOB (LOW OR HIGH SEG) IS LOCKED OR HIGH SEG LOCKED
; NOTHING IS SWAPPED OUT (INCLUDING OTHER JOBS USING HIGH SEG)
;CALL:	MOVE J,HIGH SEG NUMBER
;	PUSHJ P,XPANDH


XPANDH::PUSH	P,J		;SAVE JOB NUMBER
	PUSHJ	P,XPNHGH##	;CHECK IF THIS IS A HIGH SEG EXPANDING
				; IF YES, SCAN OTHER JOBS, CALL XPANDH
				; FOR EACH JOB WHICH IS STILL IN CORE
				; SET JXPN FOR THIS HIGH SEG.  THUS NO JOB
				; WILL BE ABLE TO USE THIS HIGH SEG UNTIL
				; IT IS SWAPPED BACK IN FOR SOME JOB.
				; ALWAYS RETURN JOB NO.
	MOVSI	T2,JXPN		;SET THIS JOB EXPANDING BIT SO IT WILL NOT BE RUN
	TDNE	T2,JBTSTS##(J)	;IS IT ALREADY SET FOR THIS JOB?(UNLIKELY)
	JRST	JPOPJ##		;RESTORE JOB OR HIGH SEG NUMBER (ITEM) AND RETURN
	IORM	T2,JBTSTS##(J)	;NO, SET JOB EXPANDING BIT
	PUSHJ	P,XPNSET	;AND SET BIT MAP ENTRY TOO.
	AOS	XJOB		;AND, INCREMENT COUNT ONLY ONCE FOR EACH JOB EXPANDING
	JRST	IPOPJ##		;RESTORE JOB OR HIGH SEG NUMBER (ITEM) AND RETURN

; SUBROUTINE TO SET/CLEAR ENTRY IN BIT MAP OF EXPANDING JOBS
XPNSET:	SKIPA	T1,[IORM T3,XPNMAP##(T2)]	;SET
XPNCLR:	MOVE	T1,[ANDCAM T3,XPNMAP##(T2)]	;CLEAR
	CAILE	J,JOBMAX##		;LOW SEGMENT?
	POPJ	P,		;NO. NO BIT MAP ENTRY
	PUSH	P,T3		;SAVE A REGISTER
	SETZ	T3,		;AND CLEAR ONE
	MOVE	T2,J		;COPY JOB NUMBER
	LSHC	T2,-5		;DIVIDE BY 32
	ROT	T3,5		;ALLIGN REMAINDER
	MOVE	T3,BITTBL##(T3)	;GET CORRESPONDING BIT
	XCT	T1		;SET/CLEAR BIT IN TABLE
	PJRST	T3POPJ##	;RESTORE T3 AND RETURN
SUBTTL SCHED. UUO

IFN FTNSCHED,<
;SCHED. UUO USED TO SET SCHEDULER PARAMETERS
; CALL:
;	MOVE	AC,[XWD	N,ADDR]
;	SCHED.	AC,		;OR CALLI AC,150
;	  ERROR RETURN
;	GOOD RETURN
;
; THE FORMAT OF ADDR THROUGH ADDR+N-1 IS
;
; ADDR:	XWD FN CODE,BLOCK
;	XWD FN CODE,BLOCK
;		.
;		.
;		.
; WHERE FN CODE IS THE FUNCTION CODE DESIRED. BIT 0 CONTROLS WHETHER
; THE READ PART OR THE WRITE PART OF THE FUNCTION IS SELECTED, A 1 MEANING
; WRITE.
; THE FORMAT OF BLOCK DIFFERS WITH EACH FUNCTION, AND IS DESCRIBED BEFORE
; EACH FUNCTION'S SUBROUTINE.

	SC.WRT==1B0		;WRITE BIT (MUST BE SIGN BIT)

SCHED.::PUSHJ	P,SAVE2##	;SAVE P1
	MOVE	P1,T1		;SAVE C(AC) IN P1
	MOVSI	T1,PVSPYM!PVSPYA ;DOES HE HAVE SPY
	PUSHJ	P,PRVBIT##	;PRIVS?
	   TLOA	P2,PVSPYM	;YES, SAVE IT
	TLZ	P2,PVSPYM	;NO
	MOVSI	T1,JP.POK	;DOES HE HAVE POKE
	PUSHJ	P,PRVBIT##	;PRIVS
	   TLOA	P2,JP.POK	;YES, SAVE IT
	TLZ	P2,JP.POK	;NO
	HLRE	T1,P1		;GET NUMBER OF OPERATIONS
	JUMPLE	T1,CPOPJ1##	;DONE IF ZERO OR NEG.
	MOVNS	T1
	HRL	P1,T1		;-N,,ADDR IS AOBJN POINTER
SCHDU1:	HRR	M,P1		;GET ADDR OF BLOCK
	PUSHJ	P,SCHGET	;GET A FUNCTION
	HRR	M,T1		;GET ADDRESS IN M
	HLRZ	T2,T1		;GET FUNCTION, BITS IN T2
	TRZ	T2,(SC.WRT)	;CLEAR WRITE BIT (MUST BE SIGN BIT)
	CAILE	T2,SCDFMX	;OVER MAXIMUM FUNCTION?
	JRST	SCHFNE		;YES, FUNCTION NUMBER ERROR
	MOVE	T3,SCDDIS(T2)	;ASSUME WRITE OPERATION
	JUMPL	T1,[TLNN P2,JP.POK	;WRITE, WITH POKE?
	              JRST SCHNPE	;NO GIVE ERROR
	            JRST SCHDU2]	;YES, DO THE FUNCTION
	MOVSS	T3		;READ
	TLNN	P2,PVSPYM	;WITH APPROPRIATE PRIVS?
          JRST	SCHNPE		;NO,GIVE ERROR
SCHDU2:	PUSHJ	P,(T3)		;DISPATCH TO ROUTINE
	  POPJ	P,		;ERROR - CODE IS STORED IN USER AC
	AOBJN	P1,SCHDU1	;CONTINUE FOR ALL FUNCTIONS
	JRST	CPOPJ1##	;FINISHED. RETURN SUCCESSFULLY

;DISPATCH TABLE.  LEFT HALF IS ADDRESS OF READ PART OF FUNCTION,
; RIGHT HALF IS ADDRESS OF WRITE PART.

SCDDIS:	XWD	SCHRSI,SCHWSI	;(0)READ/SET MICRO SCHEDULING INTERVAL
	XWD	SCHFNE,SCHFNE	;(1)READ/SET MCU INTERVAL
	XWD	SCHRQT,SCHWQT	;(2)READ/SET CLASS QUOTAS AND FLAGS
	XWD	SCHRTS,SCHWTS	;(3)READ/SET BASE QUANTUM RUN TIME FOR PQ1 AND PQ2
	XWD	SCHFNE,SCHFNE	;(4)READ/SET DCUF
	XWD	SCHRJC,SCHWJC	;(5)READ/SET JOB'S CLASS
	XWD	SCHRMC,SCHWMC	;(6)READ/SET PROT0 (MCU CONSTANT)
	XWD	SCHRCT,SCHFNE	;(7)READ QUOTAS USED FOR EACH CLASS SINCE STARTUP
	XWD	SCHFNE,SCHFNE	;(10)READ/SET EXPONENTIAL FACTOR
	XWD	SCHRPF,SCHWPF	;(11)READ/SET MCU MULTIPLIER (PROT)
	XWD	SCHRCD,SCHWCD	;(12)READ/SET NEW JOBS' DEFAULT CLASS
	XWD	SCHRRC,SCHWRC	;(13)READ/SET MCU REQUEUE CONSTANT (PROT1)
	XWD	SCHRPM,SCHWPM	;(14)READ/SET MCU MAXIMUM (PROTM)
	XWD	SCHRML,SCHWML	;(15)READ/SET QUANTUM MULTIPLIER FOR PQ1 AND PQ2
	XWD	SCHRMX,SCHWMX	;(16)READ/SET QUANTUM MAXIMUM FOR PQ1 AND PQ2
	XWD	SCHRSQ,SCHWSQ	;(17)READ/SET SECONDARY CLASS QUOTAS
	XWD	SCHRIQ,SCHWIQ	;(20)READ/SET JBTJIQ SCAN PERCENTAGE
	XWD	SCHRSS,SCHWSS	;(21)READ/SET SWAP SCAN TIME
	XWD	SCHRBB,SCHWBB	;(22)READ/SET BACKGROUND BATCH QUEUE
	XWD	SCHRBS,SCHWBS	;(23)READ/SET BB SWAP SCAN TIME
	XWD	SCHRSF,SCHWSF	;(24)READ/SET SCHEDULER FAIRNESS FACTOR
	XWD	SCHRSW,SCHWSW	;(25)READ/SET SWAPPER FAIRNESS FACTOR
	XWD	SCHRIO,SCHWIO	;(26)READ/SET INCORE FAIRNESS PERCENTAGE
	XWD	SCHRCS,SCHWCS	;(27)READ/SET CORE SCHEDULING INTERVAL
	XWD	SCHRSO,SCHWSO	;(30)READ/SET SCAN ORDER
	XWD	SCHRSL,SCHWSL	;(31) SEGMENT RETENTION LIMIT
	XWD	SCHRFL,SCHWFL	;(32) FREE CORE GOALS/LIMITS
	SCDFMX==.-SCDDIS-1	;MAXIMUM FUNCTION NUMBER
;ROUTINES TO PERFORM SCHED. UUO FUNCTIONS. CALLED FROM SCHED. UUO
; WITH M SET TO ADDRESS OF BLOCK. THESE ROUTINES PRESERVE P1-P4, USE
; T1,T2,T3,T4

;FUNCTION 0
;READ/SET SCHEDULING INTERVAL
; READ FUNCTION RETURNS INTERVAL VALUE AT LOCATION BLOCK
; FORMAT OF ARGUMENT BLOCK ON WRITE:
;
; BLOCK:	<DESIRED VALUE>

SCHRSI:	MOVE	T1,SCDINT##	;GET INTERVAL
SCHPVL:	PUSHJ	P,PUTWRD##	;SEND TO USER
	  JRST	SCHAER		;ADDRESS PROBLEM...
	JRST	CPOPJ1##	;OK

SCHWSI:	PUSHJ	P,SCHGET	;GET ARGUMENT FROM ADDRESS IN M
	MOVEM	T1,SCDINT##	;USE AS SCHEDULING INTERVAL
	SETZM	SCDTIM##	;FORCE NEW SCHEDULING INTERVAL
	JUMPG	T1,CPOPJ1##	;LEAVE RRFLAG ALONE IF THERE IS AN INTERVAL
	SETZM	RRFLAG##	;USE ROUND ROBIN IF NO INTERVAL
	AOS	(P)		;ADVANCE RETURN
;;	PJRST	SCHCLR		;FALL THRU TO SCHCLR

;ROUTINE TO CLEAR TABLE OF CLASS RUNTIMES
SCHCLR:	SETZM	SCDTIM##	;FORCE A NEW INTERVAL
	MOVE	T3,DATE##	;USE UNIVERSAL DATE/TIME
	MOVEM	T3,SCDSTS##	; AS TIME OF LAST INITIALIZATION
	SKIPN	RRFLAG##	;CLASS SCHEDULING?
	SETZ	T3,		;NO, STORE ZERO INSTEAD
	MOVEM	T3,SCDSET##	;SAVE FOR GETTAB
	MOVE	T1,[CLSRTM##,,CLSRTM##+1] ;SET TO CLEAR
	SYSPIF			;PREVENT RACES
	SETZM	CLSRTM##	;FIRST WORD
	BLT	T1,CLSRTM##+M.CLSN##-1 ; THEN THE FIRST
	SETZM	RTCTOT##	;CLEAR TOTAL
	JRST	ONPOPJ##	;ALLOW INTERRUPTS AND RETURN

;FUNCTION 2
;
;HERE TO READ CLASS QUOTAS
; ARGUMENT BLOCK SETUP FOR READ CLASS QUOTA FUNCTION:
;
; BLOCK:	N		;NUMBER OF CLASSES TO READ QUOTAS OF
; BLOCK+1:			;QUOTA AND BITS OF CLASS 0 RETURNED HERE
; BLOCK+2:			;QUOTA AND BITS OF CLASS 1 RETURNED HERE
;		.
; BLOCK+N:			;QUOTA AND BITS OF CLASS N-1 RETURNED HERE
;

SCHRQT:	PUSHJ	P,SCHGET	;GET NUMBER OF CLASSES TO RETURN
	SKIPLE	T1		;TOO LOW OR
	CAILE	T1,M.CLSN##	;TOO HIGH?
	JRST	SCHCLE		;YES, TELL HIM SO
	MOVN	T4,T1		;GET AN AOBJN POINTER
	HRLZS	T4
SCHRQ1:	MOVE	T1,CLSSTS##(T4)	;GET QUOTA, BITS FOR CLASS
	JSP	T2,SCHBLK	;STORE WORD
	JRST	SCHRQ1		;LOOP FOR MORE

;HERE TO SET QUOTAS FOR CLASS
;
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD <BITS>+CLASS,QUOTA
; BLOCK+2:	XWD <BITS>+CLASS,QUOTA
;		.
; BLOCK+N:	XWD <BITS>+CLASS,QUOTA
;

SCHWQT:	PUSHJ	P,SCHGET	;GET NUMBER OF ARGS
	JUMPLE	T1,CPOPJ1##	;DONE IF LE ZERO
	MOVE	T4,T1		;SAVE IN T4
SCHWQ1:	PUSHJ	P,SCHGT1	;GET ARG
	LDB	T3,[POINT 5,T1,17] ;GET CLASS
	CAIL	T3,M.CLSN##	;TOO HIGH?
	JRST	SCHCLE		;YES, REPORT IT.
	TLZ	T1,(JS.CLS)	;CLEAR CLASS PART OF ARG
	MOVEM	T1,CLSSTS##(T3)	;JUST SAVE QUOTA AND BITS
	SOJG	T4,SCHWQ1	;AND LOOP UNTIL DONE.
	PUSHJ	P,SCHCLR
	SETZB	T3,TOTSTS##	;INIT COUNT AND TOTAL OF NON-ZERO CLASSES
	MOVEI	T2,M.CLSN##-1	;LOOP COUNTER
SCHWQ2:	HRRZ	T1,CLSSTS##(T2)	;GET QUOTA
	JUMPE	T1,SCHWQ3	;JUMP IF NO QUOTA
	ADDM	T1,TOTSTS##	;ADD UP QUOTAS
	HRRZM	T2,SQSCAN##(T3)	;STORE 0,,CLASS NUMBER IN TABLE
	AOJ	T3,		;COUNT UP NON-ZERO CLASSES
SCHWQ3:	SOJGE	T2,SCHWQ2	;LOOP OVER ALL CLASSES
	MOVEM	T3,CNTSTS##	;STORE COUNT OF NON-ZERO CLASSES
	JUMPG	T3,SCHWQ4	;LEAVE RRFLAG ALONE IF THERE ARE ANY CLASSES
	SETZM	RRFLAG##	;USE ROUND ROBIN IF NO CLASSES EXIST
	SETZM	SCDSET##	;ZERO FOR NOT CLASS SCHEDULING
	JRST	CPOPJ1##	;GOOD RETURN.
SCHWQ4:	MOVEI	T1,^D100	;REQUIRE PRIMARY TABLE TO ADD TO 100%
	CAMN	T1,TOTSTS##	;IS IT?
	JRST	SCHWQ5		;YES
	SETZM	RRFLAG##	;NO, DO NOT CLASS SCHEDULE
	SETZM	CNTSTS##	;MAKE IT LOOK LIKE NO CLASSES EXIST
	SETZM	SCDSET##
	JRST	SCHNHP		;NOT HUNDRED PERCENT
SCHWQ5:	PUSHJ	P,SAVE2##	;FREE 2 ACS
	MOVE	T4,[POINT 5,PSQTAB##] ;POINTER TO PRIMARY SCAN TABLE
SCHWQ6:	MOVE	T3,CNTSTS##	;NUMBER OF NON-ZERO CLASSES
	SETZ	P1,		;POINTER TO MAX ENTRY FOUND SO FAR
	MOVSI	P2,400000	;SET MAX TO SMALLEST POSSIBLE INTEGER
	SOJLE	T3,SCHWQ9	;JUMP IF ONLY ONE CLASS
SCHWQ7:	MOVE	T2,SQSCAN##(T3)	;GET NEXT ENTRY'S PRIORITY
	HRR	T2,CLSSTS##(T2)	;APPEND QUOTA
	HRLZ	T1,T2		;ADD QUTOA
	ADD	T2,T1		;TO PRIORITY
	HLLM	T2,SQSCAN##(T3)	;MAKING HIM MORE LIKELY TO BE PICKED
	IMULI	T2,(T2)		;WEIGHT PRIORITY WITH QUOTA
	CAMG	T2,P2		;GREATER THAN CURRENT MAX?
	JRST	SCHWQ8		;NO
	MOVE	P2,T2		;SAVE MAX
	MOVEI	P1,(T3)		;SAVE POINTER
SCHWQ8:	SOJGE	T3,SCHWQ7	;UPDATE NEXT ENTRY
SCHWQ9:	MOVE	T1,SQSCAN##(P1)	;GET THE ENTRY WE PICKED
	IDPB	T1,T4		;STORE HIS CLASS IN PRIMARY SCAN TABLE
	SUB	T1,[^D100,,0]	;HE GOT HIS SHARE
	HLLM	T1,SQSCAN##(P1)	;SO MAKE HIM LESS LIKELY TO BE CHOSEN
	SOSLE	TOTSTS##	;DONE THIS 100 TIMES?
	JRST	SCHWQ6		;NO, DO SOME MORE
	LDB	T1,[POINT 5,PSQTAB##,4] ;GET FIRST BYTE
	DPB	T1,[POINT 5,PSQTAB##+^D14,14] ;STORE IN BYTE 101 FOR CPU1
	JRST	CPOPJ1##	;GOOD RETURN
;FUNCTION 3
;
;HERE TO READ TIME SLICES FOR EITHER PQ1 OR PQ2
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF QUEUES TO READ TIME SLICES FOR
;				;(CAN ONLY BE 1 OR 2)
; BLOCK+1:			;TIME SLICE FOR PQ1 RETURNED HERE
; BLOCK+2:			;TIME SLICE FOR PQ2 RETURNED HERE
;				;(IF N WAS BIG ENOUGH)
;

SCHRTS:	PUSHJ	P,SCHGET	;GET N
	MOVEI	T4,QADTAB##	;ADDRESS WHERE DATA IS STORED
	;PJRST	SCHRTB		;READ THE TABLE

SCHRTB:	CAIG	T1,2		;LEGAL ARG?
SCHRTC:	SKIPG	T1
	JRST	SCHQNE		;NO
SCHRTD:	MOVN	T1,T1
	HRL	T4,T1		;AOBJN POINTER
SCHRT1:	MOVE	T1,(T4)		;GET SLICE
	IMULI	T1,^D1000	;MILLITICKS
	IDIV	T1,TICSEC##	;CONVERT TO MILLISECS
	JSP	T2,SCHBLK
	JRST	SCHRT1


;HERE TO WRITE TIME SLICES FOR PQ1 OR PQ2
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD Q#,TIME SLICE(MS)
; BLOCK+2:	XWD Q#,TIME SLICE(MS)
;		.
; BLOCK+N:	XWD Q#,TIME SLICE
;

SCHWTS:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##	;DONE IF LE ZERO
	MOVE	T4,T1		;COPY N
SCHWT1:	PUSHJ	P,SCHGT1	;GET ARG
	MOVE	T2,TICSEC##	;GET JIFSEC
	IMULI	T2,(T1)		;GET MILLITICS IN T2
	IDIVI	T2,^D1000	;CONVERT TO TICKS (ARG WAS IN MS)
	HLRZ	T3,T1		;GET Q NUMBER
	SKIPE	T3		;ZERO IS NOT LEGAL
	CAILE	T3,2		;LEGAL?
	JRST	SCHQNE		;NO, Q NUMBER ERROR
	MOVEM	T2,QADTAB##-1(T3);SAVE
	SOJG	T4,SCHWT1	;AND LOOP
	JRST	CPOPJ1##	;FINISHED.
;FUNCTION 5
;
;HERE TO READ CLASS NUMBERS FOR ALL JOBS ON THE SYSTEM UP TO
; THE NUMBER IN ADDRESS
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OFJOBS TO READ CLASS FOR
; BLOCK+1:			;RETURN CLASS OF JOB 1 HERE
; BLOCK+2:			;RETURN CLASS OF JOB 2 HERE
;		.
; BLOCK+N:			;RETURN CLASS OF JOB N HERE
;

SCHRJC:	PUSHJ	P,SCHGET	;GET NUMBER OF JOBS TO DO
	PUSHJ	P,LGLPRC##	;IS THIS A LEGAL JOB NUMBER?
	  JRST	SCHBJN		;NO
	MOVN	T4,T1
	HRLZS	T4
	AOS	T4		;START WITH JOB 1
SCHRJ1:	LDB	T1,JBYCL4##	;GET CLASS
	JSP	T2,SCHBLK
	JRST	SCHRJ1
;HERE TO PUT A JOB INTO A CPU CLASS
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD JOB,CLASS
; BLOCK+2:	XWD JOB,CLASS
;		.
; BLOCK+N:	XWD JOB,CLASS
;

SCHWJC:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##	;RETURN IF NO WORK TO DO
	MOVE	T4,T1		;COPY N
SCHWJ1:	PUSHJ	P,SCHGT1	;
	HRRZ	T2,T1		;SAVE CLASS NUMBER IN T2
	HLRZS	T1		;GET JOB NUMBER IN RHOF T1 FOR LGLPRC
	CAIN	T1,-1		;US?
	MOVE	T1,J		;YES, USE OUR JOB NUMBER
	PUSHJ	P,LGLPRC##	;LEGAL JOB NUMBER?
	  JRST	SCHBJN		;NO
	MOVSI	T3,JNA
	TDNN	T3,JBTSTS##(T1)
	  JRST	SCHWJ3		;NO GOOD IF JOB NOT ASSIGNED
	CAIL	T2,M.CLSN##	;BAD CLASS NUMBER?
	JRST	SCHCLE		;YES.
	DPB	T2,JBYCL1##	;DEPOSIT
	SKIPL	JBTSCD##(T1)	;IS JOB IN PQ2?
	JRST	SCHWJ3		;NOT IN PQ2
	MOVSI	T2,(JS.CSQ)	;JOB IS CHANGING SUB QUEUE
	IORM	T2,JBTST2##(T1)	;SET BIT FOR THE JOB
	CAMN	T1,.CPJOB##	;IS THIS JOB US?
	JRST	SCHWJ2		;YES
	PUSH	P,J		;SAVE OUR JOB NUMBER
	MOVE	J,T1		;GET TARGET JOB IN J
	PUSHJ	P,REQUE##	;REQUEUE HIM SO HE WILL WIND UP IN PROPER SUBQUE
	POP	P,J
	JRST	SCHWJ3		;GO ON
SCHWJ2:	SYSPIF			;PREVENT RACES
	SKIPN	SCDRTF##	;ALREADY REAL TIME REQUEST IN?
	HRROS	SCDRTF##	;SEMI-PREEMPTIVE RESCHEDULE
	SYSPIN			;EXIT RACE WINDOW
	SETOM	.CPHQU##	;REQUEST A REQUEUE
SCHWJ3:	SOJG	T4,SCHWJ1	;AND LOOP FOR NEXT SPEC.
	JRST	CPOPJ1
;FUNCTION 6
;
;HERE TO READ MCU CONSTANT (PROT0)
; FORMAT OF BLOCK
;
; BLOCK:			;PROT0 RETURNED HERE
;

SCHRMC:	MOVE	T1,PROT0##
	PJRST	SCHPVL		;STORE VALUE IN USERS AREA AND RETURN

;HERE TO WRITE MCU CONSTANT (PROT0)
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF PROT0>

SCHWMC:	PUSHJ	P,SCHGET
	MOVEM	T1,PROT0##
	JRST	CPOPJ1

;FUNCTION 7
;
;HERE TO READ TIME SINCE SYSTEM STARTUP EACH CLASS HAS USED.
; FORMAT OF BLOCK
;
; BLOCK:	N		;NUMBER OF CLASSES TO READ RUNTIMES FOR
; BLOCK+1:			;CLASS 0 RUNTIME RETURNED HERE
; BLOCK+2:			;CLASS 1 RUNTIME RETURNED HERE
;		.
; BLOCK+N:			;CLASS N-1 RUNTIME RETURNED HERE
;

SCHRCT:	PUSHJ	P,SCHGET
	SKIPLE	T1		;BOMB IF OUT OF RANGE
	CAILE	T1,M.CLSN##
	JRST	SCHCLE
	MOVN	T4,T1
	HRLZS	T4
SCHRC1:	MOVE	T1,CLSRTM##(T4)	;GET TIME
	JSP	T2,SCHBLK
	JRST	SCHRC1

;FUNCTION 11
;
;HERE TO READ VALUE OF PROT (MCU MULTIPLIER)
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN VALUE HERE
;

SCHRPF:	MOVE	T1,PROT##	;GET DESIRED VALUE
	PJRST	SCHPVL		;STORE AND RETURN


;HERE TO WRITE PROT
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF PROT>

SCHWPF:	PUSHJ	P,SCHGET	;GET DESIRED VALUE
	MOVEM	T1,PROT##	;SAVE DESIRED VALUE (IN MICROSECS)
	PJRST	CPOPJ1##	;AND RETURN WELL.
;FUNCTION 12
;
;HERE TO READ VALUE OF DEFAULT CLASS FOR NEW JOBS
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN VALUE HERE
;

SCHRCD:	MOVE	T1,DEFCLS##	;GET DEFAULT CLASS
	ANDI	T1,37		;JUST CLASS BITS, NO OTHER GARBAGE
	PJRST	SCHPVL		;STORE VALUE AND RETURN

;HERE TO WRITE THE DEFAULT CLASS OF NEW JOBS
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF DEFAULT CLASS, BITS 31-35>
;

SCHWCD:	PUSHJ	P,SCHGET	;GET ARG
	CAIL	T1,M.CLSN##	;IS IT A LEGAL CLASS?
	JRST	SCHCLE		;NO, GIVE ILLEGAL CLASS NUMBER ERROR
	MOVEM	T1,DEFCLS##	;STORE
	PJRST	CPOPJ1##	;AND GIVE GOOD RETURN
;FUNCTION 13
;
;HERE TO READ VALUE OF PROT1 (MCU REQUEUE CONSTANT)
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN VALUE OF PROT1 HERE
;

SCHRRC:	MOVE	T1,PROT1##	;GET DESIRED VALUE
	IMUL	T1,[^D1000000]	;CONVERT TO MICROTICKS
	IDIV	T1,TICSEC##	;THEN TO MICROSECONDS
	PJRST	SCHPVL		;STORE AND RETURN


;HERE TO WRITE MCU REQUEUE CONSTANT
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF PROT1 IN MICROSECONDS>

SCHWRC:	PUSHJ	P,SCHGET	;GET DESIRED VALUE
	IMUL	T1,TICSEC##	;CONVERT TO MICROTICKS
	IDIV	T1,[^D1000000]	;THEN TO TICKS
	MOVEM	T1,PROT1##	;SAVE DESIRED VALUE OF PROT1
	PJRST	CPOPJ1##	;AND RETURN WELL.
;FUNCTION 14
;
;HERE TO READ VALUE OF PROTM (MCU MAXIMUM)
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN VALUE HERE
;

SCHRPM:	MOVE	T1,PROTM##	;GET DESIRED VALUE
	PJRST	SCHPVL		;STORE AND RETURN


;HERE TO WRITE PROTM
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF PROTM>

SCHWPM:	PUSHJ	P,SCHGET	;GET DESIRED VALUE
	MOVEM	T1,PROTM##	;SAVE DESIRED VALUE (IN MICROSECS)
	PJRST	CPOPJ1##	;AND RETURN WELL.
;FUNCTION 15
;
;HERE TO READ QUANTUM MULTIPLIERS FOR EITHER PQ1 OR PQ2
;AND TO READ SCALE FACTOR
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF QUEUES TO READ MULTIPLIERS FOR
				;(MUST BE 1-3)
; BLOCK+1:			;QUANTUM MULTIPLIER FOR PQ1 RETURNED HERE
; BLOCK+2:			;QUANTUM MULTIPLIER FOR PQ2 RETURNED HERE
;				;(IF N BIG ENOUGH)
; BLOCK+3:			;SCALE FACTOR FOR QUANTUM MULTIPLIERS RETURNED HERE
;				;(IF N BIG ENOUGH)
;

SCHRML:	PUSHJ	P,SCHGET	;GET N
	MOVEI	T4,QMLTAB##	;WHERE TO FIND THE DATA
	CAIGE	T1,3		;MULTIPLIERS ONLY?
	PJRST	SCHRTC		;YES, GO GET THEM
	CAIE	T1,3		;LEGAL?
	JRST	SCHQNE		;NO
	MOVE	T1,QRANGE##	;GET SCALE FACTOR
	ADDI	M,3		;ADVANCE POINTER TO PROPER LOCATION
	PUSHJ	P,PUTWRD##	;STORE IT
	  JRST	SCHAER		;ADDRESS PROBLEM
	SUBI	M,3		;RESTORE POINTER
	MOVEI	T1,2		;SETUP FOR 2 ARGS
	PJRST	SCHRTD		;DO THE REST OF THE TABLE

;HERE TO WRITE QUANTUM MULTIPLIERS FOR EITHER PQ1 OR PQ2
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD Q#,MULTIPLIER(MS)
; BLOCK+2:	XWD Q#,MULTIPLIER(MS)
; BLOCK+N:	XWD 3,QRANGE

SCHWML:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##	;RETURN IF ZERO
	MOVE	T4,T1		;COPY N
SCHWM1:	PUSHJ	P,SCHGT1	;GET ARG
	HLRZ	T3,T1		;Q NUMBER
	JUMPE	T3,SCHQNE	;ZERO IS NOT ALLOWED
	CAILE	T3,2		;LEGAL?
	JRST	SCHWM3		;PROBABLY NOT
	HRRZ	T1,T1		;CLEAR LEFT HALF
	IMUL	T1,TICSEC##	;MILLITICS
	IDIVI	T1,^D1000	;TICS
	MOVEM	T1,QMLTAB##-1(T3) ;STORE IT
SCHWM2:	SOJG	T4,SCHWM1	;GET NEXT ARG
	JRST	CPOPJ1##	;GIVE GOOD RETURN
SCHWM3:	CAIE	T3,3		;LEGAL?
	JRST	SCHQNE		;NO
	HRRZM	T1,QRANGE##	;YES STORE THE SCALE FACTOR
	JRST	SCHWM2		;AND PROCEED
;FUNCTION 16
;
;HERE TO READ QUANTUM MAXIMA FOR EITHER PQ1 OR PQ2
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF QUEUES TO READ MAXIMA FOR
;				;(CAN BE 1 OR 2)
; BLOCK+1:			;MAXIMUM QUANTUM RUN FOR PQ1 RETURNED HERE
; BLOCK+2:			;MAXIMUM QUANTUM RUN FOR PQ2 RETURNED HERE
;				;(IF N BIG ENUF)
;

SCHRMX:	PUSHJ	P,SCHGET	;GET N
	MOVEI	T4,QMXTAB##	;QUANTUM MAX TABLE
	PJRST	SCHRTB		;GO READ THE TABLE

;HERE TO WRITE QUANTUM MAXIMA FOR EITHER PQ1 OR PQ2
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD Q#,MAX TIME SLICE(MS)
; BLOCK+2:	XWD Q#,MAX TIME SLICE(MS)
;
; BLOCK+N:	XWD Q#,MAX TIME SLICE(MS)
;

SCHWMX:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##	;RETURN IF ZERO
	MOVE	T4,T1		;COPY N
SCHWX1:	PUSHJ	P,SCHGT1	;GET ARG
	MOVE	T2,TICSEC##	;GET JIFSEC
	IMULI	T2,(T1)		;MILLITICS
	IDIVI	T2,^D1000	;TICS
	HLRZ	T3,T1		;Q NUMBER
	SKIPE	T3		;ZERO IS NOT ALLOWED
	CAILE	T3,2		;LEGAL?
	JRST	SCHQNE		;Q NUMBER ERROR
	MOVEM	T2,QMXTAB##-1(T3) ;STORE IT
	SOJG	T4,SCHWX1	;GET NEXT ARG
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;FUNCTION 17
;
;HERE TO READ SECONDARY CLASS QUOTAS
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER FOR CLASSES TO READ QUOTAS OF
; BLOCK+1:			;SECONDARY QUOTA OF CLASS 0 RETURNED HERE
; BLOCK+2:			;SECONDARY QUOTA OF CLASS 1 RETURNED HERE
;
; BLOCK+N:			;SECONDARY QUOTA OF CLASS N-1 RETURNED HERE
;

SCHRSQ:	PUSHJ	P,SCHGET	;GET NUMBER OF CLASSES TO RETURN
	SKIPLE	T1		;TOO LOW OR
	CAILE	T1,M.CLSN##	;TOO HIGH?
	JRST	SCHCLE		;YES, TELL HIM SO
	MOVN	T4,T1		;GET AN AOBJN POINTER
	HRLZS	T4
SCHRS1:	MOVE	T1,CLSQTA##(T4)	;GET QUOTA
	JSP	T2,SCHBLK	;STORE WORD
	JRST	SCHRS1		;LOOP FOR MORE

;HERE TO SET SECONDARY QUOTAS FOR CLASS
;
; FORMAT OF BLOCK:
;
; BLOCK:	N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD CLASS,QUOTA
; BLOCK+2:	XWD CLASS,QUOTA
;
; BLOCK+N:	XWD CLASS,QUOTA

SCHWSQ:	PUSHJ	P,SCHGET	;GET NUMBER OF ARGS
	JUMPLE	T1,SCHWS2	;DONE IF LE ZERO
	MOVE	T4,T1		;SAVE IN T4
SCHWS1:	PUSHJ	P,SCHGT1	;GET ARG
	LDB	T3,[POINT 5,T1,17] ;GET CLASS
	CAIL	T3,M.CLSN##	;TOO HIGH?
	JRST	SCHCLE		;YES, REPORT IT.
	HRRZM	T1,CLSQTA##(T3)	;SAVE SECONDARY QUOTA
	SOJG	T4,SCHWS1	;AND LOOP UNTIL DONE.
SCHWS2:	SETZB	T1,CNTQTA##	;ZERO MAX CLASS, COUNT OF CLASSES
	SETZM	TOTQTA##	;ZERO TOTAL OF ALL CLASSES QTA
	MOVEI	T4,M.CLSN##-1	;HIGHEST LEGAL CLASS
SCHWS3:	SKIPG	T2,CLSQTA##(T4)	;ANY SECONDARY QUTOTA?
	JRST	SCHWS4		;NO
	AOS	CNTQTA##	;BUMP COUNT OF CLASSES WITH QTA
	ADDM	T2,TOTQTA##	;ADD TO TOTAL OF ALL CLASSES
	JUMPG	T1,SCHWS4	;JUMP IF ALREADY FOUND HIGHEST NON-ZERO CLASS
	MOVE	T1,T4		;ELSE SAVE HIGHEST CLASS
SCHWS4:	SOJGE	T4,SCHWS3	;REPEAT FOR ALL CLASSES
	MOVEM	T1,MAXQTA##	;STORE CLASS NUMBER OF TOP CLASS WITH QTA
	JRST	CPOPJ1##	;RETURN
;FUNCTION 20
;
;HERE TO READ SCDJIL
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN PERCENTAGE HERE
;

SCHRIQ:	MOVE	T1,SCDJIL##	;LOAD PERCENT TO SCAN JBTJIQ
	PJRST	SCHPVL		;GIVE GOOD RETURN


;HERE TO WRITE SCDJIL
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED PERCENTAGE TO SCAN JBTJIQ>

SCHWIQ:	PUSHJ	P,SCHGET	;GET VALUE
	JUMPLE	T1,SCHFNP	;MUST BE POSITIVE TO GUARANTEE CLEARING OF CORE
	CAILE	T1,^D100	;MAX OF 100%
	MOVEI	T1,^D100
	MOVEM	T1,SCDJIL##	;SAVE NEW VALUE
	PJRST	CPOPJ1##	;RETURN
;FUNCTION 21
;
;HERE TO READ SWAP SCAN TIME
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN SWAP SCAN TIME HERE
;

SCHRSS:	MOVE	T1,SCDSWP##	;HOW LONG TO SCAN SAME SUBQUEUE FOR SWAP IN
	PJRST	SCHPVL		;PUBLISH VALUE


;HERE TO WRITE SCDSWP
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF SWAP SCAN TIME>

SCHWSS:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	MOVEM	T1,SCDSWP##	;STORE IT
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;FUNCTION 22
;
;HERE TO READ BACKGROUND BATCH SUBQUEUE NUMBER
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN BACKGROUND BATCH SUBQUEUE HERE
;

SCHRBB:	MOVE	T1,BBSUBQ##	;BACKGROUND BATCH SUBQUEUE
	PJRST	SCHPVL		;PUBLISH RESULTS


;HERE TO WRITE BBSUBQ
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED SUBQUEUE FOR BACKGROUND BATCH>

SCHWBB:	PUSHJ	P,SCHGET	;GET DESIRED VALUE
	CAIL	T1,M.CLSN##	;TOO BIG?
	JRST	SCHCLE		;YES
	SKIPGE	T1		;NO BACKGROUND BATCH?
	SETO	T1,		;YES USE -1 FOR FLAG
	MOVEM	T1,BBSUBQ##	;STORE NEW B B QUEUE NUMBER
	JRST	CPOPJ1##	;RETURN
;FUNCTION 23
;
;HERE TO READ BACKGROUND BATCH SWAP TIME INTERVAL
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN BB SWAP TIME HERE
;

SCHRBS:	MOVE	T1,SCDBBS##	;BB SWAP SCAN TIME INTERVAL
	PJRST	SCHPVL		;TELL USER THE VALUE (IN TICKS)


;HERE TO WRITE SCDBBS
;
; FORMAT OF BLOCK:
; BLOCK:	<DESIRED # OF TICKS BETWEEN BB SWAPINS>

SCHWBS:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	MOVEM	T1,SCDBBS##	;STORE FOR SWAPPER
	JRST	CPOPJ1##	;GOOD RETURN
;FUNCTION 24
;
;HERE TO READ SCHEDULER FAIRNESS FACTOR
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN SCHEDULER FAIRNESS FACTOR HERE
;

SCHRSF:	MOVE	T1,.CPSCN##	;SCAN TABLE
	MOVE	T1,MFC##(T1)	;MAXIMUM FAIRNESS COUNT
	PJRST	SCHPVL		;PUBLISH VALUE


;HERE TO WRITE MFC
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF SCHEDULER FAIRNESS FACTOR>

SCHWSF:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	JUMPLE	T1,SCHFNP	;MUST BE POSITIVE
	MOVE	T2,.CPSCN##	;SCAN TABLE FOR CPU0
	MOVEM	T1,MFC##(T2)	;STORE MAX FAIRNESS COUNT
IFN FTMP,<
	MOVE	T2,SSCN##(T2)	;ADDRESS OF SECOND SCAN TABLE
	MOVEM	T1,MFC##(T2)	;MAX FAIRNESS COUNT FOR CPU1
>
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;FUNCTION 25
;
;HERE TO READ SWAPPER FAIRNESS FACTOR
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN SWAPPER FAIRNESS FACTOR HERE
;

SCHRSW:	MOVE	T1,MAXIFC	;MAXIMUM INPUT FAIRNESS COUNT
	PJRST	SCHPVL		;PUBLISH VALUE


;HERE TO WRITE MAXIFC
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF SWAPPER FAIRNESS FACTOR>

SCHWSW:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	JUMPLE	T1,SCHFNP	;MUST BE POSITIVE
	MOVEM	T1,MAXIFC	;STORE IT
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;FUNCTION 26
;
;HERE TO READ SWAP FAIRNESS PERCENTAGE FOR IN-CORE VS OUT-CORE
;
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN INCORE FAIRNESS HERE
;

SCHRIO:	MOVE	T1,SCDIOF##	;PERCENT TO SCAN IN-CORE QUEUES FIRST
	PJRST	SCHPVL		;PUBLISH VALUE


;HERE TO WRITE SCDIOF
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF INCORE FAIRNESS>

SCHWIO:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	JUMPLE	T1,SCHFNP	;MUST BE AT LEAST ONE PERCENT
	MOVEM	T1,SCDIOF##	;STORE IT
	JRST	CPOPJ1##	;GIVE GOOD RETURN

;FUNCTION 27
;
;HERE TO READ CORE SCHEDULING TIME INTERVAL (SCDCOR)
;
; FORMAT OF BLOCK:		;RETURN CORE SCHEDULING TIME HERE
;
SCHRCS:	MOVE	T1,SCDCOR##	;CORE SCHEDULING TIME IN TICK PAIRS
	ASH	T1,1		;CONVERT TO TICKS
	IDIV	T1,TICSEC##	;CONVERT TO SECONDS
	PJRST	SCHPVL		;PUBLISH VALUE


;HERE TO WRITE SCDCOR
;
; FORMAT OF BLOCK:
;
; BLOCK:	<DESIRED VALUE OF CORE SCHEDULING INTERVAL IN SECONDS>
SCHWCS:	PUSHJ	P,SCHGET	;GET VALUE FROM USER
	JUMPLE	T1,SCHFNP	;MUST BE POSITIVE
	IMUL	T1,TICSEC##	;CHANGE TO TICKS
	ASH	T1,-1		; THEN TO TICK PAIRS
	MOVEM	T1,SCDCOR##	;STORE IT
	JRST	CPOPJ1##	;GIVE GOOD RETURN
	MOVEM	T1,CORSCD	; SET COUNTER ALSO
;FUNCTION 30
;
;HERE TO READ QUEUE SCAN ORDER
;
; FORMAT OF BLOCK
;
; BLOCK: N		;NUMBER OF WORDS FOLLOWING
; BLOCK+1:		;RETURN SCAN ORDER FOR CPU0
;        .
; BLOCK+N		;RETURN SCAN ORDER FOR CPU-1

SCHRSO:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##
	MOVN	T4,T1
	HRLZS	T4
	PUSHJ	P,SAVE1##
	MOVEI	P1,.C0CDB##	;FIRST CDB
SCHRO1: MOVE	T2,.CPSCN##-.CPCDB##(P1)
	SETZ	T1,
	CAME	T2,CPSCAN##(T1)	;FIND SCAN TABLE
	AOJA	T1,.-1
	JSP	T2,SCHBLK	;STORE ANSWER
	HLRZ	P1,.CPCDB##-.CPCDB##(P1)
	JUMPN	P1,SCHRO1	;LOOK AT NEXT CDB
	JRST	CPOPJ1##

;HERE TO WRITE SCAN TABLE
;
; FORMAT OF BLOCK
;
; BLOCK:	N	;NUMBER OF WORDS FOLLOWING
; BLOCK+1:	XWD	CPU#,SCAN BLOCK NUMBER
;
; BLOCK+N	XWD	CPU#,SCAN BLOCK NUMBER

SCHWSO:	PUSHJ	P,SCHGET	;GET N
	JUMPLE	T1,CPOPJ1##
	PUSHJ	P,SAVE1##
	MOVE	P1,T1
SCHWO1:	PUSHJ	P,SCHGT1
	HLRZ	T2,T1
	CAILE	T2,M.CPU##-1
	JRST	SCHICP
	HRRZS	T1
	CAIG	T1,CPSTBL##
	SKIPN	T1,CPSCAN##(T1)
	JRST	SCHISB
	IMULI	T2,.CPLEN##
	MOVEM	T1,.C0SCN##(T2)
	SOJG	P1,SCHWO1
	JRST	CPOPJ1##


;HERE TO COMPUTE THE SUB QUEUE SCHEDULING TABLES FOR CPU0
;FUNCTION 31
;
;HERE TO READ SEGMENT RETENTION LIMIT (SGTLIM)
;
; FORMAT OF BLOCK:		;RETURN SEGMENT RETENTION LIMIT HERE (IN TICKS)
;
SCHRSL:	MOVE	T1,SGTLIM	; GET SEGMENT RETENTION LIMIT
	PJRST	SCHPVL		; PUBLISH VALUE


;HERE TO WRITE SGTLIM
;
; FORMAT OF BLOCK:
;
; BLOCK:		<DESIRED VALUE OF SEGMENT RETENTION LIMIT IN TICKS>
SCHWSL:	PUSHJ	P,SCHGET	; GET VALUE FROM USER
	MOVEM	T1,SGTLIM	; STORE IT
	JRST	CPOPJ1##	; AND GIVE GOOD RETURN


;FUNCTION 32
;
;HERE TO READ FREE CORE LIMITS/GOALS
; FORMAT OF BLOCK:
;
; BLOCK:			;RETURN "MINIMUM FREE CORE" GOAL HERE
; BLOCK+1/			;RETURN "FREE/DORMANT CORE" LIMIT HERE
;
SCHRFL:	MOVE	T1,FREMI%	; GET VALUE
	PUSHJ	P,PUTWRD##	; RETURN IT TO USER
	JRST	SCHAER		; OOPS
	MOVE	T1,MAXTA%	; GET OTHER VALUE
	PUSHJ	P,PUTWR1##	; RETURN THAT TOO
	JRST	SCHAER		; OOPS
	JRST	CPOPJ1##	; DONE. GOOD

;HERE TO SET FREE CORE GOALS/LIMITS
;
; FORMAT OF BLOCK:
;
; BLOCK/	<DESIRED VALUE OF "MINIMUM FREE CORE" GOAL>
; BLOCK+1/	<DESIRED VALUE OF "FREE/DORMANT CORE" LIMIT>

SCHWFL:	PUSHJ	P,SCHGET	; GET VALUE FROM USER
	PUSHJ	P,SCHGPG	;CONVERT TO PAGES
	MOVEM	T1,FREMI%	;STORE PERCENTAGE
	MOVEM	T2,FREMIN	;AND VALUE
	PUSHJ	P,SCHGT1	; AND SECOND VALUE
	PUSHJ	P,SCHGPG	;CONVERT TO PAGES
	MOVEM	T1,MAXTA%	;STORE PERCENTAGE
	MOVEM	T2,MAXTAL	;AND VALUE
	JRST	CPOPJ1##	; DONE. GOOD

;SUBROUTINE TO COMPUTE NUMBER OF PAGES OF USER CORE GOAL BASED ON USER
;SUPPLIED PERCENTAGES. ENTER T1= PERCENTAGE, EXIT T1= PERCENTAGE, T2= VALUE

SCHGPG:	SKIPLE	T1		;IF HE DOESN'T KNOW WHAT S(HE) ITS DOING,
	CAILE	T1,^D100
	MOVEI	T1,0		;SET IT TO ZERO WHICH CAN'T CAUSE ANY HARM
	MOVE	T2,T1		;VALUE
	IMUL	T2,USRCOR##	;CONVERT TO PERCENTAGE OF PAGES
	IDIVI	T2,^D100	
	POPJ	P,

;GET A WORD FROM USER (ERROR CODE 1 IF BAD ADDRESS)
SCHGT1:	HRRI	M,1(M)
SCHGET:	PUSHJ	P,GETWRD##	;GET WORD
	JRST	[POP	P,(P)	;ADDRESS CHECK
		 JRST	SCHAER]
	POPJ	P,0		;GOT IT

;SUBROUTINE TO STORE A WORD INTO A BLOCK
;CALL WITH:
;	T1 = WORD
;	M = ADDRESS
;	T4 = AOBJN WORD
;	JSP	T2,SCHBLK
;	RETURN HERE IF MORE
SCHBLK:	PUSHJ	P,PUTWR1##
	  JRST	SCHAER
	AOBJP	T4,CPOPJ1##
	JRST	(T2)
;ERROR RETURNS
	ERCODE	SCHAER,SCHAC%	;(1) ADDRESS CHECK ERROR
	ERCODE	SCHFNE,SCHUF%	;(2) BAD FUNCTION NUMBER
	ERCODE	SCHBJN,SCHUJ%	;(3) BAD JOB NUMBER
	ERCODE	SCHNPE,SCHNP%	;(4) NO PRIVILEGES
	ERCODE	SCHCLE,SCHUC%	;(5) BAD CLASS NUMBER
	ERCODE	SCHQNE,SCHUQ%	;(6) BAD QUEUE NUMBER
	ERCODE	SCHCNE,SCHNC%	;(7) BAD CHANNEL NUMBER
	ERCODE	SCHBFE,SCHEB%	;(10) BAD EXPONENTIAL FACTOR VALUE
	ERCODE	SCHMIS,SCHMI%	;(11) ATTEMPT TO SET PROT WHILE MCUINT NON ZERO.
	ERCODE	SCHNHP,SCHNH%	;(13) NOT HUNDRED PERCENT IN CLSSTS
	ERCODE	SCHFNP,SCHFN%	;(14) FAIRNESS NOT POSITIVE
	ERCODE	SCHICP,SCHIC%	;(15) ILLEGAL CPU
	ERCODE	SCHISB,SCHIS%	;(16) ILLEGAL SCAN BLOCK

>;END IFN FTNSCHED
SUBTTL MICRO SCHEDULING INTERVAL ROUTINES

IFN FTNSCHED,<
;HERE EVERY MICRO SCHEDULING INTERVAL TO MAINTAIN
; THE SUB-QUEUE SCHEDULING TABLES
;
;SCDQTA USES AC'S T1,T2,T3,T4.

SCDQTA::SKIPLE	T1,SCDINT##	;ANY INTERVAL AT ALL?
	SKIPG	T2,CNTSTS##	;ANY SUBCLASSES PRESENT?
	POPJ	P,		;NO, DON'T DO ANYTHING
	MOVEM	T2,RRFLAG##	;SET RRFLAG SO THAT WE CLASS SCHEDULE
	MOVE	T2,SCDSTS##
	MOVEM	T2,SCDSET##
	MOVE	T2,SYSUPT##
	CAMGE	T2,SCDTIM##	;TIME FOR A MSI?
	POPJ	P,		;NO, RETURN
	ADD	T2,T1		;GET NEXT UPTIME FOR INTERVAL
	MOVEM	T2,SCDTIM##	;SAVE
	IMUL	T1,SCDJIL##	;TIMES % TO SCAN JBTJIQ
	ADDI	T1,^D99		;ROUND UP
	IDIVI	T1,^D100	;SCALE DOWN
	ADD	T1,SYSUPT##	;PLUS CURRENT TIME
	MOVEM	T1,SCNJIL##	;SAVE FOR SCHEDULING SCAN
; (AND POSSIBLY CPU1)

	SOSLE	SSCNT##		;ANY ENTRIES LEFT IN PRIMARY SCAN TABLE?
	JRST	SCDQT1		;YES
	MOVEI	T1,^D100	;100 ENTRIES
	MOVEM	T1,SSCNT##	;RESTORE COUNT
	MOVE	T2,[POINT 5,PSQTAB##]
	MOVEM	T2,SSPNT##	;POINTER FOR CPU0
IFN FTMP,<
	MOVE	T2,[POINT 5,PSQTAB##,4]
	MOVEM	T2,SSPNT1##	;POINTER FOR CPU1
>

SCDQT1:	PUSHJ	P,SCDSS0	;SETUP SCAN TABLE FOR CPU0
IFN FTMP,<
	PUSHJ	P,SCDSS1##	;SETUP SCAN TABLE FOR CPU1
>
	POPJ	P,

SCDSS0::ILDB	T1,SSPNT##	;INCREMENT BYTE POINTER FOR CPU0
	MOVEI	T4,SSSCAN##	;ADDRESS OF CPU0 SUB-Q SCAN TABLE
;	PJRST	SCDSST		;SETUP THE TABLE

SCDSST::MOVEI	J,(T4)		;0,,ADDRESS OF SCAN TABLE
	SETCAM	T1,(J)		;STORE THE PRIMARY SUBCLASS HEADER OFFSET
	SETZM	SSSUM##		;INITIALIZE SUM OF SECONDARY PERCENTS
	MOVE	T2,MAXQTA##	;HIGHEST CLASS WITH NON-ZERO CLSQTA
SCDQT2:	SKIPLE	T3,CLSQTA##(T2)	;ANY SECONDARY QUOTA FOR THIS CLASS?
	CAMN	T2,T1		;IS THIS THE PRIMARY CLASS?
	JRST	SCDQT3		;PRIMARY CLASS OR NO QUOTA
	ADDM	T3,SSSUM##	;SUM THE PERCENTS
	AOBJP	J,.+1		;BUMP THE TABLE POINTER
	HRL	T3,T2		;CLASS #,,QUOTA
	MOVEM	T3,(J)		;STASH IN TABLE
SCDQT3:	SOJGE	T2,SCDQT2	;CHECK THE OTHER CLASSES
	SETCA	J,		;LH(J)=-(LH(J)+1)
	HRRI	J,-1(T4)	;ADDRESS OF TABLE - 1
	AOBJP	J,SCDQT7	;JUMP IF NO POSITIVE QUOTAS FOUND
	AOBJP	J,SCDQT6	;JUMP IF ONLY ONE CLASS FOUND
SCDQT4:	PUSHJ	P,RAND		;GET RANDOM NUMBER
	IDIV	T2,SSSUM##	;MOD SSSUM
	MOVE	T4,J		;GET A COPY OF AOBJN POINTER
SCDQT5:	HRRZ	T2,(T4)		;GET HIS SECONDARY QUOTA
	SUB	T3,T2		;SUBTRACT FROM SCALED RANDOM NUMBER
	JUMPL	T3,.+2		;IS THIS THE CLASS WE WANT?
	AOBJN	T4,SCDQT5	;NO, KEEP LOOKING
	MOVE	T2,(J)		;STORE THE CURRENT ENTRY
	EXCH	T2,(T4)		;ON TOP OF THE ONE WE SELECTED
	HLRZ	T1,T2		;CLASS NUMBER
	SETCAM	T1,(J)		;STORE AS SUB QUE OFFSET
	MOVNI	T2,(T2)		;SUBTRACT QUOTA
	ADDM	T2,SSSUM##	;FROM TOTAL
	AOBJN	J,SCDQT4	;GO PICK THE NEXT TABLE ENTRY
SCDQT6:	HLRZ	T1,(J)		;LAST AND CERTAINLY LEAST
	SETCAM	T1,(J)		;STORE HIM ALSO
SCDQT7:	SETZM	1(J)		;ZERO TERMINATES SCAN LIST
	POPJ	P,

>;END IFN FTNSCHED
	SUBTTL	SCHEDULER INITIALIZATION

	$INIT

;INITIALIZE SCHEDULER
;CALLED FROM SYSINI BEFORE ANY DEVICES ARE INITIALIZED

SCDINI::MOVEI	T1,AVLNUM	;MAXIMUM NUMBER OF QUEUES
SCDIN1:	SETZM	AVALTB##(T1)	;CLEAR SHARABLE DEVICE AVAIL. FLAGS
	SETZM	USRTAB##(T1)	;CLEAR SHARABLE RESOURCE OWNER
	SETOM	REQTAB(T1)	;SET SHARABLE DEVICE REQUEST COUNT TO -1
				; I.E. NO JOB WAITING OR USING DEVICE OTHER
				; THAN INITIALIZATION
	SOJGE	T1,SCDIN1
	SETZM	DAREQ		;DA IS DIFFERENT
	SETZM	AUREQ		;AU IS DIFFERENT
	SETZM	XJOB		;CLEAR NUMBER OF JOBS NEEDING EXPANDING

;PUT ALL JOBS IN THE NULL QUEUE
SCDIN2:	MOVNI	T1,MXQUE2##	;SET UP DOUBLE QUE HEADERS
	HRL	T1,T1		;BOTH HALVES POINT TO EMPTY SELF
	MOVEM	T1,JBTCQ##(T1)
	AOBJN	T1,.-1
	MOVNI	T1,OBQ##	;MAKE JBTOLS HEADERS POINT TO THEMSELVES
	HRL	T1,T1		;BACK POINTER ALSO
	MOVEM	T1,JBTOLS##(T1)
	AOBJN	T1,.-1
	MOVNI	T1,DISQ##	;MAKE DORMANT/IDLE QUEUE POINT TO SELF
	HRL	T1,T1		;
	MOVEM	T1,JBTDIH##	;
	MOVNI	T1,HSQ##	;MAKE JBTJIL HEADERS POINT TO THEMSELVES
	HRL	T1,T1		;BACK POINTER ALSO
	MOVEM	T1,JBTJIL##(T1)
	AOBJN	T1,.-1
IFN FTNSCHED,<
	MOVNI	T1,M.CLSN##	;MAKE CORE/NO-CORE SUBQUEUES POINT TO SELVES
	ASH	T1,1		;DOUBLE HEADERS
	HRL	T1,T1		;BOTH HALVES
	MOVEM	T1,JBTCSQ##(T1)
	AOBJN	T1,.-1
>;END FTNSCHED
	MOVEI	J,JOBMAX##	;MAX. JOB NO.
	MOVNI	T1,NCNULQ##	;PUT ALL JOBS IN NO CORE QUE
	MOVSM	T1,JBCQP1##	;BACK POINTER FOR JOB 1
	MOVEM	T1,JBTCQ##(J)	;FOR. POINTER OF JOBMAX JOB NO.
	HRLM	J,JBCQMN##	;SET NO CORE QUE HEADER TO POINT TO JOB 1
	MOVEI	T1,1		;AND JOBMAX
	HRRM	T1,JBCQMN##	;FORWARD POINTER
	MOVEI	T2,NULQ		;SET UP QUE NUMBER
	SETZM	JBTCQ##
SCDIN3:	DPB	T2,PJBST2##	;STORE INITIAL QUE NUMBER
	HRRM	J,JBCQM1##(J)	;JOB I-1 POINT TO JOB I
	SOJLE	J,SCDIN4	;FINISHED?
	HRLM	J,JBCQP1##(J)	;BACK POINTER JOB I+1 POINTS TO JOB I
	JRST	SCDIN3

SCDIN4:	MOVE	T1,TICSEC##	;PRESET SEGMENT RETENTION TIME
	MOVEM	T1,SGTLIM	;TO ONE SECOND IN TICKS AS AGE OF IDLE/DORMANT
				;SEGS BEFORE DELETION
IFN FTNSCHED,<
	MOVEI	T1,^D10		;10%
	MOVEM	T1,SCDJIL##	;INITIAL RESPONSE FAIRNESS FACTOR
	MOVEI	T1,^D50
	MOVEM	T1,SCDIOF##	;INITIAL INCORE FAIRNESS FACTOR
	MOVE	T1,TICSEC##	;TICKS PER SECOND
	IMULI	T1,^D3		;6 SECONDS IN TICK PAIRS
	MOVEM	T1,SCDCOR##	;INITIALIZE SCDCOR
	SETOM	BBSUBQ##	;NO BACKGROUND BATCH CLASS
>; END IFN FTNSCHED
	MOVE	T1,TICSEC##	;TICKS PER SECOND
IFN FTKL10,<IDIVI T1,^D7>	;7TH SECOND FOR TTYIOW & PQ1 (NON-CLASS SCHED)
IFN FTKS10,<IDIVI T1,^D5>	;5TH SECOND FOR TTYIOW & PQ1 (NON-CLASS SCHED)
	MOVEM	T1,QADTAB##	;SAVE FOR PQ1
	MOVEM	T1,QMXTAB##	;...
	MOVE	T1,[^D500000]	;SETUP
	IDIV	T1,TICSEC##	; CONSTANTS
	MOVEM	T1,ICPCV1	;  FOR
	MOVE	T1,[^D1000000]	;   CONVERTING
	IDIV	T1,TICSEC##	;    FROM TICKS
	MOVEM	T1,ICPCV2	;     TO MICROSECONDS
	MOVEI	T1,M.NRQT##	;INTERVAL FOR WANT-TO-RUN TIME CALCULATION
	MOVEM	T1,RQTINT	;SALT AWAY
	MOVEM	T1,RQTCNT	;INITIALIZE FOR FIRST INTERVAL

	MOVEI	J,JOBMAX##	;MAX INDEX IN JOB AND HIGH SEG TABLES
SCDIN5:	HRLOI	T2,JNA+JLOG+SWP	;CLEAR  ALL BUT JOB NO. ASSIGNED,
	ANDM	T2,JBTSTS##(J)	;JOB LOGGED IN/SHRSEG & SWAPPED BITS
	SKIPE	JBTADR##(J)	;DOES THIS JOB HAVE CORE IN MEMORY?
	PUSHJ	P,CLRJOB##	;YES, CLEAR JOB DATA AREA PROTECTED
	SOJG	J,SCDIN5	;FROM IO SERVICE (DEVICE ASSIGNMENT TABLE)
				;AND SET JERR BIT SO JOB CANNOT CONT

	POPJ	P,		;RETURN

	$HIGH
	$LIT
SCHEND:	END