Google
 

Trailing-Edge - PDP-10 Archives - BB-M080I-SM - monitor-sources/sched.mac
There are 52 other files named sched.mac in the archive. Click here to see a list.
;Edit 6717 to SCHED.MAC by WAGNER on Tue 2-Apr-85, for SPR #20483
;		Make SKDIDL not overflow into SKDTM0
;Edit 3169 to SCHED.MAC by MOSER on Thu 20-Sep-84 - FIX CSKBAS PART OF 3156
;EDIT 3169 - CHANGE CSKBAS
;Edit 3120 to SCHED.MAC by MOSER on Tue 12-Jun-84, for SPR #20130
;		UNMAP INDEX FILE
;EDIT 3120 - UNMAP INDEX AT FORK TERMINATION
;Edit 3106 to SCHED.MAC by LOMARTIRE on Mon 7-May-84
;		Make edit 3105 fix all cases of PI level 6 NOSKED/OKSKED
;Edit 3080 to SCHED.MAC by CJOHNSON on Thu 15-Mar-84, for SPR #20011
;		CLRINT call must have a line number in T2 (at PSIT13)
;Edit 3054 to SCHED.MAC by MOSER on Tue 6-Dec-83
;		PREVENT ILMNRF DURING FORK CREATION
;EDIT 3054 - PREVENT ILMNRF WHEN CREATING FORK
;Edit 3046 to SCHED.MAC by LOMARTIRE on Fri 18-Nov-83, for SPR #19563
;		Clear non-zero sections before logout - prevents hanging
;Edit 3028 to SCHED.MAC by MOSER on Wed 12-Oct-83, for SPR #19460
;		ALLOW JP%SYS FORKS TO RUN EVEN IF WINDFALL WITHHELD
;Edit 3017 to SCHED.MAC by TBOYLE on Thu 15-Sep-83
;		TCO 6.1660 remove possible scheduling errors.
;Edit 2997 to SCHED.MAC by LOMARTIRE on Thu 11-Aug-83, for SPR #19356
;		Fix .SKBCS function of SKED to loop through all batch jobs
;Edit 2939 by MOSER on Tue 29-Mar-83, for SPR #18087 - PREVENT JOBS STUCK IN DREGS QUEUE
;EDIT 2939 - FIX JOBS STUCK IN DREGS QUEUE
; UPD ID= 294, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.12,  13-Jan-83 13:40:46 by DONAHUE
;Edit 2900 - Prevent MONPDL when logging out job in MDDT
; UPD ID= 251, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.11,   8-Dec-82 13:48:26 by MOSER
;EDIT 2873 - ADD ILUUO1
; UPD ID= 187, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.10,  26-Oct-82 11:51:52 by COBB
;EDIT 2846 - Make bias 11 same as release 4.
; UPD ID= 186, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.9,  26-Oct-82 11:41:53 by COBB
;EDIT 2845 - Revisions to NEWST.
; UPD ID= 185, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.8,  26-Oct-82 11:15:07 by COBB
;EDIT 2844 - Put calls to NBNSB in SKEDSW conditional.
; UPD ID= 175, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.7,  15-Oct-82 12:22:39 by MOSER
;EDIT 2837 - FIX WINDFALL WITHHOLDING
; UPD ID= 108, FARK:<5-1-WORKING-SOURCES.MONITOR>SCHED.MAC.5,   9-Sep-82 13:18:57 by MOSER
;EDIT 2805 - PREVENT ILMNRF WHEN JSYS TRAPPING.
; UPD ID= 11, SNARK:<5.1.MONITOR>SCHED.MAC.3,  17-Jun-82 05:39:25 by GRANT
;TCO 5.1.1034 - make NHOLDF external
; UPD ID= 10, SNARK:<5.1.MONITOR>SCHED.MAC.2,  16-Jun-82 14:01:06 by MURPHY
;TCO 5.1.1034 - Fix reporting of IDLE time & load averages.
; UPD ID= 539, SNARK:<5.MONITOR>SCHED.MAC.85,  15-Mar-82 17:39:08 by COBB
;TCO 5.1754 - Check arguments of SKED% jsys
; UPD ID= 477, SNARK:<5.MONITOR>SCHED.MAC.84,  12-Feb-82 16:55:49 by MURPHY
;TCO 5.1730 - Restore lost flags, fix APSKED.
; UPD ID= 456, SNARK:<5.MONITOR>SCHED.MAC.83,   1-Feb-82 19:09:20 by MILLER
;TCO 6.1059. Treat BSCRSK and PIBMP the same as JP%SYS
; UPD ID= 455, SNARK:<5.MONITOR>SCHED.MAC.82,   1-Feb-82 16:08:39 by MILLER
; UPD ID= 454, SNARK:<5.MONITOR>SCHED.MAC.81,   1-Feb-82 15:53:07 by MILLER
;Fix missing ENDIF. in previous edit
;TCO 6.1059 AGAIN. Give JP%SYS forks a little less of a boost
; UPD ID= 441, SNARK:<5.MONITOR>SCHED.MAC.80,  25-Jan-82 13:56:01 by MILLER
;TCO 6.1059. CORFCT fixes
; UPD ID= 438, SNARK:<5.MONITOR>SCHED.MAC.79,  25-Jan-82 00:00:57 by MURPHY
;TCO 5.1697 - XSSEV%, etc.  Handle extended entry vectors in UU1050, DMSENT.
; UPD ID= 421, SNARK:<5.MONITOR>SCHED.MAC.77,  19-Jan-82 15:07:15 by MILLER
;TCO 5.1689. Fix run time guarantee
; UPD ID= 405, SNARK:<5.MONITOR>SCHED.MAC.76,  16-Jan-82 13:51:26 by PAETZOLD
;TCO 5.1680 - fix TCO 5.1658
; UPD ID= 384, SNARK:<5.MONITOR>SCHED.MAC.75,   8-Jan-82 16:35:28 by MURPHY
;TCO 5.1660 - Tags in MENTR, MRETN for JSLOOK program.
; UPD ID= 382, SNARK:<5.MONITOR>SCHED.MAC.74,   7-Jan-82 21:44:02 by PAETZOLD
;TCO 5.1658 - preserve PIFL in carrier off interrupt requests in PIRCOF and PIRLG1
; UPD ID= 330, SNARK:<5.MONITOR>SCHED.MAC.73,  30-Nov-81 10:02:29 by DONAHUE
;TCO 5.1522 - set active Batch jobs if the Batch class is set after startup
; UPD ID= 326, SNARK:<5.MONITOR>SCHED.MAC.72,  18-Nov-81 17:41:45 by MURPHY
;TCO 5.1615 - MAKE SETPCV INTERNAL
; UPD ID= 308, SNARK:<5.MONITOR>SCHED.MAC.71,   3-Nov-81 16:45:59 by MOSER
;TCO 5.1580 LOOK AT NBPROC INSTEAD OF NGOJOB TO DETERMINE IF RUNNABLE JOB
; UPD ID= 307, SNARK:<5.MONITOR>SCHED.MAC.70,   3-Nov-81 16:37:36 by MOSER
;TCO 5.1579 USE CORRECT TEST AT CORFC5: SO INTERACTIVE JOBS GET CORRECT PRIO.
; UPD ID= 299, SNARK:<5.MONITOR>SCHED.MAC.69,  28-Oct-81 11:29:02 by MURPHY
;Disable HPSCHK for now.
;Make HPSCHK less sensitive.
; UPD ID= 290, SNARK:<5.MONITOR>SCHED.MAC.68,  22-Oct-81 16:01:46 by MURPHY
;Ditto
; UPD ID= 287, SNARK:<5.MONITOR>SCHED.MAC.67,  22-Oct-81 11:35:17 by MURPHY
;Fix bug in 5.1428
; UPD ID= 262, SNARK:<5.MONITOR>SCHED.MAC.66,  15-Oct-81 13:25:44 by SCHMITT
;Reinsert TCO 5.1419 but check JOBRT instead of JOBDIR
; UPD ID= 258, SNARK:<5.MONITOR>SCHED.MAC.65,  13-Oct-81 16:15:31 by MURPHY
;Remove TCO 5.1419, ID 51 - it prevented class from being set during LOGIN
; UPD ID= 257, SNARK:<5.MONITOR>SCHED.MAC.64,  13-Oct-81 10:55:42 by MURPHY
;TCO 5.1570 - Fix bug in computation of utilization.
; UPD ID= 252, SNARK:<5.MONITOR>SCHED.MAC.63,   7-Oct-81 14:41:13 by PAETZOLD
;Remove TCO 5.1559 as it caused problems
; UPD ID= 244, SNARK:<5.MONITOR>SCHED.MAC.62,   5-Oct-81 10:38:27 by PAETZOLD
;TCO 5.1559 - Treat NVT's as real TTY's and not as PTY's in NEWST
; UPD ID= 210, SNARK:<5.MONITOR>SCHED.MAC.61,  23-Sep-81 15:38:04 by MURPHY
;TCO 5.1530 - reset local flags in AJBALS
; UPD ID= 162, SNARK:<5.MONITOR>SCHED.MAC.60,   9-Sep-81 17:26:10 by MURPHY
;Get rid of XCT of BUGHLT - make it CALL instead. (REEBUG)
;Revise previous - preserve T3 and T4 in CORFCT
; UPD ID= 119, SNARK:<5.MONITOR>SCHED.MAC.59,  25-Aug-81 09:27:18 by GRANT
;Preserve T3 and T4 over CALL CORFCT in ONGOL
; UPD ID= 95, SNARK:<5.MONITOR>SCHED.MAC.58,   8-Aug-81 09:52:19 by HALL
;Add some comments
; UPD ID= 94, SNARK:<5.MONITOR>SCHED.MAC.57,   7-Aug-81 13:15:19 by SCHMITT
;TCO 5.1439 - Do not perform JSYS trapping on execute only process
; UPD ID= 93, SNARK:<5.MONITOR>SCHED.MAC.56,   7-Aug-81 13:09:43 by SCHMITT
;TCO 5.1440 - Load Job number before compare at HLTJOB
; UPD ID= 91, SNARK:<5.MONITOR>SCHED.MAC.55,   5-Aug-81 11:54:00 by MURPHY
;Ditto
; UPD ID= 64, SNARK:<5.MONITOR>SCHED.MAC.50,  22-Jul-81 17:28:19 by MURPHY
;TCO 5.1428 - Detect excessive time in CSKED, etc.
;Compute job utilization always.
; UPD ID= 52, SNARK:<5.MONITOR>SCHED.MAC.49,  20-Jul-81 15:51:58 by MOSER
;MORE OF TCO 5.1406 SAVE T REGS.
; UPD ID= 51, SNARK:<5.MONITOR>SCHED.MAC.48,  20-Jul-81 10:15:59 by SCHMITT
;Edit 1910 - TCO 5.1419 - Check if job is logged in at CHGCLS
; UPD ID= 48, SNARK:<5.MONITOR>SCHED.MAC.47,  17-Jul-81 16:20:22 by MURPHY
;TCO 5.1398 - HANDLE SKIP RETURN FROM MSETPT
; UPD ID= 16, SNARK:<5.MONITOR>SCHED.MAC.46,  10-Jul-81 09:20:55 by MOSER
;TCO 5.1406 - IF ILLEGAL MEMORY WRITE ON ERCAL RETURN THIS ERROR TO USER.
; UPD ID= 8, SNARK:<5.MONITOR>SCHED.MAC.45,   9-Jul-81 17:13:00 by MURPHY
; TCO 5.1396  - BIT IN JOBBIT TO INDICATE SYSTEM FORK - GETS HIGH PRIORITY
;<5.MONITOR>SCHED.MAC.44, 30-Jun-81 11:23:32, EDIT BY MURPHY
;<5.MONITOR>SCHED.MAC.43, 29-Jun-81 13:45:20, EDIT BY MURPHY
;<5.MONITOR>SCHED.MAC.42, 29-Jun-81 11:58:33, EDIT BY MURPHY
;<5.MONITOR>SCHED.MAC.41, 29-Jun-81 11:43:28, EDIT BY MURPHY
;<5.MONITOR>SCHED.MAC.40, 29-Jun-81 10:55:19, EDIT BY MURPHY
; UPD ID= 2263, SNARK:<5.MONITOR>SCHED.MAC.39,  26-Jun-81 18:06:51 by MURPHY
;MAKE NOSKED/OKSKED EQUIVALENT TO NOSKD1/OKSKD1, SAME FOR CSKED, ETC.
; TCO 5.1376 -
;BAD FLAGS WHEN DEBREAK TO JOBCOF OR FLOGO; NOTE ITRAP WHEN LOGIN/LOGOUT
; UPD ID= 2195, SNARK:<5.MONITOR>SCHED.MAC.38,  12-Jun-81 13:32:16 by MURPHY
;FIX 2168 - NOSKED SHOULD HAVE BEEN NOSKD1, ETC.
; UPD ID= 2188, SNARK:<5.MONITOR>SCHED.MAC.37,  11-Jun-81 15:57:40 by MURPHY
;CHANGE TQNx TO TMNx REFLECTING CHANGE IN MACSYM
; UPD ID= 2168, SNARK:<5.MONITOR>SCHED.MAC.36,  10-Jun-81 15:46:59 by MURPHY
;ELIMINATE SCHEDULER REQUEST QUEUE, CALL FUNCTION IMMEDIATELY
; UPD ID= 2057, SNARK:<5.MONITOR>SCHED.MAC.35,  21-May-81 11:04:35 by SCHMITT
;Tco 5.1339 - Change prioritys of currently active batch jobs at SKDRDQ
; UPD ID= 2045, SNARK:<5.MONITOR>SCHED.MAC.34,  20-May-81 11:51:55 by PAETZOLD
;FIX TYPO IN PREVIOUS
; UPD ID= 2037, SNARK:<5.MONITOR>SCHED.MAC.33,  19-May-81 17:04:10 by PAETZOLD
;TCO 5.1335 DETECT OKSKED'S AND OKSKD1'S WHEN NOT NOSKED
; UPD ID= 1898, SNARK:<5.MONITOR>SCHED.MAC.32,  29-Apr-81 06:29:16 by WACHS
; UPD ID= 1855, SNARK:<5.MONITOR>SCHED.MAC.31,  21-Apr-81 07:02:36 by WACHS
;TCO 5.1290 KEEP KEEP-ALIVE COUNTER GOING ID NOSKED FOR DIAG
; UPD ID= 1707, SNARK:<5.MONITOR>SCHED.MAC.30,  16-Mar-81 11:46:40 by MURPHY
;DITTO
; UPD ID= 1668, SNARK:<5.MONITOR>SCHED.MAC.29,  11-Mar-81 17:13:23 by MURPHY
;MODIFY ENTSKD TO CHECK FOR RECURSIVE ENTRY
; UPD ID= 1570, SNARK:<5.MONITOR>SCHED.MAC.28,  19-Feb-81 14:10:20 by HALL
;TRY AGAIN RUNNING EXEC0 IN SECTION 1
; UPD ID= 1565, SNARK:<5.MONITOR>SCHED.MAC.27,  16-Feb-81 20:11:29 by MURPHY
;BUT KEEP EXEC0 IN SECTION 0
; UPD ID= 1555, SNARK:<5.MONITOR>SCHED.MAC.26,  12-Feb-81 17:42:30 by MURPHY
;MAKE PSI CODE RUN IN SECTION 1
; UPD ID= 1516, SNARK:<5.MONITOR>SCHED.MAC.25,   4-Feb-81 15:38:04 by MURPHY
;MAKE SURE UMODF ON AT PSISM1 INTERRUPT START
; UPD ID= 1471, SNARK:<5.MONITOR>SCHED.MAC.24,  22-Jan-81 09:27:41 by GRANT
;MAKE SKEDSW CONDITIONALS CONFORM TO CODING STANDARD
; UPD ID= 1463, SNARK:<5.MONITOR>SCHED.MAC.23,  21-Jan-81 11:18:10 by GRANT
;TCO 5.1230 - CHANGE OLD DEBUG SWITCH TO SKEDSW
; UPD ID= 1349, SNARK:<5.MONITOR>SCHED.MAC.22,  12-Dec-80 14:38:16 by MURPHY
;GET JOBPT SETUP EARLIER
; UPD ID= 1279, SNARK:<5.MONITOR>SCHED.MAC.21,  17-Nov-80 12:31:41 by MURPHY
;TCO 5.1198 - NBSWP NOT DECREMENTED
; UPD ID= 1273, SNARK:<5.MONITOR>SCHED.MAC.20,  14-Nov-80 17:51:56 by MURPHY
;ENSURE FORKX IS -1 WHILE RUNNING BGND TASKS
; UPD ID= 1217, SNARK:<5.MONITOR>SCHED.MAC.19,  31-Oct-80 14:57:52 by HALL
;TCO 5.1180 - MOVE DST TO NON-ZERO SECTION
;	MAKE SCHED0 RUN IN SECTION 1
; UPD ID= 1208, SNARK:<5.MONITOR>SCHED.MAC.17,  29-Oct-80 11:52:52 by MURPHY
;DITTO
; UPD ID= 1205, SNARK:<5.MONITOR>SCHED.MAC.16,  28-Oct-80 17:35:05 by MURPHY
;TCO 5.1182
;NEW BIAS FLAG SK%CL1 - MAKE CLASS SCHED USE NORMAL QUEUE PRIORITIES IF 1
; UPD ID= 1088, SNARK:<5.MONITOR>SCHED.MAC.15,   1-Oct-80 12:09:05 by MURPHY
;FIX ACVAR
; UPD ID= 968, SNARK:<5.MONITOR>SCHED.MAC.14,  25-Aug-80 16:29:08 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 792, SNARK:<5.MONITOR>SCHED.MAC.13,  23-Jul-80 20:54:21 by MURPHY
;Fix BUG call
; UPD ID= 782, SNARK:<5.MONITOR>SCHED.MAC.12,  23-Jul-80 11:24:43 by MURPHY
;Be sure JOBRT is 0 when job created
; UPD ID= 764, SNARK:<5.MONITOR>SCHED.MAC.11,  18-Jul-80 15:20:50 by MURPHY
;DETECT NEGATIVE JOBRT
; UPD ID= 596, SNARK:<5.MONITOR>SCHED.MAC.10,   3-Jun-80 17:44:31 by MURPHY
;INIT FACTSW WITH SF%MS1 ON
; UPD ID= 546, SNARK:<5.MONITOR>SCHED.MAC.9,  21-May-80 14:34:20 by MURPHY
;ALWAYS USE HIGHER INTQ IF CLASS SCHEDULING
; UPD ID= 508, SNARK:<5.MONITOR>SCHED.MAC.8,   5-May-80 15:56:19 by MILLER
;TCO 5.1033. GIVE PIBMP IN ASSFK
; UPD ID= 499, SNARK:<5.MONITOR>SCHED.MAC.7,  30-Apr-80 15:09:56 by GRANT
;TCO 5.1030 - Make ?FULL be more informative
; UPD ID= 485, SNARK:<5.MONITOR>SCHED.MAC.6,  28-Apr-80 09:35:13 by MURPHY
; UPD ID= 465, SNARK:<5.MONITOR>SCHED.MAC.5,  23-Apr-80 13:22:17 by MURPHY
;REMOVE WRITE PROTECT CHECKS
; UPD ID= 462, SNARK:<4.1.MONITOR>SCHED.MAC.349,  23-Apr-80 12:00:31 by MURPHY
;FIX STATISTICS
; UPD ID= 431, SNARK:<4.1.MONITOR>SCHED.MAC.348,  13-Apr-80 14:35:11 by OSMAN
;Use FRKTTY instead of FKCTYP
; UPD ID= 338, SNARK:<4.1.MONITOR>SCHED.MAC.347,  17-Mar-80 13:49:19 by MURPHY
;FIX SNOOP BUG, MOVE CALL RCVCH7
; UPD ID= 322, SNARK:<4.1.MONITOR>SCHED.MAC.346,  12-Mar-80 12:14:39 by MURPHY
;FIX JOBSRT
; UPD ID= 317, SNARK:<4.1.MONITOR>SCHED.MAC.345,  11-Mar-80 11:13:06 by ELFSTROM
; UPD ID= 314, SNARK:<4.1.MONITOR>SCHED.MAC.344,  10-Mar-80 18:22:05 by MURPHY
;FIX ASSFK, CHKBMP
; UPD ID= 285, SNARK:<4.1.MONITOR>SCHED.MAC.343,  20-Feb-80 17:56:18 by MURPHY
;REVISE QUEUE PARAMETERS, FLAGS
; UPD ID= 259, SNARK:<4.1.MONITOR>SCHED.MAC.342,  12-Feb-80 18:13:27 by MURPHY
;SKDLV8 AGAIN
; UPD ID= 196, SNARK:<4.1.MONITOR>SCHED.MAC.341,   9-Jan-80 14:45:47 by MURPHY
;FIX LOST FORK CONTEXT IN SKDLV8
; UPD ID= 78, SNARK:<4.1.MONITOR>SCHED.MAC.340,   1-Dec-79 16:00:57 by MILLER
;CHECK FOR SCHEDULER ALARM SPENT IN SCDR. NEEDED NOW BECAUSE
; OF MAIN PATH REORGANIZATION.
;<4.1.MONITOR>SCHED.MAC.339, 29-Nov-79 14:26:50, EDIT BY MILLER
;<4.1.MONITOR>SCHED.MAC.338, 29-Nov-79 14:20:14, EDIT BY MILLER
;FIX TYPEO
; UPD ID= 61, SNARK:<4.1.MONITOR>SCHED.MAC.337,  29-Nov-79 14:06:08 by MILLER
;TCO 4.1.1036 AGAIN
; UPD ID= 59, SNARK:<4.1.MONITOR>SCHED.MAC.336,  29-Nov-79 14:00:19 by MILLER
;TCO 4.1.1036. SAVE AND RESTORE FLKCNT AND FKLOCK OVER JSYSES
; UPD ID= 9, SNARK:<4.1.MONITOR>SCHED.MAC.335,  21-Nov-79 17:35:26 by MURPHY
;<4.1.MONITOR>SCHED.MAC.334, 19-Nov-79 16:35:59, EDIT BY MILLER
;<4.1.MONITOR>SCHED.MAC.333, 19-Nov-79 16:28:48, EDIT BY MILLER
;COMPUTE RT TIME-OUT IN AJBALS
;<4.1.MONITOR>SCHED.MAC.332, 19-Nov-79 15:31:04, EDIT BY MILLER
;<4.1.MONITOR>SCHED.MAC.331, 19-Nov-79 11:20:07, EDIT BY MILLER
;<4.1.MONITOR>SCHED.MAC.330, 19-Nov-79 11:05:32, EDIT BY MILLER
;APPLY RT TEST TO BS HOLD TIME IF MEMORY IS OVERLOADED
;<4.1.MONITOR>SCHED.MAC.329, 13-Nov-79 14:35:25, EDIT BY MURPHY
;<4.1.MONITOR>SCHED.MAC.327, 12-Nov-79 17:25:51, EDIT BY MURPHY
;CHANGE SWAP SPACE LEVEL FOR NEW JOB CUTOFF
;<MURPHY.MON>SCHED.MAC.2,  8-Nov-79 18:04:45, EDIT BY MURPHY
;REORG CODE FOR FASTER MAIN PATH
;<4.1.MONITOR>SCHED.MAC.325,  8-Nov-79 12:25:02, EDIT BY MURPHY
;FIX AC CLOBBERAGE ON ERJMP CERTAIN CASES
;<4.MONITOR>SCHED.MAC.324, 31-Oct-79 14:18:19, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.323, 30-Oct-79 12:31:00, EDIT BY MILLER
;CHARGE BALSET HOLD TIME FOR SWAP READS AS WELL AS FILE READS
;<4.MONITOR>SCHED.MAC.322, 29-Oct-79 11:22:00, EDIT BY MILLER
;CHANGE CODE AT MENT2 TO PRESERVE NOINT IN DIAG JSYS
;<4.MONITOR>SCHED.MAC.321, 25-Oct-79 14:06:02, EDIT BY MURPHY
;TTOLST FOR FASTER WAKEUP ON TTY OUTPUT
;<4.MONITOR>SCHED.MAC.318, 24-Oct-79 12:57:13, EDIT BY GRANT
;ADD 20 MS TASK FOR RCVOK TIMER
;<4.MONITOR>SCHED.MAC.317, 24-Oct-79 10:28:02, EDIT BY MURPHY
;APSKED, BSCRSK REVISIONS, SETPCV.
;<4.MONITOR>SCHED.MAC.315, 19-Oct-79 17:20:33, EDIT BY MURPHY
;BALSET HOLD TIME ADJUSTMENTS
;<4.MONITOR>SCHED.MAC.314, 18-Oct-79 12:46:01, EDIT BY MILLER
;REMOVE CODE AT SCHED0 THAT CHECKS CRSKED.
;<4.MONITOR>SCHED.MAC.313, 15-Oct-79 13:02:57, EDIT BY MILLER
;GIVE PSBUMP IN SPIRQ EVEN IF PROCESS IS BLOCKED
;<4.MONITOR>SCHED.MAC.312, 15-Oct-79 10:15:22, EDIT BY MILLER
;FIX COMPUTATION IN CHKSNP
;<4.MONITOR>SCHED.MAC.311, 12-Oct-79 17:29:14, EDIT BY MURPHY
;IGNORE SECTION NUMBER IN CHKSNP
;<4.MONITOR>SCHED.MAC.310, 28-Sep-79 12:41:37, EDIT BY MILLER
;ONE MORE TRY. APPLY SIR SECTION TO CHANNEL ROUTINE AS WELL
;<4.MONITOR>SCHED.MAC.309, 28-Sep-79 12:31:41, EDIT BY MILLER
;FIX CODE AROUND DEBRKS TO APPLY SECTION TO INTERRUPT PC
;<4.MONITOR>SCHED.MAC.308, 27-Sep-79 15:53:36, EDIT BY MILLER
;FIX CODE AT PSIS5 TO DISALLOW INTS FROM OTHER THAN PC SIR SECTION
;<4.MONITOR>SCHED.MAC.307, 21-Sep-79 13:38:43, EDIT BY MURPHY
;CSKED - ALLOW SCHED SUBTASKS TO RUN (BUGS IN FORK.MAC NOW FIXED)
;<4.MONITOR>SCHED.MAC.306, 20-Sep-79 11:52:46, EDIT BY MILLER
;MAKE SET JOB CLASS ALWAYS DO GTOKM
;<4.MONITOR>SCHED.MAC.305, 13-Sep-79 13:32:34, EDIT BY MILLER
;PARAMETERIZE MINIMUM CLASS SHARE AND ATTENDANT VALUES
;<4.MONITOR>SCHED.MAC.304, 13-Sep-79 12:48:11, EDIT BY MILLER
;FIX .SKED COMPUTATION TO USE FAD INSTEAD OF FADR
;<OSMAN.MON>SCHED.MAC.1, 10-Sep-79 16:04:00, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>SCHED.MAC.302,  7-Sep-79 10:10:57, EDIT BY MURPHY
;PUT CRSKED BACK, FIXES TO ERJMP STUFF
;<4.MONITOR>SCHED.MAC.301, 30-Aug-79 12:12:01, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.300, 29-Aug-79 15:10:03, EDIT BY MURPHY
;BETTER DETECTION OF ERJMP/ERCAL USAGE IN NESTED JSYSES
;<4.MONITOR>SCHED.MAC.299, 29-Aug-79 09:32:57, EDIT BY MILLER
;CHANGE PSII TO PRESERVE PENDING INTS IF FORK IS HALTED
;<4.MONITOR>SCHED.MAC.298, 28-Aug-79 15:49:43, EDIT BY MURPHY
;CSKED HANDLING - ALLOW SCHEDULER SUBTASKS TO RUN
;<4.MONITOR>SCHED.MAC.297, 27-Aug-79 13:57:48, EDIT BY MILLER
;CORRECT CODE AT CORF55
;<4.MONITOR>SCHED.MAC.296, 26-Aug-79 20:09:44, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.295, 26-Aug-79 20:02:21, EDIT BY MILLER
;USE SK%HT2 TO DETERMINE IF NO HOLD TIME FOR SKIPPED PROCESS
;<4.MONITOR>SCHED.MAC.293, 25-Aug-79 09:07:26, EDIT BY MILLER
;init mjrstf in skhwpt to be a bughlt
;<4.MONITOR>SCHED.MAC.292, 21-Aug-79 12:24:45, EDIT BY MILLER
;BE SURE PROCESS LOADED BECAUSE OF CRSKED OR PIBMP
; GETS NO HOLD TIME
;<4.MONITOR>SCHED.MAC.291, 20-Aug-79 13:34:50, EDIT BY MILLER
;CHANGE CODE @PSIS5 AND @DEBRK1 TO FORCE SECTION 0 ADDRESS IF OLD
; STYLE SIR DONE
;<4.MONITOR>SCHED.MAC.290, 19-Aug-79 18:06:26, EDIT BY GILBERT
;CHANGE FKIBSH TO FKIBH TO AVOID CONFLICT WITH FKIBS.
;<4.MONITOR>SCHED.MAC.289, 16-Aug-79 13:42:37, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.288, 16-Aug-79 13:20:25, EDIT BY DBELL
;TCO 4.2405 - INITIALIZE CRSKED ON ENTRY TO TOP-LEVEL JSYS
;<4.MONITOR>SCHED.MAC.287, 16-Aug-79 07:18:50, EDIT BY MILLER
;ONE MORE TIME
;<4.MONITOR>SCHED.MAC.286, 15-Aug-79 17:11:12, EDIT BY MILLER
;CORFC1 AGAIN. IF CLASS IN WINDFALL, INTQ0 PROCESSES GET SMALL BOOST
;<4.MONITOR>SCHED.MAC.285, 15-Aug-79 15:44:28, EDIT BY MILLER
;FIX CORFC1 TO NOT BOOST QUEUE 2 PROCESS IF ITS CLASS IS GETTING WINDFALL
;<4.MONITOR>SCHED.MAC.284, 14-Aug-79 10:09:19, EDIT BY MILLER
;DON'T HONOR SK%RQ1 IF PROCESS HAS SPECIAL PRIORITY
;<4.MONITOR>SCHED.MAC.283,  9-Aug-79 12:45:26, EDIT BY MILLER
;USE JOB LOAD AVGS
;<4.MONITOR>SCHED.MAC.282,  8-Aug-79 16:39:24, EDIT BY MILLER
;HANDLE .SAWA ARG TO "SET CLASS SHARE" FUNCTION OF SKED
;<4.MONITOR>SCHED.MAC.281, 30-Jul-79 09:30:24, EDIT BY MILLER
;DON'T MAKE CHECK FOR JOB 0 IN AJBALS
;<4.MONITOR>SCHED.MAC.280, 24-Jul-79 14:11:50, EDIT BY MILLER
;INIT QUANTT ACCORDING TO SCHEDULER SETTINGS
;<4.MONITOR>SCHED.MAC.279, 19-Jul-79 08:36:07, EDIT BY MILLER
;FIX CLDRJ TO DO LOAD AVG COMPUTATION BETTER
;<4.MONITOR>SCHED.MAC.278, 13-Jul-79 11:38:27, EDIT BY HALL
;CHANGES FOR USER MODE-EXTENDED ADDRESSING:
; DEBRK - FORCE PCS TO 1
; PSII - CHANGE INDEXED PREVIOUS CONTEXT REFERENCES TO INDIRECT
; TO ALLOW GLOBAL REFERENCING OF ALL SECTIONS INCLUDING 0
; (0 IN LH WOULD BE LOCAL IF INDEXED)
; CHANGE PSII FOR EXTENDED SIR STUFF
;<4.MONITOR>SCHED.MAC.277, 15-Jun-79 12:08:58, EDIT BY MURPHY
;REMOVE CALL TO WSMGR IN TRYLDF
;<4.MONITOR>SCHED.MAC.276, 23-May-79 13:59:12, EDIT BY HALL
;COMMENTS ONLY
;<4.MONITOR>SCHED.MAC.275,  2-May-79 14:41:45, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.274,  2-May-79 14:35:45, EDIT BY MILLER
;ALLOW LOADING OF JOB 0 FORK AT AJBAL6. ALSO, LIMIT BAL SET HOLD
; IF CLASS SCHEDULE TO NEWUTL CYCLE (AT SETIBS)
;<4.MONITOR>SCHED.MAC.273,  2-May-79 10:15:03, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.272,  1-May-79 16:53:16, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.271,  1-May-79 15:38:29, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.271,  1-May-79 14:31:24, EDIT BY MILLER
;FIX AJABLS NOT TO LOAD A PROCESS OF LOWER PRIORITY THAN ONE
; THAT WAS SKIPPED WHEN THE CLASS SCHEDULER IS ON
;<4.MONITOR>SCHED.MAC.270,  1-May-79 12:16:50, EDIT BY MILLER
;DON'T ASSIGN HOLD TIME TO PROCESS IF ANOTHER WAS SKIPPED
;<4.MONITOR>SCHED.MAC.269,  1-May-79 08:46:40, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.268, 30-Apr-79 17:54:01, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.267, 30-Apr-79 17:52:24, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.266, 30-Apr-79 13:03:24, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.265, 28-Apr-79 12:54:38, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.264, 26-Apr-79 16:46:55, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.263, 26-Apr-79 16:13:09, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.262, 26-Apr-79 13:40:12, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.261, 26-Apr-79 11:32:31, EDIT BY MILLER
;SAVE T4 ACROSS CALL TO REMWS AT AJBAL12
;<4.MONITOR>SCHED.MAC.260, 26-Apr-79 11:07:54, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.259, 26-Apr-79 10:58:44, EDIT BY MILLER
;FIX AJBALS TO LOAD OR KEEP IF PROCESS IS CSKED
;<4.MONITOR>SCHED.MAC.258, 25-Apr-79 16:55:46, EDIT BY MILLER
;MORE FIXES TO AJBALS AND TRYLDF TO ALLOW LOADING IF PIBMP IS ON
;<4.MONITOR>SCHED.MAC.257, 25-Apr-79 16:20:00, EDIT BY MILLER
;REMOVE .SKSSD FUNCTION OF SKED
;<4.MONITOR>SCHED.MAC.256, 25-Apr-79 11:51:12, EDIT BY MILLER
;CHANGE CORFCT TO COMPUTE PIBMP PRIORITY DIFFERENTLY
; CHNAGE AJBALS TO ALWAYS KEEP A PIBMP PROCESS EVEN IF AJHQOF IS SET
;<4.MONITOR>SCHED.MAC.255, 24-Apr-79 13:54:13, EDIT BY OSMAN
;FIX SETTING BATCH CLASS (CORRECT TEST FOR VALID CLASS, CORRECT ERROR CODE)
;<4.MONITOR>SCHED.MAC.254, 20-Apr-79 14:40:43, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.253, 17-Apr-79 10:40:24, EDIT BY MILLER
;ADD CHECK FOR INTERRUPTABILITY AT PSISV0
;<4.MONITOR>SCHED.MAC.252, 14-Apr-79 13:17:52, EDIT BY MILLER
;FIX UP CODE FOR JOB LOAD AVERGES
;<4.MONITOR>SCHED.MAC.251, 13-Apr-79 16:50:20, EDIT BY MURPHY
;ONE MORE TIME ON ILIST
;<4.MONITOR>SCHED.MAC.250, 13-Apr-79 11:30:48, EDIT BY BOSACK
;CLEAR FULLWORD AT LIST END IN ILIST
;<4.MONITOR>SCHED.MAC.249, 13-Apr-79 11:07:25, EDIT BY MILLER
;CHECK FOR HIGH Q EARLY IN NEWST AND AVOID EXECUTING NEDLESS INSTRUCTIONS
;<4.MONITOR>SCHED.MAC.248, 12-Apr-79 13:03:23, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.247, 12-Apr-79 11:08:31, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.246, 11-Apr-79 15:13:32, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.245, 11-Apr-79 14:48:21, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.244, 11-Apr-79 14:41:26, EDIT BY MILLER
;BE SURE BUMP PRIORITY IS REMOVED AT UNPIR
;<4.MONITOR>SCHED.MAC.243, 10-Apr-79 15:48:31, EDIT BY MILLER
;DO A "SOS NBSWP" WHEN PRELOAD TEST SUCCEEDS
;<4.MONITOR>SCHED.MAC.242, 10-Apr-79 13:24:34, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.241, 10-Apr-79 12:13:50, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.240, 10-Apr-79 11:43:14, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.239, 10-Apr-79 11:32:00, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.238, 10-Apr-79 10:20:25, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.237,  5-Apr-79 11:17:03, Edit by MCLEAN
;REMOVE FIRST ARG FROM GTOKM
;<4.MONITOR>SCHED.MAC.236,  4-Apr-79 09:08:38, EDIT BY MILLER
;CHANGE PIBMP PRIORITY COMPUTATON
;<4.MONITOR>SCHED.MAC.235,  3-Apr-79 14:29:08, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.234,  3-Apr-79 10:46:31, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.233,  3-Apr-79 10:44:23, EDIT BY MILLER
;FIX UP HANDLING OF MJBUSE. DON'T PRELOAD FORK IF DOING A PSI
;<4.MONITOR>SCHED.MAC.232,  1-Apr-79 14:37:54, EDIT BY MILLER
;MORE PSI FIXES
;<4.MONITOR>SCHED.MAC.231,  1-Apr-79 13:47:33, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.230,  1-Apr-79 13:30:25, EDIT BY MILLER
;FIX UP PRIORITY CALCULATIONS. USE PIBMP FOR PI BOOSTING
;<4.MONITOR>SCHED.MAC.229, 31-Mar-79 13:55:24, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.228, 31-Mar-79 13:49:32, EDIT BY MILLER
;MORE FIXES TO NEWUTL
;<4.MONITOR>SCHED.MAC.227, 31-Mar-79 13:15:39, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.226, 29-Mar-79 18:20:49, EDIT BY BOSACK
;FIX CORFCT SO THAT CRSKED IS HIGHER PRIORITY THAN QUEUE 0 OR 1
;<4.MONITOR>SCHED.MAC.225, 29-Mar-79 17:33:33, EDIT BY MILLER
;ADJUST CLASS PARAMETERS WHEN A JOB LOGS OUT
;<4.MONITOR>SCHED.MAC.224, 29-Mar-79 11:40:59, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.223, 29-Mar-79 11:23:50, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.222, 29-Mar-79 11:19:37, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.221, 29-Mar-79 10:35:38, EDIT BY MILLER
;FIX NEWUTL COMPUTATIONS
;<4.MONITOR>SCHED.MAC.220, 28-Mar-79 13:35:42, EDIT BY MILLER
;ZERO JOBIRT AT JOBSRT. REMOVE CALL TO ADJCLS @ NEWUTL
;<4.MONITOR>SCHED.MAC.219, 27-Mar-79 13:40:51, EDIT BY MILLER
;FIX SKDSJC TO ALLOW THIS JOB
;<4.MONITOR>SCHED.MAC.218, 26-Mar-79 13:17:52, EDIT BY MILLER
;ONE MORE TRY
;<4.MONITOR>SCHED.MAC.217, 26-Mar-79 12:35:13, EDIT BY MILLER
;CHANGE ARGS ON GTOKM FOR .GOCLS
;<4.MONITOR>SCHED.MAC.216, 23-Mar-79 10:29:53, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.215, 21-Mar-79 17:41:40, EDIT BY MILLER
;MAKE SURE JOBCLS IS CORRECT AT JOBSRT
;<4.MONITOR>SCHED.MAC.214, 20-Mar-79 18:26:37, EDIT BY MURPHY
;PERFORMANCE - RPLQ LOW LOGIC
;<4.MONITOR>SCHED.MAC.212, 13-Mar-79 17:10:02, EDIT BY HURLEY
;FIX GTOKM TO HAVE A LEADING 0 ARGUMENT
;<4.MONITOR>SCHED.MAC.211, 13-Mar-79 10:37:17, EDIT BY MILLER
;ALLOW 0 PERCENTAGE TO BE GIVEN TO A CLASS
;<4.MONITOR>SCHED.MAC.210, 11-Mar-79 12:54:43, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>SCHED.MAC.209,  9-Mar-79 16:38:59, EDIT BY MURPHY
;ELIMINATE SWAPOUT OF PSB, UPT WHEN FORK KILLED
;<4.MONITOR>SCHED.MAC.208,  9-Mar-79 13:53:30, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.207,  9-Mar-79 13:16:24, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.206,  9-Mar-79 11:58:13, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.205,  9-Mar-79 11:17:37, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.204,  8-Mar-79 15:57:31, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.203,  8-Mar-79 14:56:23, EDIT BY MILLER
;IMPROVE CHGCLS
;<4.MONITOR>SCHED.MAC.202,  8-Mar-79 11:24:53, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.201,  7-Mar-79 17:26:05, EDIT BY MILLER
;CHANGE CORFCT TO INCLUDE QUEUE 2 IN THE CLASS "INTERACTIVE" SET
;<4.MONITOR>SCHED.MAC.200,  7-Mar-79 12:50:25, EDIT BY MILLER
;DON'T HONOR SK%HQR IF USING CLASS SCHEDULER
;<4.MONITOR>SCHED.MAC.199,  6-Mar-79 10:58:13, EDIT BY OSMAN
;tco 4.2202 - SK%DRG, change u/s order in .SKRCV
;<4.MONITOR>SCHED.MAC.198,  5-Mar-79 20:05:10, EDIT BY MURPHY
;FIX PRELOAD BUG
;<4.MONITOR>SCHED.MAC.197,  4-Mar-79 13:46:14, EDIT BY MILLER
;MAKE SURE CLASS SURE IS>= .5%
;<4.MONITOR>SCHED.MAC.196,  2-Mar-79 17:48:52, EDIT BY MURPHY
;PREVENT CRSKED FORKS FROM LOCKING OUT HIGHQ FORKS
;<4.MONITOR>SCHED.MAC.195,  2-Mar-79 16:45:25, Edit by MCLEAN
;ADD NEW ERROR CODES FOR SKED%
;<4.MONITOR>SCHED.MAC.194,  1-Mar-79 15:19:01, EDIT BY BOSACK
;MAKE INTERACTIVE BIAS WITHIN CLASS SOMEWHAT STRONGER
;<4.MONITOR>SCHED.MAC.193,  1-Mar-79 13:39:34, EDIT BY OSMAN
;USE ARG BLOCK OFFSET SYMBOLS IN SKED% JSYS
;<4.MONITOR>SCHED.MAC.192,  1-Mar-79 10:47:36, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.191, 28-Feb-79 12:27:58, EDIT BY MILLER
;FIX CLDRJ
;<4.MONITOR>SCHED.MAC.190, 27-Feb-79 15:58:47, Edit by MCLEAN
;MAKE  .SKRCS RETURN LOAD AVERAGES ALSO
;<4.MONITOR>SCHED.MAC.189, 27-Feb-79 14:41:22, EDIT BY MILLER
;FIX CHGCLS TO RECOMPUTE CLASS GOLST COUNTS FOR OLD AND NEW CLASSES
;<4.MONITOR>SCHED.MAC.188, 19-Feb-79 23:22:17, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.187, 13-Feb-79 16:58:26, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.186,  4-Feb-79 23:05:58, EDIT BY MURPHY
;PERFORMANCE TUNING
;<4.UTILITIES>SCHED.MAC.1,  9-Jan-79 10:41:51, EDIT BY HALL
;FIX COUNT
;<4.MONITOR>SCHED.MAC.184,  8-Jan-79 13:46:28, EDIT BY MILLER
;ONCE AGAIN, FIX UP CLASS LOAD AVG COMPUTATION
;<4.MONITOR>SCHED.MAC.183,  8-Jan-79 06:58:56, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
;	Change PSECT bounds name.
;<4.MONITOR>SCHED.MAC.182,  7-Jan-79 23:55:21, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.178,  5-Jan-79 11:15:03, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.177,  4-Jan-79 15:38:23, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.176,  3-Jan-79 10:57:17, EDIT BY MILLER
;FIX CLASS LOAD AVG COMPUTATION
;<4.MONITOR>SCHED.MAC.175,  3-Jan-79 10:40:13, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.174,  3-Jan-79 10:31:48, EDIT BY MILLER
;<MURPHY.MON>SCHED.MAC.6,  4-Jan-79 14:46:11, EDIT BY MURPHY
;NEW HOLD LOGIC
;<4.MONITOR>SCHED.MAC.173,  2-Jan-79 17:24:18, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.172,  2-Jan-79 12:45:20, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.171,  2-Jan-79 10:24:57, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.170,  2-Jan-79 10:17:31, EDIT BY MILLER
;MAKE FIXED FOR CLASS SCHEDULER
;<4.MONITOR>SCHED.MAC.169, 29-Dec-78 12:29:50, EDIT BY MURPHY
;REVISE QUANTUM TIMES
;<4.MONITOR>SCHED.MAC.167, 29-Dec-78 11:17:53, EDIT BY MILLER
;COMPUTE ON-GOLST COUNT PER CLASS. NEEDED IN LOAD AVERAGE COMPUTATION
;<MURPHY.MON>SCHED.MAC.1, 27-Dec-78 15:25:55, EDIT BY MURPHY
;REMOVE PUFLD AND CORE NUMBERS
;ENSURE ADEQUATE STACK AT TRYLDF
;<4.MONITOR>SCHED.MAC.162, 21-Dec-78 14:38:42, EDIT BY MILLER
;DO SAME JUGGLE AT TLEINT
;<4.MONITOR>SCHED.MAC.161, 21-Dec-78 14:29:08, EDIT BY MILLER
;USE NORMAL PROCESS STACK AT PSIT1 WHEN PSIR4 IS CALLED
;<4.MONITOR>SCHED.MAC.160, 21-Dec-78 10:55:44, EDIT BY MILLER
;FIX UP REDIT ERROR. REORDR NO LONGER A SUBROUTINE
;<4.MONITOR>SCHED.MAC.159, 21-Dec-78 10:50:23, EDIT BY MILLER
;FIX REORDR
;<4.MONITOR>SCHED.MAC.158, 20-Dec-78 18:21:43, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.151, 19-Dec-78 10:23:09, EDIT BY MILLER
;REMOVE CODE THAT FORCES ERJMP TO SECTION OF CALL. UCODE 215 WORKS
;<4.MONITOR>SCHED.MAC.150, 14-Dec-78 17:23:46, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.143,  6-Dec-78 11:02:16, EDIT BY ENGEL
;MAKE PTY HUNGRY AFTER A ?FULL MESSAGE
;<4.MONITOR>SCHED.MAC.142,  5-Dec-78 14:04:50, EDIT BY MILLER
;SAVE LAST SETTING OF KNOB SO SKED JSYS ALWAYS REPPORTS ACCURATE VALUE
;<4.MONITOR>SCHED.MAC.141, 16-Nov-78 15:56:46, EDIT BY MILLER
;FIX CODE AT PSII THAT SETS NEW PC AND FLAGS
;<4.MONITOR>SCHED.MAC.140, 15-Nov-78 12:35:14, EDIT BY MILLER
;MAKE SURE PCS IS NOT LOST WHEN MENT0 IS INVOKED
;<4.MONITOR>SCHED.MAC.139, 15-Nov-78 12:22:30, EDIT BY MILLER
;MAKE SURE FFL CONTAINS PCS IN MENTU
;<4.MONITOR>SCHED.MAC.138,  3-Nov-78 17:22:49, EDIT BY MURPHY
;FIX ANCIENT ENTSKD BUG
;<4.MONITOR>SCHED.MAC.137,  2-Nov-78 11:05:12, EDIT BY MURPHY
;<MURPHY.MON>SCHED.MAC.23,  7-Dec-78 13:51:58, EDIT BY MURPHY
;NEW SWAP LOGIC
;<4.MONITOR>SCHED.MAC.136, 24-Oct-78 13:27:44, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.135, 23-Oct-78 15:21:29, EDIT BY MILLER
;ONE MORE CHANGE TO NEWST
;<4.MONITOR>SCHED.MAC.134, 23-Oct-78 13:43:13, EDIT BY MILLER
;FIX NEWST TO DO Q ADJUSTMENTS FOR CLASS SCHEDULER.
;<4.MONITOR>SCHED.MAC.133, 21-Oct-78 14:33:22, EDIT BY MILLER
;USE PSBUMP EVEN IF CLASS SCHEDULING ON
;<4.MONITOR>SCHED.MAC.132, 20-Oct-78 18:47:18, EDIT BY MILLER
;CHANGE CORFCT TO "ROUND-ROBIN" FORKS OF EQUAL PRIORITY
;<4.MONITOR>SCHED.MAC.131, 19-Oct-78 14:57:24, EDIT BY MILLER
;FIX SAVRT TO ALWAYS CALL GLREM AND GOCONC
;<4.MONITOR>SCHED.MAC.130,  9-Oct-78 09:09:34, EDIT BY MILLER
;PUT ERJMPS IN CODE TO REFERENCE USER PSI WORDS
;<4.MONITOR>SCHED.MAC.129,  1-Oct-78 22:16:47, EDIT BY DBELL
;TCO 4.2027 - SAVE TIME JOB STARTED IN SRTTIM
;<4.MONITOR>SCHED.MAC.128, 29-Sep-78 12:34:25, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.127, 29-Sep-78 10:11:21, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.126, 29-Sep-78 10:09:28, EDIT BY MILLER
;REMOVE VARIABLE PERIOD CODE FOR NOW
;<4.MONITOR>SCHED.MAC.125, 28-Sep-78 16:34:12, EDIT BY MILLER
;FIX NEWUTL SO PERIODS CAN BE VARIABLE
;<4.MONITOR>SCHED.MAC.124, 28-Sep-78 12:12:55, EDIT BY MILLER
;MAKE UTLEXP A VECTOR. ADD FIELD FOR NEWUTL SKIP COUNT
;<4.MONITOR>SCHED.MAC.123, 27-Sep-78 15:14:48, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.121, 27-Sep-78 11:28:39, EDIT BY MILLER
;FIX CORFCT TO DO COMPUTATION CORRECTLY
;<4.MONITOR>SCHED.MAC.120, 22-Sep-78 16:42:08, EDIT BY MILLER
;GET SCHEDULER'S STACK BEFORE GOING TO DISMSE AT PSIDF1
;<4.MONITOR>SCHED.MAC.119, 21-Sep-78 18:28:02, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.118, 20-Sep-78 11:28:20, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.117, 19-Sep-78 15:38:03, EDIT BY ENGEL
;MAKE THE "FULL" MESSAGE INTO "?FULL".
;<4.MONITOR>SCHED.MAC.116, 18-Sep-78 18:10:33, EDIT BY MILLER
;<MURPHY.MON>SCHED.MAC.5, 21-Sep-78 17:18:03, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.115, 18-Sep-78 12:18:15, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.114, 17-Sep-78 15:01:09, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.113, 17-Sep-78 14:13:18, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.112, 17-Sep-78 13:46:58, EDIT BY MILLER
;ADD FUNCTION TO READ CLASS PARAMETERS
;<4.MONITOR>SCHED.MAC.111, 16-Sep-78 15:34:42, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.110, 16-Sep-78 15:12:15, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.109, 16-Sep-78 15:05:34, EDIT BY MILLER
;ADD SKDLOG ROUTINE.
;<4.MONITOR>SCHED.MAC.108, 16-Sep-78 13:45:45, EDIT BY MILLER
;ADD MFRKWD DEF
;<4.MONITOR>SCHED.MAC.107, 16-Sep-78 13:17:46, EDIT BY MILLER
;ADD GTOKM TO "SET JOB CLASS" FUNCTION
;<4.MONITOR>SCHED.MAC.106, 16-Sep-78 12:58:08, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.105, 16-Sep-78 12:56:06, EDIT BY MILLER
;REWRITE SKED JSYS
;<4.MONITOR>SCHED.MAC.104, 15-Sep-78 12:09:36, EDIT BY MILLER
;FIX UP QUEUE TESTING IN AJBALS
;<4.MONITOR>SCHED.MAC.103, 15-Sep-78 11:00:16, EDIT BY MILLER
;ADD BATCH DREGS STUFF
;<4.MONITOR>SCHED.MAC.102, 14-Sep-78 17:24:25, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.99,  1-Sep-78 17:01:45, EDIT BY BOSACK
;<4.MONITOR>SCHED.MAC.98,  1-Sep-78 15:08:07, EDIT BY BOSACK
;CAUSE ERCAL TO NOT STORE FLAGS
;<4.MONITOR>SCHED.MAC.97,  1-Sep-78 13:45:24, EDIT BY BOSACK
;CAUSE ERJMP IN USER TO RETURN TO SECTION OF CALL
;<4.MONITOR>SCHED.MAC.96, 29-Aug-78 17:12:17, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.94, 27-Aug-78 13:05:29, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.93, 27-Aug-78 09:54:04, EDIT BY MILLER
;REMOVE TCDIV. ADD BATCH CLASS CODE
;<4.MONITOR>SCHED.MAC.92, 27-Aug-78 09:16:10, EDIT BY MILLER
;ADD BATCH CLASS WORD AND DEFAULT CLASS WORD
;<4.MONITOR>SCHED.MAC.91, 25-Aug-78 18:16:13, EDIT BY MURPHY
;REMOVE BALSET PARTITIONING, ADD DISASTER AVOIDANCE
;<MURPHY.MON>SCHED.MAC.3, 24-Aug-78 17:26:19, EDIT BY MURPHY
;GLOBAL PAGE AGING
;<4.MONITOR>SCHED.MAC.88, 25-Aug-78 08:25:36, EDIT BY MILLER
;MAKE CLASS COUNTS BE BASED ON LOGGED-IN JOBS
;<4.MONITOR>SCHED.MAC.87, 24-Aug-78 17:33:24, EDIT BY MILLER
;CLEAR CLASS COUNTS WHEN STARTING CLASS SCHEDULER
;<4.MONITOR>SCHED.MAC.86, 24-Aug-78 17:25:17, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.85, 24-Aug-78 12:57:58, EDIT BY MILLER
;FIX UP STARTING OF CLASS SCHEDULER
;<4.MONITOR>SCHED.MAC.84, 24-Aug-78 11:45:14, EDIT BY MILLER
;ADD SETCLS
;<4.MONITOR>SCHED.MAC.83, 23-Aug-78 08:22:30, EDIT BY MILLER
;CHANGE SAVRT NOT TO DEQUEUE AND REQUEUE PROCESS IF USING CLASS SCHEDULER
;<4.MONITOR>SCHED.MAC.82, 22-Aug-78 15:22:06, EDIT BY MILLER
;FIX UP CLASS DISTANCE COMPUTATION
;<4.MONITOR>SCHED.MAC.81, 21-Aug-78 08:43:42, EDIT BY MILLER
;FIX NEWST FOR CLASS SCHEDULING
;<4.MONITOR>SCHED.MAC.80, 18-Aug-78 13:44:47, EDIT BY HALL
;DO REORDR EACH TIME NEWUTL IS CALLED
;<4.MONITOR>SCHED.MAC.79, 15-Aug-78 16:59:28, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.78, 14-Aug-78 13:00:00, EDIT BY MILLER
;CLEAR CLSSUM AND CLSRJA WHEN CLASS SCHEDULER IS TURNED ON
;<4.MONITOR>SCHED.MAC.77, 14-Aug-78 12:17:55, EDIT BY MILLER
;ADD CLASS LOAD AVERAGE COMPUTATIONS. REWRITE DORJ1.
;<4.MONITOR>SCHED.MAC.76, 13-Aug-78 15:50:33, EDIT BY MILLER
;DON'T CALL PSBUMP IF DOING CLASS SCHEDULING
;<4.MONITOR>SCHED.MAC.75, 13-Aug-78 15:24:15, EDIT BY MILLER
;CLEAN UP CODE IN CLASS SCHEDULER.
;<4.MONITOR>SCHED.MAC.74, 13-Aug-78 12:30:32, EDIT BY MILLER
;FINISH REMOVING JOBQ
;<4.MONITOR>SCHED.MAC.73, 13-Aug-78 12:14:14, EDIT BY MILLER
;REMOVE JOBQ,CLSQ,CLSQI
;<4.MONITOR>SCHED.MAC.72, 12-Aug-78 13:38:31, EDIT BY MILLER
;DON'T INHIBIT LOAD OF FORK AT AJBCQS IF DOING CLASS SCHEDULING
;<4.MONITOR>SCHED.MAC.71, 12-Aug-78 12:52:38, EDIT BY MILLER
;DO CLSSHI UPDATES AT NEWUTL
;<4.MONITOR>SCHED.MAC.70, 12-Aug-78 10:53:52, EDIT BY MILLER
;REDO CLASS SCHEDULER. MAKE IT INDEPENDENT OF BALSET SCHEDULER
;<4.MONITOR>SCHED.MAC.69, 11-Aug-78 13:04:17, EDIT BY MILLER
;FIX GETJQ AND CORFCT
;<4.MONITOR>SCHED.MAC.68, 11-Aug-78 10:22:20, EDIT BY HALL
;FIX COUNT TO CALL ADJCLS IF COMPUTED COUNT IS DIFFERENT FROM OLD COUNT
;<4.MONITOR>SCHED.MAC.67, 11-Aug-78 08:15:22, EDIT BY MILLER
;fix typeo
;<4.MONITOR>SCHED.MAC.66, 11-Aug-78 08:05:39, EDIT BY MILLER
;FIX CLASS SCHEUDLER COMPUTATIONS
;<4.MONITOR>SCHED.MAC.65, 10-Aug-78 17:04:37, Edit by DBELL
;TCO 1905.  PREVENT ZERO POINTER IN TLEINT FROM CAUSING RESBAD, ILLUUO BUGCHKS
;<4.MONITOR>SCHED.MAC.64,  3-Aug-78 11:02:49, EDIT BY MILLER
;FIX TYPEOS
;<4.MONITOR>SCHED.MAC.63,  3-Aug-78 08:37:58, EDIT BY MILLER
;<4.MONITOR>SCHED.MAC.62,  3-Aug-78 08:36:21, EDIT BY MILLER
;CHANGE COMPUTATION OF CLASS POPULATION
;<4.MONITOR>SCHED.MAC.61, 30-Jul-78 10:28:22, EDIT BY MILLER
;CHECK IN LOGOUT CODE FOR JOB IN A CLASS
;<4.MONITOR>SCHED.MAC.60, 25-Jul-78 15:23:20, EDIT BY MILLER
;FIX SKJFC2 NOT TO CALL GCCOR SO MANY TIMES
;<4.MONITOR>SCHED.MAC.59, 25-Jul-78 13:32:07, Edit by PORCHER
;TCO 1953 - FIX CHKERT ROUTINE TO CHECK ONLY OP/AC FOR ERJMP/ERCAL
;<4.MONITOR>SCHED.MAC.58, 18-Jul-78 15:04:28, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.56, 17-Jul-78 11:04:25, EDIT BY MILLER
;REMOVE "SCALING" CODE AT ONBSQ
;<4.MONITOR>SCHED.MAC.55, 14-Jul-78 11:41:26, EDIT BY MILLER
;MORE CLASS FIXES
;<4.MONITOR>SCHED.MAC.54, 14-Jul-78 08:44:34, EDIT BY MILLER
;CHANGE VALUE OF SKDBQC FOR BETTER PRECISION
;<4.MONITOR>SCHED.MAC.53, 13-Jul-78 20:53:00, EDIT BY MILLER
;MORE CLASS SCHEDULING CODE
;<4.MONITOR>SCHED.MAC.52, 12-Jul-78 16:45:14, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.51, 12-Jul-78 16:34:06, EDIT BY MILLER
;FIX UP CHECK AT SAVRT9
;<4.MONITOR>SCHED.MAC.50, 11-Jul-78 12:58:07, EDIT BY MILLER
;CHECK FKMNQ AT ALL PLACES WHERE QUEUE CHANGES.
;<4.MONITOR>SCHED.MAC.49, 10-Jul-78 13:34:32, EDIT BY MILLER
;ADD MORE MAXCLS
;<4.MONITOR>SCHED.MAC.48, 10-Jul-78 13:29:52, EDIT BY MILLER
;TCO 1938. ADD CLASS SCHEDULER CODE
;<4.MONITOR>SCHED.MAC.45,  6-Jul-78 07:31:29, EDIT BY MILLER
;MORE FIXED FOR TCO 1929. FIX CODE AT PRISET
;<4.MONITOR>SCHED.MAC.43,  1-Jul-78 12:08:12, EDIT BY MILLER
;REMOVE ONBSQN
;<4.MONITOR>SCHED.MAC.42,  1-Jul-78 12:07:43, EDIT BY MILLER
;RESTORE USE OF SK%BQR AND SK%BQE
;<4.MONITOR>SCHED.MAC.41, 30-Jun-78 16:40:29, EDIT BY MURPHY
;TCO #1930 - CRITICAL SECTION FACILITY
;<4.MONITOR>SCHED.MAC.38, 30-Jun-78 14:21:31, EDIT BY MILLER
;FIX CODE IN SAVRT TO INSURE QUEUE IS CORRECT IF QUEUE #'S SET
;<4.MONITOR>SCHED.MAC.36, 30-Jun-78 13:40:13, EDIT BY MILLER
;INITIALIZE FKQMX IN ASSFK
;<4.MONITOR>SCHED.MAC.35, 30-Jun-78 13:35:20, EDIT BY MILLER
;MORE FIXES TO QUEUE NUMBERS
;<4.MONITOR>SCHED.MAC.34, 30-Jun-78 11:06:42, EDIT BY MILLER
;CHECK FKMNQ AT NEWST3
;<4.MONITOR>SCHED.MAC.27, 23-Jun-78 17:59:36, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.23, 20-Jun-78 13:13:55, EDIT BY MILLER
;FIX UP ALL XJRSTFS TO PRESERVE FLAGS. CHANGE MJRST1 TO USE JRST @
;<1BOSACK>SCHED.MAC.1001,  5-Jun-78 21:38:18, EDIT BY BOSACK
;<1BOSACK>SCHED.MAC.1000,  5-Jun-78 19:02:46, EDIT BY BOSACK
;<4.MONITOR>SCHED.MAC.21, 19-Jun-78 17:17:41, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.20, 19-Jun-78 13:50:46, Edit by MCLEAN
;ADD GOKFRE FOR GETOK JSYS TCO 1908
;<3A.MONITOR>SCHED.MAC.8, 12-Jun-78 10:07:17, EDIT BY MILLER
;TCO 1894. MAKE SURE CTY OUTPUT IS STARTED AT SWHLT3
;<4.MONITOR>SCHED.MAC.18,  8-Jun-78 09:12:45, EDIT BY MILLER
;FIX ITRSIM TO DO SPECIAL HANDLING OF MONITOR CALLS. (SEE NOTE)
;<3A.MONITOR>SCHED.MAC.7,  7-Jun-78 07:58:15, EDIT BY MILLER
;FIX DISMS JSYS
;<3A.MONITOR>SCHED.MAC.6,  7-Jun-78 07:56:41, EDIT BY MILLER
;ALLOW HDISMS OF ARBITRARY TIME
;<4.MONITOR>SCHED.MAC.16, 17-May-78 17:12:28, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.15, 16-May-78 16:49:29, EDIT BY MURPHY
;<4.MONITOR>SCHED.MAC.14, 16-May-78 14:32:36, EDIT BY MURPHY
;<MURPHY.MON>SCHED.MAC.8, 16-May-78 13:13:41, EDIT BY MURPHY
;TCO #1904 - WORKING SET SWAPPING
;<3A.MONITOR>SCHED.MAC.5, 24-Apr-78 17:20:54, EDIT BY MURPHY
;<3A.MONITOR>SCHED.MAC.4, 18-Apr-78 17:12:36, EDIT BY MURPHY
;<3A.MONITOR>SCHED.MAC.3, 13-Apr-78 15:09:47, EDIT BY MURPHY
;TCO #1901 - SCHEDULER CONTROLS FOR INTERACTIVE/COMPUTATIONAL BIAS
;<4.MONITOR>SCHED.MAC.10,  3-Apr-78 13:42:58, EDIT BY MILLER
;REMOVE 2 MS DELAY FROM SCHPRF
;<4.MONITOR>SCHED.MAC.9, 11-Mar-78 10:48:32, EDIT BY MILLER
;FIX UP REG USE IN RTG1
;<4.MONITOR>SCHED.MAC.8, 10-Mar-78 10:07:30, EDIT BY MILLER
;TCO 1889. CHECK JOBSKD AS WELL AS JOBBIT IN SAVRT
;<4.MONITOR>SCHED.MAC.7,  9-Mar-78 13:44:09, EDIT BY MILLER
;MAKE TERM INT FIELD IN FKINT BE 9 BITS. FREE UP 9 BITS FOR INTS
;<4.MONITOR>SCHED.MAC.6,  9-Mar-78 08:52:13, EDIT BY MILLER
;CLEAR "QUOTA EXCEEDED" BIT AT MRETN
;<4.MONITOR>SCHED.MAC.5, 21-Feb-78 14:59:24, Edit by HALL
;INITIALIZE JSAMX AT FKSET1
;<3.SM10-RELEASE-3>SCHED.MAC.6, 10-Feb-78 17:10:26, Edit by MCLEAN
;REMOVE LOW CORE DEFINITONS (SJOBD,SLITES AND SPRIJD) BECAUSE
;THEY ARE NEEDED SINCE THEY ARE NOT SAVED OR DESTROYED OVER
;RELOADS AND ALSO THEY ARE NOT CACHED.
;<4.MONITOR>SCHED.MAC.3,  1-Feb-78 11:11:39, EDIT BY MILLER
;ONE MORE FIX. CHECK FOR ERCAL AND ERJMP CORRECTLY
;<4.MONITOR>SCHED.MAC.2,  1-Feb-78 09:43:57, EDIT BY MILLER
;FIX ITRSIM TO ALLOW INDEXING/INDIRECTION ON ERJMP/ERCAL.
;<4.MONITOR>SCHED.MAC.1, 31-Jan-78 08:10:12, EDIT BY MILLER
;TCO 1880. REMOVE CALL TO SETOVF IN SKDJOB

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE SCHED

; SCHEDULER - D. MURPHY

;SPECIAL AC DEFINITIONS USED HEREIN

DEFAC (FX,Q3)			;FORK INDEX

;LOCAL MACROS

;USED INTERNALLY BY SCHEDULER
;ENTER SCHEDULER CONTEXT

DEFINE ENTSKD<
	SKIPE INSKED
	CALL REEBUG		;;ALREADY IN SCHED, BUGHLT
	AOS INSKED
	XPCW ENSKR>

;LOCAL ITEMS IN STG.MAC

EXTN <N2CLKS,CLK2TM,LV8CHK,CLK2CL,SCHPF0,NHOLDF>
EXTN <PAGDIF,ADJSWP,TSTFRP,HPSWRN>

;CLASS SCHEDULER EXTERNALS

EXTN <CLSSHR,CLSCNT,JOBIRT,CLSUTL,CLSDST,CLSSUM,CLSRJA>
EXTN <MJBUSE,UTLTIM,UTLINT,OLDSLD,CLASSF>
EXTN <JOBDST,JOBCLS,JOBUTL,CLSSHI,MAXCLS,CLSCTL,CLSIRT,WA>

DEFSTR (CLGLC,CLSCNT,17,18)	;COUNT OF PROCESSES ON GOLST FOR THIS CLASS
;LOWER CORE LOCATIONS FOR LITES DISPLAY


SHLTW==:30			;SCHEDULER HALT REQUEST WORD
SCTLW==:20			;SCHEDULER CONTROL WORD

MINNR==:4			;MIN SIZE OF RPLQ FOR LOADING FORK
TRMINT==^D19			;FORK TERMINATION CHANNEL

;ASSUMED WORKING SET SIZE (MINIMUM) FOR FORK WAKING UP AFTER LONG
;BLOCK.

MINWSS::^D10

;VALUES FOR DISASTER AVOIDANCE - USED ONLY IF SK%HQR = 1

;THESE ARE THE VALUES OF THE HQ LDAV AT WHICH AJNNLF WILL GO OFF AND ON
;RESPECTIVELY.  AJNNLF PREVENTS NEW LQ FORKS FROM COMING INTO THE BALSET
;WHEN ON.  THE TWO VALUES ARE SEPARATED SLIGHTLY TO PREVENT INSTABILITY.

HQLEV1::4.0			;'OFF' VALUE FOR AJNNLF
HQLEV2::6.0			;'ON' VALUE FOR AJNNLF

;THESE ARE THE VALUES OF THE HQ LDAV AT WHICH AJHQOF WILL GO OFF AND ON
;RESPECTIVELY.  AJHQOF FORCES LQ FORKS OUT OF THE BALSET.  AGAIN, TWO
;VALUES PREVENT INSTABILITY.

HQLEV3::6.0			;'OFF' VALUE FOR AJHQOF
HQLEV4::9.0			;'ON' VALUE FOR AJHQOF

;BASIC PERIODS

SKDSCY:	^D20			;SHORT CYCLE
SKDLCY:	^D100			;LONG CYCLE
AJBLCY:	^D1000			;AJBALS CYCLE
SKDBQT:	^D200*NTMS		;BALSET RUN QUANTUM
	MINQNT==^D10*NTMS	;MINMUM TIME BEFORE CHANGING ALARM
	SMLSTM==^D10		;ALARM CYCLE TO CATCH SMALL QUANTA
UTLTMI==^D1000			;TIME PERIOD
UTLINI==3			;# OF PERIODS IN A COMPUTE CYCLE
UTLEXP:	0.983471454		;e-(1/60)
	0.9672161		;e-(2/60)
	0.951229424		;e-(3/60)
	0.935506985		;e-(4/60)

	DEFSTR (SKPCT,JOBNAM,2,2) ;SKIP COUNT FOR NEWUTL
	MXSKPS==3		;MAX VALUE OF SKIP COUNT
;THE FOLLOWING MACROS AND COMPUTATIONS ARE NECESSARY DUE
;TO MACROS INABILITY TO PERFORM FLOATING POINT
;COMPUTATIONS.

	RADIX 10
MINSHR==5			;MIN % A SHARE MAY HAVE
MAXVAL==1000/MINSHR		;MAX BIAS FOR CLASS PRIORITY

;NOW SOME MACROS TO DO THE FP CONSTRUCTIONS

   DEFINE FLTMIN (A) <

	SHRMIN==0.00'A
   >

   DEFINE FLTMAX (A) <

	MXBIAS==A'.0>

;NOW PRODUCE THE VALUES

	FLTMIN (\MINSHR)	;FP REPRESENTATION OF MINSHR
	FLTMAX (\MAXVAL)	;FP REPRESENTATION OF MAXVAL

	RADIX 8			;RETURN TO DEFAULT RADIX
;STANDARD VALUES FOR SCHEDULER INTERACTIVE/COMPUTATIONAL FLAGS
; ON A SCALE OF 0 - 9

   REPEAT 0,<			;FOR REFERENCE ONLY - DEFINITIONS IN MONSYM
SK%CYT==:1B18			;CYCLE TIME
SK%IOC==:1B19			;IO QUANTUM CHARGE
SK%HT1==:1B20			;LIMIT HOLD TIME IF 1
SK%HT2==:1B21			;NO HOLD TIME AFTER SKIPPED FORK IF 1
SK%HQR==:1B22			;HIGH QUEUE FORKS HAVE ABSOLUTE PRIORITY UNDER LOAD
SK%CL1==:1B23			;USE NORMAL CORFCT WITH CLASS SKED IF 0
;24 NOT USED
SK%RSQ==1B25			;QUICK RESCHEDULE ON WAKEUP EVENTS
SK%RQ1==:1B26			;REQUEUE TO QUEUE 1
SK%TTP==:1B27			;TTY PREFERENCE
SK%WCF==:1B28			;WAIT CREDIT PROPORTIONAL TO LOAD AV
   >

SKFLGV::BYTE (18) 0 (1) 1,0,1,1,1,1,1,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,1,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,1,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0
;**;[2846]CHANGE 1 LINE AT SKFLDF:	DSC	26-OCT-82
SKFLDF:	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0 ;[2846]NORMAL DEFAULT
	BYTE (18) 0 (1) 1,0,1,0,0,0,1,0,0,1,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,0,0
	BYTE (18) 0 (1) 0,0,0,0,0,0,1,0,0,0,0
	BYTE (18) 0 (1) 0,0,0,0,0,0,1,0,0,0,0
NSKFLV==:.-SKFLGV

;CLASS SCHEDULING STRUCTURE DEFS

DEFSTR (CLSBD,CLSCTL,0,1)		;BATCH JOBS TO DREGS QUEUE
DEFSTR (CLSDF,CLSCTL,9,9)		;DEFAULT CLASS
DEFSTR (CLSBT,CLSCTL,18,9)		;BATCH CLASS
DEFSTR (CLSAC,CLSCTL,19,1)		;IF ON, CLASS BY ACCOUNTS
DEFSTR (CLSKV,CLSCTL,25,6)	;CURRENT KNOB VALUE

	DREGS==<LOWQ>B29+LOWQ+1		;BATCH DREGS PRIORITY WORD
; Execute only information for JSYS trapping
	SFEXO==1B1		;EXECUTE ONLY BIT IN SYSFK
;SCHEDULER INITIALIZATION

SCDIN::	SETZM SYSIFG
	SETZM PWRDWN
	SETZM FACTSW		;INITIALIZE SYSTEM FLAGS WORD
	SETZM RSKCHK+2		;INSURE FLAGS WORD 0
	MOVE F,SKFLDF		;SET DEFAULT CONTROL FLAGS
	MOVEM F,SCHFLG
	MOVE T1,[BUG (SCDUUO)]
	MOVEM T1,MJRSTF		;INIT SCHEULER'S UUO DISPTACH TO BUGHLT
	MOVEI T1,SKFLDF-SKFLGV+1 ;GET KNOB VALUE
	STOR T1,CLSKV		;SAVE IT
	SETOM WA		;INIT WINDFALL ALLOCATION
	MOVE T1,[WA,,WA+1]
	BLT T1,WA+MAXCLS-1	;INIT ALL TO -1
	MOVEI T1,UTLTMI*UTLINI	;DEFAULT INTERVAL FOR UTIL
	MOVEM T1,UTLINT		;SET UP INTERVAL
	SETZM UTLTIM		;WHEN TO COMPUTE UTILIZATION
	MOVE T1,[RSKCH1]	;SETUP JSR DISPATCH
	MOVEM T1,RSKCHK+3
	MOVEI T1,JTLST		; Set up JSYS trap queue
	MOVEM T1,JTLSTL
	MOVE T1,[1B0+FKPT]
	MOVEI 2,NFKS
	CALL ILIST		;INIT FREE FORK LIST
	HRRZM 1,FREFK
	MOVEI 1,JOBPT
	MOVEI 2,NJOBS
	CALL ILIST
	MOVEM 1,FREJOB		;INIT FREE JOB LIST
	SETOM JOBRT
	MOVE 1,[XWD JOBRT,JOBRT+1]
	BLT 1,JOBRT+NJOBS-1
	SETZM SCTLW
	SETZM SHLTW
	SETOM SCDRN1
	SETOM FORKX
	SETOM TADIDT
	SETOM SSKED
	MOVEM 1,INSKED
	MOVX 1,SF%FAC!SF%CRD!SF%MS1
				;INIT FACTSW TO FACT FILE ON
				;  AND ALLOW USERS TO CHANGE DIR PARAMETERS
				; AND DO MESSAGE LEVEL 1 ONLY
	IORM 1,FACTSW
	MOVSI 1,(1B1)
	MOVEM 1,CHKTIM		;PREVENT JOB 0 ALARM UNTIL INITIALIZED

;GENERATE LQWBAS TABLE

	MOVEI T2,INTQ1		;FIRST QUEUE TO DO
SCDIN0:	FLTR T1,T2		;GET FLOAT OF QUEUE NUMBER
	FDVR T1,FLOWQ		;DO DIVIDE
	FSBRI T1,(1.0)		;DO -(1-Q/LOWQ)
	FDVRI T1,(10.0)		;COMPLETE COMPUTATION
	MOVNM T1,LQWBAS-INTQ1(T2) ;STASH IT
	ADDI T2,1		;NEXT Q
	CAIG T2,LOWQ		;ALL DONE?
	JRST SCDIN0		;NO. MORE THEN
	CALLRET QBIAS		;SET UP BAIS QUANTUM TABLE
ILIST::	ADDI 1,-1(2)
	HLLZM T1,0(T1)		;CLEAR END OF LIST
	SOJLE 2,ILIST1		;  SIZE OF BLOCK IN 2
	MOVEM 1,-1(1)
	SUBI 1,1
	SOJG 2,.-2
ILIST1:	RET
	SUBTTL Channel 7 Interrupt Routines

;CLOCK, POSSIBLE RESCHEDULING, OR START PROCESS FROM SCHEDULER

PISC7::	XWD PISC7R,.+1
	CLSB SCDCHN		;ISB MUST BE EXPLICITLY CLEARED ON KI
	SKIPN RSKCHK+1		;CALL FROM RESKED CHECK?
	IFSKP.
	  DMOVEM T1,PI7AC1 	;SAVE ACS
	  DMOVE T1,RSKCHK	;MOVE FLAGS AND PC TO USUAL PLACE
	  DMOVEM T1,PISC7R
	  SETZM RSKCHK+1	;CLEAR INDICATOR
	  DMOVE T1,PI7AC1	;RESTORE ACS
	ENDIF.
	SKIPN SKEDFC		;FORCED MEMORY CLEAR?
	SKIPG SCKATM		;ALARM CLOCK?
	AOS SKEDF3		;YES
	SKIPE SKEDF1		;INITIATED BY SCHEDULER?
	JRST SCDR		;YES, GO START PROCESS
	SKIPG INSKED		;IN SCHEDULER NOW, OR
	SKIPG SKEDF3		;NO SCHEDULING REQUESTS?
	XJEN PISC7R		;IGNORE INTERRUPT
	SKIPE NSKED		;OK TO RESCHEDULE?
	JRST SCDW		;NO, GO SET TRAP
	SKIPGE UTLOCK		;ANY UNIT TESTING BEING DONE?
	SKIPE SNPCNT		;ANY SNOOP BREAK POINTS INSERTED?
	JRST CHKSNP		;YES, GO SEE IF PC IS INSIDE A BP

;Here to stop the current process

PISC7A:
	DATAO PAG,SETMON	;SET MON CONTEXT
	MOVEM 17,PAC+17		;YES, SAVE PROCESS AC'S
	MOVEI 17,PAC
	BLT 17,PAC+16
	DMOVE T1,PISC7R		;GET FLAGS AND PC
	TXNE T1,UMODF		;MONITOR PC?
	IFSKP.
	  HRRZ T3,T2		;YES, AT POINT OF RETURN TO USER?
	  CAIN T3,GOUSR+1
	  HRRI T2,GOUSR		;YES, RE-EXECUTE DATAO PAG WHEN RESUMED
	ENDIF.
	DMOVEM T1,PFL
	MOVE 1,RSKEDN		;RESET NOSKED TRAP
	MOVEM 1,RSKED
	AOS INSKED
	JSP FX,KISSAV		;SAVE APR-DEPENDENT STUFF
	XJEN [0
	     MSEC1,,SCHED0]	;GO DO THE MAIN SCHEDULER LOOP
;SET TRAP TO CAUSE INTERRUPT ON OKSKED
;Here when process can't be unscheduled now because it is in critical code,
;is NOSKED, or is in a SNOOP breakpoint. Set up RSKED to cause another
;interrupt when the process does XCT RSKED.

SCDW:	MOVEM 1,RSKED
	SKIPN PNSKDC		;NOSKED DUE TO DIAG?
	JRST SCDW1		;NO
	XCT KEPALV		;YES, UPDATE KEEP-ALIVE COUNTER
	MOVE 1,SKDSCY		;SET TO COME BACK SHORTLY
	MOVEM 1,SCKATM		;CAUSE CHANNEL 7 INTERRUPT IN THIS TIME
SCDW1:	MOVE 1,RSKEDT		;GET THE XPCW
	EXCH 1,RSKED		;PROCESS WILL EXECUTE XPCW EVENTUALLY
	XJEN PISC7R

;Possible contents of RSKED. RSKCHK points to RSKCH1.

RSKEDN:	JFCL			;NO-TRAP CONTENTS OF RSKED
RSKEDT:	XPCW RSKCHK		;TRAP CONTENTS OF RSKED

;HERE WHEN RESKED REQUEST WAITING AND PROGRAM DOES XCT RSKED

RSKCH1:	ISB SCDCHN		;ENTER VIA INTERRUPT
	JRST .			;WAIT FOR INTERRUPT TO HAPPEN
;CHECK IF PROCESS IS IN A SNOOP BREAK POINT
;  IF YES, THEN THE PROCESS CANNOT BE STOPPED IN CASE BP IS REMOVED

CHKSNP:	MOVEM T1,SNPSV1		;SAVE AN AC FOR TEST
	MOVE T1,PISC7R		;GET PC OF PROCESS BEING STOPPED
	TLNE T1,(UMODF)		;IN USER MODE?
	JRST CHKSN1		;YES, OK TO STOP HIM THEN
	HRRZ T1,PISC7R+1	;PICK UP PC
	CAIL T1,UTREP		;IN THE CRITICAL UTEST ROUTINE?
	CAILE T1,UTREPE		;...
	SKIPA			;NO
	JRST CHKSN0		;YES, DO NOT RESCHEDULE NOW
	CAIL T1,SNPBPP		;IN BREAK POINT PAGES?
	CAILE T1,SNPBPP+SNPBPS+SNPDPS-1
	JRST CHKSN1		;NOT IN BP PAGES, OK TO RESKED
CHKSN0:	SKIPG T1,SCKATM		;DID WE MISS AN ALARM?
	MOVEI T1,2		;YES. SET IT TO A SMALL VALUE THEN
	MOVEM T1,SCKATM		;MAKE SURE ALARM VALUE IS GOOD
	MOVE T1,SNPSV1		;RESTORE AC
	JRST SCDW		;SET TRAPS AND CONTINUE PROCESS

CHKSN1:	MOVE T1,SNPSV1		;RESTORE AC
	JRST PISC7A		;SAVE CONTEXT, STOP PROCESS

;SETUP AND RESUME PROCESS
;Here when SKEDF1 is set. Main scheduler path does this around SCHED4.

SCDR:
	SETZM SKEDF1		;CLEAR LOCAL FLAG
	SETZM INSKED		;NO LONGER IN SCHEDULER
	SETOM SSKED
	JSP FX,KISLOD		;LOAD APR-DEPENDENT STUFF
	MOVE 1,PFL		;GET FLAGS
	TXNE 1,UMODF		;RETURNING TO USER OR MONITOR?
	SKIPA 1,SETUSR		;USER, GET USER CONTEXT WORD
	MOVE 1,SETMON		;GET MONITOR CONTEXT WORD
	MOVEM 1,SETPAG		;SAVE FOR USE BELOW
	SKIPG T1,SCKATM		;DID WE MISS AN ALARM?
	MOVEI T1,2		;YES. SET IT TO A SMALL VALUE THEN
	MOVEM T1,SCKATM		;MAKE SURE ALARM VALUE IS GOOD
	MOVSI 17,PAC		;RESTORE PROCESS AC'S
	BLT 17,17
	DATAO PAG,SETPAG	;SET AC BLOCKS
	SKIPN NSKED		;RESUMING NOSKED PROCESS?
	SKIPE CRSKED		;OR CSKED PROCESS?
	SKIPA
	XJEN PFL		;RUN PROCESS
	AOS SKEDF3		;YES, REMEMBER SCHEDULING NEEDED
	MOVEM 1,RSKED		;SET DEFERRED SCHED TRAPS
	MOVE 1,RSKEDT
	EXCH 1,RSKED
	XJEN PFL		;RUN PROCESS
	SUBTTL Routines to Enter Scheduler

;VARIOUS WAYS OF ENTERING SCHEDULER

;JSYS HALTF - DISMISS FORK UNTIL INTERRUPT OR EXTERNALLY RESTARTED

.HALTF::MCENT
HALTF1::			;FORK TERM
HALTX:	CALL GETSFX		;GET SUPERIOR FORK INDEX
	HRRI 1,HALTT
	MOVSI T2,FHV1		;SAY LOW PRIORITY WAIT
	HDISMS
	JRST MRETN		;IF CONTINUED

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

;SCHEDULING CONTROL MACROS
;NOSKED AND NOSKD1 EXECUTE A NOINT
;OKSKED AND OKSKD1 EXECUTE AN OKINT

;NOSKD1 - ENTERED VIA JSP CX,NOSK11

NOSKD0::			;TAG FOR HISTORICAL REASONS
NOSK11::SKIPE INSKED
	JRST 0(CX)
	AOS INTDF
	AOS NSKED
	JRST 0(CX)

;OKSKD1 - ENTERED VIA JSP CX,OKSK11

OKSK11::
OKSKD0::SKIPE INSKED
	JRST 0(CX)
	SKIPG NSKED		; ARE WE REALLY NOSKED?
OKSKE1:	 BUG(OKSKBG,<<CX,ADR>>)
	SOSG NSKED
	XCT RSKED
	XCT INTDFF
	JRST 0(CX)

;CHECK FOR INTERRUPT PENDING ON THIS FORK
;MAY BE CALLED FROM SCHED CONTEXT
;PRESERVES ALL ACS

CKINT0::SAVEAC <FX>
	SKIPL FX,FORKX		;GET CURRENT FORK
	SKIPL FKINT(FX)		;PSI PENDING?
	RET			;NO
	AOS SKEDF3		;YES, REQUEST RESKED
	ISB SCDCHN
	RET
;CRITICAL SECTION, BGN AND END
;INVOKED BY CSKED AND ECSKED MACROS

CRSKD0::SKIPE INSKED
	JRST 0(CX)
	NOINT			;IMPLIES NOINT ALSO
	AOS CRSKED
	JRST 0(CX)

ECSKD0::SKIPE INSKED
	JRST 0(CX)
	SOSG CRSKED		;NOW OUT OF ALL CRITICAL SECTIONS?
	XCT RSKED		;YES, CHECK FOR DEFERRED RESCHEDULE
	OKINT
	JRST 0(CX)
;DISMISS WITH HOLD TIME--KEEP IN BALSET FOR SPECIFIED TIME BECAUSE
;BLOCK EXPECTED TO BE SATISFIED IN THAT TIME.
; 1/ USUAL DISMISS TEST
; 2/ HOLD TIME IN MILLISECONDS
;NORMALLY INVOKED VIA HDISMS(HT) MACRO

EDMSH::	ENTSKD			;ENTER SCHED
	TXZ CX,EXFLBT		;MASK OFF FLAGS BITS IF SEC 0
	MOVEM CX,PPC		;SAVE PC
	MOVE CX,ENSKR		;FIND FLAGS
	MOVEM CX,PFL		;SET FLAGS
	JRST DISMSH		;JOIN REGULAR DISMISS BUT KEEP 2

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

EDMS0::	ENTSKD			;ENTER SCHEDULER
	TXZ CX,EXFLBT		;MASK OFF FLAGS INCASE SECTION 0
	MOVEM CX,PPC		;RETURN BECOMES PROCESS PC
	MOVE CX,ENSKR		;FIND FLAGS ON THIS CALL
	MOVEM CX,PFL		;SAVE FLAGS
DISMSE:	MOVE P,PI7P		;INIT SCHED STACK
	MOVEI 2,0		;SAY 0 HOLD TIME
	SKIPE CRSKED		;CRITICAL SECTION?
	MOVEI T2,^D200		;YES, STAY IN BALSET FOR A WHILE
DISMSH:	PUSH P,2		;SAVE HOLD TIME
	HRRZ T2,T1		;GET ADR OF ROUTINE
	SKIPN NSKED		;CHECK FOR BUGGY DISMISS
	CAILE T2,RSCODZ		;CHECK FOR A NON-RESIDENT TEST ROUTINE
	BUG(NSKDIS)
	MOVEM 1,FKSTAT(FX)	;PUT IN TEST WORD
FRIBP2::CALL SAVRT		;(WATCH BPT TAG)
	HRRZ 1,FKSTAT(FX)
	CAIE 1,HALTT		;FORK TERMINATING?
	CAIN 1,FORCTM
	CALL SUPUNB		;YES, UNBLOCK SUPERIOR IF NECESSARY
	MOVE T3,JOBNO		;GET JOB NUMBER
	MOVE T3,JOBCLS(T3)	;GET COUNT OF GOLST PROCESSES
	TLNN T3,777776		;IS THIS HE LAST ONE?
	SETZM JOBCK0		;INIT MEASURING INTERVAL
	POP P,2			;RECOVER HOLD TIME
	HLRZ T3,T2		;GET WAIT PRIORITY
	CAIN T3,0		;GIVEN?
	MOVEI T3,FHV3		;NO, DEFAULT TO MIDDLE VAL
	STOR T3,FKGOLN		;SAVE IT
	HRRZ T2,T2
	JUMPE 2,[CALL REMBSJ	;IF 0 HOLD TIME, REMOVE IMMEDIATELY
		CALL GLREM	;REMOVE FROM GOLST
		CALL WTCONC
		SETOB FX,FORKX
		JRST SCHED0]
	MOVE 1,TODCLK
	ANDI 1,377777
	ADDI 1,0(2)		;CONSTRUCT SPECIAL TEST FOR HOLD TIME
	MOVSI 1,0(1)
	HRRI 1,DISMT
	MOVEM 1,FKPGST(FX)
	AOS NHOLDF		;COUNT HOLDING FORKS
	JRST SCHP3
;RESCHEDULE ON PAGE WAIT

;CALLED VIA JSP CX,SCHEDP
;	T1/ Scheduler test

SCHEDP::TXZ CX,EXFLBT		;MASK OFF FLAGS INCASE SECTION 0
	XSFM SKDFL		;STORE FLAGS
	MOVEM CX,SKDPC		;STORE PC
	ENTSKD
SCHP1:	PUSH P,1
	CALL SAVRT
	POP P,1
	MOVEM 1,FKPGST(FX)	;SAVE SCHEDULER TEST WORD
	DMOVE 1,SKDFL		;GET FLAGS AND PC
	DMOVEM 1,PFL		;SAVE THEM IN PSB
;**;[2844]ADD 1 LINE AT SCHP1:+6	DSC	26-OCT-82
IFN SKEDSW,<			;[2844]

;Keep a record of PC's that call this routine

	HRRZ T1,PPC
	SKIPE NSKED		;BLOCK WHILE NOSKED?
	CALL NBNSB		;YES, SAVE PC
;**;[2844]ADD 1 LINE AT SCHP1:+11	DSC	26-OCT-82
>				;[2844]END SKEDSW CONDITIONAL

;Here to complete the dismiss. FKPGST contains scheduler test word

SCHP3:	MOVE 1,TODCLK		;REMEMBER TIME WAIT STARTED
	MOVEM 1,FKNBW(FX)
	AOS NBWT		;COUNT WAITING BALSET PROCESS
	HRRZ T1,FKPGST(FX)
	CAIE T1,SWPINT		;SWAP WAIT?
	CAIN T1,SWPRT
	AOS NBSWP		;YES, COUNT
	MOVX T1,BSWTB
	CALL SCHP2
	JRST SCHED0

;RETAIN FORK IN BALSET, SET FLAGS, ETC.

;ACCEPTS:
;	T1/ Flags to store into FKSWP

;	CALL SCHEDR

;Returns +1: always

SCHP2:	IORM T1,FKSWP(FX)
	SKIPE NSKED
	MOVEM FX,SSKED		;REMEMBER FORK NUMBER OF NOSKED FORK
	SETOB FX,FORKX
	RET
;DO OKSKED AND RESCHEDULE

SCHEDR::TXZ CX,EXFLBT		;CLEAR FLAGS INCASE SECTION 0
	XSFM SKDFL		;SET FLAGS
	MOVEM CX,SKDPC
	ENTSKD
	SOSGE NSKED
	BUG(ILOKSK)
	SOS INTDF		;FIX UP NOINT AS WELL
	JRST SCHP1
;COMMON SCHEDULER ENTER ROUTINE, SAVE AC'S
; ** INSKED MUST BE NON-0 BEFORE THIS CALL **

ENSKED::MOVEM 17,PAC+17		;SAVE PROCESS AC'S
	MOVEI 17,PAC
	BLT 17,PAC+16
	JSP FX,KISSAV		;SAVE APR-DEPENDENT STUFF
	MOVE FX,FORKX		;GET INDEX OF CURRENT FORK
	MOVE P,PI7P		;GET PDL POINTER
	CALL UPDTCK		;UPDATE TODCLK
	DMOVE T1,PAC+1		;RESTORE T1 AND T2
	XJRSTF ENSKR

;Enter here from APRSRV handling overflow traps

KITRP1::MOVEM 1,KIMUEF		;SAVE CHANNEL NUMBER
	ENTSKD			;ENTER SCHEDULER CONTEXT
	MOVE 1,KIMUEF		;CHANNEL NUMBER
	MOVE 2,FORKX
	IFN. T1			;FOUND ANYTHING?
	  CALL PSIRQ		;YES, REQUEST INTERRUPT
	ENDIF.
	DMOVE 1,KIMUFL
	DMOVEM 1,PFL		;MOVE PC TO PSB
	JRST SCHED0		;GO TO SCHEDULER

;Several cases come here via CALL - like Charlie on the MTA, it never returns...

REEBUG:	BUG(SKDCL1)		;SOME SORT OF DISMISS IN SCHED
;**;[2844]ADD 1 LINE AT REEBUG:+1L	DSC	26-OCT-82
IFN SKEDSW,<			;[2844]

;ROUTINE TO SAVE PC'S WHICH CAUSE NOSKED BLOCKS
;CALLED FROM PGRTRP ALSO
; T1/ PC TO SAVE

NBNSB::	HRLZ T4,NNSBE		;NEG NUMBER TABLE ENTRIES IN USE
	JUMPGE T4,NBNS2		;JUMP IF TABLE EMPTY
NBNS1:	HLRZ T2,NSBTAB(T4)
	CAMN T1,T2		;ALREADY HAVE THIS PC?
	JRST NBNS3		;YES, JUST COUNT IT
	AOBJN T4,NBNS1		;CHECK ALL ENTRIES
NBNS2:	CAIL T4,NNSBT		;TABLE FULL?
	RET			;YES, CAN'T ADD NEW ENTRY
	HRLZM T1,NSBTAB(T4)	;ADD NEW PC TO TABLE
	MOVNI T2,1(T4)		;INCREMENT USE COUNT
	MOVEM T2,NNSBE
NBNS3:	AOS NSBTAB(T4)	;COUNT OCCURRANCES
	RET

NNSBT==^D20			;SIZE OF PC TABLE
RS NSBTAB,NNSBT			; PC,,COUNT
RS NNSBE,1			;NUMBER OF ENTRIES IN USE
;**;[2844]ADD 1 LINE AT NBNS3:+5L	DSC	26-OCT-82
>				;[2844]END SKEDSW CONDITIONAL
;INSTRUCTION TRAP - TRAP PC IN FPC, ASSUMED TO BE I +1

;Called via JSP T2,ITRAP1 (or JRST ITRAP) in process context

ITRAP1::MOVEM 1,LSTERR		;SAVE ERROR CODE GIVEN IN 1
	MOVEM T2,LSTIPC		;SAVE LAST ITRAP PC

;Check for illegal conditions

ITRAP::	SKIPE INSKED
	BUG(SKDTRP)
	SKIPL FORKX		;NO FORK RUNNING, OR
	CONSZ PI,177B27		;PI IN PROGRESS?
	BUG(PIITRP)
	SKIPE NSKED		;CHECK FOR PROPER STATE
	BUG(NOSKTR)
	SETZM NSKED
	SETZM CRSKED
	SETOM TRAPC		;CLEAR FLAGS AND COUNTERS
	SKIPGE SLOWF		;NOW IN SLOW CODE?
	MCENTR			;NO, ENTER
	DMOVE 1,KIMUU1		;GET LAST USER MUUO
	DMOVEM 1,UMUUOW		;SAVE AS TRAPPED INSTRUCTION

;Restore INTDF to state when JSYS was entered

	MOVE P,MPP		;GET LAST STACK FRAME
	MOVE Q2,-3(P)		;PREVIOUS CONTEXT INTDF
	MOVEM Q2,INTDF

;Loop here if doing a nested JSYS and there is no ERJMP. If there is an ERJMP
;anywhere in the calling path (back to user), this will find it.

;Check for ERJMP or ERCAL. If found, set the PC to the new location and return
;from the JSYS.

ITRRT2:	MOVE P,MPP
	MOVE Q2,INTDF		;GET CURRENT CONTEXT INTDF
	DMOVE T1,-1(P)		;GET PREV CONTEXT FLAGS AND PC
	EXCH T1,T2		;(IN PROPER ORDER)
	TXNN T1,UMODF		;BACK TO USER?
	CAMN Q2,-3(P)		;OR INTDF UNCHANGED?
	SKIPA			;YES, OK
	BUG(NOINTR)
	CALL SETPCV		;SET PREVIOUS CONTEXT VARIABLES FOR ITRSIM
	CALL ITRSIM		;SEE IF ERJMP/ERCAL
	 JRST ITRRT1		;NO
	MOVEM T3,-1(P)		;SET PC TO E OF ERJMP/ERCAL
	JRST MRETN		;RETURN TO IT

;No ERJMP at this level. If nested JSYS, set PC to ITTRP2 above and return
;from the current JSYS.
;	T1/flags

ITRRT1:	MOVE T3,JOBBIT
	IFXN. T3,LOGIOB		;IN LOGIN OR LOGOUT?
	  BUG(ITRLGO)		;YES, NOT GOOD
	  JRST MRETN		;RETURN QUIETLY AND HOPE FOR THE BEST
	ENDIF.
	TXNE T1,UMODF		;NOW TO TOP OF STACK?
	JRST ITR2		;YES, NO ERJMP SEEN
	XMOVEI T2,ITRRT2	;SET TO RETURN THROUGH MRETN
	MOVEM T2,-1(P)		; TO LOOP ABOVE
	JRST MRETN

;Got to top of stack without an ERJMP. Give an interrupt to the user.

ITR2:	SKIPN CRSKED
	SETZM INTDF		;SET TO 1 LEVEL NOINTERRUPT
	MOVE 1,CHNSON
	ANDCAM 1,PSIBW		;FLUSH PREVIOUS PANIC BREAKS
	MOVEI 1,^D15		;INITIATE CHANNEL 15 INTERRUPT
	CALL PSIRQ0
	CHKINT			;GET THE INTERRUPT "SEEN"
	OKINT			;INTERRUPT SHOULD TAKE HERE
	MOVE P,UPP		;RETURN TO USER IF CONTINUED
	ADD P,BHC+3
	JRST MRETN
;BLOCK UNTIL CONDITION SATISFIED
;BLOCK0 - STAYS IN BALSET,  BLOCK1 - LEAVES BALSET

BLOCK0::SUBI CX,2		;MAKE RETURN TO CALL-1
	TXZ CX,EXFLBT		;CLEAR FLAGS INCASE SECTION 0
	XSFM SKDFL		;STORE FLAGS
	MOVEM CX,SKDPC
	ENTSKD
	CALL BLOCKS
	JRST SCHP1

BLOCK1::ENTSKD
	CALL BLOCKS
	SUBI CX,2		;MAKE RETURN TO CALL-1
	TXZ CX,EXFLBT		;CLEAR FLAGS INCASE SECTION0
	MOVEM CX,PPC		;RETURN BECOMES PROCESS PC
	MOVE CX,ENSKR		;PICK UP CALLERS FLAGS
	MOVEM CX,PFL
	JRST DISMSE

BLOCKS:	MOVNI 1,^D100*NTMS
	ADDM T1,BSQNT		;CHARGE QUANTUM
	MOVE 1,TODCLK
	ANDI 1,377777
	ADDI 1,^D1000		;ADD 1000 MILLISECS
	MOVSI 1,0(1)
	HRRI 1,BLOCKW
	RET

;SHORT WAIT TEST.  RETURNS NUMBER OF MS LEFT TO WAIT

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

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

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

;DISMISS UNTIL WORD .L. 0

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

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

;DISMISS UNTIL WORD .G. 0

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

DISGT::	SKIPG 0(1)
	JRST 0(4)
	JRST 1(4)
;DISMISS UNTIL WORD .LE. 0

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

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

;DISMISS UNTIL WORD .E. 0

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

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

;DISMISS UNTIL WORD .N. 0

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

DISNT::	SKIPN 0(1)
	JRST 0(4)
	JRST 1(4)
	SUBTTL Sleep and Wakeup JSYS's

;DISMISS FOR SPECIFIED TIME JSYS

.DISMS::MCENT
	JUMPLE 1,MRETN
	CAIL 1,100000		;LONG OR SHORT TIME?
	JRST TDIS1		;LONG
	MOVE 2,TODCLK
	ANDI 2,377777
	ADDI 2,0(1)		;COMPUTE TIME TO RESTART
	CAIGE T1,^D200		;VERY SHORT WAIT?
	JRST [	MOVEI T1,BLOCKW	;YES, USE BLOCKW AND HDISMS
		HRL T1,T2
		HDISMS (200)	;HOLD FOR ENOUGH TIME
		JRST MRETN]
	CAIGE 1,^D2000		;USE BLOCKW FOR WAIT .L. 2000 MS
	SKIPE T1,[FHV4,,BLOCKW]	;SHORT WAIT, USE BLOCKW AND HIGHER PRIORITY
	MOVE T1,[FHV2,,BLOCKM]	;BLOCKM AND LOWER PRIORITY
	HLL T2,T1		;PASS BLOCK PRIORITY
	HRL T1,T2		;SETUP TIME
	HRRI T2,0		;NO HOLD TIME
TDIS2:	HDISMS			;DISMISS WITH SPECIFIED TEST
	JRST MRETN

TDIS1:	CALL SETBKT		;COMPUTE TEST DATA
	HRRI 1,BLOCKT
	MOVSI T2,FHV1		;VERY LOW PRIORITY
	JRST TDIS2		;GO COMPLETE DISMISSAL

;ROUTINE TO COMPUTE BLOCKT TEST DATA FROM GIVEN TIME IN MS
; 1/ TIME IN MS
;	CALL SETBKT
; RETURN +1: ALWAYS, 1/ TEST ARG FOR BLOCKT ,, 0

SETBKT::CAML 1,[400,,0]		;BELOW MAX TIME?
	MOVSI 1,400		;NO, SET TO MAX
	MOVE 2,TODCLK		;COMPUTE TIME AT WHICH WAKEUP DUE
	TLZ 2,777000		; IN FORM USED BY BLOCKT
	ADD 2,1
	LSH 2,-^D10		;ROUND TO 18-BIT VALUE
	MOVSI 1,0(2)
	RET

;SCHEDULER WAIT TEST FOR LONG WAIT
;RETURNS NUMBER OF MS LEFT TO WAIT

BLOCKT::LSH 1,^D10		;RESTORE WAKEUP TIME TO FULL SIZE
	MOVE 2,TODCLK		;GET TIME NOW
	TLZ 2,777000
	SUB 1,2			;DESIRED-NOW = TIME LEFT TO WAIT
BLKT1:	JUMPLE 1,1(4)		;WAKEUP IF NEGATIVE
	CAMG 1,[XWD 400,0]	;VERY LARGE DIFFERENCE?
	JRST 0(4)		;NO, KEEP WAITING
	SUB 1,[XWD 1000,0]	;COMPENSATE FOR WRAPAROUND
	JRST BLKT1		;CHECK AGAIN
;TEMPORARY JSYS'S FOR INTERJOB COMMUNICATION

;HIBERNATE - BLOCK UNTIL SIGNAL OR SPECIFIED ELAPSED TIME
; 1/ 0,,TIME		MAXIMUM BLOCK TIME IN SECONDS
;	THIBR
; RETURN +1: NEVER
; RETURN +2: SIGNAL RECEIVED OR TIME EXPIRED

.THIBR:: MCENT
	IMULI 1,^D1000		;CONVERT SECONDS TO MS
	CALL SETBKT		;COMPUTE TEST DATA FOR TIME
	HRRI 1,HIBERT		;CONSTRUCT TEST WORD
	MOVSI T2,FHV2		;LOWER PRIORITY BLOCK
	HDISMS
	MOVE 1,JOBNO		;DISMISS SATISFIED, CLEAR WAKE BIT
	MOVSI 2,(JWAKEF)
	ANDCAM 2,JOBNAM(1)
	SMRETN

;SCHEDULER TEST FOR HIBERNATING FORK

HIBERT::LOAD 2,FKJOBN		;GET JOB NUMBER FOR FORK
	MOVSI 3,(JWAKEF)
	TDNE 3,JOBNAM(2)	;SIGNAL RECEIVED?
	JRST 1(4)		;YES, WAKEUP
	JRST BLOCKT		;NO, GO TEST TIME

;WAKEUP - SEND SIGNAL TO JOB WHICH WILL BE SEEN BY THIBR
; 1/ 0,,JOB#		NUMBER OF JOB TO BE AWAKENED
;	TWAKE
; RETURN +1: BAD JOB NUMBER
; RETURN +2: SIGNAL SENT.  DESTINATION JOB WILL BE AWAKENED
;	IMMEDIATELY IF NOW IN THIBR OR AS SOON AS NEXT THIBR DONE

.TWAKE:: MCENT
	MOVEI 1,0(1)
	CAIGE 1,NJOBS		;JOB NUMBER WITHIN RANGE?
	SKIPGE JOBRT(1)		;AND JOB EXISTS?
TWAKER:	RETERR ATACX1		;NO
	HRRZ 2,JOBDIR(1)	;GET LOGIN DIRECTORY
	JUMPE 2,TWAKER		;ERROR IF JOB NOT LOGGED IN
	MOVSI 2,(JWAKEF)
	IORM 2,JOBNAM(1)	;SEND SIGNAL
	SMRETN
	SUBTTL Null Job

;SCHEDULER

;'NULL' JOB - WAITS WHEN NO FORKS RUNNABLE

SCDNUL:	NOP
SCDNL2:	SKIPN PSKED		;CHANGES OF STATE?
	SKIPE SKEDF3		;SCHEDULING REQUESTS?
	JRST SCDNL1		;YES
	JRST SCDNL2		;NO

SCDNL1:	CALL RDSIVL		;GET LAST INSKED INTERVAL
	SKIPN NBSWP		;FORKS WAITING FOR SWAPPING?
	IFSKP.
	  ADDM T1,SKDSWP	;YES, CHARGE SWAP-WAIT TIME
	ELSE.
;**;[2837] CHANGE 1 LINE AT SCDNL1:+5L	TAM	14-OCT-82
	  SKIPN T2,NBPROC	;[2837] ANY RUNNABLE FORKS?
	  IFSKP.
	    CAMG T2,NHOLDF	;THAT ARE NOT HOLDING?
	  ANSKP.
	    ADDM T1,SKDFIL	;YES, ACCUMULATE OTHER BS WAITS
	  ELSE.
	    ADDM 1,SKDIDL		;OTHERWISE CHARGE IDLE TIME
	  ENDIF.
	ENDIF.
	JRST SCH0		;GO SCHEDULE

;READ LAST IN-SCHEDULER INTERVAL FOR STATISTICS
;RETURNS +1,
; T1/ TIME IN HP UNITS SINCE ROUTINE LAST CALLED
; SKDLST/ VALUE OF HP TIME NOW

RDSIVL:	JSP 4,MTIME		;READ HP CLOCK
	MOVE 2,SKDLST		;GET LAST PREVIOUS READING OF HP CLOCK
	MOVEM 1,SKDLST		;SET NEW LAST READING
	SUB 1,2			;COMPUTE TIME SPEND IN NULL JOB
	CAIGE T1,0		;OVERFLOW?
	ADD T1,BASOVV		;YES, ADD CORRECTION
	RET
	SUBTTL Main Scheduler Loop

SCHED0::CONSZ PI,177B27		;ANY PI IN PROGRESS?
	BUG(PISKED)

;ENTER SECTION 1, BECAUSE CODE IN PAGEM THAT IS CALLED FROM HERE
;MUST REFERENCE DATA IN NON-ZERO SECTIONS

	XJRSTF [0
		MSEC1,,.+1]	;RUN IN SECTION 1
	MOVE P,PI7P		;SETUP LOCAL PDL
SCH0:	CALL UPDTCK		;UPDATE TODCLK
	XCT KEPALV		;DO KEEP ALIVE
	MOVE F,SCHFLG		;SETUP PERM FLAGS
	SETZM SKEDF3		;CLEAR SKED REQUEST
	SKIPL FX,FORKX		;HAVE FORK SETUP?
	CALL UCLOCK		;YES, UPDATE CLOCK
	SKIPG SCKATM		;ALARM COUNTED DOWN TO 0?
	CALL SCHUPC		;YES, UPDATE CLOCKS
	SKIPGE FX,FORKX		;JOB TO CONTINUE?
	CALL SKDJOB		;NO, GO SCHEDULE ONE
	JUMPL FX,SCDNUL		;RUN 'NULL' JOB IF NO FORK TO CONTINUE
	SKIPGE 1,FKINT(FX)	;PSI REQUEST PENDING?
	JRST SCHED5		;YES, GO CHECK IT

;Here when ready to start a process. Force a channel 7 interrupt, which will
;be processed at PISC7.

SCHED4:	CALL UPDTCK		;UPDATE TODCLK
	AOS SKEDF1		;SET FLAG FOR CH7 ROUTINE
	ISB SCDCHN		;LET IT START PROCESS
	JRST .			;WAIT FOR PI TO START

;Fork had an interrupt pending. If possible, give it now.

SCHED5:	TXNN T1,FKPSI1		;PSI NOW BEING DEFERRED?
	SKIPE NSKED		;OR NOSKED FORK?
	JRST SCHED4		;YES, CONTINUE CURRENT SEQUENCE
	MOVX T1,FKPSI1		;CLEAR WORD EXCEPT FOR PI IN PROG
	EXCH 1,FKINT(FX)
	MOVEM 1,PIMSK		;PASS REQUEST WORD TO SERVICE ROUTINE
	DMOVE T1,PFL		;SAVE PROCESS PC FOR PSI HANDLER
	DMOVEM T1,PIFL
	DMOVE T1,[PCU		;SET PPC TO START PSI HANDLER
		MSEC1,,PIRQ]
	DMOVEM T1,PFL
	JRST SCHED4		;GO START PROCESS
;PERIODIC UPDATE AND CHECK CLOCKS

SCHUPC:	SKIPGE FX,FORKX		;HAVE RUNNING FORK?
	JRST SKDLV8		;NO
	SKIPG BSQNT		;QUANT EXPIRED?
	CALL DISMSJ		;YES
	; ..

;ACTIONS DONE 'FREQUENTLY' -- EVERY 20 MS

SKDLV8:	CALL RDSIVL		;READ LAST INTERVAL
	MOVEM T1,SKDTHS		;ACCUMULATE SCHED TIME
	MOVE FX,FORKX
	MOVEM FX,LFORKX		;SAVE FORKX, MAKE IT BE -1 DURING BGND STUFF
	SETOB FX,FORKX
	CALL LV8CHK		;DO DEVICE-DEPENDENT THINGS
	CALL TTCH7		;TTY BIG BUFFER
	MOVE F,SCHFLG		;RESTORE FLAGS (TTCH7 KNOWN TO CLOBBER)
	CALL REMFPB		;CHECK DELETED PAGE QUEUE
	MOVE FX,LFORKX		;RESTORE FORKX
	MOVEM FX,FORKX
	CALL RDSIVL		;READ LAST INTERVAL
	ADDM T1,BGNDTM		;ACCUMULATE BACKGROUND OVERHEAD TIME
	MOVN T1,SKDTHS		;RESET SCHED OVERHEAD TIME
	ADDM T1,SKDLST
	CALL CLKCHK		;CHECK FORKS WAITING FOR CLOCK
	SKIPE TSKED		;TTY OUTPUT EVENTS?
	CALL CHKTL		;YES, CHECK LIST
	SKIPE PSKED		;WAKEUPS?
	CALL DISMSJ		;YES
	CALL SWTST		;CHECK POKE AND SWITCH REQUESTS
	MOVE T1,TODCLK
	CAML T1,TIM2		;LONG CYCLE DUE?
	CALL CLK2		;YES
	CALL BSBCK		;TIME TO CHECK WAITING BALSET FORKS
	SKIPGE FX,FORKX
	IFSKP.
	  CAME FX,LSTPFK	;SEE IF CONTEXT STILL SETUP
	  CALL SETPPG
	  MOVEM FX,LSTPFK
	ENDIF.
	MOVE F,SCHFLG		;BE SURE WE HAVE FLAGS
	MOVE T1,SKDSCY		;SET CLOCK TO SHORT CYCLE TIME
	TXNN F,SK%CYT		;NORMAL CYCLE TIMES?
	ASH T1,2		;NO, USE TIMES 4
	MOVEM 1,SCKATM
	RET
;SECOND PROCESS CLOCK, LESS PRECISE, UPDATES EVERY 100 MS

CLK2:	CALL DISMSJ		;DISMISS CURRENT FORK, FORCE SKDJOB
	MOVSI 1,(1B1)
	SKIPL SCDRN1		;RUNNING SPECIFIC JOB?
	MOVEM 1,CHKTIM		;YES, DISABLE JOB 0 CHECK
	MOVE 1,TODCLK
	CAML 1,CHKTIM		;JOB 0 OVERDUE?
	BUG(J0NRUN)
	CALL SCLDAV		;UPDATE LOAD AVERAGES, ETC.
	CALL RDSIVL
	MOVEM T1,SKDTHS		;SAVE SCHED OVERHEAD TIME

;VARIOUS TIMERS AND CHECKS CAN GO HERE

	CALL RCVCH7		;CHECK RCVOK TIMER

	MOVE F,SCHFLG		;BE SURE WE HAVE FLAGS
	MOVE P5,SKDLCY
	TXNN F,SK%CYT		;NORMAL CYCLE TIMES?
	ASH P5,2		;NO, USE TIMES 4
	ADD P5,TODCLK		;COMPUTE NEXT TIME DUE
	EXCH P5,TIM2		;SET IT, GET OLD
	SUB P5,TIM2		;COMPUTE INTERVAL SINCE LAST UPDATE
	MOVSI P4,-N2CLKS	;SET TO SCAN SECOND LEVEL CLOCKS
CLK21:	ADDM P5,CLK2TM(P4)	;UPDATE CLOCK
	SKIPG CLK2TM(P4)	;COUNTED OUT?
	XCT CLK2CL(P4)		;YES, DO WHATEVER
	AOBJN P4,CLK21
	CALL RDSIVL		;READ LAST INTERVAL
	ADDM T1,BGNDTM		;ACCUMULATE BACKGROUND OVERHEAD TIME
	MOVN T1,SKDTHS		;RESET SCHED OVERHEAD TIME
	ADDM T1,SKDLST
	RET

PI7P::	IOWD NSKDP,SKDPDL
;CHECK LOAD AVS AND LITES

SCLDAV:	MOVE T2,TODCLK
	SUB T2,RJTTIM
	CAIGE T2,^D100		;TIME FOR UPDATE?
	RET			;NO
	MOVE T1,TODCLK		;YES, RESET START OF INTERVAL
	MOVEM T1,RJTTIM
	MOVE T1,NGOJOB		;UPDATE NGOJOB INTEGRAL
	SUB T1,NHOLDF		;DISCOUNT BY HOLDING FORKS
	IMUL T1,T2
	ADDM T1,RJTSUM
	MOVE T1,NBPROC
	IMUL T1,T2
	ADDM T1,BSTSUM		;UPDATE NBPROC INTEGRAL
	MOVE T1,NWSMEM
	IMUL T1,T2
	ADDM T1,NWSSUM		;UPDATE NWSMEM INTEGRAL
	MOVE T1,SUMNR		;INTEGRATE SUMNR
	IMUL T1,T2
	ADDM T1,SNRSUM
	MOVE T1,NRPLQ		;INTEGRATE NRPLQ
	IMUL T1,T2
	ADDM T1,RPQSUM
	MOVE T1,NHQFK		;UPDATE HIGH-QUEUE FORKS INTEGRAL
	IMUL T1,T2
	ADDM T1,HQFSUM
	MOVE T1,NLQFK		;UPDATE LOW-QUEUE FORKS INTEGRAL
	IMUL T1,T2
	ADDM T1,LQFSUM
	SKIPE CLASSF		;DOING CLASS SCHEDULING?
	CALL CLSAVG		;YES. INTEGRATE NRUN FOR THE CLASSES
	MOVE 2,TODCLK
	CAML 2,RJATIM		;TIME FOR RJAV UPDATE?
	CALL DORJAV		;YES
	MOVE T1,TODCLK		;GET NOW AGAIN
	CAML T1,UTLTIM		;TIME TO DO CLASS UTILIZATION UPDATES?
	CALL NEWUTL		;YES. DO IT NOW
	MOVE T1,SKDIDL		;UPDATE MS VERSIONS OF HP CLOCKS
	CAML T1,[370000,,0]	;[6717]IS SKDIDL APPROACHING "WRAP-AROUND"?
	 JRST SCLD.1		;[6717]YES, MODIFY IT, AND SAVE THE "FUDGE"
	IDIVI T1,NTMS
SCLD.0:	MOVEM T1,SKDTM0		;[6717]
	MOVE T1,SKDSWP
	IDIVI T1,NTMS
	MOVEM T1,SKDTM1
	MOVE T1,SKDOVH
	IDIVI T1,NTMS
	MOVEM T1,SKDTM2
	RET
SCLD.1:	SKIPE CLASSF		;[6717]DOING CLASS SCHEDULING?
	 JRST SCLD.2		;[6717]YES, COMPUTE FUDGE DIFFERENTLY
	IDIVI T1,NTMS		;[6717]MAKE INTO MS
	ADDB T1,IDLFUG		;[6717]SUM INTO OUR FUDGE FACTOR
	SETZM SKDIDL		;[6717]CLEAR SKDIDL (GOOD FOR ANOTHER 95+HOURS)
	JRST SCLD.0		;[6717]AND RESUME INLINE
SCLD.2:	SUB T1,OLDIDL		;[6717]MAKE SKDIDL-OLDIDL (IN HP UNITS)
	MOVEM T1,SKDIDL		;[6717]SAVE AS SKDIDL
	MOVE T1,OLDIDL		;[6717]GET OLDIDL BACK
	IDIVI T1,NTMS		;[6717]MAKE INTO MS
	ADDB T1,IDLFUG		;[6717]SAVE AS OUR FUDGE FACTOR
	SETZM OLDIDL		;[6717]CLEAR OLDIDL (NEWUTL: WILL WORK NOW)
	JRST SCLD.0		;[6717]AND RESUME INLINE
;UPDATE RUNNABLE JOB AVERAGES

DORJAV:	MOVEI T1,^D1000		;SET TIME FOR NEXT UPDATE
	ADDM T1,RJATIM
	MOVE T1,RJTSUM		;DO TOTAL AVERAGES
	SUBM T1,RJAVS1
	EXCH T1,RJAVS1
	MOVEI T2,RJAV		;TABLE AT RJAV
	CALL DORJ1
	MOVE T1,HQFSUM		;DO HIGH-QUEUE AVERAGES
	SUBM T1,RJAVS2
	EXCH T1,RJAVS2
	MOVEI T2,HQLAV		;TABLE AT HQLAV
	CALL DORJ1
	MOVE T1,LQFSUM		;DO LOW-QUEUE AVERAGES
	SUBM T1,RJAVS3
	EXCH T1,RJAVS3
	MOVEI T2,LQLAV		;TABLE AT LQLAV
	CALL DORJ1
	SKIPE CLASSF		;DOING CLASS SCHEDULING?
	CALL CLDRJ		;YES. COMPUTE LOAD AVGS FOR THE CLASSES
	FIXR T1,RJAV		;GET INTEGER 1 MIN AVERAGE
	MOVEM T1,IRJAV
	RET
;RUN AVERAGE ROUTINES FOR THE CLASS SCHEDULER

;ROUTINE TO COMPUTE INTEGRALS FOR EACH OF THE CLASSES
;	T2/ TIME INTERVAL

CLSAVG:	MOVEI T3,MAXCLS-1	;SCAN ALL CLASSES
CLSAV0:	LOAD T1,CLGLC,(T3)	;GET GOLST POPULATION
	IMUL T1,T2		;COMPUTE N*dt
	ADDM T1,CLSSUM(T3)	;ACCUMULATE INTEGRAL
CLSAV1:	SOJGE T3,CLSAV0		;DO ALL CLASSES
	RET			;DONE

;ROUITNE TO COMPUTE RUN AVGS FOR THE CLASSES

CLDRJ:	SAVEAC <Q1>		;GET A WORK REG
	MOVEI Q1,MAXCLS-1	;SCAN ALL CLASSES
	JFOV .+1		;CLEAR OVERFLOW FLAG
CLDRJ0:	FLTR T1,CLSSUM(Q1)	;GET INTEGRAL
	MOVE T2,CLSSHR(Q1)	;GET SHARE
	CAMGE T2,CLSUTL(Q1)	;GOT ANY WINDFALL?
	MOVE T2,CLSUTL(Q1)	;YES. USE UTIL THEN
	FDVR T1,T2		;SCALE
	JFOV [	FLTR T1,CLSSUM(Q1) ;IF OVERFLOW, USE SUM AS INTEGRAL
		JRST .+1]	;AND PROCEED
	SETZM CLSSUM(Q1)	;NO SUM NOW
	MOVEI T2,0(Q1)		;GET CLASS
	IMULI T2,NRJAVS		;FIND N-WORD CHUNK FOR THIS CLASS
	ADDI T2,CLSRJA		;THE AREA
	CALL DORJ2		;COMPUTE AVERAGES
CLDRJ1:	SOJGE Q1,CLDRJ0		;DO ALL CLASSES
	RET			;DONE
;COMPUTE ONE SET AVERAGES
; T1/ INTEGRAL OVER LAST ONE SECOND
; T2/ TABLE TO BE UPDATED

DORJ1:	FLTR T1,T1		;FLOAT INTEGRAL
DORJ2:	FDVRI T1,(1000.0)	;DIVIDE BY 1 SECOND
	JFOV .+1		;CLEAR OV FLAG
	MOVSI T3,-NRJAVS	;NUMBER ITEMS IN TABLE
	HRLI T2,T3+(IFIW)	;SETUP INDIRECT ADDRESS
SCHC1:	MOVE T4,@T2		;GET PRESENT SUM
	FSBR T4,T1		;COMPUTE SUM-TERM
	FMPR T4,EXPFF(T3)	;COMPUTE (SUM-TERM)*e(-T/C)
	JFOV [	SETZM T4	;IF UNDERFLOW, ASSUME ZERO
		JRST .+1]
	FADR T4,T1		;SUM=(SUM-TERM)e-(T/C)+TERM
	MOVEM T4,@T2		;NEW SUM
	AOBJN T3,SCHC1		;DO ALL TABLE
	RET

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

EXPFF:	EXP 0.983471454		;C = 1 MIN
	EXP 0.996672216		;C = 5 MIN
	EXP 0.998889506		;C = 15 MIN

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

   REPEAT 0,<			;DON'T NEED THIS NOW
EXPGF:	EXP 0.0165285462	;C = 1 MIN
	EXP 0.00332778395	;C = 5 MIN
	EXP 0.00111049406	;C = 15 MIN
   >				;END OF REPEAT 0
;TEST WORD DEPOSITED BY SWITCHES IN 20 OR 30
;ACCEPTS:

;Location 20/
;	Bit 0 - go to EDDT breakpoint
;	Bit 3 - wait for DDMP to finish
;	Bit 34 - reset the front end
;	Bit 35 - same as bit 0

;Location 30/
;	non-zero to request shutdown of system

;	CALL SWTST


SWTST:	SKIPE PWRDWN		;POWER DOWN?
	JRST SCHPRF		;YES
	SKIPE SHLTW		;HALT REQUEST?
	JRST SWCRSH		;YES
	SKIPN T1,SCTLW		;SWITCHES?
	RET			;NO, NOTHING TO DO
	SETZM SCTLW
	JFFO 1,.+1
	CAIGE 2,NSWTT
	XCT SWTT(2)
	TXNE T1,1B35		;ALTERNATE MANUAL PAUSE?
	JRST SWHLT		;YES
	TXNE T1,1B34		;RESET PROTOCOL?
	JRST SWRS11		;YES
SWTST1:	RET

SWTT:	JRST SWHLT		;HALT T.S.
	JRST SWTST1		;NOT USED
	JRST SWTST1		;NOT USED
	JRST SCWAIT		;INTERNALLY GENERATED - WAIT FOR DOWN
NSWTT==.-SWTT

SWHLT:	CALL DISMSJ		;DISMISS CURRENT FORK
	CALL SETPSK		;SET SCHED CONTEXT
	SKIPE DDTPRS		;DDT LOADED?
SWHLT4:	XCT CHKADR		;YES, GET BREAKPOINT
	JRST SCHED0		;RESUME SCHEDULER WHEN PROCEEDED

;POWER FAIL DETECTED

SCHPRF:	CALL DISMSJ		;FLUSH CURRENT FORK
	CALL SETPSK		;SET SCHED CONTEXT
	XCT PWRFLE		;DO ANY SPECIAL POWER FAIL CODE
	CALL CASHOF		;MAKE SURE MEMORY IS CORRECT
	JRST SCHPF0		;FINISH IN APRSRV

;RESET FE PROTOCOL

SWRS11:	PIOFF
	JSR BUGMON		;ENTER SECONDARY
	JSR BUGPRI		;ENTER PRIMARY, SHOULD BE IN SYNCH NOW
	PION
	JRST SCHED0		;CONTINUE
;Here when 30 is non-zero. Set bit 3 in 20, and start DDMP.

SWCRSH:	SETZM SHLTW
	MOVSI 1,(1B3)		;SETUP TO WAIT FOR DDMP COMPLETION
	MOVEM 1,SCTLW
	SETZM DDTIME		;POKE DDMP
	AOS JB0FLG		;DO JOB 0
	SETZ 1,
SWRUN2:	MOVEM 1,SCDRN1		;ALLOW ONLY THAT JOB TO RUN
	CALL DISMSJ		;DISMISS CURRENT FORK
	JRST SWTST1

;Here when bit 3 is set in 20. If DDMP is finished, proceed to hit breakpoint
;or halt processor

SCWAIT:	SKIPN DDTIME		;DDMP FINISHED?
	JRST [	MOVSI 1,(1B3)	;REISSUE REQUEST
		MOVEM 1,SCTLW
		JRST SWTST1]
	CALL DISMSJ		;DISMISS CURRENT FORK IF ANY
	CALL SETPSK		;SET SCHED CONTEXT
	SKIPE IOIP		;WAIT FOR IO TO FINISH
	JRST .-1
	HRROI 1,[ASCIZ /**HALTED**
/]
	MOVE 2,CTYLNO
	CALL TTEMES		;ANNOUNCE HALT ON CTY
	CALL STADYN		;POINT TO DYNAMIC DATA
	 JRST SWHLT5		;NOT ACTIVE. SHOULDN'T HAPPEN
	PUSH P,T2		;SAVE DYNAMIC DATA ADDRESS
	CALL TTCH7		;MAKE SURE CTY OUPTUT IN PROGRESS
	MOVE T2,0(P)		;GET DYNMAIC DATA ADDRESS
	CALL TTSOBE		;SEE IF OUTPUT BUFFER IS EMPTY
	 JRST .-1		;NOT YET. KEEP WAITING
	POP P,T2		;DON'T NEED THIS ANYMORE
SWHLT5:	SKIPN DDTPRS		;DDT PRESENT?
	JRST SWHLT2		;NO, HALT PROCESSOR
	SKIPN DBUGSW		;EXPECTING BREAKPOINTS?
	SKIPE DCHKSW
	JRST SWHLT4		;YES, GET ONE
SWHLT2:
	PIOFF			;STOP ALL INTERRUPTS
	JSR BUGMON		;AND ENTER SECONDARY PROTOCOL
	JRST 4,.+1		;STOP HERE
	JSR BUGPRI		;IF CONTINUES, RESTORE MACHINE
	PION			;ALL OF IT
	JRST SCHED0		;AND RESUME SCHEDULER
;SCHEDULER REQUEST PROCESSOR
;MAY BE CALLED FROM SCHEDULER OR PROCESS CONTEXT
; T1/ DATA,,ADDRESS OF FUNCTION

; *MONUMENT*
;Once upon a time, this routine was called at interrupt level with
;several different arguments.  At present, it is called only for
;JOBSRT and only in places where JOBSRT could be called directly.
;Therefore, this routine is now just a jacket for JOBSRT after
;verifying that the caller does indeed want JOBSRT.

SCDRQ7::SAVET
	NOSKD1
	HRRZ T2,T1		;GET ROUTINE ADDRESS
	CAIE T2,JOBSRT		;THE ONE LEGAL CASE?
	BUG(SRQBAD)
	HLRZ T1,T1		;GET DATA
	CALL 0(T2)		;DO IT
	OKSKD1
	RET
;SCHEDULER REQUESTS
;CREATE A JOB
; T1/ TERMINAL LINE NUMBER OR 0,,-2 IF CRJOB

JOBSRT::SAVEQ
	CAMN T1,CTYLNO		;CTY?
	JRST JOBSR2		;YES, ALLOW IF AT ALL POSSIBLE
	MOVE 2,SPTC		;CURRENT SPT COUNT
	CAML 2,SPC1		;ABOVE LOGIN LIMIT?
	JRST [MOVE T3,[POINT 7,[ASCIZ\?FULL - No more SPT slots
\]]
	      JRST JOBSR1]
	MOVE 2,DRMFRE
	CAMG 2,DRMIN1		;ENOUGH DRUM SPACE?
	JRST [MOVE T3,[POINT 7,[ASCIZ\?FULL - No more swapping space
\]]
	      JRST JOBSR1]
JOBSR2:	SAVEAC <Q1,Q2>
	SKIPN FREJOB		;ROOM FOR NEW JOB
	JRST [MOVE T3,[POINT 7,[ASCIZ\?FULL - No more job slots
\]]
	      JRST JOBSR1]
	SKIPN FREFK		;AND NEW FORK?
	JRST [MOVE T3,[POINT 7,[ASCIZ\?FULL - No more forks
\]]
	      JRST JOBSR1]
	MOVE 2,@FREJOB		;ASSIGN JOB NUMBER
	EXCH 2,FREJOB
	SUBI 2,JOBPT
	SETZM JOBRT(T2)		;JOB RUNTIME
	SETZRO JOBRTP,(T2)	; No job runtime limit
	SETZRO TIMCNT,(T2)	;  and no clocks in use yet
	SETZM JOBIRT(T2)	;NO INCREMENTAL RUN TIME YET
	CAMLE T2,MJBUSE		;HIGHER JOB NUMBER?
	MOVEM T2,MJBUSE		;YES
	LOAD T3,CLSDF		;GET DEFAULT CLASS
	HRRM T3,JOBCLS(T2)	;INIT TO DEFAULT CLASS
	AOS CLSCNT(T3)		;COUNT THIS NEW JOB
	MOVEM T1,Q1		;SAVE TTY NUMBER
	MOVEM T2,Q2		;SAVE JOB NUMBER
	CALL ASSFK		;GET A FORK IN FX
	STOR FX,JBTFK,(Q2)	;SETUP TOP FORK FOR JOB
	STOR Q1,JBTTY,(Q2)	;SETUP TTY FOR JOB
	STOR Q2,FKJOBN		;LEAVE JOB NUMBER IN FORK
	CALL ASFSB		;ASSIGN JSB
	STOR 1,FKJSB
	MOVE T1,Q1		;TTY NUMBER
	TXO T1,NEWJB%
	IORM 1,FKINT(FX)	;LEAVE TTY NUMBER FOR STARTUP ROUTINE
	CALLRET WTCONC		;PUT FORK ON WAIT LIST

;HERE WHEN CAN'T START THE JOB BECAUSE OF SOME SHORTAGE.  SEND
;'FULL' TO THE LINE

JOBSR1:	TXNE T1,1B18		;NEGATIVE LINE NUMBER?
	JRST JOBSRC		;YES, CRJOB
	MOVE T2,T1
	MOVE T1,T3		;GET POINTER TO MESSAGE
	PUSH P,2		;SAVE
	CALL TTABRT		;CONDITION LINE FOR TTEMES
	CALL TTEMES		;GIVE USER BAD NEWS
	POP P,1			;GET LINE NUMBER
	CALL CHKPTY		;IS THIS A PTY
	 SKIPA			;NO - DONE
	CALL PTYFIN		;YES - MAKE IT HUNGRY
	RET

JOBSRC:	MOVEI T1,CRJBX6		;SYSTEM FULL ERROR CODE
	MOVEM T1,CRJANS		;ANSWER TO OTHER JOB
	RET
;ASSIGN FORK SLOT

ASSFK::	MOVE F,SCHFLG
	HRRZ FX,@FREFK
	EXCH FX,FREFK		;GET FORK, UPDATE LIST
	SUBI FX,FKPT
	SETZM FKQ2(FX)		;INIT FLAGS AND Q VALUES
	MOVEI 1,JSKP
	MOVEM 1,FKSTAT(FX)	;INIT STATUS
	CALL INIQ		;GET INITIAL QUEUE FOR FORK
	STOR T1,FKQN
	MOVE T1,QUANTT(T1)	;GET QUANTUM FOR IT
	STOR 1,FKQTM		;ESTABLISH QUEUE
	MOVE 1,TODCLK
	MOVEM 1,FKTIME(FX)
	MOVX 1,FKPSI0+NEWFK%
	MOVEM 1,FKINT(FX)	;LEAVE INTERRUPT REQUEST
	SETONE PIBMP		;BE SURE IT RUNS ASAP
	SETZM FKSWP(FX)
	SETZM FKPT(FX)
	SETZM FKINTB(FX)
	SETZM FKPGS(FX)		;CLEAR PT AND PSB WORD
	SETZM FKCNO(FX)
	SETZM FKJOB(FX)
	SETZM FKWSP(FX)
	MOVE 1,[XWD 100100,3]	;INIT AGE TO 100, W.S. TO 3
	MOVEM 1,FKNR(FX)
	CALL ASFSB		;ASSIGN PSB
	STOR 1,FKPSB
	CALL ASFSB		;ASSIGN UPT
	STOR 1,FKUPT
	CALL ASFSB		;GET ONE FOR THE STACK PAGE
	STOR T1,FSSPTN		;SAVE IT
	RET

;PROCESSOR INTERRUPTS REFERRED FROM APR PI SERVICE


MPEINT:	MOVEI 2,.ICDAE		;GIVES I/O ERROR INTERRUPT
	EXCH 1,2		;FORK NUMBER LEFT BY APR ROUTINE
	CALL PSIRQ
	RET
;BALANCE SET SCHEDULER
;CALLED TO SELECT JOB TO RUN

SKDJOB:	SETZM PSKED
	MOVE T1,NBWT		;NUMBER BALSET FORKS NOW WAITING
	CAML T1,NBPROC		;LESS THAN NUMBER IN BALSET?
	CALL BSBCK		;NO, ALL ARE WAITING. TEST ALL.
	HRRZ FX,GOLST		;SCAN GOLST FOR FORK TO RUN
SKCB5:	JUMPE FX,BKGND1		;NO RUNNABLE FORK
	SUBI FX,FKPT		;GET FORK INDEX
	MOVE T1,FKSWP(FX)	;GET SWAP FLAGS
	TXNE T1,FKWSL		;NOT LOADED?
	TXNE T1,BSWTB		;OR BLOCKED?
	JRST SKCB2		;YES, CAN'T RUN IT
	SKIPL T1,SSKED		;HAVE A NOSKED FORK?
	CAIN FX,0(T1)		;YES, THIS ONE?
	JRST SKDJ2		;OK TO RUN THIS FORK
SKCB2:	HRRZ FX,FKPT(FX)	;CAN'T RUN THIS FORK, GET NEXT IN LIST
	JRST SKCB5

;HAVE RUNNABLE FORK - SET IT UP AND RUN IT

SKDJ2:	AOS NCSWCH		;COUNT CONTEXT SWITCHES
	MOVEM FX,FORKX
	CAME FX,LSTPFK		;SAME AS LAST FORK LOADED?
	CALL SETPPG		;SETUP PAGER FOR THIS PROCESS
	MOVEM FX,LSTPFK		;REMEMBER LAST FORK LOADED
	LOAD T3,FKQTM		;SETUP QUANTUM FOR THIS RUN
	MOVEM T3,BSQNT
	MOVEM T3,BSQNT0
	SETZM FKT1		;CLEAR INCREMENTAL TIME
	CALL XGCCHK		;CHECK FOR XGC NEEDED
	RET			;DONE
;CHECK ALL WAITING BALSET FORKS

BSBCK:	SKIPL FORKX		;HAVE FORK SETUP?
	JRST BSBCK0		;YES, NO SWAPS NOW
	SKIPN SKEDFC		;FORCED CLEAR REQUESTED?
	IFSKP.
	  SKIPGE SSKED		;YES, A NOSKED FORK?
	  JRST SKDJFC		;NO, OK TO DO
	ENDIF.			;YES, CAN'T DO IT NOW
	CALL TSTBAL		;TEST AND ADJUST BALSET IF NECESSARY
	CALL WSMCHK		;DO PERIODIC WS MGT
BSBCK0:	HRRZ FX,GOLST
BSBCK1:	JUMPE FX,R		;DONE
	SUBI FX,FKPT
	MOVE T1,FKSWP(FX)
	TXNE T1,FKWSL		;NOT LOADED?
	TXNN T1,BSWTB		;OR NOT WAITING?
	JRST BSBCK2		;YES, SKIP IT
	CALL SKDJ3		;TEST IT
	 NOP
BSBCK2:	HRRZ FX,FKPT(FX)	;STEP LIST
	JRST BSBCK1
;FOUND NO FORK TO RUN

BKGND1:	CALL UPDTCK		;UPDATE TODCLK
	SKIPE NBPROC		;BALSET EMPTY?
	JRST [	CALL WTCHK	;NO, CHECK WAIT LIST ONLY
		JRST BKGND2]
	CALL SKDLV8		;DO ALL BACKGROUND STUFF
	CALL CLK2
	CALL WTCHK		;CHECK WAITING FORKS
	SETZM QSKED
	CALL AJBALS		;CHECK BALSET
BKGND2:	SETO FX,		;NOTE NO FORK TO RUN
	RET

;HERE TO FORCE UNLOAD OF BALSET AND COLLECT ALL OF MEMORY THAT
;ISNT ACTUALLY LOCKED

SKDJFC:	MOVSI FX,-NFKS
SKJFC1:	TMNE FKIBS	;IS THIS FORK IN THE BALANCE SET?
	CALL CLRIBS		;YES. REMOVE IT
	JE FKWSL,,SKJFC3	;JUMP IF WS NOT LOADED
	CALL REMWS		;REMOVE IT
SKJFC3:	AOBJN FX,SKJFC1

;HERE WHEN BALSET UNLOADED, FORCE GCCOR TO FREE MEMORY. GCCOR TAKES
;NOTE OF SKEDFC

SKJFC2:	CALL GCCOR		;GETS PRIVATE PAGES AND SPT PAGES
	SETOM LSTPFK		;NOTE PAGER CONTEXT INVALID
	SETZM SKEDFC		;CLEAR BLUNDERBUSS FLAG
	JRST SKDJOB		;AND TRY AGAIN.
;TEST WAITING BALSET FORK

SKDJ3:	HRRZ 2,FKPGST(FX)
	HLRZ 1,FKPGST(FX)	;SETUP TEST DATA
	JSP 4,0(2)		;CALL TEST ROUTINE
	 JRST SKDJW		;STILL WAITING
DISMT3:	CALL DISACC		;ACCOUNT FOR WAIT
	HRRZ 1,FKPGST(FX)
	CAIN T1,PRELWT		;PRELOAD WAIT?
	JRST SKDJS2		;WAIT SOME MORE
	CAIE 1,SWPINT		;WAS BEING LOADED?
	RETSKP			;NO, RETURN RUNNABLE
	TMNN PIBMP	;RETURNING TO NORMAL PROCESSING?
	SKIPN PRELDF		;PRELOADING DESIRED?
	JRST SKDJS1		;NO
SKDJS2:	MOVE T1,NRPLQ		;SAVE NUMBER PAGES NOW AVAIL
	ADD T1,IOIP
	PUSH P,T1
	CALL PRELD		;TRY TO PRELOAD
	 JRST [	SETONE BSWTB	;NOT COMPLETE, PUT FORK BACK INTO WAIT
		MOVEM T1,FKPGST(FX) ;WAIT TEST RETURNED BY PRELD
		AOS NBWT	;COUNT IT
		AOS NBSWP	; AS SWAP WAIT
		MOVE 1,TODCLK	;RESET TIME OF START OF WAIT
		MOVEM 1,FKNBW(FX)
		POP P,T1
		SUB T1,NRPLQ	;COMPUTE NUMBER PAGES USED FOR LOAD
		SUB T1,IOIP
		LOAD T2,FKNWCE	;GET PRELOAD RESERVE
		CAMGE T2,T1	;GREATER THAN NUMBER LOADED?
		MOVE T1,T2	;NO, LIMIT
		SUB T2,T1	;REDUCE RESERVE BY AMT LOADED
		STOR T2,FKNWCE
		MOVN T1,T1	;REDUCE TOTAL RESERVE
		ADDM T1,NRPMIN
		JRST SKDJW]
	POP P,T1		;FLUSH TEMP
SKDJS1:	CALL SOSNEB		;PROCESS FINISHED ENTERING BALSET
	RETSKP			;RETURN RUNNABLE

SKDJW:	RET			;RETURN NOSKIP, FORK STILL WAITING
;ACCOUNT FOR BALSET WAIT ON COMPLETION

DISACC:	SETZRO BSWTB		;CLEAR WAIT
	SOS NBWT		;NOW ONE LESS WAITING PROCESS
	MOVE 1,TODCLK		;COMPUTE LENGTH OF TIME WAITED
	SUB 1,FKNBW(FX)
	HRRZ 2,FKPGST(FX)	;WAIT TEST ADR
	ADDM 1,BSWT		;ACCUMULATE TOTAL WAIT
	CAIN T2,PRELWT		;PRELOAD WAIT?
	JRST DISAC2		;YES, HANDLE LIKE SWAP WAIT
	CAIE 2,SWPINT		;SWAPIN?
	CAIN 2,SWPRT		;OR SWAP?
DISAC2:	JRST [	ADDM T1,DRMWT	;YES, CHARGE TO DRUM
		SOS NBSWP	;REDUCE COUNT OF SWAP WAITS
		CAIN T2,SWPRT	;SWAP-IN?
		CALL CHGHLS	;YES. DO CHARGING THEN
		JRST DISAC1]
	CAIN T2,DWRTST		;WRITE WAIT?
	JRST [	ADDM T1,DWRWT	;YES, CHARGE IT
		JRST DISMT5]
	CAIE 2,UDWDON		;UTILITY DSK? OR
	CAIN 2,DSKRT		;DSK?
	SKIPA			;YES
	JRST DISAC1		;NO, NO CHARGE TO QUANTUM
	ADDM 1,DSKWT		;CHARGE TO DSK
DISMT5:	TXNE F,SK%IOC		;QUANTUM CHARGE FOR IO?
	JRST DISAC1		;NO
	MOVEI T1,^D10*NTMS	;NOMINAL QUANTUM CHARGE
	LOAD 3,FKQTM		;CHARGE AGAINST REGULAR QUANTUM
	CAIG T3,0(T1)		;WILL RESULT BE POSITIVE?
	MOVEI T3,1(T1)		;NO. FORCE IT TO BE SO
	SUB 3,1
	STOR 3,FKQTM
	CALL CHGHLF		;CHARGE FOR FILE READ
DISAC1:	RET

;CHARGE HOLD TIME FOR FAULT

;ENTRY FOR SWAP READ

CHGHLS:	MOVEI T1,2		;ASSUME SMALL CHARGE
	SKIPE PRELDF		;PRELOADING WS?

;ENTRY FOR FILE READ AND FOR SWAP READ IF PRELDF IS ON

CHGHLF:	MOVEI T1,^D10		;LARGE CHARGE
	LOAD T3,FKBET		;GET HOLD TIME
	JUMPE T3,R		;IF NONE, DONE
	SUBI T3,0(T1)		;REDUCE BY QUANTUM CHARGE
	STOR T3,FKBET
	RET			;AND DONE
;UPDATE FOR PROCESS FINISHED ENTERING BALSET

SOSNEB:	LOAD T1,FKNWCE		;WS SIZE RESERVED DURING SWAPIN
	MOVN 1,1
	ADDM 1,NRPMIN		;REMOVE FROM CORE RESERVE
	SOS NEBAL
	RET

;CHECK FORK HAVING DONE EDISMS, BEING HELD IN BALSET

DISMT:	HRRZ 2,FKSTAT(FX)	;SEE IF EDISMS WAIT FINISHED
	HLRZ T1,FKSTAT(FX)
	JSP 4,0(2)
	 CAIA			;NO
	JRST FRIBP1		;YES
	HLRZ T1,FKPGST(FX)	;GET TIME PARAMETER FOR BLOCKW
	JSP 4,BLOCKW		;SEE IF GRACE PERIOD OVER
	 JRST DISMT1		;NO
	SOS NHOLDF		;ONE LESS HOLDING FORK
	CALL DISACC		;YES, ACCOUNT FOR WAIT
	CALL DISMT2		;PUT FORK INTO NORMAL BLOCK STATE
	MOVEI FX,GOLST-FKPT	;REINIT LIST PTR
	JRST SKDJW		;RETURN

DISMT1:	SKIPGE 1,FKINT(FX)	;SEE IF INTERRUPT PENDING
	TLNE 1,(1B1)		;AND ACCEPTABLE
	JRST SKDJW		;NO
	MOVX 1,PSIWT%		;YES, REMEMBER FORK WAS WAITING
	IORM 1,FKINT(FX)
FRIBP1::SOS NHOLDF		;ONE LESS HOLDING FORK
	JRST DISMT3		;LET IT RUN

DISMT2:	PUSH P,FKNBW(FX)		;SAVE TIME THAT WAIT STARTED
	CALL REMBSJ		;REMOVE JOB FROM BAL SET
	CALL GLREM		;REMOVE FORK FROM GOLST
	POP P,FKPGST(FX)	;SAVE TOD OF DISMISS FOR NEWST
	CALL WTCON2		;PUT ON WAIT LIST
	RET
;CALL PERIODIC WS MGT ROUTINES

WSMPER==^D500			;LENGTH OF PERIOD

WSMCHK:	SETOM RWSOKF		;FLAG TO ALLOW REMWS IN WSMGR
	CALL TSTGCC		;SEE IF GCCOR NEEDED
	 SKIPA			;NO
	CALL DOGCC		;YES, DO IT AND ACCOUNT OVERHEAD
	MOVE T1,SUMNR
	ADD T1,NRPLQ
	ADD T1,IOIP
	CAMGE T1,MAXNR		;UNACCOUNTED PAGES?
	CALL DOGCC		;YES, COLLECT
	MOVE T1,NRPLQ
	ADD T1,IOIP
	CAIGE T1,^D32
	SETZ T1,
	SKIPE NRPLQ
	CAMG T1,NRPMIN		;LOW ON MEM?
	CALL WSMGR		;YES, FIX
	MOVE T1,TODCLK
	CAMGE T1,WSMTIM		;TIME FOR UPDATES?
	JRST WSMCK1		;NO
	ADDI T1,WSMPER		;YES, SETUP NEXT TIME
	MOVEM T1,WSMTIM
	CALL STEPFH		;UPDATE HISTORY VALUES
	CALL WSMGR		;CHECK FOR SWAP
WSMCK1:	SETZM RWSOKF		;RESET FLAG
	RET

;STEP FORK HISTORY VALUES - RUN PERIODICALLY

FHUNIT==1B<^L<FKHST>>		;UNIT VALUE IN HISTORY
STEPTC==^D8			;TIME CONSTANT, LARGER FOR SLOWER CHANGE

STEPFH:	MOVSI FX,-NFKS		;SCAN FORK TABLES
STEPH1:	SKIPGE FKPT(FX)		;FORK EXISTS?
	JRST STEPH2		;NO
	LOAD T3,FKHST
	IMULI T3,STEPTC-1	;COMPUTE H*(X-1)/X
	MOVE T1,FKSWP(FX)	;GET FLAGS
	TXZN T1,FKIBH		;WAS IN BALSET DURING INTERVAL?
	TXNE T1,FKIBS		;FORK NOW IN BALSET?
	ADD T3,[FHUNIT]		;YES, ADD UNIT VALUE
	HLLM T1,FKSWP(FX)	;UPDATE FLAGS
	IDIVI T3,STEPTC
	STOR T3,FKHST
STEPH2:	AOBJN FX,STEPH1
	RET
;GET FORK HISTORY VALUE
;VALUE USED TO RANK FORK WORKING SETS PRIORITY IN MEM
;GREATER NUMBER MEANS HIGHER PRIORITY
; FX/ FORK INDEX

;VALUES IN RESULT

FHMNSK==4000B17			;NOSKED, TOP PRIORITY
FHMRUN==2000B17			;RUNNABLE
FHMPQ==  400B17			;PRIORITY QUEUE
FHMBS==  200B17			;IN BALSET
FHMCSK== 100B17			;CRITICAL SECTION
FHMBIP==40B17			;PI BUMP
;FHMWTS==  70B17			;WAIT STATE CODE

GFHST:	MOVE T4,FKSWP(FX)	;GET SWAP FLAGS
	SETZ T1,		;START WITH 0
	TMNE PIBMP	;FORK NEEDS BUMPING FOR PI?
	ADD T1,[FHMBIP]		;YES. GIVE IT HELP THEN
	TXNE T4,BSNSK		;NOSKED?
	ADD T1,[FHMNSK]		;YES, PRIORITY
	TXNE T4,BSCRSK		;CRITICAL SECTION?
	ADD T1,[FHMCSK]		;YES
	LOAD T2,FKQN
	CAIG T2,HIGHQ		;ON PRIORITY QUEUE?
	ADD T1,[FHMPQ]		;YES, BUMP
	TXNN T4,FKBLK		;FORK RUNNABLE?
	JRST GFHST1		;YES
	LOAD T2,FKGOLN		;NO, GET BLOCK WAIT PRIORITY
	;STOR T2,FHMWTS,T1	;INCLUDE IN HISTORY WORD
	OPSTR <ADD T1,>,FKHST	;USE HISTORY VALUE
	RET

GFHST1:	ADD T1,[FHMRUN]		;YES, MAKE IT BETTER THAN ALL BLOCKED FORKS
	TXNE T4,FKIBS		;IN BALSET?
	ADD T1,[FHMBS]		;YES, BASIC UNIT VALUE
	OPSTR <ADD T1,>,FKGOLN	;GOLST POSITION IS FINAL DETERMINANT
	RET
;WORKING SET MANAGER
;SELECT WORKING SETS TO SWAP INTO OR OUT OF MEMORY

WSMGR:	TRVAR <MAXWS,MAXWSF,MINWS,MINWSF,WSMSUP,WSMSNR>
	MOVEI T4,NFKS		;ASSIGN GOLST POSITION TO ALL FORKS ON GOLST
	HRRZ FX,GOLST
WSMGS1:	JUMPE FX,WSMG0		;JUMP IF END OF LIST
	MOVEI FX,-FKPT(FX)	;GET FORK INDEX
	STOR T4,FKGOLN		;STORE POSITION
	HRRZ FX,FKPT(FX)	;STEP LIST
	SOJA T4,WSMGS1		;STEP POSITION NUMBER

WSMG0:	MOVSI FX,-NFKS		;SCAN FORK TO SELECT WORST IN-MEMORY
	SETZM WSMSUP		; FORK AND BEST NOT-IN-MEM FORK
	SETZM WSMSNR		;INIT SUMNR COUNT
	MOVX T1,1B1
	MOVEM T1,MINWS
	MOVNM T1,MAXWS
	SETOM MINWSF
WSMG2:	MOVE T1,FKSWP(FX)	;GET SWAP FLAGS
	TXNE T1,FKWSL		;WS IN MEM?
	JRST [	LOAD T2,FKWSS	;YES, COMPUTE TOTAL
		ADDM T2,WSMSNR
		LOAD T2,FKCSIZ
		ADDM T2,WSMSUP	;TOTAL USED PAGES
		CALL GFHST	;GET HISTORY VALUE
		CAML T1,MINWS	;HAVE NEW MINIMUM?
		JRST WSMG1	;NO
		MOVEM T1,MINWS	;YES, SAVE VALUE AND FX
		HRRZM FX,MINWSF
		JRST WSMG1]
	TXNN T1,FKIBS		;NOT IN MEM, WANTS TO BE?
	JRST WSMG1		;NO
	CALL GFHST		;WS NOT IN MEM, GET HISTORY VAL
	CAMG T1,MAXWS		;NEW MAX?
	JRST WSMG1		;NO
	MOVEM T1,MAXWS		;YES, SAVE VALS
	HRRZM FX,MAXWSF
WSMG1:	AOBJN FX,WSMG2
	; ..
	; ..
	MOVE T4,WSMSNR		;CHECK TOTAL
	PIOFF			;PREVENT CHANGE AT INT LEVEL
	MOVE T3,SUMNR
	ADD T4,BALSHC
	PION
	CAMN T4,T3
	IFSKP.
	  MOVE T3,SUMNR
	  BUG(SUMNR2,<<T3,D>,<T4,D>>)
	  MOVEM T4,SUMNR
	ENDIF.
	SKIPN RWSOKF		;REMWS OK HERE?
	JRST WSMG6		;NO, NO SWAPOUTS
WSMG8:	MOVE T1,NRPLQ
	ADD T1,IOIP		;CHECK AVAILABLE MEM
	SKIPE NRPLQ
	CAMG T1,NRPMIN		;LOW?
	JRST WSMG4		;YES, DO SOMETHING ABOUT IT
	SKIPGE FX,MINWSF	;HAVE FORK WHICH COULD GO OUT?
	JRST WSMG6		;NO
	JN FKIBS,,WSMG6		;JUMP IF IT BELONGS IN BALSET
	CAIGE T1,^D32		;DOESN'T, MEM GETTING LOW?
	JRST WSMG7		;YES, FLUSH IT
WSMG6:	SKIPGE MAXWS		;HAVE A FORK WAITING TO COME IN?
	JRST WSMG3		;NO
	MOVE FX,MAXWSF		;YES, GET ITS FX
	MOVE T1,MAXWS		;SEE IF BEST NOT-IN-MEM IS BETTER THAN
	SKIPL MINWSF		; WORST IN-MEM (OR NONE IN MEM)
	CAMLE T1,MINWS
	JRST WSMG5		;YES, LOAD
	LOAD T1,FKWSS		;ELSE, SEE IF FORK WOULD FIT WITH OTHERS
	ADD T1,SUMNR
	CAML T1,MAXNR		;FITS?
	JRST WSMG3		;NO, DO NOTHING
WSMG5:	CALL LOADWS		;LOAD FORK
	 JRST WSMG3		;COULDN'T
	JRST WSMG0		;RECHECK
WSMG4:	MOVE T2,SUMNR		;MEM DEFINITELY OVERLOADED?
	CAML T2,MAXNR
	IFSKP.
	  ADD T2,IOIP		;INCLUDE PAGES DUE
	  CAML T2,MAXNR		;STILL UNDER LIMIT?
	  JRST WSMG6		;NO, DO NOTHING
	  CALL DOGCC		;COLLECT UNASSIGNED PAGES
	  MOVE T2,SUMNR		;RECHECK LIMIT
	  CAMGE T2,MAXNR
	  JRST WSMG6		;UNDER, CONTINUE
	ENDIF.			;OVER, REMOVE SOMETHING
	MOVE T1,NWSMEM
	CAILE T1,1		;MORE THAN ONE FORK IN MEM?
	IFSKP.
	  CALL DOGCC		;NO, CLEAR OUT SHARED PAGES
	  JRST WSMG6		;AND LEAVE FORK AS IS
	ENDIF.
WSMG7:	SKIPGE FX,MINWSF	;HAVE A FORK TO REMOVE?
	JRST WSMG3		;NO, DO NOTHING NOW
	MOVX T1,FKBLK
	TDNN T1,FKSWP(FX)	;FORK BLOCKED?
	AOS NREMR		;NO, COUNT SWAPOUT OF RUNNABLE FORK
	CALL REMWS
	SKIPN POSPGF		;POST PURGE DONE?
	CALL FKGC		;NO, REMOVE FORK PAGES
	JRST WSMG0		;RECHECK

WSMG3:	RET			;DONE

;DO GCCOR AND SWITCH OVERHEAD CHARGING

DOGCC:	CALL RDSIVL		;YES, SWITCH OVERHEAD CHARGING
	MOVEM T1,SKDTHS
	CALL GCCOR
	SETOM LSTPFK		;NOTE PAGER CONTEXT INVALID
	CALL RDSIVL		;READ LAST INTERVAL
	ADDM T1,GCCTIM		;ACCUMULATE GCCOR TIME
	MOVN T1,SKDTHS		;RESET SCHED OVERHEAD TIME
	ADDM T1,SKDLST
	RET
;ADJUST CONTENTS OF BALANCE SET
;SCAN DOWN GOLIST, REMOVING OR ADDING PROCESSES TO BALSET
; AS APPROPRIATE

;**;[3017]COMMENT OUT 3 LINES AT DOGCC: + 14L	15-SEP-83	TAB
   REPEAT 0,<			;[3017]BEGIN REPEAT 0
RTUNIT==^D10000			;RT UNIT FOR FORCED REMOVAL
RTMIN==^D30000			;MINIMUM TIME-OUT
RTMAX==^D120000			;MAX TIME-OUT
   >				;[3017]END REPEAT 0
AJBYPF==1B0			;LOCAL FLAG - PASSED A NON-BALSET FK
AJNNLF==1B1			;NO NEW LQ FORKS
AJHQOF==1B2			;HQ FORKS ONLY
;**;[3017]REMOVE ONE LINE AT DOGCC:: + 18L	15-SEP-83	TAB
;[3017]AJRTRM==1B4			;RT REMOVAL FLAG

RS IDLFUG,1			;[6717]HOLDS IDLE IN MS FOR OVERFLOW OF SKDIDL
;LOCAL VARS - PAIRS MUST BE IN ORDER

RS AJBNHQ,1			;RUNNING NUMBER HQ FORKS
RS AJBNLQ,1			;RUNNING NUMBER LQ FORKS

RS AJBHQP,1			;RUNNING TOTAL HQ PAGES
RS AJBLQP,1			;RUNNING TOTAL LQ PAGES

RS NXTAJB,1			;TIME NEXT AJBALS DUE
RS AJBFLG,1			;PERMANENT FLAGS

BSPAD==^D20			;PAD FOR BALSET SUM
BSPADO==^D10			;POS OR NEG OFFSET FOR REMOVING OR LOADING

;TEST FOR AJBALS NECESSARY BEFORE SELECTING FORK TO RUN

TSTBAL:	MOVE T1,MAXNR
	CAMGE T1,SUMBNR		;MEM OVERCOMMITTED?
	JRST TSTBL1		;YES, ADJUST
	MOVE T1,TODCLK
	CAMGE T1,NXTAJB		;TIME FOR PERIODIC CHECK?
	RET			;NO, DO NOTHING
TSTBL1:	AOS NAJBAL		;COUNT FORCED CALLS
	CALLRET AJBALS		;DO IT
;ADJUST BALANCE SET

AJBALS:	TRVAR <AJLODN,AJBLFK,AJBBSC,PRIPST,RTREM>
	;ACS Q1,Q2,FX,P1,P2 SHOULD BE SAVED HERE
	SKIPE PAGDIF		;NEW PAGES IN SYSTEM?
	CALL ADJSWP		;YES. ADJUST PAGING TO MATCH NEW STATE
	SETOM PRIPST		;NO SKIPPED PROCESS YET
	SETZM AJLODN		;NUMBER FORKS LOADED ON THIS CALL
	SETZM AJBNHQ		;INIT VARIABLES
	SETZM AJBNLQ
	SETZM AJBHQP
	SETZM AJBLQP
	SETOM AJBLFK
	HLL F,AJBFLG		;GET PERM FLAGS
	SKIPN CLASSF		;NON-CLASS SCHEDULER?
	TXNN F,SK%HQR		;HQ DISASTER AVOIDANCE?
      IFSKP.
	MOVE T1,HQLAV		;YES, GET CURRENT HQ LDAV
	CAMGE T1,HQLEV1		;BELOW TURN OFF POINT?
	TXZ F,AJNNLF		;YES
	CAML T1,HQLEV2		;ABOVE TURN ON POINT?
	TXO F,AJNNLF		;YES
	CAMGE T1,HQLEV3		;BELOW TURN OFF POINT?
	TXZ F,AJHQOF		;YES
	CAML T1,HQLEV4		;ABOVE TURN ON POINT?
	TXO F,AJHQOF		;YES
      ELSE.
	TXZ F,AJNNLF!AJHQOF	;NO DISASTER AVOIDANCE, NORMALIZE FLAGS
      ENDIF.
	MOVE T1,MAXNR		;SET LIMIT FOR HOLDING FORKS
	SUBI T1,100
	MOVEM T1,MAXHNR		;HOLD LIMIT
	SETZM BSKED
	SETZ Q1,			;INIT NBP COUNT
	MOVE 4,BALSHC		;INIT SUMNR COUNT
	ADDI T4,BSPAD		;INCLUDE PAD
	MOVEM T4,AJBBSC		;SAVE BASE
	MOVEI Q2,BSLST		;SCAN LIST OF RECENT BALSET ENTRIES
;**;COMMENT OUT 12 LINES AT AJBS2: - 12L	15-SEP-83	TAB
   REPEAT 0,<			;[3017]BEGIN REPEAT 0
	TXZ F,AJRTRM		;ASSUME NOT DOING RT REMOVAL
	MOVE T1,NBPROC		;GET # IN BS
	CAMN T1,NGOJOB		;ALL IN?
	JRST AJBS2		;YES
	MOVE T1,IRJAV		;GET CURRENT LOAD AVG
	IMULI T1,RTUNIT		;COMPUTE TIME TO HOLD PROCESSES
	CAIGE T1,RTMIN
	MOVEI T1,RTMIN
	CAILE T1,RTMAX
	MOVEI T1,RTMAX		;MAKE SURE NUMBER IS GOOD
	MOVEM T1,RTREM		;SAVE IT
	TXO F,AJRTRM		;SAY DOING REMOVALS
   >				;[3017]END REPEAT 0
AJBS2:	HRRZ Q2,0(Q2)		;GET NEXT
	JUMPE Q2,AJBAL4		;JUMP IF END OF LIST
	MOVEI FX,-FKBSPW(Q2)
	SETZRO FKBSHF		;ASSUME NOT HOLDING
	LOAD T1,FKBET		;GET HOLD EXPIRATION TIME
	LOAD T2,FKJOBN
	SUB T1,JOBRT(T2)	;COMPUTE TIME REMAINING
;**;[3017]COMMENT OUT 8 LINES AT AJBS2: + 7L	15-SEP-83	TAB
   REPEAT 0,<			;[3017]BEGIN REPEAT 0
	TXNN F,AJRTRM		;ALL PROCESSES FIT?
	JRST AJBS0		;YES. SKIP RT TEST THEN
	HLRZ CX,0(Q2)		;GET ENTRY TIME
	HRRZ P2,TODCLK		;GET NOW
	SUB P2,CX		;COMPUTE TIME SINCE ENTERED
	SKIPGE P2		;CHECK FOR OVERFLOW
	ADD P2,[1B17]		;YES. FIX IT
	CAMG P2,RTREM		;TOO LONG?
AJBS0:	>			;[3017]END REPEAT 0
	TXNE T1,FKBETH		;NEGATIVE NUMBER? (CHECK HIGH-ORDER BIT)
	JRST [	SETZRO FKBET	;YES, SET TIME EXPIRED
		CALL REMBSL	;REMOVE FROM PROTECT LIST
		JRST AJBS2]
	LOAD T1,FKWSS
	ADD T1,T4
	SUBI T1,BSPAD
	CAMLE T1,MAXHNR		;ROOM TO HOLD FORK?
	JUMPG Q1,AJBS2		;NO (UNLESS FIRST FORK SEEN)
	SETONE FKBSHF		;SET HOLD FLAG
	CALL AJBUQS		;STILL HOLDING, COUNT PAGES
	ADDM T1,T4
	AOJA Q1,AJBS2
;SCAN GOLST CHECKING ALL FORKS, AND REMOVE, LOAD, OR
;LEAVE AS IS.

AJBAL4:	TXZ F,AJBYPF		;INIT FLAG
	MOVEI Q2,GOLST
AJBAL1:	HRRZ Q2,0(Q2)		;GET NEXT
AJBL10:	JUMPE Q2,AJBALX		;DONE IF REACHED END OF GOLST
	MOVEI FX,-FKPT(Q2)	;GET FORK INDEX
	LOAD P2,FKQN		;CHECK FORK QUEUE
	CAIGE P2,MAXQ		;HIGH QUEUES?
	TDZA P2,P2		;YES, USE 0 INDEX
	MOVEI P2,1		;NO, USE 1 INDEX
	JE FKIBS,,AJBAL5	;JUMP IF NOT IN BALSET
FRIBP0:	MOVE CX,FKSWP(FX)	;GET FLAGS
	TXNE CX,FKBSHF		;HELD?
	JRST AJBAL1		;YES. ALREADY ACCOUNTED
	TXNE CX,BSNSK!BSCRSK	;NOSKED OR CRSKED?
	JRST AJBL77		;YES. TRY TO KEEP IT THEN
	JN PIBMP,,AJBL77	;KEEP IF PI'ING
	SKIPG CLASSF		;WITHHOLDING WINDFALL?
	IFSKP.
	  CALL CKAHED		;YES. IS THIS ONE AHEAD?
	ANSKP.
	  JRST AJBL9		;YES, REMOVE FROM BALSET AND MEM
	ENDIF.
	TXNE F,AJHQOF		;HQ FORKS ONLY?
	JUMPN P2,AJBL9		;YES, FLUSH IF LQ
	JUMPE Q1,AJBAL7		;NO FURTHER CHECKS IF FIRST FORK SEEN
AJBL77:	LOAD 1,FKWSS
	ADD 1,4
	SUBI T1,BSPAD		;REDUCE BY PAD OFFSET
	CAMG Q1,MAXBP		;FORK STILL FITS IN BALSET?
	CAMLE 1,MAXNR
	JRST AJBL12		;NO
AJBAL7:	LOAD T1,FKWSS		;GET SIZE
	ADDM T1,4		;UPDATE SUM
	CALL AJBUQ0		;UPDATE QUEUE SUMS
	AOJA Q1,AJBAL1		;COUNT FORK

;HERE IF FORK NOW IN BALSET DOESN'T APPEAR TO FIT.

AJBL12:	HRRZ Q2,0(Q2)		;STEP LIST
	CALL CLRIBS		;NOTE NOT IN BALSET
	TXON F,AJBYPF		;NOTE PASSED A FORK NOT IN BALSET
	CALL SETPRP		;IF FIRST ONE, DO PRIORITY STUFF
	AOS NREMJ		;NOTE FORCED REMOVALS
	JRST AJBL10

;HERE TO REMOVE FORK FROM BALSET AND SWAPOUT IMMEDIATELY

AJBL9:	CALL CLRIBS
AJBAL2:	JE FKWSL,,AJBAL1	;JUMP IF WS NOT LOADED
	HRRZ Q2,0(Q2)		;STEP LIST
	PUSH P,T4		;SAVE SUMBNR COMPUTATION
	CALL REMWS		;SWAPOUT
	POP P,T4		;RESTORE LOCAL SUMBNR
	JRST AJBL10
;FORK NOT NOW IN BALSET

AJBAL5:	SKIPG CLASSF		;WITHHOLDING WINDFALL?
	IFSKP.
	  CALL CKAHED		;YES. IS THIS FORK AHEAD?
	ANSKP.
	  JRST AJBAL2
	ENDIF.
	SKIPGE SPMLCK		;SOMEONE TRYING TO GET A PAGE?
	IFSKP.
	  CALL TSTFRP		;YES. IS THIS FORK HOARDING THE PAGE?
	   JRST AJBAL1		;YES. DON'T LOAD IT
	ENDIF.
	JUMPE Q1,AJBAL6		;NO FURTHER CHECKS IF FIRST FORK SEEN
	LOAD T1,FKWSS		;CHECK SIZE
	ADD T1,T4			;BALSET SUM WHICH WOULD INCLUDE THIS FORK
	ADDI T1,BSPADO		;INCREASE BY PAD OFFSET
	CAMGE Q1,MAXBP		;ROOM IN BALSET FOR ANOTHER FORK?
	CAMLE T1,MAXNR		;ROOM FOR THIS FORK'S PAGES?
	JRST AJBL11		;NO
	TXNE F,AJNNLF		;ALLOW NEW LQ FORKS?
	JUMPN P2,AJB666		;NO. IF LQ CHECK FOR SPECIAL LOADING
	SKIPE CLASSF		;CLASS SCHEDULING BEING USED?
	TXNN F,AJBYPF		;YES. BYPASSED ANYBODY?
	SKIPA			;NO
	JRST [	CALL CORFCT	;YES. GET PRIORITY OF THIS PROCESS
		CAMGE T1,PRIPST	;THIS ONE LOWER THAN ONE PASSED?
		JRST AJB667	;YES. CHECK FOR SPECIAL LOAD
		CALL SETIBS	;NO. LOAD IT THEN
		JRST AJBAL7]	;AND PROCEED
AJBAL6:	CALL SETIBS		;NOTE IN BALSET
	TXNE F,SK%HT2		;NO HOLD TIME IF SKIPPED PROCESS?
	TXNN F,AJBYPF		;YES, SKIPPED A PROCESS?
	JRST AJBAL7		;NO. ACCOUNT FOR IT
AJBL69:	SETZRO FKBET		;YES. NO HOLD TIME NOW
	CALL REMBSL		;REMOVE FROM PROTECTED LIST
	JRST AJBAL7		;AND PROCEED

AJBL11:	TXON F,AJBYPF		;NOTE PASSED A FORK NOT IN BALSET
	CALL SETPRP		;IF FIRST TIME, DO PRIROITY STUFF
	JRST AJBAL1
;FORK CANNOT BE LOADED ACCORDING TO NORMAL RULES. CHECK FOR SPECIAL
;LOADING CRITERIA

AJB666:	SKIPA T1,[AJBAL1]	;WHERE TO GO
AJB667:	MOVEI T1,AJBL11		;WHERE TO GO
	JN BSCRSK,,AJB668	;IF CRSKED, LOAD IT
	JN PIBMP,,AJB668	;OR IF PI ALSO
	JRST 0(T1)		;CAN'T LOAD IT, GIVE UP
AJB668:	CALL SETIBS		;PUT IN BALSET
	JRST AJBL69		;BUT NO HOLD TIME

;UPDATE RUNNING QUEUE SUMS

AJBUQS:	LOAD P2,FKQN		;SET QUEUE SET INDEX
	CAIGE P2,MAXQ
	TDZA P2,P2		;USE 0 FOR INTERACTIVE QUEUES
	MOVEI P2,1		;1 FOR COMPUTE QUEUE
AJBUQ0:	LOAD T1,FKWSS		;UPDATE FOR CURRENT FORK
	ADDM T1,AJBHQP(P2)	;COUNT PAGES
	AOS AJBNHQ(P2)		;COUNT FORKS
	RET

;ROUTINE OF AJBALS TO HANDLE FIRST INSTANCE OF A FORK THAT
;WON'T FIT

SETPRP:	SKIPN CLASSF		;CLASS SCHEDULING?
	RET			;NO. NOTHING TO DO HERE THEN
	CALL CORFCT		;YES. GET PRIROITY OF THIS PROCESS
	CAMLE T1,[1.0]		;ONE OF THE COMPUTING PROCESSES?
	JRST [	TXZ F,AJBYPF	;NO. IGNORE THE SKIP THEN
		RET]		;AND DONE
	MOVEM T1,PRIPST		;SAVE PRIORITY OF THIS PROCESS
	RET			;AND DONE

;EXIT FROM AJBALS

AJBALX:	SUB T4,AJBBSC		;REMOVE PAD AND ORIG BALSHC
	PIOFF			;PREVENT CHANGE AT INT LEVEL
	MOVE T3,SUMBNR
	ADD T4,BALSHC		;INCLUDE CURRENT BALSHC
	PION
	CAMN T4,T3		;CHECK SUM
	IFSKP.
	  MOVE T3,SUMBNR
	  BUG(SUMNR1,<<T3,D>,<T4,D>>)
	  MOVEM T4,SUMBNR
	ENDIF.
	MOVE T1,TODCLK		;SET TIME FOR NEXT PERIODIC CALL
	ADD T1,AJBLCY
	MOVEM T1,NXTAJB
	MOVEM F,AJBFLG		;SAVE NEW SETTINGS
	MOVE T1,AJLODN		;RETURN COUNT OF FORKS LOADED THIS CALL
	RET
;CHECK FOR POSSIBILITY OF LOADING FORK INTO BALSET

CHKTFK:	SAVEQ
	MOVEI Q2,GOLST
CHKTF1:	HRRZ Q2,0(Q2)		;GET NEXT FORK ON GOLST
	JUMPE Q2,R		;DONE WHEN LIST NULL
	MOVEI FX,-FKPT(Q2)	;GET FORK INDEX
	JN FKIBS,,CHKTF1		;JUMP IF FORK IN BALSET
	SKIPGE SPMLCK		;IS SOME FORK TRYING TO GET A PAGE?
	IFSKP.
	  CALL TSTFRP		;YES. IS THIS FORK GUILTY OF HOLDING IT?
	   JRST CHKTF1		;YES. SKIP IT THEN
	ENDIF.
	CALL TRYLDF		;SEE IF IT CAN BE LOADED
	 RET			;COULDN'T, TRY NO MORE
	JRST CHKTF1		;COULD, TRY AGAIN
;CHECK SPECIFIC FORK FOR LOADING INTO BALSET
;N.B. (THIS IS A MONUMENT). THIS CODE SHOULD NEVER BE
;CALLED TO LOAD A FORK OF LOWER PRIORITY THAN ONE NOT LOADED.
;THAT IS, IF A FORK HIGHER ON GOLST CAN NOT BE LOADED, THEN
;DON'T CALL TRYLDF TO LOAD THIS ONE. PRESENTLY, CHKTFK IS
;THE ONLY USER OF TRYLDF AND IT DOES THE RIGHT THING.
;WOE BE TO HE (OR HER) THAT VIOLATES THIS TRUST.

TRYLDF:	MOVE T2,AJBFLG		;GET AJBALS PERMANENT FLAGS
	JN BSCRSK,,TRYLD0	;IF CSKED, ALWAYS TRY
	JN PIBMP,,TRYLD0	;IF PI'ING, ALSO LOAD
	TXNN T2,AJNNLF		;LQ FORK ALLOWED?
	IFSKP.
	  LOAD T1,FKQN		;NO
	  CAIL T1,MAXQ		;THIS FORK LQ?
	  RET			;YES, DON'T LOAD
	ENDIF.
	SKIPG CLASSF		;CLASS SCHED?
	IFSKP.
	  CALL CKAHED		;WINDFALL?
	ANSKP.
	  JRST TRYLD2		;NO, DON'T LOAD
	ENDIF.
TRYLD0:	LOAD T1,FKWSS		;GET WS SIZE
	ADDI T1,BSPAD		;INCREASE BY PAD AND OFFSET
	ADD T1,SUMBNR		;COMPUTE BALSET SIZE WITH FORK
	CAML T1,MAXNR		;FORK WS FITS?
	JRST TRYLD2		;NO, DON'T LOAD
	CALL SETIBS		;NOTE FORK IN BALSET
	MOVE T1,FKSWP(FX)
	TXNN T1,FKWSL		;WS NOW LOADED?
	SETZM WSMTIM		;NO, CHECK SOON
	RETSKP			;DONE

TRYLD2:	RET
;REMOVE FORK FROM BALSET WHEN BLOCKING

REMBSJ:	JE FKIBS,,R		;RETURN IF ALREADY OUT
	CALL CLRIBS
	LOAD T1,FKWSS
	LOAD T2,FKCSIZ
	ADDI T2,4
	CAMGE T2,T1		;WS SMALLER NOW?
	CALL [	MOVE T1,T2	;YES, REDUCE RESERVE
		CALLRET ADJWSS]
	HLRZ 2,FKJOB(FX)	;MAINTAIN SUBSYSTEM INFO...
	HRRZ 2,JOBNAM(2)
	HRRZ 1,FKNR(FX)
	ADDM 1,SSIZE(2)		;INTEGRATE WS SIZE
	AOS SNBLKS(2)		;AND COUNT NUMBER OF SAMPLES
	RET

;NOTE FORK IN/OUT OF BALSET, MAINTAIN COUNT
; FX/ FORK INDEX

SETIBS:	SETONE <FKIBS,FKIBH>
	SETZRO FKBSHF		;INIT HOLD FLAG
	JXE F,SK%HT1,SETIB2	;ALWAYS DO HOLD IF SK%HT1 0
	MOVE T1,NBSL		;NUMBER HOLDING FORKS
	CAIL T1,2		;ENOUGH NOW?
	JRST SETIB1		;YES, NO MORE
	JUMPE T1,SETIB2		;GIVE HOLD TIME IF NO OTHERS
	MOVE T1,SUMBNR
	ASH T1,1
	CAML T1,MAXNR		;IF 1 OTHER, GIVE HOLD TIME IF
	JRST SETIB1		; BALSET LESS THAN HALF FULL
SETIB2:	CALL APPBSL		;APPEND FORK TO BALSET LIST
	MOVEI T2,^D10000	;MAX HOLD TIME IF BIAS SCHEDULER
	SKIPE CLASSF		;IS IT?
	MOVEI T2,UTLINI*UTLTMI	;NO. SET TO NEWUTL CYCLE THEN
	LOAD T1,FKWSS		;COMPUTE HOLD TIME AS SIZE * 20 MS
	IMULI T1,^D20
	CAIGE T1,^D1000		;AT LEAST 1 SEC
	MOVEI T1,^D1000
	CAILE T1,0(T2)		;OVER MAX LIMIT?
	MOVEI T1,0(T2)		;YES. APPLY LIMIT THEN
	LOAD T2,FKJOBN
	ADD T1,JOBRT(T2)	;COMPUTE EXPIRATION TIME
	STOR T1,FKBET
SETIB1:	LOAD T1,FKWSS
	ADDM T1,SUMBNR		;UPDATE BALSET SUM
	AOS NBPROC
	RET

CLRIBS:	SETZRO <FKIBS,FKBET>
	CALL REMBSL		;REMOVE FORK FROM LIST
	LOAD T1,FKWSS
	MOVN T1,T1
	ADDM T1,SUMBNR		;UPDATE BALSET SUM
	SOS NBPROC
	RET
;APPEND FORK TO BALSET LIST

APPBSL:	SAVEAC <Q1,Q2>
	MOVEI Q1,BSLST
APPBS1:	HRRZ Q2,0(Q1)		;GET NEXT, SAVE PREV PTR
	JUMPN Q2,[MOVE Q1,Q2	;STEP AGAIN IF NOT END OF LIST
		JRST APPBS1]
	MOVEI Q2,FKBSPW(FX)	;END OF LIST, MAKE PTR TO NEW FORK
	HRRM Q2,0(Q1)		;APPEND
	SETZRO FKBLP		;NEW END
	AOS NBSL		;MAINTAIN COUNT
	RET

;REMOVE FORK FROM BALSET LIST

REMBSL:	MOVEI T1,BSLST
CLRIB1:	HRRZ T2,0(T1)		;GET NEXT, SAVE PREV
	JUMPE T2,R		;NOT ON LIST, IGNORE
	CAIE T2,FKBSPW(FX)	;DESIRED ONE?
	JRST [	MOVE T1,T2	;NO, STEP
		JRST CLRIB1]
	HRRZ T2,0(T2)		;SPLICE LIST
	HRRM T2,0(T1)
	SOS NBSL		;MAINTAIN COUNT
	RET

;CHANGE FKNR, UPDATE SUMNR IF NECESSARY
; T1/ NEW VALUE OF FKNR
; FX/ FORK INDEX

ADJWSS::JE FKWSL,,ADJWS1	;JUMP IF FORK WS NOT LOADED
	LOAD T2,FKWSS		;WS IN MEM, MUST UPDATE SUMNR
	SUBM T1,T2		;GET DIFFERENCE
	ADDM T2,SUMNR		;ADJUST SUMNR
ADJWS1:	STOR T1,FKWSS		;SET NEW VALUE
	RET
;REMOVE FORK WORKING SET FROM MEMORY
;REMWSN - REMOVE WORKING SET WITHOUT POSTPURGING

REMWS:	JE BSWTB,,REMWS1	;JUMP IF FORK NOT IN WAIT
	CALL DISACC		;TERMINATE WAIT
	HRRZ T1,FKPGST(FX)
	CAIN T1,DISMT		;HDISMS?
	JRST [	CALL DISMT2	;YES, CLEAN UP
		SOS NHOLDF	;ONE LESS HOLDING FORK
		JRST REMWS1]
	CAIE T1,PRELWT		;ENTERING?
	CAIN T1,SWPINT
	CALL SOSNEB		;YES, CLEAN UP
REMWS1:	SKIPN POSPGF		;POSTPURGING?
	IFSKP.
	  JSP T4,SWPINT		;YES, PSB AND UPT IN CORE?
	ANSKP.
	  CALL WSSWPO		;YES, DO IT
	  SETOM LSTPFK		;NOTE PAGER CONTEXT INVALID
	  JRST REMBS7
	ENDIF.
REMWSN:	MOVSI 2,(-PLKV)
	MOVSI T4,-NFKSPP	;UNLOCK ALL SPECIAL PAGES
REMBS6:	XCT FKSPPT(T4)		;GET PAGE ID
	HRRZ T1,SPT(T1)		;GET CORE ADDRESS
	ADDM T2,CST1(T1)	;UNLOCK IT
	AOBJN T4,REMBS6
REMBS7:	LOAD T2,FKWSS		;GET CURRENT RESERVE
	MOVN 1,2
	ADDM 1,SUMNR		;REDUCE BALSET SIZE
	SETZRO FKWSL		;WORKING SET NOT LOADED NOW
	SOS NWSMEM
	RET

;TABLE OF SPECIAL FORK PAGES
;EXECUTED BY LOADBS, REMBSJ, WSSWPO

FKSPPT::HRRZ T1,FKPGS(FX)	;PSB
	HLRZ T1,FKPGS(FX)	;UPT
	LOAD T1,FKJSB		;JSB
	LOAD T1,FSSPTN		;SECOND PSB
NFKSPP==:.-FKSPPT
;LOAD WORKING SET INTO MEMORY

LOADWS:	MOVE T1,NRPLQ
	CAIG T1,NFKSPP		;ENOUGH PAGES TO START LOAD?
	RET			;NO
	SAVEAC <P2>
LDJB3::	AOS NWSMEM		;COUNT NUMBER OF PROCESSES
	SETONE <BSWTB,FKWSL>	;SET FLAGS, WS LOADED AND WAITING
	MOVEI 1,SWPINT
	MOVEM 1,FKPGST(FX)	;SET TEST TO WAIT FOR PSB AND PT
	HRRZ 1,FKNR(FX)		;GET WORKING SET SIZE
	HRRZ 2,FKWSP(FX)	;PAGES NOW ASSIGNED
	CAMGE 1,2		;REASONABLE VALUES?
	JRST FIXWSP		;NO
LDJB5:	ADDM 1,SUMNR		;UPDATE SUM OF NR
	SUB T1,T2		;REDUCE RESERVE BY PAGES ALREADY ASSIGNED
	SKIPN PRELDF		;PRELOADING?
	MOVEI T1,NFKSPP		;NO, USE SMALL CONSTANT
	STOR T1,FKNWCE		;SAVE PRELOAD RESERVE
	ADDM T1,NRPMIN		;ADDITIONAL RESERVE FOR ENTERING FORKS
	AOS NEBAL		;COUNT ENTERING PROCESSES
	MOVSI P2,-NFKSPP	;SWAPIN ALL SPECIAL PAGES
LDJB1:	XCT FKSPPT(P2)
	CALL SWPIN0
	AOBJN P2,LDJB1
	AOS NWSLOD		;COUNT WS LOADS
	AOS NBWT		;COUNT WAITING BALSET PROCESS
	AOS NBSWP		;COUNT IS AS SWAP WAIT
	MOVE T1,TODCLK		;SET START OF WAIT TIME
	MOVEM T1,FKNBW(FX)
	SKIPN INSKED		;CHECK COMPLETION UNLESS NOT INSKED
	SKIPN PRELDF		; AND PRELOADING
	SKIPL FORKX		;CAN'T DO IT IF FORK CONTEXT SETUP
	SKIPA
	CALL SKDJ3
	 NOP
	RETSKP
;HANDLE BAD FKCSIZ - RECOMPUTE COUNT AND REPORT VALUES

FIXWSP:	MOVE T4,MONCOR		;SETUP TO SCAN CST3
	SETZ T2,		; TO COUNT ASSIGNED PAGES
FIXWS1:	LOAD T1,CSTOFK,(T4)	;GET FORK ASSIGNMENT
	CAMN T1,FX		;THIS FORK?
	AOS T2			;YES, COUNT
	CAME T4,NHIPG		;SCANNED ALL PAGES
	AOJA T4,FIXWS1		;NO
	LOAD T1,FKWSS		;GET EXISTING VALUES
	LOAD T3,FKCSIZ
	BUG(FKWSP1,<<T1,D>,<T2,D>,<T3,D>>)
	STOR T2,FKCSIZ		;FIX COUNT
	CAMGE T1,T2		;NOW LOOKS OK?
	MOVE T1,T2		;NO, RESET FKWSS ALSO
	STOR T1,FKWSS
	JRST LDJB5		;NOW...
;UPDATE QUEUE NUMBER AND TIME USED VALUE

SAVRT:	CALL UCLOCK		;UPDATE CLOCKS
	SETZ T1,
	SKIPN T2,JOBSKD
	MOVE T2,JOBBIT
	TXNE T2,JP%SYS		;SYSTEM FORK?
	TXO T1,BSSPQ		;YES
	SKIPE NSKED		;NOSKED?
	TXO T1,BSNSK		;YES
	SKIPE CRSKED		;CSKED?
	TXO T1,BSCRSK		;YES
	XOR T1,FKSWP(FX)	;COMPARE WITH LAST SETTING
	TXNN T1,BSNSK!BSCRSK!BSSPQ ;CHANGED?
	IFSKP.
	  ANDX T1,BSNSK!BSCRSK!BSSPQ
	  XORM T1,FKSWP(FX) 	;YES, UPDATE VALUES
	  CALL GLREM		;CHANGE FORK POSITION ON GOLST
	  CALL GOCONC
	ENDIF.
	MOVE T1,FKSWP(FX)
	TMNN PIBMP		;ANY HIGH PRIORITY SCHED FLAGS?
	TXNE T1,BSCRSK!BSSPQ
	IFSKP.
	  TXZE T1,BSNST!BSOVRD	;NO, CLEAN UP IF NECESSARY
	  MOVEM T1,FKSWP(FX)
	ELSE.
	  MOVE T2,FACTSW	;YES, SYSTEM IN NORMAL OPERATION?
	  TXNN T2,SF%RMT!SF%LCL	;I.E. LOCAL OR REMOTE LOGINS ALLOWED?
	  TXZ T1,BSNST		;NO, DON'T START WATCHDOG
	  TXOE T1,BSNST		;YES, JUST HAPPENED?
	  IFSKP.
	    MOVEM T1,FKSWP(FX)	;YES, UPDATE FLAG
	    MOVE T2,TODCLK	;INIT ALARM FOR 5 SECS
	    ADDI T2,^D5000
	    MOVEM T2,HPSWRN
	  ENDIF.
	  MOVE T2,TODCLK
	  CAMGE T2,HPSWRN	;TIME UP?
	  IFSKP.
	    ANDXE. T1,BSOVRD	;YES, NOT ALREADY NOTED?
	    MOVE T2,JOBNO	;YES, JOB PROBABLY STUCK
	    SKIPA		;BUGCHK DISABLED NOW.

;This bugchk is intended to detect forks which are running with priority
;(e.g. JP%SYS, NOSKED, CRKSED, or even PIBUMP) and using too much time.
;This is useful to know because such cases impact response for all
;ordinary users.  We are still trying to determine the right heuristic
;for unreasonable vs. reasonable behaviour, and this bugchk is disabled
;so as not to alarm people with false indications.  If you are suffering
;from unexplained sluggish response, you may want to turn the SKIPA
;above into a NOP and see what info is produced.  The bugchk reports
;the job and fork number of the offending fork.   DLM  10/28/81

	    BUG(HPSCHK,<<T2,JOBNO>,<FX,FRKNO>>)
	    SETONE BSOVRD	;OVERRIDE PRIORITY
	    CALL GLREM		;FIND NEW POSITION ON GOLST
	    CALL GOCONC
	  ENDIF.
	ENDIF.
	MOVE T1,FKT1		;GET TIME USE SINCE SETRT
	SETZM FKT1
	LOAD T2,FKQN		;ACCUMULATE QUEUE DISTRIBUTION
	ADDM T1,QSUM(T2)	; STATISTICS
	MOVE T1,BSQNT		;GET REMAINING BALSET QUANTUM
	SUB T1,BSQNT0		;COMPUTE QUANTUM CHARGE THIS RUNNING
	OPSTRM <ADDB T1,>,FKQTM	;UPDATE FORK QUANTUM
	SKIPN T3,JOBBIT		;GET CONTROLLING WORD
	MOVE T3,JOBSKD
	LOAD T3,JP%MXQ,T3	;CHECK MAXQ
	CAIE T3,0		;NON-0 AND EXCEEDED?
	CAMGE T2,T3
;**;[2939] MAKE CHANGES AT SAVRT:+70L	TAM	29-MAR-83
	JUMPG T1,[CAIG T2,MAXQ	;[2939] DREGS QUEUE?
		  RET		;[2939] NO DONE
		  LOAD T3,FKMNQ	;[2939] DONE IF NOT EXHAUSTED
		  CAMG T2,T3	;[2939] SUPPOSED TO BE ON DREGS
		  RET		;[2939] YES
		  JRST .+1]	;[2939] NO
	AOS BSKED		;EXHAUSTED, REQUEST ADJUST OF BALSET
	CALL GLREM		;NO, REMOVE FROM GOLST WHILE CHANGING QUEUE
SAVR12:	LOAD T2,FKQN		;GET Q NUMBER
SAVRT8:	CAIGE 2,MAXQ		;NOW ON MAX Q?
	AOSA T2			;NO, GO TO NEXT ONE
	MOVEI T2,MAXQ		;STAY ON MAXQ
	SKIPN T4,JOBBIT		;SPECIAL PRIORITY?
	SKIPE T4,JOBSKD		;ANY JOB-WIDE SCHEDULING CAPS?
	IFNSK.
	  LOAD T3,JP%RTG,T4 	;GET RUNTIME GUARANTEE
	  SKIPN CLASSF		;IGNORE IF CLASS SCHEDULING
	  JUMPN T3,RTG1		;CHECK IT IF SET
	  LOAD T3,JP%MNQ,T4 	;GET MIN QUEUE
	  CAMGE T2,T3		;WITHIN RANGE?
	  MOVE T2,T3		;NO, FIX
	  LOAD T3,JP%MXQ,T4 	;GET MAX QUEUE
	ANDN. T3		;IF SET...
	  CAML T2,T3		;WITHIN RANGE?
	  MOVEI T2,-1(T3)	;NO, FIX
	ENDIF.
SAVRT9:	STOR 2,FKQN		;SET NEW QUEUE NUMBER
	MOVE 1,QUANTT(2)	;GET QUANTUM FOR THIS QUEUE
RTG2:	STOR 1,FKQTM		;SET NEW QUANTUM VALUE
	MOVE 3,TODCLK
	MOVEM 3,FKTIME(FX)	;SET TIME ON QUEUE
	CALLRET GOCONC		;NO. PUT FORK BACK ON GOLST
;DISMISS JOB FOR RESCHEDULING

DISMSJ:	MOVE FX,FORKX
	JUMPL FX,R		;NO JOB
	CALL SAVRT		;UPDATE QUEUE AND QUANTUM
	SETZ 1,
	CALL SCHP2		;SET BALSET WORD
	RET

;ROUTINE USED BY LOADBS AND AJBALS TO CHECK IF A PROCESS SHOULD
;BE LOADED. IF A PRCESS IS "WAY AHEAD" OF ITS UTILIZATION,
;IT WILL NOT BE LOADED.
;	FX/ FORK INDEX
;RETURNS:	+1 NOT "WAY AHEAD"
;		+2 "WAY AHEAD"

CKAHED:	LOAD T1,FKQN		;GET QUEUE NUMBER OF PROCESS
	MOVE CX,FKSWP(FX)	;GET FLAGS ALSO
;**;[3028] CHANGE 1 LINE AT CKAHED:+2L	TAM	12-OCT-83
	TXNN CX,BSNSK!BSCRSK!BSSPQ ;[3028] IF CRITICAL OR HIGH PRIORITY, DO IT
	CAIG T1,INTQ1		;INTERACTIVE OR SPECIAL?
	RET			;NO. LOAD IT TO ALLOW AN INTERACTION
	JN PIBMP,,R		;OR IF DOING PI, ALLOW IT
	CALL DIST		;GET PROCESS'S DISTANCE
	JUMPGE T1,R		;IF NOT AHEAD, LOAD IT
	RETSKP			;IS AHEAD. DON'T LOAD IT
;RUNTIME GUARANTEE CONTROL - COMPUTE RUNTIME/ELAPSED, COMPARE WITH
;DESIGNATED CPU FRACTION.  RAISE OR LOWER SCHEDULER PRIORITY AS
;NECESSARY.
;	T4/ PRIORTY WORD

;LOWQT - CONTROLS INTERVAL OVER WHICH TIME IN GUARANTEED

LOWQT==^D10000

RTG1:	LOAD T3,JP%RTG,T4	;GET CPU RUN-TIME GUARANTEE
	MOVE 1,JOBNO
	SKIPN JOBCK0		;GUARANTEE WORDS INIT'ED?
	JRST [	MOVE 4,TODCLK	;INITIALIZE TIME QUARANTEE WORDS
		MOVEM 4,JOBCK0
		MOVE 4,JOBRT(1)
		MOVEM 4,JOBCK1
		JRST RTG3]
SAVRT7:	JUMPE T3,SAVRT8		;NOT SPECIAL
	MOVE 4,JOBRT(1)		;COMPUTE RUNTIME DURING TEST INTERVAL
	SUB 4,JOBCK1
	MOVE 1,TODCLK		;COMPUTE REAL TIME OF TEST INTERVAL
	SUB 1,JOBCK0
	IMULI 4,^D100		;COMPUTE RUNTM*100%/PCT TO GET
	IDIV 4,T3		;EXPECTED REAL TIME
	SUB 4,1			;EXCESS OR DEFICIT OF REAL TIME
	CAIL 4,LOWQT/2		;ACCUMULATED REASONABLE EXCESS?
	JRST SAVRT5		;YES, REDUCE PRIORITY
RTG3:	IMUL T3,NBPROC		;GIVE BALSET QUANTUM PROPORTIONAL TO NBPROC
	IMUL T3,SKDBQT		;AND DESIRED PERCENTAGE
	IDIVI T3,^D100
	MOVEI T2,INTQ0		;KEEP ON A HIGH Q TO GET EXCLUSIVE TIME
	JRST SAVRT9


;4 NOW CONTAINS TIME SUCH THAT AFTER THAT REAL-TIME INTERVAL,
;WITH NO RUNNING OF PROGRAM, ACTUAL PCT WILL EXACTLY EQUAL DESIRED PCT

SAVRT5:	CAIGE 4,LOWQT		;ACCUMULATED EXCESS .GE. LOW-Q QUANT?
	JRST [	CAIGE 2,MAXQ-1	;NO, STILL ON HIGHER QUEUES?
		JRST SAVRT8	;YES, FOLLOW NORMAL ALGORITHM
		MOVEI 2,MAXQ-1	;STAY ON SECOND LOWEST QUEUE
		JRST SAVRT9]
	CAIGE 4,2*LOWQT		;ACCUMULATED LARGE EXCESS?
	JRST SAVRT6		;NO
	SUBI 4,2*LOWQT		;YES, REMOVE EXCESS OVER 2*LOWQT
	MOVN 4,4
	ADDM 4,JOBCK0		;FROM CONSIDERATION
	MOVEI 4,2*LOWQT
SAVRT6:	MOVEI 2,MAXQ		;PUT ON LOWEST QUEUE
	STOR 2,FKQN		;SET QUEUE NUMBER
SAVR66:	MOVE 1,QUANTT		;GIVE ONLY SHORT QUANTUM SO WILL RECHECK SOON
	JRST RTG2
	SUBTTL Miscellaneous global routines

;UPDATE USER CLOCKS ON REQUEST (MUST BE NOSKED OR INSKED)

UCLOCK::SKIPN INSKED		;NOW INSKED?
	JRST [	PUSH P,T4	;NO, READ CLOCK
		JSP T4,MTIME
		POP P,T4
		JRST UCLOC3]
	SKIPN FKT0		;ALREADY DONE?
	RET			;YES
	MOVE T1,SKDLST		;TIME AT ENTRY TO SCHED
UCLOC3:	SKIPN FKTOFF		;CLOCK NOW OFF?
	IFSKP.
	  SUB T1,FKTOFF		;YES, COMPUTE TIME OFF
	  ADDM T1,FKTLST	;ACCUMULATE AS LOST
	  MOVE T1,FKTOFF	;USE TIME OFF AS END OF CHARGE INTERVAL
	ENDIF.
	SUBM T1,FKT0		;COMPUTE INCREMENTAL RUNTIME
	EXCH T1,FKT0		;INIT NEW INTERVAL
	SKIPE INSKED		;IF INSKED
	SETZM FKT0		;LEAVE FKT0 CLEAR
	CAIGE T1,0		;OVERFLOW?
	ADD T1,BASOVV		;YES, CORRECT
	MOVN 2,1
	ADDM T2,BSQNT		;SUBTRACT TIME FROM QUANTUM
	ADD 1,RUNT2		;ACCUMULATE HIGH PRECISION TIME
	IDIVI 1,NTMS		;CONVERT TO MS
	MOVEM 2,RUNT2		;RETAIN HIGH PRECISION UNITS
	JUMPE 1,R		;RETURN IF NO CHANGE
	ADDM T1,FKT1		;ACCUMULATE RUNTIME SINCE SETRT
	MOVE 2,JOBNO
	SKIPGE JOBRT(T2)	;RUNTIME OK?
	CALL [	BUG(NEGJRT,<<T2,JOBNO>>)
		SETZM JOBRT(T2)	;QUICK FIX
		SAVET
		LOAD T2,JBTFK,(T2) ;NO, GET TOP FORK
		MOVX T1,PSILO%	;FORCE LOGOUT ON IT
		CALLRET PSIGR]
	ADDM 1,JOBRT(T2)	;ACCOUNT FOR JOB
	ADDM 1,FKRT		;ACCOUNT FOR FORK
	ADDM T1,USRTIM		;ACCUMULATE TOTAL USER TIME
	ADDM T1,JOBIRT(T2)	;ACCUMULATE JOB RUN-TIME AS WELL
	HRRZ T3,JOBCLS(T2)	;GET CLASS OF THIS FORK
	ADDM T1,CLSIRT(T3)	;AND ACCUMULATE HERE ALSO
	JN JOBRTP,(2),UCLOC1	; Do runtime limit exceeded check if one set
UCLOC2:	HRRZ 2,JOBNAM(2)	;GET SUBSYSTEM INDEX
	ADDM 1,STIMES(2)	;ACCUMULATE SUBSYSTEM TIME
	RET

UCLOC1:	LOAD 3,JOBRTP,(2)	; Get blk ptr
	LOAD 3,TIMTIM,(3)	; Get limit
	JUMPE 3,UCLOC2		; Already done this stage?
	CAML 3,JOBRT(2)		; Exceeded yet?
	 JRST UCLOC2		; No, continue normally
	LOAD 3,JOBRTP,(2)	; Once again retrieve blk ptr
	SETZRO TIMTIM,(3)	; So we won't try to do it again
	PUSH P,1		; Save increment of time
	MOVX 1,PSITL%
	MOVE 2,FORKX
	HLRZ 2,FKJOB(2)		; First get job this fork belongs to
	LOAD T2,JBTFK,(T2)	; then the top fork of the job
	CALL PSIGR		; Start up the fork
	POP P,1			; Recover time increment
	MOVE 2,JOBNO		; And job number
	JRST UCLOC2		; Done here, do the rest
;TURN FORK CPU TIME CLOCK OFF

FRTOFF::JSP T4,MTIME		;SAVE TIME AT WHICH CLOCK TURNED OFF
	MOVEM T1,FKTOFF
	RET

;TURN FORK CPU TIME CLOCK BACK ON
; RETURNS:
;  1/ CPU TIME THAT CLOCK WAS OFF IN HP UNITS

FRTON::	JSP T4,MTIME
	SUB T1,FKTOFF		;COMPUTE TIME OFF
	ADDM T1,FKTLST		;ACCUMULATE AS LOST TIME
	ADDM T1,FKT0		;ADJUST START OF PERIOD TO EXCLUDE LOST TIME
	SETZB T1,FKTOFF		;NOTE CLOCK NOW ON
	EXCH T1,FKTLST		;RETURN ACCUMULATED LOST TIME AND CLEAR
	RET

;GET CURRENT FORK RUNTIME

GETFRT::NOSKED
	;SKIPN T1,FKTOFF		;USE CLOCK OFF TIME IF PRESENT
	JSP T4,MTIME		;READ CLOCK
	SUB T1,FKT0		;COMPUTE TIME SINCE LAST UPDATE
	CAIGE T1,0		;OVERFLOW?
	ADD T1,BASOVV		;YES, CORRECT
	ADD T1,RUNT2		;ADD FRACTIONAL MS
	IDIVI T1,NTMS		;CONVERT TO MS
	ADD T1,FKRT		;ADD CURRENT TIME
	OKSKED
	RET

;GET CURRENT FORK RUNTIME IN HIGH PRECISION UNITS

GETHRT::NOSKED
	;SKIPN T1,FKTOFF	;USE CLOCK OFF TIME IF PRESENT
	JSP T4,MTIME		;READ CLOCK
	SUB T1,FKT0		;COMPUTE TIME SINCE LAST UPDATE
	CAIGE T1,0		;CHECK FOR OVERFLOW
	ADD T1,BASOVV
	ADD T1,RUNT2		;ADD FRACTIONAL MS ACCUMULATED RUNTIME
	MOVE T2,FKRT		;GET MS ACCUMULATED RUNTIME
	IMULI T2,NTMS		;CONVERT TO HP UNITS
	ADD T1,T2		;COMPUTE SUM OF ACCUMULATED AND RECENT RUNTIME
	OKSKED
	RET
;PUT FORK ON WAIT LIST

WTCONC::MOVE 1,TODCLK		;SAVE TIME FORK WAS PUT INTO WAITING
	MOVEM 1,FKPGST(FX)
WTCON2:	HRRZ 1,FKSTAT(FX)	;CHECK FOR SPECIAL WAITS
	CAIN 1,TCITST		;TTY INPUT?
	JRST [	MOVEI 2,TTILST	;YES
		JRST WTCON1]
	CAIE T1,TCOTST		;TTY OUTPUT WAITS?
	CAIN T1,TTOBET
	SKIPA
	CAIN T1,TTOAV
	JRST [	MOVEI T2,TTOLST	;YES
		JRST WTCON1]
	CAIE T1,HALTT		;ANY OF VARIOUS HALTS?
	CAIN T1,JRET
	JRST WTCON3
	CAIE T1,SUSWT
	CAIN 1,FRZWT		;FREEZE?
WTCON3:	JRST [	MOVEI T2,FHV1
		STOR T2,FKGOLN	;SET WAIT PRIORITY
		MOVEI 2,FRZLST
		JRST WTCON1]
	CAIE 1,TRMTS1
	CAIN 1,TRMTST		;INFERIOR FORK WAIT?
	JRST [	MOVEI 2,TRMLST
		JRST WTCON1]
	CAIE 1,BLOCKM
	CAIN 1,BLOCKW		;CLOCKS?
	SKIPA
	CAIN 1,BLOCKT
	JRST [	MOVEI 2,CLKLST
		SETZM ALARMT	;FORCE RECHECK OF CLOCKS TO INCLUDE THIS
		JRST WTCON1]
	CAIN 1,PIDWAT		;IPCF?
	JRST [	MOVEI 2,WT2LST	;YES, USE GENERAL PURPOSE LIST
		JRST WTCON1]
	MOVEI 2,WTLST		;ALL OTHER WAITS
WTCON1:	STOR 2,FKWTL		;REMEMBER WHICH LIST
	MOVEI 1,FKPT(FX)	;PUT FORK ON PROPER LIST
	EXCH 1,0(2)
	HRRM 1,FKPT(FX)
	SETONE FKBLK		;NOTE BLOCKED
	MOVE 2,FKSTAT(FX)	;NOW TRY TEST ONCE
	HLRZ 1,2
	HRRZ 4,2
	JSP 4,0(4)
	IFSKP.
	  CALL UNBLK1		;CONDITION ALREADY SATISFIED
	ELSE.
	  SKIPGE 1,FKINT(FX) 	;TEST FAILS, IS INTERRUPT REQUESTED?
	  TLNE 1,(1B1)		;AND NOT ALREADY DEFERRING?
	  IFSKP.
	    MOVX 1,PSIWT%	;YES, FLAG INTERRUPT FROM WAIT STATE
	    IORM 1,FKINT(FX)
	    CALL UNBLK1		;AND WAKEUP FORK
	  ENDIF.
	ENDIF.
	RET
;MOVE FORK FROM ONE WAIT LIST TO ANOTHER.  USED WHEN WAIT STATE
; CHANGES (E.G. FREEZE)
; FX/ FORK

RECONC::SAVEAC <Q2>
	JE FKBLK,,UNBLK3		;JUMP IF NOT BLOCKED
	LOAD 1,FKWTL		;GET POINTER TO SPECIFIC LIST
RECON1:	HRRZ Q2,0(1)		;SCAN FOR FORK
	JUMPE Q2,UBBAD		;COULDN'T FIND IT
	MOVEI 2,-FKPT(Q2)		;GET FOR INDEX
	CAIE 2,0(FX)		;DESIRED FORK
	JRST [	MOVEI 1,0(Q2)	;NO
		JRST RECON1]
	HRRZ 2,0(Q2)		;YES, REMOVE FROM CURRENT LIST
	HRRM 2,0(1)
	CALL WTCON2		;PUT ON NEW LIST
	JRST UNBLK3		;RETURN


; CHKWT - Check if fork in FX is on wait list

CHKWT::	JE FKBLK,,R		;JUMP AND RETURN IF NOT BLOCKED
	RETSKP			;SKIP IF BLOCKED

;CHKTOT - CALLED BY TTYSRV WHEN A TTY OUTPUT EVENT HAS OCCURED WHICH
;WILL LIKELY ALLOW A FORK TO WAKEUP

CHKTOT::AOS TSKED		;JUST FLAG FOR NEXT TCLKS
	RET
;UNBLOCK SPECIFIC FORK - MAY BE CALLED FROM OUTSIDE SCHEDULER
; 1/ FORK INDEX
;	CALL UNBLKF
; RETURN +1 ALWAYS

UNBLKF::SAVEAC <FX>
	MOVEM 1,FX		;SETUP ARG
	NOSKD1			;NOSKED WHILE DIDDLING LISTS
	JE FKBLK,,UNBF1		;JUMP IF NOT BLOCKED
UNBF2:	HRRZ 2,FKSTAT(FX)
	HLRZ 1,FKSTAT(FX)		;SETUP TEST CALL
	JSP 4,0(2)		;IS FORK REALLY UNBLOCKED?
	 JRST UNBF1		;NO, IGNORE CALL
	CALL UNBLK1		;DO THE WORK
UNBF1:	OKSKD1
	RET

;ROUTINE TO UNBLOCK SPECIFIC FORK
; FX/ FORK

UNBLK1::SAVEAC <Q2,F>
	MOVE F,SCHFLG		;SETUP PERMANENT FLAGS
	JE FKBLK,,UBBAD		;JUMP IF NOT BLOCKED
	LOAD 1,FKWTL		;YES, GET POINTER TO IT
UNBLK2:	HRRZ Q2,0(1)		;GET NEXT FORK ON LIST
	JUMPE Q2,UBBAD		;COULDN'T FIND IT
	MOVEI 2,-FKPT(Q2)		;GET INDEX FOR FORK
	CAIE 2,0(FX)		;REQUESTED ONE?
	JRST [	MOVEI 1,0(Q2)	;NO
		JRST UNBLK2]
	HRRZ 2,0(Q2)		;REMOVE FORK FROM LIST
	HRRM 2,0(1)
	CALL SCHEDJ		;ADJUST QUEUE AND PUT ON GOLST
UNBLK3:	RET

UBBAD:	BUG(UNBFNF)
	JRST UNBLK3
;WAKEUP SUPERIOR, E.G. ON FORK SUSPENSION
; T1/ TEST ADR - WAKEUP ONLY IF THIS TEST
;	CALL WAKSUP

WAKSUP:	SAVEAC <FX>
	MOVE T2,T1
	HRRZ T1,FORKN		;GET SUPERIOR
	JUMPE T1,R		;RETURN IF TOP FORK
	ADD T1,SUPERP
	LDB T1,T1
	HRRZ FX,SYSFK(T1)
	JE FKBLK,,R		;RETURN IF NOT BLOCKED
	HRRZ T1,FKSTAT(FX)
	CAME T1,T2		;SPECIFIED TEST?
	RET			;NO, DON'T WAKE
	CALLRET UNBLK1		;WAKE IT

;SPECIAL ROUTINE CALLED FROM NSPSRV TO UNBLOCK A PROCESS IF
;NECESSARY. ACCEPTS:
;		T1/ FORK INDEX
;		T2/ LOW ADDRESS FOR SCHEDULER TESTS
;		T3/ HIGH ADDRESS

;THIS ROUTINE CHECKS IF PROCESS IS ON WAIT LIST AND IS WAITING
;ON ONE OF THE SPECIFIED ROUTINES

NETWKF::MOVE T3,T2		;SET UP RANGE TEST
NETWK1::SAVEAC <FX>
	MOVE FX,T1		;GET FORK # INTO FX
	NOSKD1			;PREVENT STATE CHANGES
	JE FKBLK,,UNBF1		;JUMP IF NOT BLOCKED
	HRRZ T1,FKSTAT(FX)	;YES. GET WAIT ROUTINE
	CAML T1,T2		;WITHIN RANGE?
	CAMLE T1,T3		;STILL?
	JRST UNBF1		;NO. DON'T WAKE IT
	JRST UNBF2		;YES. WAKE IT
;CHECK CLOCK LIST.  WAKEUP ANY FORKS HAVING EXPIRED TIMES AND
; COMPUTE TIME FOR NEXT CHECK

CLKCHK:	SAVEQ
	MOVE 1,TODCLK
	CAMGE 1,ALARMT		;TIME FOR CHECK NOW?
	RET			;NO
	MOVSI 1,(1B1)		;YES, INIT TO FIND MIN VALUE
	MOVEM 1,ALARMT
	MOVEI 5,CLKLST
CLKCH1:	HRRZ Q2,0(Q1)		;GET NEXT FORK
	JUMPE Q2,R
	MOVEI FX,-FKPT(Q2)	;GET FORK INDEX
	HRRZ 2,FKSTAT(FX)
	HLRZ 1,FKSTAT(FX)
	JSP 4,0(2)		;CALL WAKEUP TEST
	 JRST [	ADD 1,TODCLK	;FAILS, RETURNS NUMBER OF MS REMAINING
		CAMGE 1,ALARMT	;THIS SOONER THAN SOONEST SO FAR?
		MOVEM 1,ALARMT	;YES
		MOVEI Q1,0(Q2)
		JRST CLKCH1]
	HRRZ 2,0(Q2)		;REMOVE FORK FROM LIST
	HRRM 2,0(Q1)
	CALL SCHEDJ		;WAKEUP THE FORK
	JRST CLKCH1
;CHECK SUPERIOR ON FORK TERMINATION
;SUPERIOR FORK INDEX LEFT IN LH OF DISMISS TEST WORD
;OR ENTER AT SUPUB0 WITH FORKX INDEX IN 1

SUPUNB:	STKVAR <SUPFX>
	MOVEM FX,SUPFX		;SAVE CURRENT
	HLRZ FX,FKSTAT(FX)	;GET SUPERIOR FORK INDEX
	JE FKBLK,,SUPUX		;JUMP IF SUPERIOR NOT BLOCKED
	LOAD 1,FKWTL		;SEE WHERE IT IS
	CAIE 1,TRMLST		;WAITING FOR TERMINATION?
	JRST SUPUX		;NO
	HRRZ 2,FKSTAT(FX)	;YES
	CAIN 2,TRMTS1		;WAITING FOR ANY FORK?
	JRST SUPU1		;YES, WAKE IT
	HLRZ 2,FKSTAT(FX)	;NO, SPECIFIC FORK.
	CAMN 2,SUPFX		;WAITING FOR THIS ONE?
SUPU1:	CALL UNBLK1		;YES, WAKE IT
SUPUX:	MOVE FX,SUPFX		;RESTORE SELF
	SKIPE PRIMRY		;IS THIS IN FORK INIT?
	CALL FKTMI		;NO. GENERATE INTERRUPT THEN
	RET

SUPUB0::MOVEI T1,TRMINT		;GET CHANNEL FOR FORK TERMINATION
	MOVE T2,FORKX		;TO SELF
	CALL PSIRQ		;GO REQUEST INTERRUPT
	CHKINT			;AND MAKE IT HAPPEN
	RET			;AND DONE

;WTCHK - TEST ALL NON-SPECIAL WAITING FORKS
;CHKTL - TEST TTY OUTPUT FORKS

WTCHK::	MOVEI T1,^D300		;SET TIME FOR NEXT CHECK
	MOVEM T1,WTTIM
	MOVEI Q2,WTLST		;HEAD OF WAITING LIST
	CALL SCHEDA
CHKTL:	MOVEI Q2,TTOLST		;TTY OUTPUT LIST
	SETZM TSKED
SCHEDA:	MOVEI Q1,0(Q2)		;KEEP POINTER TO LAST ONE IN Q1,
SCHEDB:	HRRZ Q2,0(Q1)		;POINTER TO CURRENT ONE IN Q2
	JUMPE Q2,R		;DONE
	MOVEI FX,-FKPT(Q2)	;FORK INDEX
	HRRZ 2,FKSTAT(FX)	;FKSTAT/  TEST VALUE,,ADR OF TEST ROUTINE
	HLRZ 1,FKSTAT(FX)
	JSP 4,0(2)		;CALL TEST ROUTINE
	JRST SCHEDA		;NO SKIP => STILL NOT RUNNABLE
	HRRZ 2,0(Q2)		;REMOVE FROM WAIT LIST
	HRRM 2,0(Q1)
	CALL SCHEDJ		;SETUP QUEUE AND GOLST
	JRST SCHEDB
;DO WAKEUP ON FORK - SET NEW STATUS AND PUT ON GOLST

SCHEDJ:	AOS TTYBKS		;NOW RUNNABLE, COUNT UNBLOCKS
	SETZRO FKBLK
	CALL APSKED		;SEE IF RESCHEDULE NEEDED
	CALL NEWST		;ESTABLISH NEW QUEUE STATUS
	CALL GOCONC		;PUT ON READY LIST
	CALLRET CHKTFK		;PUT FORK INTO BALSET IF POSSIBLE

;UPON RECEIPT OF WAKEUP EVENT FOR FORK, SEE IF RESCHEDULING SHOULD
;OCCUR TO RUN UNBLOCKED FORK RATHER THAN CURRENT FORK
; FX/ FORK INDEX
;	CALL APSKED
; RETURN +1 ALWAYS, ALL ACS PRESERVED

APSKED::SKIPL FORKX		;HAVE A CURRENT FORK?
	SKIPE INSKED		;ALREADY IN SCHEDULER?
	JRST APSK1		;NO OR YES - NO NEED TO INTERRUPT
	CAIL FX,NFKS
	JRST APSK1		;NOT A VALID FORK
	SAVEAC <T1,T2,FX>
	LOAD T1,FKQN		;GET QUEUE NUMBER OF NEW FORK
	MOVE FX,FORKX
	LOAD T2,FKQN		;GET QUEUE NUMBER OF CURRENT FORK
	CAMLE T1,T2		;NEW BETTER THAN CURRENT?
	RET			;NO, DO NOTHING
	MOVX T1,SK%RSQ		;SYSTEM MGR WANTS THIS?
	TDNN T1,SCHFLG
	JRST APSK1		;NO
	AOS SKEDF3		;YES, REQUEST RESCHED
	AOS PSKED
	;ISB SCDCHN		;RIGHT NOW
	RET

APSK1:	AOS PSKED		;FORCE DISMISS OF CURRENT FORK
	RET
;PUT FORK ON GO LIST.  LIST IS KEPT IN PRIORITY ORDER; SEARCH
; DOWN LIST UNTIL FORK OF LOWER PRIORITY IF FOUND.  PUT NEW FORK
; JUST AHEAD OF THAT ONE.

GOCONC:	SAVEAC <Q2>
	CALL ONGOL		;PUT ON GO LIST
	AOS NGOJOB		;KEEP COUNT OF READY JOBS
	LOAD T3,FKJOBN		;GET JOB #
	MOVSI CX,1		;GET AN INCREMENTOR
	ADDB CX,JOBCLS(T3)	;ONE MORE ON GOLST
	TLNE CX,777776		;FIRST ONE ON?
	JRST GOCNC0		;NO.
	HRRZ T3,JOBCLS(T3)	;GET CLASS
	INCR CLGLC,(T3)		;ONE MORE ON GOLST
GOCNC0:	LOAD T3,FKQN		;UPDATE QUEUE COUNTS
	CAIGE T3,MAXQ
	AOSA NHQFK
	AOS NLQFK
GOC3:	RET

;ROUTINE TO DO THE WORK.

ONGOL: STKVAR <SFX,SP1,SP2>
	MOVEM FX,SFX		;SAVE FORK INDEX
	CALL CORFCT		;COMPUTE PRIORITY
	MOVEM T1,SP1
	MOVEM T2,SP2		;SAVE PRIORITIES
	MOVEI T3,GOLST
GOC1:	HRRZ T4,0(T3)		;GET NEXT FORK ON LIST
	JUMPE T4,ONGOL0		;END OF LIST?
	MOVEI FX,-FKPT(T4)	;GET FORK INDEX (.. -FKPT(T4) )
	CALL CORFCT		;GET PRIORITY OF THIS FORK
	CAMG T1,SP1		;BETTER THAN CLASS TO BE ADDED?
	JRST GOC2		;NO. TEST FOR INSET HERE
ONGOL1:	MOVEI T3,0(T4)		;YES. KEEP SCANNING
	JRST GOC1

;FOUND BEGINNING OF CLASS STUFF. NOW FIND PROPER PLACE

GOC2:	CAMN T1,SP1		;SAME CLASS?
	CAMGE T2,SP2		;YES. BELONG HERE?
	JRST ONGOL0		;YES. DO IT
	JRST ONGOL1		;NO. KEEP GOING THEN
ONGOL0:	MOVE FX,SFX		;GET ORIGINAL INDEX
	MOVEI T1,FKPT(FX)	;PUT FORK INTO LIST
	HRRM T1,0(T3)		;LINK TO PREVIOUS
	HRRM T4,FKPT(FX)
	RET			;DONE
;REMOVE SELECTED FORK FROM GOLST
;	FX/ fork index

GLREM:	SAVEQ
	HRRZ Q1,FX		;GET FORK INDEX FOR COMPARING
	MOVEI 1,GOLST
GLREM1:	HRRZ Q2,0(1)
	JUMPE Q2,GLREM2
	MOVEI FX,-FKPT(Q2)	;GET FORK INDEX
	CAME FX,Q1		;DESIRED ONE?
	JRST [	MOVEI 1,0(Q2)	;NO
		JRST GLREM1]
	HRRZ Q2,FKPT(FX)		;YES, REMOVE FROM LIST
	HRRM Q2,0(1)
	SOS NGOJOB
	LOAD Q1,FKJOBN		;GET JOB NUMBER
	MOVSI CX,-1		;GET A DECREMNTOR
	ADDB CX,JOBCLS(Q1)	;DO IT
	TLNE CX,-1		;LAST ONE OFF?
	JRST GLREM0		;NO
	HRRZ Q1,JOBCLS(Q1)	;GET CLASS NUMBER
	DECR CLGLC,(Q1)		;ONE LESS ON GOLST
GLREM0:	LOAD Q1,FKQN		;UPDATE QUEUE COUNTS
	CAIGE Q1,MAXQ
	SOSA NHQFK
	SOS NLQFK
	RET

GLREM2:	BUG(GLFNF)

JSKP::	JRST 1(4)
JRET::	JRST 0(4)
;COMPUTE PRIORITY NUMBER FOR FORK
; FX/ FORK INDEX
;	CALL CORFCT
; RETURNS +1, T1/ FIRST SORT KEY
; T2/ SECOND SORT KEY

CORFCT:	LOAD T2,FKQN		;GET QUEUE NUMBER
	SKIPE CLASSF		;CLASS SCHEDULING?
	JRST CORFC1		;YES
CORFCO:	MOVE T1,TODCLK		;NO, ORDER FORKS BY QUEUE NUMBER
	SUB T1,FKTIME(FX)	; AND THEN ELAPSED TIME ON QUEUE
	JUMPL T1,CORFC2		;RETURN NEG IF NOT DUE TO RUN YET
	ADD T1,TBASE(T2)	;ADD QUEUE OFFSET
CORFC2:	MOVE T2,FKSWP(FX)	;CHECK FLAGS
	TXNE T2,BSNSK		;NOSKED?
	ADD T1,NSKBAS		;YES, PRIORITY
	TXNE T2,BSOVRD		;PRIORITY OVERRIDE?
	IFSKP.
	  TMNN PIBMP		;IF PI'ING, GIVE PRIORITY
	  TXNE T2,BSCRSK	;CRITICAL SECTION?
	  SKIPA
	  TXNE T2,BSSPQ		;OR SPECIAL SYSTEM FORK?
	  ADD T1,CSKBAS		;YES, SECOND PRIORITY
	ENDIF.
	MOVEI T2,0		;NO SECOND KEY HERE
	RET
;THE CLASS SCHEDULER IS ON. THE COMPUTED PRIORITY IS AS FOLLOWS:
;	T1/ CLASS DISTANCE+MODIFIER
;  OR	T1/ SPECIAL VALUE
;WHERE THE SPECIALS ARE:
;	6.0 IF NOSKED
;	4.0 IF Q 0
;	    IF Q1 OR PI BOOST OR CRSKED OR SPECIAL SYSTEM FORK,
;	     3.0 + VALUE (0 TO 1) FOR LENGTH OF TIME ON PRESENT QUEUE

;HOWEVER, IF THE CLASS IS PRESENTLY USING WINDFALL, Q1 PROCESSES
;RECEIVE CSLDST+.05 AS THE PRIORITY

;MODIFIERS IF NON-SPECIAL
;	0.5 IF ON INTQ1 AND CLASS NOT USING WINDFALL
;	T2/ JOB DISTANCE + MODIFIER
;WHERE THESE MODIFERS ARE:
;	0.1(1-Q/LOWQ)
;OR	T2/	Q NUMBER
;	IF PROCESS IS SPECIAL

CORFC1:	SAVEAC<T3,T4>
	MOVE T1,FKSWP(FX)	;GET PRIORITY FLAGS
	TXNE T1,BSNSK		;NOSKED?
	JRST CORFC4		;YES
	JUMPE T2,[MOVX T1,<4.0>	;IF QUEUE 0, DO IT
		JRST CORFC7]
	CAIG T2,INTQ0		;INTERACTIVE PROCESS?
	JRST CORFC5		;YES. GO HANDLE IT
	CALL DIST		;GET DISTANCES
CORFC3:	TMNN SK%CL1,SCHFLG	;USING QUEUES OR DISTANCES?
	IFNSK.			;IF QUEUES
	 PUSH P,T1		;SAVE CURRENT CLASS DIST
	 LOAD T2,FKQN		;GET QUEUE
	 CALL CORFCO		;DO OTHER COMPUTATION
	 MOVE T2,T1		;RETURN RESULT AS JOB DISTANCE
	 POP P,T1		;RECOVER CALL DIST
	 LOAD CX,FKQN
	ELSE.			;IF DISTANCES
	 LOAD CX,FKQN		;GET Q VALUE AGAIN
	 FADR T2,LQWBAS-INTQ1(CX) ;ATTENUATE JOB DISTANCE
	ENDIF.
	IFGE. T1
	 CAIN CX,INTQ1		;SECOND INTERACTIVE QUEUE?
	 FADRI T1,(EXP 0.5)	;YES. ATTENUATE CLASS DISTANCE SUCH
				; THAT A WELL-BEHAVED CLASS WILL
				; ACHIEVE PRIORITY ON THIS QUEUE
	ENDIF.
	MOVE T3,FKSWP(FX)	; GET FLAGS AGAIN
	TXNE T3,BSOVRD		;OVERRIDDEN?
	IFSKP.
	 TMNN PIBMP
	 TXNE T3,BSSPQ!BSCRSK	;NO SPECIAL?
	 IFNSK.
	  CAMGE T1,[0.5]	;MAKE SURE ADEQUATELY BOOSTED
	  MOVX T1,<0.5>		;IF NOT, HELP IT OUT SOME, BUT NOT TO
				; THE DETRIMENT OF WELL-BEHAVED QUEUE 2
				; PROCESSES
	 ENDIF.
	ENDIF.
	RET			;AND DONE
;NEED SPECIAL PRIORITY

CORFC8:	SKIPA T1,[3.0]		;AHEAD OF ALL COMPUTE BOUND FORKS
CORFC4:	MOVX T1,<6.0>		;FOR NOSKED

;The following computes a value which increases from 0 to 1 as
;the length of time on the present queue.  This provides a
;round-robin among forks with otherwise equal high priority.
;The computation is N/(N+C) where N is the length of time
;on the queue and C is a constant.

CORFC7:	MOVE T2,TODCLK
	SUB T2,FKTIME(FX)	;TIME ON QUEUE
	FLTR T2,T2
	MOVE T4,T2
	FADRI T4,(4096.0)	;AN ARBITRARY CONSTANT
	FDVR T2,T4
	RET			;AND DONE

;GET JOB DIST ONLY, PRESERVE CLASS DIST IN T1

CORFC6:	SAVEAC <T1>		;KEEP THE CLASS DIST WE HAVE
	CALL DIST		;GET THE JOB DIST
	RET			;RETURN THOSE TWO

;PROCESS IS ON QUEUE 1 AND CLASS SCHEDULER IS ON

CORFC5:	CALL DIST
	SKIPL CLASSF		;WITHHOLDING?
	SKIPL T1		;IN WINDFALL?
	JRST CORFC8		;WITHHOLDING OFF OR NOT IN WINDFALL, BOOST
	FADRI T1,(0.5)		;IN WINDFALL AND WITHHOLDING, SMALL BOOST
	JRST CORFC3
;COMPUTE NEW UTILIZATION FOR ALL CLASSES.

;COMPUTATION PERFORMED IS:
;	U(I+1)=U(I)*e^-(T/C)+F(1-e^(T/C))
;WHERE:
;	U(I)=PREVIOUS UTILIZATION
;	U(I+1)= NEWLY COMPUTED UTILIZATION
;	T/C= 1/20 (TIME CONSTANT OF 60 SEC, COMPUTED EVERY 3 SEC)
;	F= FRACTIONAL UTILIZTION IN INTERVAL. COMPUTE AS:
;		CLSIRT/TIME    WHERE:
;	TIME = SELLABLE TIME = (SOLD TIME + IDLE TIME)

NEWUTL:	ACVAR <W1,W2,W3>	;GET A WORK REG
	MOVE W2,USRTIM		;GET CURRENT USER TIME
	SUBM W2,OLDSLD		;COMPUTE TIME SOLD IN INTERVAL
	EXCH W2,OLDSLD		;START NEW INTERVAL
	MOVE T1,SKDIDL		;GET IDLE TIME (HP UNITS)
	SUBM T1,OLDIDL		;COMPUTE IDLE TIME USED IN INTERVAL
	EXCH T1,OLDIDL		;AND START NEW INTERVAL
	IDIVI T1,NTMS		;CONVERT TO MILLISECONDS
	ADD W2,T1		;TIME = SOLD + IDLE
	FLTR W2,W2		;GET FLOAT OF INTERVAL
	JFOV .+1		;INIT OVERFLOW FLAG
	SKIPN CLASSF		;CLASS SCHEDULING ON?
	JRST NEWUTJ		;NO, ONLY DO JOB UTILS
	MOVEI W1,MAXCLS-1	;SET UP TO COMPUTE CLASS UTILS
NEWUT0:	SKIPN T3,CLSIRT(W1)	;ANY TIME IN THIS INTERVAL?
	JRST NEWUT1		;NO. PROCEED
	SETZM CLSIRT(W1)	;CLEAR COUNTER
	FLTR T3,T3		;FLOAT THE VALUE
	FDVR T3,W2		;COMPUTE FRACTIONAL USE
NEWUT1:	MOVE T1,CLSUTL(W1)	;GET CLASS UTIL
	FSBR T1,T3
	FMPR T1,UTLEXP+UTLINI-1	;DECAY IT
	JFOV [	SETZM T1	;YES. ASSUME UNDERFLOW THEN
		JRST .+1]
	FADR T1,T3		;NEW UTIL
	MOVEM T1,CLSUTL(W1)
	FSBR T1,CLSSHR(W1)	;COMPUTE LINEAR DISTANCE
	SKIPL T1		;WINDFALL?
	SKIPGE T3,WA(W1)	;YES. ANY WINDFALL ALLOCATION?
	MOVE T3,CLSSHR(W1)	;NO. USE NORMAL SHARE THEN
	FDVR T1,T3		;COMPUTE DISTANCE
	JFOV [	SKIPE T3	;ANY SHARE?
		TDZA T1,T1	;YES. ASSUME ON TARGET THEN
		FADRI T1,(MXBIAS) ;NO. MAKE SURE IS RUN LAST THEN
		JRST .+1]	;PROCEED
	MOVNM T1,CLSDST(W1)	;SAVE DISTANCE
	SOJGE W1,NEWUT0		;DO ALL CLASSES
	; ..
;NEWUTL CONTINUED...
;COMPUTE JOB UTILS AND DISTANCES

NEWUTJ:	MOVE W1,MJBUSE		;GET HIGHEST JOB IN USE
NEWU00:	SKIPGE JOBRT(W1)	;THIS JOB IN USE?
	JRST NEWU02		;NO. SKIP IT THEN
	SKIPN T3,JOBIRT(W1)	;THIS JOB HAVE SOME RUN-TIME?
	JRST NEWU01		;NO
	SETZM JOBIRT(W1)	;YES. CLEAR COUNTER
	FLTR T3,T3		;GET FLOAT OF TIME
	FDVR T3,W2		;GET FRACTION
NEWU01:	MOVE T1,JOBUTL(W1)	;GET CURRENT JOB UTILIZATON
	FSBR T1,T3
	FMPR T1,UTLEXP+UTLINI-1	;DECAY IT
	JFOV [	SETZM T1
		JRST .+1]
	FADR T1,T3		;NEW UTIL
	MOVEM T1,JOBUTL(W1)	;SAVE IT
	HRRZ T2,JOBCLS(W1)	;GET CLASS
	MOVE T3,CLSSHI(T2)	;GET JOB'S SHARE
	FSBR T3,T1		;COMPUTE LINEAR DIFFERENCE
	FDVR T3,CLSSHI(T2)	;COMPUTE "EXPONENTIAL DIFFERENCE
	JFOV [	SKIPE CLSSHI(T2) ;ANY SHARE?
		SETZM T3	;NO. ASSUME ON TARGET THEN
		JRST .+1]
	MOVEM T3,JOBDST(W1)	;SAVE JOB DISTANCE
NEWU02:	SOJGE W1,NEWU00		;DO ALL JOBS
	MOVE T1,TODCLK		;GET NOW
	ADD T1,UTLINT		;WHEN TO DO IT NEXT
	MOVEM T1,UTLTIM		;""

;REORDER GOLST

	MOVE W1,GOLST		;GET GOLST
	SETZM GOLST		;INIT IT TO EMPTY
REORDR:	JUMPE W1,R		;IF EMPTY NOW, ALL DONE
	MOVEI FX,-FKPT(W1)	;GET FORK INDEX
	HRRZ W1,FKPT(FX)	;GET NEXT ITEM
	CALL ONGOL		;INSERT IN NEW GOLST
	JRST REORDR		;AND PROCEED

	ENDAV.			;END ACVAR
;COMPUTE CURRENT DISTANCE FROM TARGET UTIL FOR PROCESS
;FX/	FORK HANDLE
;RETURNS:	T1/ DISTANCE FROM CLASS TARGET UTILIZATION (IN %)
;		T2/ DISTNCE FROM JOB TARGET UTIL (IN %)
;CLOBBERS ONLY T1 AND T2

DIST:	LOAD T2,FKJOBN		;GET JOB NUMBER
	HRRZ T1,JOBCLS(T2)	;GET JOB CLASS
	MOVE T1,CLSDST(T1)	;GET CLASS DISTANCE
	MOVE T2,JOBDST(T2)	;GET JOB DISTANCE
	RET			;DONE
;MORE CLASS SCHEDULING PARAMETERS.
;ROUTINES TO MAINTAIN SHARE COUNTS

;ADD A MEMBER TO A CLASS
;	T1/ CLASS

   REPEAT 0,<			;NOT BEING USED NOW
DECSHR:	SOSA CLSCNT(T1)		;ONE LESS ITEM
INCSHR:	AOS CLSCNT(T1)		;ONE MORE ITEM
	SKIPE CLASSF		;DOING CLASS SCHEDULING?
	CALL ADJCLS		;YES. ADJUST CLASS PARAMETERS
	RET			;ALL DONE THEN
   >				;END OF REPEAT 0

;ROUTINE TO START UP CLASS SCHEDULING

STRCLS:	SKIPE CLASSF		;NOW ON?
	RET			;YES. NO NEED THEN
	ACVAR <W1>
	SETOM CLASSF		;START IT UP
   REPEAT 0,<			;DON'T NEED THIS BECAUSE NEWUTL ALWAYS ON
	MOVEI W1,NJOBS-1	;SCAN JOBS
STRCL0:	SETZM JOBIRT(W1)	;NO INCREMENTAL RUN-TIME YET
	SETZM JOBUTL(W1)	;NO UTIL
	SOJGE W1,STRCL0		;DO ALL JOBS
	MOVE T1,USRTIM		;GET CURRENT "SOLD" TIME
	MOVEM T1,OLDSLD		;INIT INTERVAL
   >
	MOVE T1,[CLSIRT,,CLSIRT+1]
	SETZM CLSIRT
	BLT T1,CLSIRT+MAXCLS-1	;INIT THESE TO 0 ALSO
	MOVE T1,[CLSSUM,,CLSSUM+1]
	SETZM CLSSUM
	BLT T1,CLSSUM+MAXCLS-1	;CLEAR INTEGRAL ACCUMUALTOR
	MOVE T1,[CLSRJA,,CLSRJA+1]
	SETZM CLSRJA		;SET UP TO CLEAR RUN AVG AS WELL
	BLT T1,CLSRJA+<MAXCLS*NRJAVS>-1 ;CLEAR IT
	SETZM CLSCNT		;CLEAR COUNTS AS WELL
	MOVE T1,[CLSCNT,,CLSCNT+1]
	BLT T1,CLSCNT+MAXCLS-1	;DO IT
	CALL COUNT		;GET CORRECT CLASS COUNTS
	RET

	ENDAV.			;END ACVAR
;ROUTINES TO COMPUTE CLASS PARAMETERS

;FIRST. COMPUTE ALL CLSCNT VALUES BY SCANNING GOLST

COUNT:	SAVEAC <FX>		;SAVE REG
	MOVEI T4,NJOBS-1	;SCAN ALL JOBS
COUNT0:	SKIPGE JOBRT(T4)	;THIS JOB ACTIVE?
	JRST COUNT4		;NO
	HRRZS T2,JOBCLS(T4)	;YES. GET CLASS
	AOS CLSCNT(T2)		;INCREMENT COUNT
COUNT4:	SOJGE T4,COUNT0		;DO ALL JOBS
COUNT1:	MOVEI T1,MAXCLS-1
COUNT2:	SKIPE CLSCNT(T1)	;ANYBODY IN THIS CLASS?
	CALL ADJCLS		;YES. DO COMPUTING THEN
	SOJGE T1,COUNT2

;NOW COMPUTE ON GOLST COUNT

	HRRZ T1,GOLST		;GET TOP ENTRY OF GOLST
COUNT5:	JUMPE T1,R		;IF AT THE END, DONE
	MOVEI FX,-FKPT(T1)	;GET FORK INDEX
	LOAD T2,FKJOBN		;GET JOB NUMBER
	MOVSI CX,1		;AN INCREMENTOR
	ADDB CX,JOBCLS(T2)	;ONE MORE ON GOLST
	TLNE CX,777776		;FIRST ONE?
	JRST COUNT6		;NO
	HRRZ T2,JOBCLS(T2)	;GET CLASS
	INCR CLGLC,(T2)		;INCREMENT COUNT
COUNT6:	HRRZ T1,FKPT(FX)	;GET NEXT FORK
	JRST COUNT5		;AND STEP

;ADJUST GOLST COUNTS WHEN A JOB CHANGES CLASSES
;	T1/ OLD CLASS
;	T2/ JOB #

CHGCNT:	SAVEAC <FX>		;SAVE A REG
	HRRZ T4,JOBCLS(T2)	;GET NEW CLASS
	SKIPN FX,GOLST		;ANYTHING ON GOLST?
	RET			;NO
CHGCN0:	SUBI FX,FKPT		;GET FORK #
	LOAD T3,FKJOBN		;GET JOB #
	CAIE T3,0(T2)		;SAME AS TARGET?
	JRST CHGCNX		;NO
	DECR CLGLC,(T1)		;YES. ONE LESS IN OLD CLASS
	INCR CLGLC,(T4)		;AND ONE MORE IN NEW CLASS
	RET
CHGCNX:	HRRZ FX,FKPT(FX)	;GET NEXT ITEM
	JUMPN FX,CHGCN0		;DO IT
	RET			;ALL DONE
;ROUTINE TO CHANGE CLASS FOR A JOB.
;	T1/ NEW CLASS
;	T2/ JOB NUMBER
;MUST BE IN THE SCHEDULER

;**;[2997]  Change 1 line at CHGCLS:+0			DML	11-AUG-83
CHGCLS:	SASUBR <NCLASS,JOBNOM>	;[2997] SAVE TEMP ACS TO BE RESTORED LATER
	CAMN T2,JOBNO		;THIS JOB?
	CALL [	SAVET		;YES
		CALLRET UCLOCK]	;UPDATE CLOCKS
	SKIPGE JOBRT(T2)	;HAS JOB LOGGED OUT
	 RET			;YES, DON'T CHANGE ITS CLASS
	HRRZ T3,JOBCLS(T2)	;GET CURRENT CLASS VALUE
	SOS CLSCNT(T3)		;ONE LESS IN THIS CLASS
	AOS CLSCNT(T1)		;ONE MORE IN THIS CLASS
	HRRM T1,JOBCLS(T2)	;SET NEW CLASS
	SKIPN CLASSF		;DOING CLASS SCHEDULING?
	RET			;NO .DONE THEN
	MOVEM T3,NCLASS		;SAVE OLD CLASS IN NEW CLASS PLACE
	CALL ADJCLS		;ADJUST CLASS PARAMETERS
	MOVE T1,NCLASS		;GET BACK OLD CLASS
	CALL ADJCLS		;AND ADJUST THIS AS WELL
	MOVE T2,JOBNOM		;RECOVER JOB NUMBER
	CALLRET CHGCNT		;AND ADJUST GOLST COUNTS

;ROUTINE TO SET CLASS PARAMETERS
;	T1/ SHARE OF MACHINE TO GET
;	T2/ CLASS #

CRTSHR:	MOVEM T1,CLSSHR(T2)	;SET CLASSES SHARE
	MOVE T1,T2		;GET CLASS I.D.
	CALLRET ADJCLS		;GO ADJUST CLASS PARAMETERS

;ROUTINE TO ADSJUST CLSSHI AND CLSQ WHEN SOMETHING CHANGES
;	T1/ CLASS

ADJCLS:	SKIPN T2,CLSCNT(T1)	;ANY MEMBERS OF THIS CLASS?
	MOVEI T2,1		;NO. ASSUME ONE FOR CONVENIENCE
	HRRZS T2		;GET POPULATION COUNT ONLY
	FLTR T2,T2		;GET FLOAT OF POPULATION
	MOVE T3,CLSSHR(T1)	;GET CLASS'S SHARE
	FDVR T3,T2		;GET EACH MEMBER'S FAIR SHARE
	MOVEM T3,CLSSHI(T1)	;SAVE IT
	RET			;DONE

;ROUTINE USED BY CACCT AND LOGIN TO SET CLASS OF JOB.
;	T1/ CLASS TO SET

SETCLS::ASUBR <CLSNUM>		;SAVE INCOMING ARG
	SKIPL T1,CTRLTT		;ATTACHED?
	CALL CHKBCH		;SEE IF A BATCH JOB
	 JRST SETCL0		;NO. PROCEED
	IFQN. CLSBD,
	  SKIPE JOBSKD		;ALREADY PRIORITZED?
	ANSKP.
	  MOVE T1,JOBNO		;NO. GET JOB NUMBER
	  MOVX T2,DREGS		;GET DREGS PRIORITY WORD
	  SJPRI			;SET PRIORITY WORD
	   ERJMP .+1		;IF FAILED, PROCEED ANYWAY
	ENDIF.
	LOAD T1,CLSBT		;GET BATCH CLASS
	SOSGE T1		;IF A BATCH CLASS, USE IT
SETCL0:	MOVE T1,CLSNUM		;GET CLASS
	JE CLSAC,,R		;IF NOT USING ACCOUNTS, RETURN NOW
	NOSKED			;OWN MACHINE
	SKIPL T1		;VALID CLASS?
	CAIL T1,MAXCLS		;""
	SETZM T1		;NO. USE ZERO THEN
	MOVE T2,JOBNO		;GET JOB NUMBER
	HRRZ T3,JOBCLS(T2)	;GET PRESENT CLASS
	CAIE T3,0(T1)		;CHANGING?
	CALL CHGCLS		;YES
	OKSKED			;ALL DONE
	RET			;""

;ROUTINE CALLED WHEN LOGIN WILL SUCCEED.

SKDLOG::TMNN CLSAC	;CLASS BY ACCOUNT?
	SKIPN CLASSF		;NO. CLASS SCHEDULING OFF THEN?
	RET			;YES. NOTHING TO DO
	GTOKM (.GOCL0,,R) 	;IF FAILURE, USE DEFAULT
	RET			;AND DONE
;QUEUE PARAMETER TABLES

	RADIX 10

;QUANTA FOR EACH QUEUE (IN HIGH PRECISION UNITS)
;HEURISTIC: A JOB SHOULD GET AT LEAST A FULL LOWEST QUEUE QUANTUM
;BEFORE FALLING TO LOW QUEUE AND THEREBY YEILDING TO ALL THE COMPUTE
;BOUND JOBS.  HENCE, THE SUM OF QUANTA FOR QUEUES 0 TO MAXQ-1
;SHOULD BE .GE. THE QUANTUM FOR MAXQ

;DEFINE PROTO TABLE FOR BIAS CONTROL
QUANTB:	300*NTMS
	300*NTMS		;QUICK INTERACTIVE QUEUE
	1000*NTMS		;REGULAR INTERACTIVE
	3000*NTMS		;MIDDLE QUEUE
	3000*NTMS		;NORMAL COMPUTE QUEUE
	10000*NTMS		;"DREGS" QUEUE

NQUEUE==:.-QUANTB		;NUMBER OF QUEUES
RS QUANTT,NQUEUE		;ACTIVE QUANTA TABLE

;DEFINE PROTO TABLE FOR CLASS SCHEDULER

QUANTC:	300*NTMS
	300*NTMS
	1000*NTMS
	2000*NTMS
	3000*NTMS
	10000*NTMS

IFN .-QUANTC-NQUEUE,<PRINTX QUANTA TABLE LENGTHS DIFFER>

HIGHQ==0			;SPECIAL HI PRI QUEUE
INTQ0==1			;QUICK INTERACTIVE QUEUE
INTQ1==INTQ0+1			;REGULAR INTERACTIVE QUEUE
LOWQ==:NQUEUE-1			;SPECIAL LOW-PRIORITY QUEUE
MAXQ==:LOWQ-1		;NORMAL LOW QUEUE

BQUANT:	100*NTMS		;QUANTUM GIVEN FOR PSI 'BUMP'

DEFINE GETFLQ(N)<
EXP N'.0
>
FLOWQ:	GETFLQ(\LOWQ)
MFRKWD==:JP%SYS			;PRIORITY WORD FOR JOB 0

	RADIX 8

RS QSUM,NQUEUE			;ACCUMULATED RUNTIMES OF QUEUES
RS LQWBAS,<LOWQ-INTQ0>		;# OF WORDS IN TABLE

;NON-CLASS BIASES

NSKBAS:	1B4			;BASE FOR NOSKED FORK

CSKBAS:	1B5			;[3169]BASE FOR CRSKED FORK, BETTER THAN LOW Q

TBASE:	XX==NQUEUE-1
	REPEAT NQUEUE,<
	<XX+1>B8-1
	XX==XX-1>
;ROUTINE TO INIT QUANTT TABLE

;FIRST, TO INIT TO BIAS CONTROL SETTINGS

QBIAS:	SKIPA T1,[QUANTB,,QUANTT]

;NOW FOR CLASS SCHEDULER

QCLASS:	MOVE T1,[QUANTC,,QUANTT]
	BLT T1,QUANTT+NQUEUE-1	;DO TABLE
	RET			;AND DONE
;HEURISTIC FOR ADJUSTING QUEUE LEVEL AFTER I/O WAIT

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

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

;'WAITING TIME' ABOVE MEANS ACTUAL ELAPSED WAITING TIME
;DIVIDED BY THE 1-MINUTE LOAD AVERAGE.  THIS KEEPS 'WELL-TIMED'
;INTERACTIONS FROM USING MORE THAN ABOUT 1/LDAV OF THE CPU.
;COMPUTE NEW Q VALUE

NEWST:	MOVE T1,TODCLK		;CALCULATE ACTUAL WAITING TIME
	SUB T1,FKPGST(FX)
	ADDM T1,FKTIME(FX)	;DON'T COUNT WAIT TIME
	CAIGE T1,^D100		;ABOVE MIN WAIT TIME?
	JRST [	LOAD T1,FKQN	;NO, NO CHANGE
		JRST NEWSTX]
	SETZRO <BSNST,BSOVRD>	;YES, NOTE
	CAIGE T1,^D2000		;ABOVE THRESHOLD?
	IFSKP.
	  CALL NEWWSS		;RESET WS SIZE
	ENDIF.
	IMULI 1,NTMS		;CONVERT TO HIGH PRECISION UNITS
	TXNE F,SK%TTP		;CONSIDER INTERACTIONS?
	CAMGE 1,[^D1000*NTMS]	;YES, ABOVE MIN WAIT TIME?
	JRST NEWST2		;NO FOLLOW REGULAR ALGORITHM
	HRRZ 2,FKSTAT(FX)
	CAIE T2,TCOTST		;TTY OUTPUT?
	CAIN T2,TTOBET
	TXNN F,SK%TOP		;YES, SKIP IF WANT TTY OUTPUT PRIORITY
	CAIN T2,TCITST		;TTY INPUT?
	JRST [	HLRZ T2,FKSTAT(FX) ;YES
		CALL CKPHYT	;IS IT A PSEUDO TTY?
		 JRST NEWST2	;FOR PTY, FOLLOW NORMAL ALGORITHM
		JRST NEWST1]	;NO, BE MORE GENEROUSL
NEWST2:	TXNE F,SK%WCF		;CONSIDER LOAD AVG?
	JRST NEWST5		;NO
	MOVE 2,IRJAV		;AV NUMBER RUNNABLE FORKS
;**;[2845]ADD 2 LINES AT NEWST2:+3	DSC	26-OCT-82
	CAILE T2,^D10		;[2845]BUT LIMIT IT TO 10 MAX
	MOVEI T2,^D10		;[2845]
	CAILE T2,2
	IDIV T1,T2		;WAIT CREDIT INV PROP'L TO LOAD AV
NEWST5:	MOVE T2,T1
	LOAD T1,FKQN		;CURRENT QUEUE
	CAIG T1,INTQ1		;ONE OF THE HIGHEST?
	JRST NEWSTX		;YES, NO CHANGE
;**;[2845]REPLACE 9 LINES WITH 11 LINES AT NEWST5:+4	DSC	26-OCT-82
	CAIE T1,MAXQ		;[2845]ON COMPUTE QUEUE?
	CAML T2,QUANTT+MAXQ-1	;[2845]NO, WAITED FULL QUANTUM?
	IFSKP.
	  LOAD T3,FKQTM		;[2845]NO, JUST CREDIT REMAINING QUANTUM
	  ADD T3,T2
	  CAML T3,QUANTT(T1) 	;[2845]MORE THAN FULL?
	ANSKP.
	  STOR T3,FKQTM		;[2845]NO, UPDATE REMAINING QUANT
	  JRST NEWSTX
	ENDIF.
	SUBI T1,1		;[2845]BUMP ONE QUEUE
	CAIGE T1,INTQ1+1	;BUT KEEP OFF INTERACTIVE QUEUES
	MOVEI T1,INTQ1+1
	JRST NEWST3		;SET NEW QUEUE
;ESTABLISH VALUES FOR NEW QUEUE

NEWST1:	CALL NEWWSS		;SET NEW WS SIZE
	CALL INIQ		;GET INITIAL INT QUEUE
NEWST3:	MOVE 2,QUANTT(1)
	STOR 2,FKQTM		;SET NEW QUEUE VALUE
	STOR 1,FKQN		;SET NEW QUEUE NUMBER
	MOVE 2,TODCLK
	MOVEM 2,FKTIME(FX)
NEWSTX:	LOAD T3,FKMNQ		;GET MIN QUEUE
	CAML T1,T3		;WITHIN RANGE?
	RET			;YES, DONE
	MOVE T1,T3		;NO, USE MIN
	JRST NEWST3		;AND SET VALUES

;ADJUST WS SIZE AFTER BLOCK

NEWWSS:	SAVEAC <T1>
	HRRZ T1,FKWSP(FX)	;SET NR TO MAX(6, WSP)
	CAMGE T1,MINWSS		;ABOVE MIN WS SIZE?
	MOVE T1,MINWSS		;NO, SET TO IT
	LOAD T2,FKWSS		;GET CURRENT SIZE
	CAMLE T2,T1
	CALL ADJWSS		;CHANGE FKNR FOR FORK
	RET

;SELECT INITIAL QUEUE FOR FORK

INIQ:	MOVEI T1,INTQ1
	TXNN F,SK%RQ1
	SKIPE CLASSF		;ALWAYS USE FIRST INTQ IF CLASS SCHED
	MOVEI T1,INTQ0		;USE SECOND INT QUEUE
	RET
;BUMP PRIORITY OF FORK SO PSI WILL BE HANDLED PROMPTLY.  GIVE
;GIVE PRIORITY TO SEE IF PSI IS OF INTEREST.
; FX/ FORK INDEX
;	CALL PSBUMP
; RETURN +1 ALWAYS

PSBUMP:	CALL CHKBMP		;SEE IF NEED BUMP PRIORITY
	 RET			;NO. SO RETURN NOW
	JN FKBLK,,R		;IF NOW BLOCKED, DONE
	CALL GLREM		;REMOVE FROM GOLST
	CALLRET GOCONC		;AND REQUEUE WITH NEW PRIORITY

;ROUTINES USED BY SJPRI AND SPRIW TO CAUSE PSI FOR FKMNQ UPDATE

;INTERRUPT SPECIFIC PROCESS
;	T2/ SYSTEM FORK HANDLE

SETPRF::MOVX T1,PSIPRI
	CALLRET PSIGR		;AND COMPLETE TASK
	SUBTTL HLTJB - Halt job

;Here in top fork of job that is on its way out

HLTJB::	HRRE 6,CTRLTT
	JUMPL 6,HLTJB1		;IF JOB DETACHED
	CALL LCKDVL		;LOCK DEVICE LOCK, GO NOINT
	MOVE 2,6
	CALL TTYDAS		;DEASSIGN CTRLTT
	 JRST HLTJB3		;GO CHECK FOR ERROR OR DISMISS
	UNLOKK DEVLKK		;UNLOCK THE DEVICE LOCK
	OKINT			;DEVLCK WENT NOINT
HLTJB1:	MOVE 5,JOBNO
	SETOM CTRLTT		;CLEAR CONTROL TTY WORDS
	HRROS JOBPT(5)
;**;[3120] CHANGE 1 LINE AT HLTJB1:+3L	TAM	11-JUN-84
	CALL UNMIDX		;[3120] UNMAP DIRECTORY AND INDEX
;**;[3046]  Add 2 lines after HLTJB1:+3			DML	18-NOV-83
	CALL CLNZSC		;[3046] CLEAR ALL NON-ZERO SECTIONS
	 JFCL			;[3046] UNABLE TO CLEAR ALL - CONTINUE ANYWAY
	SETZM JOBM0+JSBPG	;CLEAR FAKE JSB MAPPING
	MOVE FX,FORKX		;THIS FORK.
	HRRZ 1,FKJOB(FX)	;GET JSB
	CALL WTSPT		;WAIT FOR IT TO BE UNSHARED
	SETZ 1,
	HRLZ 2,FKJOB(FX)	;GET SPTN OF JSB
	HRRI 2,JOBMAP-JSBPGA
	MOVEI 4,JSLST-JSBPG
	CALL MSETP1		;CLEAR JOB MAP
	HRLZ 2,FKPGS(FX)
	HRRI 2,PPLOW
	SETZ 1,
	MOVEI 4,PPHI+1-PPLOW
	CALL MSETP1		;CLEAR ALL PAGES OF PROCESS MAP
	HRRZ 1,FKJOB(FX)	;JSB
	CALL WTSPT		;WAIT FOR IT TO BE UNSHARED
	CALL WTFPGS		;WAIT FOR PSB AND UPT TO BE IN NO MAPS
	ENTSKD			;ENTER SCHED
	MOVE T2,JOBNO		;RELEASE JOB NUMBER
	SETZM JOBDIR(T2)	;CLEAR DIRECTORY NUMBER
	SETOM JOBRT(T2)		;INDICATE JOB NUMBER NOT IN USE
	HRRZ T1,JOBCLS(T2)	;SAVE CLASS OF JOB
	ADDI T2,JOBPT
	EXCH T2,FREJOB		;PUT SLOT ON FREE LIST
	MOVEM T2,@FREJOB
	SOS CLSCNT(T1)		;ONE LESS JOB IN THIS CLASS
	MOVE T2,JOBNO		;GET THE JOB NUMBER
	CAME T2,MJBUSE		;WAS THIS THE HIGHEST JOB IN USE?
	IFSKP.
	DO.
	  SOS T2,MJBUSE		;YES. NO LONGER IN USE
	  SKIPGE JOBRT(T2) 	;PREVIOUS JOB IN USE?
	  LOOP.			;NO. DISCOUNT IT TOO
	OD.
	ENDIF.
	SKIPE CLASSF		;DOING CLASS SCHEDULING?
	CALL ADJCLS		;NOW UPDATE CLASS VALUES
	JRST HLTFK2		;FLUSH THIS LAST FORK

;LOCAL MSETPT - BUGCHK ON FAILURE

MSETP1:	CALL MSETPT		;CLEAR ALL PAGES OF JOB MAP
	 BUG(MAPCLF)
	RET
;HLTJB CONTINUED..
;DEASSIGN OF JOB CONTROLLING FAILED

HLTJB3:	TXZN T1,1B0		;FAILED. NEED TO WAIT?
	BUG(TTDAS1)
	UNLOKK DEVLKK		;YES. UNLOCK THE DEVICE LOCK
	OKINT			;LCKDVL WENT NOINT
	HRL T1,CTRLTT		;T1/(LINE NUMBER,,ADDRESS OF ROUTINE)
	MDISMS			;WAIT UNTIL DEALLOCATION IS POSSIBLE
	JRST HLTJB		; AND TRY AGAIN
;FINISH DELETE OF FORK

HLTFK1::ENTSKD			;ENTER SCHEDULER
HLTFK2:	CALL REMBSJ		;REMOVE FORK FROM BAL SET
	CALL REMWSN		;REMOVE WS WO POSTPURGING
	CALL GLREM		;REMOVE FORK FROM GOLST
	HRRZ 1,FKJOB(FX)	;JSB
	CALL GETSHR		;GET SHARE COUNT
	MOVE 2,1		;SAVE IT
	HRRZ 1,FKJOB(FX)	;GET BACK JSB
	CAIN 2,1		;LAST USE OF JSB?
	IFSKP.
	  CALL DWNSHR		;NO. REDUCE SHARE COUNT
	ELSE.
	  CALL DESPT		;YES, DELETE IT (LOGOUT CASE)
	ENDIF.
	HLRZ 1,FKPGS(FX)	;UPT
	CALL DESPT		;DELETE IT
	LOAD T1,FSSPTN		;GET STACK I.D.
	CALL DESPT		;RELEASE IT AS WELL
	HRRZ 1,FKPGS(FX)
	CALL DESPT		;DEASSIGN PSB
	SETOM FORKX
	MOVEI T1,FKPT(FX)
	EXCH T1,FREFK		;PUT FORK NUMBER ON FREE LIST
	TLO T1,400000
	MOVEM T1,@FREFK
	CALL FKGC		;CLEAN UP ALL PAGES OF FORK
	HRRZ 1,FKWSP(FX)	;MAKE SURE FORK CLEANED UP
	HRRZ 2,FKCNO(FX)
	CAIN 1,0
	CAIE 2,0
	BUG(FRKNDL)
	CALL SETPSK		;SET TO SCHED CONTEXT SINCE PSB GONE
	JRST SCHED0		;NOW THERE IS NOTHING LEFT OF JOB...
;WAIT FOR PSB AND UPT TO HAVE SHARE COUNT OF 1

WTFPGS::HRRZ 1,FKPGS(FX)	;PSB
	CALL WTSPT
	LOAD T1,FSSPTN		;GET STACK PAGE
	CALL WTSPT		;WAIT FOR THIS AS WELL
	HLRZ 1,FKPGS(FX)	;UPT
WTSPT::	PUSH P,4
WTSPT2:	MOVE 2,1		;SAVE 1 SINCE WTSPTT CLOBBERS IT
	JSP 4,WTSPTT		;TEST PAGE NOW
	JRST WTSPT1		;MUST WAIT
	POP P,4			;NOW OK
	RET

WTSPT1:	MOVSI 1,0(2)
	HRRI 1,WTSPTT
	MDISMS
	HLRZ 1,1
	JRST WTSPT2

WTSPTT::CALL GETSHR		;GET SHARE COUNT
	CAIE 1,1
	JRST 0(4)
	JRST 1(4)
	SUBTTL Fork initialization

FKSET:	MOVE 1,UPP		;GET USUAL MON STACK
	MOVEM 1,PIAC+P		;PUT IN AC17
	MOVE T1,[IOWD NPSIPG*PGSIZ,PSIPGA] ;SET UP STACK POINTER
	MOVEM 1,PSIPT		;PSI STORAGE STACK
	MOVEI 1,<UACB>B39-1	;SETUP AC BASE
	MOVEM 1,ACBAS
	CALL FKSETK		;SETUP HWPT STUFF
	MOVX T1,<NOP>
	MOVEM T1,FRKNOP
	MOVE 1,INTDF0		;INTERRUPT SWITCHES
	MOVEM 1,INTDFF
	MOVE 1,MJRST0
	MOVEM 1,MJRSTF
	XMOVEI 1,PSISV1
	MOVEM 1,PIPC+2
	SETZM PIPC+1		;INSURE FLAGS 0
	SETZM NSKED
	SETZM CRSKED
	SETZM SNPPGS		;INITIALIZE SNOOP BREAK POINTS
	SETZM SNPLST		;  NONE TO START WITH
	SETOM PSISYS		;INIT PI SYSTEM OFF
	MOVE 1,RSKEDN
	MOVEM 1,RSKED
	MOVSI 1,<MOVEM 1,0>B53
	MOVEM 1,PATU40		;SETUP INSTRUCTION PART FOR COMPAT
	MOVEM 1,PATUPC		;ENTRY PROCEDURE
	MOVEM 1,DMSU40		;SET UP FOR DMS CALLS
	MOVEM 1,DMSUPC
	SETOM SLOWF
	SETOM INTDF
	SETOM TRAPC
	MOVE 1,NPMAX		;INIT LOCAL NPMAX TO SYSTEM NPMAX
	MOVEM 1,FNPMAX
	SETOM FKTAB
	MOVEI 1,FKTAB+1
	HRLI 1,-1(1)
	BLT 1,FKTAB+NLFKS/2-1
	SETZM JTTRW		; Clear JSYS trap word
	SETZRO JTFRK		; Clear trapped fork
	MOVEI T1,7777		; We haven't interrupted anyone yet
	STOR T1,JTMNI		; ...
	MOVEI T1,77		; And we don't want to be interrupted
	STOR T1,JTMCN
	MOVE T1,[IFIW!FKJTB]	; Put under top fork's environment
	MOVEM T1,JTBLK		;  until CFROK can update to FKJTB+forkn
	SETOM JTLCK		; Clear lock
	MOVE FX,FORKX
;**;[3054] ADD 1 LINE AT FKSET:+43L	TAM	6-DEC-83
	NOINT			;[3054] MUST BE NOINT FOR PAGE CREATION
	CALL FKSETP		;SETUP PSB AND UPT POINTERS
	MOVEI T1,NPSIPG		;MUST CREATE ALL PI PAGES
	MOVEI T2,PSIPGA		;THE FIRST ONE
FKSET4:	SETZM 0(T2)		;CREATE THIS ONE
	ADDI T2,PGSIZ		;NEXT PAGE
	SOJG T1,FKSET4		;DO ALL OF THEM
;**;[3054] ADD 1 LINE AT FKSET4:+3L	TAM	6-DEC-83
	OKINT			;[3054] BE OKINT AGAIN
	MOVE 6,PIMSK		;GET REQUEST BITS

;See if this is part of job creation. If yes, go initialize the job.

	TXNE 6,NEWJB%		;NEW JOB TOO?
	JRST FKSET1		;YES
	HRRZ 1,FKJOB(FX)	;GET JSB
	CALL UPSHR		;BUMP SHARE COUNT
	XMOVEI 1,FKSET2
FKSET3:	MOVEM 1,PIPC
	SETZM PIFL
	SETZM PIOLDS
	JRST PIRQR		;DEBREAK - RUN IN NORMAL MODE
;INIT NEW JOB

;Here when NEWJB% was set in PIMSK during fork initialization.

FKSET1:	HRREI T2,0(6)		;GET NUMBER OF CONTROLLING TTY, IF ANY
	LOAD 1,FKJOBN		;GET JOB NUMBER
	MOVEM 1,JOBNO
	STOR T2,JBTTY,(T1)	;TTY ASSIGNED TO JOB
FKSE01:	PUSH P,T1		;SAVE JOB NUMBER
	MOVE T1,FORKX		;SET FORKX INTO THIS TTY'S PSI DESTINATION
	SKIPL T2		;IF THERE IS A TTY,
	CALL STTOPF		; PUT IN THE FORKX
	POP P,T1		;RESTORE JOB NUMBER
	HRRZ T2,JOBCLS(1)	;GET CLASS OF THIS JOB
	MOVE T1,T2		;GET CLASS
	SKIPE CLASSF		;IF DOING CLASS SCHEDULING, ADJUST
	CALL ADJCLS		;AND SET UP PARAMETERS
	CALL LGTAD		;GET CURRENT TIME
	MOVEM T1,SRTTIM		;REMEMBER TIME JOB STARTED (MAYBE -1)
	MOVNI T1,1		;INITIALLY SET CONTROLLING TERMINALS TO -1
	MOVSI T2,-NUFKS		;DO FOR ALL FORKS
ICTTY:	STOR T1,FRKTTY,(T2)
	AOBJN T2,ICTTY		;LOOP FOR ALL FORK SLOTS
	MOVE T1,JOBNO
	HLRE T2,JOBPT(T1)	;CONTROLLING TTY, IF ANY, -1 IF NONE
	MOVEM T2,CTRLTT		;IN JSB
	LOAD T1,FKJSB		;GET JSB IDENT
	MOVE T2,SHRPTR		;CONSTRUCT JSB MAPPING
	STOR T1,SPTX,T2
	MOVEM T2,JOBM0+JSBPG
	SETZM @JTBLK		; No jsys traps for top fork
	MOVEI T1,DCOPNM		;DEFAULT MAX DECNET LINKS
	STOR T1,DCMAX		;TO THE JSB
	MOVEI T1,ATJBMX		;MAXIMUM HTN'S FOR A JOB
	STOR T1,JSAMX		;STORE IN JSB
	XMOVEI T1,EXEC0		;RUN AT EXEC0
	JRST FKSET3

;Here when PSI processing is complete. FKSET stored this location in FPC,
;and process is continued here after the interrupt.

FKSET2:	XCTU [SETZM 0]		;CLEAR USER AC'S
	MOVEI CX,1
	XBLTUU [BLT CX,17]
	ENTSKD
	SETZM PPC		;SET PC 0
	MOVSI 1,(UMODF)
	MOVEM 1,PFL
	MOVEI 1,HALTT
	JRST DISMSE
	SUBTTL Software Interrupt Service

INTDF0:	SOS INTDF		;NORMAL CONTENTS OF INTDFF
MJRST0:	XJRSTF FFL		;NORMAL CONTENTS OF MJRSTF
CHNSON::EXP 1B9+1B11+1B12+1B15+1B16+1B17+1B18+1B20 ;ALWAYS ON PSI CHANS

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

;Here from main scheduler loop if FKINT indicates interrupt is pending
;(bit FKPSI1 is on).
;PCU is set so that previous context references go to user
;FKINT has been copied to PIMSK

PIRQ:	MOVEM P,PIAC+17
	MOVEI P,PIAC		;SAVE USER AC'S
	BLT P,PIAC+16
	MOVE P,PIPDL		;SET UP LOCAL STACK
	MOVE P2,TRAPFL
	MOVE P3,KIMUFL
	MOVE P4,TRAPPC		;SAVE IMMEDIATELY VULNERABLE CELLS
	MOVE P5,KIMUPC
	MOVE P6,KIMUEF
	MOVE FX,PIMSK		;INTERRUPT REQUEST WORD
	MOVE Q2,FORKX
	SETZ 2,

;Save wait state at time of interrupt

	TXZE FX,PSIWT%		;WAS JOB IN WAIT STATUS?
	MOVE 2,FKSTAT(Q2)	;YES, GET OLD STATUS
	MOVEM 2,PIOLDS		;SAVE OLD STATUS, OR 0 IF WAS RUNNING

;Determine reason for interrupt and go handle some cases.

	TXZE FX,NEWFK%		;START NEW FORK?
	JRST FKSET		;YES
	TXZE FX,PSIT1%
	JRST PSIT1		;TERMINAL, PHASE 1
	TXZE FX,PSIT2%
	JRST PSIT2		;TERMINAL, PHASE 2
	TXZE FX,PSITL%		;TIME LIMIT EXCEEDED INTERRUPT?
	JRST TLEINT		;YES, GO INTERRUPT THE FORK
	TXZE FX,PSIPRI		;SET PRIORITY WORD?
	JRST PRISET		;YES. GO FIX UP DATA BASE
PSITR1:	TXNE FX,PSIIF%+SUSFK%+PSILO%+PSICO%+PSIJT%+ADRBK%
	JRST PSII		;CHANNEL INTERRUPT SPEC. BY FKINTB



;Here to finish the interrupt.
;Restore data as before the interrupt and allow rescheduling.

PIRQR:	CALL UNPIR		;LEAVE PI STATE
PSIDF1:	SKIPN 1,PIOLDS		;WAS RUNNING BEFORE PSI?
	JRST SCHED0		;YES
	CAIE 1,TRMTS1		;WAITING FOR ARBITRARY FORK TERM?
	JRST DISMSE		;NO, RETURN TO WAIT STATE
	SETZM PIOLDS		;CLEAR OLD STATE
	XMOVEI 1,WFORKA		;GO BACK INTO JSYS TO DO TEST
	MOVEM 1,PPC		; AND MAKE THIS THE PC
	SETZM PFL		; SET FLAGS
	JRST SCHED0		;GO RESCHEDULE THIS PROCESS
;LEAVE PSI CONTEXT.  RETURN THROUGH SCHEDULER
;Leaves with P pointing to SKDPDL
;Caller set up PIFL and PIPC to point to where process should start running.
;PIOLDS contains 0 if process is runnable.

UNPIRN:	TDZA T1,T1		;DON'T REQUEUE IF BUMPED
UNPIR:	MOVEI T1,1		;CONDITIONAL REQUEUE IF BUMPED
	AOS INSKED		;ENTER SCHEDULER
	POP P,CX		;GET LOCAL RETURN
	MOVE P,PI7P		;SETUP SCHED STACK
	PUSH P,CX		;PUT LOCAL RETURN ON IT
	PUSH P,T1		;SAVE ENTRY FLAG ON STACK
	MOVEM P2,TRAPFL
	MOVEM P3,KIMUFL
	MOVEM P4,TRAPPC		;RESTORE VULNERABLE CELLS
	MOVEM P5,KIMUPC
	MOVEM P6,KIMUEF
	MOVE 1,[XWD PIAC,PAC]
	BLT 1,PAC+17		;PUT AC'S BACK
	JSP FX,KISSAV		;SAVE APR-DEPENDENT STUFF
	MOVE 1,PIFL
	MOVEM 1,PFL
	MOVE 1,PIPC
	MOVEM 1,PPC
	MOVX T1,FKPSI1		;IN-PSI FLAG
	MOVE FX,FORKX
	TDNN T1,FKINT(FX)
	BUG(UNPIRX)
	ANDCAM 1,FKINT(FX)
	JE PIBMP,,[POP P,0(P)	;CLEAN UP THE STACK
		   RET]		;AND DONE
	SETZRO PIBMP		;CLEAR BUMPING
	POP P,CX		;GET BACK ENTFLG
	SKIPE CX		;REQUEUEING WANTED?
	SKIPE PIOLDS		;YES. CONTINUE AS RUNNABLE?
	RET			;NO. DONE THEN
	SAVET			;YES. SAVE ALL REGS
	CALL GLREM		;REMOVE FROM GOLST
	CALLRET GOCONC		;AND DONE

PIPDL:	IOWD NPIPDL,PIPDB	;INTERRUPT ROUTINES LOCAL PDL

;REQUEST PSEUDO INTERRUPT

;IIC TO SELF - FOR MONITOR INTERNAL USE.  FASTER THAN IIC AND DOES
;NOT REQUIRE PROCESS TO BE ABLE TO SET FKLOCK.
; 1/ CHANNEL MASK
;	CALL IICSLF
; RETURN +1 ALWAYS

;PSIRQ0 - SAME AS IICSLF EXCEPT TAKES CHANNEL NUMBER IN 1 RATHER THAN MASK

PSIRQ0::MOVE 1,BITS(1)		;GET MASK FOR CHANNEL
IICSLF::TDNN 1,PSICHM		;SEE IF INTERRUPT WILL BE TAKEN
	TDNE 1,CHNSON
	JRST IICSL1		;YES
	TDNN 1,SUPCHN
	RET			;NO, DON'T SEND IT
IICSL1:	NOINT
	MOVE 2,FORKX
	CALL PSIRQB		;REQUEST THE INTERRUPT
	OKINT
	CHKINT			;GET IT PROCESSED IF POSSIBLE
	RET
;GENERAL PSI REQUEST HANDLER
; 1/ CHANNEL MASK FOR PSIRQB, CHANNEL NUMBER FOR PSIRQ
; 2/ FORK INDEX
;	CALL ...
; RETURN +1 ALWAYS

;VARIENTS:
; PSITQ - CHANNEL BITS ALREADY SET, JUST REQUEST CHECK
; PSIGR - T1/ MASK FOR OTHER REQUESTS

PSIRQ::	MOVE 1,BITS(1)
PSIRQB::HRRZS 2
	IORM 1,FKINTB(2)	;SET BIT IN INTERRUPT WAITING BUFFER
PSITQ:	MOVX T1,PSIIF%		;REGULAR INTERRUPT FLAGS
PSIGR::	TXO T1,FKPSI0
	IORM 1,FKINT(2)
	CAMN 2,FORKX		;FOR THIS FORK?
	RET			;YES
;**;[3106]  Replace 1 line at PSIR4:  			DML	7-MAY-84
PSIR4::	CONSO PI,77000		;[3106] GO NOSKED ONLY AT PI LEVEL 7
       	NOSKD1
	PUSH P,FX
	MOVEI FX,0(2)
	MOVE 1,FKINT(FX)
	TXNE T1,FKPSI1		;FORK NOW INTERRUPTABLE?
	JRST PSIR61		;NO
	IFQN. FKBLK,
	  MOVX 1,PSIWT%		;YES, SET FLAG
	  IORM 1,FKINT(FX)
	  CALL UNBLK1		;WAKE UP THE FORK
	ENDIF.
	PUSH P,3
	CALL PSBUMP		;NO, GIVE FORK 'BUMP' TO GET PSI HANDLED
	POP P,3
PSIR61:	MOVEI 2,0(FX)
	POP P,FX
;**;[3106]  Add 1 line after PSIR61:+1			DML	7-MAY-84
       	CONSO PI,77000		;[3106] GO OKSKED ONLY AT PI LEVEL 7
	OKSKD1
	RET
;TERMINAL INTERRUPT
;PHASE ONE - CALLED FROM TERM SERVICE ROUTINES
; 2/ LINE NO.,   3/ INTERRUPT CODE
;SEND TO TOP FORK TO FIND PROPER DESTINATION

TTPSRQ::PUSH P,T3		;SAVE INTERRUPT CODE
	CALL GTCJOB		;GET CONTROLLING JOB
TTPSRX:	 JRST [	POP P,T3	;NONE (SHOULDN'T HAPPEN)
		RET]
	CAIN T3,-1		;IS THERE A CONTROLLING JOB?
	JRST TTPSRX		;NO. SHOULDN'T HAPPEN
	HLRZ T4,JOBPT(T3)	;GET THE JOB'S CONTROLLING LINE
	CAIE T4,0(T2)		;IS IT THIS LINE?
	JRST TTPSR2		;NO, LOOK ELSEWHERE IN THAT JOB
	HRRZ 2,JOBPT(3)		;GET INDEX OF TOP FORK
TTPSR1:	POP P,T3		;RESTORE INTERRUPT CODE
	STOR 3,TRMCOD,FKINT(2)	;INTERRUPT CODE
	MOVX T1,PSIT1%		;PHASE ONE REQUEST
	CALLRET PSIGR

TTPSR2:	CALL GTTOPF		;GET TOP FORK OF TTY'S CTTY GROUP
	 JRST TTPSRX		;THAT TTY ISN'T ACTIVE
	MOVEI T2,(T3)		;COPY THE FORKX
	CAIL T2,NFKS		;IS IT VALID? (ELSE -1 FOR NONE)
	JRST TTPSRX		;NO
	JRST TTPSR1		;YES, GO INTERRUPT THIS FORK
;ROUTINES TO HANDLE INTERRUPT CONDITIONS AS SPECIFIED BY BITS
;IN LEFT HALF OF FKINT

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

;Here when PSIT1% is set in FKINT

PSIT1:	LOAD Q2,TRMCOD,FX	;GET TERM INTERRUPT CODE
	MOVE Q2,BITS(Q2)
	HRRZ 1,FORKN		;START WITH TOP FORK
	LOAD T4,FRKTTY,(T1)	;GET CONTROLLING TERMINAL
	SETO Q1,
	TDNE Q2,FKPSIE(1)	;TERM CODE ON IN FORK?
	MOVEI Q1,0(1)		;YES, REMEMBER FORK
	CALL PSIT1A		;LOOK AT ALL INFERIORS
	JUMPL Q1,PSIT11		;NOT FOUND, SO TURN OFF CODE
	HRRZ 2,SYSFK(Q1)		;GET SYSTEM INDEX OF FORK TO GET INTERPT
	CAMN 2,FORKX		;THIS FORK?
	JRST PSIT2		;YES, GO DIRECTLY TO PHASE TWO
	NOSKED
	LOAD T1,TRMCOD,FX	;NO. GET TERM INTERRUPT CODE
	STOR T1,TRMCOD,FKINT(T2) ; AND SET UP INT FOR PROPER FORK
	MOVX 1,PSIT2%		;PHASE TWO REQUEST FLAG
	CALL PSIGR
	OKSKED
	JRST PSITR1

PSIT11:	CAIN T4,-1		;SOURCE OF PSI = JOB CTTY?
	JRST PSIT12		;YES
	TRZN T4,1B18		;MAYBE, CONVERT TO LINE #
	JRST PSITR1		;DESIGNATOR, NOT TTY. RETURN.
	CAMN T4,CTRLTT		;CTTY OF JOB?
	JRST PSIT12		;YES
	CAIGE T4,NLINES		;VALID TTY NUMBER?
;**;[3080] Replace one line at PSIT11:+7L	15-Mar-84	CRJ
;	CAIGE T4,0
	SKIPGE T2,T4		;[3080] See if ge 0, line # in T2 (for CLRINT)
	JRST PSITR1
	JRST PSIT13		;YES

PSIT12:	ANDCAM Q2,TTSPSI ;NOT FOUND, SO TURN OFF CODE
	SKIPGE T2,CTRLTT
	JRST PSITR1
PSIT13:	MOVE T1,Q2		;T1/ INTERRUPT BIT
	CALL CLRINT		;CLEAR THE INTERRUPT IN TERMINAL'S DATA
	JRST PSITR1
;SEARCH FORK STRUCTURE FOR FORK TO INTERRUPT
; T4/ DESIGNATOR OF SOURCE OF THIS PSI

PSIT1A::ADD 1,INFERP		;LOOK AT INFERIOR LIST
PSIT1B:	LDB 1,1			;GET NEXT IN LIST
	JUMPE 1,R		;RETURN AT END OF LIST
	LOAD T2,FRKTTY,(T1)	;GET CONTROLLING TERMINAL
	CAIE T2,0(T4)		;IS IT THE ONE THAT MADE THIS PSI?
	JRST PSIT1E		;NO, SO DON'T CONSIDER FORK.
	HRRZ 2,SYSFK(1)		;CHECK STATE OF FORK
	PUSH P,FX		;SAVE FX
	MOVEI FX,0(T2)		;SEE IF THIS FORK IS FROZEN OR HALTED
	CALL CHKWT		; ..
	 JRST [	POP P,FX	;IT'S NOT.
		JRST PSIT1D]
	POP P,FX		;YES, SEE WHICH
	HRRZ T3,FKSTAT(T2)	;GET ITS STATE
	CAIN T3,FRZWT		;FROZEN?
	JRST PSIT1G		;YUP
	CAIE T3,HALTT		;NO, HALTED OR FORCED TERM?
	CAIN T3,FORCTM		; ..
	JRST PSIT1C		;YES.
PSIT1D:	TDNE Q2,FKPSIE(1)	;FORK HAS CODE ENABLED?
	MOVEI Q1,0(1)		;YES, REMEMBER IT
PSIT1E:	HRLM T1,0(P)		;REMEMBER CURRENT FORK
	CALL PSIT1A		;CHECK ITS INFERIORS
	HLRZ T1,0(P)		;RECOVER CURRENT FORK
	XMOVEI T2,20		;RESTORE RETURN ADDRESS
	HLLM T2,0(P)
PSIT1C:	ADD T1,PARALP		;LOOK AT ITS PARALLELS
	JRST PSIT1B		;DO PARALLELS

PSIT1G:	MOVX T3,JTFRZ%		;FORK FROZEN. BY JSYS TRAP?
	TDNN T3,FKINT(T2)	; ..
	JRST PSIT1C		;NO. ORDINARY FREEZE
	MOVX T3,FRZBB%		;YES. ONLY TRAP, OR OTHERS TOO?
	TDNE T3,FKINT(T2)	; ..
	JRST PSIT1C		;OTHERS TOO. DON'T CONSIDER THIS FK
	JRST PSIT1D		;NO, JUST JSYS TRAP. IT MAY STILL
				; TAKE THE PSI, SO CONSIDER THIS FK.

;FORK STRUCTURE POINTERS

SUPERP::POINT 12,FKPTRS,11	;SUPERIOR
PARALP::POINT 12,FKPTRS,23	;PARALLEL
INFERP::POINT 12,FKPTRS,35
;TERMINAL INTERRUPT, PHASE TWO

;Here when PSIT2% is set in FKINT or directly from PSIT1.

PSIT2:	LOAD T1,TRMCOD,FX	;GET TERM INTERRUPT CODE
	CALL GETCHA
	LDB 2,2
	MOVE 1,BITS(2)		;AND SET BIT IN INT. WAITING WORD
	AND 1,PSICHM		;BUT ONLY FOR ENABLED CHANNELS
	IORM 1,PSIBW
	JRST PSII		;THEN GO PROCESS IT

;TIME LIMIT EXCEEDED INTERRUPT
;ROUTINE TO ISSUE TIME LIMIT EXCEEDED INTERRUPT
;  RUN BY TOP FORK OF JOB ONLY

;Here when PSITL% is set in FKINT

TLEINT:	MOVE T1,JOBNO		; Get the job
	LOAD T2,JOBRTP,(T1)	; And then ptr to runtime limit blk
	JUMPE T2,PSITR1		; If none, then don't do this
	PUSH P,T2		; Save so we can release blk
	LOAD T1,TIMCHN,(T2)	; Channel for poke
	LOAD T2,TIMFRK,(T2)	; And fork to poke
	CALL PSIRQ
	POP P,T4		; Blk to be released
	CALL CLKKIL		; Release storage for clock
	MOVE T1,JOBNO
	SETZRO JOBRTP,(T1)	; And finally clear the ptr
	JRST PSITR1		;CONTINUE ON

;PRIORITY WORD WAS SET. COMPUTE NEW FKMNQ

;Here when PSIPRI is set in FKINT

PRISET:	PUSH P,FX		;SAVE INT BITS
	MOVE FX,FORKX		;GET FORK HANDLE
	SKIPN T1,JOBBIT		;GET LOCAL PRIORITY WORD
	MOVE T1,JOBSKD		;GET JOB PRIORITY WORD
	LDB T1,[POINT 6,T1,29]	;GET HIGH Q NUMBER FROM PRIORITY WORD
	STOR T1,FKMNQ		;NEW MIN Q FOR PROCESS
	POP P,FX
	JRST PSITR1		;PROCEED
;SUSPEND FORK REQUEST

;Here when SUSFK% is set in FKINT

PIRSFK:	MOVE 1,FX		;GET PIMSK
	MOVE FX,FORKX
	TXZ 1,FKPSI0+SUSFK%	;CLEAR THIS REQUEST
	IORM 1,FKINT(FX)	;KEEP OTHER REQUESTS
	DMOVE 1,PIFL
	CALL PITEST		;NOW INTERRUPTABLE?
	 JRST PIRSF1		;NO
	MOVEI 3,SUSWT		;SUSPENDED FORK TEST
PIRSK1:	MOVE 2,FORKX
	MOVX 1,SUSFK%
	ANDCAM 1,FKINT(2)
	CALL UNPIRN		;LEAVE INTERRUPT STATE
	IORM 1,FKINT(FX)	;KEEP INTERRUPT STARTING BIT
	MOVEI 1,0(3)		;SUSWT OR FRZWT
	HRL 1,PIOLDS		;WITH OLD STATUS
	PUSH P,T1
	MOVEI T1,SUSFKT
	CALL WAKSUP		;WAKEUP SUPERIOR IF WAITING FOR SUSP
	POP P,T1
	JRST DISMSE		;DISMISS

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

PIRSF2:	MOVEI T1,FKJTQ(FX)	; FORK IN JSYS TRAP QUEUE WAIT
	CALL JTDEQ		; REMOVE IT FROM QUEUE
	XMOVEI T1,JTRLCK		; SET RESUME ADDR. TO LOCK ROUTINE
	SETZM PIOLDS		;
	SETZM PIFL
	MOVEM T1,PIPC		;
	OKSKED			;
	MOVEI T3,SUSWT		;
	JRST PIRSK1		;

SUSWT::	JRST 0(4)		;SCHEDULER TEST FOR SUSPENDED FORK
;CARRIER OFF ACTION REQUEST

;Here when PSICO% is set in FKINT

PIRCOF:	DMOVE T1,PIFL
	CALL TFTEST		;INTERRUPT OK NOW?
	 JRST [	MOVE FX,FORKX	;NO, SETUP DEFER
		MOVX T1,PSICO%	;KEEP REQUEST
		IORM T1,FKINT(FX)
		JRST PSIDFR]	;GO SET DEFER
	MOVX T1,PSIWT%		;SEE IF PROCESS WAS WAITING
	TDNE T1,PIMSK		;WAS IT?
	SOS PIPC		;YES. MAKE IT GO BACK INTO WAIT THEN
	MOVX T1,PSICO%		;GET THE BIT FOR THIS CONDITION
	MOVE FX,FORKX		;GET THIS FORK'S ID
	ANDCAM T1,FKINT(FX)	;CLEAR THIS CONDITION (NECESSARY
				; IF THIS WAS DEFERRED).
	XMOVEI T1,JOBCOF		;SET TO DEBREAK TO ACTION PROCEDURE
	JRST PIRLG1

;LOGOUT REQUEST

;Here when PSILO% is set in FKINT

PIRLGO:	DMOVE T1,PIFL
	CALL TFTEST		;OK TO INTERRUPT?
	 JRST [	MOVE FX,FORKX	;NO, REMEMBER REQUEST
		MOVX T1,PSILO%
		IORM T1,FKINT(FX)
		JRST PSIDFR]
	XMOVEI T1,FLOGO
;**;[2900] Add 6 lines at PIRLGO:+4L	PED	13-JAN-83
	MOVEM T1,PIPC		;[2900] STORE IT
	SETZM PIOLDS		;[2900] MAKE FORK RUNNABLE
	SETZM PIFL		;[2900] SET NEW FLAGS FOR DEBREAK
	MOVX P3,UMODF		;[2900] FORCE REINIT OF STACK AT FLOGO
	SETZM P5		;[2900] NEW PC
	JRST PIRQR		;[2900]

PIRLG1:	SETZM PIOLDS		;MAKE FORK RUNNABLE
	EXCH T1,PIPC
	SETZ T2,		;ZERO NEW PIFL
	EXCH T2,PIFL		;GET FLAGS, SET NEW ONES FOR DEBREAK
	TXNN T2,UMODF
	SKIPGE SLOWF
	JRST [	MOVEM T1,FPC	;IN USER MODE, SIMULATE JSYS
		MOVEM T2,FFL
		JRST PIRQR]
	MOVE T2,PIAC+17		;IN MON MODE, SIMULATE PUSHJ
	PUSH T2,T1
	MOVEM T2,PIAC+17
	MOVX T1,PCU		;GET THE MASK FOR PCU
	IORM T1,PIFL		;AND TURN IT ON
	JRST PIRQR

;SPECIAL TEST USED BEFORE INTERRUPT TOP FORK FOR LOGOUT OR CARRIER OFF

TFTEST:	CALL PITEST		;INTERRUPTABLE NORMALLY?
	 RET			;NO, NOT HERE EITHER
	MOVX T2,LOGIOB
	TDNE T2,JOBBIT		;LOGGING IN OR OUT?
	RET			;YES, NO INTERRUPT
	RETSKP			;NO, INTERRUPT OK
; JSYS TRAP REQUEST

;Here when PSIJT% is set in FKINT

PIRJTP:	DMOVE T1,PIFL		; Pick up flags
	CALL PITEST		; FORK INTERRUPTABLE?
	 JRST PIRJT1		; NO, DEFER IT
	MOVX T1,PSIJT%		;
	MOVE FX,FORKX		; IN CASE THIS PSI WAS DEFERRED
	ANDCAM T1,FKINT(FX)	; CLEAR IT FROM FKINT
	LOAD T1,JTMCN		; GET PSI CHANNEL FOR TRAP
	MOVE T1,BITS(T1)	;
	IORM T1,PSIBW		; SET BIT IN INT WAITING WORD
	SETZ FX,		;
	JRST PSII		; GO PROCESS THE TRAP

PIRJT1:	MOVE FX,FORKX		; DEFER THE JSYS TRAP PSI
	MOVX T1,PSIJT%		;
	IORM T1,FKINT(FX)	;
	JRST PSIDFR		;

;ADDRESS BREAK REQUEST - FREEZE FORK AND INTERRUPT SUPERIOR

;Here when ADRBK% is set in FKINT

PIRABK:	MOVE T1,FX		;GET REQUEST BITS
	MOVE FX,FORKX		; AND FORK INDEX
	TXZ T1,FKPSI0+ADRBK%	;CLEAR BITS FOR THIS REQUEST
	IORM T1,FKINT(FX)	;SAVE OTHERS
	DMOVE T1,PIFL		;GET INTERRUPTED PC DOUBLEWORD
	CALL PITEST		;INTERRUPTABLE?
	 JRST PIRBK1		;NO
	MOVX T1,FRZB1%+ABFRZ%	;YES, INDICATE FREEZE DUE TO ADDR BRK
	IORM T1,FKINT(FX)	; ..
	MOVX T1,ADRBK%		;CLEAR ORIGINAL REQUEST BIT
	ANDCAM T1,FKINT(FX)	; ..
	CALL FKTMI		;INTERRUPT SUPERIOR FORK
	CALL UNPIRN		;LEAVE PSI CONTEXT
	SETZM PIOLDS		;SET OLD STATE TO RUNNING
	MOVEI T1,FRZWT		;WAIT LIST ON WHICH WE WISH TO LIVE
	JRST DISMSE		;DISMISS

PIRBK1:	MOVX T1,ADRBK%		;RE-LIGHT REQUEST BIT
	IORM T1,FKINT(FX)	; ..
	JRST PSIDFR		;AND DEFER THE INTERRUPT
;PROCESS INTERRUPT(S) FOR THIS FORK AS SPECIFIED BY FKINTB
;THIS CODE *CAN* CAUSE PAGE FAULTS WHEN REFERENCING THE USER
;CHANNEL AND LEVEL TABLES.

;FX/ flags from FKINT

PSII:	MOVE 1,MJRST0		;NORMALIZE ALL DEFER TRAPS
	MOVEM 1,MJRSTF
	MOVE 1,INTDF0
	MOVEM 1,INTDFF

;DETERMINE REASON FOR THE INTERRUPT AND GO PROCESS IT.

	TXNE FX,SUSFK%		;FORK SUSPENSION REQUEST?
	JRST PIRSFK		;YES
	TXNE FX,PSILO%		;LOGOUT REQUEST?
	JRST PIRLGO
	TXNE FX,PSICO%		;CARRIER OFF REQUEST?
	JRST PIRCOF		;YES
	TXNE FX,PSIJT%		; JSYS trap requested?
	 JRST PIRJTP		; Yes
	TXNE FX,ADRBK%		;ADDRESS BREAK REQUEST?
	JRST PIRABK		;YES, HANDLE

;HERE BECAUSE BIT PSIIF% IS SET IN FKINT, INDICATING A CHANNEL
;INTERRUPT. FKINTB HAS BIT SET FOR EACH CHANNEL THAT NEEDS TO
;INTERRUPT.

	MOVE 2,FORKX
	MOVEI 1,0
	EXCH 1,FKINTB(2)	;RESET FKINTB TO 0
	IORM 1,PSIBW		;INCLUDE IN PROCESS WAITING BREAKS
	MOVE 1,PSICHM		;USERS ENABLED CHANNELS
	IOR 1,CHNSON		;WITH ALWAYS ON CHANNELS
	IOR 1,SUPCHN		;WITH SUPERIOR RESERVED CHANNELS
	SKIPN 3,PIOLDS		;WAS FORK WAITING?
	IFSKP.
	  SKIPN FORKN		;AND NOT TOP FORK?
	ANSKP.
	  MOVEI 3,0(3)		;YES, HALT OR FORCED TERM?
	  CAIE 3,HALTT
	  CAIN 3,FORCTM
	  JRST PIRQR		;YES. IGNORE REQUEST UNTIL LATER
	ENDIF.
	ANDB 1,PSIBW		;FLUSH DISABLED CHANS
	JUMPE 1,PIRQR		;RETURN IF NO BREAKS WAITING
	;..
	;..

;Here when an interrupt is pending and it is enabled (or a panic channel)

	DMOVE 1,PIFL		;PROCESS PC
	CALL PITEST		;CAN PROCESS BE INTERRUPTED NOW?
	 JRST PSIDFR		;NO, GO SETUP DEFERRED INTERRUPT
	MOVE 1,PSIBW
	TDNE 1,MONCHN		;MONITOR RESERVED CHANNEL?
	JRST PSIMB		;YES
	TDNN T1,CHNSON		;PANIC CHANNEL?
	JRST PSIN5		;NO

;Panic channel. If ERJMP follows user's instruction, go there.

	DMOVE T1,PIFL		;YES, CHECK FOR ERJMP/ERCAL
	TXNE T1,UMODF		;USER PC NOW?
	IFSKP.
	  DMOVE T1,UPDL		;NO, GET IT
	  EXCH T1,T2		;(IN PROPER ORDER)
	ENDIF.
	CALL SETPCV		;SET PREVIOUS CONTEXT FOR ITRSIM
	CALL ITRSIM		;CHECK AND INTERPRET ER INSTRUCTION
	 JRST PSIN6		;NONE THERE, CONTINUE WITH INTERRUPT
	MOVEM T3,PIPC		;FOUND, SET PC TO E OF INSTRUCTION
	MOVEM T1,PIFL		;AND FLAGS TO USER FLAGS
	MOVE T3,CHNSON		;CLEAR INTERRUPT REQUEST
	ANDCAM T3,PSIBW
	JRST PIRQR		;RETURN TO USER

;Not a panic channel, or panic channel with no ERJMP. Terminate the process if
;it can't take the interrupt or the superior wants it.

PSIN6:	MOVE T1,PSIBW
PSIN5:	AND 1,SUPCHN		;LOOK AT SUPERIOR RESERVED CHANS
	JUMPN 1,PSIN3		;TERMINATE IF ANY
	MOVE 1,PSIBW
	AND 1,CHNSON		;LOOK AT SPECIAL CHANNELS
	SKIPE PSISYS		;IF THIS PROCESS NOT TAKING PSI'S,
	JUMPN 1,PSIN3		;TERMINATE IT IF ANY SPECIALS
	ANDCM 1,PSICHM		;AND'ING WITH USER'S 'OFF' CHANNELS
	JUMPN 1,PSIN3		;TERMINATE CAUSE CHANNEL NOT ACTIVE
	SKIPE PSISYS		;PSI SYSTEM ON?
	JRST PIRQR		;NO
	SKIPN PSLEVT		;THIS PROCESS TAKING INTERRUPTS?
	JRST PSIN1		;NO, GO TRANSMIT THE PSI
	;..
	;..

;PSIBW (AND AC 1) HAS A BIT SET FOR EACH CHANNEL TO GIVE AN INTERRUPT.
;CHECK THEM ALL TO FIND THE HIGHEST PRIORITY (LOWEST LEVEL NUMBER)

	XJRSTF [PCU+MSEC1
		MSEC1,,.+1]	;SET PCS SO EXT REFS WORK
	MOVE 1,PSIBW		;GET CHANNELS NEEDING INTERRUPTS
	MOVEI 2,0		;INIT CHANNEL NUMBER
	MOVSI 3,1		;INIT LOWEST LEVEL
PSIS4:	JFFO T1,PSIS2		;JUMP WITH FIRST CHN FOUND IN T2
	JRST PSIS10		;NO MORE. GO FINISH

;T2/ CHANNEL NUMBER
;T3/ PREVIOUS LOW LEVEL NUMBER

PSIS2:	ANDCM T1,BITS(T2)	;DON'T LOOK AT THIS BIT NEXT TIME
	MOVE 4,PSCHNT		;GET ADR OF USER'S CHANNEL TABLE
	ADDI 4,0(2)		;COMPUTE ADR OF USER'S CHANNEL WORD
	UMOVE T4,@T4		;GET LEVEL NUMBER FOR THIS CHANNEL
	 ERJMP PSIN1
	JN PSXSIR,,[
		LOAD T4,SILEV,T4 ;GET LEVEL NUMBER
		JRST PSIS3]
	HLRZS T4		;GET LEVEL NUMBER
PSIS3:	CAILE 4,NPILEV		;LEGAL LEVEL?
	SETZ 4,			;NO, TREAT AS 0
	CAIG 3,0(4)		;OLD LEVEL GREATER THAN CURRENT?
	JRST PSIS4		;NO
	MOVEI 3,0(4)		;YES, REMEMBER NEW LEVEL
	MOVEI Q1,0(2)		;AND CHANNEL NUMBER
	JRST PSIS4		;RESUME SCAN
;HERE WHEN ALL BITS HAVE BEEN LOOKED AT.
;T3/ LEVEL OF HIGHEST PRIORITY INTERRUPT FOUND
;Q1/ CORRESPONDING CHANNEL NUMBER

PSIS10:	JUMPE 3,PSID1		;NO LEVEL ASSIGNED? GO XMIT INTERRUPT
	MOVE 1,BITS(3)
	CAMG 1,PSIBIP		;OK TO BREAK ON THIS LEVEL?
	JRST [	MOVE 2,PSIBW	;NO, .GE. PRIORITY LEVEL IN PROGRESS
		TDNN 2,CHNSON	;BREAKS ON PANIC CHNS WAITING?
		JRST PIRQR	;NO, HOLD WAITING BREAKS
		MOVE 1,2
		JRST PSIN3]	;YES, MUST TERMINATE
	IORM 1,PSIBIP		;YES, REMEMBER  BREAK THIS LEVEL
	MOVE 1,PSCHNT		;GET ADR OF USER'S CHANNEL TABLE
	ADDI 1,0(Q1)		;COMPUTE ADR OF USER'S CHANNEL WORD
	UMOVE T4,@1		;GET LEVEL + ADDR OF USER'S INT ROUTINE
	 ERJMP PSIN1		;IF FAILED, TERMINATE
	JN PSXSIR,,[
		ANDX T4,SIADR	;IF EXTENDED, GET ROUTINE ADDRESS
		JRST PSIS9]
	HLL T4,PSCHNT		;APPLY SECTION USED IN SIR JSYS

;User has provided routine address for this level.
;	T4/ address

PSIS9:	MOVE 1,PIFL		;GET FLAGS WHEN INTERRUPTED
	EXCH 4,PIPC		;GET PC WHEN INTERRUPTED,SAVE NEW PC
	TLNN 1,(UMODF)		;WAS IN USER MODE?
	JRST PSISM		;NO, MUST SAVE MONITOR CONTEXT
	HLLZM T1,PIFL		;PRESERVE USERS FLAGS
	;..
;HERE WHEN MONITOR CONTEXT HAS BEEN SAVED (IF NECESSARY). READY TO
;STORE PC INTO USER'S LEVTAB. PIFL AND PIPC ARE SET UP FOR GOING TO
;USER'S INTERRUPT ROUTINE.

;	T1/ FLAGS TO GO INTO LEVTAB
;	T4/ PC TO GO INTO LEVTAB
;	Q1/ CHANNEL NUMBER

	;..
PSIS5:	SETZM PIOLDS
	MOVE 2,PSLEVT		;GET ADR OF USER'S LEVEL TABLE
	ADDI 2,-1(3)		;COMPUTE ADR OF USER'S LEVEL WORD
	UMOVE 2,@2		;GET ADR OF PC WORD FOR THIS LEVEL
	 ERJMP PSIN1		;IF FAILED, TERMINATE
	JN PSXSIR,,[
		UMOVEM T1,@T2	;SAVE FLAGS WORD
		ERJMP PSIN1	;QUIT IF FAILED
		AOS T2
		UMOVEM T4,@T2	;SAVE PC WORD
		 ERJMP PSIN1	;QUIT IF FAILED
		JRST PSID3]
	HRR T1,T4		;COMBINE PC
	XOR T4,PSLEVT		;SEE IF SECTIONS ARE THE SAME
	TLNE T4,-1		;ARE THEY?
	JRST PSIN1		;NO. ERROR THEN
	HLL T2,PSLEVT		;FORCE CORRECT SECTION
	UMOVEM 1,@2		;STORE BREAK PC IN USER'S MEMORY
	ERJMP PSIN1		;IF FAILED, TERMINATE
PSID3:	MOVE 1,BITS(Q1)		;CLEAR WAITING BREAK BIT FOR THIS CHANNEL
	ANDCAM 1,PSIBW
	JRST PIRQR		;TO USER


;MONITOR ROUTINE IS SHORTSTOPPING INTERRUPTS - SIMULATE  JSYS MONBK
;MONBK/(where to store flags and PC,,new PC)
;Copy new PC to PIPC, and stores flags and PC where MONBK points to

PSIMB:	HRRZ 1,MONBK		;ROUTINE ADDRESS
	EXCH 1,PIPC		;GET OLD PC
	MOVE 3,PIFL		;GET FLAGS
	SETZM PIFL		;SET MONITOR
	SETZM PIOLDS
	HLRZ 2,MONBK		;RET LOC
	MOVEM 3,0(2)		;STORE FLAGS FOR RETURN
	MOVEM 1,1(2)		;STORE RETURN
	JRST PIRQR
;HERE WHEN INTERRUPTED OUT OF MONITOR CONTEXT. SAVE ALL RELEVANT
;INFO BEFORE GIVING THE INTERRUPT.

;THIS CODE SAVES ONTO A SPECIAL PSI STACK. IT USES AC FX AS ITS STACK
;POINTER. THE DEBRK JSYS USERS THIS INFORMATION TO CONTINUE THE INTERRUPTED
;JSYS

;T1/ FLAGS AT TIME OF INTERRUPT (FROM PIFL)
;T4/ PC AT TIME OF INTERRUPT (FROM PIPC)

PSISM:	HLRZ 2,BITS(3)		;NO, REMEMBER MONITOR INTERRUPT
	IORM 2,PSIBIP		;IN RH OF BIP WORD
	MOVE FX,PSIPT		;STORAGE STACK POINTER
	MOVE P1,FX		;SAVE POINTER
	PUSH FX,1
	PUSH FX,4		;SAVED PC AND FLAGS

;SAVE A SET OF IMPORTANT CELLS. SAVCT CONTAINS A LIST OF THEM.

	MOVSI Q2,-NSAVC		;SAVE VULNERABLE CELLS
	PUSH FX,@SAVCT(Q2)
	AOBJN Q2,.-1

;SAVE THE UPDL STACK

	MOVSI Q2,UPDL		;STORE ENTIRE MONITOR STACK
	HRRI Q2,1(FX)
	ADD FX,[XWD NUPDL,NUPDL]
	JUMPGE FX,PIOVFW	;IF POSITIVE NO ROOM
	BLT Q2,0(FX)

;STORE THE CURRENT CONTEXT AC'S AT THE TIME OF THE INTERRUPT

	MOVSI 1,PIAC		;STORE CURRENT MONITOR AC'S
	HRRI 1,1(FX)		;NOW LIVING IN PIAC
	ADD FX,[XWD 20,20]
	JUMPGE FX,PIOVFW	;IF POSISTVE NO ROOM
	BLT 1,0(FX)
	;..
;SAVE ALL AC BLOCKS (THOSE IN ACBAS BLOCKS AND PREVIOUS
;CONTEXT AC'S)

	;..
	HRRZ 1,ACBAS		;STORE ALL AC BLOCKS IN USE
	SUBI 1,<UACB>B39-1	;COMPUTE NUMBER BLOCKS IN USE
	JUMPLE 1,PSISM1		;JUMP IF NONE
	MOVEI T2,1(FX)		;SAVE PREVIOUS CONTEXT ACS
	ADD FX,[20,,20]
	JUMPGE FX,PIOVFW	;IF POSITIVE NO ROOM
	XBLTUM [BLT T2,0(FX)]
	MOVSI T2,UACB		;PUT USER ACS BACK INTO AC BLOCK
	XBLTMU [BLT T2,17]
	MOVSI 2,UACB		;SETUP TO BLT ENTIRE AC STACK
	HRRI 2,1(FX)		; .. TO PSI STACK ..
	LSH 1,4			;COMPUTE NUMBER WORDS IN USE
	HRLI 1,0(1)		;NUMBER OF WORDS BOTH HALFS
	ADD FX,1
	JUMPGE FX,PIOVFW	;IF POSITIVE NO ROOM
	BLT 2,0(FX)
PSISM1:	PUSH FX,1		;SAVE COUNT FOR DEBRK
	PUSH FX,ACBAS		;AND CURRENT ACBAS
	MOVE 1,UPP		;RESET MON STACK
	MOVEM 1,PIAC+P
	HLLZ 1,UPDL+1		;USER FLAGS AT MONITOR CALL
	TXO T1,UMODF		;MAKE DAMN SURE IT'S USER MODE
	MOVEM T1,PIFL		;PRESERVE USERS FLAGS
	MOVE T4,UPDL		;GET PC AT JSYS ENTRY
	PUSH FX,P1		;PSI STACK BEFORE ALL THIS PUSHING
	PUSH FX,1		;SAVE FLAGS AT JSYS ENTRY
	PUSH FX,T4		;SAVE PC AT JSYS ENTRY
	MOVEM FX,PSIPT		;SAVE CURRENT STACK POINTER
	TLZ 1,(UMODF)		;SO HE CAN TELL IT WAS MON INTERRUPT
	SETOM SLOWF
	JRST PSIS5		;FINISH INTERRUPT START

PIOVFW:	BUG(PSISTK)
;XMIT INTERRUPT TO SUPERIOR FORK

PSIT:	HRRZ 2,FORKN
	ADD 2,SUPERP		;GET SUPERIOR
	LDB 2,2
	HRRZ 2,SYSFK(2)		;SYSTEM FORK INDEX
	CALLRET PSIRQ		;REQUEST INTERRUPT

;THIS FORK WON'T TAKE INTERRUPT, DISMISS IT AND RECORD WHY
;Get the channel number

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

;Determine channel number from waiting interrupts

PSIN1:	MOVE 1,PSIBW		;INTERRUPTS OFF OR NO LEVCHN
PSIN3:	JFFO 1,.+1		;CALCULATE CHANNEL NUMBER

;T2/ channel number on which interrupt was attempted

PSIN2:	MOVEM 2,FORCTC		;SAVE CHANNEL NUMBER FOR STATUS
	MOVE 1,BITS(2)		;JUST ONE CHANNEL AT A TIME
	ANDCAM 1,PSIBW		;RESET WAITING BIT
	MOVE 1,CAPENB
	TLNE 1,(1B17)		;SUPERIOR WANTS FROZEN STEAD HALT?
	JRST [	CALL FKTMI	;YES. GO INTERRUPT IT THEN
		MOVEI 3,FRZWT	;AND GET PROPER STATUS
		JRST PIRSK1]	;AND GO DO THE FREEZE
	CALL GETSFX		;GET SUPERIOR FORK INDEX
	MOVE Q2,1		;SAVE IT
	CALL UNPIRN		;LEAVE PI STATE, MOVE AC'S ETC.
	MOVE P,PI7P
	MOVE 1,Q2		;RECOVER SUPERIOR FORK INDEX
	HRRI 1,FORCTM
	JRST DISMSE		;THIS ONE IS BEING DISMISSED
;GET SUPERIOR FORK INDEX FOR HALT OR FORCED TERMINATION

GETSFX:	HRRZ 1,FORKN
	ADD 1,SUPERP		;MAKE POINTER TO SUPERIOR
	LDB 1,1
	HRLZ 1,SYSFK(1)		;PUT INDEX IN LH FOR DISMISS TEST WORD
	RET

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

;INTERRUPT SUPERIOR FORK ON TERMINATION

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

;CONSTRUCT BYTE PTR TO CHANNEL NUMBER FOR TERM CODE
; 1/ TERMINAL CODE
;	CALL GETCHA
; RETURN +1: ALWAYS, 2/ BYTE PTR TO CHANNEL NUMBER

GETCHA::MOVEI 2,0(1)
	IDIVI 2,6
	ADDI 2,PSICHA
	HLL 2,CH6TAB(3)
	RET
;DEFERRED INTERRUPT LOGIC
;SET TRAPS TO RECHECK INTERRUPTS WHEN STATE CHANGES
;HERE WHEN PROCESS IS NOINT AND CAN'T TAKE AN INTERRUPT. SET UP INTDFF
;AND MJRSTF TO HANDLE THIS LATER

PSIDFR:	MOVE 1,MJRST1
	MOVEM 1,MJRSTF
	MOVE 1,INTDF1
	MOVEM 1,INTDFF
	CALL UNPIRN		;LEAVE BREAK STARTING STATE
	IORM 1,FKINT(FX)	;BUT LEAVE PENDING BIT
	CALL CHKBMP		;SEE IF NEED PI BUMPING AGAIN
	 NOP
	JRST PSIDF1		;RESUME

MJRST1:	JRST PSISV0		;TRY FOR INTERRUPT NOW
INTDF1:	XPCW PIFL		;CONTENTS OF INTDFF WHEN TRAP SET
				;PIPC+1 CONTAINS JRST PSISV1

;HERE WHEN PROCESS DID AN OKINT AND THERE WAS AN INTERRUPT PENDING FOR
;THE PROCESS. DON'T LET IT TAKE IF PROCESS IS STILL NOINT.

PSISV1:	DATAO PAG,SETMON	;SET MON AC BLOCK CURRENT
	SOSL INTDF
	XJRSTF PIFL		;IF STILL NOINT, PROCEED
	JRST PSISV2		;GO ON

;HERE WHEN PROCESS WENT TO MRETN (TO RETURN FROM A JSYS OR UUO),
;AN INTERRUPT WAS PENDING, AND THE PROCESS HAS BEEN NOINT UNTIL NOW.
;IF JSYS WAS NESTED (I.E., PROCESS IS NOT RETURNING TO USER) AND
;PROCESS IS STILL NOINT, DON'T LET THE INTERRUPT TAKE.

PSISV0:	DATAO PAG,SETMON	;SET MON AC BLOCK CURRENT
	DMOVEM 1,PIFL		;SAVE AC1
	DMOVE 1,FFL		;FFL NOW CONTAINS USER'SPC
	TXNE T1,UMODF		;A USER-MODE PC?
	IFSKP.
	  SKIPGE INTDF		;NO. NOW INTERRUPTABLE?
	ANSKP.
	  DMOVE T1,PIFL		;NO. RECOVER AC CONTENTS
	  XJRSTF FFL		;AND RETURN FROM MUUO
	ENDIF.
	EXCH 1,PIFL
	EXCH 2,PIPC

;Allow deferred interrupt to happen

PSISV2:	MOVEM P,PIAC+17		;SAVE USER'S AC17
	MOVEI P,PIAC		;AND AC'S 0-16
	BLT P,PIAC+16
	MOVE P,PIPDL		;RESTORE INTERRUPT STARTING STATE
	MOVE P2,TRAPFL
	MOVE P3,KIMUFL
	MOVE P4,TRAPPC		;SAVE VULNERABLE CELLS
	MOVE P5,KIMUPC
	MOVE P6,KIMUEF
	SETZM PIOLDS
PSISV3:	MOVE 2,FORKX
	MOVE FX,FKINT(2)
	JRST PSII		;ENTER MAIN SEQUENCE
;TEST FOR IMMEDIATE OR DEFERRED INTERRUPT
;SKIP => IMMEDIATE
;NOSKIP => DEFERRED
;CALLED WITH TEST USER PC IN AC1,AC2

PITEST::TLNE 1,(UMODF)		;USER MODE?
	JRST [	SKIPE NSKED	;ARE WE NOSKED?
		SKIPN PNSKDC	;YES. SHOULD WE BE BECAUSE OF RESOURCES?
		RETSKP		;NO. SAY CAN INTERRUPT THEN
		RET]		;YES. DEFER THE INT
	SKIPL SLOWF		;NO, SLOW CODE?
	SKIPL INTDF		;YES, INTERRUPTABLE
	RET			;NO, DEFER
	SKIPN CRSKED
	SKIPE NSKED		;IN CASE NOSKED W/O NOINT
	BUG(PSINSK)
	JRST RSKP		;IMMEDIATE

;TEST FOR PI BUMPING NEEDED
;	FX/ FORK INDEX

CHKBMP:	MOVE CX,FKINT(FX)
;**;[2939] ADD 1 LINE AT CHKBMP:+1L	TAM	29-MAR-83
	TXNE CX,SUSFK%!PSILO%!PSIT1%!PSIT2%!PSIPRI ;[2939] ANY INTERRUPT BITS?
	TXNE CX,FKPSI1		;AND NOT DEFERRING
	JRST [	SETZRO PIBMP	;MAKE SURE BIT IS OFF
		RET]
	SETONE PIBMP		;YES. BUMP IT
	RETSKP			;AND INFORM CALLER OF SAME
;DEBREAK

.DEBRK::MCENT
	SKIPN PSIBIP		;ANY BREAKS IN PROGRESS?
	ITERR DBRKX1		;NO, ERROR
	DMOVE T3,[PCU+MSEC1
		MSEC1,,DEBRK1]	;GET NEW PC
	XJRSTF T3		;DO IT
DEBRK1:	MOVE 2,FORKX
	MOVSI 1,200000
	IORM 1,FKINT(2)		;SET INTERRUPT STARTING BIT
	SETZM PIOLDS
	MOVE 2,PSIBIP		;BREAKS NOW IN PROGRESS
	JFFO 2,.+1		;FIND HIGHEST ONE
	MOVE 1,PSLEVT		;COMPUTE ADDRESS OF RETURN PC
	ADDI 1,-1(3)
	UMOVE 1,@1
	JN PSXSIR,,[
		XCTU [DMOVE Q1,@T1]
		JRST DEBRK2]
	HRRZS 1			;IF OLD STYLE, FORCE SECTION 0 ADDRESS
	UMOVE Q1,@1		;GET RETURN PC FROM USER MEMORY
	HRRZ Q2,Q1		;SAVE THE PC HERE
	HLLZS Q1		;SAVE ONLY FLAGS HERE
	HLL Q2,PSLEVT		;APPLY SECTION THAT WAS LOST WHEN STORED
DEBRK2:	MOVS 2,BITS(3)
	TDNE 2,PSIBIP		;WAS THIS MONITOR INTERRUPT?
	JRST DEBRK6		;YES, GO UNWIND

;HERE TO RETURN CONTROL TO THE USER PROGRAM.
;Q1/ FLAGS FROM LEVTAB
;Q2/ PC FROM LEVTAB
;SEND USER TO THIS LOCATION PRESERVING CERTAIN FLAGS IF THEY WERE
;ON AT ENTRY TO DEBRK

DEBRK3:	HLLZ T2,0(P)		;GET FLAGS FROM JSYS ENTRY
	MOVE P,PIPDL		;ESTABLISH PI STACK
	XOR Q1,T2		;KEEP PRIVILEGED BITS FROM THIS CALL
	TXZ Q1,UMODF+UIOF+PC%AFI+37B17
	XOR Q1,T2
	MOVEM Q1,PIFL		;SET THIS AS FLAGS FOR PROCEEDING
	MOVEM Q2,PIPC		;SET TO DEBREAK AT THAT ADDRESS
	SETOM SLOWF		;NORMALIZE FLAGS FOR RETURN TO USER
	SETOM INTDF
	MOVE 1,UPP
	MOVEM 1,PIAC+P
DEBRK4:	MOVE 1,BITS(3)
	ANDCAM 1,PSIBIP		;CLEAR BIP THIS LEVEL
	JRST PSISV3		;GO CHECK FOR OTHER INTERRUPTS AND RETURN
;HERE BECAUSE INTERRUPT OCCURRED OUT OF MONITOR CONTEXT. PSISM SAVED
;CONTEXT ON PSI STACK. IF PC IN LEVTAB HAS BEEN CHANGED, DON'T CONTINUE
;IN MONITOR. IF UMODF IS ON, USER MUST HAVE SET IT, BECAUSE PSISM
;CLEARED IT BEFORE PUTTING IT IN LEVTAB. PSI STACK CONTAINS FLAGS AND
;PC AT TOP OF UPDL WHEN INTERRUPT OCCURRED. THESE WERE PUT INTO LEVTAB
;BY PSISM.

;Q1/ FLAGS FROM USER'S LEVTAB
;Q2/ PC FROM USER'S LEVTAB

DEBRK6:	ANDCAM 2,PSIBIP		;CLEAR MON BREAK FLAG FOR THIS LEVEL
	MOVE FX,PSIPT
	POP FX,T4		;PC AT TOP OF UPDL WHEN INTERRUPT
	POP FX,T2		;FLAGS AT TOP OF UPDL WHEN INTERRUPTED
	POP FX,PSIPT		;TOP OF THIS BLOCK OF PSI STORAGE
	TLOE Q1,(UMODF)		;IF IT WAS DIDDLED AT ALL,
	JRST DEBRK5
;NOT NEEDED IF DEBRK3 DOES HLLZ
;	HLLZS T2		;CLEAR RH FLAGS
	CAMN Q1,T2		;DO FLAGS MATCH?
	CAME Q2,T4		;YES. PC MATCH?

;HERE WHEN PC HAS BEEN CHANGED. DON'T PROCEED IN THE MONITOR ROUTINE
;THAT WAS INTERRUPTED. RELEASE ANY RESOURCES THAT THE PROCESS OWNS, AND
;GO SEND THE PROCESS TO THE ADDRESS IN LEVTAB.

DEBRK5:	JRST [	MOVE T1,FORKX	;NO. GET FORK HANDLE
		HLLZ T2,PSIBIP	;TELL THEM WHAT INTERRUPT LEVEL WE'RE AT
		TDZ T2,BITS(T3)	;POINT TO LEVEL WE'RE GOING TO
		PUSH P,T2	;SAVE FOR CALL TO GOKFRE
		CALL JSBSTF	;GO PROCESS DEALLOCATION STACK
		MOVE T1,FORKX	;GET FORK HANDLE
		POP P,T2	;GET CORRECT LEVEL
		CALL GOKFRE	;FREE GETOK ENTRIES
		JRST DEBRK3]	;DON'T RESUME MON ROUTINE

;HERE WHEN INTERRUPT OCCURRED FROM MONITOR CONTEXT, AND WE ARE
;RESUMING THE MONITOR ROUTINE. RESTORE CONTEXT AS SAVED BY PSISM
;ON SPECIAL PSI STACK

	MOVE P,PIPDL		;ESTABLISH PI PDL
	POP FX,ACBAS
	POP FX,4		;GET NUMBER OF WORDS FOR AC BLOCKS
	;..

;RESTORE AC STACKS

	;..
	JUMPLE 4,PDBK1		;JUMP IF NO AC STACK TO RESTORE
	SUB FX,4
	MOVEI Q1,UACB
	HRLI Q1,1(FX)
	ADDI 4,0(Q1)
	HRRZS T4
	BLT Q1,-1(4)		;RESTORE AC BLOCKS
	MOVEI Q1,UACB		;PUT USER ACS BACK ONTO STACK
	XBLTUM [BLT Q1,UACB+17]
	SUB FX,[20,,20]		;RESTORE PREVIOUS CONTEXT AC'S
	MOVSI 2,1(FX)
	XBLTMU [BLT 2,17]

;RESTORE AC'S FOR MONITOR

PDBK1:	SUB FX,[XWD 20,20]
	MOVEI 2,PIAC
	HRLI 2,1(FX)
	BLT 2,PIAC+17		;RESTORE MONITOR AC'S

;RESTORE UPDL STACK

	SUB FX,[XWD NUPDL,NUPDL]
	MOVEI 2,UPDL
	HRLI 2,1(FX)
	BLT 2,UPDL+NUPDL-1	;RESTORE STACK

;RESTORE SPECIAL CELLS

	MOVEI 2,NSAVC-1		;RESTORE VULNERABLE CELLS
	POP FX,@SAVCT(2)
	SOJGE 2,.-1
	POP FX,2		;GET PC AT TIME OF INTERRUPT
	MOVEM 2,PIPC		;SAVE PC (PROCESS WILL GO THERE)
	POP FX,2		;GET FLAGS AT TIME OF INTERRUPT
	MOVEM 2,PIFL		;SAVE FLAGS
	SETZM SLOWF
	SETOM INTDF		;BE OKINT
	JRST DEBRK4		;NOW DEBRK

;TABLE OF VULNERABLE CELLS

SAVCT:	MPP
	FFL
	FPC
	MONFL
	MONPC
	PIOLDS
	P2
	P3
	P4
	P5
	P6
NSAVC==.-SAVCT
	SUBTTL JSYS trapping

; Jsys Traps support code (TRAPSI, JTLOCK, JTULCK, etc)..


;TRAP AND PSI ROUTINE EXECUTED WHEN A FORK EXECUTES A TRAPPED JSYS
;CALLED AS FIRST CODE EXECUTED BY THE TRAPPED JSYS (WITH IT'S CONTEXT
;BUT TOTALLY INVISIBLE TO IT)

;P1/	ADDRESS OF FORK'S JTB + P2
;P2/	OFFSET FOR THIS JSYS NUMBER
;P3/	BIT MASK FOR THIS JSYS NUMBER

;P4/	MONITOR'S FORKN
;P5/	TRAP HANDLED FLAG
;P6/	OFFSET TO MONITOR'S PSB

TRAPSI::NOINT			;DON'T INTERRUPT THIS CODE
	SUBI P1,(P2)		;GET BACK ADDRESS OF JTB WITHOUT OFFSET
	SKIPA P5,[0]		;TRAP HANDLED IF NON-ZERO

TRPSI2:	MOVE P1,FKJTB(P4)	;pointer to monitor's JTB
	JUMPE P1,TRPSI6		;if he's not monitored were done
	LOAD P4,JTIMP,(P1)	;forkn of monitor's monitor
	ADDI P1,(P2)		;add in offset to bit table
	TDNN P3,JTBIM(P1)	;HANDLED BY THIS MONTIOR?
	JRST TRPSI2		;no, keep looking up the chain of monitors

	SETO P5,		;YES, INDICATE TRAP HANDLED
	MOVEI T1,0(P4)
	CALL SETLF1		;MAP PSB OF THE MONITOR
	MOVE P6,T1		;SAVE POINTER TO MONITOR'S PSB
;**;[2805] CHANGE 1 LINE AT TRPSI4:+0L	TAM	9-SEP-82
TRPSI4:	LOAD T2,JTMCN,(P6)	;[2805]
	CAIN T2,77		;IS CHANNEL SPECIFIED?
	JRST TRPSI2		;NO, DON'T PSI, SEARCH FOR ANOTHER MONITOR
	CALL JTLOCK		;YES, SYNCH WITH OTHER TRAPPING FORKS
	JRST TRPSI4		;FORK SUSPENDED AND RESUMED
	 			;WHILE QUEUED, RETRY LOCKING
	JSP CX,FRZPSI		;FREEZE SELF AND PSI MONITOR


;RESUMED HERE AFTER TRAP HANDLED IF MONITOR DOES NOT CHANGE PC
;WHEN CONTROL RETURNS TO TRPSI5 ACS P1-5 MUST BE THE SAME AS TRPSI3

TRPSI5::JRST TRPSI2		;LOOK FOR MORE MONITORS (OF MONITORS)

;RETURN TO THE NORMAL JSYS CODE

TRPSI6:	SKIPL P5		;HAS TRAP BEEN HANDLED AT ALL?
	 BUG(TRPSIE)
	LDB T1,[POINT 9,KIMUU1,26] ; Pick up opcode of trapped guy
	CAIE T1,<JSYS>B62	; Was a JSYS?
	 JRST TRPSI7		; No, a UUO
	LOAD T1,JTJNO
	MOVE CX,JSTAB(T1)	;GET NORMAL DISPATCH
	HLLZM CX,FFL		; Restore normal flags
	TXZ CX,EXFLBT
	MOVEM CX,FPC		; And dispatch
	XCTU [DMOVE T1,1]	;RESTORE STANDARD 4 ARGS
	XCTU [DMOVE T3,3]
	SETZM INTDF		;RESTORE STATE TO ENTRY AT TRAPSI
	OKINT			;TURN PSIS BACK ON
	XCT MJRSTF		;DO NORMAL DISP FOR THIS JSYS

TRPSI7:	SETOM SLOWF		; Untangle ourselves
	MOVE P,MPP		; in a state like this
	POP P,FFL		; Reset flags
	POP P,FPC		; And caller
	MOVE P,UPP		; Reset the stack...
	SETZM INTDF
	OKINT
	JRST U10501		; Return to handle the UUO
;FREEZE AND PSI ROUTINE - FORK INITIATES JSYS TRAP PSI OF
;MONITOR AND THEN FREEZES ITSELF
;P4/ JOB INDEX OF FORK TO PSI
;P6/ OFFSET TO FORKS PSB


FRZPSI:	MOVS T4,KIMUU1		; Pick LH of instruction
	HRR T4,KIMUU1+1		; And then RH
	MOVEM T4,JTTRW(P6)	; Set last trapped instruction
	HRRZ T4,FORKN
	STOR T4,JTFRK,(P6)	; Trapped fork index
	STOR P4,JTMNI		;SAVE FORK WE TRAPPED TO FOR UTFRK

	ENTSKD			;SAVE ACS ETC.
	TXZ CX,EXFLBT
	MOVEM CX,PPC		; Save return for DISMSE
	MOVE CX,ENSKR		;GET THE RIGHT FLAGS
	HLLZM CX,PFL		;FOR RESUME AFTER DISMSE

	LOAD T2,JTMNI
	HRRZ T2,SYSFK(T2)	;GET FORKX OF MONITOR FORK
	MOVX T1,PSIJT%
	CALL PSIGR		;MAKE SCHEDULER SEE IT
	MOVX T1,FKPSI1+JTFRZ%	;DO "JSYS TRAP" FREEZE OF SELF
	IORM T1,FKINT(FX)	;FX=FORKX SET BY ENSKED
	SETZM PIOLDS		;"OLD STATE" = RUNNING
	MOVEI T1,FRZWT
	JRST DISMSE		;DISMS
;JSYS TRAP LOCK AND UNLOCK ROUTINES
;WHEN A FORK TRIES JTLOCK AND SOME OTHER FORK HAS THE
;LOCK, THE FORK ADDS ITSELF TO A QUEUE (FKJTQ) AND BECOMES BLOCKED.
;WHEN THE LOCK IS CLEARED (BY A MONITORING FORK) THE QUEUE IS
;SCANNED FOR THE FIRST FORK (IF ANY) WAITING ON THE LOCK.  THAT
;FORK IS REMOVED FROM THE QUEUE AND ALLOWED TO RUN.

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

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

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

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


JTRLCK:	RET

				;ROUTINE TO PLACE FORK ON QUEUE
JTENQ:	HRL T1,SYSFK(P4)	;1=FORK WAITING ON
	HLLZM CX,PFL
	TXZ CX,EXFLBT
	MOVEM CX,PPC		;SAVE RETURN PC NOW
	ENTSKD			;ENTER SCHEDULER
	SOSE NSKED		;MATCHED NOSKED IN JTLOCK
	BUG(JTENQE)
	MOVEI T2,FKJTQ(FX)	;FX=FORKX, SET BY ENSKED
	HRRM T2,@JTLSTL		;ADD THIS FORK TO END OF QUEUE
	EXCH T2,JTLSTL		;SET NEW END OF QUEUE PTR
	MOVSM T2,FKJTQ(FX)	;SET BACK PTR TO OLD QUEUE END
	HRRI T1,JTQWT
	JRST DISMSE		;DISMS


;JSYS TRAP QUEUE WAIT TEST

JTQWT:	MOVE T1,FKINT(FX)	;DID A SUSPEND REQUEST OCCUR
	TXNN T1,SUSFK%		;BEFORE BLOCKING?
	JRST 0(4)		;NO.
	MOVX T1,FKPSI0+PSIWT%	;YES, REINITIATE SUSPEND
	IORM T1,FKINT(FX)	;REQUEST PSI
	MOVSI T1,200000
	ANDCAM T1,FKINT(FX)	;ALLOW PSI'S
	PUSH P,3
	CALL PSBUMP		;NO, GIVE FORK SOME PRIORITY
	POP P,3
	JRST 1(4)


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

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

JTULC2:	CALL JTDEQ		;REMOVE FORK FROM QUEUE
	PUSH P,FX		;UNBLOCK FORK
	MOVE FX,T4
	CALL UNBLK1
	POP P,FX
	CAIA
JTULC3:	SETOM JTLCK		;NO FORKS ON QUEUE, CLEAR LOCK
       OKSKED
	RET

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

JTDEQ:	NOSKED
	HRRZ T3,(T1)		;3=PTR TO NEXT ITEM ON QUEUE
	HLRZ T2,(T1)		;2=PTR TO PREV ITEM
	HRRM T3,(T2)
	JUMPE T3,JTDEQ1		;REMOVING LAST ITEM?
	HRLM T2,(T3)		;NO
	CAIA
JTDEQ1:	MOVEM T2,JTLSTL
       OKSKED
	RET
	SUBTTL Context switching for MUUO's


;Here from APRSRV when user or monitor executed an illegal UUO.

ILUUO::	MCENTR
;**;[2873]CHANGE 1 LINE AT ILUUO:+1L	TAM	7-DEC-82
ILUUO1::ITERR ILINS1		;[2873] ILLEGAL UUO

;ALL UNDEFINED JSYS'S

UJSYS0::MCENT
UJSYS::	ITERR ILINS2		;UNDEFINED JSYS
;Here when user executes a TOPS-10 UUO (op codes 40-77). Enter compatibility
;package

UU1050::SKIPE P1,@JTBLK		; JSYS traps?
	 JRST [ SETZ P2,	; Word 0
		MOVSI P3,(1B0)	; Check for JSYS 0 (UUO trapping)
		TDNN P3,JTBAL(P1)
		 JRST .+1	; Not trapping UUOs
		MOVE T1,FORKN	; Get fork number
		MOVE T1,SYSFK(T1) ; Is this fork execute only?
		TXNE T1,SFEXO	;...
		JRST U10501	;Yes, No trapping in this case
		MOVE CX,[PCU+MSEC1B+TRAPSI] ; We are, go JSYS trap route
		JRST MENTU1]	; Join JSYS code
U10501::SKIPG T1,PATADR		;GOT PAT NOW?
	JRST GETPAT		;NO
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,PATUPC	;YES, GET ITS ADDRESS
	  DMOVE T2,FFL		;GET FLAGS, PC
	  XCTU [DMOVEM T2,0(T1)] ;PASS THEM TO PA1050
	  MOVE T1,PATU40	;PTR TO UUO WORD
	  MOVE T2,KIMUEF	;MOVE UUO WORD TO PA1050
	  UMOVEM T2,0(T1)
	ELSE.
	  MOVE T1,PATUPC	;NON-EXTENDED FORMAT, GET PTR TO PC
	  MOVE T2,FPC		;CONSTRUCT OLD STYLE FLAGS,,PC
	  HLL T2,FFL
	  UMOVEM T2,0(T1)	;PASS IT TO PA1050
	  MOVE T1,PATU40	;PTR TO UUO WORD
	  MOVE T2,KIMUEF	;CONSTRUCT OLD STYLE UUO WORD
	  HRL T2,FFL
	  UMOVEM T2,0(T1)
	ENDIF.
	MOVE T1,PATADR		;SET PC TO ENTER PA1050
	MOVEM T1,FPC
	JRST GOUSR

;HERE ON DMS JSYS

DMSENT::SKIPG T1,DMSADR		;HAVE RMS NOW?
	JRST GETDMS		;NO
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,DMSUPC	;PTR TO PC
	  DMOVE T2,FFL		;EXTENDED FLAGS, PC
	  XCTU [DMOVEM T2,0(T1)] ;PASS IT TO RMS
	  MOVE T1,DMSU40	;PTR TO UUO WORD
	  MOVE T2,KIMUEF	;MOVE UUO WORD TO RMS
	  UMOVEM T2,0(T1)
	ELSE.
	  MOVE T1,DMSUPC	;OLD FORMAT VECTOR, GET PTR TO PC
	  MOVE T2,FPC		;CONSTRUCT OLD STYLE FLAGS, PC
	  HLL T2,FFL
	  UMOVEM T2,0(T1)	;PASS IT TO RMS
	  MOVE T1,DMSU40	;PTR TO UUO WORD
	  MOVE T2,KIMUEF	;CONSTRUCT OLD STYLE UUO WORD
	  HRL T2,KIMUFL
	  UMOVEM T2,0(T1)
	ENDIF.
	MOVE T1,DMSADR		;SET RETURN PC TO ENTER RMS
	MOVEM T1,FPC
	JRST GOUSR
;SLOW MONITOR CALL SETUP ROUTINE
;MENTM - Invoked via JRST from APRSRV with JSYS number in CX
;MENT0 - INVOKED VIA MCENTR (JSP CX,MENT0)

;At this point,
;KIMUFL and FFL/ flags, op code, AC for MUUO; or just flags at last monitor call
;KIMUPC and FPC/ PC at context switch

MENTM::	LOAD CX,EXPCBT,JSTAB(CX) ;GET ROUTINE ADDRESS WITHOUT PCU FLAG
MENT0::	SETOM SLOWF
	EXCH T1,MONFL		;SAVE T1
	EXCH T2,MONPC		;SAVE T2
	XSFM T1			;GET PCS INTO T1
	HLL T1,CX		;GET NEW FLAGS
	MOVE T2,CX		;GET NEW FLAGS AND PC
	TXZ T2,EXFLBT		;MASK OFF FLAGS
	EXCH T2,KIMUPC		;SAVE NEW PC, GET OLD PC
	MOVE CX,T1		;RESTORE CX TO FLAGS AND PCS
	EXCH T1,MONFL		;RESTORE T1
	EXCH T2,MONPC		;SAVE OLD PC, RESTORE T2
	EXCH CX,FFL		;SAVE NEW FLAGS, GET OLD FLAGS, ETC.
	MOVEM CX,MONFL		;SAVE OLD FLAGS, ETC.
	TLNE CX,(UMODF)		;FROM USER?
	JRST MENT1		;YES

;At this point,
;	MONFL/ flags at time of entry
;	MONPC/ PC at time of entry
;	FFL/ new flags
;	FPC/ new PC

;Here on nested JSYS in monitor

   IFN SKEDSW,<
	AOSGE INTDF		;CHECK STATE OF INTDF
	BUG(IDFOD1)
	SOS INTDF
   >				;END OF IFN SKEDSW
;	PUSH P,FKLOCK		;SAVE VALUE OF FORK LOCK
;	PUSH P,FLKCNT		; AND NEST COUNT

;Save state information on the UPDL stack, and the current value of the stack pointer.

	PUSH P,INTDF		;SAVE STATE OF INTERRUPTIBILITY
	PUSH P,MPP		;SAVE POINTER TO UPDL
	PUSH P,MONPC		;SAVE OLD PC
	PUSH P,CX		;SAVE RETURN FLAGS
	MOVEM P,MPP		;SAVE CURRENT STACK POINTER

;When running in the monitor, AC block 0 is current, 1 is previous
;Save the former "previous" AC block (block 1) in the PSB.
;Copy the former "current" AC's (block 0) to the new "previous" AC's (block 1)

	AOS CX,ACBAS		;SETUP NEXT AC STACK BLOCK
	CAIL CX,<EUACB>B39	;USED ALL BLOCKS?
	BUG(NOACB)
	LSH CX,4		;MAKE INTO ADDRESS
	HRRZ P,CX		;SAVE COPY
	XBLTUM [BLT CX,17(P)]	;PUSH PREV AC BLOCK ONTO STACK
	SETZ CX,
	XBLTMU [BLT CX,CX-1]	;MOVE CURR TO PREV
	MOVE P,MPP		;RESTORE P
	SETZM SLOWF
	XCT MJRSTF		;RESUME MONITOR ROUTINE (NORMALLY XJRSTF FFL)

;Here when context was user at last monitor call
;Set current flags to include PCU, and simulate JSYS entry

MENT1:	EXCH CX,FFL		;SAVE CX, GET NEW FLAGS
	TLO CX,(PCU)		;MAKE SURE PCU IS ON LOCALLY
	EXCH CX,FFL		;RESTORE CX, SAVE FLAGS WITH PCU
	XSFM T1			;GET CURRENT FLAGS
	TXO T1,PCU		;MAKE USER PREVIOUS CONTEXT
	MOVE T2,[MSEC1,,MENT11]	;WHERE TO PROCEED
	XJRSTF T1		;DO IT
MENT11:	MOVE P,UPP		;TOP OF MON STACK
	PUSH P,MONPC		;SAVE RETURN FOR PSI
	PUSH P,CX		;SAVE FLAGS
	PUSH P,MONPC
	PUSH P,CX		;SAVE RETURN FOR OTHER USES
	JRST MENT2		;JOIN NORMAL USER ENTRY
;ENTRY TO TOP-LEVEL JSYS (I.E. FROM USER)
;Here when user executed a JSYS.
;	CX/ JSYS number

MENTU::	SKIPE P1,@JTBLK		; Any JSYSes monitored for this fork?
	 JRST [	JUMPE CX,[ MCENTR	; Special case JSYS 0 (UUO trapping)
			JRST UJSYS]
		MOVE T1,FORKN	;Get fork number
		MOVE T1,SYSFK(T1) ;Is this fork execute only?
		TXNE T1,SFEXO	;...
		JRST .+1	;Yes, no trapping in this case
		MOVE CX,JSTAB(CX)	;GET ROUTINE ADDRESS AND PCU FLAG
		LOAD P2,JTJNO	; Yes, get JSYS number
		IDIVI P2,^D36	; Get word offset into bit table
		MOVE P3,BITS(P3) ; And bit mask
		ADDI P1,0(P2)	; Form address within bit table
		TDNE P3,JTBAL(P1) ; Trapped?
		 HRRI CX,TRAPSI	; Yes, go trapped route
		JRST MENTU1]
	MOVE CX,JSTAB(CX)	;GET ROUTINE ADDRESS AND PCU FLAG

;Save on UPDL stack the flags and PC at the time of the MUUO
;Set up FFL and FPC to contain information for XJRSTF.
;	CX/ flags and PC to go to

MENTU1:	MOVE P,UPP		;SET UP STACK
	PUSH P,KIMUPC
	PUSH P,KIMUFL		;RETURN FOR PSI
	PUSH P,KIMUPC
	PUSH P,KIMUFL
JSLKB1::			;TAG FOR JSLOOK (SNOOP PGM)
	XSFM FFL		;STORE PCS INTO FFL
	HLLM CX,FFL		;SET FLAGS
	TXZ CX,EXFLBT		;CLEAR FLAGS
	MOVEM CX,FPC		;SAVE NEW PC

;Common code for all JSYS entry from user
;Top of UPDL is set up. FFL and FPC are ready for XJRSTF.

MENT2:	MOVEM P,MPP		;SET STACK FENCE
	XCTU [DMOVE T1,T1]	;GET STANDARD 4 ARGS
	XCTU [DMOVE T3,T3]
	MOVEI CX,<UACB>B39-1	;INIT AC STACK
	MOVEM CX,ACBAS		;CURRENT AC'S MAY BE STORED HERE
	SKIPE NSKED		;IS THIS PROCESS NOSKED?
	CALL [	SKIPN PNSKDC	;YES, SHOULD IT BE?
		RET		;NO. ALLOW INTS THEN
		RETSKP]		;YES
	SETOM INTDF		;INIT INTDF
	SETZM CRSKED		;INIT CRITICAL REGION FLAG
	SETZM SLOWF		;INIT SLOWF
	XCT MJRSTF		;RESUME MONITOR ROUTINE (NORMALLY XJRSTF FFL)
IMCFLG==1B14			;INTERNAL MONITOR CALL FLAG (X FIELD OF PC)

;New JSYS's go to ITRAP on error, MRETN on success

;Error returns from skipping JSYS's:

;MRETNE - invoked via RETERR. Stores error code from T1 into user's AC 1 and LSTERR
;EMRET0 - invoked via EMRETN. Stores error code into LSTERR but not to user
;EMRET1 - invoked via JRST. Assumes LSTERR already stored.

MRETNE::UMOVEM 1,1		;RETURN ERROR CODE IN AC1
EMRET0::MOVEM 1,LSTERR		;SAVE ERROR CODE IN STANDARD PLACE
EMRET1::MOVE P,MPP		;RESTORE STACK PTR
	DMOVE T1,-1(P)		;GET RETURN PC
	EXCH T1,T2		;IN PROPER ORDER
	CALL ITRSIM		;ERJMP/ERCAL PRESENT?
	 JRST MRETN		;NO, NORMAL RETURN
	MOVEM T3,-1(P)		;YES, SETUP RETURN
	JRST MRETN

;SKMRTN IS STANDARD SKIP RETURN FROM JSYS
;Invoked via SMRETN

SKMRTN::MOVE P,MPP		;SET UP THE STACK POINTER
	AOS -1(P)		;THEN INCREMENT THE RETURN ADDRESS

;Standard return from JSYS. MPP is stack pointer at time of entry.
;Make FFL and FPC point to caller's return address

MRETN::	SETOM SLOWF		;RESET FLAG
   IFN SKEDSW,<
	AOSGE INTDF		;CHECK STATE OF INTDF
	BUG(IDFOD2)
   >				;END OF IFN SKEDSW
	MOVE P,MPP		;GO BACK TO LAST STACK FENCE
	POP P,CX		;RETURN PC
	TXZ CX,QUOTAB		;FLUSH "QUOTA" BIT
	TLNN CX,(UMODF)		;RETURN TO USER?
	JRST MRETN1		;NO

;JSYS was called from user context. Set up FFL and FPC from the stack

	MOVEM CX,FFL		;SET UP FLAGS
	POP P,FPC		;RESTORE PC
JSLKB2::			;TAG FOR JSLOOK (SNOOP PGM)
	SKIPGE FKLOCK		;FORK LOCK FREE?
	IFSKP.
	  HRRZ CX,FORKN		;GET US
	  CAME CX,FLKOWN	;ARE WE THE OWNER?
	ANSKP.
	  BUG (INCFLK)		;YES. COMPLAIN THEN
	  SETOM FKLOCK		;FREE IT
	  SETZM FLKCNT		;AND FREE THIS TOO
	ENDIF.

;ALL TRANSFERS TO USER MODE COME HERE.  THE SCHEDULER RECOGNIZES
;THE PC AT GOUSR+1 AS A SINGULARITY (USER AC BLOCK BUT MONITOR PC)
;AND CORRECTS FOR IT.

GOUSR::
	DATAO PAG,SETUSR	;SETUP USER AC BLOCK AS CURRENT
	XCT MJRSTF		;RETURN TO USER (NORMALLY XJRSTF FFL)

;Here if returning to monitor context. Check for returning from IMCALL.

MRETN1:	POP P,FPC		;RESTORE PC
	MOVEM CX,FFL		;STORE FLAGS
	TXZE CX,IMCFLG		;INTERNAL CALL FLAG?
	JRST IMCLL1		;YES, DIFFERENT RETURN SEQUENCE

;Copy "previous" AC's to "current". Restore "previous" AC's, which were stored
;in PSB at JSYS entry.

	SETZ CX,		;MOVE PREV AC TO CURRENT
	XBLTUM [BLT CX,CX-1]
	HRLZ CX,ACBAS		;POP AC STACK
	LSH CX,4
	XBLTMU [BLT CX,17]
	SOS CX,ACBAS		;DECREMENT ACBAS PTR
	CAIGE CX,<UACB>B39-1
	BUG(OPOPAC)

;Restore variables stored on UPDL stack at JSYS entry.

	POP P,MPP		;RESTORE VARIABLES
	POP P,INTDF
;	POP P,FLKCNT		;RESTORE NEXT COUNT
;	POP P,FKLOCK		;AND LOCK VALUE AS WELL
	SETZM SLOWF
	XCT MJRSTF		;RETURN TO CALLER (NORMALLY XJRSTF FFL)
;CKMMOD - CHECK FOR MONITOR MODE

	CALL CKMMOD

;RETURNS +1: CALLER CAME FROM USER CONTEXT
;	 +2: CALLER CAME FROM MONITOR CONTEXT

;CLOBBERS NO AC'S

;THIS ROUTINE IS CALLED BY A JSYS (TTMSG, FOR EXAMPLE), WHEN IT
;REQUIRES THE CALLER TO BE PRIVILEGED EXCEPT WHEN THE CALLER IS IN
;MONITOR CONTEXT.  THIS ALLOWS A NON-PRIVILEGED JSYS LIKE DTACH
;TO DO A PRIVILEGED FUNCTION LIKE TTMSG

CKMMOD::ACVAR <W1>		;GET A WORK AC
	MOVE W1,MPP		;GET STACK POINTER ON ENTRY TO THE JSYS
	MOVE W1,0(W1)		;GET THE FLAGS WORD FROM THE STACK
	TLNE W1,(UMODF)		;IS IT USER MODE?
	RET			;YES. TAKE NONSKIP RETURN
	RETSKP			;NO. TAKE SKIP RETURN

	ENDAV.			;END ACVAR
;INTERNAL MONITOR CALL LOGIC
;	JSP CX,IMCLL0
;	 ADDRESS
;THIS EFFECTS A CALL TO 'ADDRESS' (PRESUMABLY A JSYS ENTRY POINT)
;JUST AS THOUGH A JSYS HAD BEEN DONE BUT WITHOUT CHANGING THE
;PREVIOUS CONTEXT.  THUS PREVIOUS CONTEXT REFERENCES IN THE CALLEE
;WILL NOT REFERENCE THE CURRENT CONTEXT OF THE CALLER BUT RATHER
;THE PREVIOUS CONTEXT OF THE CALLER.  USED WHERE ARGUMENTS
;(E.G. BLOCK POINTERS, STRINGS) MUST BE PASSED TO LOWER LEVEL
;ROUTINES.  NOTE THAT ALL ACS ARE AUTOMATICALLY SAVED AND RESTORED,
;THE THE AC CONTEXT IS NOT CHANGED, SO ARGUMENTS MUST GENERALLY
;BE SETUP IN THE PREVIOUS CONTEXT ACS.

IMCLL0::SETOM SLOWF		;HERE VIA JSP CX,IMCLL0, INHIBIT PSI
	XSFM FFL		;SAVE FLAGS
	TXZ CX,EXFLBT		;MASK OFF FLAGS FROM JSP
	MOVEM CX,FPC		;SAVE RETURN
	ADD P,[CX,,CX]		;ALLOCATE STACK SPACE FOR ACS
	MOVEI CX,-CX+1(P)	;MOVE ACS TO STACK
	BLT CX,0(P)
;	PUSH P,FKLOCK		;SAVE VALUE OF FKLOCK
;	PUSH P,FLKCNT		;AND NEXT COUNT AS WELL
	PUSH P,INTDF		;ESTABLISH USUAL STACK CONTEXT
	PUSH P,MPP
	AOS FPC			;BUMP RETURN PAST CALL ADDRESS WORD
	PUSH P,FPC
	MOVE CX,FFL		;PICK UP FLAGS
	TXO CX,IMCFLG		;FLAG INTERNAL CALL
	PUSH P,CX		;STACK RETURN
	MOVE CX,FPC		;RESTORE PC
	MOVE CX,-1(CX)		;GET CALL ADDRESS
	TXC CX,<JSYS>		;SEE IF A JSYS
	TXCE CX,<JSYS>		;IS IT?
	IFSKP.
	  TLNE CX,<-<JSYS+1>>B53 ;MAYBE. STILL?
	ANSKP.
	  HRRZS CX		;YES. GET INDEX
	  LDB CX,[POINT ^D23,JSTAB(CX),35] ;GET DISPATCH ADDRESS
	ENDIF.
	MOVEM CX,FPC		;SET UP TRANSFER TO PROPER SECTION,,OFFSET
	MOVEM P,MPP		;SAVE STACK FENCE
	XCTU [DMOVE T1,T1]	;GET STANDARD 4 ARGS
	XCTU [DMOVE T3,T3]
	SETZM SLOWF		;ENABLE PSI
	XCT MJRSTF		;JUMP TO CALL ADDRESS

;HERE WHEN INTERNAL CALL FLAG DETECTED IN RETURN PC

IMCLL1:	POP P,MPP		;RESTORE CONTEXT VARIABLES
	POP P,INTDF
;	POP P,FLKCNT		;RESTORE NEST COUNT
;	POP P,FKLOCK		;AND LOCK AS WELL
	MOVSI CX,-CX+1(P)	;RESTORE ACS
	BLT CX,CX-1
	SUB P,[CX,,CX]		;DEALLOCATE STACK SPACE
	XCTU [DMOVE T1,T1]	;SETUP RETURN VALUES
	XCTU [DMOVE T3,T3]
	SETZM SLOWF		;ENABLE PSI
	XCT MJRSTF		;RETURN
;CHECK FOR PRESENCE OF SPECIAL INSTRUCTIONS FOLLOWING JSYS WHICH
;FAILED.

;COMMON ROUTINE TO CHECK FOR ERJMP/ERCAL AND DO
;CORRECT SIMULATION.
; T1,T2/ FLAGS AND PC
;
; RETURNS +1 IF NONE FOUND OR PDL OV ON ERCAL
; RETURNS +2 WITH RETURN ADDRS IN C(T3)
;NOTE: ALL REFERENCES TO PREVIOUS CONTEXT SHOULD BE PROTECTED WITH
;ERJMPS IN CASE USER HAS BAD PROTECTIONS, NONX SECTIONS, ETC.

ITRSIM::TXNN T1,UMODF		;CALL FROM MONITOR?
	SKIPA T3,0(T2)		;YES, FETCH FROM CURRENT CONTEXT
	UMOVE T3,0(T2)		;NO, FETCH FROM PREVIOUS CONTEXT
	 ERJMP R		;RETURN IF REF FAILS
	LDB T4,[POINT 13,T3,12]	;GET OPCODE AND AC
	CAIN T4,<ERJMP>B58	;AN ERJMP?
	JRST ITRSX		;YES
	CAIE T4,<ERCAL>B58	;AN ERCAL?
	RET			;NO

;Found an ERCAL. Fix up user's stack to simulate a call.

	HRRI T2,1(T2)		;YES, GET INCREMENTED PC
	UMOVE T4,P		;LOOK AT STACK PTR
	TXNE T2,VSECNO		;PC IN SECTION 0?
	JUMPGE T4,[MOVEI T4,1	;NO, DIFFERENT RULES
		XCTU [ADDB T4,P] ;BUMP PTR, NO OV CHECK
		JRST ITRSY]	;GO FINISH UP JUMP
	MOVE T4,[1,,1]
	XCTU [ADDB T4,P]	;BUMP PTR
	TLNN T4,377777		;PDL OVERFLOW?
	CALL [SAVET		;YES
	      MOVE T1,BITS+.ICPOV ;CHANNEL 9 INTERRUPT
	      CALL IICSLF
	      RET]
	TXNN T2,VSECNO		;IF NOT EXT ADR,
	HLL T2,T1		;INCLUDE FLAGS WITH PC
ITRSY:	UMOVEM T2,0(T4)		;STORE PC FROM JSYS
	 ERJMP [SAVET
		MOVE T1,BITS+.ICIWR ;ILLEGAL MEMORY WRITE
		CALL IICSLF	;GIVE INTERRUPT
		RET]		;AND RETURN

;Get 30-bit address to go to, and return it to caller.

ITRSX:	TLZ T3,777740		;GET RID OF INSTRUCTION PART
	TXO T3,<XMOVEI T3,0>	;FORM INST FETCH
	XCTUU T3		;GET PREV CONTEXT ADDRESS
	 ERJMP R		;GIVE UP IF E CALC FAILS
	RETSKP			;GIVE GOOD RETURN
;SET PREVIOUS CONTEXT VARIABLES
;CALLED WHEN CHANGING CONTEXT IN SOME UNUSUAL WAY, E.G. POPPING UPDL
; T1/ FLAGS
; T2/ PC
;	CALL SETPCV
;  RETURN +1 ALWAYS, ARGS PRESERVED

SETPCV::XSFM T3			;GET CURRENT FLAGS
	TXZ T3,PCU		;CLEAR VARIABLES
	TXNE T1,UMODF		;PREVIOUS CONTEXT WAS USER?
	TXO T3,PCU		;YES
	LOAD T4,VSECNO,T2	;GET PREVIOUS PC SECTION
	STOR T4,EXPCS,T3
	POP P,T4		;GET LOCAL RETURN
	ANDX T4,EXPCBT		;BUT ONLY THE GOOD BITS
	XJRSTF T3		;RETURN AND SET PREV CONTEXT VARIABLES
;ROUTINE TO CHECK IF THERE IS AN ERJMP OR AN ERCAL AFTER A JSYS
;ACCEPTS IN T1/ RETURN FLAGS
;		T2/ RETURN PC
;	CALL CHKERT
;RETURNS +1:	NO ERJMP OR ERCAL
;	 +2:	THERE IS AN ERJMP OR AN ERCAL

CHKERT::TXNE T1,IMCFLG		;INTERNAL CALL?
	SKIPA T1,0(T2)		;YES, FETCH FROM CURRENT CONTEXT
	UMOVE T1,0(T2)		;NO, FETCH FROM PREVIOUS CONTEXT
	LDB T1,[POINT 13,T1,12]	;GET OP AND AC FIELDS
	CAIE T1,<ERJMP>B58	;IS IT AN ERJMP?
	CAIN T1,<ERCAL>B58	; OR AN ERCAL?
	RETSKP			;YES
	RET			;NO

UPP::	IOWD NUPDL,UPDL		;MONITOR BASE STACK POINTER
UPP1:	XWD -NUPDL+3,UPDL-1+3	;STK PTR AT ENTRY TO TOP LEVEL JSYS
	SUBTTL SKED JSYS

;JSYS TO DO SCHEDULER CONTROLS

;JSYS TO READ/SET SCHEDULER PARAMETERS.

	SWAPCD			;START UP IS SWAPPABLE
.SKED::	MCENT			;GET INTO MONITOR
	SKIPLE T1		;VALIDATE FUNCTION
	CAILE T1,MAXFUN		;VALID FUNCTION
	ITERR (ARGX02)		;INVALID
	SKIPL FNCTBL-1(T1)	;PRIVILEGED FUNCTION?
	JRST SKED1		;NO
	MOVX T4,SC%WHL!SC%OPR	;MUST BE PRIVILEGED
	TDNN T4,CAPENB		;IS IT?
	ITERR (CAPX1)		;NO. BOMB THEN
SKED1:	HRRZ T1,FNCTBL-1(T1)	;GET DISPATCH
	JRST 0(T1)		;DO FUNCTION

FNCTBL:	SKDRNB			;READ KNOB
	IFIW!SKDSNB		;SET KNOB
	SKDRCS			;READ CLASS SHARES
	IFIW!SKDSCS		;SET CLASS SHARE
	IFIW!SKDSCL		;START CLASS SCHEDULING
	SKDSJC			;SET JOB CLASS
	SKDRTJ			;READ THIS JOB'S UTILIZATION AND SHARE
	SKDRCB			;READ CLASS SETTING FOR BATCH JOBS
	IFIW!SKDSCB		;SET BATCH CLASS
	IFIW!SKDRDQ		;RUN BATCH JOBS ON DREGS QUEUE
	IFIW![ITERR (ARGX02)]	;UNUSED SLOT
	SKDRCP			;READ CLASS PARAMETERS
MAXFUN==.-FNCTBL
;ACTION ROUTINES FOR EACH FUNCTION

;READ MICRO-CONTROL KNOB

SKDRNB:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,1		;ROOM TO STORE VALUE?
	ITERR (ARGX04)		;NO. ERROR THEN
	LOAD T1,CLSKV		;GET KNOB VALUE
	UMOVEM T1,.SAKNB(T2)		;RETURN TO USER
	MRETNG			;AND DONE

;SET MICRO-CONTROL VALUE

SKDSNB:	UMOVE T3,.SACNT(T2)		;GET COUNT
	CAIG T3,1		;HAVE VALUE TO SET?
	ITERR (ARGX04)		;NO.
	UMOVE T2,.SAKNB(T2)		;YES. GET IT
	SKIPLE T2
	CAILE T2,NSKFLV		;VALID SETTING?
	ITERR (ARGX30)		;INVALID KNOB
	STOR T2,CLSKV		;STORE KNOB VALUE
	MOVE T2,SKFLGV-1(T2)	;GET NEW FLAGS
	MOVEM T2,SCHFLG		;NEW FLAGS
	MRETNG			;AND DONE

;READ CLASS SHARE

SKDRCS:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,2		;ROOM FOR DATA?
	ITERR (ARGX04)		;NO
	SUBI T3,2		;REMOVE HEADER
	MOVNS T3
	HRLZS T3		;GET VALUE TO LH
	HRRI T3,2(T2)		;START OF DATA
	UMOVE P1,1(T2)		;GET CLASS I.D.
	SKIPL P1		;GOOD CLASS?
	CAIL P1,MAXCLS		;STILL?
	ITERR (ARGX25)		;NO
	MOVE T4,CLSSHR(P1)	;GET CLASS' SHARE
	UMOVEM T4,0(T3)		;RETURN TO CALLER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,CLSUTL(P1)	;YES. GET UTILIZATION
	UMOVEM T4,0(T3)		;RETURN TO CALLER
	AOBJP T3,SKDONE		;WANT MORE?
	IMULI P1,3		;LOAD AVERAGES *3
	MOVE T4,CLSRJA(P1)	;GET FIRST AVERAGE
	UMOVEM T4,0(T3)		;STORE IT
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,CLSRJA+1(P1)	;GET SECOND AVERAGE
	UMOVEM T4,0(T3)		;STORE IT
	AOBJP T3,SKDONE		;LAST ONE TOO?
	MOVE T4,CLSRJA+2(P1)	;GET THIRD AVERAGE
	UMOVEM T4,0(T3)		;STORE THIRD AVERAGE
	JRST SKDON0		;AND DONE

;READ THIS JOB'S UTILIZATION AND SHARE

SKDRTJ:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,2		;ROOM FOR ANY DATA?
	ITERR (ARGX04)		;NO
	SUBI T3,2		;YES. GET NUMBER OF WORDS WANTED
	MOVNS T3		;MAKE IT NEG
	HRLZS T3		;GET IT IN THE LH
	HRRI T3,.SAJCL(T2)		;FORM AOBJP POINTER
	UMOVE T1,1(T2)		;GET JOB NUMBER
	CAMN T1,[-1]		;THIS JOB?
	MOVE T1,JOBNO		;YES. GET THE JOB NUMBER THEN
	SKIPL T1		;VALID JOB NUMBER?
	CAIL T1,NJOBS		;STILL?
	ITERR (ARGX08)		;NO
	SKIPGE JOBRT(T1)	;LOGGED IN?
	ITERR (ARGX15)		;NO
	HRRZ P1,JOBCLS(T1)	;GET CLASS OF JOB
	UMOVEM P1,0(T3)		;RETURN CLASS NUMBER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,CLSSHI(P1)	;YES. GET JOB'S SHARE
	UMOVEM T4,0(T3)		;AND RETURN TO USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,JOBUTL(T1)	;YES. GET UTILIZATION
	UMOVEM T4,0(T3)		;AND RETURN IT TO THE USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,CLSSHR(P1)	;YES. GET CLASS SHARE
	UMOVEM T4,0(T3)		;AND RETURN TO USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,CLSUTL(P1)	;YES. GET CLASS UTILIZATION
	UMOVEM T4,0(T3)		;AND RETURN TO USER
SKDON0:	ADD T3,BHC+1		;ACCOUNT FOR LAST ONE
SKDONE:	HLRES T3		;GET REMAINING COUNT
	XCTU [HRRZ T4,0(T2)]	;GET ORIGINAL COUNT
	ADD T3,T4		;COMPUTE WORDS PROCESSED
	XCTU [HRLM T3,0(T2)]	;AND RETURN THIS AS WELL
	MRETNG			;AND DONE

;SET CLASS SHARE FOR CLASS N

	RESCD			;MUST BE RESIDENT TO AVOID PAGE FAULTS
SKDSCS:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,.SACLS+1	;ENOUGH ARGS GIVEN?
	ITERR (ARGX04)
	SETOM P2		;ASSUME WA SETTING IN ON
	CAILE T3,.SAWA		;SPECIFIED SWITCH SETTING?
	UMOVE P2,.SAWA(T2)	;YES. GET IT
	SKIPE P2		;ON?
	SETOM P2		;YES. SWITCH IT THEN
	XCTU [DMOVE T1,.SACLS(T2)]	;GET ARGS
	SKIPL T1
	CAILE T1,MAXCLS-1	;VALID CLASS?
	ITERR (ARGX25)
	NOSKED			;OWN MACHINE FOR A WHILE
	PUSH P,CLSSHR(T1)	;SAVE OLD CLASS VALUE
	MOVEM T2,CLSSHR(T1)	;SET NEW CLASS
	SETZM P1		;GET ACCUMULATOR
	MOVEI T3,MAXCLS-1
SKDSC1:	FAD P1,CLSSHR(T3)	;GET TOTAL SHARES ALLOCATED
	SOJGE T3,SKDSC1
	POP P,CLSSHR(T1)	;PUT BACK OLD VALUE
	JUMPE T2,SKDS11		;ALLOW 0 ALWAYS
	CAML T2,[SHRMIN]	;AT LEAST THE MINIMUM?
	CAMLE P1,[1.0]		;VALID NUMBER?
	ITERR (ARGX29,<OKSKED>)	;NO
SKDS11:	MOVEM P2,WA(T1)		;SET WA VECTOR VALUE
	EXCH T1,T2		;ORDER ARGS
	CALL CRTSHR		;MAKE SHARE
	OKSKED			;RESTORE MACHINE
	MRETNG			;AND DONE

;SET CLASS FOR JOB

SKDSJC:	TMNN CLSAC	;DOING CLASS BY ACCOUNT?
	SKIPN CLASSF		;NO. ACCOUNTING OFF?
	ITERR (SKDX1)		;YES. CAN'T DO THIS THEN
	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIGE T3,3		;ENOUGH ROOM?
	ITERR (ARGX04)		;NO
	XCTU [DMOVE T1,.SAJOB(T2)]	;GET DATA
	CAME T1,[-1]		;THIS JOB?
	CAMN T1,JOBNO		;NO. OR THIS WAY?
	SKIPA T1,JOBNO		;YES. DO IT
	JRST [	MOVX T3,SC%WHL!SC%OPR ;NO. MUST BE PRIVILEGED
		TDNN T3,CAPENB	;IS IT?
		ITERR (CAPX1)	;NO. ERROR THEN
		JRST SKDSJ0]	;YES. PROCEED
SKDSJ0:	SKIPL T1
	CAIL T1,NJOBS		;VALID JOB
	ITERR (ARGX08)		;NO
	SKIPGE JOBRT(T1)	;LOGGED IN?
	ITERR (ARGX15)		;NO
	SKIPL T2		;IS NEW CLASS IN RANGE
	CAIL T2,MAXCLS		;??
	 ITERR (ARGX25)		;NOPE, USER LOSES, BAD ARGS
;	MOVX T3,SC%WHL		;SEE IF THIS JOB IS WHEELED
;	TDNE T3,CAPENB		;IS IT?
;	JRST SKDSJ1		;YES. SKIP GETOK THEN
	GTOKM (.GOCLS,<T1,T2>)	;VERIFY REQUEST. ITRAP IF DENIED
SKDSJ1:	EXCH T1,T2		;ARRANGE ARGS PROPERLY
	NOSKED
	CALL CHGCLS		;DO CHANGE
	OKSKED
	MRETNG			;AND DONE

;START UP THE CLASS SCHEDULER

SKDSCL:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,1		;ENOUGH WORDS?
	ITERR (ARGX04)		;NO
	NOSKED
	UMOVE P1,.SACTL(T2)		;GET CONTROL WORD
	TXNE P1,SK%STP		;STOP?
	JRST [	SETZM CLASSF	;YES
		CALL QBIAS	;SET UP QUANTS PROPERLY
		JRST SKDSC0]	;DONE
	SKIPE CLASSF		;NO. IS IT NOW ON?
	ITERR (ARGX31,<OKSKED>)	;YES. CAN'T DO IT THEN
	CALL QCLASS		;SET UP CLASS QUANTS
	CALL STRCLS		;START UP CLASS SCHEDULER
	MOVEI T1,0
	TXNE P1,SK%ACT		;WANT CLASS BY ACCOUNTS?
	MOVEI T1,1		;YES.
	STOR T1,CLSAC		;STORE VALUE
	MOVEI T1,1
	TXNE P1,SK%WDF		;WITHHOLD WINDFALL?
	MOVEM T1,CLASSF		;YES. STATE THIS THEN
SKDSC0:	OKSKED			;RESTORE MACHINE
	MRETNG			;AND DONE
;FUNCTIONS TO SET/READ DEFAULT INFORMATION

;READ CLASS SETTING FOR BATCH JOBS

	SWAPCD			;BACK TO SWAPPABLE CODE
SKDRCB:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,1		;ROOM TO STORE VALUE?
	ITERR (ARGX04)		;NO. CAN'T DO IT THEN
	LOAD T1,CLSBT		;GET BATCH CLASS
	SUBI T1,1		;ONE LESS
	UMOVEM T1,.SABCL(T2)		;RETURN GOOD DATA
	MRETNG			;AND DONE

;SET BATCH CLASS

SKDSCB:	STKVAR <CLASS>
	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,1		;HAVE AN ARG?
	ITERR (ARGX04)		;NO
	UMOVE T1,.SABCL(T2)		;GET SETTING
	AOSL T1			;VALID?
	CAILE T1,MAXCLS+1	;STILL?
	ITERR (ARGX25)		;NO
	STOR T1,CLSBT		;SAVE IT
	SOS T1			;DECREMENT CLASS
	MOVEM T1,CLASS		;SAVE CLASS
	MOVSI T4,-NTTPTY	;SET UP AOBJN POINTER
SKDSB1:	MOVEI T2,(T4)		;GET NEXT PTY NUMBER
	CALL PTYJOB		;GET A JOB NUMBER
	 JRST SKDSB2		;NO JOB
	MOVE T2,T3		;GET JOB NUMBER
	MOVE T1,CLASS		;GET BACK CLASS
	NOSKED
	SKIPE JOBDIR(T2)	;JOB STILL LOGGED IN?
	CALL CHGCLS		;YES - SET ITS CLASS
	OKSKED
SKDSB2:	AOBJN T4,SKDSB1		;NEXT PTY NUMBER
	MRETNG			;AND DONE

;RUN ALL BATCH JOBS ON DREGS QUEUE

SKDRDQ:	STKVAR <OPRIOR,NPRIOR,JOBN>
	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	SKIPE T2		;HAVE A COUNT?
	CAIG T3,1		;BIG ENOUGH?
	TROA T1,1		;NO. SET IT THEN
	UMOVE T1,.SADRG(T2)		;YES. GET IT
	SKIPE T1		;SET OR CLEAR?
	MOVEI T1,1		;SET
	STOR T1,CLSBD		;DO IT
	SETZ T4,		;CLEAR DREGS STATE FIRST
	SKIPE T1		;ARE WE SETTING OR CLEARING THE STATE
	MOVX T4,DREGS		;SETTING, GET PRIORITY WORD
	MOVEM T4,NPRIOR		;AND SAVE NEW PRIORITY
	MOVSI T4,-NTTPTY	;GET AOBJN POINTER OVER PTYSTS TABLE
SKDDQ1:	MOVEI T2,0(T4)		;GET PTY NUMBER
	CALL PTYJOB		;GET CONTROLLING JOB NUMBER
	 JRST SKDDQ2		;TERMINAL NOT ACTIVE, SHOULD NOT HAPPEN
	MOVEM T3,JOBN		;SAVE JOB NUMBER
	MOVE T1,JOBN		;GET JOB NUMBER INTO AC1
	CALL MAPJSB		;MAP IN THE JOBS JSB
	 JRST SKDDQ2		;NO JOB? FORGET IT
	MOVE T2,JOBSKD(T1)	;GET OLD PRIORITY WORD.
	MOVEM T2,OPRIOR		;SAVE OLD PRIORITY WORD
	CALL CLRJSB		;NOW CLEAR THE MAPPING OF THE JSB
	SKIPE T2,OPRIOR		;WAS A PRIORITY SET?
	CAIN T2,DREGS		;EITHER 0 OR DREGS?
	SKIPA			;YES, OKAY TO CHANGE
	 JRST SKDDQ2		;NO, CHANGED PRIORITY, SKIP IT
	MOVE T1,JOBN		;GET BACK JOB NUMBER
	MOVE T2,NPRIOR		;AND GET NEW PRIORITY WORD
	SJPRI			;SET IT
	 ERJMP SKDDQ2		;SHOULD NOT GENERATE AN ERROR
SKDDQ2:	AOBJN T4,SKDDQ1		;LOOP OVER ALL PTYS
	MRETNG			;AND DONE

;ROUTINE TO CONVERT FROM A PTY NUMBER TO CONTROLLING JOB NUMBER IF A BATCH JOB
;ACCEPTS IN T2/ PTY NUMBER
;	CALL PTYJOB
;RETURNS +1: NOT A BATCH JOB OR NOT A JOB
;	 +2: JOB NUMBER IN T3

PTYJOB:	STKVAR <TTYN>
	CALL PTYTTY		;CONVERT FROM PTY NUMBER TO TTY
	MOVE T1,T2		;GET TTY NUMBER
	MOVEM T2,TTYN		;SAVE TTY NUMBER
	CALL CHKBCH		;SEE IF A BATCH JOB
	 RET			;NOPE
	MOVE T2,TTYN		;GET TTY NUMBER
	CALL GTCJOB		;GET CONTROLLING JOB NUMBER
	 RET			;NO JOB
	RETSKP			;SUCCESS

;READ CLASS PARAMETERS

SKDRCP:	XCTU [HRRZ T3,.SACNT(T2)]	;GET COUNT
	CAIG T3,1		;ROOM FOR DATA?
	ITERR (ARGX04)		;NO
	SKIPN CLASSF		;CLASS SCHEDULER ON?
	JRST [	MOVX T1,SK%STP	;NO. SAY STOPPED
		JRST SKDRC0]	;AND FINISH UP
	SETZM T1		;INIT VALUE
	TMNE CLSAC	;DOING ACCOUNTS?
	TXO T1,SK%ACT		;YES
	SKIPL CLASSF		;WINDFALL WITHHELD?
	TXO T1,SK%WDF		;YES.
SKDRC0:	LOAD T3,CLSBD		;SEE IF BATCH ON DREGS
	STOR T3,SK%DRG,T1	;0 IF SO, 1 IF NOT
	UMOVEM T1,.SACTL(T2)		;RETURN DATA
	MRETNG			;AND DONE
	TNXEND
	END